The Trunk: Kernel-mt.1244.mcz

Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-mt.1244.mcz

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

Name: Kernel-mt.1244
Author: mt
Time: 12 July 2019, 9:59:41.866568 am
UUID: d585f898-09cc-094b-98ed-a74204c82019
Ancestors: Kernel-mt.1243

Refactoring of #literalsDo: - Step 2 of 3.

For more information, see http://forum.world.st/Please-Review-Refactoring-for-literalsDo-etc-tp5099756p5100896.html.

=============== Diff against Kernel-mt.1243 ===============

Item was removed:
- ----- Method: AdditionalMethodState>>hasLiteralSuchThat: (in category 'testing') -----
- hasLiteralSuchThat: aBlock
- "Answer true if litBlock returns true for any literal in this array, even if embedded in further array structure.
- This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"
- 1 to: self basicSize do: [:i |
- | propertyOrPragma "<Association|Pragma>" |
- propertyOrPragma := self basicAt: i.
- (propertyOrPragma isVariableBinding
- ifTrue: [(aBlock value: propertyOrPragma key)
- or: [(aBlock value: propertyOrPragma value)
- or: [propertyOrPragma value isArray
- and: [propertyOrPragma value hasLiteralSuchThat: aBlock]]]]
- ifFalse: [propertyOrPragma hasLiteralSuchThat: aBlock]) ifTrue:
- [^true]].
- ^false!

Item was removed:
- ----- Method: CompiledBlock>>allLiterals (in category 'literals') -----
- allLiterals
- ^self homeMethod allLiterals!

Item was removed:
- ----- Method: CompiledBlock>>allSubLiterals (in category 'literals') -----
- allSubLiterals
- | literalsExceptOuter unfoldedSubLiterals |
- literalsExceptOuter := self literals allButLast.
- unfoldedSubLiterals := literalsExceptOuter
- select: [:lit| lit isCompiledCode]
- thenCollect: [:blockMethod| blockMethod allSubLiterals].
- unfoldedSubLiterals ifEmpty:
- [^literalsExceptOuter].
- ^literalsExceptOuter, (unfoldedSubLiterals fold: [:a :b| a, b])!

Item was added:
+ ----- Method: CompiledBlock>>codeLiteralsDo: (in category 'literals') -----
+ codeLiteralsDo: aBlock
+ "Overwritten to not cause infinite loop."
+
+ aBlock value: self.
+
+ self literalsDo: [:literal |
+ (literal isCompiledCode and: [literal ~~ self outerCode]) ifTrue: [
+ literal codeLiteralsDo: aBlock]].!

Item was removed:
- ----- Method: CompiledBlock>>hasLiteral: (in category 'literals') -----
- hasLiteral: literal
- "Answer whether the receiver references the argument, literal."
- 2 to: self numLiterals do: "exclude outerCode"
- [:index | | lit |
- lit := self objectAt: index.
- (lit literalEqual: literal) ifTrue:
- [^true].
- (lit isCompiledCode and: [lit hasLiteral: literal]) ifTrue:
- [^true]].
- ^false!

Item was removed:
- ----- Method: CompiledBlock>>hasLiteralSuchThat: (in category 'literals') -----
- hasLiteralSuchThat: litBlock
- "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure."
- 2 to: self numLiterals do: "exclude outerCode"
- [:index | | lit |
- lit := self objectAt: index.
- ((litBlock value: lit)
- or: [(lit isArray or: [lit isCompiledCode]) and: [lit hasLiteralSuchThat: litBlock]]) ifTrue:
- [^true]].
- ^false!

Item was changed:
  ----- Method: CompiledCode>>allLiterals (in category 'literals') -----
  allLiterals
+ "Skip compiled-code objects. Keep literal arrays, bindings, etc."
+
+ ^ Array streamContents: [:result |
+ self allLiteralsDo: [:literal | result nextPut: literal]]!
- self subclassResponsibility!

