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 key: 'category' value: 'linear function test replacement'! MultiplyInstruction method! replaceTest: testInstruction fromValue: valueInstruction in: aRedundancyGraph | scale increment bound | aRedundancyGraph template doInputOperands: [:templateOperand | testInstruction doInputOperands: [:testOperand | templateOperand outputOperand == testOperand outputOperand ifTrue: [increment _ templateOperand]] ifKindOf: Instruction. templateOperand = increment ifFalse: [scale _ aRedundancyGraph namespace at: templateOperand outputOperand]] ifKindOf: Instruction. testInstruction doInputOperandsWithIndex: [:operand :position | (operand isKindOf: Instruction) ifTrue: [operand outputOperand = increment outputOperand ifTrue: [testInstruction atInputOperand: position put: valueInstruction] ifFalse: [bound _ MultiplyInstruction new operands: (Array with: (aRedundancyGraph function allocateLocalVariable: scale outputOperand storageType) with: scale with: operand). testInstruction basicBlock add: bound before: testInstruction. testInstruction atInputOperand: position put: bound]]. (operand isKindOf: Constant) ifTrue: [(scale isKindOf: Constant) ifTrue: [bound _ Constant value: operand value * scale value] ifFalse: [bound _ MultiplyInstruction new operands: (Array with: (aRedundancyGraph function allocateLocalVariable: scale outputOperand storageType) with: scale with: operand). testInstruction basicBlock add: bound before: testInstruction]. testInstruction atInputOperand: position put: bound]]. ^ testInstruction! Annotation key: 'category' value: 'linear function test replacement'! MultiplyInstruction method! mayDeriveInductionVariable ^ (((self operands at: 3) isKindOf: Constant) and: [(self operands at: 3) value isPowerOfTwo]) or: [((self operands at: 2) isKindOf: Constant) and: [(self operands at: 2) value isPowerOfTwo]]! Annotation key: 'category' value: 'loop analysis'! MultiplyInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: firstConstant value * secondConstant value! Annotation key: 'category' value: 'expression simplification'! Class named: 'DivideInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! DivideInstruction method! translateOn: aTranslator aTranslator translateDivide: self! Annotation key: 'category' value: 'translating'! DivideInstruction method! mayDeriveInductionVariable ^ ((self operands at: 3) isKindOf: Constant) and: [(self operands at: 3) value isPowerOfTwo]! Annotation key: 'category' value: 'loop analysis'! DivideInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: ((firstConstant value isKindOf: Integer) & (secondConstant value isKindOf: Integer) ifTrue: [firstConstant value // secondConstant value] ifFalse: [firstConstant value / secondConstant value])! Annotation key: 'category' value: 'expression simplification'! DivideInstruction method! simplifyExpression (self atInputOperand: 2) ifKindOf: Constant thenDo: [:scale | (self atInputOperand: 1) ifKindOf: Constant thenDo: [:operand | ^ self evaluate: operand with: scale]. scale value = 1 ifTrue: [^ self atInputOperand: 1]. scale value isPowerOfTwo ifTrue: [^ self basicBlock add: (ArithmeticShiftRightInstruction new operands: (Array with: (self basicBlock region function allocateLocalVariable: (self atInputOperand: 1) outputOperand storageType) with: (self atInputOperand: 1) with: (Constant new value: scale value lowBit - 1))) before: self]]. ^ self! Annotation key: 'category' value: 'expression simplification'! Class named: 'RemainderInstruction' superclass: 'BinaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! RemainderInstruction method! translateOn: aTranslator aTranslator translateRemainder: self! Annotation key: 'category' value: 'translating'! RemainderInstruction method! mayDeriveInductionVariable ^ ((self operands at: 3) isKindOf: Constant) and: [(self operands at: 3) value isPowerOfTwo]! Annotation key: 'category' value: 'loop analysis'! RemainderInstruction method! evaluate: firstConstant with: secondConstant ^ Constant new value: firstConstant value - (firstConstant value * (firstConstant value / secondConstant value) floor)! Annotation key: 'category' value: 'loop analysis'! RemainderInstruction method! simplifyExpression (self atInputOperand: 2) ifKindOf: Constant thenDo: [:scale | (self atInputOperand: 1) ifKindOf: Constant thenDo: [:operand | ^ self evaluate: operand with: scale]. scale value = 1 ifTrue: [^ Constant new value: 0]. scale value isPowerOfTwo ifTrue: [^ self basicBlock add: (AndInstruction new operands: (Array with: (self basicBlock region function allocateLocalVariable: (self atInputOperand: 1) outputOperand storageType) with: (self atInputOperand: 1) with: (Constant new value: scale value - 1))) before: self]]. ^ self! Annotation key: 'category' value: 'expression simplification'! Class named: 'MoveInstruction' superclass: 'UnaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! MoveInstruction method! translateOn: aTranslator aTranslator translateMove: self! Annotation key: 'category' value: 'translating'! MoveInstruction method! copyPropagate ((operands at: 2) isKindOf: Instruction orOf: Constant) ifTrue: [^ operands at: 2] ifFalse: [^ self]! Annotation key: 'category' value: 'copy propagation'! MoveInstruction method! mayBeRedunant ^ false! Annotation key: 'category' value: 'partial redundancy elimination'! MoveInstruction method! evaluate: aConstant ^ aConstant! Annotation key: 'category' value: 'expression simplification'! MoveInstruction method! simplifyExpression ^ self copyPropagate! Annotation key: 'category' value: 'expression simplification'! Class named: 'TruncateInstruction' superclass: 'UnaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! TruncateInstruction method! translateOn: aTranslator aTranslator translateTruncate: self! Annotation key: 'category' value: 'translating'! TruncateInstruction method! evaluate: aConstant ^ Constant new value: (aConstant value bitAnd: (1 bitShift: self outputOperand storageType bitSize) - 1)! Annotation key: 'category' value: 'expression simplification'! Class named: 'SignExtendInstruction' superclass: 'UnaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! SignExtendInstruction method! translateOn: aTranslator aTranslator translateSignExtend: self! Annotation key: 'category' value: 'translating'! SignExtendInstruction method! evaluate: aConstant ^ aConstant! Annotation key: 'category' value: 'expression simplification'! Class named: 'ZeroExtendInstruction' superclass: 'UnaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! ZeroExtendInstruction method! translateOn: aTranslator aTranslator translateZeroExtend: self! Annotation key: 'category' value: 'translating'! ZeroExtendInstruction method! evaluate: aConstant ^ aConstant! Annotation key: 'category' value: 'expression simplification'! Class named: 'ConvertInstruction' superclass: 'UnaryInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! ConvertInstruction method! translateOn: aTranslator aTranslator translateConvert: self! Annotation key: 'category' value: 'translating'! ConvertInstruction method! evaluate: aConstant ^ Constant new value: ((self outputOperand storageType isKindOf: FloatStorageType) ifTrue: [aConstant value asFloat] ifFalse: [aConstant value])! Annotation key: 'category' value: 'expression simplification'! Class named: 'BoundsCheckInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BoundsCheckInstruction method! translateOn: aTranslator aTranslator translateBoundsCheck: self! Annotation key: 'category' value: 'translating'! BoundsCheckInstruction method! mayBeRedundant ^ true! Annotation key: 'category' value: 'partial redundancy elimination'! BoundsCheckInstruction method! mayDeriveInductionVariable | inductionVariables | (self operands at: 1) ifKindOf: Instruction thenDo: [:instruction | (instruction sequence = #derived or: [instruction sequence isKindOf: InductionVariable]) ifFalse: [^ false]. inductionVariables _ Set new. instruction derivedFrom: inductionVariables. inductionVariables do: [:inductionVariable | ((self operands at: 2) loopInvariantFor: inductionVariable loop) ifFalse: [^ false]]]. ^ true! Annotation key: 'category' value: 'loop analysis'! BoundsCheckInstruction method! mayHoist ^ true! Annotation key: 'category' value: 'bounds check hoisting'! BoundsCheckInstruction method! insertAliases self basicBlock region function memoryLocations do: [:memoryLocation | self basicBlock add: (UseInstruction new operands: (Array with: memoryLocation)) before: self]. self basicBlock region function globalVariables do: [:globalVariable | self basicBlock add: (GlobalVariableInstruction new operands: (Array with: globalVariable)) before: self]! Annotation key: 'category' value: 'SSA translation'! Class named: 'LoadInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! LoadInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! LoadInstruction method! translateOn: aTranslator aTranslator translateLoad: self! Annotation key: 'category' value: 'translating'! LoadInstruction method! insertAliases (self operands at: 2) ifKindOf: MemoryLocation thenDo: [:memoryLocation | memoryLocation aliases do: [:alias | self basicBlock region add: (UseInstruction new operands: (Array with: alias)) after: self]]! Annotation key: 'category' value: 'SSA translation'! LoadInstruction method! mayHaveAliases ^ (self operands at: 2) isKindOf: MemoryAlias! Annotation key: 'category' value: 'alias analysis'! LoadInstruction method! aliasedLocation ^ MemoryLocation new storageType: self outputOperand storageType base: (self operands at: 3) offset: (self operands at: 4)! Annotation key: 'category' value: 'alias analysis'! LoadInstruction method! useMemoryLocation: aMemoryLocation self operands at: 2 put: aMemoryLocation! Annotation key: 'category' value: 'alias analysis'! LoadInstruction method! mayBeRedundant ^ true! Annotation key: 'category' value: 'partial redundancy elimination'! LoadInstruction method! isUse ^ true! Annotation key: 'category' value: 'dead store elimination'! LoadInstruction method! mayBeUnused ^ true! Annotation key: 'category' value: 'unused code removal'! LoadInstruction method! maySimplify ^ true! Annotation key: 'category' value: 'expression simplification'! LoadInstruction method! simplifyExpression | accumulator increment | ((self operands at: 2) isKindOf: MemoryLocation) ifFalse: [^ self]. accumulator _ self operands at: 3. ((accumulator isKindOf: AddInstruction orOf: SubtractInstruction) and: [(accumulator operands at: 3) isKindOf: Constant]) ifTrue: [^ self]. increment _ self operands at: 4. (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: 3 put: (accumulator operands at: 2). ^ self! Annotation key: 'category' value: 'expression simplification'! Class named: 'StoreInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! StoreInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! StoreInstruction method! translateOn: aTranslator aTranslator translateStore: self! Annotation key: 'category' value: 'translating'! StoreInstruction method! mayHaveAliases ^ (self operands at: 1) isKindOf: MemoryAlias! Annotation key: 'category' value: 'alias analysis'! StoreInstruction method! memoryAddress ^ MemoryLocation new storageType: self outputOperand storageType base: (self operands at: 2) offset: (self operands at: 3)! Annotation key: 'category' value: 'alias analysis'! StoreInstruction method! useMemoryLocation: aMemoryLocation self operands at: 1 put: aMemoryLocation! Annotation key: 'category' value: 'alias analysis'! StoreInstruction method! mayBeDead ^ true! Annotation key: 'category' value: 'dead store elimination'! StoreInstruction method! insertAliases (self operands at: 1) ifKindOf: MemoryLocation thenDo: [:memoryLocation | memoryLocation aliases do: [:alias | self basicBlock region add: (ClobberInstruction new operands: (Array with: alias)) after: self]]! Annotation key: 'category' value: 'SSA translation'! StoreInstruction method! expressionHash | hash | hash _ self class hash. 1 to: self operands size - 1 do: [:position | hash _ (hash + (self operands at: position) operandHash) hashMultiply]. ^ hash! Annotation key: 'category' value: 'dead store elimination'! StoreInstruction method! expressionCompare: anInstruction self class == anInstruction class ifFalse: [^ false]. 1 to: self operands size - 1 do: [:position | ((self operands at: position) operandCompare: (anInstruction operands at: position)) ifFalse: [^ false]]. ^ true! Annotation key: 'category' value: 'dead store elimination'! Class named: 'PushInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! PushInstruction method! translateOn: aTranslator aTranslator translatePush: self! Annotation key: 'category' value: 'translating'! Class named: 'PopInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! PopInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! PopInstruction method! translateOn: aTranslator aTranslator translatePop: self! Annotation key: 'category' value: 'translating'! Class named: 'AllocateInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! AllocateInstruction method! translateOn: aTranslator aTranslator translateAllocate: self! Annotation key: 'category' value: 'translating'! Class named: 'FreeInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! FreeInstruction method! translateOn: aTranslator aTranslator translateFree: self! Annotation key: 'category' value: 'translating'! Class named: 'PrologueInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! PrologueInstruction method! translateOn: aTranslator aTranslator translatePrologue: self! Annotation key: 'category' value: 'translating'! Class named: 'EpilogueInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! EpilogueInstruction method! translateOn: aTranslator aTranslator translateEpilogue: self! Annotation key: 'category' value: 'translating'! Class named: 'SpillInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! SpillInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! SpillInstruction method! translateOn: aTranslator aTranslator translateSpill: self! Annotation key: 'category' value: 'translating'! Class named: 'ReloadInstruction' superclass: 'SideEffectInstruction ' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! ReloadInstruction method! outputOperands ^ 1! Annotation key: 'category' value: 'analyzing'! ReloadInstruction method! translateOn: aTranslator aTranslator translateReload: self! Annotation key: 'category' value: 'translating'! Class named: 'ExitInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! ExitInstruction method! labelOperands ^ 0! Annotation key: 'category' value: 'analyzing'! ExitInstruction method! atLabelOperand: anInteger ^ self operands at: (self operands size - self labelOperands) + anInteger! Annotation key: 'category' value: 'analyzing'! ExitInstruction method! atLabelOperand: anInteger put: anObject ^ self operands at: (self operands size - self labelOperands) + anInteger put: anObject! Annotation key: 'category' value: 'analyzing'! Class named: 'JumpInstruction' superclass: 'ExitInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! JumpInstruction method! translateOn: aTranslator aTranslator translateJump: self! Annotation key: 'category' value: 'translating'! JumpInstruction method! labelOperands ^ 1! Annotation key: 'category' value: 'analyzing'! Class named: 'CallInstruction' superclass: 'SideEffectInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! CallInstruction method! translateOn: aTranslator aTranslator translateCall: self! Annotation key: 'category' value: 'translating'! CallInstruction method! insertAliases | calleeGlobalVariables | self basicBlock region function memoryLocations do: [:memoryLocation | self basicBlock add: (UseInstruction new operands: (Array with: memoryLocation)) before: self. self basicBlock add: (ClobberInstruction new operands: (Array with: memoryLocation)) after: self]. (self operands at: 1) ifKindOf: FunctionLabel thenDo: [:label | calleeGlobalVariables _ label target globalVariables]. self basicBlock region function globalVariables do: [:globalVariable | (calleeGlobalVariables isNil or: [calleeGlobalVariables includes: globalVariable]) ifTrue: [self basicBlock add: (UseInstruction new operands: (Array with: globalVariable)) before: self. self basicBlock add: (ClobberInstruction new operands: (Array with: globalVariable)) after: self]]! Annotation key: 'category' value: 'SSA translation'! Class named: 'ReturnInstruction' superclass: 'ExitInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! ReturnInstruction method! translateOn: aTranslator aTranslator translateReturn: self! Annotation key: 'category' value: 'translating'! Class named: 'BranchInstruction' superclass: 'ExitInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BranchInstruction method! labelOperands ^ 2! Annotation key: 'category' value: 'analyzing'! BranchInstruction method! maySimplify ^ true! Annotation key: 'category' value: 'expression simplification'! BranchInstruction method! evaluate: firstConstant with: secondConstant self subclassResponsibility! Annotation key: 'category' value: 'expression simplification'! BranchInstruction method! simplifyExpression | x y path unlinked | x _ self atInputOperand: 1. y _ self atInputOperand: 2. ((x isKindOf: Constant) and: [y isKindOf: Constant]) ifFalse: [^ self]. (self evaluate: x with: y) ifTrue: [path _ self atInputOperand: 3. unlinked _ self atInputOperand: 4] ifFalse: [path _ self atInputOperand: 4. unlinked _ self atInputOperand: 3]. self basicBlock remove: self. self basicBlock addLast: (JumpInstruction new operands: (Array with: path)). unlinked target entrances isEmpty ifTrue: [unlinked target unlink]. self basicBlock region loop ifNotNilDo: [:loop | loop exits remove: self ifAbsent: []. (loop body includes: path target) ifFalse: [loop exits add: self basicBlock last]]. (self basicBlock region loop == path target region loop and: [path target entrances size = 1]) ifTrue: [path target region do: [:pathBasicBlock | pathBasicBlock region: self basicBlock region]. self basicBlock region concatenateLast: path target region]. ^ self basicBlock last! Annotation key: 'category' value: 'expression simplification'! Class named: 'BranchEqualInstruction' superclass: 'BranchInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BranchEqualInstruction method! translateOn: aTranslator aTranslator translateBranchEqual: self! Annotation key: 'category' value: 'translating'! BranchEqualInstruction method! evaluate: firstConstant with: secondConstant ^ firstConstant value = secondConstant value! Annotation key: 'category' value: 'expression simplification'! Class named: 'BranchNotEqualInstruction' superclass: 'BranchInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BranchNotEqualInstruction method! translateOn: aTranslator aTranslator translateBranchNotEqual: self! Annotation key: 'category' value: 'translating'! BranchNotEqualInstruction method! evaluate: firstConstant with: secondConstant ^ firstConstant value ~= secondConstant value! Annotation key: 'category' value: 'expression simplification'! Class named: 'BranchLessInstruction' superclass: 'Instruction ' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BranchLessInstruction method! translateOn: aTranslator aTranslator translateBranchLess: self! Annotation key: 'category' value: 'translating'! BranchLessInstruction method! evaluate: firstConstant with: secondConstant ^ firstConstant value < secondConstant value! Annotation key: 'category' value: 'expression simplification'! BranchLessInstruction method! mayBeReplaceableTest ^ ((self operands at: 1) isKindOf: Instruction) and: [(self operands at: 2) loopInvariantFor: self basicBlock region loop]! Annotation key: 'category' value: 'linear function test replacement'! BranchLessInstruction method! isPredictableExit (((self operands at: 2) loopInvariantFor: self basicBlock region loop) and: [(self operands at: 3) target == self basicBlock region loop entrance]) ifFalse: [^ false]. (self operands at: 1) sequence ifKindOf: InductionVariable thenDo: [:inductionVariable | ^ (inductionVariable increment isKindOf: Constant) and: [inductionVariable increment value > 0] and: [(inductionVariable increment value isPowerOfTwo) or: [(self operands at: 2) isKindOf: Constant]]]. ^ false! Annotation key: 'category' value: 'loop analysis'! BranchLessInstruction method! canPredictInductionVariable: anInductionVariable ^ (anInductionVariable == (operands at: 1) sequence) or: [(anInductionVariable increment isKindOf: Constant) and: [anInductionVariable increment value > 0] and: [anInductionVariable increment value isPowerOfTwo or: [tripCount notNil]]]! Annotation key: 'category' value: 'loop analysis'! BranchLessInstruction method! tripCount (operands at: 1) sequence seed ifKindOf: constant thenDo: [:seed | (operands at: 2) ifKindOf: Constant thenDo: [:bound | (operands at: 1) sequence tripCount: (Constant new value: (bound value - seed value) / (operands at: 1) sequence increment value)]]. ^ (operands at: 1) sequence tripCount ifKindOf: Constant thenDo: [:tripCount | tripCount copy]! Annotation key: 'category' value: 'loop analysis'! BranchLessInstruction method! insertTripCountBefore: anInstruction | tripCount | (operands at: 1) sequence tripCount ifNotNil: [^ (operands at: 1) sequence tripCount copy]. (((operands at: 1) sequence seed isKindOf: Constant) and: [(operands at: 1) sequence seed value = 0]) ifTrue: [tripCount _ operands at: 2] ifFalse: [tripCount _ SubtractInstruction new operands: (Array with: (anInstruction basicBlock region function allocateLocalVariable: (operands at: 2) outputOperand storageType) with: (operands at: 2) with: (operands at: 1) sequence seed) anInstruction basicBlock add: tripCount before: anInstruction]. inductionVariable increment value = 1 ifFalse: [tripCount _ LogicalShiftRightInstruction new operands: (Array with: (tripCount = (operands at: 2) ifTrue: [anInstruction basicBlock region function allocateLocalVariable: (operands at: 2) outputOperand storageType] ifFalse: [tripCount outputOperand]) with: tripCount with: (Constant new value: inductionVariable increment value lowBit - 1)). anInstruction basicBlock add: tripCount before: anInstruction]. (operands at: 1) sequence tripCount: tripCount. ^ tripCount! Annotation key: 'category' value: 'loop analysis'! BranchLessInstruction method! insertMaximumFor: anInductionVariable before: anInstruction | maximum | (operands at: 1) sequence maximum ifNotNil: [^ (operands at: 1) sequence maximum copy]. anInductionVariable == (operands at: 1) sequence ifTrue: [((operands at: 2) isKindOf: Constant) ifTrue: [maximum _ Constant new value: (operands at: 2) value - 1] ifFalse: [inductionVariable increment value = 1 ifTrue: [maximum _ anInstruction basicBlock add: (SubtractInstruction new operands: (Array with: (anInstruction basicBlock region function allocateLocalVariable: (operands at: 2) storageType) with: (operands at: 2) with: (Constant new value: 1))) before: anInstruction] ifFalse: [self tripCount ifNotNilDo: [:tripCount | maximum _ tripCount value: (tripCount value - 1) * anInductionVariable increment value + anInductionVariable seed value]]]] ifFalse: [self tripCount ifNotNilDo: [:tripCount | tripCount value: (tripCount value - 1) * anInductionVariable increment value. (anInductionVariable seed value isKindof: Constant) ifTrue: [maximum _ tripCount value: tripCount value + anInductionVariable seed value] ifFalse: [maximum _ anInstruction basicBlock add: (AddInstruction new operands: (Array with: (anInstruction basicBlock region function allocateLocalVariable: anInductionVariable seed storageType) with: anInductionVariable seed with: tripCount)) before: anInstruction]]]. maximum ifNil: [maximum _ self insertTripCountBefore: anInstruction. maximum _ anInstruction basicBlock add: (SubtractInstruction new operands: (Array with: (anInstruction basicBlock region function allocateLocalVariable: maximum outputOperand storageType) with: maximum with: (Constant new value: 1))) before: anInstruction. anInductionVariable increment value = 1 ifFalse: [maximum _ anInstruction basicBlock add: (LogicalShiftLeftInstruction new operands: (Array with: maximum outputOperand with: maximum with: (Constant new value: anInductionVariable increment value lowBit - 1))) before: anInstruction]. ((anInductionVariable seed isKindOf: Constant) and: [anInductionVariable seed value = 0]) ifFalse: [maximum _ anInstruction basicBlock add: (AddInstruction new operands: (Array with: maximum outputOperand with: maximum with: anInductionVariable seed)) before: anInstruction]]. anInductionVariable sequence maximum: maximum. ^ maximum! Annotation key: 'category' value: 'loop analysis'! Class named: 'BranchLessEqualInstruction' superclass: 'BranchInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BranchLessEqualInstruction method! translateOn: aTranslator aTranslator translateBranchLessEqual: self! Annotation key: 'category' value: 'translating'! BranchLessEqualInstruction method! evaluate: firstConstant with: secondConstant ^ firstConstant value <= secondConstant value! Annotation key: 'category' value: 'expression simplification'! Class named: 'BranchGreaterInstruction' superclass: 'BranchInstruction' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BranchGreaterInstruction method! translateOn: aTranslator aTranslator translateBranchGreater: self! Annotation key: 'category' value: 'translating'! BranchGreaterInstruction method! evaluate: firstConstant with: secondConstant ^ firstConstant value > secondConstant value! Annotation key: 'category' value: 'expression simplification'! Class named: 'BranchGreaterEqualInstruction' superclass: 'BranchInstruction ' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Instructions'! BranchGreaterEqualInstruction method! translateOn: aTranslator aTranslator translateBranchGreaterEqual: self! Annotation key: 'category' value: 'translating'! BranchGreaterEqualInstruction method! evaluate: firstConstant with: secondConstant ^ firstConstant value >= secondConstant value! Annotation key: 'category' value: 'expression simplification'! Class named: 'StorageType' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'bitSize ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! StorageType method! bitSize ^ bitSize! Annotation key: 'category' value: 'accessing'! StorageType method! bitSize: anInteger bitSize _ anInteger! Annotation key: 'category' value: 'accessing'! StorageType method! byteSize ^ (bitSize + 7) / 8! Annotation key: 'category' value: 'accessing'! StorageType method! byteSizeSize: anInteger byteSize _ bitSize * 8! Annotation key: 'category' value: 'accessing'! StorageType method! mayContain: aStorageType ^ (aStorageType isKindOf: self class) and: [aStorageType bitSize <= bitSize]! Annotation key: 'category' value: 'analyzing'! StorageType method! = aStorageType ^ self class = aStorageType class and: [bitSize = aStorageType bitSize]! Annotation key: 'category' value: 'comparing'! Class named: 'ConditionStorageType' superclass: 'StorageType' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'FloatStorageType' superclass: 'StorageType' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'IntegerStorageType' superclass: 'StorageType' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'PointerStorageType' superclass: 'IntegerStorageType' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'LiveRange ' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'start end ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Register Allocation'! LiveRange method! start ^ start! Annotation key: 'category' value: 'accessing'! LiveRange method! start: anInteger start _ anInteger! Annotation key: 'category' value: 'accessing'! LiveRange method! end ^ end! Annotation key: 'category' value: 'accessing'! LiveRange method! end: anInteger end _ anInteger! Annotation key: 'category' value: 'accessing'! Class named: 'Storage' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'storageType ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Storage method! storageType ^ storageType! Annotation key: 'category' value: 'accessing'! Storage method! storageType: aStorageType storageType _ aStorageType! Annotation key: 'category' value: 'accessing'! Storage method! sequence ^ #unknown! Annotation key: 'category' value: 'loop analysis'! Storage method! loopInvariantFor: aLoop ^ self sequence = #invariant! Annotation key: 'category' value: 'loop analysis'! Storage method! mayLinkUsesToDefinitions ^ false! Annotation key: 'category' value: 'SSA translation'! Storage method! mayLinkDefinitionsToUses ^ false! Annotation key: 'category' value: 'dead store elimination'! Storage method! operandHash ^ self hash! Annotation key: 'category' value: 'partial redundancy elimination'! Storage method! operandCompare: aStorage ^ self == aStorage! Annotation key: 'category' value: 'partial redundancy elimination'! Storage method! expressionDepth: anExpressionDictionary ^ 0! Annotation key: 'category' value: 'partial redundancy elimination'! Class named: 'Constant' superclass: 'Storage' indexedInstanceVariables: #none instanceVariableNames: 'value ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Constant method! value ^ value! Annotation key: 'category' value: 'accessing'! Constant method! value: anObject value _ anObject! Annotation key: 'category' value: 'accessing'! Constant method! sequence ^ #invariant! Annotation key: 'category' value: 'loop analysis'! Constant method! operandHash ^ self class hash + value hash! Annotation key: 'category' value: 'partial redundancy elimination'! Constant method! operandCompare: aConstant ^ self class == aConstant class and: [value = aConstant value]! Annotation key: 'category' value: 'partial redundancy elimination'! Constant method! = aConstant ^ self class == aConstant class and: [value = aConstant value]! Annotation key: 'category' value: 'comparing'! Class named: 'Label' superclass: 'Storage' indexedInstanceVariables: #none instanceVariableNames: 'target ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Label method! target ^ target! Annotation key: 'category' value: 'accessing'! Label method! target: anObject target _ anObject! Annotation key: 'category' value: 'accessing'! Label method! sequence ^ #invariant! Annotation key: 'category' value: 'partial redundancy elimination'! Label method! operandHash ^ self class hash + target hash! Annotation key: 'category' value: 'partial redundancy elimination'! Label method! operandCompare: aLabel ^ target == aLabel target! Annotation key: 'category' value: 'partial redundancy elimination'! Class named: 'BasicBlockLabel' superclass: 'Label' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'FunctionLabel' superclass: 'Label' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'MemoryAlias' superclass: 'Storage' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'MemoryLocation' superclass: 'Storage' indexedInstanceVariables: #none instanceVariableNames: 'base offset aliases ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! MemoryLocation classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! MemoryLocation method! initialize aliases _ Set new! Annotation key: 'category' value: 'initializing'! MemoryLocation method! aliases ^ aliases! Annotation key: 'category' value: 'accessing'! MemoryLocation method! aliases: aMemoryLocation ^ aliases includes: aMemoryLocation! Annotation key: 'category' value: 'accessing'! MemoryLocation method! base ^ base! Annotation key: 'category' value: 'accessing'! MemoryLocation method! base: anInstructionOrConstant base _ anInstructionOrConstant! Annotation key: 'category' value: 'accessing'! MemoryLocation method! offset ^ offset! Annotation key: 'category' value: 'accessing'! MemoryLocation method! offset: anInstructionOrConstant offset _ anInstructionOrConstant! Annotation key: 'category' value: 'accessing'! MemoryLocation method! hash ^ ((self class hash + storageType hash) hashMultiply + base hash) hashMultiply + offset hash! Annotation key: 'category' value: 'comparing'! MemoryLocation method! = aMemoryLocation ^ self class == aMemoryLocation class and: [storageType = aMemoryLocation storageType] and: [base = aMemoryLocation base] and: [offset = aMemoryLocation offset]! Annotation key: 'category' value: 'comparing'! MemoryLocation method! mayOverlap: aMemoryLocation | start end otherStart otherEnd | start _ ((base isKindOf: Constant) ifTrue: [base] ifFalse: [offset]) value. end _ start + storageType byteSize. otherStart _ ((aMemoryLocation base isKindOf: Constant) ifTrue: [aMemoryLocation base] ifFalse: [aMemoryLocation offset]) value. otherEnd _ start + aMemoryLocation storageType byteSize. ^ (start >= otherStart and: [start < otherEnd]) or: [end >= otherStart and: [end < otherEnd]]! Annotation key: 'category' value: 'alias analysis'! MemoryLocation method! mayAlias: aMemoryLocation self == aMemoryLocation ifTrue: [^ false]. (base isKindOf: Constant) ifTrue: [(aMemoryLocation base isKindOf: Constant) ifTrue: [^ self mayOverlap: aMemoryLocation] ifFalse: [^ true]]. (base == aMemoryLocation base and: [offset isKindOf: Constant] and: [aMemoryLocation offset isKindOf: Constant]) ifTrue: [^ self mayOverlap: aMemoryLocation] ifFalse: [^ true]! Annotation key: 'category' value: 'alias analysis'! MemoryLocation method! mayLinkUsesToDefinitions ^ true! Annotation key: 'category' value: 'SSA translation'! MemoryLocation method! mayLinkDefinitionsToUses ^ true! Annotation key: 'category' value: 'dead store elimination'! Class named: 'Register' superclass: 'Storage' indexedInstanceVariables: #none instanceVariableNames: 'name useCount ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Register method! name ^ name! Annotation key: 'category' value: 'accessing'! Register method! name: aString name _ aString! Annotation key: 'category' value: 'accessing'! Register method! useCount ^ useCount! Annotation key: 'category' value: 'accessing'! Register method! useCount: aninteger useCount _ anInteger! Annotation key: 'category' value: 'accessing'! Class named: 'CompositeRegister' superclass: 'Register' indexedInstanceVariables: #none instanceVariableNames: 'components ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! CompositeRegister method! components ^ components! Annotation key: 'category' value: 'accessing'! CompositeRegister method! components: aRegisterArray components _ aRegisterArray! Annotation key: 'category' value: 'accessing'! Class named: 'Variable' superclass: 'Storage' indexedInstanceVariables: #none instanceVariableNames: 'offset ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Variable method! offset ^ offset! Annotation key: 'category' value: 'accessing'! Variable method! offset: anInteger offset _ anInteger! Annotation key: 'category' value: 'accessing'! Class named: 'GlobalVariable' superclass: 'Variable' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! GlobalVariable method! mayLinkUsesToDefinitions ^ true! Annotation key: 'category' value: 'SSA translation'! GlobalVariable method! mayLinkDefinitionsToUses ^ true! Annotation key: 'category' value: 'dead store elimination'! Class named: 'RegisterVariableLocation' superclass: 'Variable' indexedInstanceVariables: #none instanceVariableNames: 'variable register damaged' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Register Allocation'! RegisterVariableLocation method! variable ^ variable! Annotation key: 'category' value: 'accessing'! RegisterVariableLocation method! variable: aRegisterVariable variable _ aRegisterVariable! Annotation key: 'category' value: 'accessing'! RegisterVariableLocation method! register ^ register! Annotation key: 'category' value: 'accessing'! RegisterVariableLocation method! register: aRegister register _ aRegister! Annotation key: 'category' value: 'accessing'! RegisterVariableLocation method! damaged ^ damaged! Annotation key: 'category' value: 'accessing'! RegisterVariableLocation method! damaged: aBoolean damaged _ aBoolean! Annotation key: 'category' value: 'accessing'! Class named: 'RegisterVariable' superclass: 'Variable' indexedInstanceVariables: #none instanceVariableNames: 'register spilled damaged liveRanges weight ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! RegisterVariable classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! RegisterVariable method! initialize spilled _ false. damaged _ true. weight _ 1! Annotation key: 'category' value: 'initializing'! RegisterVariable method! register ^ register! Annotation key: 'category' value: 'accessing'! RegisterVariable method! register: aRegister register _ aRegister! Annotation key: 'category' value: 'accessing'! RegisterVariable method! usesFixedRegister ^ false! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! spilled ^ spilled! Annotation key: 'category' value: 'accessing'! RegisterVariable method! spilled: aBoolean spilled _ aBoolean! Annotation key: 'category' value: 'accessing'! RegisterVariable method! damaged ^ damaged! Annotation key: 'category' value: 'accessing'! RegisterVariable method! damaged: aBoolean damaged _ aBoolean! Annotation key: 'category' value: 'accessing'! RegisterVariable method! liveRanges ^ liveRanges! Annotation key: 'category' value: 'accessing'! RegisterVariable method! locationAt: anInteger ^ RegisterVariableLocation new variable: self; register: ((self liveAt: anInteger) ifTrue: [register] ifFalse: []); damaged: damaged! Annotation key: 'category' value: 'accessing'! RegisterVariable method! holeAt: anInteger ^ self register notNil and: [liveRanges first start >= anInteger]! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! holeIncluding: aRegisterVariable ^ self holeAt: aRegisterVariable liveRanges last end! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! liveAt: anInteger ^ self register notNil and: [spilled not] and: [liveRanges first start <= anInteger]! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! reloadAt: anInteger ^ self register notNil and: [spilled] and: [liveRanges first start <= anInteger]! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! weight ^ (end - start) / weight! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! weight: anInstruction | newWeight | newWeight _ 1. anInstruction basicBlock region loop ifNotNilDo: [:loop | newWeight _ loop depth + 1]. weight _ weight max: newWeight! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! useLiveRangeAt: anInteger liveRanges ifNil: [liveRanges _ OrderedCollection new]. (liveRanges isEmpty or: [liveRanges first start notNil]) ifTrue: [liveRanges addFirst: (LiveRange new end: anInteger)]! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! defineLiveRangeAt: anInteger self useLiveRangeAt: anInteger. liveRanges first start: anInteger! Annotation key: 'category' value: 'register allocation'! RegisterVariable method! removeLiveRangeAt: anInteger liveRanges first end <= anInteger ifTrue: [liveRanges removeFirst]! Annotation key: 'category' value: 'register allocation'! Class named: 'LocalVariable' superclass: 'RegisterVariable' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! LocalVariable method! mayLinkUsesToDefinitions ^ true! Annotation key: 'category' value: 'SSA translation'! Class named: 'InputOutputVariable' superclass: 'RegisterVariable' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! InputOutputVariable method! usesFixedRegister ^ self register notNil! Annotation key: 'category' value: 'register allocation'! Class named: 'InputVariable' superclass: 'InputOutputVariable' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'OutputVariable' superclass: 'InputOutputVariable' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Storage'! Class named: 'ListElement' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'nextElement previousElement' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Support'! ListElement method! nextElement ^ nextElement! Annotation key: 'category' value: 'accessing'! ListElement method! nextElement: aListElement nextElement _ aListElement! Annotation key: 'category' value: 'accessing'! ListElement method! previousElement ^ previousElement! Annotation key: 'category' value: 'accessing'! ListElement method! previousElement: aListElement previousElement _ aListElement! Annotation key: 'category' value: 'accessing'! ListElement method! addBefore: aListElement previousElement _ aListElement previousElement. nextElement _ aListElement. previousElement nextElement: self. nextElement previousElement: self! Annotation key: 'category' value: 'adding'! ListElement method! addAfter: aListElement self addBefore: aListElement nextElement! Annotation key: 'category' value: 'adding'! ListElement method! remove nextElement previousElement: previousElement. previousElement nextElement: nextElement! Annotation key: 'category' value: 'removing'! Class named: 'List' superclass: 'ListElement' indexedInstanceVariables: #none instanceVariableNames: 'size ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Support'! List classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! List method! initialize self clear! Annotation key: 'category' value: 'initializing'! List method! size ^ size! Annotation key: 'category' value: 'accessing'! List method! first ^ self nextElement! Annotation key: 'category' value: 'accessing'! List method! last ^ self previousElement! Annotation key: 'category' value: 'accessing'! List method! clear size _ 0. self nextElement: self. self previousElement: self! Annotation key: 'category' value: 'removing'! List method! isEmpty ^ size = 0! Annotation key: 'category' value: 'testing'! List method! notEmpty ^ size ~= 0! Annotation key: 'category' value: 'testing'! List method! addFirst: aListElement ^ self add: aListElement before: self first! Annotation key: 'category' value: 'adding'! List method! addLast: aListElement ^ self add: aListElement before: self! Annotation key: 'category' value: 'adding'! List method! add: newListElement before: oldListElement size _ size + 1. ^ newListElement addBefore: oldListElement! Annotation key: 'category' value: 'adding'! List method! add: newListElement after: oldListElement ^ self add: aListElement before: oldListElement nextElement! Annotation key: 'category' value: 'adding'! List method! add: aListElement ^ self addLast: aListElement! Annotation key: 'category' value: 'adding'! List method! addAll: aCollection aCollection do: [:element | self add: element]. ^ aCollection! Annotation key: 'category' value: 'adding'! List method! remove: aListElement size _ size - 1. ^ aListElement remove! Annotation key: 'category' value: 'removing'! List method! removeFirst ^ self remove: self first! Annotation key: 'category' value: 'removing'! List method! removeLast ^ self remove: self last! Annotation key: 'category' value: 'removing'! List method! removeAll: aCollection aCollection do: [:element | self remove: element]. ^ aCollection! Annotation key: 'category' value: 'removing'! List method! do: aBlock | element | element _ self first. [element == self] whileFalse: [element _ element nextElement. aBlock value: element previousElement]! Annotation key: 'category' value: 'enumerating'! List method! reverseDo: aBlock | element | element _ self last. [element = self] whileFalse: [element _ element previousElement. aBlock value: element nextElement]! Annotation key: 'category' value: 'enumerating'! List method! concatenateFirst: aList aList isEmpty ifTrue: [^ self]. size _ size + aList size. self first previousElement: aList last. aList last nextElement: self first. self nextElement: aList first. self first previousElement: self. aList clear! Annotation key: 'category' value: 'adding'! List method! concatenateLast: aList aList isEmpty ifTrue: [^ self]. size _ size + aList size. self last nextElement: aList first. aList first previousElement: self last. self previousElement: aList last. self last nextElement: self. aList clear! Annotation key: 'category' value: 'adding'! Class named: 'ExpressionSet' superclass: 'PluggableSet' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Support'! ExpressionSet classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! ExpressionSet classMethod! new: anInteger ^ (super new: anInteger) initialize! Annotation key: 'category' value: 'instance creation'! ExpressionSet method! initialize self hashBlock: [:instruction | instruction expressionHash]. self equalBlock: [:x :y | x expressionCompare: y]! Annotation key: 'category' value: 'initializing'! Class named: 'ExpressionDictionary' superclass: 'PluggableDictionary' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Support'! ExpressionDictionary classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! ExpressionDictionary classMethod! new: anInteger ^ (super new: anInteger) initialize! Annotation key: 'category' value: 'instance creation'! ExpressionDictionary method! initialize self hashBlock: [:instruction | instruction expressionHash]. self equalBlock: [:x :y | x expressionCompare: y]! Annotation key: 'category' value: 'initializing'! Class named: 'ScopedExpressionDictionary' superclass: 'PluggableScopedDictionary' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Support'! ScopedExpressionDictionary classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! ScopedExpressionDictionary classMethod! new: anInteger ^ (super new: anInteger) initialize! Annotation key: 'category' value: 'instance creation'! ScopedExpressionDictionary method! initialize self hashBlock: [:instruction | instruction expressionHash]. self equalBlock: [:x :y | x expressionCompare: y]! Annotation key: 'category' value: 'initializing'! Class named: 'ScopedDictionaryEntry' superclass: 'Association' indexedInstanceVariables: #none instanceVariableNames: 'nextEntry' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Support'! ScopedDictionaryEntry method! nextEntry ^ nextEntry! Annotation key: 'category' value: 'accessing'! ScopedDictionaryEntry method! nextEntry: aScopedDictionaryEntry nextEntry _ aScopedDictionaryEntry! Annotation key: 'category' value: 'accessing'! ScopedDictionaryEntry method! key: keyObject value: valueObject nextEntry: aScopedDictionaryEntry self key: keyObject value: valueObject. nextEntry _ aScopedDictionaryEntry! Annotation key: 'category' value: 'accessing'! Class named: 'ScopedDictionary' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'scopes ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Support'! ScopedDictionary classMethod! new ^ super new initialize: 16! Annotation key: 'category' value: 'instance creation'! ScopedDictionary classMethod! new: anInteger ^ super new initialize: anInteger! Annotation key: 'category' value: 'instance creation'! ScopedDictionary method! initialize: anInteger scopes _ OrderedCollection with: (Array new: anInteger)! Annotation key: 'category' value: 'initializing'! ScopedDictionary method! pushScope (scopes last isKindOf: Array) ifTrue: [scopes addLast: 1] ifFalse: [scopes last: scopes last + 1]! Annotation key: 'category' value: 'scoping'! ScopedDictionary method! popScope | top | top _ scopes last. (top isKindOf: Array) ifTrue: [scopes removeLast] ifFalse: [top = 1 ifTrue: [scopes removeLast] ifFalse: [scopes last: top - 1]]! Annotation key: 'category' value: 'scoping'! ScopedDictionary method! errorKeyNotFound self error: 'key not found'! Annotation key: 'category' value: 'private'! ScopedDictionary method! topScope | top | top _ scopes last. (top isKindOf: Array) ifFalse: [top = 1 ifTrue: [top _ (scopes at: scopes size - 1) copy. scopes last: top] ifFalse: [scopes last: top - 1. top _ (scopes at: scopes size - 1) copy. scopes addLast: top]]. ^ top! Annotation key: 'category' value: 'private'! ScopedDictionary method! at: anObject ifPresent: presentBlock ifAbsent: absentBlock | top | top _ scopes last. (top isKindOf: Array) ifFalse: [top _ scopes at: scopes size - 1]. (top at: (anObject hash \\ top size) + 1) ifNotNilDo: [:entry | [entry isNotNil] whileTrue: [entry key = anObject ifTrue: [^ presentBlock value: entry value]. entry _ entry nextEntry]]. ^ absentBlock value! Annotation key: 'category' value: 'accessing'! ScopedDictionary method! at: anObject ifAbsent: aBlock ^ self at: anObject ifPresent: [:value | value] ifAbsent: aBlock! Annotation key: 'category' value: 'accessing'! ScopedDictionary method! at: anObject ifPresent: aBlock ^ self at: anObject ifPresent: aBlock ifAbsent: []! Annotation key: 'category' value: 'accessing'! ScopedDictionary method! at: anObject ^ self at: anObject ifAbsent: [self errorKeyNotFound]! Annotation key: 'category' value: 'accessing'! ScopedDictionary method! at: keyObject put: valueObject | top hash | top _ self topScope. hash _ (keyObject hash \\ top size) + 1. (top at: hash) ifNotNilDo: [:entry | [entry isNotNil] whileTrue: [entry key = keyObject ifTrue: [entry value: valueObject. ^ valueObject]. entry _ entry nextEntry]]. top at: hash put: (ScopedDictionaryEntry new key: keyObject value: valueObject nextEntry: (top at: hash)). ^ valueObject! Annotation key: 'category' value: 'accessing'! Class named: 'PluggableScopedDictionary' superclass: 'ScopedDictionary' indexedInstanceVariables: #none instanceVariableNames: 'hashBlock equalBlock ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Support'! PluggableScopedDictionary method! hashBlock ^ hashBlock! Annotation key: 'category' value: 'accessing'! PluggableScopedDictionary method! hashBlock: aBlock hashBlock _ aBlock! Annotation key: 'category' value: 'accessing'! PluggableScopedDictionary method! equalBlock ^ equalBlock! Annotation key: 'category' value: 'accessing'! PluggableScopedDictionary method! equalBlock: aBlock equalBlock _ aBlock! Annotation key: 'category' value: 'accessing'! PluggableScopedDictionary method! at: anObject ifPresent: presentBlock ifAbsent: absentBlock | top hash | top _ scopes last. (top isKindOf: Array) ifFalse: [top _ scopes at: scopes size - 1]. hashBlock ifNil: [hash _ anObject hash] ifNotNil: [hash _ hashBlock value: anObject]. (top at: (hash \\ top size) + 1) ifNotNilDo: [:entry | [entry isNotNil] whileTrue: [(equalBlock ifNil: [entry key = anObject] ifNotNil: [equalBlock value: entry key value: keyObject]) ifTrue: [^ presentBlock value: entry value]. entry _ entry nextEntry]]. ^ absentBlock value! Annotation key: 'category' value: 'accessing'! PluggableScopedDictionary method! at: keyObject put: valueObject | top hash | top _ self topScope. hashBlock ifNil: [hash _ anObject hash] ifNotNil: [hash _ hashBlock value: keyObject]. hash _ (hash \\ top size) + 1. (top at: hash) ifNotNilDo: [:entry | [entry isNotNil] whileTrue: [(equalBlock ifNil: [entry key = keyObject] ifNotNil: [equalBlock value: entry key value: keyObject]) ifTrue: [entry value: valueObject. ^ valueObject]. entry _ entry nextEntry]]. top at: hash put: (ScopedDictionaryEntry new key: keyObject value: valueObject nextEntry: (top at: hash)). ^ valueObject! Annotation key: 'category' value: 'accessing'! Class named: 'RedundancyClass' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'value definingOccurrence ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! RedundancyClass method! value ^ value! Annotation key: 'category' value: 'accessing'! RedundancyClass method! value: anInstruction value _ anInstruction! Annotation key: 'category' value: 'accessing'! RedundancyClass method! definingOccurrence ^ definingOccurrence! Annotation key: 'category' value: 'accessing'! RedundancyClass method! definingOccurrence: aRedundancyGraphNode definingOccurrence _ aRedundancyGraphNode! Annotation key: 'category' value: 'accessing'! Class named: 'RedundancyGraphNode' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'redundancyGraph redundancyClass successors ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! RedundancyGraphNode classMethod! new ^ super new initialize! Annotation key: 'category' value: 'instance creation'! RedundancyGraphNode method! initialize successors _ OrderedCollection new! Annotation key: 'category' value: 'initializing'! RedundancyGraphNode method! redundancyGraph ^ redundancyGraph! Annotation key: 'category' value: 'accessing'! RedundancyGraphNode method! redundancyGraph: aRedundancyGraph redundancyGraph _ aRedundancyGraph! Annotation key: 'category' value: 'accessing'! RedundancyGraphNode method! redundancyClass ^ redundancyClass! Annotation key: 'category' value: 'accessing'! RedundancyGraphNode method! redundancyClass: aRedundancyClass redundancyClass _ aRedundancyClass! Annotation key: 'category' value: 'accessing'! RedundancyGraphNode method! successors ^ successors! Annotation key: 'category' value: 'accessing'! RedundancyGraphNode method! downSafe ^ true! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! canBeAvailable ^ true! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! latest ^ false! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! needsRepair ^ false! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! needsRepair: aBoolean ! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! accumulateInjury ^ false! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! computeDownSafety ! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! computeCanBeAvailable ! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! computeLatest ! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! computeNeedsRepair ! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! computeRedundancyClass: aRedundancyClass redundancyClass _ aRedundancyClass. ^ aRedundancyClass! Annotation key: 'category' value: 'analyzing'! RedundancyGraphNode method! eliminateRedundancies ! Annotation key: 'category' value: 'restructuring'! RedundancyGraphNode method! receiveFlow: aRedundancyGraphNode ! Annotation key: 'category' value: 'restructuring'! Class named: 'RedundancyGraphEntry' superclass: 'RedundancyGraphNode' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! Class named: 'RedundancyGraphExit' superclass: 'RedundancyGraphNode' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! RedundancyGraphExit method! downSafe ^ false! Annotation key: 'category' value: 'analyzing'! RedundancyGraphExit method! canBeAvailable ^ false! Annotation key: 'category' value: 'analyzing'! Class named: 'OccurrenceNode' superclass: 'RedundancyGraphNode' indexedInstanceVariables: #none instanceVariableNames: 'instruction predecessor ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! OccurrenceNode method! instruction ^ instruction! Annotation key: 'category' value: 'accessing'! OccurrenceNode method! instruction: anInstruction instruction _ anInstruction! Annotation key: 'category' value: 'accessing'! OccurrenceNode method! predecessor ^ predecessor! Annotation key: 'category' value: 'accessing'! OccurrenceNode method! predecessor: aRedundancyGraphNode predecessor _ aRedundancyGraphNode! Annotation key: 'category' value: 'accessing'! Class named: 'ComputationOccurrenceNode' superclass: 'OccurrenceNode' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! ComputationOccurrenceNode method! latest ^ true! Annotation key: 'category' value: 'analyzing'! ComputationOccurrenceNode method! computeRedundancyClass: aRedundancyClass self redundancyClass: ((aRedundancyClass isNil) ifTrue: [RedundancyClass new value: (self redundancyGraph substitutions at: self instruction ifAbsent: [self instruction]) definingOccurrence: self] ifFalse: [aRedundancyClass]). ^ self redundancyClass! Annotation key: 'category' value: 'analyzing'! ComputationOccurrenceNode method! computeNeedsRepair | predecessor latestRepair | predecessor _ self predecessor. latestRepair _ nil. [((predecessor isKindOf: RedefinitionOccurrenceNode) and: [self redundancyGraph template isInjuredBy: predecessor instruction]) or: [predecessor isKindOf: TestOccurrenceNode]] whileTrue: [((predecessor isKindOf: RedefinitionOccurenceNode) and: [self redundancyGraph template canAccumulateInjury: predecessor instruction]) ifTrue: [(latestRepair notNil and: [latestRepair instruction outputOperand == predecessor instruction outputOperand]) ifTrue: [predecessor accumulateInjury: true] ifFalse: [predecessor needsRepair: true. latestRepair _ predecessor]] ifFalse: [predecessor needsRepair: true. latestRepair _ nil]. predecessor _ predecessor predecessor]! Annotation key: 'category' value: 'analyzing'! ComputationOccurrenceNode method! eliminateRedundancies | redundancyClass move | redundancyClass _ self predecessor redundancyClass. redundancyClass ifNil: [redundancyClass _ self redundancyClass]. redundancyClass definingOccurrence == self ifFalse: [redundancyClass value outputOperands > 0 ifTrue: [self redundancyGraph substitutions at: self instruction ifAbsentPut: [redundancyClass value outputOperand == self redundancyGraph temporaryVariable ifFalse: [move _ MoveInstruction new operands: (Array with: self redundancyGraph temporaryVariable with: redundancyClass value). (self redundancyGraph assignments at: move outputOperand ifAbsentPut: [OrderedCollection new]) addLast: move. redundancyClass value basicBlock add: move. redundancyClass value: move]. redundancyClass value]] ifFalse: [self instruction basicBlock remove: self instruction]]! Annotation key: 'category' value: 'restructuring'! Class named: 'TestOccurrenceNode' superclass: 'OccurrenceNode' indexedInstanceVariables: #none instanceVariableNames: '' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! TestOccurrenceNode method! downSafe ^ self successors allSatisfy: [:successor | successor downSafe]! Annotation key: 'category' value: 'analyzing'! TestOccurrenceNode method! canBeAvailable ^ self predecessor canBeAvailable! Annotation key: 'category' value: 'analyzing'! TestOccurrenceNode method! latest ^ self predessor latest! Annotation key: 'category' value: 'analyzing'! TestOccurrenceNode method! redundancyClass ^ self predecessor redundancyClass! Annotation key: 'category' value: 'analyzing'! TestOccurrenceNode method! computeRedundancyClass: aRedundancyClass redundancyClass _ aRedundancyClass. ^ aRedundancyClass! Annotation key: 'category' value: 'analyzing'! TestOccurrenceNode method! eliminateRedundancies (self redundancyClass notNil and: [self redundancyClass value notNil]) ifTrue: [self redundancyGraph template replaceTest: self instruction fromValue: self redundancyClass value in: self redundancyGraph]! Annotation key: 'category' value: 'restructuring'! Class named: 'RedefinitionOccurrenceNode' superclass: 'OccurrenceNode' indexedInstanceVariables: #none instanceVariableNames: 'needsRepair accumulateInjury ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! RedefinitionOccurrenceNode method! initialize super initialize. needsRepair _ false. accumulateInjury _ false! Annotation key: 'category' value: 'initializing'! RedefinitionOccurrenceNode method! downSafe ^ false! Annotation key: 'category' value: 'analyzing'! RedefinitionOccurrenceNode method! canBeAvailable ^ false! Annotation key: 'category' value: 'analyzing'! RedefinitionOccurrenceNode method! needsRepair ^ needsRepair! Annotation key: 'category' value: 'accessing'! RedefinitionOccurrenceNode method! needsRepair: aBoolean needsRepair _ aBoolean! Annotation key: 'category' value: 'accessing'! RedefinitionOccurrenceNode method! accumulateInjury ^ accumulateInjury! Annotation key: 'category' value: 'accessing'! RedefinitionOccurrenceNode method! accumulateInjury: aBoolean accumulateInjury _ aBoolean! Annotation key: 'category' value: 'accessing'! RedefinitionOccurrenceNode method! computeRedundancyClass: aRedundancyClass ^ nil! Annotation key: 'category' value: 'analyzing'! RedefinitionOccurrenceNode method! eliminateRedundancies | increment predecessor | self redundancyGraph namespace at: self instruction outputOperand put: self instruction. needsRepair ifTrue: [predecessor _ self predecessor. [predecessor accumulateInjury] whileTrue: [predecessor _ predecessor predecessor]. increment _ self redundancyGraph template repairInjury: self instruction fromValue: predecessor redundancyClass value in: self redundancyGraph. predecessor _ self predecessor. [predecessor accumulateInjury] whileTrue: [self redundancyGraph template accumulateInjury: predecessor instruction into: increment. predecessor _ predecessor predecessor]. self redundancyClass: (RedundancyClass new value: increment definingOccurrence: self)]! Annotation key: 'category' value: 'restructuring'! Class named: 'FactoredRedundancyFlow' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'basicBlock predecessor ' classVariableNames: '' sharedPools: '' classInstanceVariablesNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! FactoredRedundancyFlow method! basicBlock ^ basicBlock! Annotation key: 'category' value: 'accessing'! FactoredRedundancyFlow method! basicBlock: aBasicBlock basicBlock _ aBasicBlock! Annotation key: 'category' value: 'accessing'! FactoredRedundancyFlow method! predecessor ^ predecessor! Annotation key: 'category' value: 'accessing'! FactoredRedundancyFlow method! predecessor: aRedundancyGraphNode predecessor _ aRedundancyGraphNode! Annotation key: 'category' value: 'accessing'! Class named: 'FactoredRedundancyNode' superclass: 'RedundancyGraphNode' indexedInstanceVariables: #none instanceVariableNames: 'basicBlock flows merges downSafe canBeAvailable latest ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! FactoredRedundancyNode method! initialize super initialize. merges _ Set new. downSafe _ true. canBeAvailable _ true. latest _ true! Annotation key: 'category' value: 'initializing'! FactoredRedundancyNode method! basicBlock ^ basicBlock! Annotation key: 'category' value: 'accessing'! FactoredRedundancyNode method! basicBlock: aBasicBlock | flows index | flows _ Array new: aBasicBlock countPredecessors. index _ 1. aBasicBlock doPredecessors: [:predecessor | flows at: index put: (FactoredRedundancyFlow new basicBlock: predecessor). index _ index + 1]. basicBlock _ aBasicBlock! Annotation key: 'category' value: 'accessing'! FactoredRedundancyNode method! flows ^ flows! Annotation key: 'category' value: 'accessing'! FactoredRedundancyNode method! merges ^ merges! Annotation key: 'category' value: 'accessing'! FactoredRedundancyNode method! downSafe ^ downSafe! Annotation key: 'category' value: 'accessing'! FactoredRedundancyNode method! canBeAvailable ^ canBeAvailable! Annotation key: 'category' value: 'accessing'! FactoredRedundancyNode method! latest ^ latest! Annotation key: 'category' value: 'accessing'! FactoredRedundancyNode method! computeDownSafety downSafe _ self successors allSatisfy: [:successor | successor downSafe]! Annotation key: 'category' value: 'analyzing'! FactoredRedundancyNode method! computeCanBeAvailable downSafe ifFalse: [canBeAvailable _ flows allSatisfy: [:flow | flow predecessor canBeAvailable]]! Annotation key: 'category' value: 'analyzing'! FactoredRedundancyNode method! computeLatest canBeAvailable ifTrue: [latest _ flows anySatisfy: [:flow | flow predecessor latest]]! Annotation key: 'category' value: 'analyzing'! FactoredRedundancyNode method! computeRedundancyClass: aRedundancyClass canBeAvailable & latest ifTrue: [self redundancyClass: ((flows allSatisfy: [:flow | flow predecessor redundancyClass == aRedundancyClass]) ifTrue: [aRedundancyClass] ifFalse: [RedundancyClass new value: (self redundancyGraph template outputOperands > 0 ifTrue: [self redundancyGraph insertMergeAt: self basicBlock]); definingOccurrence: self])]. ^ self redundancyClass! Annotation key: 'category' value: 'analyzing'! FactoredRedundancyNode method! computeNeedsRepair | predecessor latestRepair | canBeAvailable & latest ifFalse: [^ self]. flows do: [:flow | predecessor _ flow predecessor. latestRepair _ nil. [((predecessor isKindOf: RedefinitionOccurrenceNode) and: [self redundancyGraph template isInjuredBy: predecessor instruction]) or: [predecessor isKindOf: TestOccurrenceNode]] whileTrue: [((predecessor isKindOf: RedefeinitionOccurrenceNode) and: [self redundancyGraph template canAccumulateInjury: predecessor instruction]) ifTrue: [(latestRepair notNil and: [latestRepair instruction outputOperand == predecessor instruction outputOperand]) ifTrue: [predecessor accumulateInjury: true] ifFalse: [predecessor needsRepair: true. latestRepair _ predecessor]] ifFalse: [predecessor needsRepair: true. latestRepair _ nil]. predecessor _ predecessor predecessor]]! Annotation key: 'category' value: 'analyzing'! FactoredRedundancyNode method! eliminateRedundancies merges do: [:merge | self redundancyGraph namespace at: merge outputOperand put: merge]! Annotation key: 'category' value: 'restructuring'! FactoredRedundancyNode method! receiveFlow: aRedundancyGraphNode | index value | (self redundancyClass notNil and: [self redundancyClass definingOccurrence == self]) ifTrue: [index _ flows findFirst: [:flow | flow predecessor == aRedundancyGraphNode]. value _ aRedundancyGraphNode redundancyClass ifNotNil: [aRedundancyGraphNode redundancyClass] ifNil: [self redundancyGraph insertComputationAt: (flows at: index) basicBlock]. self redundancyClass value ifNotNil: [self redundancyClass value operands at: index + 1 put: value]]! Annotation key: 'category' value: 'restructuring'! Class named: 'RedundancyGraph' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'function template substitutions namespace assignments merges tests expressions entry exit temporaryVariable' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! RedundancyGraph method! function: aFunction function _ aFunction! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! function ^ function! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! template ^ template! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! substitutions ^ substitutions! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! substitutions: aDictionary substitutions _ aDictionary! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! namespace ^ namespace! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! assignments ^ assignments! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! assignments: aDictionary assignments _ aDictionary! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! merges ^ merges! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! merges: aDictionary merges _ aDictionary! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! tests ^ tests! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! tests: aDictionary tests _ aDictionary! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! expressions ^ expressions! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! expressions: anOrderedCollection expressions _ anOrderedCollection! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! nodes ^ nodes! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! entry ^ entry! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! exit ^ exit! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! temporaryVariable temporaryVariable ifNil: [temporaryVariable _ function allocateLocalVariable: template outputOperand storageType]. ^ temporaryVariable! Annotation key: 'category' value: 'accessing'! RedundancyGraph method! buildNodes | factors predecessors occurrences predecessor operands instruction index | factors _ Dictionary new: 64. index _ 1. [index <= expressions size] whileTrue: [instruction _ expressions at: index. instruction basicBlock doIteratedDominanceFrontier: [:frontier | factors at: frontier ifAbsentPut: [FactoredRedundancyNode new redundancyGraph: self; basicBlock: frontier]]. index _ index + 1. [index <= expressions size and: [(expressions at: index) basicBlock = instruction basicBlock]] whileTrue: [index _ index + 1]]. template doInputOperands: [:operand | merges at: operand outputOperand ifPresent: [:instructions | instructions do: [:merge | (factors at: merge basicBlock ifAbsentPut: [FactoredRedundancyNode new redundancyGraph: self; basicBlock: merge basicBlock]) merges add: merge]]] ifKindOf: Instruction. predecessors _ OrderedCollection new. occurrences _ OrderedCollection new. operands _ Set new. template doInputOperands: [:operand | operands add: operand outputOperand] ifKindOf: Instruction. function entry doDominatorTreeBeforeDescent: [:basicBlock | predecessor _ nil. factors at: basicBlock ifPresent: [:factor | nodes add: factor. predecessor _ factor] ifAbsent: [[predecessors notEmpty and: [(predecessors last basicBlock dominates: basicBlock) not]] whileTrue: [predecessors removeLast]. predecessors isEmpty ifTrue: [predecessor _ entry] ifFalse: [predecessor _ predecessors last]]. occurrences reset. operands do: [:operand | assignments at: operand ifPresent: [:instructions | index _ 1. [index <= instructions size and: [instruction _ instructions at: index. index _ index + 1. instruction basicBlock == basicBlock]] whileTrue: [occurrences add: (RedefinitionOccurrenceNode new redundancyGraph: self; instruction: instruction)]]. [tests notNil] ifTrue: [tests at: operand ifPresent: [:instructions | index _ 1. [index <= instructions size and: [instruction _ instructions at: index. index _ index + 1. instruction basicBlock == basicBlock]] whileTrue: [occurrences add: (RedefinitionOccurrenceNode new redundancyGraph: self; instruction: instruction)]]]]. index _ 1. [index <= expressions size and: [instruction _ expressions at: index. index _ index + 1. instruction basicBlock == basicBlock]] whileTrue: [occurrences add: (ComputationOccurrenceNode new redundancyGraph: self; instruction: instruction)]. occurrences notEmpty ifTrue: [(occurrences asSortedCollection: [:x :y | (x instruction == y instruction and: [x isKindOf: ComputationOccurrenceNode]) or: [x instruction dominates: y instruction]]) do: [:occurrence | occurrence predecessor: predecessor. predecessor successors add: occurrence. nodes add: occurrence. predecessor _ occurrence]. predecessors add: predecessor]. [basicBlock exits isEmpty] ifTrue: [predecessor successors add: exit]. basicBlock doSuccessors: [:successor | factors at: successor ifPresent: [:factor | (factor flows detect: [:flow | flow basicBlock == basicBlock]) predecessor: predecessor]]]! Annotation key: 'category' value: 'private'! RedundancyGraph method! computeDownSafety nodes reverseDo: [:node | node computeDownSafety]! Annotation key: 'category' value: 'analyzing'! RedundancyGraph method! computeCanBeAvailable nodes do: [:node | node computeCanBeAvailable]! Annotation key: 'category' value: 'analyzing'! RedundancyGraph method! computeLatest nodes do: [:node | node computeLatest]! Annotation key: 'category' value: 'analyzing'! RedundancyGraph method! computeRedundancyClass nodes inject: nil into: [:redundancyClass :node | node computeRedundancyClass: redundancyClass]! Annotation key: 'category' value: 'analyzing'! RedundancyGraph method! computeNeedsRepair nodes do: [:node | computeNeedsRepair]! Annotation key: 'category' value: 'analyzing'! RedundancyGraph method! insertMergeAt: aBasicBlock | merge | merge _ MergeInstruction new operands: (Array new: aBasicBlock countPredecessors + 1). merge outputOperand: self temporaryVariable. (merges at: merge outputOperand ifAbsentPut: [OrderedCollection new]) addLast: merge. aBasicBlock addFirst: merge. ^ merge! Annotation key: 'category' value: 'restructuring'! RedundancyGraph method! insertComputationAt: aBasicBlock | computation | computation _ template class new operands: (template operands copy). template outputOperands > 0 ifTrue: [computation outputOperand: self temporaryVariable. (assignments at: computation outputOperand ifAbsentPut: [OrderedCollection new]) addLast: computation]. template doInputOperandsWithIndex: [:operand :index | (operand isKindOf: Instruction) ifTrue: [computation operands at: index put: (namespace at: operand outputOperand)]]. aBasicBlock add: computation. ^ computation! Annotation key: 'category' value: 'restructuring'! RedundancyGraph method! eliminateRedundancies | scopeOwner | nodes _ OrderedCollection new: 2 * expressionDictionary size. entry _ RedundancyGraphEntry new. exit _ RedundancyGraphExit new. self buildNodes. self computeDownSafety. self computeCanBeAvailable. self computeLatest. self computeRedundancyClass. template strengthReductionCandidate ifTrue: [self computeNeedsRepair]. namespace _ ScopedDictionary new. namespace pushScope. scopeOwner _ OrderedCollection new: 16. nodes do: [:node | [scopeOwner last basicBlock dominates: node instruction basicBlock] whileFalse: [namespace popScope. scopeOwner removeLast]. ((node predecessor isKindOf: FactoredRedundancyNode) and: [node predecessor successors size > 1]) ifTrue: [namespace pushScope. scopeOwner addLast: node instruction basicBlock]. node eliminateRedundancies. node successors do: [:successor | successor receiveFlow: node]]! Annotation key: 'category' value: 'restructuring'! Class named: 'PartialRedundancyEliminator' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'function assignments merges tests expressions ordering substitutions ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Redundancy Elimination'! PartialRedundancyEliminator method! function ^ function! Annotation key: 'category' value: 'accessing'! PartialRedundancyEliminator method! function: aFunction function _ aFunction! Annotation key: 'category' value: 'accessing'! PartialRedundancyEliminator method! assignments ^ assignments! Annotation key: 'category' value: 'accessing'! PartialRedundancyEliminator method! merges ^ merges! Annotation key: 'category' value: 'accessing'! PartialRedundancyEliminator method! tests ^ tests! Annotation key: 'category' value: 'accessing'! PartialRedundancyEliminator method! substitutions ^ substitutions! Annotation key: 'category' value: 'accessing'! PartialRedundancyEliminator method! collectExpressions | depths | assignments _ Dictionary new. merges _ Dictionary new. tests _ Dictionary new. expressions _ ExpressionDictionary new. depths _ ExpressionDictionary new. ordering _ OrderedCollection new. function entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock 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]]]]. depths keysAndValuesDo: [:expression :depth | depth > ordering size ifTrue: [(depth - ordering size) timesRepeat: [ordering addLast: OrderedCollection new]]. (ordering at: depth) add: (expressions at: expression)]! Annotation key: 'category' value: 'analyzing'! PartialRedundancyEliminator method! eliminatePartialRedundancies | template currentExpressions newExpressions | self collectExpressions. substitutions _ Dictionary new. ordering do: [:stage | [stage notEmpty] whileTrue: [currentExpressions _ stage removeFirst. currentExpressions size > 1 ifTrue: [template _ currentExpressions first copy. expressions at: template put: (expressions removeKey: template). currentExpressions do: [:instruction | (instruction substituteOperands: substitutions) > 0 ifTrue: [newExpressions _ expressions at: instruction ifAbsentPut: [stage addLast: OrderedCollection new]. currentExpressions == newExpressions ifFalse: [newExpressions add: instruction]]]. (RedundancyGraph new function: function; template: template; substitutions: substitutions; expressions: currentExpressions; assignments: assignments; merges: merges; tests: (template strengthReductionCandidate ifTrue: [tests])) eliminateRedundancies]]]! Annotation key: 'category' value: 'restructuring'! Class named: 'RegisterAllocator' superclass: 'Object' indexedInstanceVariables: #none instanceVariableNames: 'function currentTime allocatedVariables freeRegisters calleeSaveRegisters modifiedRegisters' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'comment' value: ''! Annotation key: 'package' value: 'Squeampiler-Register Allocation'! RegisterAllocator classMethod! for: aFunction ^ super new for: aFunction! Annotation key: 'category' value: 'instance creation'! RegisterAllocator method! for: aFunction function _ aFunction! Annotation key: 'category' value: 'initializing'! RegisterAllocator method! allocateRegisters | ordering | self computeLiveness. allocatedVariables _ Set new. currentTime _ 0. ordering _ OrderedCollection new. function exit doPostDominatorTreeBeforeDescent: [:basicBlock | ordering addFirst: basicBlock. self computeLiveRangesFor: basicBlock]. freeRegisters _ aFunction compilationUnit architecture callerSaveRegisters copy. calleeSaveRegisters _ aFunction compilationUnit architecture calleeSaveRegisters copy. modifiedRegisters _ Set new. allocatedVariables _ Set new. freeRegisters do: [:register | register useCount: 0]. calleeSaveRegisters do: [:register | register useCount: 0]. function inputVariables do: [:inputVariable | allocatedVariables add: inputVariable. inputVariable register ifNotNil: [inputVariable register useCount: 1. freeRegisters remove: inputVariable register] ifNil: [inputVariable spilled: true. inputVariable damaged: false]]. ordering do: [:basicBlock | self allocateRegistersFor: basicBlock]. ordering do: [:basicBlock | self resolveAllocationConflictsFor: basicBlock]. function allocatedRegisters: modifiedRegisters! Annotation key: 'category' value: 'restructuring'! RegisterAllocator method! resolveAllocationConflictsFor: aBasicBlock | used spills reloads copies remap workList copy source temporary | used _ Set new. spills _ OrderedCollection new. reloads _ OrderedCollection new. copies _ OrderedCollection new. remap _ Dictionary new. workList _ OrderedCollection new. aBasicBlock doSuccessors: [:successor | successor locationIn doKeysAndValues: [:registerVariable :destination | source _ aBasicBlock locationOut at: registerVariable. (destination register isNil or: [source register isNil] or: [destination damaged] or: [source damaged not]) ifFalse: [copy _ SpillInstruction new operands: (Array with: registerVariable with: source register). source damaged: false. spills add: copy]. destination register == source register ifFalse: [destination register ifNotNil: [source register ifNotNil: [copy _ Array with: destination register with: source. copies add: copy. used add: source register] ifNil: [copy _ ReloadInstructions new operands: (Array with: destination register with: registerVariable). reloads add: copy]] ifNil: [copy _ SpillInstruction new operands: (Array with: registerVariable with: source register). spills add: copy]]]]. spills do: [:spill | aBasicBlock add: spill]. copies do: [:nextCopy | (used includes: (copy at: 1)) ifFalse: [workList add: nextCopy. copies remove: nextCopy]]. [workList notEmpty or: [copies notEmpty]] whileTrue: [[workList notEmpty] whileTrue: [copy _ workList removeLast. source _ copy at: 2. remap at: source register ifPresent: [:newSource | copy at: 2 put: newSource] ifAbsent: [copy at: 2 put: source register]. aBasicBlock add: (((copy at: 2) isKindOf: RegisterVariable) ifTrue: [ReloadInstruction new operands: copy] ifFalse: [MoveInstruction new operands: copy]). remap at: source register put: (copy at: 1). (copies detect: [:nextCopy | (nextCopy at: 1) == source register] ifNone: []) ifNotNilDo: [:nextCopy | workList add: nextCopy]]. copies notEmpty ifTrue: [copy _ copies removeLast. workList add: copy. source _ copy at: 2. aBasicBlock freeOut notEmpty ifTrue: [temporary _ aBasicBlock freeOut anyone. aBasicBlock freeOut remove: temporary. modifiedRegisters add: temporary. remap at: source register put: temporary. aBasicBlock add: (MoveInstruction new operands: (Array with: temporary with: source register))] ifFalse: [remap at: source register put: source variable. source damaged ifTrue: [aBasicBlock add: (SpillInstruction new operands: (Array with: source variable with: source register))]]]]. reloads do: [:reload | aBasicBlock add: reload]! Annotation key: 'category' value: 'restructuring'! RegisterAllocator method! computeLiveness function entry doDominatorTreeBeforeDescent: [:basicBlock | basicBlock liveIn: nil. basicBlock liveOut: nil]. function exit liveOut: function outputVariables asSet. function entry region doBackwardDataflow: [:basicBlock | basicBlock liveOut ifNil: [basicBlock liveOut: Set new]. basicBlock doSuccessors: [:successor | successor liveIn ifNotNil: [basicBlock liveOut addAll: successor liveIn]]. basicBlock liveIn: basicBlock liveOut copy. basicBlock reverseDo: [:instruction | instruction doOutputOperands: [:operand | region liveIn remove: operand ifAbsent: []] ifKindOf: RegisterVariable. instruction doInputOperands: [:operand | basicBlock liveIn add: operand] ifKindOf: RegisterVariable]]! Annotation key: 'category' value: 'analyzing'! RegisterAllocator method! computeLiveRangesFor: aBasicBlock aBasicBlock liveOut do: [:registerVariable | registerVariable useLiveRangeAt: currentTime]. allocatedVariables do: [:registerVariable | (aBasicBlock liveOut includes: registerVariable) ifFalse: [allocatedVariables remove: registerVariable. registerVariable defineLiveRangeAt: currentTime]]. allocatedVariables addAll: liveOut. aBasicBlock reverseDo: [:instruction | currentTime _ currentTime - 1. instruction doOutputOperands: [:operand | allocatedVariables remove: operand ifAbsent: []. operand defineLiveRangeAt: currentTime. operand weight: instruction] ifKindOf: RegisterVariable. instruction doInputOperands: [:operand | allocatedVariables add: operand. operand useLiveRangeAt: currentTime. operand weight: instruction] ifKindOf: RegisterVariable]. aBasicBlock entrances ifNil: [liveIn do: [:registerVariable | registerVariable defineLiveRangeAt: currentTime]]! Annotation key: 'category' value: 'analysis'! RegisterAllocator method! allocateRegistersFor: aBasicBlock | calleeRegisters | aBasicBlock locationIn: Dictionary new: allocatedVariables size. aBasicBlock liveIn do: [:registerVariable | "Ensure that the register set is consistent. Lifetime holes injure it." (registerVariable liveAt: currentTime) ifTrue: [freeRegisters remove: registerVariable register ifAbsent: []]]. allocatedVariables do: [:registerVariable | aBasicBlock locationIn at: registerVariable put: (registerVariable locationAt: currentTime). (aBasicBlockliveIn includes: registerVariable) ifFalse: [freeRegisters add: registerVariable register]]. aBasicBlock do: [:instruction | (instruction isKindOf: CallInstruction) ifTrue: [(instruction atInputOperand: 1) ifKindOf: FunctionLabel thenDo: [:label | calleeRegisters _ label target allocatedRegisters]. allocatedSet do: [:registerVariable | ((registerVariable liveAt: currentTime) and: [function compilationUnit architecture callerSaveRegisters includes: registerVariable register] and: [calleeRegisters isNil or: [calleeRegisters includes: registerVariable register]]) ifTrue: [self spillVariable: aRegisterVariable forDefinition: instruction]]]. instruction doInputOperands: [:operand | operand spilled ifTrue: [self reloadRegisterFor: operand inUse: instruction]] ifKindOf: RegisterVariable. instruction doInputOperands: [:operand | operand liveRanges first end <= currentTime ifTrue: [operand removeLiveRangeAt: currentTime. operand liveRanges isEmpty ifTrue: [operand register useCount: operand register useCount - 1. operand register useCount = 0 ifTrue: [freeRegisters remove: operand register]]]] ifKindOf: RegisterVariable. instruction doOutputOperands: [:operand | (operand liveAt: currentTime) ifFalse: [self allocateRegisterTo: operand inDefinition: instruction]] ifKindOf: RegisterVariable. instruction operands withIndexDo: [:operand :index | (operand isKindOf: RegisterVariable) ifTrue: [instruction operands at: index put: operand register]]]. aBasicBlock freeOut: freeRegisters copy. aBasicBlock locationOut: Dictionary new: allocatedSet size. allocatedVariables do: [:registerVariable | (registerVariable holeAt: currentTime) ifTrue: [aBasicBlock freeOut add: registerVariable register] ifFalse: [aBasicBlock locationOut at: registerVariable put: (registerVariable locationAt: currentTime)]]! Annotation key: 'category' value: 'restructuring'! RegisterAllocator method! reloadRegisterFor: aRegisterVariable inUse: anInstruction | register | register _ self allocateRegisterTo: aRegisterVariable inDefinition: anInstruction. anInstruction basicBlock add: (ReloadInstruction new operands: (Array with: register with: aRegisterVariable)) before: anInstruction. ^ register! Annotation key: 'category' value: 'accounting'! RegisterAllocator method! spillVariable: aRegisterVariable forDefinition: anInstruction aRegisterVariable damaged ifTrue: [anInstruction basicBlock add: (SpillInstruction new operands: (Array with: aRegisterVariable with: aRegisterVariable register)) before: anInstruction]. aRegisterVariable spilled: true. aRegisterVariable damaged: false. aRegisterVariable register useCount: aRegisterVariable register useCount - 1! Annotation key: 'category' value: 'accounting'! RegisterAllocator method! evictRegisterFor: aRegisterVariable inDefinition: anInstruction | evictee | aRegisterVariable usesFixedRegister ifTrue: [evictee _ allocatedVariables detect: [:candidate | (candidate liveAt: anInteger) and: [candidate register == aRegisterVariable register]] ifNone: [^ aRegisterVariable register]] ifFalse: [evictee _ allocatedVariables detectMax: [:candidate | ((candidate liveAt: anInteger) and: [candidate register storageType mayContain: aRegisterVariable storageType]) ifTrue: [candidate weight] ifFalse: [0]]]. self spillVariable: evictee forDefinition: anInstruction. ^ evictee register! Annotation key: 'category' value: 'accounting'! RegisterAllocator method! chooseRegisterFor: aRegisterVariable | choice register | aRegisterVariable usesFixedRegister ifTrue: [(freeRegisters includes: aRegisterVariable register) ifTrue: [^ aRegisterVariable register]. ^ nil]. choice _ allocatedVariables detectMin: [:candidate | ((candidate holeIncludes: aRegisterVariable) and: [candidate register storageType mayContain: aRegisterVariable storageType]) ifTrue: [candidate liveRanges first start] ifFalse: [SmallInteger maxVal]]. choice ifNil: [register _ freeRegisters detect: [:candidate | candidate storageType mayContain: aRegisterVariable storageType] ifNone: []. register ifNotNil: [freeRegisters remove: register] ifNil: [register _ calleeSaveRegisters detect: [:candidate | candidate storageType mayContain: aRegisterVariable storageType] ifNone: []. register ifNotNil: [calleeSaveRegisters remove: register] ifNil: [choice _ allocateSet detectMax: [:candidate | ((candidate holeAt: anInteger) and: [candidate register storageType mayContain: aRegisterVariable storageType]) ifTrue: [candidate weight] ifFalse: [0]]]]]. choice ifNotNil: [^ choice register]. ^ register! Annotation key: 'category' value: 'accounting'! RegisterAllocator method! allocateRegisterTo: aRegisterVariable inDefinition: anInstruction | register | register _ self chooseRegisterFor: aRegisterVariable. register ifNil: [register _ self evictRegisterFor: aRegisterVariable inDefinition: anInstruction]. aRegisterVariable register isNil | aRegisterVariable spilled ifTrue: [allocatedVariables add: aRegisterVariable. register useCount: register useCount + 1]. aRegisterVariable spilled: false. aRegisterVariable damaged: true. aRegisterVariable register: register. modifiedRegisters add: register. ^ register! Annotation key: 'category' value: 'accounting'!