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'!

