Vm-dev March 2017

vm-dev@lists.squeakfoundation.org

39 participants
154 discussions

VM Maker: VMMaker.oscog-eem.2148.mcz
by commits＠source.squeak.org 14 Mar '17

14 Mar '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2148.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2148 Author: eem Time: 13 March 2017, 1:19:30.469259 pm UUID: 7f6e1475-0975-451e-8d17-b827aa97c1eb Ancestors: VMMaker.oscog-dtl.2147 Slang: Fix serious bug with inlining expressions such as context := ignoreContext ifTrue: [objectMemory nilObject ] ifFalse: [self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop)]. where the exitVar (context) is lost and ensureFrameIsMarried:SP: is inlined missing the implicit assignment to context in the first ifTrue:. Fix bug with type inference for #-. The difference between two unsigned values is signed. Fix bug with inferring return types of methods that return unsigned typed variables and positive integer constants. Don't interpret the type of an integer constant as #sqInt if the method also returns an unsigned. So defer considering the non-negative integer return values unless no other return type information can be found. VMMaker: Add a SpurStackSistaVM configuration (in which the above inlining expressions bug was found). This is not one of the ones under version control. =============== Diff against VMMaker.oscog-dtl.2147 =============== Item was changed: ----- Method: CCodeGenerator>>harmonizeReturnTypesIn: (in category 'type inference') ----- harmonizeReturnTypesIn: aSetOfTypes + "Eliminate signed/unsigned conflicts in aSetOfTypes. Non-negative integers can be either + signed or unsigned. Ignore them unless there are no types, in which case default to sqInt." + | constantIntegers sqs usqs | + constantIntegers := aSetOfTypes select: [:element| element isInteger]. + aSetOfTypes removeAll: constantIntegers. + "N.B. Because of LP64 vs LLP64 issues do *not* rename #long to #sqInt or #'unsigned long' to #usqInt" + #(char short int #'long long' #'unsigned char' #'unsigned short' #'unsigned int' #'unsigned long long') + with: #(sqInt sqInt sqInt sqLong usqInt usqInt usqInt usqLong) - "Eliminate signed/unsigned conflicts in aSetOfTypes" - | sqs usqs | - #(char short int #'unsigned char' #'unsigned short' #'unsigned int' #'unsigned long') - with: #(sqInt sqInt sqInt #usqInt #usqInt #usqInt #usqInt) do: [:type :replacement| (aSetOfTypes includes: type) ifTrue: [aSetOfTypes remove: type; add: replacement]]. sqs := aSetOfTypes select: [:t| t beginsWith: 'sq']. usqs := aSetOfTypes select: [:t| t beginsWith: 'usq']. ^(sqs size + usqs size = aSetOfTypes size and: [sqs notEmpty and: [sqs allSatisfy: [:t| usqs includes: 'u', t]]]) ifTrue: [sqs] + ifFalse: [(aSetOfTypes isEmpty and: [constantIntegers notEmpty]) + ifTrue: [Set with: #sqInt] + ifFalse: [aSetOfTypes]]! - ifFalse: [aSetOfTypes]! Item was changed: ----- Method: CCodeGenerator>>typeForArithmetic:in: (in category 'type inference') ----- typeForArithmetic: sendNode in: aTMethod "Answer the return type for an arithmetic sendThis is so that the inliner can still inline simple expressions. Deal with pointer arithmetic, floating point arithmetic and promotion." + | rcvrType argType arg promotedType | - | rcvrType argType | rcvrType := self typeFor: sendNode receiver in: aTMethod. + argType := self typeFor: (arg := sendNode args first) in: aTMethod. - argType := self typeFor: sendNode args first in: aTMethod. "deal with pointer arithmetic" + ((rcvrType notNil and: [rcvrType last == $*]) or: [argType notNil and: [argType last == $*]]) ifTrue: - ((rcvrType notNil and: [rcvrType last = $*]) or: [argType notNil and: [argType last = $*]]) ifTrue: [(rcvrType isNil or: [argType isNil]) ifTrue: [^nil]. + (rcvrType last == $* and: [argType last == $*]) ifTrue: - (rcvrType last = $* and: [argType last = $*]) ifTrue: [sendNode selector == #- ifTrue: [^#int]. self error: 'invalid pointer arithmetic']. + ^rcvrType last == $* - ^rcvrType last = $* ifTrue: [rcvrType] ifFalse: [argType]]. + promotedType := self promoteArithmeticTypes: rcvrType and: argType. + "We have to be very careful with subtraction. The difference between two unsigned types is signed. + But we don't want unsigned - constant to be signed. We almost always want this to stay unsigned." + ^(sendNode selector == #- and: [promotedType first == $u and: [(arg isConstant and: [arg value isInteger]) not]]) + ifTrue: [promotedType allButFirst: ((promotedType beginsWith: 'unsigned') ifTrue: [9] ifFalse: [1])] + ifFalse: [promotedType]! - ^self promoteArithmeticTypes: rcvrType and: argType! Item was changed: ----- Method: TMethod>>addTypesFor:to:in: (in category 'type inference') ----- addTypesFor: node to: typeSet in: aCodeGen "Add the value types for the node to typeSet. Answer if any type was derived from an as-yet-untyped method, which allows us to abort inferReturnTypeFromReturnsIn: if the return type depends on a yet-to-be-typed method." | expr | expr := node. [expr isAssignment or: [expr isStmtList]] whileTrue: [expr isAssignment ifTrue: [expr := expr variable]. expr isStmtList ifTrue: [expr := expr statements last]]. expr isSend ifTrue: [(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) ifTrue: [^expr args inject: false into: [:asYetUntyped :block| asYetUntyped | (self addTypesFor: block to: typeSet in: aCodeGen)]]. (aCodeGen returnTypeForSend: expr in: self ifNil: nil) ifNil: [^(aCodeGen methodNamed: expr selector) notNil and: [expr selector ~~ selector]] ifNotNil: [:type | typeSet add: type. ^false].]. expr isVariable ifTrue: [(aCodeGen typeOfVariable: expr name) ifNotNil: [:type| typeSet add: type] ifNil: [typeSet add: (expr name = 'self' ifTrue: [#void] ifFalse: [#sqInt])]]. expr isConstant ifTrue: + [(expr value isInteger and: [expr value >= 0]) "cannot determine if signed or unsigned yet..." + ifTrue: [typeSet add: expr value] + ifFalse: + [(expr typeOrNilFrom: aCodeGen in: self) ifNotNil: + [:type | typeSet add: type]]]. - [(expr typeOrNilFrom: aCodeGen in: self) ifNotNil: - [:type | typeSet add: type]].. ^false! Item was changed: ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') ----- inferTypesForImplicitlyTypedVariablesIn: aCodeGen "infer types for untyped variables from assignments and arithmetic uses. For debugging answer a Dictionary from var to the nodes that determined types This for debugging: (self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)" + | alreadyExplicitlyTypedOrNotToBeTyped asYetUntyped effectiveNodes | - | alreadyExplicitlyTypedOrNotToBeTyped effectiveNodes | aCodeGen maybeBreakForTestToInline: selector in: self. alreadyExplicitlyTypedOrNotToBeTyped := declarations keys asSet. + asYetUntyped := locals copyWithoutAll: alreadyExplicitlyTypedOrNotToBeTyped. effectiveNodes := Dictionary new. "this for debugging" parseTree nodesDo: [:node| | type var | "If there is something of the form i >= 0, then i should be signed, not unsigned." (node isSend and: [(locals includes: (var := node receiver variableNameOrNil)) and: [(alreadyExplicitlyTypedOrNotToBeTyped includes: var) not "don't be fooled by inferred unsigned types" and: [(#(<= < >= >) includes: node selector) and: [node args first isConstant and: [node args first value = 0 and: [(type := self typeFor: var in: aCodeGen) notNil and: [type first == $u]]]]]]]) ifTrue: [self declarationAt: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var. effectiveNodes at: var put: { declarations at: var. node }]. "if an assignment to an untyped local of a known type, set the local's type to that type. Only observe known sends (methods in the current set) and typed local variables." (node isAssignment and: [(locals includes: (var := node variable name)) and: [(alreadyExplicitlyTypedOrNotToBeTyped includes: var) not]]) ifTrue: "don't be fooled by previously inferred types" [type := node expression isSend ifTrue: [aCodeGen returnTypeForSend: node expression in: self ifNil: nil] ifFalse: [self typeFor: node expression in: aCodeGen]. type "If untyped, then cannot type the variable yet. A subsequent assignment may assign a subtype of what this type ends up being" ifNil: [alreadyExplicitlyTypedOrNotToBeTyped add: var] + ifNotNil: "Merge simple types (but *don't* merge untyped vars); complex types must be defined by the programmer." - ifNotNil: "Merge simple types; complex types must be defined by the programmer." [(aCodeGen isSimpleType: type) ifTrue: + [(asYetUntyped includes: var) + ifTrue: [declarations at: var put: type, ' ', var. asYetUntyped remove: var] + ifFalse: + [aCodeGen mergeTypeOf: var in: declarations with: type method: self]. - [aCodeGen mergeTypeOf: var in: declarations with: type method: self. effectiveNodes at: var put: { declarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]]]]. ^effectiveNodes! Item was changed: ----- Method: TMethod>>tryToInlineMethodStatementsIn:statementListsInto: (in category 'inlining') ----- tryToInlineMethodStatementsIn: aCodeGen statementListsInto: aBlock "Expand any (complete) inline methods sent by this method as top-level statements. Answer if anything was inlined." | stmtLists didSomething newStatements returningNodes | didSomething := false. returningNodes := Set new. + stmtLists := self statementsListsForInliningIn: aCodeGen. + "stmtLists may include expressions that are used for value but the exitVar is distant because its in an ifTrue:ifTrue:, + e.g. in + context := ignoreContext + ifTrue: [objectMemory nilObject ] + ifFalse: [self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop)]. + ensureFrameIsMarried:SP: *does* have an exitVar, context, but it is the exitVar for the ifTrue:ifFalse:. So + inlineCodeOrNilForStatement:returningNodes:in: should not consider inlining these in its last phrase where exitVar is nil." parseTree nodesDo: [:node| node isReturn ifTrue: [returningNodes add: node expression. node expression isConditionalSend ifTrue: + [returningNodes addAll: (node expression args collect: [:stmtList| stmtList statements last])]]. + node isAssignment ifTrue: + [node expression nodesDo: + [:assignmentSubNode| + (stmtLists includes: assignmentSubNode) ifTrue: + [stmtLists remove: assignmentSubNode]]]]. + - [returningNodes addAll: (node expression args collect: [:stmtList| stmtList statements last])]]]. - stmtLists := self statementsListsForInliningIn: aCodeGen. stmtLists do: [:stmtList| newStatements := OrderedCollection new: stmtList statements size. stmtList statements do: [:stmt| (self inlineCodeOrNilForStatement: stmt returningNodes: returningNodes in: aCodeGen) ifNil: [newStatements addLast: stmt] ifNotNil: [:inlinedStmts| didSomething := true. newStatements addAllLast: inlinedStmts]]. stmtList setStatements: newStatements asArray]. "This is a hack; forgive me. The inlining above tends to keep return statements in statement lists. In the case of returning ifs we don't want the returns in case the returning if is generated as an expression." returningNodes do: [:returningNode| (returningNode isConditionalSend and: [returningNode args anySatisfy: [:alternativeNode| alternativeNode endsWithReturn]]) ifTrue: [returningNode args withIndexDo: [:alternativeNode :index| alternativeNode endsWithReturn ifTrue: [returningNode args at: index put: alternativeNode copyWithoutReturn]]]]. aBlock value: stmtLists. ^didSomething! Item was added: + ----- Method: VMMaker class>>generateSqueakSpurStackSistaVM (in category 'configurations') ----- + generateSqueakSpurStackSistaVM + "No primitives since we can use those for the Cog VM" + ^VMMaker + generate: StackInterpreter + with: #(SistaVM true + ObjectMemory Spur32BitMemoryManager + FailImbalancedPrimitives false + MULTIPLEBYTECODESETS true + bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid) + to: (FileDirectory default pathFromURI: self sourceTree, '/spursistastacksrc') + platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms') + including:#()!

3 2

VM Maker: VMMaker.oscog-eem.2151.mcz
by commits＠source.squeak.org 14 Mar '17

