[Vm-dev] VM Maker: VMMaker.oscog-eem.2380.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu May 3 01:09:45 UTC 2018
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2380.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2380
Author: eem
Time: 2 May 2018, 6:09:06.540045 pm
UUID: c76d37e1-445c-4e34-9796-fc836dfd50c9
Ancestors: VMMaker.oscog-cb.2379
Fix compiler bug with Apple LLVM version 7.0.0 (clang-700.1.76) for 64-bit Spur segment loading where compiler bug eliminated second version check in segment load when at -Os. Fix is to never inline the 32-bit word byte reversal.
Fix sign extension in printOop: et al on 64-bit Spur.
Revert an unchanged method that gained a later version.
=============== Diff against VMMaker.oscog-cb.2379 ===============
Item was changed:
----- Method: SpurCompactor>>printTheBogons: (in category 'debugging') -----
printTheBogons: aBogon
<inline: true>
coInterpreter
print: 'bogon '; printHexnp: aBogon; cr!
Item was changed:
----- Method: SpurMemoryManager>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') -----
loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray
"This primitive is called from Smalltalk as...
<imageSegment> loadSegmentFrom: aWordArray outPointers: anArray."
"This primitive will load a binary image segment created by primitiveStoreImageSegment.
It expects the outPointer array to be of the proper size, and the wordArray to be well formed.
It will return as its value the original array of roots, and the segmentWordArray will become an
array of the loaded objects. If this primitive should fail, the segmentWordArray will, sadly, have
been reduced to an unrecognizable and unusable jumble. But what more could you have done
with it anyway?
The primitive, if it succeeds, also becomes the segmentWordArray into the array of loaded objects.
This allows fixing up of loaded objects directly, without nextObject, which Spur doesn't support."
+ <inline: #never>
- <inline: false>
| segmentLimit segmentStart segVersion errorCode numLoadedObjects loadedObjectsArray |
segmentLimit := self numSlotsOf: segmentWordArray.
(self objectBytesForSlots: segmentLimit) < (self allocationUnit "version info" + self baseHeaderSize "one object header") ifTrue:
[^PrimErrBadArgument halt].
"Verify format. If the format is wrong, word-swap (since ImageSegment data are 32-bit longs).
If it is still wrong, undo the damage and fail."
segVersion := self longAt: segmentWordArray + self baseHeaderSize.
(coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse:
+ [self reverseBytesIn32BitWordsIn: segmentWordArray.
- [self reverseBytesIn32BitWordsFrom: segmentWordArray + self baseHeaderSize
- to: (self addressAfter: segmentWordArray).
segVersion := self longAt: segmentWordArray + self baseHeaderSize.
(coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse:
+ [self reverseBytesIn32BitWordsIn: segmentWordArray.
- [self reverseBytesIn32BitWordsFrom: segmentWordArray + self baseHeaderSize
- to: (self addressAfter: segmentWordArray).
^PrimErrBadArgument halt]].
segmentStart := segmentWordArray + self baseHeaderSize + self allocationUnit.
segmentLimit := segmentLimit * self bytesPerOop + segmentWordArray + self baseHeaderSize.
"Notionally reverse the Byte type objects if the data is from opposite endian machine.
Test top byte. $d on the Mac or $s on the PC. Rest of word is equal. If Spur is ever
ported to big-endian machines then the segment may have to be byte/word swapped,
+ but so far it only runs on little-endian machines, so for now just fail if endianness is wrong."
- but so far it only runs on little-endian machines, so for now just fail if endinanness is wrong."
self flag: #endianness.
(segVersion >> 24 bitAnd: 16rFF) ~= (self imageSegmentVersion >> 24 bitAnd: 16rFF) ifTrue:
"Reverse the byte-type objects once"
[true
ifTrue: [^PrimErrBadArgument halt]
ifFalse:
[self byteSwapByteObjectsFrom: (self objectStartingAt: segmentStart)
to: segmentLimit
flipFloatsIf: false]].
"Avoid having to remember by arranging that there are no young outPointers if segment is in old space."
(self isOldObject: segmentWordArray) ifTrue:
[errorCode := self ensureNoNewObjectsIn: outPointerArray.
errorCode ~= 0 ifTrue:
[^errorCode]].
"scan through mapping oops and validating class references. Defer entering any
class objects into the class table and/or pinning objects until a second pass."
errorCode := self mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray.
errorCode > 0 ifTrue:
[^errorCode].
numLoadedObjects := errorCode negated.
loadedObjectsArray := self allocateSlots: numLoadedObjects format: self arrayFormat classIndex: ClassArrayCompactIndex.
loadedObjectsArray ifNil:
[^PrimErrNoMemory halt].
"Scan for classes contained in the segment, entering them into the class table.
Classes are at the front, after the root array and have the remembered bit set."
errorCode := self enterClassesIntoClassTableFrom: segmentStart to: segmentLimit.
errorCode ~= 0 ifTrue:
[^errorCode].
"Make a final pass, assigning class indices and/or pinning pinned objects and collecting the loaded objects in loadedObjectsArray"
self assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray filling: loadedObjectsArray.
"Evaporate the container, leaving the newly loaded objects in place."
(self hasOverflowHeader: segmentWordArray)
ifTrue: [self rawOverflowSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop]
ifFalse: [self rawNumSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop].
"Finally forward the segmentWordArray to the loadedObjectsArray"
self forward: segmentWordArray to: loadedObjectsArray.
self runLeakCheckerFor: GCModeImageSegment.
^self objectStartingAt: segmentStart!
Item was added:
+ ----- Method: SpurMemoryManager>>reverseBytesIn32BitWordsIn: (in category 'image segment in/out') -----
+ reverseBytesIn32BitWordsIn: segmentWordArray
+ "This exists to get around a compiler bug in Apple LLVM version 7.0.0 (clang-700.1.76)
+ that was avoiding the second comparison of segVersion after the first byte swap."
+ <inline: #never>
+ self reverseBytesIn32BitWordsFrom: segmentWordArray + self baseHeaderSize
+ to: (self addressAfter: segmentWordArray)!
Item was changed:
----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
longPrintOop: oop
<api>
| fmt lastIndex startIP bytecodesPerLine column |
+ <var: 'field16' type: #'unsigned short'>
+ <var: 'field32' type: #'unsigned int'>
+ <var: 'field64' type: #usqLong>
((objectMemory isImmediate: oop)
or: [(objectMemory addressCouldBeObj: oop) not
or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
or: [(objectMemory isFreeObject: oop)
or: [objectMemory isForwarded: oop]]]]) ifTrue:
[self printOop: oop.
^self].
self printHex: oop.
(objectMemory fetchClassOfNonImm: oop)
ifNil: [self print: ' has a nil class!!!!']
ifNotNil: [:class|
self print: ': a(n) '; printNameOfClass: class count: 5;
print: ' ('.
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>'].
self printHexnp: class; print: ')'].
fmt := objectMemory formatOf: oop.
self print: ' format '; printHexnp: fmt.
fmt > objectMemory lastPointerFormat
ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)]
ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
[| len |
len := objectMemory lengthOf: oop.
self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
objectMemory printHeaderTypeOf: oop.
self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
self cr.
(fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
[^self printStringOf: oop; cr].
(fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue:
[0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do:
[:i| | field32 |
field32 := objectMemory fetchLong32: i ofObject: oop.
self space; printNum: i; space; printHex: field32; space; cr].
^self].
objectMemory hasSpurMemoryManagerAPI ifTrue:
[fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
[0 to: ((objectMemory num64BitUnitsOf: oop) min: 256) - 1 do:
[:i| | field64 |
field64 := objectMemory fetchLong64: i ofObject: oop.
self space; printNum: i; space; printHex: field64; space; cr].
^self].
(fmt between: objectMemory firstShortFormat and: objectMemory firstShortFormat + 1) ifTrue:
[0 to: ((objectMemory num16BitUnitsOf: oop) min: 256) - 1 do:
[:i| | field16 |
field16 := objectMemory fetchShort16: i ofObject: oop.
self space; printNum: i; space; printHex: field16; space; cr].
^self]].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:i| | fieldOop |
fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
self space; printNum: i - 1; space; printHex: fieldOop; space.
(i = 1 and: [objectMemory isCompiledMethod: oop])
ifTrue: [self printMethodHeaderOop: fieldOop]
ifFalse: [self cCode: [self printOopShort: fieldOop]
inSmalltalk: [self print: (self shortPrint: fieldOop)]].
self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > lastIndex ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * objectMemory wordSize + 1.
lastIndex := objectMemory lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
[self cCode: 'printf("0x%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))'
inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
column = 1 ifFalse:
[self cr]]!
Item was changed:
----- Method: StackInterpreter>>printHex: (in category 'debug printing') -----
printHex: n
"Print n in hex, in the form ' 0x1234', padded to a width of 10 characters
in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles)"
<api>
+ <var: #n type: #usqInt>
| len buf |
<var: #buf declareC: 'char buf[37]'> "large enough for a 64-bit value in hex plus the null plus 16 spaces"
self cCode: 'memset(buf,'' '',36)' inSmalltalk: [buf := 'doh!!'].
len := self cCode: 'sprintf(buf + 2 + 2 * BytesPerWord, "0x%" PRIxSQPTR, (usqIntptr_t)(n))'.
self cCode: 'printf("%s", buf + len)'.
len touch: buf!
Item was changed:
----- Method: StackInterpreter>>printHexnp: (in category 'debug printing') -----
printHexnp: n
<api>
+ <var: #n type: #usqInt>
"Print n in hex, in the form '0x1234', unpadded"
+ self print: '0x%lx' f: n!
- self print: '0x%lx' f: (self cCoerceSimple: n to: #'unsigned long')!
Item was changed:
----- Method: StackInterpreter>>printHexnpnp: (in category 'debug printing') -----
printHexnpnp: n
+ <var: #n type: #usqInt>
"Print n in hex, in the form '1234', unpadded"
+ self print: '%lx' f: n!
- self print: '%lx' f: (self cCoerceSimple: n to: #'unsigned long')!
Item was changed:
----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
| cls fmt lastIndex startIP bytecodesPerLine column |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
[^self shortPrintOop: oop].
self printHex: oop.
(objectMemory addressCouldBeObj: oop) ifFalse:
[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [self whereIs: oop]); cr].
(objectMemory isFreeObject: oop) ifTrue:
[self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop).
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop).
objectMemory printHeaderTypeOf: oop].
^self cr].
(objectMemory isForwarded: oop) ifTrue:
[self
print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop).
objectMemory printHeaderTypeOf: oop.
^self cr].
self print: ': a(n) '.
self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
cls = (objectMemory splObj: ClassFloat) ifTrue:
[^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr].
fmt := objectMemory formatOf: oop.
fmt > objectMemory lastPointerFormat ifTrue:
[self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)].
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
self print: ((self isIndirectAlien: oop)
ifTrue: [' indirect @ ']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: [' pointer @ ']
ifFalse: [' direct @ ']]).
^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
(objectMemory isWordsNonImm: oop) ifTrue:
[lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
+ self space; printHex: (self cCoerceSimple: (objectMemory fetchLong32: index - 1 ofObject: oop)
+ to: #'unsigned int').
- self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
^self].
^self printStringOf: oop; cr].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * objectMemory wordSize + 1.
lastIndex := objectMemory lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
[self cCode: 'printf("0x%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))'
inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
column = 1 ifFalse:
[self cr]]!
More information about the Vm-dev
mailing list