[Vm-dev] VM Maker: VMMaker.oscog-eem.174.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jun 26 19:30:54 UTC 2012


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.174.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.174
Author: eem
Time: 26 June 2012, 12:28:31.674 pm
UUID: 28bc956b-53cc-4f7c-a763-09fb8a576071
Ancestors: VMMaker.oscog-eem.173

Comment some return implementations.

Make the array initializer creator non-static (clients can prepend
"static" if required).

Make frame flags printing more concise.

=============== Diff against VMMaker.oscog-eem.173 ===============

Item was added:
+ ----- Method: CCodeGenerator>>arrayInitializerCalled:for:type: (in category 'utilities') -----
+ arrayInitializerCalled: varName for: array type: cType
+ 	"array is a literal array or a CArray on some array."
+ 	| sequence lastLine |
+ 	sequence := array isCollection ifTrue: [array] ifFalse: [array object].
+ 	lastLine := 0.
+ 	^String streamContents:
+ 		[:s|
+ 		s	nextPutAll: cType;
+ 			space;
+ 			nextPutAll: varName;
+ 			nextPutAll: '[] = {'; crtab: 2.
+ 		sequence
+ 			do: [:element| s nextPutAll: (self cLiteralFor: element)]
+ 			separatedBy:
+ 				[s nextPut: $,.
+ 				 (s position - lastLine) > 76
+ 					ifTrue: [s crtab: 2. lastLine := s position]
+ 					ifFalse: [s space]].
+ 		s crtab; nextPut: $}; cr]!

Item was removed:
- ----- Method: CCodeGenerator>>staticArrayInitializerCalled:for:type: (in category 'utilities') -----
- staticArrayInitializerCalled: varName for: array type: cType
- 	"array is a literal array or a CArray on some array."
- 	| sequence lastLine |
- 	sequence := array isCollection ifTrue: [array] ifFalse: [array object].
- 	lastLine := 0.
- 	^String streamContents:
- 		[:s|
- 		s	nextPutAll: 'static ';
- 			nextPutAll: cType;
- 			space;
- 			nextPutAll: varName;
- 			nextPutAll: '[] = {'; crtab: 2.
- 		sequence
- 			do: [:element| s nextPutAll: (self cLiteralFor: element)]
- 			separatedBy:
- 				[s nextPut: $,.
- 				 (s position - lastLine) > 76
- 					ifTrue: [s crtab: 2. lastLine := s position]
- 					ifFalse: [s space]].
- 		s crtab; nextPut: $}; cr]!

Item was changed:
  ----- Method: CoInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	"Override to avoid repeating StackInterpreter's declarations and add our own extensions"
  	| threaded |
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	threaded := aCCodeGenerator vmClass isThreadedVM.
  	aCCodeGenerator
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"cogmethod.h"';
  		addHeaderFile: (threaded ifTrue: ['"cointerpmt.h"'] ifFalse: ['"cointerp.h"']);
  		addHeaderFile:'"cogit.h"'.
  	self declareInterpreterVersionIn: aCCodeGenerator
  		defaultName: (threaded ifTrue: ['Cog MT'] ifFalse: ['Cog']).
  	aCCodeGenerator
  		var: #heapBase
  		declareC: 'static usqInt heapBase';
  		var: #maxLiteralCountForCompile
  		declareC: 'sqInt maxLiteralCountForCompile = MaxLiteralCountForCompile /* ', MaxLiteralCountForCompile printString, ' */';
  		var: #minBackwardJumpCountForCompile
  		declareC: 'sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* ', MinBackwardJumpCountForCompile printString, ' */'.
  	aCCodeGenerator
  		var: #reenterInterpreter
  		declareC: 'jmp_buf reenterInterpreter; /* private export */'.
  	aCCodeGenerator
  		var: #statCodeCompactionUsecs
  		type: #usqLong.
  	aCCodeGenerator
  		var: #primTraceLogIndex type: #'unsigned char';
  		var: #primTraceLog declareC: 'sqInt primTraceLog[256]';
  		var: #traceLog
  		declareC: 'sqInt traceLog[TraceBufferSize /* ', TraceBufferSize printString, ' */]';
  		var: #traceSources
  		declareC: (aCCodeGenerator
+ 					arrayInitializerCalled: 'traceSources'
- 					staticArrayInitializerCalled: 'traceSources'
  					for: TraceSources
  					type: 'char *')!

Item was changed:
  ----- Method: CoInterpreter>>baseFrameReturn (in category 'return bytecodes') -----
  baseFrameReturn
