Vm-dev February 2015

vm-dev@lists.squeakfoundation.org

27 participants
101 discussions

About BitBlt on the Raspberry Pie VM
by Clément Bera 19 Feb '15

19 Feb '15

Hello everyone, When I run a Squeak image on the Raspberry Pie, the UI is much faster with the default VM present on the Raspberry Pie than with a VM compiled on the Cog or Pharo branch. I heard that this is because Tim Rowledge changed BitBlt implementation in the Pie VM / Pie image, reimplementing it image-side and not VM-side, resulting in a faster BitBlt. I have questions: - Is it true ? - Is the BitBlt code of Tim Rowledge open source ? If so, where is it and what is exactly its license ? - Would it make sense to port that or do something similar on Intel VM ? Would we see a performance gain / loss ? I am asking it because last time I discussed with Bert, he said that it would be fun to have a smalltalk-implemented BitBlt combined with a JIT compiler doing automatic vectorization in order to have vector graphics implemented as Bit-based graphics. The more I think about it the more I think this makes sense. Even if it's in the far future (I'm stabilizing inlining and SmallInteger range optimizations first in the JIT), I would like to go in that direction. Thanks for any answer. Clement

5 7

About allInstances and allObjects in Spur
by Clément Bera 19 Feb '15

19 Feb '15

