The Trunk: Kernel-eem.1133.mcz

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

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

Name: Kernel-eem.1133
Author: eem
Time: 2 January 2018, 5:12:57.488977 pm
UUID: a8d2d18d-bbe6-4c69-91bc-5767ec8c3076
Ancestors: Kernel-tpr.1132

Several minor refactorings for CompiledBlock.  Move CompiledMethod>>(hasBreakpoint,longPrintOn:,symbolic,symbolicLinesDo:) up to CompiledCode.  Provide CompiledBlock>>(isQuick,methodClass,primitive) to suppor tthe printing/exploring methods.

Provide an instance creation method for FuillBlockClosure, shuttong off the inheritance of the one for normal closures.

Provide InstructionPrinter support for the full closure creation bytecode.

Modify the postscript to ensure FullBlockClosure's identityHash/class index is 38 as expected by the VM.

=============== Diff against Kernel-tpr.1132 ===============

Item was added:
+ ----- Method: CompiledBlock>>encoderClass (in category 'accessing') -----
+ encoderClass
+ "Answer the encoder class that encoded the bytecodes in this method.
+ The sign flag bit is used by the VM to select a bytecode set.  This formulation
+ may seem odd but this has to be fast, so no property probe unless needed."
+
+ ^self header >= 0
+ ifTrue:
+ [PrimaryBytecodeSetEncoderClass]
+ ifFalse:
+ [PrimaryBytecodeSetEncoderClass == SecondaryBytecodeSetEncoderClass
+ ifTrue: "Support for testing prior to installing another set"
+ [(self outerCode propertyValueAt: #encoderClass) ifNil: [SecondaryBytecodeSetEncoderClass]]
+ ifFalse:
+ [SecondaryBytecodeSetEncoderClass]]!

Item was added:
+ ----- Method: CompiledBlock>>headerDescription (in category 'printing') -----
+ headerDescription
+ "Answer a description containing the information about the form of the
+ receiver and the form of the context needed to run the receiver."
+
+ ^(ByteString new: 128) writeStream
+ print: self header; cr;
+ nextPutAll: '"block full'; cr;
+ nextPutAll: ' numArgs: '; print: self numArgs; cr;
+ nextPutAll: ' numTemps: '; print: self numTemps; cr;
+ nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
+ nextPutAll: ' frameSize: '; print: self frameSize; cr;
+ nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
+ nextPut: $"; cr;
+ contents!

Item was added:
+ ----- Method: CompiledBlock>>isQuick (in category 'testing') -----
+ isQuick
+ ^false!

Item was added:
+ ----- Method: CompiledBlock>>longPrintOn:indent: (in category 'printing') -----
+ longPrintOn: aStream indent: tabs
+ "List of all the byte codes in a method with a short description of each"
+ (InstructionPrinter on: self) indent: tabs; printInstructionsOn: aStream!

Item was changed:
  ----- Method: CompiledBlock>>methodClass (in category 'accessing') -----
  methodClass
+ "Answer the class that I am installed in."
+ | outerCodeOrMethodClassAssoc |
+ outerCodeOrMethodClassAssoc := self outerCode.
+ outerCodeOrMethodClassAssoc isVariableBinding ifTrue:
+ [self assert: outerCodeOrMethodClassAssoc value isBehavior.
+ ^outerCodeOrMethodClassAssoc value].
+ ^outerCodeOrMethodClassAssoc methodClass!
- "answer the compiled method that I am installed in, or nil if none."
- ^self outerCode methodClass!

Item was added:
+ ----- Method: CompiledBlock>>primitive (in category 'accessing') -----
+ primitive
+ ^0!

Item was added:
+ ----- Method: CompiledBlock>>printReferenceOn: (in category 'printing') -----
+ printReferenceOn: aStream
+ "Override to indicate that this is a block, and to print a null reference when
+ the CompiledBlock is only partially initialized, as it is during compilation."
+ aStream nextPutAll: '[] in '.
+ self outerCode isVariableBinding
+ ifTrue: [aStream nextPutAll: ' (as yet unbound)']
+ ifFalse: [super printReferenceOn: aStream]!

Item was added:
+ ----- Method: CompiledCode>>hasBreakpoint (in category '*Kernel-tool support') -----
+ hasBreakpoint
+ ^ self class environment
+ at: #BreakpointManager
+ ifPresent: [:bpm | bpm methodHasBreakpoint: self]
+ ifAbsent: [false]!

Item was added:
+ ----- Method: CompiledCode>>headerDescription (in category 'printing') -----
+ headerDescription
+ "Answer a description containing the information about the form of the
+ receiver and the form of the context needed to run the receiver."
+
+ self subclassResponsibility!

Item was added:
+ ----- Method: CompiledCode>>longPrintOn: (in category 'printing') -----
+ longPrintOn: aStream
+ "List of all the byte codes in a method with a short description of each"
+
+ self longPrintOn: aStream indent: 0!

Item was changed:
  ----- Method: CompiledCode>>methodClass (in category 'accessing') -----
  methodClass
+ "Answer the class that I am installed in."
  ^self subclassResponsibility!

Item was added:
+ ----- Method: CompiledCode>>symbolic (in category 'printing') -----
+ symbolic
+ "Answer a String that contains a list of all the byte codes in a method
+ with a short description of each."
+
+ | aStream |
+ aStream := WriteStream on: (String new: 1000).
+ self longPrintOn: aStream.
+ ^aStream contents!

Item was added:
+ ----- Method: CompiledCode>>symbolicLinesDo: (in category 'printing') -----
+ symbolicLinesDo: aBlock
+ "Evaluate aBlock with each of the lines in the symbolic output."
+
+ | aStream pc |
+ aStream := (String new: 64) writeStream.
+ self isQuick ifTrue:
+ [self longPrintOn: aStream.
+ aBlock value: 0 value: aStream contents.
+ ^self].
+
+ self primitive ~= 0 ifTrue:
+ [self printPrimitiveOn: aStream.
+ aBlock value: 1 value: aStream contents.
+ aStream resetContents].
+
+ pc := self initialPC.
+ (InstructionPrinter on: self)
+ indent: 0;
+ printPC: false; "explorer provides pc anyway"
+ printInstructionsOn: aStream
+ do: [:printer :scanner :stream| | line index |
+ line := stream contents allButLast.
+ (line includes: Character cr) ifTrue:
+ [line := (line copyUpTo: Character cr), '...'' (continues)'].
+ (index := line indexOf: $>) > 0 ifTrue:
+ [[(line at: index + 1) isSeparator] whileTrue: [index := index + 1].
+ line := ((line copyFrom: 1 to: index) copyReplaceAll: (String with: Character tab) with: (String new: 8 withAll: Character space)),
+ (line copyFrom: index + 1 to: line size)].
+ aBlock value: pc value: line.
+ pc := scanner pc.
+ stream resetContents]!

Item was removed:
- ----- Method: CompiledMethod>>hasBreakpoint (in category '*Kernel-tool support') -----
- hasBreakpoint
- ^ self class environment
- at: #BreakpointManager
- ifPresent: [:bpm | bpm methodHasBreakpoint: self]
- ifAbsent: [false]!

Item was changed:
+ ----- Method: CompiledMethod>>headerDescription (in category 'printing') -----
- ----- Method: CompiledMethod>>headerDescription (in category 'literals') -----
  headerDescription
  "Answer a description containing the information about the form of the
  receiver and the form of the context needed to run the receiver."
 
  ^(ByteString new: 128) writeStream
  print: self header; cr;
  nextPutAll: '"primitive: '; print: self primitive; cr;
  nextPutAll: ' numArgs: '; print: self numArgs; cr;
  nextPutAll: ' numTemps: '; print: self numTemps; cr;
  nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
  nextPutAll: ' frameSize: '; print: self frameSize; cr;
  nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
  nextPut: $"; cr;
  contents!

Item was removed:
- ----- Method: CompiledMethod>>longPrintOn: (in category 'printing') -----
- longPrintOn: aStream
- "List of all the byte codes in a method with a short description of each"
-
- self longPrintOn: aStream indent: 0!

Item was removed:
- ----- Method: CompiledMethod>>symbolic (in category 'printing') -----
- symbolic
- "Answer a String that contains a list of all the byte codes in a method
- with a short description of each."
-
- | aStream |
- aStream := WriteStream on: (String new: 1000).
- self longPrintOn: aStream.
- ^aStream contents!

Item was removed:
- ----- Method: CompiledMethod>>symbolicLinesDo: (in category 'printing') -----
- symbolicLinesDo: aBlock
- "Evaluate aBlock with each of the lines in the symbolic output."
-
- | aStream pc |
- aStream := (String new: 64) writeStream.
- self isQuick ifTrue:
- [self longPrintOn: aStream.
- aBlock value: 0 value: aStream contents.
- ^self].
-
- self primitive ~= 0 ifTrue:
- [self printPrimitiveOn: aStream.
- aBlock value: 1 value: aStream contents.
- aStream resetContents].
-
- pc := self initialPC.
- (InstructionPrinter on: self)
- indent: 0;
- printPC: false; "explorer provides pc anyway"
- printInstructionsOn: aStream
- do: [:printer :scanner :stream| | line index |
- line := stream contents allButLast.
- (line includes: Character cr) ifTrue:
- [line := (line copyUpTo: Character cr), '...'' (continues)'].
- (index := line indexOf: $>) > 0 ifTrue:
- [[(line at: index + 1) isSeparator] whileTrue: [index := index + 1].
- line := ((line copyFrom: 1 to: index) copyReplaceAll: (String with: Character tab) with: (String new: 8 withAll: Character space)),
- (line copyFrom: index + 1 to: line size)].
- aBlock value: pc value: line.
- pc := scanner pc.
- stream resetContents]!

Item was added:
+ ----- Method: FullBlockClosure class>>receiver:outerContext:method:copiedValues: (in category 'instance creation') -----
+ receiver: aReceiver outerContext: aContextOrNil method: aCompiledBlock copiedValues: anArrayOrNil
+ ^(self new: anArrayOrNil basicSize)
+ receiver: aReceiver
+ outerContext: aContextOrNil
+ method: aCompiledBlock
+ copiedValues: anArrayOrNil!

Item was added:
+ ----- Method: FullBlockClosure>>outerContext:startpc:numArgs:copiedValues: (in category 'initialize-release') -----
+ outerContext: aContext startpc: aStartpc numArgs: argCount copiedValues: anArrayOrNil
+ self shouldNotImplement!

Item was added:
+ ----- Method: FullBlockClosure>>receiver:outerContext:method:copiedValues: (in category 'initialize-release') -----
+ receiver: aReceiver outerContext: aContextOrNil method: aCompiledBlock copiedValues: anArrayOrNil
+ receiver := aReceiver.
+ outerContext := aContextOrNil.
+ startpc := aCompiledBlock.
+ numArgs := aCompiledBlock numArgs.
+ 1 to: self numCopiedValues do:
+ [:i|
+ self at: i put: (anArrayOrNil at: i)]!

Item was added:
+ ----- Method: InstructionPrinter>>pushFullClosure:numCopied: (in category 'printing') -----
+ pushFullClosure: aCompiledBlock numCopied: numCopied
+ self print: 'closureNumCopied: ', numCopied printString
+ , ' numArgs: ', aCompiledBlock numArgs printString!

Item was changed:
+ (PackageInfo named: 'Kernel') postscript: '"below, add code to be run after the loading of this package"
+ ((ByteArray subclasses includes: CompiledMethod)
+  and: [CompiledMethod superclass ~= ByteArray]) ifTrue:
+ [ByteArray removeSubclass: CompiledMethod].
+ (Smalltalk classNamed: #FullBlockClosure) ifNotNil:
+ [:fbc|
+ (fbc identityHash ~= 38) ifTrue:
+ [fbc tryPrimitive: 161 withArgs: #(38 true)]]'!
- (PackageInfo named: 'Kernel') postscript: '((ByteArray subclasses includes: CompiledMethod) and: [CompiledMethod superclass ~= ByteArray]) ifTrue: [ByteArray removeSubclass: CompiledMethod]'!