+ 	"Return from a baseFrame (the bottom frame in a stackPage).  The context to
+ 	 return to (which may be married) is stored in the first word of the stack."
  	<inline: true>
  	| contextToReturnTo retToContext theFP theSP thePage newPage frameAbove |
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #newPage type: #'StackPage *'>
  	<var: #frameAbove type: #'char *'>
  	contextToReturnTo := self frameCallerContext: localFP.
  
  	"The stack page is effectively free now, so free it.  We must free it to be
  	 correct in determining if contextToReturnTo is still married, and in case
  	 makeBaseFrameFor: cogs a method, which may cause a code compaction,
  	 in which case the frame must be free to avoid the relocation machinery
  	 tracing the dead frame.  Since freeing now temporarily violates the page-list
  	 ordering invariant, use the assert-free version."
  	stackPages freeStackPageNoAssert: stackPage.
  	retToContext := self isContext: contextToReturnTo.
  	(retToContext
  	 and: [self isStillMarriedContext: contextToReturnTo])
  		ifTrue:
  			[theFP := self frameOfMarriedContext: contextToReturnTo.
  			 thePage := stackPages stackPageFor: theFP.
  			 theFP = thePage headFP
  				ifTrue:
  					[theSP := thePage headSP]
  				ifFalse:
  					["Returning to some interior frame, presumably because of a sender assignment.
  					  Move the frames above to another page (they may be in use, e.g. via coroutining).
  					  Make the interior frame the top frame."
  					 frameAbove := self findFrameAbove: theFP inPage: thePage.
  					 "Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
  					 newPage := self newStackPage.
  					 self assert: newPage = stackPage.
  					 self moveFramesIn: thePage through: frameAbove toPage: newPage.
  					 stackPages markStackPageMostRecentlyUsed: newPage.
  					 theFP := thePage headFP.
  					 theSP := thePage headSP]]
  		ifFalse:
  			[(retToContext
  			  and: [objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: contextToReturnTo)]) ifFalse:
  				[| contextToReturnFrom |
  				 contextToReturnFrom := stackPages longAt: stackPage baseAddress - BytesPerWord.
  				 self tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom
  					to: contextToReturnTo
  					returnValue: localReturnValue.
  				^self externalCannotReturn: localReturnValue from: contextToReturnFrom].
  			 "We must void the instructionPointer to stop it being updated if makeBaseFrameFor:
  			  cogs a method, which may cause a code compaction."
  			 instructionPointer := 0.
  			 thePage := self makeBaseFrameFor: contextToReturnTo.
  			 theFP := thePage headFP.
  			 theSP := thePage headSP].
  	self setStackPageAndLimit: thePage.
  	self assert: (stackPages stackPageFor: theFP) = stackPage.
  	localSP := theSP.
  	localFP := theFP.
  	localIP := self pointerForOop: self internalStackTop.
  	localIP asUnsignedInteger < objectMemory startOfMemory ifTrue:
  		[localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue:
  			["localIP in the cog method zone indicates a return to machine code."
  			 ^self returnToMachineCodeFrame].
  		 localIP := self pointerForOop: (self iframeSavedIP: localFP)].
  	self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
  	self setMethod: (self iframeMethod: localFP).
  	self internalStackTopPut: localReturnValue.
  	^self fetchNextBytecode!

Item was changed:
  ----- Method: CoInterpreter>>ceReturnToInterpreter: (in category 'trampolines') -----
  ceReturnToInterpreter: anOop
+ 	"Perform a return from a machine code frame to an interpreted frame.
+ 	 The machine code has executed a return instruction when the return address
+ 	 is set to ceReturnToInterpreterPC.  Return the result and switch to the interpreter."
  	<api>
  	self assert: ((objectMemory isIntegerObject: anOop) or: [objectMemory addressCouldBeObj: anOop]).
  	self flag: 'are you really sure setStackPageAndLimit: is needed?'.
  	"I think you're only doing this for the markStackPageMostRecentlyUsed:
  	 and that's probably not needed either"
  	self setStackPageAndLimit: stackPage.
  	self assert: (self isMachineCodeFrame: framePointer) not.
  	self setMethod: (self iframeMethod: framePointer).
  	self assertValidExecutionPointe: (self iframeSavedIP: framePointer)
  		r: framePointer
  		s: stackPointer
  		imbar: true.
  	instructionPointer := self iframeSavedIP: framePointer.
  	self push: anOop.
  	self siglong: reenterInterpreter jmp: ReturnToInterpreter.
  	"NOTREACHED"
  	^nil!

