VM Maker: VMMaker.oscog-eem.2452.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-eem.2452.mcz

commits-2
 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2452.mcz

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

Name: VMMaker.oscog-eem.2452
Author: eem
Time: 11 October 2018, 10:44:32.529708 pm
UUID: fbf68fea-bb48-48c2-b1b0-8e712167cdbb
Ancestors: VMMaker.oscog-eem.2451

General:
Fix error code reporting for primitiveAdoptInstance.  It uses changeClassOf:to: which expects the class to be the argument, so BadArgument/BadReceiver errors must be swapped.

Spur:
Simplify the two changeClassOf:to: implementations, fixing a bug when a byte class adopts a 32 bit indexable instance on the 32 bit system.

Spur Cogit:
Fix a regression in 32 bit genGetSizeOf:into:formatReg:scratchReg:abortJumpsInto: that failed to abort for 64 bit indexable receivers.  Nuke the now inferred jump type declarations from both versions.

Slang:
Fix a regression in cFunctionNameFor: caused by adding support for foo:_: selectors too carelessly which consequently generated __LINE__ as __LINE.

Simulator:
Fix as[Double|Single]FloatAccessor given that adoptInstance: answers the receiver (the class), not the adopted instance.

Exclude primitiveAdoptInstance from halts in stack simulator's getErrorObjectFromPrimFailCode.  Hernan, if this halt annoys you, feel free to delete the method.  I've included it just to catch potentially interesting primitive failures.

=============== Diff against VMMaker.oscog-eem.2451 ===============

Item was changed:
  ----- Method: CArray>>asDoubleFloatAccessor (in category 'converting') -----
  asDoubleFloatAccessor
+ | accessor |
+ CFloatArray adoptInstance: (accessor := self shallowCopy unitSize: 8).
+ ^accessor!
- ^CFloatArray adoptInstance: (self shallowCopy unitSize: 8)!

Item was changed:
  ----- Method: CArray>>asSingleFloatAccessor (in category 'converting') -----
  asSingleFloatAccessor
+ | accessor |
+ CFloatArray adoptInstance: (accessor := self shallowCopy unitSize: 4).
+ ^accessor!
- ^CFloatArray adoptInstance: (self shallowCopy unitSize: 4)!

Item was changed:
  ----- Method: CCodeGenerator>>cFunctionNameFor: (in category 'C code generator') -----
  cFunctionNameFor: aSelector
  "Create a C function name from the given selector by finding
  a specific translation, or if none, simply omitting colons, and
  any trailing underscores (this supports a varargs convention)."
  ^selectorTranslations
  at: aSelector
  ifAbsent:
  [| cSelector |
  cSelector := aSelector copyWithout: $:.
+ aSelector last = $: ifTrue:
+ [[cSelector last = $_] whileTrue:
+ [cSelector := cSelector allButLast]].
- [cSelector last = $_] whileTrue:
- [cSelector := cSelector allButLast].
  cSelector]!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetSizeOf:into:formatReg:scratchReg:abortJumpsInto: (in category 'primitive generators') -----
  genGetSizeOf: sourceReg into: destReg formatReg: formatReg scratchReg: scratchReg abortJumpsInto: aBinaryBlock
  "Get the size of the non-immediate object in sourceReg into destReg using formatReg
  and scratchReg as temps.  None of these registers can overlap.  Supply the jumps
  taken if the object in sourceReg is not indexable, or if the object in sourceReg is a
  context.. Hack: If the object has a pointer format other than 2 leave the number of
  fixed fields in formatReg.  Used by primitiveSize, primitiveAt, and primitiveAtPut"
  <returnTypeC: #'AbstractInstruction *'>
  | jumpNotIndexable
+  jumpBytesDone jumpShortsDone jumpArrayDone jump32BitLongsDone jump64BitLongsDone
+  jumpIsBytes jumpHasFixedFields jumpIsShorts jumpIs64BitLongs jumpIsContext  |
-  jumpBytesDone jumpShortsDone jumpArrayDone jump32BitLongsDone
-  jumpIsBytes jumpHasFixedFields jumpIsShorts jumpIsContext  |
  <inline: true>
  "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
