[Vm-dev] VM Maker: VMMaker.oscog-eem.532.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Dec 5 01:33:12 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.532.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.532
Author: eem
Time: 4 December 2013, 5:28:36.915 pm
UUID: 6fdc596d-9f99-4e53-87ab-622cf233bc5f
Ancestors: VMMaker.oscog-eem.531
Nuke all NonInt: forms in favour of NonImm:. I depend on the
corrective abilities of the compiler ;-).
=============== Diff against VMMaker.oscog-eem.531 ===============
Item was changed:
----- Method: NewObjectMemory>>findString: (in category 'debug support') -----
findString: aCString
"Print the oops of all string-like things that have the same characters as aCString"
<api>
<var: #aCString type: #'char *'>
| cssz obj sz |
cssz := self strlen: aCString.
obj := self firstObject.
[self oop: obj isLessThan: freeStart] whileTrue:
[(self isFreeObject: obj)
ifTrue:
[sz := self sizeOfFree: obj]
ifFalse:
+ [((self isBytesNonImm: obj)
- [((self isBytesNonInt: obj)
and: [(self lengthOf: obj) = cssz
and: [(self str: aCString n: (self pointerForOop: obj + BaseHeaderSize) cmp: cssz) = 0]]) ifTrue:
[coInterpreter printHex: obj; space; printOopShort: obj; cr].
sz := self sizeBitsOf: obj].
obj := self oopFromChunk: obj + sz]!
Item was changed:
----- Method: NewObjectMemory>>findStringBeginningWith: (in category 'debug support') -----
findStringBeginningWith: aCString
"Print the oops of all string-like things that start with the same characters as aCString"
<api>
<var: #aCString type: #'char *'>
| cssz obj sz |
cssz := self strlen: aCString.
obj := self firstObject.
[self oop: obj isLessThan: freeStart] whileTrue:
[(self isFreeObject: obj)
ifTrue:
[sz := self sizeOfFree: obj]
ifFalse:
+ [((self isBytesNonImm: obj)
- [((self isBytesNonInt: obj)
and: [(self lengthOf: obj) >= cssz
and: [(self str: aCString n: (self pointerForOop: obj + BaseHeaderSize) cmp: cssz) = 0]]) ifTrue:
[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr].
sz := self sizeBitsOf: obj].
obj := self oopFromChunk: obj + sz]!
Item was changed:
----- Method: NewObjectMemory>>longPrintReferencesTo: (in category 'debug printing') -----
longPrintReferencesTo: anOop
"Scan the heap long printing the oops of any and all objects that refer to anOop"
| oop i prntObj |
<api>
prntObj := false.
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
+ [((self isPointersNonImm: oop) or: [self isCompiledMethod: oop]) ifTrue:
- [((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
[(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart]
ifFalse:
[(self isContextNonImm: oop)
ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
ifFalse: [i := self lengthOf: oop]].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[self printHex: oop; print: ' @ '; printNum: i; cr.
prntObj := true.
i := 0]].
prntObj ifTrue:
[prntObj := false.
coInterpreter longPrintOop: oop]].
oop := self accessibleObjectAfter: oop]!
Item was changed:
----- Method: NewObjectMemory>>numReferencesTo: (in category 'debug printing') -----
numReferencesTo: anOop
"Answer the number of objects that refer to anOop, other than anOop."
| oop i n |
oop := self firstAccessibleObject.
n := 0.
[oop = nil] whileFalse:
+ [((self isPointersNonImm: oop) or: [self isCompiledMethod: oop]) ifTrue:
- [((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
[(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart]
ifFalse:
[(self isContextNonImm: oop)
ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
ifFalse: [i := self lengthOf: oop]].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[anOop ~= oop ifTrue:
[n := n + 1].
i := 0]]].
oop := self accessibleObjectAfter: oop].
^n!
Item was changed:
----- Method: NewObjectMemory>>oopHasAcceptableClass: (in category 'image segment in/out') -----
oopHasAcceptableClass: signedOop
"Similar to oopHasOkayClass:, except that it only returns true or false."
| oopClass formatMask behaviorFormatBits oopFormatBits oop |
<var: #oop type: #usqInt>
<var: #oopClass type: #usqInt>
(self isIntegerObject: signedOop) ifTrue: [^ true].
oop := self cCoerce: signedOop to: #usqInt.
(self addressCouldBeObj: oop) ifFalse: [^ false].
oopClass := self cCoerce: (self fetchClassOfNonImm: oop) to: #usqInt.
(self addressCouldBeObj: oopClass) ifFalse: [^ false].
(oopClass + (self sizeBitsOf: oopClass)) <= freeStart ifFalse: [^ false].
+ ((self isPointersNonImm: oopClass) and: [(self lengthOf: oopClass) >= 3]) ifFalse: [^ false].
- ((self isPointersNonInt: oopClass) and: [(self lengthOf: oopClass) >= 3]) ifFalse: [^ false].
+ formatMask := (self isBytesNonImm: oop)
- formatMask := (self isBytesNonInt: oop)
ifTrue: [16rC00] "ignore extra bytes size bits"
ifFalse: [16rF00].
behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
behaviorFormatBits = oopFormatBits ifFalse: [^ false].
^ true!
Item was changed:
----- Method: NewObjectMemory>>printReferencesTo: (in category 'debug printing') -----
printReferencesTo: anOop
"Scan the heap printing the oops of any and all objects that refer to anOop"
| oop i |
<api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
+ [((self isPointersNonImm: oop) or: [self isCompiledMethod: oop]) ifTrue:
- [((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
[(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart]
ifFalse:
[(self isContextNonImm: oop)
ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
ifFalse: [i := self lengthOf: oop]].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[self interpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
i := 0]]].
oop := self accessibleObjectAfter: oop]!
Item was changed:
----- Method: NewObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
shorten: obj toIndexableSize: nSlots
"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:
- (self isPointersNonInt: 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.
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 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)] }.
^obj!
Item was changed:
----- Method: ObjectMemory>>checkOopHasOkayClass: (in category 'debug support') -----
checkOopHasOkayClass: obj
"Attempt to verify that the given obj has a reasonable behavior. The class must be a
valid, non-integer oop and must not be nilObj. It must be a pointers object with three
or more fields. Finally, the instance specification field of the behavior must match that
of the instance. If OK answer true. If not, print reason and answer false."
<api>
<var: #obj type: #usqInt>
| objClass formatMask behaviorFormatBits objFormatBits |
<var: #objClass type: #usqInt>
(self checkOkayOop: obj) ifFalse:
[^false].
objClass := self cCoerce: (self fetchClassOfNonImm: obj) to: #usqInt.
(self isIntegerObject: objClass) ifTrue:
[self print: 'obj '; printHex: obj; print: ' a SmallInteger is not a valid class or behavior'; cr. ^false].
(self okayOop: objClass) ifFalse:
[self print: 'obj '; printHex: obj; print: ' class obj is not ok'; cr. ^false].
+ ((self isPointersNonImm: objClass) and: [(self lengthOf: objClass) >= 3]) ifFalse:
- ((self isPointersNonInt: objClass) and: [(self lengthOf: objClass) >= 3]) ifFalse:
[self print: 'obj '; printHex: obj; print: ' a class (behavior) must be a pointers object of size >= 3'; cr. ^false].
formatMask := (self isBytes: obj)
ifTrue: [16rC00] "ignore extra bytes size bits"
ifFalse: [16rF00].
behaviorFormatBits := (self formatOfClass: objClass) bitAnd: formatMask.
objFormatBits := (self baseHeader: obj) bitAnd: formatMask.
behaviorFormatBits = objFormatBits ifFalse:
[self print: 'obj '; printHex: obj; print: ' and its class (behavior) formats differ'; cr. ^false].
^true!
Item was changed:
----- Method: ObjectMemory>>isBytes: (in category 'header access') -----
isBytes: oop
"Answer true if the argument contains indexable bytes. See comment in formatOf:"
"Note: Includes CompiledMethods."
+ ^(self isNonIntegerObject: oop) and:[self isBytesNonImm: oop]!
- ^(self isNonIntegerObject: oop) and:[self isBytesNonInt: oop]!
Item was added:
+ ----- Method: ObjectMemory>>isBytesNonImm: (in category 'header access') -----
+ isBytesNonImm: oop
+ "Answer true if the argument contains indexable bytes. See comment in formatOf:"
+ "Note: Includes CompiledMethods."
+
+ ^(self formatOf: oop) >= self firstByteFormat!
Item was removed:
- ----- Method: ObjectMemory>>isBytesNonInt: (in category 'header access') -----
- isBytesNonInt: oop
- "Answer true if the argument contains indexable bytes. See comment in formatOf:"
- "Note: Includes CompiledMethods."
-
- ^(self formatOf: oop) >= self firstByteFormat!
Item was changed:
----- Method: ObjectMemory>>isPointers: (in category 'header access') -----
isPointers: oop
"Answer true if the argument has only fields that can hold oops. See comment in formatOf:"
+ ^(self isNonIntegerObject: oop) and:[self isPointersNonImm: oop]!
- ^(self isNonIntegerObject: oop) and:[self isPointersNonInt: oop]!
Item was changed:
----- Method: ObjectMemory>>isPointersNonImm: (in category 'header access') -----
+ isPointersNonImm: oop
- isPointersNonImm: objOop
"Answer if the argument has only fields that can hold oops. See comment in formatOf:"
+ ^(self formatOf: oop) <= self lastPointerFormat!
- ^(self formatOf: objOop) <= self lastPointerFormat!
Item was removed:
- ----- Method: ObjectMemory>>isPointersNonInt: (in category 'header access') -----
- isPointersNonInt: oop
- "Answer if the argument has only fields that can hold oops. See comment in formatOf:"
-
- ^(self formatOf: oop) <= self lastPointerFormat!
Item was changed:
----- Method: ObjectMemory>>isWords: (in category 'header access') -----
isWords: oop
+ "Answer if the argument contains only indexable words (no oops). See comment in formatOf:"
- "Answer true if the argument contains only indexable words (no oops). See comment in formatOf:"
+ ^(self isNonIntegerObject: oop) and: [self isWordsNonImm: oop]!
- ^(self isNonIntegerObject: oop) and:[self isWordsNonInt: oop]!
Item was added:
+ ----- Method: ObjectMemory>>isWordsNonImm: (in category 'header access') -----
+ isWordsNonImm: oop
+ "Answer if the argument contains only indexable words (no oops). See comment in formatOf:"
+
+ ^ (self formatOf: oop) = self firstLongFormat!
Item was removed:
- ----- Method: ObjectMemory>>isWordsNonInt: (in category 'header access') -----
- isWordsNonInt: oop
- "Answer true if the argument contains only indexable words (no oops). See comment in formatOf:"
-
- ^ (self formatOf: oop) = self firstLongFormat!
Item was changed:
----- Method: ObjectMemory>>isWordsOrBytes: (in category 'header access') -----
isWordsOrBytes: oop
+ "Answer if the contains only indexable words or bytes (no oops). See comment in formatOf:"
- "Answer true if the contains only indexable words or bytes (no oops). See comment in formatOf:"
"Note: Excludes CompiledMethods."
+ ^(self isNonIntegerObject: oop) and: [self isWordsOrBytesNonImm: oop]!
- ^(self isNonIntegerObject: oop) and:[self isWordsOrBytesNonInt: oop]!
Item was added:
+ ----- Method: ObjectMemory>>isWordsOrBytesNonImm: (in category 'header access') -----
+ isWordsOrBytesNonImm: oop
+ "Answer if the contains only indexable words or bytes (no oops). See comment in formatOf:"
+ "Note: Excludes CompiledMethods."
+
+ | fmt |
+ fmt := self formatOf: oop.
+ ^fmt = self firstLongFormat
+ or: [fmt >= self firstByteFormat
+ and: [fmt < self firstCompiledMethodFormat]]!
Item was removed:
- ----- Method: ObjectMemory>>isWordsOrBytesNonInt: (in category 'header access') -----
- isWordsOrBytesNonInt: oop
- "Answer true if the contains only indexable words or bytes (no oops). See comment in formatOf:"
- "Note: Excludes CompiledMethods."
-
- | fmt |
- fmt := self formatOf: oop.
- ^fmt = self firstLongFormat
- or: [fmt >= self firstByteFormat
- and: [fmt < self firstCompiledMethodFormat]]!
Item was changed:
----- Method: ObjectMemory>>oopHasAcceptableClass: (in category 'image segment in/out') -----
oopHasAcceptableClass: signedOop
"Similar to oopHasOkayClass:, except that it only returns true or false."
| oopClass formatMask behaviorFormatBits oopFormatBits oop |
<var: #oop type: #usqInt>
<var: #oopClass type: #usqInt>
(self isIntegerObject: signedOop) ifTrue: [^ true].
oop := self cCoerce: signedOop to: #usqInt.
(self addressCouldBeObj: oop) ifFalse: [^ false].
oopClass := self cCoerce: (self fetchClassOfNonImm: oop) to: #usqInt.
(self addressCouldBeObj: oopClass) ifFalse: [^ false].
(oopClass + (self sizeBitsOf: oopClass)) < freeBlock ifFalse: [^ false].
+ ((self isPointersNonImm: oopClass) and: [(self lengthOf: oopClass) >= 3]) ifFalse: [^ false].
- ((self isPointersNonInt: oopClass) and: [(self lengthOf: oopClass) >= 3]) ifFalse: [^ false].
+ formatMask := (self isBytesNonImm: oop)
- formatMask := (self isBytesNonInt: oop)
ifTrue: [16rC00] "ignore extra bytes size bits"
ifFalse: [16rF00].
behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
behaviorFormatBits = oopFormatBits ifFalse: [^ false].
^ true!
Item was changed:
----- Method: ObjectMemory>>oopHasOkayClass: (in category 'debug support') -----
oopHasOkayClass: signedOop
"Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance."
| oop oopClass formatMask behaviorFormatBits oopFormatBits |
<var: #oop type: #usqInt>
<var: #oopClass type: #usqInt>
oop := self cCoerce: signedOop to: #usqInt.
self okayOop: oop.
oopClass := self cCoerce: (self fetchClassOf: oop) to: #usqInt.
(self isIntegerObject: oopClass)
ifTrue: [ self error: 'a SmallInteger is not a valid class or behavior'. ^false ].
(self okayOop: oopClass)
ifFalse: [ self error: 'class oop is not ok'. ^false ].
+ ((self isPointersNonImm: oopClass) and: [(self lengthOf: oopClass) >= 3])
- ((self isPointersNonInt: oopClass) and: [(self lengthOf: oopClass) >= 3])
ifFalse: [ self error: 'a class (behavior) must be a pointers object of size >= 3'. ^false ].
(self isBytes: oop)
ifTrue: [ formatMask := 16rC00 ] "ignore extra bytes size bits"
ifFalse: [ formatMask := 16rF00 ].
behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
behaviorFormatBits = oopFormatBits
ifFalse: [ self error: 'object and its class (behavior) formats differ'. ^false ].
^true!
Item was changed:
----- Method: ObjectMemory>>printReferencesTo: (in category 'debug printing') -----
printReferencesTo: anOop
"Scan the heap printing the oops of any and all objects that refer to anOop"
| oop i |
<api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
+ [((self isPointersNonImm: oop) or: [self isCompiledMethod: oop]) ifTrue:
- [((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
[(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart]
ifFalse:
[(self isContextNonImm: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop)]
ifFalse: [i := self lengthOf: oop]].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[self interpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
i := 0]]].
oop := self accessibleObjectAfter: oop]!
Item was changed:
----- Method: ObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
shorten: obj toIndexableSize: nSlots
"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:
- (self isPointersNonInt: 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.
desiredLength := fixedFields + nSlots.
deltaBytes := (totalLength - desiredLength) * BytesPerWord.
self setSizeOfFree: obj + BaseHeaderSize + (desiredLength * BytesPerWord)
to: deltaBytes.
(self headerType: obj) caseOf: {
[HeaderTypeSizeAndClass] ->
[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)] }.
^obj!
Item was changed:
----- Method: SpurMemoryManager>>findStringBeginningWith: (in category 'debug support') -----
findStringBeginningWith: aCString
"Print the oops of all string-like things that start with the same characters as aCString"
<api>
<var: #aCString type: #'char *'>
| cssz |
cssz := self strlen: aCString.
self allObjectsDo:
[:obj|
+ ((self isBytesNonImm: obj)
- ((self isBytesNonInt: obj)
and: [(self lengthOf: obj) >= cssz
and: [(self str: aCString n: (self pointerForOop: obj + BaseHeaderSize) cmp: cssz) = 0]]) ifTrue:
[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr]]!
More information about the Vm-dev
mailing list