Item was changed:
  ----- Method: CoInterpreter>>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."
- 	"Note: Assumed to be inlined into the dispatch loop."
  
  	| 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 *'>
  	<sharedCodeNamed: 'commonReturn' inCase: 120>
  
  	"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.
  			 ((self 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: (self isContext: currentCtx).
  		 stackPages freeStackPage: stackPage.
  		 [(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.
  					 self 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:
  			[localIP := self pointerForOop: self internalStackTop]
  		ifFalse:
  			[[callerFP := localFP.
  			  localFP := self frameCallerFP: localFP.
  			  localFP ~~ frameToReturnTo] whileTrue.
  			localIP := self frameCallerSavedIP: callerFP.
  			localSP := (self frameCallerSP: callerFP) - BytesPerWord].
  	localIP asUnsignedInteger < objectMemory startOfMemory ifTrue:
  		[localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue:
  			["localIP in the cog method zone indicates a return to machine code."
  			 ^self returnToMachineCodeFrame].
  		 localIP := self pointerForOop: (self iframeSavedIP: localFP)].
  	"pop the saved IP, push the return value and continue."
  	self internalStackTopPut: localReturnValue.
  	self setMethod: (self iframeMethod: localFP).
  	^self fetchNextBytecode!

Item was changed:
  ----- Method: CoInterpreter>>printFrameFlagsForFP: (in category 'debug printing') -----
  printFrameFlagsForFP: theFP
  	| address it |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #address type: #'char *'>
  	(self isMachineCodeFrame: theFP)
  		ifTrue:
  			[address := theFP + FoxMethod.
  			it := (stackPages longAt: address) bitAnd: 16r7]
  		ifFalse:
  			[address := theFP + FoxIFrameFlags.
  			 it := stackPages longAt: address].
  	self printHexPtr: address;
  		print: ((self isMachineCodeFrame: theFP)
  				ifTrue: [': mcfrm flags: ']
  				ifFalse: [':intfrm flags: ']);
  		printHex: it.
  	it ~= 0 ifTrue:
  		[self printChar: $=; printNum: it].
  	self print: '  numArgs: '; printNum: (self frameNumArgs: theFP);
+ 		print: ((self frameHasContext: theFP) ifTrue: [' hasContext'] ifFalse: [' noContext']);
+ 		print: ((self frameIsBlockActivation: theFP) ifTrue: [' isBlock'] ifFalse: [' notBlock']);
- 		print: '  hasContext: '; printNum: (self frameHasContext: theFP);
- 		print: '  isBlock: '; printNum: (self frameIsBlockActivation: theFP);
  		cr!

Item was changed:
  ----- Method: StackInterpreter>>baseFrameReturn (in category 'return bytecodes') -----
  baseFrameReturn
+ 	"Return from a baseFrame (the bottom frame in a stackPage).  The context to
+ 	 return to (which may be married) is stored in the saved instruction pointer slot."
  	<inline: true>
  	| contextToReturnTo isAContext theFP theSP thePage frameAbove |
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #frameAbove type: #'char *'>
  	contextToReturnTo := self frameCallerContext: localFP.
  	isAContext := self isContext: contextToReturnTo.
  	(isAContext
  	 and: [self isStillMarriedContext: contextToReturnTo])
  		ifTrue:
  			[theFP := self frameOfMarriedContext: contextToReturnTo.
  			 thePage := stackPages stackPageFor: theFP.
  			 theFP = thePage headFP
  				ifTrue:
  					[theSP := thePage headSP.
  					 stackPages freeStackPageNoAssert: stackPage "for a short time invariant is violated; assert follows"]
  				ifFalse:
  					["Returning to some interior frame, presumably because of a sender assignment.
  					  Move the frames above to another page (they may be in use, e.g. via coroutining).
  					  Make the interior frame the top frame."
  					 frameAbove := self findFrameAbove: theFP inPage: thePage.
  					 "Reuse the page we're exiting, which avoids allocating a new page and
  					  manipulating the page list to mark the page we're entering as least recently
  					  used (to avoid it being deallocated when allocating a new page)."
  					 self moveFramesIn: thePage through: frameAbove toPage: stackPage.
  					 theFP := thePage headFP.
  					 theSP := thePage headSP]]
  		ifFalse:
  			[(isAContext
  			  and: [objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: contextToReturnTo)]) ifFalse:
  				[^self internalCannotReturn: localReturnValue].
  			 thePage := self makeBaseFrameFor: contextToReturnTo.
  			 theFP := thePage headFP.
  			 theSP := thePage headSP.
  			 stackPages freeStackPageNoAssert: stackPage "for a short time invariant is violated; assert follows"].
  	self setStackPageAndLimit: thePage.
  	self assert: (stackPages stackPageFor: theFP) = stackPage.
  	localSP := theSP.
  	localFP := theFP.
  	self setMethod: (self frameMethod: localFP).
  	localIP := self pointerForOop: self internalStackTop.
  	self internalStackTopPut: localReturnValue.
  	self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
  	^self fetchNextBytecode!

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."
- 	"Note: Assumed to be inlined into the dispatch loop."
  
  	| 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 *'>
  	<sharedCodeNamed: 'commonReturn' inCase: 120>
  
  	"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.
  			 ((self 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: (self isContext: currentCtx).
  		 stackPages freeStackPage: stackPage.
  		 [self assert: (self 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.
  					 self 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 internalStackTopPut: localReturnValue.
  	self setMethod: (self frameMethod: localFP).
  	^self fetchNextBytecode!

Item was changed:
  ----- Method: StackInterpreter>>printFrameFlagsForFP: (in category 'debug printing') -----
  printFrameFlagsForFP: theFP
  	| address it |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #address type: #'char *'>
  	address := theFP + FoxFrameFlags.
  	it := stackPages longAt: address.
  	self printHexPtr: address;
  		print: ':       flags: ';
  		printHex: it.
  	it ~= 0 ifTrue:
  		[self printChar: $=; printNum: it].
  	self print: '  numArgs: '; printNum: (self frameNumArgs: theFP);
+ 		print: ((self frameHasContext: theFP) ifTrue: [' hasContext'] ifFalse: [' noContext']);
+ 		print: ((self frameIsBlockActivation: theFP) ifTrue: [' isBlock'] ifFalse: [' notBlock']);
- 		print: '  hasContext: '; printNum: (self frameHasContext: theFP);
- 		print: '  isBlock: '; printNum: (self frameIsBlockActivation: theFP);
  		cr!

Item was changed:
  ----- Method: TAssignmentNode>>emitLiteralArrayDeclarationOn:level:generator: (in category 'C code generation') -----
  emitLiteralArrayDeclarationOn: aStream level: level generator: aCCodeGen
  	| type |
  	type := expression args last value.
  	self assert: type last = $*.
  	aStream
  		crtab: level;
+ 		nextPutAll: '{ static ';
+ 		nextPutAll: (aCCodeGen arrayInitializerCalled: 'aLiteralArray' for: expression args first value type: type allButLast);
- 		nextPutAll: '{ ';
- 		nextPutAll: (aCCodeGen staticArrayInitializerCalled: 'aLiteralArray' for: expression args first value type: type allButLast);
  		nextPut: $;;
  		crtab: level + 1;
  		nextPutAll: variable name;
  		nextPutAll: ' = aLiteralArray;';
  		crtab: level;
  		nextPut: $};
  		cr!

Item was changed:
  ----- Method: VMClass>>sizeof: (in category 'translation support') -----
  sizeof: objectSymbolOrClass
  	<doNotGenerate>
  	| index |
  	objectSymbolOrClass isInteger ifTrue:
  		[self flag: #Dan.
  		 ^BytesPerWord].
  	objectSymbolOrClass isSymbol ifTrue:
  		[(objectSymbolOrClass last == $*
  		 or: [#long == objectSymbolOrClass
  		 or: [#'unsigned long' == objectSymbolOrClass]]) ifTrue:
  			[^BytesPerWord].
  		index := #(	#sqLong #usqLong #double
  					#int #'unsigned int' #float
  					#short #'unsigned short'
  					#char #'unsigned char' #'signed char')
  						indexOf: objectSymbolOrClass
+ 						ifAbsent:
+ 							[objectSymbolOrClass = #sqInt ifTrue: [^BytesPerOop].
+ 							 self error: 'unrecognized C type name'].
- 						ifAbsent: [self error: 'unrecognized C type name'].
  		^#(8 8 8
  			4 4 4
  			2 2
  			1 1 1) at: index].
  	^(objectSymbolOrClass isBehavior
  		ifTrue: [objectSymbolOrClass]
  		ifFalse: [objectSymbolOrClass class])
  			alignedByteSizeOf: objectSymbolOrClass
  			forClient: self!



More information about the Vm-dev mailing list