[Vm-dev] VM Maker: VMMaker.oscog-eem.374.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Sep 12 05:39:03 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.374.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.374
Author: eem
Time: 11 September 2013, 10:34:21.315 pm
UUID: e7f877e9-5f76-41da-85e9-872da59c1a2e
Ancestors: VMMaker.oscog-eem.373
Implement enterIntoClassTable:.
Rewrite commonVariable:at:put:cacheIndex: to be efficient with
immediate characters.
Sdd printing of hash to longPrintOop:.
I notice that
'hello' copy at: 1 put: (Character value: 256); yourself
hash disastrous effects.
=============== Diff against VMMaker.oscog-eem.373 ===============
Item was added:
+ ----- Method: NewObjectMemory>>rawHashBitsOf: (in category 'header access') -----
+ rawHashBitsOf: objOop
+ "Compatibility with Spur."
+ ^self hashBitsOf: objOop!
Item was changed:
----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') -----
enterIntoClassTable: aBehavior
"Enter aBehavior into the class table and answer 0. Otherwise answer a primitive failure code."
+ | initialMajorIndex majorIndex minorIndex page |
+ majorIndex := classTableIndex >> self classTableMajorIndexShift.
+ initialMajorIndex := majorIndex.
+ "classTableIndex should never index the first page; it's reserved for known classes"
+ self assert: initialMajorIndex > 0.
+ minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask.
+
+ [page := self fetchPointer: majorIndex ofObject: classTableRootObj.
+ page = nilObj ifTrue:
+ [page := self allocateSlots: self classTablePageSize
+ format: self arrayFormat
+ classIndex: self arrayClassIndexPun.
+ page ifNil:
+ [^PrimErrNoMemory].
+ self storePointer: majorIndex
+ ofObject: classTableRootObj
+ withValue: page.
+ minorIndex := 0].
+ minorIndex to: self classTablePageSize - 1 do:
+ [:i|
+ (self fetchPointer: i ofObject: page) = nilObj ifTrue:
+ [classTableIndex := majorIndex << self classTableMajorIndexShift + i.
+ self storePointer: i
+ ofObject: page
+ withValue: aBehavior.
+ self setHashBitsOf: aBehavior to: classTableIndex.
+ self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior.
+ ^0]].
+ majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
+ majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
+ [^PrimErrLimitExceeded]] repeat!
- self shouldBeImplemented!
Item was changed:
----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
(#( makeBaseFrameFor:
quickFetchInteger:ofObject:
frameOfMarriedContext:
addressCouldBeClassObj:
isMarriedOrWidowedContext:
shortPrint:
bytecodePrimAt
commonAt:
loadFloatOrIntFrom:
positive32BitValueOf:
primitiveExternalCall
checkedIntegerValueOf:
bytecodePrimAtPut
commonAtPut:
primitiveVMParameter
checkIsStillMarriedContext:currentFP:
displayBitsOf:Left:Top:Right:Bottom:
+ fetchStackPointerOf:
+ primitiveContextAt
+ primitiveContextAtPut) includes: thisContext sender method selector) ifFalse:
- fetchStackPointerOf:) includes: thisContext sender method selector) ifFalse:
[self halt].
^(oop bitAnd: 1) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>printHeaderTypeOf: (in category 'debug printing') -----
printHeaderTypeOf: objOop
coInterpreter print: ((self numSlotsOf: objOop) >= self numSlotsMask
+ ifTrue: [' 8 byte header']
+ ifFalse: [' 16 byte header'])!
- ifTrue: ['8 byte header']
- ifFalse: ['16 byte header'])!
Item was changed:
----- Method: StackInterpreter>>commonVariable:at:put:cacheIndex: (in category 'indexing primitive support') -----
commonVariable: rcvr at: index put: value cacheIndex: atIx
"This code assumes the receiver has been identified at location atIx in the atCache."
| stSize fmt fixedFields valToPut isCharacter |
<inline: true>
stSize := atCache at: atIx+AtCacheSize.
((self oop: index isGreaterThanOrEqualTo: 1)
and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
[fmt := atCache at: atIx+AtCacheFmt.
fmt <= objectMemory weakArrayFormat ifTrue:
[self assert: (objectMemory isContextNonImm: rcvr) not.
fixedFields := atCache at: atIx+AtCacheFixedFields.
^objectMemory storePointer: index + fixedFields - 1 ofObject: rcvr withValue: value].
fmt < objectMemory firstByteFormat ifTrue: "Bitmap"
[valToPut := self positive32BitValueOf: value.
self successful ifTrue:
[objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut.
^nil].
^self primitiveFailFor: PrimErrBadArgument].
fmt >= objectMemory firstStringyFakeFormat "Note fmt >= firstStringyFormat is an artificial flag for strings"
ifTrue: [isCharacter := objectMemory isCharacterObject: value.
isCharacter ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [valToPut := objectMemory characterValueOf: value]
+ ifFalse:
+ [valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value.
+ valToPut := (objectMemory isIntegerObject: valToPut)
+ ifTrue: [objectMemory integerValueOf: valToPut]
+ ifFalse: [-1]]]
- valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value]
ifFalse:
+ [(fmt >= objectMemory firstCompiledMethodFormat
+ and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue:
- [(fmt >= objectMemory firstCompiledMethodFormat and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue: "CompiledMethod"
[^self primitiveFailFor: PrimErrBadIndex].
+ valToPut := (objectMemory isIntegerObject: value)
+ ifTrue: [objectMemory integerValueOf: value]
+ ifFalse: [-1]].
+ ((valToPut >= 0) and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
+ ^objectMemory storeByte: index - 1 ofObject: rcvr withValue: valToPut].
- valToPut := value].
- (objectMemory isIntegerObject: valToPut) ifTrue:
- [valToPut := objectMemory integerValueOf: valToPut.
- ((valToPut >= 0) and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
- ^objectMemory storeByte: index - 1 ofObject: rcvr withValue: valToPut]].
^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
ifFalse: [PrimErrBadReceiver]
ifTrue: [PrimErrBadIndex])!
Item was changed:
----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
longPrintOop: oop
<api>
| class fmt lastIndex startIP bytecodesPerLine column |
((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].
class := objectMemory fetchClassOfNonImm: oop.
self printHex: oop;
print: ': a(n) '; printNameOfClass: class count: 5;
print: ' ('; printHex: class; print: ')'.
fmt := objectMemory formatOf: oop.
fmt > objectMemory lastPointerFormat ifTrue:
[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
objectMemory printHeaderTypeOf: oop.
+ self print: ' hash '; printHex: (objectMemory rawHashBitsOf: oop).
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
[^self].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / 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 printOopShort: fieldOop].
self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * BytesPerWord + 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%08x: ", oop+BaseHeaderSize+index-1)'
inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,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>>superclassSend (in category 'send bytecodes') -----
superclassSend
"Send a message to self, starting lookup with the superclass of the class
containing the currently executing method."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
<sharedCodeNamed: 'commonSupersend' inCase: #singleExtendedSuperBytecode>
+ | superclass |
+ superclass := self superclassOf: (self methodClassOf: method).
+ objectMemory ensureBehaviorHash: superclass.
+ lkupClassTag := objectMemory classTagForClass: superclass.
- lkupClassTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: method)).
self assert: lkupClassTag ~= objectMemory nilObject.
self commonSend!
More information about the Vm-dev
mailing list