14 Mar '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2151.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2151 Author: eem Time: 13 March 2017, 6:15:17.757399 pm UUID: 688f5e9d-e98c-42e1-9aee-32960a437195 Ancestors: VMMaker.oscog-cb.2151 Stack Interpreter Alien Callbacks: Implement ownVM: and disownVM: for the non-threaded VM in StackInterpreter (consequently sqVirtualMachine.c will have to change and will be committed in github soon). Arrange that sendInvokeCallbackContext: & returnAs:ThroughCallback:Context: along with ownVM: and disownVM: conspire to save and restore newMethod, argumentCount and primitiveFunctionPointer around a callback. The VM depends on argumentCount being correct to cut-back the correct number of arguments on primitive return. If a primitive that invokes a callback fails after invoking a callback (a bad idea, but s**t happens during development) then newMethod is required to activate the right faling method, and Spur expects primitiveFunctionPointer to be valid, so asserts will fail misleadingly if not. Add three variables to help debug callbacks that are updated only in the assert and debug VMs. debugCallbackPath has bits set in it that describe the specific path taken through returnAs:ThroughCallback:Context:, while debugCallbackReturns debugCallbackInvokes merely count invocations and returns, and can be used for breakponts if reproducible cases arise (such as the recent Pharo 6 VGTigerDemo runDemo issues with copyBits using surface funciton callbacks. =============== Diff against VMMaker.oscog-cb.2151 =============== Item was changed: ----- Method: IA32ABIPlugin class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGen aCCodeGen addHeaderFile: '<setjmp.h>'; addHeaderFile: '"vmCallback.h"'; + addHeaderFile: '"ia32abi.h"'; + addHeaderFile: '"sqAssert.h"'! - addHeaderFile: '"ia32abi.h"'! Item was changed: ----- Method: IA32ABIPlugin>>primReturnAsFromContextThrough (in category 'primitives-callbacks') ----- primReturnAsFromContextThrough "Return a result from a callback to the callback's callee. The primitive has a signature of either of the forms: result <VMCallbackContext32/64> primReturnAs: returnTypeCode <Integer> FromContext: callbackContext <Context> result <VMCallbackContext32/64> primSignal: aSemaphore <Semaphore> andReturnAs: returnTypeCode <Integer> FromContext: callbackContext <Context> <primitive: 'primReturnAsFromContextThrough' error: errorCode module: 'IA32ABI'>. If of the second form answer false if this is not the most recent callback, and signal aSemaphore if it is, so as to implement LIFO ordering of callbacks." <export: true> | vmCallbackContext isMostRecent | <var: #vmCallbackContext type: #'VMCallbackContext *'> interpreterProxy methodArgumentCount = 3 ifTrue: + [self assert: (interpreterProxy isNonImmediate: (interpreterProxy stackValue: 3)). + self assert: (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore. + self assert: (interpreterProxy isIntegerObject: (interpreterProxy stackValue: 1)). + self assert: (interpreterProxy isNonImmediate: (interpreterProxy stackValue: 0)). + vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 3)) - [vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 3)) to: #'VMCallbackContext *'. isMostRecent := vmCallbackContext = self getMostRecentCallbackContext. isMostRecent ifFalse: [^interpreterProxy methodReturnValue: interpreterProxy falseObject]. (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. [interpreterProxy signalNoResume: (interpreterProxy stackValue: 2)] whileFalse] ifFalse: + [self assert: interpreterProxy methodArgumentCount = 2. + self assert: (interpreterProxy isNonImmediate: (interpreterProxy stackValue: 2)). + self assert: (interpreterProxy isIntegerObject: (interpreterProxy stackValue: 1)). + self assert: (interpreterProxy isNonImmediate: (interpreterProxy stackValue: 0)). + vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 2)) - [vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 2)) to: #'VMCallbackContext *']. (interpreterProxy returnAs: (interpreterProxy stackValue: 1) ThroughCallback: vmCallbackContext Context: (interpreterProxy stackValue: 0)) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. "NOTREACHED"! 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 statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer debugCallbackPath debugCallbackReturns debugCallbackInvokes' - 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 statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer' 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…. 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?rel…).! Item was changed: ----- Method: StackInterpreter class>>mustBeGlobal: (in category 'translation') ----- mustBeGlobal: var "Answer if a variable must be global and exported. Used for inst vars that are accessed from VM support code." ^(super mustBeGlobal: var) or: [(self objectMemoryClass mustBeGlobal: var) or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents' 'deferDisplayUpdates' 'extraVMMemory' 'showSurfaceFn' 'desiredNumStackPages' 'desiredEdenBytes' 'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller' 'checkedPluginName' + 'suppressHeartbeatFlag' 'debugCallbackInvokes' 'debugCallbackPath' 'debugCallbackReturns') includes: var) - 'suppressHeartbeatFlag') includes: var) or: [ "This allows slow machines to define bytecodeSetSelector as 0 to avoid the interpretation overhead." MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]]! Item was added: + ----- Method: StackInterpreter>>disownVM: (in category 'vm scheduling') ----- + disownVM: flags + <api> + <inline: false> + "Release the VM to other threads and answer the current thread's index. + + This is the entry-point for plugins and primitives that wish to release the VM while + performing some operation that may potentially block, and for callbacks returning + back to some blocking operation. While this exists for the threaded FFI VM we use + it to reset newMethod and the argumentCount after a callback." + self assert: ((objectMemory isIntegerObject: flags) + and: [(objectMemory integerValueOf: flags) + between: 0 + and: (self argumentCountOfMethodHeader: -1)]). + self assert: primFailCode = 0. + argumentCount := objectMemory integerValueOf: flags. + newMethod := self popStack. + self assert: ((objectMemory isOopCompiledMethod: newMethod) + and: [(self argumentCountOf: newMethod) = argumentCount]). + ^0! Item was changed: ----- Method: StackInterpreter>>initialize (in category 'initialization') ----- initialize "Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated." checkAllocFiller := false. "must precede initializeObjectMemory:" primFailCode := 0. stackLimit := 0. "This is also the initialization flag for the stack system." stackPage := overflowedPage := 0. extraFramesToMoveOnOverflow := 0. bytecodeSetSelector := 0. highestRunnableProcessPriority := 0. nextProfileTick := 0. nextPollUsecs := 0. nextWakeupUsecs := 0. tempOop := tempOop2 := tempOop3 := theUnknownShort := 0. interruptPending := false. inIOProcessEvents := 0. fullScreenFlag := 0. deferDisplayUpdates := false. pendingFinalizationSignals := statPendingFinalizationSignals := 0. globalSessionID := 0. jmpDepth := 0. longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0. maxExtSemTabSizeSet := false. + debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0. statForceInterruptCheck := statStackOverflow := statCheckForEvents := statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0! Item was added: + ----- Method: StackInterpreter>>ownVM: (in category 'vm scheduling') ----- + ownVM: threadIndexAndFlags + <api> + <inline: false> + "This is the entry-point for plugins and primitives that wish to reacquire the VM after having + released it via disownVM or callbacks that want to acquire it without knowing their ownership + status. While this exists for the threaded FFI VM we use it to reset newMethod and the + argumentCount after a callback. + + Answer the argumentCount encoded as a SmallInteger if the current thread is the VM thread. + Answer -1 if the current thread is unknown to the VM and fails to take ownership." + | amInVMThread | + <var: 'amInVMThread' declareC: 'extern sqInt amInVMThread(void)'> + self cCode: [] inSmalltalk: [amInVMThread := 1. amInVMThread class]. + self amInVMThread ifFalse: + [^-1]. + self assert: primFailCode = 0. + self assert: ((objectMemory isOopCompiledMethod: newMethod) + and: [(self argumentCountOf: newMethod) = argumentCount]). + self push: newMethod. + ^objectMemory integerObjectOf: argumentCount! Item was changed: ----- Method: StackInterpreter>>returnAs:ThroughCallback:Context: (in category 'callback support') ----- returnAs: returnTypeOop ThroughCallback: vmCallbackContext Context: callbackMethodContext "callbackMethodContext is an activation of invokeCallback:[stack:registers:jmpbuf:]. Its sender is the VM's state prior to the callback. Reestablish that state (via longjmp), and mark callbackMethodContext as dead." <export: true> <var: #vmCallbackContext type: #'VMCallbackContext *'> | calloutMethodContext theFP thePage | <var: #theFP type: #'char *'> <var: #thePage type: #'StackPage *'> + self assert: primFailCode = 0. + self assert: (objectMemory isIntegerObject: returnTypeOop). + self assert: (objectMemory isImmediate: vmCallbackContext) not. + self assert: ((objectMemory addressCouldBeObj: callbackMethodContext) + and: [objectMemory isContext: callbackMethodContext]). + self assert: (debugCallbackPath := 0) = 0. + ((objectMemory isIntegerObject: returnTypeOop) - ((self isIntegerObject: returnTypeOop) and: [self isLiveContext: callbackMethodContext]) ifFalse: + [self assert: (debugCallbackPath := 1) = 1. + ^false]. - [^false]. calloutMethodContext := self externalInstVar: SenderIndex ofContext: callbackMethodContext. (self isLiveContext: calloutMethodContext) ifFalse: + [self assert: (debugCallbackPath := 2) = 2. + ^false]. + self assert: (debugCallbackReturns := debugCallbackReturns + 1) > 0. + "self assert: debugCallbackReturns < 3802." - [^false]. "We're about to leave this stack page; must save the current frame's instructionPointer." self push: instructionPointer. self externalWriteBackHeadFramePointers. "Mark callbackMethodContext as dead; the common case is that it is the current frame. We go the extra mile for the debugger." (self isSingleContext: callbackMethodContext) + ifTrue: + [self assert: (debugCallbackPath := debugCallbackPath bitOr: 4) > 0. + self markContextAsDead: callbackMethodContext] - ifTrue: [self markContextAsDead: callbackMethodContext] ifFalse: + [self assert: (debugCallbackPath := debugCallbackPath bitOr: 8) > 0. + theFP := self frameOfMarriedContext: callbackMethodContext. + self assert: (self frameReceiver: theFP) = (objectMemory splObj: ClassAlien). - [theFP := self frameOfMarriedContext: callbackMethodContext. framePointer = theFP "common case" ifTrue: + [self assert: (debugCallbackPath := debugCallbackPath bitOr: 16) > 0. + (self isBaseFrame: theFP) ifFalse: "calloutMethodContext is immediately below on the same page. Make it current." + [self assert: (debugCallbackPath := debugCallbackPath bitOr: 32) > 0. + instructionPointer := (self frameCallerSavedIP: theFP) asUnsignedInteger. + stackPointer := theFP + (self frameStackedReceiverOffset: theFP) + objectMemory wordSize. + framePointer := self frameCallerFP: theFP. - [(self isBaseFrame: theFP) ifFalse: "calloutMethodContext is immediately below on the same page. Make it current." - [instructionPointer := (self frameCallerSavedIP: framePointer) asUnsignedInteger. - stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer) + objectMemory wordSize. - framePointer := self frameCallerFP: framePointer. self setMethod: (self frameMethodObject: framePointer). self restoreCStackStateForCallbackContext: vmCallbackContext. + self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer. "N.B. siglongjmp is defines as _longjmp on non-win32 platforms. This matches the use of _setjmp in ia32abicc.c." self siglong: vmCallbackContext trampoline jmp: (self integerValueOf: returnTypeOop). ^true]. stackPages freeStackPage: stackPage] ifFalse: + [self assert: (debugCallbackPath := debugCallbackPath bitOr: 64) > 0. + self externalDivorceFrame: theFP andContext: callbackMethodContext. - [self externalDivorceFrame: theFP andContext: callbackMethodContext. self markContextAsDead: callbackMethodContext]]. "Make the calloutMethodContext the active frame. The case where calloutMethodContext is immediately below callbackMethodContext on the same page is handled above." (self isStillMarriedContext: calloutMethodContext) ifTrue: + [self assert: (debugCallbackPath := debugCallbackPath bitOr: 128) > 0. + theFP := self frameOfMarriedContext: calloutMethodContext. - [theFP := self frameOfMarriedContext: calloutMethodContext. thePage := stackPages stackPageFor: theFP. "findSPOf:on: points to the word beneath the instructionPointer, but there is no instructionPointer on the top frame of the current page." self assert: thePage ~= stackPage. stackPointer := thePage headFP = theFP ifTrue: [thePage headSP] ifFalse: [(self findSPOf: theFP on: thePage) - objectMemory wordSize]. + framePointer := theFP. + self assert: stackPointer < framePointer] - framePointer := theFP] ifFalse: + [self assert: (debugCallbackPath := debugCallbackPath bitOr: 256) > 0. + thePage := self makeBaseFrameFor: calloutMethodContext. + self setStackPointersFromPage: thePage]. - [thePage := self makeBaseFrameFor: calloutMethodContext. - framePointer := thePage headFP. - stackPointer := thePage headSP]. instructionPointer := self popStack. self setMethod: (objectMemory fetchPointer: MethodIndex ofObject: calloutMethodContext). self setStackPageAndLimit: thePage. self restoreCStackStateForCallbackContext: vmCallbackContext. + primitiveFunctionPointer := vmCallbackContext savedPrimFunctionPointer. + "N.B. siglongjmp is defined as _longjmp on non-win32 platforms. - "N.B. siglongjmp is defines as _longjmp on non-win32 platforms. This matches the use of _setjmp in ia32abicc.c." self siglong: vmCallbackContext trampoline jmp: (self integerValueOf: returnTypeOop). "NOTREACHED" ^true! Item was changed: ----- Method: StackInterpreter>>sendInvokeCallbackContext: (in category 'callback support') ----- sendInvokeCallbackContext: vmCallbackContext + "Send the calllback message to Alien class with the supplied arg(s). Use either the 1 arg + invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf: message, + depending on what selector is installed in the specialObjectsArray. Note that if invoking the + legacy invokeCallback:stack:registers:jmpbuf: we pass the vmCallbackContext as the jmpbuf + argument (see reestablishContextPriorToCallback:). The arguments are raw C addresses and + are converted to integer objects on the way. sendInvokeCallbackContext: & + returnAs:ThroughCallback:Context: along with ownVM: and disownVM: conspire to save and + restore newMethod, argumentCount and primitiveFunctionPointer around a callback. + The VM depends on argumentCount being correct to cut-back the correct number of + arguments on primitive return. If a primitive that invokes a callback fails after invoking a + callback (a bad idea, but s**t happens during development) then newMethod is required to + activate the right faling method, and Spur expects primitiveFunctionPointer to be valid, so + asserts will fail misleadingly if not." - "Send the calllback message to Alien class with the supplied arg(s). Use either the - 1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf: - message, depending on what selector is installed in the specialObjectsArray. - Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the - vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:). - The arguments are raw C addresses and are converted to integer objects on the way." <export: true> <var: #vmCallbackContext type: #'VMCallbackContext *'> | classTag | + vmCallbackContext savedPrimFunctionPointer: primitiveFunctionPointer. + classTag := self fetchClassTagOfNonImm: (objectMemory splObj: ClassAlien). - classTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien). messageSelector := self splObj: SelectorInvokeCallback. (self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse: [(self lookupOrdinaryNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue: [^false]]. primitiveFunctionPointer ~= 0 ifTrue: + [primitiveFunctionPointer := vmCallbackContext savedPrimFunctionPointer. + ^false]. + self assert: (debugCallbackInvokes := debugCallbackInvokes + 1) > 0. + "self assert: debugCallbackInvokes < 3802." - [^false]. self saveCStackStateForCallbackContext: vmCallbackContext. + self push: (objectMemory splObj: ClassAlien). "receiver" - self push: (self splObj: ClassAlien). "receiver" (self argumentCountOf: newMethod) = 4 ifTrue: [self push: (self positiveMachineIntegerFor: vmCallbackContext thunkp asUnsignedInteger). self push: (self positiveMachineIntegerFor: vmCallbackContext stackp asUnsignedInteger). self push: (self positiveMachineIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)]. self push: (self positiveMachineIntegerFor: vmCallbackContext asUnsignedInteger). self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector. self justActivateNewMethod. (self isMachineCodeFrame: framePointer) ifFalse: [self maybeFlagMethodAsInterpreted: newMethod]. self checkForStackOverflow. + self assert: (self frameReceiver: framePointer) = (objectMemory splObj: ClassAlien). self enterSmalltalkExecutiveFromCallback. "not reached" ^true! Item was changed: VMStructType subclass: #VMCallbackContext + instanceVariableNames: 'thunkp stackp intregargsp floatregargsp savedCStackPointer savedCFramePointer savedPrimFunctionPointer rvs trampoline savedReenterInterpreter' - instanceVariableNames: 'thunkp stackp intregargsp floatregargsp savedCStackPointer savedCFramePointer rvs trampoline savedReenterInterpreter' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Support'! Item was changed: ----- Method: VMCallbackContext class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "Define a CallbackContext, the argument to sendInvokeCallbackContext: self typedef" self instVarNames do: [:ivn| aBinaryBlock value: ivn value: (ivn caseOf: { + ['stackp'] -> [#'sqIntptr_t *']. + ['intregargsp'] -> [#'sqIntptr_t *']. + ['floatregargsp'] -> [#'double *']. + ['rvs'] -> [ + 'union { + sqIntptr_t valword; + struct { int low, high; } valleint64; + struct { int high, low; } valbeint64; + double valflt64; + struct { void *addr; sqIntptr_t size; } valstruct; + }']. + ['trampoline'] -> [#'jmp_buf']. + ['savedReenterInterpreter'] -> [#'jmp_buf']} + otherwise: [#'void *'])]! - ['thunkp'] -> [#'void *']. - ['stackp'] -> [#'sqIntptr_t *']. - ['intregargsp'] -> [#'sqIntptr_t *']. - ['floatregargsp'] -> [#'double *']. - ['rvs'] -> [ - 'union { - sqIntptr_t valword; - struct { int low, high; } valleint64; - struct { int high, low; } valbeint64; - double valflt64; - struct { void *addr; sqIntptr_t size; } valstruct; - }']. - ['savedCStackPointer'] -> [#'void *']. - ['savedCFramePointer'] -> [#'void *']. - ['trampoline'] -> [#'jmp_buf']. - ['savedReenterInterpreter'] -> [#'jmp_buf']})]! Item was added: + ----- Method: VMCallbackContext>>savedPrimFunctionPointer (in category 'accessing') ----- + savedPrimFunctionPointer + + ^ savedPrimFunctionPointer + ! Item was added: + ----- Method: VMCallbackContext>>savedPrimFunctionPointer: (in category 'accessing') ----- + savedPrimFunctionPointer: anObject + + ^ savedPrimFunctionPointer := anObject. + !

