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

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

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

Name: VMMaker.oscog-eem.999
Author: eem
Time: 25 December 2014, 5:56:07.016 pm
UUID: b0fe8d34-046c-4ef4-8ca5-cdfe166c52fe
Ancestors: VMMaker.oscog-eem.998

Spur:
Fix argument count slips in three primitives.
Check for sufficient memory in two-way become.

All:
Fix checking of boolean arg in
primitiveArrayBecomeOneWayCopyHash.

Make primitiveSlotAt[Put] cope with non-pointer
objects.

Sista: Simplify genGetNumBytesOf:into:

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

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetNumBytesOf:into: (in category 'compile abstract instructions') -----
  genGetNumBytesOf: srcReg into: destReg
  "Get the size in byte-sized slots of the object in srcReg into destReg.
  srcReg may equal destReg.
+ destReg <- numSlots << self shiftForWord - (fmt bitAnd: 3).
+ Assumes the object in srcReg has a byte format, i.e. 16 to 23 or 24 to 31 "
- destReg <- numSlots << self shiftForWord - (fmt bitAnd: 7)."
  <var: #jmp type: #'AbstractInstruction'>
  | jmp |
  self genGetRawSlotSizeOfNonImm: srcReg into: TempReg.
  cogit CmpCq: objectMemory numSlotsMask R: TempReg.
  jmp := cogit JumpLess: 0.
+ cogit MoveMw: objectMemory wordSize negated r: srcReg R: destReg.
+ jmp jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: destReg).
- cogit MoveMw: objectMemory wordSize negated r: srcReg R: TempReg.
- jmp jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: TempReg).
  "Now: TempReg = numSlots << shiftForWord"
+ cogit MoveMw: 0 r: srcReg R: TempReg.
+ cogit LogicalShiftRightCq: objectMemory formatShift R: TempReg.
+ cogit AndCq: objectMemory wordSize - 1 R: TempReg.
+ "Now: fmt bitAnd: 3 in TempReg"
- cogit MoveMw: 0 r: srcReg R: destReg.
- cogit LogicalShiftRightCq: objectMemory formatShift R: destReg.
- cogit AndCq: objectMemory formatMask R: destReg.
- cogit AndCq: objectMemory wordSize - 1 R: destReg.
- "Now: fmt bitAnd: 7 in destReg"
  cogit SubR: TempReg R: destReg.
  ^0!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveArrayBecomeOneWayCopyHash (in category 'object access primitives') -----
  primitiveArrayBecomeOneWayCopyHash
+ "Similar to primitiveArrayBecomeOneWay but accepts a third argument deciding whether to
+ copy the receiver's element's identity hash over the argument's elementy's identity hash."
- "Similar to primitiveArrayBecomeOneWay but accepts a third argument whether to copy
- the receiver's identity hash over the argument's identity hash."
 
+ | copyHashFlag ec |
+ self stackTop = objectMemory trueObject
+ ifTrue: [copyHashFlag := true]
+ ifFalse:
+ [self stackTop = objectMemory falseObject
+ ifTrue: [copyHashFlag := false]
+ ifFalse:
+ [self primitiveFailFor: PrimErrBadArgument.
+ ^nil]].
+ ec := objectMemory
+ become: (self stackValue: 2)
+ with: (self stackValue: 1)
+ twoWay: false
+ copyHash: copyHashFlag.
- | copyHashFlag arg rcvr ec |
- copyHashFlag := self booleanValueOf: (self stackTop).
- arg := self stackValue: 1.
- rcvr := self stackValue: 2.
- ec := objectMemory become: rcvr with: arg twoWay: false copyHash: copyHashFlag.
  ec = PrimNoErr
+ ifTrue: [self pop: argumentCount]
- ifTrue: [self pop: 2]
  ifFalse: [self primitiveFailFor: ec]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveImmediateAsInteger (in category 'arithmetic float primitives') -----
  primitiveImmediateAsInteger
  "For a Smalnteger, answer itself.
  For a Character, answer its code as an unsigned integer.
  For a SmallFloat, answer the signed, but unadjusted bit pattern (so as to keep the result a SmallInteger).
  This is a good value for an immediate's hash."
  <option: #Spur64BitMemoryManager>
  | oop value |
  oop := self stackTop.
  (objectMemory isIntegerObject: oop) ifTrue:
  [value := objectMemory integerValueOf: oop] ifFalse:
  [(objectMemory isCharacterObject: oop) ifTrue:
  [value := objectMemory characterValueOf: oop] ifFalse:
  [(objectMemory isImmediateFloat: oop) ifTrue:
  [value := objectMemory rotatedFloatBitsOf: oop] ifFalse:
  [^self primitiveFailFor: PrimErrBadReceiver]]].
