VM Maker: VMMaker.oscog-eem.1851.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-eem.1851.mcz

commits-2
 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1851.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.1851
Author: eem
Time: 28 April 2016, 10:29:51.033515 pm
UUID: a2b37448-8ea6-480e-aa07-e99d6de1744a
Ancestors: VMMaker.oscog-eem.1850

Slang:
Fix inlining in the wake of recent type inferrence/promotion changes that changed the inlining landscape sufficiently to uncover bugs.

inlineCodeOrNilForStatement:returningNodes:in: and inlineSend:directReturn:exitVar:in: must cooperate to not drop returns in statement lists, other than at the end of the statement list, in the context of returning ifs.  They must be careful not to leave returns at the end of statement lists in returning ifs.  The symptom was falure to assign the value of a converted SmallInteger when inlining positive32BitIntegerFor: into positiveMachineIntegerFor: in the 32-bit case.

Do not use cppIf: SPURVM ifTrue: ... or cppIf: MULTIPLEBYTECODESETS ifTrue: in InterpreterPrimitives and subclasses, and allow the vmClass to override VMBasicConstants so as to eliminate code at translation time that tests COGVM, COGMTVM, SPURVM  and STACKVM.  These need to be defined at compile time only in plugins; the VMs generated are soecific to the values of these constants.

Rewrite methodClassOf: to not reply on comma-separated expressions in the generated C.

In 1851 a population census is taken in the United Kingdom. The population reaches 21 million. 6.3 million live in cities of 20,000 or more in England and Wales and cities of 20,000 or more account for 35% of the total English population.  The first protected submarine telegraph cable is laid, across the English Channel. The Chilean Revolution ends after the rebel defeat at the Battle of Loncomilla.

=============== Diff against VMMaker.oscog-eem.1850 ===============