- <var: #jumpIsBytes type: #'AbstractInstruction *'>
- <var: #jumpIsShorts type: #'AbstractInstruction *'>
- <var: #jumpIsContext type: #'AbstractInstruction *'>
- <var: #jumpArrayDone type: #'AbstractInstruction *'>
- <var: #jumpNotIndexable type: #'AbstractInstruction *'>
- <var: #jumpHasFixedFields type: #'AbstractInstruction *'>
- <var: #jump32BitLongsDone type: #'AbstractInstruction *'>
 
  "formatReg := self formatOf: sourceReg"
  self genGetFormatOf: sourceReg
  into: formatReg
  leastSignificantHalfOfBaseHeaderIntoScratch: scratchReg.
 
  self genGetNumSlotsOf: sourceReg into: destReg.
 
  "dispatch on format in a combination of highest dynamic frequency order first and convenience.
   0 = 0 sized objects (UndefinedObject True False et al)
   1 = non-indexable objects with inst vars (Point et al)
   2 = indexable objects with no inst vars (Array et al)
   3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
   4 = weak indexable objects with inst vars (WeakArray et al)
   5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
   6 unused, reserved for exotic pointer objects?
   7 Forwarded Object, 1st field is pointer, rest of fields are ignored
   8 unused, reserved for exotic non-pointer objects?
   9 64-bit indexable
  10 - 11 32-bit indexable
  12 - 15 16-bit indexable
  16 - 23 byte indexable
  24 - 31 compiled method"
  cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  jumpIsBytes := cogit JumpGreaterOrEqual: 0.
  cogit CmpCq: objectMemory arrayFormat R: formatReg.
  jumpArrayDone := cogit JumpZero: 0.
  jumpNotIndexable := cogit JumpLess: 0.
  cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  jumpHasFixedFields := cogit JumpLessOrEqual: 0.
  cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  jumpIsShorts := cogit JumpGreaterOrEqual: 0.
  cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  jump32BitLongsDone := cogit JumpGreaterOrEqual: 0.
+ cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg.
+ jumpIs64BitLongs := cogit JumpZero: 0.
  "For now ignore 64-bit indexability."
  jumpNotIndexable jmpTarget: cogit Label.
  jumpNotIndexable := cogit Jump: 0.
 
  jumpIsBytes jmpTarget:
  (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: destReg).
  cogit AndCq: objectMemory wordSize - 1 R: formatReg.
  cogit SubR: formatReg R: destReg.
  jumpBytesDone := cogit Jump: 0.
 
  jumpIsShorts jmpTarget:
  (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: destReg).
  cogit AndCq: 1 R: formatReg.
  cogit SubR: formatReg R: destReg.
  jumpShortsDone := cogit Jump: 0.
 
+ jumpIs64BitLongs jmpTarget:
+ (cogit LogicalShiftRightCq: 1 R: destReg).
+ jump64BitLongsDone := cogit Jump: 0.
+
  "formatReg contains fmt, now up for grabs.
  destReg contains numSlots, precious.
  sourceReg must be preserved"
  jumpHasFixedFields jmpTarget:
  (cogit AndCq: objectMemory classIndexMask R: scratchReg).
  cogit MoveR: scratchReg R: formatReg.
  cogit CmpCq: ClassMethodContextCompactIndex R: scratchReg.
  jumpIsContext := cogit JumpZero: 0.
  cogit PushR: destReg.
  self genGetClassObjectOfClassIndex: formatReg into: destReg scratchReg: scratchReg.
  self genLoadSlot: InstanceSpecificationIndex sourceReg: destReg destReg: formatReg.
  self genConvertSmallIntegerToIntegerInReg: formatReg.
  cogit
  PopR: destReg;
  AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
  SubR: formatReg R: destReg.
 
  jumpArrayDone jmpTarget:
+ (jump64BitLongsDone jmpTarget:
  (jump32BitLongsDone jmpTarget:
  (jumpShortsDone jmpTarget:
  (jumpBytesDone jmpTarget:
+ cogit Label)))).
- cogit Label))).
  aBinaryBlock value: jumpNotIndexable value: jumpIsContext!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genGetSizeOf:into:formatReg:scratchReg:abortJumpsInto: (in category 'primitive generators') -----
  genGetSizeOf: sourceReg into: destReg formatReg: formatReg scratchReg: scratchReg abortJumpsInto: aBinaryBlock
  "Get the size of the non-immediate object in sourceReg into destReg using formatReg
  and scratchReg as temps.  None of these registers can overlap.  Supply the jumps
  taken if the object in sourceReg is not indexable, or if the object in sourceReg is a
  context.. Hack: If the object has a pointer format other than 2 leave the number of
  fixed fields in formatReg.  Used by primitiveSize, primitiveAt, and primitiveAtPut"
  <returnTypeC: #'AbstractInstruction *'>
  | jumpNotIndexable
   jumpBytesDone jumpShortsDone jumpArrayDone jump32BitLongsDone jump64BitLongsDone
   jumpIsBytes jumpHasFixedFields jumpIsShorts jumpIs32BitLongs jumpIsContext  |
  <inline: true>
  "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