+ self pop: argumentCount + 1 thenPushInteger: value!
- self pop: argumentCount thenPushInteger: value!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveIsPinned (in category 'memory space primitives') -----
  primitiveIsPinned
  "Answer if the receiver is pinned, i.e. immobile."
  | obj |
  obj := self stackTop.
  ((objectMemory isImmediate: obj)
  or: [objectMemory isForwarded: obj]) ifTrue:
  [^self primitiveFailFor: PrimErrBadReceiver].
+ self pop: argumentCount + 1
+ thenPushBool: (objectMemory hasSpurMemoryManagerAPI
+ and: [objectMemory booleanObjectOf: (objectMemory isPinned: obj)])!
- self pop: argumentCount - 1.
- self stackTopPut:
- (objectMemory hasSpurMemoryManagerAPI
- ifTrue: [objectMemory booleanObjectOf: (objectMemory isPinned: obj)]
- ifFalse: [objectMemory falseObject])!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitivePin (in category 'memory space primitives') -----
  primitivePin
  "Pin or unpin the receiver, i.e. make it immobile or mobile, based on the argument.
  Answer whether the object was already pinned. N.B. pinning does *not* prevent
  an object from being garbage collected."
  | obj boolean wasPinned |
  objectMemory hasSpurMemoryManagerAPI ifFalse:
  [^self primitiveFailFor: PrimErrUnsupported].
 
  obj := self stackValue: 1.
  ((objectMemory isImmediate: obj)
  or: [(objectMemory isForwarded: obj)
  or: [(objectMemory isContext: obj)
  and: [self isStillMarriedContext: obj]]]) ifTrue:
  [^self primitiveFailFor: PrimErrBadReceiver].
  boolean := self stackTop.
  (boolean = objectMemory falseObject
  or: [boolean = objectMemory trueObject]) ifFalse:
  [^self primitiveFailFor: PrimErrBadArgument].
 
  (objectMemory isPinned: obj)
  ifTrue:
  [wasPinned := objectMemory trueObject.
  objectMemory setIsPinnedOf: obj to: boolean = objectMemory trueObject]
  ifFalse:
  [wasPinned := objectMemory falseObject.
  (boolean = objectMemory trueObject
   and: [objectMemory pinObject: obj]) = 0 ifTrue:
  [^self primitiveFailFor: PrimErrNoMemory]].
 
+ self pop: argumentCount + 1 thenPush: wasPinned!
- self pop: argumentCount - 1 thenPush: wasPinned!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
  primitiveSlotAt
+ "Answer a slot in an object.  This numbers all slots from 1, ignoring the distinction between
+ named and indexed inst vars.  In objects with both named and indexed inst vars, the named
+ inst vars preceed the indexed ones.  In non-object indexed objects (objects that contain
+ bits, not object references) this primitive answers the raw integral value at each slot.
+ e.g. for Strings it answers the character code, not the Character object at each slot."
+ | index rcvr fmt numSlots |
- | index rcvr numSlots |
  index := self stackTop.
  rcvr := self stackValue: 1.
  (objectMemory isIntegerObject: index) ifFalse:
  [^self primitiveFailFor: PrimErrBadArgument].
  (objectMemory isImmediate: rcvr) ifTrue:
  [^self primitiveFailFor: PrimErrBadReceiver].
+ fmt := objectMemory formatOf: rcvr.
  index := objectMemory integerValueOf: index.