Item was changed:
  ----- Method: CCodeGenerator>>emitCConstants:on: (in category 'C code generator') -----
  emitCConstants: constList on: aStream
  "Store the global variable declarations on the given stream."
  constList isEmpty ifTrue: [^self].
  aStream cr; nextPutAll: '/*** Constants ***/'; cr.
  (self sortStrings: constList) do:
  [:varName| | node default value conditional |
  node := constants at: varName.
  node name isEmpty ifFalse:
  ["If the definition includes a C comment, take it as is, otherwise convert the value from Smalltalk to C.
   Allow the class to provide an alternative definition, either of just the value or the whole shebang."
  default := (node value isString and: [node value includesSubString: '/*'])
  ifTrue: [node value]
  ifFalse: [self cLiteralFor: node value name: varName].
  default = #undefined
  ifTrue: [aStream nextPutAll: '#undef '; nextPutAll: node name; cr]
  ifFalse:
+ [conditional := (vmClass ifNil: VMBasicConstants) defineAtCompileTime: node name.
- [conditional := VMBasicConstants defineAtCompileTime: node name.
  conditional ifTrue:
  [aStream nextPutAll: '#if !!defined('; nextPutAll: node name; nextPutAll: ') /* Allow this to be overridden on the compiler command line */'; cr].
  value := vmClass
  ifNotNil:
  [(vmClass specialValueForConstant: node name default: default)
  ifNotNil: [:specialDef| specialDef]
  ifNil: [default]]
  ifNil: [default].
  value first ~= $# ifTrue:
  [aStream nextPutAll: (conditional ifTrue: ['# define '] ifFalse: ['#define ']); nextPutAll: node name; space].
  aStream nextPutAll: value; cr.
  conditional ifTrue:
  [aStream nextPutAll: '#endif'; cr]]]].
  aStream cr!

Item was changed:
  ----- Method: CCodeGenerator>>isConstantNode:valueInto: (in category 'utilities') -----
  isConstantNode: aNode valueInto: aBlock
  "Answer if aNode evaluates to a constant, and if so, evaluate aBlock with the value of that constant."
 
  aNode isConstant ifTrue:
  [(aNode isDefine
+  and: [(vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: aNode name]) ifTrue:
-  and: [VMBasicConstants defineAtCompileTime: aNode name]) ifTrue:
  [^false].
  aBlock value: aNode value.
  ^true].
  (aNode isVariable
  and: [aNode name = #nil]) ifTrue:
  [aBlock value: nil.
  ^true].
  aNode isSend ifFalse:
  [^false].
  (self anyMethodNamed: aNode selector)
  ifNil:
  [(VMBasicConstants valueOfBasicSelector: aNode selector) ifNotNil:
  [:value|
  aBlock value: value.
  ^true]]
  ifNotNil:
  [:m|
  (m statements size = 1
  and: [m statements last isReturn]) ifTrue:
  [^self isConstantNode: m statements last expression valueInto: aBlock]].
  ^false!

Item was changed:
  ----- Method: CCodeGenerator>>nilOrBooleanConditionFor: (in category 'utilities') -----
  nilOrBooleanConditionFor: nodeOrNil
  "If nodeOrNil is one of the conditional sends for which we do translation-time dead code elimination
  (i.e. cppIf:ifTrue: et al or ifTrue: et al) and the conditional does evaluate to a translation-time
  boolean constant, answer that constant, otherwise answer nil.  Used to prune dead code,
  either for code generaton or dead variable elimination."
  generateDeadCode ifTrue: [^nil].
  nodeOrNil ifNil:
  [^nil].
  nodeOrNil isSend ifFalse:
  [^nil].
  (#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: nodeOrNil selector) ifTrue:
  [^self nilOrBooleanConstantReceiverOf: nodeOrNil receiver].
  (#(and: or:) includes: nodeOrNil selector) ifTrue:
  [^self nilOrBooleanConstantReceiverOf: nodeOrNil].
  (#(cppIf:ifTrue: cppIf:ifTrue:ifFalse:) includes: nodeOrNil selector) ifTrue:
  [(vmClass notNil
  and: [nodeOrNil args first isConstant
  and: [nodeOrNil args first value isSymbol
+ and: [((vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: nodeOrNil args first value) not
- and: [(VMBasicConstants defineAtCompileTime: nodeOrNil args first value) not
  and: [(vmClass bindingOf: nodeOrNil args first value) notNil]]]]) ifTrue:
  [self logger
  nextPutAll: 'Warning: cppIf: reference to ';
  store: nodeOrNil args first value;
  nextPutAll: ' when variable of same name exists.'; cr].
 
  ^(optionsDictionary notNil
    and: [nodeOrNil args first isConstant
    and: [#(true false) includes: (optionsDictionary at: nodeOrNil args first name ifAbsent: [nil])]]) ifTrue:
  [optionsDictionary at: nodeOrNil args first name]].
  ^nil!

Item was changed:
  ----- Method: CCodeGenerator>>optionIsTrue:in: (in category 'utilities') -----
  optionIsTrue: pragma in: aClass
  "Answer whether an option: or notOption: pragma is true in the context of aClass.
  The argument to the option: pragma is interpreted as either a Cogit class name
  or a class variable name or a variable name in VMBasicConstants."
  | key |
  key := pragma argumentAt: 1.
 
  "If the option is one to be defined at compile time we'll generate a
  conditional around its declaration and definition."
+ ((vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: key) ifTrue:
- (VMBasicConstants defineAtCompileTime: key) ifTrue:
  [^true].
 
  "If the option is the name of a subclass of Cogit, include it if it inherits from the Cogit class."
  (Smalltalk classNamed: key) ifNotNil:
  [:optionClass|
  aClass cogitClass ifNotNil:
  [:cogitClass|
  (optionClass includesBehavior: Cogit) ifTrue:
  [^cogitClass includesBehavior: optionClass]].
  aClass objectMemoryClass ifNotNil:
  [:objectMemoryClass|
  ((optionClass includesBehavior: ObjectMemory)
    or: [optionClass includesBehavior: SpurMemoryManager]) ifTrue:
  [^objectMemoryClass includesBehavior: optionClass]]].
  "Lookup options in options, class variables of the defining class, VMBasicConstants, the interpreterClass and the objectMemoryClass"
  {aClass initializationOptions.
   aClass.
   VMBasicConstants.
   aClass interpreterClass.
   aClass objectMemoryClass} do:
  [:scopeOrNil|
  scopeOrNil ifNotNil:
  [:scope|
  (scope bindingOf: key) ifNotNil:
  [:binding|
  binding value ~~ false ifTrue: [^true]]]].
  ^false!

Item was added:
+ ----- Method: Cogit class>>defineAtCompileTime: (in category 'C translation') -----
+ defineAtCompileTime: anObject
+ "Override to define at translation time those variables that need to
+ be defined at compile time only in plugins, but not in the main VM,
+ because the VM generated is specific to these varables."
+ anObject isSymbol ifFalse:
+ [^false].
+ (#(STACKVM COGVM COGMTVM SPURVM) includes: anObject) ifTrue:
+ [^false].
+ ^VMBasicConstants namesDefinedAtCompileTime includes: anObject!

Item was added:
+ ----- Method: InterpreterPrimitives class>>defineAtCompileTime: (in category 'C translation') -----
+ defineAtCompileTime: anObject
+ "Override to define at translation time those variables that need to
+ be defined at compile time only in plugins, but not in the main VM,
+ because the VM generated is specific to these varables."
+ anObject isSymbol ifFalse:
+ [^false].
+ (#(STACKVM COGVM COGMTVM SPURVM) includes: anObject) ifTrue:
+ [^false].
+ ^VMBasicConstants namesDefinedAtCompileTime includes: anObject!

Item was changed:
  ----- Method: InterpreterPrimitives>>magnitude64BitIntegerFor:neg: (in category 'primitive support') -----
  magnitude64BitIntegerFor: magnitude neg: isNegative
  "Return a Large Integer object for the given integer magnitude and sign"
  | newLargeInteger largeClass highWord sz isSmall smallVal |
  <var: 'magnitude' type: #usqLong>
  <var: 'highWord' type: #usqInt>
 
  isSmall := isNegative
  ifTrue: [magnitude <= (objectMemory maxSmallInteger + 1)]
  ifFalse: [magnitude <= objectMemory maxSmallInteger].
  isSmall ifTrue:
  [smallVal := self cCoerceSimple: magnitude to: #sqInt.
  isNegative ifTrue: [smallVal := 0 - smallVal].
  ^objectMemory integerObjectOf: smallVal].
 
  largeClass := isNegative
  ifTrue: [objectMemory classLargeNegativeInteger]
  ifFalse: [objectMemory classLargePositiveInteger].
  objectMemory wordSize = 8
  ifTrue: [sz := 8]
  ifFalse:
  [(highWord := magnitude >> 32) = 0
  ifTrue: [sz := 4]
  ifFalse:
  [sz := 5.
  (highWord := highWord >> 8) = 0 ifFalse:
  [sz := sz + 1.
  (highWord := highWord >> 8) = 0 ifFalse:
  [sz := sz + 1.
  (highWord := highWord >> 8) = 0 ifFalse: [sz := sz + 1]]]]].
  newLargeInteger := objectMemory instantiateClass: largeClass indexableSize:  sz.
+ SPURVM
- self cppIf: SPURVM
  ifTrue:
  ["Memory is eight byte aligned in SPUR, so we are sure to have room for 64bits word whatever allocated sz"
  objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped64IfBigEndian: magnitude)]
  ifFalse:
  [sz > 4
  ifTrue: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped64IfBigEndian: magnitude)]
  ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped32IfBigEndian: magnitude)]].
 
  ^newLargeInteger!

Item was changed:
  ----- Method: StackInterpreter>>fetchNextBytecode (in category 'interpreter shell') -----
  fetchNextBytecode
  "This method fetches the next instruction (bytecode). Each bytecode method is responsible for fetching the next bytecode, preferably as early as possible to allow the memory system time to process the request before the next dispatch."
 
+ MULTIPLEBYTECODESETS
- self cppIf: MULTIPLEBYTECODESETS
  ifTrue: [currentBytecode := self fetchByte + bytecodeSetSelector]
  ifFalse: [currentBytecode := self fetchByte]!

Item was changed:
  ----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in category 'primitive support') -----
  maybeInlinePositive32BitIntegerFor: integerValue
  "N.B. will *not* cause a GC.
  integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:."
  <notOption: #Spur64BitMemoryManager>
  <var: 'integerValue' type: #'unsigned int'>
  | newLargeInteger |
  self deny: objectMemory hasSixtyFourBitImmediates.
         "force coercion because slang inliner sometimes incorrectly pass a signed int without converting to unsigned"
         (self cCode: [self cCoerceSimple: integerValue to: #'unsigned int']
  inSmalltalk: [integerValue bitAnd: 1 << 32 - 1]) <= objectMemory maxSmallInteger ifTrue:
  [^objectMemory integerObjectOf: integerValue].
  newLargeInteger := objectMemory
  eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
  format: (objectMemory byteFormatForNumBytes: 4)
  numSlots: 1.
+ SPURVM
- self cppIf: SPURVM
  ifTrue:
+ ["Memory is 8 byte aligned in Spur, make sure that oversized bytes are set to zero" "eem 4/28/2016 questionable; they should never be read"
- ["Memory is 8 byte aligned in Spur, make sure that oversized bytes are set to zero"
  objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped32IfBigEndian: integerValue).
  objectMemory storeLong32: 1 ofObject: newLargeInteger withValue: 0]
  ifFalse:
  [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped32IfBigEndian: integerValue)].
  ^newLargeInteger!

Item was changed:
  ----- Method: StackInterpreter>>methodClassOf: (in category 'compiled methods') -----
  methodClassOf: methodPointer
  <api>
  "Using a read barrier here simplifies the become implementation and costs very little
  because the class index and ValueIndex of the association almost certainly share a cache line."
  | literal |
  literal := self followLiteral: (objectMemory literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
+ NewspeakVM
- ^NewspeakVM
  ifTrue:
+ [literal ~= objectMemory nilObject ifTrue:
+ [literal := objectMemory followField: ValueIndex ofObject: literal]]
- [literal = objectMemory nilObject
- ifTrue: [literal]
- ifFalse: [objectMemory followField: ValueIndex ofObject: literal]]
  ifFalse:
  [self assert: ((objectMemory isPointers: literal) and: [(objectMemory numSlotsOf: literal) > ValueIndex]).
+ literal := objectMemory followField: ValueIndex ofObject: literal].
+ ^literal!
- objectMemory followField: ValueIndex ofObject: literal]!

Item was changed:
  ----- Method: StackInterpreter>>noInlineSigned32BitIntegerFor: (in category 'primitive support') -----
  noInlineSigned32BitIntegerFor: integerValue
  "Answer a full 32 bit integer object for the given integer value."
  <notOption: #Spur64BitMemoryManager>
  | newLargeInteger magnitude largeClass |
  <inline: false>
  <var: 'magnitude' type: 'unsigned int'>
  (objectMemory isIntegerValue: integerValue) ifTrue:
  [^objectMemory integerObjectOf: integerValue].
  self deny: objectMemory hasSixtyFourBitImmediates.
  integerValue < 0
  ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
  magnitude := 0 asUnsignedInteger - integerValue]
  ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
  magnitude := integerValue].
  newLargeInteger := objectMemory
  eeInstantiateSmallClassIndex: largeClass
  format: (objectMemory byteFormatForNumBytes: 4)
  numSlots: 1.
+ SPURVM
- self cppIf: SPURVM
  ifTrue:
+ ["Memory is 8 byte aligned in Spur, make sure that oversized bytes are set to zero" "eem 4/28/2016 questionable; they should never be read"
- ["Memory is 8 byte aligned in Spur, make sure that oversized bytes are set to zero"
  objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped32IfBigEndian: magnitude).
  objectMemory storeLong32: 1 ofObject: newLargeInteger withValue: 0]
  ifFalse:
  [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped32IfBigEndian: magnitude)].
  ^newLargeInteger!

Item was changed:
  ----- Method: StackInterpreter>>signed64BitIntegerFor: (in category 'primitive support') -----
  signed64BitIntegerFor: integerValue
  <var: 'integerValue' type: #sqLong>
  "Answer a Large Integer object for the given integer value.  N.B. will *not* cause a GC."
  | newLargeInteger magnitude largeClass highWord sz |
  <inline: false>
  <var: 'magnitude' type: #usqLong>
  <var: 'highWord' type: #usqInt>
 
  integerValue < 0
  ifTrue:[ integerValue >= objectMemory minSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue asInteger].
  largeClass := ClassLargeNegativeIntegerCompactIndex.
  magnitude := 0 - (self cCoerceSimple: integerValue to: #usqLong)]
  ifFalse:[ integerValue <= objectMemory maxSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue asInteger].
  largeClass := ClassLargePositiveIntegerCompactIndex.
  magnitude := integerValue].
 
  objectMemory wordSize = 8
  ifTrue: [sz := 8]
  ifFalse: [
  (highWord := magnitude >> 32) = 0
  ifTrue: [sz := 4]
  ifFalse:
  [sz := 5.
  (highWord := highWord >> 8) = 0 ifFalse:
  [sz := sz + 1.
  (highWord := highWord >> 8) = 0 ifFalse:
  [sz := sz + 1.
  (highWord := highWord >> 8) = 0 ifFalse:
  [sz := sz + 1]]]]].
 
  newLargeInteger := objectMemory
  eeInstantiateSmallClassIndex: largeClass
  format: (objectMemory byteFormatForNumBytes: sz)
  numSlots: sz + 3 // objectMemory bytesPerOop.
+ SPURVM
- self cppIf: SPURVM
  ifTrue:
  ["Memory is eight byte aligned in SPUR, so we are sure to have room for 64bits word whatever allocated sz"
  objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped64IfBigEndian: magnitude)]
  ifFalse:
  [sz > 4
  ifTrue: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped64IfBigEndian: magnitude)]
  ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped32IfBigEndian: magnitude)]].
  ^newLargeInteger!