- <var: #jumpIsBytes type: #'AbstractInstruction *'>
- <var: #jumpIsShorts type: #'AbstractInstruction *'>
- <var: #jumpIsContext type: #'AbstractInstruction *'>
- <var: #jumpArrayDone type: #'AbstractInstruction *'>
- <var: #jumpIs32BitLongs type: #'AbstractInstruction *'>
- <var: #jumpNotIndexable type: #'AbstractInstruction *'>
- <var: #jumpHasFixedFields type: #'AbstractInstruction *'>
- <var: #jump32BitLongsDone type: #'AbstractInstruction *'>
- <var: #jump64BitLongsDone type: #'AbstractInstruction *'>
 
  "formatReg := self formatOf: sourceReg"
  self genGetFormatOf: sourceReg
  into: formatReg
  leastSignificantHalfOfBaseHeaderIntoScratch: scratchReg.
 
  self genGetNumSlotsOf: sourceReg into: destReg.
 
  "dispatch on format in a combination of highest dynamic frequency order first and convenience.
   0 = 0 sized objects (UndefinedObject True False et al)
   1 = non-indexable objects with inst vars (Point et al)
   2 = indexable objects with no inst vars (Array et al)
   3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
   4 = weak indexable objects with inst vars (WeakArray et al)
   5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
   6 unused, reserved for exotic pointer objects?
   7 Forwarded Object, 1st field is pointer, rest of fields are ignored
   8 unused, reserved for exotic non-pointer objects?
   9 64-bit indexable
  10 - 11 32-bit indexable
  12 - 15 16-bit indexable
  16 - 23 byte indexable
  24 - 31 compiled method"
  cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  jumpIsBytes := cogit JumpGreaterOrEqual: 0.
  cogit CmpCq: objectMemory arrayFormat R: formatReg.
  jumpArrayDone := cogit JumpZero: 0.
  jumpNotIndexable := cogit JumpLess: 0.
  cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  jumpHasFixedFields := cogit JumpLessOrEqual: 0.
  cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  jumpIsShorts := cogit JumpGreaterOrEqual: 0.
  cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  jumpIs32BitLongs := cogit JumpGreaterOrEqual: 0.
  cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg.
  jump64BitLongsDone := cogit JumpZero: 0.
  jumpNotIndexable jmpTarget: cogit Label.
  jumpNotIndexable := cogit Jump: 0.
 
  jumpIsBytes jmpTarget:
  (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: destReg).
  cogit AndCq: objectMemory wordSize - 1 R: formatReg.
  cogit SubR: formatReg R: destReg.
  jumpBytesDone := cogit Jump: 0.
 
  jumpIsShorts jmpTarget:
  (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: destReg).
  cogit AndCq: objectMemory wordSize >> 1 - 1 R: formatReg.
  cogit SubR: formatReg R: destReg.
  jumpShortsDone := cogit Jump: 0.
 
  jumpIs32BitLongs jmpTarget:
  (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 2 R: destReg).
  cogit AndCq: objectMemory wordSize >> 2 - 1 R: formatReg.
  cogit SubR: formatReg R: destReg.
  jump32BitLongsDone := cogit Jump: 0.
 
  "formatReg contains fmt, now up for grabs.
  destReg contains numSlots, precious.
  sourceReg must be preserved"
  jumpHasFixedFields jmpTarget:
  (cogit AndCq: objectMemory classIndexMask R: scratchReg).
  cogit MoveR: scratchReg R: formatReg.
  cogit CmpCq: ClassMethodContextCompactIndex R: scratchReg.
  jumpIsContext := cogit JumpZero: 0.
  self genGetClassObjectOfClassIndex: formatReg into: Extra0Reg scratchReg: scratchReg.
  self genLoadSlot: InstanceSpecificationIndex sourceReg: Extra0Reg destReg: formatReg.
  self genConvertSmallIntegerToIntegerInReg: formatReg.
  cogit
  AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
  SubR: formatReg R: destReg.
 
  jumpArrayDone jmpTarget:
  (jump64BitLongsDone jmpTarget:
  (jump32BitLongsDone jmpTarget:
  (jumpShortsDone jmpTarget:
  (jumpBytesDone jmpTarget:
  cogit Label)))).
  aBinaryBlock value: jumpNotIndexable value: jumpIsContext!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveAdoptInstance (in category 'object access primitives') -----
  primitiveAdoptInstance
  "Primitive. Change the class of the argument to make it an instance of the receiver
  given that the format of the receiver matches the format of the argument's class.
  Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a
  compact class and the argument isn't, or when the argument's class is compact and
  the receiver isn't, or when the format of the receiver is different from the format of
  the argument's class, or when the arguments class is fixed and the receiver's size
  differs from the size that an instance of the argument's class should have."
  | rcvr arg err |
 
  arg := self stackTop.
  rcvr := self stackValue: 1.
  ((objectMemory isImmediate: arg)
  or: [argumentCount > 1
  and: [(objectMemory isImmediate: rcvr)
  or: [(self objCouldBeClassObj: rcvr) not]]]) ifTrue:
  [^self primitiveFailFor: PrimErrBadArgument].
 
  err := objectMemory changeClassOf: arg to: rcvr.
  err = 0