+
+ fmt <= objectMemory lastPointerFormat ifTrue:
- (objectMemory isPointersNonImm: rcvr) ifTrue:
  [numSlots := objectMemory numSlotsOf: rcvr.
  (self asUnsigned: index) < numSlots ifTrue:
  [self pop: argumentCount + 1 thenPush: (objectMemory fetchPointer: index ofObject: rcvr).
  ^0].
  ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt >= objectMemory firstByteFormat ifTrue:
+ [fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ [^self primitiveFailFor: PrimErrUnsupported].
+ numSlots := objectMemory numBytesOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr).
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ (objectMemory hasSpurMemoryManagerAPI
+ and: [fmt >= objectMemory firstShortFormat]) ifTrue:
+ [numSlots := objectMemory num16BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchShort16: index ofObject: rcvr).
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
+ [numSlots := objectMemory num64BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [self pop: argumentCount + 1
+ thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)).
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt >= objectMemory firstLongFormat ifTrue:
+ [numSlots := objectMemory num32BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [self pop: argumentCount + 1
+ thenPush: (objectMemory bytesPerOop = 8
+ ifTrue: [objectMemory integerObjectOf: (objectMemory fetchLong32: index ofObject: rcvr)]
+ ifFalse: [self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)]).
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
- "for now just fail for non-pointer objects; the issue here is should
- strings answer characters and if so how do we efficiently identify strings?"
  ^self primitiveFailFor: PrimErrBadReceiver!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSlotAtPut (in category 'object access primitives') -----
  primitiveSlotAtPut
+ "Assign a slot in an object.  This numbers all slots from 1, ignoring the distinction between
+ named and indexed inst vars.  In objects with both named and indexed inst vars, the named
+ inst vars preceed the indexed ones.  In non-object indexed objects (objects that contain
+ bits, not object references) this primitive assigns a raw integral value at each slot."
+ | newValue index rcvr fmt numSlots value |
- | newValue index rcvr numSlots |
  newValue := self stackTop.
  index := self stackValue: 1.
  rcvr := self stackValue: 2.
  (objectMemory isIntegerObject: index) ifFalse:
  [^self primitiveFailFor: PrimErrBadArgument].
  (objectMemory isImmediate: rcvr) ifTrue:
  [^self primitiveFailFor: PrimErrBadReceiver].
+ fmt := objectMemory formatOf: rcvr.
  index := objectMemory integerValueOf: index.
+
+ fmt <= objectMemory lastPointerFormat ifTrue:
- (objectMemory isPointersNonImm: rcvr) ifTrue:
  [numSlots := objectMemory numSlotsOf: rcvr.
  (self asUnsigned: index) < numSlots ifTrue:
  [objectMemory storePointer: index ofObject: rcvr withValue: newValue.
  self pop: argumentCount + 1 thenPush: newValue.
  ^0].
  ^self primitiveFailFor: PrimErrBadIndex].
+
+ value := self positiveMachineIntegerValueOf: newValue.
+ self failed ifTrue:
+ [primFailCode := PrimErrBadArgument.
+ ^0].
+
+ fmt >= objectMemory firstByteFormat ifTrue:
+ [fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ [^self primitiveFailFor: PrimErrUnsupported].
+ (self asUnsigned: value) > 16rFF ifTrue:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ numSlots := objectMemory numBytesOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory storeByte: index ofObject: rcvr withValue: value.
+ self pop: argumentCount + 1 thenPush: newValue.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ (objectMemory hasSpurMemoryManagerAPI
+ and: [fmt >= objectMemory firstShortFormat]) ifTrue:
+ [(self asUnsigned: value) > 16rFFFF ifTrue:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ numSlots := objectMemory num16BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory storeShort16: index ofObject: rcvr withValue: value.
+ self pop: argumentCount + 1 thenPush: newValue.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ (objectMemory bytesPerOop = 8
+ and: [fmt = objectMemory sixtyFourBitIndexableFormat]) ifTrue:
+ [numSlots := objectMemory num64BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory storeLong64: index ofObject: rcvr withValue: value.
+ self pop: argumentCount + 1 thenPush: newValue.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt >= objectMemory firstLongFormat ifTrue:
+ [(objectMemory wordSize > 4
+  and: [(self asUnsigned: value) > 16rFFFFFFFF]) ifTrue:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ numSlots := objectMemory num32BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory storeLong32: index ofObject: rcvr withValue: value.
+ self pop: argumentCount + 1 thenPush: newValue.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
- "for now just fail for non-pointer objects; the issue here is should
- strings answer characters and if so how do we efficiently identify strings?"
  ^self primitiveFailFor: PrimErrBadReceiver!

Item was added:
+ ----- Method: ObjectMemory>>sixtyFourBitIndexableFormat (in category 'header formats') -----
+ sixtyFourBitIndexableFormat
+ ^7!

Item was changed:
  ----- Method: SpurMemoryManager>>containsOnlyValidBecomeObjects:and: (in category 'become implementation') -----
  containsOnlyValidBecomeObjects: array1 and: array2
  "Answer 0 if neither array contains only unpinned non-immediates.
  Otherwise answer an informative error code.
  Can't become: immediates!!  Shouldn't become pinned objects."
+ | fieldOffset effectsFlags oop size |
- | fieldOffset effectsFlags oop |
  fieldOffset := self lastPointerOf: array1.
+ effectsFlags := size := 0.
- effectsFlags := 0.
  "same size as array2"
  [fieldOffset >= self baseHeaderSize] whileTrue:
  [oop := self longAt: array1 + fieldOffset.
  (self isOopForwarded: oop) ifTrue:
  [oop := self followForwarded: oop.
  self longAt: array1 + fieldOffset put: oop].
  (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
  (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
  effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
+ size := size + (self bytesInObject: oop).
  oop := self longAt: array2 + fieldOffset.
  (self isOopForwarded: oop) ifTrue:
  [oop := self followForwarded: oop.
  self longAt: array2 + fieldOffset put: oop].
  (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
  (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
  effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
+ size := size + (self bytesInObject: oop).
  fieldOffset := fieldOffset - self bytesPerOop].
  "only set flags after checking all args."
  becomeEffectsFlags := effectsFlags.
+ size >= (totalFreeOldSpace + (scavengeThreshold - freeStart)) ifTrue:
+ [^PrimErrNoMemory].
  ^0!