Item was changed:
  ----- Method: TMethod>>inlineCodeOrNilForStatement:returningNodes:in: (in category 'inlining') -----
  inlineCodeOrNilForStatement: aNode returningNodes: returningNodes in: aCodeGen
  "If the given statement node can be inlined, answer the statements that replace it. Otherwise, answer nil."
 
  | stmts |
+ (aNode isReturn
+ and: [self inlineableSend: aNode expression in: aCodeGen]) ifTrue:
+ [stmts := self inlineSend: aNode expression
+ directReturn: true exitVar: nil in: aCodeGen.
+ stmts last endsWithReturn ifFalse:
+ [stmts at: stmts size put: stmts last asReturnNode].
+ ^stmts].
+ (aNode isAssignment
+ and: [self inlineableSend: aNode expression in: aCodeGen]) ifTrue:
+ [^self inlineSend: aNode expression
+ directReturn: false exitVar: aNode variable name in: aCodeGen].
+ (aNode isSend
+ and: [self inlineableSend: aNode in: aCodeGen]) ifTrue:
+ [^self inlineSend: aNode
+ directReturn: (returningNodes includes: aNode) exitVar: nil in: aCodeGen].
- aNode isReturn ifTrue:
- [(self inlineableSend: aNode expression in: aCodeGen) ifTrue:
- [stmts := self inlineSend: aNode expression
- directReturn: true exitVar: nil in: aCodeGen.
- ^stmts]].
- (aNode isAssignment and: [aNode expression isSend])  ifTrue:
- [(self inlineableSend: aNode expression in: aCodeGen) ifTrue:
- [^self inlineSend: aNode expression
- directReturn: false exitVar: aNode variable name in: aCodeGen]].
- aNode isSend ifTrue:
- [(self inlineableSend: aNode in: aCodeGen) ifTrue:
- [^self inlineSend: aNode
- directReturn: (returningNodes includes: aNode) exitVar: nil in: aCodeGen]].
  ^nil!

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.
  (methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue:
  [methArgs := methArgs allButFirst].
  methArgs size = aSendNode args size ifFalse:
  [^nil].
  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]].
 
  "Propagate any unusual argument types to untyped argument variables"
  methArgs
  with: aSendNode args
  do: [:formal :actual|
  (meth declarationAt: formal ifAbsent: nil) ifNil:
  [(self typeFor: actual in: aCodeGen) ifNotNil:
  [:type|
  type ~= #sqInt ifTrue:
  [meth declarationAt: formal put: (type last = $* ifTrue: [type, formal] ifFalse: [type, ' ', formal])]]]].
 
  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: meth statements size + meth args size + 2)