+ ifTrue:
+ ["Flush at cache because rcvr's class has changed."
+ self flushAtCache.
+ self pop: self methodArgumentCount]
+ ifFalse:
+ ["changeClassOf:to: answers errors as if rcvr (the class) is an argument..."
+ err = PrimErrBadReceiver
+ ifTrue:
+ [err := PrimErrBadArgument]
+ ifFalse:
+ [err = PrimErrBadArgument ifTrue:
+ [err := PrimErrBadReceiver]].
+ self primitiveFailFor: err].
- ifTrue: ["Flush at cache because rcvr's class has changed."
- self flushAtCache.
- self pop: self methodArgumentCount]
- ifFalse: [self primitiveFailFor: err].
  ^nil!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
  changeClassOf: rcvr to: argClass
  "Attempt to change the class of the receiver to the argument given that the
  format of the receiver matches the format of the argument.  If successful,
  answer 0, otherwise answer an error code indicating the reason for failure.
  Fail if the format of the receiver is incompatible with the format of the argument,
  or if the argument is a fixed class and the receiver's size differs from the size
  that an instance of the argument should have."
  <inline: false>
+ | classFormat fixedFields instFormat newFormat classIndex instSlots instBytes |
- | classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex |
  (self isObjImmutable: rcvr) ifTrue:
  [^PrimErrNoModification].
  classFormat := self formatOfClass: argClass.
  fixedFields := self fixedFieldsOfClassFormat: classFormat.
  classFormat := self instSpecOfClassFormat: classFormat.
  instFormat := self formatOf: rcvr.