1 0

VM Maker: VMMaker.oscog-cb.2151.mcz
by commits＠source.squeak.org 14 Mar '17

14 Mar '17

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2151.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.2151 Author: cb Time: 13 March 2017, 6:10:59.621322 pm UUID: 8ab2036a-1289-4814-b7a0-da58ae42d82b Ancestors: VMMaker.oscog-eem.2150 Fixed a bug where directed super send byte was leaking numExtB, leasing to the next instruction with ExtB being incorrectly interpreted =============== Diff against VMMaker.oscog-eem.2150 =============== Item was changed: ----- Method: StackInterpreter>>extSendSuperBytecode (in category 'send bytecodes') ----- extSendSuperBytecode "239 11101111 i i i i i j j j ExtendB < 64 ifTrue: [Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments] ifFalse: [Send To Superclass of Stacked Class Literal Selector #iiiii (+ Extend A * 32) with jjj (+ (Extend B bitAnd: 63) * 8) Arguments]" | byte | byte := self fetchByte. messageSelector := self literal: (byte >> 3) + (extA << 5). extA := 0. BytecodeSetHasDirectedSuperSend ifTrue: [extB >= 64 ifTrue: [argumentCount := (byte bitAnd: 7) + (extB - 64 << 3). extB := 0. + numExtB := 0. ^self directedSuperclassSend]]. argumentCount := (byte bitAnd: 7) + (extB << 3). extB := 0. numExtB := 0. self superclassSend!

1 0

VM Maker: VMMaker.oscog-eem.2150.mcz
by commits＠source.squeak.org 14 Mar '17