Item was added:
+ ----- Method: CompiledCode>>allLiteralsDo: (in category 'literals') -----
+ allLiteralsDo: aBlock
+ "Enumerate all literals thoroughly. Follow nested instances of CompiledCode. Do not treat compiled code as literals here."
+
+ self codeLiteralsDo: [:compiledCode | compiledCode literalsDo: [:literal |
+ literal isCompiledCode ifFalse: [literal allLiteralsDo: aBlock] ]].
+
+ "Enumerate special selectors."
+ self flag: #todo.
+
+ "Enumerate special literals such as true and false."
+ self flag: #todo.!

Item was added:
+ ----- Method: CompiledCode>>codeLiterals (in category 'literals') -----
+ codeLiterals
+
+ ^ Array streamContents: [:stream |
+ self codeLiteralsDo: [:compiledCode | stream nextPut: compiledCode]]!

Item was added:
+ ----- Method: CompiledCode>>codeLiteralsDo: (in category 'literals') -----
+ codeLiteralsDo: aBlock
+ "Enumerate all literals that represent instances of CompiledCode. This is especially required for SistaV1."
+
+ aBlock value: self.
+
+ self literalsDo: [:literal | literal isCompiledCode ifTrue: [
+ literal codeLiteralsDo: aBlock]].!

Item was added:
+ ----- Method: CompiledCode>>hasLiteral: (in category 'literals') -----
+ hasLiteral: aLiteral
+ "Since we cannot enumerate this code's special literals, we have to overwrite this method to invoke the encoder scanner explicitely."
+
+ | scanBlock |
+ (super hasLiteral: aLiteral) ifTrue: [^ true].
+
+ scanBlock := self class
+ scanBlocksForLiteral: aLiteral
+ do: [:primaryScanner :secondaryScanner |
+ "E.g., scanner for SistaV1 or scanner for V3PlusClosures"
+ self signFlag ifTrue: [secondaryScanner] ifFalse: [primaryScanner]].
+
+ self codeLiteralsDo: [:compiledCode |
+ (compiledCode scanFor: scanBlock) ifTrue: [^ true]].
+
+ ^ false!

Item was added:
+ ----- Method: CompiledCode>>hasMethodReturn (in category 'testing') -----
+ hasMethodReturn
+ "Answer whether the receiver has a method-return ('^') in its code."
+
+ | scanner |
+ self codeLiteralsDo: [:compiledCode |
+ scanner := InstructionStream on: compiledCode.
+ (scanner scanFor: [:x | (scanner willReturn
+ and: [scanner willBlockReturn not])
+ "and: [scanner willReturnTopFromMethod not]" "-> Not supported in EncoderForSistaV1"])
+ ifTrue: [^ true]].
+ ^ false!

Item was added:
+ ----- Method: CompiledCode>>isQuick (in category 'testing') -----
+ isQuick
+
+ self subclassResponsibility.!

Item was changed:
  ----- Method: CompiledCode>>literals (in category 'literals') -----
  literals
+
+ ^ Array streamContents: [:result |
+ self literalsDo: [:lit | result nextPut: lit]]!
- "Answer an Array of the literals referenced by the receiver."
- | literals numberLiterals |
- literals := Array new: (numberLiterals := self numLiterals).
- 1 to: numberLiterals do:
- [:index |
- literals at: index put: (self objectAt: index + 1)].
- ^literals!

Item was added:
+ ----- Method: CompiledCode>>literalsDo: (in category 'literals') -----
+ literalsDo: aBlock
+ "Evaluate aBlock for each of the literals referenced by the receiver. Note that this (raw) enumeration addresses *all* objects stored *after* the method header and *before* the first byte code. If you require a deep and meaningful enumeration of literals use #allLiteralsDo: or #codeLiteralsDo:."
+
+ 1 to: self numLiterals do: [:index |
+ aBlock value: (self literalAt: index)].!

Item was changed:
  ----- Method: CompiledCode>>messages (in category 'scanning') -----
  messages
  "Answer a Set of all the message selectors sent by this method."
 
