[Vm-dev] VM Maker: VMMaker.oscog-eem.234.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Dec 14 20:24:33 UTC 2012
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.234.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.234
Author: eem
Time: 13 December 2012, 3:58:19.013 pm
UUID: 66acafd1-cad0-4f20-b786-ab8f48201d82
Ancestors: VMMaker.oscog-eem.233
Fix semicolons appearing after the #endif on expanding expandDereferenceInterpreterProxyFunctionTable
=============== Diff against VMMaker.oscog-eem.232 ===============
Item was changed:
----- Method: BlockNode>>isPotentialCCaseLabel (in category '*VMMaker-C translation') -----
isPotentialCCaseLabel
| stmt |
^statements size = 1
and: [(stmt := statements first) isVariableNode
+ or: [(stmt isLiteralNode
+ and: [stmt isConstantNumber or: [stmt literalValue isSymbol]])
- or: [stmt isConstantNumber
or: [stmt isMessageNode
and: [stmt selector key = #asSymbol
+ and: [stmt receiver isLiteralNode
- and: [stmt receiver isLiteral
and: [stmt receiver literalValue isSymbol]]]]]]!
Item was changed:
----- Method: CCodeGenerator>>cFunctionNameFor: (in category 'C code generator') -----
cFunctionNameFor: aSelector
+ "Create a C function name from the given selector by finding
+ a specific translation, or if none, simply omitting colons."
- "Create a C function name from the given selector by omitting colons
- and prefixing with the plugin name if the method is exported."
^selectorTranslations at: aSelector ifAbsent: [aSelector copyWithout: $:]!
Item was changed:
----- Method: CCodeGenerator>>cLiteralFor: (in category 'C code generator') -----
cLiteralFor: anObject
"Return a string representing the C literal value for the given object."
anObject isNumber
ifTrue:
[anObject isInteger ifTrue:
[^(anObject < 16r7FFFFFFF)
ifTrue: [anObject printString]
ifFalse: [anObject printString , ObjectMemory unsignedIntegerSuffix]].
anObject isFloat ifTrue:
[^anObject printString]]
ifFalse:
+ [anObject isSymbol ifTrue:
+ [^self cFunctionNameFor: anObject].
+ anObject isString ifTrue:
- [anObject isString ifTrue:
[^'"', (anObject copyReplaceAll: (String with: Character cr) with: '\n') , '"'].
anObject == nil ifTrue: [^ 'null' ].
anObject == true ifTrue: [^ '1' ].
anObject == false ifTrue: [^ '0' ].
anObject isCharacter ifTrue:
[^anObject == $'
ifTrue: ['''\'''''] "i.e. '\''"
ifFalse: [anObject asString printString]]].
self error: 'Warning: A Smalltalk literal could not be translated into a C constant: ', anObject printString.
^'"XXX UNTRANSLATABLE CONSTANT XXX"'!
Item was changed:
----- Method: CCodeGenerator>>cLiteralFor:name: (in category 'C code generator') -----
cLiteralFor: anObject name: smalltalkName
+ "Return a string representing the C literal value for the given object.
+ This version may use hex for integers that are bit masks."
- "Return a string representing the C literal value for the given object."
anObject isInteger ifTrue:
[| hex dec rep |
hex := anObject printStringBase: 16.
dec := anObject printStringBase: 10.
rep := ((smalltalkName endsWith: 'Mask')
or: [anObject digitLength > 1
and: [(hex asSet size * 3) <= (dec asSet size * 2)
and: [(smalltalkName endsWith: 'Size') not]]])
ifTrue: [hex first = $- ifTrue: ['-0x', hex allButFirst] ifFalse: ['0x', hex]]
ifFalse: [dec].
^(anObject < 16r7FFFFFFF)
ifTrue: [rep]
ifFalse: [rep, ObjectMemory unsignedIntegerSuffix "ikp"]].
+ ^self cLiteralFor: anObject!
- anObject isFloat ifTrue:
- [^anObject printString].
- anObject isString ifTrue:
- [^'"', (anObject copyReplaceAll: (String with: Character cr) with: '\n') , '"'].
- anObject == nil ifTrue: [^ 'null' ].
- anObject == true ifTrue: [^ '1' ]. "ikp"
- anObject == false ifTrue: [^ '0' ]. "ikp"
- anObject isCharacter ifTrue:[^anObject asString printString]. "ar"
- self error: 'Warning: A Smalltalk literal could not be translated into a C constant: ', anObject printString.
- ^'"XXX UNTRANSLATABLE CONSTANT XXX"'!
Item was added:
+ ----- Method: CCodeGenerator>>generateFlag:on:indent: (in category 'C translation') -----
+ generateFlag: msgNode on: aStream indent: level
+ "Compoensate for the use of self flag: #aSymbol. We used to translate symbols
+ as strings unless they were quoted via #aSymbol asSymbol. But this is too tedious,
+ so we now translate symbols directly. The only use that this affected was in
+ self flag: #aSymbol,
+ so hard-code it to produce a string value. Note that this isn't strictly necessary
+ because there's a
+ #define flag(foo) 0
+ in C land, but it makes the generated C less dissonant."
+
+ aStream
+ nextPutAll: 'flag(';
+ nextPutAll: (self cLiteralFor: msgNode args last value asString);
+ nextPut: $)!
Item was changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
translationDict := Dictionary new: 200.
pairs := #(
#& #generateAnd:on:indent:
#| #generateOr:on:indent:
#and: #generateSequentialAnd:on:indent:
#or: #generateSequentialOr:on:indent:
#not #generateNot:on:indent:
#+ #generatePlus:on:indent:
#- #generateMinus:on:indent:
#negated #generateNegated:on:indent:
#* #generateTimes:on:indent:
#/ #generateDivide:on:indent:
#// #generateDivide:on:indent:
#\\ #generateModulo:on:indent:
#<< #generateShiftLeft:on:indent:
#>> #generateShiftRight:on:indent:
#min: #generateMin:on:indent:
#max: #generateMax:on:indent:
#between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent:
#bitOr: #generateBitOr:on:indent:
#bitXor: #generateBitXor:on:indent:
#bitShift: #generateBitShift:on:indent:
#signedBitShift: #generateSignedBitShift:on:indent:
#bitInvert32 #generateBitInvert32:on:indent:
#bitClear: #generateBitClear:on:indent:
#< #generateLessThan:on:indent:
#<= #generateLessThanOrEqual:on:indent:
#= #generateEqual:on:indent:
#> #generateGreaterThan:on:indent:
#>= #generateGreaterThanOrEqual:on:indent:
#~= #generateNotEqual:on:indent:
#== #generateEqual:on:indent:
#~~ #generateNotEqual:on:indent:
#isNil #generateIsNil:on:indent:
#notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent:
#whileFalse: #generateWhileFalse:on:indent:
#whileTrue #generateDoWhileTrue:on:indent:
#whileFalse #generateDoWhileFalse:on:indent:
#to:do: #generateToDo:on:indent:
#to:by:do: #generateToByDo:on:indent:
#repeat #generateRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent:
#ifFalse: #generateIfFalse:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#ifNotNil: #generateIfNotNil:on:indent:
#ifNil: #generateIfNil:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent:
#at: #generateAt:on:indent:
#at:put: #generateAtPut:on:indent:
#basicAt: #generateAt:on:indent:
#basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent:
#integerObjectOf: #generateIntegerObjectOf:on:indent:
#isIntegerObject: #generateIsIntegerObject:on:indent:
#cCode: #generateInlineCCode:on:indent:
#cCode:inSmalltalk: #generateInlineCCode:on:indent:
#cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElse:on:indent:
#cCoerce:to: #generateCCoercion:on:indent:
#cCoerceSimple:to: #generateCCoercion:on:indent:
#addressOf: #generateAddressOf:on:indent:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort:on:indent:
#signedIntToShort #generateSignedIntToShort:on:indent:
#preIncrement #generatePreIncrement:on:indent:
#preDecrement #generatePreDecrement:on:indent:
#inline: #generateInlineDirective:on:indent:
#asFloat #generateAsFloat:on:indent:
#asInteger #generateAsInteger:on:indent:
#asUnsignedInteger #generateAsUnsignedInteger:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
#asSymbol #generateAsSymbol:on:indent:
+ #flag: #generateFlag:on:indent:
#anyMask: #generateBitAnd:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:
#bytesPerWord #generateBytesPerWord:on:indent:
#baseHeaderSize #generateBaseHeaderSize:on:indent:
#sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
#perform: #generatePerform:on:indent:
#perform:with: #generatePerform:on:indent:
#perform:with:with: #generatePerform:on:indent:
#perform:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent:
#value: #generateValue:on:indent:
#value:value: #generateValue:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #generateSmalltalkMetaError:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #(
#ifTrue: #generateIfTrueAsArgument:on:indent:
#ifFalse: #generateIfFalseAsArgument:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
#ifNotNil: #generateIfNotNilAsArgument:on:indent:
#ifNil: #generateIfNilAsArgument:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent:
#cCode: #generateInlineCCodeAsArgument:on:indent:
#cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent:
).
asArgumentTranslationDict := Dictionary new: 8.
1 to: pairs size by: 2 do: [:i |
asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
Item was changed:
----- Method: CoInterpreter class>>initializeFrameIndices (in category 'initialization') -----
initializeFrameIndices
"Format of a stack frame. Word-sized indices relative to the frame pointer.
Terminology
Frames are either single (have no context) or married (have a context).
Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited).
Stacks grow down:
receiver for method activations/closure for block activations
arg0
...
argN
caller's saved ip/this stackPage (for a base frame)
fp-> saved fp
method
context (initialized to nil)
frame flags (interpreter only)
saved method ip (initialized to 0; interpreter only)
receiver
first temp
...
sp-> Nth temp
In an interpreter frame
frame flags holds
the number of arguments (since argument temporaries are above the frame)
the flag for a block activation
and the flag indicating if the context field is valid (whether the frame is married).
saved method ip holds the saved method ip when the callee frame is a machine code frame.
This is because the saved method ip is actually the ceReturnToInterpreterTrampoline address.
In a machine code frame
the flag indicating if the context is valid is the least significant bit of the method pointer
the flag for a block activation is the next most significant bit of the method pointer
Interpreter frames are distinguished from method frames by the method field which will
be a pointer into the heap for an interpreter frame and a pointer into the method zone for
a machine code frame.
The first frame in a stack page is the baseFrame and is marked as such by a saved fp being its stackPage,
in which case the first word on the stack is the caller context (possibly hybrid) beneath the base frame."
| fxCallerSavedIP fxSavedFP fxMethod fxIFrameFlags fxThisContext fxIFReceiver fxMFReceiver fxIFSavedIP |
fxCallerSavedIP := 1.
fxSavedFP := 0.
fxMethod := -1.
fxThisContext := -2.
fxIFrameFlags := -3. "Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP.
Can find ``is block'' bit
Can find ``has context'' bit"
fxIFSavedIP := -4.
fxIFReceiver := -5.
fxMFReceiver := -3.
"For debugging nil out values that differ in the StackInterpreter."
+ FrameSlots := #undeclared.
- FrameSlots := #undeclared asSymbol.
IFrameSlots := fxCallerSavedIP - fxIFReceiver + 1.
MFrameSlots := fxCallerSavedIP - fxMFReceiver + 1.
FoxCallerSavedIP := fxCallerSavedIP * BytesPerWord.
"In Cog a base frame's caller context is stored on the first word of the stack page."
+ FoxCallerContext := #undeclared.
- FoxCallerContext := #undeclared asSymbol.
FoxSavedFP := fxSavedFP * BytesPerWord.
FoxMethod := fxMethod * BytesPerWord.
FoxThisContext := fxThisContext * BytesPerWord.
+ FoxFrameFlags := #undeclared.
- FoxFrameFlags := #undeclared asSymbol.
FoxIFrameFlags := fxIFrameFlags * BytesPerWord.
FoxIFSavedIP := fxIFSavedIP * BytesPerWord.
+ FoxReceiver := #undeclared.
- FoxReceiver := #undeclared asSymbol.
FoxIFReceiver := fxIFReceiver * BytesPerWord.
FoxMFReceiver := fxMFReceiver * BytesPerWord.
"N.B. There is room for one more flag given the current 8 byte alignment of methods (which
is at least needed to distinguish the checked and uncecked entry points by their alignment."
MFMethodFlagHasContextFlag := 1.
MFMethodFlagIsBlockFlag := 2.
MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag.
MFMethodMask := (MFMethodFlagsMask + 1) negated!
Item was changed:
----- Method: CoInterpreter>>addNewMethodToCache: (in category 'method lookup cache') -----
addNewMethodToCache: class
"Override to refuse to cache other than compiled methods.
This protects open PICs against having to test for compiled methods."
(objectMemory isOopCompiledMethod: newMethod) ifFalse:
+ [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod.
- [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod asSymbol.
^self].
super addNewMethodToCache: class!
Item was changed:
----- Method: CoInterpreter>>assertValidExecutionPointe:r:s:imbar: (in category 'debug support') -----
assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterpreter
<var: #lip type: #usqInt>
<var: #lifp type: #'char *'>
<var: #lisp type: #'char *'>
| methodField cogMethod |
<var: #cogMethod type: #'CogMethod *'>
self assert: stackPage = (stackPages stackPageFor: lifp).
self assert: stackPage = stackPages mostRecentlyUsedPage.
+ self deferStackLimitSmashAround: #assertValidStackLimits.
- self deferStackLimitSmashAround: #assertValidStackLimits asSymbol.
self assert: lifp < stackPage baseAddress.
self assert: lisp < lifp.
self assert: lifp > lisp.
self assert: lisp >= (stackPage realStackLimit - self stackLimitOffset).
self assert: (lifp - lisp) < LargeContextSize.
methodField := self frameMethodField: lifp.
inInterpreter
ifTrue:
[self assert: (self isMachineCodeFrame: lifp) not.
self assert: method = methodField.
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256)].
((self asserta: methodField asUnsignedInteger > objectMemory startOfMemory)
and: [self asserta: methodField asUnsignedInteger < objectMemory freeStart]) ifTrue:
[lip ~= cogit ceReturnToInterpreterPC ifTrue:
[self assert: (lip >= (methodField + (objectMemory lastPointerOf: methodField) + BaseHeaderSize - 1)
and: [lip < (methodField + (objectMemory byteLengthOf: methodField) + BaseHeaderSize)])]].
self assert: ((self iframeIsBlockActivation: lifp)
or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self iframeReceiver: lifp)])]
ifFalse:
[self assert: (self isMachineCodeFrame: lifp).
((self asserta: methodField asUnsignedInteger >= cogit minCogMethodAddress)
and: [self asserta: methodField asUnsignedInteger < cogit maxCogMethodAddress]) ifTrue:
[cogMethod := self mframeHomeMethod: lifp.
self assert: (lip > (methodField + ((self mframeIsBlockActivation: lifp)
ifTrue: [self sizeof: CogBlockMethod]
ifFalse: [self sizeof: CogMethod]))
and: [lip < (methodField + cogMethod blockSize)])].
self assert: ((self mframeIsBlockActivation: lifp)
or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self mframeReceiver: lifp)])].
(self isBaseFrame: lifp) ifTrue:
[self assert: (self frameHasContext: lifp).
self assert: (self frameContext: lifp) = (stackPages longAt: stackPage baseAddress - BytesPerWord)]!
Item was changed:
----- Method: CoInterpreter>>bytecodePrimAt (in category 'common selector sends') -----
bytecodePrimAt
"BytecodePrimAt will only succeed if the receiver is in the atCache.
Otherwise it will fail so that the more general primitiveAt will put it in the
cache after validating that message lookup results in a primitive response.
Override to insert in the at: cache here. This is necessary since once there
is a compiled at: primitive method (which doesn't use the at: cache) the only
way something can get installed in the atCache is here."
| index rcvr result atIx |
index := self internalStackTop.
rcvr := self internalStackValue: 1.
((objectMemory isIntegerObject: rcvr) not
and: [objectMemory isIntegerObject: index]) ifTrue:
[atIx := rcvr bitAnd: AtCacheMask. "Index into atCache = 4N, for N = 0 ... 7"
(atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
[lkupClass := objectMemory fetchClassOfNonInt: rcvr.
messageSelector := self specialSelector: 16.
(self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
[argumentCount := 1.
^self commonSend].
+ primitiveFunctionPointer == #primitiveAt
- primitiveFunctionPointer == #primitiveAt asSymbol
ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
ifFalse:
+ [primitiveFunctionPointer == #primitiveStringAt
- [primitiveFunctionPointer == #primitiveStringAt asSymbol
ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
ifFalse:
[argumentCount := 1.
^self commonSend]]].
self successful ifTrue:
[result := self commonVariable: rcvr at: (objectMemory integerValueOf: index) cacheIndex: atIx].
self successful ifTrue:
[self fetchNextBytecode.
^self internalPop: 2 thenPush: result].
self initPrimCall].
messageSelector := self specialSelector: 16.
argumentCount := 1.
self normalSend!
Item was changed:
----- Method: CoInterpreter>>bytecodePrimAtPut (in category 'common selector sends') -----
bytecodePrimAtPut
"BytecodePrimAtPut will only succeed if the receiver is in the atCache.
Otherwise it will fail so that the more general primitiveAtPut will put it in the
cache after validating that message lookup results in a primitive response.
Override to insert in the atCache here. This is necessary since once there
is a compiled at:[put:] primitive method (which doesn't use the at: cache) the
only way something can get installed in the atCache is here."
| index rcvr atIx value |
value := self internalStackTop.
index := self internalStackValue: 1.
rcvr := self internalStackValue: 2.
((objectMemory isIntegerObject: rcvr) not
and: [objectMemory isIntegerObject: index]) ifTrue:
[atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase. "Index into atPutCache"
(atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
[lkupClass := objectMemory fetchClassOfNonInt: rcvr.
messageSelector := self specialSelector: 17.
(self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
[argumentCount := 2.
^self commonSend].
+ primitiveFunctionPointer == #primitiveAtPut
- primitiveFunctionPointer == #primitiveAtPut asSymbol
ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
ifFalse:
+ [primitiveFunctionPointer == #primitiveStringAtPut
- [primitiveFunctionPointer == #primitiveStringAtPut asSymbol
ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
ifFalse:
[argumentCount := 2.
^self commonSend]]].
self successful ifTrue:
[self commonVariable: rcvr at: (objectMemory integerValueOf: index) put: value cacheIndex: atIx].
self successful ifTrue:
[self fetchNextBytecode.
^self internalPop: 3 thenPush: value].
self initPrimCall].
messageSelector := self specialSelector: 17.
argumentCount := 2.
self normalSend!
Item was changed:
----- Method: CoInterpreter>>callbackEnter: (in category 'callback support') -----
callbackEnter: callbackID
"Re-enter the interpreter for executing a callback"
| currentCStackPointer currentCFramePointer savedReenterInterpreter
wasInMachineCode calledFromMachineCode |
<volatile>
<export: true>
<var: #currentCStackPointer type: #'void *'>
<var: #currentCFramePointer type: #'void *'>
<var: #callbackID type: #'sqInt *'>
<var: #savedReenterInterpreter type: #'jmp_buf'>
"For now, do not allow a callback unless we're in a primitiveResponse"
(self asserta: primitiveFunctionPointer ~= 0) ifFalse:
[^false].
self assert: primFailCode = 0.
"Check if we've exceeded the callback depth"
(self asserta: jmpDepth < MaxJumpBuf) ifFalse:
[^false].
jmpDepth := jmpDepth + 1.
wasInMachineCode := self isMachineCodeFrame: framePointer.
calledFromMachineCode := instructionPointer <= objectMemory startOfMemory.
"Suspend the currently active process"
suspendedCallbacks at: jmpDepth put: self activeProcess.
"We need to preserve newMethod explicitly since it is not activated yet
and therefore no context has been created for it. If the caller primitive
for any reason decides to fail we need to make sure we execute the correct
method and not the one 'last used' in the call back"
suspendedMethods at: jmpDepth put: newMethod.
self flag: 'need to debug this properly. Conceptually it is the right thing to do but it crashes in practice'.
false
ifTrue:
["Signal external semaphores since a signalSemaphoreWithIndex: request may
have been issued immediately prior to this callback before the VM has any
chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:"
self signalExternalSemaphores.
"If no process is awakened by signalExternalSemaphores then transfer
to the highest priority runnable one."
(suspendedCallbacks at: jmpDepth) == self activeProcess ifTrue:
[self transferTo: self wakeHighestPriority from: CSCallbackLeave]]
ifFalse:
[self transferTo: self wakeHighestPriority from: CSCallbackLeave].
"Typically, invoking the callback means that some semaphore has been
signaled to indicate the callback. Force an interrupt check as soon as possible."
self forceInterruptCheck.
"Save the previous CStackPointers and interpreter entry jmp_buf."
currentCStackPointer := cogit getCStackPointer.
currentCFramePointer := cogit getCFramePointer.
self mem: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
cp: reenterInterpreter
+ y: (self sizeof: #'jmp_buf').
- y: (self sizeof: #'jmp_buf' asSymbol).
cogit assertCStackWellAligned.
(self setjmp: (jmpBuf at: jmpDepth)) == 0 ifTrue: "Fill in callbackID"
[callbackID at: 0 put: jmpDepth.
self enterSmalltalkExecutive.
self assert: false "NOTREACHED"].
"Restore the previous CStackPointers and interpreter entry jmp_buf."
cogit setCStackPointer: currentCStackPointer.
cogit setCFramePointer: currentCFramePointer.
self mem: reenterInterpreter
cp: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
+ y: (self sizeof: #'jmp_buf').
- y: (self sizeof: #'jmp_buf' asSymbol).
"Transfer back to the previous process so that caller can push result"
self putToSleep: self activeProcess yieldingIf: preemptionYields.
self transferTo: (suspendedCallbacks at: jmpDepth) from: CSCallbackLeave.
newMethod := suspendedMethods at: jmpDepth. "see comment above"
argumentCount := self argumentCountOf: newMethod.
self assert: wasInMachineCode = (self isMachineCodeFrame: framePointer).
calledFromMachineCode
ifTrue:
[instructionPointer >= objectMemory startOfMemory ifTrue:
[self iframeSavedIP: framePointer put: instructionPointer.
instructionPointer := cogit ceReturnToInterpreterPC]]
ifFalse:
["Even if the context was flushed to the heap and rebuilt in transferTo:from:
above it will remain an interpreted frame because the context's pc would
remain a bytecode pc. So the instructionPointer must also be a bytecode pc."
self assert: (self isMachineCodeFrame: framePointer) not.
self assert: instructionPointer > objectMemory startOfMemory].
self assert: primFailCode = 0.
jmpDepth := jmpDepth-1.
^true!
Item was changed:
----- Method: CoInterpreter>>flushExternalPrimitiveOf: (in category 'plugin primitive support') -----
flushExternalPrimitiveOf: methodObj
"methodObj is a CompiledMethod containing an external primitive.
Flush the function address and session ID of the CM. Override
to also flush the machine code call if one exists."
<api>
super flushExternalPrimitiveOf: methodObj.
(self methodHasCogMethod: methodObj) ifTrue:
[cogit
rewritePrimInvocationIn: (self cogMethodOf: methodObj)
+ to: #primitiveExternalCall]!
- to: #primitiveExternalCall asSymbol]!
Item was changed:
----- Method: CoInterpreter>>functionForPrimitiveExternalCall: (in category 'plugin primitives') -----
functionForPrimitiveExternalCall: methodObj
"Arrange to call the external primitive directly. The complication is arranging
that the call can be flushed, given that it is embedded in machine code."
<returnTypeC: 'void (*functionForPrimitiveExternalCall(sqInt methodObj))(void)'>
| lit index functionPointer |
<var: #functionPointer declareC: #'void (*functionPointer)(void)'>
+ cogit setPostCompileHook: #recordCallOffsetIn:of:.
- cogit setPostCompileHook: #recordCallOffsetIn:of: asSymbol.
(self literalCountOf: methodObj) > 0 ifFalse:
+ [^#primitiveExternalCall].
- [^#primitiveExternalCall asSymbol].
lit := self literal: 0 ofMethod: methodObj.
"Check if it's an array of length 4"
((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]) ifFalse:
+ [^#primitiveExternalCall].
- [^#primitiveExternalCall asSymbol].
index := objectMemory fetchPointer: 3 ofObject: lit.
((objectMemory isIntegerObject: index)
and: [(index := objectMemory integerValueOf: index) > 0
and: [index <= MaxExternalPrimitiveTableSize]]) ifFalse:
+ [^#primitiveExternalCall].
- [^#primitiveExternalCall asSymbol].
functionPointer := externalPrimitiveTable at: index - 1.
functionPointer = 0 ifTrue:
+ [^#primitiveExternalCall].
- [^#primitiveExternalCall asSymbol].
^functionPointer!
Item was changed:
----- Method: CoInterpreter>>functionPointerForCompiledMethod:primitiveIndex: (in category 'cog jit support') -----
functionPointerForCompiledMethod: methodObj primitiveIndex: primIndex
<api>
<returnTypeC: 'void (*functionPointerForCompiledMethodprimitiveIndex(sqInt methodObj, sqInt primIndex))(void)'>
| functionPointer |
<var: #functionPointer declareC: #'void (*functionPointer)(void)'>
functionPointer := self functionPointerFor: primIndex inClass: nil.
+ functionPointer == #primitiveAt ifTrue:
+ [^#primitiveNoAtCacheAt].
+ functionPointer == #primitiveAtPut ifTrue:
+ [^#primitiveNoAtCacheAtPut].
+ functionPointer == #primitiveStringAt ifTrue:
+ [^#primitiveNoAtCacheStringAt].
+ functionPointer == #primitiveStringAtPut ifTrue:
+ [^#primitiveNoAtCacheStringAtPut].
+ functionPointer == #primitiveCalloutToFFI ifTrue:
- functionPointer == #primitiveAt asSymbol ifTrue:
- [^#primitiveNoAtCacheAt asSymbol].
- functionPointer == #primitiveAtPut asSymbol ifTrue:
- [^#primitiveNoAtCacheAtPut asSymbol].
- functionPointer == #primitiveStringAt asSymbol ifTrue:
- [^#primitiveNoAtCacheStringAt asSymbol].
- functionPointer == #primitiveStringAtPut asSymbol ifTrue:
- [^#primitiveNoAtCacheStringAtPut asSymbol].
- functionPointer == #primitiveCalloutToFFI asSymbol ifTrue:
[^self functionForPrimitiveCallout].
+ functionPointer == #primitiveExternalCall ifTrue:
- functionPointer == #primitiveExternalCall asSymbol ifTrue:
[^self functionForPrimitiveExternalCall: methodObj].
^functionPointer!
Item was changed:
----- Method: CoInterpreter>>interpretAddress (in category 'trampoline support') -----
interpretAddress
"This is used for asserts that check that inline cache editing results in valid addresses.
In the C VM interpret is presumed to come before any primitives and so it constitutes
the lowest address in C code that machine code should be linked. In the simulator
we just answer something not low."
<api>
<returnTypeC: #usqInt>
+ ^self cCode: [(self addressOf: #interpret) asUnsignedInteger]
- ^self cCode: [(self addressOf: #interpret asSymbol) asUnsignedInteger]
inSmalltalk: [heapBase]!
Item was changed:
----- Method: CoInterpreter>>interpretMethodFromMachineCode (in category 'message sending') -----
interpretMethodFromMachineCode
"Execute a method interpretively from machine code. We assume (require) that newMethod
messageSelector, primitiveFunctionPointer and argumentCount have been set in the caller.
Once evaluated either continue in the interpreter via a jongjmp or in machine code via an
enilopmart (a form of longjmp - a stinking rose by any other name)."
<inline: false>
cogit assertCStackWellAligned.
self assert: (self validInstructionPointer: instructionPointer inFrame: framePointer).
primitiveFunctionPointer ~= 0
ifTrue:
+ [primitiveFunctionPointer = #primitiveInvokeObjectAsMethod
- [primitiveFunctionPointer = #primitiveInvokeObjectAsMethod asSymbol
ifTrue: [self assert: (objectMemory isOopCompiledMethod: newMethod) not]
ifFalse: [self assert: ((objectMemory isOopCompiledMethod: newMethod)
and: [(self primitiveIndexOf: newMethod) ~= 0])].
"Invoke an interpreter primitive (because the method is to be interpreted or has not yet been
compiled). This is very similar to invoking an interpreter primitive from a compiled primitive
(see e.g. SimpleStackBasedCogit>>compileInterpreterPrimitive:). Cut back the stack pointer
(done above) to skip the return address and invoke the function. On return if it has succeeded
simply continue otherwise restore the stackPointer, collect the pc and interpret. Note that
frame building primitives such as primitiveClosureValue, primitiveEvaluateMethod et al will not
return but will instead jump into either machine code or longjmp back to the interpreter."
"Assign stackPage headFP so we can tell if the primitive built a frame. We can't simply save
the framePointer since e.g. assignment to contexts (via primitiveInstVarAt:put:) can change the
framePointer. But context assignments will change both the framePointer and stackPage headFP."
stackPage headFP: framePointer.
self isPrimitiveFunctionPointerAnIndex
ifTrue:
[self externalQuickPrimitiveResponse.
primFailCode := 0]
ifFalse:
[self slowPrimitiveResponse].
self successful ifTrue:
[self return: self popStack toExecutive: false
"NOTREACHED"]]
ifFalse:
[self assert: ((objectMemory isOopCompiledMethod: newMethod)
and: [(self primitiveIndexOf: newMethod) = 0
or: [(self functionPointerFor: (self primitiveIndexOf: newMethod) inClass: objectMemory nilObject) = 0
or: [self isNullExternalPrimitiveCall: newMethod]]])].
"if not primitive, or primitive failed, activate the method and reenter the interpreter"
self activateNewMethod.
self siglong: reenterInterpreter jmp: ReturnToInterpreter.
"NOTREACHED"
^nil!
Item was changed:
----- Method: CoInterpreter>>primitiveFailAddress (in category 'trampoline support') -----
primitiveFailAddress
"This is used for asserts that check that inline cache editing results in valid addresses.
In the C VM interpret is presumed to come before any primitives and so it constitutes
the lowest address in C code that machine code should be linked, but optimizing
compilers change things around. In the simulator we just answer something not low."
<api>
<returnTypeC: #usqInt>
+ ^self cCode: [(self addressOf: #primitiveFail) asUnsignedInteger]
- ^self cCode: [(self addressOf: #primitiveFail asSymbol) asUnsignedInteger]
inSmalltalk: [heapBase]!
Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlags: (in category 'cog jit support') -----
primitivePropertyFlags: primIndex
<api>
"Answer any special requirements of the given primitive"
| baseFlags functionPointer |
<var: #functionPointer declareC: 'void (*functionPointer)(void)'>
functionPointer := self functionPointerFor: primIndex inClass: nil.
baseFlags := profileSemaphore ~= objectMemory nilObject
ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
ifFalse: [0].
longRunningPrimitiveCheckSemaphore ~= nil ifTrue:
[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod].
+ (functionPointer == #primitiveExternalCall
+ or: [functionPointer == #primitiveCalloutToFFI]) ifTrue: "For callbacks"
- (functionPointer == #primitiveExternalCall asSymbol
- or: [functionPointer == #primitiveCalloutToFFI asSymbol]) ifTrue: "For callbacks"
[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayCallBack].
^baseFlags!
Item was changed:
----- Method: CoInterpreter>>quickPrimitiveGeneratorFor: (in category 'cog jit support') -----
quickPrimitiveGeneratorFor: aQuickPrimitiveIndex
<api>
<returnTypeC: 'int (*quickPrimitiveGeneratorFor(sqInt aQuickPrimitiveIndex))(void)'>
^aQuickPrimitiveIndex
caseOf: {
+ [256] -> [#genQuickReturnSelf].
+ [257] -> [#genQuickReturnConst].
+ [258] -> [#genQuickReturnConst].
+ [259] -> [#genQuickReturnConst].
+ [260] -> [#genQuickReturnConst].
+ [261] -> [#genQuickReturnConst].
+ [262] -> [#genQuickReturnConst].
+ [263] -> [#genQuickReturnConst] }
+ otherwise: [#genQuickReturnInstVar]!
- [256] -> [#genQuickReturnSelf asSymbol].
- [257] -> [#genQuickReturnConst asSymbol].
- [258] -> [#genQuickReturnConst asSymbol].
- [259] -> [#genQuickReturnConst asSymbol].
- [260] -> [#genQuickReturnConst asSymbol].
- [261] -> [#genQuickReturnConst asSymbol].
- [262] -> [#genQuickReturnConst asSymbol].
- [263] -> [#genQuickReturnConst asSymbol] }
- otherwise: [#genQuickReturnInstVar asSymbol]!
Item was changed:
----- Method: CoInterpreter>>restoreCStackStateForCallbackContext: (in category 'callback support') -----
restoreCStackStateForCallbackContext: vmCallbackContext
<var: #vmCallbackContext type: #'VMCallbackContext *'>
cogit
setCStackPointer: vmCallbackContext savedCStackPointer;
setCFramePointer: vmCallbackContext savedCFramePointer.
self mem: reenterInterpreter
cp: (self cCoerceSimple: vmCallbackContext savedReenterInterpreter to: #'void *')
+ y: (self sizeof: #'jmp_buf')!
- y: (self sizeof: #'jmp_buf' asSymbol)!
Item was changed:
----- Method: CoInterpreter>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') -----
rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress
"Rewrite an existing entry in the method cache with a new primitive function address.
Used by primitiveExternalCall to make direct calls to found external prims, or quickly
fail not found external prims.
Override to do the same to the machine code call. If methodObj has a cogged dual
rewrite the primitive call in it to call localPrimAddress. Used to update calls through
primitiveExternalCall to directly call the target function or to revert to calling
primitiveExternalCall after a flush."
<var: #localPrimAddress declareC: 'void (*localPrimAddress)(void)'>
<inline: false>
(self methodHasCogMethod: newMethod) ifTrue:
[cogit
rewritePrimInvocationIn: (self cogMethodOf: newMethod)
to: (localPrimAddress = 0
+ ifTrue: [self cCoerceSimple: #primitiveFail to: #'void (*)(void)']
- ifTrue: [self cCoerceSimple: #primitiveFail asSymbol to: #'void (*)(void)']
ifFalse: [localPrimAddress])].
(methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue:
[methodCache
at: lastMethodCacheProbeWrite + MethodCachePrimFunction
put: (self cCoerce: localPrimAddress to: #long)]!
Item was changed:
----- Method: CoInterpreter>>saveCStackStateForCallbackContext: (in category 'callback support') -----
saveCStackStateForCallbackContext: vmCallbackContext
<var: #vmCallbackContext type: #'VMCallbackContext *'>
vmCallbackContext
savedCStackPointer: cogit getCStackPointer;
savedCFramePointer: cogit getCFramePointer.
self mem: (self cCoerceSimple: vmCallbackContext savedReenterInterpreter to: #'void *')
cp: reenterInterpreter
+ y: (self sizeof: #'jmp_buf')!
- y: (self sizeof: #'jmp_buf' asSymbol)!
Item was changed:
----- Method: CoInterpreterMT>>ownVM: (in category 'vm scheduling') -----
ownVM: threadIndexAndFlags
<api>
<inline: false>
"This is the entry-point for plugins and primitives that wish to reacquire the VM after having
released it via disownVM or callbacks that want to acquire it without knowing their ownership
status. This call will block until the VM is owned by the current thread or an error occurs.
The argument should be the value answered by disownVM, or 0 for callbacks that don't know
if they have disowned or not. This is both an optimization to avoid having to query thread-
local storage for the current thread's index (since it can easily keep it in some local variable),
and a record of when an unbound process becomes affined to a thread for the dynamic
extent of some operation.
Answer 0 if the current thread is known to the VM.
Answer 1 if the current thread is unknown to the VM and takes ownership.
Answer -1 if the current thread is unknown to the VM and fails to take ownership."
| threadIndex flags vmThread myProc activeProc sched |
<var: #vmThread type: #'CogVMThread *'>
threadIndexAndFlags = 0 ifTrue:
[^self ownVMFromUnidentifiedThread].
threadIndex := threadIndexAndFlags bitAnd: ThreadIdMask.
flags := threadIndexAndFlags >> DisownFlagsShift.
(flags anyMask: DisownVMForProcessorRelinquish) ifTrue:
[relinquishing := false.
self sqLowLevelMFence].
(threadIndexAndFlags anyMask: LockGUIThreadFlag) ifTrue:
[self assert: (noThreadingOfGUIThread and: [self inGUIThread]).
self assert: disowningVMThread = nil.
(flags anyMask: DisownVMLockOutFullGC) ifTrue:
[objectMemory decrementFullGCLock].
cogit recordEventTrace ifTrue:
[self recordTrace: TraceOwnVM thing: ConstZero source: 0].
^0].
vmThread := cogThreadManager acquireVMFor: threadIndex.
disownCount := disownCount - 1.
(flags anyMask: DisownVMLockOutFullGC) ifTrue:
[objectMemory decrementFullGCLock].
disowningVMThread notNil ifTrue:
[vmThread = disowningVMThread ifTrue:
[self cCode: ''
inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: threadIndex.
self assert: (range includes: cogit getCStackPointer).
self assert: (range includes: cogit getCFramePointer)].
self assert: self successful.
self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
disowningVMThread := nil.
cogit recordEventTrace ifTrue:
[self recordTrace: TraceOwnVM thing: ConstOne source: 0].
^0]. "if not preempted we're done."
self preemptDisowningThread].
"We've been preempted; we must restore state and update the threadId
in our process, and may have to put the active process to sleep."
activeProc := self activeProcess.
(threadIndexAndFlags anyMask: OwnVMForeignThreadFlag)
ifTrue:
[self assert: foreignCallbackProcessSlot == ForeignCallbackProcess.
myProc := objectMemory splObj: foreignCallbackProcessSlot.
self assert: myProc ~= objectMemory nilObject.
objectMemory splObj: foreignCallbackProcessSlot put: objectMemory nilObject]
ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread].
self assert: activeProc ~= myProc.
(activeProc ~= objectMemory nilObject
and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue:
[self putToSleep: activeProc yieldingIf: preemptionYields].
self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag).
sched := self schedulerPointer.
objectMemory
storePointer: ActiveProcessIndex ofObject: sched withValue: myProc;
storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject.
"Only unaffine if the process was affined at this level and did not become bound in the interim."
((threadIndexAndFlags anyMask: ProcessUnaffinedOnDisown)
and: [(self isBoundProcess: myProc) not]) ifTrue:
[self setOwnerIndexOfProcess: myProc to: 0 bind: false].
self initPrimCall.
self externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc.
"If this primitive is called from machine code maintain the invariant that the return pc
of an interpreter callee calling a machine code caller is ceReturnToInterpreterPC."
instructionPointer := self popStack.
(vmThread inMachineCode
and: [instructionPointer >= objectMemory startOfMemory]) ifTrue:
[self iframeSavedIP: framePointer put: instructionPointer.
instructionPointer := cogit ceReturnToInterpreterPC].
newMethod := vmThread newMethodOrNull.
argumentCount := vmThread argumentCount.
self cCode:
[self mem: reenterInterpreter
cp: vmThread reenterInterpreter
+ y: (self sizeof: #'jmp_buf')]
- y: (self sizeof: #'jmp_buf' asSymbol)]
inSmalltalk:
[reenterInterpreter := vmThread reenterInterpreter].
vmThread newMethodOrNull: nil.
self cCode: ''
inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: threadIndex.
self assert: (range includes: vmThread cStackPointer).
self assert: (range includes: vmThread cFramePointer)].
cogit setCStackPointer: vmThread cStackPointer.
cogit setCFramePointer: vmThread cFramePointer.
self assert: newMethod ~~ nil..
cogit recordEventTrace ifTrue:
[self recordTrace: TraceOwnVM thing: ConstTwo source: 0].
^threadIndexAndFlags bitAnd: OwnVMForeignThreadFlag!
Item was changed:
----- Method: CoInterpreterMT>>preemptDisowningThread (in category 'vm scheduling') -----
preemptDisowningThread
"Set the relevant state for disowningVMThread so that it can resume after
being preempted and set disowningVMThread to nil to indicate preemption.
N.B. This should only be sent from checkPreemptionOfDisowningThread.
There are essentially four things to do.
a) save the VM's notion of the current C stack pointers; these are pointers
into a thread's stack and must be saved and restored in thread switch.
b) save the VM's notion of the current Smalltalk execution point. This is
simply the suspend half of a process switch that saves the current context
in the current process.
c) add the process to the thread's set of AWOL processes so that the scheduler
won't try to run the process while the thread has disowned the VM.
d) save the in-primitive VM state, newMethod and argumentCount
ownVM: will restore the VM context as of disownVM: from the above when it
finds it has been preempted."
| activeProc activeContext preemptedThread |
<var: #preemptedThread type: #'CogVMThread *'>
<inline: false>
self assert: disowningVMThread notNil.
self assert: (disowningVMThread state = CTMUnavailable
or: [disowningVMThread state = CTMWantingOwnership]).
self cCode: ''
inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: disowningVMThread index.
self assert: (range includes: cogit getCStackPointer).
self assert: (range includes: cogit getCFramePointer)].
cogit recordEventTrace ifTrue:
[self recordTrace: TracePreemptDisowningThread
thing: (objectMemory integerObjectOf: disowningVMThread index)
source: 0].
disowningVMThread cStackPointer: cogit getCStackPointer.
disowningVMThread cFramePointer: cogit getCFramePointer.
activeProc := self activeProcess.
self assert: (objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject.
objectMemory
storePointer: MyListIndex
ofObject: activeProc
withValue: (objectMemory splObj: ProcessInExternalCodeTag).
"The instructionPointer must be pushed because the convention for inactive stack pages is that the
instructionPointer is top of stack. We need to know if this primitive is called from machine code
because the invariant that the return pc of an interpreter callee calling a machine code caller is
ceReturnToInterpreterPC must be maintained."
self push: instructionPointer.
self externalWriteBackHeadFramePointers.
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
objectMemory
storePointer: SuspendedContextIndex
ofObject: activeProc
withValue: activeContext.
"Since pushing the awol process may realloc disowningVMThread we need to reassign.
But since we're going to nil disowningVMThread anyway we can assign to a local."
preemptedThread := cogThreadManager pushAWOLProcess: activeProc on: disowningVMThread.
disowningVMThread := nil.
preemptedThread priority: (self quickFetchInteger: PriorityIndex ofObject: activeProc).
(self ownerIndexOfProcess: activeProc) = 0
ifTrue: [self setOwnerIndexOfProcess: activeProc to: preemptedThread index bind: false]
ifFalse: [self assert: (self ownerIndexOfProcess: activeProc) = preemptedThread index].
preemptedThread
newMethodOrNull: newMethod;
argumentCount: argumentCount;
inMachineCode: instructionPointer asUnsignedInteger <= objectMemory startOfMemory.
self cCode:
[self mem: preemptedThread reenterInterpreter
cp: reenterInterpreter
+ y: (self sizeof: #'jmp_buf')]
- y: (self sizeof: #'jmp_buf' asSymbol)]
inSmalltalk:
[preemptedThread reenterInterpreter: reenterInterpreter]!
Item was changed:
----- Method: CoInterpreterMT>>primitiveRelinquishProcessor (in category 'I/O primitives') -----
primitiveRelinquishProcessor
"Relinquish the processor for up to the given number of microseconds.
The exact behavior of this primitive is platform dependent.
Override to check for waiting threads."
| microSecs threadIndexAndFlags currentCStackPointer currentCFramePointer savedReenterInterpreter |
<var: #currentCStackPointer type: #'void *'>
<var: #currentCFramePointer type: #'void *'>
<var: #savedReenterInterpreter type: #'jmp_buf'>
microSecs := self stackTop.
(objectMemory isIntegerObject: microSecs) ifFalse:
[^self primitiveFail].
self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
self assert: relinquishing not.
"DO NOT allow relinquishing the processor while we are profiling since this
may skew the time base for our measures (it may reduce processor speed etc).
Instead we go full speed, therefore measuring the precise time we spend in the
inner idle loop as a busy loop."
nextProfileTick = 0 ifTrue:
"Presumably we have nothing to do; this primitive is typically called from the
background process. So we should /not/ try and activate any threads in the
pool; they will waste cycles finding there is no runnable process, and will
cause a VM abort if no runnable process is found. But we /do/ want to allow
FFI calls that have completed, or callbacks a chance to get into the VM; they
do have something to do. DisownVMForProcessorRelinquish indicates this."
[currentCStackPointer := cogit getCStackPointer.
currentCFramePointer := cogit getCFramePointer.
self cCode:
[self mem: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
cp: reenterInterpreter
+ y: (self sizeof: #'jmp_buf')].
- y: (self sizeof: #'jmp_buf' asSymbol)].
threadIndexAndFlags := self disownVM: DisownVMForProcessorRelinquish.
self assert: relinquishing.
self ioRelinquishProcessorForMicroseconds: (objectMemory integerValueOf: microSecs).
self assert: relinquishing.
self ownVM: threadIndexAndFlags.
self assert: relinquishing not.
self assert: cogThreadManager currentVMThread state = CTMAssignableOrInVM.
self assert: currentCStackPointer = cogit getCStackPointer.
self assert: currentCFramePointer = cogit getCFramePointer.
self cCode:
[self assert: (self mem: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
cm: reenterInterpreter
+ p: (self sizeof: #'jmp_buf')) = 0]].
- p: (self sizeof: #'jmp_buf' asSymbol)) = 0]].
self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
self pop: 1 "microSecs; leave rcvr on stack"!
Item was changed:
----- Method: CoInterpreterMT>>returnToSchedulingLoopAndReleaseVMOrWakeThread:source: (in category 'process primitive support') -----
returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: source
| savedReenterInterpreter |
<var: #savedReenterInterpreter type: #'jmp_buf'>
<var: #vmThread type: #'CogVMThread *'>
<inline: false>
self cCode:
[self flag: 'this is just for debugging. Note the current C stack pointers'.
cogThreadManager currentVMThread
cStackPointer: cogit getCStackPointer;
cFramePointer: cogit getCFramePointer]
inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: cogThreadManager getVMOwner.
self assert: (range includes: cogit getCStackPointer).
self assert: (range includes: cogit getCFramePointer)].
"We must use a copy of reenterInterpreter since we're giving up the VM to another vmThread."
self cCode:
[self mem: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
cp: reenterInterpreter
+ y: (self sizeof: #'jmp_buf')]
- y: (self sizeof: #'jmp_buf' asSymbol)]
inSmalltalk:
[savedReenterInterpreter := reenterInterpreter].
self recordThreadSwitchTo: (vmThread ifNotNil: [vmThread index] ifNil: [0]) source: source.
vmThread
ifNotNil: [cogThreadManager wakeVMThreadFor: vmThread index]
ifNil: [cogThreadManager releaseVM].
"2 implies returning to the threadSchedulingLoop."
self siglong: savedReenterInterpreter jmp: ReturnToThreadSchedulingLoop!
Item was changed:
----- Method: CogObjectRepresentationForSqueakV3>>genAllocFloatValue:into:scratchReg:scratchReg: (in category 'compile abstract instructions') -----
genAllocFloatValue: dpreg into: resultReg scratchReg: scratch1 scratchReg: scratch2
<returnTypeC: #'AbstractInstruction *'>
| allocSize newFloatHeaderSansHash jumpFail |
<var: #jumpFail type: #'AbstractInstruction *'>
+ allocSize := BaseHeaderSize + (objectMemory sizeof: #double).
- allocSize := BaseHeaderSize + (objectMemory sizeof: #double asSymbol).
newFloatHeaderSansHash := ((objectMemory classFloatCompactIndex << objectMemory compactClassFieldLSB
bitOr: (objectMemory formatOfClass: objectMemory classFloat))
bitOr: allocSize)
bitOr: HeaderTypeShort.
cogit MoveAw: objectMemory freeStartAddress R: resultReg.
cogit MoveR: resultReg R: scratch1.
cogit AddCq: allocSize R: scratch1.
cogit MoveAw: objectMemory scavengeThresholdAddress R: scratch2.
cogit CmpR: scratch2 R: scratch1.
jumpFail := cogit JumpAboveOrEqual: 0.
cogit MoveR: resultReg R: scratch2.
self flag: #newObjectHash.
cogit AndCq: HashMaskUnshifted << BytesPerWord R: scratch2.
cogit LogicalShiftLeftCq: HashBitsOffset - BytesPerWord R: scratch2.
cogit OrCq: newFloatHeaderSansHash R: scratch2.
cogit MoveR: scratch2 Mw: 0 r: resultReg.
cogit MoveRd: dpreg M64: BaseHeaderSize r: resultReg.
cogit MoveR: scratch1 Aw: objectMemory freeStartAddress.
^jumpFail!
Item was changed:
----- Method: CogObjectRepresentationForSqueakV3>>genStoreCheckTrampoline (in category 'initialization') -----
genStoreCheckTrampoline
"Call noteAsRoot: with the object stored into"
^cogit
+ genTrampolineFor: #ceStoreCheck:
- genTrampolineFor: #ceStoreCheck: asSymbol
called: 'ceStoreCheckTrampoline'
arg: ReceiverResultReg
result: cogit returnRegForStoreCheck!
Item was changed:
----- Method: CogThreadManager>>startThreadForThreadInfo: (in category 'scheduling') -----
startThreadForThreadInfo: vmThread
<var: #vmThread type: #'CogVMThread *'>
<inline: false>
self assert: vmThread state isNil.
vmThread state: CTMInitializing.
"self cCode: ''
inSmalltalk: [coInterpreter transcript
cr;
nextPutAll: 'starting VM thread ';
print: vmThread index;
flush.
(thisContext home stackOfSize: 10) do:
[:ctxt|
coInterpreter transcript cr; print: ctxt; flush]]."
+ (self ioNewOS: #startVMThread: Thread: vmThread) = 0 ifTrue:
- (self ioNewOS: #startVMThread: asSymbol Thread: vmThread) = 0 ifTrue:
[self ioTransferTimeslice.
^true].
memoryIsScarce := true.
"self cCode: [coInterpreter print: 'ERVT failed to spawn so memory is scarce'; cr]"
^false!
Item was changed:
----- Method: CogVMSimulator>>ioLoadExternalFunction:OfLength:FromModule:OfLength: (in category 'plugin support') -----
ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength
"Load and return the requested function from a module"
| pluginString functionString |
pluginString := String new: moduleLength.
1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
functionString := String new: functionLength.
1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
- functionString := functionString asSymbol.
^self ioLoadFunction: functionString From: pluginString!
Item was changed:
----- Method: CogVMSimulator>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') -----
rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress
super rewriteMethodCacheEntryForExternalPrimitiveToFunction:
(self mapFunctionToAddress: (localPrimAddress = 0
+ ifTrue: [#primitiveFail]
- ifTrue: [#primitiveFail asSymbol]
ifFalse: [localPrimAddress])).
"Hack; the super call will rewrite the entry to the address of the function.
So (when simulating) undo the damage and put back the functionPointer"
(methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue:
[methodCache
at: lastMethodCacheProbeWrite + MethodCachePrimFunction
put: (self cCoerce: localPrimAddress to: #long)]!
Item was changed:
----- Method: Cogit>>allMachineCodeObjectReferencesValid (in category 'garbage collection') -----
allMachineCodeObjectReferencesValid
"Check that all methods have valid selectors, and that all linked sends are to valid targets and have valid cache tags"
| ok cogMethod |
<var: #cogMethod type: #'CogMethod *'>
ok := true.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[(self asserta: (objectRepresentation checkValidObjectReference: cogMethod selector)) ifFalse:
[ok := false].
(self asserta: (self cogMethodDoesntLookKosher: cogMethod) = 0) ifFalse:
[ok := false]].
(cogMethod cmType = CMMethod
or: [cogMethod cmType = CMOpenPIC]) ifTrue:
[(self asserta: ((self mapFor: cogMethod
+ performUntil: #checkIfValidObjectRefAndTarget:pc:cogMethod:
- performUntil: #checkIfValidObjectRefAndTarget:pc:cogMethod: asSymbol
arg: cogMethod asInteger) = 0)) ifFalse:
[ok := false]].
cogMethod cmType = CMClosedPIC ifTrue:
[(self asserta: (self noTargetsFreeInClosedPIC: cogMethod)) ifFalse:
[ok := false]].
cogMethod := methodZone methodAfter: cogMethod].
^ok!
Item was changed:
----- Method: Cogit>>bytecodePCFor:startBcpc:in: (in category 'method map') -----
bytecodePCFor: mcpc startBcpc: startbcpc in: cogMethod
"Answer the zero-relative bytecode pc matching the machine code pc argument in
cogMethod, given the start of the bytecodes for cogMethod's block or method object."
<api>
<var: #cogMethod type: #'CogBlockMethod *'>
^self
mapFor: cogMethod
bcpc: startbcpc
+ performUntil: #findMcpc:Bcpc:MatchingMcpc:
- performUntil: #findMcpc:Bcpc:MatchingMcpc: asSymbol
arg: (self cCoerceSimple: mcpc to: #'void *')!
Item was changed:
----- Method: Cogit>>checkIntegrityOfObjectReferencesInCode: (in category 'debugging') -----
checkIntegrityOfObjectReferencesInCode: fullGCFlag
<api>
"Answer if all references to objects in machine-code are valid."
| cogMethod ok count |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
ok := true.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[cogMethod cmRefersToYoung ifTrue:
[(count := methodZone occurrencesInYoungReferrers: cogMethod) ~= 1 ifTrue:
[self print: 'young referrer CM '; printHex: cogMethod asInteger.
count = 0
ifTrue: [self print: ' is not in youngReferrers'; cr]
ifFalse: [self print: ' is in youngReferrers '; printNum: count; print: ' times!!'; cr].
ok := false]].
(objectRepresentation checkValidObjectReference: cogMethod selector) ifFalse:
[self print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' selector'; cr.
ok := false].
cogMethod cmType = CMMethod
ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
(objectRepresentation checkValidObjectReference: cogMethod methodObject) ifFalse:
[self print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' methodObject'; cr.
ok := false].
(self mapFor: cogMethod
+ performUntil: #checkIfValidObjectRef:pc:cogMethod:
- performUntil: #checkIfValidObjectRef:pc:cogMethod: asSymbol
arg: cogMethod asInteger) ~= 0
ifTrue: [ok := false].
fullGCFlag ifFalse:
[(((objectMemory isYoung: cogMethod methodObject)
or: [objectMemory isYoung: cogMethod selector])
and: [cogMethod cmRefersToYoung not]) ifTrue:
[self print: 'CM '; printHex: cogMethod asInteger; print: ' refers to young but not marked as such'; cr.
ok := false]]]
ifFalse:
[cogMethod cmType = CMClosedPIC
ifTrue:
[(self checkValidObjectReferencesInClosedPIC: cogMethod) ifFalse:
[ok := false]]
ifFalse:
[cogMethod cmType = CMOpenPIC
ifTrue:
[(self mapFor: cogMethod
+ performUntil: #checkIfValidObjectRef:pc:cogMethod:
- performUntil: #checkIfValidObjectRef:pc:cogMethod: asSymbol
arg: cogMethod asInteger) ~= 0
ifTrue: [ok := false]]]]].
cogMethod := methodZone methodAfter: cogMethod].
^ok!
Item was changed:
----- Method: Cogit>>disassembleMethod:on: (in category 'disassembly') -----
disassembleMethod: surrogateOrAddress on: aStream
<doNotGenerate>
| cogMethod mapEntries codeRanges |
cogMethod := surrogateOrAddress isInteger
ifTrue: [self cogMethodSurrogateAt: surrogateOrAddress]
ifFalse: [surrogateOrAddress].
cogMethod cmType = CMBlock ifTrue:
[^self disassembleMethod: cogMethod cmHomeMethod on: aStream].
self printMethodHeader: cogMethod on: aStream.
(mapEntries := Dictionary new)
at: cogMethod asInteger + cmEntryOffset put: 'entry'.
cogMethod cmType = CMMethod ifTrue:
[mapEntries at: cogMethod asInteger + cmNoCheckEntryOffset put: 'noCheckEntry'.
self cppIf: NewspeakVM
ifTrue: [mapEntries at: cogMethod asInteger + dynSuperEntryAlignment put: 'dynSuperEntry']].
cogMethod cmType = CMClosedPIC ifTrue:
[mapEntries at: cogMethod asInteger + firstCPICCaseOffset put: 'ClosedPICCase0'.
1 to: numPICCases - 1 do:
[:i|
mapEntries
at: cogMethod asInteger + firstCPICCaseOffset + (i * cPICCaseSize)
put: 'ClosedPICCase', i printString]].
self mapFor: cogMethod
+ performUntil: #collectMapEntry:address:into:
- performUntil: #collectMapEntry:address:into: asSymbol
arg: mapEntries.
"This would all be far more elegant and simple if we used blocks.
But there are no blocks in C and the basic enumerators here need
to be used in the real VM. Apologies."
(codeRanges := self codeRangesFor: cogMethod) do:
[:range|
(cogMethod cmType = CMMethod) ifTrue:
[mapEntries keysAndValuesDo:
[:mcpc :label| | bcpc |
((range includes: mcpc)
and: [#(IsSendCall HasBytecodePC) includes: label]) ifTrue:
[bcpc := self bytecodePCFor: mcpc startBcpc: range startpc in: range cogMethod.
bcpc ~= 0 ifTrue:
[mapEntries at: mcpc put: label, ' bc ', bcpc printString, '/', (bcpc + 1) printString]]]].
(cogMethod blockEntryOffset ~= 0
and: [range first = (cogMethod blockEntryOffset + cogMethod asInteger)])
ifTrue:
[aStream nextPutAll: 'blockEntry:'; cr.
self blockDispatchFor: cogMethod
perform: #disassemble:from:to:arg:
arg: aStream]
ifFalse:
[range first > (cogMethod address + cmNoCheckEntryOffset) ifTrue:
[self printMethodHeader: range cogMethod
on: aStream].
self disassembleFrom: range first to: range last labels: mapEntries on: aStream]].
aStream nextPutAll: 'startpc: '; print: codeRanges first startpc; cr.
(cogMethod cmType = CMMethod
or: [cogMethod cmType = CMOpenPIC]) ifTrue:
[[self mapFor: cogMethod
performUntil: #printMapEntry:mcpc:args:
arg: { aStream. codeRanges. cogMethod }]
on: AssertionFailure
do: [:ex|
ex primitiveChangeClassTo: ResumableVMError basicNew. ":) :) :)"
ex resume: nil]].
^cogMethod!
Item was changed:
----- Method: Cogit>>findEnclosingMethodFor:inHomeMethod: (in category 'method map') -----
findEnclosingMethodFor: mcpc inHomeMethod: cogMethod
<var: #cogMethod type: #'CogMethod *'>
<returnTypeC: #'CogBlockMethod *'>
<api>
"Find the CMMethod or CMBlock that encloses mcpc.
If the method contains blocks then, because block dispatch is not in order,
enumerate the block dispatch and find the nearest preceeding entry."
self assert: cogMethod cmType = CMMethod.
cogMethod blockEntryOffset = 0 ifTrue:
[^self cCoerceSimple: cogMethod to: #'CogBlockMethod *'].
maxMethodBefore := self cCoerceSimple: cogMethod to: #'CogBlockMethod *'.
+ self blockDispatchTargetsFor: cogMethod perform: #findMinAndMaxMethodsPC:around: arg: mcpc.
- self blockDispatchTargetsFor: cogMethod perform: #findMinAndMaxMethodsPC:around: asSymbol arg: mcpc.
^maxMethodBefore!
Item was changed:
----- Method: Cogit>>findMethodForStartBcpc:inHomeMethod: (in category 'method map') -----
findMethodForStartBcpc: startbcpc inHomeMethod: cogMethod
<api>
<var: #cogMethod type: #'CogMethod *'>
<returnTypeC: #'CogBlockMethod *'>
"Find the CMMethod or CMBlock that has zero-relative startbcpc as its first bytecode pc.
As this is for cannot resume processing and/or conversion to machine-code on backward
branch, it doesn't have to be fast. Enumerate block returns and map to bytecode pcs."
self assert: cogMethod cmType = CMMethod.
startbcpc = (coInterpreter startPCOfMethodHeader: cogMethod methodHeader) ifTrue:
[^self cCoerceSimple: cogMethod to: #'CogBlockMethod *'].
self assert: cogMethod blockEntryOffset ~= 0.
^self cCoerceSimple: (self blockDispatchTargetsFor: cogMethod
+ perform: #findBlockMethodWithEntry:startBcpc:
- perform: #findBlockMethodWithEntry:startBcpc: asSymbol
arg: startbcpc)
to: #'CogBlockMethod *'!
Item was changed:
----- Method: Cogit>>genActiveContextTrampoline (in category 'initialization') -----
genActiveContextTrampoline
"Short-circuit the interpreter call if a frame is already married."
| jumpSingle |
<var: #jumpSingle type: #'AbstractInstruction *'>
opcodeIndex := 0.
self MoveMw: FoxMethod r: FPReg R: TempReg.
self AndCq: MFMethodFlagHasContextFlag R: TempReg.
jumpSingle := self JumpZero: 0.
self MoveMw: FoxThisContext r: FPReg R: ReceiverResultReg.
self RetN: 0.
jumpSingle jmpTarget: self Label.
+ ^self genTrampolineFor: #ceActiveContext
- ^self genTrampolineFor: #ceActiveContext asSymbol
called: 'ceActiveContextTrampoline'
callJumpBar: true
numArgs: 0
arg: nil
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: ReceiverResultReg
appendOpcodes: true!
Item was changed:
----- Method: Cogit>>genCheckForInterruptsTrampoline (in category 'initialization') -----
genCheckForInterruptsTrampoline
opcodeIndex := 0.
self PopR: TempReg. "instruction pointer"
self MoveR: TempReg Aw: coInterpreter instructionPointerAddress.
+ ^self genTrampolineFor: #ceCheckForInterrupts
- ^self genTrampolineFor: #ceCheckForInterrupts asSymbol
called: 'ceCheckForInterruptsTrampoline'
callJumpBar: true
numArgs: 0
arg: nil
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: Cogit>>genInnerPICAbortTrampoline: (in category 'initialization') -----
genInnerPICAbortTrampoline: name
"Generate the abort for a PIC. This abort performs either a call of
ceInterpretMethodFromPIC:receiver: to handle invoking an uncogged
target or a call of ceMNUFromPICMNUMethod:receiver: to handle an
MNU dispatch in a closed PIC. It distinguishes the two by testing
ClassReg. If the register is zero then this is an MNU."
<var: #name type: #'char *'>
| jumpMNUCase |
<var: #jumpMNUCase type: #'AbstractInstruction *'>
self CmpCq: 0 R: ClassReg.
jumpMNUCase := self JumpZero: 0.
+ self compileTrampolineFor: #ceInterpretMethodFromPIC:receiver:
- self compileTrampolineFor: #ceInterpretMethodFromPIC:receiver: asSymbol
callJumpBar: true
numArgs: 2
arg: SendNumArgsReg
arg: ReceiverResultReg
arg: nil
arg: nil
saveRegs: false
resultReg: nil.
jumpMNUCase jmpTarget: self Label.
+ ^self genTrampolineFor: #ceMNUFromPICMNUMethod:receiver:
- ^self genTrampolineFor: #ceMNUFromPICMNUMethod:receiver: asSymbol
called: name
callJumpBar: true
numArgs: 2
arg: SendNumArgsReg
arg: ReceiverResultReg
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: Cogit>>genMethodAbortTrampoline (in category 'initialization') -----
genMethodAbortTrampoline
"Generate the abort for a method. This abort performs either a call of ceSICMiss:
to handle a single-in-line cache miss or a call of ceStackOverflow: to handle a
stack overflow. It distinguishes the two by testing ResultReceiverReg. If the
register is zero then this is a stack-overflow because a) the receiver has already
been pushed and so can be set to zero before calling the abort, and b) the
receiver must always contain an object (and hence be non-zero) on SIC miss."
| jumpSICMiss |
<var: #jumpSICMiss type: #'AbstractInstruction *'>
opcodeIndex := 0.
self CmpCq: 0 R: ReceiverResultReg.
jumpSICMiss := self JumpNonZero: 0.
+ self compileTrampolineFor: #ceStackOverflow:
- self compileTrampolineFor: #ceStackOverflow: asSymbol
callJumpBar: true
numArgs: 1
arg: SendNumArgsReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil.
jumpSICMiss jmpTarget: self Label.
+ ^self genTrampolineFor: #ceSICMiss:
- ^self genTrampolineFor: #ceSICMiss: asSymbol
called: 'ceMethodAbort'
callJumpBar: true
numArgs: 1
arg: ReceiverResultReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: Cogit>>genNonLocalReturnTrampoline (in category 'initialization') -----
genNonLocalReturnTrampoline
opcodeIndex := 0.
self PopR: TempReg. "instruction pointer"
self MoveR: TempReg Aw: coInterpreter instructionPointerAddress.
+ ^self genTrampolineFor: #ceNonLocalReturn:
- ^self genTrampolineFor: #ceNonLocalReturn: asSymbol
called: 'ceNonLocalReturnTrampoline'
callJumpBar: true
numArgs: 1
arg: ReceiverResultReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: Cogit>>generateEnilopmarts (in category 'initialization') -----
generateEnilopmarts
"Enilopmarts transfer control from C into machine code (backwards trampolines)."
self cppIf: Debug
ifTrue:
[realCEEnterCogCodePopReceiverReg :=
self genEnilopmartFor: ReceiverResultReg
called: 'realCEEnterCogCodePopReceiverReg'.
+ ceEnterCogCodePopReceiverReg := #enterCogCodePopReceiver.
- ceEnterCogCodePopReceiverReg := #enterCogCodePopReceiver asSymbol.
realCEEnterCogCodePopReceiverAndClassRegs :=
self genEnilopmartFor: ReceiverResultReg
and: ClassReg
called: 'realCEEnterCogCodePopReceiverAndClassRegs'.
+ ceEnterCogCodePopReceiverAndClassRegs := #enterCogCodePopReceiverAndClassRegs]
- ceEnterCogCodePopReceiverAndClassRegs := #enterCogCodePopReceiverAndClassRegs asSymbol]
ifFalse:
[ceEnterCogCodePopReceiverReg := self genEnilopmartFor: ReceiverResultReg
called: 'ceEnterCogCodePopReceiverReg'.
ceEnterCogCodePopReceiverAndClassRegs :=
self genEnilopmartFor: ReceiverResultReg
and: ClassReg
called: 'ceEnterCogCodePopReceiverAndClassRegs'].
self genPrimReturnEnterCogCodeEnilopmart: false.
cePrimReturnEnterCogCode := methodZoneBase.
self outputInstructionsForGeneratedRuntimeAt: cePrimReturnEnterCogCode.
self recordGeneratedRunTime: 'cePrimReturnEnterCogCode' address: cePrimReturnEnterCogCode.
self genPrimReturnEnterCogCodeEnilopmart: true.
cePrimReturnEnterCogCodeProfiling := methodZoneBase.
self outputInstructionsForGeneratedRuntimeAt: cePrimReturnEnterCogCodeProfiling.
self recordGeneratedRunTime: 'cePrimReturnEnterCogCodeProfiling' address: cePrimReturnEnterCogCodeProfiling!
Item was changed:
----- Method: Cogit>>generateNewspeakRuntime (in category 'initialization') -----
generateNewspeakRuntime
<option: #NewspeakVM>
| jumpMiss jumpItsTheReceiverStupid |
<var: #jumpMiss type: #'AbstractInstruction *'>
<var: #jumpItsTheReceiverStupid type: #'AbstractInstruction *'>
"Generate the non-send runtime support for Newspeak, explicit outer and implicit receiver.
The dynamic frequency of explicit outer is so low we merely call an interpreter routine."
+ ceExplicitReceiverTrampoline := self genTrampolineFor: #ceExplicitReceiverAt:
- ceExplicitReceiverTrampoline := self genTrampolineFor: #ceExplicitReceiverAt: asSymbol
called: 'ceExplicitReceiverTrampoline'
arg: SendNumArgsReg
result: ReceiverResultReg.
"Cached push implicit receiver implementation. Caller looks like
mov selector, ClassReg
call ceImplicitReceiver
br continue
Lclass: .word
Lmixin:: .word
continue:
If class matches class of receiver then mixin contains either 0 or the implicit receiver.
If 0, answer the actual receiver, otherwise the mixin.
Generate the class fetch and cache probe inline for speed. Smashes Arg0Reg and caller-saved regs."
opcodeIndex := 0.
self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
objectRepresentation genGetClassObjectOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
self MoveMw: 0 r: SPReg R: TempReg.
self MoveMw: backEnd jumpShortByteSize r: TempReg R: Arg0Reg.
self CmpR: ClassReg R: Arg0Reg.
jumpMiss := self JumpNonZero: 0.
self MoveMw: backEnd jumpShortByteSize + BytesPerOop r: TempReg R: ClassReg.
self CmpCq: 0 R: ClassReg.
jumpItsTheReceiverStupid := self JumpZero: 0.
self MoveR: ClassReg R: ReceiverResultReg.
jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
jumpMiss jmpTarget: self Label.
ceImplicitReceiverTrampoline := self
+ genTrampolineFor: #ceImplicitReceiverFor:receiver:class:
- genTrampolineFor: #ceImplicitReceiverFor:receiver:class: asSymbol
called: 'ceImplicitReceiverTrampoline'
callJumpBar: true
numArgs: 3
arg: SendNumArgsReg
arg: ReceiverResultReg
arg: ClassReg
arg: nil
saveRegs: false
resultReg: ReceiverResultReg
appendOpcodes: true!
Item was changed:
----- Method: Cogit>>generateRunTimeTrampolines (in category 'initialization') -----
generateRunTimeTrampolines
"Generate the run-time entries at the base of the native code zone and update the base."
ceSendMustBeBooleanAddFalseTrampoline := self genMustBeBooleanTrampolineFor: objectMemory falseObject
called: 'ceSendMustBeBooleanAddFalseTrampoline'.
ceSendMustBeBooleanAddTrueTrampoline := self genMustBeBooleanTrampolineFor: objectMemory trueObject
called: 'ceSendMustBeBooleanAddTrueTrampoline'.
+ ceClosureCopyTrampoline := self genTrampolineFor: #ceClosureCopyDescriptor:
- "Slang needs these apparently superfluous asSymbol sends."
- ceClosureCopyTrampoline := self genTrampolineFor: #ceClosureCopyDescriptor: asSymbol
called: 'ceClosureCopyTrampoline'
arg: SendNumArgsReg
result: ReceiverResultReg.
ceActiveContextTrampoline := self genActiveContextTrampoline.
ceNonLocalReturnTrampoline := self genNonLocalReturnTrampoline.
+ ceBaseFrameReturnTrampoline := self genTrampolineFor: #ceBaseFrameReturn:
- ceBaseFrameReturnTrampoline := self genTrampolineFor: #ceBaseFrameReturn: asSymbol
called: 'ceBaseFrameReturnTrampoline'
arg: ReceiverResultReg.
+ ceCreateNewArrayTrampoline := self genTrampolineFor: #ceNewArraySlotSize:
- ceCreateNewArrayTrampoline := self genTrampolineFor: #ceNewArraySlotSize: asSymbol
called: 'ceCreateNewArrayTrampoline'
arg: SendNumArgsReg
result: ReceiverResultReg.
ceCheckForInterruptTrampoline := self genCheckForInterruptsTrampoline.
ceStoreCheckTrampoline := objectRepresentation genStoreCheckTrampoline.
+ ceFetchContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:
- ceFetchContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar: asSymbol
called: 'ceFetchContextInstVarTrampoline'
arg: ReceiverResultReg
arg: SendNumArgsReg
result: SendNumArgsReg.
+ ceStoreContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:value:
- ceStoreContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:value: asSymbol
called: 'ceStoreContextInstVarTrampoline'
arg: ReceiverResultReg
arg: SendNumArgsReg
arg: ClassReg
result: ReceiverResultReg. "to keep ReceiverResultReg live."
+ cePositive32BitIntegerTrampoline := self genTrampolineFor: #cePositive32BitIntegerFor:
- cePositive32BitIntegerTrampoline := self genTrampolineFor: #cePositive32BitIntegerFor: asSymbol
called: 'cePositive32BitIntegerTrampoline'
arg: ReceiverResultReg
result: TempReg.
+ ceReturnToInterpreterTrampoline := self genTrampolineFor: #ceReturnToInterpreter:
- ceReturnToInterpreterTrampoline := self genTrampolineFor: #ceReturnToInterpreter: asSymbol
called: 'ceReturnToInterpreterTrampoline'
arg: ReceiverResultReg.
+ ceCannotResumeTrampoline := self genTrampolineFor: #ceCannotResume
- ceCannotResumeTrampoline := self genTrampolineFor: #ceCannotResume asSymbol
called: 'ceCannotResumeTrampoline'!
Item was changed:
----- Method: Cogit>>generateSendTrampolines (in category 'initialization') -----
generateSendTrampolines
- "Slang needs these apparently superfluous asSymbol sends."
0 to: NumSendTrampolines - 2 do:
[:numArgs|
sendTrampolines
at: numArgs
+ put: (self genTrampolineFor: #ceSend:super:to:numArgs:
- put: (self genTrampolineFor: #ceSend:super:to:numArgs: asSymbol
called: (self trampolineName: 'ceSend' numArgs: numArgs)
arg: ClassReg
arg: 0
arg: ReceiverResultReg
arg: numArgs)].
sendTrampolines
at: NumSendTrampolines - 1
+ put: (self genTrampolineFor: #ceSend:super:to:numArgs:
- put: (self genTrampolineFor: #ceSend:super:to:numArgs: asSymbol
called: (self trampolineName: 'ceSend' numArgs: -1)
arg: ClassReg
arg: 0
arg: ReceiverResultReg
arg: SendNumArgsReg).
self cppIf: NewspeakVM
ifTrue:
[0 to: NumSendTrampolines - 2 do:
[:numArgs|
dynamicSuperSendTrampolines
at: numArgs
+ put: (self genTrampolineFor: #ceDynamicSuperSend:to:numArgs:
- put: (self genTrampolineFor: #ceDynamicSuperSend:to:numArgs: asSymbol
called: (self trampolineName: 'ceDynSuperSend' numArgs: numArgs)
arg: ClassReg
arg: ReceiverResultReg
arg: numArgs)].
dynamicSuperSendTrampolines
at: NumSendTrampolines - 1
+ put: (self genTrampolineFor: #ceDynamicSuperSend:to:numArgs:
- put: (self genTrampolineFor: #ceDynamicSuperSend:to:numArgs: asSymbol
called: (self trampolineName: 'ceDynSuperSend' numArgs: -1)
arg: ClassReg
arg: ReceiverResultReg
arg: SendNumArgsReg)].
0 to: NumSendTrampolines - 2 do:
[:numArgs|
superSendTrampolines
at: numArgs
+ put: (self genTrampolineFor: #ceSend:super:to:numArgs:
- put: (self genTrampolineFor: #ceSend:super:to:numArgs: asSymbol
called: (self trampolineName: 'ceSuperSend' numArgs: numArgs)
arg: ClassReg
arg: 1
arg: ReceiverResultReg
arg: numArgs)].
superSendTrampolines
at: NumSendTrampolines - 1
+ put: (self genTrampolineFor: #ceSend:super:to:numArgs:
- put: (self genTrampolineFor: #ceSend:super:to:numArgs: asSymbol
called: (self trampolineName: 'ceSuperSend' numArgs: -1)
arg: ClassReg
arg: 1
arg: ReceiverResultReg
arg: SendNumArgsReg).
firstSend := sendTrampolines at: 0.
lastSend := superSendTrampolines at: NumSendTrampolines - 1!
Item was changed:
----- Method: Cogit>>generateStackPointerCapture (in category 'initialization') -----
generateStackPointerCapture
"Generate a routine ceCaptureCStackPointers that will capture the C stack pointer,
and, if it is in use, the C frame pointer. These are used in trampolines to call
run-time routines in the interpreter from machine-code."
| oldMethodZoneBase oldTrampolineTableIndex |
self assertCStackWellAligned.
oldMethodZoneBase := methodZoneBase.
oldTrampolineTableIndex := trampolineTableIndex.
self generateCaptureCStackPointers: true.
+ self perform: #ceCaptureCStackPointers.
- self perform: #ceCaptureCStackPointers asSymbol.
(cFramePointerInUse := self isCFramePointerInUse) ifFalse:
[methodZoneBase := oldMethodZoneBase.
trampolineTableIndex := oldTrampolineTableIndex.
self generateCaptureCStackPointers: false]!
Item was changed:
----- Method: Cogit>>mapObjectReferencesInMachineCodeForBecome (in category 'garbage collection') -----
mapObjectReferencesInMachineCodeForBecome
"Update all references to objects in machine code for a become.
Unlike incrementalGC or fullGC a method that does not refer to young may
refer to young as a result of the become operation. Unlike incrementalGC
or fullGC the reference from a Cog method to its methodObject *must not*
change since the two are two halves of the same object."
| cogMethod hasYoungObj hasYoungObjPtr freedPIC |
<var: #cogMethod type: #'CogMethod *'>
hasYoungObj := false.
hasYoungObjPtr := self cCode: [(self addressOf: hasYoungObj) asInteger]
inSmalltalk: [CPluggableAccessor new
setObject: nil;
atBlock: [:obj :idx| hasYoungObj]
atPutBlock: [:obj :idx :val| hasYoungObj := val]].
codeModified := freedPIC := false.
self mapObjectReferencesInGeneratedRuntime.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[self assert: hasYoungObj not.
cogMethod cmType ~= CMFree ifTrue:
[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
cogMethod selector: (objectRepresentation remapOop: cogMethod selector)..
cogMethod cmType = CMClosedPIC
ifTrue:
[((objectMemory isYoung: cogMethod selector)
or: [self mapObjectReferencesInClosedPIC: cogMethod]) ifTrue:
[freedPIC := true.
methodZone freeMethod: cogMethod]]
ifFalse:
[(objectMemory isYoung: cogMethod selector) ifTrue:
[hasYoungObj := true].
cogMethod cmType = CMMethod ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
self assert: ((coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
or: [(self noAssertMethodClassAssociationOf: cogMethod methodObject)
= objectMemory nilObject]).
(objectMemory isYoung: cogMethod methodObject) ifTrue:
[hasYoungObj := true]].
self mapFor: cogMethod
performUntil: (self cppIf: NewspeakVM
+ ifTrue: [#remapNSIfObjectRef:pc:hasYoung:]
+ ifFalse: [#remapIfObjectRef:pc:hasYoung:])
- ifTrue: [#remapNSIfObjectRef:pc:hasYoung: asSymbol]
- ifFalse: [#remapIfObjectRef:pc:hasYoung: asSymbol])
arg: hasYoungObjPtr.
hasYoungObj
ifTrue:
[cogMethod cmRefersToYoung ifFalse:
[cogMethod cmRefersToYoung: true.
methodZone addToYoungReferrers: cogMethod].
hasYoungObj := false]
ifFalse: [cogMethod cmRefersToYoung: false]]].
cogMethod := methodZone methodAfter: cogMethod].
methodZone pruneYoungReferrers.
freedPIC ifTrue:
[self unlinkSendsToFree.
codeModified := true].
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!
Item was changed:
----- Method: Cogit>>mapObjectReferencesInMachineCodeForFullGC (in category 'garbage collection') -----
mapObjectReferencesInMachineCodeForFullGC
"Update all references to objects in machine code for a full gc. Since
the current (New)ObjectMemory GC makes everything old in a full GC
a method not referring to young will not refer to young afterwards"
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
codeModified := false.
self mapObjectReferencesInGeneratedRuntime.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
cogMethod selector: (objectRepresentation remapOop: cogMethod selector).
cogMethod cmType = CMClosedPIC
ifTrue:
[self assert: cogMethod cmRefersToYoung not.
self mapObjectReferencesInClosedPIC: cogMethod]
ifFalse:
[cogMethod cmType = CMMethod ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
cogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject)].
self mapFor: cogMethod
performUntil: (self cppIf: NewspeakVM
+ ifTrue: [#remapNSIfObjectRef:pc:hasYoung:]
+ ifFalse: [#remapIfObjectRef:pc:hasYoung:])
- ifTrue: [#remapNSIfObjectRef:pc:hasYoung: asSymbol]
- ifFalse: [#remapIfObjectRef:pc:hasYoung: asSymbol])
arg: 0.
(cogMethod cmRefersToYoung
and: [objectRepresentation allYoungObjectsAgeInFullGC]) ifTrue:
[cogMethod cmRefersToYoung: false]]].
cogMethod := methodZone methodAfter: cogMethod].
methodZone pruneYoungReferrers.
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!
Item was changed:
----- Method: Cogit>>mapObjectReferencesInMachineCodeForIncrementalGC (in category 'garbage collection') -----
mapObjectReferencesInMachineCodeForIncrementalGC
"Update all references to objects in machine code for an incremental gc.
Avoid scanning all code by using the youngReferrers list. In an incremental
GC a method referring to young may no longer refer to young, but a method
not referring to young cannot and will not refer to young afterwards."
| pointer cogMethod hasYoungObj hasYoungObjPtr |
<var: #cogMethod type: #'CogMethod *'>
hasYoungObj := false.
hasYoungObjPtr := self cCode: [(self addressOf: hasYoungObj) asInteger]
inSmalltalk: [CPluggableAccessor new
setObject: nil;
atBlock: [:obj :idx| hasYoungObj]
atPutBlock: [:obj :idx :val| hasYoungObj := val]].
codeModified := false.
pointer := methodZone youngReferrers.
[pointer < methodZone zoneEnd] whileTrue:
[self assert: hasYoungObj not.
cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
cogMethod cmType = CMFree
ifTrue: [self assert: cogMethod cmRefersToYoung not]
ifFalse:
[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
cogMethod cmRefersToYoung ifTrue:
[self assert: (cogMethod cmType = CMMethod
or: [cogMethod cmType = CMOpenPIC]).
cogMethod selector: (objectRepresentation remapOop: cogMethod selector).
(objectMemory isYoung: cogMethod selector) ifTrue:
[hasYoungObj := true].
cogMethod cmType = CMMethod ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
cogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
(objectMemory isYoung: cogMethod methodObject) ifTrue:
[hasYoungObj := true]].
self mapFor: cogMethod
performUntil: (self cppIf: NewspeakVM
+ ifTrue: [#remapNSIfObjectRef:pc:hasYoung:]
+ ifFalse: [#remapIfObjectRef:pc:hasYoung:])
- ifTrue: [#remapNSIfObjectRef:pc:hasYoung: asSymbol]
- ifFalse: [#remapIfObjectRef:pc:hasYoung: asSymbol])
arg: hasYoungObjPtr.
hasYoungObj
ifTrue: [hasYoungObj := false]
ifFalse: [cogMethod cmRefersToYoung: false]]].
pointer := pointer + BytesPerWord].
methodZone pruneYoungReferrers.
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!
Item was changed:
----- Method: Cogit>>markLiteralsAndUnlinkUnmarkedSendsIn: (in category 'garbage collection') -----
markLiteralsAndUnlinkUnmarkedSendsIn: cogMethod
"Unlink sends that have unmarked classes in inline caches or freed/freeable targets.
Nil-out inline caches linked to open PICs.
Assert that any selectors are marked. We can do this since
this is only run on marked methods and thus any selectors they
reference should already be marked."
<var: #cogMethod type: #'CogMethod *'>
<inline: true>
self assert: cogMethod cmType = CMMethod.
self assert: (objectMemory isMarked: cogMethod methodObject).
objectRepresentation markAndTraceLiteral: cogMethod selector.
self mapFor: cogMethod
performUntil: (self cppIf: NewspeakVM
+ ifTrue: [#markLiteralsAndUnlinkIfUnmarkedSendOrPushImplicit:pc:method:]
+ ifFalse: [#markLiteralsAndUnlinkIfUnmarkedSend:pc:method:])
- ifTrue: [#markLiteralsAndUnlinkIfUnmarkedSendOrPushImplicit:pc:method: asSymbol]
- ifFalse: [#markLiteralsAndUnlinkIfUnmarkedSend:pc:method: asSymbol])
arg: cogMethod asInteger!
Item was changed:
----- Method: Cogit>>markMethodAndReferents: (in category 'jit - api') -----
markMethodAndReferents: aCogMethod
<api>
<var: #aCogMethod type: #'CogBlockMethod *'>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
self assert: (aCogMethod cmType = CMMethod
or: [aCogMethod cmType = CMBlock]).
cogMethod := aCogMethod cmType = CMMethod
ifTrue: [self cCoerceSimple: aCogMethod to: #'CogMethod *']
ifFalse: [aCogMethod cmHomeMethod].
cogMethod cmUsageCount: CMMaxUsageCount.
self mapFor: cogMethod
+ performUntil: #incrementUsageOfTargetIfLinkedSend:mcpc:ignored:
- performUntil: #incrementUsageOfTargetIfLinkedSend:mcpc:ignored: asSymbol
arg: 0!
Item was changed:
----- Method: Cogit>>markYoungObjectsIn: (in category 'garbage collection') -----
markYoungObjectsIn: cogMethod
"Mark young literals in the method."
<var: #cogMethod type: #'CogMethod *'>
<inline: true>
self assert: (cogMethod cmType = CMMethod
or: [cogMethod cmType = CMOpenPIC]).
(objectMemory isYoung: cogMethod selector) ifTrue:
[objectMemory markAndTrace: cogMethod selector].
(cogMethod cmType = CMMethod
and: [objectMemory isYoung: cogMethod methodObject]) ifTrue:
[objectMemory markAndTrace: cogMethod methodObject].
self mapFor: cogMethod
performUntil: (self cppIf: NewspeakVM
+ ifTrue: [#markNSYoungObjects:pc:method:]
+ ifFalse: [#markYoungObjects:pc:method:])
- ifTrue: [#markNSYoungObjects:pc:method: asSymbol]
- ifFalse: [#markYoungObjects:pc:method: asSymbol])
arg: cogMethod asInteger!
Item was changed:
----- Method: Cogit>>mcPCFor:startBcpc:in: (in category 'method map') -----
mcPCFor: bcpc startBcpc: startbcpc in: cogMethod
"Answer the absolute machine code pc matching the zero-relative bytecode pc argument
in cogMethod, given the start of the bytecodes for cogMethod's block or method object."
<api>
<var: #cogMethod type: #'CogBlockMethod *'>
| absPC |
absPC := self
mapFor: cogMethod
bcpc: startbcpc
+ performUntil: #findMcpc:Bcpc:MatchingBcpc:
- performUntil: #findMcpc:Bcpc:MatchingBcpc: asSymbol
arg: (self cCoerceSimple: bcpc to: #'void *').
^absPC ~= 0
ifTrue: [absPC asUnsignedInteger - cogMethod asUnsignedInteger]
ifFalse: [absPC]!
Item was changed:
----- Method: Cogit>>relocateCallsAndSelfReferencesInMethod: (in category 'compaction') -----
relocateCallsAndSelfReferencesInMethod: cogMethod
<var: #cogMethod type: #'CogMethod *'>
| delta |
delta := cogMethod objectHeader signedIntFromLong.
backEnd relocateCallBeforeReturnPC: cogMethod asInteger + missOffset by: delta negated.
self mapFor: cogMethod
+ performUntil: #relocateIfCallOrMethodReference:mcpc:delta:
- performUntil: #relocateIfCallOrMethodReference:mcpc:delta: asSymbol
arg: delta!
Item was changed:
----- Method: Cogit>>scanBlock: (in category 'compile abstract instructions') -----
scanBlock: blockStart
"Scan the block to determine if the block needs a frame or not"
| descriptor pc end stackDelta nExts |
<var: #blockStart type: #'BlockStart *'>
<var: #descriptor type: #'BytecodeDescriptor *'>
needsFrame := false.
methodOrBlockNumArgs := blockStart numArgs.
nExts := 0.
pc := blockStart startpc.
end := blockStart startpc + blockStart span.
stackDelta := 0.
[pc < end] whileTrue:
[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
descriptor := self generatorAt: byte0.
needsFrame ifFalse:
[(descriptor needsFrameFunction isNil
or: [self perform: descriptor needsFrameFunction with: true])
ifTrue: [needsFrame := true]
ifFalse: [stackDelta := stackDelta + descriptor stackDelta]].
pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
needsFrame ifFalse:
[stackDelta < 0 ifTrue:
[self error: 'negative stack delta in block; block contains bogus code or internal error'].
[stackDelta > 0] whileTrue:
[descriptor := self generatorAt: (objectMemory fetchByte: blockStart startpc ofObject: methodObj) + bytecodeSetOffset.
+ descriptor generator ~~ #genPushConstantNilBytecode ifTrue:
- descriptor generator ~~ #genPushConstantNilBytecode asSymbol ifTrue:
[self error: 'frameless block doesn''t start with enough pushNils'].
blockStart
startpc: blockStart startpc + descriptor numBytes;
span: blockStart span - descriptor numBytes.
stackDelta := stackDelta - 1]]!
Item was changed:
----- Method: Cogit>>unlinkAllSends (in category 'jit - api') -----
unlinkAllSends
<api>
"Unlink all sends in cog methods."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase isNil ifTrue: [^self].
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
+ performUntil: #unlinkIfLinkedSend:pc:ignored:
- performUntil: #unlinkIfLinkedSend:pc:ignored: asSymbol
arg: 0]
ifFalse:
[cogMethod cmType ~= CMFree ifTrue:
[methodZone freeMethod: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod].
"After updating inline caches we need to flush the icache."
processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger!
Item was changed:
----- Method: Cogit>>unlinkSendsOf:isMNUSelector: (in category 'jit - api') -----
unlinkSendsOf: selector isMNUSelector: isMNUSelector
<api>
"Unlink all sends in cog methods."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase isNil ifTrue: [^self].
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
"First check if any method actually has the selector; if not there can't
be any linked send to it."
[cogMethod < methodZone limitZony
and: [cogMethod selector ~= selector]] whileTrue:
[cogMethod := methodZone methodAfter: cogMethod].
cogMethod >= methodZone limitZony ifTrue:
[^nil].
codeModified := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
+ performUntil: #unlinkIfLinkedSend:pc:of:
- performUntil: #unlinkIfLinkedSend:pc:of: asSymbol
arg: selector]
ifFalse:
[(cogMethod cmType ~= CMFree
and: [(isMNUSelector and: [cogMethod cpicHasMNUCase])
or: [cogMethod selector = selector]]) ifTrue:
[methodZone freeMethod: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod].
codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!
Item was changed:
----- Method: Cogit>>unlinkSendsTo:andFreeIf: (in category 'jit - api') -----
unlinkSendsTo: targetMethodObject andFreeIf: freeIfTrue
<api>
"Unlink all sends in cog methods to a particular target method.
If targetMethodObject isn't actually a method (perhaps being
used via invokeAsMethod) then flush all sends since anything
could be affected."
| cogMethod targetMethod freedPIC |
<var: #cogMethod type: #'CogMethod *'>
<var: #targetMethod type: #'CogMethod *'>
((objectMemory isOopCompiledMethod: targetMethodObject)
and: [coInterpreter methodHasCogMethod: targetMethodObject]) ifFalse:
[^self].
targetMethod := coInterpreter cogMethodOf: targetMethodObject.
methodZoneBase isNil ifTrue: [^self].
codeModified := freedPIC := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
+ performUntil: #unlinkIfLinkedSend:pc:to:
- performUntil: #unlinkIfLinkedSend:pc:to: asSymbol
arg: targetMethod asInteger]
ifFalse:
[(cogMethod cmType = CMClosedPIC
and: [self cPIC: cogMethod HasTarget: targetMethod]) ifTrue:
[methodZone freeMethod: cogMethod.
freedPIC := true]].
cogMethod := methodZone methodAfter: cogMethod].
freeIfTrue ifTrue: [self freeMethod: targetMethod].
freedPIC
ifTrue: [self unlinkSendsToFree]
ifFalse:
[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]]!
Item was changed:
----- Method: Cogit>>unlinkSendsToFree (in category 'garbage collection') -----
unlinkSendsToFree
<api>
"Unlink all sends in cog methods to free methods and/or pics."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase isNil ifTrue: [^self].
codeModified := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
+ performUntil: #unlinkIfLinkedSendToFree:pc:ignored:
- performUntil: #unlinkIfLinkedSendToFree:pc:ignored: asSymbol
arg: 0]
ifFalse:
[cogMethod cmType = CMClosedPIC ifTrue:
[self assert: (self noTargetsFreeInClosedPIC: cogMethod)]].
cogMethod := methodZone methodAfter: cogMethod].
codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!
Item was changed:
----- Method: FilePlugin>>fileRecordSize (in category 'file primitives') -----
fileRecordSize
"Return the size of a Smalltalk file record in bytes."
<static: false>
+ ^self sizeof: #SQFile!
- ^self sizeof: #SQFile asSymbol!
Item was changed:
----- Method: Interpreter>>addNewMethodToCache (in category 'method lookup cache') -----
addNewMethodToCache
"Add the given entry to the method cache.
The policy is as follows:
Look for an empty entry anywhere in the reprobe chain.
If found, install the new entry there.
If not found, then install the new entry at the first probe position
and delete the entries in the rest of the reprobe chain.
This has two useful purposes:
If there is active contention over the first slot, the second
or third will likely be free for reentry after ejection.
Also, flushing is good when reprobe chains are getting full."
| probe hash |
<inline: false>
hash := messageSelector bitXor: lkupClass. "drop low-order zeros from addresses"
(self isOopCompiledMethod: newMethod)
ifTrue:
[primitiveIndex := self primitiveIndexOf: newMethod.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: lkupClass]
ifFalse:
+ [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
- [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod asSymbol].
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: lkupClass.
0 to: CacheProbeMax-1 do:
[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
(methodCache at: probe + MethodCacheSelector) = 0 ifTrue:
["Found an empty entry -- use it"
methodCache at: probe + MethodCacheSelector put: messageSelector.
methodCache at: probe + MethodCacheClass put: lkupClass.
methodCache at: probe + MethodCacheMethod put: newMethod.
methodCache at: probe + MethodCachePrim put: primitiveIndex.
methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: 'long').
^ nil]].
"OK, we failed to find an entry -- install at the first slot..."
probe := hash bitAnd: MethodCacheMask. "first probe"
methodCache at: probe + MethodCacheSelector put: messageSelector.
methodCache at: probe + MethodCacheClass put: lkupClass.
methodCache at: probe + MethodCacheMethod put: newMethod.
methodCache at: probe + MethodCachePrim put: primitiveIndex.
methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: 'long').
"...and zap the following entries"
1 to: CacheProbeMax-1 do:
[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
methodCache at: probe + MethodCacheSelector put: 0].
!
Item was changed:
----- Method: Interpreter>>positive64BitValueOf: (in category 'primitive support') -----
positive64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger."
| sz szsqLong value |
<returnTypeC: #sqLong>
<var: #value type: #sqLong>
(self isIntegerObject: oop) ifTrue:
[value := self integerValueOf: oop.
value < 0 ifTrue: [^self primitiveFail].
^ value].
(self
isClassOfNonImm: oop
equalTo: (self splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex) ifFalse:
[^self primitiveFail].
+ szsqLong := self sizeof: #sqLong.
- szsqLong := self sizeof: #sqLong asSymbol.
sz := self lengthOf: oop.
sz > szsqLong ifTrue:
[^self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (self fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
^value!
Item was changed:
----- Method: Interpreter>>signed64BitValueOf: (in category 'primitive support') -----
signed64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive ST integer or a eight-byte LargeInteger."
| sz value largeClass negative szsqLong |
<inline: false>
<returnTypeC: #sqLong>
<var: #value type: #sqLong>
(self isIntegerObject: oop) ifTrue: [^self cCoerce: (self integerValueOf: oop) to: #sqLong].
largeClass := self fetchClassOfNonInt: oop.
largeClass = self classLargePositiveInteger
ifTrue:[negative := false]
ifFalse:[largeClass = self classLargeNegativeInteger
ifTrue:[negative := true]
ifFalse:[^self primitiveFail]].
+ szsqLong := self sizeof: #sqLong.
- szsqLong := self sizeof: #sqLong asSymbol.
sz := self lengthOf: oop.
sz > szsqLong
ifTrue: [^ self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (self fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
"Filter out values out of range for the signed interpretation such as
16rFFFFFFFF... (positive w/ bit 64 set) and -16rFFFFFFFF... (negative w/ bit
64 set). Since the sign is implicit in the class we require that the high bit of
the magnitude is not set which is a simple test here. Note that we have to
handle the most negative 64-bit value -9223372036854775808 specially."
self cCode: []
inSmalltalk:
[(value anyMask: 16r8000000000000000) ifTrue:
[value := value - 16r10000000000000000]].
value < 0 ifTrue:
[self cCode:
[self assert: (self sizeof: value) == 8.
self assert: (self sizeof: value << 1) == 8].
"Don't fail for -9223372036854775808/-16r8000000000000000.
Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
(negative and: [0 = (self cCode: [value << 1]
inSmalltalk: [value << 1 bitAnd: (1 << 64) - 1])]) ifTrue:
[^value].
^self primitiveFail].
^negative
ifTrue:[0 - value]
ifFalse:[value]!
Item was changed:
----- Method: InterpreterPrimitives>>magnitude64BitValueOf: (in category 'primitive support') -----
magnitude64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or a eight-byte LargeInteger."
| sz value ok smallIntValue |
<returnTypeC: #usqLong>
<var: #value type: #usqLong>
(objectMemory isIntegerObject: oop) ifTrue:
[smallIntValue := (objectMemory integerValueOf: oop).
smallIntValue < 0 ifTrue: [smallIntValue := 0 - smallIntValue].
^self cCoerce: smallIntValue to: #usqLong].
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
ok
ifFalse:
[ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse: [^self primitiveFail]].
sz := objectMemory lengthOf: oop.
+ sz > (self sizeof: #sqLong) ifTrue:
- sz > (self sizeof: #sqLong asSymbol) ifTrue:
[^self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
^value!
Item was changed:
----- Method: InterpreterPrimitives>>positive64BitValueOf: (in category 'primitive support') -----
positive64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger."
<returnTypeC: #sqLong>
| sz value ok |
<var: #value type: #sqLong>
(objectMemory isIntegerObject: oop) ifTrue:
[value := objectMemory integerValueOf: oop.
value < 0 ifTrue: [^self primitiveFail].
^value].
ok := objectMemory
isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ (ok and: [(sz := objectMemory lengthOf: oop) <= (self sizeof: #sqLong)]) ifFalse:
- (ok and: [(sz := objectMemory lengthOf: oop) <= (self sizeof: #sqLong asSymbol)]) ifFalse:
[^self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
^value!
Item was changed:
----- Method: InterpreterPrimitives>>positiveMachineIntegerValueOf: (in category 'primitive support') -----
positiveMachineIntegerValueOf: oop
"Answer a value of an integer in address range, i.e up to the size of a machine word.
The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size."
<returnTypeC: #'unsigned long'>
| value bs ok |
(objectMemory isIntegerObject: oop) ifTrue:
[value := objectMemory integerValueOf: oop.
value < 0 ifTrue: [^self primitiveFail].
^value].
ok := objectMemory
isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ (ok and: [(bs := objectMemory lengthOf: oop) <= (self sizeof: #'unsigned long')]) ifFalse:
- (ok and: [(bs := objectMemory lengthOf: oop) <= (self sizeof: #'unsigned long' asSymbol)]) ifFalse:
[^self primitiveFail].
+ ((self sizeof: #'unsigned long') = 8
- ((self sizeof: #'unsigned long' asSymbol) = 8
and: [bs > 4]) ifTrue:
[^ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)
+ ((objectMemory fetchByte: 4 ofObject: oop) << 32)
+ ((objectMemory fetchByte: 5 ofObject: oop) << 40)
+ ((objectMemory fetchByte: 6 ofObject: oop) << 48)
+ ((objectMemory fetchByte: 7 ofObject: oop) << 56)].
^ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)!
Item was changed:
----- Method: InterpreterPrimitives>>signed64BitValueOf: (in category 'primitive support') -----
signed64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or a eight-byte LargeInteger."
| sz value negative ok |
<inline: false>
<returnTypeC: #sqLong>
<var: #value type: #sqLong>
(objectMemory isIntegerObject: oop) ifTrue:
[^self cCoerce: (objectMemory integerValueOf: oop) to: #sqLong].
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
ok
ifTrue: [negative := false]
ifFalse:
[negative := true.
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse: [^self primitiveFail]].
sz := objectMemory lengthOf: oop.
+ sz > (self sizeof: #sqLong) ifTrue:
- sz > (self sizeof: #sqLong asSymbol) ifTrue:
[^self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
"Filter out values out of range for the signed interpretation such as
16rFFFFFFFF... (positive w/ bit 64 set) and -16rFFFFFFFF... (negative w/ bit
64 set). Since the sign is implicit in the class we require that the high bit of
the magnitude is not set which is a simple test here. Note that we have to
handle the most negative 64-bit value -9223372036854775808 specially."
self cCode: []
inSmalltalk:
[(value anyMask: 16r8000000000000000) ifTrue:
[value := value - 16r10000000000000000]].
value < 0 ifTrue:
[self cCode:
[self assert: (self sizeof: value) == 8.
self assert: (self sizeof: value << 1) == 8].
"Don't fail for -9223372036854775808/-16r8000000000000000.
Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
(negative and: [0 = (self cCode: [value << 1]
inSmalltalk: [value << 1 bitAnd: (1 << 64) - 1])]) ifTrue:
[^value].
^self primitiveFail].
^negative
ifTrue:[0 - value]
ifFalse:[value]!
Item was changed:
----- Method: InterpreterPrimitives>>signedMachineIntegerValueOf: (in category 'primitive support') -----
signedMachineIntegerValueOf: oop
"Answer a signed value of an integer up to the size of a machine word.
The object may be either a positive SmallInteger or a LargeInteger of size <= word size."
<returnTypeC: #'long'>
| negative ok bs value bits |
<var: #value type: #long>
(objectMemory isIntegerObject: oop) ifTrue:
[^objectMemory integerValueOf: oop].
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
ok
ifTrue: [negative := false]
ifFalse:
[negative := true.
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse: [^self primitiveFail]].
+ (bs := objectMemory lengthOf: oop) > (self sizeof: #'unsigned long') ifTrue:
- (bs := objectMemory lengthOf: oop) > (self sizeof: #'unsigned long' asSymbol) ifTrue:
[^self primitiveFail].
+ ((self sizeof: #'unsigned long') = 8
- ((self sizeof: #'unsigned long' asSymbol) = 8
and: [bs > 4])
ifTrue:
[value := (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)
+ ((objectMemory fetchByte: 4 ofObject: oop) << 32)
+ ((objectMemory fetchByte: 5 ofObject: oop) << 40)
+ ((objectMemory fetchByte: 6 ofObject: oop) << 48)
+ ((objectMemory fetchByte: 7 ofObject: oop) << 56)]
ifFalse:
[value := (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)].
self cCode: []
inSmalltalk:
[bits := (self sizeof: #long) * 8.
(value bitShift: 1 - bits) > 0 ifTrue:
[value := value - (1 bitShift: bits)]].
value < 0 ifTrue:
["Don't fail for -16r80000000[00000000].
Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
(negative and: [0 = (self cCode: [value << 1]
inSmalltalk: [value << 1 bitAnd: (1 << bits) - 1])]) ifTrue:
[^value].
^self primitiveFail].
^negative
ifTrue: [0 - value]
ifFalse: [value]!
Item was changed:
----- Method: InterpreterSimulator>>ioLoadExternalFunction:OfLength:FromModule:OfLength: (in category 'plugin support') -----
ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength
"Load and return the requested function from a module"
| pluginString functionString |
pluginString := String new: moduleLength.
1 to: moduleLength do:[:i| pluginString byteAt: i put: (self byteAt: moduleName+i-1)].
functionString := String new: functionLength.
1 to: functionLength do:[:i| functionString byteAt: i put: (self byteAt: functionName+i-1)].
- functionString := functionString asSymbol.
^self ioLoadFunction: functionString From: pluginString!
Item was changed:
----- Method: NewspeakInterpreter>>positiveMachineIntegerValueOf: (in category 'primitive support') -----
positiveMachineIntegerValueOf: oop
"Answer a value of an integer in address range, i.e up to the size of a machine word.
The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size."
<returnTypeC: #'unsigned long'>
| value bs ok |
(self isIntegerObject: oop) ifTrue:
[value := self integerValueOf: oop.
value < 0 ifTrue: [^self primitiveFail].
^value].
ok := self
isClassOfNonImm: oop
equalTo: (self splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ (ok and: [(bs := self lengthOf: oop) <= (self sizeof: #'unsigned long')]) ifFalse:
- (ok and: [(bs := self lengthOf: oop) <= (self sizeof: #'unsigned long' asSymbol)]) ifFalse:
[^self primitiveFail].
+ ((self sizeof: #'unsigned long') = 8
- ((self sizeof: #'unsigned long' asSymbol) = 8
and: [bs > 4]) ifTrue:
[^ (self fetchByte: 0 ofObject: oop)
+ ((self fetchByte: 1 ofObject: oop) << 8)
+ ((self fetchByte: 2 ofObject: oop) << 16)
+ ((self fetchByte: 3 ofObject: oop) << 24)
+ ((self fetchByte: 4 ofObject: oop) << 32)
+ ((self fetchByte: 5 ofObject: oop) << 40)
+ ((self fetchByte: 6 ofObject: oop) << 48)
+ ((self fetchByte: 7 ofObject: oop) << 56)].
^ (self fetchByte: 0 ofObject: oop)
+ ((self fetchByte: 1 ofObject: oop) << 8)
+ ((self fetchByte: 2 ofObject: oop) << 16)
+ ((self fetchByte: 3 ofObject: oop) << 24)!
Item was changed:
----- Method: NewspeakInterpreter>>signedMachineIntegerValueOf: (in category 'primitive support') -----
signedMachineIntegerValueOf: oop
"Answer a signed value of an integer up to the size of a machine word.
The object may be either a positive SmallInteger or a LargeInteger of size <= word size."
<returnTypeC: #'long'>
| negative ok bs value bits |
<var: #value type: #long>
(self isIntegerObject: oop) ifTrue:
[^self integerValueOf: oop].
ok := self isClassOfNonImm: oop
equalTo: (self splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
ok
ifTrue: [negative := false]
ifFalse:
[negative := true.
ok := self isClassOfNonImm: oop
equalTo: (self splObj: ClassLargeNegativeInteger)
compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse: [^self primitiveFail]].
+ (bs := self lengthOf: oop) > (self sizeof: #'unsigned long') ifTrue:
- (bs := self lengthOf: oop) > (self sizeof: #'unsigned long' asSymbol) ifTrue:
[^self primitiveFail].
+ ((self sizeof: #'unsigned long') = 8
- ((self sizeof: #'unsigned long' asSymbol) = 8
and: [bs > 4])
ifTrue:
[value := (self fetchByte: 0 ofObject: oop)
+ ((self fetchByte: 1 ofObject: oop) << 8)
+ ((self fetchByte: 2 ofObject: oop) << 16)
+ ((self fetchByte: 3 ofObject: oop) << 24)
+ ((self fetchByte: 4 ofObject: oop) << 32)
+ ((self fetchByte: 5 ofObject: oop) << 40)
+ ((self fetchByte: 6 ofObject: oop) << 48)
+ ((self fetchByte: 7 ofObject: oop) << 56)]
ifFalse:
[value := (self fetchByte: 0 ofObject: oop)
+ ((self fetchByte: 1 ofObject: oop) << 8)
+ ((self fetchByte: 2 ofObject: oop) << 16)
+ ((self fetchByte: 3 ofObject: oop) << 24)].
self cCode: []
inSmalltalk:
[bits := (self sizeof: #long) * 8.
(value bitShift: 1 - bits) > 0 ifTrue:
[value := value - (1 bitShift: bits)]].
value < 0 ifTrue:
["Don't fail for -16r80000000[00000000].
Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
(negative and: [0 = (self cCode: [value << 1]
inSmalltalk: [value << 1 bitAnd: (1 << bits) - 1])]) ifTrue:
[^value].
^self primitiveFail].
^negative
ifTrue: [0 - value]
ifFalse: [value]!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>ioLoadExternalFunction:OfLength:FromModule:OfLength: (in category 'plugin support') -----
ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength
"Load and return the requested function from a module"
| pluginString functionString |
pluginString := String new: moduleLength.
1 to: moduleLength do:[:i| pluginString byteAt: i put: (self byteAt: moduleName+i-1)].
functionString := String new: functionLength.
1 to: functionLength do:[:i| functionString byteAt: i put: (self byteAt: functionName+i-1)].
- functionString := functionString asSymbol.
^self ioLoadFunction: functionString From: pluginString!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive: (in category 'primitive generators') -----
compileInterpreterPrimitive: primitiveRoutine
"Compile a call to an interpreter primitive. Call the C routine with the
usual stack-switching dance, test the primFailCode and then either
return on success or continue to the method body."
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
| flags jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
<var: #jmp type: #'AbstractInstruction *'>
<var: #jmpSamplePrim type: #'AbstractInstruction *'>
<var: #continuePostSamplePrim type: #'AbstractInstruction *'>
<var: #jmpSampleNonPrim type: #'AbstractInstruction *'>
<var: #continuePostSampleNonPrim type: #'AbstractInstruction *'>
"Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers"
self genExternalizePointersForPrimitiveCall.
"Switch to the C stack."
self genLoadCStackPointersForPrimCall.
flags := coInterpreter primitivePropertyFlags: primitiveIndex.
(flags bitAnd: PrimCallCollectsProfileSamples) ~= 0 ifTrue:
["Test nextProfileTick for being non-zero and call checkProfileTick if so"
BytesPerWord = 4
ifTrue:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self MoveAw: coInterpreter nextProfileTickAddress + BytesPerWord R: ClassReg.
self OrR: TempReg R: ClassReg]
ifFalse:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self CmpCq: 0 R: TempReg].
"If set, jump to record sample call."
jmpSampleNonPrim := self JumpNonZero: 0.
continuePostSampleNonPrim := self Label].
"Clear the primFailCode and set argumentCount"
self MoveCq: 0 R: TempReg.
self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
methodOrBlockNumArgs ~= 0 ifTrue:
[self MoveCq: methodOrBlockNumArgs R: TempReg].
self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
(flags bitAnd: PrimCallNeedsPrimitiveFunction) ~= 0 ifTrue:
[self MoveCw: primitiveRoutine asInteger R: TempReg.
self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
"Old full prim trace is in VMMaker-eem.550 and prior"
self recordPrimTrace ifTrue:
[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
((flags bitAnd: PrimCallNeedsNewMethod+PrimCallMayCallBack) ~= 0) ifTrue:
["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
(flags bitAnd: PrimCallMayCallBack) ~= 0 ifTrue:
[needsFrame := true].
methodLabel addDependent:
(self annotateAbsolutePCRef:
(self MoveCw: methodLabel asInteger R: ClassReg)).
+ self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
- self MoveMw: (self offset: CogMethod of: #methodObject asSymbol) r: ClassReg R: TempReg.
self MoveR: TempReg Aw: coInterpreter newMethodAddress].
self PrefetchAw: coInterpreter primFailCodeAddress.
(flags bitAnd: PrimCallMayCallBack) ~= 0
ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode."
[backEnd genSubstituteReturnAddress:
((flags bitAnd: PrimCallCollectsProfileSamples) ~= 0
ifTrue: [cePrimReturnEnterCogCodeProfiling]
ifFalse: [cePrimReturnEnterCogCode]).
self JumpRT: primitiveRoutine asInteger.
primInvokeLabel := self Label.
jmp := jmpSamplePrim := continuePostSamplePrim := nil]
ifFalse:
["Call the C primitive routine."
self CallRT: primitiveRoutine asInteger.
primInvokeLabel := self Label.
(flags bitAnd: PrimCallCollectsProfileSamples) ~= 0 ifTrue:
[self assert: (flags bitAnd: PrimCallNeedsNewMethod) ~= 0.
"Test nextProfileTick for being non-zero and call checkProfileTick if so"
BytesPerWord = 4
ifTrue:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self MoveAw: coInterpreter nextProfileTickAddress + BytesPerWord R: ClassReg.
self OrR: TempReg R: ClassReg]
ifFalse:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self CmpCq: 0 R: TempReg].
"If set, jump to record sample call."
jmpSamplePrim := self JumpNonZero: 0.
continuePostSamplePrim := self Label].
"Switch back to the Smalltalk stack. Stack better be in either of these two states:
success: stackPointer -> result (was receiver)
arg1
...
argN
return pc
failure: receiver
arg1
...
stackPointer -> argN
return pc
In either case we can push the instructionPointer to reestablish the return pc"
self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.
self genLoadStackPointers.
"Test primitive failure"
self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
self PushR: ClassReg. "Restore return pc"
self flag: 'ask concrete code gen if move sets condition codes?'.
self CmpCq: 0 R: TempReg.
jmp := self JumpNonZero: 0.
"Fetch result from stack"
self MoveMw: BytesPerWord r: SPReg R: ReceiverResultReg.
self flag: 'currently caller pushes result'.
self RetN: BytesPerWord].
(flags bitAnd: PrimCallCollectsProfileSamples) ~= 0 ifTrue:
["The sample is collected by cePrimReturnEnterCogCode for external calls"
jmpSamplePrim notNil ifTrue:
["Call ceCheckProfileTick: to record sample and then continue."
jmpSamplePrim jmpTarget: self Label.
self assert: (flags bitAnd: PrimCallNeedsNewMethod) ~= 0.
self CallRT: (self cCode: '(unsigned long)ceCheckProfileTick'
inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
"reenter the post-primitive call flow"
self Jump: continuePostSamplePrim].
"Null newMethod and call ceCheckProfileTick: to record sample and then continue.
ceCheckProfileTick will map null/0 to coInterpreter nilObject"
jmpSampleNonPrim jmpTarget: self Label.
self MoveCq: 0 R: TempReg.
self MoveR: TempReg Aw: coInterpreter newMethodAddress.
self CallRT: (self cCode: '(unsigned long)ceCheckProfileTick'
inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
"reenter the post-primitive call flow"
self Jump: continuePostSampleNonPrim].
jmp notNil ifTrue:
["Jump to restore of receiver reg and proceed to frame build for failure."
jmp jmpTarget: self Label.
"Restore receiver reg from stack."
self MoveMw: BytesPerWord * (methodOrBlockNumArgs + 1) r: SPReg R: ReceiverResultReg].
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>genFastPrimTraceUsing:and: (in category 'primitive generators') -----
genFastPrimTraceUsing: r1 and: r2
"Suport for compileInterpreterPrimitive. Generate inline code so as to record the primitive
trace as fast as possible."
self MoveCq: 0 R: TempReg.
self MoveCq: 0 R: r2.
self MoveMb: coInterpreter primTraceLogIndexAddress r: TempReg R: r2.
self MoveR: r2 R: r1.
self AddCq: 1 R: r1.
self MoveR: r1 Mb: coInterpreter primTraceLogIndexAddress r: TempReg.
methodLabel addDependent:
(self annotateAbsolutePCRef:
(self MoveCw: methodLabel asInteger R: r1)).
+ self MoveMw: (self offset: CogMethod of: #selector) r: r1 R: TempReg.
- self MoveMw: (self offset: CogMethod of: #selector asSymbol) r: r1 R: TempReg.
self MoveCw: coInterpreter primTraceLogAddress asInteger R: r1.
self MoveR: TempReg Xwr: r2 R: r1!
Item was changed:
----- Method: SimpleStackBasedCogit>>genMustBeBooleanTrampolineFor:called: (in category 'initialization') -----
genMustBeBooleanTrampolineFor: boolean called: trampolineName
<var: #trampolineName type: #'char *'>
<inline: false>
opcodeIndex := 0.
"If the objectRepresentation does want true & false to be mobile then we need to record these addresses."
self assert: (objectRepresentation shouldAnnotateObjectReference: boolean) not.
self AddCq: boolean R: TempReg.
+ ^self genTrampolineFor: #ceSendMustBeBoolean:
- ^self genTrampolineFor: #ceSendMustBeBoolean: asSymbol
called: trampolineName
callJumpBar: true
numArgs: 1
arg: TempReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveClosureValue (in category 'primitive generators') -----
genPrimitiveClosureValue
"Check the argument count. Fail if wrong.
Get the method from the outerContext and see if it is cogged. If so, jump to the
block entry or the no-context-switch entry, as appropriate, and we're done. If not,
invoke the interpreter primitive."
| jumpFail jumpBCMethod primitiveRoutine result |
<var: #jumpFail type: #'AbstractInstruction *'>
<var: #jumpBCMethod type: #'AbstractInstruction *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)()'>
objectRepresentation genLoadSlot: ClosureNumArgsIndex sourceReg: ReceiverResultReg destReg: TempReg.
self CmpCq: (objectMemory integerObjectOf: methodOrBlockNumArgs) R: TempReg.
jumpFail := self JumpNonZero: 0.
objectRepresentation
genLoadSlot: ClosureOuterContextIndex sourceReg: ReceiverResultReg destReg: ClassReg;
genLoadSlot: MethodIndex sourceReg: ClassReg destReg: SendNumArgsReg;
genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
self MoveR: TempReg R: ClassReg.
jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
+ self MoveM16: (self offset: CogMethod of: #blockEntryOffset) r: ClassReg R: TempReg.
- self MoveM16: (self offset: CogMethod of: #blockEntryOffset asSymbol) r: ClassReg R: TempReg.
self AddR: ClassReg R: TempReg.
primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
primitiveIndex: primitiveIndex.
+ primitiveRoutine = #primitiveClosureValueNoContextSwitch ifTrue:
- primitiveRoutine = #primitiveClosureValueNoContextSwitch asSymbol ifTrue:
[blockNoContextSwitchOffset = nil ifTrue:
[^NotFullyInitialized].
self SubCq: blockNoContextSwitchOffset R: TempReg].
self JumpR: TempReg.
jumpBCMethod jmpTarget: self Label.
(result := self compileInterpreterPrimitive: primitiveRoutine) < 0 ifTrue:
[^result].
jumpFail jmpTarget: self Label.
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFloatDivide (in category 'primitive generators') -----
genPrimitiveFloatDivide
+ ^self genDoubleArithmetic: DivRdRd preOpCheck: #genDoubleFailIfZeroArgRcvr:arg:!
- ^self genDoubleArithmetic: DivRdRd preOpCheck: #genDoubleFailIfZeroArgRcvr:arg: asSymbol!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFloatEqual (in category 'primitive generators') -----
genPrimitiveFloatEqual
+ ^self genDoubleComparison: #JumpFPEqual: invert: false!
- ^self genDoubleComparison: #JumpFPEqual: asSymbol invert: false!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFloatGreaterOrEqual (in category 'primitive generators') -----
genPrimitiveFloatGreaterOrEqual
+ ^self genDoubleComparison: #JumpFPGreaterOrEqual: invert: false!
- ^self genDoubleComparison: #JumpFPGreaterOrEqual: asSymbol invert: false!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFloatGreaterThan (in category 'primitive generators') -----
genPrimitiveFloatGreaterThan
+ ^self genDoubleComparison: #JumpFPGreater: invert: false!
- ^self genDoubleComparison: #JumpFPGreater: asSymbol invert: false!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFloatLessOrEqual (in category 'primitive generators') -----
genPrimitiveFloatLessOrEqual
+ ^self genDoubleComparison: #JumpFPGreaterOrEqual: invert: true!
- ^self genDoubleComparison: #JumpFPGreaterOrEqual: asSymbol invert: true!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFloatLessThan (in category 'primitive generators') -----
genPrimitiveFloatLessThan
+ ^self genDoubleComparison: #JumpFPGreater: invert: true!
- ^self genDoubleComparison: #JumpFPGreater: asSymbol invert: true!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFloatNotEqual (in category 'primitive generators') -----
genPrimitiveFloatNotEqual
+ ^self genDoubleComparison: #JumpFPNotEqual: invert: false!
- ^self genDoubleComparison: #JumpFPNotEqual: asSymbol invert: false!
Item was changed:
----- Method: SimpleStackBasedCogit>>genTraceStoreTrampoline (in category 'initialization') -----
genTraceStoreTrampoline
+ ceTraceStoreTrampoline := self genSafeTrampolineFor: #ceTraceStoreOf:into:
- ceTraceStoreTrampoline := self genSafeTrampolineFor: #ceTraceStoreOf:into: asSymbol
called: 'ceTraceStoreTrampoline'
arg: ClassReg
arg: ReceiverResultReg!
Item was changed:
----- Method: SimpleStackBasedCogit>>generateMissAbortTrampolines (in category 'initialization') -----
generateMissAbortTrampolines
"Generate the run-time entries for the various method and PIC entry misses and aborts..
Read the class-side method trampolines for documentation on the various trampolines"
- "Slang needs these apparently superfluous asSymbol sends."
ceMethodAbortTrampoline := self genMethodAbortTrampoline.
cePICAbortTrampoline := self genPICAbortTrampoline.
+ ceCPICMissTrampoline := self genTrampolineFor: #ceCPICMiss:receiver:
- ceCPICMissTrampoline := self genTrampolineFor: #ceCPICMiss:receiver: asSymbol
called: 'ceCPICMissTrampoline'
arg: ClassReg
arg: ReceiverResultReg.
self cCode: '' inSmalltalk:
[simulatedTrampolines
at: (self simulatedAddressFor: #ceSendFromInLineCacheMiss:)
put: #ceSendFromInLineCacheMiss:]!
Item was changed:
----- Method: SimpleStackBasedCogit>>generateTracingTrampolines (in category 'initialization') -----
generateTracingTrampolines
"Generate trampolines for tracing. In the simulator we can save a lot of time
and avoid noise instructions in the lastNInstructions log by short-cutting these
trampolines, but we need them in the real vm."
ceTraceLinkedSendTrampoline
:= self cCode:
+ [self genSafeTrampolineFor: #ceTraceLinkedSend:
- [self genSafeTrampolineFor: #ceTraceLinkedSend: asSymbol
called: 'ceTraceLinkedSendTrampoline'
arg: ReceiverResultReg]
inSmalltalk:
[| a |
simulatedTrampolines
at: (a := self simulatedAddressFor: #ceShortCutTraceLinkedSend:)
put: #ceShortCutTraceLinkedSend:.
a].
ceTraceBlockActivationTrampoline
:= self cCode:
+ [self genTrampolineFor: #ceTraceBlockActivation
- [self genTrampolineFor: #ceTraceBlockActivation asSymbol
called: 'ceTraceBlockActivationTrampoline']
inSmalltalk:
[| a |
simulatedTrampolines
at: (a := self simulatedAddressFor: #ceShortCutTraceBlockActivation:)
put: #ceShortCutTraceBlockActivation:.
a].
ceTraceStoreTrampoline
:= self cCode:
+ [self genSafeTrampolineFor: #ceTraceStoreOf:into:
- [self genSafeTrampolineFor: #ceTraceStoreOf:into: asSymbol
called: 'ceTraceStoreTrampoline'
arg: ClassReg
arg: ReceiverResultReg]
inSmalltalk:
[| a |
simulatedTrampolines
at: (a := self simulatedAddressFor: #ceShortCutTraceStore:)
put: #ceShortCutTraceStore:.
a]!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>bytecodePCFor:startBcpc:in: (in category 'method map') -----
bytecodePCFor: mcpc startBcpc: startbcpc in: cogMethod
"Answer the zero-relative bytecode pc matching the machine code pc argument in
cogMethod, given the start of the bytecodes for cogMethod's block or method object."
<api>
<var: #cogMethod type: #'CogBlockMethod *'>
^self
mapFor: cogMethod
bcpc: startbcpc
+ performUntil: #find:Mcpc:Bcpc:MatchingMcpc:
- performUntil: #find:Mcpc:Bcpc:MatchingMcpc: asSymbol
arg: (self cCoerceSimple: mcpc to: #'void *')!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>genMustBeBooleanTrampolineFor:called: (in category 'initialization') -----
genMustBeBooleanTrampolineFor: boolean called: trampolineName
"This can be entered in one of two states, depending on SendNumArgsReg. See
e.g. genJumpIf:to:. If SendNumArgsReg is non-zero then this has been entered via
the initial test of the counter in the jump executed count (i.e. the counter has
tripped). In this case TempReg contains the boolean to be tested and should not
be offset, and ceCounterTripped should be invoked with the unoffset TempReg.
If SendNumArgsReg is zero then this has been entered for must-be-boolean
processing. TempReg has been offset by boolean and must be corrected and
ceSendMustBeBoolean: invoked with the corrected value."
<var: #trampolineName type: #'char *'>
| jumpMBB |
<var: #jumpMBB type: #'AbstractInstruction *'>
<inline: false>
opcodeIndex := 0.
self CmpCq: 0 R: SendNumArgsReg.
jumpMBB := self JumpZero: 0.
+ self compileTrampolineFor: #ceCounterTripped:
- self compileTrampolineFor: #ceCounterTripped: asSymbol
callJumpBar: true
numArgs: 1
arg: TempReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil.
"If the objectRepresentation does want true & false to be mobile then we need to record these addresses."
self assert: (objectRepresentation shouldAnnotateObjectReference: boolean) not.
jumpMBB jmpTarget: (self AddCq: boolean R: TempReg).
+ ^self genTrampolineFor: #ceSendMustBeBoolean:
- ^self genTrampolineFor: #ceSendMustBeBoolean: asSymbol
called: trampolineName
callJumpBar: true
numArgs: 1
arg: TempReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>mcPCFor:startBcpc:in: (in category 'method map') -----
mcPCFor: bcpc startBcpc: startbcpc in: cogMethod
"Answer the absolute machine code pc matching the zero-relative bytecode pc argument
in cogMethod, given the start of the bytecodes for cogMethod's block or method object."
<api>
<var: #cogMethod type: #'CogBlockMethod *'>
| absPC |
absPC := self
mapFor: cogMethod
bcpc: startbcpc
+ performUntil: #find:Mcpc:Bcpc:MatchingBcpc:
- performUntil: #find:Mcpc:Bcpc:MatchingBcpc: asSymbol
arg: (self cCoerceSimple: bcpc to: #'void *').
^absPC ~= 0
ifTrue: [absPC asUnsignedInteger - cogMethod asUnsignedInteger]
ifFalse: [absPC]!
Item was changed:
----- Method: SistaStackToRegisterMappingCogit>>picDataFor:into: (in category 'method introspection') -----
picDataFor: cogMethod into: arrayObj
"Answer the zero-relative bytecode pc matching the machine code pc argument in
cogMethod, given the start of the bytecodes for cogMethod's block or method object."
<api>
<var: #cogMethod type: #'CogMethod *'>
| errCode |
cogMethod stackCheckOffset = 0 ifTrue:
[^0].
picDataIndex := 0.
picData := arrayObj.
errCode := self
mapFor: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *')
bcpc: (coInterpreter startPCOfMethod: cogMethod methodObject)
+ performUntil: #picDataFor:Mcpc:Bcpc:Method:
- performUntil: #picDataFor:Mcpc:Bcpc:Method: asSymbol
arg: (self cCoerceSimple: cogMethod to: #'void *').
errCode ~= 0 ifTrue:
[self assert: errCode = PrimErrNoMemory.
^-1].
^picDataIndex!
Item was changed:
----- Method: StackInterpreter>>addNewMethodToCache: (in category 'method lookup cache') -----
addNewMethodToCache: class
"Add the given entry to the method cache.
The policy is as follows:
Look for an empty entry anywhere in the reprobe chain.
If found, install the new entry there.
If not found, then install the new entry at the first probe position
and delete the entries in the rest of the reprobe chain.
This has two useful purposes:
If there is active contention over the first slot, the second
or third will likely be free for reentry after ejection.
Also, flushing is good when reprobe chains are getting full."
| probe hash primitiveIndex |
<inline: false>
hash := messageSelector bitXor: class. "drop low-order zeros from addresses"
(objectMemory isOopCompiledMethod: newMethod)
ifTrue:
[primitiveIndex := self primitiveIndexOf: newMethod.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: class]
ifFalse:
+ [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
- [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod asSymbol].
0 to: CacheProbeMax-1 do:
[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
(methodCache at: probe + MethodCacheSelector) = 0 ifTrue:
["Found an empty entry -- use it"
methodCache at: probe + MethodCacheSelector put: messageSelector.
methodCache at: probe + MethodCacheClass put: class.
methodCache at: probe + MethodCacheMethod put: newMethod.
methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
^ nil]].
"OK, we failed to find an entry -- install at the first slot..."
probe := hash bitAnd: MethodCacheMask. "first probe"
methodCache at: probe + MethodCacheSelector put: messageSelector.
methodCache at: probe + MethodCacheClass put: class.
methodCache at: probe + MethodCacheMethod put: newMethod.
methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
"...and zap the following entries"
1 to: CacheProbeMax-1 do:
[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
methodCache at: probe + MethodCacheSelector put: 0]!
Item was changed:
----- Method: StackInterpreterSimulator>>ioLoadExternalFunction:OfLength:FromModule:OfLength: (in category 'plugin support') -----
ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength
"Load and return the requested function from a module"
| pluginString functionString |
pluginString := String new: moduleLength.
1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
functionString := String new: functionLength.
1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
- functionString := functionString asSymbol.
^self ioLoadFunction: functionString From: pluginString!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genMethodAbortTrampolineFor: (in category 'initialization') -----
genMethodAbortTrampolineFor: numArgs
"Generate the abort for a method. This abort performs either a call of ceSICMiss:
to handle a single-in-line cache miss or a call of ceStackOverflow: to handle a
stack overflow. It distinguishes the two by testing ResultReceiverReg. If the
register is zero then this is a stack-overflow because a) the receiver has already
been pushed and so can be set to zero before calling the abort, and b) the
receiver must always contain an object (and hence be non-zero) on SIC miss."
| jumpSICMiss |
<var: #jumpSICMiss type: #'AbstractInstruction *'>
opcodeIndex := 0.
self CmpCq: 0 R: ReceiverResultReg.
jumpSICMiss := self JumpNonZero: 0.
+ self compileTrampolineFor: #ceStackOverflow:
- self compileTrampolineFor: #ceStackOverflow: asSymbol
callJumpBar: true
numArgs: 1
arg: SendNumArgsReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil.
jumpSICMiss jmpTarget: self Label.
self genPushRegisterArgsForAbortMissNumArgs: numArgs.
+ ^self genTrampolineFor: #ceSICMiss:
- ^self genTrampolineFor: #ceSICMiss: asSymbol
called: (self trampolineName: 'ceMethodAbort' numArgs: (numArgs <= self numRegArgs ifTrue: [numArgs] ifFalse: [-1]))
callJumpBar: true
numArgs: 1
arg: ReceiverResultReg
arg: nil
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genPICMissTrampolineFor: (in category 'initialization') -----
genPICMissTrampolineFor: numArgs
| startAddress |
<var: #aString type: #'char *'>
<inline: false>
startAddress := methodZoneBase.
opcodeIndex := 0.
"N.B. a closed PIC jumps to the miss routine, not calls it, so there is only one retpc on the stack."
self genPushRegisterArgsForNumArgs: numArgs.
+ self genTrampolineFor: #ceCPICMiss:receiver:
- self genTrampolineFor: #ceCPICMiss:receiver: asSymbol
called: (self trampolineName: 'cePICMiss' numArgs: (numArgs <= self numRegArgs ifTrue: [numArgs] ifFalse: [-1]))
callJumpBar: true
numArgs: 2
arg: ClassReg
arg: ReceiverResultReg
arg: nil
arg: nil
saveRegs: false
resultReg: nil
appendOpcodes: true.
^startAddress!
Item was changed:
----- Method: StackToRegisterMappingCogit>>generateEnilopmarts (in category 'initialization') -----
generateEnilopmarts
"Enilopmarts transfer control from C into machine code (backwards trampolines).
Override to add version for generic and PIC-specific entry with reg args."
super generateEnilopmarts.
self cppIf: Debug
ifTrue:
[realCEEnterCogCodePopReceiverArg0Regs :=
self genEnilopmartFor: ReceiverResultReg
and: Arg0Reg
called: 'realCEEnterCogCodePopReceiverArg0Regs'.
+ ceEnterCogCodePopReceiverArg0Regs := #enterCogCodePopReceiverArg0Regs.
- ceEnterCogCodePopReceiverArg0Regs := #enterCogCodePopReceiverArg0Regs asSymbol.
realCEEnterCogCodePopReceiverArg1Arg0Regs :=
self genEnilopmartFor: ReceiverResultReg
and: Arg0Reg
and: Arg1Reg
called: 'realCEEnterCogCodePopReceiverArg1Arg0Regs'.
+ ceEnterCogCodePopReceiverArg1Arg0Regs := #enterCogCodePopReceiverArg1Arg0Regs]
- ceEnterCogCodePopReceiverArg1Arg0Regs := #enterCogCodePopReceiverArg1Arg0Regs asSymbol]
ifFalse:
[ceEnterCogCodePopReceiverArg0Regs :=
self genEnilopmartFor: ReceiverResultReg
and: Arg0Reg
called: 'ceEnterCogCodePopReceiverArg0Regs'.
ceEnterCogCodePopReceiverArg1Arg0Regs :=
self genEnilopmartFor: ReceiverResultReg
and: Arg0Reg
and: Arg1Reg
called: 'ceEnterCogCodePopReceiverArg1Arg0Regs'].
"These are special versions of the ceEnterCogCodePopReceiverAndClassRegs enilopmart that also
pop register argsfrom the stack to undo the pushing of register args in the abort/miss trampolines."
ceEnter0ArgsPIC := self genEnterPICEnilopmartNumArgs: 0.
self numRegArgs >= 1 ifTrue:
[ceEnter1ArgsPIC := self genEnterPICEnilopmartNumArgs: 1.
self numRegArgs >= 2 ifTrue:
[ceEnter1ArgsPIC := self genEnterPICEnilopmartNumArgs: 2.
self assert: self numRegArgs = 2]]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>generateSendTrampolines (in category 'initialization') -----
generateSendTrampolines
"Override to generate code to push the register arg(s) for <= numRegArg arity sends."
- "Slang needs these apparently superfluous asSymbol sends."
0 to: NumSendTrampolines - 2 do:
[:numArgs|
sendTrampolines
at: numArgs
+ put: (self genSendTrampolineFor: #ceSend:super:to:numArgs:
- put: (self genSendTrampolineFor: #ceSend:super:to:numArgs: asSymbol
numArgs: numArgs
called: (self trampolineName: 'ceSend' numArgs: numArgs)
arg: ClassReg
arg: 0
arg: ReceiverResultReg
arg: numArgs)].
sendTrampolines
at: NumSendTrampolines - 1
+ put: (self genSendTrampolineFor: #ceSend:super:to:numArgs:
- put: (self genSendTrampolineFor: #ceSend:super:to:numArgs: asSymbol
numArgs: self numRegArgs + 1
called: (self trampolineName: 'ceSend' numArgs: -1)
arg: ClassReg
arg: 0
arg: ReceiverResultReg
arg: SendNumArgsReg).
self cppIf: NewspeakVM
ifTrue:
[0 to: NumSendTrampolines - 2 do:
[:numArgs|
dynamicSuperSendTrampolines
at: numArgs
+ put: (self genSendTrampolineFor: #ceDynamicSuperSend:to:numArgs:
- put: (self genSendTrampolineFor: #ceDynamicSuperSend:to:numArgs: asSymbol
numArgs: numArgs
called: (self trampolineName: 'ceDynSuperSend' numArgs: numArgs)
arg: ClassReg
arg: ReceiverResultReg
arg: numArgs)].
dynamicSuperSendTrampolines
at: NumSendTrampolines - 1
+ put: (self genSendTrampolineFor: #ceDynamicSuperSend:to:numArgs:
- put: (self genSendTrampolineFor: #ceDynamicSuperSend:to:numArgs: asSymbol
numArgs: self numRegArgs + 1
called: (self trampolineName: 'ceDynSuperSend' numArgs: -1)
arg: ClassReg
arg: ReceiverResultReg
arg: SendNumArgsReg)].
0 to: NumSendTrampolines - 2 do:
[:numArgs|
superSendTrampolines
at: numArgs
+ put: (self genSendTrampolineFor: #ceSend:super:to:numArgs:
- put: (self genSendTrampolineFor: #ceSend:super:to:numArgs: asSymbol
numArgs: numArgs
called: (self trampolineName: 'ceSuperSend' numArgs: numArgs)
arg: ClassReg
arg: 1
arg: ReceiverResultReg
arg: numArgs)].
superSendTrampolines
at: NumSendTrampolines - 1
+ put: (self genSendTrampolineFor: #ceSend:super:to:numArgs:
- put: (self genSendTrampolineFor: #ceSend:super:to:numArgs: asSymbol
numArgs: self numRegArgs + 1
called: (self trampolineName: 'ceSuperSend' numArgs: -1)
arg: ClassReg
arg: 1
arg: ReceiverResultReg
arg: SendNumArgsReg).
firstSend := sendTrampolines at: 0.
lastSend := superSendTrampolines at: NumSendTrampolines - 1!
Item was changed:
----- Method: StackToRegisterMappingCogit>>generateTracingTrampolines (in category 'initialization') -----
generateTracingTrampolines
"Generate trampolines for tracing. In the simulator we can save a lot of time
and avoid noise instructions in the lastNInstructions log by short-cutting these
trampolines, but we need them in the real vm."
ceTraceLinkedSendTrampoline
:= self cCode:
+ [self genSafeTrampolineFor: #ceTraceLinkedSend:
- [self genSafeTrampolineFor: #ceTraceLinkedSend: asSymbol
called: 'ceTraceLinkedSendTrampoline'
arg: ReceiverResultReg]
inSmalltalk:
[| a |
simulatedTrampolines
at: (a := self simulatedAddressFor: #ceShortCutTraceLinkedSend:)
put: #ceShortCutTraceLinkedSend:.
a].
ceTraceBlockActivationTrampoline
:= self cCode:
+ [self genTrampolineFor: #ceTraceBlockActivation
- [self genTrampolineFor: #ceTraceBlockActivation asSymbol
called: 'ceTraceBlockActivationTrampoline']
inSmalltalk:
[| a |
simulatedTrampolines
at: (a := self simulatedAddressFor: #ceShortCutTraceBlockActivation:)
put: #ceShortCutTraceBlockActivation:.
a].
ceTraceStoreTrampoline
:= self cCode:
+ [self genSafeTrampolineFor: #ceTraceStoreOf:into:
- [self genSafeTrampolineFor: #ceTraceStoreOf:into: asSymbol
called: 'ceTraceStoreTrampoline'
arg: TempReg
arg: ReceiverResultReg]
inSmalltalk:
[| a |
simulatedTrampolines
at: (a := self simulatedAddressFor: #ceShortCutTraceStore:)
put: #ceShortCutTraceStore:.
a]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>v3:Is:Push:Nil: (in category 'span functions') -----
v3: descriptor Is: pc Push: nExts Nil: aMethodObj
<var: #descriptor type: #'BytecodeDescriptor *'>
<inline: true>
+ ^descriptor generator == #genPushConstantNilBytecode!
- ^descriptor generator == #genPushConstantNilBytecode asSymbol!
Item was changed:
----- Method: StackToRegisterMappingCogit>>v4:Is:Push:Nil: (in category 'span functions') -----
v4: descriptor Is: pc Push: nExts Nil: aMethodObj
<var: #descriptor type: #'BytecodeDescriptor *'>
<inline: true>
+ ^descriptor generator == #genExtPushPseudoVariableOrOuterBytecode
- ^descriptor generator == #genExtPushPseudoVariableOrOuterBytecode asSymbol
and: [self assert: (objectMemory fetchByte: pc ofObject: aMethodObj) = 77.
nExts = 1
and: [(objectMemory fetchByte: pc - 1 ofObject: aMethodObj) = 2]]!
Item was added:
+ ----- Method: Symbol>>defined (in category '*VMMaker-interpreter simulator') -----
+ defined
+ "To allow constructs such as self cppIf: #'SA_NOCLDSTOP' defined ifTrue: [...].
+ We could go look for a definition but likely there won't be one."
+ ^false!
Item was changed:
----- Method: TConstantNode>>printOn:level: (in category 'printing') -----
printOn: aStream level: level
+ value isSymbol
+ ifTrue: [aStream nextPutAll: (value copyWithout: $:)]
+ ifFalse: [value storeOn: aStream]!
-
- value storeOn: aStream.!
Item was added:
+ ----- Method: TLabeledCommentNode>>needsTrailingSemicolon (in category 'testing') -----
+ needsTrailingSemicolon
+ "Answer if, when emitted as a statement (in particular in a TStmtList), the
+ receiver needs a trailing semicolon. Comments do not. You'd think that
+ labels do not, but we put them at the end of blocks where there needs
+ to be a null statement following the label and before the end of block."
+ ^self isComment not!
Item was changed:
----- Method: TParseNode>>allCalls (in category 'utilities') -----
allCalls
"Answer a collection of selectors for the messages sent in this parse tree."
| calls |
+ calls := Set new: 32.
- calls := Set new: 100.
self nodesDo:
+ [:node|
- [ :node |
node isSend ifTrue:
+ [calls add: node selector].
+ (node isConstant and: [node value isSymbol]) ifTrue:
+ [calls add: node value]].
- [((calls add: node selector) = #asSymbol
- and: [node receiver isConstant
- and: [node receiver value isSymbol]]) ifTrue:
- [calls add: node receiver value]]].
^calls!
Item was removed:
- ----- Method: TParseNode>>isPreprocessorDirective (in category 'testing') -----
- isPreprocessorDirective
- ^false!
Item was added:
+ ----- Method: TParseNode>>needsTrailingSemicolon (in category 'testing') -----
+ needsTrailingSemicolon
+ "Answer if, when emitted as a statement (in particular in a TStmtList), the
+ receiver needs a trailing semicolon. Subclasses redefine as appropriate."
+ ^true!
Item was added:
+ ----- Method: TSendNode>>needsTrailingSemicolon (in category 'testing') -----
+ needsTrailingSemicolon
+ "Answer if, when emitted as a statement (in particular in a TStmtList), the
+ receiver needs a trailing semicolon. Preprocessor directives and special expansions do not."
+ ^(self isPreprocessorDirective
+ or: [self isValueExpansion
+ or: [selector == #expandDereferenceInterpreterProxyFunctionTable]]) not!
Item was changed:
----- Method: TStmtListNode>>emitCCodeOn:prependToEnd:level:generator: (in category 'C code generation') -----
emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen
self emitCCommentOn: aStream level: level.
statements withIndexDo:
[:s :idx|
s emitCCommentOn: aStream level: level.
aStream peekLast ~~ Character tab ifTrue:
[aStream tab: level].
(aNodeOrNil notNil
and: [idx = statements size])
ifTrue:
[s emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen]
ifFalse:
[s emitCCodeOn: aStream level: level generator: aCodeGen].
+ (self endsWithCloseBracket: aStream) ifFalse:
+ [s needsTrailingSemicolon ifTrue:
+ [aStream nextPut: $;]].
- ((self endsWithCloseBracket: aStream)
- or: [s isComment
- or: [s isPreprocessorDirective
- or: [s isSend and: [s isValueExpansion]]]]) ifFalse:
- [aStream nextPut: $;].
aStream cr].
!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') -----
ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs
"Generic callout. Does the actual work. If argArrayOrNil is nil it takes args from the stack
and the spec from the method. If argArrayOrNil is not nil takes args from argArrayOrNil
and the spec from the receiver."
| flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result |
<inline: true>
<var: #theCalloutState type: #'CalloutState'>
<var: #calloutState type: #'CalloutState *'>
<var: #allocation type: #'char *'>
(interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse:
[^self ffiFail: FFIErrorNotFunction].
"Load and check the values in the externalFunction before we call out"
flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction.
interpreterProxy failed ifTrue:
[^self ffiFail: FFIErrorBadArgs].
"This must come early for compatibility with the old FFIPlugin. Image-level code
may assume the function pointer is loaded eagerly. Thanks to Nicolas Cellier."
address := self ffiLoadCalloutAddress: externalFunction.
interpreterProxy failed ifTrue:
[^0 "error code already set by ffiLoadCalloutAddress:"].
argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction.
"must be array of arg types"
((interpreterProxy isArray: argTypeArray)
and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse:
[^self ffiFail: FFIErrorBadArgs].
"check if the calling convention is supported"
self cppIf: COGMTVM
ifTrue:
[(self ffiSupportsCallingConvention: (flags bitAnd: FFICallTypesMask)) ifFalse:
[^self ffiFail: FFIErrorCallType]]
ifFalse: "not masking causes threaded calls to fail, which is as they should if the plugin is not threaded."
[(self ffiSupportsCallingConvention: flags) ifFalse:
[^self ffiFail: FFIErrorCallType]].
requiredStackSize := self externalFunctionHasStackSizeSlot
ifTrue: [interpreterProxy
fetchInteger: ExternalFunctionStackSizeIndex
ofObject: externalFunction]
ifFalse: [-1].
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: (argArrayOrNil isNil
ifTrue: [PrimErrBadMethod]
ifFalse: [PrimErrBadReceiver])].
stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize].
self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new].
calloutState := self addressOf: theCalloutState.
+ self cCode: [self me: calloutState ms: 0 et: (self sizeof: #CalloutState)].
- self cCode: [self me: calloutState ms: 0 et: (self sizeof: #CalloutState asSymbol)].
calloutState callFlags: flags.
"Fetch return type and args"
argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray.
argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
(err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue:
[^self ffiFail: err]. "cannot return"
"alloca the outgoing stack frame, leaving room for register args while marshalling, and including space for the return struct, if any."
allocation := self alloca: stackSize + calloutState structReturnSize + self registerArgsSlop + self cStackAlignment.
self allocaLiesSoUseGetsp ifTrue:
[allocation := self getsp].
self cStackAlignment ~= 0 ifTrue:
[allocation := self cCoerce: (allocation asUnsignedInteger bitClear: self cStackAlignment - 1)
to: #'char *'].
calloutState
argVector: allocation;
currentArg: allocation + self registerArgsSlop;
limit: allocation + stackSize + self registerArgsSlop.
(calloutState structReturnSize > 0
and: [self nonRegisterStructReturnIsViaImplicitFirstArgument
and: [(self returnStructInRegisters: calloutState structReturnSize) not]]) ifTrue:
[err := self ffiPushPointer: calloutState limit in: calloutState.
err ~= 0 ifTrue:
[self cleanupCalloutState: calloutState.
self cppIf: COGMTVM ifTrue:
[err = PrimErrObjectMayMove negated ifTrue:
[^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
^self ffiFail: err]].
1 to: nArgs do:
[:i|
argType := interpreterProxy fetchPointer: i ofObject: argTypeArray.
argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
oop := argArrayOrNil isNil
ifTrue: [interpreterProxy stackValue: nArgs - i]
ifFalse: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil].
err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState.
err ~= 0 ifTrue:
[self cleanupCalloutState: calloutState.
self cppIf: COGMTVM ifTrue:
[err = PrimErrObjectMayMove negated ifTrue:
[^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
^self ffiFail: err]]. "coercion failed or out of stack space"
"Failures must be reported back from ffiArgument:Spec:Class:in:.
Should not fail from here on in."
self assert: interpreterProxy failed not.
self ffiLogCallout: externalFunction.
(requiredStackSize < 0
and: [self externalFunctionHasStackSizeSlot]) ifTrue:
[stackSize := calloutState currentArg - calloutState argVector.
interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize].
"Go out and call this guy"
result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState.
self cleanupCalloutState: calloutState.
^result!
Item was removed:
- ----- Method: VMClass class>>browseSymbolRefsMissingAsSymbolSendLocalToPackage: (in category 'utilities') -----
- browseSymbolRefsMissingAsSymbolSendLocalToPackage: aPackageName
- "Slang will bite you hard if you write e.g.
- self sizeof: #mytype
- because it will translate this as
- sizeof(''mytype'').
- Instead you must write
- self sizeof: #mytype asSymbol
- because it will translate this as
- sizeof(mytype).
- This is a really easy slip to make (and arguably a horrible bug in Slang, but backward-compatibility etc, bitch, moan.
- So here's a scanner to find any offending occurrences. Forgive the deluge of false positives.
-
- VMClass browseSymbolRefsMissingAsSymbolSendLocalToPackage: #VMMaker.
- VMClass browseSymbolRefsMissingAsSymbolSendLocalToPackage: #VMConstruction.
- VMClass browseSymbolRefsMissingAsSymbolSendLocalToPackage: #'Qwaq-Plugins'.
- VMClass browseSymbolRefsMissingAsSymbolSendLocalToPackage: #'Cog-ProcessorPlugins'.
- VMClass browseSymbolRefsMissingAsSymbolSendLocalToPackage: #'SqueakSSL-Plugin'.
- VMClass browseSymbolRefsMissingAsSymbolSendLocalToPackage: #'Freetype-Plugin'"
-
- SystemNavigation new
- browseAllSelect:
- [:m| | is bad prevLit |
- m methodClass isMeta not
- and: [(m pragmaAt: #doNotGenerate) isNil
- and: [is := InstructionStream on: m.
- bad := false.
- [is atEnd] whileFalse:
- [[is interpretNextInstructionFor: nil]
- on: MessageNotUnderstood
- do: [:ex| | s args |
- s := ex message selector.
- args := ex message arguments.
- prevLit ifNotNil:
- [(s = #send:super:numArgs:
- and: [#(asSymbol cCoerceSimple:to: cCoerce:to: flag: primitive:parameters:receiver:)
- includes: args first]) ifFalse:
- [bad := true]].
- prevLit := (s == #pushConstant: and: [args first isSymbol]) ifTrue:
- [args first]]].
- bad]]]
- localToPackage: aPackageName!
More information about the Vm-dev
mailing list