David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-dtl.601.mcz==================== Summary ====================
Name: VMMaker.oscog-dtl.601
Author: dtl
Time: 2 February 2014, 2:50:58.398 pm
UUID: 0074410d-1695-4af5-82f4-c74b52a35a9e
Ancestors: VMMaker.oscog-eem.600
Fix NewObjectMemory>>shorten:toIndexableSize: for large arrays (3 word header) and make it work for variable objects with fixed fields. Change return value to be number of bytes freed, to permit sender to check for success.
Fix method comment in ObjectMemory>>lengthOf:baseHeader:format:
Add primitiveAllObjects.
Add primitiveTestShortenIndexableSize for testing shorten:toIndexableSize: from the image.
Adapted from VMMaker-dtl.339.mcz
=============== Diff against VMMaker.oscog-eem.600 ===============
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveAllObjects (in category 'object access primitives') -----
+ primitiveAllObjects
+ "Answer an array of all objects that exist when the primitive is called, excluding those
+ that may be garbage collected as a side effect of allocating the result array. The array
+ will contain at least one trailing integer zero that serves as a marker for end of valid
+ object references. Additional trailing zeros represent objects that were garbage
+ collected during execution of this primitive. Sender is responsible for ignoring all
+ trailing zero marker objects in the result array."
+
+ <export: true>
+ | count obj resultArray newCount |
+ self pop: argumentCount+1.
+ "Count the currently accessible objects"
+ count := 0.
+ obj := objectMemory firstAccessibleObject.
+ [obj = nil] whileFalse:
+ [count := count + 1.
+ obj := objectMemory accessibleObjectAfter: obj].
+ "Allocate result array, may cause GC"
+ resultArray := objectMemory instantiateClass: objectMemory classArray indexableSize: count.
+ resultArray = nil ifTrue:
+ [^self primitiveFailFor: PrimErrNoMemory].
+ "Store all objects in result array, excluding any reference to the result array
+ itself, as may happen if garbage collection occurred during allocation of the array."
+ newCount := 0.
+ obj := objectMemory firstAccessibleObject.
+ [obj = nil or: [newCount >= count]] whileFalse:
+ [obj == resultArray
+ ifFalse: [newCount := newCount + 1.
+ self stObject: resultArray at: newCount put: obj ].
+ obj := objectMemory accessibleObjectAfter: obj].
+ "If GC occurred during result array allocation, truncate unused portion of result array"
+ newCount < count
+ ifTrue: [self shorten: resultArray toIndexableSize: newCount].
+ self push: resultArray!
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveTestShortenIndexableSize (in category 'object access primitives') -----
+ primitiveTestShortenIndexableSize
+ "Given an object with indexable pointer fields, reduce the size of the indexable fields
+ to the requested size. Answer the number of bytes freed, or zero if the object cannot
+ be shortened."
+
+ <export: true>
+ | array newSize bytesFreed |
+ newSize := self stackIntegerValue: 0.
+ array := self stackValue: 1.
+ self pop: argumentCount + 1.
+ bytesFreed := self shorten: array toIndexableSize: newSize.
+ self pushInteger: bytesFreed!
Item was changed:
----- Method: NewObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
shorten: obj toIndexableSize: nSlots
+ "Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the
+ unused residual to a free chunk. Word and byte indexable objects are not changed.
+ Answer the number of bytes returned to free memory, which may be zero if no change
+ was possible."
+ | deltaBytes desiredLength fixedFields fmt hdr totalLength
+ indexableFields |
+ (self isPointersNonImm: obj) ifFalse: [^0].
+ nSlots > 0
+ ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative"
- "Currently this works for pointer objects only, and is almost certainly wrong for 64 bits."
- | deltaBytes desiredLength fixedFields fmt hdr totalLength |
- (self isPointersNonImm: obj) ifFalse:
- [^obj].
hdr := self baseHeader: obj.
fmt := self formatOfHeader: hdr.
totalLength := self lengthOf: obj baseHeader: hdr format: fmt.
fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength.
+ indexableFields := totalLength - fixedFields.
+ nSlots >= indexableFields
+ ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk"
+ desiredLength := fixedFields + nSlots.
- desiredLength := fixedFields + nSlots.
deltaBytes := (totalLength - desiredLength) * BytesPerWord.
obj + BaseHeaderSize + (totalLength * BytesPerWord) = freeStart
ifTrue: "Shortening the last object. Need to reduce freeStart."
[self maybeFillWithAllocationCheckFillerFrom: obj + BaseHeaderSize + (desiredLength * BytesPerWord) to: freeStart.
freeStart := obj + BaseHeaderSize + (desiredLength * BytesPerWord)]
ifFalse: "Shortening some interior object. Need to create a free block."
[self setSizeOfFree: obj + BaseHeaderSize + (desiredLength * BytesPerWord)
to: deltaBytes].
(self headerType: obj) caseOf: {
[HeaderTypeSizeAndClass] ->
+ [self longAt: (obj - (BaseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes].
- [self longAt: obj put: hdr - deltaBytes].
[HeaderTypeClass] ->
[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)].
[HeaderTypeShort] ->
[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)] }.
+ ^deltaBytes!
- ^obj!
Item was changed:
----- Method: ObjectMemory>>lengthOf:baseHeader:format: (in category 'indexing primitive support') -----
lengthOf: oop baseHeader: hdr format: fmt
+ "Return the number of fixed and indexable bytes, words, or object pointers in the
+ given object. Assume the given oop is not an integer. For a CompiledMethod, the size
+ of the method header (in bytes) should be subtracted from the result of this method."
- "Return the number of indexable bytes or words in the given object. Assume the given oop is not an integer. For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result of this method."
| sz |
<inline: true>
<asmLabel: false>
(hdr bitAnd: TypeMask) = HeaderTypeSizeAndClass
ifTrue: [ sz := (self sizeHeader: oop) bitAnd: LongSizeMask ]
ifFalse: [ sz := (hdr bitAnd: SizeMask)].
sz := sz - (hdr bitAnd: Size4Bit).
fmt <= self lastPointerFormat
ifTrue: [ ^ (sz - BaseHeaderSize) >> ShiftForWord "words"].
^fmt < self firstByteFormat
ifTrue: [(sz - BaseHeaderSize) >> 2 "32-bit longs"]
ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3) "bytes"]!
Item was changed:
----- Method: ObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
shorten: obj toIndexableSize: nSlots
+ "Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the
+ unused residual to a free chunk. Word and byte indexable objects are not changed.
+ Answer the number of bytes returned to free memory, which may be zero if no change
+ was possible."
+ | deltaBytes desiredLength fixedFields fmt hdr totalLength
+ indexableFields |
+ (self isPointersNonImm: obj) ifFalse: [^0].
+ nSlots > 0
+ ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative"
- "Currently this works for pointer objects only, and is almost certainly wrong for 64 bits."
- | deltaBytes desiredLength fixedFields fmt hdr totalLength |
- (self isPointersNonImm: obj) ifFalse:
- [^obj].
hdr := self baseHeader: obj.
fmt := self formatOfHeader: hdr.
totalLength := self lengthOf: obj baseHeader: hdr format: fmt.
fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength.
+ indexableFields := totalLength - fixedFields.
+ nSlots >= indexableFields
+ ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk"
+ desiredLength := fixedFields + nSlots.
- desiredLength := fixedFields + nSlots.
deltaBytes := (totalLength - desiredLength) * BytesPerWord.
self setSizeOfFree: obj + BaseHeaderSize + (desiredLength * BytesPerWord)
to: deltaBytes.
(self headerType: obj) caseOf: {
[HeaderTypeSizeAndClass] ->
+ [self longAt: (obj - (BaseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes].
- [self longAt: obj put: hdr - deltaBytes].
[HeaderTypeClass] ->
[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)].
[HeaderTypeShort] ->
[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)] }.
+ ^deltaBytes!
- ^obj!
Locked
Foo.st (1K)