+ | result |
+ result := Set new.
+ self messagesDo: [:selector | result add: selector].
+ ^ result!
- | encoderClass scanner aSet |
- encoderClass := self encoderClass.
- aSet := Set new.
- scanner := InstructionStream on: self.
- scanner scanFor: [ :x |
- | selector |
- (selector := encoderClass selectorToSendOrItselfFor: scanner in: self at: scanner pc) == scanner
- ifFalse:
- [aSet add: selector]
- ifTrue:
- [(encoderClass blockMethodOrNilFor: scanner in: self at: scanner pc) ifNotNil:
- [:blockMethod| aSet addAll: blockMethod messages]].
- false "keep scanning" ].
- ^aSet!

Item was added:
+ ----- Method: CompiledCode>>messagesDo: (in category 'scanning') -----
+ messagesDo: workBlock
+ "Evaluate aBlock with all the message selectors sent by me. Duplicate sends possible."
+
+ | scanner selector  |
+ self isQuick ifTrue: [^ self].
+
+ self codeLiteralsDo: [:compiledCode |
+ scanner := InstructionStream on: compiledCode.
+ scanner scanFor: [ :x |
+ (selector := scanner selectorToSendOrSelf) == scanner
+ ifFalse: [workBlock value: selector].
+ false "keep scanning" ] ].!

Item was removed:
- ----- Method: CompiledCode>>messagesDo:encoderClass:visitedSet: (in category 'private') -----
- messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet
- "The inner engine for messagesDo:"
-
- | scanner |
- scanner := InstructionStream on: self.
- scanner scanFor: [ :x |
- | selector |
- (selector := encoderClass selectorToSendOrItselfFor: scanner in: self at: scanner pc) == scanner
- ifFalse:
- [(visitedSet ifAbsentAdd: selector) ifTrue:
- [aBlock value: selector]]
- ifTrue:
- [(encoderClass blockMethodOrNilFor: scanner in: self at: scanner pc) ifNotNil:
- [:blockMethod|
- blockMethod messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet]].
- false "keep scanning" ]!

Item was removed:
- ----- Method: CompiledCode>>refersTo:bytecodeScanner:thorough: (in category 'literals') -----
- refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough
- "Answer if the receiver refers to the literal.  If the scan block is non-nil, then
- use it to find the literal in bytecode.  If thorough is true, dive down into
- literal arrays and method properties to locate references to the literal there-in."
- 2 to: (self isCompiledBlock
- ifTrue: [self numLiterals] "exclude outerCode or methodClass"
- ifFalse: [self numLiterals - 1]) "exclude selector/properties and methodClass"
-   do: [:i| | lit |
- lit := self objectAt: i.
- (literal == lit or: [literal literalEqual: lit]) ifTrue: [^true]. "== for Float bindingOf: #NaN since NaN ~= NaN"
- lit isCompiledCode
- ifTrue:
- [(lit refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough) ifTrue:
- [^true]]
- ifFalse:
- [thorough ifTrue:
- [lit isVariableBinding
- ifTrue:
- [literal == lit key ifTrue: [^true]]
- ifFalse:
- [(lit isArray
-   and: [(lit hasLiteral: literal)
- or: [literal isVariableBinding
- and: [literal key isSymbol
- and: [lit hasLiteral: literal key]]]]) ifTrue:
- [^true]]]]].
- scanBlockOrNil ifNotNil:
- [(self scanFor: scanBlockOrNil) ifTrue:
- [^true]].
- ^false!

Item was removed:
- ----- Method: CompiledCode>>refersTo:primaryBytecodeScanner:secondaryBytecodeScanner:thorough: (in category 'literals') -----
- refersTo: literal primaryBytecodeScanner: primaryScanBlockOrNil secondaryBytecodeScanner: secondaryScanBlockOrNil thorough: thorough
- "Answer if the receiver refers to the literal.  If the scan blocks are non-nil, then
- use them to find the literal in bytecode.  If thorough is true, dive down into
- literal arrays and method properties to locate references to the literal there-in."
- ^self
- refersTo: literal
- bytecodeScanner: (self signFlag
- ifTrue: [secondaryScanBlockOrNil]
- ifFalse: [primaryScanBlockOrNil])
- thorough: thorough!

