[Vm-dev] VM Maker: VMMaker.oscog-eem.2994.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Jul 26 01:40:02 UTC 2021
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2994.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2994
Author: eem
Time: 25 July 2021, 6:39:54.66594 pm
UUID: 735de269-3317-455d-b991-d9adca76cebc
Ancestors: VMMaker.oscog-eem.2993
Cog: Implement calling named primitives on the Smalltalk stack if the primitive's export:flags: pragma so specifies. Spur only.
A named primitive can now export itself with metadata thusly:
<export: true flags: #FastCPrimitiveFlag>
Most of the LargeIntegersPlugin primitives now do this along with all teh MiscPrimitivePlugin primitives.
On Spur arrange that these primitives are invoked on the Smalltalk stack, using the standard stackPointer/argumentCount/primErrorCode primitive convention. [A future extension may be to get Slang to implement a conventioanl C function taking all operands as parameters; this can be invoked with less overhead, being able to avoid setting stackPointer/argumentCount/primErrorCode]. This depends on a platforms change where ioLoadFunction:From:AccessorDepthInto: is replaced with ioLoadFunction:From:MetadataInto:.
Discard the old support for rebinding external primtiives in machine code (externalPrimCallOffsets et al). Instead make sure that any and all contexts for external primitives are divorced and have bytecode PCs whenever a module is unloaded. Unloading is essentially a development time operation so it being slow is not an issue. Getting rid of the rebinding support that allowed external primitive cog methods to revert to invoking primtiiveExternalCall on unload, simplifies supporting multiple plugin calling conventions. This also eliminates the truly horrible postCompilationHook.
Extend the support used to flush methods when setting/unsetting the "do mixed arithmetic" control (VM parameter 75) to provide both that toggle and the flush external primitives functionality.
1. Refactor the divorce fncitonality to take a criterion; divorceMachineCodeFramesWithMachineCodePrimitiveMethod becomes divorceAllFramesSuchThat:, and can take isMachineCodeFrameWithCogMethod: & isMachineCodeFrameForExternalPrimitiveMethod: as criteria.
2. Refactor and simplify the Cogit unlinking API. unlinkSendsToMachineCodePrimitiveMethodsAndFreeIf: becomes unlinkSendsToMethodsSuchThat:AndFreeIf:, and can use e.g. cogMethodHasMachineCodePrim: and cogMethodHasExternalPrim: as criteria. Type mapFor:performUntil:arg:;s arg parameter as CogMethod *; it almost always is.
Refactor primitiveExternalCall into linkExternalCall:ifFail:, which allows CoInterpreter>>#functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: to link an external method to find its metadata, and arranges (should arrange) that the Cogit will always be compiling a call direct to the target primtiive method.
CogARMv8Compiler: fix a bug in concretizePrefetchAw that produced a read rather than a prefetch.
Simplify the module listing & unloading primitives, and make sure they simulate. N.B. Smalltalk unloadModule: #FilePlugin will cause lots of failures in the FilePlugin on reloading because the file descriptors are not preserved across the unload/reload, unlike the real OS. This could be done e.g. by stashing them in IntializationOptions.
This feels like a significant change. Review and/or hard testing appreciated.
=============== Diff against VMMaker.oscog-eem.2993 ===============
Item was changed:
----- Method: CCodeGenerator>>emitExportsNamed:pluginName:on: (in category 'C code generator') -----
emitExportsNamed: exportsNamePrefix pluginName: pluginName on: aStream
"Store all the exported primitives in the form used by the internal named prim system."
+ | nilVMClass excludeMetadata exportsNeedingMetadata |
- | nilVMClass excludeDepth |
(nilVMClass := vmClass isNil) ifTrue: "We need a vmClass temporarily to compute accessor depths."
[vmClass := StackInterpreter].
"Don't include the depth in the vm's named primitives if the vm is non-Spur."
+ excludeMetadata := exportsNamePrefix = 'vm'
- excludeDepth := exportsNamePrefix = 'vm'
and: [pluginName isEmpty
and: [vmClass objectMemoryClass hasSpurMemoryManagerAPI not]].
aStream cr; cr; nextPutAll: 'static char _m[] = "'; nextPutAll: pluginName; nextPutAll: '";'.
aStream cr; nextPutAll: 'void* '; nextPutAll: exportsNamePrefix; nextPutAll: '_exports[][3] = {'; cr.
+ exportsNeedingMetadata := self exportsNeedingMetadata.
self sortedExportMethods do:
[:method|
self withOptionalConditionalDefineFor: method
on: aStream
+ do: [| primName depth exportFlags |
- do: [| primName |
primName := self cFunctionNameFor: method selector.
aStream tab; nextPutAll: '{(void*)_m, "'; nextPutAll: primName.
+ (excludeMetadata not and: [exportsNeedingMetadata includes: method]) ifTrue:
+ [depth := self accessorDepthForMethod: method.
+ exportFlags := CoInterpreter metadataFlagsForPrimitive: method compiledMethod.
+ (depth notNil or: [exportFlags > 0]) ifTrue:
+ "store the metadata in two hidden bytes immediately after the primName"
+ [self assert: depth < 128.
+ aStream
- excludeDepth ifFalse:
- [(self accessorDepthForSelector: primName asSymbol) ifNotNil:
- [:depth| "store the accessor depth in a hidden byte immediately after the primName"
- self assert: depth < 128.
- aStream
nextPutAll: '\000\';
+ nextPutAll: ((depth bitAnd: 255) printStringBase: 8 nDigits: 3);
+ nextPut: $\;
+ nextPutAll: ((exportFlags bitAnd: 255) printStringBase: 8 nDigits: 3)]].
- nextPutAll: ((depth bitAnd: 255) printStringBase: 8 nDigits: 3)]].
aStream nextPutAll: '", (void*)'; nextPutAll: primName; nextPutAll: '},'; cr]].
aStream tab; nextPutAll: '{NULL, NULL, NULL}'; cr; nextPutAll: '};'; cr.
nilVMClass ifTrue:
[vmClass := nil]!
Item was added:
+ ----- Method: CCodeGenerator>>exportsNeedingMetadata (in category 'spur primitive compilation') -----
+ exportsNeedingMetadata
+ ^self sortedExportMethods reject:
+ [:m| m selector = #initialiseModule or: [InterpreterPlugin includesSelector: m smalltalkSelector]]!
Item was added:
+ ----- Method: CObjectAccessor>>asVoidPointer (in category 'converting') -----
+ asVoidPointer
+ ^self!
Item was changed:
StackInterpreterPrimitives subclass: #CoInterpreter
instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile CFramePointer CStackPointer CReturnAddress primTracePluginName'
+ classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimNumberHashMultiply PrimTraceLogSize PrimitiveMetadataFlagsShift RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
- classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimNumberHashMultiply PrimTraceLogSize RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
category: 'VMMaker-JIT'!
!CoInterpreter commentStamp: 'eem 3/31/2020 18:56' prior: 0!
I am a variant of the StackInterpreter that can co-exist with the Cog JIT. I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT. See CogMethod class's comment for method interoperability.
cogCodeSize
- the current size of the machine code zone
cogCompiledCodeCompactionCalledFor
- a variable set when the machine code zone runs out of space, causing a machine code zone compaction at the next available opportunity
cogMethodZone
- the manager for the machine code zone (instance of CogMethodZone)
cogit
- the JIT (co-jit) (instance of SimpleStackBasedCogit, StackToRegisterMappoingCogit, etc)
deferSmash
- a flag causing deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
deferredSmash
- a flag noting deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
desiredCogCodeSize
- the desred size of the machine code zone, set at startup or via primitiveVMParameter to be written at snapshot time
flagInterpretedMethods
- true if methods that are interpreted shoudl have their flag bit set (used to identity methods that are interpreted because they're unjittable for some reason)
gcMode
- the variable holding the gcMode, used to inform the cogit of how to scan the machine code zone for oops on GC
heapBase
- the address in memory of the base of the objectMemory's heap, which is immediately above the machine code zone
lastCoggableInterpretedBlockMethod
- a variable used to invoke the cogit for a block mehtod being invoked repeatedly in the interpreter
lastUncoggableInterpretedBlockMethod
- a variable used to avoid invoking the cogit for an unjittable method encountered on block evaluation
maxLiteralCountForCompile
- the variable controlling which methods to jit. methods with a literal count above this value will not be jitted (on the grounds that large methods are typically used for initialization, and take up a lot of space in the code zone)
minBackwardJumpCountForCompile
- the variable controlling when to attempt to jit a method being interpreted. If as many backward jumps as this occur, the current method will be jitted
primTraceLog
- a small array implementing a crcular buffer logging the last N primitive invocations, GCs, code compactions, etc used for crash reporting
primTraceLogIndex
- the index into primTraceLog of the next entry
reenterInterpreter
- the jmpbuf used to jmp back into the interpreter when transitioning from machine code to the interpreter
statCodeCompactionCount
- the count of machine code zone compactions
statCodeCompactionUsecs
- the total microseconds spent in machine code zone compactions
traceLog
- a log of various events, used in debugging
traceLogIndex
- the index into traceLog of the next entry
traceSources
- the names associated with the codes of events in traceLog
CFramePointer
- if in use, the value of the C frame pointer on most recent entry to the interpreter after start-up or a callback. Used to establish the C stack when calling the run-time from generated machine code.
CStackPointer
- the value of the C stack pointer on most recent entry to the interpreter after start-up or a callback. Used to establish the C stack when calling the run-time from generated machine code.
CReturnAddress
- the return address for the function call which invoked the interpreter at start-up. Using this as teh return address when entering the interpreter via ceInvokeInterpeter maintains a valid stack. Since this is effevtively a constant it does not need to be saved and restored once set.!
Item was changed:
----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants
super initializeMiscConstants.
COGVM := true.
MinBackwardJumpCountForCompile := 40.
MaxNumArgs := 15.
PrimCallNeedsNewMethod := 1.
PrimCallNeedsPrimitiveFunction := 2.
PrimCallMayEndureCodeCompaction := 4.
+ PrimCallCollectsProfileSamples := 8.
+ PrimCallDoNotJIT := 16.
+ PrimCallIsExternalCall := 32.
- PrimCallOnSmalltalkStack := 8.
- PrimCallCollectsProfileSamples := 16.
"CheckAllocationFillerAfterPrimCall := 32. this has never been successfully used in all the years we've had it; nuking it"
+ PrimCallOnSmalltalkStack := 64. "Speed up simple external prims by avoiding stack switch"
- PrimCallDoNotJIT := 64.
+ "Flags for use in export:flags:, shifted and combined with the PrimCallXXX flags above"
+ FastCPrimitiveFlag := 1.
+ PrimitiveMetadataFlagsShift := PrimCallOnSmalltalkStack highBit - FastCPrimitiveFlag highBit.
+
+ "the primitive trace log; a record of the last 256 named/external primitives or significant events invoked."
PrimTraceLogSize := 256. "Room for 256 selectors. Must be 256 because we use a byte to hold the index"
TraceBufferSize := 256 * 3. "Room for 256 events"
TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
TracePrimitiveFailure := self objectMemoryClass basicNew integerObjectOf: 14.
TracePrimitiveRetry := self objectMemoryClass basicNew integerObjectOf: 15.
TraceIsFromMachineCode := 1.
TraceIsFromInterpreter := 2.
CSCallbackEnter := 3.
CSCallbackLeave := 4.
CSEnterCriticalSection := 5.
CSExitCriticalSection := 6.
CSResume := 7.
CSSignal := 8.
CSSuspend := 9.
CSWait := 10.
CSYield := 11.
CSCheckEvents := 12.
CSThreadSchedulingLoop := 13.
CSOwnVM := 14.
CSThreadBind := 15.
CSSwitchIfNeccessary := 16.
TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal' 'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').
"this is simulation only"
RumpCStackSize := 4096!
Item was added:
+ ----- Method: CoInterpreter class>>metadataFlagsForPrimitive: (in category 'spur compilation support') -----
+ metadataFlagsForPrimitive: aPrimitiveMethodOrNil
+ "We allow methods to decorate themselves with 8 flags (only one specified so far: FastCPrimitiveFlag)
+ using the export:flags: pragma."
+ aPrimitiveMethodOrNil ifNil: [^0].
+ ^(aPrimitiveMethodOrNil pragmaAt: #export:flags:)
+ ifNil: [0]
+ ifNotNil: [:pragma| | flags |
+ (flags := pragma arguments second) isInteger
+ ifTrue: [flags]
+ ifFalse:
+ [(self bindingOf: flags)
+ ifNil: [self error: 'could not find primitive flag'. 0]
+ ifNotNil:
+ [:binding| | flagValue |
+ ((flagValue := binding value) isInteger and: [flagValue between: 1 and: 255])
+ ifTrue: [flagValue]
+ ifFalse: [self error: 'integer flag required'. 0]]]]!
Item was added:
+ ----- Method: CoInterpreter>>accessorDepthForExternalPrimitiveMethod: (in category 'plugin primitive support') -----
+ accessorDepthForExternalPrimitiveMethod: methodObj
+ <api>
+ <option: #SpurMemoryManager>
+ | flags lit |
+ self assert: (self isLinkedExternalPrimitive: methodObj).
+ lit := self literal: 0 ofMethod: methodObj.
+ flags := objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit.
+ ^(objectMemory integerValueOf: flags) bitShift: -8!
Item was changed:
----- Method: CoInterpreter>>assertValidExternalStackPointers (in category 'debug support') -----
assertValidExternalStackPointers
<doNotGenerate>
"For use *ONLY* by routines coming in to the VM,
i.e. handleCallOrJumpSimulationTrap:. This is because it nils localFP as a side-effect,
and it does so so that the head frame can be determined reliably."
self assert: framePointer < stackPage baseAddress.
self assert: stackPointer < framePointer.
self assert: framePointer > stackPointer.
self assert: stackPointer >= (stackPage realStackLimit - self stackLimitOffset).
+ self nilLocalFP!
- localFP := nil!
Item was added:
+ ----- Method: CoInterpreter>>attemptToLinkExternalPrimitive: (in category 'plugin primitive support') -----
+ attemptToLinkExternalPrimitive: methodObj
+ | header primIdx firstLiteral targetFunctionIndex |
+ header := objectMemory methodHeaderOf: methodObj.
+ primIdx := self primitiveIndexOfMethod: methodObj header: header.
+ firstLiteral := self literal: 0 ofMethod: methodObj.
+ self assert: (primIdx = PrimNumberExternalCall
+ and: [(objectMemory literalCountOfMethodHeader: header) > 0
+ and: [(objectMemory isArray: firstLiteral)
+ and: [(objectMemory numSlotsOf: firstLiteral) = 4]]]).
+ targetFunctionIndex := objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: firstLiteral.
+ self assert: (objectMemory isIntegerObject: targetFunctionIndex).
+ (objectMemory integerValueOf: targetFunctionIndex) = 0 ifTrue:
+ [self linkExternalCall: firstLiteral ifFail: []].
+ ^firstLiteral!
Item was changed:
----- Method: CoInterpreter>>checkForAndFollowForwardedPrimitiveState (in category 'primitive support') -----
checkForAndFollowForwardedPrimitiveState
+ "Override to log and export to Cogit"
+ <api>
- "Override to log"
<option: #SpurObjectMemory>
| found |
(cogit recordPrimTrace and: [primTracePluginName isNil]) ifTrue:
[self fastLogPrim: TracePrimitiveFailure].
found := super checkForAndFollowForwardedPrimitiveState.
(found and: [cogit recordPrimTrace]) ifTrue:
[self fastLogPrim: TracePrimitiveRetry].
^found!
Item was added:
+ ----- Method: CoInterpreter>>divorceAFrameIf:in: (in category 'frame access') -----
+ divorceAFrameIf: criterion in: aStackPage
+ "Divorce at most one frame in the current page (since the divorce may cause the page to be split)
+ and answer whether a frame was divorced."
+ <var: #criterion declareC: 'sqInt (*criterion)(char *fp)'>
+ <var: #aStackPage type: #'StackPage *'>
+ | theFP calleeFP theSP theContext |
+
+ theFP := aStackPage headFP.
+ theSP := aStackPage headSP.
+ theSP := theSP + objectMemory wordSize. "theSP points at hottest item on frame's stack"
+
+ [(self perform: criterion with: theFP) ifTrue:
+ [theContext := self ensureFrameIsMarried: theFP SP: theSP.
+ self externalDivorceFrame: theFP andContext: theContext.
+ ^true].
+ calleeFP := theFP.
+ theFP := self frameCallerFP: theFP.
+ theFP ~= 0] whileTrue:
+ ["theSP points at stacked hottest item on frame's stack"
+ theSP := self frameCallerSP: calleeFP].
+
+ ^false!
Item was removed:
- ----- Method: CoInterpreter>>divorceAMachineCodeFrameWithMachineCodePrimitiveMethodIn: (in category 'frame access') -----
- divorceAMachineCodeFrameWithMachineCodePrimitiveMethodIn: aStackPage
- "Divorce at most one frame in the current page (since the divorce may cause the page to be split)
- and answer whether a frame was divorced."
- <var: #aStackPage type: #'StackPage *'>
- | theFP calleeFP theSP theContext |
- <var: #aStackPage type: #'StackPage *'>
- <var: #theFP type: #'char *'>
- <var: #calleeFP type: #'char *'>
- <var: #theSP type: #'char *'>
-
- theFP := aStackPage headFP.
- theSP := aStackPage headSP.
- theSP := theSP + objectMemory wordSize. "theSP points at hottest item on frame's stack"
-
- [((self isMachineCodeFrame: theFP)
- and: [cogit cogMethodHasMachineCodePrim: (self mframeHomeMethod: theFP)]) ifTrue:
- [theContext := self ensureFrameIsMarried: theFP SP: theSP.
- self externalDivorceFrame: theFP andContext: theContext.
- ^true].
- calleeFP := theFP.
- theFP := self frameCallerFP: theFP.
- theFP ~= 0] whileTrue:
- ["theSP points at stacked hottest item on frame's stack"
- theSP := self frameCallerSP: calleeFP].
-
- ^false!
Item was added:
+ ----- Method: CoInterpreter>>divorceAllFramesSuchThat: (in category 'frame access') -----
+ divorceAllFramesSuchThat: criterion
+ "Divorce all frames that satisfy criterion nd answer the current activeContext."
+ <var: #criterion declareC: 'sqInt (*criterion)(char *fp)'>
+ | activeContext divorcedSome |
+ activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
+ self ensurePushedInstructionPointer.
+ self externalWriteBackHeadFramePointers.
+ [stackPage ~= 0 ifTrue: "This is needed for the assert in externalDivorceFrame:andContext:"
+ [stackPages markStackPageMostRecentlyUsed: stackPage].
+ "Slang can't currently cope with the lack of the variable here.
+ Something to do with the preceding statement. Take it out
+ and the code is good. leave it in and we get do { ... } while(l1:)"
+ divorcedSome := self divorceSomeFramesIf: criterion.
+ divorcedSome] whileTrue.
+ ^activeContext!
Item was removed:
- ----- Method: CoInterpreter>>divorceMachineCodeFramesWithMachineCodePrimitiveMethod (in category 'frame access') -----
- divorceMachineCodeFramesWithMachineCodePrimitiveMethod
- | divorcedSome |
- [stackPage ~= 0 ifTrue: "This is needed for the assert in externalDivorceFrame:andContext:"
- [stackPages markStackPageMostRecentlyUsed: stackPage].
- "Slang can't currently cope with the lack of the variable here.
- Something to do with the preceding statement. Take it out
- and the code is good. leave it in and we get do { ... } while(l1:)"
- divorcedSome := self divorceSomeFramesWithMachineCodePrimitiveMethod.
- divorcedSome] whileTrue!
Item was added:
+ ----- Method: CoInterpreter>>divorceSomeFramesIf: (in category 'frame access') -----
+ divorceSomeFramesIf: criterion
+ "Divorce at most one frame (since the divorce may cause the containing
+ page to be split) and answer whether a frame was divorced."
+ <var: #criterion declareC: 'sqInt (*criterion)(char *fp)'>
+ | divorcedSome |
+ divorcedSome := false.
+ 0 to: numStackPages - 1 do:
+ [:i| | aPage |
+ aPage := stackPages stackPageAt: i.
+ (stackPages isFree: aPage) ifFalse:
+ ["this to avoid assert in externalDivorceFrame:andContext:"
+ stackPages markStackPageMostRecentlyUsed: stackPage.
+ (self divorceAFrameIf: criterion in: aPage) ifTrue:
+ [divorcedSome := true]]].
+ ^divorcedSome!
Item was removed:
- ----- Method: CoInterpreter>>divorceSomeFramesWithMachineCodePrimitiveMethod (in category 'frame access') -----
- divorceSomeFramesWithMachineCodePrimitiveMethod
- "Divorce at most one frame (since the divorce may cause the containing
- page to be split) and answer whether a frame was divorced."
- | divorcedSome |
- <var: #aPage type: #'StackPage *'>
- divorcedSome := false.
- 0 to: numStackPages - 1 do:
- [:i| | aPage |
- aPage := stackPages stackPageAt: i.
- (stackPages isFree: aPage) ifFalse:
- ["this to avoid assert in externalDivorceFrame:andContext:"
- stackPages markStackPageMostRecentlyUsed: stackPage.
- (self divorceAMachineCodeFrameWithMachineCodePrimitiveMethodIn: aPage) ifTrue:
- [divorcedSome := true]]].
- ^divorcedSome!
Item was removed:
- ----- 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>
- | primIdx |
- primIdx := super flushExternalPrimitiveOf: methodObj.
- (primIdx = PrimNumberExternalCall
- and: [self methodHasCogMethod: methodObj]) ifTrue:
- [cogit
- rewritePrimInvocationIn: (self cogMethodOf: methodObj)
- to: #primitiveExternalCall]!
Item was added:
+ ----- Method: CoInterpreter>>flushExternalPrimitives (in category 'plugin primitive support') -----
+ flushExternalPrimitives
+ "Flush the references to external functions from plugin primitives.
+ Then continue execution answering self.
+ This will force a reload of those primitives when accessed next.
+ Note: We must flush the method cache here also, so that any failed
+ primitives are looked up again.
+ Override to ensure that any and all activations of an external method
+ have a bytecode pc so that if code generation changes (e.g. a primitive
+ method is used, unloaded, and the reloaded primitive is marked with
+ the FastCPrimitiveFlag) stale machine code pcs have been eliminated.
+ THIS MUST BE INVOKED IN THE CONTEXT OF A PRIMITIVE."
+ | activeContext theFrame thePage |
+ activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameForExternalPrimitiveMethod:.
+ objectMemory allObjectsDo:
+ [:oop|
+ (objectMemory isCompiledMethod: oop)
+ ifTrue:
+ [self flushExternalPrimitiveOf: oop]
+ ifFalse:
+ [(objectMemory isContext: oop) ifTrue:
+ [self mapToBytecodePCIfActivationOfExternalMethod: oop]]].
+ cogit unlinkSendsToMethodsSuchThat: #cogMethodHasExternalPrim: AndFreeIf: true.
+ self flushMethodCache.
+ self flushExternalPrimitiveTable.
+ self cCode: '' inSmalltalk:
+ [self assert: (cogit methodZone cogMethodsSelect: [:cogMethod| cogMethod cmType > CMFree and: [cogit cogMethodHasExternalPrim: cogMethod]]) isEmpty].
+ "If flushing led to divorce continue in the interpreter."
+ (self isStillMarriedContext: activeContext) ifFalse:
+ [self zeroStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
+ self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
+ self popStack. "pop pushed instructionPointer"
+ self pop: argumentCount.
+ cogit ceInvokeInterpret
+ "NOTREACHED"].
+ "If not, work out where we are and continue"
+ theFrame := self frameOfMarriedContext: activeContext.
+ thePage := stackPages stackPageFor: theFrame.
+ self assert: thePage headFP = theFrame.
+ self setStackPageAndLimit: thePage.
+ self setStackPointersFromPage: thePage.
+ instructionPointer := self popStack.
+ self pop: argumentCount!
Item was changed:
----- Method: CoInterpreter>>flushMethodsWithMachineCodePrimitivesAndContinueAnswering: (in category 'primitive support') -----
flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
"Arrange that any and all cog methods with machine code primitives can be and are discarded.
Hence scan contexts and map their PCs to bytecode PCs if required, and scan frames, divorcing
+ the frames of activationsif required. Then continue execution answering result. THIS MUST BE
- the frames of activationsif required. The continue execution answering result. THIS MUST BE
INVOKED IN THE CONTEXT OF A PRIMITIVE. It exists to support vmParameterAt:put:."
| activeContext theFrame thePage |
+ activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameWithCogMethod:.
- <var: #theFrame type: #'char *'>
- <var: #thePage type: #'StackPage *'>
- activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
- self ensurePushedInstructionPointer.
- self externalWriteBackHeadFramePointers.
- self divorceMachineCodeFramesWithMachineCodePrimitiveMethod.
self ensureAllContextsWithMethodMachineCodePrimitiveMethodHaveBytecodePCs.
+ cogit unlinkSendsToMethodsSuchThat: #cogMethodHasMachineCodePrim: AndFreeIf: true.
- cogit unlinkSendsToMachineCodePrimitiveMethodsAndFreeIf: true.
"If flushing led to divorce continue in the interpreter."
(self isStillMarriedContext: activeContext) ifFalse:
[self zeroStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
"pop bogus machine-code instructionPointer, arguments and receiver"
self pop: argumentCount + 2 thenPush: result.
cogit ceInvokeInterpret
"NOTREACHED"].
"If not, work out where we are and continue"
theFrame := self frameOfMarriedContext: activeContext.
thePage := stackPages stackPageFor: theFrame.
self assert: thePage headFP = theFrame.
self setStackPageAndLimit: thePage.
self setStackPointersFromPage: thePage.
instructionPointer := self popStack.
self pop: argumentCount + 1 thenPush: result!
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:.
(objectMemory literalCountOf: methodObj) > 0 ifFalse:
[^#primitiveExternalCall].
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].
+ index := objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit.
- index := objectMemory fetchPointer: 3 ofObject: lit.
((objectMemory isIntegerObject: index)
and: [(index := objectMemory integerValueOf: index) > 0
and: [index <= MaxExternalPrimitiveTableSize]]) ifFalse:
[^#primitiveExternalCall].
functionPointer := externalPrimitiveTable at: index - 1.
functionPointer = 0 ifTrue:
[^#primitiveExternalCall].
^functionPointer!
Item was removed:
- ----- 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 == #primitiveCalloutToFFI ifTrue:
- [^self functionForPrimitiveCallout].
- functionPointer == #primitiveExternalCall ifTrue:
- [^self functionForPrimitiveExternalCall: methodObj].
- ^functionPointer!
Item was added:
+ ----- Method: CoInterpreter>>functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: (in category 'cog jit support') -----
+ functionPointerForCompiledMethod: methodObj primitiveIndex: primitiveIndex primitivePropertyFlagsInto: flagsPtr
+ <api>
+ <returnTypeC: 'void (*functionPointerForCompiledMethodprimitiveIndexprimitivePropertyFlagsInto(sqInt methodObj, sqInt primitiveIndex, sqInt *flagsPtr))(void)'>
+ | functionPointer |
+ <var: #functionPointer declareC: #'void (*functionPointer)(void)'>
+ flagsPtr ifNotNil:
+ [flagsPtr at: 0 put: (self primitivePropertyFlags: primitiveIndex)].
+ functionPointer := self functionPointerFor: primitiveIndex inClass: nil.
+ functionPointer == #primitiveCalloutToFFI ifTrue:
+ [^self functionForPrimitiveCallout].
+ functionPointer == #primitiveExternalCall ifTrue:
+ [| lit |
+ lit := self attemptToLinkExternalPrimitive: methodObj.
+ "N.B. We only support the FastCPrimitiveFlag on Spur because Spur
+ will *not* run a GC to satisfy an allocation in a primitive. The V3
+ ObjectMemory will and hence the depth of stack needed in a V3
+ primitive is probably too large to safely execute on a stack page."
+ objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [| flags shiftedMetadataFlags |
+ flags := objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit.
+ (objectMemory isIntegerObject: flags) ifTrue:
+ [shiftedMetadataFlags := ((objectMemory integerValueOf: flags) bitAnd: 16rFF) bitShift: PrimitiveMetadataFlagsShift.
+ flagsPtr at: 0 put: ((flagsPtr at: 0) bitOr: shiftedMetadataFlags)]].
+ ^self functionForPrimitiveExternalCall: methodObj].
+ ^functionPointer!
Item was added:
+ ----- Method: CoInterpreter>>isExternalMethodInPlugin: (in category 'plugin primitive support') -----
+ isExternalMethodInPlugin: methodObj
+ | header primIdx literal |
+ header := objectMemory methodHeaderOf: methodObj.
+ primIdx := self primitiveIndexOfMethod: methodObj header: header.
+ ^primIdx = PrimNumberExternalCall
+ and: [(objectMemory literalCountOfMethodHeader: header) > 0
+ and: [(objectMemory isArray: (literal := self literal: 0 ofMethod: methodObj))
+ and: [(objectMemory numSlotsOf: literal) = 4
+ and: [(objectMemory isBytes: (objectMemory fetchPointer: ExternalCallLiteralModuleNameIndex ofObject: literal))
+ and: [(objectMemory numBytesOf: (objectMemory fetchPointer: ExternalCallLiteralModuleNameIndex ofObject: literal)) > 0]]]]] "A 0 byte module name implies a primitive in the main VM; these can't change"!
Item was added:
+ ----- Method: CoInterpreter>>isLinkedExternalPrimitive: (in category 'plugin primitive support') -----
+ isLinkedExternalPrimitive: methodObj
+ | header primIdx literal targetFunctionIndex |
+ header := objectMemory methodHeaderOf: methodObj.
+ primIdx := self primitiveIndexOfMethod: methodObj header: header.
+ ^primIdx = PrimNumberExternalCall
+ and: [(objectMemory literalCountOfMethodHeader: header) > 0
+ and: [(objectMemory isArray: (literal := self literal: 0 ofMethod: methodObj))
+ and: [(objectMemory numSlotsOf: literal) = 4
+ and: [targetFunctionIndex := objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: literal.
+ (objectMemory isIntegerObject: targetFunctionIndex)
+ and: [(objectMemory integerValueOf: targetFunctionIndex) > 0]]]]] "A 0 byte module name implies a primitive in the main VM; these can't change"!
Item was added:
+ ----- Method: CoInterpreter>>isMachineCodeFrameForExternalPrimitiveMethod: (in category 'plugin primitive support') -----
+ isMachineCodeFrameForExternalPrimitiveMethod: theFP
+ <var: #theFP type: #'char *'>
+ | homeMethod |
+ ^(self isMachineCodeFrame: theFP)
+ and: [(cogit cogMethodHasMachineCodePrim: (homeMethod := self mframeHomeMethod: theFP))
+ and: [self isExternalMethodInPlugin: homeMethod methodObject]]!
Item was added:
+ ----- Method: CoInterpreter>>isMachineCodeFrameWithCogMethod: (in category 'plugin primitive support') -----
+ isMachineCodeFrameWithCogMethod: theFP
+ <var: #theFP type: #'char *'>
+ ^(self isMachineCodeFrame: theFP)
+ and: [cogit cogMethodHasMachineCodePrim: (self mframeHomeMethod: theFP)]!
Item was added:
+ ----- Method: CoInterpreter>>mapToBytecodePCIfActivationOfExternalMethod: (in category 'plugin primitive support') -----
+ mapToBytecodePCIfActivationOfExternalMethod: ctxtObj
+ (self isExternalMethodInPlugin: (objectMemory fetchPointer: MethodIndex ofObject: ctxtObj)) ifTrue:
+ [(self isMarriedOrWidowedContext: ctxtObj) ifTrue:
+ [(self asserta: (self isWidowedContext: ctxtObj)) ifTrue:
+ [^self]].
+ self ensureContextHasBytecodePC: ctxtObj]!
Item was added:
+ ----- Method: CoInterpreter>>nilLocalFP (in category 'debug support') -----
+ nilLocalFP
+ <doNotGenerate>
+ "For use *ONLY* by handleCallOrJumpSimulationTrap:. Nil
+ localFP so that the head frame can be determined reliably."
+ localFP := nil!
Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlagsForSpur: (in category 'cog jit support') -----
primitivePropertyFlagsForSpur: primIndex
<inline: true>
"Answer any special requirements of the given primitive. Spur always needs to set
primitiveFunctionPointer and newMethod so primitives can retry on failure due to forwarders."
| baseFlags |
self cCode: [] inSmalltalk: [#(mcprimHashMultiply: primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
primIndex = PrimNumberHashMultiply ifTrue:
[^PrimCallOnSmalltalkStack].
baseFlags := PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod.
profileSemaphore ~= objectMemory nilObject ifTrue:
[baseFlags := baseFlags bitOr: PrimCallCollectsProfileSamples].
+ (self isCalloutPrimitiveIndex: primIndex) "For callbacks & module unloading"
+ ifTrue: [baseFlags := baseFlags bitOr: PrimCallMayEndureCodeCompaction + PrimCallIsExternalCall]
+ ifFalse:
+ [(self isCodeCompactingPrimitiveIndex: primIndex) ifTrue: "For code reclamations"
+ [baseFlags := baseFlags bitOr: PrimCallMayEndureCodeCompaction]].
- ((self isCalloutPrimitiveIndex: primIndex) "For callbacks"
- or: [self isCodeCompactingPrimitiveIndex: primIndex]) ifTrue: "For code reclamations"
- [baseFlags := baseFlags bitOr: PrimCallMayEndureCodeCompaction].
^baseFlags!
Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlagsForV3: (in category 'cog jit support') -----
primitivePropertyFlagsForV3: primIndex
<inline: true>
"Answer any special requirements of the given primitive"
| baseFlags |
baseFlags := profileSemaphore ~= objectMemory nilObject
ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
ifFalse: [0].
longRunningPrimitiveCheckSemaphore ifNotNil:
[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod].
+ (self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks & module unloading"
+ [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayEndureCodeCompaction + PrimCallIsExternalCall].
- (self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks"
- [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayEndureCodeCompaction].
(self isCodeCompactingPrimitiveIndex: primIndex) ifTrue:
[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction].
^baseFlags!
Item was removed:
- ----- 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)']
- ifFalse: [localPrimAddress])].
- (methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue:
- [methodCache
- at: lastMethodCacheProbeWrite + MethodCachePrimFunction
- put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')]!
Item was added:
+ ----- Method: CoInterpreter>>validExternalStackPointers (in category 'debug support') -----
+ validExternalStackPointers
+ <doNotGenerate>
+ ^framePointer < stackPage baseAddress
+ and: [stackPointer < framePointer
+ and: [framePointer > stackPointer
+ and: [stackPointer >= (stackPage realStackLimit - self stackLimitOffset)]]]!
Item was changed:
----- Method: CoInterpreterPrimitives>>primitiveFlushCacheByMethod (in category 'system control primitives') -----
primitiveFlushCacheByMethod
"The receiver is a compiledMethod. Clear all entries in the method lookup cache that
refer to this method, presumably because it has been redefined, overridden or removed.
+ Override to flush the appropriate machine code state."
+ self primitiveVoidVMStateForMethod!
- Override to flush appropriate machine code caches also."
- super primitiveFlushCacheByMethod.
- cogit unlinkSendsTo: self stackTop andFreeIf: false!
Item was changed:
----- Method: CogARMv8Compiler>>concretizePrefetchAw (in category 'generate machine code - concretize') -----
concretizePrefetchAw
"Will get inlined into concretizeAt: switch."
<inline: true>
| srcAddr |
srcAddr := operands at: 0.
(self isAddressRelativeToVarBase: srcAddr) ifTrue:
[srcAddr < cogit varBaseAddress ifTrue:
[self shouldBeImplemented.
^4].
machineCode
at: 0
put: (self prn: VarBaseReg imm: srcAddr - cogit varBaseAddress shiftBy12: false).
^4].
+ "cogit processor disassembleInstructionAt: 0 In: machineCode object"
self halt.
^0!
Item was added:
+ ----- Method: CogARMv8Compiler>>instructionIsBR: (in category 'generate machine code - support') -----
+ instructionIsBR: word
+ <var: 'word' type: #usqInt>
+ <inline: true>
+ ^(word bitOr: 31 << 5) = 2r11010110000111110000001111100000!
Item was changed:
----- Method: CogARMv8Compiler>>isCallPrecedingReturnPC: (in category 'testing') -----
isCallPrecedingReturnPC: mcpc
"Assuming mcpc is a send return pc answer if the instruction before it is a call (not a CallFull)."
"There are two types of calls: BL & BLR; BLR is used for CallFull"
+ | instruction |
+ instruction := self instructionBeforeAddress: mcpc.
+ ^(self instructionIsBL: instruction) or: [self instructionIsBLR: instruction]!
- ^self instructionIsBL: (self instructionBeforeAddress: mcpc)!
Item was added:
+ ----- Method: CogARMv8Compiler>>isFullJumpAtPC: (in category 'testing') -----
+ isFullJumpAtPC: mcpc
+ ^self instructionIsBR: (objectMemory long32At: mcpc)!
Item was changed:
----- Method: CogARMv8Compiler>>prn:imm:shiftBy12: (in category 'generate machine code - support') -----
prn: baseReg imm: offset shiftBy12: shiftBy12
"C6.2.211 PRFM (immediate) C6-1136"
"Unsigned offset, C6-1136"
+ "This is the only case we can make use of so far..."
- "This is the only casde we can make use of so far..."
self assert: (offset \\ 8 = 0
and: [offset / 8 between: 0 and: 1 << 12 - 1]).
+ ^2r1111100110 << 22
- ^2r1111100101 << 22
+ (offset << 7 "10 - 3")
+ (baseReg << 5)
+ 0 "prfop = PLD:L1:KEEP"!
Item was changed:
SharedPool subclass: #CogMethodConstants
instanceVariableNames: ''
+ classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallIsExternalCall PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction PrimCallOnSmalltalkStack ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
- classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction PrimCallOnSmalltalkStack ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
poolDictionaries: ''
category: 'VMMaker-JIT'!
Item was changed:
----- Method: CogMethodZone>>clearCogCompiledCode (in category 'jit - api') -----
clearCogCompiledCode
+ "Free all methods. Do it the slow way to keep methodBytesFreedSinceLastCompaction accurate."
+ <inline: true>
- "Free all methods"
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
NewspeakVM ifTrue: [unpairedMethodList := nil].
cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod asUnsignedInteger < mzFreeStart] whileTrue:
[cogMethod cmType = CMMethod ifTrue:
[self freeMethod: cogMethod].
cogMethod := self methodAfter: cogMethod].
self manageFrom: baseAddress to: limitAddress!
Item was changed:
----- Method: CogMethodZone>>cogMethodContaining: (in category 'jit - api') -----
cogMethodContaining: mcpc
"Answer the method containing mcpc for the purposes of code zone compaction,
where mcpc is actually the value of instructionPointer at the time of a compaction."
<var: 'mcpc' type: #usqInt>
<api>
| cogMethod prevMethod |
mcpc > limitAddress ifTrue:
[^nil].
mcpc < baseAddress ifTrue:
[cogit assertMcpcIsPrimReturn: mcpc.
^nil].
self assert: mcpc < self freeStart.
cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod asUnsignedInteger < mcpc] whileTrue:
[prevMethod := cogMethod.
cogMethod := self methodAfter: cogMethod].
"Since mcpc is actually instructionPointer we expect that it is either at the stack check
(normal code zone reclamation invoked through checkForEventsMayContextSwitch:)
or is in a primitive, immediately following the call of the C primitive routine."
self assert: (prevMethod notNil
and: [mcpc = (prevMethod asUnsignedInteger + prevMethod stackCheckOffset)
or: [(self mcpc: mcpc isAtStackCheckOfBlockMethodIn: prevMethod)
+ or: [(coInterpreter
+ primitiveIndexOfMethod: prevMethod methodObject
+ header: prevMethod methodHeader) > 0
or: [(cogit backEnd isCallPrecedingReturnPC: mcpc)
+ and: [(cogit backEnd callTargetFromReturnAddress: mcpc) = cogit ceCheckForInterruptTrampoline]]]]]).
- and: [(coInterpreter
- primitiveIndexOfMethod: prevMethod methodObject
- header: prevMethod methodHeader) > 0
- or: [(cogit backEnd callTargetFromReturnAddress: mcpc) = cogit ceCheckForInterruptTrampoline]]]]]).
^prevMethod!
Item was removed:
- ----- Method: CogVMSimulator>>flushExternalPrimitives (in category 'plugin support') -----
- flushExternalPrimitives
- self initializePluginEntries.
- super flushExternalPrimitives!
Item was removed:
- ----- Method: CogVMSimulator>>functionPointerForCompiledMethod:primitiveIndex: (in category 'cog jit support') -----
- functionPointerForCompiledMethod: methodObj primitiveIndex: primIndex
- ^self mapFunctionToAddress: (super functionPointerForCompiledMethod: methodObj primitiveIndex: primIndex)!
Item was added:
+ ----- Method: CogVMSimulator>>functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: (in category 'cog jit support') -----
+ functionPointerForCompiledMethod: methodObj primitiveIndex: primIndex primitivePropertyFlagsInto: flagsPtr
+ ^self mapFunctionToAddress: (super functionPointerForCompiledMethod: methodObj primitiveIndex: primIndex primitivePropertyFlagsInto: flagsPtr)!
Item was added:
+ ----- Method: CogVMSimulator>>hasFastCLinkage: (in category 'plugin primitive support') -----
+ hasFastCLinkage: methodObj
+ "Simulation only!!!! the attempt to look up is entirely inappropriate for the real VM!!!!"
+ | header primIdx literal metadata |
+ objectMemory hasSpurMemoryManagerAPI ifFalse:
+ [^false].
+ header := objectMemory methodHeaderOf: methodObj.
+ primIdx := self primitiveIndexOfMethod: methodObj header: header.
+ (primIdx = PrimNumberExternalCall
+ and: [(objectMemory literalCountOfMethodHeader: header) > 0
+ and: [(objectMemory isArray: (literal := self literal: 0 ofMethod: methodObj))
+ and: [(objectMemory numSlotsOf: literal) = 4]]]) ifFalse:
+ [^false].
+ (objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: literal) ~= (objectMemory integerObjectOf: 0) ifTrue:
+ [^FastCPrimitiveFlag anyMask: (objectMemory integerValueOf: (objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: literal))].
+ ^(self ioLoadFunction: (self stringOf: (objectMemory fetchPointer: ExternalCallLiteralFunctionNameIndex ofObject: literal))
+ From: (self stringOf: (objectMemory fetchPointer: ExternalCallLiteralModuleNameIndex ofObject: literal))
+ MetadataInto: (self addressOf: metadata put: [:v| metadata := v])) ~= 0
+ and: [FastCPrimitiveFlag anyMask: metadata]!
Item was changed:
----- Method: CogVMSimulator>>initializePluginEntries (in category 'plugin support') -----
+ initializePluginEntries
- initializePluginEntries.
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
+ [pluginList := {'' -> self }].
+ cogit flushPluginEntriesFor: #tryLoadNewPlugin:pluginEntries:!
- [pluginList := {'' -> self }]!
Item was added:
+ ----- Method: CogVMSimulator>>ioListBuiltinModule: (in category 'simulation support') -----
+ ioListBuiltinModule: index
+ ^index > 0 ifTrue:
+ [(InitializationOptions
+ at: #builtinModules
+ ifAbsent: [#('BitBltPlugin' 'FloatArrayPlugin' 'FloatMathPlugin' 'LargeIntegers' 'MiscPrimitivePlugin')]) at: index ifAbsent: nil]!
Item was added:
+ ----- Method: CogVMSimulator>>ioListLoadedModule: (in category 'simulation support') -----
+ ioListLoadedModule: index
+ ^index > 0 ifTrue: [(pluginList at: index + 1 ifAbsent: [^nil]) key]!
Item was removed:
- ----- Method: CogVMSimulator>>ioLoadFunction:From:AccessorDepthInto: (in category 'plugin support') -----
- ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr
- "Load and return the requested function from a module.
- Assign the accessor depth through accessorDepthPtr.
- N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
- | firstTime plugin fnSymbol |
- firstTime := false.
- fnSymbol := functionString asSymbol.
- transcript
- cr;
- show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
- (pluginString isEmpty ifTrue: ['vm'] ifFalse: [pluginString]).
- (breakSelector notNil
- and: [(pluginString size = breakSelector size
- and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0])
- or: [functionString size = breakSelector size
- and: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
- [self halt: pluginString, '>>', functionString].
- plugin := pluginList
- detect: [:any| any key = pluginString asString]
- ifNone:
- [firstTime := true.
- self loadNewPlugin: pluginString].
- plugin ifNil:
- [firstTime ifTrue: [transcript cr; show: '... FAILED; primitive not in plugin'].
- ^0].
- plugin := plugin value.
- mappedPluginEntries withIndexDo:
- [:pluginAndName :index|
- ((pluginAndName at: 1) == plugin
- and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
- [firstTime ifTrue: [transcript show: ' ... okay'].
- accessorDepthPtr at: 0 put: (pluginAndName at: 4).
- ^index]].
- firstTime ifTrue: [transcript cr; show: '... FAILED; primitive not in plugin'].
- ^0!
Item was added:
+ ----- Method: CogVMSimulator>>ioLoadFunction:From:MetadataInto: (in category 'plugin support') -----
+ ioLoadFunction: functionString From: pluginString MetadataInto: metadataPtr
+ "Load and return the requested function from a module.
+ Assign the accessor depth and flags through metadataPtr.
+ N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
+ | firstTime plugin fnSymbol |
+ firstTime := false.
+ fnSymbol := functionString asSymbol.
+ transcript
+ cr;
+ show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
+ (pluginString isEmpty ifTrue: ['vm'] ifFalse: [pluginString]).
+ (breakSelector notNil
+ and: [(pluginString size = breakSelector size
+ and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0])
+ or: [functionString size = breakSelector size
+ and: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
+ [self halt: pluginString, '>>', functionString].
+ plugin := pluginList
+ detect: [:any| any key = pluginString asString]
+ ifNone:
+ [firstTime := true.
+ self loadNewPlugin: pluginString].
+ plugin ifNil:
+ [firstTime ifTrue: [transcript cr; show: '... FAILED; primitive not in plugin'].
+ ^0].
+ plugin := plugin value.
+ mappedPluginEntries withIndexDo:
+ [:pluginAndName :index|
+ ((pluginAndName at: 1) == plugin
+ and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
+ [firstTime ifTrue: [transcript show: ' ... okay'].
+ metadataPtr at: 0 put: (pluginAndName at: 4).
+ ^index]].
+ firstTime ifTrue: [transcript cr; show: '... FAILED; primitive not in plugin'].
+ ^0!
Item was changed:
CogClass subclass: #Cogit
(excessive size, no diff calculated)
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 checkValidOopReference: 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: #checkIfValidOopRefAndTarget:pc:cogMethod:
+ arg: cogMethod) = 0)) ifFalse:
- arg: cogMethod asInteger) = 0)) ifFalse:
[ok := false]].
(cogMethod cmType = CMMethod
and: [(NewspeakVM or: [SistaVM])
and: [objectRepresentation canPinObjects]]) ifTrue:
[(SistaVM and: [cogMethod counters ~= 0]) ifTrue:
[(self asserta: (objectRepresentation checkValidDerivedObjectReference: cogMethod counters)) ifFalse:
[ok := false]].
(NewspeakVM and: [cogMethod nextMethodOrIRCs ~= 0]) ifTrue:
[(cogMethod nextMethodOrIRCs > methodZone zoneEnd) ifTrue:
[(self asserta: (objectRepresentation checkValidDerivedObjectReference: cogMethod nextMethodOrIRCs)) 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>>checkIfValidOopRef:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidOopRef: annotation pc: mcpc cogMethod: cogMethod
"Check for a valid object reference, if any, at a map entry. Answer a code unique to each error for debugging."
<var: #mcpc type: #'char *'>
+ <var: #cogMethod type: #'CogMethod *'>
+
<var: #nsSendCache type: #'NSSendCache *'>
annotation = IsObjectReference ifTrue:
[| literal |
literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation checkValidOopReference: literal) ifFalse:
[coInterpreter print: 'object ref leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache enclosingObject |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
[(objectRepresentation checkValidOopReference: nsSendCache selector) ifFalse:
[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]].
(enclosingObject := nsSendCache enclosingObject) ~= 0 ifTrue:
[[(objectRepresentation checkValidOopReference: enclosingObject) ifFalse:
[coInterpreter print: 'enclosing object leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]]]]].
(self isPureSendAnnotation: annotation) ifTrue:
[| entryPoint selectorOrCacheTag offset |
entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint <= methodZoneBase
ifTrue:
[offset := entryPoint]
ifFalse:
[self
offsetAndSendTableFor: entryPoint
annotation: annotation
into: [:off :table| offset := off]].
selectorOrCacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
(entryPoint > methodZoneBase
and: [offset ~= cmNoCheckEntryOffset
and: [(self cCoerceSimple: entryPoint - offset to: #'CogMethod *') cmType ~= CMOpenPIC]])
ifTrue: "linked non-super send, cacheTag is a cacheTag"
[(objectRepresentation validInlineCacheTag: selectorOrCacheTag) ifFalse:
[coInterpreter print: 'cache tag leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]]
ifFalse: "unlinked send or super send; cacheTag is a selector unless 64-bit, in which case it is an index."
[(self inlineCacheTagsAreIndexes
or: [objectRepresentation checkValidOopReference: selectorOrCacheTag]) ifFalse:
[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>checkIntegrityOfObjectReferencesInCode: (in category 'debugging') -----
checkIntegrityOfObjectReferencesInCode: gcModes
<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:
[coInterpreter print: 'young referrer CM '; printHex: cogMethod asInteger.
count = 0
ifTrue: [coInterpreter print: ' is not in youngReferrers'; cr]
ifFalse: [coInterpreter print: ' is in youngReferrers '; printNum: count; print: ' times!!'; cr].
ok := false]].
(objectRepresentation checkValidOopReference: cogMethod selector) ifFalse:
[coInterpreter 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:
[coInterpreter print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' methodObject'; cr.
ok := false].
(objectMemory isOopCompiledMethod: cogMethod methodObject) ifFalse:
[coInterpreter print: 'non-method in CM '; printHex: cogMethod asInteger; print: ' methodObject'; cr.
ok := false].
(self mapFor: cogMethod
performUntil: #checkIfValidOopRef:pc:cogMethod:
+ arg: cogMethod) ~= 0
- arg: cogMethod asInteger) ~= 0
ifTrue: [ok := false].
(objectRepresentation hasSpurMemoryManagerAPI
or: [gcModes anyMask: GCModeNewSpace]) ifTrue:
[(((objectMemory isYoungObject: cogMethod methodObject)
or: [objectMemory isYoung: cogMethod selector])
and: [cogMethod cmRefersToYoung not]) ifTrue:
[coInterpreter 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: #checkIfValidOopRef:pc:cogMethod:
+ arg: cogMethod) ~= 0
- arg: cogMethod asInteger) ~= 0
ifTrue: [ok := false]]]]].
cogMethod := methodZone methodAfter: cogMethod].
^ok!
Item was changed:
----- Method: Cogit>>compileCogFullBlockMethod: (in category 'compile abstract instructions') -----
compileCogFullBlockMethod: numCopied
<returnTypeC: #'CogMethod *'>
<option: #SistaV1BytecodeSet>
| numBytecodes numBlocks numCleanBlocks result |
self setHasMovableLiteral: false.
self setHasYoungReferent: (objectMemory isYoungObject: methodObj).
methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
inBlock := InFullBlock.
- postCompileHook := nil.
maxLitIndex := -1.
self assert: (coInterpreter primitiveIndexOf: methodObj) = 0.
initialPC := coInterpreter startPCOfMethod: methodObj.
"initial estimate. Actual endPC is determined in scanMethod."
endPC := objectMemory numBytesOf: methodObj.
numBytecodes := endPC - initialPC + 1.
primitiveIndex := 0.
self allocateOpcodes: (numBytecodes + 10) * self estimateOfAbstractOpcodesPerBytecodes
bytecodes: numBytecodes
ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
self flag: #TODO. "currently copiedValue access implies frameful method, this is suboptimal"
(numBlocks := self scanMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
self assert: numBlocks = 0. "blocks in full blocks are full blocks, they are not inlined."
numCleanBlocks := self scanForCleanBlocks.
self assert: numCleanBlocks = 0. "blocks in full blocks are full blocks, they are not inlined."
self allocateBlockStarts: numBlocks + numCleanBlocks.
blockCount := 0.
numCleanBlocks > 0 ifTrue:
[self addCleanBlockStarts].
(self maybeAllocAndInitCounters
and: [self maybeAllocAndInitIRCs]) ifFalse: "Inaccurate error code, but it'll do. This will likely never fail."
[^coInterpreter cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
blockEntryLabel := nil.
methodLabel dependent: nil.
(result := self compileEntireFullBlockMethod: numCopied) < 0 ifTrue:
[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
^self generateCogFullBlock!
Item was changed:
----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
compileCogMethod: selector
<returnTypeC: #'CogMethod *'>
| numBytecodes numBlocks numCleanBlocks result extra |
self setHasMovableLiteral: false.
self setHasYoungReferent: ((objectMemory isYoungObject: methodObj)
or: [objectMemory isYoung: selector]).
methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
inBlock := 0.
- postCompileHook := nil.
maxLitIndex := -1.
extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
ifTrue: [30]
ifFalse: [10].
initialPC := coInterpreter startPCOfMethod: methodObj.
"initial estimate. Actual endPC is determined in scanMethod."
endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
ifTrue: [initialPC - 1]
ifFalse: [objectMemory numBytesOf: methodObj].
numBytecodes := endPC - initialPC + 1.
self allocateOpcodes: (numBytecodes + extra) * self estimateOfAbstractOpcodesPerBytecodes
bytecodes: numBytecodes
ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
(numBlocks := self scanMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
numCleanBlocks := self scanForCleanBlocks.
self methodFoundInvalidPostScan ifTrue:
[^coInterpreter cCoerceSimple: ShouldNotJIT to: #'CogMethod *'].
self allocateBlockStarts: numBlocks + numCleanBlocks.
blockCount := 0.
numCleanBlocks > 0 ifTrue:
[self addCleanBlockStarts].
(self maybeAllocAndInitCounters
and: [self maybeAllocAndInitIRCs]) ifFalse: "Inaccurate error code, but it'll do. This will likely never fail."
[^coInterpreter cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
blockEntryLabel := nil.
methodLabel dependent: nil.
(result := self compileEntireMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
^self generateCogMethod: selector!
Item was added:
+ ----- Method: Cogit>>flushPluginEntriesFor: (in category 'simulation only') -----
+ flushPluginEntriesFor: aSelector
+ (simulatedTrampolines keys select:
+ [:k|
+ (simulatedTrampolines at: k) isBlock
+ and: [(simulatedTrampolines at: k) home selector == aSelector]]) do:
+ [:k| simulatedTrampolines removeKey: k]!
Item was changed:
----- Method: Cogit>>followForwardedLiteralsIn: (in category 'garbage collection') -----
followForwardedLiteralsIn: cogMethod
<api>
<option: #SpurObjectMemory>
<var: #cogMethod type: #'CogMethod *'>
| writableCogMethod hasYoungObj hasYoungObjPtr |
self assert: (cogMethod cmType ~= CMMethod or: [(objectMemory isForwarded: cogMethod methodObject) not]).
writableCogMethod := self writableMethodFor: cogMethod.
self ensureWritableCodeZone.
hasYoungObj := objectMemory isYoung: cogMethod methodObject.
(objectMemory shouldRemapOop: cogMethod selector) ifTrue:
[writableCogMethod selector: (objectMemory remapObj: cogMethod selector).
(objectMemory isYoung: cogMethod selector) ifTrue:
[hasYoungObj := true]].
hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
self mapFor: cogMethod
performUntil: #remapIfObjectRef:pc:hasYoung:
+ arg: hasYoungObjPtr asVoidPointer.
- arg: hasYoungObjPtr.
hasYoungObj
ifTrue: [methodZone ensureInYoungReferrers: cogMethod]
ifFalse: [writableCogMethod cmRefersToYoung: false].
self ensureExecutableCodeZone!
Item was changed:
----- Method: Cogit>>gen: (in category 'compile abstract instructions') -----
gen: opcode "<Integer>"
| abstractInstruction |
<inline: false>
<returnTypeC: #'AbstractInstruction *'>
<var: #abstractInstruction type: #'AbstractInstruction *'>
self assert: opcodeIndex < numAbstractOpcodes.
abstractInstruction := self abstractInstructionAt: opcodeIndex.
opcodeIndex := opcodeIndex + 1.
abstractInstruction opcode: opcode.
+ self cCode: '' inSmalltalk:
+ [abstractInstruction bcpc: bytecodePC.
+ self maybeBreakGeneratingInstructionWithIndex: opcodeIndex - 1].
- self cCode: '' inSmalltalk: [abstractInstruction bcpc: bytecodePC].
^abstractInstruction!
Item was changed:
----- Method: Cogit>>gen:operand: (in category 'compile abstract instructions') -----
gen: opcode "<Integer>" operand: operand "<Integer|CogAbstractInstruction>"
| abstractInstruction |
<inline: false>
<returnTypeC: #'AbstractInstruction *'>
<var: #abstractInstruction type: #'AbstractInstruction *'>
self assert: opcodeIndex < numAbstractOpcodes.
abstractInstruction := self abstractInstructionAt: opcodeIndex.
opcodeIndex := opcodeIndex + 1.
abstractInstruction opcode: opcode.
abstractInstruction operands at: 0 put: operand.
+ self cCode: '' inSmalltalk:
+ [abstractInstruction bcpc: bytecodePC.
+ self maybeBreakGeneratingInstructionWithIndex: opcodeIndex - 1].
- self cCode: '' inSmalltalk: [abstractInstruction bcpc: bytecodePC].
^abstractInstruction!
Item was changed:
----- Method: Cogit>>gen:operand:operand: (in category 'compile abstract instructions') -----
gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>" operand: operandTwo "<Integer|CogAbstractInstruction>"
| abstractInstruction |
<inline: false>
<returnTypeC: #'AbstractInstruction *'>
<var: #abstractInstruction type: #'AbstractInstruction *'>
self assert: opcodeIndex < numAbstractOpcodes.
abstractInstruction := self abstractInstructionAt: opcodeIndex.
opcodeIndex := opcodeIndex + 1.
abstractInstruction opcode: opcode.
abstractInstruction operands at: 0 put: operandOne.
abstractInstruction operands at: 1 put: operandTwo.
+ self cCode: '' inSmalltalk:
+ [abstractInstruction bcpc: bytecodePC.
+ self maybeBreakGeneratingInstructionWithIndex: opcodeIndex - 1].
- self cCode: '' inSmalltalk: [abstractInstruction bcpc: bytecodePC].
^abstractInstruction!
Item was changed:
----- Method: Cogit>>gen:operand:operand:operand: (in category 'compile abstract instructions') -----
gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>" operand: operandTwo "<Integer|CogAbstractInstruction>" operand: operandThree "<Integer|CogAbstractInstruction>"
| abstractInstruction |
<inline: false>
<returnTypeC: #'AbstractInstruction *'>
<var: #abstractInstruction type: #'AbstractInstruction *'>
self assert: opcodeIndex < numAbstractOpcodes.
abstractInstruction := self abstractInstructionAt: opcodeIndex.
opcodeIndex := opcodeIndex + 1.
abstractInstruction opcode: opcode.
abstractInstruction operands at: 0 put: operandOne.
abstractInstruction operands at: 1 put: operandTwo.
abstractInstruction operands at: 2 put: operandThree.
+ self cCode: '' inSmalltalk:
+ [abstractInstruction bcpc: bytecodePC.
+ self maybeBreakGeneratingInstructionWithIndex: opcodeIndex - 1].
- self cCode: '' inSmalltalk: [abstractInstruction bcpc: bytecodePC].
^abstractInstruction!
Item was added:
+ ----- Method: Cogit>>genExternalizeStackPointerForFastPrimitiveCall (in category 'trampoline support') -----
+ genExternalizeStackPointerForFastPrimitiveCall
+ backEnd hasLinkRegister
+ ifTrue: [self MoveR: SPReg Aw: coInterpreter stackPointerAddress]
+ ifFalse:
+ [self AddCq: objectRepresentation wordSize R: SPReg R: TempReg.
+ self MoveR: TempReg Aw: coInterpreter stackPointerAddress]!
Item was changed:
----- Method: Cogit>>generateCogFullBlock (in category 'generate machine code') -----
generateCogFullBlock
"We handle jump sizing simply. First we make a pass that asks each
instruction to compute its maximum size. Then we make a pass that
sizes jumps based on the maxmimum sizes. Then we make a pass
that fixes up jumps. When fixing up a jump the jump is not allowed to
choose a smaller offset but must stick to the size set in the second pass."
<returnTypeC: #'CogMethod *'>
<option: #SistaV1BytecodeSet>
| codeSize headerSize mapSize totalSize startAddress result method |
<var: #method type: #'CogMethod *'>
headerSize := self sizeof: CogMethod.
methodLabel address: methodZone freeStart.
self computeMaximumSizes.
methodLabel concretizeAt: methodZone freeStart.
codeSize := self generateInstructionsAt: methodLabel address + headerSize.
mapSize := self generateMapAt: nil start: methodLabel address + cbNoSwitchEntryOffset.
.
totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize.
totalSize > MaxMethodSize ifTrue:
[^self cCoerceSimple: MethodTooBig to: #'CogMethod *'].
startAddress := methodZone allocate: totalSize.
startAddress = 0 ifTrue:
[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
self assert: startAddress + cbEntryOffset = fullBlockEntry address.
self assert: startAddress + cbNoSwitchEntryOffset = fullBlockNoContextSwitchEntry address.
result := self outputInstructionsAt: startAddress + headerSize.
self assert: startAddress + headerSize + codeSize = result.
backEnd padIfPossibleWithStopsFrom: result to: startAddress + totalSize - mapSize - 1.
self generateMapAt: startAddress + totalSize - 1 start: startAddress + cbNoSwitchEntryOffset.
self flag: #TOCHECK. "It's not clear we want the same header than regular methods.
It could be of the same size, but maybe the cmType could be different and the selector could be ignored."
method := self writableMethodFor: startAddress.
self fillInMethodHeader: method size: totalSize selector: objectMemory nilObject.
method cpicHasMNUCaseOrCMIsFullBlock: true.
"This also implicitly flushes the read/write mapped dual zone to the read/execute zone."
backEnd flushICacheFrom: startAddress to: startAddress + totalSize.
+ ^self cCoerceSimple: startAddress to: #'CogMethod *'!
- method := self cCoerceSimple: startAddress to: #'CogMethod *'.
- postCompileHook ifNotNil:
- [self perform: postCompileHook with: method.
- postCompileHook := nil].
- ^method!
Item was changed:
----- Method: Cogit>>generateCogMethod: (in category 'generate machine code') -----
generateCogMethod: selector
"We handle jump sizing simply. First we make a pass that asks each
instruction to compute its maximum size. Then we make a pass that
sizes jumps based on the maxmimum sizes. Then we make a pass
that fixes up jumps. When fixing up a jump the jump is not allowed to
choose a smaller offset but must stick to the size set in the second pass."
<returnTypeC: #'CogMethod *'>
+ | codeSize headerSize mapSize totalSize startAddress result |
- | codeSize headerSize mapSize totalSize startAddress result method |
<var: #method type: #'CogMethod *'>
headerSize := self sizeof: CogMethod.
methodLabel address: methodZone freeStart.
self computeMaximumSizes.
methodLabel concretizeAt: methodZone freeStart.
codeSize := self generateInstructionsAt: methodLabel address + headerSize.
mapSize := self generateMapAt: nil start: methodLabel address + cmNoCheckEntryOffset.
totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize.
totalSize > MaxMethodSize ifTrue:
[^self cCoerceSimple: MethodTooBig to: #'CogMethod *'].
startAddress := methodZone allocate: totalSize.
startAddress = 0 ifTrue:
[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
self assert: startAddress + cmEntryOffset = entry address.
self assert: startAddress + cmNoCheckEntryOffset = noCheckEntry address.
result := self outputInstructionsAt: startAddress + headerSize.
self assert: startAddress + headerSize + codeSize = result.
backEnd padIfPossibleWithStopsFrom: result to: startAddress + totalSize - mapSize - 1.
self generateMapAt: startAddress + totalSize - 1 start: startAddress + cmNoCheckEntryOffset.
self fillInBlockHeadersAt: startAddress.
self fillInMethodHeader: (self writableMethodFor: startAddress)
size: totalSize
selector: selector.
"This also implicitly flushes the read/write mapped dual zone to the read/execute zone."
backEnd flushICacheFrom: startAddress to: startAddress + totalSize.
+ ^self cCoerceSimple: startAddress to: #'CogMethod *'!
- method := self cCoerceSimple: startAddress to: #'CogMethod *'.
- postCompileHook ifNotNil:
- [self perform: postCompileHook with: method.
- postCompileHook := nil].
- ^method!
Item was changed:
----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
+ | evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount retpc invalidStackPointersExpected |
- | evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount retpc |
"Execution of a single instruction must be within the processorLock critical section to ensure
simulation traps are executed atomically. However, at this point control is leaving machine
code and entering the run-time and hence the lock must be released."
processorLock primitiveExitCriticalSection.
"This is a hack fix before we revise the simulators. When a jump call is made, the next
pc is effectively the return address on the stack, not the instruction following the jump."
aProcessorSimulationTrap type == #jump ifTrue:
[processor hackFixNextPCOfJumpFor: aProcessorSimulationTrap using: objectMemory].
evaluable := simulatedTrampolines
at: aProcessorSimulationTrap address
ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
in: simulatedTrampolines].
function := evaluable isBlock
ifTrue: ['aBlock; probably some plugin primitive']
ifFalse:
[evaluable receiver == backEnd ifTrue: "this is for invoking ARMv5 floating-point intrinsics, and for the short-cut tracing trampolines"
[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
evaluable selector].
memory := coInterpreter memory.
function == #interpret ifTrue: "i.e. we're here via ceInvokeInterpret/ceReturnToInterpreterTrampoline and should discard all state back to enterSmalltalkExecutiveImplementation"
[self recordInstruction: {'(simulated jump call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
"self halt: evaluable selector."
clickConfirm ifTrue:
[(self confirm: 'skip jump to interpret?') ifFalse:
[clickConfirm := false. self halt]].
processor simulateJumpCallOf: aProcessorSimulationTrap address memory: memory.
coInterpreter reenterInterpreter.
"NOTREACHED"
self halt].
+ invalidStackPointersExpected := false.
function ~~ #ceBaseFrameReturn: ifTrue:
+ [evaluable isBlock
+ ifTrue: "external primitives..."
+ ["The only acceptable exception to the rule are fast C primitive calls..."
+ (methodZone cogMethodContaining: (self mostLikelyPrimInvocationPC: processor pc or: (processor leafRetpcIn: memory)))
+ ifNil: [self assertf: 'call to block evaluable from non-external method']
+ ifNotNil: [:cogMethod|
+ self assert: (self cogMethodHasExternalPrim: cogMethod).
+ (coInterpreter hasFastCLinkage: cogMethod methodObject)
+ ifTrue: [invalidStackPointersExpected := true. coInterpreter nilLocalFP]
+ ifFalse: [coInterpreter assertValidExternalStackPointers]]]
+ ifFalse:
+ [coInterpreter assertValidExternalStackPointers]].
- [coInterpreter assertValidExternalStackPointers].
processor
simulateCallOf: aProcessorSimulationTrap address
nextpc: aProcessorSimulationTrap nextpc
memory: memory.
retpc := processor retpcIn: memory.
self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
savedFramePointer := coInterpreter framePointer.
savedStackPointer := coInterpreter stackPointer.
savedArgumentCount := coInterpreter argumentCount.
result := ["self halt: evaluable selector."
clickConfirm ifTrue:
[(self confirm: 'skip run-time call?') ifFalse:
[clickConfirm := false. self halt]].
evaluable valueWithArguments: (processor
postCallArgumentsNumArgs: evaluable numArgs
in: memory)]
on: ReenterMachineCode
do: [:ex| ex return: #continueNoReturn].
+ invalidStackPointersExpected ifFalse:
+ [coInterpreter assertValidExternalStackPointers].
- coInterpreter assertValidExternalStackPointers.
"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
not called something that has built a frame, such as closure value or evaluate method, or
switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
(function beginsWith: 'primitive') ifTrue:
[coInterpreter primFailCode = 0
ifTrue: [(CogVMSimulator stackAlteringPrimitives includes: function) ifFalse:
["This is a rare case (e.g. in Scorch where a married context's sender is set to nil on trapTrpped and hence the stack layout is altered."
(function == #primitiveSlotAtPut and: [objectMemory isContext: (coInterpreter frameReceiver: coInterpreter framePointer)]) ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
= coInterpreter stackPointer]]]
ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer = coInterpreter stackPointer]].
result ~~ #continueNoReturn ifTrue:
[self recordInstruction: {'(simulated return to '. processor retpcIn: memory. ')'}.
processor simulateReturnIn: memory.
self assert: processor pc = retpc.
processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize].
self assert: (result isInteger "an oop result"
or: [result == coInterpreter
or: [result == objectMemory
or: [result == nil
or: [result == #continueNoReturn]]]]).
processor cResultRegister: (result
ifNil: [0]
ifNotNil: [result isInteger
ifTrue: [result]
ifFalse: [16rF00BA222]])!
Item was changed:
----- Method: Cogit>>mapFor:performUntil:arg: (in category 'method map') -----
mapFor: cogMethod performUntil: functionSymbol arg: arg
"Unlinking/GC/Disassembly support"
<var: #cogMethod type: #'CogMethod *'>
+ <var: #arg type: #'CogMethod *'> "most of the time arg is a CogMethod..."
+ <var: #functionSymbol declareC: 'sqInt (*functionSymbol)(sqInt annotation, char *mcpc, CogMethod *arg)'>
- <var: #functionSymbol declareC: 'sqInt (*functionSymbol)(sqInt annotation, char *mcpc, sqInt arg)'>
<inline: true>
| mcpc map mapByte annotation result |
mcpc := self firstMappedPCFor: cogMethod.
map := self mapStartFor: cogMethod.
self inlineCacheTagsAreIndexes ifTrue:
[enumeratingCogMethod := cogMethod].
[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue:
[mapByte >= FirstAnnotation
ifTrue:
[mcpc := mcpc + ((mapByte bitAnd: DisplacementMask) * backEnd codeGranularity).
"If this is an IsSendCall annotation, peek ahead for an IsAnnotationExtension, and consume it."
((annotation := mapByte >> AnnotationShift) = IsSendCall
and: [(mapByte := objectMemory byteAt: map - 1) >> AnnotationShift = IsAnnotationExtension]) ifTrue:
[annotation := annotation + (mapByte bitAnd: DisplacementMask).
map := map - 1].
result := self perform: functionSymbol
with: annotation
with: (self cCoerceSimple: mcpc to: #'char *')
with: arg.
result ~= 0 ifTrue:
[^result]]
ifFalse:
[mapByte < (IsAnnotationExtension << AnnotationShift) ifTrue:
[mcpc := mcpc + ((mapByte - DisplacementX2N << AnnotationShift) * backEnd codeGranularity)]].
map := map - 1].
^0!
Item was changed:
----- Method: Cogit>>mapObjectReferencesInMachineCodeForYoungGC (in category 'garbage collection') -----
mapObjectReferencesInMachineCodeForYoungGC
"Update all references to objects in machine code for either a Spur scavenging gc
or a Squeak V3 incremental GC. Avoid scanning all code by using the youngReferrers
list. In a young 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 zoneIsWritable |
codeModified := zoneIsWritable := hasYoungObj := false.
hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
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:
[| writableCogMethod |
self assert: (cogMethod cmType = CMMethod
or: [cogMethod cmType = CMOpenPIC]).
zoneIsWritable ifFalse:
[self ensureWritableCodeZone.
zoneIsWritable := true].
writableCogMethod := self writableMethodFor: cogMethod.
writableCogMethod selector: (objectRepresentation remapOop: cogMethod selector).
(objectMemory isYoung: cogMethod selector) ifTrue:
[hasYoungObj := true].
cogMethod cmType = CMMethod ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
writableCogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
(objectMemory isYoung: cogMethod methodObject) ifTrue:
[hasYoungObj := true]].
self mapFor: cogMethod
performUntil: #remapIfObjectRef:pc:hasYoung:
+ arg: hasYoungObjPtr asVoidPointer.
- arg: hasYoungObjPtr.
hasYoungObj
ifTrue: [hasYoungObj := false]
ifFalse: [writableCogMethod cmRefersToYoung: false]]].
pointer := pointer + objectMemory wordSize].
methodZone pruneYoungReferrers.
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
Item was changed:
----- Method: Cogit>>markAndTraceLiteralsIn: (in category 'garbage collection') -----
markAndTraceLiteralsIn: cogMethod
<option: #SpurObjectMemory>
"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
and: [objectMemory isMarked: cogMethod methodObject])
or: [cogMethod cmType = CMOpenPIC
and: [(objectMemory isImmediate: cogMethod selector)
or: [objectMemory isMarked: cogMethod selector]]]).
objectRepresentation
markAndTraceLiteral: cogMethod selector
in: cogMethod
at: (self addressOf: cogMethod selector put: [:val| cogMethod selector: val]).
self maybeMarkCountersIn: cogMethod.
self maybeMarkIRCsIn: cogMethod.
self mapFor: cogMethod
performUntil: #markLiterals:pc:method:
+ arg: cogMethod!
- arg: cogMethod asInteger!
Item was changed:
----- Method: Cogit>>markLiterals:pc:method: (in category 'garbage collection') -----
markLiterals: annotation pc: mcpc method: cogMethod
"Mark and trace literals.
Additionally in Newspeak, void push implicits that have unmarked classes."
<var: #mcpc type: #'char *'>
+ <var: #cogMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
| literal |
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
+ (objectRepresentation markAndTraceLiteral: literal in: cogMethod atpc: mcpc asUnsignedInteger) ifTrue:
- (objectRepresentation
- markAndTraceLiteral: literal
- in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
- atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache sel eo |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
sel := nsSendCache selector.
(objectMemory isForwarded: sel)
ifFalse: [objectMemory markAndTrace: sel]
ifTrue: [sel := objectMemory followForwarded: literal.
nsSendCache selector: sel.
self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
eo := nsSendCache enclosingObject.
eo ~= 0 ifTrue:
[(objectMemory isForwarded: eo)
ifFalse: [objectMemory markAndTrace: eo]
ifTrue: [eo := objectMemory followForwarded: literal.
nsSendCache enclosingObject: eo.
self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
(self isPureSendAnnotation: annotation) ifTrue:
[self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj |
+ (tagCouldBeObj
+ and: [objectRepresentation markAndTraceCacheTagLiteral: cacheTag in: cogMethod atpc: mcpc asUnsignedInteger]) ifTrue:
+ ["cacheTag is selector" codeModified := true]]].
- tagCouldBeObj ifTrue:
- [(objectRepresentation
- markAndTraceCacheTagLiteral: cacheTag
- in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
- atpc: mcpc asUnsignedInteger) ifTrue:
- ["cacheTag is selector" codeModified := true]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>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
in: cogMethod
at: (self addressOf: cogMethod selector put: [:val| cogMethod selector: val]).
self maybeMarkCountersIn: cogMethod.
self maybeMarkIRCsIn: cogMethod.
self mapFor: cogMethod
performUntil: #markLiteralsAndUnlinkIfUnmarkedSend:pc:method:
+ arg: cogMethod!
- arg: cogMethod asInteger!
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: #markYoungObjects:pc:method:
+ arg: cogMethod!
- arg: cogMethod asInteger!
Item was added:
+ ----- Method: Cogit>>mostLikelyPrimInvocationPC:or: (in category 'simulation support') -----
+ mostLikelyPrimInvocationPC: branchPC or: retPC
+ (branchPC > methodZoneBase and: [branchPC < methodZone freeStart]) ifTrue:
+ [^branchPC].
+ ^retPC!
Item was changed:
----- Method: Cogit>>relocateCallsAndSelfReferencesInMethod: (in category 'compaction') -----
relocateCallsAndSelfReferencesInMethod: cogMethod
<var: #cogMethod type: #'CogMethod *'>
| refDelta callDelta |
refDelta := cogMethod objectHeader.
callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
self assert: (cogMethod cmType = CMMethod or: [cogMethod cmType = CMOpenPIC]).
self assert: (backEnd callTargetFromReturnAddress: cogMethod asInteger + missOffset)
= (cogMethod cmType = CMMethod
ifTrue: [self methodAbortTrampolineFor: cogMethod cmNumArgs]
ifFalse: [self picAbortTrampolineFor: cogMethod cmNumArgs]).
backEnd relocateCallBeforeReturnPC: cogMethod asInteger + missOffset by: callDelta negated.
self mapFor: cogMethod
performUntil: #relocateIfCallOrMethodReference:mcpc:delta:
+ arg: refDelta asVoidPointer!
- arg: refDelta!
Item was changed:
----- Method: Cogit>>relocateIfCallOrMethodReference:mcpc:delta: (in category 'compaction') -----
+ relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: refDeltaArg
- relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: refDelta
<var: #mcpc type: #'char *'>
+ <var: #refDeltaArg type: #'CogMethod *'> "To placate the C static type system..."
+ | refDelta callDelta entryPoint targetMethod unlinkedRoutine |
- | callDelta entryPoint targetMethod unlinkedRoutine |
<var: #targetMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
+ refDelta := self cCoerceSimple: refDeltaArg to: #sqInt.
callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
NewspeakVM ifTrue:
[| nsSendCache |
annotation = IsNSSendCall ifTrue:
["Retrieve the send cache before relocating the stub call. Fetching the send
cache asserts the stub call points below all the cogged methods, but
until this method is actually moved, the adjusted stub call may appear to
point to somewhere in the method zone."
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
"Fix call to trampoline. This method is moving [delta] bytes, and calls are
relative, so adjust the call by -[delta] bytes"
backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
nsSendCache target ~= 0 ifTrue: "Send is linked"
[entryPoint := nsSendCache target.
targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
targetMethod cmType = CMMethod
ifTrue: "send target not freed; just relocate. The cache has an absolute
target, so only adjust by the target method's displacement."
[nsSendCache target: entryPoint + targetMethod objectHeader]
ifFalse: "send target was freed, unlink"
[self voidNSSendCache: nsSendCache]].
^0]].
(self isPureSendAnnotation: annotation) ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint <= methodZoneBase ifTrue: "send is not linked; just relocate"
[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
^0].
"It's a linked send; find which kind."
self
offsetAndSendTableFor: entryPoint
annotation: annotation
into: [:offset :sendTable|
targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
targetMethod cmType ~= CMFree ifTrue: "send target not freed; just relocate."
[backEnd
relocateCallBeforeReturnPC: mcpc asInteger
by: (callDelta - targetMethod objectHeader) negated.
SistaVM ifTrue: "See comment in planCompaction"
[methodZone restorePICUsageCount: targetMethod].
^0].
"Target was freed; map back to an unlinked send; but include this method's reocation"
unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
unlinkedRoutine := unlinkedRoutine - callDelta.
backEnd
rewriteInlineCacheAt: mcpc asInteger
tag: (backEnd inlineCacheValueForSelector: targetMethod selector in: enumeratingCogMethod)
target: unlinkedRoutine.
^0]].
annotation = IsRelativeCall ifTrue:
[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
^0].
annotation = IsAbsPCReference ifTrue:
[backEnd relocateMethodReferenceBeforeAddress: mcpc asInteger by: refDelta].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>remapIfObjectRef:pc:hasYoung: (in category 'garbage collection') -----
remapIfObjectRef: annotation pc: mcpc hasYoung: hasYoungPtr
<var: #mcpc type: #'char *'>
+ <var: #hasYoungPtr type: #'CogMethod *'> "to placate the C static type system..."
+
<var: #targetMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
annotation = IsObjectReference ifTrue:
[| literal mappedLiteral |
literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation couldBeObject: literal) ifTrue:
[mappedLiteral := objectRepresentation remapObject: literal.
literal ~= mappedLiteral ifTrue:
[self setCodeModified.
literalsManager storeLiteral: mappedLiteral atAnnotatedAddress: mcpc asUnsignedInteger using: backEnd].
(hasYoungPtr ~= 0
and: [objectMemory isYoung: mappedLiteral]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
[| nsSendCache oop mappedOop |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc.
oop := nsSendCache selector.
mappedOop := objectRepresentation remapObject: oop.
oop ~= mappedOop ifTrue:
[nsSendCache selector: mappedOop.
(hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
oop := nsSendCache enclosingObject.
oop ~= 0 ifTrue: [
mappedOop := objectRepresentation remapObject: oop.
oop ~= mappedOop ifTrue:
[nsSendCache enclosingObject: mappedOop.
(hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
^0 "keep scanning"]].
(self isPureSendAnnotation: annotation) ifTrue:
[self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj | | mappedCacheTag |
(tagCouldBeObj
and: [objectRepresentation couldBeObject: cacheTag]) ifTrue:
[mappedCacheTag := objectRepresentation remapObject: cacheTag.
cacheTag ~= mappedCacheTag ifTrue:
[self setCodeModified.
backEnd rewriteInlineCacheTag: mappedCacheTag at: mcpc asUnsignedInteger].
(hasYoungPtr ~= 0
and: [objectMemory isYoung: mappedCacheTag]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
hasYoungPtr ~= 0 ifTrue:
["Since the unlinking routines may rewrite the cacheTag to the send's selector, and
since they don't have the cogMethod to hand and can't add it to youngReferrers,
the method must remain in youngReferrers if the targetMethod's selector is young."
entryPoint > methodZoneBase ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :ignored|
(objectMemory isYoung: targetMethod selector) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]]].
^0 "keep scanning"!
Item was removed:
- ----- Method: Cogit>>setPostCompileHook: (in category 'jit - api') -----
- setPostCompileHook: aFunction
- <api>
- <var: #aFunction declareC: #'void (*aFunction)(CogMethod *)'>
- postCompileHook := aFunction!
Item was changed:
----- Method: Cogit>>unlinkIfFreeOrLinkedSend:pc:of: (in category 'in-line cacheing') -----
unlinkIfFreeOrLinkedSend: annotation pc: mcpc of: theSelector
<var: #mcpc type: #'char *'>
+ <var: #theSelector type: #'CogMethod *'> "To placate the C static type system..."
+
<var: #nsSendCache type: #'NSSendCache *'>
| entryPoint |
NewspeakVM ifTrue:
[| nsSendCache |
annotation = IsNSSendCall ifTrue:
[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
(entryPoint := nsSendCache target) ~= 0 ifTrue:
[ | targetMethod |
targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ (targetMethod cmType = CMFree
+ or: [nsSendCache selector = (self cCoerceSimple: theSelector to: #sqInt)]) ifTrue:
- (targetMethod cmType = CMFree or: [nsSendCache selector = theSelector]) ifTrue:
[self voidNSSendCache: nsSendCache]].
^0 "keep scanning"]].
(self isPureSendAnnotation: annotation) ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
(targetMethod cmType = CMFree
+ or: [targetMethod selector = (self cCoerceSimple: theSelector to: #sqInt)]) ifTrue:
- or: [targetMethod selector = theSelector]) ifTrue:
[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
^0 "keep scanning"!
Item was added:
+ ----- Method: Cogit>>unlinkIfLinkedSend:pc:if: (in category 'in-line cacheing') -----
+ unlinkIfLinkedSend: annotation pc: mcpc if: criterionArg
+ <var: #mcpc type: #'char *'>
+ <var: #criterionArg type: #'CogMethod *'> "To placate the C static type system..."
+
+ <var: 'criterion' declareC: 'sqInt (*criterion)(CogMethod *)'>
+ <var: #nsSendCache type: #'NSSendCache *'>
+ | criterion entryPoint |
+ criterion := criterionArg asVoidPointer.
+ NewspeakVM ifTrue:
+ [| nsSendCache |
+ annotation = IsNSSendCall ifTrue:
+ [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
+ ((entryPoint := nsSendCache target) ~= 0
+ and: [self perform: criterion
+ with: (self cCoerce: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *')]) ifTrue:
+ [self voidNSSendCache: nsSendCache].
+ ^0 "keep scanning"]].
+
+ (self isPureSendAnnotation: annotation) ifTrue:
+ [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
+ entryPoint > methodZoneBase ifTrue: "It's a linked send."
+ [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
+ [:targetMethod :sendTable|
+ (self perform: criterion with: targetMethod) ifTrue:
+ [self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
+
+ ^0 "keep scanning"!
Item was removed:
- ----- Method: Cogit>>unlinkIfLinkedSend:pc:toMachineCodePrim: (in category 'in-line cacheing') -----
- unlinkIfLinkedSend: annotation pc: mcpc toMachineCodePrim: ignored
- <var: #mcpc type: #'char *'>
- <var: #nsSendCache type: #'NSSendCache *'>
- | entryPoint |
-
- NewspeakVM ifTrue:
- [| nsSendCache |
- annotation = IsNSSendCall ifTrue:
- [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
- (entryPoint := nsSendCache target) ~= 0 ifTrue:
- [ | targetMethod |
- targetMethod := entryPoint - cmNoCheckEntryOffset.
- (self cogMethodHasMachineCodePrim: targetMethod) ifTrue:
- [self voidNSSendCache: nsSendCache]].
- ^0 "keep scanning"]].
-
- (self isPureSendAnnotation: annotation) ifTrue:
- [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
- entryPoint > methodZoneBase ifTrue: "It's a linked send."
- [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
- [:targetMethod :sendTable|
- (self cogMethodHasMachineCodePrim: targetMethod) ifTrue:
- [self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
-
- ^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkSendsOf:isMNUSelector: (in category 'jit - api') -----
unlinkSendsOf: selector isMNUSelector: isMNUSelector
<api>
"Unlink all sends in cog methods. Free all Closed PICs with the selector,
or with an MNU case if isMNUSelector. First check if any method actually
has the selector; if not there can't be any linked send to it. This routine
(including descendents) is performance critical. It contributes perhaps
30% of entire execution time in Compiler recompileAll."
| cogMethod mustScanAndUnlink |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase ifNil: [^self].
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
mustScanAndUnlink := false.
isMNUSelector
ifTrue:
[[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[cogMethod cpicHasMNUCase
ifTrue:
[self assert: cogMethod cmType = CMClosedPIC.
methodZone freeMethod: cogMethod.
mustScanAndUnlink := true]
ifFalse:
[cogMethod selector = selector ifTrue:
[mustScanAndUnlink := true.
cogMethod cmType = CMClosedPIC ifTrue:
[methodZone freeMethod: cogMethod]]]].
cogMethod := methodZone methodAfter: cogMethod]]
ifFalse:
[[cogMethod < methodZone limitZony] whileTrue:
[(cogMethod cmType ~= CMFree
and: [cogMethod selector = selector]) ifTrue:
[mustScanAndUnlink := true.
cogMethod cmType = CMClosedPIC ifTrue:
[methodZone freeMethod: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod]].
mustScanAndUnlink ifFalse:
[^self].
codeModified := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfFreeOrLinkedSend:pc:of:
+ arg: (self cCoerceSimple: selector to: #'CogMethod *')].
- arg: selector].
cogMethod := methodZone methodAfter: cogMethod].
codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart].
"And ensure code zone is executable. May merely have freed methods..."
self ensureExecutableCodeZone!
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 there's nothing to do."
| 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 ifNil: [^self].
self ensureWritableCodeZone.
codeModified := freedPIC := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfLinkedSend:pc:to:
+ arg: targetMethod]
- 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."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]].
self ensureExecutableCodeZone!
Item was changed:
+ ----- Method: Cogit>>unlinkSendsToFree (in category 'jit - api') -----
- ----- 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 ifNil: [^self].
codeModified := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfLinkedSendToFree:pc:ignored:
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."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
Item was removed:
- ----- Method: Cogit>>unlinkSendsToMachineCodePrimitiveMethodsAndFreeIf: (in category 'jit - api') -----
- unlinkSendsToMachineCodePrimitiveMethodsAndFreeIf: freeIfTrue
- <api>
- "Unlink all sends in cog methods to methods with a machine code
- primitive, and free machine code primitive methods if freeIfTrue.
- To avoid having to scan PICs, free any and all PICs"
- | cogMethod freedSomething |
- <var: #cogMethod type: #'CogMethod *'>
- methodZoneBase ifNil: [^self].
- codeModified := freedSomething := false.
- cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
- [cogMethod < methodZone limitZony] whileTrue:
- [cogMethod cmType = CMMethod
- ifTrue:
- [(freeIfTrue
- and: [self cogMethodHasMachineCodePrim: cogMethod])
- ifTrue:
- [methodZone freeMethod: cogMethod.
- freedSomething := true]
- ifFalse:
- [self mapFor: cogMethod
- performUntil: #unlinkIfLinkedSend:pc:toMachineCodePrim:
- arg: 0]]
- ifFalse:
- [cogMethod cmType = CMClosedPIC ifTrue:
- [methodZone freeMethod: cogMethod.
- freedSomething := true]].
- cogMethod := methodZone methodAfter: cogMethod].
- freedSomething
- ifTrue: [self unlinkSendsToFree]
- ifFalse:
- [codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
- [backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]]!
Item was added:
+ ----- Method: Cogit>>unlinkSendsToMethodsSuchThat:AndFreeIf: (in category 'jit - api') -----
+ unlinkSendsToMethodsSuchThat: criterion AndFreeIf: freeIfTrue
+ <api>
+ "Unlink all sends in cog methods to methods with a machine code
+ primitive, and free machine code primitive methods if freeIfTrue.
+ To avoid having to scan PICs, free any and all PICs"
+ <var: 'criterion' declareC: 'sqInt (*criterion)(CogMethod *)'>
+ | cogMethod freedSomething |
+ <var: #cogMethod type: #'CogMethod *'>
+ methodZoneBase ifNil: [^self].
+ self cCode: nil inSmalltalk: [debugAPISelector := nil].
+ codeModified := freedSomething := false.
+ cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
+ [cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod cmType = CMMethod
+ ifTrue:
+ [(freeIfTrue
+ and: [self perform: criterion with: cogMethod])
+ ifTrue:
+ [methodZone freeMethod: cogMethod.
+ freedSomething := true]
+ ifFalse:
+ [self mapFor: cogMethod
+ performUntil: #unlinkIfLinkedSend:pc:if:
+ arg: criterion]]
+ ifFalse:
+ [cogMethod cmType = CMClosedPIC ifTrue:
+ [methodZone freeMethod: cogMethod.
+ freedSomething := true]].
+ cogMethod := methodZone methodAfter: cogMethod].
+ freedSomething
+ ifTrue: [self unlinkSendsToFree]
+ ifFalse:
+ [codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ [backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]]!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>functionPointerForCompiledMethod:primitiveIndex: (in category 'accessing') -----
- functionPointerForCompiledMethod: methodOop primitiveIndex: primIndex
- ^([coInterpreter functionPointerForCompiledMethod: methodOop primitiveIndex: primIndex]
- on: Error
- do: [:ex|
- #someExternalPrimitive]) ifNotNil:
- [:symbol|
- self addressForLabel: symbol]!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: (in category 'accessing') -----
+ functionPointerForCompiledMethod: methodOop primitiveIndex: primIndex primitivePropertyFlagsInto: flagsPtr
+ ^([coInterpreter
+ functionPointerForCompiledMethod: methodOop
+ primitiveIndex: primIndex
+ primitivePropertyFlagsInto: flagsPtr]
+ on: Error
+ do: [:ex|
+ #someExternalPrimitive]) ifNotNil:
+ [:symbol|
+ self addressForLabel: symbol]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveListBuiltinModule (in category 'plugin primitives') -----
primitiveListBuiltinModule
"Primitive. Return the n-th builtin module name."
+ | index |
+ self methodArgumentCount = 1 ifFalse:
+ [^self primitiveFail].
- | moduleName index length nameOop |
- <var: #moduleName type: #'char *'>
- self methodArgumentCount = 1 ifFalse:[^self primitiveFail].
index := self stackIntegerValue: 0.
+ (self failed or: [index <= 0]) ifTrue:
+ [^self primitiveFail].
+ (self ioListBuiltinModule: index)
+ ifNil: [self methodReturnValue: objectMemory nilObject]
+ ifNotNil: [:moduleName| self methodReturnString: moduleName]!
- index <= 0 ifTrue:[^self primitiveFail].
- moduleName := self ioListBuiltinModule: index.
- moduleName == nil ifTrue:[
- self pop: 2. "arg+rcvr"
- ^self push: objectMemory nilObject].
- length := self strlen: moduleName.
- nameOop := objectMemory instantiateClass: objectMemory classString indexableSize: length.
- 0 to: length-1 do:[:i|
- objectMemory storeByte: i ofObject: nameOop withValue: (moduleName at: i)].
- self forceInterruptCheck.
- self pop: 2 thenPush: nameOop!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveListExternalModule (in category 'plugin primitives') -----
primitiveListExternalModule
+ "Primitive. Answer the n-th loaded external module name."
+ | index |
+ self methodArgumentCount = 1 ifFalse:
+ [^self primitiveFail].
- "Primitive. Return the n-th loaded external module name."
- | moduleName index length nameOop |
- <var: #moduleName type: #'char *'>
- self methodArgumentCount = 1 ifFalse:[^self primitiveFail].
index := self stackIntegerValue: 0.
+ (self failed or: [index <= 0]) ifTrue:
+ [^self primitiveFail].
+ (self ioListLoadedModule: index)
+ ifNil: [self methodReturnValue: objectMemory nilObject]
+ ifNotNil: [:moduleName| self methodReturnString: moduleName]!
- index <= 0 ifTrue:[^self primitiveFail].
- moduleName := self ioListLoadedModule: index.
- moduleName == nil ifTrue:[
- self pop: 2. "arg+rcvr"
- ^self push: objectMemory nilObject].
- length := self strlen: moduleName.
- nameOop := objectMemory instantiateClass: objectMemory classString indexableSize: length.
- 0 to: length-1 do:[:i|
- objectMemory storeByte: i ofObject: nameOop withValue: (moduleName at: i)].
- self forceInterruptCheck.
- self pop: 2 thenPush: nameOop!
Item was removed:
- ----- Method: InterpreterProxy>>ioLoadFunction:From:AccessorDepthInto: (in category 'FFI support') -----
- ioLoadFunction: functionName From: moduleName AccessorDepthInto: accessorDepthPtr
- <returnTypeC: #'void *'>
- <var: #functionName type: #'char *'>
- <var: #moduleName type: #'char *'>
- <var: #accessorDepthPtr type: #'sqInt *'>
- "Dummy - provided by support code"
- ^0!
Item was added:
+ ----- Method: InterpreterProxy>>ioLoadFunction:From:MetadataInto: (in category 'FFI support') -----
+ ioLoadFunction: functionName From: moduleName MetadataInto: metadataPtr
+ <returnTypeC: #'void *'>
+ <var: #functionName type: #'char *'>
+ <var: #moduleName type: #'char *'>
+ <var: #metadataPtr type: #'sqInt *'>
+ "Dummy - provided by support code"
+ ^0!
Item was added:
+ ----- Method: InterpreterProxy>>ioLoadFunction:From:MetadataIntoInto: (in category 'FFI support') -----
+ ioLoadFunction: functionName From: moduleName MetadataIntoInto: metadataPtr
+ <returnTypeC: #'void *'>
+ <var: #functionName type: #'char *'>
+ <var: #moduleName type: #'char *'>
+ <var: #metadataPtr type: #'sqInt *'>
+ "Dummy - provided by support code"
+ ^0!
Item was changed:
----- Method: LargeIntegersPlugin>>primAnyBitFrom:to: (in category 'Integer primitives') -----
+ primAnyBitFrom: from to: to
+ <export: true flags: #FastCPrimitiveFlag>
- primAnyBitFrom: from to: to
| integer someBitIsSet val mask |
+ integer := self primitive: 'primAnyBitFromTo' parameters: #(SmallInteger SmallInteger) receiver: #Integer.
+ from < 1 | (to < 1) ifTrue:
+ [^ interpreterProxy primitiveFail].
- integer := self
- primitive: 'primAnyBitFromTo'
- parameters: #(#SmallInteger #SmallInteger )
- receiver: #Integer.
- from < 1 | (to < 1)
- ifTrue: [^ interpreterProxy primitiveFail].
(interpreterProxy isIntegerObject: integer)
+ ifTrue: "For small integers, use a single bit mask operation"
+ [from <= to
- ifTrue: ["For small integers, use a single bit mask operation"
- from <= to
ifTrue:
[val := interpreterProxy integerValueOf: integer.
val < 0 ifTrue: ["Get the bits of magnitude" val := 0 - val].
+ mask := (1 asUnsignedInteger << (to min: (self sizeof: #usqInt) * 8 - 1))
+ - (1 asUnsignedInteger << (from - 1 min: (self sizeof: #usqInt) * 8 - 1)).
- mask := (1 asUnsignedInteger << (to min: (self sizeof: #usqInt)*8-1))
- - (1 asUnsignedInteger << (from - 1 min: (self sizeof: #usqInt)*8-1)).
someBitIsSet := val anyMask: mask]
ifFalse: [someBitIsSet := 0]]
+ ifFalse:
+ [someBitIsSet := self anyBitOfLargeInt: integer from: from to: to].
- ifFalse: [someBitIsSet := self
- anyBitOfLargeInt: integer
- from: from
- to: to].
^someBitIsSet asOop: Boolean!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitAdd: (in category 'Integer primitives') -----
primDigitAdd: secondInteger
+ <export: true flags: #FastCPrimitiveFlag>
| firstLarge secondLarge firstInteger |
+ firstInteger := self primitive: 'primDigitAdd' parameters: #(Integer) receiver: #Integer.
- firstInteger := self
- primitive: 'primDigitAdd'
- parameters: #(Integer )
- receiver: #Integer.
(interpreterProxy isIntegerObject: firstInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
self remapOop: secondInteger in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
self remapOop: firstLarge in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
ifFalse: [secondLarge := secondInteger].
^ self digitAddLarge: firstLarge with: secondLarge!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitAnd: (in category 'Integer primitives') -----
primDigitBitAnd: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
+ <export: true flags: #FastCPrimitiveFlag>
| firstInteger |
+ firstInteger := self primitive: 'primDigitBitAnd' parameters: #(Integer) receiver: #Integer.
+ ^self
- firstInteger := self
- primitive: 'primDigitBitAnd'
- parameters: #(Integer )
- receiver: #Integer.
- ^ self
digitBitLogic: firstInteger
with: secondInteger
opIndex: andOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitOr: (in category 'Integer primitives') -----
primDigitBitOr: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
+ <export: true flags: #FastCPrimitiveFlag>
| firstInteger |
+ firstInteger := self primitive: 'primDigitBitOr' parameters: #(Integer) receiver: #Integer.
+ ^self
- firstInteger := self
- primitive: 'primDigitBitOr'
- parameters: #(Integer )
- receiver: #Integer.
- ^ self
digitBitLogic: firstInteger
with: secondInteger
opIndex: orOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitShiftMagnitude: (in category 'Integer primitives') -----
+ primDigitBitShiftMagnitude: shiftCount
+ <export: true flags: #FastCPrimitiveFlag>
- primDigitBitShiftMagnitude: shiftCount
| rShift aLarge anInteger |
+ anInteger := self primitive: 'primDigitBitShiftMagnitude' parameters: #(SmallInteger) receiver: #Integer.
- anInteger := self
- primitive: 'primDigitBitShiftMagnitude'
- parameters: #(#SmallInteger )
- receiver: #Integer.
(interpreterProxy isIntegerObject: anInteger)
+ ifTrue: "convert it to a not normalized LargeInteger"
+ [aLarge := self createLargeFromSmallInteger: anInteger]
- ifTrue: ["convert it to a not normalized LargeInteger"
- aLarge := self createLargeFromSmallInteger: anInteger]
ifFalse: [aLarge := anInteger].
+ shiftCount >= 0 ifTrue:
+ [^ self digit: aLarge Lshift: shiftCount].
+ rShift := 0 - shiftCount.
+ ^self normalize: (self
+ digit: aLarge
+ Rshift: rShift
+ lookfirst: (self digitSizeOfLargeInt: aLarge))!
- shiftCount >= 0
- ifTrue: [^ self digit: aLarge Lshift: shiftCount]
- ifFalse:
- [rShift := 0 - shiftCount.
- ^ self normalize: (self
- digit: aLarge
- Rshift: rShift
- lookfirst: (self digitSizeOfLargeInt: aLarge))]!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitXor: (in category 'Integer primitives') -----
+ primDigitBitXor: secondInteger
- primDigitBitXor: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
+ <export: true flags: #FastCPrimitiveFlag>
| firstInteger |
+ firstInteger := self primitive: 'primDigitBitXor' parameters: #(Integer) receiver: #Integer.
+ ^self
- firstInteger := self
- primitive: 'primDigitBitXor'
- parameters: #(Integer )
- receiver: #Integer.
- ^ self
digitBitLogic: firstInteger
with: secondInteger
opIndex: xorOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitCompare: (in category 'Integer primitives') -----
primDigitCompare: secondInteger
"Compare the magnitude of self with that of arg.
+ Answer a code of 1, 0, -1 for self >, = , < arg"
+ <export: true flags: #FastCPrimitiveFlag>
+ | firstVal secondVal firstInteger |
+ firstInteger := self primitive: 'primDigitCompare' parameters: #(Integer) receiver: #Integer.
- Answer a code of 1, 0, -1 for self >, = , < arg" | firstVal secondVal firstInteger |
- firstInteger := self
- primitive: 'primDigitCompare'
- parameters: #(#Integer )
- receiver: #Integer.
"shortcut: aSmallInteger has to be smaller in Magnitude than aLargeInteger"
(interpreterProxy isIntegerObject: firstInteger) ifTrue:
[(interpreterProxy isIntegerObject: secondInteger) ifTrue:
[firstVal := interpreterProxy integerValueOf: firstInteger.
secondVal := interpreterProxy integerValueOf: secondInteger.
"Compute their magnitudes. Since SmallIntegers are tagged they have
fewer bits than an integer on the platform; therefore in computing their
magnitude they cannot overflow."
firstVal < 0 ifTrue: [firstVal := 0 - firstVal].
secondVal < 0 ifTrue: [secondVal := 0 - secondVal].
^firstVal = secondVal
ifTrue: [0 asOop: SmallInteger]
ifFalse:
[firstVal < secondVal
ifTrue: [-1 asOop: SmallInteger]
ifFalse: [1 asOop: SmallInteger]]].
^-1 asOop: SmallInteger]. "first < second"
(interpreterProxy isIntegerObject: secondInteger) ifTrue:
[^1 asOop: SmallInteger]. "first > second"
^ self digitCompareLarge: firstInteger with: secondInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitDiv:negative: (in category 'Integer primitives') -----
primDigitDiv: secondInteger negative: neg
"Answer the result of dividing firstInteger by secondInteger.
+ Fail if parameters are not integers, not normalized or secondInteger is zero. "
+ <export: true flags: #FastCPrimitiveFlag>
- Fail if parameters are not integers, not normalized or secondInteger is
- zero. "
| firstAsLargeInteger secondAsLargeInteger firstInteger |
+ firstInteger := self primitive: 'primDigitDivNegative' parameters: #(Integer Boolean) receiver: #Integer.
- firstInteger := self
- primitive: 'primDigitDivNegative'
- parameters: #(#Integer #Boolean )
- receiver: #Integer.
"Coerce SmallIntegers to corresponding (not normalized) large integers
and check for zerodivide."
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: "convert to LargeInteger"
+ [self
- ifTrue: ["convert to LargeInteger"
- self
remapOop: secondInteger
in: [firstAsLargeInteger := self createLargeFromSmallInteger: firstInteger]]
ifFalse:
["Avoid crashes in case of getting unnormalized args."
(self isNormalized: firstInteger)
ifFalse:
[self debugCode:
[self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
self msg: '------> receiver *not* normalized!!'].
^ interpreterProxy primitiveFail].
firstAsLargeInteger := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: "check for zerodivide and convert to LargeInteger"
+ [(interpreterProxy integerValueOf: secondInteger)
- ifTrue: ["check for zerodivide and convert to LargeInteger"
- (interpreterProxy integerValueOf: secondInteger)
= 0
ifTrue: [^ interpreterProxy primitiveFail].
self
remapOop: firstAsLargeInteger
in: [secondAsLargeInteger := self createLargeFromSmallInteger: secondInteger]]
ifFalse:
["Avoid crashes in case of getting unnormalized args."
+ (self isNormalized: secondInteger) ifFalse:
+ [self debugCode:
+ [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
+ self msg: '------> argument *not* normalized!!'].
+ ^ interpreterProxy primitiveFail].
- (self isNormalized: secondInteger)
- ifFalse:
- [self debugCode:
- [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
- self msg: '------> argument *not* normalized!!'].
- ^ interpreterProxy primitiveFail].
secondAsLargeInteger := secondInteger].
^ self
digitDivLarge: firstAsLargeInteger
with: secondAsLargeInteger
negative: neg!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitMultiply:negative: (in category 'Integer primitives') -----
+ primDigitMultiply: secondInteger negative: neg
+ <export: true flags: #FastCPrimitiveFlag>
- primDigitMultiply: secondInteger negative: neg
| firstLarge secondLarge firstInteger |
+ firstInteger := self primitive: 'primDigitMultiplyNegative' parameters: #(Integer Boolean) receiver: #Integer.
- firstInteger := self
- primitive: 'primDigitMultiplyNegative'
- parameters: #(#Integer #Boolean )
- receiver: #Integer.
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: "convert it to a not normalized LargeInteger"
+ [self
- ifTrue: ["convert it to a not normalized LargeInteger"
- self
remapOop: secondInteger
in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: "convert it to a not normalized LargeInteger"
+ [self
- ifTrue: ["convert it to a not normalized LargeInteger"
- self
remapOop: firstLarge
in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
ifFalse: [secondLarge := secondInteger].
^ self
digitMultiplyLarge: firstLarge
with: secondLarge
negative: neg!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitSubtract: (in category 'Integer primitives') -----
+ primDigitSubtract: secondInteger
+ <export: true flags: #FastCPrimitiveFlag>
- primDigitSubtract: secondInteger
| firstLarge secondLarge firstInteger |
+ firstInteger := self primitive: 'primDigitSubtract' parameters: #(Integer) receiver: #Integer.
- firstInteger := self
- primitive: 'primDigitSubtract'
- parameters: #(#Integer )
- receiver: #Integer.
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: "convert it to a not normalized LargeInteger"
+ [self
- ifTrue: ["convert it to a not normalized LargeInteger"
- self
remapOop: secondInteger
in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: "convert it to a not normalized LargeInteger"
+ [self
- ifTrue: ["convert it to a not normalized LargeInteger"
- self
remapOop: firstLarge
in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
ifFalse: [secondLarge := secondInteger].
^ self digitSubLarge: firstLarge with: secondLarge!
Item was changed:
----- Method: LargeIntegersPlugin>>primMontgomeryDigitLength (in category 'Integer primitives') -----
primMontgomeryDigitLength
+ <export: true flags: #FastCPrimitiveFlag>
+ self primitive: #primMontgomeryDigitLength parameters: #() receiver: #Integer.
- self
- primitive: 'primMontgomeryDigitLength'
- parameters: #()
- receiver: #Integer.
^interpreterProxy integerObjectOf: 32!
Item was changed:
----- Method: LargeIntegersPlugin>>primMontgomeryTimes:modulo:mInvModB: (in category 'Integer primitives') -----
primMontgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: mInverseInteger
+ <export: true flags: #FastCPrimitiveFlag>
| firstLarge secondLarge firstInteger thirdLarge mInv |
<var: #mInv type: #'unsigned int'>
+ firstInteger := self primitive: 'primMontgomeryTimesModulo' parameters: #(Integer Integer Integer) receiver: #Integer.
- firstInteger := self
- primitive: 'primMontgomeryTimesModulo'
- parameters: #(Integer Integer Integer )
- receiver: #Integer.
mInv := interpreterProxy positive32BitValueOf: mInverseInteger.
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: "convert it to a not normalized LargeInteger"
+ [self remapOop: #(secondOperandInteger thirdModuloInteger) in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
- ifTrue: ["convert it to a not normalized LargeInteger"
- self remapOop: #(secondOperandInteger thirdModuloInteger) in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondOperandInteger)
+ ifTrue: "convert it to a not normalized LargeInteger"
+ [self remapOop: #(firstLarge thirdModuloInteger) in: [secondLarge := self createLargeFromSmallInteger: secondOperandInteger]]
- ifTrue: ["convert it to a not normalized LargeInteger"
- self remapOop: #(firstLarge thirdModuloInteger) in: [secondLarge := self createLargeFromSmallInteger: secondOperandInteger]]
ifFalse: [secondLarge := secondOperandInteger].
(interpreterProxy isIntegerObject: thirdModuloInteger)
+ ifTrue: "convert it to a not normalized LargeInteger"
+ [self remapOop: #(firstLarge secondLarge) in: [thirdLarge := self createLargeFromSmallInteger: thirdModuloInteger]]
- ifTrue: ["convert it to a not normalized LargeInteger"
- self remapOop: #(firstLarge secondLarge) in: [thirdLarge := self createLargeFromSmallInteger: thirdModuloInteger]]
ifFalse: [thirdLarge := thirdModuloInteger].
^ self digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv!
Item was changed:
----- Method: LargeIntegersPlugin>>primNormalizeNegative (in category 'Integer primitives') -----
primNormalizeNegative
+ <export: true flags: #FastCPrimitiveFlag>
| rcvr |
+ rcvr := self primitive: #primNormalizeNegative parameters: #() receiver: #LargeNegativeInteger.
- rcvr := self
- primitive: 'primNormalizeNegative'
- parameters: #()
- receiver: #LargeNegativeInteger.
^ self normalizeNegative: rcvr!
Item was changed:
----- Method: LargeIntegersPlugin>>primNormalizePositive (in category 'Integer primitives') -----
primNormalizePositive
+ <export: true flags: #FastCPrimitiveFlag>
| rcvr |
+ rcvr := self primitive: #primNormalizePositive parameters: #() receiver: #LargePositiveInteger.
- rcvr := self
- primitive: 'primNormalizePositive'
- parameters: #()
- receiver: #LargePositiveInteger.
^ self normalizePositive: rcvr!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveCompareString (in category 'primitives') -----
primitiveCompareString
"ByteString (class) compare: string1 with: string2 collated: order"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| len1 len2 order string1 string2 orderOop string1Oop string2Oop |
<var: 'order' type: #'unsigned char *'>
<var: 'string1' type: #'unsigned char *'>
<var: 'string2' type: #'unsigned char *'>
orderOop := interpreterProxy stackValue: 0.
string2Oop := interpreterProxy stackValue: 1.
string1Oop := interpreterProxy stackValue: 2.
((interpreterProxy isBytes: orderOop)
and: [(interpreterProxy isBytes: string2Oop)
and: [interpreterProxy isBytes: string1Oop]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
order := interpreterProxy firstIndexableField: orderOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: order) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
string1 := interpreterProxy firstIndexableField: string1Oop.
string2 := interpreterProxy firstIndexableField: string2Oop.
len1 := interpreterProxy sizeOfSTArrayFromCPrimitive: string1.
len2 := interpreterProxy sizeOfSTArrayFromCPrimitive: string2.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
0 to: (len1 min: len2) - 1 do:
[ :i | | c1 c2 |
c1 := order at: (string1 at: i).
c2 := order at: (string2 at: i).
c1 = c2 ifFalse:
[^interpreterProxy methodReturnInteger: (c1 < c2 ifTrue: [1] ifFalse: [3])]].
interpreterProxy methodReturnInteger:
(len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]])!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveCompressToByteArray (in category 'primitives') -----
primitiveCompressToByteArray
"Bitmap compress: bm toByteArray: ba"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| bm ba eqBytes i j k lowByte size destSize word |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1))
to: #'int *'].
interpreterProxy failed ifTrue: [^nil].
(interpreterProxy isBytes: (interpreterProxy stackValue: 0)) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy isOopImmutable: (interpreterProxy stackValue: 0)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported"
i := self encodeInt: size in: ba at: 0.
k := 0.
[k < size] whileTrue:
[word := bm at: k.
lowByte := word bitAnd: 255.
eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]].
j := k.
[j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1].
j > k
ifTrue:
[eqBytes
ifTrue:
[i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1]
ifFalse:
[i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i.
i := self encodeBytesOf: word in: ba at: i].
k := j + 1]
ifFalse:
[eqBytes
ifTrue:
[i := self encodeInt: 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1.
k := k + 1]
ifFalse:
[[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1].
j + 1 = size ifTrue: [j := j + 1].
i := self encodeInt: j - k * 4 + 3 in: ba at: i.
k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
k := j]]].
interpreterProxy methodReturnInteger: i!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveConvert8BitSigned (in category 'primitives') -----
primitiveConvert8BitSigned
"SampledSound (class) convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| aByteArray aSoundBuffer arraySize byteArrayOop soundBufferOop |
<var: 'aByteArray' type: #'unsigned char *'>
<var: 'aSoundBuffer' type: #'unsigned short *'>
byteArrayOop := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: byteArrayOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
soundBufferOop := interpreterProxy stackValue: 0.
(interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
aSoundBuffer := self
cCode: [interpreterProxy arrayValueOf: soundBufferOop]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: soundBufferOop)
to: #'unsigned short *'].
arraySize := interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy byteSizeOf: soundBufferOop) < (2 * arraySize) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
0 to: arraySize - 1 do:
[ :i | | s |
s := aByteArray at: i.
aSoundBuffer
at: i
put: (s > 127
ifTrue: [s - 256 bitShift: 8]
ifFalse: [s bitShift: 8])].
interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveDecompressFromByteArray (in category 'primitives') -----
primitiveDecompressFromByteArray
"Bitmap decompress: bm fromByteArray: ba at: index"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| bm ba index i anInt code data end k n pastEnd |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
<var: 'anInt' type: #'unsigned int'>
<var: 'code' type: #'unsigned int'>
<var: 'data' type: #'unsigned int'>
<var: 'n' type: #'unsigned int'>
bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2)]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2))
to: #'int *'].
(interpreterProxy isOopImmutable: (interpreterProxy stackValue: 2)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
(interpreterProxy isBytes: (interpreterProxy stackValue: 1)) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
index := interpreterProxy stackIntegerValue: 0.
end := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
pastEnd := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := index - 1.
k := 0.
[i < end] whileTrue:
[anInt := ba at: i.
i := i + 1.
anInt <= 223 ifFalse:
[anInt <= 254
ifTrue:
[anInt := anInt - 224 * 256 + (ba at: i).
i := i + 1]
ifFalse:
[anInt := 0.
1 to: 4 by: 1 do:
[ :j | anInt := (anInt bitShift: 8) + (ba at: i).
i := i + 1]]].
n := anInt >> 2.
k + n > pastEnd ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
code := anInt bitAnd: 3.
"code = 0 ifTrue: [nil]."
code = 1 ifTrue:
[data := ba at: i.
i := i + 1.
data := data bitOr: (data bitShift: 8).
data := data bitOr: (data bitShift: 16).
1 to: n do:
[ :j |
bm at: k put: data.
k := k + 1]].
code = 2 ifTrue:
[data := 0.
1 to: 4 do:
[ :j |
data := (data bitShift: 8) bitOr: (ba at: i).
i := i + 1].
1 to: n do:
[ :j |
bm at: k put: data.
k := k + 1]].
code = 3 ifTrue:
[1 to: n do:
[ :m |
data := 0.
1 to: 4 do:
[ :j |
data := (data bitShift: 8) bitOr: (ba at: i).
i := i + 1].
bm at: k put: data.
k := k + 1]]].
interpreterProxy pop: interpreterProxy methodArgumentCount!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveFindFirstInString (in category 'primitives') -----
primitiveFindFirstInString
"ByteString (class) findFirstInString: aString inSet: inclusionMap startingAt: start"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| aString i inclusionMap stringSize aStringOop inclusionMapOop |
<var: 'aString' type: #'unsigned char *'>
<var: 'inclusionMap' type: #'unsigned char *'>
aStringOop := interpreterProxy stackValue: 2.
(interpreterProxy isBytes: aStringOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
inclusionMapOop := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: inclusionMapOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := i - 1. "Convert to 0-based index."
i < 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
inclusionMap := interpreterProxy firstIndexableField: inclusionMapOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: inclusionMap) ~= 256 ifTrue:
[^interpreterProxy methodReturnInteger: 0].
aString := interpreterProxy firstIndexableField: aStringOop.
stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
[i < stringSize and: [(inclusionMap at: (aString at: i)) = 0]] whileTrue:
[i := i + 1].
interpreterProxy methodReturnInteger: (i >= stringSize ifTrue: [0] ifFalse: [i + 1])!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveFindSubstring (in category 'primitives') -----
primitiveFindSubstring
"ByteString findSubstring: key in: body startingAt: start matchTable: matchTable"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| body key keySize bodySize matchTable start bodyOop keyOop matchTableOop |
<var: #key type: #'unsigned char *'>
<var: #body type: #'unsigned char *'>
<var: #matchTable type: #'unsigned char *'>
keyOop := interpreterProxy stackValue: 3.
(interpreterProxy isBytes: keyOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
bodyOop := interpreterProxy stackValue: 2.
(interpreterProxy isBytes: bodyOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start := interpreterProxy stackIntegerValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
matchTableOop := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: matchTableOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
matchTable := interpreterProxy firstIndexableField: matchTableOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: matchTable) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
key := interpreterProxy firstIndexableField: keyOop.
(keySize := interpreterProxy sizeOfSTArrayFromCPrimitive: key) > 0 ifTrue:
[keySize := keySize - 1. "adjust for zero relative indexes"
start := start - 1 max: 0. "adjust for zero relative indexes"
body := interpreterProxy firstIndexableField: bodyOop.
bodySize := interpreterProxy sizeOfSTArrayFromCPrimitive: body.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start to: bodySize - 1 - keySize do:
[ :startIndex | | index |
index := 0.
[(matchTable at: (body at: startIndex + index)) = (matchTable at: (key at: index))] whileTrue:
[index = keySize ifTrue:
[^interpreterProxy methodReturnInteger: startIndex + 1].
index := index + 1]]].
^interpreterProxy methodReturnInteger: 0!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveIndexOfAsciiInString (in category 'primitives') -----
primitiveIndexOfAsciiInString
"ByteString indexOfAscii: anInteger inString: aString startingAt: start"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| integerOop startOop anInteger aString start stringSize stringOop |
<var: #aString type: #'unsigned char *'>
integerOop := interpreterProxy stackValue: 2.
stringOop := interpreterProxy stackValue: 1.
startOop := interpreterProxy stackValue: 0.
((interpreterProxy isIntegerObject: integerOop)
and: [(interpreterProxy isIntegerObject: startOop)
and: [(interpreterProxy isBytes: stringOop)
and: [interpreterProxy isWordsOrBytes: stringOop]]]) ifFalse: "sizeOfSTArrayFromCPrimitive: is defined only for words or bytes"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(start := interpreterProxy integerValueOf: startOop) >= 1 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
anInteger := interpreterProxy integerValueOf: integerOop.
aString := interpreterProxy firstIndexableField: stringOop.
stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
start - 1 to: stringSize - 1 do:
[:pos |
(aString at: pos) = anInteger ifTrue:
[^interpreterProxy methodReturnInteger: pos + 1]].
^interpreterProxy methodReturnInteger: 0!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveStringHash (in category 'primitives') -----
primitiveStringHash
"ByteArray (class) hashBytes: aByteArray startingWith: speciesHash"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| aByteArray hash byteArrayOop |
<var: 'aByteArray' type: #'unsigned char *'>
<var: 'hash' type: #'unsigned int'>
hash := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
byteArrayOop := interpreterProxy stackValue: 1.
((interpreterProxy isBytes: byteArrayOop)
+ and: [interpreterProxy isWordsOrBytesNonImm: byteArrayOop]) ifFalse: "filters out CompiledMethods"
- and: [interpreterProxy isWordsOrBytes: byteArrayOop]) ifFalse: "filters out CompiledMethods"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
0 to: (interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray) - 1 do:
[ :pos |
hash := hash + (aByteArray at: pos) * 16r19660D ].
interpreterProxy methodReturnInteger: (hash bitAnd: 16r0FFFFFFF)!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveTranslateStringWithTable (in category 'primitives') -----
primitiveTranslateStringWithTable
"ByteString (class) translate: aString from: start to: stop table: table"
+ <export: true flags: #FastCPrimitiveFlag>
- <export: true>
| aString start stop table aStringOop tableOop |
<var: #table type: #'unsigned char *'>
<var: #aString type: #'unsigned char *'>
aStringOop := interpreterProxy stackValue: 3.
(interpreterProxy isBytes: aStringOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy isOopImmutable: aStringOop) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
start := interpreterProxy stackIntegerValue: 2.
stop := interpreterProxy stackIntegerValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
tableOop := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: tableOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aString := interpreterProxy firstIndexableField: aStringOop.
(start >= 1 and: [stop <= (interpreterProxy sizeOfSTArrayFromCPrimitive: aString)]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
table := interpreterProxy firstIndexableField: tableOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: table) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start - 1 to: stop - 1 do: [ :i | aString at: i put: (table at: (aString at: i))].
interpreterProxy methodReturnReceiver!
Item was changed:
Cogit subclass: #SimpleStackBasedCogit
+ instanceVariableNames: 'primitiveGeneratorTable primSetFunctionLabel primInvokeInstruction introspectionDataIndex introspectionData'
- instanceVariableNames: 'primitiveGeneratorTable primSetFunctionLabel primInvokeInstruction externalPrimCallOffsets externalPrimJumpOffsets externalSetPrimOffsets introspectionDataIndex introspectionData'
classVariableNames: ''
poolDictionaries: 'VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices'
category: 'VMMaker-JIT'!
!SimpleStackBasedCogit commentStamp: '<historical>' prior: 0!
I am the stage one JIT for Cog that does not attempt to eliminate the stack via deferred code generation.!
Item was changed:
----- Method: SimpleStackBasedCogit class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
aCCodeGenerator vmClass primitiveTable ifNotNil:
[:bytecodeGenTable|
aCCodeGenerator
var: #primitiveGeneratorTable
declareC: 'static PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]',
(self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
in: aCCodeGenerator)].
aCCodeGenerator
- var: #externalPrimCallOffsets
- declareC: 'sqInt externalPrimCallOffsets[MaxNumArgs + MaxNumArgs + 2]';
- var: #externalPrimJumpOffsets
- declareC: 'sqInt externalPrimJumpOffsets[MaxNumArgs + MaxNumArgs + 2]';
- var: #externalSetPrimOffsets
- declareC: 'sqInt externalSetPrimOffsets[MaxNumArgs + MaxNumArgs + 2]';
var: #primSetFunctionLabel type: #'AbstractInstruction *';
var: #primInvokeInstruction type: #'AbstractInstruction *'!
Item was added:
+ ----- Method: SimpleStackBasedCogit>>cogMethodHasExternalPrim: (in category 'in-line cacheing') -----
+ cogMethodHasExternalPrim: aCogMethod
+ <api>
+ <var: 'aCogMethod' type: #'CogMethod *'>
+ | primIndex |
+ primIndex := coInterpreter primitiveIndexOfMethod: aCogMethod methodObject header: aCogMethod methodHeader.
+ ^primIndex = PrimNumberExternalCall
+ or: [primIndex = PrimNumberFFICall]!
Item was changed:
----- Method: SimpleStackBasedCogit>>cogMethodHasMachineCodePrim: (in category 'in-line cacheing') -----
cogMethodHasMachineCodePrim: aCogMethod
<api>
<var: 'aCogMethod' type: #'CogMethod *'>
- <inline: true>
| primIndex |
primIndex := coInterpreter primitiveIndexOfMethod: aCogMethod methodObject header: aCogMethod objectHeader.
^(primIndex between: 1 and: MaxCompiledPrimitiveIndex)
and: [(primitiveGeneratorTable at: primIndex) primitiveGenerator notNil]!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive (in category 'primitive generators') -----
compileInterpreterPrimitive
<inline: true>
+ | primitiveRoutine flags |
- | primitiveRoutine |
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
+ primitiveIndex: primitiveIndex
+ primitivePropertyFlagsInto: (self addressOf: flags put: [:val| flags := val]).
+ self deny: (flags anyMask: PrimCallOnSmalltalkStack).
+ ^self compileInterpreterPrimitive: primitiveRoutine flags: flags!
- primitiveIndex: primitiveIndex.
- ^ self
- compileInterpreterPrimitive: primitiveRoutine
- flags: (coInterpreter primitivePropertyFlags: primitiveIndex)!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive:flags: (in category 'primitive generators') -----
compileInterpreterPrimitive: primitiveRoutine flags: flags
"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)'>
| jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
-
"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 anyMask: PrimCallCollectsProfileSamples) ifTrue:
["Test nextProfileTick for being non-zero and call checkProfileTick if so"
objectMemory wordSize = 4
ifTrue:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize 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].
"Old old full prim trace is in VMMaker-eem.550 and prior.
Old simpler full prim trace is in VMMaker-eem.2969 and prior."
(coInterpreter recordPrimTraceForMethod: methodObj) ifTrue:
[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
"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.
"If required, set primitiveFunctionPointer and newMethod"
(flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
[self MoveCw: primitiveRoutine asInteger R: TempReg.
primSetFunctionLabel :=
self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
(flags anyMask: PrimCallNeedsNewMethod+PrimCallMayEndureCodeCompaction) ifTrue:
["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
(flags anyMask: PrimCallMayEndureCodeCompaction) 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 MoveR: TempReg Aw: coInterpreter newMethodAddress].
"Invoke the primitive"
self PrefetchAw: coInterpreter primFailCodeAddress.
(flags anyMask: PrimCallMayEndureCodeCompaction)
ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode."
["On Spur ceActivateFailingPrimitiveMethod: would like to retry if forwarders
are found. So insist on PrimCallNeedsPrimitiveFunction being set too."
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction)].
backEnd
genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil;
genSubstituteReturnAddress:
((flags anyMask: PrimCallCollectsProfileSamples)
ifTrue: [cePrimReturnEnterCogCodeProfiling]
ifFalse: [cePrimReturnEnterCogCode]).
primInvokeInstruction := self JumpFullRT: primitiveRoutine asInteger.
jmp := jmpSamplePrim := continuePostSamplePrim := nil]
ifFalse:
["Call the C primitive routine."
backEnd genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0.
primInvokeInstruction := self CallFullRT: primitiveRoutine asInteger.
backEnd genRemoveNArgsFromStack: 0.
(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
[self assert: (flags anyMask: PrimCallNeedsNewMethod).
"Test nextProfileTick for being non-zero and call checkProfileTick if so"
objectMemory wordSize = 4
ifTrue:
[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize 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].
objectRepresentation maybeCompileRetryOnPrimitiveFail: primitiveIndex.
"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 or load it into the LinkRegister to reestablish the return pc"
self MoveAw: coInterpreter instructionPointerAddress
R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
backEnd genLoadStackPointers.
"Test primitive failure"
self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
backEnd hasLinkRegister ifFalse: [self PushR: ClassReg]. "Restore return pc on CISCs"
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: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [objectMemory wordSize])
r: SPReg
R: ReceiverResultReg.
self RetN: objectMemory wordSize]. "return to caller, popping receiver"
(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
["The sample is collected by cePrimReturnEnterCogCode for external calls"
jmpSamplePrim ifNotNil:
["Call ceCheckProfileTick: to record sample and then continue."
jmpSamplePrim jmpTarget: self Label.
self assert: (flags anyMask: PrimCallNeedsNewMethod).
self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr]
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 CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr]
inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
"reenter the post-primitive call flow"
self Jump: continuePostSampleNonPrim].
jmp ifNotNil:
["Jump to restore of receiver reg and proceed to frame build for failure."
jmp jmpTarget: self Label.
"Restore receiver reg from stack. If on RISCs ret pc is in LinkReg, if on CISCs ret pc is on stack."
self MoveMw: objectMemory wordSize * (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1]))
r: SPReg
R: ReceiverResultReg].
^0!
Item was added:
+ ----- Method: SimpleStackBasedCogit>>compileOnStackExternalPrimitive: (in category 'primitive generators') -----
+ compileOnStackExternalPrimitive: primitiveRoutine
+ "Compile a fast call of a C primitive using the current stack page, avoiding the stack switch except on failure.
+ This convention still uses stackPointer and argumentCount to access operands. Push all operands to the stack,
+ assign stackPointer, argumentCount, and zero primFailCode. Make the call (saving a LinkReg if required).
+ Test for failure and return. On failure on Spur, if there is an accessor depth, assign framePointer and newMethod,
+ do the stack switch, call checkForAndFollowForwardedPrimitiveState, and loop back if forwarders are found.
+ Fall throguh tio frame build."
+
+ <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
+ | jmp retry calleeSavedReg |
+ "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.
+ self genExternalizeStackPointerForFastPrimitiveCall.
+ backEnd hasLinkRegister ifTrue:
+ [self PushR: LinkReg].
+ retry := self Label.
+ calleeSavedReg := NoReg.
+ (SPReg ~= NativeSPReg
+ and: [(self isCalleeSavedReg: SPReg) not]) ifTrue:
+ [calleeSavedReg := self availableRegisterOrNoneIn: ABICalleeSavedRegisterMask.
+ self deny: calleeSavedReg = NoReg.
+ self MoveR: SPReg R: calleeSavedReg].
+ self CallFullRT: primitiveRoutine.
+ self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
+ calleeSavedReg ~= NoReg ifTrue:
+ [self MoveR: calleeSavedReg R: SPReg].
+ self CmpCq: 0 R: TempReg.
+ jmp := self JumpNonZero: 0.
+ backEnd hasLinkRegister
+ ifTrue: [self PopR: LinkReg]
+ ifFalse: [self PopR: TempReg]. "i.e. save retpc"
+ self MoveAw: coInterpreter stackPointerAddress R: SPReg.
+ self PopR: ReceiverResultReg.
+ backEnd hasLinkRegister ifFalse: [self PushR: TempReg]. "i.e. restore retpc"
+ self RetN: 0.
+
+ jmp jmpTarget: self Label.
+ (objectRepresentation hasSpurMemoryManagerAPI
+ and: [(coInterpreter accessorDepthForExternalPrimitiveMethod: methodObj) >= 0]) ifTrue:
+ ["Given that following primitive state to the accessor depth is recursive, we're asking for
+ trouble if we run the fixup on the Smalltalk stack page. Run it on the full C stack instead.
+ This won't be a performance issue since primitive failure should be very rare."
+ self MoveR: FPReg Aw: coInterpreter framePointerAddress.
+ self genLoadCStackPointersForPrimCall.
+ methodLabel addDependent:
+ (self annotateAbsolutePCRef:
+ (self MoveCw: methodLabel asInteger R: ClassReg)).
+ self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
+ self MoveR: TempReg Aw: coInterpreter newMethodAddress.
+ self CallFullRT: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
+ inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState]).
+ backEnd genLoadStackPointers.
+ self CmpCq: 0 R: ABIResultReg.
+ self JumpNonZero: retry].
+ ^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>compilePrimitive (in category 'primitive generators') -----
compilePrimitive
"Compile a primitive. If possible, performance-critical primitives will
be generated by their own routines (primitiveGenerator). Otherwise,
if there is a primitive at all, we 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."
<inline: false>
| primitiveDescriptor primitiveRoutine flags |
<var: #primitiveDescriptor type: #'PrimitiveDescriptor *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
primitiveIndex = 0 ifTrue: [^0].
"If a descriptor specifies an argument count (by numArgs >= 0) then it must match
for the generated code to be correct. For example for speed many primitives use
ResultReceiverReg instead of accessing the stack, so the receiver better be at
numArgs down the stack. Use the interpreter version if not."
((primitiveDescriptor := self primitiveGeneratorOrNil) notNil
and: [primitiveDescriptor primitiveGenerator notNil
and: [(primitiveDescriptor primNumArgs < 0 "means generator doesn't care"
or: [primitiveDescriptor primNumArgs = (coInterpreter argumentCountOf: methodObj)])]]) ifTrue:
[| opcodeIndexAtPrimitive code |
"Note opcodeIndex so that any arg load instructions
for unimplemented primitives can be discarded."
opcodeIndexAtPrimitive := opcodeIndex.
code := objectRepresentation perform: primitiveDescriptor primitiveGenerator.
(code < 0 and: [code ~= UnimplementedPrimitive]) ifTrue: "Generator failed, so no point continuing..."
[^code].
"If the primitive can never fail then there is nothing more that needs to be done."
code = UnfailingPrimitive ifTrue:
[^0].
"If the machine code version handles all cases the only reason to call the interpreter
primitive is to reap the primitive error code. Don't bother if it isn't used."
(code = CompletePrimitive
and: [(self methodUsesPrimitiveErrorCode: methodObj header: methodHeader) not]) ifTrue:
[^0].
"Discard any arg load code generated by the primitive generator."
code = UnimplementedPrimitive ifTrue:
[opcodeIndex := opcodeIndexAtPrimitive]].
+ primitiveRoutine := coInterpreter
+ functionPointerForCompiledMethod: methodObj
+ primitiveIndex: primitiveIndex
+ primitivePropertyFlagsInto: (self addressOf: flags put: [:val| flags := val]).
- flags := coInterpreter primitivePropertyFlags: primitiveIndex.
(flags anyMask: PrimCallDoNotJIT) ifTrue:
[^ShouldNotJIT].
(flags anyMask: PrimCallOnSmalltalkStack) ifTrue:
+ [(flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue: "TEMPORARY HACK!!!!"
+ [^self compileOnStackExternalPrimitive: primitiveRoutine].
- [self assert: flags = PrimCallOnSmalltalkStack.
^self compileMachineCodeInterpreterPrimitive: (self cCoerceSimple: (coInterpreter mcprimFunctionForPrimitiveIndex: primitiveIndex)
to: 'void (*)(void)')].
+ (primitiveRoutine = 0 "no primitive"
- ((primitiveRoutine := coInterpreter
- functionPointerForCompiledMethod: methodObj
- primitiveIndex: primitiveIndex) = 0 "no primitive"
or: [primitiveRoutine = (self cCoerceSimple: #primitiveFail to: 'void (*)(void)')]) ifTrue:
[^self genFastPrimFail].
minValidCallAddress := minValidCallAddress min: primitiveRoutine asUnsignedInteger.
^self compileInterpreterPrimitive: primitiveRoutine flags: flags!
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."
| jumpFailNArgs jumpFail1 jumpFail2 jumpFail3 jumpFail4 jumpBCMethod primitiveRoutine result |
<var: #jumpFail1 type: #'AbstractInstruction *'>
<var: #jumpFail2 type: #'AbstractInstruction *'>
<var: #jumpFail3 type: #'AbstractInstruction *'>
<var: #jumpFail4 type: #'AbstractInstruction *'>
<var: #jumpFailNArgs type: #'AbstractInstruction *'>
<var: #jumpBCMethod type: #'AbstractInstruction *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
objectRepresentation genLoadSlot: ClosureNumArgsIndex sourceReg: ReceiverResultReg destReg: TempReg.
self CmpCq: (objectMemory integerObjectOf: methodOrBlockNumArgs) R: TempReg.
jumpFailNArgs := self JumpNonZero: 0.
objectRepresentation genLoadSlot: ClosureOuterContextIndex sourceReg: ReceiverResultReg destReg: ClassReg.
jumpFail1 := objectRepresentation genJumpImmediate: ClassReg.
objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: TempReg.
objectRepresentation genCmpClassMethodContextCompactIndexR: TempReg.
jumpFail2 := self JumpNonZero: 0.
"We defer unforwarding the receiver to the prologue; scanning blocks
for inst var refs and only unforwarding if the block refers to inst vars."
(false
and: [objectRepresentation hasSpurMemoryManagerAPI]) ifTrue:
[objectRepresentation
genLoadSlot: ReceiverIndex sourceReg: ClassReg destReg: SendNumArgsReg;
genEnsureOopInRegNotForwarded: SendNumArgsReg
scratchReg: TempReg
updatingSlot: ReceiverIndex
in: ClassReg].
objectRepresentation genLoadSlot: MethodIndex sourceReg: ClassReg destReg: SendNumArgsReg.
jumpFail3 := objectRepresentation genJumpImmediate: SendNumArgsReg.
objectRepresentation genGetFormatOf: SendNumArgsReg into: TempReg.
self CmpCq: objectMemory firstCompiledMethodFormat R: TempReg.
jumpFail4 := self JumpLess: 0.
objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
self MoveM16: (self offset: CogMethod of: #blockEntryOffset) r: ClassReg R: TempReg.
self AddR: ClassReg R: TempReg.
primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
+ primitiveIndex: primitiveIndex
+ primitivePropertyFlagsInto: nil.
- primitiveIndex: primitiveIndex.
primitiveRoutine = #primitiveClosureValueNoContextSwitch ifTrue:
[blockNoContextSwitchOffset = nil ifTrue:
[^NotFullyInitialized].
self SubCq: blockNoContextSwitchOffset R: TempReg].
self JumpR: TempReg.
jumpBCMethod jmpTarget: (jumpFail1 jmpTarget: (jumpFail2 jmpTarget: (jumpFail3 jmpTarget: (jumpFail4 jmpTarget: self Label)))).
(result := self
compileInterpreterPrimitive: primitiveRoutine
flags: (coInterpreter primitivePropertyFlags: primitiveIndex)) < 0 ifTrue:
[^result].
jumpFailNArgs jmpTarget: self Label.
^CompletePrimitive!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFullClosureValue (in category 'primitive generators') -----
genPrimitiveFullClosureValue
"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."
| jumpFailNArgs jumpFailImmediateMethod jumpFail4 jumpBCMethod primitiveRoutine result |
<option: #SistaV1BytecodeSet>
<var: #jumpFailImmediateMethod type: #'AbstractInstruction *'>
<var: #jumpFail4 type: #'AbstractInstruction *'>
<var: #jumpFailNArgs type: #'AbstractInstruction *'>
<var: #jumpBCMethod type: #'AbstractInstruction *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
objectRepresentation genLoadSlot: ClosureNumArgsIndex sourceReg: ReceiverResultReg destReg: TempReg.
self CmpCq: (objectMemory integerObjectOf: methodOrBlockNumArgs) R: TempReg.
jumpFailNArgs := self JumpNonZero: 0.
"We defer unforwarding the receiver to the prologue; scanning blocks
for inst var refs and only unforwarding if the block refers to inst vars."
(false
and: [objectRepresentation hasSpurMemoryManagerAPI]) ifTrue:
[objectRepresentation
genLoadSlot: FullClosureReceiverIndex sourceReg: ReceiverResultReg destReg: SendNumArgsReg;
genEnsureOopInRegNotForwarded: SendNumArgsReg
scratchReg: TempReg
updatingSlot: FullClosureReceiverIndex
in: ReceiverResultReg].
objectRepresentation genLoadSlot: FullClosureCompiledBlockIndex sourceReg: ReceiverResultReg destReg: SendNumArgsReg.
jumpFailImmediateMethod := objectRepresentation genJumpImmediate: SendNumArgsReg.
objectRepresentation genGetFormatOf: SendNumArgsReg into: TempReg.
self CmpCq: objectMemory firstCompiledMethodFormat R: TempReg.
jumpFail4 := self JumpLess: 0.
objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
+ primitiveIndex: primitiveIndex
+ primitivePropertyFlagsInto: nil.
- primitiveIndex: primitiveIndex.
self AddCq: (primitiveRoutine = #primitiveFullClosureValueNoContextSwitch
ifTrue: [self fullBlockNoContextSwitchEntryOffset]
ifFalse: [self fullBlockEntryOffset])
R: ClassReg.
self JumpR: ClassReg.
jumpBCMethod jmpTarget: (jumpFailImmediateMethod jmpTarget: (jumpFail4 jmpTarget: self Label)).
(result := self
compileInterpreterPrimitive: primitiveRoutine
flags: (coInterpreter primitivePropertyFlags: primitiveIndex)) < 0 ifTrue:
[^result].
jumpFailNArgs jmpTarget: self Label.
^CompletePrimitive!
Item was added:
+ ----- Method: SimpleStackBasedCogit>>isCalleeSavedReg: (in category 'register management') -----
+ isCalleeSavedReg: reg
+ <inline: true>
+ ^self register: reg isInMask: ABICalleeSavedRegisterMask!
Item was removed:
- ----- Method: SimpleStackBasedCogit>>recordCallOffsetIn: (in category 'external primitive support') -----
- recordCallOffsetIn: cogMethod
- "Remember the offsets in an external primitive method where the function address is assigned
- to primitiveFunctionPointer (Spur) and where the external function is either called or jumped to.
- This allows the machine code to be unlinked when a plugin is unloaded, etc."
- <api>
- <var: #cogMethod type: #'CogMethod *'>
- | index offset offsetTable |
- <var: #offsetTable type: #'sqInt *'>
- offset := primSetFunctionLabel address - cogMethod asInteger.
- index := (coInterpreter recordPrimTraceForMethod: cogMethod methodObject)
- ifTrue: [cogMethod cmNumArgs + MaxNumArgs + 1]
- ifFalse: [cogMethod cmNumArgs].
- (externalSetPrimOffsets at: index)
- ifNil: [externalSetPrimOffsets at: index put: offset]
- ifNotNil: [self assert: (externalSetPrimOffsets at: index) = offset].
- offsetTable := primInvokeInstruction isJump
- ifTrue: [externalPrimJumpOffsets]
- ifFalse: [externalPrimCallOffsets].
- offset := primInvokeInstruction address + primInvokeInstruction machineCodeSize - cogMethod asInteger.
- (offsetTable at: index)
- ifNil: [offsetTable at: index put: offset]
- ifNotNil: [self assert: (offsetTable at: index) = offset]!
Item was removed:
- ----- Method: SimpleStackBasedCogit>>rewritePrimInvocationIn:to: (in category 'external primitive support') -----
- rewritePrimInvocationIn: cogMethod to: primFunctionPointer
- <api>
- <var: #cogMethod type: #'CogMethod *'>
- <var: #primFunctionPointer declareC: #'void (*primFunctionPointer)(void)'>
- | primIndex flags index |
- self cCode: [] inSmalltalk:
- [primFunctionPointer isInteger ifFalse:
- [^self rewritePrimInvocationIn: cogMethod to: (self simulatedTrampolineFor: primFunctionPointer)]].
- self assert: cogMethod cmType = CMMethod.
- self ensureWritableCodeZone.
- index := (coInterpreter recordPrimTraceForMethod: cogMethod methodObject)
- ifTrue: [cogMethod cmNumArgs + MaxNumArgs + 1]
- ifFalse: [cogMethod cmNumArgs].
- primIndex := coInterpreter
- primitiveIndexOfMethod: cogMethod methodObject
- header: cogMethod methodHeader.
- flags := coInterpreter primitivePropertyFlags: primIndex.
- (flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
- [backEnd
- storeLiteral: primFunctionPointer asUnsignedInteger
- beforeFollowingAddress: cogMethod asUnsignedInteger
- + (externalSetPrimOffsets at: index)].
- "See compileInterpreterPrimitive:"
- (flags anyMask: PrimCallMayEndureCodeCompaction)
- ifTrue:
- [backEnd
- rewriteJumpFullAt: cogMethod asUnsignedInteger
- + (externalPrimJumpOffsets at: index)
- target: primFunctionPointer asUnsignedInteger]
- ifFalse:
- [backEnd
- rewriteCallFullAt: cogMethod asUnsignedInteger
- + (externalPrimCallOffsets at: index)
- target: primFunctionPointer asUnsignedInteger].
- backEnd
- flushICacheFrom: cogMethod asUnsignedInteger + cmNoCheckEntryOffset
- to: cogMethod asUnsignedInteger + cogMethod stackCheckOffset!
Item was changed:
----- Method: SimpleStackBasedCogit>>setInterpreter: (in category 'initialization') -----
setInterpreter: aCoInterpreter
"Initialization of the code generator in the simulator.
These objects already exist in the generated C VM
or are used only in the simulation."
<doNotGenerate>
super setInterpreter: aCoInterpreter.
primitiveGeneratorTable := self class primitiveTable.
- externalPrimJumpOffsets := CArrayAccessor on: (Array new: MaxNumArgs + 1 * 2).
- externalPrimCallOffsets := CArrayAccessor on: (Array new: MaxNumArgs + 1 * 2).
- externalSetPrimOffsets := CArrayAccessor on: (Array new: MaxNumArgs + 1 * 2).
(shortCutTrampolineBlocks := IdentityDictionary new)
at: #ceShortCutTraceBlockActivation:
put: [coInterpreter ceTraceBlockActivation];
at: #ceShortCutTraceLinkedSend:
put: [coInterpreter ceTraceLinkedSend: (processor registerAt: ReceiverResultReg)];
at: #ceShortCutTraceStore:
put: [coInterpreter
ceTraceStoreOf: (processor registerAt: ClassReg)
into: (processor registerAt: ReceiverResultReg)]!
Item was removed:
- ----- Method: SimpleStackBasedCogit>>voidCogCompiledCode (in category 'jit - api') -----
- voidCogCompiledCode
- <api>
- methodZone clearCogCompiledCode.
- 0 to: MaxNumArgs + MaxNumArgs + 1 do:
- [:i|
- externalPrimJumpOffsets at: i put: nil.
- externalPrimCallOffsets at: i put: nil.
- externalSetPrimOffsets at: i put: nil]!
Item was changed:
InterpreterPrimitives subclass: #StackInterpreter
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)
Item was added:
+ ----- Method: StackInterpreter class>>metadataFlagsForPrimitive: (in category 'spur compilation support') -----
+ metadataFlagsForPrimitive: aPrimitiveMethod
+ "We allow methods to decorate themselves with 8 flags (only one specified so far: FastCPrimitiveFlag)
+ using the export:flags: pragma. But this is not relevant to the StackInterpreter."
+ ^0!
Item was changed:
----- Method: StackInterpreter>>flushExternalPrimitiveTable (in category 'plugin primitive support') -----
flushExternalPrimitiveTable
"Flush the external primitive table"
+ 0 to: MaxExternalPrimitiveTableSize - 1 do:
+ [:i| externalPrimitiveTable at: i put: 0].
+ externalPrimitiveTableFirstFreeIndex := 0.
+ self cCode: '' inSmalltalk: [self initializePluginEntries]!
- 0 to: MaxExternalPrimitiveTableSize-1 do:[:i|
- externalPrimitiveTable at: i put: 0].
- externalPrimitiveTableFirstFreeIndex := 0!
Item was removed:
- ----- Method: StackInterpreter>>ioLoadExternalFunction:OfLength:FromModule:OfLength:AccessorDepthInto: (in category 'primitive support') -----
- ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength AccessorDepthInto: accessorDepthPtr
- "Load and return the requested function from a module. Assign the accessor depth through accessorDepthPtr.
- N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
- <doNotGenerate>
- | 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)].
- "We used to ignore loads of the SqueakFFIPrims plugin, but that means doing without integerAt:[put:]size:signed:
- which is too much of a limitation (not that these simulate unaligned accesses yet)."
- ^self ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr!
Item was added:
+ ----- Method: StackInterpreter>>ioLoadExternalFunction:OfLength:FromModule:OfLength:MetadataInto: (in category 'primitive support') -----
+ ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength MetadataInto: metadataPtr
+ "Load and return the requested function from a module. Assign the accessor depth and flags through metadataPtr.
+ N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
+ <doNotGenerate>
+ | 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)].
+ "We used to ignore loads of the SqueakFFIPrims plugin, but that means doing without integerAt:[put:]size:signed:
+ which is too much of a limitation (not that these simulate unaligned accesses yet)."
+ ^self ioLoadFunction: functionString From: pluginString MetadataInto: metadataPtr!
Item was added:
+ ----- Method: StackInterpreter>>metadataFlagsFor:using: (in category 'primitive support') -----
+ metadataFlagsFor: selector using: aCCodeGenerator
+ "Compute a primitive's metadata. This is the accessorDepth which is derived from parse tree analysis,
+ and some optional flags. Try and locate the flags parameter in an export:flags: pragma in the primitive method."
+ <doNotGenerate>
+
+ ^(((aCCodeGenerator accessorDepthForSelector: selector) ifNil: [0]) bitShift: 8)
+ + (self class metadataFlagsForPrimitive: ((aCCodeGenerator methodNamed: selector) ifNotNil: [:m| m definingClass >> m smalltalkSelector]))!
Item was changed:
----- Method: StackInterpreter>>primitiveAccessorDepthForExternalPrimitiveMethod: (in category 'primitive support') -----
primitiveAccessorDepthForExternalPrimitiveMethod: methodObj
+ ^(objectMemory integerValueOf:
- ^objectMemory integerValueOf:
(objectMemory
fetchPointer: 2
+ ofObject: (self literal: 0 ofMethod: methodObj))) bitShift: -8!
- ofObject: (self literal: 0 ofMethod: methodObj))!
Item was changed:
----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') -----
tryLoadNewPlugin: pluginString pluginEntries: pluginEntries
"Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin."
<doNotGenerate>
| plugin realPluginClass plugins |
self transcript cr; show: 'Looking for module ', pluginString.
pluginString isEmpty
ifTrue:
[plugin := self]
ifFalse:
[plugins := InterpreterPlugin allSubclasses select:
[:psc|
psc moduleName asString = pluginString asString
and: [psc shouldBeTranslated]].
plugins isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil].
plugins size > 1 ifTrue: [^self error: 'This won''t work...'].
"plugins size > 1 ifTrue:
[self transcript show: '...multiple plugin classes; choosing ', plugins last name]."
realPluginClass := plugins anyOne. "hopefully lowest in the hierarchy..."
plugin := realPluginClass simulatorForInterpreterInterface: objectMemory.
plugin ifNil: [self transcript show: ' ... no simulator class; cannot simulate'. ^nil].
(plugin respondsTo: #initialiseModule) ifTrue:
[plugin initialiseModule ifFalse:
[self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
self transcript show: ' ... loaded'.
objectMemory hasSpurMemoryManagerAPI ifTrue:
[| realPlugin cg |
self transcript show: '...computing accessor depths'.
plugin class isPluginClass
ifTrue:
[realPlugin := (plugin isSmartSyntaxPluginSimulator
ifTrue: [realPluginClass]
ifFalse: [plugin class])
withAllSuperclasses detect: [:class| class shouldBeTranslated].
cg := realPlugin buildCodeGenerator]
ifFalse:
[cg := self codeGeneratorToComputeAccessorDepth.
primitiveTable withIndexDo:
[:prim :index| | depth |
prim isSymbol ifTrue:
[depth := cg accessorDepthForSelector: prim.
self assert: (depth isInteger or: [depth isNil and: [(plugin class whichClassIncludesSelector: prim) isNil]]).
primitiveAccessorDepthTable at: index - 1 put: depth]]].
cg exportedPrimitiveNames do:
[:primName| | fnSymbol |
fnSymbol := primName asSymbol.
pluginEntries addLast: {plugin.
fnSymbol.
[plugin perform: fnSymbol. self].
+ self metadataFlagsFor: fnSymbol using: cg}].
- cg accessorDepthForSelector: fnSymbol}].
self transcript show: '...done'].
^pluginString asString -> plugin!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>linkExternalCall:ifFail: (in category 'plugin primitive support') -----
+ linkExternalCall: externalCallLiteral ifFail: failBlock
+ <inline: #always>
+ "The function has not been loaded yet. Fetch module and function name."
+ | addr functionLength functionName index metadata moduleLength moduleName |
+ <var: #addr declareC: 'void (*addr)()'>
+ moduleName := objectMemory fetchPointer: ExternalCallLiteralModuleNameIndex ofObject: externalCallLiteral.
+ moduleName = objectMemory nilObject
+ ifTrue: [moduleLength := 0]
+ ifFalse: [(objectMemory isBytes: moduleName) ifFalse:
+ [failBlock value.
+ ^0].
+ moduleLength := objectMemory lengthOf: moduleName].
+ functionName := objectMemory fetchPointer: ExternalCallLiteralFunctionNameIndex ofObject: externalCallLiteral.
+ (objectMemory isBytes: functionName) ifFalse:
+ [failBlock value.
+ ^0].
+ functionLength := objectMemory lengthOf: functionName.
+
+ "Spur needs metadata for the primitive, which is stored in the third slot of the literal."
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
+ OfLength: functionLength
+ FromModule: moduleName + objectMemory baseHeaderSize
+ OfLength: moduleLength
+ MetadataInto: (self addressOf: metadata
+ put: [:val| metadata := val]).
+ addr = 0
+ ifTrue: [index := -1]
+ ifFalse: "add the function to the external primitive table"
+ [index := self addToExternalPrimitiveTable: addr.
+ objectMemory
+ storePointerUnchecked: ExternalCallLiteralFlagsIndex
+ ofObject: externalCallLiteral
+ withValue: (objectMemory integerObjectOf: metadata)]]
+ ifFalse:
+ [addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
+ OfLength: functionLength
+ FromModule: moduleName + objectMemory baseHeaderSize
+ OfLength: moduleLength.
+ addr = 0
+ ifTrue: [index := -1]
+ ifFalse: "add the function to the external primitive table"
+ [index := self addToExternalPrimitiveTable: addr]].
+
+ "Store the index (or -1 if failure) back in the literal"
+ objectMemory
+ storePointerUnchecked: ExternalCallLiteralTargetFunctionIndex
+ ofObject: externalCallLiteral
+ withValue: (objectMemory integerObjectOf: index).
+
+ "If the function has been successfully loaded cache it"
+ self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (index >= 0
+ ifTrue: [self cCode: [addr] inSmalltalk: [1000 + index]]
+ ifFalse: [0]).
+ ^addr!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
primitiveDoNamedPrimitiveWithArgs
"Simulate an primitiveExternalCall invocation (e.g. for the Debugger). Do not cache anything.
e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
| argumentArray arraySize methodArg methodHeader
moduleName functionName moduleLength functionLength
spec addr primRcvr isArray |
<var: #addr declareC: 'void (*addr)()'>
objectMemory hasSpurMemoryManagerAPI ifTrue: "See checkForAndFollowForwardedPrimitiveState"
[metaAccessorDepth := -2].
argumentArray := self stackTop.
methodArg := self stackValue: 2.
((objectMemory isArray: argumentArray)
and: [objectMemory isOopCompiledMethod: methodArg]) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
arraySize := objectMemory numSlotsOf: argumentArray.
(self roomToPushNArgs: arraySize) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
methodHeader := objectMemory methodHeaderOf: methodArg.
(objectMemory literalCountOfMethodHeader: methodHeader) > 2 ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
isArray := self isInstanceOfClassArray: spec.
(isArray
and: [(objectMemory numSlotsOf: spec) = 4
and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = PrimNumberExternalCall]]) ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
"The function has not been loaded yet. Fetch module and function name."
moduleName := objectMemory fetchPointer: 0 ofObject: spec.
moduleName = objectMemory nilObject
ifTrue: [moduleLength := 0]
ifFalse: [self success: (objectMemory isBytes: moduleName).
moduleLength := objectMemory lengthOf: moduleName].
functionName := objectMemory fetchPointer: 1 ofObject: spec.
self success: (objectMemory isBytes: functionName).
functionLength := objectMemory lengthOf: functionName.
self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
"Spur needs to know the primitive's accessorDepth."
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
OfLength: functionLength
FromModule: moduleName + objectMemory baseHeaderSize
OfLength: moduleLength
+ MetadataInto: (self addressOf: metaAccessorDepth
- AccessorDepthInto: (self addressOf: metaAccessorDepth
put: [:val| metaAccessorDepth := val]).
+ "N.B. the accessor depth is the second byte of the primitive's metadata;
+ the first byte is various flags (currently l.s.b. = use fast C linkage)."
+ metaAccessorDepth := addr = 0 ifTrue: [-2] ifFalse: [metaAccessorDepth bitShift: -8]]
- addr = 0 ifTrue:
- [metaAccessorDepth := -2]]
ifFalse:
[addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
OfLength: functionLength
FromModule: moduleName + objectMemory baseHeaderSize
OfLength: moduleLength].
addr = 0 ifTrue:
[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
"Cannot fail this primitive from now on. Can only fail the external primitive."
tempOop := objectMemory
eeInstantiateClassIndex: ClassArrayCompactIndex
format: objectMemory arrayFormat
numSlots: 4.
objectMemory
storePointerUnchecked: 0 ofObject: tempOop withValue: (argumentArray := self popStack);
storePointerUnchecked: 1 ofObject: tempOop withValue: (primRcvr := self popStack);
storePointerUnchecked: 2 ofObject: tempOop withValue: self popStack; "the method"
storePointerUnchecked: 3 ofObject: tempOop withValue: self popStack. "the context receiver"
self push: primRcvr. "replace context receiver with actual receiver"
argumentCount := arraySize.
1 to: arraySize do:
[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
self callExternalPrimitive: addr.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[self pop: arraySize + 1.
self push: (objectMemory fetchPointer: 3 ofObject: tempOop).
self push: (objectMemory fetchPointer: 2 ofObject: tempOop).
self push: (objectMemory fetchPointer: 1 ofObject: tempOop).
self push: (objectMemory fetchPointer: 0 ofObject: tempOop).
argumentCount := 3.
"Must reset primitiveFunctionPointer for checkForAndFollowForwardedPrimitiveState"
objectMemory hasSpurMemoryManagerAPI ifTrue:
[primitiveFunctionPointer := #primitiveDoNamedPrimitiveWithArgs].
"Hack. A nil prim error code (primErrorCode = 1) is interpreted by the image
as meaning this primitive is not implemented. So to pass back nil as an error
code we use -1 to indicate generic failure."
primFailCode = 1 ifTrue:
[primFailCode := -1]]!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') -----
primitiveExternalCall
"Call an external primitive. External primitive methods first literals are an array of
* The module name (String | Symbol)
* The function name (String | Symbol)
+ * The session ID (SmallInteger) [OBSOLETE], or in Spur, the metadata (accessorDepth and flags; Integer))
- * The session ID (SmallInteger) [OBSOLETE], or in Spur, the accessorDepth (Integer)
* The function index (Integer) in the externalPrimitiveTable
For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer
in the method cache is rewritten, either to the function itself, or to zero if the external
function is not found. This allows for fast responses as long as the method stays in
the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in
addNewMethodToCache:.
Now that the VM flushes function addresses from its tables, the session ID is obsolete,
but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a
method has been looked up and not been found, the function address is stored as -1
(i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from
lookup), and the primitive fails with PrimErrNotFound."
+ | lit addr index |
- | lit addr moduleName functionName moduleLength functionLength accessorDepth index |
- <var: #addr declareC: 'void (*addr)()'>
"Check for it being a method for primitiveDoPrimitiveWithArgs.
Fetch the first literal of the method; check its an Array of length 4.
Look at the function index in case it has been loaded before"
((objectMemory isOopCompiledMethod: newMethod)
and: [(objectMemory literalCountOf: newMethod) > 0
and: [lit := self literal: 0 ofMethod: newMethod.
(objectMemory isArray: lit)
and: [(objectMemory numSlotsOf: lit) = 4
+ and: [index := objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit.
- and: [index := objectMemory fetchPointer: 3 ofObject: lit.
objectMemory isIntegerObject: index]]]]) ifFalse:
[^self primitiveFailFor: PrimErrBadMethod].
index := objectMemory integerValueOf: index.
"Check if we have already looked up the function and failed."
index < 0 ifTrue:
["Function address was not found in this session,
Void the primitive function."
self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
^self primitiveFailFor: PrimErrNotFound].
"Try to call the function directly"
(index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue:
[addr := externalPrimitiveTable at: index - 1.
addr ~= 0 ifTrue:
[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]).
self callExternalPrimitive: addr. "On Spur, sets primitiveFunctionPointer"
self maybeRetryPrimitiveOnFailure.
^nil].
"if we get here, then an index to the external prim was
kept on the ST side although the underlying prim
table was already flushed"
^self primitiveFailFor: PrimErrNamedInternal].
+ "Clean up session id/metadata and external primitive index"
+ objectMemory storePointerUnchecked: ExternalCallLiteralFlagsIndex ofObject: lit withValue: ConstZero.
+ objectMemory storePointerUnchecked: ExternalCallLiteralTargetFunctionIndex ofObject: lit withValue: ConstZero.
- "Clean up session id and external primitive index"
- objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
- objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
+ "The function has not been loaded yet. Attempt to link it, cache it, and call it."
+ addr := self linkExternalCall: lit ifFail: [^self primitiveFailFor: PrimErrBadMethod].
+ addr = 0 ifTrue:
+ [self assert: (objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit) = ConstZero.
+ ^self primitiveFailFor: PrimErrNotFound].
- "The function has not been loaded yet. Fetch module and function name."
- moduleName := objectMemory fetchPointer: 0 ofObject: lit.
- moduleName = objectMemory nilObject
- ifTrue: [moduleLength := 0]
- ifFalse: [(objectMemory isBytes: moduleName) ifFalse:
- [self primitiveFailFor: PrimErrBadMethod].
- moduleLength := objectMemory lengthOf: moduleName].
- functionName := objectMemory fetchPointer: 1 ofObject: lit.
- (objectMemory isBytes: functionName) ifFalse:
- [self primitiveFailFor: PrimErrBadMethod].
- functionLength := objectMemory lengthOf: functionName.
+ self callExternalPrimitive: addr.
+ self maybeRetryPrimitiveOnFailure !
- "Spur needs to know the primitive's accessorDepth which is stored in the third slot of the first literal."
- objectMemory hasSpurMemoryManagerAPI
- ifTrue:
- [addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
- OfLength: functionLength
- FromModule: moduleName + objectMemory baseHeaderSize
- OfLength: moduleLength
- AccessorDepthInto: (self addressOf: accessorDepth
- put: [:val| accessorDepth := val]).
- addr = 0
- ifTrue: [index := -1]
- ifFalse: "add the function to the external primitive table"
- [index := self addToExternalPrimitiveTable: addr.
- objectMemory
- storePointerUnchecked: 2
- ofObject: lit
- withValue: (objectMemory integerObjectOf: accessorDepth)]]
- ifFalse:
- [addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
- OfLength: functionLength
- FromModule: moduleName + objectMemory baseHeaderSize
- OfLength: moduleLength.
- addr = 0
- ifTrue: [index := -1]
- ifFalse: "add the function to the external primitive table"
- [index := self addToExternalPrimitiveTable: addr]].
-
- "Store the index (or -1 if failure) back in the literal"
- objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
-
- "If the function has been successfully loaded cache and call it"
- index >= 0
- ifTrue:
- [self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: [addr] inSmalltalk: [1000 + index]).
- self callExternalPrimitive: addr.
- self maybeRetryPrimitiveOnFailure]
- ifFalse: "Otherwise void the primitive function and fail"
- [self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
- self assert: (objectMemory fetchPointer: 2 ofObject: lit) = ConstZero.
- self primitiveFailFor: PrimErrNotFound]!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveVoidVMState (in category 'system control primitives') -----
primitiveVoidVMState
"Void all internal VM state in the stack and machine code zones"
| activeContext |
self push: instructionPointer.
activeContext := self voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
+ self flushMethodCache.
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext!
Item was removed:
- ----- Method: StackInterpreterSimulator>>flushExternalPrimitives (in category 'plugin support') -----
- flushExternalPrimitives
- self initializePluginEntries.
- super flushExternalPrimitives!
Item was changed:
----- Method: StackInterpreterSimulator>>initializePluginEntries (in category 'plugin support') -----
+ initializePluginEntries
- initializePluginEntries.
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
[pluginList := {'' -> self }]!
Item was added:
+ ----- Method: StackInterpreterSimulator>>ioListBuiltinModule: (in category 'simulation support') -----
+ ioListBuiltinModule: index
+ ^index > 0 ifTrue:
+ [(InitializationOptions
+ at: #builtinModules
+ ifAbsent: [#('BitBltPlugin' 'FloatArrayPlugin' 'FloatMathPlugin' 'LargeIntegers' 'MiscPrimitivePlugin')]) at: index ifAbsent: nil]!
Item was added:
+ ----- Method: StackInterpreterSimulator>>ioListLoadedModule: (in category 'simulation support') -----
+ ioListLoadedModule: index
+ ^index > 0 ifTrue: [(pluginList at: index + 1 ifAbsent: [^nil]) key]!
Item was removed:
- ----- Method: StackInterpreterSimulator>>ioLoadFunction:From:AccessorDepthInto: (in category 'plugin support') -----
- ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr
- "Load and return the requested function from a module.
- Assign the accessor depth through accessorDepthPtr.
- N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
- | firstTime plugin fnSymbol |
- firstTime := false.
- fnSymbol := functionString asSymbol.
- transcript
- cr;
- show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
- (pluginString isEmpty ifTrue: ['vm'] ifFalse: [pluginString]).
- (breakSelector notNil
- and: [(pluginString size = breakSelector size
- and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0])
- or: [functionString size = breakSelector size
- and: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
- [self halt: pluginString, '>>', functionString].
- plugin := pluginList
- detect: [:any| any key = pluginString asString]
- ifNone:
- [firstTime := true.
- self loadNewPlugin: pluginString].
- plugin ifNil:
- [firstTime ifTrue: [transcript show: '... FAILED; no plugin found'].
- ^0].
- plugin := plugin value.
- mappedPluginEntries withIndexDo:
- [:pluginAndName :index|
- ((pluginAndName at: 1) == plugin
- and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
- [firstTime ifTrue: [transcript show: ' ... okay'].
- accessorDepthPtr at: 0 put: (pluginAndName at: 4).
- ^index]].
- firstTime ifTrue: [transcript show: '... FAILED; primitive not in plugin'].
- ^0!
Item was added:
+ ----- Method: StackInterpreterSimulator>>ioLoadFunction:From:MetadataInto: (in category 'plugin support') -----
+ ioLoadFunction: functionString From: pluginString MetadataInto: metadataPtr
+ "Load and return the requested function from a module.
+ Assign the accessor depth and flags through metadataPtr.
+ N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
+ | firstTime plugin fnSymbol |
+ firstTime := false.
+ fnSymbol := functionString asSymbol.
+ transcript
+ cr;
+ show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
+ (pluginString isEmpty ifTrue: ['vm'] ifFalse: [pluginString]).
+ (breakSelector notNil
+ and: [(pluginString size = breakSelector size
+ and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0])
+ or: [functionString size = breakSelector size
+ and: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
+ [self halt: pluginString, '>>', functionString].
+ plugin := pluginList
+ detect: [:any| any key = pluginString asString]
+ ifNone:
+ [firstTime := true.
+ self loadNewPlugin: pluginString].
+ plugin ifNil:
+ [firstTime ifTrue: [transcript show: '... FAILED; no plugin found'].
+ ^0].
+ plugin := plugin value.
+ mappedPluginEntries withIndexDo:
+ [:pluginAndName :index|
+ ((pluginAndName at: 1) == plugin
+ and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
+ [firstTime ifTrue: [transcript show: ' ... okay'].
+ metadataPtr at: 0 put: (pluginAndName at: 4).
+ ^index]].
+ firstTime ifTrue: [transcript show: '... FAILED; primitive not in plugin'].
+ ^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genExternalizePointersForPrimitiveCall (in category 'trampoline support') -----
genExternalizePointersForPrimitiveCall
+ "Override to push the register receiver and register arguments, if any."
- " Override to push the register receiver and register arguments, if any."
self genPushRegisterArgs.
^super genExternalizePointersForPrimitiveCall!
Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genExternalizeStackPointerForFastPrimitiveCall (in category 'trampoline support') -----
+ genExternalizeStackPointerForFastPrimitiveCall
+ "Override to push the register receiver and register arguments, if any."
+ self genPushRegisterArgs.
+ ^super genExternalizeStackPointerForFastPrimitiveCall!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genPushRegisterArgs (in category 'compile abstract instructions') -----
genPushRegisterArgs
"Ensure that the register args are pushed before the retpc for methods with arity <= self numRegArgs."
+ "This isn't as clumsy on a RISC. But putting the receiver and
- "This won't be as clumsy on a RISC. But putting the receiver and
args above the return address means the CoInterpreter has a
single machine-code frame format which saves us a lot of work."
(regArgsHaveBeenPushed
or: [methodOrBlockNumArgs > self numRegArgs]) ifFalse:
[backEnd genPushRegisterArgsForNumArgs: methodOrBlockNumArgs scratchReg: SendNumArgsReg.
regArgsHaveBeenPushed := true]!
Item was added:
+ ----- Method: Symbol>>asVoidPointer (in category '*VMMaker-interpreter simulator') -----
+ asVoidPointer
+ ^self!
Item was changed:
----- Method: TMethod>>compiledMethod (in category 'accessing') -----
compiledMethod
^definingClass
+ compiledMethodAt: self smalltalkSelector
- compiledMethodAt: selector
ifAbsent: [definingClass compiledMethodAt: properties selector]!
Item was changed:
----- Method: TMethod>>extractExportDirective (in category 'transformations') -----
extractExportDirective
"Scan the top-level statements for an inlining directive of the form:
self export: <boolean>
and remove the directive from the method body. Answer the
argument of the directive or false if there is no export directive."
^self
+ extractDirective: ((properties includesKey: #export:flags:) ifTrue: [#export:flags:] ifFalse: [#export:])
- extractDirective: #export:
valueBlock: [:sendNode| sendNode args first value ~= false]
default: false!
Item was changed:
SharedPool subclass: #VMBasicConstants
instanceVariableNames: ''
+ classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMForFFICall DisownVMForThreading DoAssertionChecks DoExpensiveAssertionChecks FastCPrimitiveFlag GCCheckFreeSpace GCCheckImageSegment GCCheckPrimCall GCCheckShorten GCModeBecome GCModeFull GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrFFIException PrimErrGenericFailure PrimErrInappropriate PrimErrInternalError PrimErrLimitExceeded PrimErrNamedInternal PrimErrNeedCompaction PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrOperationFailed PrimErrUninitialized PrimErrUnsupported PrimErrWritePastObject PrimNoErr PrimNumberHand
lerMarker PrimNumberNoContextSwitchMarker PrimNumberUnwindMarker SPURVM STACKVM SistaVM TempVectReadBarrier VMBIGENDIAN'
- classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMForFFICall DisownVMForThreading DoAssertionChecks DoExpensiveAssertionChecks GCCheckFreeSpace GCCheckImageSegment GCCheckPrimCall GCCheckShorten GCModeBecome GCModeFull GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrFFIException PrimErrGenericFailure PrimErrInappropriate PrimErrInternalError PrimErrLimitExceeded PrimErrNamedInternal PrimErrNeedCompaction PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrOperationFailed PrimErrUninitialized PrimErrUnsupported PrimErrWritePastObject PrimNoErr PrimNumberHandlerMarker PrimNumbe
rNoContextSwitchMarker PrimNumberUnwindMarker SPURVM STACKVM SistaVM TempVectReadBarrier VMBIGENDIAN'
poolDictionaries: ''
category: 'VMMaker-Interpreter'!
!VMBasicConstants commentStamp: '<historical>' prior: 0!
I am a shared pool for basic constants upon which the VM as a whole depends.
self ensureClassPool.
self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
(ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
[:k| self classPool declare: k from: ObjectMemory classPool]!
Item was changed:
SharedPool subclass: #VMBytecodeConstants
instanceVariableNames: ''
+ classVariableNames: 'BytecodeSetHasDirectedSuperSend CtxtTempFrameStart LargeContextBit LargeContextSize LargeContextSlots NewsqueakV4BytecodeSet PrimNumberDoExternalCall PrimNumberDoPrimitive PrimNumberExternalCall PrimNumberFFICall PrimNumberInstVarAt PrimNumberShallowCopy PrimNumberSlotAt SistaV1BytecodeSet SmallContextSize SmallContextSlots SqueakV3PlusClosuresBytecodeSet'
- classVariableNames: 'BytecodeSetHasDirectedSuperSend CtxtTempFrameStart LargeContextBit LargeContextSize LargeContextSlots NewsqueakV4BytecodeSet SistaV1BytecodeSet SmallContextSize SmallContextSlots SqueakV3PlusClosuresBytecodeSet'
poolDictionaries: 'VMBasicConstants'
category: 'VMMaker-Interpreter'!
!VMBytecodeConstants commentStamp: '<historical>' prior: 0!
self ensureClassPool.
#(CtxtTempFrameStart LargeContextBit LargeContextSize SmallContextSize) do:
[:k|
self classPool declare: k from: ObjectMemory classPool]!
Item was removed:
- ----- Method: VMPluginCodeGenerator>>emitAccessorDepthsOn: (in category 'C code generator') -----
- emitAccessorDepthsOn: aStream
- "Output accessor depth bytes for all primitives in the plugin.
- This is for external primitives in Spur."
- self sortedExportMethods do:
- [:method| | primName |
- primName := self cFunctionNameFor: method selector.
- (self accessorDepthForSelector: primName asSymbol) ifNotNil:
- [:depth|
- "store the accessor depth in a byte variable; save a little space
- by omitting depths < 0; support code supplies the default."
- self assert: depth < 128.
- depth >= 0 ifTrue:
- [self withOptionalConditionalDefineFor: method
- on: aStream
- do: [aStream
- nextPutAll: 'EXPORT(signed char) ';
- nextPutAll: primName;
- nextPutAll: 'AccessorDepth = ';
- nextPutAll: (self cLiteralFor: depth);
- nextPut: $;;
- cr]]]]!
Item was changed:
----- Method: VMPluginCodeGenerator>>emitExportsOn: (in category 'C code generator') -----
emitExportsOn: aStream
"Store all the exported primitives in the form used by the internal named prim system."
| nilVMClass |
(nilVMClass := vmClass isNil) ifTrue: "We need a vmClass temporarily to compute accessor depths."
[vmClass := StackInterpreter].
aStream cr; cr; nextPutAll:'#ifdef SQUEAK_BUILTIN_PLUGIN'.
self emitExportsNamed: pluginClass moduleName
pluginName: pluginClass internalModuleName
on: aStream.
aStream cr; nextPutAll: '#else /* ifdef SQ_BUILTIN_PLUGIN */'; cr; cr.
+ self emitPrimitiveMetadataOn: aStream.
- self emitAccessorDepthsOn: aStream.
aStream cr; nextPutAll: '#endif /* ifdef SQ_BUILTIN_PLUGIN */'; cr.
nilVMClass ifTrue:
[vmClass := nil]!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>emitPrimitiveMetadataOn: (in category 'C code generator') -----
+ emitPrimitiveMetadataOn: aStream
+ "Output accessor depth bytes for all primitives in the plugin.
+ This is for external primitives in Spur."
+ self exportsNeedingMetadata do:
+ [:method| | primName depth exportFlags |
+ primName := self cFunctionNameFor: method selector.
+ depth := self accessorDepthForMethod: method.
+ exportFlags := CoInterpreter metadataFlagsForPrimitive: method compiledMethod.
+ (depth >= 0 or: [exportFlags > 0]) ifTrue:
+ ["store the metadata in a short variable; save a little space
+ by omitting depths < 0; support code supplies the default."
+ self assert: depth < 128.
+ self withOptionalConditionalDefineFor: method
+ on: aStream
+ do: [aStream
+ nextPutAll: 'EXPORT(signed short) ';
+ nextPutAll: primName;
+ nextPutAll: 'Metadata = ';
+ nextPutAll: (self cLiteralFor: (depth bitShift: 8) + exportFlags);
+ nextPut: $;;
+ cr]]]!
More information about the Vm-dev
mailing list