14 Mar '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2150.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2150 Author: eem Time: 13 March 2017, 5:38:40.739778 pm UUID: 022f453c-dd21-46ff-877c-e997ce7cdc88 Ancestors: VMMaker.oscog-eem.2149 Stack/CoInterpreter: Refactor the assignments to the stack pointers from a page's head pointers into setStackPointersFromPage:. Remove calls to addNewmethodToCache: from clients of lookupOrdinaryNoMNUEtcInClass: which does this anyway. Cogit: Use unsigned int as the type of 32-bit instructions (ARM & MIPS). Reduce code on the class side in defining the CogAbstractInstruction typedefs. Eliminate some "variable name shadows method" warnings. Document that the limit on the Cogit's alloca more than ensures that the number of abstract instructions and bytecode fixups fits within 16 bits. Make sure a simulation-only merthod is not generated. FDix traceMerge: for in-image compilation. =============== Diff against VMMaker.oscog-eem.2149 =============== Item was changed: ----- Method: CoInterpreter>>ceBaseFrameReturn: (in category 'trampolines') ----- ceBaseFrameReturn: returnValue "Return across a page boundary. The context to return to (which may be married) is stored in the first word of the stack. We get here when a return instruction jumps to the ceBaseFrameReturn: address that is the return pc for base frames. A consequence of this is that the current frame is no longer valid since an interrupt may have overwritten its state as soon as the stack pointer has been cut-back beyond the return pc. So to have a context to send the cannotReturn: message to we also store the base frame's context in the second word of the stack page." <api> | contextToReturnTo contextToReturnFrom isAContext thePage newPage frameAbove | <var: #thePage type: #'StackPage *'> <var: #newPage type: #'StackPage *'> <var: #frameAbove type: #'char *'> self assert: (stackPages stackPageFor: stackPointer) = stackPage. self assert: stackPages mostRecentlyUsedPage = stackPage. cogit assertCStackWellAligned. self assert: framePointer = 0. self assert: stackPointer <= (stackPage baseAddress - objectMemory wordSize). self assert: stackPage baseFP + (2 * objectMemory wordSize) < stackPage baseAddress. "We would like to use the following assert but we can't since the stack pointer will be above the base frame pointer in the base frame return and hence the 0 a base frame pointer points at could be overwritten which will cause the isBaseFrame assert in frameCallerContext: to fail." "self assert: (self frameCallerContext: stackPage baseFP) = (stackPages longAt: stackPage baseAddress)." self assert: ((objectMemory addressCouldBeObj: (stackPages longAt: stackPage baseAddress - objectMemory wordSize)) and: [objectMemory isContext: (stackPages longAt: stackPage baseAddress - objectMemory wordSize)]). contextToReturnTo := stackPages longAt: stackPage baseAddress. self assert: (objectMemory addressCouldBeObj: contextToReturnTo). "The stack page is effectively free now, so free it. We must free it to be correct in determining if contextToReturnTo is still married, and in case makeBaseFrameFor: cogs a method, which may cause a code compaction, in which case the frame must be free to avoid the relocation machinery tracing the dead frame. Since freeing now temporarily violates the page-list ordering invariant, use the assert-free version." stackPages freeStackPageNoAssert: stackPage. isAContext := objectMemory isContext: contextToReturnTo. (isAContext and: [self isStillMarriedContext: contextToReturnTo]) ifTrue: [framePointer := self frameOfMarriedContext: contextToReturnTo. thePage := stackPages stackPageFor: framePointer. framePointer = thePage headFP ifTrue: [stackPointer := thePage headSP] ifFalse: ["Returning to some interior frame, presumably because of a sender assignment. Move the frames above to another page (they may be in use, e.g. via coroutining). Make the interior frame the top frame." frameAbove := self findFrameAbove: framePointer inPage: thePage. "Since we've just deallocated a page we know that newStackPage won't deallocate an existing one." newPage := stackPages newStackPage. self assert: newPage = stackPage. self moveFramesIn: thePage through: frameAbove toPage: newPage. stackPages markStackPageMostRecentlyUsed: newPage. + self setStackPointersFromPage: thePage]] - framePointer := thePage headFP. - stackPointer := thePage headSP]] ifFalse: [(isAContext and: [objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: contextToReturnTo)]) ifFalse: [contextToReturnFrom := stackPages longAt: stackPage baseAddress - objectMemory wordSize. self tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue. ^self externalCannotReturn: returnValue from: contextToReturnFrom]. "void the instructionPointer to stop it being incorrectly updated in a code compaction in makeBaseFrameFor:." instructionPointer := 0. thePage := self makeBaseFrameFor: contextToReturnTo. + self setStackPointersFromPage: thePage]. - framePointer := thePage headFP. - stackPointer := thePage headSP]. self setStackPageAndLimit: thePage. self assert: (stackPages stackPageFor: framePointer) = stackPage. (self isMachineCodeFrame: framePointer) ifTrue: [self push: returnValue. cogit ceEnterCogCodePopReceiverReg. "NOTREACHED"]. instructionPointer := self stackTop. instructionPointer = cogit ceReturnToInterpreterPC ifTrue: [instructionPointer := self iframeSavedIP: framePointer]. self setMethod: (self iframeMethod: framePointer). self stackTopPut: returnValue. "a.k.a. pop saved ip then push result" self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: framePointer). self siglong: reenterInterpreter jmp: ReturnToInterpreter. "NOTREACHED" ^nil! Item was changed: ----- Method: CoInterpreter>>ceCounterTripped: (in category 'cog jit support') ----- ceCounterTripped: condition "Two things are going on here. The main one is catching a counter trip and attempting to send the SelectorCounterTripped selector. In this case we would like to back-up the pc to the return address of the send that yields the boolean to be tested, so that after potential optimization, computation proceeds by retrying the jump. But we cannot, since there may be no send, just a pop (as in and: [] and or: [] chains). In this case we also want to prevent further callbacks until optimization is complete. So we nil-out the SelectorCounterTripped entry in the specialSelectorArray. The minor case is that there is an unlikely possibility that the cointer tripped but condition is not a boolean, in which case a mustBeBoolean response should occur." <api> <option: #SistaCogit> "Send e.g. thisContext conditionalBranchCounterTrippedOn: boolean." | context counterTrippedSelector classTag classObj | (condition = objectMemory falseObject or: [condition = objectMemory trueObject]) ifFalse: [^self ceSendMustBeBoolean: condition]. counterTrippedSelector := objectMemory maybeSplObj: SelectorCounterTripped. (counterTrippedSelector isNil or: [counterTrippedSelector = objectMemory nilObject]) ifTrue: [cogit resetCountersIn: (self mframeHomeMethod: framePointer). ^condition]. classTag := objectMemory classTagForSpecialObjectsIndex: ClassMethodContext compactClassIndex: ClassMethodContextCompactIndex. (self lookupInMethodCacheSel: counterTrippedSelector classTag: classTag) ifFalse: [messageSelector := counterTrippedSelector. classObj := objectMemory classForClassTag: classTag. (self lookupOrdinaryNoMNUEtcInClass: classObj) ~= 0 ifTrue: [cogit resetCountersIn: (self mframeHomeMethod: framePointer). + ^condition]]. - ^condition]. - self addNewMethodToCache: classObj]. (primitiveFunctionPointer ~= 0 or: [(self argumentCountOf: newMethod) ~= 1]) ifTrue: [cogit resetCountersIn: (self mframeHomeMethod: framePointer). ^condition]. objectMemory splObj: SelectorCounterTripped put: objectMemory nilObject. instructionPointer := self popStack. context := self ensureFrameIsMarried: framePointer SP: stackPointer. self push: context. self push: condition. self ifAppropriateCompileToNativeCode: newMethod selector: counterTrippedSelector. self activateNewMethod. "not reached" ^true! Item was changed: ----- Method: CoInterpreter>>ceNonLocalReturn: (in category 'trampolines') ----- ceNonLocalReturn: returnValue <api> | closure home unwindContextOrNilOrZero ourContext frameToReturnTo contextToReturnTo theFP callerFP newPage | <var: #frameToReturnTo type: #'char *'> <var: #theFP type: #'char *'> <var: #callerFP type: #'char *'> <var: #newPage type: #'StackPage *'> <var: #thePage type: #'StackPage *'> "self shortPrintFrameAndCallers: framePointer. self printOop: returnValue. self halt." self assert: (self isMachineCodeFrame: framePointer). self assert: (self frameIsBlockActivation: framePointer). "Since this is a block activation the closure is on the stack above any args and the frame." closure := self pushedReceiverOrClosureOfFrame: framePointer. home := nil. "Walk the closure's lexical chain to find the context or frame to return from (home)." [closure ~= objectMemory nilObject] whileTrue: [home := objectMemory followField: ClosureOuterContextIndex ofObject: closure. closure := objectMemory followField: ClosureIndex ofObject: home]. "home is to be returned from provided there is no unwind-protect activation between this frame and home's sender. Search for an unwind. findUnwindThroughContext: will answer either the context for an unwind-protect activation or nilObj if the sender cannot be found or 0 if no unwind is found but the sender is. We must update the current page's headFrame pointers to enable the search to identify widowed contexts correctly." self externalWriteBackHeadFramePointers. unwindContextOrNilOrZero := self findUnwindThroughContext: home. unwindContextOrNilOrZero = objectMemory nilObject ifTrue: ["error: can't find home on chain; cannot return" ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer. ^self externalCannotReturn: returnValue from: ourContext]. unwindContextOrNilOrZero ~= 0 ifTrue: [^self externalAboutToReturn: returnValue through: unwindContextOrNilOrZero]. "Now we know home is on the sender chain. We could be returning to either a context or a frame. Find out which." contextToReturnTo := nil. (self isMarriedOrWidowedContext: home) ifTrue: [self assert: (self checkIsStillMarriedContext: home currentFP: framePointer). theFP := self frameOfMarriedContext: home. (self isBaseFrame: theFP) ifTrue: [contextToReturnTo := self frameCallerContext: theFP] ifFalse: [frameToReturnTo := self frameCallerFP: theFP]] ifFalse: [contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home. ((objectMemory isContext: contextToReturnTo) and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue: [self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: framePointer). frameToReturnTo := self frameOfMarriedContext: contextToReturnTo. contextToReturnTo := nil]]. "If returning to a context we must make a frame for it unless it is dead." contextToReturnTo ~= nil ifTrue: [frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo. frameToReturnTo == 0 ifTrue: ["error: home's sender is dead; cannot return" ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer. ^self externalCannotReturn: returnValue from: ourContext]]. "Now we have a frame to return to. If it is on a different page we must free intervening pages and nil out intervening contexts. We must free intervening stack pages because if we leave the pages to be divorced then their contexts will be divorced with intact senders and instruction pointers. This code is similar to primitiveTerminateTo." self assert: stackPages pageListIsWellFormed. newPage := stackPages stackPageFor: frameToReturnTo. newPage ~~ stackPage ifTrue: [| currentCtx thePage nextCntx | currentCtx := self frameCallerContext: stackPage baseFP. self assert: (objectMemory isContext: currentCtx). stackPages freeStackPage: stackPage. [self assert: (objectMemory isContext: currentCtx). (self isMarriedOrWidowedContext: currentCtx) and: [(stackPages stackPageFor: (theFP := self frameOfMarriedContext: currentCtx)) = newPage]] whileFalse: [(self isMarriedOrWidowedContext: currentCtx) ifTrue: [thePage := stackPages stackPageFor: theFP. currentCtx := self frameCallerContext: thePage baseFP. stackPages freeStackPage: thePage] ifFalse: [nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx. self markContextAsDead: currentCtx. currentCtx := nextCntx]]. self setStackPageAndLimit: newPage. + self setStackPointersFromPage: newPage]. - stackPointer := stackPage headSP. - framePointer := stackPage headFP]. "Two cases. Returning to the top frame or an interior frame. The top frame has its instruction pointer on top of stack. An interior frame has its instruction pointer in the caller frame. We need to peel back any frames on the page until we get to the correct frame." framePointer = frameToReturnTo ifTrue: [instructionPointer := self popStack] ifFalse: [[callerFP := framePointer. framePointer := self frameCallerFP: framePointer. framePointer ~~ frameToReturnTo] whileTrue. instructionPointer := (self frameCallerSavedIP: callerFP) asUnsignedInteger. stackPointer := (self frameCallerSP: callerFP)]. ^self return: returnValue toExecutive: false! Item was changed: ----- Method: CoInterpreter>>ceSend:above:to:numArgs: (in category 'trampolines') ----- ceSend: selector above: startAssociationArg to: rcvr numArgs: numArgs "Entry-point for an unlinked directed super send in a CogMethod. Smalltalk stack looks like receiver args head sp -> sender return pc startAssociation is an association whose value is the class above which to start the lookup. If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and may choose to allocate a closed PIC with a fast MNU dispatch for this send. Otherwise attempt to link the send site as efficiently as possible. All link attempts may fail; e.g. because we're out of code memory. Continue execution via either executeMethod or interpretMethodFromMachineCode: depending on whether the target method is cogged or not." <api> <option: #BytecodeSetHasDirectedSuperSend> | startAssociation classTag classObj errSelIdx cogMethod | <inline: false> <var: #cogMethod type: #'CogMethod *'> <var: #newCogMethod type: #'CogMethod *'> "self printExternalHeadFrame" "self printStringOf: selector" cogit assertCStackWellAligned. self assert: (objectMemory addressCouldBeOop: rcvr). self sendBreakpoint: selector receiver: rcvr. startAssociation := objectMemory followMaybeForwarded: startAssociationArg. classTag := objectMemory classTagForClass: (self superclassOf: (objectMemory fetchPointer: ValueIndex ofObject: startAssociation)). argumentCount := numArgs. (self lookupInMethodCacheSel: selector classTag: classTag) ifTrue:"check for coggability because method is in the cache" [self ifAppropriateCompileToNativeCode: newMethod selector: selector] ifFalse: [self deny: (objectMemory isForwardedClassTag: classTag). (objectMemory isOopForwarded: selector) ifTrue: [^self ceSend: (self handleForwardedSelectorFaultFor: selector) above: startAssociation to: rcvr numArgs: numArgs]. messageSelector := selector. classObj := objectMemory classForClassTag: classTag. (errSelIdx := self lookupOrdinaryNoMNUEtcInClass: classObj) ~= 0 ifTrue: [(errSelIdx = SelectorDoesNotUnderstand and: [(cogMethod := cogit cogMNUPICSelector: messageSelector receiver: rcvr methodOperand: (self mnuMethodOrNilFor: rcvr) numArgs: argumentCount) asUnsignedInteger > cogit minCogMethodAddress]) ifTrue: [cogit linkSendAt: (stackPages longAt: stackPointer) in: (self mframeHomeMethod: framePointer) to: cogMethod offset: cogit noCheckEntryOffset receiver: rcvr]. self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classObj. + self assert: false "NOTREACHED"]]. - self assert: false "NOTREACHED"]. - self addNewMethodToCache: classObj]. "Method found and has a cog method. Attempt to link to it. The receiver's class may be young. If the Cogit can't store young classes in inline caches we can link to an open PIC instead." (self maybeMethodHasCogMethod: newMethod) ifTrue: [cogMethod := self cogMethodOf: newMethod. cogMethod selector = objectMemory nilObject ifTrue: [cogit setSelectorOf: cogMethod to: selector] ifFalse: ["Deal with anonymous accessors, e.g. in Newspeak. The cogMethod may not have the correct selector. If not, try and compile a new method with the correct selector." cogMethod selector ~= selector ifTrue: [(cogit cog: newMethod selector: selector) ifNotNil: [:newCogMethod| cogMethod := newCogMethod]]]. cogMethod selector = selector ifTrue: [cogit linkSendAt: (stackPages longAt: stackPointer) in: (self mframeHomeMethod: framePointer) to: cogMethod offset: cogit noCheckEntryOffset receiver: rcvr] ifFalse: "If patchToOpenPICFor:.. returns we're out of code memory" [cogit patchToOpenPICFor: selector numArgs: numArgs receiver: rcvr]. instructionPointer := self popStack. self executeNewMethod. self assert: false "NOTREACHED"]. instructionPointer := self popStack. ^self interpretMethodFromMachineCode "NOTREACHED"! Item was changed: ----- Method: CoInterpreter>>ceSend:super:to:numArgs: (in category 'trampolines') ----- ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs "Entry-point for an unlinked send in a CogMethod. Smalltalk stack looks like receiver args head sp -> sender return pc If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and may choose to allocate a closed PIC with a fast MNU dispatch for this send. Otherwise attempt to link the send site as efficiently as possible. All link attempts may fail; e.g. because we're out of code memory. Continue execution via either executeMethod or interpretMethodFromMachineCode: depending on whether the target method is cogged or not." <api> | classTag classObj errSelIdx cogMethod | <inline: false> <var: #cogMethod type: #'CogMethod *'> <var: #newCogMethod type: #'CogMethod *'> "self printExternalHeadFrame" "self printStringOf: selector" cogit assertCStackWellAligned. self assert: (objectMemory addressCouldBeOop: rcvr). self sendBreakpoint: selector receiver: rcvr. superNormalBar = 0 ifTrue: [classTag := objectMemory fetchClassTagOf: rcvr] ifFalse: [classTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer)))]. argumentCount := numArgs. (self lookupInMethodCacheSel: selector classTag: classTag) ifTrue:"check for coggability because method is in the cache" [self ifAppropriateCompileToNativeCode: newMethod selector: selector] ifFalse: [(objectMemory isOopForwarded: selector) ifTrue: [^self ceSend: (self handleForwardedSelectorFaultFor: selector) super: superNormalBar to: rcvr numArgs: numArgs]. (objectMemory isForwardedClassTag: classTag) ifTrue: [self assert: superNormalBar = 0. ^self ceSend: selector super: superNormalBar to: (self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc") numArgs: numArgs]. messageSelector := selector. classObj := objectMemory classForClassTag: classTag. (errSelIdx := self lookupOrdinaryNoMNUEtcInClass: classObj) ~= 0 ifTrue: [(errSelIdx = SelectorDoesNotUnderstand and: [(cogMethod := cogit cogMNUPICSelector: messageSelector receiver: rcvr methodOperand: (self mnuMethodOrNilFor: rcvr) numArgs: argumentCount) asUnsignedInteger > cogit minCogMethodAddress]) ifTrue: [cogit linkSendAt: (stackPages longAt: stackPointer) in: (self mframeHomeMethod: framePointer) to: cogMethod offset: (superNormalBar = 0 ifTrue: [cogit entryOffset] ifFalse: [cogit noCheckEntryOffset]) receiver: rcvr]. self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classObj. + self assert: false "NOTREACHED"]]. - self assert: false "NOTREACHED"]. - self addNewMethodToCache: classObj]. "Method found and has a cog method. Attempt to link to it. The receiver's class may be young. If the Cogit can't store young classes in inline caches we can link to an open PIC instead." (self maybeMethodHasCogMethod: newMethod) ifTrue: [cogMethod := self cogMethodOf: newMethod. cogMethod selector = objectMemory nilObject ifTrue: [cogit setSelectorOf: cogMethod to: selector] ifFalse: ["Deal with anonymous accessors, e.g. in Newspeak. The cogMethod may not have the correct selector. If not, try and compile a new method with the correct selector." cogMethod selector ~= selector ifTrue: [(cogit cog: newMethod selector: selector) ifNotNil: [:newCogMethod| cogMethod := newCogMethod]]]. cogMethod selector = selector ifTrue: [cogit linkSendAt: (stackPages longAt: stackPointer) in: (self mframeHomeMethod: framePointer) to: cogMethod offset: (superNormalBar = 0 ifTrue: [cogit entryOffset] ifFalse: [cogit noCheckEntryOffset]) receiver: rcvr] ifFalse: "If patchToOpenPICFor:.. returns we're out of code memory" [cogit patchToOpenPICFor: selector numArgs: numArgs receiver: rcvr]. instructionPointer := self popStack. self executeNewMethod. self assert: false "NOTREACHED"]. instructionPointer := self popStack. ^self interpretMethodFromMachineCode "NOTREACHED"! Item was changed: ----- Method: CoInterpreter>>ceSendAbort:to:numArgs: (in category 'trampolines') ----- ceSendAbort: selector to: rcvr numArgs: numArgs "Entry-point for an abort send in a CogMethod (aboutToReturn:through:, cannotReturn: et al). Try and dispatch the send, but the send may turn into an MNU in which case defer to handleMNUInMachineCodeTo:... which will dispatch the MNU. Continue execution via either executeMethod or interpretMethodFromMachineCode: depending on whether the target method is cogged or not." <api> | classTag classObj errSelIdx | <inline: false> "self printExternalHeadFrame" "self printStringOf: selector" cogit assertCStackWellAligned. self assert: (objectMemory addressCouldBeOop: rcvr). self sendBreakpoint: selector receiver: rcvr. argumentCount := numArgs. classTag := objectMemory fetchClassTagOf: rcvr. (self lookupInMethodCacheSel: selector classTag: classTag) ifTrue:"check for coggability because method is in the cache" [self ifAppropriateCompileToNativeCode: newMethod selector: selector] ifFalse: [messageSelector := selector. classObj := objectMemory classForClassTag: classTag. (errSelIdx := self lookupOrdinaryNoMNUEtcInClass: classObj) ~= 0 ifTrue: [self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classObj. "NOTREACHED" + self assert: false]]. - self assert: false]. - self addNewMethodToCache: classObj]. instructionPointer := self popStack. (self maybeMethodHasCogMethod: newMethod) ifTrue: [self executeNewMethod. self assert: false "NOTREACHED"]. ^self interpretMethodFromMachineCode "NOTREACHED"! Item was changed: ----- Method: CoInterpreter>>ceSendFromInLineCacheMiss: (in category 'trampolines') ----- ceSendFromInLineCacheMiss: cogMethodOrPIC "Send from an Open PIC when the first-level method lookup probe has failed, or to continue when PIC creation has failed (e.g. because we're out of code space), or when a send has failed due to a forwarded receiver." <api> <var: #cogMethodOrPIC type: #'CogMethod *'> | numArgs rcvr classTag classObj errSelIdx | "self printFrame: stackPage headFP WithSP: stackPage headSP" "self printStringOf: selector" numArgs := cogMethodOrPIC cmNumArgs. rcvr := self stackValue: numArgs + 1. "skip return pc" self assert: (objectMemory addressCouldBeOop: rcvr). classTag := objectMemory fetchClassTagOf: rcvr. argumentCount := numArgs. false ifTrue: "would like to assert this but must also allow for an interpretable method in the cache." [self deny: (cogMethodOrPIC cmType = CMOpenPIC and: [self newMethodInLookupCacheAt: cogMethodOrPIC selector and: classTag])]. (self lookupInMethodCacheSel: cogMethodOrPIC selector classTag: classTag) ifTrue:"check for coggability because method is in the cache" [self ifAppropriateCompileToNativeCode: newMethod selector: cogMethodOrPIC selector] ifFalse: [(objectMemory isOopForwarded: cogMethodOrPIC selector) ifTrue: [self handleForwardedSelectorFaultFor: cogMethodOrPIC selector. ^self ceSendFromInLineCacheMiss: cogMethodOrPIC]. (objectMemory isForwardedClassTag: classTag) ifTrue: [self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc". ^self ceSendFromInLineCacheMiss: cogMethodOrPIC]. messageSelector := cogMethodOrPIC selector. classObj := objectMemory classForClassTag: classTag. (errSelIdx := self lookupOrdinaryNoMNUEtcInClass: classObj) ~= 0 ifTrue: [self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classObj. "NOTREACHED" + self assert: false]]. - self assert: false]. - self addNewMethodToCache: classObj]. instructionPointer := self popStack. (self maybeMethodHasCogMethod: newMethod) ifTrue: [self executeNewMethod. self assert: false "NOTREACHED"]. ^self interpretMethodFromMachineCode "NOTREACHED"! Item was changed: ----- Method: CoInterpreter>>tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom:to:returnValue: (in category 'return bytecodes') ----- tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue "Handle the cannot return response for a base frame return to an invalid context. Build a new base frame for the context in the cannot resume state ready for the send of cannotReturn:. Since we have returned from the base frame of the page the context is effectively widowed. But its sender needs to be contextToReturnTo, and its pc needs to be the HasBeenReturnedFromMCPC marker. So bereave it (as a side-effect of isWidowedContext:), assign contextToReturnTo to sender, and rebuild its frame, which will have the ceCannotResumePC as its pc. Finally push returnValue and set instructionPointer to ceCannotResumePC in preparation for the send." | newPage | <inline: false> <var: #newPage type: #'StackPage *'> self assert: (stackPage ~= 0 and: [stackPage isFree]). self isWidowedContext: contextToReturnFrom. self assert: (self isMarriedOrWidowedContext: contextToReturnFrom) not. objectMemory storePointer: SenderIndex ofObject: contextToReturnFrom withValue: contextToReturnTo; storePointer: InstructionPointerIndex ofObject: contextToReturnFrom withValue: HasBeenReturnedFromMCPCOop. "void the instructionPointer to stop it being incorrectly updated in a code compaction in makeBaseFrameFor:." instructionPointer := 0. newPage := self makeBaseFrameFor: contextToReturnFrom. self assert: stackPage = newPage. self setStackPageAndLimit: newPage. + self setStackPointersFromPage: newPage. - framePointer := stackPage headFP. - stackPointer := stackPage headSP. self assert: self stackTop = cogit ceCannotResumePC. "overwrite the ceSendCannotResumePC on the stack. If ever re-executed the returnValue will be taken from top-of-stack by ceCannotResume." self stackTopPut: returnValue. "Assign it to instructionPointer as externalCannotReturn:from: pushes it." instructionPointer := cogit ceCannotResumePC! Item was changed: ----- Method: CoInterpreterPrimitives>>primitiveVoidVMStateForMethod (in category 'system control primitives') ----- primitiveVoidVMStateForMethod "The receiver is a compiledMethod. Clear all VM state associated with the method, including any machine code, or machine code pcs in context objects." | activeContext methodObj hasCogMethod theFrame thePage | <var: #theFrame type: #'char *'> <var: #thePage type: #'StackPage *'> super primitiveFlushCacheByMethod. "One might think (as this author did) that the heap scan is unnecessary if the method does not have a cog method. But it could be the case that the code zone has recently been reclaimed and so not having a cog method is no indication that it didn't have a cog method some time in the recent past, and that there are indeed still contexts with machine code pcs out there. The only steps that can be avoided is divorcing frames in the stack zone, and scanning to unlink and free if there isn't a cog method." methodObj := self stackTop. activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. self ensurePushedInstructionPointer. self externalWriteBackHeadFramePointers. (hasCogMethod := self methodHasCogMethod: methodObj) ifTrue: [self divorceMachineCodeFramesWithMethod: methodObj]. self ensureAllContextsWithMethodHaveBytecodePCs: methodObj. hasCogMethod ifTrue: [cogit unlinkSendsTo: methodObj andFreeIf: true]. (self isStillMarriedContext: activeContext) ifTrue: [theFrame := self frameOfMarriedContext: activeContext. thePage := stackPages stackPageFor: theFrame. self assert: thePage headFP = theFrame. self setStackPageAndLimit: thePage. + self setStackPointersFromPage: thePage. - stackPointer := thePage headSP. - framePointer := thePage headFP. instructionPointer := self popStack. self assert: methodObj = self stackTop] ifFalse: [self zeroStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:" self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext. self popStack. "pop bogus machine-code instructionPointer" self assert: methodObj = self stackTop. self siglong: reenterInterpreter jmp: ReturnToInterpreter]! Item was changed: ----- Method: CogARMCompiler class>>machineCodeDeclaration (in category 'translation') ----- machineCodeDeclaration + "Answer the declaration for the machineCode array. + ARM instructions are 32-bits in length." + ^{#'unsigned int'. '[', self basicNew machineCodeWords printString, ']'}! - "Answer the declaration for the machineCode array." - ^{#'usqIntptr_t'. '[', self basicNew machineCodeWords printString, ']'}! Item was changed: ----- Method: CogARMCompiler>>rewriteCPICJumpAt:target: (in category 'inline cacheing') ----- + rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddr - rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddress "Rewrite a jump instruction to call a different target. This variant is used to reset the jumps in the prototype CPIC to suit each use,. Answer the extent of the code change which is used to compute the range of the icache to flush." <var: #addressFollowingJump type: #usqInt> + <var: #jumpTargetAddr type: #usqInt> - <var: #jumpTargetAddress type: #usqInt> <inline: true> + ^self rewriteTransferAt: addressFollowingJump target: jumpTargetAddr! - ^self rewriteTransferAt: addressFollowingJump target: jumpTargetAddress! Item was added: + ----- Method: CogAbstractInstruction class>>filteredInstVarNames (in category 'translation') ----- + filteredInstVarNames + "Eliminate bcpc, which is development-time only." + ^super filteredInstVarNames copyWithout: 'bcpc'! Item was changed: ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock + "Enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct." + "(CogAbstractInstruction withAllSubclasses reject: [:c| c name includesSubString: 'ForTests']) do: - "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct." - "{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do: [:c| Transcript print: c; cr. c printTypedefOn: Transcript]" (self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do: [:ivn| + aBinaryBlock + value: ivn + value: (ivn caseOf: { + ['address'] -> [#usqInt]. "usqInt is always large enough to contain a pointer; we do not need to use usqIntptr_t" + ['machineCode'] -> [self machineCodeDeclaration]. + ['operands'] -> [{#usqInt. '[', NumOperands, ']'}]. + ['dependent'] -> ['struct _AbstractInstruction *']} + otherwise: + [#'unsigned char'])]! - ivn ~= 'bcpc' ifTrue: - [aBinaryBlock - value: ivn - value: (ivn caseOf: { - ['address'] -> [#'usqIntptr_t']. - ['machineCode'] -> [self machineCodeDeclaration]. - ['operands'] -> [{#'usqIntptr_t'. '[', NumOperands, ']'}]. - ['dependent'] -> ['struct _AbstractInstruction *']} - otherwise: - [#'unsigned char'])]]! Item was changed: ----- Method: CogAbstractInstruction class>>machineCodeDeclaration (in category 'translation') ----- machineCodeDeclaration + "Answer a dummy declaration. Subclasses will override to provide the real one." - "Answer a dummy declaration. Subclasses will override to provgide the real one." ^#(#'unsigned char' '[4]')! Item was changed: ----- Method: CogBytecodeFixup class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock + "Enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a BytecodeFixup struct." + "self withAllSubclasses collect: [:ea| ea typedef]" - "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a BytecodeFixup struct." self filteredInstVarNames do: [:ivn| aBinaryBlock value: ivn + value: (ivn first ~= $# ifTrue: + [ivn caseOf: { + ['targetInstruction'] -> [#'AbstractInstruction *']. + ['mergeSimStack'] -> [#'SimStackEntry *']. + ['instructionIndex'] -> [#'unsigned short']. + ['simStackPtr'] -> [#char]. + ['simNativeStackPtr'] -> [#'unsigned short']. + ['simNativeStackSize'] -> [#'unsigned short']. + ['isReceiverResultRegSelf'] -> [#char] }])]! - value: (ivn = 'targetInstruction' - ifTrue: [#'AbstractInstruction *'] - ifFalse: - [#sqInt])]! Item was changed: ----- Method: CogIA32Compiler>>genPushC64: (in category 'abstract instructions') ----- genPushC64: constant64Bits <inline: true> <var: #constant64Bits type: #sqLong> <returnTypeC: #'AbstractInstruction *'> | inst highPart | + self assert: BytesPerWord = 4. + highPart := self cCode: '(constant64Bits >> 32LL)' inSmalltalk: [ constant64Bits bitShift: -32 ]. + inst :=cogit PushCw: highPart. + cogit PushCw: (constant64Bits bitAnd: 16rFFFFFFFF). + ^inst! - BytesPerWord == 4 ifTrue: [ - highPart := self cCode: '(constant64Bits >> 32ll)' inSmalltalk: [ constant64Bits bitShift: -32 ]. - inst :=cogit PushCw: highPart. - cogit PushCw: (constant64Bits bitAnd: 16rFFFFFFFF). - ^ inst - ] ifFalse: [ - ^ cogit PushCw: constant64Bits. - ]! Item was changed: ----- Method: CogIA32Compiler>>rewriteCPICJumpAt:target: (in category 'inline cacheing') ----- + rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddr - rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddress "Rewrite the short jump instruction to jump to a new cpic case target. " <var: #addressFollowingJump type: #usqInt> + <var: #jumpTargetAddr type: #usqInt> - <var: #jumpTargetAddress type: #usqInt> <var: #callDistance type: #sqInt> "prevent type inference for avoiding warning on abs" | callDistance | + callDistance := jumpTargetAddr - addressFollowingJump. - callDistance := jumpTargetAddress - addressFollowingJump. self assert: callDistance abs < 128. objectMemory byteAt: addressFollowingJump - 1 put: (callDistance bitAnd: 16rFF). "self cCode: '' + inSmalltalk: [cogit disassembleFrom: addressFollowingJump - 10 to: addressFollowingJump - 1]."! - inSmalltalk: [cogit disassembleFrom: addressFollowingJump - 10 to: addressFollowingJump - 1]." - ^2! Item was changed: ----- Method: CogMIPSELCompiler class>>machineCodeDeclaration (in category 'translation') ----- machineCodeDeclaration + "Answer the declaration for the machineCode array. + MPIS instructions are 32-bits in length." + ^{#'unsigned int'. '[', self basicNew machineCodeWords printString, ']'}! - "Answer the declaration for the machineCode array." - ^{#'usqIntptr_t'. '[', self basicNew machineCodeWords printString, ']'}! Item was changed: ----- Method: CogMIPSELCompiler>>rewriteCPICJumpAt:target: (in category 'inline cacheing') ----- + rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddr - rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddress "Rewrite a jump instruction to call a different target. This variant is used to reset the jumps in the prototype CPIC to suit each use,. Answer the extent of the code change which is used to compute the range of the icache to flush." <var: #addressFollowingJump type: #usqInt> + <var: #jumpTargetAddr type: #usqInt> - <var: #jumpTargetAddress type: #usqInt> "self CmpR: ClassReg R: TempReg. ^self JumpNonZero: 0" "bne s5, s3, +156 ; =BE7C nop (delay slot) .... <-- addressFollowingJump" self assert: (self opcodeAtAddress: addressFollowingJump - 8) = BNE. self assert: (objectMemory longAt: addressFollowingJump - 4) = self nop. "cogit disassembleFrom: addressFollowingJump - 8 to: addressFollowingJump." + self rewriteITypeBranchAtAddress: addressFollowingJump - 8 target: jumpTargetAddr. - self rewriteITypeBranchAtAddress: addressFollowingJump - 8 target: jumpTargetAddress. self assert: (self opcodeAtAddress: addressFollowingJump - 8) = BNE. self assert: (objectMemory longAt: addressFollowingJump - 4) = self nop. "cogit disassembleFrom: addressFollowingJump - 8 to: addressFollowingJump."! Item was removed: - ----- Method: CogMethodZone>>alignment (in category 'accessing') ----- - alignment - ^8! Item was added: + ----- Method: CogMethodZone>>zoneAlignment (in category 'accessing') ----- + zoneAlignment + ^8! Item was changed: ----- Method: CogObjectRepresentationFor64BitSpur>>maybeGenerateSelectorIndexDereferenceRoutine (in category 'initialization') ----- maybeGenerateSelectorIndexDereferenceRoutine "Generate the routine that converts selector indices into selector objects. It is called from the send trampolines. If the selector index is negative, convert it into a positive index into the special selectors array and index that. Otherwise, index the current method. The routine uses Extra0Reg & Extra1Reg, which are available, since they are not live at point of send." | jumpNegative jumpNotBlock jumpFullBlock | <var: 'jumpNegative' type: #'AbstractInstruction *'> <var: 'jumpNotBlock' type: #'AbstractInstruction *'> <var: 'jumpFullBlock' type: #'AbstractInstruction *'> cogit zeroOpcodeIndex. cogit CmpCq: 0 R: ClassReg. jumpNegative := cogit JumpLess: 0. cogit MoveMw: FoxMethod r: FPReg R: Extra0Reg; AddCq: 2 R: ClassReg; "Change selector index to 1-relative, skipping the method header" TstCq: MFMethodFlagIsBlockFlag R: Extra0Reg. jumpNotBlock := cogit JumpZero: 0. "If in a block, need to find the home method... If using full blocks, need to test the cpicHasMNUCaseOrCMIsFullBlock bit" + cogit AndCq: methodZone zoneAlignment negated R: Extra0Reg. - cogit AndCq: methodZone alignment negated R: Extra0Reg. SistaV1BytecodeSet ifTrue: [self bitAndByteOffsetOfIsFullBlockBitInto: [:bitmask :byteOffset| jumpFullBlock := cogit MoveMb: byteOffset r: Extra0Reg R: Extra1Reg; TstCq: bitmask R: Extra1Reg; JumpNonZero: 0]]. cogit MoveM16: 0 r: Extra0Reg R: Extra1Reg; SubR: Extra1Reg R: Extra0Reg. jumpNotBlock jmpTarget: cogit Label. SistaV1BytecodeSet ifTrue: [jumpFullBlock jmpTarget: jumpNotBlock getJmpTarget]. cogit "Now fetch the method object and index with the literal index to retrieve the selector" + AndCq: methodZone zoneAlignment negated R: Extra0Reg; - AndCq: methodZone alignment negated R: Extra0Reg; MoveMw: (cogit offset: CogMethod of: #methodObject) r: Extra0Reg R: Extra1Reg; MoveXwr: ClassReg R: Extra1Reg R: ClassReg; RetN: 0. jumpNegative jmpTarget: cogit Label. cogit NegateR: ClassReg; LogicalShiftLeftCq: 1 R: ClassReg; MoveAw: objectMemory specialObjectsArrayAddress R: Extra0Reg; SubCq: 1 R: ClassReg; MoveMw: SpecialSelectors + 1 * objectMemory wordSize r: Extra0Reg R: Extra1Reg; "Index, including header size" MoveXwr: ClassReg R: Extra1Reg R: ClassReg; RetN: 0. ceDereferenceSelectorIndex := cogit methodZoneBase. cogit outputInstructionsForGeneratedRuntimeAt: ceDereferenceSelectorIndex; recordGeneratedRunTime: 'ceDereferenceSelectorIndex' address: ceDereferenceSelectorIndex; recordRunTimeObjectReferences! Item was added: + ----- Method: CogRASSBytecodeFixup class>>filteredInstVarNames (in category 'translation') ----- + filteredInstVarNames + "Override to group char and short vars together for compactness. + self typedef" + | vars | + vars := super filteredInstVarNames asOrderedCollection. + vars + remove: 'mergeSimStack'; + add: 'mergeSimStack' afterIndex: (vars indexOf: 'targetInstruction'); + remove: 'isReceiverResultRegSelf'; + add: 'isReceiverResultRegSelf' afterIndex: (vars indexOf: 'simStackPtr'). + ^vars! Item was removed: - ----- Method: CogRASSBytecodeFixup class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- - instVarNamesAndTypesForTranslationDo: aBinaryBlock - "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogRASSBytecodeFixup struct." - - (self allInstVarNames copyWithout: 'cogit') do: - [:ivn| - aBinaryBlock - value: ivn - value: (ivn caseOf: { - ['targetInstruction'] -> [#'AbstractInstruction *']. - ['mergeSimStack'] -> [#'CogSimStackEntry *'] } - otherwise: [#sqInt])]! Item was changed: ----- Method: CogSSBytecodeFixup class>>filteredInstVarNames (in category 'translation') ----- filteredInstVarNames + "Override to add ifdef LowcodeVM around the native stack info, and to put + char vars before short vars. - "Override to add ifdef LowcodeVM around the native stack info. self typedef" + | vars | + vars := super filteredInstVarNames asOrderedCollection. + vars + remove: 'instructionIndex'; + add: 'instructionIndex' afterIndex: (vars indexOf: 'simStackPtr'); + add: '#if LowcodeVM' beforeIndex: (vars indexOf: 'simNativeStackPtr'); + add: '#endif' afterIndex: (vars indexOf: 'simNativeStackSize'). + ^vars! - ^super filteredInstVarNames - copyReplaceAll: #('simNativeStackPtr' 'simNativeStackSize') - with: #('#if LowcodeVM' 'simNativeStackPtr' 'simNativeStackSize' '#endif')! Item was added: + ----- Method: CogX64Compiler>>genPushC64: (in category 'abstract instructions') ----- + genPushC64: constant64Bits + <inline: true> + ^cogit PushCw: constant64Bits! Item was changed: ----- Method: CogX64Compiler>>rewriteCPICJumpAt:target: (in category 'inline cacheing') ----- + rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddr - rewriteCPICJumpAt: addressFollowingJump target: jumpTargetAddress "Rewrite the short jump instruction to jump to a new cpic case target. " <var: #addressFollowingJump type: #usqInt> + <var: #jumpTargetAddr type: #usqInt> - <var: #jumpTargetAddress type: #usqInt> <var: #callDistance type: #sqInt> "prevent type inference for avoiding warning on abs" | callDistance | + callDistance := jumpTargetAddr - addressFollowingJump. - callDistance := jumpTargetAddress - addressFollowingJump. self assert: callDistance abs < 128. objectMemory byteAt: addressFollowingJump - 1 put: (callDistance bitAnd: 16rFF). "self cCode: '' + inSmalltalk: [cogit disassembleFrom: addressFollowingJump - 10 to: addressFollowingJump - 1]."! - inSmalltalk: [cogit disassembleFrom: addressFollowingJump - 10 to: addressFollowingJump - 1]." - ^2! Item was changed: ----- Method: CogX64Compiler>>rewriteJumpLongAt:target: (in category 'inline cacheing') ----- + rewriteJumpLongAt: addressFollowingJump target: jumpTargetAddr - rewriteJumpLongAt: addressFollowingJump target: jumpTargetAddress "Rewrite a long jump instruction to jump to a different target. This variant is used to rewrite cached primitive calls. Answer the extent of the code change which is used to compute the range of the icache to flush." <inline: true> + ^self rewriteCallAt: addressFollowingJump target: jumpTargetAddr! - ^self rewriteCallAt: addressFollowingJump target: jumpTargetAddress! Item was changed: ----- Method: Cogit>>allocateOpcodes:bytecodes:ifFail: (in category 'initialization') ----- allocateOpcodes: numberOfAbstractOpcodes bytecodes: numberOfBytecodes ifFail: failBlock "Allocate the various arrays needed to compile abstract instructions, failing if the size needed is considered too high. Notionally we only need as many fixups as there are bytecodes. But we reuse fixups to record pc-dependent instructions in generateInstructionsAt: and so need at least as many as there are abstract opcodes. This *must* be inlined since the arrays are alloca'ed (stack allocated) so that they are freed when compilation is done. N.B. We do one single alloca to save embarrassing C optimizers that generate incorrect code as both gcc and the intel compiler do on x86." <inline: true> | opcodeBytes fixupBytes allocBytes | numAbstractOpcodes := numberOfAbstractOpcodes. opcodeBytes := (self sizeof: CogAbstractInstruction) * numAbstractOpcodes. fixupBytes := (self sizeof: CogBytecodeFixup) * numAbstractOpcodes. allocBytes := opcodeBytes + fixupBytes. + "Document the fact that the MaxStackAllocSize ensures that the number of abstract + opcodes fits in a 16 bit integer (e.g. CogBytecodeFixup's instructionIndex)." + self assert: (self sizeof: CogAbstractInstruction) + (self sizeof: CogBytecodeFixup) * 32768 > MaxStackAllocSize. + allocBytes > MaxStackAllocSize ifTrue: + [^failBlock value]. - allocBytes > MaxStackAllocSize ifTrue: [^failBlock value]. self cCode: [abstractOpcodes := self alloca: allocBytes. self b: abstractOpcodes zero: allocBytes. fixups := (abstractOpcodes asUnsignedInteger + opcodeBytes) asVoidPointer] inSmalltalk: [abstractOpcodes := CArrayAccessor on: ((1 to: numAbstractOpcodes) collect: [:ign| CogCompilerClass for: self]). fixups := CArrayAccessor on: ((1 to: numAbstractOpcodes) collect: [:ign| self bytecodeFixupClass for: self])]. self zeroOpcodeIndexForNewOpcodes. labelCounter := 0! Item was changed: ----- Method: Cogit>>cPICPrototypeCaseOffset (in category 'in-line cacheing') ----- cPICPrototypeCaseOffset "Whimsey; we want 16rCA5E10 + cPICPrototypeCaseOffset to be somewhere in the middle of the zone." + <inline: true> + ^methodZoneBase + methodZone youngReferrers / 2 - 16rCA5E10! - ^methodZoneBase + methodZone youngReferrers / 2 - 16rCA5E10! Item was changed: ----- Method: Cogit>>findMapLocationForMcpc:inMethod: (in category 'method map') ----- findMapLocationForMcpc: targetMcpc inMethod: cogMethod + <var: #targetMcpc type: #usqInt> <var: #cogMethod type: #'CogMethod *'> | mcpc map mapByte annotation | mcpc := self firstMappedPCFor: cogMethod. map := self mapStartFor: cogMethod. mcpc = targetMcpc ifTrue: [^map]. [(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: [annotation := mapByte >> AnnotationShift. annotation ~= IsAnnotationExtension ifTrue: [mcpc := mcpc + (backEnd codeGranularity * (annotation = IsDisplacementX2N ifTrue: [mapByte - DisplacementX2N << AnnotationShift] ifFalse: [mapByte bitAnd: DisplacementMask]))]. mcpc >= targetMcpc ifTrue: [self assert: mcpc = targetMcpc. annotation = IsDisplacementX2N ifTrue: [map := map - 1. mapByte := objectMemory byteAt: map. annotation := mapByte >> AnnotationShift. self assert: annotation > IsAnnotationExtension]. ^map]. map := map - 1]. ^0! Item was changed: ----- Method: Cogit>>generateMapAt:start: (in category 'method map') ----- generateMapAt: addressOrNull start: startAddress "Generate the method map at addressrNull (or compute it if addressOrNull is null). Answer the length of the map in byes. Each entry in the map is in two parts. In the least signficant bits are a displacement of how far from the start or previous entry, unless it is an IsAnnotationExtension byte, in which case those bits are the extension. In the most signficant bits are the type of annotation at the point reached. A null byte ends the map." + <var: 'addressOrNull' type: #usqInt> + <var: 'startAddress' type: #usqInt> | length location | <var: #instruction type: #'AbstractInstruction *'> length := 0. location := startAddress. 0 to: opcodeIndex - 1 do: [:i| | instruction mcpc delta maxDelta mapEntry | instruction := self abstractInstructionAt: i. instruction annotation ifNotNil: [:annotation| literalsManager assertValidAnnotation: annotation for: instruction. mcpc := instruction mapEntryAddress. [(delta := mcpc - location / backEnd codeGranularity) > DisplacementMask] whileTrue: [maxDelta := (delta min: MaxX2NDisplacement) bitClear: DisplacementMask. self assert: maxDelta >> AnnotationShift <= DisplacementMask. addressOrNull ifNotNil: [self addToMap: IsDisplacementX2N instruction: instruction byte: maxDelta >> AnnotationShift + DisplacementX2N at: addressOrNull - length for: mcpc]. location := location + (maxDelta * backEnd codeGranularity). length := length + 1]. addressOrNull ifNotNil: [mapEntry := delta + ((annotation min: IsSendCall) << AnnotationShift). self addToMap: annotation instruction: instruction byte: mapEntry at: addressOrNull - length for: mcpc]. location := location + (delta * backEnd codeGranularity). length := length + 1. annotation > IsSendCall ifTrue: "Add the necessary IsAnnotationExtension" [addressOrNull ifNotNil: [mapEntry := IsAnnotationExtension << AnnotationShift + (annotation - IsSendCall). self addToMap: annotation instruction: instruction byte: mapEntry at: addressOrNull - length for: mcpc]. length := length + 1]]]. addressOrNull ifNotNil: [self addToMap: MapEnd instruction: nil byte: MapEnd at: addressOrNull - length for: 0]. ^length + 1! Item was changed: ----- Method: Cogit>>lookupFrameOffset: (in category 'disassembly') ----- lookupFrameOffset: anInteger + <doNotGenerate> (self class initializationOptions at: #tempNames ifAbsent: nil) ifNotNil: [:dict| (self class initializationOptions at: #startpc ifAbsent: nil) ifNotNil: [:startpc| (dict at: startpc + 1 ifAbsent: nil) ifNotNil: [:tempNames| | numArgs | anInteger = FoxMFReceiver ifTrue: [^'self']. numArgs := self class initializationOptions at: #numArgs. 1 to: tempNames size do: [:i| anInteger = (self frameOffsetOfTemporary: i - 1 numArgs: numArgs) ifTrue: [^tempNames at: i]]]]]. ^nil! Item was changed: ----- Method: StackInterpreter>>externalDivorceFrame:andContext: (in category 'frame access') ----- externalDivorceFrame: theFP andContext: ctxt "Divorce a single frame and its context. If it is not the top frame of a stack this means splitting its stack." | thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP | <inline: false> <var: #theFP type: #'char *'> <var: #thePage type: #'StackPage *'> <var: #theSP type: #'char *'> <var: #newPage type: #'StackPage *'> <var: #frameAbove type: #'char *'> <var: #callerFP type: #'char *'> <var: #callerSP type: #'char *'> "stackPage needs to have current head pointers to avoid confusion." self assert: (stackPage = 0 or: [stackPage = stackPages mostRecentlyUsedPage]). thePage := stackPages stackPageFor: theFP. (onCurrent := thePage = stackPage) ifFalse: [stackPages markStackPageNextMostRecentlyUsed: thePage]. theSP := self findSPOf: theFP on: thePage. self updateStateOfSpouseContextForFrame: theFP WithSP: theSP. callerCtx := self ensureCallerContext: theFP. (frameAbove := self findFrameAbove: theFP inPage: thePage) == 0 ifTrue: "If we're divorcing the top frame we can simply peel it off." [theIP := stackPages longAt: thePage headSP] ifFalse: "othewise move all frames above to a new stack and then peel the frame off." [newPage := stackPages newStackPage. theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove). frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage. onCurrent ifTrue: [self setStackPageAndLimit: newPage. + self setStackPointersFromPage: newPage] - framePointer := stackPage headFP. - stackPointer := stackPage headSP] ifFalse: [stackPages markStackPageMostRecentlyUsed: newPage]. self assert: (self frameCallerContext: frameAbove) = ctxt]. objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: ctxt withValue: (self contextInstructionPointer: theIP frame: theFP). objectMemory storePointer: SenderIndex ofObject: ctxt withValue: callerCtx. callerFP := self frameCallerFP: theFP. callerFP == 0 "theFP is a base frame; it is now alone; free the entire page" ifTrue: [stackPages freeStackPage: thePage] ifFalse: [callerIP := self oopForPointer: (self frameCallerSavedIP: theFP). callerSP := (self frameCallerSP: theFP) - objectMemory wordSize. stackPages longAt: callerSP put: callerIP. self setHeadFP: callerFP andSP: callerSP inPage: thePage] ! Item was changed: ----- Method: StackInterpreter>>externalEnsureIsBaseFrame: (in category 'frame access') ----- externalEnsureIsBaseFrame: aFramePtr "Ensure aFramePtr is a base frame. Then we can assign its sender. Answer the possibly moved location of the frame." | theFP thePage onCurrent | <var: #aFramePtr type: #'char *'> <var: #theFP type: #'char *'> <var: #thePage type: #'StackPage *'> <returnTypeC: 'char *'> (self isBaseFrame: aFramePtr) ifTrue: [^aFramePtr]. theFP := aFramePtr. thePage := stackPages stackPageFor: theFP. onCurrent := thePage = stackPage. "Storing the frame's sender with its caller's context has the side effect of making theFP a base frame." theFP := self storeSenderOfFrame: theFP withValue: (self ensureCallerContext: theFP). onCurrent ifTrue: [self assert: stackPage ~~ thePage. "stackPage has moved to a new page" + self setStackPointersFromPage: stackPage] - framePointer := stackPage headFP. - stackPointer := stackPage headSP] ifFalse: [stackPages markStackPageMostRecentlyUsed: stackPage]. self assert: stackPages pageListIsWellFormed. self assert: stackPage = stackPages mostRecentlyUsedPage. ^theFP! Item was changed: ----- Method: StackInterpreter>>externalInstVar:ofContext:put: (in category 'frame access') ----- externalInstVar: index ofContext: maybeMarriedContext put: anOop | theFP thePage onCurrentPage | <var: #theFP type: #'char *'> <var: #thePage type: #'StackPage *'> self assert: (objectMemory isContext: maybeMarriedContext). self externalWriteBackHeadFramePointers. "Assign the field of a married context." self deny: (objectMemory isObjImmutable: maybeMarriedContext). (self isStillMarriedContext: maybeMarriedContext) ifFalse: [objectMemory storePointer: index ofObject: maybeMarriedContext withValue: anOop. index = StackPointerIndex ifTrue: [self ensureContextIsExecutionSafeAfterAssignToStackPointer: maybeMarriedContext]. ^nil]. theFP := self frameOfMarriedContext: maybeMarriedContext. thePage := stackPages stackPageFor: theFP. self assert: stackPage = stackPages mostRecentlyUsedPage. onCurrentPage := thePage = stackPage. index == SenderIndex ifTrue: [self storeSenderOfFrame: theFP withValue: anOop] ifFalse: [self externalDivorceFrame: theFP andContext: maybeMarriedContext. objectMemory storePointer: index ofObject: maybeMarriedContext withValue: anOop. index = StackPointerIndex ifTrue: [self ensureContextIsExecutionSafeAfterAssignToStackPointer: maybeMarriedContext]]. onCurrentPage ifTrue: + [self setStackPointersFromPage: stackPage] - [framePointer := stackPage headFP. - stackPointer := stackPage headSP] ifFalse: [stackPages markStackPageMostRecentlyUsed: stackPage]. stackPages assert: stackPage = stackPages mostRecentlyUsedPage. stackPages assert: stackPages pageListIsWellFormed. stackPages assert: self validStackPageBaseFrames! Item was changed: ----- Method: StackInterpreter>>externalSetStackPageAndPointersForSuspendedContextOfProcess: (in category 'frame access') ----- externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess "Set stackPage, instructionPointer, framePointer and stackPointer for the suspendedContext of aProcess, marrying the context if necessary, and niling the suspendedContext slot. This is used on process switch to ensure a context has a stack frame and so can continue execution." | newContext theFrame thePage newPage | <inline: true> <var: #theFrame type: #'char *'> <var: #thePage type: #'StackPage *'> <var: #newPage type: #'StackPage *'> newContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess. self assert: (objectMemory isContext: newContext). (self isMarriedOrWidowedContext: newContext) ifTrue: [self assert: (self checkIsStillMarriedContext: newContext currentFP: framePointer)]. objectMemory storePointerUnchecked: SuspendedContextIndex ofObject: aProcess withValue: objectMemory nilObject. (self isStillMarriedContext: newContext) ifTrue: [theFrame := self frameOfMarriedContext: newContext. thePage := stackPages stackPageFor: theFrame. theFrame ~= thePage headFP ifTrue: ["explicit assignment of suspendedContext can cause switch to interior frame." newPage := stackPages newStackPage. self moveFramesIn: thePage through: (self findFrameAbove: theFrame inPage: thePage) toPage: newPage. stackPages markStackPageLeastMostRecentlyUsed: newPage]. self assert: thePage headFP = theFrame] ifFalse: [thePage := self makeBaseFrameFor: newContext. theFrame := thePage baseFP]. self setStackPageAndLimit: thePage. + self setStackPointersFromPage: thePage. - stackPointer := thePage headSP. - framePointer := thePage headFP. (self isMachineCodeFrame: framePointer) ifFalse: [self setMethod: (self iframeMethod: framePointer)]. instructionPointer := self popStack. self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer! Item was changed: ----- Method: StackInterpreter>>handleStackOverflow (in category 'message sending') ----- handleStackOverflow "Check for stack overflow, moving frames to another stack if so. This should *only* be sent from checkForStackOverflow." <inline: #never> | newPage theFP callerFP overflowLimitAddress overflowCount | <var: #newPage type: #'StackPage *'> <var: #theFP type: #'char *'> <var: #callerFP type: #'char *'> <var: #overflowLimitAddress type: #'char *'> self assert: stackPointer < stackPage realStackLimit. self maybeTraceStackOverflow. statStackOverflow := statStackOverflow + 1. "The stack has overflowed this page. If the system is executing some recursive algorithm, e.g. fibonacci, then the system could thrash overflowing the stack if the call soon returns back to the current page. To avoid thrashing, since overflow is quite slow, we can move more than one frame. The idea is to record which page has overflowed, and the first time it overflows move one frame, the second time two frames, and so on. We move no more frames than would leave the page half occupied." theFP := framePointer. stackPage = overflowedPage ifTrue: [overflowLimitAddress := stackPage baseAddress - stackPages overflowLimit. overflowCount := extraFramesToMoveOnOverflow := extraFramesToMoveOnOverflow + 1. [(overflowCount := overflowCount - 1) >= 0 and: [(callerFP := self frameCallerFP: theFP) < overflowLimitAddress and: [(self isBaseFrame: callerFP) not]]] whileTrue: [theFP := callerFP]] ifFalse: [overflowedPage := stackPage. extraFramesToMoveOnOverflow := 0]. self ensureCallerContext: theFP. newPage := stackPages newStackPage. self moveFramesIn: stackPage through: theFP toPage: newPage. self setStackPageAndLimit: newPage. + self setStackPointersFromPage: newPage. - framePointer := stackPage headFP. - stackPointer := stackPage headSP. self isCog ifFalse: "To overflow the stack this must be a new frame, but in Cog base frames are married." [self assert: (self frameHasContext: framePointer) not. self assert: (self validInstructionPointer: instructionPointer + 1 inMethod: method framePointer: framePointer)] ifTrue: [self assert: (self validInstructionPointer: instructionPointer + 1 inFrame: framePointer). self assert: ((self frameHasContext: framePointer) not or: [objectMemory isContext: (self frameContext: framePointer)])]! Item was changed: + ----- Method: StackInterpreter>>internalPopStackNativeSize: (in category 'internal interpreter access') ----- - ----- Method: StackInterpreter>>internalPopStackNativeSize: (in category 'as yet unclassified') ----- internalPopStackNativeSize: popSize <option: #LowcodeVM> "In the StackInterpreter stacks grow down." nativeSP := self nativeStackPointerIn: localFP. nativeSP := self nativeStackPointerIn: localFP put: nativeSP + popSize.! Item was changed: ----- Method: StackInterpreter>>marryContextInNewStackPageAndInitializeInterpreterRegisters: (in category 'frame access') ----- marryContextInNewStackPageAndInitializeInterpreterRegisters: aContext "Establish aContext at the base of a new stackPage, make the stackPage the active one and set-up the interreter registers. This is used to boot the system and bring it back after a snapshot." <inline: false> | newPage | <var: #newPage type: #'StackPage *'> self assert: stackPage = 0. newPage := self makeBaseFrameFor: aContext. self setStackPageAndLimit: newPage. + self setStackPointersFromPage: newPage. - framePointer := stackPage headFP. - stackPointer := stackPage headSP. self setMethod: (self iframeMethod: stackPage headFP). instructionPointer := self popStack! Item was changed: ----- Method: StackInterpreter>>reestablishContextPriorToCallback: (in category 'callback support') ----- reestablishContextPriorToCallback: callbackContext "callbackContext is an activation of invokeCallback:[stack:registers:jmpbuf:]. Its sender is the VM's state prior to the callback. Reestablish that state, and mark calloutContext as dead." | calloutContext theFP thePage | <export: true> <var: #theFP type: #'char *'> <var: #thePage type: #'StackPage *'> self flag: #obsolete. (self isLiveContext: callbackContext) ifFalse: [^false]. calloutContext := self externalInstVar: SenderIndex ofContext: callbackContext. (self isLiveContext: calloutContext) ifFalse: [^false]. "We're about to leave this stack page; must save the current frame's instructionPointer." self push: instructionPointer. self externalWriteBackHeadFramePointers. "Mark callbackContext as dead; the common case is that it is the current frame. We go the extra mile for the debugger." (self isSingleContext: callbackContext) ifTrue: [self markContextAsDead: callbackContext] ifFalse: [theFP := self frameOfMarriedContext: callbackContext. framePointer = theFP "common case" ifTrue: [(self isBaseFrame: theFP) ifTrue: [stackPages freeStackPage: stackPage] ifFalse: "calloutContext is immediately below on the same page. Make it current." [instructionPointer := (self frameCallerSavedIP: framePointer) asUnsignedInteger. stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer) + objectMemory wordSize. framePointer := self frameCallerFP: framePointer. ^true]] ifFalse: [self externalDivorceFrame: theFP andContext: callbackContext. self markContextAsDead: callbackContext]]. "Make the calloutContext the active frame. The case where calloutContext is immediately below callbackContext on the same page is handled above." (self isStillMarriedContext: calloutContext) ifTrue: [theFP := self frameOfMarriedContext: calloutContext. thePage := stackPages stackPageFor: theFP. "findSPOf:on: points to the word beneath the instructionPointer, but there is no instructionPointer on the top frame of the current page." self assert: thePage ~= stackPage. stackPointer := (self findSPOf: theFP on: thePage) - objectMemory wordSize. + framePointer := theFP. + self assert: stackPointer < framePointer] - framePointer := theFP] ifFalse: [thePage := self makeBaseFrameFor: calloutContext. + self setStackPointersFromPage: thePage]. - framePointer := thePage headFP. - stackPointer := thePage headSP]. instructionPointer := self popStack. self setStackPageAndLimit: thePage. ^true! Item was added: + ----- Method: StackInterpreter>>setStackPointersFromPage: (in category 'stack pages') ----- + setStackPointersFromPage: thePage + <var: #thePage type: #'StackPage *'> + <inline: true> + stackPointer := thePage headSP. + framePointer := thePage headFP! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveStoreStackp (in category 'object access primitives') ----- primitiveStoreStackp "Atomic store into context stackPointer. Also ensures that any newly accessible cells are initialized to nil " | ctxt newStackp theFP thePage onCurrentPage stackp | <var: #theFP type: #'char *'> <var: #thePage type: #'StackPage *'> ctxt := self stackValue: 1. newStackp := self stackIntegerValue: 0. (self successful and: [newStackp between: 0 and: (objectMemory numSlotsOf: ctxt) - CtxtTempFrameStart]) ifFalse: [^self primitiveFail]. self externalWriteBackHeadFramePointers. (self isStillMarriedContext: ctxt) ifTrue: [theFP := self frameOfMarriedContext: ctxt. thePage := stackPages stackPageFor: theFP. ((onCurrentPage := thePage = stackPage) and: [theFP = framePointer]) ifTrue: [^self primitiveFail]. "Probably easy to do this right here right now (just move stackPointer). But fail for now." self externalDivorceFrame: theFP andContext: ctxt. onCurrentPage ifTrue: + [self setStackPointersFromPage: stackPage] - [framePointer := stackPage headFP. - stackPointer := stackPage headSP] ifFalse: [self assert: stackPage = (stackPages stackPageFor: framePointer). stackPages markStackPageMostRecentlyUsed: stackPage]]. stackp := self fetchStackPointerOf: ctxt. "Nil any newly accessible cells" stackp + 1 to: newStackp do: [:i | objectMemory storePointerUnchecked: i + CtxtTempFrameStart - 1 ofObject: ctxt withValue: objectMemory nilObject]. self storeStackPointerValue: newStackp inContext: ctxt. self ensureContextIsExecutionSafeAfterAssignToStackPointer: ctxt. self pop: 1! Item was changed: ----- Method: StackToRegisterMappingCogit>>traceMerge: (in category 'simulation only') ----- traceMerge: fixup <cmacro: '(ign) 0'> | index original | (compilationTrace anyMask: 16) ifTrue: [index := (fixups object identityIndexOf: fixup) - 1. + (fixup isBackwardBranchFixup and: [compilationPass notNil and: [compilationPass > 1 and: [(original := fixup simStackPtr) < 0]]]) ifTrue: - (fixup isBackwardBranchFixup and: [compilationPass > 1 and: [(original := fixup simStackPtr) < 0]]) ifTrue: [fixup simStackPtr: simStackPtr]. [coInterpreter transcript ensureCr; print: index; nextPut: $/; print: index + initialPC; nextPut: $:; space. fixup printStateOn: coInterpreter transcript. coInterpreter transcript cr; flush] ensure: [original ifNotNil: [fixup simStackPtr: original]]]!

1 0

VM Maker: VMMaker.oscog-eem.2149.mcz
by commits＠source.squeak.org 14 Mar '17

14 Mar '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2149.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2149 Author: eem Time: 13 March 2017, 5:16:33.83321 pm UUID: e49449d0-624a-4ad6-91a9-0ea0d0c0f195 Ancestors: VMMaker.oscog-eem.2148, VMMaker.oscog-cb.2148 Merge VMMaker.oscog-eem.2148 & VMMaker.oscog-cb.2148. Slang: Reimplement the fix in for VMMaker.oscog-eem.2148 context := ignoreContext ifTrue: [objectMemory nilObject ] ifFalse: [self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop)] and revert Clément's work-arounds for the bug. Use TMethod>>replaceNodesIn: instead of the inlined version in some places. It's much nicer simply to move the pass that transforms conditional assignments to its own method (ensureConditionalAssignmentsAreTransformedIn:) prior to any inlining attempts. =============== Diff against VMMaker.oscog-eem.2148 =============== Item was added: + ----- Method: SocketPluginSimulator>>sqResolverLocalAddress (in category 'simulation') ----- + sqResolverLocalAddress + "For now don't simulate the implicit semaphore." + | bytes | + bytes := NetNameResolver primLocalAddress. + self assert: bytes size = 4. + "Effectively netAddressToInt: bytes" + ^ ((bytes at: 4)) + + ((bytes at: 3) <<8) + + ((bytes at: 2) <<16) + + ((bytes at: 1) <<24)! Item was removed: - ----- Method: StackInterpreterSimulator>>externalWriteBackHeadFramePointers (in category 'stack pages') ----- - externalWriteBackHeadFramePointers - self assert: (localFP = framePointer - or: [localFP = (self frameCallerFP: framePointer)]). - super externalWriteBackHeadFramePointers! Item was changed: ----- Method: StackInterpreterSimulator>>getErrorObjectFromPrimFailCode (in category 'debugging traps') ----- getErrorObjectFromPrimFailCode + (primFailCode > 1 and: [(#(primitiveNew primitiveFetchNextMourner) includes: primitiveFunctionPointer) not]) ifTrue: [self halt]. - primFailCode > 1 ifTrue: [self halt]. ^super getErrorObjectFromPrimFailCode! Item was changed: ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') ----- primitiveDirectoryEntry | name pathName arrayNilOrSymbol result | name := self stringOf: self stackTop. pathName := self stringOf: (self stackValue: 1). - "temporary work-around to make it work in Pharo..." - self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ]. - self successful ifFalse: [^self primitiveFail]. arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name. arrayNilOrSymbol ifNil: [self pop: 3 thenPush: objectMemory nilObject. ^self]. arrayNilOrSymbol isArray ifFalse: ["arrayNilOrSymbol ~~ #primFailed ifTrue: [self halt]. " self transcript show: name , ' NOT FOUND'. ^self primitiveFail]. result := PharoVM ifTrue: [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3) isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) + posixPermissions: (arrayNilOrSymbol at: 6 ifAbsent: [8r644]) isSymlink: (arrayNilOrSymbol at: 7 ifAbsent: [false]) ] - posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ] ifFalse: [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3) isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ]. self pop: 3 thenPush: result! Item was added: + ----- Method: TMethod>>ensureConditionalAssignmentsAreTransformedIn: (in category 'inlining') ----- + ensureConditionalAssignmentsAreTransformedIn: aCodeGen + "Make passes transforming + foo := expr ifTrue: [a] ifFalse: [b] + into + expr ifTrue: [foo := a] ifFalse: [foo := b] + until no such instances exist in the tree. This is needed for correct inlining + given the limitations of inlineCodeOrNilForStatement:returningNodes:in:" + | transformedAssignments | + [transformedAssignments := Dictionary new. + parseTree + nodesDo: + [:node| + (self transformConditionalAssignment: node in: aCodeGen) ifNotNil: + [:replacement| + transformedAssignments at: node put: replacement]] + unless: "Don't inline the arguments to asserts to keep the asserts readable" + [:node| + node isSend + and: [node selector == #cCode:inSmalltalk: + or: [aCodeGen isAssertSelector: node selector]]]. + transformedAssignments notEmpty + and: [self replaceNodesIn: transformedAssignments. + true]] whileTrue + ! Item was changed: ----- Method: TMethod>>transformToStructClassMethodFor: (in category 'transformations') ----- transformToStructClassMethodFor: aCCodeGenerator "Transform this method so that it can be used on an instance of a struct class (VMStructType subclass). Convert inst var refs into field dereferences of self. Add selfSelector as the first argument with the right struct type. As a complete hack to avoid breaking the inlinert don't use 'self' as the name for self as this causes serious type redefinitions ``somewhere'' in the inliner." | replacements selfNode typeForSelf | self isStructAccessor ifTrue: [^self returnType: (definingClass returnTypeForAccessor: selector)]. replacements := IdentityDictionary new. selfNode := TVariableNode new setName: 'self_in_', (aCCodeGenerator cFunctionNameFor: selector). args do: [:var| (definingClass isAccessor: var) ifTrue: [self error: 'In ', definingClass name, '>>', selector, ' ', var, ' arg shadows struct field and will break during translation!!']]. parseTree nodesDo: [:node| node isVariable ifTrue: [node name = 'self' ifTrue: [replacements at: node put: selfNode copy]. (definingClass isAccessor: node name) ifTrue: [replacements at: node put: (TSendNode new setSelector: node name asSymbol receiver: selfNode arguments: #())]]]. replacements notEmpty ifTrue: + [self replaceNodesIn: replacements]. - [parseTree := parseTree replaceNodesIn: replacements]. typeForSelf := self typeForSelf. self assert: (typeForSelf notNil and: [typeForSelf ~~ #implicit]). self declarationAt: (args addFirst: selfNode name) put: (declarations removeKey: 'self'), '_in_', (aCCodeGenerator cFunctionNameFor: selector)! Item was changed: ----- Method: TMethod>>tryToInlineMethodExpressionsIn: (in category 'inlining') ----- tryToInlineMethodExpressionsIn: aCodeGen "Expand any (complete) inline methods sent by this method as receivers or parameters. Answer if anything was inlined." | sendsToInline | sendsToInline := Dictionary new: 100. parseTree nodesDo: [:node| - (self transformConditionalAssignment: node in: aCodeGen) ifNotNil: - [:replacement| - sendsToInline at: node put: replacement]. (self inlineableFunctionCall: node in: aCodeGen) ifTrue: [(self inlineFunctionCall: node in: aCodeGen) ifNotNil: [:replacement| sendsToInline at: node put: replacement]]] unless: "Don't inline the arguments to asserts to keep the asserts readable" [:node| node isSend and: [node selector == #cCode:inSmalltalk: or: [aCodeGen isAssertSelector: node selector]]]. sendsToInline isEmpty ifTrue: [^false]. + self replaceNodesIn: sendsToInline. - parseTree := parseTree replaceNodesIn: sendsToInline. ^true! Item was changed: ----- Method: TMethod>>tryToInlineMethodStatementsIn:statementListsInto: (in category 'inlining') ----- tryToInlineMethodStatementsIn: aCodeGen statementListsInto: aBlock "Expand any (complete) inline methods sent by this method as top-level statements. Answer if anything was inlined." | stmtLists didSomething newStatements returningNodes | didSomething := false. returningNodes := Set new. - stmtLists := self statementsListsForInliningIn: aCodeGen. - "stmtLists may include expressions that are used for value but the exitVar is distant because its in an ifTrue:ifTrue:, - e.g. in - context := ignoreContext - ifTrue: [objectMemory nilObject ] - ifFalse: [self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop)]. - ensureFrameIsMarried:SP: *does* have an exitVar, context, but it is the exitVar for the ifTrue:ifFalse:. So - inlineCodeOrNilForStatement:returningNodes:in: should not consider inlining these in its last phrase where exitVar is nil." parseTree nodesDo: [:node| node isReturn ifTrue: [returningNodes add: node expression. node expression isConditionalSend ifTrue: + [returningNodes addAll: (node expression args collect: [:stmtList| stmtList statements last])]]]. + stmtLists := self statementsListsForInliningIn: aCodeGen. - [returningNodes addAll: (node expression args collect: [:stmtList| stmtList statements last])]]. - node isAssignment ifTrue: - [node expression nodesDo: - [:assignmentSubNode| - (stmtLists includes: assignmentSubNode) ifTrue: - [stmtLists remove: assignmentSubNode]]]]. - stmtLists do: [:stmtList| newStatements := OrderedCollection new: stmtList statements size. stmtList statements do: [:stmt| (self inlineCodeOrNilForStatement: stmt returningNodes: returningNodes in: aCodeGen) ifNil: [newStatements addLast: stmt] ifNotNil: [:inlinedStmts| didSomething := true. newStatements addAllLast: inlinedStmts]]. stmtList setStatements: newStatements asArray]. "This is a hack; forgive me. The inlining above tends to keep return statements in statement lists. In the case of returning ifs we don't want the returns in case the returning if is generated as an expression." returningNodes do: [:returningNode| (returningNode isConditionalSend and: [returningNode args anySatisfy: [:alternativeNode| alternativeNode endsWithReturn]]) ifTrue: [returningNode args withIndexDo: [:alternativeNode :index| alternativeNode endsWithReturn ifTrue: [returningNode args at: index put: alternativeNode copyWithoutReturn]]]]. aBlock value: stmtLists. ^didSomething! Item was changed: ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') ----- tryToInlineMethodsIn: aCodeGen "Expand any (complete) inline methods sent by this method. Set the complete flag when all inlining has been done. Answer if something was inlined." | didSomething statementLists | "complete ifTrue: [^false]." self definedAsMacro ifTrue: [complete ifTrue: [^false]. ^complete := true]. + self ensureConditionalAssignmentsAreTransformedIn: aCodeGen. didSomething := self tryToInlineMethodStatementsIn: aCodeGen statementListsInto: [:stmtLists| statementLists := stmtLists]. didSomething := (self tryToInlineMethodExpressionsIn: aCodeGen) or: [didSomething]. didSomething ifTrue: [writtenToGlobalVarsCache := nil]. complete ifFalse: [self checkForCompletenessIn: aCodeGen. complete ifTrue: [didSomething := true]]. "marking a method complete is progress" ^didSomething!

1 0

VM Maker: VMMaker.oscog-cb.2148.mcz
by commits＠source.squeak.org 14 Mar '17

14 Mar '17

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2148.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.2148 Author: cb Time: 13 March 2017, 4:26:04.291103 pm UUID: 7ad32bbc-667b-4b98-9588-6bbd8f15d214 Ancestors: VMMaker.oscog-dtl.2147 I do not merge with Eliot's version as it seems buggy. - Changed pushFullClosure code to worj around a slang compilation bug - fixes and improvements in SocketSimulatorPlugin and StackInterpreterSimulator to support Pharo simulation better =============== Diff against VMMaker.oscog-dtl.2147 =============== Item was changed: ----- Method: CoInterpreter>>pushFullClosureNumArgs:copiedValues:compiledBlock:receiverIsOnStack:ignoreContext: (in category 'stack bytecodes') ----- pushFullClosureNumArgs: numArgs copiedValues: numCopiedArg compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack ignoreContext: ignoreContext "The compiler has pushed the values to be copied, if any. The receiver has been pushed on stack before if specified. Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure. Sets outerContext, compiledBlock, numArgs and receiver as specified.." <inline: true> | numCopied newClosure context startIndex | "No need to record the pushed copied values in the outerContext." + ignoreContext + ifTrue: [context := objectMemory nilObject ] + ifFalse: [context := self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop)]. - context := ignoreContext - ifTrue: [objectMemory nilObject ] - ifFalse: [self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop)]. newClosure := self fullClosureIn: context numArgs: numArgs numCopiedValues: numCopiedArg compiledBlock: compiledBlock. cogit recordSendTrace ifTrue: [self recordTrace: TraceBlockCreation thing: newClosure source: TraceIsFromInterpreter]. receiverIsOnStack ifFalse: [ startIndex := FullClosureFirstCopiedValueIndex. objectMemory storePointerUnchecked: FullClosureReceiverIndex ofObject: newClosure withValue: self receiver. numCopied := numCopiedArg ] ifTrue: [ startIndex := FullClosureReceiverIndex. numCopied := numCopiedArg + 1 ]. numCopied > 0 ifTrue: [0 to: numCopied - 1 do: [ :i | "Assume: have just allocated a new BlockClosure; it must be young. Thus, can use unchecked stores." objectMemory storePointerUnchecked: i + startIndex ofObject: newClosure withValue: (self internalStackValue: numCopied - i - 1)]. self internalPop: numCopied]. self fetchNextBytecode. self internalPush: newClosure! Item was added: + ----- Method: SocketPluginSimulator>>sqResolverLocalAddress (in category 'simulation') ----- + sqResolverLocalAddress + "For now don't simulate the implicit semaphore." + | bytes | + bytes := NetNameResolver primLocalAddress. + self assert: bytes size = 4. + "Effectively netAddressToInt: bytes" + ^ ((bytes at: 4)) + + ((bytes at: 3) <<8) + + ((bytes at: 2) <<16) + + ((bytes at: 1) <<24)! Item was changed: ----- Method: StackInterpreter>>pushFullClosureNumArgs:copiedValues:compiledBlock:receiverIsOnStack:ignoreContext: (in category 'stack bytecodes') ----- pushFullClosureNumArgs: numArgs copiedValues: numCopiedArg compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack ignoreContext: ignoreContext "The compiler has pushed the values to be copied, if any. The receiver has been pushed on stack before if specified. Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure. Sets outerContext, compiledBlock, numArgs and receiver as specified.." <inline: true> | numCopied newClosure context startIndex | "No need to record the pushed copied values in the outerContext." + ignoreContext + ifTrue: [context := objectMemory nilObject ] + ifFalse: [context := self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop)]. - context := ignoreContext - ifTrue: [objectMemory nilObject ] - ifFalse: [self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop)]. newClosure := self fullClosureIn: context numArgs: numArgs numCopiedValues: numCopiedArg compiledBlock: compiledBlock. receiverIsOnStack ifFalse: [ startIndex := FullClosureFirstCopiedValueIndex. objectMemory storePointerUnchecked: FullClosureReceiverIndex ofObject: newClosure withValue: self receiver. numCopied := numCopiedArg ] ifTrue: [ startIndex := FullClosureReceiverIndex. numCopied := numCopiedArg + 1 ]. numCopied > 0 ifTrue: [0 to: numCopied - 1 do: [ :i | "Assume: have just allocated a new BlockClosure; it must be young. Thus, can use unchecked stores." objectMemory storePointerUnchecked: i + startIndex ofObject: newClosure withValue: (self internalStackValue: numCopied - i - 1)]. self internalPop: numCopied]. self fetchNextBytecode. self internalPush: newClosure! Item was removed: - ----- Method: StackInterpreterSimulator>>externalWriteBackHeadFramePointers (in category 'stack pages') ----- - externalWriteBackHeadFramePointers - self assert: (localFP = framePointer - or: [localFP = (self frameCallerFP: framePointer)]). - super externalWriteBackHeadFramePointers! Item was changed: ----- Method: StackInterpreterSimulator>>getErrorObjectFromPrimFailCode (in category 'debugging traps') ----- getErrorObjectFromPrimFailCode + (primFailCode > 1 and: [(#(primitiveNew primitiveFetchNextMourner) includes: primitiveFunctionPointer) not]) ifTrue: [self halt]. - primFailCode > 1 ifTrue: [self halt]. ^super getErrorObjectFromPrimFailCode! Item was changed: ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') ----- primitiveDirectoryEntry | name pathName arrayNilOrSymbol result | name := self stringOf: self stackTop. pathName := self stringOf: (self stackValue: 1). - "temporary work-around to make it work in Pharo..." - self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ]. - self successful ifFalse: [^self primitiveFail]. arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name. arrayNilOrSymbol ifNil: [self pop: 3 thenPush: objectMemory nilObject. ^self]. arrayNilOrSymbol isArray ifFalse: ["arrayNilOrSymbol ~~ #primFailed ifTrue: [self halt]. " self transcript show: name , ' NOT FOUND'. ^self primitiveFail]. result := PharoVM ifTrue: [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3) isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) + posixPermissions: (arrayNilOrSymbol at: 6 ifAbsent: [8r644]) isSymlink: (arrayNilOrSymbol at: 7 ifAbsent: [false]) ] - posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ] ifFalse: [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3) isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ]. self pop: 3 thenPush: result!

1 0

VM Maker: VMMaker.oscog-dtl.2147.mcz
by commits＠source.squeak.org 12 Mar '17

12 Mar '17

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-dtl.2147.mcz ==================== Summary ==================== Name: VMMaker.oscog-dtl.2147 Author: dtl Time: 12 March 2017, 6:42:24.851569 pm UUID: 8204a87f-f5aa-40a9-a9a6-532993ed89cb Ancestors: VMMaker.oscog-eem.2146 Fix variable declaration in primitiveSignalAtMilliseconds to prevent arithmetic overflow in calculating nextWakeupUsecs on millisecond clock rollover. Addresses a problem reported for 32 bit images converted to 64 bit (e.g. Cuis port to Spur64) for which delay timing has not yet been updated to use microsecond primitives. Prior to this change, the following would lock a 64 bit Spur image: s := Semaphore new. Delay primSignal: s atMilliseconds: Time primMillisecondClock - 10. s wait. =============== Diff against VMMaker.oscog-eem.2146 =============== Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSignalAtMilliseconds (in category 'system control primitives') ----- primitiveSignalAtMilliseconds "Cause the time semaphore, if one has been registered, to be signalled when the microsecond clock is greater than or equal to the given tick value. A tick value of zero turns off timer interrupts." | msecsObj msecs deltaMsecs sema | <var: #msecs type: #usqInt> + <var: #deltaMsecs type: #usqLong> msecsObj := self stackTop. sema := self stackValue: 1. msecs := self positive32BitValueOf: msecsObj. self successful ifTrue: [(objectMemory isSemaphoreOop: sema) ifTrue: [objectMemory splObj: TheTimerSemaphore put: sema. deltaMsecs := msecs - (self ioMSecs bitAnd: MillisecondClockMask). deltaMsecs < 0 ifTrue: [deltaMsecs := deltaMsecs + MillisecondClockMask + 1]. nextWakeupUsecs := self ioUTCMicroseconds + (deltaMsecs * 1000). ^self pop: 2]. sema = objectMemory nilObject ifTrue: [objectMemory storePointer: TheTimerSemaphore ofObject: objectMemory specialObjectsOop withValue: objectMemory nilObject. nextWakeupUsecs := 0. ^self pop: 2]]. self primitiveFailFor: PrimErrBadArgument!

1 0

UI VM vs. Consol VM on Windows
by Torsten Bergmann 12 Mar '17

12 Mar '17

Hi, for the virtual machine on Windows we have a UI VM and a headless console version. For instance "Squeak.exe"/"Pharo.exe"/... (UI VM) and "SqueakConsole.exe"/"PharoConsole.exe"/... (Console version to access stdin, stdout and stderr) IMHO there is no need for a separate and special console version on Windows. Maybe it was the easiest/quickest way to implement this but usually one should be able to access/create and redirect the std handles even in a UI application. See http://dslweb.nwnexus.com/~ast/dload/guicon.htm for a start. Maybe it is possible to get rid of a separate "XXXConsole.exe" version so the VM on Windows behaves like on other platforms. Maybe that als unifies/eases the build. Side note: Maybe there is also a difference when you start an executable with Explorer (double click) where you might need to create a new console vs. starting the executable from an already existing console command line (where it might be possible to catch an existing handle). But this could be evaluated with a simple C executable and (if working) transformed to the Open Smalltalk virtual machine. Bye T.

4 3

Re: [Vm-dev] BUG? A problem with callbacks that shows up in 64bits (but is on 32bits too)
by LEnglish 11 Mar '17

11 Mar '17

I mentioned to Eliot ages ago that I saw what may have been a similar bug when I accidentally called the 32-bit version of OpenGL using 64-bit parameter variables. Nothing crashed, but things became *very* strange, with entire bits of functionality in Squeak itself simply ceasing to function. I’ve been quite sick for the past few years, so I never followed up (sorry Elliot) in trying to figure out what exactly I had done to trigger the erratic behavior. L > On Mar 10, 2017, at 08:35, Esteban Lorenzano <estebanlm(a)gmail.com> wrote: > > > Hi, > > I’m tumbling into an error in Pharo, because we use callbacks intensively, in Athens(cairo)-to-World conversion in particular, and people is sending always their crash reports… we made the whole conversion a lot more robust since problems started to arise, but now I hit a wall I cannot solve: I think problem is in something in callbacks. > > And problem is showing very easy on 64bits (while in 32bits it takes time and is more random). > > Here is the easiest way to reproduce it (in mac): > > wget files.pharo.org/get-files/60/pharo64-mac-latest.zip > wget files.pharo.org/get-files/60/pharo64.zip > wget files.pharo.org/get-files/60/sources.zip > unzip pharo64-mac-latest.zip > unzip pharo64.zip > unzip sources.zip > ./Pharo.app/Contents/MacOS/Pharo ./Pharo64-60438.image eval "VGTigerDemo runDemo" > > eventually (like 5-6 seconds after, if not immediately), you will have a stack like this: > > SmallInteger(Object)>>primitiveFailed: > SmallInteger(Object)>>primitiveFailed > SmallInteger(VMCallbackContext64)>>primSignal:andReturnAs:fromContext: > GrafPort>>copyBits > GrafPort>>image:at:sourceRect:rule: > FormCanvas>>image:at:sourceRect:rule: > FormCanvas(Canvas)>>drawImage:at:sourceRect: > FormCanvas(Canvas)>>drawImage:at: > VGTigerDemo>>runDemo > VGTigerDemo class>>runDemo > UndefinedObject>>DoIt > OpalCompiler>>evaluate > OpalCompiler(AbstractCompiler)>>evaluate: > [ result := Smalltalk compiler evaluate: aStream. > self hasSessionChanged > ifFalse: [ self stdout > print: result; > lf ] ] in EvaluateCommandLineHandler>>evaluate: in Block: [ result := Smalltalk compiler evaluate: aStream.... > BlockClosure>>on:do: > EvaluateCommandLineHandler>>evaluate: > EvaluateCommandLineHandler>>evaluateArguments > EvaluateCommandLineHandler>>activate > EvaluateCommandLineHandler class(CommandLineHandler class)>>activateWith: > [ aCommandLinehandler activateWith: commandLine ] in PharoCommandLineHandler(BasicCommandLineHandler)>>activateSubCommand: in Block: [ aCommandLinehandler activateWith: commandLine ] > BlockClosure>>on:do: > PharoCommandLineHandler(BasicCommandLineHandler)>>activateSubCommand: > PharoCommandLineHandler(BasicCommandLineHandler)>>handleSubcommand > PharoCommandLineHandler(BasicCommandLineHandler)>>handleArgument: > [ self > handleArgument: > (self arguments > ifEmpty: [ '' ] > ifNotEmpty: [ :arguments | arguments first ]) ] in PharoCommandLineHandler(BasicCommandLineHandler)>>activate in Block: [ self... > BlockClosure>>on:do: > PharoCommandLineHandler(BasicCommandLineHandler)>>activate > PharoCommandLineHandler>>activate > PharoCommandLineHandler class(CommandLineHandler class)>>activateWith: > [ super activateWith: aCommandLine ] in PharoCommandLineHandler class>>activateWith: in Block: [ super activateWith: aCommandLine ] > > Any idea? > > thanks! > Esteban

2 1

MacOSX squeak.cog.spur 64bits failure
by Nicolas Cellier 10 Mar '17

10 Mar '17

Hi, as already reported there are failures while loading .mcz. I launched the debug version from Terminal and got some feedback: /Users/nicolas/Smalltalk/OpenSmalltalk/opensmalltalk-vm/build.macos64x64/squeak.cog.spur/CocoaDebug.app/Contents/MacOS/Squeak (lip > (methodField + ((mframeIsBlockActivation(lifp) ? sizeof(CogBlockMethod) : sizeof(CogMethod))))) && (lip < (methodField + ((cogMethod->blockSize)))) 22043 (lip > (methodField + ((mframeIsBlockActivation(lifp) ? sizeof(CogBlockMethod) : sizeof(CogMethod))))) && (lip < (methodField + ((cogMethod->blockSize)))) 23333 Illegal instruction: 4

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev March 2017