- (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 ifTrue:
+ [meth endsWithReturn
+ ifTrue:
+ [exitVar ifNotNil: "don't remove the returns if being invoked in the context of a return"
+ [inlineStmts at: inlineStmts size put: inlineStmts last copyWithoutReturn]]
+ ifFalse:
+ [inlineStmts add:
+ (TReturnNode new setExpression: (TVariableNode new setName: 'nil'))]].
+ exitLabel ifNotNil:
- (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 size = 1 ifTrue: "Nuke empty methods; e.g. override of flushAtCache"
+ [self assert: inlineStmts first isComment.
- [self assert: inlineStmts first class == TLabeledCommentNode.
  inlineStmts removeFirst].
  ^inlineStmts!

Item was changed:
  ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') -----
  tryToInlineMethodsIn: aCodeGen
  "Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined."
 
  | stmtLists didSomething newStatements sendsToInline returningNodes |
  self definedAsMacro ifTrue:
  [complete := true.
  ^false].
  didSomething := false.
  sendsToInline := Dictionary new: 100.
  parseTree
  nodesDo:
  [:node|
  (self transformConditionalAssignment: node in: aCodeGen) ifNotNil:
  [:replacement|
  sendsToInline at: node put: replacement].
  (self inlineableFunctionCall: node in: aCodeGen) ifTrue:
  [(self inlineFunctionCall: node in: aCodeGen) ifNotNil:
  [:replacement|
  sendsToInline at: node put: replacement]]]
  unless: "Don't inline the arguments to asserts to keep the asserts readable"
  [:node|
  node isSend
  and: [node selector == #cCode:inSmalltalk:
  or: [aCodeGen isAssertSelector: node selector]]].
 
  sendsToInline isEmpty ifFalse:
  [didSomething := true.
  parseTree := parseTree replaceNodesIn: sendsToInline].
 
  didSomething ifTrue:
  [writtenToGlobalVarsCache := nil.
  ^didSomething].
 
  returningNodes := Set new.
  parseTree nodesDo:
  [:node|
  node isReturn ifTrue:
  [returningNodes add: node expression.
  node expression isConditionalSend ifTrue:
  [returningNodes addAll: (node expression args collect: [:stmtList| stmtList statements last])]]].
  stmtLists := self statementsListsForInliningIn: aCodeGen.
  stmtLists do:
  [:stmtList|
+ newStatements := OrderedCollection new: stmtList statements size.
- newStatements := OrderedCollection new: 100.
  stmtList statements do:
  [:stmt|
  (self inlineCodeOrNilForStatement: stmt returningNodes: returningNodes in: aCodeGen)
  ifNil: [newStatements addLast: stmt]
  ifNotNil: [:inlinedStmts|
  didSomething := true.
  newStatements addAllLast: inlinedStmts]].
  stmtList setStatements: newStatements asArray].
 
+ "This is a hack; forgive me. The inlining abiove tends to keep return statements in statement lists.
+ In the case of returning ifs we don't want the returns in case the returning if is generated as an expression."
+ returningNodes do:
+ [:returningNode|
+ (returningNode isConditionalSend
+  and: [returningNode args anySatisfy: [:alternativeNode| alternativeNode endsWithReturn]]) ifTrue:
+ [returningNode args withIndexDo:
+ [:alternativeNode :index|
+ alternativeNode endsWithReturn ifTrue:
+ [returningNode args at: index put: alternativeNode copyWithoutReturn]]]].
+
  didSomething ifTrue:
  [writtenToGlobalVarsCache := nil.
  ^didSomething].
 
  complete ifFalse:
  [self checkForCompleteness: stmtLists in: aCodeGen.
  complete ifTrue: [ didSomething := true ]].  "marking a method complete is progress"
  ^didSomething!

Item was added:
+ ----- Method: TParseNode>>asReturnNode (in category 'transformations') -----
+ asReturnNode
+ ^TReturnNode new
+ setExpression: self;
+ yourself!

Item was added:
+ ----- Method: TReturnNode>>asReturnNode (in category 'transformations') -----
+ asReturnNode
+ ^self!

Item was added:
+ ----- Method: TReturnNode>>copyWithoutReturn (in category 'transformations') -----
+ copyWithoutReturn
+ ^expression!

Item was added:
+ ----- Method: TSendNode>>copyWithoutReturn (in category 'transformations') -----
+ copyWithoutReturn
+ self assert: self endsWithReturn.
+ ^self class new
+ setSelector: selector
+ receiver: receiver
+ arguments: (arguments collect:
+ [:arg|
+ arg endsWithReturn
+ ifTrue: [arg copyWithoutReturn]
+ ifFalse: [arg]]);
+ yourself!

Item was added:
+ ----- Method: TStmtListNode>>asReturnNode (in category 'transformations') -----
+ asReturnNode
+ self endsWithReturn ifTrue:
+ [^self].
+ ^self class new
+ setArguments: arguments
+ statements: statements allButLast, {statements last asReturnNode};
+ yourself!

Item was added:
+ ----- Method: TStmtListNode>>copyWithoutReturn (in category 'transformations') -----
+ copyWithoutReturn
+ self assert: self endsWithReturn.
+ ^self class new
+ setArguments: arguments
+ statements: statements allButLast, {statements last copyWithoutReturn};
+ yourself!

Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.1851.mcz

timrowledge


> On 29-04-2016, at 5:31 AM, [hidden email] wrote:
>
> In 1851 a population census is taken in the United Kingdom. The population reaches 21 million. 6.3 million live in cities of 20,000 or more in England and Wales and cities of 20,000 or more account for 35% of the total English population.  The first protected submarine telegraph cable is laid, across the English Channel. The Chilean Revolution ends after the rebel defeat at the Battle of Loncomilla.

Even more interesting is the Great Exhibition of 1851; amongst other things, the Royal Commission to run it was set up without a termination clause and thus continues to exist to this day. The monies it gathered have been used to finance significant things like parts of the Imperial College and the Royal College of Art  - and indeed my attendance at both.


tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Fractured Idiom:- AMICUS PURIAE - Platonic friend