Item was changed:
  ----- Method: CompiledCode>>scanFor: (in category 'scanning') -----
  scanFor: byteOrClosure
  "Answer whether the receiver contains the argument as a bytecode, if it is a number,
  or evaluates to true if a block.  If a block it can take from one to four bytes."
  | s end |
  ^(s := InstructionStream on: self)
  scanFor: (byteOrClosure isBlock
  ifTrue: [byteOrClosure numArgs caseOf: {
  [1] -> [byteOrClosure].
  [2] -> [[:byte| byteOrClosure value: byte value: s secondByte]].
  [3] -> [end := self endPC - 2.
  [:byte|
  s pc <= end
  and: [byteOrClosure
  value: byte
  value: s secondByte
  value: s thirdByte]]].
  [4] -> [end := self endPC - 3.
  [:byte|
  s pc <= end
  and: [byteOrClosure
  value: byte
  value: s secondByte
  value: s thirdByte
  value: s fourthByte]]] }]
  ifFalse: [[:instr | instr = byteOrClosure]])
  "
+ SystemNavigation default browseAllSelect: [:m | m scanFor: 134]
- Smalltalk browseAllSelect: [:m | m scanFor: 134]
  "!

Item was added:
+ ----- Method: CompiledCode>>sendsMessage: (in category 'testing') -----
+ sendsMessage: aSelector
+
+ self messagesDo: [:selector |
+ selector = aSelector ifTrue: [^ true]].
+ ^ false!

Item was added:
+ ----- Method: CompiledCode>>sendsSelector: (in category 'testing') -----
+ sendsSelector: aSelector
+
+ self flag: #todo. "mt: Deprecate? AST/Refactoring project needs it..."
+ ^ self sendsMessage: aSelector!

Item was added:
+ ----- Method: CompiledCode>>sendsToSuper (in category 'testing') -----
+ sendsToSuper
+ "Answer whether the receiver sends any message to super."
+
+ | scanner |
+ self codeLiteralsDo: [:compiledCode |
+ scanner := InstructionStream on: compiledCode.
+ (scanner scanFor: (self encoderClass superSendScanBlockUsing: scanner))
+ ifTrue: [^ true]].
+ ^ false!

Item was removed:
- ----- Method: CompiledMethod>>allLiterals (in category 'literals') -----
- allLiterals
- | literals unfoldedSubLiterals |
- literals := self literals.
- unfoldedSubLiterals := literals
- select: [:lit| lit isCompiledCode]
- thenCollect: [:blockMethod| blockMethod allSubLiterals].
- unfoldedSubLiterals ifEmpty:
- [^literals].
- ^literals, (unfoldedSubLiterals fold: [:a :b| a, b])!

Item was added:
+ ----- Method: CompiledMethod>>allLiteralsDo: (in category 'literals') -----
+ allLiteralsDo: aBlock
+ "Overwritten to skip certain (raw) literals."
+
+ " Exclude method selector (or properties) and the method's class."
+ 1 to: self numLiterals - 2 do: [:index |
+ (self literalAt: index) allLiteralsDo: aBlock].
+
+ "Enumerate method selector only through additional method state."
+ self penultimateLiteral isMethodProperties
+ ifTrue: [self penultimateLiteral allLiteralsDo: aBlock].
+
+ "Enumerate special selectors."
+ self flag: #todo.
+
+ "Enumerate special literals such as true and false."
+ self flag: #todo.!

Item was removed:
- ----- Method: CompiledMethod>>hasLiteral: (in category 'literals') -----
- hasLiteral: literal
- "Answer whether the receiver references the argument, literal."
- 2 to: self numLiterals - 1 do: "exclude selector/properties & methodClass"
- [:index | | lit |
- lit := self objectAt: index.
- (lit literalEqual: literal) ifTrue:
- [^true].
- (lit isCompiledCode and: [lit hasLiteral: literal]) ifTrue:
- [^true]].
- ^false!

