The Trunk: System-eem.987.mcz

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

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

Name: System-eem.987
Author: eem
Time: 15 December 2017, 2:19:51.532605 pm
UUID: 5f61563a-54e7-4ec7-a2dc-8bd71ce75760
Ancestors: System-eem.986

Spur Image Segments.  Fix mapping of out pointer oops in 32-bit segment loads.  Fix typos & tweak comments.  Nuke an inadvertent halt.

=============== Diff against System-eem.986 ===============

Item was changed:
  ----- Method: Spur32BitImageSegmentLoader>>mapPC:in: (in category 'private') -----
  mapPC: pc in: compiledCode
+ "Assuming the word size of compiledCode is 8, and that the pc is one for a word size of 4,
+ map the pc from 4 to 8 byte literals. The filter is in updatePCDependentObjects."
- "Assuming the word size of compiledCode is 8, and that the pc is one for a word size of 4, map the pc from 4 to 8.
- The filter is in updatePCDependentObjects."
  ^pc + (compiledCode numLiterals + 1 * 4)!

Item was changed:
  ----- Method: Spur32BitImageSegmentLoader>>readOop (in category 'reading') -----
  readOop
  "Read an oop and map it to an object:
  - The oop may be immediate in which case its tag indicates its class and the remeaining bits its value.
  - the oop may have its top bit set in which case it is an index into the outPointers
  - otherwise the oop is a byte offset from the start of the first object in the segment and is in oopMap"
  | oop topBit |
  oop := self readUint32.
  topBit := oop bitShift: -31.
  ^(oop bitAnd: 3) caseOf: {
  [0] -> [topBit = 1
+ ifTrue: [outPointers at: oop - 16r80000000 / 4 + 1]
- ifTrue: [outPointers at: oop - 16r80000000 / 8 + 1]
  ifFalse: [oopMap at: oop]].
  [1] -> [(oop bitShift: -1) - (topBit = 1 ifTrue: [16r80000000] ifFalse: [0])].
  [3] -> [(oop bitShift: -1) - (topBit = 1 ifTrue: [16r80000000] ifFalse: [0])].
  [2] -> [Character value: (oop bitShift: -2)]}!

Item was changed:
  ----- Method: Spur64BitImageSegmentLoader>>mapPC:in: (in category 'private') -----
  mapPC: pc in: compiledCode
+ "Assuming the word size of compiledCode is 4, and that the pc is one for a word size of 8,
+ map the pc from 8 to 4 byte literals. The filter is in updatePCDependentObjects."
- "Assuming the word size of compiledCode is 4, and that the pc is one for a word size of 8, map the pc from 8 to 4.
- The filter is in updatePCDependentObjects."
  ^pc - (compiledCode numLiterals + 1 * 4)!

Item was changed:
  ----- Method: Spur64BitImageSegmentLoader>>readObject (in category 'reading') -----
  readObject
  "Read the header and the class of the object, instantiate it, and store it in oopMap at its oop."
  | headerLo headerHi oop numSlots classIndex format rawNumSlots |
  "the oop is the address of the two byte header (which follows the overflow size word, if there is one)."
  oop := position - 8. "compensate for 64-bit version stamp"
- oop = 1390072 ifTrue: [self halt].
  headerLo := self readUint32.
  headerHi := self readUint32.
  rawNumSlots := headerHi bitShift: -24.
  rawNumSlots = 255
  ifTrue: "128-bit header; overflow slots in least significant 32 bits of first 64-bit header word"
  [numSlots := headerLo.
  oop := position - 8. "compensate for 64-bit version stamp"
  headerLo := self readUint32.
  headerHi := self readUint32]
  ifFalse: "64-bit header"
  [numSlots := rawNumSlots].
  "N.B. The format field is a 5 bit field, but immediately above it is the
  remembered bit which is used to mark classes is the segment."
  self checkValidFormat: (format := (headerLo bitShift: -24) bitAnd: 63).
  classIndex := headerLo bitAnd: 16r3FFFFF.
  ^[oopMap at: oop ifAbsentPut:
  [self allocateObject: format classIndex: classIndex slots: numSlots]]
  ensure: "Spur objects have at least one slot"
  [position := oop + 16 + ((numSlots max: 1) * 8)]!

Item was changed:
  ----- Method: Spur64BitImageSegmentLoader>>readOop (in category 'reading') -----
  readOop
  "Read an oop and map it to an object:
  - The oop may be immediate in which case its tag indicates its class and the remeaining bits its value.
  - the oop may have its top bit set in which case it is an index into the outPointers
  - otherwise the oop is a byte offset from the start of the first object in the segment and is in oopMap.
  The method is written to avoid large integer arithmetic as much as possible."
  | lo hi topBit oop |
  lo := self readUint32.
  hi := self readUint32.
  topBit := hi bitShift: -31.
  ^(lo bitAnd: 7) caseOf: {
  [0] -> [topBit = 1
  ifTrue:
  [oop := (hi - 16r80000000 bitShift: 32) + lo.
  outPointers at: oop / 8 + 1]
  ifFalse:
  [oop := (hi bitShift: 32) + lo.
  oopMap at: oop]].
  [1] -> [(lo bitShift: -3) bitOr: (hi - (topBit = 1 ifTrue: [16r100000000] ifFalse: [0]) bitShift: 29)].
  [2] -> [Character value: ((lo bitShift: -3) bitOr: (hi bitShift: 29))].
  [4] -> [(hi = 0 and: [lo <= 15]) "+ve & -ve zero"
  ifTrue: [lo <= 7 ifTrue: [0.0] ifFalse: [-0.0]]
  ifFalse: "convert lo: | tag | sign | mantissa low 28 bits | hi: | mantissa high 24 bits | exponent - 896 |
  to hi: | mantissa high 20 bits | exponent 11 bits | sign | lo: | mantissa low 32 bits |"
+ [(BoxedFloat64 basicNew: 2)
- [^(BoxedFloat64 basicNew: 2)
  basicAt: 1 put: ((lo bitAnd: 8) bitShift: 28) + ((hi bitShift: -4) + (896 bitShift: 20));
  basicAt: 2 put: (lo bitShift: -4) + ((hi bitAnd: 15) bitShift: 28);
+ * 1.0 "& reduce to SmallFloat64 if possible"]]}
- * 1.0]]}
  otherwise: [self error: 'unrecognized tag pattern']!

Item was changed:
  ----- Method: SpurImageSegmentLoader>>oopIndexForClassIndex: (in category 'private') -----
  oopIndexForClassIndex: classIndex
+ "When a classIndex doesn't have the topBit set it maps to an oop in the segment thusly:"
- "Whebn a classIndex doesn't have the topBit set it maps to an oop in the segment thusly:"
  ^classIndex - 16 "self firstClassIndexPun" * 8 "self allocationUnit"!