- normalizedInstFormat := self classFormatForInstanceFormat: instFormat.
 
  "Fail for inability to access classIndex before making contexts snapshot-safe."
  (classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
  [^classIndex negated].
 
+ "Now check the instance for compatibility and compute odd bits if necessary."
+ classFormat <= self lastPointerFormat
+ ifTrue:
+ [instFormat > self lastPointerFormat ifTrue:
+ [^PrimErrInappropriate].
+ ((instSlots := self numSlotsOf: rcvr) < fixedFields
+  or: [instSlots > fixedFields and: [self isFixedSizePointerFormat: classFormat]]) ifTrue:
+ [^PrimErrBadReceiver].
+ (instFormat = self indexablePointersFormat
+  and: [self isContextNonImm: rcvr]) ifTrue:
+ [coInterpreter makeContextSnapshotSafe: rcvr].
+ newFormat := classFormat]
- (normalizedInstFormat > self lastPointerFormat
- and: [normalizedInstFormat = classFormat])
- ifTrue: [newFormat := instFormat]
  ifFalse:
+ ["Fail if the class's format is somehow invalid."
+ classFormat ~= (self classFormatForInstanceFormat: classFormat) ifTrue:
+ [^PrimErrBadArgument].
+
+ instBytes := self numBytesOf: rcvr.
+ classFormat
+ caseOf: {
+ [self sixtyFourBitIndexableFormat]
+ -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstLongFormat]
+ -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstShortFormat]
+ -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat + (2 - (instBytes >> 1) bitAnd: 1)].
+ [self firstByteFormat]
+ -> [newFormat := classFormat + (4 - instBytes bitAnd: 3)].
+ [self firstCompiledMethodFormat]
+ -> [classFormat ~= self firstCompiledMethodFormat ifTrue:
+ [^PrimErrInappropriate].
+ newFormat := instFormat] }
+ otherwise: "bits instances cannot be adopted by pointer-like classes..."
+ [^PrimErrInappropriate]].
+
- [normalizedInstFormat <= self lastPointerFormat
- ifTrue:
- [classFormat > self lastPointerFormat ifTrue:
- [^PrimErrInappropriate].
- (self numSlotsOf: rcvr) < fixedFields ifTrue:
- [^PrimErrBadReceiver].
- (instFormat = self indexablePointersFormat
-  and: [self isContextNonImm: rcvr]) ifTrue:
- [coInterpreter makeContextSnapshotSafe: rcvr].
- newFormat := classFormat]
- ifFalse:
- [| instBytes |
- instBytes := self numBytesOf: rcvr.
- normalizedInstFormat caseOf: {
- [self sixtyFourBitIndexableFormat] ->
- [(classFormat < self sixtyFourBitIndexableFormat
-  or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
- [^PrimErrInappropriate].
- newFormat := classFormat].
- [self firstLongFormat] ->
- [(classFormat < self sixtyFourBitIndexableFormat
-  or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
- [^PrimErrInappropriate].
- (classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue:
- [^PrimErrBadReceiver].
- newFormat := classFormat].
- [self firstShortFormat] ->
- [(classFormat < self sixtyFourBitIndexableFormat
-  or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
- [^PrimErrInappropriate].
- classFormat caseOf: {
- [self sixtyFourBitIndexableFormat]
- -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
- newFormat := classFormat].
- [self firstLongFormat]
- -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
- newFormat := classFormat].
- [self firstByteFormat]
- -> [newFormat := classFormat + (4 - instBytes bitAnd: 3)] }].
- [self firstByteFormat] ->
- [(classFormat < self sixtyFourBitIndexableFormat
-  or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
- [^PrimErrInappropriate].
- classFormat caseOf: {
- [self sixtyFourBitIndexableFormat]
- -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]].
- [self firstLongFormat]
- -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]].
- [self firstShortFormat]
- -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]] }.
- newFormat := classFormat].
- [self firstCompiledMethodFormat] ->
- [classFormat ~= self firstCompiledMethodFormat ifTrue:
- [^PrimErrInappropriate].
- newFormat := instFormat] }]].
  self set: rcvr classIndexTo: classIndex formatTo: newFormat.
+
+ self assert: (self numBytesOf: rcvr) = (classFormat <= self lastPointerFormat
+ ifTrue: [instSlots * self bytesPerOop]
+ ifFalse: [instBytes]).
  "ok"
  ^0!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
  changeClassOf: rcvr to: argClass
  "Attempt to change the class of the receiver to the argument given that the
  format of the receiver matches the format of the argument.  If successful,
  answer 0, otherwise answer an error code indicating the reason for failure.
  Fail if the format of the receiver is incompatible with the format of the argument,
  or if the argument is a fixed class and the receiver's size differs from the size
  that an instance of the argument should have."
  <inline: false>
+ | classFormat fixedFields instFormat newFormat classIndex instSlots instBytes |
- | classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex |
  (self isObjImmutable: rcvr) ifTrue:
  [^PrimErrNoModification].
  classFormat := self formatOfClass: argClass.
  fixedFields := self fixedFieldsOfClassFormat: classFormat.
  classFormat := self instSpecOfClassFormat: classFormat.
  instFormat := self formatOf: rcvr.
