The Trunk: Kernel-eem.1159.mcz

Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.1159.mcz

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

Name: Kernel-eem.1159
Author: eem
Time: 14 March 2018, 1:12:38.815374 pm
UUID: 93f461ff-a65a-4a12-ba07-7512b7203329
Ancestors: Kernel-eem.1158

Provide the new multiple bytecode set aware scanning machinery in CompiledCode et al.  Have Behavior>>whichSelectorsReferTo:[thorough:] use it.

=============== Diff against Kernel-eem.1158 ===============

Item was removed:
- ----- Method: Behavior>>thoroughWhichSelectorsReferTo:special:byte: (in category 'testing method dictionary') -----
- thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte
- "Answer a set of selectors whose methods access the argument as a
- literal. Dives into the compact literal notation, making it slow but
- thorough "
-
- ^self whichSelectorsReferTo: literal special: specialFlag byte: specialByte thorough: true!

Item was changed:
  ----- Method: Behavior>>whichSelectorsReferTo: (in category 'testing method dictionary') -----
  whichSelectorsReferTo: literal
+ "Answer a Set of selectors whose methods access the argument as a literal."
- "Answer a Set of selectors whose methods access the argument as a
- literal."
 
+ ^self whichSelectorsReferTo: literal thorough: false
- | special byte |
- special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b | byte := b].
- ^self whichSelectorsReferTo: literal special: special byte: byte
 
  "Rectangle whichSelectorsReferTo: #+."!

Item was removed:
- ----- Method: Behavior>>whichSelectorsReferTo:special:byte: (in category 'testing method dictionary') -----
- whichSelectorsReferTo: literal special: specialFlag byte: specialByte
- "Answer a set of selectors whose methods access the argument as a literal."
-
- ^self whichSelectorsReferTo: literal special: specialFlag byte: specialByte thorough: false!

Item was removed:
- ----- Method: Behavior>>whichSelectorsReferTo:special:byte:thorough: (in category 'testing method dictionary') -----
- whichSelectorsReferTo: literal special: specialFlag byte: specialByte thorough: thorough
- "Answer a set of selectors whose methods access the argument as a literal. If thorough is true, then dives into the compact literal notation, making it slow but thorough "
-
- | who |
- who := IdentitySet new.
- self selectorsAndMethodsDo: [ :selector :method |
- (((thorough
- ifFalse: [ method hasLiteral: literal ]
- ifTrue: [ method hasLiteralThorough: literal ]) or: [
- specialFlag and: [ method scanFor: specialByte ] ]) and: [
- literal isVariableBinding not or: [
- "N.B. (method indexOfLiteral: literal) < method numLiterals copes with l;ooking for
- Float bindingOf: #NaN, since (Float bindingOf: #NaN) ~= (Float bindingOf: #NaN)."
- (method indexOfLiteral: literal) ~= 0] ]) ifTrue: [
- who add: selector ] ].
- ^who!

Item was added:
+ ----- Method: Behavior>>whichSelectorsReferTo:thorough: (in category 'testing method dictionary') -----
+ whichSelectorsReferTo: aLiteral thorough: thorough
+ "Answer a set of selectors whose methods access the argument as a literal.
+ If thorough is true, then dives into the compact literal notation, and pragmas,
+ etc, making it slow but thorough "
+
+ | who |
+ who := IdentitySet new.
+ CompiledCode
+ scanBlocksForLiteral: aLiteral
+ do: [:primaryScanner :secondaryScanner |
+ self selectorsAndMethodsDo:
+ [ :selector :method |
+ (method
+ refersTo: aLiteral
+ primaryBytecodeScanner: primaryScanner
+ secondaryBytecodeScanner: secondaryScanner
+ thorough: thorough) ifTrue:
+ [who add: selector]]].
+ ^who!

Item was added:
+ ----- 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 changed:
  ----- 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"
- 2 to: self numLiterals 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 added:
+ ----- Method: CompiledCode class>>scanBlocksForLiteral:do: (in category 'scanning') -----
+ scanBlocksForLiteral: aLiteral do: aBinaryBlock
+ "Evaluate aBinaryBlock with the literal scanners for aLiteral (which will be nil
+ if there are no special bytecodes that access aLiteral), and answer its value."
+ ^aBinaryBlock
+ value: (PrimaryBytecodeSetEncoderClass scanBlockOrNilForLiteral: aLiteral)
+ value: (SecondaryBytecodeSetEncoderClass scanBlockOrNilForLiteral: aLiteral)!

Item was added:
+ ----- 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 or: [thorough])
+ 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 added:
+ ----- 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 added:
+ ----- 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]])
+ "
+ Smalltalk browseAllSelect: [:m | m scanFor: 134]
+ "!

Item was changed:
  ----- 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]].
- 2 to: self numLiterals - 1 do: "exclude superclass + selector/properties"
- [:index |
- ((self objectAt: index) literalEqual: literal) ifTrue: [^true]].
  ^false!

Item was changed:
  ----- Method: CompiledMethod>>indexOfLiteral: (in category 'literals') -----
  indexOfLiteral: literal
  "Answer the literal index of the argument, literal, or zero if none."
+ 2 to: self numLiterals - 1 "exclude selector/properties + methodClass"
- 2 to: self numLiterals - 1 "exclude superclass + selector/properties"
    do:
  [:index |
  literal == (self objectAt: index) ifTrue: [^index - 1]].
  ^0!

Item was added:
+ ----- Method: CompiledMethod>>refersTo:bytecodeScanner:thorough: (in category 'scanning') -----
+ refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough
+ "Override to check method properties"
+ | maybeProperties |
+ (super refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough) ifTrue:
+ [^true].
+ ^thorough
+   and: [(maybeProperties := self penultimateLiteral) isSymbol not
+   and: [(maybeProperties hasLiteralThorough: literal)
+ or: [literal isVariableBinding
+ and: [literal key isSymbol
+ and: [maybeProperties hasLiteralThorough: literal key]]]]]!

Item was removed:
- ----- Method: CompiledMethod>>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."
- ^ (InstructionStream on: self) scanFor: (byteOrClosure isBlock
- ifTrue: [byteOrClosure]
- ifFalse: [[:instr | instr = byteOrClosure]])
- "
- Smalltalk browseAllSelect: [:m | m scanFor: 134]
- "!