Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2195.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2195 Author: eem Time: 17 April 2017, 5:11:48.443128 pm UUID: 6a437cbf-eb21-432f-83ea-a1d28e00b193 Ancestors: VMMaker.oscog-eem.2194 StackInterpreter: Add hash multiply under primitive number 159. Cogit: Implement calling C primitive on Smalltalk stack support in compileMachineCodeInterpreterPrimitive:. Refactor compileInterpreterPrimitive: to compileInterpreterPrimitive:flags:, accessed via the CoInterrpeter supplying the PrimCallOnSmalltalkStack flag, moving the flags extraction to compilePrimitive. Leave an unused C primitive on Smalltalk stack version of hashMultiply (mcprimHashMultiply:). Implement as machine code (genPrimitiveHashMultiply) because its significantly faster. Remove PrimitiveExternalCallIndex an favour of PrimNumberExternalCall. Sista: Use duff's device to generate more compact instane intialization in the inline pointer new primitive bytecode. As yet untested!! Comment the inverse form of extJumpIfNotInstanceOfBehaviorsBytecode Slang: Corrct a comment and a variable name in emitCAPIExportHeaderOn:. =============== Diff against VMMaker.oscog-eem.2194 =============== Item was changed: ----- Method: CCodeGenerator>>emitCAPIExportHeaderOn: (in category 'C code generator') ----- emitCAPIExportHeaderOn: aStream + "Store prototype declarations for all API methods on the given stream." + | exportedAPIMethods usedConstants | + exportedAPIMethods := self sortMethods: (methods select: [:m| m isAPIMethod]). + exportedAPIMethods do: - "Store prototype declarations for all non-inlined methods on the given stream." - | apiMethods usedConstants | - apiMethods := self sortMethods: (methods select: [:m| m isAPIMethod]). - apiMethods do: [:m| m static ifTrue: [logger ensureCr; show: m selector, ' excluded from export API because it is static'; cr]]. + self emitCFunctionPrototypes: exportedAPIMethods on: aStream. - self emitCFunctionPrototypes: apiMethods on: aStream. self emitGlobalCVariablesOn: aStream. + usedConstants := self emitCMacros: exportedAPIMethods on: aStream. - usedConstants := self emitCMacros: apiMethods on: aStream. self emitCConstants: usedConstants on: aStream! Item was changed: StackInterpreterPrimitives subclass: #CoInterpreter instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod reenterInterpreter deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile' + classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimNumberHashMultiply PrimTraceLogSize ReturnToInterpreter 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 PrimTraceLogSize ReturnToInterpreter 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: '<historical>' 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.! Item was changed: ----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') ----- initializeMiscConstants super initializeMiscConstants. COGVM := true. MinBackwardJumpCountForCompile := 40. MaxNumArgs := 15. PrimCallNeedsNewMethod := 1. PrimCallNeedsPrimitiveFunction := 2. PrimCallMayCallBack := 4. + PrimCallOnSmalltalkStack := 8. + PrimCallCollectsProfileSamples := 16. + CheckAllocationFillerAfterPrimCall := 32. + PrimCallDoNotJIT := 64. - PrimCallCollectsProfileSamples := 8. - CheckAllocationFillerAfterPrimCall := 16. - PrimCallDoNotJIT := 32. ReturnToInterpreter := 1. "setjmp/longjmp code." 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 changed: ----- Method: CoInterpreter class>>initializePrimitiveTable (in category 'initialization') ----- initializePrimitiveTable super initializePrimitiveTable. + PrimNumberHashMultiply := 159. + self assert: (PrimitiveTable at: PrimNumberHashMultiply + 1) = #primitiveHashMultiply. + #(216 253) do: [:pidx| self assert: (PrimitiveTable at: pidx + 1) = #primitiveFail]. self assert: (PrimitiveTable at: 215 + 1) = #primitiveFlushCacheByMethod. PrimitiveTable at: 253 + 1 put: #primitiveCollectCogCodeConstituents; at: 215 + 1 put: #primitiveVoidVMStateForMethod; at: 216 + 1 put: #primitiveMethodXray! Item was changed: ----- Method: CoInterpreter>>flushExternalPrimitiveOf: (in category 'plugin primitive support') ----- flushExternalPrimitiveOf: methodObj "methodObj is a CompiledMethod containing an external primitive. Flush the function address and session ID of the CM. Override to also flush the machine code call if one exists." <api> | primIdx | primIdx := super flushExternalPrimitiveOf: methodObj. + (primIdx = PrimNumberExternalCall - (primIdx = PrimitiveExternalCallIndex and: [self methodHasCogMethod: methodObj]) ifTrue: [cogit rewritePrimInvocationIn: (self cogMethodOf: methodObj) to: #primitiveExternalCall]! Item was added: + ----- Method: CoInterpreter>>mcprimFunctionForPrimitiveIndex: (in category 'cog jit support') ----- + mcprimFunctionForPrimitiveIndex: primIndex + <api> + primIndex = PrimNumberHashMultiply ifTrue: + [^#mcprimHashMultiply:]. + self error: 'unknown mcprim'. + ^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 cCode: [] inSmalltalk: [#(primitiveExternalCall primitiveCalloutToFFI)]. "For senders..." (primIndex = PrimNumberExternalCall "#primitiveExternalCall" or: [primIndex = PrimNumberFFICall "#primitiveCalloutToFFI"]) ifTrue: "For callbacks" [baseFlags := baseFlags bitOr: PrimCallMayCallBack. checkAllocFiller ifTrue: [baseFlags := baseFlags bitOr: CheckAllocationFillerAfterPrimCall]]. ^baseFlags! Item was added: + ----- Method: CoInterpreterPrimitives>>mcprimHashMultiply: (in category 'arithmetic primitives') ----- + mcprimHashMultiply: receiverArg + "Machine code primitive for hash multiply. c.f. primitiveHashMultiply. + mcprims consume receiver and arguments as parameters and answer the + result on success, or set the primitive error code and answer 0 on failure." + "Implement 28-bit hashMultiply for SmallInteger and LargePositiveInteger receivers." + <api> + | receiver low | + (objectMemory isIntegerObject: receiverArg) + ifTrue: [receiver := objectMemory integerValueOf: receiverArg] + ifFalse: + [| ok | + ok := objectMemory is: receiverArg instanceOf: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. + ok ifFalse: + [self primitiveFailFor: PrimErrBadReceiver. + ^0]. + receiver := objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: receiverArg)]. + low := receiver bitAnd: 16383. + "N.B. We use undefined behaviour assuming the compiler will still generate a multiply, rather than simply crap out, so as to save the unnecessary bitAnd: 16383." + ^objectMemory integerObjectOf: ((16r260D * low + ((16r260D * (receiver bitShift: -14) + (16r0065 * low) "bitAnd: 16383") * 16384)) bitAnd: 16r0FFFFFFF)! Item was changed: SharedPool subclass: #CogMethodConstants instanceVariableNames: '' + classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CheckAllocationFillerAfterPrimCall CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallMayCallBack PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction PrimCallOnSmalltalkStack ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC' - classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CheckAllocationFillerAfterPrimCall CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallMayCallBack PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC' poolDictionaries: '' category: 'VMMaker-JIT'! Item was added: + ----- Method: CogObjectRepresentation>>genPrimitiveHashMultiply (in category 'primitive generators') ----- + genPrimitiveHashMultiply + <doNotGenerate> + ^cogit genPrimitiveHashMultiply! Item was added: + ----- Method: CogObjectRepresentationForSpur>>genGetInstanceOfFixedClass:into:initializingIf: (in category 'bytecode generator support') ----- + genGetInstanceOfFixedClass: classObj into: destReg initializingIf: initializeInstance + "Create an instance of classObj and assign it to destReg, initializing the instance + if initializeInstance is true with nil or 0 as appropriate This is for inline primitives. + Assume there is sufficient space in new space to complete the operation. + Answer zero on success." + | classIndex classFormat header slots branch constReg inst loop delta loopCount slotsPerIteration | + ((objectMemory isNonImmediate: classObj) + and: [(coInterpreter objCouldBeClassObj: classObj) + and: [(classIndex := objectMemory rawHashBitsOf: classObj) ~= 0 + and: [(objectMemory isFixedSizePointerFormat: (objectMemory instSpecOfClassFormat: (classFormat := objectMemory formatOfClass: classObj))) + and: [(slots := objectMemory fixedFieldsOfClassFormat: classFormat) < objectMemory numSlotsMask]]]]) ifFalse: + [^UnimplementedOperation]. + + header := objectMemory + headerForSlots: slots + format: (objectMemory instSpecOfClassFormat: classFormat) + classIndex: classIndex. + + cogit MoveAw: objectMemory freeStartAddress R: destReg. + self genStoreHeader: header intoNewInstance: destReg using: TempReg. + cogit + LoadEffectiveAddressMw: (objectMemory smallObjectBytesForSlots: slots) r: destReg R: TempReg; + MoveR: TempReg Aw: objectMemory freeStartAddress. + (initializeInstance and: [slots > 0]) ifFalse: + [^0]. + slots <= (slotsPerIteration := 8) ifTrue: "slotsPerIteration must be a power of two. see bitAnd: below" + [cogit genMoveConstant: objectMemory nilObject R: TempReg. + 0 to: slots - 1 do: + [:i| cogit MoveR: TempReg + Mw: i * objectMemory wordSize + objectMemory baseHeaderSize + r: destReg]. + ^0]. + constReg := cogit allocateRegNotConflictingWith: destReg. + cogit genMoveConstant: objectMemory nilObject R: constReg. + + slots \\ slotsPerIteration ~= 0 + ifTrue: + [delta := objectMemory baseHeaderSize - ((slotsPerIteration - (slots \\ slotsPerIteration) bitAnd: slotsPerIteration - 1) * objectMemory bytesPerOop). + delta ~= 0 ifTrue: + [cogit AddCq: delta R: destReg]. + branch := cogit Jump: 0] + ifFalse: + [delta := objectMemory baseHeaderSize. + cogit AddCq: objectMemory baseHeaderSize R: destReg]. + loopCount := slots + slotsPerIteration - 1 // slotsPerIteration. + self assert: loopCount > 1. + loop := cogit Label. + 0 to: 7 do: + [:i| + inst := cogit MoveR: constReg Mw: i * objectMemory bytesPerOop r: destReg. + slotsPerIteration - (slots \\ slotsPerIteration) = i ifTrue: + [branch jmpTarget: inst]]. + "N.B. We get away with comparing against TempReg, which points to the start of the next + object, not necessarily immediately after the last slot, because if the size is a multiple of 8, + TempReg will point after the last slot, and if the size is not a multiple of 8 then the add of + slotsPerIteration * objectMemory bytesPerOop will put destReg beyond TempReg any way." + cogit + AddCq: slotsPerIteration * objectMemory bytesPerOop R: destReg; + CmpR: TempReg R: destReg; + JumpBelow: loop; + SubCq: delta + (loopCount * slotsPerIteration * objectMemory bytesPerOop) R: destReg. + ^0! Item was added: + ----- Method: CogVMSimulator>>mcprimFunctionForPrimitiveIndex: (in category 'cog jit support') ----- + mcprimFunctionForPrimitiveIndex: primIndex + ^self mapFunctionToAddress: (super mcprimFunctionForPrimitiveIndex: primIndex)! Item was added: + ----- Method: InterpreterPrimitives>>primitiveHashMultiply (in category 'arithmetic integer primitives') ----- + primitiveHashMultiply + "Implement 28-bit hashMultiply for SmallInteger and LargePositiveInteger receivers." + | receiver low result | + receiver := self stackTop. + (objectMemory isIntegerObject: receiver) + ifTrue: [receiver := objectMemory integerValueOf: receiver] + ifFalse: + [| ok | + ok := objectMemory is: receiver instanceOf: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. + ok ifFalse: + [^self primitiveFailFor: PrimErrBadReceiver]. + receiver := objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: receiver)]. + low := receiver bitAnd: 16383. + "N.B. We use undefined behaviour assuming the compiler will still generate a multiply, rather than simply crap out, so as to save the unnecessary bitAnd: 16383." + result := (16r260D * low + ((16r260D * (receiver bitShift: -14) + (16r0065 * low) "bitAnd: 16383") * 16384)) bitAnd: 16r0FFFFFFF. + self pop: 1 thenPush: (objectMemory integerObjectOf: result)! Item was changed: Cogit subclass: #SimpleStackBasedCogit instanceVariableNames: 'primitiveGeneratorTable primSetFunctionLabel primInvokeInstruction externalPrimCallOffsets externalPrimJumpOffsets externalSetPrimOffsets introspectionDataIndex introspectionData' classVariableNames: '' + poolDictionaries: 'VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices' - poolDictionaries: 'VMMethodCacheConstants VMObjectIndices' 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>>initializePrimitiveTableForSqueak (in category 'class initialization') ----- initializePrimitiveTableForSqueak "Initialize the table of primitive generators. This does not include normal primitives implemented in the coInterpreter. N.B. primitives that don't have an explicit arg count (the integer following the generator) may be variadic." "SimpleStackBasedCogit initializePrimitiveTableForSqueak" MaxCompiledPrimitiveIndex := self objectRepresentationClass wordSize = 8 ifTrue: [555] ifFalse: [222]. primitiveTable := CArrayAccessor on: (Array new: MaxCompiledPrimitiveIndex + 1). self table: primitiveTable from: #( "Integer Primitives (0-19)" (1 genPrimitiveAdd 1) (2 genPrimitiveSubtract 1) (3 genPrimitiveLessThan 1) (4 genPrimitiveGreaterThan 1) (5 genPrimitiveLessOrEqual 1) (6 genPrimitiveGreaterOrEqual 1) (7 genPrimitiveEqual 1) (8 genPrimitiveNotEqual 1) (9 genPrimitiveMultiply 1) (10 genPrimitiveDivide 1) (11 genPrimitiveMod 1) (12 genPrimitiveDiv 1) (13 genPrimitiveQuo 1) (14 genPrimitiveBitAnd 1) (15 genPrimitiveBitOr 1) (16 genPrimitiveBitXor 1) (17 genPrimitiveBitShift 1) "(18 primitiveMakePoint)" "(19 primitiveFail)" "Guard primitive for simulation -- *must* fail" "LargeInteger Primitives (20-39)" "(20 primitiveFail)" "(21 primitiveAddLargeIntegers)" "(22 primitiveSubtractLargeIntegers)" "(23 primitiveLessThanLargeIntegers)" "(24 primitiveGreaterThanLargeIntegers)" "(25 primitiveLessOrEqualLargeIntegers)" "(26 primitiveGreaterOrEqualLargeIntegers)" "(27 primitiveEqualLargeIntegers)" "(28 primitiveNotEqualLargeIntegers)" "(29 primitiveMultiplyLargeIntegers)" "(30 primitiveDivideLargeIntegers)" "(31 primitiveModLargeIntegers)" "(32 primitiveDivLargeIntegers)" "(33 primitiveQuoLargeIntegers)" "(34 primitiveBitAndLargeIntegers)" "(35 primitiveBitOrLargeIntegers)" "(36 primitiveBitXorLargeIntegers)" "(37 primitiveBitShiftLargeIntegers)" "Float Primitives (38-59)" "(38 genPrimitiveFloatAt)" "(39 genPrimitiveFloatAtPut)" (40 genPrimitiveAsFloat 0) (41 genPrimitiveFloatAdd 1) (42 genPrimitiveFloatSubtract 1) (43 genPrimitiveFloatLessThan 1) (44 genPrimitiveFloatGreaterThan 1) (45 genPrimitiveFloatLessOrEqual 1) (46 genPrimitiveFloatGreaterOrEqual 1) (47 genPrimitiveFloatEqual 1) (48 genPrimitiveFloatNotEqual 1) (49 genPrimitiveFloatMultiply 1) (50 genPrimitiveFloatDivide 1) "(51 genPrimitiveTruncated)" "(52 genPrimitiveFractionalPart)" "(53 genPrimitiveExponent)" "(54 genPrimitiveTimesTwoPower)" (55 genPrimitiveFloatSquareRoot 0) "(56 genPrimitiveSine)" "(57 genPrimitiveArctan)" "(58 genPrimitiveLogN)" "(59 genPrimitiveExp)" "Subscript and Stream Primitives (60-67)" (60 genPrimitiveAt 1) (61 genPrimitiveAtPut 2) (62 genPrimitiveSize 0) (63 genPrimitiveStringAt 1) (64 genPrimitiveStringAtPut 2) "The stream primitives no longer pay their way; normal Smalltalk code is faster." (65 genFastPrimFail)"was primitiveNext" (66 genFastPrimFail) "was primitiveNextPut" (67 genFastPrimFail) "was primitiveAtEnd" "StorageManagement Primitives (68-79)" (68 genPrimitiveObjectAt 1) "Good for debugger/InstructionStream performance" "(69 primitiveObjectAtPut)" (70 genPrimitiveNew 0) (71 genPrimitiveNewWithArg 1) "(72 primitiveArrayBecomeOneWay)" "Blue Book: primitiveBecome" "(73 primitiveInstVarAt)" "(74 primitiveInstVarAtPut)" (75 genPrimitiveIdentityHash 0) "(76 primitiveStoreStackp)" "Blue Book: primitiveAsObject" "(77 primitiveSomeInstance)" "(78 primitiveNextInstance)" (79 genPrimitiveNewMethod 2) "Control Primitives (80-89)" "(80 primitiveFail)" "Blue Book: primitiveBlockCopy" "(81 primitiveFail)" "Blue Book: primitiveValue" "(82 primitiveFail)" "Blue Book: primitiveValueWithArgs" (83 genPrimitivePerform) "(84 primitivePerformWithArgs)" "(85 primitiveSignal)" "(86 primitiveWait)" "(87 primitiveResume)" "(88 primitiveSuspend)" "(89 primitiveFlushCache)" "System Primitives (110-119)" (110 genPrimitiveIdentical 1) (111 genPrimitiveClass) "Support both class and Context>>objectClass:" "(112 primitiveBytesLeft)" "(113 primitiveQuit)" "(114 primitiveExitToDebugger)" "(115 primitiveChangeClass)" "Blue Book: primitiveOopsLeft" "(116 primitiveFlushCacheByMethod)" "(117 primitiveExternalCall)" "(118 primitiveDoPrimitiveWithArgs)" "(119 primitiveFlushCacheSelective)" (148 genPrimitiveShallowCopy 0) "a.k.a. clone" + (159 genPrimitiveHashMultiply 0) + (169 genPrimitiveNotIdentical 1) (170 genPrimitiveAsCharacter) "SmallInteger>>asCharacter, Character class>>value:" (171 genPrimitiveImmediateAsInteger 0) "Character>>value SmallFloat64>>asInteger" "(173 primitiveSlotAt 1)" "(174 primitiveSlotAtPut 2)" (175 genPrimitiveIdentityHash 0) "Behavior>>identityHash" "Old closure primitives" "(186 primitiveFail)" "was primitiveClosureValue" "(187 primitiveFail)" "was primitiveClosureValueWithArgs" "Perform method directly" "(188 primitiveExecuteMethodArgsArray)" "(189 primitiveExecuteMethod)" "Unwind primitives" "(195 primitiveFindNextUnwindContext)" "(196 primitiveTerminateTo)" "(197 primitiveFindHandlerContext)" (198 genFastPrimFail "primitiveMarkUnwindMethod") (199 genFastPrimFail "primitiveMarkHandlerMethod") "new closure primitives" "(200 primitiveClosureCopyWithCopiedValues)" (201 genPrimitiveClosureValue 0) "value" (202 genPrimitiveClosureValue 1) "value:" (203 genPrimitiveClosureValue 2) "value:value:" (204 genPrimitiveClosureValue 3) "value:value:value:" (205 genPrimitiveClosureValue 4) "value:value:value:value:" "(206 genPrimitiveClosureValueWithArgs)" "valueWithArguments:" (207 genPrimitiveFullClosureValue) "value[:value:value:value:] et al" "(208 genPrimitiveFullClosureValueWithArgs)" "valueWithArguments:" (209 genPrimitiveFullClosureValue) "valueNoContextSwitch[:value:] et al" "(210 primitiveContextAt)" "(211 primitiveContextAtPut)" "(212 primitiveContextSize)" "(218 primitiveDoNamedPrimitiveWithArgs)" "(219 primitiveFail)" "reserved for Cog primitives" "(220 primitiveFail)" "reserved for Cog primitives" (221 genPrimitiveClosureValue 0) "valueNoContextSwitch" (222 genPrimitiveClosureValue 1) "valueNoContextSwitch:" "SmallFloat primitives (540-559)" (541 genPrimitiveSmallFloatAdd 1) (542 genPrimitiveSmallFloatSubtract 1) (543 genPrimitiveSmallFloatLessThan 1) (544 genPrimitiveSmallFloatGreaterThan 1) (545 genPrimitiveSmallFloatLessOrEqual 1) (546 genPrimitiveSmallFloatGreaterOrEqual 1) (547 genPrimitiveSmallFloatEqual 1) (548 genPrimitiveSmallFloatNotEqual 1) (549 genPrimitiveSmallFloatMultiply 1) (550 genPrimitiveSmallFloatDivide 1) "(551 genPrimitiveSmallFloatTruncated 0)" "(552 genPrimitiveSmallFloatFractionalPart 0)" "(553 genPrimitiveSmallFloatExponent 0)" "(554 genPrimitiveSmallFloatTimesTwoPower 1)" (555 genPrimitiveSmallFloatSquareRoot 0) "(556 genPrimitiveSmallFloatSine 0)" "(557 genPrimitiveSmallFloatArctan 0)" "(558 genPrimitiveSmallFloatLogN 0)" "(559 genPrimitiveSmallFloatExp 0)" )! Item was removed: - ----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive: (in category 'primitive generators') ----- - compileInterpreterPrimitive: primitiveRoutine - "Compile a call to an interpreter primitive. Call the C routine with the - usual stack-switching dance, test the primFailCode and then either - return on success or continue to the method body." - <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'> - | flags jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim | - <var: #jmp type: #'AbstractInstruction *'> - <var: #jmpSamplePrim type: #'AbstractInstruction *'> - <var: #jmpSampleNonPrim type: #'AbstractInstruction *'> - <var: #continuePostSamplePrim type: #'AbstractInstruction *'> - <var: #continuePostSampleNonPrim type: #'AbstractInstruction *'> - - "Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers" - self genExternalizePointersForPrimitiveCall. - "Switch to the C stack." - self genLoadCStackPointersForPrimCall. - - flags := coInterpreter primitivePropertyFlags: primitiveIndex. - (flags anyMask: PrimCallDoNotJIT) ifTrue: - [^ShouldNotJIT]. - - (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 full prim trace is in VMMaker-eem.550 and prior" - self recordPrimTrace 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+PrimCallMayCallBack) ifTrue: - ["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness." - (flags anyMask: PrimCallMayCallBack) 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: PrimCallMayCallBack) - 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." - self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction). - backEnd genSubstituteReturnAddress: - ((flags anyMask: PrimCallCollectsProfileSamples) - ifTrue: [cePrimReturnEnterCogCodeProfiling] - ifFalse: [cePrimReturnEnterCogCode]). - primInvokeInstruction := self JumpFullRT: primitiveRoutine asInteger. - jmp := jmpSamplePrim := continuePostSamplePrim := nil] - ifFalse: - ["Call the C primitive routine." - primInvokeInstruction := self CallFullRT: primitiveRoutine asInteger. - (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. - self maybeCompileAllocFillerCheck. - "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>>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 | + <var: #jmp type: #'AbstractInstruction *'> + <var: #jmpSamplePrim type: #'AbstractInstruction *'> + <var: #jmpSampleNonPrim type: #'AbstractInstruction *'> + <var: #continuePostSamplePrim type: #'AbstractInstruction *'> + <var: #continuePostSampleNonPrim type: #'AbstractInstruction *'> + + "Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers" + self genExternalizePointersForPrimitiveCall. + "Switch to the C stack." + self genLoadCStackPointersForPrimCall. + + (flags 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 full prim trace is in VMMaker-eem.550 and prior" + self recordPrimTrace 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+PrimCallMayCallBack) ifTrue: + ["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness." + (flags anyMask: PrimCallMayCallBack) 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: PrimCallMayCallBack) + 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." + self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction). + backEnd genSubstituteReturnAddress: + ((flags anyMask: PrimCallCollectsProfileSamples) + ifTrue: [cePrimReturnEnterCogCodeProfiling] + ifFalse: [cePrimReturnEnterCogCode]). + primInvokeInstruction := self JumpFullRT: primitiveRoutine asInteger. + jmp := jmpSamplePrim := continuePostSamplePrim := nil] + ifFalse: + ["Call the C primitive routine." + primInvokeInstruction := self CallFullRT: primitiveRoutine asInteger. + (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. + self maybeCompileAllocFillerCheck. + "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>>compileMachineCodeInterpreterPrimitive: (in category 'primitive generators') ----- + compileMachineCodeInterpreterPrimitive: primitiveRoutine + "Compile a call to a machine-code convention interpreter primitive. Call the C routine + on the Smalltalk stack, assuming it consumes little or no stack space." + <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'> + | jmpFail liveRegsMask | + "for now handle functions with less than 4 arguments; our C call marshalling machinery + extends up to 4 arguments only, and the first argument of an mcprim is the receiver." + self assert: methodOrBlockNumArgs <= 3. + liveRegsMask := (methodOrBlockNumArgs > self numRegArgs + or: [methodOrBlockNumArgs = 0]) + ifTrue: + [self registerMaskFor: ReceiverResultReg] + ifFalse: + [(self numRegArgs > 1 and: [methodOrBlockNumArgs > 1]) + ifFalse: [self registerMaskFor: ReceiverResultReg and: Arg0Reg] + ifTrue: [self registerMaskFor: ReceiverResultReg and: Arg0Reg and: Arg1Reg]]. + backEnd genSaveRegs: (liveRegsMask bitAnd: CallerSavedRegisterMask). + methodOrBlockNumArgs > self numRegArgs ifTrue: + ["Wrangle args into Arg0Reg, Arg1Reg, SendNumArgsReg & ClassReg" + "offset := self bitCountOf: (liveRegsMask bitAnd: CallerSavedRegisterMask)." + self shouldBeImplemented]. + backEnd + genMarshallNArgs: methodOrBlockNumArgs + 1 + arg: ReceiverResultReg + arg: Arg0Reg + arg: Arg1Reg + arg: SendNumArgsReg + "arg: ClassReg (when we extend C call marchalling to support 5 args for replaceFrom:to:with:startingAt:". + self CallFullRT: primitiveRoutine asInteger. + backEnd + genRemoveNArgsFromStack: methodOrBlockNumArgs + 1; + genRestoreRegs: (liveRegsMask bitAnd: CallerSavedRegisterMask). + self CmpCq: 0 R: backEnd cResultRegister. + jmpFail := self JumpZero: 0. + backEnd cResultRegister ~= ReceiverResultReg ifTrue: + [self MoveR: backEnd cResultRegister R: ReceiverResultReg]. + self RetN: (methodOrBlockNumArgs > self numRegArgs + ifTrue: [methodOrBlockNumArgs + 1 * objectMemory wordSize] + ifFalse: [0]). + jmpFail jmpTarget: self Label. + ^0! Item was changed: ----- Method: SimpleStackBasedCogit>>compilePrimitive (in category 'primitive generators') ----- compilePrimitive "Compile a primitive. If possible, performance-critical primtiives 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> + | code opcodeIndexAtPrimitive primitiveDescriptor primitiveRoutine flags | - | code opcodeIndexAtPrimitive primitiveDescriptor primitiveRoutine | <var: #primitiveDescriptor type: #'PrimitiveDescriptor *'> <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'> primitiveIndex = 0 ifTrue: [^0]. code := 0. "Note opcodeIndex so that compileFallbackToInterpreterPrimitive: can discard arg load instructions for unimplemented primitives." opcodeIndexAtPrimitive := opcodeIndex. "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 don't care" or: [primitiveDescriptor primNumArgs = (coInterpreter argumentCountOf: methodObj)])]]) ifTrue: [code := objectRepresentation perform: primitiveDescriptor primitiveGenerator]. (code < 0 and: [code ~= UnimplementedPrimitive]) ifTrue: "Generator failed, so no point continuing..." [^code]. code = UnfailingPrimitive ifTrue: [^0]. "If the machine code verison 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]. + + flags := coInterpreter primitivePropertyFlags: primitiveIndex. + (flags anyMask: PrimCallDoNotJIT) ifTrue: + [^ShouldNotJIT]. + + (flags anyMask: PrimCallOnSmalltalkStack) ifTrue: + [self assert: flags = PrimCallOnSmalltalkStack. + ^self compileMachineCodeInterpreterPrimitive: (coInterpreter mcprimFunctionForPrimitiveIndex: primitiveIndex)]. + ((primitiveRoutine := coInterpreter functionPointerForCompiledMethod: methodObj + primitiveIndex: primitiveIndex) = 0 "no primitive" + or: [primitiveRoutine = #primitiveFail]) ifTrue: - primitiveIndex: primitiveIndex) isNil "no primitive" - or: [primitiveRoutine = (coInterpreter functionPointerFor: 0 inClass: nil) "routine = primitiveFail"]) ifTrue: [^self genFastPrimFail]. minValidCallAddress := minValidCallAddress min: primitiveRoutine asUnsignedInteger. + ^self compileInterpreterPrimitive: primitiveRoutine flags: flags! - ^self compileInterpreterPrimitive: primitiveRoutine! 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)()'> 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. 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 := self compileInterpreterPrimitive: primitiveRoutine) < 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)()'> 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. 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 := self compileInterpreterPrimitive: primitiveRoutine) < 0 ifTrue: [^result]. jumpFailNArgs jmpTarget: self Label. ^CompletePrimitive! Item was added: + ----- Method: SimpleStackBasedCogit>>genPrimitiveHashMultiply (in category 'primitive generators') ----- + genPrimitiveHashMultiply + | highReg jmpFailImm jmpFailNonImm jmpNotSmallInt lowReg reenter | + jmpNotSmallInt := objectRepresentation genJumpNotSmallInteger: ReceiverResultReg. + objectRepresentation genConvertSmallIntegerToIntegerInReg: ReceiverResultReg. + reenter := self MoveR: ReceiverResultReg R: (highReg := Arg1Reg). + self + ArithmeticShiftRightCq: 14 R: highReg; "highReg := receiver bitShift: -14" + AndCq: 16383 R: ReceiverResultReg; + MoveR: ReceiverResultReg R: (lowReg := Arg0Reg); "lowReg := receiver bitAnd: 16383" + MoveCq: 16r260D R: TempReg; + MulR: TempReg R: ReceiverResultReg; "RRR := 16r260D * low" + MulR: TempReg R: highReg; "highReg := (16r260D * (receiver bitShift: -14))" + MoveCq: 16r0065 R: TempReg; + MulR: TempReg R: lowReg; "lowReg := 16r0065 * low" + AddR: lowReg R: highReg; "highReg := (16r260D * (receiver bitShift: -14)) + (16r0065 * low)" + MoveCq: 16384 R: TempReg; + MulR: TempReg R: highReg; "highReg := (16r260D * (receiver bitShift: -14)) + (16r0065 * low)" + AddR: highReg R: ReceiverResultReg; + AndCq: 16r0FFFFFFF R: ReceiverResultReg. + objectRepresentation genConvertIntegerToSmallIntegerInReg: ReceiverResultReg. + self RetN: 0. + jmpNotSmallInt jmpTarget: self Label. + jmpFailImm := objectRepresentation genJumpImmediate: ReceiverResultReg. + objectRepresentation genGetClassIndexOfNonImm: ReceiverResultReg into: ClassReg. + self CmpCq: ClassLargePositiveIntegerCompactIndex R: ClassReg. + jmpFailNonImm := self JumpNonZero: 0. + objectRepresentation genLoadSlot: 0 sourceReg: ReceiverResultReg destReg: ReceiverResultReg. + self Jump: reenter. + jmpFailImm jmpTarget: (jmpFailNonImm jmpTarget: self Label). + ^0! Item was changed: ----- Method: SistaCogit>>genUnaryInlinePrimitive: (in category 'inline primitive generators') ----- genUnaryInlinePrimitive: prim "Unary inline primitives." "SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution. See EncoderForSistaV1's class comment and StackInterpreter>>#unaryInlinePrimitive:" | rcvrReg resultReg | rcvrReg := self allocateRegForStackEntryAt: 0. resultReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg). prim caseOf: { "00 unchecked class" [1] -> "01 unchecked pointer numSlots" [self ssTop popToReg: rcvrReg. self ssPop: 1. objectRepresentation genGetNumSlotsOf: rcvrReg into: resultReg; genConvertIntegerToSmallIntegerInReg: resultReg]. "02 unchecked pointer basicSize" [3] -> "03 unchecked byte numBytes" [self ssTop popToReg: rcvrReg. self ssPop: 1. objectRepresentation genGetNumBytesOf: rcvrReg into: resultReg; genConvertIntegerToSmallIntegerInReg: resultReg]. "04 unchecked short16Type format numShorts" "05 unchecked word32Type format numWords" "06 unchecked doubleWord64Type format numDoubleWords" [11] -> "11 unchecked fixed pointer basicNew" [self ssTop type ~= SSConstant ifTrue: [^EncounteredUnknownBytecode]. (objectRepresentation + genGetInstanceOfFixedClass: self ssTop constant - genGetInstanceOf: self ssTop constant into: resultReg initializingIf: self extBSpecifiesInitializeInstance) ~= 0 ifTrue: [^ShouldNotJIT]. "e.g. bad class" self ssPop: 1] . [20] -> "20 identityHash" [objectRepresentation genGetIdentityHash: rcvrReg resultReg: resultReg. self ssPop: 1] . "21 identityHash (SmallInteger)" "22 identityHash (Character)" "23 identityHash (SmallFloat64)" "24 identityHash (Behavior)" "30 immediateAsInteger (Character) 31 immediateAsInteger (SmallFloat64) 35 immediateAsFloat (SmallInteger) " [30] -> [self ssTop popToReg: resultReg. objectRepresentation genConvertCharacterToSmallIntegerInReg: resultReg. self ssPop: 1]. [35] -> [self assert: self processorHasDoublePrecisionFloatingPointSupport. self MoveR: rcvrReg R: TempReg. self genConvertSmallIntegerToIntegerInReg: TempReg. self ConvertR: TempReg Rd: DPFPReg0. self flag: #TODO. "Should never fail" self genAllocFloatValue: DPFPReg0 into: resultReg scratchReg: TempReg scratchReg: NoReg. "scratch2 for V3 only"] } otherwise: [^EncounteredUnknownBytecode]. extB := 0. numExtB := 0. self ssPushRegister: resultReg. ^0! Item was changed: InterpreterPrimitives subclass: #StackInterpreter instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB numExtB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelector Length longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals statIdleUsecs debugCallbackPath debugCallbackReturns debugCallbackInvokes' + classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimNumberDoExternalCall PrimNumberExternalCall PrimNumberFFICall PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask' - classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimNumberDoExternalCall PrimNumberExternalCall PrimNumberFFICall PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask' poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMStackFrameOffsets' category: 'VMMaker-Interpreter'! !StackInterpreter commentStamp: 'eem 12/5/2014 11:32' prior: 0! This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. This VM supports Closures but *not* old-style BlockContexts. It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms. The VM does not use Contexts directly. Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image. There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up. The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations. A send establishes a new frame in the current stack page, a return returns to the previous frame. This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return. Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together). Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse f rame has been returned from (died). A married context is specially marked (more details in the code) and refers to its frame. Likewise a married frame is specially marked and refers to its context. In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case. StackInterpreter and subclasses support multiple memory managers. Currently there are two. NewMemoryManager is a slightly refined version of ObjectMemory, and is the memory manager and garbage collector for the original Squeak object representation as described in "Back to the Future The Story of Squeak, A Practical Smalltalk Written in Itself", see http://ftp.squeak.org/docs/OOPSLA.Squeak.html. Spur is a faster, more regular object representation that is designed for more performance and functionality, and to have a common header format for both 32-bit and 64-bit versions. You can read about it in SpurMemoryManager's class comment. There is also a video of a presentation at ESUG 2014 (https://www.youtube.com/watch?v=k0nBNS1aHZ4), along with slides (http://www.slideshare.net/esug/spur-a-new-object-representation-for-cog?related=1).! Item was changed: ----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') ----- initializeMiscConstants super initializeMiscConstants. STACKVM := true. "These flags function to identify a GC operation, or to specify what operations the leak checker should be run for." GCModeFull := 1. "stop-the-world global GC" GCModeNewSpace := 2. "Spur's scavenge, or V3's incremental" GCModeIncremental := 4. "incremental global gc (Dijkstra tri-colour marking); as yet unimplemented" GCModeBecome := 8. "v3 post-become sweeping/Spur forwarding" GCModeImageSegment := 16. "just a flag for leak checking image segments" GCModeFreeSpace := 32. "just a flag for leak checking free space; Spur only" GCCheckPrimCall := 64. "just a flag for leak checking external primitive calls" StackPageTraceInvalid := -1. StackPageUnreached := 0. StackPageReachedButUntraced := 1. StackPageTraced := 2. DumpStackOnLowSpace := 0. - PrimitiveExternalCallIndex := 117. "Primitive index for #primitiveExternalCall" MillisecondClockMask := 16r1FFFFFFF. "Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)" MaxExternalPrimitiveTableSize := 4096. "entries" MaxJumpBuf := 32. "max. callback depth" FailImbalancedPrimitives := initializationOptions at: #FailImbalancedPrimitives ifAbsentPut: [true]. EnforceAccessControl := initializationOptions at: #EnforceAccessControl ifAbsent: [true]! Item was changed: ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') ----- (excessive size, no diff calculated) Item was changed: ----- Method: StackInterpreter>>extJumpIfNotInstanceOfBehaviorsBytecode (in category 'sista bytecodes') ----- extJumpIfNotInstanceOfBehaviorsBytecode + "254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B between: 0 and: 127) + 254 11111110 kkkkkkkk jjjjjjjj branch If Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B - 128 * 256, where Extend B between: 128 and: 255)" - "254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)" | tosClassTag literal distance inverse | SistaVM ifFalse: [^self respondToUnknownBytecode]. self assert: ((extB bitAnd: 128) = 0 or: [extB < 0]). (inverse := extB < 0) ifTrue: [extB := extB + 128]. tosClassTag := objectMemory fetchClassTagOf: self internalPopStack. literal := self literal: extA << 8 + self fetchByte. distance := extB << 8 + self fetchByte. extA := extB := numExtB := 0. (objectMemory isArrayNonImm: literal) ifTrue: [0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do: [:i | tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal)) ifTrue: [inverse ifTrue: [ localIP := localIP + distance ]. ^self fetchNextBytecode ] ]. inverse ifFalse: [localIP := localIP + distance]. ^self fetchNextBytecode]. tosClassTag = (objectMemory rawClassTagForClass: literal) = inverse ifTrue: [localIP := localIP + distance]. self fetchNextBytecode! Item was changed: ----- Method: StackInterpreter>>flushExternalPrimitiveOf: (in category 'plugin primitive support') ----- flushExternalPrimitiveOf: methodObj "methodObj is a CompiledMethod. If it contains an external primitive, flush the function address and session ID of the CM. Answer the prim index for the benefit of subclass overrides." <inline: false> | header primIdx lit | header := objectMemory methodHeaderOf: methodObj. primIdx := self primitiveIndexOfMethod: methodObj header: header. + (primIdx = PrimNumberExternalCall - (primIdx = PrimitiveExternalCallIndex and: [(objectMemory literalCountOfMethodHeader: header) > 0]) ifTrue: "If not, something's broken" [lit := self literal: 0 ofMethod: methodObj. ((objectMemory isArray: lit) and: [(objectMemory numSlotsOf: lit) = 4]) ifTrue: "If not, something's broken" [objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero; storePointerUnchecked: 3 ofObject: lit withValue: ConstZero]]. ^primIdx! |
Free forum by Nabble | Edit this page |