Smalltalk interchangeVersion: '1.0'! Class named: 'NativeCode' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'instructions labels constants relocations ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Code'! NativeCode classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! NativeCode method! initialize instructions _ ByteArray new. labels _ IntegerArray new. constants _ Array new. relocations _ Array new! Annotation key: 'category' value: 'initializing'! NativeCode method! instructions ^ instructions! Annotation key: 'category' value: 'accessing'! NativeCode method! labels ^ labels! Annotation key: 'category' value: 'accessing'! NativeCode method! constants ^ constants! Annotation key: 'category' value: 'accessing'! NativeCode method! relocations ^ relocations! Annotation key: 'category' value: 'accessing'! NativeCode method! instructions: aByteArray instructions _ aByteArray! Annotation key: 'category' value: 'accessing'! NativeCode method! labels: anIntegerArray labels _ anIntegerArray! Annotation key: 'category' value: 'accessing'! NativeCode method! constants: anArray constants _ anArray! Annotation key: 'category' value: 'accessing'! NativeCode method! relocations: anArray relocations _ anArray! Annotation key: 'category' value: 'accessing'! NativeCode method! relocate relocations do: [:relocation | relocation relocate: self]! Annotation key: 'category' value: 'relocating'! Class named: 'Translator' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'compilationUnit function basicBlock ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Representation'! Translator classMethod! on: aCompilationUnit ^ super new on: aCompilationUnit! Annotation key: 'category' value: 'instance creation'! Translator method! on: aCompilationUnit compilationUnit _ aCompilationUnit! Annotation key: 'category' value: 'initializing'! Translator method! compilationUnit ^ compilationUnit! Annotation key: 'category' value: 'accessing'! Translator method! function ^ function! Annotation key: 'category' value: 'accessing'! Translator method! basicBlock ^ basicBlock! Annotation key: 'category' value: 'accessing'! Translator method! translate compilationUnit functions copy do: [:currentFunction | function _ currentFunction. self beginTranslatingFunction: currentFunction. currentFunction basicBlocks copy do: [:currentBasicBlock | basicBlock _ currentBasicBlock. self beginTranslatingBasicBlock: currentBasicBlock. currentBasicBlock do: [:currentInstruction | currentInstruction translateOn: self]. self endTranslatingBasicBlock: currentBasicBlock]. self endTranslatingfunction: currentFunction]! Annotation key: 'category' value: 'translating'! Translator method! beginTranslatingFunction: aFunction self subclassResponsibility! Annotation key: 'category' value: 'translating'! Translator method! endTranslatingFunction: aFunction self subclassResponsibility! Annotation key: 'category' value: 'translating'! Translator method! beginTranslatingBasicBlock: aBasicBlock self subclassResponsibility! Annotation key: 'category' value: 'translating'! Translator method! endTranslatingBasicBlock: aBasicBlock self subclassResponsibility! Annotation key: 'category' value: 'translating'! Translator method! translateInstruction: anInstruction self subclassResponsibility! Annotation key: 'category' value: 'translating'! Translator method! translateProjection: aProjectionInstruction self translateInstruction: aProjectionInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateMerge: aMergeInstruction self translateInstruction: aMergeInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateNot: aNotInstruction self translateInstruction: aNotInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateOr: anOrInstruction self translateInstruction: anOrInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateXor: anXorInstruction self translateInstruction: anXorInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateAnd: anAndInstruction self translateInstruction: anAndInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateLogicalShiftRight: aLogicalShiftRightInstruction self translateInstruction: aLogicalShiftRightInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateLogicalShiftLeft: aLogicalShiftLeftInstruction self translateInstruction: aLocalShiftleftInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateArithmeticShiftRight: anArithmeticShiftRightInstruction self translateInstruction: anArithmeticShiftRightInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateAdd: anAddInstruction self translateInstruction: anAddInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateSubtract: aSubtractInstruction self translateInstruction: aSubtractInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateMultiply: aMultiplyInstruction self translateInstruction: aMultiplyInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateDivide: aDivideInstruction self translateInstruction: aDivideInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateRemainder: aRemainderInstruction self translateInstruction: aRemainderInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateMove: aMoveInstruction self translateInstruction: aMoveInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateTruncate: aTruncateInstruction self translateInstruction: aTruncateInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateSignExtend: aSignExtendInstruction self translateInstruction: aSignExtendInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateZeroExtend: aZeroExtendInstruction self translateInstruction: aZeroExtendInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateConvert: aConvertInstruction self translateInstruction: aConvertInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateLoad: aLoadInstruction self translateInstruction: aLoadInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateStore: aStoreInstruction self translateInstruction: aStoreInstruction! Annotation key: 'category' value: 'translating'! Translator method! translatePush: aPushInstruction self translateInstruction: aPushInstruction! Annotation key: 'category' value: 'translating'! Translator method! translatePop: aPopInstruction self translateInstruction: aPopInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateAllocate: anAllocateInstruction self translateInstruction: anAllocateInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateFree: aFreeInstruction self translateInstruction: aFreeInstruction! Annotation key: 'category' value: 'translating'! Translator method! translatePrologue: aPrologueInstruction self translateInstruction: aPrologueInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateEpilogue: anEpilogueInstruction self translateInstruction: aEpilogueInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateSpill: aSpillInstruction self translateInstruction: aSpillInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateReload: aReloadInstruction self translateInstruction: aReloadInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateClobber: aClobberInstruction self translateInstruction: aClobberInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateJump: aJumpInstruction self translateInstruction: aJumpInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateBranchEqual: aBranchEqualInstruction self translateInstruction: aBranchEqualInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateBranchNotEqual: aBranchNotEqualInstruction self translateInstruction: aBranchNotEqualInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateBranchLess: aBranchLessInstruction self translateInstruction: aBranchLessInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateBranchLessEqual: aBranchLessEqualInstruction self translateInstruction: aBranchlessEqualInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateBranchGreater: aBranchGreaterInstruction self translateInstruction: aBranchGreaterInstruction! Annotation key: 'category' value: 'translating'! Translator method! translateBranchGreaterEqual: aBranchGreaterEqualInstruction self translateInstruction: aBranchGreaterEqualInstruction! Annotation key: 'category' value: 'translating'! Class named: 'Assembler' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'instructions labels constants relocations ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Code'! Assembler classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! Assembler method! initialize instructions _ ReadWriteStream on: (ByteArray new: 512). labels _ ReadWriteStream on: (IntegerArray new: 16). constants _ ReadWriteStream on: (Array new: 16). relocations _ ReadWriteStream on: (Array new: 16)! Annotation key: 'category' value: 'initializing'! Assembler method! instructions ^ instructions! Annotation key: 'category' value: 'accessing'! Assembler method! labels ^ labels! Annotation key: 'category' value: 'accessing'! Assembler method! constants ^ constants! Annotation key: 'category' value: 'accessing'! Assembler method! relocations ^ relocations! Annotation key: 'category' value: 'accessing'! Assembler method! defineLabel labels nextPut: instructions position. ^ labels position - 1! Annotation key: 'category' value: 'assembling'! Assembler method! defineConstant: anObject constants nextPut: anObject. ^ constants position - 1! Annotation key: 'category' value: 'assembling'! Assembler method! addRelocation: aRelocation aRelocation offset: instructions position. relocations nextPut: aRelocation! Annotation key: 'category' value: 'assembling'! Class named: 'Relocation' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'offset ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Code'! Relocation method! offset ^ offset! Annotation key: 'category' value: 'accessing'! Relocation method! offset: anInteger offset _ anInteger! Annotation key: 'category' value: 'accessing'! Relocation method! relocate: aNativeCode self subclassResponsibility! Annotation key: 'category' value: 'relocating'! Relocation method! relocate: aNativeCode with: anObject self subclassResponsibility! Annotation key: 'category' value: 'relocating'! Class named: 'ConstantRelocation' superclass: 'Relocation' indexedInstanceVariables: #none instanceVariableNames: 'constant ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Code'! ConstantRelocation method! constant ^ constant! Annotation key: 'category' value: 'accessing'! ConstantRelocation method! constant: anInteger constant _ anInteger! Annotation key: 'category' value: 'accessing'! ConstantRelocation method! relocate: aNativeCode self relocate: aNativeCode with: (aNativeCode constants at: constant)! Annotation key: 'category' value: 'relocating'! Class named: 'LabelRelocation' superclass: 'Relocation' indexedInstanceVariables: #none instanceVariableNames: 'label ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Code'! LabelRelocation method! label ^ label! Annotation key: 'category' value: 'accessing'! LabelRelocation method! label: anInteger label _ anInteger! Annotation key: 'category' value: 'accessing'! LabelRelocation method! relocate: aNativeCode self relocate: aNativeCode with: (aNativeCode labels at: label)! Annotation key: 'category' value: 'relocating'! Class named: 'RelativeLabelRelocation' superclass: 'Relocation' indexedInstanceVariables: #none instanceVariableNames: 'label ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Code'! RelativeLabelRelocation method! relocate: aNativeCode self relocate: aNativeCode with: (aNativeCode labels at: label) - self offset - 1! Annotation key: 'category' value: 'relocating'! Class named: 'CompilationUnit' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'architecture globalVariables functions ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Representation'! CompilationUnit classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! CompilationUnit method! initialize globalVariables _ OrderedCollection new. functions _ OrderedCollection new! Annotation key: 'category' value: 'initializing'! CompilationUnit method! architecture ^ architecture! Annotation key: 'category' value: 'accessing'! CompilationUnit method! architecture: anArchitecture architecture _ anArchitecture! Annotation key: 'category' value: 'accessing'! CompilationUnit method! globalVariables ^ globalVariables! Annotation key: 'category' value: 'accessing'! CompilationUnit method! functions ^ functions! Annotation key: 'category' value: 'accessing'! Class named: 'Architecture' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'conditionType integerType floatType pointerType registerSet calleeSaveRegisters callerSaveRegisters inputVariables outputVariables' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Representation'! Architecture classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! Architecture method! initialize registerSet _ Set new. calleeSaveRegisters _ Set new. callerSaveRegisters _ Set new. inputVariables _ OrderedCollection new. outputVariables _ OrderedCollection new! Annotation key: 'category' value: 'initializing'! Architecture method! registerSet ^ registerSet! Annotation key: 'category' value: 'accessing'! Architecture method! calleeSaveRegisters ^ calleeSaveRegisters! Annotation key: 'category' value: 'accessing'! Architecture method! callerSaveRegisters ^ callerSaveRegisters! Annotation key: 'category' value: 'accessing'! Architecture method! inputVariables ^ inputVariables! Annotation key: 'category' value: 'accessing'! Architecture method! outputVariables ^ outputVariables! Annotation key: 'category' value: 'accessing'! Architecture method! conditionType ^ conditionType! Annotation key: 'category' value: 'accessing'! Architecture method! conditionType: aConditionStorageType conditionType _ aConditionStorageType! Annotation key: 'category' value: 'accessing'! Architecture method! integerType ^ integerType! Annotation key: 'category' value: 'accessing'! Architecture method! integerType: anIntegerStorageType integerType _ anIntegerStorageType! Annotation key: 'category' value: 'accessing'! Architecture method! floatType ^ floatType! Annotation key: 'category' value: 'accessing'! Architecture method! floatType: aFloatStorageType floatType _ aFloatStorageType! Annotation key: 'category' value: 'accessing'! Architecture method! pointerType ^ pointerType! Annotation key: 'category' value: 'accessing'! Architecture method! pointerType: aPointerStorageType pointerType _ aPointerStorageType! Annotation key: 'category' value: 'accessing'! Class named: 'Bracket' superclass: 'ListElement' indexedInstanceVariables: #none instanceVariableNames: 'source destination equivalenceClass recentSize recentClass ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Analyses'! Bracket method! source ^ source! Annotation key: 'category' value: 'accessing'! Bracket method! source: aCycleEquivalenceNode source _ aCycleEquivalenceNode! Annotation key: 'category' value: 'accessing'! Bracket method! destination ^ destination! Annotation key: 'category' value: 'accessing'! Bracket method! destination: aCycleEquivalenceNode destination _ aCycleEquivalenceNode! Annotation key: 'category' value: 'accessing'! Bracket method! equivalenceClass ^ equivalenceClass! Annotation key: 'category' value: 'accessing'! Bracket method! equivalenceClass: anInteger equivalenceClass _ anInteger! Annotation key: 'category' value: 'accessing'! Bracket method! recentSize ^ recentSize! Annotation key: 'category' value: 'accessing'! Bracket method! recentSize: anInteger recentSize _ anInteger! Annotation key: 'category' value: 'accessing'! Bracket method! recentClass ^ recentClass! Annotation key: 'category' value: 'accessing'! Bracket method! recentClass: anInteger recentClass _ anInteger! Annotation key: 'category' value: 'accessing'! Bracket method! includes: aCycleEquivalenceNode ^ source == aCycleEquivalenceNode or: [destination == aCycleEquivalenceNode]! Annotation key: 'category' value: 'testing'! Bracket method! opposite: aCycleEquivalenceNode ^ source == aCycleEquivalenceNode ifTrue: [destination] ifFalse: [source]! Annotation key: 'category' value: 'accessing'! Class named: 'CycleEquivalenceNode' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'basicBlock parent children crossEdges cappingEdges depthFirstNumber highest brackets ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Analyses'! CycleEquivalenceNode classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! CycleEquivalenceNode method! initialize children _ Set new. crossEdges _ Set new. cappingEdges _ Set new. brackets _ List new! Annotation key: 'category' value: 'initializing'! CycleEquivalenceNode method! basicBlock ^ basicBlock! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! basicBlock: aRegion basicBlock _ aRegion! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! parent ^ parent! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! parent: aCycleEquivalenceNode parent _ aCycleEquivalenceNode! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! depthFirstNumber ^ depthFirstNumber! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! depthFirstNumber: anInteger depthFirstNumber _ anInteger! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! children ^ children! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! crossEdges ^ crossEdges! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! cappingEdges ^ cappingEdges! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! brackets ^ brackets! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! highest ^ highest! Annotation key: 'category' value: 'accessing'! CycleEquivalenceNode method! highest: anInteger highest _ anInteger! Annotation key: 'category' value: 'accessing'! Class named: 'ControlDependenceAnalyzer' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'function representativeEdges depthFirstOrder equivalenceClasses controlDependence equivalentRegions ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Analyses'! ControlDependenceAnalyzer classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! ControlDependenceAnalyzer method! initialize equivalenceClasses _ 0! Annotation key: 'category' value: 'initializing'! ControlDependenceAnalyzer method! function ^ function! Annotation key: 'category' value: 'accessing'! ControlDependenceAnalyzer method! function: aFunction function _ aFunction! Annotation key: 'category' value: 'accessing'! ControlDependenceAnalyzer method! newEquivalenceClass equivalenceclasses _ equivalenceClasses + 1. ^ equivalenceClasses! Annotation key: 'category' value: 'accessing'! ControlDependenceAnalyzer method! buildNodes | entryNodes exitNodes entryNode exitNode bracket root | entryNodes _ Dictionary new. exitNodes _ Dictionary new. representativeEdges _ Dictionary new. function entry doDominatorTreeBeforeDescent: [:basicBlock | entryNode _ CycleEquivalenceNode new basicBlock: basicBlock. exitNode _ CycleEquivalenceNode new basicBlock: basicBlock. bracket _ Bracket new source: entryNode destination: exitNode. representativeEdges at: basicBlock put: bracket. entryNode children add: bracket. exitNode children add: bracket]. function entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock doPredecessors: [:predecessor | entryNode _ entryNodes at: basicBlock. exitNode _ exitNodes at: predecessor. bracket _ Bracket new source: exitNode destination: entryNode. entryNode children add: bracket. exitNode children add: bracket]]. root _ entryNodes at: function entry. exitNodes do: [:node | node children size <= 1 ifTrue: [bracket _ Bracket new source: node destination: root. root children add: bracket. node children add: bracket]]! Annotation key: 'category' value: 'analyzing'! ControlDependenceAnalyzer method! computeDepthFirstOrder | newNode workList | depthFirstOrder _ OrderedCollection new: 2 * representativeEdges size. workList _ OrderedCollection with: (representativeEdges at: function entry) source. [workList notEmpty] whileTrue: [newNode _ workList removeLast. newNode depthFirstNumber: depthFirstOrder size + 1. depthFirstOrder addLast: newNode. newNode children do: [:edge | child _ edge opposite: newNode. child parent ifNotNil: [node crossEdges add: edge. child children remove: edge ifAbsent: []. child crossEdges add: edge] ifNil: [workList addLast: ((child opposite newNode) parent: edge)]. newNode children removeAllFoundIn: node crossEdges]]! Annotation key: 'category' value: 'analyzing'! ControlDependenceAnalyzer method! computeCycleEquivalence | child highBackEdge highChild | depthFirstOrder reverseDo: [:node | highBackEdge _ node crossEdges detectMin: [:edge | child _ edge opposite: child. node depthFirstNumber > child depthFirstNumber ifTrue: [child depthFirstNumber] ifFalse: [SmallInteger maxVal]]. highBackEdge _ highBackEdge opposite: node. highChild _ node children detectMin: [:edge | (edge opposite: node) highest]. hichChild _ highChild opposite: node. node highest: (highBackEdge depthFirstNumber min: highChild depthFirstNumber). highChild _ node children detect: [:edge | (edge opposite: node) highest == highChild]. highChild _ highChild opposite: node. highChild _ node detectMin: [:edge | child _ edge opposite: node. child == highChild ifTrue: [SmallInteger maxVal] ifFalse: [child highest]]. hichChild _ highChild opposite: node. node children do: [:edge | node brackets concatenateFirst: (edge opposite: node) brackets]. node brackets removeAll: node cappingEdges. node crossEdges do: [:edge | child _ edge opposite: node. node depthFirstNumber >= child depthFirstNumber ifTrue: [node brackets addLast: (Bracket new source: node destination: child)] ifFalse: [node brackets remove: edge. edge equivalenceClass: self newEquivalenceClass]]. highChild depthFirstNumber < highBackEdge depthFirstNumber ifTrue: [node brackets addLast: (node crossEdges add: (highChild cappingEdges add: (Bracket new source: node destination: highChild)))]. node parent ifNotNil: [child _ node brackets last. child recentSize = node brackets size ifFalse: [child recentSize: node brackets size. child recentClass: self newEquivalenceClass]. node parent equivalenceClass: child recentClass. child resizeSize = 1 ifTrue: [child equivalenceClass: node parent equivalenceClass]]]! Annotation key: 'category' value: 'analyzing'! ControlDependenceAnalyzer method! computeControlDependence | visited representativeEdge currentBasicBlocks parents workList | children _ Dictionary new. workList _ OrderedCollection with: function entry. depthFirstOrder _ OrderedCollection new. visited_ Set new. [workList notEmpty] whileTrue: [currentBasicBlock _ workList removeLast. currentBasicBlock doSuccessors: [:successor | (visited includes: successor) ifFalse: [visited add: successor. workList addLast: successor. depthFirstOrder addLast: successor]]]. controlDependence _ IntegerArray new: equivalenceClasses. equivalentRegions _ Array new: equivalenceClasses. parents _ OrderedCollection new. currentBasicBlock _ nil. depthFirstOrder do: [:basicBlock | representativeEdge _ representativeEdges at: basicBlock. (currentBasicBlock isNil or: [(representativeEdges at: currentBasicBlock) equivalenceClass ~= representativeEdge equivalenceClass]) ifTrue: [(equivalentRegions at: representativeEdge equivalenceClass) ifNotNil: [parents notEmpty ifTrue: [currentBasicBlock _ parents removeLast] ifFalse: [currentBasicBlock _ nil]] ifFalse: [equivalentRegions at: representativeEdge equivalenceClass put: OrderedCollection new. currentBasicBlock ifNotNil: [parents notEmpty ifTrue: [controlDependence at: representativeEdge equivalenceClass put: (representativeEdges at: parents last) equivalenceClass]. parents addLast: currentBasicBlock]]]. (equivalentRegions at: representativeEdge equivalenceClass) addLast: basicBlock]! Annotation key: 'category' value: 'analyzing'! ControlDependenceAnalyzer method! computeDepths | workList region | function entry region depth: 1. workList _ OrderedCollection with: function entry region. [workList notEmpty] whileTrue: [region _ workList removeLast. region children do: [:instruction | instruction basicBlock region depth ifNil: [instruction basicBlock region depth: region depth + 1. workList addLast: instruction basicBlock region]]]! Annotation key: 'category' value: 'analyzing'! ControlDependenceAnalyzer method! buildControlDependenceRegions | region | self buildNodes. self computeDepthFirstOrder. self computeCycleEquivalence. self computeControlDependence. equivalentRegions do: [:basicBlocks | region _ Region new function: function. basicBlocks do: [:basicBlock | region addLast: basicBlock]]. self computeDepths! Annotation key: 'category' value: 'restructuring'! Class named: 'Function' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'compilationUnit entry exit localVariables inputVariables outputVariables globalVariables memoryLocations loopNest allocatedRegisters' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Representation'! Function classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! Function method! initialize localVariables _ OrderedCollection new. inputVariables _ OrderedCollection new. outputVariables _ OrderedCollection new. globalVariables _ Set new. memoryLocations _ Set new. loopNest _ OrderedCollection new! Annotation key: 'category' value: 'initializing'! Function method! compilationUnit ^ compilationUnit! Annotation key: 'category' value: 'accessing'! Function method! compilationUnit: aCompilationUnit compilationUnit _ aCompilationUnit! Annotation key: 'category' value: 'accessing'! Function method! entry ^ entry! Annotation key: 'category' value: 'accessing'! Function method! entry: aBasicBlock entry _ aBasicBlock ! Annotation key: 'category' value: 'accessing'! Function method! exit ^ exit! Annotation key: 'category' value: 'accessing'! Function method! exit: aBasicBlock exit _ aBasicBlock ! Annotation key: 'category' value: 'accessing'! Function method! localVariables ^ localVariables! Annotation key: 'category' value: 'accessing'! Function method! inputVariables ^ inputVariables! Annotation key: 'category' value: 'accessing'! Function method! outputVariables ^ outputVariables! Annotation key: 'category' value: 'accessing'! Function method! memoryLocations ^ memoryLocations! Annotation key: 'category' value: 'accessing'! Function method! loopNest ^ loopNest! Annotation key: 'category' value: 'accessing'! Function method! allocatedRegisters ^ allocatedRegisters! Annotation key: 'category' value: 'accessing'! Function method! allocatedRegisters: aSet allocatedRegisters _ aSet! Annotation key: 'category' value: 'accessing'! Function method! allocateLocalVariable: aStorageType ^ localVariables add: (LocalVariable new storageType: aStorageType)! Annotation key: 'category' value: 'accounting'! Function method! allocateMemoryLocation: aStorageType ^ memoryLocations add: (MemoryLocation new storageType: aStorageType)! Annotation key: 'category' value: 'accounting'! Function method! eliminatePartialRedundancies (PartialRedundancyEliminator new function: self) eliminatePartialRedundancies! Annotation key: 'category' value: 'partial redundancy elimination'! Function method! simplifyExpressions | substitutions newValue | substitutions _ Dictionary new: 64. entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock do: [:instruction | instruction doInputOperandsWithIndex: [:operand :index | substitutions at: operand ifPresent: [:substitute | instruction atInputOperand: index put: newValue]]. instruction maySimplify ifTrue: [newValue _ instruction simplifyExpression. instruction == newValue ifFalse: [substitutions at: instruction put: newValue]]]]! Annotation key: 'category' value: 'expression simplification'! Function method! hoistBoundsChecks | inductionVariables reusing | reusing _ ExpressionDictionary new. entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock instructions copy do: [:instruction | instruction sequence = #derived & mayHoist ifTrue: [inductionVariables _ instruction derivedFrom: Set new. (inductionVariables allSatisfy: [:inductionVariable | (inductionVariable loop canPredictInductionVariable: inductionVariable) and: [instruction postDominates: inductionVariable loop entrance basicBlock]]) ifTrue: [instruction insertDerivationBefore: instruction reusing: reusing. basicBlock remove: instruction]]]]! Annotation key: 'category' value: 'bounds check hoisting'! Function method! eliminateRedundandies | available redundant substitutions | available _ ScopedExpressionDictionary new: 64. substitutions _ Dictionary new: 64. entry doDominatorTreeBeforeDescent: [:basicBlock | available pushScope. basicBlock do: [:instruction | 1 to: instruction inputOperands do: [:index | (instruction atInputOperand: index) ifKindOf: Instruction thenDo: [:operand | (substitutions at: operand) ifPresent: [:definition | instruction atInputOperand: index put: definition]]]. instruction mayBeRedundant ifTrue: [redundant _ false. available at: instruction ifPresent: [:definition | redundant _ true. 1 to: instruction inputOperands do: [:index | (instruction atInputOperand: index) ifKindOf: Instruction thenDo: [:operand | redundant _ redundant & (operand == (definition atInputOperand: index))]]. redundant ifTrue: [basicBlock remove: instruction. substitutions at: instruction put: definition]]. redundant ifFalse: [available at: instruction put: instruction]]]] afterAscent: [:basicBlock | available popScope]! Annotation key: 'category' value: 'redundancy elimination'! Function method! eliminateDeadStores exit doPostDominatorTreeBeforeDescent: [:basicBlock | basicBlock doSuccessors: [:successor | successor anticipatableIn ifNotNil: [basicBlock anticipatableIn ifNil: [basicBlock anticipatableIn: successor anticipatableIn copy] ifNotNil: [basicBlock anticipatableIn do: [:storage | (successor anticipatableIn includes: storage) ifFalse: [basicBlock anticipatableIn remove: storage]]]]]. basicBlock anticipatableIn ifNil: [basicBlock anticipatableIn: Set new]. basicBlock reverseDo: [:instruction | instruction isUse ifTrue: [instruction doInputOperands: [:operand | basicBlock anticipatableIn remove: operand ifAbsent: []] if: [:operand | operand mayLinkDefinitionsToUse]]. instruction mayBeDead ifTrue: [(basicBlock anticipatableIn includes: instruction outputOperand) ifTrue: [basicBlock remove: instruction] ifFalse: [basicBlock anticipatableIn add: instruction outputOperand]]]]! Annotation key: 'category' value: 'dead store elimination'! Function method! removeUnusedCode | used | used _ Set new: 1024. entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock do: [:instruction | instruction mayBeUnused ifFalse: [instruction markUsedCode: used]]]. entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock do: [:instruction | (instruction mayBeUnused and: [(used includes: instruction) not]) ifTrue: [basicBlock remove: instruction]]]! Annotation key: 'category' value: 'unused code removal'! Class named: 'SSAAnalyzer' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'function ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Analyses'! SSAAnalyzer method! function ^ function! Annotation key: 'category' value: 'accessing'! SSAAnalyzer method! function: aFunction function _ aFunction! Annotation key: 'category' value: 'accessing'! SSAAnalyzer method! detectAliases | explicitAliases aliasedLocation memoryLocations | explicitAliases _ function memoryLocations copy. memoryLocations _ Dictionary new: 64. function entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock do: [:instruction | instruction mayHaveAliases ifTrue: [aliasedLocation _ instruction aliasedLocation. instruction useMemoryLocation: (memoryLocations at: aliasedLocation ifAbsentPut: [function memoryLocations add: aliasedLocation])]]]. function memoryLocations do: [:memoryLocation | function memoryLocations do: [:alias | ((memoryLocation aliases: alias) not and: [(explicitAliases includes: memoryLocation) not or: [(explicitAliases includes: alias) not]] and: [memoryLocation mayAlias: alias]) ifTrue: [memoryLocation aliases add: alias. alias aliases add: memoryLocation]]]! Annotation key: 'category' value: 'analyzing'! SSAAnalyzer method! insertAliases function memoryLocations do: [:memoryLocation | function entry addFirst: (ClobberInstruction new operands: (Array with: memoryLocation))]. function globalVariables do: [:globalVariable | function entry addFirst: (ClobberInstruction new operands: (Array with: globalVariable))]. function memoryLocations do: [:memoryLocation | function exit add: (UseInstruction new operands: (Array with: memoryLocation))]. function globalVariables do: [:globalVariable | function exit add: (UseInstruction new operands: (Array with: globalVariable))]. function entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock do: [:instruction | instruction insertAliases]]! Annotation key: 'category' value: 'restructuring'! SSAAnalyzer method! insertMergesFor: aStorage at: aBasicBlock | merge | merge _ aBasicBlock first. [(merge isKindOf: MergeInstruction) and: [(merge outputOperand == aStorage) not]] whileTrue: [merge _ merge nextElement]. (merge isKindOf: MergeInstruction) ifFalse: [aBasicBlock addFirst: (MergeInstruction new operands: ((Array new: frontier labelOperands) at: 1 put: aStorage; yourself))]! Annotation key: 'category' value: 'restructuring'! SSAAnalyzer method! insertMerges function entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock do: [:instruction | basicBlock doDominanceFrontier: [:frontier | instruction doOutputOperands: [:operand | self insertMergesFor: operand at: frontier] if: [:operand | operand mayLinkUsesToDefinition]]]]! Annotation key: 'category' value: 'restructuring'! SSAAnalyzer method! linkUsesToDefinitions | namespace index merge | namespace _ ScopedDictionary new: 64. function entry doDominatorTreeBeforeDescent: [:basicBlock | namespace pushScope. basicBlock do: [:instruction | instruction linkUsesToDefinitions: namespace]. basicBlock doSuccessors: [:successor | index _ successor indexOfPredecessor: basicBlock. merge _ successor first. [merge isKindOf: MergeInstruction] whileTrue: [merge atInputOperand: index put: (namespace at: merge outputOperand). merge _ merge nextElement]]] afterAscent: [:basicBlock | namespace popScope]! Annotation key: 'category' value: 'restructuring'! SSAAnalyzer method! repairLostCopies | namespace | namespace _ ScopedDictionary new: 64. function entry doDominatorTreeBeforeDescent: [:basicBlock | namespace pushScope. basicBlock instructions do: [:instruction | instruction doInputOperands: [:operand | namespace at: operand outputOperand ifPresent: [:definition | operand == definition ifFalse: [operand outputOperand: (self allocateLocalVariable: operand outputOperand storageType)]]] ifKindOf: Instruction. instruction doOutputOperands: [:operand | namespace at: operand put: instruction] if: [:operand | operand mayLinkUsesToDefinitions]]] afterAscent: [:basicBlock | namespace popScope]! Annotation key: 'category' value: 'restructuring'! SSAAnalyzer method! unlinkUsesFromDefinitions function entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock do: [:instruction | (instruction isKindOf: PseudoInstruction) ifTrue: [basicBlock remove: instruction] ifFalse: [instruction operands withIndexDo: [:operand :index | (operand isKindOf: Instruction) ifTrue: [instruction operands at: index put: operand outputOperand]]]]]! Annotation key: 'category' value: 'restructuring'! SSAAnalyzer method! splitCriticalEdgesFor: aBasicBlock | merge index newBasicBlock | (aBasicBlock countPredecessors > 1 or: [aBasicBlock first isKindOf: MergeInstruction]) ifFalse: [^ self]. index _ 1. aBasicBlock entrances copy do: [:entrance | merge _ aBasicBlock first. [(merge isKindOf: MergeInstruction) and: [(merge atInputOperand: index) isKindOf: Instruction] and: [merge outputOperand == (merge atInputOperand: index) outputOperand]] whileTrue: [merge _ merge nextElement]. (entrance labelOperands > 1 and: [merge isKindOf: MergeInstruction]) ifTrue: [entrance doInputOperands: [:label | aBasicBlock entrances remove: entrance ifAbsent: []. newBasicBlock _ BasicBlock new. newBasicBlock region: (Region new function: function; depth: entrance basicBlock region depth + 1). newBasicBlock region loop: ((entrance basicBlock region loop == aBasicBlock region loop or: [entrance basicBlock region loop isNil]) ifTrue: [entrance basicBlock region loop] ifFalse: [entrance basicBlock region loop parent]). newBasicBlock region loop ifNotNilDo: [:loop | loop body add: newBasicBlock]. newBasicBlock addLast: (JumpInstruction new operands: (Array with: (BasicBlockLabel new target: aBasicBlock))). label target: newBasicBlock] ifKindOf: BasicBlockLabel]]! Annotation key: 'category' value: 'restructuring'! SSAAnalyzer method! insertCopiesFor: aBasicBlock | used copies remap workList copy operand temporary merge index | used _ Set new. copies _ OrderedCollection new. remap _ Dictionary new. workList _ OrderedCollection new. aBasicBlock doSuccessors: [:successor | index _ successor indexOfPredecessor: aBasicBlock. merge _ successor first. [merge isKindOf: MergeInstruction] whileTrue: [operand _ merge atInputOperand: index. (operand isKindOf: Instruction) ifTrue: [merge outputOperand == operand outputOperand ifFalse: [used add: operand outputOperand. copies add: (Array with: merge outputOperand with: operand outputOperand)]] ifFalse: [copies add: (Array with: merge outputOperand with: operand)]. merge _ merge nextElement]]. copies do: [:nextCopy | (used includes: (nextCopy at: 1)) ifFalse: [workList add: nextCopy. copies remove: nextCopy]]. [workList notEmpty or: [copies notEmpty]] whileTrue: [[workList notEmpty] whileTrue: [copy _ workList removeLast. operand _ copy at: 2. remap at: operand ifPresent: [:newOperand | copy at: 2 put: newOperand]. aBasicBlock add: (MoveInstruction new operands: copy). (operand isKindOf: Instruction) ifTrue: [remap at: operand put: (copy at: 1). (copies detect: [:nextCopy | (nextCopy at: 1) == operand] ifNone: []) ifNotNilDo: [:nextCopy | workList add: nextCopy]]]. copies notEmpty ifTrue: [copy _ copies removeLast. workList add: copy. temporary _ function allocateLocalVariable: (copy at: 1) storageType. aBasicBlock add: (MoveInstruction new operands: (Array with: temporary with: (copy at: 1))). remap at: (copy at: 1) put: temporary]]! Annotation key: 'category' value: 'restructuring'! Class named: 'InductionVariable' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'sequence seed increment tripCount maximum ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Analyses'! InductionVariable method! sequence ^ sequence! Annotation key: 'category' value: 'accessing'! InductionVariable method! sequence: aSequenceableCollection sequence _ aSequenceableCollection! Annotation key: 'category' value: 'accessing'! InductionVariable method! increment ^ increment! Annotation key: 'category' value: 'accessing'! InductionVariable method! increment: anObject increment _ anObject! Annotation key: 'category' value: 'accessing'! InductionVariable method! seed ^ seed! Annotation key: 'category' value: 'accessing'! InductionVariable method! seed: anObject seed _ anObject! Annotation key: 'category' value: 'accessing'! InductionVariable method! tripCount ^ tripCount! Annotation key: 'category' value: 'accessing'! InductionVariable method! tripCount: anObject tripCount _ anObject! Annotation key: 'category' value: 'accessing'! InductionVariable method! maximum ^ maximum! Annotation key: 'category' value: 'accessing'! InductionVariable method! maximum: anObject maximum _ anObject! Annotation key: 'category' value: 'accessing'! InductionVariable method! loop ^ sequence first region loop! Annotation key: 'category' value: 'analyzing'! Class named: 'Loop' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'entrance exits body parent children depth inductionVariables' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Analyses'! Loop classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! Loop method! initialize exits _ Set new. body _ Set new. children _ Set new. inductionVariables _ Set new! Annotation key: 'category' value: 'initializing'! Loop method! entrance ^ entrance! Annotation key: 'category' value: 'accessing'! Loop method! entrance: aRegion entrance _ aRegion! Annotation key: 'category' value: 'accessing'! Loop method! exits ^ exits! Annotation key: 'category' value: 'accessing'! Loop method! body ^ body! Annotation key: 'category' value: 'accessing'! Loop method! parent ^ parent! Annotation key: 'category' value: 'accessing'! Loop method! parent: aLoop parent _ aLoop! Annotation key: 'category' value: 'accessing'! Loop method! children ^ children! Annotation key; 'category' value: 'accessing'! Loop method! depth ^ depth! Annotation key: 'category' value: 'accessing'! Loop method! depth: anInteger depth _ anInteger! Annotation key: 'category' value: 'accessing'! Loop method! inductionVariables ^ inductionVariables! Annotation key: 'category' value: 'accessing'! Loop method! hasPredictableExit (exits size = 1 and: [exits anyOne isPredictableExit]) ifTrue: [^ exits anyOne]. ^ nil! Annotation key: 'category' value: 'analyzing'! Loop method! canPredictInductionVariable: anInstruction self hasPredictableExit ifNotNilDo: [:predictableExit | ^ predictableExit canPredictInductionVariable: anInstruction]. ^ false! Annotation key: 'category' value: 'analyzing'! Loop method! tripCount self hasPredictableExit ifNotNilDo: [:predictableExit | ^ predictableExit tripCount]. ^ nil! Annotation key: 'category' value: 'analyzing'! Loop method! insertMaximumFor: anInductionVariable before: anInstruction self hasPredictableExit ifNotNilDo: [:predictableExit | ^ predictableExit insertMaximumFor: anInductionVariable before: anInstruction]. ^ nil! Annotation key: 'category' value: 'restructuring'! Loop method! doNestBefore: aBlock aBlock value: self. children do: [:child | child doNest: aBlock]! Annotation key: 'category' value: 'analyzing'! Loop method! doNestAfter: aBlock aBlock value: self. children do: [:child | child doNest: aBlock]. aBlock value: self! Annotation key: 'category' value: 'analyzing'! Loop method! doNest: aBlock self doNestBefore: aBlock! Annotation key: 'category' value: 'analyzing'! Loop method! computeDepth parent ifNil: [depth _ 1] ifNotNil: [depth _ parent depth + 1]. children do: [:child | child computeDepth]! Annotation key: 'category' value: 'analyzing'! Loop method! uniteEntrances | entrances newPredecessor | entrances _ 0. entrance doPredecessors: [:predecessor | (body includes: predecessor) ifFalse: [entrances _ entrances + 1]]. entrances > 1 ifFalse: [^ nil]. newPredecessor _ BasicBlock new region: entrance region. entrance region add: newPredecessor before: entrance. entrance entrances do: [:instruction | (body includes: instruction basicBlock) ifFalse: [entrance entrances remove: instruction. newPredecessor entrances add: instruction. instruction doInputOperands: [:label | label target: newPredecessor] ifKindOf: BasicBlockLabel]]. newPedecessor addLast: (JumpInstruction new operands: (Array with: (BasicBlockLabel new target: entrance))). ^ newPredecessor! Annotation key: 'category' value: 'restructuring'! Loop method! duplicate: shouldOmitExits | remappedInstructions remappedBlocks newBlock newInstruction newRegion merge | children notEmpty ifTrue: [^ self]. remappedInstructions _ Dictionary new: 64. remappedBlocks _ Dictionary new: 64. remappedBlocks at: entrance region put: entrance region. body do: [:basicBlock | remappedBlocks at: basicBlock region ifAbsentPut: [Region new function: basicBlock region function loop: self depth: basicBlock region depth]. newBlock _ BasicBlock new region: (remappedBlocks at: basicBlock region). remappedBlocks at: basicBlock put: newBlock]. body do: [:basicBlock | newBlock _ remappedBlocks at: basicBlock. basicBlock do: [:instruction | (shouldOmitExits and: [exits includes: instruction]) ifTrue: [instruction doInputOperands: [:label | (body includes: label target) ifTrue: [newInstruction _ JumpInstruction new operands: (Array with: (BasicBlockLabel new target: label target))]] ifKindOf: BasicBlockLabel] ifFalse: [newInstruction _ instruction copy. remappedInstructions at: instruction put: newInstruction. newInstruction doInputOperandsWithIndex: [:operand :position | remappedInstructions at: operand ifPresent: [:newOperand | newInstruction atInputOperand: position put: newOperand]]. newInstruction doInputOperands: [:label | remappedBlocks at: label target ifPresent: [:newTarget | basicBlock == entrance ifFalse: [label target: newTarget]]] ifKindOf: BasicBlockLabel]. newBlock addLast: newInstruction]]. entrance region doAllChildren: [:region | newRegion _ remappedBlocks at: region. region == entrance region ifFalse: [region do: [:basicBlock | newRegion addLast: (remappedBlocks at: basicBlock)]]]. entrance region do: [:basicBlock | (body includes: basicBlock) ifTrue: [entrance region add: (remappedBlocks at: basicBlock) before: entrance]]. entrance doDominatorTreeBeforeDescent: [:basicBlock | (body includes: basicBlock) ifTrue: [basicBlock doSuccessors: [:frontier | (body includes: frontier) ifFalse: [merge _ frontier first. [merge isKindOf: MergeInstruction] whileTrue: [merge doInputOperandsWithIndex: [:operand :position | remappedInstructions at: operand ifPresent: [:newOperand | merge atInputOperand: position put: newOperand]]. merge _ merge nextElement]]]] ifFalse: [basicBlock do: [:instruction | instruction doInputOperandsWithIndex: [:operand :position | remappedInstructions at: operand ifPresent: [:newOperand | instruction atInputOperand: position put: newOperand]]]]]! Annotation key: 'category' value: 'restructuring'! Loop method! unroll: anInteger | remap size unrollCount merge | children isEmpty ifFalse: [^ 0]. body do: [:basicBlock | basicBlock do: [:instruction | instruction doOutputOperands: [:memoryLocation | ^ 0] ifKindOf: MemoryLocation. size _ size + 1]]. size > anInteger ifTrue: [^ 0]. tripCount _ self tripCount. unrollCount _ anInteger // size. tripCount ifNotNil: [unrollCount > tripCount ifTrue: [unrollCount _ tripCount]]. unrollCount timesRepeat: [self duplicate: tripCount notNil] unrollCount = tripCount ifTrue: [entrance region loop: parent. entrance region do: [:basicBlock | (body includes: basicBlock) ifTrue: [entrance region remove: basicBlock]]]! Annotation key: 'category' value: 'restructuring'! Class named: 'LoopAnalyzer' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'function lowLinks stack ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Analyses'! LoopAnalyzer method! function ^ function! Annotation key: 'category' value: 'accessing'! LoopAnalyzer method! function: aFunction function _ aFunction! Annotation key: 'category' value: 'accessing'! LoopAnalyzer method! findLoopBody: aLoop from: aBasicBlock | loop | aBasicBlock region loop ifNil: [aBasicBlock region loop: aLoop]. loop _ aBasicBlock region loop. loop == aLoop ifTrue: [aLoop body add: aBasicBlock. aBasicBlock doPredecessors: [:predecessor | (aLoop body includes: predecessor) ifFalse: [self findLoopBody: aLoop from: predecessor]]] ifFalse: [loop parent ifNil: [loop parent: aLoop. aLoop body addAll: loop body. aLoop children add: loop. loop entrance doPredecessors: [:predecessor | (loop body includes: predecessor) ifFalse: [self findLoopBody: aLoop from: predecessor]]]]! Annotation key: 'category' value: 'analyzing'! LoopAnalyzer method! findLoopFrom: aRegion "NOTE: This currently only handles reducible loops." | loop | aRegion loop ifNotNil: [^ aRegion loop]. aRegion first doPredecessors: [:predecessor | predecessor region depth >= aRegion depth ifTrue: [loop ifNil: [loop _ Loop new. aRegion loop: loop. loop entrance: self. loop body add: self]. self findLoopBody: newLoop from: predecessor]]. aRegion loop body do: [:basicBlock | basicBlock doSuccessors: [:successor | (aRegion loop body includes: successor) ifFalse: [aRegion loop exits add: basicBlock last]]]! Annotation key: 'category' value: 'analyzing'! LoopAnalyzer method! findLoops function entry region doAllChildrenAfterAscent: [:region | self findLoopFrom: region]. function entry region doAllChildren: [:region | region loop ifNotNilDo: [:loop | (loop parent isNil and: [region == loop entrance]) ifTrue: [function loopNest add: loop. loop computeDepth]]]! Annotation key: 'category' value: 'analyzing'! LoopAnalyzer method! classifyTrivial: anInstruction | sequence | sequence _ #invariant. anInstruction doInputOperands: [:operand | ((operand isKindOf: InductionVariable) and: [(sequence = #unknown) not]) ifTrue: [sequence _ #derived] ifFalse: [sequence _ #(unknown derived invariant) detect: [:type | (sequence = type) | (operand sequence = type)]]]. (sequence = #derived and: [anInstruction mayDeriveInductionVariable not]) ifTrue: [sequence _ #unknown]. anInstruction sequence: sequence! Annotation key: 'category' value: 'analyzing'! LoopAnalyzer method! classifySequence: aSet | merges linear inductionVariable increment sequence | merges _ 0. linear _ true. aSet do: [:instruction | linear _ linear or: [instruction isLinearIn: aSet]. (instruction isKindOf: MergeInstruction) ifTrue: [increment _ instruction. merges _ merges + 1]]. merges = 1 & linear ifTrue: [inductionVariable _ InductionVariable new. sequence _ OrderedCollection new. [sequence notEmpty and: [sequence first isKindOf: MergeInstruction]] whileTrue: [increment _ increment detect: [:operand | aSet includes: operand]. sequence addFirst: increment]. inductionVariable sequence: sequence. inductionVariable seed: inductionVariable sequence first inductionVariableSeed. (aSet allSatisfy: [:instruction | (instruction inductionVariableIncrementIn: aSet) isKindOf: Constant]) ifTrue: [inductionVariable increment: (aSet inject: (Constant new value: 0) into: [:accumulator :instruction | instruction accumulateInductionVariableIncrementInto: accumulator])]. inductionVariable loop inductionVariables add: inductionVariable. aSet do: [:instruction | instruction sequence: inductionVariable]] ifFalse: [aSet do: [:instruction | instruction sequence: #unknown]]! Annotation key: 'category' value: 'analyzing'! LoopAnalyzer method! findInductionVariablesFrom: anInstruction | lowLink sequence | lowLink _ lowLinks size + 1. lowLinks at: anInstruction put: lowLink. stack addLast: anInstruction. anInstruction doInputOperands: [:operand | lowLink _ lowLink min: (lowLinks at: operand ifAbsent: [self findInductionVariablesFrom: operand])] ifKindOf: Instruction. (lowLinks at: instruction) = lowLink ifFalse: [^ lowLinks at: instruction put: lowLink] stack last == instruction ifTrue: [stack removeLast classifyTrivial] ifFalse: [[stack last == instruction] whileFalse: [sequence add: stack removeLast]. sequence add: stack removeLast. self classifySequence: sequence]! Annotation key: 'category' value: 'analyzing'! LoopAnalyzer method! classifyInductionVariables lowLinks _ Dictionary new. stack _ OrderedCollection new. function entry doDominatorTreeAfterAscent: [:basicBlock | basicBlock region loop notNil ifTrue: [basicBlock reverseDo: [:instruction | lowLinks at: instruction ifAbsent: [self findInductionVariablesFrom: instruction]]]]! Annotation key: 'category' value: 'analyzing'! LoopAnalyzer method! analyzeLoops self findLoops. self classifyInductionVariables! Annotation key: 'category' value: 'analyzing'! Class named: 'BasicBlock' superclass: 'List' indexedInstanceVariables: #none instanceVariableNames: 'region entrances exits liveIn liveOut locationIn locationOut freeOut anticipatableIn ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Representation'! BasicBlock method! initialize super initialize. entrances _ Set new. exits _ Set new! Annotation key: 'category' value: 'initializing'! BasicBlock method! region ^ region! Annotation key: 'category' value: 'accessing'! BasicBlock method! region: aRegion region _ aRegion! Annotation key: 'category' value: 'accessing'! BasicBlock method! entrances ^ entrances! Annotation key: 'category' value: 'accessing'! BasicBlock method! exits ^ exits! Annotation key: 'category' value: 'accessing'! BasicBlock method! liveIn ^ liveIn! Annotation key: 'category' value: 'accessing'! BasicBlock method! liveIn: aSet liveIn _ aSet! Annotation key: 'category' value: 'accessing'! BasicBlock method! liveOut ^ liveOut! Annotation key: 'category' value: 'accessing'! BasicBlock method! liveOut: aSet liveOut _ aSet! Annotation key: 'category' value: 'accessing'! BasicBlock method! locationIn ^ locationIn! Annotation key: 'category' value: 'accessing'! BasicBlock method! locationIn: aDictionary locationIn _ aDictionary! Annotation key: 'category' value: 'accessing'! BasicBlock method! locationOut ^ locationOut! Annotation key: 'category' value: 'accessing'! BasicBlock method! locationOut: aDictionary locationOut _ aDictionary! Annotation key: 'category' value: 'accessing'! BasicBlock method! freeOut ^ freeOut! Annotation key: 'category' value: 'accessing'! BasicBlock method! freeOut: aSet freeOut _ aSet! Annotation key: 'category' value: 'accessing'! BasicBlock method! anticipatableIn ^ anticipatableIn! Annotation key: 'category' value: 'accessing'! BasicBlock method! anticipatableIn: aSet anticipatableIn _ aSet! Annotation key: 'category' value: 'accessing'! BasicBlock method! add: newInstruction before: oldInstruction oldInstruction == self first ifTrue: [newInstruction index: (oldInstruction == self ifTrue: [0] ifFalse: [oldInstruction index - 16])] ifFalse: [newInstruction index: (oldInstruction == self ifTrue: [oldInstruction previousElement index + 16] ifFalse: [(oldInstruction index + oldInstruction previousElement index) / 2])]. newInstruction basicBlock: self. (newInstruction isKindOf: ExitInstruction) ifTrue: [exits add: newInstruction. newInstruction doOperands: [:label | label target entrances add: newInstruction] ifKindOf: BasicBlockLabel]. ^ super add: newInstruction before: oldInstruction! Annotation key: 'category' value: 'adding'! BasicBlock method! add: anInstruction self reverseDo: [:instruction | (instruction isKindOf: ExitInstruction) ifFalse: [^ self add: anInstruction after: instruction]]. ^ self addFirst: anInstruction! Annotation key: 'category' value: 'adding'! BasicBlock method! remove: anInstruction (anInstruction isKindOf: ExitInstruction) ifTrue: [exits remove: anInstruction. anInstruction doOperands: [:label | label target entrances remove: newInstruction ifAbsent: []] ifKindOf: BasicBlockLabel]. ^ super remove: anInstruction! Annotation key: 'category' value: 'removing'! BasicBlock method! unlink region remove: self. region loop ifNotNilDo: [:loop | (self last isKindOf: ExitInstruction) ifTrue: [region loop exits remove: self last ifAbsent: []]. loop body remove: self. loop entrance == self ifTrue: [loop parent ifNotNilDo: [:parent | parent children remove: loop]]]. exits do: [:exit | exit doInputOperands: [:label | label target entrances remove: exit ifAbsent: []. label target entrances isEmpty ifTrue: [label target unlink]] ifKindOf: BasicBlockLabel]! Annotation key: 'category' value: 'restructuring'! BasicBlock method! doSuccessors: aBlock exits do: [:exit | exit doOperands: [:label | aBlock value: label target] ifKindOf: BasicBlockLabel]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doSuccessors: visitBlock if: predicateBlock self doSuccessors: [:basicBlock | (predicateBlock value: basicBlock) ifTrue: [visitBlock value: basicBlock]]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! countSuccessors | count | count _ 0. self doSuccessors: [:successor | count _ count + 1]. ^ count! Annotation key: 'category' value: 'analyzing'! BasicBlock method! indexOfSuccessor: aBasicBlock | index | index _ 1. self doSuccessors: [:successor | (successor == aBasicBlock) ifTrue: [^ index]. index _ index + 1]. ^ nil! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doPredecessors: aBlock entrances do: [:entrance | aBlock value: entrance basicBlock]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doPredecessors: visitBlock if: predicateBlock self doPredecessors: [:basicBlock | (predicateBlock value: basicBlock) ifTrue: [visitBlock value: basicBlock]]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! countPredecessors | count | count _ 0. self doPredecessors: [:predecessor | count _ count + 1]. ^ count! Annotation key: 'category' value: 'analyzing'! BasicBlock method! indexOfPredecessor: aBasicBlock | index | index _ 1. self doPredecessors: [:predecessor | (predecessor == aBasicBlock) ifTrue: [^ index]. index _ index + 1]. ^ nil! Annotation key: 'category' value: 'analyzing'! BasicBlock method! splitBefore: anInstruction | newBasicBlock position instruction | newBasicBlock _ BasicBlock new region: self region. position _ anInstruction. [position == self] whileFalse: [instruction _ position. position _ position nextElement. self remove: instruction. newBasicBlock addLast: instruction]. self region add: newBasicBlock after: self. self region loop ifNotNilDo: [:loop | loop body add: newBasicBlock]. self addLast: (JumpInstruction new operands: (Array with: (BasicBlockLabel new target: newBasicBlock))). ^ newBasicBlock! Annotation key: 'category' value: 'restructuring'! BasicBlock method! splitAfter: anInstruction ^ self splitBefore: anInstruction nextElement! Annotation key: 'category' value: 'restructuring'! BasicBlock method! findCommonAncestorsWith: aBasicBlock thenDo: aBlock | dominator dominatee | dominator _ self. dominatee _ aBasicBlock. [dominator region depth > dominatee region depth] whileTrue: [dominator region first doPrecessors: [:predecessor | predecessor region depth < depth ifTrue: [dominator _ predecessor]]]. [dominatee region depth > dominator region depth] whileTrue: [dominatee region first doPrecessors: [:predecessor | predecessor region depth < depth ifTrue: [dominatee _ predecessor]]]. [dominator region == dominatee region] whileFalse: [dominator region first doPrecessors: [:predecessor | predecessor region depth < depth ifTrue: [dominator _ predecessor]]. dominatee region first doPrecessors: [:predecessor | predecessor region depth < depth ifTrue: [dominatee _ predecessor]]]. ^ aBlock value: dominator value: dominatee! Annotation key: 'category' value: 'analyzing'! BasicBlock method! dominates: aBasicBlock "FIX ME: Make this properly handle loop entrances." self findCommonAncestorsWith: aBasicBlock thenDo: [:dominator :dominatee | dominator region do: [:basicBlock | basicBlock == dominator ifTrue: [^ true]. basicBlock == dominatee ifFalse: [^ false]]]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! postDominates: aBasicBlock "FIX ME: Make this properly handle loop entrances." self findCommonAncestorsWith: aBasicBlock thenDo: [:postDominator :postDominatee | postDominator region reverseDo: [:basicBlock | basicBlock == postDominator ifTrue: [^ true]. basicBlock == postDominatee ifFalse: [^ false]]]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doDominanceFrontier: aBlock of: aBasicBlock | frontier | self doSuccessors: [:successor | successor region depth <= aBasicBlock region depth ifTrue: [aBlock value: successor] ifFalse: [successor doDominanceFrontier: aBlock of: aBasicBlock]]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doDominanceFrontier: aBlock self doDominanceFrontier: aBlock of: self! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doIteratedDominanceFrontier: aBlock self doDominanceFrontier: [:frontier | aBlock value: frontier. frontier doIteratedDominanceFrontier: aBlock]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doDominatorTreeBeforeDescent: descentBlock afterAscent: ascentBlock descentBlock value: self. self doSuccessors: [:successor | (successor region depth > region depth or: [successor region == region and: [(successor == self) not]]) ifTrue: [successor doDominatorTreeBeforeDescent: descentBlock afterAscent: ascentBlock]]. ascentBlock value: self! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doDominatorTreeBeforeDescent: descentBlock self doDominatorTreeBeforeDescent: descentBlock afterAscent: [:basicBlock]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doDominatorTreeAfterAscent: ascentBlock self doDominatorTreeBeforeDescent: [:basicBlock] afterAscent: ascentBlock! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doDominatorTree: aBlock self doDominatorTreeBeforeDescent: aBlock afterAscent: [:basicBlock]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doPostDominatorTreeBeforeDescent: descentBlock afterAscent: ascentBlock descentBlock value: self. self doPredecessors: [:predecessor | (predecessor region depth > region depth or: [predecessor region == region and: [(predecessor == self) not]]) ifTrue: [predecessor doPostDominatorTreeBeforeDescent: descentBlock afterAscent: ascentBlock]]. ascentBlock value: self! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doPostDominatorTreeBeforeDescent: descentBlock self doPostDominatorTreeBeforeDescent: descentBlock afterAscent: [:basicBlock]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doPostDominatorTreeAfterAscent: ascentBlock self doPostDominatorTreeBeforeDescent: [:basicBlock] afterAscent: ascentBlock! Annotation key: 'category' value: 'analyzing'! BasicBlock method! doPostDominatorTree: aBlock self doPostDominatorTreeBeforeDescent: aBlock afterAscent: [:basicBlock]! Annotation key: 'category' value: 'analyzing'! BasicBlock method! collectExpressions: expressions andDepths: depths andAssignments: assignments andMerges: merges andTests: tests self do: [:instruction | instruction mayBeRedundant ifTrue: [depths at: instruction put: ((instruction expressionDepth: depths) max: (depths at: instruction ifPresent: [:depth | depth] ifAbsent: [0])). (expressions at: instruction ifAbsentPut: [OrderedCollection new]) addLast: instruction]. (instruction isKindOf: MergeInstruction) ifTrue: [(merges at: instruction outputOperand ifAbsentPut: [OrderedCollection new]) addLast: instruction]. instruction mayBeReplaceableTest ifTrue: [instruction doInputOperands: [:operand | (tests at: operand outputOperand ifAbsentPut: [OrderedCollection new]) addLast: instruction] if: [:operand | operand mayLinkUsesToDefinitions]]. instruction isAssignment ifTrue: [instruction doOutputOperands: [:operand | (assignments at: operand ifAbsentPut: [OrderedCollection new]) addLast: instruction] if: [:operand | operand mayLinkUsesToDefinitions]]]! Annotation key: 'category' value: 'partial redundancy elimination'! Class named: 'Region' superclass: 'List' indexedInstanceVariables: #none instanceVariableNames: 'function loop depth ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Representation'! Region method! function ^ function! Annotation key: 'category' value: 'accessing'! Region method! function: aFunction function _ aFunction! Annotation key: 'category' value: 'accessing'! Region method! loop ^ loop! Annotation key: 'category' value: 'accessing'! Region method! loop: aLoop loop _ aLoop! Annotation key: 'category' value: 'accessing'! Region method! depth ^ depth! Annotation key: 'category' value: 'accessing'! Region method! depth: anInteger depth _ anInteger! Annotation key: 'category' value: 'accessing'! Region method! doChildren: aBlock self do: [:basicBlock | basicBlock doSuccessors: [:successor | successor region depth > depth ifTrue: [aBlock value: successor region]]]! Annotation key: 'category' value: 'analyzing'! Region method! detectChild: predicateBlock ifNone: failBlock self doChildren: [:child | (predicateBlock value: child) ifTrue: [^ child]]. ^ failBlock value! Annotation key: 'category' value: 'analyzing'! Region method! detectChild: aBlock ^ self detectChild: aBlock ifNone: []! Annotation key: 'category' value: 'analyzing'! Region method! parent self first doPrecessors: [:predecessor | predecessor region depth < depth ifTrue: [^ predecessor region]]. ^ nil! Annotation key: 'category' value: 'analyzing'! Region method! doAllChildrenBeforeDescent: descentBlock afterAscent: ascentBlock descentBlock value: self. self doChildren: [:child | child doAllChildrenBeforeDescent: descentBlock afterAscent: ascentBlock]. ascentBlock value: self! Annotation key: 'category' value: 'analyzing'! Region method! doAllChildrenBeforeDescent: aBlock self doAllChildrenBeforeDescent: aBlock afterAscent: [:region :instruction]! Annotation key: 'category' value: 'analyzing'! Region method! doAllChildrenAfterAscent: aBlock self doAllChildrenBeforeDescent: [:region :instruction] afterAscent: aBlock! Annotation key: 'category' value: 'analyzing'! Region method! doAllChildren: aBlock self doAllChildrenBeforeDescent: aBlock afterAscent: [:region :instruction]! Annotation key: 'category' value: 'analyzing'! Region method! doForwardDataflow: aBlock ((loop notNil and: [loop entrance == self]) ifTrue: [2] ifFalse: [1]) timesRepeat: [self do: [:basicBlock | aBlock value: basicBlock. basicBlock doSuccessors: [:successor | successor region depth > depth ifTrue: [successor region doForwardDataflow: aBlock]]]]! Annotation key: 'category' value: 'analyzing'! Region method! doBackwardDataflow: aBlock ((loop notNil and: [loop entrance == self]) ifTrue: [2] ifFalse: [1]) timesRepeat: [self reverseDo: [:basicBlock | basicBlock doSuccessors: [:successor | successor region depth > depth ifTrue: [successor region doBackwardDataflow: aBlock]]. aBlock value: basicBlock]]! Annotation key: 'category' value: 'analyzing'! Class named: 'Instruction' superclass: 'ListElement' indexedInstanceVariables: #none instanceVariableNames: 'basicBlock operands sequence index ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! Instruction classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! Instruction method! initialize sequence _ #unknown! Annotation key: 'category' value: 'initializing'! Instruction method! basicBlock ^ basicBlock! Annotation key: 'category' value: 'accessing'! Instruction method! basicBlock: aBasicBlock basicBlock _ aBasicBlock! Annotation key: 'category' value: 'accessing'! Instruction method! operands ^ operands! Annotation key: 'category' value: 'accessing'! Instruction method! operands: anArray operands _ anArray! Annotation key: 'category' value: 'accessing'! Instruction method! sequence ^ sequence! Annotation key: 'category' value: 'accessing'! Instruction method! sequence: anObject sequence _ anObject! Annotation key: 'category' value: 'accessing'! Instruction method! index ^ index! Annotation key: 'category' value: 'accessing'! Instruction method! index: aNumber index _ aNumber! Annotation key: 'category' value: 'accessing'! Instruction method! copy ^ self class new operands: operands copy! Annotation key: 'category' value: 'copying'! Instruction method! region ^ basicBlock region! Annotation key: 'category' value: 'analyzing'! Instruction method! depth ^ basicBlock region depth! Annotation key: 'category' value: 'analyzing'! Instruction method! outputOperands ^ 0! Annotation key: 'category' value: 'analyzing'! Instruction method! inputOperands ^ operands size - self outputOperands! Annotation key: 'category' value: 'analyzing'! Instruction method! doInputOperands: aBlock operands from: self outputOperands + 1 to: operands size do: aBlock! Annotation key: 'category' value: 'analyzing'! Instruction method! doInputOperandsWithIndex: aBlock 1 to: self inputOperands do: [:position | aBlock value: (self atInputOperand: position) value: position]! Annotation key: 'category' value: 'analyzing'! Instruction method! doInputOperands: valueBlock if: predicateBlock self doInputOperands: [:operand | (predicateBlock value: operand) ifTrue: [valueBlock value: operand]]! Annotation key: 'category' value: 'analyzing'! Instruction method! doInputOperands: aBlock ifKindOf: aClass self doInputOperands: [:operand | (operand isKindOf: aClass) ifTrue: [aBlock value: operand]]! Annotation key: 'category' value: 'analyzing'! Instruction method! doOutputOperands: aBlock operands from: 1 to: self outputOperands do: aBlock! Annotation key: 'category' value: 'analyzing'! Instruction method! doOutputOperandsWithIndex: aBlock 1 to: self outputOperands do: [:position | aBlock value: (self atOutputOperand: position) value: position]! Annotation key: 'category' value: 'analyzing'! Instruction method! doOutputOperands: valueBlock if: predicateBlock self doOutputOperands: [:operand | (predicateBlock value: operand) ifTrue: [valueBlock value: operand]]! Annotation key: 'category' value: 'analyzing'! Instruction method! doOutputOperands: aBlock ifKindOf: aClass self doOutputOperands: [:operand | (operand isKindOf: aClass) ifTrue: [aBlock value: operand]]! Annotation key: 'category' value: 'analyzing'! Instruction method! outputOperand ^ operands at: 1! Annotation key: 'category' value: 'accessing'! Instruction method! outputOperand: anObject operands at: 1 put: anObject! Annotation key: 'category' value: 'accessing'! Instruction method! atInputOperand: anInteger ^ operands at: self outputOperands + anInteger! Annotation key: 'category' value: 'accessing'! Instruction method! atInputOperand: anInteger put: anObject ^ operands at: self outputOperands + anInteger put: anObject! Annotation key: 'category' value: 'accessing'! Instruction method! atOutputOperand: anInteger ^ operands at: anInteger! Annotation key: 'category' value: 'accessing'! Instruction method! atOutputOperand: anInteger put: anObject ^ operands at: anInteger put: anObject! Annotation key: 'category' value: 'accessing'! Instruction method! markUsedCode: aSet self doInputOperands: [:operand | (aSet includes: operand) ifFalse: [aSet add: operand. operand markUsedCode: aSet]] ifKindOf: Instruction! Annotation key: 'category' value: 'unused code removal'! Instruction method! mayHaveAliases ^ false! Annotation key: 'category' value: 'alias analysis'! Instruction method! aliasedLocation ^ nil! Annotation key: 'category' value: 'alias analysis'! Instruction method! useMemoryLocation: aMemoryLocation ! Annotation key: 'category' value: 'alias analysis'! Instruction method! isLinearIn: aSet ^ false! Annotation key: 'category' value: 'loop analysis'! Instruction method! inductionVariableIncrementIn: aSet ^ nil! Annotation key: 'category' value: 'loop analysis'! Instruction method! inductionVariableSeed ^ nil! Annotation key: 'category' value: 'loop analysis'! Instruction method! accumulateInductionVariableIncrementInto: aConstant ^ aConstant! Annotation key: 'category' value: 'loop analysis'! Instruction method! loopInvariantFor: aLoop ^ basicBlock region loop isNil | aLoop isNil or: [(basicBlock region loop depth < aLoop depth) | (sequence = #invariant)] or: [sequence = #derived and: [(self derivedFrom: Set new) allSatisfy: [:inductionVariable | inductionVariable loop depth < aLoop depth]]]! Annotation key: 'category' value: 'loop analysis'! Instruction method! derivedFrom: aSet (sequence isKindOf: InductionVariable) ifTrue: [aSet add: inductionVariables] sequence = #derived ifTrue: [self doInputOperands: [:operand | operand derivedFrom: aSet]]. ^ aSet! Annotation key: 'category' value: 'loop analysis'! Instruction method! mayDeriveInductionVariable ^ false! Annotation key: 'category' value: 'loop analysis'! Instruction method! translateOn: aTranslator self subclassResponsibility! Annotation key: 'category' value: 'translating'! Instruction method! outputOperands self subclassResponsibility! Annotation key: 'category' value: 'analyzing'! Instruction method! inputOperands ^ self operands size - self outputOperands! Annotation key: 'category' value: 'analyzing'! Instruction method! doOutputOperands: aBlock operands from: 1 to: self outputOperands do: aBlock! Annotation key: 'category' value: 'analyzing'! Instruction method! doOutputOperands: visitBlock if: predicateBlock self doOutputOperands: [:operand | (predicateBlock value: operand) ifTrue: [visitBlock value: operand]]! Annotation key: 'category' value: 'analyzing'! Instruction method! doOutputOperands: aBlock ifKindOf: aClass self doOutputOperands: aBlock if: [:operand | operand isKindOf: aClass]! Annotation key: 'category' value: 'analyzing'! Instruction method! doInputOperands: aBlock operands from: self outputOperands + 1 to: operands size do: aBlock! Annotation key: 'category' value: 'analyzing'! Instruction method! doInputOperands: visitBlock if: predicateBlock self doInputOperands: [:operand | (predicateBlock value: operand) ifTrue: [visitBlock value: operand]]! Annotation key: 'category' value: 'analyzing'! Instruction method! doInputOperands: aBlock ifKindOf: aClass self doInputOperands: aBlock if: [:operand | operand isKindOf: aClass]! Annotation key: 'category' value: 'analyzing'! Instruction method! doOperands: aBlock operands do: aBlock! Annotation key: 'category' value: 'analyzing'! Instruction method! doOperands: visitBlock if: predicateBlock self doOperands: [:operand | (predicateBlock value: operand) ifTrue: [visitBlock value: operand]]! Annotation key: 'category' value: 'analyzing'! Instruction method! doOperands: aBlock ifKindOf: aClass self doOperands: aBlock if: [:operand | operand isKindOf: aClass]! Annotation key: 'category' value: 'analyzing'! Instruction method! dominates: anInstruction basicBlock == anInstruction basicBlock ifTrue: [^ index <= anInstruction index] ifFalse: [^ basicBlock dominates: anInstruction basicBlock]! Annotation key: 'category' value: 'analyzing'! Instruction method! postDominates: anInstruction basicBlock == anInstruction basicBlock ifTrue: [^ index >= anInstruction index] ifFalse: [^ basicBlock postDominates: anInstruction basicBlock]! Annotation key: 'category' value: 'analyzing'! Instruction method! copyPropagate ^ self! Annotation key: 'category' value: 'copy propagation'! Instruction method! maySimplify ^ false! Annotation key: 'category' value: 'expression simplification'! Instruction method! simplifyExpression ^ self! Annotation key: 'category' value: 'expression simplification'! Instruction method! linkUsesToDefinitions: aDictionary self doInputOperandsWithIndex: [:operand :position | operand mayLinkUsesToDefinitions ifTrue: [aDictionary at: operand ifPresent: [:definition | self atInputOperand: position put: definition]]]. self doOutputOperandsWithIndex: [:operand :position | operand mayLinkUsesToDefinitions ifTrue: [position = 1 ifTrue: [aDictionary at: operand put: self] ifFalse: [aDictionary at: operand put: (basicBlock add: (ProjectionInstruction new operands: (Array with: operand with: self with: (Constant new value: position))) after: self)]]]! Annotation key: 'category' value: 'SSA translation'! Instruction method! expressionHash | hash | hash _ self class hash. self doInputOperands: [:operand | hash _ (hash + operand operandHash) hashMultiply]. ^ hash! Annotation key: 'category' value: 'partial redundancy elimination'! Instruction method! expressionCompare: anInstruction self class == anInstruction class ifFalse: [^ false]. self doInputOperandsWithIndex: [:operand :position | (operand operandCompare: (anInstruction atInputOperand: position)) ifFalse: [^ false]]. ^ true! Annotation key: 'category' value: 'partial redundancy elimination'! Instruction method! operandHash ^ self outputOperand hash! Annotation key: 'category' value: 'partial redundancy elimination'! Instruction method! operandCompare: anInstruction ^ self outputOperand == anInstruction outputOperand! Annotation key: 'category' value: 'partial redundncy elimination'! Instruction method! expressionDepth: anExpressionDictionary ^ (operands detectMax: [:operand | operand expressionDepth: anExpressionDictionary]) expressionDepth + 1! Annotation key: 'category' value: 'partial redundancy elimination'! Instruction method! substituteOperands: aDictionary | substitutions | substitutions _ 0. self doInputOperandsWithIndex: [:operand :position | (operand isKindOf: Instruction) ifTrue: [aDictionary at: operand ifPresent: [:substitute | substitutions _ substitutions + 1. self atInputOperand: index put: substitute]]]. ^ substitutions! Annotation key: 'category' value: 'partial redundancy elimination'! Instruction method! isAssignment ^ outputOperands = 1! Annotation key: 'category' value: 'partial redundancy elimination'! Instruction method! isUse ^ false! Annotation key: 'category' value: 'dead store elimination'! Instruction method! mayBeDead ^ false! Annotation key: 'category' value: 'dead store elimination'! Instruction method! mayBeRedundant outputOperands = 1 ifFalse: [^ false]. self doInputOperands: [:operand | (operand isKindOf: Instruction orOf: Constant) ifFalse: [^ false]]. ^ true! Annotation key: 'category' value: 'partial redundancy elimination'! Instruction method! mayBeUnused ^ true! Annotation key: 'category' value: 'unused code removal'! Instruction method! strengthReductionCandidate ^ false! Annotation key: 'category' value: 'strength reduction'! Instruction method! isInjuredBy: anInstruction ^ false! Annotation key: 'category' value: 'strength reduction'! Instruction method! canAccumulateInjury: anInstruction ^ false! Annotation key: 'category' value: 'strength reduction'! Instruction method! repairInjury: injuryInstruction fromValue: valueInstruction in: aRedundancyGraph ^ nil! Annotation key: 'category' value: 'strength reduction'! Instruction method! accumulateInjury: injuryInstruction into: accumulatorInstruction ^ nil! Annotation key: 'category' value: 'strength reduction'! Instruction method! replaceTest: testInstruction fromValue: valueInstruction in: aRedundancyGraph ^ nil! Annotation key: 'category' value: 'linear function test replacement'! Instruction method! canReplaceTest: anInstruction ^ false! Annotation key: 'category' value: 'linear function test replacement'! Instruction method! mayBeReplaceableTest ^ false! Annotation key: 'category' value: 'linear function test replacement'! Instruction method! isPredictableExit ^ false! Annotation key: 'category' value: 'loop analysis'! Instruction method! canPredictInductionVariable: anInductionVariable ^ false! Annotation key: 'category' value: 'loop analysis'! Instruction method! tripCount ^ nil! Annotation key: 'category' value: 'loop analysis'! Instruction method! insertTripCountBefore: anInstruction ^ nil! Annotation key: 'category' value: 'loop analysis'! Instruction method! insertMaximumFor: anInductionVariable before: anInstruction ^ nil! Annotation key: 'category' value: 'loop analysis'! Instruction method! insertDerivationBefore: anInstruction reusing: anExpressionDictionary ^ nil! Annotation key: 'category' value: 'bounds check hoisting'! Instruction method! mayHoist ^ false! Annotation key: 'category' value: 'bounds check hoisting'! Class named: 'PseudoInstruction' superclass: 'Instruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! PseudoInstruction method! mayBeRedundant ^ false! Annotation key: 'category' value: 'partial redundancy elimination'! Class named: 'UnaryInstruction' superclass: 'Instruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! UnaryInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! UnaryInstruction method! inputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! UnaryInstruction method! maySimplify ^ true! Annotation key: 'category' value: 'expression simplification'! UnaryInstruction method! simplifyExpression ^ ((self atInputOperand: 1) isKindOf: Constant) ifTrue: [self evaluate: (self atInputOperand: 1)] ifFalse: [self]! Annotation key: 'category' value: 'expression simplification'! Class named: 'BinaryInstruction' superclass: 'Instruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BinaryInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! BinaryInstruction method! inputOperands ^ 2! Annotation key: 'category' value: 'analyzing'! BinaryInstruction method! maySimplify ^ true! Annotation key: 'category' value: 'expression simplification'! BinaryInstruction method! simplifyExpression ^ (((self atInputOperand: 1) isKindOf: Constant) and: [(self atInputOperand: 2) isKindOf: Constant]) ifTrue: [self evaluate: (self atInputOperand: 1) with: (self atInputOperand: 2)] ifFalse: [self]! Annotation key: 'category' value: 'expression simplification'! BinaryInstruction method! insertDerivationBefore: anInstruction reusing: anExpressionDictionary | accumulator increment | self doInputOperands: [:operand | (operand isKindOf: Constant) ifTrue: [increment _ operand] ifFalse: [accumulator _ operand]]. (accumulator sequence isKindOf: InductionVariable) ifTrue: [accumulator _ accumulator sequence loop insertMaximumFor: accumulator sequence before: anInstruction] ifFalse: [accumulator _ accumulator insertDerivationBefore: anInstruction reusing: anExpressionDictionary]. ((accumulator isKindOf: Constant) and: [increment isKindOf: Constant]) ifTrue: [accumulator _ self evaluate: accumulator with: scale] ifFalse: [accumulator _ self class new operands: (Array with: (anInstruction basicBlock region function allocateLocalVariable: accumulator outputOperand storageType) with: accumulator with: scale). anExpressionDictionary at: accumulator ifPresent: [:oldAccumulator | (oldAccumulator dominates: anInstruction) ifTrue: [accumulator _ oldAccumulator] ifFalse: [anInstruction basicBlock add: accumulator before: anInstruction. anExpressionDictionary at: accumulator put: accumulator]] ifAbsent: [anInstruction basicBlock add: accumulator before: anInstruction. anExpressionDictionary at: accumulator put: accumulator]]. ^ accumulator! Annotation key: 'category' value: 'loop analysis'! BinaryInstruction method! evaluate: firstConstant with: secondConstant ^ nil! Annotation key: 'category' value: 'expression simplification'! Class named: 'SideEffectInstruction' superclass: 'Instruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! SideEffectInstruction method! outputOperands ^ 0! Annotation key: 'category' value: 'analyzing'! SideEffectInstruction method! sequence ^ #unknown! Annotation key: 'category' value: 'loop analysis'! SideEffectInstruction method! mayBeRedundant ^ false! Annotation key: 'category' value: 'partial redundancy elimination'! SideEffectInstruction method! mayBeUnused ^ false! Annotation key: 'category' value: 'unused code removal'! Class named: 'ClobberInstruction' superclass: 'PseudoInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! ClobberInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! ClobberInstruction method! translateOn: aTranslator anAssembler translateClobber: self! Annotation key: 'category' value: 'translating'! Class named: 'UseInstruction' superclass: 'PseudoInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! UseInstruction method! outputOperands ^ 0! Annotation key: 'category' value: 'analyzing'! UseInstruction method! translateOn: aTranslator anAssembler translateUse: self! Annotation key: 'category' value: 'translating'! UseInstruction method! isUse ^ true! Annotation key: 'category' value: 'dead code elimination'! Class named: 'ProjectionInstruction' superclass: 'PseudoInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! ProjectionInstruction method! translateOn: aTranslator aTranslator translateProjection: self! Annotation key: 'category' value: 'translating'! ProjectionInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! ProjectionInstruction method! outputOperand: anObject super outputOperand: anObject. (self operands at: 2) at: (self operands at: 3) value put: anObject! Annotation key: 'category' value: 'analyzing'! Class named: 'MergeInstruction' superclass: 'PseudoInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! MergeInstruction method! translateOn: aTranslator aTranslator translateMerge: self! Annotation key: 'category' value: 'translating'! MergeInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! MergeInstruction method! copyPropagate self doInputOperands: [:operand | (operand isKindOf: Constant) and: [operand value = (operands at: 2) value] ifFalse: [^ self]]. ^ operands at: 2! Annotation key: 'category' value: 'copy propagation'! MergeInstruction method! isAssignment ^ false! Annotation key: 'category' value: 'partial redundancy elimination'! MergeInstruction method! isLinearIn: aSet ^ operands size = 3! Annotation key: 'category' value: 'loop analysis'! MergeInstruction method! inductionVariableIncrementIn: aSet ^ Constant new value: 0! Annotation key: 'category' value: 'loop analysis'! MergeInstruction method! inductionVariableSeed self basicBlock region loop ifNotNilDo: [:loop | (loop body includes: (operands at: 3) basicBlock region) ifTrue: [^ operands at: 2]]. ^ operands at: 3! Annotation key: 'category' value: 'loop analysis'! MergeInstruction method! linkUsesToDefinitions: namespace ! Annotation key: 'category' value: 'SSA translation'! Class named: 'NotInstruction' superclass: 'UnaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! NotInstruction method! translateOn: aTranslator aTranslator translateNot: self! Annotation key: 'category' value: 'translating'! NotInstruction method! evaluate: aConstant ^ Constant new value: aConstant value bitInvert! Annotation key: 'category' value: 'expression simplification'! Class named: 'OrInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! OrInstruction method! translateOn: aTranslator aTranslator translateOr: self! Annotation key: 'category' value: 'translating'! OrInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: (firstConstant value bitOr: secondConstant value)! Annotation key: 'category' value: 'expression simplification'! Class named: 'AndInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! AndInstruction method! translateOn: aTranslator aTranslator translateAnd: self! Annotation key: 'category' value: 'translating'! AndInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: (firstConstant value bitAnd: secondConstant value)! Annotation key: 'category' value: 'expression simplification'! Class named: 'XorInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! XorInstruction method! translateOn: aTranslator aTranslator translateXor: self! Annotation key: 'category' value: 'translating'! XorInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: (firstConstant value bitXor: secondConstant value)! Annotation key: 'category' value: 'expression simplification'! Class named: 'LogicalShiftRightInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! LogicalShiftRightInstruction method! translateOn: aTranslator aTranslator translateLogicalShiftRight: self! Annotation key: 'category' value: 'translating'! LogicalShiftRightInstruction method! mayDeriveInductionVariable ^ (self operands at: 3) isKindOf: Constant! Annotation key: 'category' value: 'loop analysis'! LogicalShiftRightInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: ((firstConstant value bitShift: secondConstant value negated) bitAnd: ((1 bitShift: firstConstant value highBit - secondConstant value) - 1))! Annotation key: 'category' value: 'expression simplification'! Class named: 'LogicalShiftLeftInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! LogicalShiftLeftInstruction method! translateOn: aTranslator aTranslator translateLogicalShiftLeft: self! Annotation key: 'category' value: 'translating'! LogicalShiftLeftInstruction method! mayDeriveInductionVariable ^ (self operands at: 3) isKindOf: Constant! Annotation key: 'category' value: 'loop analysis'! LogicalShiftLeftInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: (firstConstant value bitShift: secondConstant value)! Annotation key: 'category' value: 'expression simplification'! Class named: 'ArithmeticShiftRightInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! ArithmeticShiftRightInstruction method! translateOn: aTranslator aTranslator translateArithmeticShiftRight: self! Annotation key: 'category' value: 'translating'! ArithmeticShiftRightInstruction method! mayDeriveInductionVariable ^ (self operands at: 3) isKindOf: Constant! Annotation key: 'category' value: 'loop analysis'! ArithmeticShiftRightInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: (firstConstant value bitShift: secondConstant value negated)! Annotation key: 'category' value: 'expression simplification'! Class named: 'AddInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! AddInstruction method! translateOn: aTranslator aTranslator translateAdd: self! Annotation key: 'category' value: 'translating'! AddInstruction method! isLinearIn: aSet ^ ((aSet includes: (self operands at: 2)) and: [(self operands at: 3) loopInvariantFor: self basicBlock region loop]) or: [(aSet includes: (self operands at: 3)) and: [(self operands at: 2) loopInvariantFor: self basicBlock region loop]]! Annotation key: 'category' value: 'loop analysis'! AddInstruction method! inductionVariableIncrementIn: aSet ^ (aSet includes: (self operands at: 2)) ifTrue: [self operands at: 3] ifFalse: [self operands at: 2]! Annotation key: 'category' value: 'loop analysis'! AddInstruction method! accumulateInductionVariableIncrementInto: aConstant ((self operands at: 3) isKindOf: Constant) ifTrue: [aConstant value: aConstant value + (self operands at: 3) value] ifFalse: [aConstant value: aConstant value + (self operands at: 2) value]. ^ aConstant! Annotation key: 'category' value: 'loop analysis'! AddInstruction method! mayDeriveInductionVariable ^ ((self operands at: 3) isKindOf: Constant) or: [(self operands at: 2) isKindOf: Constant]! Annotation key: 'category' value: 'loop analysis'! AddInstruction method! simplifyExpression | accumulator increment | accumulator _ self operands at: 2. ((accumulator isKindOf: AddInstruction orOf: SubtractInstruction) and: [(accumulator operands at: 3) isKindOf: Constant]) ifTrue: [^ self simplifyExpression]. increment _ self operands at: 3. (increment isKindOf: Constant) ifFalse: [^ self]. (accumulator isKindOf: AddInstruction) ifTrue: [increment value: increment value + (accumulator operands at: 3) value] ifFalse: [increment value: increment value - (accumulator operands at: 3) value]. self operands at: 2 put: (accumulator operands at: 2). ^ self! Annotation key: 'category' value: 'expression simplification'! AddInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: firstConstant value + secondConstant value! Annotation key: 'category' value: 'expression simplification'! Class named: 'SubtractInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! SubtractInstruction method! translateOn: aTranslator aTranslator translateSubtract: self! Annotation key: 'category' value: 'translating'! SubtractInstruction method! isLinearIn: aSet ^ (aSet includes: (self operands at: 2)) and: [(self operands at: 3) loopInvariantFor: self basicBlock region loop]! Annotation key: 'category' value: 'loop analysis'! SubtractInstruction method! inductionVariableIncrementIn: aSet ^ self operands at: 3! Annotation key: 'category' value: 'loop analysis'! SubtractInstruction method! accumulateInductionVariableIncrementInto: aConstant aConstant value: aConstant value - (self operands at: 3) value. ^ aConstant! Annotation key: 'category' value: 'loop analysis'! SubtractInstruction method! mayDeriveInductionVariable ^ ((self operands at: 3) isKindOf: Constant)! Annotation key: 'category' value: 'loop analysis'! SubtractInstruction method! simplifyExpression | accumulator increment | accumulator _ self operands at: 2. ((accumulator isKindOf: AddInstruction orOf: SubtractInstruction) and: [(accumulator operands at: 3) isKindOf: Constant]) ifTrue: [^ self simplifyExpression]. increment _ self operands at: 3. (increment isKindOf: Constant) ifFalse: [^ self]. (accumulator isKindOf: SubtractInstruction) ifTrue: [increment value: increment value + (accumulator operands at: 3) value] ifFalse: [increment value: increment value - (accumulator operands at: 3) value]. self operands at: 2 put: (accumulator operands at: 2). ^ self! Annotation key: 'category' value: 'expression simplification'! SubtractInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: firstConstant value - secondConstant value! Annotation key: 'category' value: 'expression simplification'! Class named: 'MultiplyInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! MultiplyInstruction method! translateOn: aTranslator aTranslator translateMultiply: self! Annotation key: 'category' value: 'translating'! MultiplyInstruction method! simplifyExpression | operand scale bits accumVar incVar accumulator increment | ((self atInputOperand: 2) isKindOf: Constant) ifTrue: [operand _ self atInputOperand: 1. scale _ self atInputOperand: 2. (operand isKindOf: Constant) ifTrue: [^ self evaluate: operand with: scale]] ifFalse: [operand _ self atInputOperand: 2. scale _ self atInputOperand: 1. (scale isKindOf: Constant) ifFalse: [^ self]]. scale value = 0 ifTrue: [^ Constant new value: 0]. scale value = 1 ifTrue: [^ self atInputOperand: 1]. (scale value isKindOf: Integer) ifFalse: [^ self]. bits _ 0. 0 to: self outputOperand storageType bitSize - 1 do: [:shiftCount | (scale value bitAnd: (1 bitShift: shiftCount)) = 0 ifFalse: [bits _ bits + 1]]. bits > 3 ifTrue: [^ self]. accumVar _ self basicBlock region function allocateLocalVariable: operand outputOperand storageType. scale value lowBit = 1 ifTrue: [accumulator _ MoveInstruction new operands: (Array with: accumVar with: operand)] ifFalse: [accumulator _ LogicalShiftLeftInstruction new operands: (Array with: accumVar with: operand with: (Constant new value: scale value lowBit - 1))]. self basicBlock add: accumulator before: self. bits = 1 ifTrue: [^ accumulator]. incVar _ self basicBlock region function allocateLocalVariable: operand outputOperand storageType. scale value lowBit to: self outputOperand storageType bitSize - 1 do: [:shiftCount | (scale value bitAnd: (1 bitShift: shiftCount)) = 0 ifFalse: [increment _ self basicBlock add: (LogicalShiftLeftInstruction new operands: (Array with: incVar with: operand with: (Constant new value: shiftCount))) before: self. accumulator _ self basicBlock add: (AddInstruction new operands: (Array with: accumVar with: accumulator with: increment)) before: self]]. ^ accumulator! Annotation key: 'category' value: 'expression simplification'! MultiplyInstruction method! strengthReductionCandidate | instructions | instructions _ 0. self doInputOperands: [:operand | (operand isKindOf: Instruction) ifTrue: [instructions _ instructions + 1] ifFalse: [(operand isKindOf: Constant) ifFalse: [^ false]]]. ^ instructions > 0! Annotation key: 'category' value: 'strength reduction'! MultiplyInstruction method! isInjuredBy: anInstruction | increment scale injury | (anInstruction isKindOf: AddInstruction orOf: SubtractInstruction) ifFalse: [^ false]. anInstruction operands doInputOperands: [:operand | ((operand isKindOf: Instruction) and: [operand outputOperand == anInstruction outputOperand]) ifTrue: [injury _ operand] ifFalse: [increment _ operand]]. injury ifNil: [^ false]. increment ifNil: [^ false]. (increment isKindOf: Instruction orOf: Constant) ifFalse: [^ false]. self doInputOperands: [:operand | ((operand isKindOf: Instruction) and: [operand outputOperand == self outputOperand]) ifFalse: [scale _ operand]]. scale ifNil: [^ false]. (increment isKindOf: Constant) ifTrue: [^ (increment value = 1) or: [scale isKindOf: Constant]] ifFalse: [^ (increment loopInvariantFor: anInstruction basicBlock region loop) and: [scale loopInvariantFor: anInstruction basicBlock region loop]]! Annotation key: 'category' value: 'strength reduction'! MultiplyInstruction method! canAccumulateInjury: anInstruction ^ (anInstruction operands anySatisfy: [:operand | operand isKindOf: Constant]) and: [self operands anySatisfy: [:operand | operand isKindOf: Constant]]! Annotation key: 'category' value: 'strength reduction'! MultiplyInstruction method! repairInjury: injuryInstruction fromValue: valueInstruction in: aRedundancyGraph | increment scale repair | increment _ injuryInstruction operands at: 3. ((increment isKindOf: Instruction) and: [increment outputOperand == injuryInstruction outputOperand]) ifTrue: [increment _ injuryInstruction operands at: 2]. aRedundancyGraph template doInputOperands: [:operand | ((operand isKindOf: Instruction) and: [operand outputOperand == injuryInstruction outputOperand]) ifFalse: [scale _ operand]]. (scale isKindOf: Instruction) ifTrue: [scale _ aRedundancyGraph namespace at: scale outputOperand]. (increment isKindOf: Constant) ifTrue: [(scale isKindOf: Constant) ifTrue: [increment _ increment copy. increment value: increment value * scale value] ifFalse: [increment _ scale]] ifFalse: [increment _ MultiplyInstruction new operands: (Array with: (aRedundancyGraph function allocateLocalVariable: increment outputOperand storageType) with: scale with: increment). injuryInstruction loop ifNotNil: [injuryInstruction loop entrance doPredecessors: [:predecessor | (predecessor region depth < injuryInstruction loop entrance region depth) ifTrue: [predecessor add: increment]]] ifNil: [injuryInstruction basicBlock add: increment before: injuryInstruction]]. repair _ injuryInstruction class new. repair operands: (Array with: valueInstruction outputOperand with: valueInstruction with: increment). injuryInstruction basicBlock add: repair after: injuryInstruction. ^ repair! Annotation key: 'category' value: 'strength reduction'! MultiplyInstruction method! accumulateInjury: injuryInstruction into: accumulatorInstruction | increment scale accumulator | scale _ self operands detect: [:operand | operand isKindOf: Constant]. increment _ injuryInstruction operands detect: [:operand | operand isKindOf: Constant]. accumulator _ accumulatorInstruction operands detect: [:operand | operand isKindOf: constant]. injuryInstruction class == accumulatorInstruction class ifTrue: [accumulator value: accumulator value + increment value * scale value] ifFalse: [accumulator value: accumulator value - increment value * scale value]! Annotation key: 'category' value: 'strength reduction'! MultiplyInstruction method! canReplaceTest: anInstruction ^ (anInstruction isKindOf: BranchLessInstruction) and: [(anInstruction operands at: 2) loopInvariantFor: anInstruction basicBlock region loop] and: [((anInstruction operands at: 1) isKindOf: Instruction) and: [self operands anySatisfy: [:operand | (operand isKindOf: Instruction) and: [operand outputOperand == (anInstruction operands at: 1) outputOperand]]]]! Annotation ke