[Vm-dev] VM Maker: VMMaker.oscog-eem.1137.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Mar 31 18:34:01 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1137.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1137
Author: eem
Time: 31 March 2015, 11:31:47.262 am
UUID: f5b1b284-2ce3-43df-a03a-279529d7091c
Ancestors: VMMaker.oscog-eem.1136
Rescue generation of cogit.c after adding NSSendCache
type. Do so by moving the definition of the
nsSendcache variable in all uses inside the
cppIf: NewspeakVM block and beefing up unused
variable deletion to no longer include varables
referenced in dead code.
To do this add a new parse tree enumerator,
nodesDo:parent:unless:, and refactoring
allReferencedVariables and removeUnusedTemps
to take the code generator as an argument.
=============== Diff against VMMaker.oscog-eem.1136 ===============
Item was changed:
----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') -----
addMethodFor: aClass selector: selector
"Add the given method to the code base and answer its translation
or nil if it shouldn't be translated."
| method tmethod |
method := aClass compiledMethodAt: selector.
(method pragmaAt: #doNotGenerate) ifNotNil:
["only remove a previous method if this one overrides it, i.e. this is a subclass method.
If the existing method is in a different hierarchy this method must be merely a redeirect."
(methods at: selector ifAbsent: []) ifNotNil:
[:tm|
(aClass includesBehavior: tm definingClass) ifTrue:
[self removeMethodForSelector: selector]].
^nil].
method isSubclassResponsibility ifTrue:
[^nil].
(self shouldIncludeMethodFor: aClass selector: selector) ifFalse:
[^nil].
tmethod := self compileToTMethodSelector: selector in: aClass.
"Even thoug we exclude initialize methods, we must consider their
global variable usage, otherwise globals may be incorrectly localized."
selector == #initialize ifTrue:
+ [self checkForGlobalUsage: (tmethod allReferencedVariablesIn: self) in: tmethod.
- [self checkForGlobalUsage: tmethod allReferencedVariables in: tmethod.
^nil].
self addMethod: tmethod.
"If the method has a macro then add the macro. But keep the method
for analysis purposes (e.g. its variable accesses)."
(method pragmaAt: #cmacro:) ifNotNil:
[:pragma|
self addMacro: (pragma argumentAt: 1) for: selector.
(inlineList includes: selector) ifTrue:
[inlineList := inlineList copyWithout: selector]].
(method propertyValueAt: #cmacro:) ifNotNil:
[:macro|
self addMacro: macro for: selector.
(inlineList includes: selector) ifTrue:
[inlineList := inlineList copyWithout: selector]].
^tmethod!
Item was added:
+ ----- Method: CCodeGenerator>>addVariablesInVerbatimCIn:to: (in category 'utilities') -----
+ addVariablesInVerbatimCIn: aCCodeSendNode to: aCollection
+ "If aCCodeSendNode has a string argument, parse it and extract anything
+ that looks like a variable, and add the resulting vars to aCollection."
+ | separators tokens |
+ (aCCodeSendNode isSend
+ and: [(aCCodeSendNode selector beginsWith: #cCode:)
+ and: [aCCodeSendNode args first isConstant
+ and: [aCCodeSendNode args first value isString]]]) ifFalse:
+ [^self].
+ separators := (Character space to: 255 asCharacter) reject:
+ [:char|
+ char isLetter or: [char isDigit or: [char = $_]]].
+ tokens := aCCodeSendNode args first value findTokens: separators.
+ aCollection addAll: (tokens select: [:token| token first isLetter]) asSet!
Item was changed:
----- Method: CCodeGenerator>>emitCCodeOn:doInlining:doAssertions: (in category 'C code generator') -----
emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag
"Emit C code for all methods in the code base onto the given stream. All inlined method calls should already have been expanded."
| verbose methodList |
"method preparation"
verbose := false.
self prepareMethods.
verbose ifTrue: [
self printUnboundCallWarnings.
self printUnboundVariableReferenceWarnings.
logger cr.
].
assertionFlag ifFalse: [ self removeAssertions ].
self doInlining: inlineFlag.
"code generation"
"If we're outputting the VM put the main interpreter loop first for two reasons.
1, so that the dispdbg.h header included at the bytecode dispatch can define
macros that affect all C code in the interpreter, and 2, so that all primitive
functions will come after and have relatively high addresses. This provides safety
in the use of primitiveFunctionPointer as a function pointer and an index by trying
to ensure that primitives have addresses much higher than any indices."
methodList := self sortMethods: methods.
(methods includesKey: #interpret) ifTrue:
[methodList := { methods at: #interpret }, (methodList copyWithout: (methods at: #interpret))].
"clean out no longer valid variable names and then
handle any global variable usage in each method"
+ methodList do: [:m | self checkForGlobalUsage: (m removeUnusedTempsIn: self) in: m].
- methodList do: [:m | self checkForGlobalUsage: m removeUnusedTemps in: m].
self localizeGlobalVariables.
self emitCHeaderOn: aStream.
self emitCTypesOn: aStream.
self emitCConstantsOn: aStream.
self emitCFunctionPrototypes: methodList on: aStream.
self emitCVariablesOn: aStream.
self emitCMacros: methodList on: aStream.
self emitCMethods: methodList on: aStream.
self emitExportsOn: aStream.
!
Item was changed:
----- Method: CCodeGenerator>>generateInlineCppIfElse:asArgument:on:indent: (in category 'C translation') -----
generateInlineCppIfElse: msgNode asArgument: asArgument on: aStream indent: level
"Generate the C code for this message onto the given stream."
| expr putStatement |
"Compile-time expansion for constants set in the options dictionary,
e.g. to cut down on noise for MULTIPLEBYTECODESETS."
putStatement := asArgument
ifTrue: "emitCCodeAsArgumentOn: doesn't indent, the code needs indenting if it takes multiple lines, so post-process."
[[:node| | expansion |
expansion := String streamContents: [:s| node emitCCodeAsArgumentOn: s level: level generator: self].
aStream nextPutAll:
((expansion includes: Character cr)
ifTrue:
[(String streamContents:
[:s|
s position > 0 ifTrue: [s tab: level + 1].
node emitCCodeAsArgumentOn: s level: level generator: self])
copyReplaceAll: (String with: Character cr)
with: (String with: Character cr), (String new: level + 1 withAll: Character tab)]
ifFalse: [expansion])]]
ifFalse:
[[:node| | expansion |
expansion := String streamContents: [:s| node emitCCodeOn: s level: level generator: self].
"Remove tabs from first line to avoid indenting a second time"
expansion := expansion allButFirst: (expansion findFirst: [:c| c ~~ Character tab]) - 1.
aStream nextPutAll: expansion]].
+ (self nilOrBooleanConditionFor: msgNode) ifNotNil:
+ [:condition|
+ condition
- (optionsDictionary notNil
- and: [msgNode args first isConstant
- and: [#(true false) includes: (optionsDictionary at: msgNode args first name ifAbsent: [nil])]]) ifTrue:
- [(optionsDictionary at: msgNode args first name)
ifTrue:
[putStatement value: msgNode args second]
ifFalse:
[msgNode args size >= 3 ifTrue:
[putStatement value: msgNode args third]].
^self].
"Full #if ... #else..."
putStatement := asArgument
ifTrue: "emitCCodeAsArgumentOn: doesn't indent, the code needs indenting in this case, so post-process."
[[:node|
aStream nextPutAll:
((String streamContents:
[:s|
s next: level + 1 put: Character tab.
node emitCCodeAsArgumentOn: s level: level generator: self])
copyReplaceAll: (String with: Character cr)
with: (String with: Character cr), (String new: level + 1 withAll: Character tab))]]
ifFalse:
[[:node| node emitCCodeOn: aStream level: level generator: self]].
expr := String streamContents:
[:es|
msgNode args first
emitCCodeAsArgumentOn: es
level: 0
generator: self].
[expr last isSeparator] whileTrue:
[expr := expr allButLast].
aStream
ensureCr;
nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'if '; nextPutAll: expr; cr.
self with: msgNode args first
ifAppropriateSetTo: true
do: [putStatement value: msgNode args second].
expr := ' /* ', expr, ' */'.
msgNode args size >= 3 ifTrue:
[aStream
ensureCr;
nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'else'; nextPutAll: expr;
cr.
self with: msgNode args first
ifAppropriateSetTo: false
do: [putStatement value: msgNode args third]].
aStream
ensureCr;
nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'endif'; nextPutAll: expr;
cr.
asArgument ifTrue:
[aStream next: level + 1 put: Character tab]!
Item was added:
+ ----- Method: CCodeGenerator>>nilOrBooleanConditionFor: (in category 'utilities') -----
+ nilOrBooleanConditionFor: nodeOrNil
+ "If nodeOrNil is one of the conditional sends for which we do translation-time dead code elimination
+ (i.e. cppIf:ifTrue: et al or ifTrue: et al) and the conditional does evaluate to a translation-time
+ boolean constant, answer that constant, otherwise answer nil. Used to prune dead code,
+ either for code egenraton or dead variable elimination."
+ nodeOrNil ifNil:
+ [^nil].
+ nodeOrNil isSend ifFalse:
+ [^nil].
+ (#(cppIf:ifTrue: cppIf:ifTrue:ifFalse:) includes: nodeOrNil selector) ifTrue:
+ [^(optionsDictionary notNil
+ and: [nodeOrNil args first isConstant
+ and: [#(true false) includes: (optionsDictionary at: nodeOrNil args first name ifAbsent: [nil])]]) ifTrue:
+ [optionsDictionary at: nodeOrNil args first name]].
+
+ ^(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: nodeOrNil selector) ifTrue:
+ [self nilOrBooleanConstantReceiverOf: nodeOrNil]!
Item was changed:
----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
#( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
+ 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
- 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass'
'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
[:simulationVariableNotNeededForRealVM|
aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
NewspeakVM ifFalse:
[#( 'selfSendEntry' 'selfSendEntryAlignment' 'cmSelfSendEntryOffset'
'dynSuperEntry' 'dynSuperEntryAlignment' 'cmDynSuperEntryOffset'
'selfSendTrampolines' 'dynamicSuperSendTrampolines' 'implicitReceiverSendTrampolines'
'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
[:variableNotNeededInNormalVM|
aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
aCCodeGenerator
addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
addHeaderFile:'"sqCogStackAlignment.h"';
addHeaderFile:'"dispdbg.h"'; "must preceed cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
addHeaderFile:'"cogmethod.h"'.
NewspeakVM ifTrue:
[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
aCCodeGenerator
addHeaderFile:'#if COGMTVM';
addHeaderFile:'"cointerpmt.h"';
addHeaderFile:'#else';
addHeaderFile:'"cointerp.h"';
addHeaderFile:'#endif';
addHeaderFile:'"cogit.h"'.
aCCodeGenerator
var: #ceGetSP
declareC: 'unsigned long (*ceGetSP)(void)';
var: #ceCaptureCStackPointers
declareC: 'void (*ceCaptureCStackPointers)(void)';
var: #ceEnterCogCodePopReceiverReg
declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
var: #realCEEnterCogCodePopReceiverReg
declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
var: #ceCallCogCodePopReceiverReg
declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
var: #realCECallCogCodePopReceiverReg
declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
var: #ceCallCogCodePopReceiverAndClassRegs
declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
var: #realCECallCogCodePopReceiverAndClassRegs
declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
var: #ceFlushICache
declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
var: #ceCheckFeaturesFunction
declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
var: #ceTryLockVMOwner
declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
var: #ceUnlockVMOwner
declareC: 'void (*ceUnlockVMOwner)(void)';
var: #postCompileHook
declareC: 'void (*postCompileHook)(CogMethod *, void *)';
var: #openPICList declareC: 'CogMethod *openPICList = 0';
var: #maxMethodBefore type: #'CogBlockMethod *'.
aCCodeGenerator
declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel';
var: #primInvokeLabel type: #'AbstractInstruction *'.
self declareC: #(abstractOpcodes stackCheckLabel
blockEntryLabel blockEntryNoContextSwitch
stackOverflowCall sendMiss
entry noCheckEntry selfSendEntry dynSuperEntry
picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1)
as: #'AbstractInstruction *'
in: aCCodeGenerator.
aCCodeGenerator
declareVar: #annotations type: #'InstructionAnnotation *';
declareVar: #blockStarts type: #'BlockStart *';
declareVar: #fixups type: #'BytecodeFixup *'.
aCCodeGenerator
var: #ordinarySendTrampolines
declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
var: #superSendTrampolines
declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
var: #selfSendTrampolines
declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
var: #dynamicSuperSendTrampolines
declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
var: #implicitReceiverSendTrampolines
declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
var: #trampolineAddresses
declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
var: #objectReferencesInRuntime
declareC: 'static sqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
var: #labelCounter
type: #int;
var: #traceFlags
declareC: 'int traceFlags = 8 /* prim trace log on by default */';
var: #cStackAlignment
declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
aCCodeGenerator
declareVar: #CFramePointer type: #'void *';
declareVar: #CStackPointer type: #'void *';
declareVar: #minValidCallAddress type: #'unsigned long';
declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
aCCodeGenerator vmClass generatorTable ifNotNil:
[:bytecodeGenTable|
aCCodeGenerator
var: #generatorTable
declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
(self tableInitializerFor: bytecodeGenTable
in: aCCodeGenerator);
var: #primitiveGeneratorTable
declareC: 'static PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]',
(self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
in: aCCodeGenerator)].
"In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic
sugar to avoid the clash."
(self organization listAtCategoryNamed: #'abstract instructions') do:
[:s|
aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!
Item was changed:
----- Method: Cogit>>checkIfValidOopRef:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidOopRef: annotation pc: mcpc cogMethod: cogMethod
- | nsSendCache |
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
annotation = IsObjectReference ifTrue:
[| literal |
literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
(objectRepresentation checkValidOopReference: literal) ifFalse:
[coInterpreter print: 'object ref leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]].
self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
+ [| nsSendCache enclosingObject |
- [ | enclosingObject |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
[(objectRepresentation checkValidOopReference: nsSendCache selector) ifFalse:
[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]].
(enclosingObject := nsSendCache enclosingObject) ~= 0 ifTrue:
[[(objectRepresentation checkValidOopReference: enclosingObject) ifFalse:
[coInterpreter print: 'enclosing object leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]]]]].
annotation = IsSendCall ifTrue:
[| entryPoint selectorOrCacheTag offset |
entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint <= methodZoneBase
ifTrue:
[offset := entryPoint]
ifFalse:
[self
offsetAndSendTableFor: entryPoint
annotation: annotation
into: [:off :table| offset := off]].
selectorOrCacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
(entryPoint > methodZoneBase
and: [offset ~= cmNoCheckEntryOffset
and: [(self cCoerceSimple: entryPoint - offset to: #'CogMethod *') cmType ~= CMOpenPIC]])
ifTrue: "linked non-super send, cacheTag is a cacheTag"
[(objectRepresentation validInlineCacheTag: selectorOrCacheTag) ifFalse:
[coInterpreter print: 'cache tag leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]]
ifFalse: "unlinked send or super send; cacheTag is a selector"
[(objectRepresentation checkValidOopReference: selectorOrCacheTag) ifFalse:
[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>checkIfValidOopRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidOopRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ | literal entryPoint |
- | literal entryPoint nsSendCache |
annotation = IsObjectReference ifTrue:
[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
(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]]].
self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
+ [ | nsSendCache classTag enclosingObject nsTargetMethod |
- [ | 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]]]].
annotation = IsSendCall ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
[^3].
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 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 into:
[:targetMethod :sendTable|
(self asserta: (targetMethod cmType = CMMethod
or: [targetMethod cmType = CMClosedPIC
or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
[^8]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>incrementUsageOfTargetIfLinkedSend:mcpc:ignored: (in category 'compaction') -----
incrementUsageOfTargetIfLinkedSend: annotation mcpc: mcpc ignored: superfluity
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ | entryPoint |
- | entryPoint nsSendCache |
self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
+ [| nsSendCache |
+ nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ nsSendCache classTag ~= 0 ifTrue: "send is linked"
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- nsSendCache classTag ~= 0 ifTrue: "send is linked"
[ | targetMethod |
entryPoint := nsSendCache target.
targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
self assert: (self isPCWithinMethodZone: targetMethod asUnsignedInteger).
targetMethod cmUsageCount < (CMMaxUsageCount // 2) ifTrue:
[targetMethod cmUsageCount: targetMethod cmUsageCount + 1]]]].
annotation = IsSendCall ifTrue:
[self assert: annotation ~= IsNSSendCall.
+ entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
- entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint into:
[:targetMethod :sendTable|
targetMethod cmUsageCount < (CMMaxUsageCount // 2) ifTrue:
[targetMethod cmUsageCount: targetMethod cmUsageCount + 1]]]].
^0 "keep scanning"!
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 |
- | literal nsSendCache |
annotation = IsObjectReference ifTrue:
[literal := backEnd literalBeforeFollowingAddress: mcpc asUnsignedInteger.
(objectRepresentation
markAndTraceLiteral: literal
in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]].
self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
+ [| nsSendCache sel eo |
- [ | 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)
- 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 *')]]]].
annotation = IsSendCall ifTrue:
[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 |
- | literal nsSendCache |
annotation = IsObjectReference ifTrue:
[literal := backEnd literalBeforeFollowingAddress: mcpc asUnsignedInteger.
(objectRepresentation
markAndTraceLiteral: literal
in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]].
self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
+ [| nsSendCache entryPoint targetMethod sel eo |
- [ | entryPoint targetMethod sel eo |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
entryPoint := nsSendCache target.
entryPoint ~= 0 ifTrue: "Send is linked"
[targetMethod := entryPoint - cmNoCheckEntryOffset.
(self markAndTraceOrFreeCogMethod: targetMethod
firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger) ifTrue:
[nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
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 *')]]]].
annotation = IsSendCall ifTrue:
[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj | | cacheTagMarked |
+ self assert: annotation ~= IsNSSendCall.
- self assert: annotation ~= IsNSSendCall.
cacheTagMarked := tagCouldBeObj and: [objectRepresentation cacheTagIsMarked: cacheTag].
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint 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: 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 |
- | literal nsSendCache |
annotation = IsObjectReference ifTrue:
[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
objectRepresentation markAndTraceLiteralIfYoung: literal].
self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
+ [| nsSendCache |
+ nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ objectRepresentation markAndTraceLiteralIfYoung: nsSendCache selector.
+ nsSendCache enclosingObject ~= 0 ifTrue:
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- objectRepresentation markAndTraceLiteralIfYoung: nsSendCache selector.
- nsSendCache enclosingObject ~= 0 ifTrue:
[objectRepresentation markAndTraceLiteralIfYoung: nsSendCache enclosingObject]]].
annotation = IsSendCall ifTrue:
[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj |
tagCouldBeObj ifTrue:
[objectRepresentation markAndTraceLiteralIfYoung: cacheTag]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>relocateIfCallOrMethodReference:mcpc:delta: (in category 'compaction') -----
relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: delta
<var: #mcpc type: #'char *'>
+ | entryPoint offset sendTable targetMethod unlinkedRoutine |
- | entryPoint offset sendTable targetMethod unlinkedRoutine nsSendCache |
<var: #sendTable type: #'sqInt *'>
<var: #targetMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ self cppIf: NewspeakVM ifTrue:
+ [| nsSendCache |
+ annotation = IsNSSendCall ifTrue:
+ ["Retrieve the send cache before relocating the stub call. Fetching the send
+ cache asserts the stub call points below all the cogged methods, but
+ until this method is actually moved, the adjusted stub call may appear to
+ point to somewhere in the method zone."
+ nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- ["Retrieve the send cache before relocating the stub call. Fetching the send
- cache asserts the stub call points below all the cogged methods, but
- until this method is actually moved, the adjusted stub call may appear to
- point to somewhere in the method zone."
- nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ "Fix call to trampoline. This method is moving [delta] bytes, and calls are
+ relative, so adjust the call by -[delta] bytes"
+ backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
- "Fix call to trampoline. This method is moving [delta] bytes, and calls are
- relative, so adjust the call by -[delta] bytes"
- backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
+ nsSendCache target ~= 0 ifTrue: "Send is linked"
+ [entryPoint := nsSendCache target.
+ targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ targetMethod cmType = CMMethod
+ ifTrue: "send target not freed; just relocate. The cache has an absolute
+ target, so only adjust by the target method's displacement."
+ [nsSendCache target: entryPoint + targetMethod objectHeader]
+ ifFalse: "send target was freed, unlink"
+ [nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
+ ^0]].
- nsSendCache target ~= 0 ifTrue: "Send is linked"
- [entryPoint := nsSendCache target.
- targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
- targetMethod cmType = CMMethod
- ifTrue: "send target not freed; just relocate. The cache has an absolute
- target, so only adjust by the target method's displacement."
- [nsSendCache target: entryPoint + targetMethod objectHeader]
- ifFalse: "send target was freed, unlink"
- [nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
- ^0]].
annotation = IsSendCall ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint <= methodZoneBase ifTrue: "send is not linked; just relocate"
[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
^0].
"It's a linked send; find which kind."
self
offsetAndSendTableFor: entryPoint
annotation: annotation
into: [:off :table| offset := off. sendTable := table].
targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
targetMethod cmType = CMMethod ifTrue: "send target not freed; just relocate."
[backEnd
relocateCallBeforeReturnPC: mcpc asInteger
by: (delta - targetMethod objectHeader) negated.
^0].
"Target was freed; map back to an unlinked send; but include this method's reocation"
unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
unlinkedRoutine := unlinkedRoutine - delta.
backEnd
rewriteInlineCacheAt: mcpc asInteger
tag: targetMethod selector
target: unlinkedRoutine.
^0].
annotation = IsRelativeCall ifTrue:
[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
^0].
annotation = IsAbsPCReference ifTrue:
[backEnd relocateMethodReferenceBeforeAddress: mcpc asInteger by: delta].
^0 "keep scanning"!
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 *'>
- | nsSendCache |
annotation = IsObjectReference ifTrue:
[| literal mappedLiteral |
literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
(objectRepresentation couldBeObject: literal) ifTrue:
[mappedLiteral := objectRepresentation remapObject: literal.
literal ~= mappedLiteral ifTrue:
[backEnd storeLiteral: mappedLiteral beforeFollowingAddress: mcpc asInteger.
codeModified := true].
(hasYoungPtr ~= 0
and: [objectMemory isYoung: mappedLiteral]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
+ [| nsSendCache oop mappedOop |
- [ | oop mappedOop |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
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"]].
annotation = IsSendCall ifTrue:
[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 asInteger.
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 into:
[:targetMethod :ignored|
(objectMemory isYoung: targetMethod selector) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkIfForwardedSend:pc:ignored: (in category 'in-line cacheing') -----
unlinkIfForwardedSend: annotation pc: mcpc ignored: superfluity
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ | entryPoint |
- | entryPoint nsSendCache |
+ self cppIf: NewspeakVM ifTrue:
+ [| nsSendCache |
+ annotation = IsNSSendCall ifTrue:
+ [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ nsSendCache classTag ~= 0 ifTrue:
+ [(objectMemory isForwardedClassIndex: nsSendCache classTag) ifTrue: [
+ nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
+ "Should we check if the enclosing object's class is forwarded as well?"
+ ^0 "keep scanning"]].
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- nsSendCache classTag ~= 0 ifTrue:
- [(objectMemory isForwardedClassIndex: nsSendCache classTag) ifTrue: [
- nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
- "Should we check if the enclosing object's class is forwarded as well?"
- ^0 "keep scanning"]].
annotation = IsSendCall ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase
ifTrue: "It's a linked send, but maybe a super send or linked to an OpenPIC, in which case the cache tag will be a selector...."
[(objectMemory isForwardedClassIndex: (backEnd inlineCacheTagAt: mcpc asInteger)) ifTrue:
[self targetMethodAndSendTableFor: entryPoint into:
[:targetMethod :sendTable|
self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkIfFreeOrLinkedSend:pc:of: (in category 'in-line cacheing') -----
unlinkIfFreeOrLinkedSend: annotation pc: mcpc of: theSelector
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ | entryPoint |
- | entryPoint nsSendCache |
+ self cppIf: NewspeakVM ifTrue:
+ [| nsSendCache |
+ annotation = IsNSSendCall ifTrue:
+ [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ (entryPoint := nsSendCache target) ~= 0 ifTrue:
+ [ | targetMethod |
+ targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ (targetMethod cmType = CMFree or: [nsSendCache selector = theSelector]) ifTrue:
+ [nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
+ ^0 "keep scanning"]].
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- (entryPoint := nsSendCache target) ~= 0 ifTrue:
- [ | targetMethod |
- targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
- (targetMethod cmType = CMFree or: [nsSendCache selector = theSelector]) ifTrue:
- [nsSendCache classTag: 0; enclosingObject: 0; target: 0]].
- ^0 "keep scanning"]].
annotation = IsSendCall ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint into:
[:targetMethod :sendTable|
(targetMethod cmType = CMFree
or: [targetMethod selector = theSelector]) ifTrue:
[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkIfLinkedSend:pc:ignored: (in category 'in-line cacheing') -----
unlinkIfLinkedSend: annotation pc: mcpc ignored: superfluity
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ | entryPoint |
- | entryPoint nsSendCache |
+ self cppIf: NewspeakVM ifTrue:
+ [| nsSendCache |
+ annotation = IsNSSendCall ifTrue:
+ [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ nsSendCache classTag ~= 0 ifTrue: "Send is linked"
+ [nsSendCache classTag: 0; enclosingObject: 0; target: 0].
+ ^0 "keep scanning"]].
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- nsSendCache classTag ~= 0 ifTrue: "Send is linked"
- [nsSendCache classTag: 0; enclosingObject: 0; target: 0].
- ^0 "keep scanning"]].
annotation = IsSendCall ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint into:
[:targetMethod :sendTable|
self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkIfLinkedSend:pc:of: (in category 'in-line cacheing') -----
unlinkIfLinkedSend: annotation pc: mcpc of: theSelector
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ | entryPoint |
- | entryPoint nsSendCache |
+ self cppIf: NewspeakVM ifTrue:
+ [| nsSendCache |
+ annotation = IsNSSendCall ifTrue:
+ [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ nsSendCache selector = theSelector ifTrue:
+ [nsSendCache classTag: 0; enclosingObject: 0; target: 0].
+ ^0 "keep scanning"]].
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- nsSendCache selector = theSelector ifTrue:
- [nsSendCache classTag: 0; enclosingObject: 0; target: 0].
- ^0 "keep scanning"]].
annotation = IsSendCall ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint into:
[:targetMethod :sendTable|
targetMethod selector = theSelector ifTrue:
[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkIfLinkedSend:pc:to: (in category 'in-line cacheing') -----
unlinkIfLinkedSend: annotation pc: mcpc to: theCogMethod
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ | entryPoint |
- | entryPoint nsSendCache |
+ self cppIf: NewspeakVM ifTrue:
+ [| nsSendCache |
+ annotation = IsNSSendCall ifTrue:
+ [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ (entryPoint := nsSendCache target) ~= 0 ifTrue:
+ [ | targetMethod |
+ targetMethod := entryPoint - cmNoCheckEntryOffset.
+ targetMethod = theCogMethod ifTrue:
+ [nsSendCache classTag: 0.
+ nsSendCache enclosingObject: 0.
+ nsSendCache target: 0]].
+ ^0 "keep scanning"]].
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- (entryPoint := nsSendCache target) ~= 0 ifTrue:
- [ | targetMethod |
- targetMethod := entryPoint - cmNoCheckEntryOffset.
- targetMethod = theCogMethod ifTrue:
- [nsSendCache classTag: 0.
- nsSendCache enclosingObject: 0.
- nsSendCache target: 0]].
- ^0 "keep scanning"]].
annotation = IsSendCall ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint into:
[:targetMethod :sendTable|
targetMethod asInteger = theCogMethod ifTrue:
[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkIfLinkedSendToFree:pc:ignored: (in category 'in-line cacheing') -----
unlinkIfLinkedSendToFree: annotation pc: mcpc ignored: superfluity
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
<var: #nsTargetMethod type: #'CogMethod *'>
+ | entryPoint |
- | entryPoint nsSendCache nsTargetMethod |
+ self cppIf: NewspeakVM ifTrue:
+ [| nsSendCache nsTargetMethod |
+ annotation = IsNSSendCall ifTrue:
+ [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ (entryPoint := nsSendCache target) ~= 0 ifTrue: "It's a linked send."
+ [nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ nsTargetMethod cmType = CMFree ifTrue:
+ [nsSendCache classTag: 0.
+ nsSendCache enclosingObject: 0.
+ nsSendCache target: 0]].
+ ^0 "keep scanning"]].
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- (entryPoint := nsSendCache target) ~= 0 ifTrue: "It's a linked send."
- [nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
- nsTargetMethod cmType = CMFree ifTrue:
- [nsSendCache classTag: 0.
- nsSendCache enclosingObject: 0.
- nsSendCache target: 0]].
- ^0 "keep scanning"]].
annotation = IsSendCall ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint into:
[:targetMethod :sendTable|
targetMethod cmType = CMFree ifTrue:
[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
^0 "keep scanning"!
Item was added:
+ ----- Method: TAssignmentNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+
+ (cautionaryBlock value: self value: parent) ifTrue: [^self].
+ variable nodesDo: aBlock parent: self unless: cautionaryBlock.
+ expression nodesDo: aBlock parent: self unless: cautionaryBlock.
+ aBlock value: self value: parent!
Item was added:
+ ----- Method: TBraceCaseNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+
+ (cautionaryBlock value: self value: parent) ifTrue: [^self].
+ caseLabels do:
+ [:node| node nodesDo: aBlock parent: self unless: cautionaryBlock].
+ cases do:
+ [:node| node nodesDo: aBlock parent: self unless: cautionaryBlock].
+ aBlock value: self value: parent!
Item was added:
+ ----- Method: TCaseStmtNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+
+ (cautionaryBlock value: self value: parent) ifTrue: [^self].
+ expression nodesDo: aBlock parent: self unless: cautionaryBlock.
+ cases do: [ :c | c nodesDo: aBlock parent: self unless: cautionaryBlock].
+ aBlock value: self value: parent!
Item was added:
+ ----- Method: TInlineNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+
+ (cautionaryBlock value: self value: parent) ifTrue: [^self].
+ method parseTree nodesDo: aBlock parent: self unless: cautionaryBlock.
+ aBlock value: self value: parent!
Item was removed:
- ----- Method: TMethod>>allReferencedVariables (in category 'accessing') -----
- allReferencedVariables
- "Answer the set of all variables referenced in the receiver."
- | refs |
- refs := Set new.
- "find all the variable names referenced in this method"
- parseTree nodesDo:
- [:node|
- node isVariable ifTrue: [refs add: node name asString].
- node isStmtList ifTrue: [refs addAll: node args]].
- "add all the non-arg declarations (might be variables used only in cCode sections)"
- refs addAll: (declarations keys reject: [:e | self args includes: e]).
- ^refs!
Item was added:
+ ----- Method: TMethod>>allReferencedVariablesIn: (in category 'accessing') -----
+ allReferencedVariablesIn: aCodeGen
+ "Answer the set of all variables referenced in the receiver."
+ | refs |
+ refs := Set new.
+ "Find all the variable names referenced in this method.
+ Don't descend into "
+ parseTree
+ nodesWithParentsDo:
+ [:node :parent|
+ node isVariable ifTrue: [refs add: node name asString].
+ node isStmtList ifTrue: [refs addAll: node args].
+ (node isSend
+ and: [node selector beginsWith: #cCode:]) ifTrue:
+ [aCodeGen addVariablesInVerbatimCIn: node to: refs]]
+ unless:
+ [:node :parent|
+ (aCodeGen nilOrBooleanConditionFor: parent)
+ ifNil: [false]
+ ifNotNil:
+ [:condition| "double negatives are confusing, aren't they ;-)"
+ node = parent args second == condition not]].
+ ^refs!
Item was changed:
----- Method: TMethod>>emitInlineOn:level:generator: (in category 'C code generation') -----
emitInlineOn: aStream level: level generator: aCodeGen
"Emit C code for this method onto the given stream. All calls to inlined methods should already have been expanded."
+ self removeUnusedTempsIn: aCodeGen.
- self removeUnusedTemps.
sharedLabel ifNotNil:
[aStream crtab: level-1; nextPutAll: sharedLabel; nextPut: $:.
aStream crtab: level.
aStream nextPutAll: '/* '; nextPutAll: selector; nextPutAll: ' */'.
aStream crtab: level].
aStream nextPut: ${.
locals isEmpty ifFalse:
[(aCodeGen sortStrings: locals) do:
[:var|
aStream
crtab: level+1;
nextPutAll: (self declarationAt: var);
nextPut: $;].
aStream cr].
aStream crtab: level+1.
aCodeGen outputAsmLabel: selector on: aStream.
aStream crtab: level+1.
aCodeGen
pushScope: declarations
while: [parseTree emitCCodeOn: aStream level: level+1 generator: aCodeGen].
aStream tab: level; nextPut: $}!
Item was removed:
- ----- Method: TMethod>>removeUnusedTemps (in category 'utilities') -----
- removeUnusedTemps
- "Remove all of the unused temps in this method. Answer a set of the references."
- "After inlining some variable references are now obsolete, we could fix them there
- but the code seems a bit complicated, the other choice to to rebuild the locals
- before extruding. This is done here"
- | refs |
- refs := self allReferencedVariables.
- "reset the locals to be only those still referred to"
- locals := locals select: [:e| refs includes: e].
- ^refs!
Item was added:
+ ----- Method: TMethod>>removeUnusedTempsIn: (in category 'utilities') -----
+ removeUnusedTempsIn: aCodeGen
+ "Remove all of the unused temps in this method. Answer a set of the references."
+ "After inlining some variable references are now obsolete, we could fix them there
+ but the code seems a bit complicated, the other choice to to rebuild the locals
+ before extruding. This is done here"
+ | refs |
+ refs := self allReferencedVariablesIn: aCodeGen.
+ "reset the locals to be only those still referred to"
+ locals := locals select: [:e| refs includes: e].
+ ^refs!
Item was added:
+ ----- Method: TParseNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+ "Evaluate aBlock for all nodes in the tree except those for which cautionaryBlock
+ answers true or are children of those for which cautionaryBlock answers true."
+ (cautionaryBlock value: self value: parent) ifFalse:
+ [aBlock value: self value: parent]!
Item was added:
+ ----- Method: TParseNode>>nodesWithParentsDo:unless: (in category 'enumerating') -----
+ nodesWithParentsDo: aBlock unless: cautionaryBlock
+ "Evaluate aBlock for all nodes in the tree and their parent except those for which
+ cautionaryBlock answers true or are children of those for which cautionaryBlock
+ answers true. Cautionary block is invoked with node and parent. parent may be nil."
+ self nodesDo: aBlock parent: nil unless: cautionaryBlock!
Item was added:
+ ----- Method: TReturnNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+
+ (cautionaryBlock value: self value: parent) ifTrue: [^self].
+ expression nodesDo: aBlock parent: self unless: cautionaryBlock.
+ aBlock value: self value: parent!
Item was added:
+ ----- Method: TSendNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+
+ (cautionaryBlock value: self value: parent) ifTrue: [^self].
+ receiver nodesDo: aBlock parent: self unless: cautionaryBlock.
+ arguments do: [ :arg | arg nodesDo: aBlock parent: self unless: cautionaryBlock].
+ aBlock value: self value: parent!
Item was added:
+ ----- Method: TStmtListNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+
+ (cautionaryBlock value: self value: parent) ifTrue: [^self].
+ statements do: [ :s | s nodesDo: aBlock parent: self unless: cautionaryBlock].
+ aBlock value: self value: parent!
Item was added:
+ ----- Method: TSwitchStmtNode>>nodesDo:parent:unless: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent unless: cautionaryBlock
+
+ (cautionaryBlock value: self value: parent) ifTrue: [^self].
+ expression nodesDo: aBlock parent: self unless: cautionaryBlock.
+ cases do:
+ [:pair|
+ pair first do: [:node| node nodesDo: aBlock parent: self unless: cautionaryBlock].
+ pair last nodesDo: aBlock parent: self unless: cautionaryBlock].
+ otherwiseOrNil ifNotNil:
+ [otherwiseOrNil nodesDo: aBlock parent: self unless: cautionaryBlock]!
More information about the Vm-dev
mailing list