[Vm-dev] VM Maker: VMMaker.oscog-eem.881.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Sep 13 23:54:05 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.881.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.881
Author: eem
Time: 13 September 2014, 4:51:25.863 pm
UUID: 539d444b-dd24-4254-a007-bd1e298e84f7
Ancestors: VMMaker.oscog-eem.880
Fix some conflicting return types. Add debug hook to
inferReturnTypeFromReturnsIn: to do so.
=============== Diff against VMMaker.oscog-eem.880 ===============
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
primitiveFullGC
"Do a full garbage collection. In SqueakV3ObjectMemory, answer the number
of bytes available (including swap space if dynamic memory management is
supported). In Spur, answer the size of the largest free chunk."
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self pop: 1 thenPushInteger: objectMemory fullGC.
^self].
objectMemory fullGCLock > 0 ifTrue:
+ [self primitiveFailFor: PrimErrInappropriate.
+ ^self].
- [^self primitiveFailFor: PrimErrInappropriate].
objectMemory incrementalGC. "maximimize space for forwarding table"
objectMemory fullGC.
self pop: 1 thenPushInteger: (objectMemory bytesLeft: true)!
Item was changed:
----- Method: StackInterpreter>>commonReturn (in category 'return bytecodes') -----
commonReturn
"Do an ^-return (return form method), perhaps checking for unwinds if this is a block activation.
Note: Assumed to be inlined into the dispatch loop."
<sharedCodeInCase: #returnReceiver>
| closure home unwindContextOrNilOrZero frameToReturnTo contextToReturnTo theFP callerFP newPage |
<var: #frameToReturnTo type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #newPage type: #'StackPage *'>
<var: #thePage type: #'StackPage *'>
"If this is a method simply return to the sender/caller."
(self frameIsBlockActivation: localFP) ifFalse:
[^self commonCallerReturn].
"Since this is a block activation the closure is on the stack above any args and the frame."
closure := self pushedReceiverOrClosureOfFrame: localFP.
home := nil.
"Walk the closure's lexical chain to find the context or frame to return from (home)."
[closure ~= objectMemory nilObject] whileTrue:
[home := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closure.
closure := objectMemory fetchPointer: ClosureIndex ofObject: home].
"home is to be returned from provided there is no unwind-protect activation between
this frame and home's sender. Search for an unwind. findUnwindThroughContext:
will answer either the context for an unwind-protect activation or nilObj if the sender
cannot be found or 0 if no unwind is found but the sender is. We must update the
current page's headFrame pointers to enable the search to identify widowed contexts
correctly."
self writeBackHeadFramePointers.
unwindContextOrNilOrZero := self internalFindUnwindThroughContext: home.
unwindContextOrNilOrZero = objectMemory nilObject ifTrue:
["error: can't find home on chain; cannot return"
^self internalCannotReturn: localReturnValue].
unwindContextOrNilOrZero ~= 0 ifTrue:
[^self internalAboutToReturn: localReturnValue through: unwindContextOrNilOrZero].
"Now we know home is on the sender chain.
We could be returning to either a context or a frame. Find out which."
contextToReturnTo := nil.
(self isMarriedOrWidowedContext: home)
ifTrue:
[self assert: (self checkIsStillMarriedContext: home currentFP: localFP).
theFP := self frameOfMarriedContext: home.
(self isBaseFrame: theFP)
ifTrue:
[contextToReturnTo := self frameCallerContext: theFP]
ifFalse:
[frameToReturnTo := self frameCallerFP: theFP]]
ifFalse:
[contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home.
((objectMemory isContext: contextToReturnTo)
and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue:
[self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
frameToReturnTo := self frameOfMarriedContext: contextToReturnTo.
contextToReturnTo := nil]].
"If returning to a context we must make a frame for it unless it is dead."
contextToReturnTo ~= nil ifTrue:
[frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo.
frameToReturnTo == 0 ifTrue:
["error: home's sender is dead; cannot return"
^self internalCannotReturn: localReturnValue]].
"Now we have a frame to return to. If it is on a different page we must free intervening pages and
nil out intervening contexts. We must free intervening stack pages because if we leave the pages
to be divorced then their contexts will be divorced with intact senders and instruction pointers. This
code is similar to primitiveTerminateTo. We must move any frames on itervening pages above the
frame linked to because these may be in use, e.g. via co-routining (see baseFrameReturn)."
self assert: stackPages pageListIsWellFormed.
newPage := stackPages stackPageFor: frameToReturnTo.
newPage ~~ stackPage ifTrue:
[| currentCtx thePage nextCntx |
currentCtx := self frameCallerContext: stackPage baseFP.
self assert: (objectMemory isContext: currentCtx).
stackPages freeStackPage: stackPage.
[self assert: (objectMemory isContext: currentCtx).
(self isMarriedOrWidowedContext: currentCtx)
and: [(stackPages stackPageFor: (theFP := self frameOfMarriedContext: currentCtx)) = newPage]] whileFalse:
[(self isMarriedOrWidowedContext: currentCtx)
ifTrue:
[thePage := stackPages stackPageFor: theFP.
theFP ~= thePage headFP ifTrue:
["Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
self moveFramesIn: thePage through: (self findFrameAbove: theFP inPage: thePage) toPage: self newStackPage].
currentCtx := self frameCallerContext: thePage baseFP.
stackPages freeStackPage: thePage]
ifFalse:
[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
self markContextAsDead: currentCtx.
currentCtx := nextCntx]].
self setStackPageAndLimit: newPage.
localSP := stackPage headSP.
localFP := stackPage headFP].
"Two cases. Returning to the top frame on a new page or an interior frame on the current page.
The top frame has its instruction pointer on top of stack. An interior frame has its instruction pointer
in the caller frame. We need to peel back any frames on the page until we get to the correct frame."
localFP = frameToReturnTo
ifTrue: "pop the saved IP, push the return value and continue."
[localIP := self pointerForOop: self internalStackTop]
ifFalse:
[[callerFP := localFP.
localFP := self frameCallerFP: localFP.
localFP ~~ frameToReturnTo] whileTrue.
localIP := self frameCallerSavedIP: callerFP.
localSP := (self frameCallerSP: callerFP) - BytesPerWord].
self setMethod: (self frameMethod: localFP).
self fetchNextBytecode.
+ self internalStackTopPut: localReturnValue!
- ^self internalStackTopPut: localReturnValue!
Item was changed:
----- Method: StackInterpreter>>printStringOf: (in category 'debug printing') -----
printStringOf: oop
| fmt len cnt max i |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
+ [^self].
- [^nil].
(objectMemory addressCouldBeObj: oop) ifFalse:
+ [^self].
- [^nil].
fmt := objectMemory formatOf: oop.
+ fmt < objectMemory firstByteFormat ifTrue: [^self].
- fmt < objectMemory firstByteFormat ifTrue: [^nil].
cnt := (max := 128) min: (len := objectMemory lengthOf: oop).
i := 0.
((objectMemory is: oop
instanceOf: (objectMemory splObj: ClassByteArray)
compactClassIndex: classByteArrayCompactIndex)
or: [(self isInstanceOfClassLargePositiveInteger: oop)
or: [(self isInstanceOfClassLargeNegativeInteger: oop)]])
ifTrue:
[[i < cnt] whileTrue:
[self printHex: (objectMemory fetchByte: i ofObject: oop).
i := i + 1]]
ifFalse:
[[i < cnt] whileTrue:
[self cCode:
[(objectMemory fetchByte: i ofObject: oop) = 13 "Character cr asInteger" ifTrue:
[self print: '<CR>'.
i + 1 < len ifTrue:
[self print: '...'].
^self]].
self printChar: (objectMemory fetchByte: i ofObject: oop).
i := i + 1]].
len > max ifTrue:
[self print: '...'].
self flush!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveContextAt (in category 'indexing primitives') -----
primitiveContextAt
"Special version of primitiveAt for accessing contexts.
Written to be varargs for use from mirror primitives."
| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
<inline: false>
<var: #spouseFP type: #'char *'>
index := self stackTop.
(objectMemory isIntegerObject: index) ifFalse:
+ [self primitiveFailFor: PrimErrBadArgument.
+ ^self].
- [^self primitiveFailFor: PrimErrBadArgument].
index := objectMemory integerValueOf: index.
aContext := self stackValue: 1.
"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
hdr := objectMemory baseHeader: aContext.
(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
[value := self stObject: aContext at: index.
self successful ifTrue:
[self pop: argumentCount + 1 thenPush: value].
^self].
self externalWriteBackHeadFramePointers.
(self isStillMarriedContext: aContext) ifFalse:
[fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: aContext baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
stSize := self fetchStackPointerOf: aContext.
(index between: 1 and: stSize) ifFalse:
+ [self primitiveFailFor: PrimErrBadIndex.
+ ^self].
- [^self primitiveFailFor: PrimErrBadIndex].
value := self subscript: aContext with: (index + fixedFields) format: fmt.
self pop: argumentCount + 1 thenPush: value.
^self].
spouseFP := self frameOfMarriedContext: aContext.
(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
+ [self primitiveFailFor: PrimErrBadIndex.
+ ^self].
- [^self primitiveFailFor: PrimErrBadIndex].
value := self temporary: index - 1 in: spouseFP.
self pop: argumentCount + 1 thenPush: value!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveContextAtPut (in category 'indexing primitives') -----
primitiveContextAtPut
"Special version of primitiveAtPut for accessing contexts.
Written to be varargs for use from mirror primitives."
| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
<inline: false>
<var: #spouseFP type: #'char *'>
value := self stackTop.
index := self stackValue: 1.
aContext := self stackValue: 2.
(objectMemory isIntegerObject: index) ifFalse:
+ [self primitiveFailFor: PrimErrBadArgument.
+ ^self].
- [^self primitiveFailFor: PrimErrBadArgument].
"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
hdr := objectMemory baseHeader: aContext.
index := objectMemory integerValueOf: index.
(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
[self stObject: aContext at: index put: value.
self successful ifTrue:
[self pop: argumentCount + 1 thenPush: value].
^self].
self externalWriteBackHeadFramePointers.
(self isStillMarriedContext: aContext) ifFalse:
[fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: aContext baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
stSize := self fetchStackPointerOf: aContext.
(index between: 1 and: stSize) ifFalse:
+ [self primitiveFailFor: PrimErrBadIndex.
+ ^self].
- [^self primitiveFailFor: PrimErrBadIndex].
self subscript: aContext with: (index + fixedFields) storing: value format: fmt.
self pop: argumentCount + 1 thenPush: value.
^self].
spouseFP := self frameOfMarriedContext: aContext.
(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
+ [self primitiveFailFor: PrimErrBadIndex.
+ ^self].
- [^self primitiveFailFor: PrimErrBadIndex].
self temporary: index - 1 in: spouseFP put: value.
self pop: argumentCount + 1 thenPush: value!
Item was changed:
----- Method: TMethod>>inferReturnTypeFromReturnsIn: (in category 'type inference') -----
inferReturnTypeFromReturnsIn: aCodeGen
"Attempt to infer the return type of the receiver from returns in the parse tree."
"this for determining which returns have which return types:"
"aCodeGen
pushScope: declarations
while: [parseTree
nodesSelect: [:n| n isReturn]
thenCollect: [:n| | s |
s := Set new.
self addTypesFor: n expression to: s in: aCodeGen.
{n. s}]]"
returnType ifNil: "the initial default"
[aCodeGen
pushScope: declarations
while:
[| hasReturn returnTypes |
hasReturn := false.
returnTypes := Set new.
+ "Debug:
+ (| rettypes |
+ rettypes := Dictionary new.
+ parseTree nodesDo:
+ [:node|
+ node isReturn ifTrue:
+ [| types |
+ self addTypesFor: node expression to: (types := Set new) in: aCodeGen.
+ rettypes at: node expression put: types]].
+ rettypes)"
parseTree nodesDo:
[:node|
node isReturn ifTrue:
[hasReturn := true.
self addTypesFor: node expression to: returnTypes in: aCodeGen]].
returnTypes remove: #implicit ifAbsent: [].
returnTypes := aCodeGen harmonizeReturnTypesIn: returnTypes.
hasReturn
ifTrue:
[returnTypes size > 1 ifTrue:
+ [| message |
+ message := String streamContents:
+ [:s|
+ s nextPutAll: 'conflicting return types '.
+ returnTypes
+ do: [:t| s nextPutAll: t]
+ separatedBy: [s nextPutAll: ', '].
+ s nextPutAll: ' in '; nextPutAll: selector; cr].
+ Notification signal: message.
+ aCodeGen logger show: message].
- [aCodeGen logger show:
- (String streamContents:
- [:s|
- s nextPutAll: 'conflicting return types '.
- returnTypes
- do: [:t| s nextPutAll: t]
- separatedBy: [s nextPutAll: ', '].
- s nextPutAll: ' in '; nextPutAll: selector; cr])].
returnTypes size = 1 ifTrue:
[self returnType: returnTypes anyOne]]
ifFalse:
[self returnType: (aCodeGen implicitReturnTypeFor: selector)]]]!
More information about the Vm-dev
mailing list