Item was removed:
- ----- Method: CompiledMethod>>hasLiteralSuchThat: (in category 'literals') -----
- hasLiteralSuchThat: litBlock
- "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure."
- (self penultimateLiteral isMethodProperties
- and: [self penultimateLiteral hasLiteralSuchThat: litBlock]) ifTrue:
- [^true].
- 2 to: self numLiterals + 1 do:
- [:index | | lit |
- lit := self objectAt: index.
- ((litBlock value: lit)
- or: [(lit isArray or: [lit isCompiledCode]) and: [lit hasLiteralSuchThat: litBlock]]) ifTrue:
- [^true]].
- ^false!

Item was removed:
- ----- Method: CompiledMethod>>hasLiteralThorough: (in category 'literals') -----
- hasLiteralThorough: literal
- "Answer true if any literal in this method is literal,
- even if embedded in array structure."
-
- (self penultimateLiteral isMethodProperties
- and: [self penultimateLiteral hasLiteralThorough: literal]) ifTrue:[^true].
- 2 to: self numLiterals - 1 "exclude superclass + selector/properties"
-   do:[:index | | lit |
- (((lit := self objectAt: index) literalEqual: literal)
- or: [(lit isVariableBinding and: [lit key == literal])
- or: [lit isArray and: [lit hasLiteral: literal]]]) ifTrue:
- [^ true]].
- ^ false !

Item was removed:
- ----- Method: CompiledMethod>>literalsDo: (in category 'literals') -----
- literalsDo: aBlock
- "Evaluate aBlock for each of the literals referenced by the receiver."
- 1 to: self numLiterals do:
- [:index |
- aBlock value: (self objectAt: index + 1)]!

Item was removed:
- ----- Method: CompiledMethod>>messages (in category 'scanning') -----
- messages
- "Answer a Set of all the message selectors sent by this method."
-
- | scanner aSet |
- aSet := Set new.
- scanner := InstructionStream on: self.
- scanner scanFor: [ :x |
- | selector |
- (selector := scanner selectorToSendOrSelf) == scanner ifFalse: [
- aSet add: selector ].
- false "keep scanning" ].
- ^aSet!

Item was removed:
- ----- Method: CompiledMethod>>messagesDo: (in category 'scanning') -----
- messagesDo: aBlock
- "Evaluate aBlock exactly once with all the message selectors sent by me."
-
- self isQuick ifFalse:
- [self messagesDo: aBlock
- encoderClass: self encoderClass
- visitedSet: IdentitySet new]!

Item was changed:
  ----- Method: CompiledMethod>>messagesSequence (in category 'scanning') -----
  messagesSequence
- "Answer a Set of all the message selectors sent by this method."
 
+ self flag: #todo. "mt: Better change #messages to return an array instead of a set?"
+ ^ self messages asArray!
- ^Array streamContents:
- [:str| | scanner |
- scanner := InstructionStream on: self.
- scanner scanFor:
- [:x | | selectorOrSelf |
- (selectorOrSelf := scanner selectorToSendOrSelf) == scanner ifFalse:
- [str nextPut: selectorOrSelf].
- false "keep scanning"]]!

Item was changed:
  ----- Method: CompiledMethod>>objectForDataStream: (in category 'file in/out') -----
  objectForDataStream: refStrm
+ "Reconfigure pragma. Example: #(#FFTPlugin #primitiveFFTTransformData 0 0). See FFT >> #pluginTransformData:."
+
+ self primitive = 117 ifTrue: [(self literalAt: 1) at: 4 put: 0].!
-
- self primitive = 117 ifTrue: [self literals first at: 4 put: 0].
- !

Item was changed:
  ----- Method: CompiledMethod>>readsField: (in category 'scanning') -----
  readsField: varIndex
+ "Answer whether the receiver loads the instance variable indexed by the argument."
+
- "Answer whether the receiver loads the instance variable indexed by the  argument."
  | varIndexCode scanner |
  varIndexCode := varIndex - 1.
+ self isQuick ifTrue: [^ self isReturnField and: [self returnField = varIndexCode]].
+
+ self codeLiteralsDo: [:compiledCode |
+ scanner := InstructionStream on: compiledCode.
+ (scanner scanFor: (self encoderClass instVarReadScanBlockFor: varIndexCode using: scanner))
+ ifTrue: [^ true]].
+
+ ^ false!
- self isQuick ifTrue:
- [^self isReturnField and: [self returnField = varIndexCode]].
- scanner := InstructionStream on: self.
- ^scanner scanFor:(self encoderClass instVarReadScanBlockFor: varIndexCode using: scanner)!