- normalizedInstFormat := self classFormatForInstanceFormat: instFormat.
 
  "Fail for inability to access classIndex before making contexts snapshot-safe."
  (classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
  [^classIndex negated].
 
+ "Now check the instance for compatibility and compute odd bits if necessary."
+ classFormat <= self lastPointerFormat
+ ifTrue:
+ [instFormat > self lastPointerFormat ifTrue:
+ [^PrimErrInappropriate].
+ ((instSlots := self numSlotsOf: rcvr) < fixedFields
+  or: [instSlots > fixedFields and: [self isFixedSizePointerFormat: classFormat]]) ifTrue:
+ [^PrimErrBadReceiver].
+ (instFormat = self indexablePointersFormat
+  and: [self isContextNonImm: rcvr]) ifTrue:
+ [coInterpreter makeContextSnapshotSafe: rcvr].
+ newFormat := classFormat]
- (normalizedInstFormat > self lastPointerFormat
- and: [normalizedInstFormat = classFormat])
- ifTrue: [newFormat := instFormat]
  ifFalse:
+ ["Fail if the class's format is somehow invalid."
+ classFormat ~= (self classFormatForInstanceFormat: classFormat) ifTrue:
+ [^PrimErrBadArgument].
- [normalizedInstFormat <= self lastPointerFormat
- ifTrue:
- [classFormat > self lastPointerFormat ifTrue:
- [^PrimErrInappropriate].
- (self numSlotsOf: rcvr) < fixedFields ifTrue:
- [^PrimErrBadReceiver].
- (instFormat = self indexablePointersFormat
-  and: [self isContextNonImm: rcvr]) ifTrue:
- [coInterpreter makeContextSnapshotSafe: rcvr].
- newFormat := classFormat]
- ifFalse:
- [| instBytes |
- instBytes := self numBytesOf: rcvr.
- normalizedInstFormat caseOf: {
- [self sixtyFourBitIndexableFormat] ->
- [(classFormat < self sixtyFourBitIndexableFormat
-  or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
- [^PrimErrInappropriate].
- newFormat := classFormat].
- [self firstLongFormat] ->
- [(classFormat < self sixtyFourBitIndexableFormat
-  or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
- [^PrimErrInappropriate].
- (classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue:
- [^PrimErrBadReceiver].
- newFormat := classFormat].
- [self firstShortFormat] ->
- [(classFormat < self sixtyFourBitIndexableFormat
-  or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
- [^PrimErrInappropriate].
- classFormat caseOf: {
- [self sixtyFourBitIndexableFormat]
- -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
- newFormat := classFormat].
- [self firstLongFormat]
- -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
- newFormat := classFormat + (2 - instBytes bitAnd: 1)].
- [self firstByteFormat]
- -> [newFormat := classFormat + (8 - instBytes bitAnd: 7)] }].
- [self firstByteFormat] ->
- [(classFormat < self sixtyFourBitIndexableFormat
-  or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
- [^PrimErrInappropriate].
- classFormat caseOf: {
- [self sixtyFourBitIndexableFormat]
- -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
- newFormat := classFormat].
- [self firstLongFormat]
- -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
- newFormat := classFormat + (2 - instBytes bitAnd: 1)].
- [self firstShortFormat]
- -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
- newFormat := classFormat + (4 - instBytes bitAnd: 3)] }.
- newFormat := classFormat].
- [self firstCompiledMethodFormat] ->
- [classFormat ~= self firstCompiledMethodFormat ifTrue:
- [^PrimErrInappropriate].
- newFormat := instFormat] }]].
 
+ instBytes := self numBytesOf: rcvr.
+ classFormat
+ caseOf: {
+ [self sixtyFourBitIndexableFormat]
+ -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstLongFormat]
+ -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat + (2 - (instBytes >> 2) bitAnd: 1)].
+ [self firstShortFormat]
+ -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat + (4 - (instBytes >> 1) bitAnd: 3)].
+ [self firstByteFormat]
+ -> [newFormat := classFormat + (8 - instBytes bitAnd: 7)].
+ [self firstCompiledMethodFormat]
+ -> [classFormat ~= self firstCompiledMethodFormat ifTrue:
+ [^PrimErrInappropriate].
+ newFormat := instFormat] }
+ otherwise: "bits instances cannot be adopted by pointer-like classes..."
+ [^PrimErrInappropriate]].
+
  self set: rcvr classIndexTo: classIndex formatTo: newFormat.
+
+ self assert: (self numBytesOf: rcvr) = (classFormat <= self lastPointerFormat
+ ifTrue: [instSlots * self bytesPerOop]
+ ifFalse: [instBytes]).
  "ok"
  ^0!

Item was changed:
  ----- Method: StackInterpreterSimulator>>getErrorObjectFromPrimFailCode (in category 'debugging traps') -----
  getErrorObjectFromPrimFailCode
+ (primFailCode > 1 and: [(#(primitiveNew primitiveFetchNextMourner primitiveAdoptInstance) includes: primitiveFunctionPointer) not]) ifTrue: [self halt].
- (primFailCode > 1 and: [(#(primitiveNew primitiveFetchNextMourner) includes: primitiveFunctionPointer) not]) ifTrue: [self halt].
  ^super getErrorObjectFromPrimFailCode!