[Vm-dev] VM Maker: VMMaker.oscog-eem.2069.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jan 4 17:17:57 UTC 2017
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2069.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2069
Author: eem
Time: 4 January 2017, 9:16:54.512363 am
UUID: f3417712-c17c-4755-92d6-f769cad5da06
Ancestors: VMMaker.oscog-eem.2068
Fix some memory access sends to self to be sends to objectMemory.
=============== Diff against VMMaker.oscog-eem.2068 ===============
Item was changed:
----- Method: CoInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') -----
unmarkAllFrames
| thePage theFP methodField flags |
<var: #thePage type: #'StackPage *'>
<var: #theFP type: #'char *'>
<inline: false>
0 to: numStackPages - 1 do:
[:i|
thePage := stackPages stackPageAt: i.
(stackPages isFree: thePage) ifFalse:
[theFP := thePage headFP.
+ [methodField := stackPages longAt: theFP + FoxMethod.
- [methodField := self longAt: theFP + FoxMethod.
methodField asUnsignedInteger < objectMemory startOfMemory
ifTrue:
[(methodField bitAnd: 4) ~= 0 ifTrue:
[self longAt: theFP + FoxMethod put: methodField - 4]]
ifFalse:
+ [flags := stackPages longAt: theFP + FoxIFrameFlags.
- [flags := self longAt: theFP + FoxIFrameFlags.
(flags bitAnd: 2) ~= 0 ifTrue:
+ [stackPages longAt: theFP + FoxIFrameFlags put: flags - 2]].
- [self longAt: theFP + FoxIFrameFlags put: flags - 2]].
(theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]!
Item was changed:
----- Method: CogVMSimulator>>clipboardRead:Into:At: (in category 'I/O primitives') -----
clipboardRead: sz Into: actualAddress At: zeroBaseIndex
| str |
str := Clipboard clipboardText.
1 to: sz do:
+ [:i | objectMemory byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!
- [:i | self byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!
Item was changed:
----- Method: CogVMSimulator>>printRumpCStackTo: (in category 'rump c stack') -----
printRumpCStackTo: address
self assert: (self isOnRumpCStack: address).
heapBase - objectMemory wordSize
to: address
by: objectMemory wordSize negated
do:
[:addr|
+ self printHex: addr; tab; printHex: (objectMemory longAt: addr); cr]!
- self printHex: addr; tab; printHex: (self longAt: addr); cr]!
Item was removed:
- ----- Method: CogVMSimulator>>validOop: (in category 'testing') -----
- validOop: oop
- " Return true if oop appears to be valid "
- (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
- (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
- oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range"
- "could test if within the first large freeblock"
- (self longAt: oop) = 4 ifTrue: [^ false].
- (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
- ^ true!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
primitiveObjectPointsTo
| rcvr thang lastField |
thang := self stackTop.
rcvr := self stackValue: 1.
(objectMemory isIntegerObject: rcvr) ifTrue:
[^self pop: 2 thenPushBool: false].
lastField := self lastPointerOf: rcvr.
+ objectMemory baseHeaderSize to: lastField by: objectMemory bytesPerOop do:
- objectMemory baseHeaderSize to: lastField by: objectMemory wordSize do:
[:i |
+ (objectMemory longAt: rcvr + i) = thang ifTrue:
- (self longAt: rcvr + i) = thang ifTrue:
[^self pop: 2 thenPushBool: true]].
self pop: 2 thenPushBool: false!
Item was changed:
----- Method: InterpreterPrimitives>>sizeFieldOfAlien: (in category 'primitive support') -----
sizeFieldOfAlien: alienObj
"Answer the first field of alienObj which is assumed to be an Alien of at least 8 bytes"
<inline: true>
+ ^objectMemory longAt: alienObj + objectMemory baseHeaderSize!
- ^self longAt: alienObj + objectMemory baseHeaderSize!
Item was changed:
----- Method: InterpreterPrimitives>>startOfAlienData: (in category 'primitive support') -----
startOfAlienData: oop
"Answer the start of the Alien's data or fail if oop is not an Alien."
<api>
<returnTypeC: #'void *'>
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifFalse:
[self primitiveFailFor: PrimErrBadArgument.
^0].
^self cCoerceSimple: ((self isDirectAlien: oop)
ifTrue: [oop + objectMemory baseHeaderSize + objectMemory bytesPerOop]
+ ifFalse: [objectMemory longAt: oop + objectMemory baseHeaderSize + objectMemory bytesPerOop])
- ifFalse: [self longAt: oop + objectMemory baseHeaderSize + objectMemory bytesPerOop])
to: #'void *'!
Item was removed:
- ----- Method: InterpreterSimulator>>integerAt: (in category 'memory access') -----
- integerAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^memory integerAt: (byteAddress // 4) + 1!
Item was removed:
- ----- Method: InterpreterSimulator>>integerAt:put: (in category 'memory access') -----
- integerAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!
Item was changed:
----- Method: StackInterpreter>>checkForLastObjectOverwrite (in category 'simulation') -----
checkForLastObjectOverwrite
<doNotGenerate>
| freeStart |
checkAllocFiller ifTrue:
[self assert: ((freeStart := objectMemory freeStart) >= objectMemory scavengeThreshold
+ or: [(objectMemory longAt: freeStart) = freeStart])]!
- or: [(self longAt: freeStart) = freeStart])]!
Item was changed:
----- Method: StackInterpreter>>createActualMessageTo: (in category 'message sending') -----
createActualMessageTo: lookupClass
"Bundle up the selector, arguments and lookupClass into a Message object.
In the process it pops the arguments off the stack, and pushes the message object.
This can then be presented as the argument of e.g. #doesNotUnderstand:"
| argumentArray message |
<inline: false> "This is a useful break-point"
self assert: ((objectMemory isImmediate: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]).
self mnuBreakpoint: messageSelector receiver: nil.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[argumentArray := objectMemory
eeInstantiateSmallClassIndex: ClassArrayCompactIndex
format: objectMemory arrayFormat
numSlots: argumentCount.
message := objectMemory
eeInstantiateSmallClassIndex: ClassMessageCompactIndex
format: objectMemory nonIndexablePointerFormat
numSlots: MessageLookupClassIndex + 1]
ifFalse:
[argumentArray := objectMemory
eeInstantiateSmallClass: (objectMemory splObj: ClassArray)
numSlots: argumentCount.
message := objectMemory
eeInstantiateSmallClass: (objectMemory splObj: ClassMessage)
numSlots: MessageLookupClassIndex + 1].
"Since the array is new can use unchecked stores."
(argumentCount - 1) * objectMemory bytesPerOop to: 0 by: objectMemory bytesPerOop negated do:
[:i|
+ objectMemory longAt: argumentArray + objectMemory baseHeaderSize + i put: self popStack].
- self longAt: argumentArray + objectMemory baseHeaderSize + i put: self popStack].
"Since message is new can use unchecked stores."
objectMemory
storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector;
storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray;
storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass.
self push: message.
argumentCount := 1!
Item was changed:
----- Method: StackInterpreter>>stringOf: (in category 'debug support') -----
stringOf: oop
<doNotGenerate>
| size long nLongs chars |
^ String streamContents:
[:strm |
size := 128 min: (self stSizeOf: oop).
nLongs := size-1//objectMemory wordSize+1.
1 to: nLongs do:
+ [:i | long := objectMemory longAt: oop + objectMemory baseHeaderSize + (i-1*objectMemory wordSize).
- [:i | long := self longAt: oop + objectMemory baseHeaderSize + (i-1*objectMemory wordSize).
chars := self charsOfLong: long.
strm nextPutAll: (i=nLongs
ifTrue: [chars copyFrom: 1 to: size-1\\objectMemory wordSize+1]
ifFalse: [chars])]]!
Item was changed:
----- Method: StackInterpreter>>updateObjectsPostByteSwap (in category 'image save/restore') -----
updateObjectsPostByteSwap
"Byte-swap the words of all bytes objects in the image, including Strings, ByteArrays,
and CompiledMethods. This returns these objects to their original byte ordering
after blindly byte-swapping the entire image. For compiled methods, byte-swap
only their bytecodes part. Ensure floats are in platform-order."
| swapFloatWords |
swapFloatWords := objectMemory vmEndianness ~= imageFloatsBigEndian.
self assert: ClassFloatCompactIndex ~= 0.
objectMemory allObjectsDo:
[:oop| | fmt wordAddr methodHeader temp |
fmt := objectMemory formatOf: oop.
fmt >= self firstByteFormat ifTrue: "oop contains bytes"
[wordAddr := oop + objectMemory baseHeaderSize.
fmt >= self firstCompiledMethodFormat ifTrue: "compiled method; start after methodHeader and literals"
+ [methodHeader := objectMemory longAt: oop + objectMemory baseHeaderSize.
- [methodHeader := self longAt: oop + objectMemory baseHeaderSize.
wordAddr := wordAddr + (((objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart) * objectMemory bytesPerOop)].
objectMemory reverseBytesFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)].
fmt = self firstLongFormat ifTrue: "Bitmap, Float etc"
[(swapFloatWords
and: [(objectMemory compactClassIndexOf: oop) = ClassFloatCompactIndex])
ifTrue:
+ [temp := objectMemory longAt: oop + objectMemory baseHeaderSize.
+ objectMemory longAt: oop + objectMemory baseHeaderSize put: (self longAt: oop + objectMemory baseHeaderSize + 4).
+ objectMemory longAt: oop + objectMemory baseHeaderSize + 4 put: temp]
- [temp := self longAt: oop + objectMemory baseHeaderSize.
- self longAt: oop + objectMemory baseHeaderSize put: (self longAt: oop + objectMemory baseHeaderSize + 4).
- self longAt: oop + objectMemory baseHeaderSize + 4 put: temp]
ifFalse:
[(objectMemory hasSpurMemoryManagerAPI not
and: [objectMemory wordSize = 8]) ifTrue: "Object contains 32-bit half-words packed into 64-bit machine words."
[wordAddr := oop + objectMemory baseHeaderSize.
objectMemory reverseWordsFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)]]]]!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
primitiveObjectPointsTo
"This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so.
N.B. Works forrectly for cogged methods too."
| rcvr thang header fmt numSlots methodHeader |
thang := self stackTop.
rcvr := self stackValue: 1.
(objectMemory isImmediate: rcvr) ifTrue:
[^self pop: 2 thenPushBool: false].
"Inlined version of lastPointerOf: for speed in determining if rcvr is a context."
header := objectMemory baseHeader: rcvr.
fmt := objectMemory formatOfHeader: header.
(objectMemory isPointersFormat: fmt)
ifTrue:
[(fmt = objectMemory indexablePointersFormat
and: [objectMemory isContextHeader: header])
ifTrue:
[(self isMarriedOrWidowedContext: rcvr) ifTrue:
[self externalWriteBackHeadFramePointers.
(self isStillMarriedContext: rcvr) ifTrue:
[^self pop: 2
thenPushBool: (self marriedContext: rcvr
pointsTo: thang
stackDeltaForCurrentFrame: 2)]].
"contexts end at the stack pointer"
numSlots := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr)]
ifFalse:
[numSlots := objectMemory numSlotsOf: rcvr]]
ifFalse:
[fmt < objectMemory firstCompiledMethodFormat "no pointers" ifTrue:
[^self pop: 2 thenPushBool: false].
"CompiledMethod: contains both pointers and bytes:"
methodHeader := objectMemory methodHeaderOf: rcvr.
methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true].
numSlots := (objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart].
self assert: numSlots - 1 * objectMemory bytesPerOop + objectMemory baseHeaderSize = (objectMemory lastPointerOf: rcvr).
objectMemory baseHeaderSize
to: numSlots - 1 * objectMemory bytesPerOop + objectMemory baseHeaderSize
by: objectMemory bytesPerOop
do: [:i|
+ (objectMemory longAt: rcvr + i) = thang ifTrue:
- (self longAt: rcvr + i) = thang ifTrue:
[^self pop: 2 thenPushBool: true]].
self pop: 2 thenPushBool: false!
Item was changed:
----- Method: StackInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') -----
unmarkAllFrames
| thePage theFP flags |
<var: #thePage type: #'StackPage *'>
<var: #theFP type: #'char *'>
<inline: false>
0 to: numStackPages - 1 do:
[:i|
thePage := stackPages stackPageAt: i.
(stackPages isFree: thePage) ifFalse:
[theFP := thePage headFP.
+ [flags := objectMemory longAt: theFP + FoxFrameFlags.
- [flags := self longAt: theFP + FoxFrameFlags.
(flags bitAnd: 2) ~= 0 ifTrue:
+ [objectMemory longAt: theFP + FoxFrameFlags put: flags - 2].
- [self longAt: theFP + FoxFrameFlags put: flags - 2].
(theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]!
Item was changed:
----- Method: StackInterpreterSimulator>>clipboardRead:Into:At: (in category 'I/O primitives') -----
clipboardRead: sz Into: actualAddress At: zeroBaseIndex
| str |
str := Clipboard clipboardText.
1 to: sz do:
+ [:i | objectMemory byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!
- [:i | self byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!
Item was removed:
- ----- Method: StackInterpreterSimulator>>integerAt: (in category 'memory access') -----
- integerAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- self deprecated.
- ^objectMemory memory integerAt: (byteAddress // 4) + 1!
Item was removed:
- ----- Method: StackInterpreterSimulator>>integerAt:put: (in category 'memory access') -----
- integerAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- self deprecated.
- ^objectMemory memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!
Item was removed:
- ----- Method: StackInterpreterSimulator>>validOop: (in category 'testing') -----
- validOop: oop
- " Return true if oop appears to be valid "
- (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
- (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
- oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range"
- "could test if within the first large freeblock"
- (self longAt: oop) = 4 ifTrue: [^ false].
- (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
- ^ true!
More information about the Vm-dev
mailing list