Item was changed:
  ----- Method: CompiledMethod>>readsRef: (in category 'scanning') -----
  readsRef: variableBinding
  "Answer whether the receiver reads the value of the argument."
  "eem 5/24/2008 Rewritten to no longer assume the compler uses the
  most compact encoding available (for EncoderForLongFormV3 support)."
+
  | litIndex scanner |
+ (litIndex := self indexOfLiteral: variableBinding) = 0
+ ifTrue: [^false].
+
+ self codeLiteralsDo: [:compiledCode |
+ scanner := InstructionStream on: compiledCode.
+ (scanner scanFor: (self encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner))
+ ifTrue: [^ true]].
+
+ ^ false!
- (litIndex := self indexOfLiteral: variableBinding) = 0 ifTrue:
- [^false].
- scanner := InstructionStream on: self.
- ^scanner scanFor: (self encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner)!

Item was removed:
- ----- Method: CompiledMethod>>refersToLiteral: (in category 'literals') -----
- refersToLiteral:aLiteral
-
- ^self hasLiteral: aLiteral.!

Item was removed:
- ----- Method: CompiledMethod>>sendsSelector: (in category 'literals') -----
- sendsSelector: aSelector
- | scanner |
- scanner := InstructionStream on: self.
- scanner scanFor:
- [:x |
- scanner selectorToSendOrSelf == aSelector ifTrue:
- [^true].
- false "keep scanning"].
- ^false!

Item was removed:
- ----- Method: CompiledMethod>>sendsToSuper (in category 'scanning') -----
- sendsToSuper
- "Answer whether the receiver sends any message to super."
- | scanner |
- scanner := InstructionStream on: self.
- ^scanner scanFor: (self encoderClass superSendScanBlockUsing: scanner)!

Item was changed:
  ----- Method: CompiledMethod>>writesField: (in category 'scanning') -----
  writesField: varIndex
+ "Answer whether the receiver stores into the instance variable indexed by the argument."
- "Answer whether the receiver stores into the instance variable indexed
- by the argument."
 
+ | varIndexCode scanner |
+ self isQuick ifTrue: [^ false].
+ varIndexCode := varIndex - 1.
+
+ self codeLiteralsDo: [:compiledCode |
+ scanner := InstructionStream on: compiledCode.
+ (scanner scanFor: (self encoderClass instVarWriteScanBlockFor: varIndex - 1 using: scanner))
+ ifTrue: [^ true]].
+
+ ^ false!
- | scanner |
- self isQuick ifTrue: [^false].
- scanner := InstructionStream on: self.
- ^scanner scanFor: (self encoderClass instVarWriteScanBlockFor: varIndex - 1 using: scanner)!

Item was changed:
  ----- Method: CompiledMethod>>writesRef: (in category 'scanning') -----
  writesRef: variableBinding
  "Answer whether the receiver writes the value of the argument."
  "eem 5/24/2008 Rewritten to no longer assume the compler uses the
  most compact encoding available (for EncoderForLongFormV3 support)."
+
  | litIndex scanner |
+ (litIndex := self indexOfLiteral: variableBinding) = 0
+ ifTrue: [^ false].
+
+ self codeLiteralsDo: [:compiledCode |
+ scanner := InstructionStream on: compiledCode.
+ (scanner scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner))
+ ifTrue: [^ true]].
+
+ ^ false!
- (litIndex := self indexOfLiteral: variableBinding) = 0 ifTrue:
- [^false].
- scanner := InstructionStream on: self.
- ^scanner scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner)!

Item was removed:
- ----- Method: Pragma>>hasLiteralSuchThat: (in category 'testing') -----
- hasLiteralSuchThat: aBlock
- "Answer true if litBlock returns true for any literal in the receiver, even if embedded in further array structure.
- This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"
- ^(aBlock value: keyword)
-   or: [arguments hasLiteralSuchThat: aBlock]!