Hey everyone, I remember a discussion from january 2014 where it was said that the following primitives: - someObject - nextObject - someInstance - nextInstance did not make sense in Spur as they expect an ordering of objects. I think it was suggested to replace them with the primitives: - allObjects 178 - allInstances 177 I saw that the implementation of allObjects and allInstances are in the repository. Now at image-level, in squeak 4.5 and Pharo 4, allObjectsDo: still uses nextObject and someObject. So I am wondering, should we change the image-side implementation of allObjectsDo: to use primitive 178 allObjects ? If so, does it work in the V3 memory manager (when I tried it didn't work but it may be my VM) ? Best, Clement

2 2

Can anyone build the unix midi plugin with ALSA?
by tim Rowledge 19 Feb '15

19 Feb '15

It seems to not be possible to build the MIDI plugin on unix when ALSA support is wanted. The sqUnixMIDI.c file tries to use ‘USE_MIDI_ALSA’ to decide whether to include null code or actual ALSA calling code - that seems to fail. If we manually fudge it to force use of sqUnixMIDIALSA.inc then we fall foul of ‘debugf’ not being defined and the best I could do there was replace with ‘DPRINTF’. Which implies to me that it is a long time since anyone even made a working midi unix plugin. Anyone got any ideas? tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Always try to be modest. And be damn proud of it!

2 1

So who broke bitOr: ?
by tim Rowledge 19 Feb '15

19 Feb '15

On a fresh Pi vm (as in svn updated yesterday) 16rFFFF bitOr:(16rFFFF bitShift: 16) -> -1 On a slightly older Mac vm 16rFFFF bitOr:(16rFFFF bitShift: 16) -> 4294967295, aka 16rFFFFFFFF This breaks, amongst other things, Color>bitPatternForDepth:, whcih pretty much trashes an image since that gets used to makes cursor bitmaps as you move the pointer around. Nicely fills your window with notifiers… So come along; hands up the boy that did that! I’ll keep you all in late unless someone confesses. It’s only your own time you’re wasting! Was it *you* Molesworth? tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Strange OpCodes: PBC: Print and Break Chain

6 5

VM Maker: VMMaker.oscog-eem.1071.mcz
by commits＠source.squeak.org 19 Feb '15

19 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1071.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1071 Author: eem Time: 18 February 2015, 7:25:44.963 pm UUID: 6b4dfa33-242b-4b9b-8b1a-0aee9139cf6c Ancestors: VMMaker.oscog-eem.1070 Fix several bugs in the new type inferrence code, resulting in a functional VM again (phew!). Do a much better job at typeForArithmetic:in:; answering the longest type for integral types. In inferTypesForImplicitlyTypedVariablesIn:, observe assignments from both sends and typed vars. Comment the method better so that alreadyExplicitlyTyped's usage is clear(er). On type compatibility of inlined expressions, insist on signed compatibility or accept an untyped actual. Provide a return type for asFloat (so inlining in primitiveAsFloat still occurs) Provide an exception in unsignedTypeForBitwiseSend:in: for currentBytecode to preserve the nice constant inlining of currentBytecode & N in the bytecode cases. This time I feel that the Slang Sensei has hit me over the head and some enlightenment has ensued. That's a first ;-). =============== Diff against VMMaker.oscog-eem.1070 =============== Item was changed: ----- Method: CCodeGenerator>>isActualType:compatibleWithFormalType: (in category 'inlining') ----- isActualType: actualTypeOrNil compatibleWithFormalType: formalTypeOrNil | actualType formalType | actualType := actualTypeOrNil ifNil: [#sqInt]. formalType := formalTypeOrNil ifNil: [#sqInt]. ((self isIntegralCType: actualType) and: [self isIntegralCType: formalType]) ifFalse: [^actualType = formalType or: [formalType = 'double' and: [actualType = 'float']]]. "For now, insist that the signedness agrees." ^(actualType first = $u) = (formalType first = $u) + or: [actualTypeOrNil isNil] "a nil formal defaults to #sqInt"! - or: [actualTypeOrNil isNil or: [formalTypeOrNil isNil]]! Item was changed: ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') ----- returnTypeForSend: sendNode in: aTMethod "Answer the return type for a send. Absent sends default to #sqInt. The bitwise operators answer unsigned versions of their argument types, at least in gcc although this author can't find that in the C99 spec. If you can find this, please let me know." | sel | ^(self anyMethodNamed: (sel := sendNode selector)) ifNil: [kernelReturnTypes at: sel ifAbsent: [^sel caseOf: { [#+] -> [self typeForArithmetic: sendNode in: aTMethod]. [#-] -> [self typeForArithmetic: sendNode in: aTMethod]. [#*] -> [self typeForArithmetic: sendNode in: aTMethod]. [#/] -> [self typeForArithmetic: sendNode in: aTMethod]. [#addressOf:] -> [(self typeFor: sendNode receiver in: aTMethod) ifNil: [#sqInt] ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]]. [#at:] -> [self typeForDereference: sendNode in: aTMethod]. [#bitAnd:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. [#bitOr:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. [#bitXor:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. + [#asFloat] -> [#double]. - [#asVoidPointer] -> [#'void *']. - [#asVoidPointer] -> [#'void *']. - [#asUnsignedInteger] -> [#usqInt]. [#asLong] -> [#long]. + [#asUnsignedInteger] -> [#usqInt]. [#asUnsignedLong] -> [#'unsigned long']. + [#asVoidPointer] -> [#'void *']. [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:" [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:" [#cCoerce:to:] -> [sendNode args last value]. [#cCoerceSimple:to:] -> [sendNode args last value] } otherwise: [#sqInt]]] ifNotNil: [:m| m returnType ifNotNil: [:type| self baseTypeForType: type]]! 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." - inline simple expressions. Deal with pointer arithmetic and floating point arithmetic" | rcvrType argType | argType := self typeFor: sendNode args first in: aTMethod. argType = #double ifTrue: [^#double]. rcvrType := self typeFor: sendNode receiver in: aTMethod. + "deal with unknowns, answering nil." + (rcvrType isNil or: [argType isNil]) ifTrue: + [^nil]. + "deal with pointer arithmetic" + (rcvrType last = $* or: [argType last = $*]) ifTrue: + [(sendNode selector == #- + and: [rcvrType last = $* and: [argType last = $*]]) ifTrue: + [^#int]. + ^rcvrType last = $ + ifTrue: [rcvrType] + ifFalse: [argType]]. + "deal with promotion; answer the longest type, defaulting to the recever if they're the same" + ^(self sizeOfIntegralCType: rcvrType) >= (self sizeOfIntegralCType: argType) + ifTrue: [rcvrType] + ifFalse: [argType]! - (sendNode selector == #- - and: [rcvrType notNil and: [rcvrType last = $* - and: [argType notNil and: [argType last = $*]]]]) ifTrue: - [^#int]. - ^rcvrType! Item was changed: ----- Method: CCodeGenerator>>unsignedTypeForBitwiseSend:in: (in category 'type inference') ----- unsignedTypeForBitwiseSend: aTSendNode in: aTMethod + "The result of the bitwise operators in C is unsigned. + We make an exception for currentBytecode bitAnd: N to allow better inlining in cases." - "The result of the bitwise operators in C is unsigned." | t1 t2 type | + (aTSendNode receiver isVariable + and: [aTSendNode receiver name = 'currentBytecode' + and: [aTSendNode selector == #bitAnd:]]) ifTrue: + [^#sqInt]. t1 := (self typeFor: aTSendNode receiver in: aTMethod) ifNil: [^nil]. t2 := (self typeFor: aTSendNode args first in: aTMethod) ifNil: [^nil]. type := (self sizeOfIntegralCType: t1) >= (self sizeOfIntegralCType: t1) ifTrue: [t1] ifFalse: [t2]. ^type first = $u ifTrue: [type] ifFalse: [(type beginsWith: 'sq') ifTrue: ['u', type] ifFalse: ['unsigned ', type]]! 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)" + | alreadyExplicitlyTyped effectiveNodes | + "selector = #blockDispatchTargetsFor:perform:arg: ifTrue: + [self halt]." + alreadyExplicitlyTyped := declarations keys asSet. - | explicitlyTyped effectiveNodes | - explicitlyTyped := declarations keys asSet. 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: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by inferred unsigned types" - and: [(explicitlyTyped includes: var) not 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: [declarations at: 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." - "if an assignment to an untyped local of a known type, set the local's type to that type." (node isAssignment and: [(locals includes: (var := node variable name)) and: [(declarations includesKey: var) not + and: [(type := node expression isSend + ifTrue: [aCodeGen returnTypeForSend: node expression in: self] + ifFalse: [self typeFor: node expression in: aCodeGen]) notNil - and: [(type := self typeFor: node expression in: aCodeGen) notNil and: [type ~= #void]]]]) ifTrue: [declarations at: var put: type, ' ', var. effectiveNodes at: var put: { declarations at: var. node }]]. ^effectiveNodes!

1 0

VM Maker: VMMaker.oscog-eem.1070.mcz
by commits＠source.squeak.org 18 Feb '15

18 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1070.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1070 Author: eem Time: 17 February 2015, 4:24:04.463 pm UUID: 080caffc-cd6c-4da2-934b-8c477c1f0c1f Ancestors: VMMaker.oscog-eem.1069 Fix inferTypesForImplicitlyTypedVariablesIn: for variables assigned arguments. This rescues at least BitBlt plugin. Fix typeFor:in: to provide sqInt as the default type for arguments. =============== Diff against VMMaker.oscog-eem.1068 =============== Item was added: + ----- Method: ADPCMCodecPlugin class>>methodsToBePruned (in category 'translation') ----- + methodsToBePruned + "Since sharing between plugins means that normal pruning + can't be done, allow plugins that want to prune specific methods." + ^#(indexForDeltaFrom:to: nextBits: nextBits:put:)! Item was removed: - ----- Method: ADPCMCodecPlugin class>>translateInDirectory:doInlining: (in category 'translation') ----- - translateInDirectory: directory doInlining: inlineFlag - "handle a special case code string rather than generated code" - "Not currently hooked into the timeStamp mechanism for VMMaker since this would mean replicating code from InterpreterPlugin; waiting for a more elegant solution to appear. In the meantime this means that this plugin will always get regenerated even if the file is uptodate" - | cg | - self initialize. - - cg := self buildCodeGeneratorUpTo: InterpreterPlugin. - - cg addMethodsForPrimitives: ADPCMCodec translatedPrimitives. - inlineFlag ifTrue:[ - "now remove a few which will be inlined but not pruned" - cg pruneMethods: #(indexForDeltaFrom:to: nextBits: nextBits:put:)]. - self pruneUnusedInterpreterPluginMethodsIn: cg. - self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: self moduleName, '.c'). - ^cg exportedPrimitiveNames asArray - ! Item was added: + ----- Method: ADPCMCodecPlugin class>>translatedPrimitives (in category 'translation') ----- + translatedPrimitives + "Answer an Array of Class, selector pair Arrays for any primitives to + be translated from Smalltalk methods elsewhere in the system." + ^ADPCMCodec translatedPrimitives! Item was changed: ----- Method: CCodeGenerator>>accessorChainsForMethod:interpreterClass: (in category 'spur primitive compilation') ----- accessorChainsForMethod: method interpreterClass: interpreterClass "Answer a set of access paths from arguments through objects, in the method, assuming it is a primitive. This is in support of Spur's lazy become. A primitive may fail because it may encounter a forwarder. The primitive failure code needs to know to what depth it must follow arguments to follow forwarders and, if any are found and followed, retry the primitive. This method determines that depth. It starts by collecting references to the stack and then follows these through assignments to variables and use of accessor methods such as fetchPointer:ofObject:. For example | obj field | obj := self stackTop. field := objectMemory fetchPointer: 1 ofObject: obj. self storePointer: 1 ofObject: field withValue: (self stackValue: 1) has depth 2, since field is accessed, and field is an element of obj." | accessors assignments roots chains extendedChains extended lastPass | self accessorsAndAssignmentsForMethod: method + actuals: (self actualsForMethod: method) - actuals: {} depth: 0 interpreterClass: interpreterClass into: [:theRoots :theAccessors :theAssignments| roots := theRoots. accessors := theAccessors. assignments := theAssignments]. "Compute the transitive closure of assignments of accessor sends or variables to variables from the roots. Start from the stack accesses (the roots). On the last pass look only for accessors of the targets of the tip assignments." chains := OrderedCollection new. roots do: [:root| chains addAll: (assignments select: [:assignment| assignment expression = root] thenCollect: [:assignment| OrderedCollection with: assignment])]. lastPass := false. [extended := false. extendedChains := OrderedCollection new: chains size * 2. chains do: [:chain| | tip refs accessorRefs variableRefs | tip := chain last variable. refs := accessors select: [:send| send args anySatisfy: [:arg| tip isSameAs: arg]]. lastPass ifFalse: [accessorRefs := refs collect: [:send| assignments detect: [:assignment| assignment expression = send and: [(chain includes: assignment) not]] ifNone: []] thenSelect: [:assignmentOrNil| assignmentOrNil notNil]. variableRefs := assignments select: [:assignment| (tip isSameAs: assignment expression) and: [(tip isSameAs: assignment variable) not and: [(chain includes: assignment) not]]]. refs := (Set withAll: accessorRefs) addAll: variableRefs; yourself]. refs isEmpty ifTrue: [extendedChains add: chain] ifFalse: [lastPass ifFalse: [extended := true]. self assert: (refs noneSatisfy: [:assignment| chain includes: assignment]). extendedChains addAll: (refs collect: [:assignment| chain, {assignment}])]]. extended or: [lastPass not]] whileTrue: [chains := extendedChains. extended ifFalse: [lastPass := true]]. ^chains! Item was added: + ----- Method: CCodeGenerator>>actualsForMethod: (in category 'spur primitive compilation') ----- + actualsForMethod: aTMethod + "Normal primitives have no arguments, but translated primitives do. + This class doesn't handle translated primitives and so smply answers an empty array. + Subclasses override as required." + ^#()! Item was removed: - ----- Method: CCodeGenerator>>addMethodsForPrimitives: (in category 'public') ----- - addMethodsForPrimitives: classAndSelectorList - | verbose | - verbose := false. - classAndSelectorList do: - [:classAndSelector | | aClass selector meth | - aClass := Smalltalk at: classAndSelector first. - selector := classAndSelector last. - self addAllClassVarsFor: aClass. - "TPR - should pool vars also be added here?" - - "compile the method source and convert to a suitable translation method. - find the method in either the class or the metaclass" - meth := self - compileToTMethodSelector: selector - in: ((aClass includesSelector: selector) - ifTrue: [aClass] - ifFalse: [aClass class]). - meth primitive > 0 ifTrue:[meth preparePrimitiveName]. - "for old-style array accessing: - meth covertToZeroBasedArrayReferences." - meth replaceSizeMessages. - self addMethod: meth]. - - self prepareMethods. - verbose - ifTrue: - [self printUnboundCallWarnings. - self printUnboundVariableReferenceWarnings. - logger cr]. - - "code generation" - self doInlining: true. - - methods do:[:m| - "if this method is supposed to be a primitive (rather than a helper - routine), add assorted prolog and epilog items" - m primitive > 0 ifTrue: [m preparePrimitivePrologue]].! Item was added: + ----- Method: CCodeGenerator>>addMethodsForTranslatedPrimitives: (in category 'public') ----- + addMethodsForTranslatedPrimitives: classAndSelectorList + | verbose | + verbose := false. + classAndSelectorList do: + [:classAndSelector | | aClass selector meth | + aClass := Smalltalk at: classAndSelector first. + selector := classAndSelector last. + self addAllClassVarsFor: aClass. + + "compile the method source and convert to a suitable translation method. + find the method in either the class or the metaclass" + meth := self + compileToTMethodSelector: selector + in: ((aClass includesSelector: selector) + ifTrue: [aClass] + ifFalse: [aClass class]). + meth primitive > 0 ifTrue: + [meth preparePrimitiveName]. + meth replaceSizeMessages. + self addMethod: meth]. + + self prepareMethods! Item was added: + ----- Method: CCodeGenerator>>baseTypeForType: (in category 'utilities') ----- + baseTypeForType: aCType + "Reduce various declarations to the most basic type we can determine." + | type fpIndex closeidx openidx | + type := aCType. + ((openidx := type indexOfSubCollection: 'const ') > 0 + and: [openidx = 1 or: [(type at: openidx) isSeparator]]) ifTrue: + [type := type copyReplaceFrom: openidx to: openidx + 5 with: '']. + ((type beginsWith: 'unsigned') and: [(type includes: $:) and: [type last isDigit]]) ifTrue: + [^#usqInt]. + (fpIndex := type indexOfSubCollection: '(*') > 0 ifTrue: + [type := type copyReplaceFrom: (type indexOf: $( startingAt: fpIndex + 1) + to: (type indexOf: $) startingAt: fpIndex + 1) + with: '']. + "collapse [size] to *" + openidx := 0. + [(openidx := type indexOf: $[ startingAt: openidx + 1) > 0 + and: [(closeidx := type indexOf: $] startingAt: openidx + 1) > 0]] whileTrue: + [type := type copyReplaceFrom: openidx to: closeidx with: '*']. + ^type withBlanksTrimmed! Item was changed: ----- Method: CCodeGenerator>>extractTypeFor:fromDeclaration: (in category 'utilities') ----- extractTypeFor: aVariable fromDeclaration: aVariableDeclaration "Eliminate inessentials from aVariableDeclaration to answer a C type without the variable, or initializations etc" + | decl | - | decl fpIndex closeidx openidx | decl := aVariableDeclaration. (decl beginsWith: 'static') ifTrue: [decl := decl allButFirst: 6]. (decl indexOf: $= ifAbsent: []) ifNotNil: [:index| decl := decl copyFrom: 1 to: index - 1]. decl := decl copyReplaceAll: aVariable with: '' tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]]. + ^self baseTypeForType: decl! - (fpIndex := decl indexOfSubCollection: '(*') > 0 ifTrue: - [decl := decl copyReplaceFrom: (decl indexOf: $( startingAt: fpIndex + 1) - to: (decl indexOf: $) startingAt: fpIndex + 1) - with: '']. - "collapse [size] to *" - openidx := 0. - [(openidx := decl indexOf: $[ startingAt: openidx + 1) > 0 - and: [(closeidx := decl indexOf: $] startingAt: openidx + 1) > 0]] whileTrue: - [decl := decl copyReplaceFrom: openidx to: closeidx with: '*']. - ^decl withBlanksTrimmed! Item was changed: ----- Method: CCodeGenerator>>inferTypesForImplicitlyTypedVariablesAndMethods (in category 'type inference') ----- inferTypesForImplicitlyTypedVariablesAndMethods "Infer the return tupe and the types of untyped variables. As far as variables go, for now we try only to infer variables assigned the result of #longLongAt:, but much more could be done here." "Iterate over all methods, inferring #void return types, until we reach a fixed point." | firstTime allMethods | firstTime := true. allMethods := apiMethods ifNil: [methods] ifNotNil: [(Set withAll: methods) addAll: apiMethods; yourself]. + "Make an initial pass to assign the return types of all simple methods that return constants." - "Make an initial pass to assign the return types of all simple mehtods that return constants." allMethods do: [:m| m isReturnConstant ifTrue: [m inferReturnTypeIn: self]]. [| changedReturnType | changedReturnType := false. allMethods do: [:m| firstTime ifTrue: [m removeFinalSelfReturnIn: self. "must preceed recordDeclarationsIn: because it may set returnType" m recordDeclarationsIn: self]. m inferTypesForImplicitlyTypedVariablesIn: self. (m inferReturnTypeIn: self) ifTrue: [changedReturnType := true]]. firstTime := false. changedReturnType] whileTrue. "Type all as-yet-untyped methods as the default" methods do: [:m| m returnType ifNil: [m returnType: (self implicitReturnTypeFor: m selector)]]! Item was changed: ----- Method: CCodeGenerator>>isActualType:compatibleWithFormalType: (in category 'inlining') ----- isActualType: actualTypeOrNil compatibleWithFormalType: formalTypeOrNil | actualType formalType | actualType := actualTypeOrNil ifNil: [#sqInt]. formalType := formalTypeOrNil ifNil: [#sqInt]. ((self isIntegralCType: actualType) and: [self isIntegralCType: formalType]) ifFalse: + [^actualType = formalType + or: [formalType = 'double' and: [actualType = 'float']]]. - [^actualType = formalType]. "For now, insist that the signedness agrees." ^(actualType first = $u) = (formalType first = $u) or: [actualTypeOrNil isNil or: [formalTypeOrNil isNil]]! Item was changed: ----- Method: CCodeGenerator>>maybeBreakForTestToInline:in: (in category 'inlining') ----- maybeBreakForTestToInline: aNode in: aTMethod "convenient for debugging..." (aNode isSend and: [(breakSrcInlineSelector notNil or: [breakDestInlineSelector notNil]) and: [(breakSrcInlineSelector ifNil: [true] ifNotNil: [:srcSel| srcSel = aNode selector]) + and: [(breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = aTMethod selector]) + and: [breakOnInline ~~ true]]]]) ifTrue: - and: [breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = aTMethod selector - and: [breakOnInline ~~ true]]]]]) ifTrue: [aTMethod halt: aTMethod selector, ' ', aNode selector]! Item was changed: ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') ----- returnTypeForSend: sendNode in: aTMethod "Answer the return type for a send. Absent sends default to #sqInt. The bitwise operators answer unsigned versions of their argument types, at least in gcc although this author can't find that in the C99 spec. If you can find this, please let me know." | sel | ^(self anyMethodNamed: (sel := sendNode selector)) ifNil: [kernelReturnTypes at: sel ifAbsent: [^sel caseOf: { [#+] -> [self typeForArithmetic: sendNode in: aTMethod]. [#-] -> [self typeForArithmetic: sendNode in: aTMethod]. [#*] -> [self typeForArithmetic: sendNode in: aTMethod]. [#/] -> [self typeForArithmetic: sendNode in: aTMethod]. + [#addressOf:] -> [(self typeFor: sendNode receiver in: aTMethod) + ifNil: [#sqInt] + ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]]. [#at:] -> [self typeForDereference: sendNode in: aTMethod]. [#bitAnd:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. [#bitOr:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. [#bitXor:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. [#asVoidPointer] -> [#'void *']. [#asVoidPointer] -> [#'void *']. [#asUnsignedInteger] -> [#usqInt]. [#asLong] -> [#long]. [#asUnsignedLong] -> [#'unsigned long']. [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:" [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:" [#cCoerce:to:] -> [sendNode args last value]. [#cCoerceSimple:to:] -> [sendNode args last value] } otherwise: [#sqInt]]] ifNotNil: [:m| + m returnType ifNotNil: + [:type| + self baseTypeForType: type]]! - m returnType ifNotNil: - [:type| "map fields to #usqInt" - ((type beginsWith: 'unsigned') - and: [(type includes: $:) - and: [type last isDigit]]) - ifTrue: [#usqInt] - ifFalse: [type]]]! 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 and floating point arithmetic" + | rcvrType argType | + argType := self typeFor: sendNode args first in: aTMethod. + argType = #double ifTrue: - (self typeFor: sendNode args first in: aTMethod) = #double ifTrue: [^#double]. + rcvrType := self typeFor: sendNode receiver in: aTMethod. + (sendNode selector == #- + and: [rcvrType notNil and: [rcvrType last = $* + and: [argType notNil and: [argType last = $*]]]]) ifTrue: + [^#int]. + ^rcvrType! - ^self typeFor: sendNode receiver in: aTMethod! Item was changed: ----- Method: CCodeGenerator>>typeForDereference:in: (in category 'type inference') ----- typeForDereference: sendNode in: aTMethod + (self typeFor: sendNode receiver in: aTMethod) ifNotNil: + [:type| + type last = $* ifTrue: + [^type allButLast withBlanksTrimmed]]. + "It would be nice to warn here, but there are contexts when the type is unknown, for example determining + the return types of apiMethods. inferTypesForImplicitlyTypedVariablesAndMethods could provide a signal + handler to suppress the warnings in that case but that's too fancy. Instead we live with the default." + "logger + nextPutAll: 'warning, cannot determine type of at: for ', sendNode receiver asString, ' in ', aTMethod selector; + cr." + ^#sqInt! - | type | - type := self typeFor: sendNode receiver in: aTMethod. - type last = $* ifTrue: - [^type allButLast withBlanksTrimmed]. - self error: 'cannot determine type'. - ^nil! Item was added: + ----- Method: InterpreterPlugin class>>allCodeOlderThan: (in category 'translation') ----- + allCodeOlderThan: modificationTime + ^((self pluginClassesUpTo: self) allSatisfy: + [:aPluginClass| aPluginClass timeStamp < modificationTime]) + and: [self translatedPrimitives allSatisfy: + [:pair| | c m stamp | + c := Smalltalk classNamed: pair first. + m := c compiledMethodAt: pair last ifAbsent: [c class >> pair last]. + stamp := (m timeStamp subStrings: {Character space}) last: 2. + stamp := TimeStamp date: (Date fromString: stamp first) time: (Time fromString: stamp last). + stamp asSeconds < modificationTime]]! Item was changed: ----- Method: InterpreterPlugin class>>buildCodeGeneratorUpTo: (in category 'translation') ----- buildCodeGeneratorUpTo: aPluginClass "Build a CCodeGenerator for the plugin" | cg pluginClasses | cg := self codeGeneratorClass new initialize. cg pluginClass: self. (pluginClasses := self pluginClassesUpTo: aPluginClass) do: [:aClass| cg addClass: aClass]. (cg structClassesForTranslationClasses: pluginClasses) do: [:structClasss| cg addStructClass: structClasss]. + cg addMethodsForTranslatedPrimitives: self translatedPrimitives. ^cg! Item was added: + ----- Method: InterpreterPlugin class>>methodsToBePruned (in category 'translation') ----- + methodsToBePruned + "Since sharing between plugins means that normal pruning + can't be done, allow plugins that want to prune specific methods." + ^#()! Item was changed: ----- Method: InterpreterPlugin class>>translateInDirectory:doInlining: (in category 'translation') ----- translateInDirectory: directory doInlining: inlineFlag "This is the default method for writing out sources for a plugin. Several classes need special handling, so look at all implementors of this message" + | cg fname | - | cg fname fstat | fname := self moduleName, '.c'. "don't translate if the file is newer than my timeStamp" + (directory entryAt: fname ifAbsent: nil) ifNotNil: + [:fstat| + (self allCodeOlderThan: fstat modificationTime) ifTrue: - fstat := directory entryAt: fname ifAbsent:[nil]. - fstat ifNotNil: - [((self pluginClassesUpTo: self) allSatisfy: - [:aPluginClass| aPluginClass timeStamp < fstat modificationTime]) ifTrue: [^nil]]. self initialize. cg := self buildCodeGeneratorUpTo: self. cg inferTypesForImplicitlyTypedVariablesAndMethods. self pruneUnusedInterpreterPluginMethodsIn: cg. cg storeCodeOnFile: (directory fullNameFor: fname) doInlining: inlineFlag. ^cg exportedPrimitiveNames asArray! Item was added: + ----- Method: InterpreterPlugin class>>translatedPrimitives (in category 'translation') ----- + translatedPrimitives + "Answer an Array of Class, selector pair Arrays for any primitives to + be translated from Smalltalk methods elsewhere in the system. + By default answer none. Some subclasses redefine as required." + ^#()! Item was changed: ----- Method: InterpreterProxy>>fullGC (in category 'other') ----- fullGC + <returnTypeC: #sqInt> + Smalltalk garbageCollect! - Smalltalk garbageCollect.! Item was changed: ----- Method: InterpreterProxy>>pop: (in category 'stack access') ----- pop: nItems + <returnTypeC: #sqInt> 1 to: nItems do:[:i| stack removeLast].! Item was changed: ----- Method: InterpreterProxy>>pop:thenPush: (in category 'stack access') ----- pop: nItems thenPush: oop + <returnTypeC: #sqInt> self pop: nItems. + self push: oop! - self push: oop.! Item was changed: ----- Method: InterpreterProxy>>push: (in category 'stack access') ----- push: object + <returnTypeC: #sqInt> stack addLast: object! Item was changed: ----- Method: InterpreterProxy>>pushBool: (in category 'stack access') ----- pushBool: trueOrFalse + <returnTypeC: #sqInt> (trueOrFalse == true or:[trueOrFalse == false]) ifFalse:[self error:'Not a Boolean']. self push: trueOrFalse! Item was changed: ----- Method: InterpreterProxy>>pushFloat: (in category 'stack access') ----- pushFloat: f + <returnTypeC: #sqInt> <var: #f type: 'double '> f isFloat ifFalse:[^self error:'Not a Float']. self push: f.! Item was changed: ----- Method: InterpreterProxy>>pushInteger: (in category 'stack access') ----- pushInteger: integerValue + <returnTypeC: #sqInt> self push: (self integerObjectOf: integerValue).! Item was changed: ----- Method: InterpreterProxy>>pushRemappableOop: (in category 'instance creation') ----- pushRemappableOop: oop + <returnTypeC: #sqInt> remapBuffer addLast: oop! Item was changed: ----- Method: InterpreterProxy>>returnAs:ThroughCallback:Context: (in category 'callback support') ----- returnAs: returnTypeOop ThroughCallback: vmCallbackContext Context: callbackMethodContext + <returnTypeC: #sqInt> <var: #vmCallbackContext type: #'VMCallbackContext *'> "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." self notYetImplemented! Item was changed: ----- Method: InterpreterProxy>>signalSemaphoreWithIndex: (in category 'other') ----- signalSemaphoreWithIndex: semaIndex + <returnTypeC: #sqInt> ((Smalltalk externalObjects) at: semaIndex) signal! Item was changed: ----- Method: InterpreterProxy>>success: (in category 'other') ----- success: aBoolean + <returnTypeC: #sqInt> aBoolean ifTrue: [^self]. primFailCode = 0 ifTrue: [self primitiveFailFor: 1]! Item was changed: ----- Method: InterpreterProxy>>tenuringIncrementalGC (in category 'other') ----- tenuringIncrementalGC + <returnTypeC: #sqInt> Smalltalk forceTenuring; garbageCollectMost! Item was removed: - ----- Method: MiscPrimitivePlugin class>>translateInDirectory:doInlining: (in category 'translation') ----- - translateInDirectory: directory doInlining: inlineFlag - "handle a special case code string rather than normal generated code." - | cg fname fstat | - fname := self moduleName, '.c'. - - "don't translate if the file is newer than my timeStamp" - fstat := directory entryAt: fname ifAbsent:[nil]. - fstat ifNotNil:[self timeStamp < fstat modificationTime ifTrue:[^nil]]. - - self initialize. - cg := self buildCodeGeneratorUpTo: InterpreterPlugin. - cg addMethodsForPrimitives: self translatedPrimitives. - self pruneUnusedInterpreterPluginMethodsIn: cg. - self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: fname). - ^cg exportedPrimitiveNames asArray - ! Item was added: + ----- Method: MiscPrimitivePlugin>>asciiValue: (in category 'helper functions') ----- + asciiValue: aCharacter + <cmacro: '(aCharacter) aCharacter'> + ^aCharacter asciiValue! Item was changed: ----- Method: SmartSyntaxPluginTMethod>>printTempsAndVar:on: (in category 'private') ----- printTempsAndVar: varName on: aStream "add the required temps and the varname to the stream" aStream nextPutAll: '| '. + (#('rcvr' 'stackPointer' 'interpreterProxy') reject: [:each | locals includes: each]) - (#('rcvr' 'stackPointer' 'successFlag' 'interpreterProxy' ) reject: [:each | locals includes: each]) do: [:each | aStream nextPutAll: each; space]. (locals reject: [:each | each first = $_]) do: [:each | aStream nextPutAll: each; space]. "don't add varName twice. Probably a deeper reason for this, but WTH. TPR" (locals includes: varName) ifFalse:[aStream nextPutAll: varName]. aStream nextPutAll: '|'; cr! Item was removed: - ----- Method: SoundGenerationPlugin class>>translateInDirectory:doInlining: (in category 'accessing') ----- - translateInDirectory: directory doInlining: inlineFlag - "handle a special case code string rather than generated code. - NB sqOldSoundsPrims IS NOT FULLY INTEGRATED - it still isn't included in the exports list" - | cg | - self initialize. - - cg := self buildCodeGeneratorUpTo: InterpreterPlugin. - - cg addMethodsForPrimitives: AbstractSound translatedPrimitives. - self pruneUnusedInterpreterPluginMethodsIn: cg. - self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: self moduleName, '.c'). - "What we need here is some way to derive the prim names from sqOldSoundPrims - or dump it entirely. Perhaps add this class (without then generating the file again) using fake entry points like SurfacePlugin does" - - ^cg exportedPrimitiveNames asArray - ! Item was added: + ----- Method: SoundGenerationPlugin class>>translatedPrimitives (in category 'translation') ----- + translatedPrimitives + "Answer an Array of Class, selector pair Arrays for any primitives to + be translated from Smalltalk methods elsewhere in the system." + ^AbstractSound translatedPrimitives! Item was changed: ----- Method: TMethod>>checkSuccessExpr (in category 'primitive compilation') ----- checkSuccessExpr + "Answer the parse tree for an expression that aborts the primitive if there has been a failure." + ^self + statementsFor: 'interpreterProxy failed ifTrue: [^nil]' + varName: ''! - "Return the parse tree for an expression that aborts the primitive if the successFlag is not true." - - | expr | - expr := 'successFlag ifFalse: [^ nil ]'. - ^ self statementsFor: expr varName: '' - ! Item was removed: - ----- Method: TMethod>>covertToZeroBasedArrayReferences (in category 'primitive compilation') ----- - covertToZeroBasedArrayReferences - "Replace the index expressions in at: and at:put: messages with (<expr> - 1), since C uses zero-based array indexing." - "Note: Up through release 1.31, generated primitives used the convention that array variables pointed to the first element. That meant that Smalltalk one-based index expressions had to have one subtracted to yield a zero-based index. Later, we decided to adjust the base address by -1 once in the primitive prolog rather on every array access. This resulted in a five percent performance increase for the bitmap compress/decompress primitives. This method is retained as documentation and in case we choose to revert the the previous scheme." - - | oldIndexExpr newIndexExpr | - parseTree nodesDo: [ :n | - (n isSend and: [(n selector = #at:) or: [ n selector = #at:put: ]]) ifTrue: [ - oldIndexExpr := n args first. - oldIndexExpr isConstant ifTrue: [ - "index expression is a constant: decrement the constant now" - newIndexExpr := TConstantNode new setValue: (n args first value - 1). - ] ifFalse: [ - "index expression is complex: build an expression to decrement result at runtime" - newIndexExpr := TSendNode new - setSelector: #- - receiver: oldIndexExpr - arguments: (Array with: (TConstantNode new setValue: 1)). - ]. - n args at: 1 put: newIndexExpr. - ]. - ]. - ! Item was changed: ----- Method: TMethod>>determineTypeFor:in: (in category 'C code generation') ----- determineTypeFor: aNode in: aCodeGen aNode isSend ifTrue: + [^(aCodeGen returnTypeForSend: aNode in: self) ifNil: [#sqInt]]. - [aNode selector == #addressOf: ifTrue: - [^(self determineTypeFor: aNode args first in: aCodeGen) - ifNil: [#sqInt] - ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]]. - (aNode selector == #at: - and: [aNode receiver isVariable]) ifTrue: - [(aCodeGen typeOfVariable: aNode receiver name) ifNotNil: - [:type| - ^type last = $* - ifTrue: [aCodeGen - extractTypeFor: aNode receiver name - fromDeclaration: type allButLast] - ifFalse: [type]]]. - ^(aCodeGen anyMethodNamed: aNode selector) - ifNil: [#sqInt] - ifNotNil: [:method| method returnType]]. aNode isAssignment ifTrue: [^self determineTypeFor: aNode expression in: aCodeGen]. self error: 'don''t know how to extract return type from this kind of node'! 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 - "infer types for untyped variables form assignments and arithmetic uses. This for debugging: (self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)" | explicitlyTyped effectiveNodes | explicitlyTyped := declarations keys asSet. 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: [(explicitlyTyped includes: var) not 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: + [declarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var. - [declarations at: var put: (declarations at: var) allButFirst. 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." - "if an assignment of a known send, set the variable's type to the return type of the send." (node isAssignment and: [(locals includes: (var := node variable name)) and: [(declarations includesKey: var) not + and: [(type := self typeFor: node expression in: aCodeGen) notNil + and: [type ~= #void]]]]) ifTrue: + [declarations at: var put: type, ' ', var. + effectiveNodes at: var put: { declarations at: var. node }]]. - and: [node expression isSend - and: [(type := aCodeGen returnTypeForSend: node expression in: self) notNil]]]]) ifTrue: - [(#(sqInt void) includes: type) ifFalse: - ["the $: is to map things like unsigned field : 3 to usqInt" - declarations - at: var - put: ((type includes: $:) ifTrue: [#usqInt] ifFalse: [type]), ' ', var. - effectiveNodes at: var put: { declarations at: var. node }]]]. ^effectiveNodes! Item was added: + ----- Method: TMethod>>isConditionalToBeTransformedForAssignment:in: (in category 'inlining') ----- + isConditionalToBeTransformedForAssignment: aSend in: aCodeGen + "Answer if a send is of the form + e1 + ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] + ifFalse: [self m3] + such that at least one of the sends mN may be inlined.." + + ^(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: aSend selector) + and: [aSend args anySatisfy: + [:arg| | stmt | + self assert: arg isStmtList. + arg statements size > 1 + or: [(stmt := arg statements first) isSend + and: [(aCodeGen mayInline: stmt selector) + or: [self isConditionalToBeTransformedForAssignment: stmt in: aCodeGen]]]]]! Item was added: + ----- Method: TMethod>>mapSendsFromSelfToInterpreterProxy: (in category 'transformations') ----- + mapSendsFromSelfToInterpreterProxy: selectors + | interpreterProxyNode | + interpreterProxyNode := TVariableNode new setName: 'interpreterProxy'. + parseTree nodesDo: + [:node| + (node isSend + and: [node receiver isVariable + and: [node receiver name = 'self' + and: [selectors includes: node selector]]]) ifTrue: + [node receiver: interpreterProxyNode]]! Item was changed: ----- Method: TMethod>>printTempsAndVar:on: (in category 'private') ----- printTempsAndVar: varName on: aStream "add the required temps and the varname to the stream" + aStream nextPutAll: '| rcvr stackPointer interpreterProxy ' , varName , ' |'; cr! - aStream nextPutAll: '| rcvr stackPointer successFlag ' , varName , ' |'; - cr! Item was changed: ----- Method: TMethod>>transformConditionalAssignment:in: (in category 'inlining') ----- transformConditionalAssignment: node in: aCodeGen + "If possible answer the transformation of code of the form - "If possible asnwer the transformation of code of the form var := e1 + ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] + ifFalse: [self m3] - ifTrue: [e2 ifTrue: [v1] ifFalse: [v2]] - ifFalse: [v3] into e1 + ifTrue: [e2 ifTrue: [var := self m1] ifFalse: [var := self m2]] + ifFalse: [var := self m3] + to allow inlining of m1, m2, et al. Otherwise answer nil." - ifTrue: [e2 ifTrue: [var := v1] ifFalse: [var := v2]] - ifFalse: [var := v3] - to allow inlining of v1, v2, et al. Otherwise answer nil." | expr | ^(node isAssignment and: [(expr := node expression) isSend + and: [(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) + and: [self isConditionalToBeTransformedForAssignment: expr in: aCodeGen]]]) ifTrue: - and: [#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector]]) ifTrue: [expr copy arguments: (expr args collect: [:stmtList| stmtList copy assignLastExpressionTo: node variable]); yourself]! Item was changed: ----- Method: TMethod>>typeFor:in: (in category 'utilities') ----- typeFor: aVariable in: aCodeGen "Answer the type for aVariable, deferring to aCodeGen (which defers to the vmClass) if no type is found and the variable is global (not an arg or a local). Expect the cCodeGen to answer nil for variables without types. nil for typelessness is required by the type propagation logic in inlineSend:directReturn:exitVar:in:." + | varName | + varName := aVariable asString. ^(declarations + at: varName + ifAbsent: + [(args includes: varName) "arg types default to sqInt" + ifTrue: ['sqInt ', varName] + ifFalse: + [(locals includes: varName) ifFalse: "don't provide type for locals" + [aCodeGen typeOfVariable: varName]]]) ifNotNil: - at: aVariable asString - ifAbsent: [((locals includes: aVariable) or: [args includes: aVariable]) ifFalse: - [aCodeGen typeOfVariable: aVariable asString]]) ifNotNil: [:decl| + aCodeGen extractTypeFor: varName fromDeclaration: decl]! - aCodeGen extractTypeFor: aVariable asString fromDeclaration: decl]! Item was changed: CCodeGenerator subclass: #VMPluginCodeGenerator + instanceVariableNames: 'pluginClass pluginName pluginFunctionsUsed inProgressSelectors inliningDone' - instanceVariableNames: 'pluginClass pluginName pluginFunctionsUsed inProgressSelectors' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Translation to C'! !VMPluginCodeGenerator commentStamp: '<historical>' prior: 0! I generate code that can be loaded dynamically from external libraries (e.g., DSOs on Unix or DLLs on Windows)! Item was added: + ----- Method: VMPluginCodeGenerator>>actualsForMethod: (in category 'spur primitive compilation') ----- + actualsForMethod: aTMethod + "Normal primitives have no arguments, but translated primitives do. + Override to answer actuals for translated primitives." + ^(aTMethod args size - 1 to: 0 by: -1) collect: + [:i| + TSendNode new + setSelector: #stackValue: + receiver: (TVariableNode new setName: 'interpreterProxy') + arguments: {TConstantNode new setValue: i}]! Item was removed: - ----- Method: VMPluginCodeGenerator>>compileToTMethodSelector:in: (in category 'utilities') ----- - compileToTMethodSelector: selector in: aClass - "Compile a method to a TMethod. Override to eagerly record declarations etc - that happen in a later phase in the main VM's CCodeGenerator." - - | m | - m := (Compiler new - parse: (aClass sourceCodeAt: selector) - in: aClass - notifying: nil) - asTranslationMethodOfClass: self translationMethodClass. - m removeFinalSelfReturnIn: self. - m recordDeclarationsIn: self. - m inferReturnTypeIn: self. - m returnType ifNil: - [m returnType: (self implicitReturnTypeFor: selector)]. - ^m! Item was changed: ----- Method: VMPluginCodeGenerator>>doInlining: (in category 'inlining') ----- doInlining: inlineFlag + "do inlining for a plugin; avoid doing it twice and make sure that + primitive prolog preparation is done immediately after inlining. + Also, since sharing between plugins means that normal pruning + can't be done, allow plugins that want to prune specific methods." + inliningDone ifFalse: + [self doBasicInlining: inlineFlag. + self prepareTranslatedPrimitives. + pluginClass methodsToBePruned do: + [:sel| + methods removeKey: sel]. + inliningDone := true]! - "do inlining for a plugin" - ^self doBasicInlining: inlineFlag! Item was removed: - ----- Method: VMPluginCodeGenerator>>emitCHeaderForPrimitivesOn: (in category 'C code generator') ----- - emitCHeaderForPrimitivesOn: aStream - "Write a C file header for compiled primitives onto the given stream." - - self emitCHeaderOn: aStream. - aStream nextPutAll: ' - /*** Proxy Functions ***/ - #if defined(SQUEAK_BUILTIN_PLUGIN) - extern sqInt stackValue(sqInt offset); - extern sqInt stackIntegerValue(sqInt offset); - extern sqInt failed(void); - # define successFlag (!!failed()) - extern sqInt success(sqInt aBoolean); - extern void * arrayValueOf(sqInt oop); - extern void * fetchArrayofObject(sqInt fieldIndex, sqInt objectPointer); - extern double fetchFloatofObject(sqInt fieldIndex, sqInt objectPointer); - extern sqInt fetchIntegerofObject(sqInt fieldIndex, sqInt objectPointer); - extern double floatValueOf(sqInt oop); - extern sqInt pop(sqInt nItems); - extern sqInt pushInteger(sqInt integerValue); - extern sqInt sizeOfSTArrayFromCPrimitive(void *cPtr); - extern sqInt storeIntegerofObjectwithValue(sqInt index, sqInt oop, sqInt integer); - extern sqInt primitiveFail(void); - #else /* SQUEAK_BUILTIN_PLUGIN */ - # define stackValue(i) (interpreterProxy->stackValue(i)) - # define stackIntegerValue(i) (interpreterProxy->stackIntegerValue(i)) - # define successFlag (!!interpreterProxy->failed()) - # define success(bool) (interpreterProxy->success(bool)) - # define arrayValueOf(oop) (interpreterProxy->arrayValueOf(oop)) - # define fetchArrayofObject(idx,oop) (interpreterProxy->fetchArrayofObject(idx,oop)) - # define fetchFloatofObject(idx,oop) (interpreterProxy->fetchFloatofObject(idx,oop)) - # define fetchIntegerofObject(idx,oop) (interpreterProxy->fetchIntegerofObject(idx,oop)) - # define floatValueOf(oop) (interpreterProxy->floatValueOf(oop)) - # define pop(n) (interpreterProxy->pop(n)) - # define pushInteger(n) (interpreterProxy->pushInteger(n)) - # define sizeOfSTArrayFromCPrimitive(cPtr) (interpreterProxy->sizeOfSTArrayFromCPrimitive(cPtr)) - # define storeIntegerofObjectwithValue(idx,oop,value) (interpreterProxy->storeIntegerofObjectwithValue(idx,oop,value)) - # define primitiveFail() interpreterProxy->primitiveFail() - #endif /* SQUEAK_BUILTIN_PLUGIN */ - - /* allows accessing Strings in both C and Smalltalk */ - #define asciiValue(c) c - - - '! Item was removed: - ----- Method: VMPluginCodeGenerator>>generateCodeStringForPrimitives (in category 'public') ----- - generateCodeStringForPrimitives - "TPR - moved down from CCodeGenerator" - | s methodList | - s := ReadWriteStream on: (String new: 1000). - methodList := methods asSortedCollection: [:m1 :m2 | m1 selector < m2 selector]. - self emitCHeaderForPrimitivesOn: s. - self emitCConstantsOn: s. - self emitCVariablesOn: s. - self emitCFunctionPrototypes: methodList on: s. - methodList do: [:m | m emitCCodeOn: s generator: self]. - self emitExportsOn: s. - ^ s contents - ! Item was changed: ----- Method: VMPluginCodeGenerator>>initialize (in category 'public') ----- initialize super initialize. + pluginFunctionsUsed := Set new. + inliningDone := false! - pluginFunctionsUsed := Set new! Item was changed: ----- Method: VMPluginCodeGenerator>>preDeclareInterpreterProxyOn: (in category 'C code generator') ----- preDeclareInterpreterProxyOn: aStream "Put the necessary #defines needed before interpreterProxy. Basically internal plugins use the VM's interpreterProxy variable and external plugins use their own. Override to keep local copies of all functions in external prims, and link directly in internal plugins." "| pcc | pcc := self new. (InterpreterProxy selectors reject: [:s| #(initialize private) includes: (InterpreterProxy whichCategoryIncludesSelector: s)]) do: [:s| pcc noteUsedPluginFunction: s]. pcc preDeclareInterpreterProxyOn: Transcript. Transcript flush" | pluginFuncs interpreterClass objectMemoryClass | (pluginFuncs := self pluginFunctionsToClone) isEmpty ifTrue: [^super preDeclareInterpreterProxyOn: aStream]. aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'; cr. interpreterClass := self referenceInterpreterClass. objectMemoryClass := self referenceObjectMemoryClass. pluginFuncs := pluginFuncs collect: [:selector| | reference actual | reference := self compileToTMethodSelector: selector in: ((interpreterClass whichClassIncludesSelector: selector) ifNil: [(objectMemoryClass whichClassIncludesSelector: selector) ifNil: [InterpreterProxy]]). actual := self compileToTMethodSelector: selector in: InterpreterProxy. (reference returnType ~= actual returnType or: [(1 to: reference args size) anySatisfy: [:i| (reference typeFor: (reference args at: i) in: self) ~= (actual typeFor: (actual args at: i) in: self)]]) ifTrue: [self logger nextPutAll: 'warning, signature of InterpreterProxy>>'; nextPutAll: selector; nextPutAll: ' does not match reference implementation.'; cr]. actual]. pluginFuncs do: + [:tMethod| + tMethod recordDeclarationsIn: self. + tMethod returnType ifNil: + [tMethod inferReturnTypeIn: self]]. + pluginFuncs do: [:tMethod| | functionName | functionName := self cFunctionNameFor: tMethod selector. aStream nextPutAll: ((String streamContents: [:s| tMethod static: true; emitCFunctionPrototype: s generator: self]) copyReplaceAll: functionName with: '(*', functionName, ')' tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]]). aStream nextPut: $;; cr]. aStream nextPutAll: '#else /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'. pluginFuncs do: [:tMethod| self withOptionalVerbiageFor: tMethod selector on: aStream do: [aStream cr; nextPutAll: 'extern '. tMethod static: false; export: false; emitCFunctionPrototype: aStream generator: self. aStream nextPut: $;] ifOptionalDo: [aStream cr; nextPutAll: '# define '. (TSendNode new setSelector: tMethod selector receiver: (TVariableNode new setName: 'interpreterProxy') arguments: (tMethod args collect: [:a| TVariableNode new setName: a])) emitCCodeAsArgumentOn: aStream level: 0 generator: self. aStream nextPutAll: ' 0']]. aStream cr; nextPutAll: 'extern'. aStream cr; nextPutAll: '#endif'; cr! Item was added: + ----- Method: VMPluginCodeGenerator>>prepareTranslatedPrimitives (in category 'C code generator') ----- + prepareTranslatedPrimitives + "Translated primitives need their prolog and epilog adding and all + sends to self that should be sends to interpreterproxy changing." + methods do: + [:meth| + meth primitive > 0 ifTrue: + [meth + preparePrimitivePrologue; + mapSendsFromSelfToInterpreterProxy: InterpreterProxy selectors]]! Item was added: + ----- Method: VMPluginCodeGenerator>>typeFor:in: (in category 'type inference') ----- + typeFor: aNode in: aTMethod + "Override to provide the type for InterpreterProxy's implicit stack variable." + aNode isVariable ifTrue: + [^(aTMethod typeFor: aNode in: self) ifNil: + [aNode name = 'stack' + ifTrue: [#'sqInt *'] + ifFalse: [#sqInt]]]. + ^super typeFor: aNode in: aTMethod!

1 0

[commit][3257] update the mvm scripts to add libasound and add CameraPlugin to the debug plugins .int list
by commits＠squeakvm.org 18 Feb '15

18 Feb '15

Revision: 3257 Author: rowledge Date: 2015-02-17 16:00:19 -0800 (Tue, 17 Feb 2015) Log Message: ----------- update the mvm scripts to add libasound and add CameraPlugin to the debug plugins.int list Modified Paths: -------------- branches/Cog/build.linux32ARM/squeak.stack.v3/build/mvm branches/Cog/build.linux32ARM/squeak.stack.v3/build.assert/mvm branches/Cog/build.linux32ARM/squeak.stack.v3/build.debug/mvm branches/Cog/build.linux32ARM/squeak.stack.v3/build.debug/plugins.int Modified: branches/Cog/build.linux32ARM/squeak.stack.v3/build/mvm =================================================================== --- branches/Cog/build.linux32ARM/squeak.stack.v3/build/mvm 2015-02-14 02:19:04 UTC (rev 3256) +++ branches/Cog/build.linux32ARM/squeak.stack.v3/build/mvm 2015-02-18 00:00:19 UTC (rev 3257) @@ -23,10 +23,10 @@ CC="gcc " \ CXX="g++ " \ CFLAGS="$OPT -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DI_REALLY_DONT_CARE_HOW_UNSAFE_THIS_IS" \ - LIBS="-lpthread -luuid" \ + LIBS="-lpthread -luuid -lasound" \ LDFLAGS=-Wl,-z,now rm -f vm/sqUnixMain.o # nuke version info rm -rf ../../../products/$INSTALLDIR # prefer make install prefix=`readlink -f \`pwd\`/../../../products/$INSTALLDIR` # but older linux readlinks lack the -f flag and Raspbian lacks `readlinks` -make install prefix=`(cd ../../../;pwd)`/products/$INSTALLDIR 2>&1 | tee LOG +make -j4 install prefix=`(cd ../../../;pwd)`/products/$INSTALLDIR 2>&1 | tee LOG Modified: branches/Cog/build.linux32ARM/squeak.stack.v3/build.assert/mvm =================================================================== --- branches/Cog/build.linux32ARM/squeak.stack.v3/build.assert/mvm 2015-02-14 02:19:04 UTC (rev 3256) +++ branches/Cog/build.linux32ARM/squeak.stack.v3/build.assert/mvm 2015-02-18 00:00:19 UTC (rev 3257) @@ -19,7 +19,7 @@ CC="gcc " \ CXX="g++ " \ CFLAGS="$OPT -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DI_REALLY_DONT_CARE_HOW_UNSAFE_THIS_IS" \ - LIBS="-lpthread -luuid" \ + LIBS="-lpthread -luuid -lasound" \ LDFLAGS=-Wl,-z,now rm -f vm/sqUnixMain.o # nuke version info rm -rf ../../../products/$INSTALLDIR Modified: branches/Cog/build.linux32ARM/squeak.stack.v3/build.debug/mvm =================================================================== --- branches/Cog/build.linux32ARM/squeak.stack.v3/build.debug/mvm 2015-02-14 02:19:04 UTC (rev 3256) +++ branches/Cog/build.linux32ARM/squeak.stack.v3/build.debug/mvm 2015-02-18 00:00:19 UTC (rev 3257) @@ -19,10 +19,10 @@ CC="gcc " \ CXX="g++ " \ CFLAGS="$OPT -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DI_REALLY_DONT_CARE_HOW_UNSAFE_THIS_IS" \ - LIBS="-lpthread -luuid" \ + LIBS="-lpthread -luuid -lasound" \ LDFLAGS=-Wl,-z,now rm -f vm/sqUnixMain.o # nuke version info rm -rf ../../../products/$INSTALLDIR # prefer make install prefix=`readlink -f \`pwd\`/../../../products/$INSTALLDIR` # but older linux readlinks lack the -f flag and Raspbian lacks `readlinks` -make install prefix=`(cd ../../../;pwd)`/products/$INSTALLDIR 2>&1 | tee LOG +make -j4 install prefix=`(cd ../../../;pwd)`/products/$INSTALLDIR 2>&1 | tee LOG Modified: branches/Cog/build.linux32ARM/squeak.stack.v3/build.debug/plugins.int =================================================================== --- branches/Cog/build.linux32ARM/squeak.stack.v3/build.debug/plugins.int 2015-02-14 02:19:04 UTC (rev 3256) +++ branches/Cog/build.linux32ARM/squeak.stack.v3/build.debug/plugins.int 2015-02-18 00:00:19 UTC (rev 3257) @@ -6,7 +6,7 @@ B2DPlugin \ BitBltPlugin \ BMPReadWriterPlugin \ -CroquetPlugin \ +CameraPlugin \ ZipPlugin \ DropPlugin \ DSAPrims \ @@ -25,6 +25,7 @@ MiscPrimitivePlugin \ Mpeg3Plugin \ RePlugin \ +ScratchPlugin \ SecurityPlugin \ SerialPlugin \ SocketPlugin \

1 0

VM Maker: VMMaker.oscog-eem.1068.mcz
by commits＠source.squeak.org 16 Feb '15

16 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1068.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1068 Author: eem Time: 16 February 2015, 11:53:51.24 am UUID: 3aeb252a-64eb-45a8-a5ad-c4daf88f87b8 Ancestors: VMMaker.oscog-eem.1067 ...and add type inference support for at: rto rescue inlining in the Klatt plugin. Mark SpurSegmentManager>>initializeFromFreeChunks: as doNotGenerate to avoid a type inferrence error. =============== Diff against VMMaker.oscog-eem.1067 =============== Item was changed: ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') ----- returnTypeForSend: sendNode in: aTMethod "Answer the return type for a send. Absent sends default to #sqInt. The bitwise operators answer unsigned versions of their argument types, at least in gcc although this author can't find that in the C99 spec. If you can find this, please let me know." | sel | ^(self anyMethodNamed: (sel := sendNode selector)) ifNil: [kernelReturnTypes at: sel ifAbsent: [^sel caseOf: { [#+] -> [self typeForArithmetic: sendNode in: aTMethod]. [#-] -> [self typeForArithmetic: sendNode in: aTMethod]. [#*] -> [self typeForArithmetic: sendNode in: aTMethod]. [#/] -> [self typeForArithmetic: sendNode in: aTMethod]. + [#at:] -> [self typeForDereference: sendNode in: aTMethod]. [#bitAnd:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. [#bitOr:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. [#bitXor:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. [#asVoidPointer] -> [#'void *']. [#asVoidPointer] -> [#'void *']. [#asUnsignedInteger] -> [#usqInt]. [#asLong] -> [#long]. [#asUnsignedLong] -> [#'unsigned long']. [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:" [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:" [#cCoerce:to:] -> [sendNode args last value]. [#cCoerceSimple:to:] -> [sendNode args last value] } otherwise: [#sqInt]]] ifNotNil: [:m| m returnType ifNotNil: [:type| "map fields to #usqInt" ((type beginsWith: 'unsigned') and: [(type includes: $:) and: [type last isDigit]]) ifTrue: [#usqInt] ifFalse: [type]]]! Item was added: + ----- Method: CCodeGenerator>>typeForDereference:in: (in category 'type inference') ----- + typeForDereference: sendNode in: aTMethod + | type | + type := self typeFor: sendNode receiver in: aTMethod. + type last = $* ifTrue: + [^type allButLast withBlanksTrimmed]. + self error: 'cannot determine type'. + ^nil! Item was changed: ----- Method: SpurSegmentManager>>initializeFromFreeChunks: (in category 'simulation only') ----- initializeFromFreeChunks: freeChunks + <doNotGenerate> "For testing, create a set of segments using the freeChunks as bridges." self assert: (freeChunks allSatisfy: [:f| manager hasOverflowHeader: f]). numSegments := freeChunks size. freeChunks do: [:f| manager initSegmentBridgeWithBytes: (manager bytesInObject: f) at: (manager startOfObject: f). self assert: (manager isSegmentBridge: f)]. segments := (1 to: numSegments) collect: [:i| | bridge start size | bridge := freeChunks at: i. start := i = 1 ifTrue: [manager newSpaceLimit] ifFalse: [manager addressAfter: (freeChunks at: i - 1)]. size := bridge + manager baseHeaderSize - start. SpurSegmentInfo new segStart: start; segSize: size; yourself]. manager setEndOfMemory: segments last segLimit. segments := CArrayAccessor on: segments. freeChunks with: segments object do: [:bridge :segment| self assert: (self isValidSegmentBridge: bridge). self assert: bridge = (self bridgeFor: segment)]!

1 0

VM Maker: VMMaker.oscog-eem.1067.mcz
by commits＠source.squeak.org 16 Feb '15

16 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1067.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1067 Author: eem Time: 16 February 2015, 11:26:13.727 am UUID: a5db4c60-0a4d-4375-8e2b-9a1ece21e34c Ancestors: VMMaker.oscog-eem.1066 Back out of the wrong-headed attempt to fix the symptoms of bad inlining rather than the cause by hacking comparison generation. Insist on signedness of actual expressions matching the signedness of formals to inline an expression, otherwise assign the expression to the inlined formal. Add support for type inferrence of simple arithmetic (+,-,*,/) but *not* >> << et al, so that inlining is still done for e.g. pointer arithmetic expressions. Refactor the inlining breakpoint machinery so one can break only at the point of inline as well as only at the point of testing for inlinability. Fix a bug in TMethod>>typeFor:in: which was causing the failure to find the types of global variables. =============== Diff against VMMaker.oscog-eem.1066 =============== Item was changed: Object subclass: #CCodeGenerator + instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors logger suppressAsmLabels asmLabelCounts pools selectorTranslations optionsDictionary breakSrcInlineSelector breakDestInlineSelector breakOnInline vmMaker' - instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors logger suppressAsmLabels asmLabelCounts pools selectorTranslations optionsDictionary breakSrcInlineSelector breakDestInlineSelector vmMaker' classVariableNames: 'NoRegParmsInAssertVMs' poolDictionaries: 'VMBasicConstants' category: 'VMMaker-Translation to C'! !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0! This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter. See VMMaker for more useful info! Item was removed: - ----- Method: CCodeGenerator>>breakDestInlineSelector (in category 'accessing') ----- - breakDestInlineSelector - ^breakDestInlineSelector! Item was added: + ----- Method: CCodeGenerator>>breakOnInline: (in category 'accessing') ----- + breakOnInline: aBooleanOrNil + breakOnInline := aBooleanOrNil! Item was removed: - ----- Method: CCodeGenerator>>breakSrcInlineSelector (in category 'accessing') ----- - breakSrcInlineSelector - ^breakSrcInlineSelector! Item was changed: ----- Method: CCodeGenerator>>collectInlineList: (in category 'inlining') ----- collectInlineList: inlineFlagOrSymbol "Make a list of methods that should be inlined. If inlineFlagOrSymbol == #asSpecified only inline methods marked with <inline: true>." "Details: The method must not include any inline C, since the translator cannot currently map variable names in inlined C code. Methods to be inlined must be small or called from only one place." | selectorsOfMethodsNotToInline callsOf | self assert: (#(true false asSpecified) includes: inlineFlagOrSymbol). selectorsOfMethodsNotToInline := Set new: methods size. selectorsOfMethodsNotToInline addAll: macros keys. apiMethods ifNotNil: [selectorsOfMethodsNotToInline addAll: apiMethods keys]. methods do: [:m| m isStructAccessor ifTrue: [selectorsOfMethodsNotToInline add: m selector]]. "build dictionary to record the number of calls to each method" callsOf := Dictionary new: methods size * 2. methods keysAndValuesDo: [:s :m| (m isRealMethod and: [self shouldGenerateMethod: m]) ifTrue: [callsOf at: s put: 0]]. "For each method, scan its parse tree once or twice to: 1. determine if the method contains unrenamable C code or declarations or has a C builtin 2. determine how many nodes it has 3. increment the sender counts of the methods it calls" inlineList := Set new: methods size * 2. (methods reject: [:m| selectorsOfMethodsNotToInline includes: m selector]) do: [:m| | inlineIt hasUnrenamableCCode nodeCount | + (breakSrcInlineSelector = m selector + and: [breakOnInline isNil]) ifTrue: - breakSrcInlineSelector = m selector ifTrue: [self halt]. inlineIt := #dontCare. (translationDict includesKey: m selector) ifTrue: [hasUnrenamableCCode := true] ifFalse: [hasUnrenamableCCode := m hasUnrenamableCCode. nodeCount := 0. m parseTree nodesDo: [:node| node isSend ifTrue: [callsOf at: node selector ifPresent: [:senderCount| callsOf at: node selector put: senderCount + 1]]. nodeCount := nodeCount + 1]. inlineIt := m extractInlineDirective]. "may be true, false, or #dontCare" (hasUnrenamableCCode or: [inlineIt == false]) ifTrue: "don't inline if method has C code or contains negative inline directive" [inlineIt == true ifTrue: [logger ensureCr; nextPutAll: 'failed to inline '; nextPutAll: m selector; nextPutAll: ' as it contains unrenamable C declarations or C code'; cr; flush]. selectorsOfMethodsNotToInline add: m selector] ifFalse: [(inlineFlagOrSymbol == #asSpecified ifTrue: [inlineIt == true] ifFalse: [nodeCount < 40 or: [inlineIt == true]]) ifTrue: "inline if method has no C code and is either small or contains inline directive" [inlineList add: m selector]]]. inlineFlagOrSymbol ~~ #asSpecified ifTrue: [callsOf associationsDo: [:assoc| (assoc value = 1 and: [(selectorsOfMethodsNotToInline includes: assoc key) not]) ifTrue: [inlineList add: assoc key]]]! Item was removed: - ----- Method: CCodeGenerator>>emitSignedComparison:for:on:indent: (in category 'C translation support') ----- - emitSignedComparison: operator for: msgNode on: aStream indent: level - "Emit a signed comparison. - Make sure the receiver expression is signed if comparing against zero." - - | arg rcvrType | - ((arg := msgNode args first) isConstant - and: [arg value isInteger - and: [arg value = 0 - and: [(self typeFor: msgNode receiver in: currentMethod) - ifNil: [false] - ifNotNil: [:t| (rcvrType := t) first = $u]]]]) ifTrue: - [aStream nextPut: $(; nextPutAll: (self signedTypeForIntegralType: rcvrType); nextPut: $)]. - self emitCExpression: msgNode receiver on: aStream. - aStream space; nextPutAll: operator; space. - self emitCExpression: arg on: aStream! Item was changed: ----- Method: CCodeGenerator>>generateGreaterThan:on:indent: (in category 'C translation') ----- generateGreaterThan: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + self emitCExpression: msgNode receiver on: aStream. + aStream nextPutAll: ' > '. + self emitCExpression: msgNode args first on: aStream.! - self emitSignedComparison: #> for: msgNode on: aStream indent: level! Item was changed: ----- Method: CCodeGenerator>>generateGreaterThanOrEqual:on:indent: (in category 'C translation') ----- generateGreaterThanOrEqual: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + self emitCExpression: msgNode receiver on: aStream. + aStream nextPutAll: ' >= '. + self emitCExpression: msgNode args first on: aStream.! - self emitSignedComparison: #>= for: msgNode on: aStream indent: level! Item was changed: ----- Method: CCodeGenerator>>generateLessThan:on:indent: (in category 'C translation') ----- generateLessThan: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + self emitCExpression: msgNode receiver on: aStream. + aStream nextPutAll: ' < '. + self emitCExpression: msgNode args first on: aStream.! - self emitSignedComparison: #< for: msgNode on: aStream indent: level! Item was changed: ----- Method: CCodeGenerator>>generateLessThanOrEqual:on:indent: (in category 'C translation') ----- generateLessThanOrEqual: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + self emitCExpression: msgNode receiver on: aStream. + aStream nextPutAll: ' <= '. + self emitCExpression: msgNode args first on: aStream.! - self emitSignedComparison: #<= for: msgNode on: aStream indent: level! Item was added: + ----- Method: CCodeGenerator>>isActualType:compatibleWithFormalType: (in category 'inlining') ----- + isActualType: actualTypeOrNil compatibleWithFormalType: formalTypeOrNil + | actualType formalType | + actualType := actualTypeOrNil ifNil: [#sqInt]. + formalType := formalTypeOrNil ifNil: [#sqInt]. + ((self isIntegralCType: actualType) + and: [self isIntegralCType: formalType]) ifFalse: + [^actualType = formalType]. + "For now, insist that the signedness agrees." + ^(actualType first = $u) = (formalType first = $u) + or: [actualTypeOrNil isNil or: [formalTypeOrNil isNil]]! Item was added: + ----- Method: CCodeGenerator>>maybeBreakForInlineOf:in: (in category 'inlining') ----- + maybeBreakForInlineOf: aNode in: aTMethod + "convenient for debugging..." + (aNode isSend + and: [(breakSrcInlineSelector notNil or: [breakDestInlineSelector notNil]) + and: [(breakSrcInlineSelector ifNil: [true] ifNotNil: [:srcSel| srcSel = aNode selector]) + and: [breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = aTMethod selector + and: [breakOnInline ~~ false]]]]]) ifTrue: + [aTMethod halt: aTMethod selector, ' ', aNode selector]! Item was added: + ----- Method: CCodeGenerator>>maybeBreakForTestToInline:in: (in category 'inlining') ----- + maybeBreakForTestToInline: aNode in: aTMethod + "convenient for debugging..." + (aNode isSend + and: [(breakSrcInlineSelector notNil or: [breakDestInlineSelector notNil]) + and: [(breakSrcInlineSelector ifNil: [true] ifNotNil: [:srcSel| srcSel = aNode selector]) + and: [breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = aTMethod selector + and: [breakOnInline ~~ true]]]]]) ifTrue: + [aTMethod halt: aTMethod selector, ' ', aNode selector]! Item was changed: ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') ----- + returnTypeForSend: sendNode in: aTMethod - returnTypeForSend: aTSendNode in: aTMethod "Answer the return type for a send. Absent sends default to #sqInt. The bitwise operators answer unsigned versions of their argument types, at least in gcc although this author can't find that in the C99 spec. If you can find this, please let me know." | sel | + ^(self anyMethodNamed: (sel := sendNode selector)) - ^(self anyMethodNamed: (sel := aTSendNode selector)) ifNil: [kernelReturnTypes at: sel ifAbsent: [^sel caseOf: { + [#+] -> [self typeForArithmetic: sendNode in: aTMethod]. + [#-] -> [self typeForArithmetic: sendNode in: aTMethod]. + [#*] -> [self typeForArithmetic: sendNode in: aTMethod]. + [#/] -> [self typeForArithmetic: sendNode in: aTMethod]. + [#bitAnd:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. + [#bitOr:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. + [#bitXor:] -> [self unsignedTypeForBitwiseSend: sendNode in: aTMethod]. - [#bitAnd:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod]. - [#bitOr:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod]. - [#bitXor:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod]. [#asVoidPointer] -> [#'void *']. [#asVoidPointer] -> [#'void *']. [#asUnsignedInteger] -> [#usqInt]. [#asLong] -> [#long]. [#asUnsignedLong] -> [#'unsigned long']. [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:" [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:" + [#cCoerce:to:] -> [sendNode args last value]. + [#cCoerceSimple:to:] -> [sendNode args last value] } - [#cCoerce:to:] -> [aTSendNode args last value]. - [#cCoerceSimple:to:] -> [aTSendNode args last value] } otherwise: [#sqInt]]] ifNotNil: [:m| m returnType ifNotNil: [:type| "map fields to #usqInt" ((type beginsWith: 'unsigned') and: [(type includes: $:) and: [type last isDigit]]) ifTrue: [#usqInt] ifFalse: [type]]]! Item was added: + ----- 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 and floating point arithmetic" + (self typeFor: sendNode args first in: aTMethod) = #double ifTrue: + [^#double]. + ^self typeFor: sendNode receiver in: aTMethod! Item was changed: ----- Method: CCodeGenerator>>typeOfVariable: (in category 'C code generator') ----- + typeOfVariable: varName "<String>" + self assert: varName isString. - typeOfVariable: varName "<String>" scopeStack reverseDo: [:dict| (dict includesKey: varName) ifTrue: [^self extractTypeFor: varName fromDeclaration: (dict at: varName)]]. ^self extractTypeFor: varName fromDeclaration: (variableDeclarations at: varName ifAbsent: [^nil])! Item was changed: ----- Method: TMethod>>inlineGuardingConditional:in: (in category 'inlining') ----- inlineGuardingConditional: aSendNode in: aCodeGen "Inline aSend ifTrue:/ifFalse: [statements] where aSend is inlineable and always answers booleans. We convert the boolean returns in aSend to jumps." | evaluateIfTrue replacementTree map lastNode evaluateLabel skipLabel method | self assert: self == aCodeGen currentMethod. self assert: (self isInlineableConditional: aSendNode in: aCodeGen). + aCodeGen maybeBreakForInlineOf: aSendNode in: self. - self maybeBreakFor: aSendNode receiver in: aCodeGen. evaluateIfTrue := aSendNode selector = #ifTrue:. method := (aCodeGen methodNamed: aSendNode receiver selector) copy. replacementTree := method inlineFunctionCall: aSendNode receiver in: aCodeGen. map := Dictionary new. (replacementTree statements last isReturn and: [replacementTree statements last expression value = evaluateIfTrue]) ifTrue: [lastNode := replacementTree statements last]. skipLabel := TLabeledCommentNode new setLabel: (self unusedLabelForInlining: method). replacementTree nodesDo: [:node| | expr | node isReturn ifTrue: [expr := node expression. self assert: (expr isConstant and: [#(true false) includes: expr value]). map at: node put: (expr value ~~ evaluateIfTrue ifTrue: [TGoToNode new setLabel: skipLabel label] ifFalse: [node == lastNode ifTrue: [TLabeledCommentNode new setComment: 'end ', aSendNode receiver selector, '; fall through'] ifFalse: [evaluateLabel ifNil: [evaluateLabel := TLabeledCommentNode new setLabel: (self unusedLabelForInlining: method)]. TGoToNode new setLabel: evaluateLabel label]])]]. replacementTree replaceNodesIn: map. replacementTree comment: {'inline ', aSendNode receiver selector}. self addVarsDeclarationsAndLabelsOf: method except: method args. ^TStmtListNode new setArguments: #() statements: (evaluateLabel ifNil: [replacementTree statements, aSendNode args first statements, {skipLabel}] ifNotNil: [replacementTree statements, {evaluateLabel}, aSendNode args first statements, {skipLabel}])! Item was changed: ----- Method: TMethod>>inlineReturningConditional:in: (in category 'inlining') ----- inlineReturningConditional: aSendNode in: aCodeGen "Inline aSend ifTrue:/ifFalse: [^expr] where aSend is inlineable and always answers booleans. We inline ^expr into aSend." | returnIfTrue returnNode replacementTree map lastNode label method | self assert: self == aCodeGen currentMethod. self assert: (self isInlineableConditional: aSendNode in: aCodeGen). + aCodeGen maybeBreakForInlineOf: aSendNode receiver in: self. - self maybeBreakFor: aSendNode receiver in: aCodeGen. returnIfTrue := aSendNode selector = #ifTrue:. returnNode := aSendNode args first. method := (aCodeGen methodNamed: aSendNode receiver selector) copy. replacementTree := method inlineFunctionCall: aSendNode receiver in: aCodeGen. map := Dictionary new. (replacementTree statements last isReturn and: [replacementTree statements last expression value = returnIfTrue not]) ifTrue: [lastNode := replacementTree statements last]. replacementTree nodesDo: [:node| | expr | node isReturn ifTrue: [expr := node expression. self assert: (expr isConstant and: [#(true false) includes: expr value]). map at: node put: (expr value == returnIfTrue ifTrue: [returnNode] ifFalse: [node == lastNode ifTrue: [TLabeledCommentNode new setComment: 'end ', aSendNode receiver selector, '; fall through'] ifFalse: [label ifNil: [label := TLabeledCommentNode new setLabel: (self unusedLabelForInlining: method)]. TGoToNode new setLabel: label label]])]]. replacementTree replaceNodesIn: map. self addVarsDeclarationsAndLabelsOf: method except: method args. replacementTree comment: {'inline ', aSendNode receiver selector}. ^label ifNil: [replacementTree] ifNotNil: [TStmtListNode new setArguments: #() statements: {replacementTree. label}]! Item was changed: ----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') ----- inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen "Answer a collection of statements to replace the given send. directReturn indicates that the send is the expression in a return statement, so returns can be left in the body of the inlined method. If exitVar is nil, the value returned by the send is not used; thus, returns need not assign to the output variable. Types are propagated to as-yet-untyped variables when inlining a send that is assigned, otherwise the assignee variable type must match the return type of the inlinee. Return types are not propagated." | sel meth methArgs exitLabel inlineStmts label exitType | sel := aSendNode selector. meth := aCodeGen methodNamed: sel. methArgs := meth args. "convenient for debugging..." + aCodeGen maybeBreakForInlineOf: aSendNode in: self. - self maybeBreakFor: aSendNode in: aCodeGen. (methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue: [methArgs := methArgs allButFirst]. methArgs size = aSendNode args size ifFalse: [^nil]. methArgs with: aSendNode args do: [:formal :actual| (actual isVariable and: [(aCodeGen variableOfType: (self typeFor: formal using: aCodeGen) acceptsValueOfType: (self typeFor: actual name in: aCodeGen)) not]) ifTrue: [aCodeGen logger nextPutAll: 'type mismatch for formal ', formal, ' and actual ', actual name, ' when inlining ', sel, ' in ', selector, '. Use a cast.'; cr; flush]]. meth := meth copy. "Propagate the return type of an inlined method" (directReturn or:[exitVar notNil]) ifTrue:[ exitType := directReturn ifTrue:[returnType] ifFalse:[(self typeFor: exitVar in: aCodeGen) ifNil:[#sqInt]]. (exitType = #void or:[exitType = meth returnType]) ifFalse:[meth propagateReturnIn: aCodeGen]]. meth renameVarsForInliningInto: self except: #() in: aCodeGen. meth renameLabelsForInliningInto: self. self addVarsDeclarationsAndLabelsOf: meth except: #(). meth hasReturn ifTrue:[ directReturn ifFalse:[ exitLabel := self unusedLabelForInliningInto: self. (meth exitVar: exitVar label: exitLabel) "is label used?" ifTrue: [ labels add: exitLabel ] ifFalse: [ exitLabel := nil ]]]. (inlineStmts := OrderedCollection new: 100) add: (label := TLabeledCommentNode new setComment: 'begin ', sel); addAll: (self argAssignmentsFor: meth send: aSendNode in: aCodeGen); addAll: meth statements. "method body" (directReturn and: [meth endsWithReturn not]) ifTrue: [inlineStmts add: (TReturnNode new setExpression: (TVariableNode new setName: 'nil'))]. exitLabel ~= nil ifTrue: [inlineStmts add: (TLabeledCommentNode new setLabel: exitLabel comment: 'end ', meth selector)]. ^inlineStmts! Item was changed: ----- Method: TMethod>>inlineableFunctionCall:in: (in category 'inlining') ----- inlineableFunctionCall: aNode in: aCodeGen "Answer true if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted." + aCodeGen maybeBreakForTestToInline: aNode in: self. - self maybeBreakFor: aNode in: aCodeGen. aNode isSend ifFalse: [^false]. ^(aCodeGen methodNamed: aNode selector) ifNil: [aNode asTransformedConstantPerform ifNil: [self isInlineableConditional: aNode in: aCodeGen] ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]] ifNotNil: [:m| m ~~ self and: [m isFunctional and: [(aCodeGen mayInline: m selector) and: [aNode args allSatisfy: [ :a | self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]! Item was changed: ----- Method: TMethod>>inlineableSend:in: (in category 'inlining') ----- inlineableSend: aNode in: aCodeGen "Answer true if the given send node is a call to a method that can be inlined." | m | + aCodeGen maybeBreakForTestToInline: aNode in: self. - self maybeBreakFor: aNode in: aCodeGen. aNode isSend ifFalse: [ ^false ]. m := aCodeGen methodNamed: aNode selector. "nil if builtin or external function" ^m ~= nil and: [m ~~ self and: [m isComplete and: [aCodeGen mayInline: m selector]]]! Item was changed: ----- Method: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') ----- isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen "Answer if the given parameter node may be substituted directly into the body of the method during inlining, instead of being bound to the actual parameter variable. We allow a constant, a local variable, or a formal parameter, or simple expressions involving only these to to be directly substituted. Note that global variables cannot be subsituted into methods with possible side effects (i.e., methods that may assign to global variables) because the inlined method might depend on having the value of the global variable captured when it is passed in as an argument." | madeNonTrivialCall count constantExpression usageCount | aNode isConstant ifTrue: [^true]. aNode isVariable ifTrue: [((locals includes: aNode name) or: [(args includes: aNode name) or: [#('self' 'true' 'false' 'nil') includes: aNode name]]) ifTrue: [^true]. "We can substitute any variable provided it is only read in the method being inlined, and if it is not read after any non-trivial call (which may update the variable)." madeNonTrivialCall := false. (targetMeth isComplete and: [targetMeth parseTree noneSatisfy: [:node| (node isSend and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue: [madeNonTrivialCall := true]. (madeNonTrivialCall and: [node isVariable and: [node name = argName]]) or: [node isAssignment and: [node variable name = argName]]] unless: [:node| node isSend and: [aCodeGen isAssertSelector: node selector]]]) ifTrue: [^true]. ^targetMeth maySubstituteGlobal: aNode name in: aCodeGen]. "For now allow literal blocks to be substituted. They better be accessed only with value[:value:*] messages though!!" aNode isStmtList ifTrue: [^true]. + "Don't inline expressions unless type-compatible," + aNode isSend ifTrue: + [(aCodeGen + isActualType: (aCodeGen returnTypeForSend: aNode in: self) + compatibleWithFormalType: (self typeFor: argName in: aCodeGen)) ifFalse: + [^false]]. + count := 0. constantExpression := true. "scan expression tree; must contain only constants, builtin ops, and inlineable vars" aNode nodesDo: [:node| node isConstant ifTrue: [] ifFalse: [node isSend ifTrue: [((VMBasicConstants mostBasicConstantSelectors includes: node selector) or: [node isBuiltinOperator]) ifFalse: [^false]. count := count + 1] ifFalse: [node isVariable ifTrue: [(aCodeGen isNonArgumentImplicitReceiverVariableName: node name) ifFalse: [constantExpression := false. ((locals includes: node name) or: [(args includes: node name) or: [(#('self' 'true' 'false' 'nil') includes: node name) or: [targetMeth maySubstituteGlobal: node name in: aCodeGen]]]) ifFalse: [^false]]] ifFalse: [^false]]]]. "inline constant expressions" constantExpression ifNil: [^true]. "scan target to find usage count" usageCount := 0. targetMeth parseTree nodesDo: [:node| (node isVariable and: [node name = argName]) ifTrue: [usageCount := usageCount + 1]]. "(usageCount > 1 and: [count <= usageCount]) ifTrue: [[UsageCounts := Dictionary new. self removeClassVarName: #UsageCounts]. (UsageCounts at: usageCount ifAbsentPut: [Set new]) add: ({targetMeth. argName. aNode})]." "Now only inline expressions if they are used only once or are simple w.r.t. the usage count, and the usage count is not large; a heuristic that seems to work well enough." ^usageCount = 1 or: [usageCount <= 7 and: [count <= usageCount]]! Item was removed: - ----- Method: TMethod>>maybeBreakFor:in: (in category 'inlining') ----- - maybeBreakFor: aNode in: aCodeGen - "convenient for debugging..." - (aNode isSend - and: [(aCodeGen breakSrcInlineSelector notNil or: [aCodeGen breakDestInlineSelector notNil]) - and: [(aCodeGen breakSrcInlineSelector ifNil: [true] ifNotNil: [:srcSel| srcSel = aNode selector]) - and: [aCodeGen breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = selector]]]]) ifTrue: - [self halt: selector]! Item was changed: ----- Method: TMethod>>typeFor:in: (in category 'utilities') ----- typeFor: aVariable in: aCodeGen "Answer the type for aVariable, deferring to aCodeGen (which defers to the vmClass) if no type is found and the variable is global (not an arg or a local). Expect the cCodeGen to answer nil for variables without types. nil for typelessness is required by the type propagation logic in inlineSend:directReturn:exitVar:in:." ^(declarations at: aVariable asString ifAbsent: [((locals includes: aVariable) or: [args includes: aVariable]) ifFalse: + [aCodeGen typeOfVariable: aVariable asString]]) ifNotNil: - [aCodeGen typeOfVariable: aVariable]]) ifNotNil: [:decl| aCodeGen extractTypeFor: aVariable asString fromDeclaration: decl]!

1 0

VM Maker: VMMaker.oscog-eem.1066.mcz
by commits＠source.squeak.org 15 Feb '15

15 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1066.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1066 Author: eem Time: 15 February 2015, 1:07:25.633 pm UUID: 1ddbaab7-252c-4785-a326-3beb68f0fe08 Ancestors: VMMaker.oscog-eem.1064 Make sure that integral comparisons against zero are signed, casting the receiver as necessary. Refactor the typeOf:in: machinery to allow the TMethod and the CCodeGenerator to dance together. Change the heuristic for inlining expressions to include a maximum usage count. =============== Diff against VMMaker.oscog-eem.1064 =============== Item was added: + ----- Method: CCodeGenerator>>emitSignedComparison:for:on:indent: (in category 'C translation support') ----- + emitSignedComparison: operator for: msgNode on: aStream indent: level + "Emit a signed comparison. + Make sure the receiver expression is signed if comparing against zero." + + | arg rcvrType | + ((arg := msgNode args first) isConstant + and: [arg value isInteger + and: [arg value = 0 + and: [(self typeFor: msgNode receiver in: currentMethod) + ifNil: [false] + ifNotNil: [:t| (rcvrType := t) first = $u]]]]) ifTrue: + [aStream nextPut: $(; nextPutAll: (self signedTypeForIntegralType: rcvrType); nextPut: $)]. + self emitCExpression: msgNode receiver on: aStream. + aStream space; nextPutAll: operator; space. + self emitCExpression: arg on: aStream! Item was changed: ----- Method: CCodeGenerator>>generateGreaterThan:on:indent: (in category 'C translation') ----- generateGreaterThan: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + self emitSignedComparison: #> for: msgNode on: aStream indent: level! - self emitCExpression: msgNode receiver on: aStream. - aStream nextPutAll: ' > '. - self emitCExpression: msgNode args first on: aStream.! Item was changed: ----- Method: CCodeGenerator>>generateGreaterThanOrEqual:on:indent: (in category 'C translation') ----- generateGreaterThanOrEqual: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + self emitSignedComparison: #>= for: msgNode on: aStream indent: level! - self emitCExpression: msgNode receiver on: aStream. - aStream nextPutAll: ' >= '. - self emitCExpression: msgNode args first on: aStream.! Item was changed: ----- Method: CCodeGenerator>>generateLessThan:on:indent: (in category 'C translation') ----- generateLessThan: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + self emitSignedComparison: #< for: msgNode on: aStream indent: level! - self emitCExpression: msgNode receiver on: aStream. - aStream nextPutAll: ' < '. - self emitCExpression: msgNode args first on: aStream.! Item was changed: ----- Method: CCodeGenerator>>generateLessThanOrEqual:on:indent: (in category 'C translation') ----- generateLessThanOrEqual: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + self emitSignedComparison: #<= for: msgNode on: aStream indent: level! - self emitCExpression: msgNode receiver on: aStream. - aStream nextPutAll: ' <= '. - self emitCExpression: msgNode args first on: aStream.! Item was changed: ----- Method: CCodeGenerator>>inferTypesForImplicitlyTypedVariablesAndMethods (in category 'type inference') ----- inferTypesForImplicitlyTypedVariablesAndMethods "Infer the return tupe and the types of untyped variables. As far as variables go, for now we try only to infer variables assigned the result of #longLongAt:, but much more could be done here." "Iterate over all methods, inferring #void return types, until we reach a fixed point." | firstTime allMethods | firstTime := true. allMethods := apiMethods ifNil: [methods] ifNotNil: [(Set withAll: methods) addAll: apiMethods; yourself]. + "Make an initial pass to assign the return types of all simple mehtods that return constants." + allMethods do: + [:m| + m isReturnConstant ifTrue: + [m inferReturnTypeIn: self]]. [| changedReturnType | changedReturnType := false. allMethods do: [:m| firstTime ifTrue: [m removeFinalSelfReturnIn: self. "must preceed recordDeclarationsIn: because it may set returnType" m recordDeclarationsIn: self]. m inferTypesForImplicitlyTypedVariablesIn: self. (m inferReturnTypeIn: self) ifTrue: [changedReturnType := true]]. firstTime := false. changedReturnType] whileTrue. "Type all as-yet-untyped methods as the default" methods do: [:m| m returnType ifNil: [m returnType: (self implicitReturnTypeFor: m selector)]]! Item was removed: - ----- Method: CCodeGenerator>>returnTypeForSend: (in category 'type inference') ----- - returnTypeForSend: aTSendNode - "Answer the return type for a send. Absent sends default to #sqInt." - | sel | - ^(self anyMethodNamed: (sel := aTSendNode selector)) - ifNil: [kernelReturnTypes - at: sel - ifAbsent: - [^sel - caseOf: { - [#asVoidPointer] -> [#'void *']. - [#asUnsignedInteger] -> [#usqInt]. - [#asLong] -> [#long]. - [#asUnsignedLong] -> [#'unsigned long']. - [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:" - [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:" - [#cCoerce:to:] -> [aTSendNode args last value]. - [#cCoerceSimple:to:] -> [aTSendNode args last value] } - otherwise: [#sqInt]]] - ifNotNil: - [:m| - m returnType ifNotNil: - [:type| "map fields to #usqInt" - ((type beginsWith: 'unsigned') - and: [(type includes: $:) - and: [type last isDigit]]) - ifTrue: [#usqInt] - ifFalse: [type]]]! Item was added: + ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') ----- + returnTypeForSend: aTSendNode in: aTMethod + "Answer the return type for a send. Absent sends default to #sqInt. + The bitwise operators answer unsigned versions of their argument types, at least in gcc + although this author can't find that in the C99 spec. If you can find this, please let me know." + | sel | + ^(self anyMethodNamed: (sel := aTSendNode selector)) + ifNil: [kernelReturnTypes + at: sel + ifAbsent: + [^sel + caseOf: { + [#bitAnd:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod]. + [#bitOr:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod]. + [#bitXor:] -> [self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod]. + [#asVoidPointer] -> [#'void *']. + [#asVoidPointer] -> [#'void *']. + [#asUnsignedInteger] -> [#usqInt]. + [#asLong] -> [#long]. + [#asUnsignedLong] -> [#'unsigned long']. + [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:" + [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:" + [#cCoerce:to:] -> [aTSendNode args last value]. + [#cCoerceSimple:to:] -> [aTSendNode args last value] } + otherwise: [#sqInt]]] + ifNotNil: + [:m| + m returnType ifNotNil: + [:type| "map fields to #usqInt" + ((type beginsWith: 'unsigned') + and: [(type includes: $:) + and: [type last isDigit]]) + ifTrue: [#usqInt] + ifFalse: [type]]]! Item was added: + ----- Method: CCodeGenerator>>signedTypeForIntegralType: (in category 'type inference') ----- + signedTypeForIntegralType: aCTypeString + (aCTypeString beginsWith: 'unsigned ') ifTrue: + [^aCTypeString allButFirst: 8]. + + (aCTypeString beginsWith: 'usq') ifTrue: + [^aCTypeString allButFirst]. + + self error: 'unknown type'. + ^#long! Item was changed: ----- Method: CCodeGenerator>>sizeOfIntegralCType: (in category 'inlining') ----- sizeOfIntegralCType: anIntegralCType "<String>" "N.B. Only works for values for which isIntegralCType: answers true." | prunedCType index | + (anIntegralCType beginsWith: 'register ') ifTrue: + [^self sizeOfIntegralCType: (anIntegralCType allButFirst: 9)]. prunedCType := (anIntegralCType beginsWith: 'unsigned ') ifTrue: [(anIntegralCType allButFirst: 9) withBlanksTrimmed] ifFalse: [(anIntegralCType beginsWith: 'signed ') ifTrue: [(anIntegralCType allButFirst: 7) withBlanksTrimmed] ifFalse: [anIntegralCType]]. ^prunedCType asString caseOf: { ['sqLong'] -> [8]. ['usqLong'] -> [8]. ['sqInt'] -> [BytesPerWord]. ['usqInt'] -> [BytesPerWord]. ['int'] -> [4]. ['short'] -> [2]. ['char'] -> [1]. ['long'] -> [BytesPerWord]. ['size_t'] -> [BytesPerWord]. ['pid_t'] -> [BytesPerWord]. } otherwise: [((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned : 8'" and: [(anIntegralCType includesAnyOf: '[*]') not and: [(index := anIntegralCType indexOf: $:) > 0]]) ifTrue: [(Integer readFrom: (anIntegralCType copyFrom: index + 1 to: anIntegralCType size) withBlanksTrimmed readStream) + 7 // 8] ifFalse: [self error: 'unrecognized integral type']]! Item was added: + ----- Method: CCodeGenerator>>typeFor:in: (in category 'type inference') ----- + typeFor: aNode in: aTMethod + aNode isVariable ifTrue: + [^(aTMethod typeFor: aNode in: self) ifNil: [#sqInt]]. + aNode isSend ifTrue: + [^self returnTypeForSend: aNode in: aTMethod]. + ^#sqInt! Item was added: + ----- Method: CCodeGenerator>>unsignedTypeForBitwiseSend:in: (in category 'type inference') ----- + unsignedTypeForBitwiseSend: aTSendNode in: aTMethod + "The result of the bitwise operators in C is unsigned." + | t1 t2 type | + t1 := (self typeFor: aTSendNode receiver in: aTMethod) ifNil: [^nil]. + t2 := (self typeFor: aTSendNode args first in: aTMethod) ifNil: [^nil]. + type := (self sizeOfIntegralCType: t1) >= (self sizeOfIntegralCType: t1) + ifTrue: [t1] + ifFalse: [t2]. + ^type first = $u + ifTrue: [type] + ifFalse: + [(type beginsWith: 'sq') + ifTrue: ['u', type] + ifFalse: ['unsigned ', type]]! Item was changed: ----- Method: TMethod>>addTypesFor:to:in: (in category 'type inference') ----- addTypesFor: node to: typeSet in: aCodeGen | 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 do: [:block| self addTypesFor: block to: typeSet in: aCodeGen]]. (#(= ~= == ~~ < > <= >= anyMask: noMask:) includes: expr selector) ifTrue: [^typeSet add: #sqInt]. (#(+ - * / // \\ mod: quo: bitAnd: bitClear: bitOr: bitXor: bitShift:) includes: expr selector) ifTrue: [| types | types := Set new. self addTypesFor: expr receiver to: types in: aCodeGen. (types size = 1 and: [types anyOne last = $*]) ifTrue: "pointer arithmetic" [^typeSet add: types anyOne]. self addTypesFor: expr args first to: types in: aCodeGen. types := aCodeGen harmonizeReturnTypesIn: types. types size = 2 ifTrue: [(types includes: #double) ifTrue: [^typeSet add: #double]. (types includes: #float) ifTrue: [^typeSet add: #float]. ^self]. "don't know; leave unspecified." ^types notEmpty ifTrue: [typeSet add: types anyOne]]. + ^(aCodeGen returnTypeForSend: expr in: self) ifNotNil: - ^(aCodeGen returnTypeForSend: expr) ifNotNil: [:type| typeSet add: type]]. 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: [| val | val := expr value. val isInteger ifTrue: [typeSet add: ((val >= 0 ifTrue: [val] ifFalse: [-1 - val]) highBit <= 32 ifTrue: [#sqInt] ifFalse: [#sqLong])]. (#(nil true false) includes: val) ifTrue: [typeSet add: #sqInt]. val isFloat ifTrue: [typeSet add: #float]]! Item was changed: ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') ----- inferTypesForImplicitlyTypedVariablesIn: aCodeGen "infer types for untyped variables form assignments and arithmetic uses. This for debugging: (self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)" | explicitlyTyped effectiveNodes | explicitlyTyped := declarations keys asSet. 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: [(explicitlyTyped includes: var) not 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: [declarations at: var put: (declarations at: var) allButFirst. effectiveNodes at: var put: { declarations at: var. node }]. "if an assignment of a known send, set the variable's type to the return type of the send." (node isAssignment and: [(locals includes: (var := node variable name)) and: [(declarations includesKey: var) not and: [node expression isSend + and: [(type := aCodeGen returnTypeForSend: node expression in: self) notNil]]]]) ifTrue: - and: [(type := aCodeGen returnTypeForSend: node expression) notNil]]]]) ifTrue: [(#(sqInt void) includes: type) ifFalse: ["the $: is to map things like unsigned field : 3 to usqInt" declarations at: var put: ((type includes: $:) ifTrue: [#usqInt] ifFalse: [type]), ' ', var. effectiveNodes at: var put: { declarations at: var. node }]]]. ^effectiveNodes! Item was changed: ----- Method: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') ----- isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen "Answer if the given parameter node may be substituted directly into the body of the method during inlining, instead of being bound to the actual parameter variable. We allow a constant, a local variable, or a formal parameter, or simple expressions involving only these to to be directly substituted. Note that global variables cannot be subsituted into methods with possible side effects (i.e., methods that may assign to global variables) because the inlined method might depend on having the value of the global variable captured when it is passed in as an argument." | madeNonTrivialCall count constantExpression usageCount | aNode isConstant ifTrue: [^true]. aNode isVariable ifTrue: [((locals includes: aNode name) or: [(args includes: aNode name) or: [#('self' 'true' 'false' 'nil') includes: aNode name]]) ifTrue: [^true]. "We can substitute any variable provided it is only read in the method being inlined, and if it is not read after any non-trivial call (which may update the variable)." madeNonTrivialCall := false. (targetMeth isComplete and: [targetMeth parseTree noneSatisfy: [:node| (node isSend and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue: [madeNonTrivialCall := true]. (madeNonTrivialCall and: [node isVariable and: [node name = argName]]) or: [node isAssignment and: [node variable name = argName]]] unless: [:node| node isSend and: [aCodeGen isAssertSelector: node selector]]]) ifTrue: [^true]. ^targetMeth maySubstituteGlobal: aNode name in: aCodeGen]. "For now allow literal blocks to be substituted. They better be accessed only with value[:value:*] messages though!!" aNode isStmtList ifTrue: [^true]. count := 0. constantExpression := true. "scan expression tree; must contain only constants, builtin ops, and inlineable vars" aNode nodesDo: [:node| node isConstant ifTrue: [] ifFalse: [node isSend ifTrue: [((VMBasicConstants mostBasicConstantSelectors includes: node selector) or: [node isBuiltinOperator]) ifFalse: [^false]. count := count + 1] ifFalse: [node isVariable ifTrue: [(aCodeGen isNonArgumentImplicitReceiverVariableName: node name) ifFalse: [constantExpression := false. ((locals includes: node name) or: [(args includes: node name) or: [(#('self' 'true' 'false' 'nil') includes: node name) or: [targetMeth maySubstituteGlobal: node name in: aCodeGen]]]) ifFalse: [^false]]] ifFalse: [^false]]]]. "inline constant expressions" constantExpression ifNil: [^true]. "scan target to find usage count" usageCount := 0. targetMeth parseTree nodesDo: [:node| (node isVariable and: [node name = argName]) ifTrue: [usageCount := usageCount + 1]]. + "(usageCount > 1 and: [count <= usageCount]) ifTrue: + [[UsageCounts := Dictionary new. + self removeClassVarName: #UsageCounts]. + (UsageCounts at: usageCount ifAbsentPut: [Set new]) add: ({targetMeth. argName. aNode})]." "Now only inline expressions if they are used only once or are simple + w.r.t. the usage count, and the usage count is not large; a heuristic that seems to work well enough." + ^usageCount = 1 or: [usageCount <= 7 and: [count <= usageCount]]! - w.r.t. the usage count; a heuristic that seems to work well enough." - ^usageCount = 1 or: [count <= usageCount]! Item was added: + ----- Method: TMethod>>isReturnConstant (in category 'testing') ----- + isReturnConstant + ^parseTree statements size = 1 + and: [parseTree statements last isReturn + and: [parseTree statements last expression isLeaf]]! Item was changed: ----- Method: TMethod>>typeFor:in: (in category 'utilities') ----- typeFor: aVariable in: aCodeGen "Answer the type for aVariable, deferring to aCodeGen (which defers to the vmClass) if no type is found and the variable is global (not an arg or a local). Expect the cCodeGen to answer nil for variables without types. nil for typelessness is required by the type propagation logic in inlineSend:directReturn:exitVar:in:." ^(declarations at: aVariable asString ifAbsent: [((locals includes: aVariable) or: [args includes: aVariable]) ifFalse: [aCodeGen typeOfVariable: aVariable]]) ifNotNil: [:decl| + aCodeGen extractTypeFor: aVariable asString fromDeclaration: decl]! - aCodeGen extractTypeFor: aVariable fromDeclaration: decl]!

1 0

← Newer
1
2
3
4
5
6
7
...
11
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev February 2015