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

commits at source.squeak.org commits at source.squeak.org
Tue Mar 14 01:16:10 UTC 2017


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

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

Name: VMMaker.oscog-eem.2151
Author: eem
Time: 13 March 2017, 6:15:17.757399 pm
UUID: 688f5e9d-e98c-42e1-9aee-32960a437195
Ancestors: VMMaker.oscog-cb.2151

Stack Interpreter Alien Callbacks:
Implement ownVM: and disownVM: for the non-threaded VM in StackInterpreter (consequently sqVirtualMachine.c will have to change and will be committed in github soon).  Arrange that sendInvokeCallbackContext: & returnAs:ThroughCallback:Context: along with ownVM: and disownVM: conspire to save and restore newMethod, argumentCount and primitiveFunctionPointer around a callback. The VM depends on argumentCount being correct to cut-back the correct number of arguments on primitive return.  If a primitive that invokes a callback fails after invoking a callback (a bad idea, but s**t happens during development) then newMethod is required to activate the right faling method, and Spur expects primitiveFunctionPointer to be valid, so asserts will fail misleadingly if not.
Add three variables to help debug callbacks that are updated only in the assert and debug VMs. debugCallbackPath has bits set in it that describe the specific path taken through returnAs:ThroughCallback:Context:, while debugCallbackReturns debugCallbackInvokes merely count invocations and returns, and can be used for breakponts if reproducible cases arise (such as the recent Pharo 6 VGTigerDemo runDemo issues with copyBits using surface funciton callbacks.

=============== Diff against VMMaker.oscog-cb.2151 ===============

Item was changed:
  ----- Method: IA32ABIPlugin class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGen
  	aCCodeGen
  		addHeaderFile: '<setjmp.h>';
  		addHeaderFile: '"vmCallback.h"';
+ 		addHeaderFile: '"ia32abi.h"';
+ 		addHeaderFile: '"sqAssert.h"'!
- 		addHeaderFile: '"ia32abi.h"'!

Item was changed:
  ----- Method: IA32ABIPlugin>>primReturnAsFromContextThrough (in category 'primitives-callbacks') -----
  primReturnAsFromContextThrough
  	"Return a result from a callback to the callback's callee.  The primitive
  	 has a signature of either of the forms:
  		result <VMCallbackContext32/64>
  				primReturnAs: returnTypeCode <Integer>
  				FromContext: callbackContext <Context>
  		result <VMCallbackContext32/64>
  				primSignal: aSemaphore <Semaphore>
  				andReturnAs: returnTypeCode <Integer>
  				FromContext: callbackContext <Context>
  			<primitive: 'primReturnAsFromContextThrough' error: errorCode module: 'IA32ABI'>.
  	 If of the second form answer false if this is not the most recent callback, and signal aSemaphore
  	 if it is, so as to implement LIFO ordering of callbacks."
  	<export: true>
  	| vmCallbackContext isMostRecent |
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	interpreterProxy methodArgumentCount = 3
  		ifTrue:
+ 			[self assert: (interpreterProxy isNonImmediate: (interpreterProxy stackValue: 3)).
+ 			 self assert: (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore.
+ 			 self assert: (interpreterProxy isIntegerObject: (interpreterProxy stackValue: 1)).
+ 			 self assert: (interpreterProxy isNonImmediate: (interpreterProxy stackValue: 0)).
+ 			 vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 3))
- 			[vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 3))
  										to: #'VMCallbackContext *'.
  			 isMostRecent := vmCallbackContext = self getMostRecentCallbackContext.
  			 isMostRecent ifFalse:
  				[^interpreterProxy methodReturnValue: interpreterProxy falseObject].
  			(interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore ifFalse:
  				[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  			[interpreterProxy signalNoResume: (interpreterProxy stackValue: 2)] whileFalse]
  		ifFalse:
+ 			[self assert: interpreterProxy methodArgumentCount = 2.
+ 			 self assert: (interpreterProxy isNonImmediate: (interpreterProxy stackValue: 2)).
+ 			 self assert: (interpreterProxy isIntegerObject: (interpreterProxy stackValue: 1)).
+ 			 self assert: (interpreterProxy isNonImmediate: (interpreterProxy stackValue: 0)).
+ 			 vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 2))
- 			[vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 2))
  										to: #'VMCallbackContext *'].
  	(interpreterProxy
  		returnAs: (interpreterProxy stackValue: 1)
  		ThroughCallback: vmCallbackContext
  		Context: (interpreterProxy stackValue: 0)) ifFalse:
  			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	"NOTREACHED"!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
+ 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB numExtB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelector
 Length longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer debugCallbackPath debugCallbackReturns debugCallbackInvokes'
- 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB numExtB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelector
 Length longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer'
  	classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimNumberDoExternalCall PrimNumberExternalCall PrimNumberFFICall PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
  	poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: 'eem 12/5/2014 11:32' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse f
 rame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  StackInterpreter and subclasses support multiple memory managers.  Currently there are two.  NewMemoryManager is a slightly refined version of ObjectMemory, and is the memory manager and garbage collector for the original Squeak object representation as described in "Back to the Future The Story of Squeak, A Practical Smalltalk Written in Itself", see http://ftp.squeak.org/docs/OOPSLA.Squeak.html.  Spur is a faster, more regular object representation that is designed for more performance and functionality, and to have a common header format for both 32-bit and 64-bit versions.  You can read about it in SpurMemoryManager's class comment.  There is also a video of a presentation at ESUG 2014 (https://www.youtube.com/watch?v=k0nBNS1aHZ4), along with slides (http://www.slideshare.net/esug/spur-a-new-object-representation-for-cog?related=1).!

Item was changed:
  ----- Method: StackInterpreter class>>mustBeGlobal: (in category 'translation') -----
  mustBeGlobal: var
  	"Answer if a variable must be global and exported.  Used for inst vars that are accessed from VM support code."
  
  	^(super mustBeGlobal: var)
  	   or: [(self objectMemoryClass mustBeGlobal: var)
  	   or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
  			'deferDisplayUpdates' 'extraVMMemory' 'showSurfaceFn'
  			'desiredNumStackPages' 'desiredEdenBytes'
  			'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller' 'checkedPluginName'
+ 			'suppressHeartbeatFlag' 'debugCallbackInvokes' 'debugCallbackPath' 'debugCallbackReturns') includes: var)
- 			'suppressHeartbeatFlag') includes: var)
  	   or: [ "This allows slow machines to define bytecodeSetSelector as 0
  			to avoid the interpretation overhead."
  			MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]]!

Item was added:
+ ----- Method: StackInterpreter>>disownVM: (in category 'vm scheduling') -----
+ disownVM: flags
+ 	<api>
+ 	<inline: false>
+ 	"Release the VM to other threads and answer the current thread's index.
+ 
+ 	 This is the entry-point for plugins and primitives that wish to release the VM while
+ 	 performing some operation that may potentially block, and for callbacks returning
+ 	 back to some blocking operation.  While this exists for the threaded FFI VM we use
+ 	 it to reset newMethod and the argumentCount after a callback."
+ 	self assert: ((objectMemory isIntegerObject: flags)
+ 				and: [(objectMemory integerValueOf: flags)
+ 						between: 0
+ 						and: (self argumentCountOfMethodHeader: -1)]).
+ 	self assert: primFailCode = 0.
+ 	argumentCount := objectMemory integerValueOf: flags.
+ 	newMethod := self popStack.
+ 	self assert: ((objectMemory isOopCompiledMethod: newMethod)
+ 				and: [(self argumentCountOf: newMethod) = argumentCount]).
+ 	^0!

Item was changed:
  ----- Method: StackInterpreter>>initialize (in category 'initialization') -----
  initialize
  	"Here we can initialize the variables C initializes to zero.  #initialize methods do /not/ get translated."
  	checkAllocFiller := false. "must precede initializeObjectMemory:"
  	primFailCode := 0.
  	stackLimit := 0. "This is also the initialization flag for the stack system."
  	stackPage := overflowedPage := 0.
  	extraFramesToMoveOnOverflow := 0.
  	bytecodeSetSelector := 0.
  	highestRunnableProcessPriority := 0.
  	nextProfileTick := 0.
  	nextPollUsecs := 0.
  	nextWakeupUsecs := 0.
  	tempOop := tempOop2 := tempOop3 := theUnknownShort := 0.
  	interruptPending := false.
  	inIOProcessEvents := 0.
  	fullScreenFlag := 0.
  	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	jmpDepth := 0.
  	longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
  	maxExtSemTabSizeSet := false.
+ 	debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0.
  	statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
  	statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0!

Item was added:
+ ----- Method: StackInterpreter>>ownVM: (in category 'vm scheduling') -----
+ ownVM: threadIndexAndFlags
+ 	<api>
+ 	<inline: false>
+ 	"This is the entry-point for plugins and primitives that wish to reacquire the VM after having
+ 	 released it via disownVM or callbacks that want to acquire it without knowing their ownership
+ 	 status.  While this exists for the threaded FFI VM we use it to reset newMethod and the
+ 	 argumentCount after a callback.
+ 
+ 	 Answer the argumentCount encoded as a SmallInteger if the current thread is the VM thread.
+ 	 Answer -1 if the current thread is unknown to the VM and fails to take ownership."
+ 	| amInVMThread |
+ 	<var: 'amInVMThread' declareC: 'extern sqInt amInVMThread(void)'>
+ 	self cCode: [] inSmalltalk: [amInVMThread := 1. amInVMThread class].
+ 	self amInVMThread ifFalse:
+ 		[^-1].
+ 	self assert: primFailCode = 0.
+ 	self assert: ((objectMemory isOopCompiledMethod: newMethod)
+ 				and: [(self argumentCountOf: newMethod) = argumentCount]).
+ 	self push: newMethod.
+ 	^objectMemory integerObjectOf: argumentCount!

Item was changed:
  ----- Method: StackInterpreter>>returnAs:ThroughCallback:Context: (in category 'callback support') -----
  returnAs: returnTypeOop ThroughCallback: vmCallbackContext Context: callbackMethodContext
  	"callbackMethodContext is an activation of invokeCallback:[stack:registers:jmpbuf:].
  	 Its sender is the VM's state prior to the callback.  Reestablish that state (via longjmp),
  	 and mark callbackMethodContext as dead."
  	<export: true>
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	| calloutMethodContext theFP thePage |
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
+ 	self assert: primFailCode = 0.
+ 	self assert: (objectMemory isIntegerObject: returnTypeOop).
+ 	self assert: (objectMemory isImmediate: vmCallbackContext) not.
+ 	self assert: ((objectMemory addressCouldBeObj: callbackMethodContext)
+ 				and: [objectMemory isContext: callbackMethodContext]).
+ 	self assert: (debugCallbackPath := 0) = 0.
+ 	((objectMemory isIntegerObject: returnTypeOop)
- 	((self isIntegerObject: returnTypeOop)
  	 and: [self isLiveContext: callbackMethodContext]) ifFalse:
+ 		[self assert: (debugCallbackPath := 1) = 1.
+ 		 ^false].
- 		[^false].
  	calloutMethodContext := self externalInstVar: SenderIndex ofContext: callbackMethodContext.
  	(self isLiveContext: calloutMethodContext) ifFalse:
+ 		[self assert: (debugCallbackPath := 2) = 2.
+ 		 ^false].
+ 	self assert: (debugCallbackReturns := debugCallbackReturns + 1) > 0.
+ 	"self assert: debugCallbackReturns < 3802."
- 		[^false].
  	"We're about to leave this stack page; must save the current frame's instructionPointer."
  	self push: instructionPointer.
  	self externalWriteBackHeadFramePointers.
  	"Mark callbackMethodContext as dead; the common case is that it is the current frame.
  	 We go the extra mile for the debugger."
  	(self isSingleContext: callbackMethodContext)
+ 		ifTrue:
+ 			[self assert: (debugCallbackPath := debugCallbackPath bitOr: 4) > 0.
+ 		 	 self markContextAsDead: callbackMethodContext]
- 		ifTrue: [self markContextAsDead: callbackMethodContext]
  		ifFalse:
+ 			[self assert: (debugCallbackPath := debugCallbackPath bitOr: 8) > 0.
+ 		 	 theFP := self frameOfMarriedContext: callbackMethodContext.
+ 			 self assert: (self frameReceiver: theFP) = (objectMemory splObj: ClassAlien).
- 			[theFP := self frameOfMarriedContext: callbackMethodContext.
  			 framePointer = theFP "common case"
  				ifTrue:
+ 					[self assert: (debugCallbackPath := debugCallbackPath bitOr: 16) > 0.
+ 		 			 (self isBaseFrame: theFP) ifFalse: "calloutMethodContext is immediately below on the same page.  Make it current."
+ 						[self assert: (debugCallbackPath := debugCallbackPath bitOr: 32) > 0.
+ 		 				 instructionPointer := (self frameCallerSavedIP: theFP) asUnsignedInteger.
+ 						 stackPointer := theFP + (self frameStackedReceiverOffset: theFP) + objectMemory wordSize.
+ 						 framePointer := self frameCallerFP: theFP.
- 					[(self isBaseFrame: theFP) ifFalse: "calloutMethodContext is immediately below on the same page.  Make it current."
- 						[instructionPointer := (self frameCallerSavedIP: framePointer) asUnsignedInteger.
- 						 stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer) + objectMemory wordSize.
- 						 framePointer := self frameCallerFP: framePointer.
  						 self setMethod: (self frameMethodObject: framePointer).
  						 self restoreCStackStateForCallbackContext: vmCallbackContext.
+ 						 self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer.
  						 "N.B. siglongjmp is defines as _longjmp on non-win32 platforms.
  						  This matches the use of _setjmp in ia32abicc.c."
  						 self siglong: vmCallbackContext trampoline jmp: (self integerValueOf: returnTypeOop).
  						 ^true].
  					 stackPages freeStackPage: stackPage]
  				ifFalse:
+ 					[self assert: (debugCallbackPath := debugCallbackPath bitOr: 64) > 0.
+ 		 			 self externalDivorceFrame: theFP andContext: callbackMethodContext.
- 					[self externalDivorceFrame: theFP andContext: callbackMethodContext.
  					 self markContextAsDead: callbackMethodContext]].
  	"Make the calloutMethodContext the active frame.  The case where calloutMethodContext
  	 is immediately below callbackMethodContext on the same page is handled above."
  	(self isStillMarriedContext: calloutMethodContext)
  		ifTrue:
+ 			[self assert: (debugCallbackPath := debugCallbackPath bitOr: 128) > 0.
+ 		 	 theFP := self frameOfMarriedContext: calloutMethodContext.
- 			[theFP := self frameOfMarriedContext: calloutMethodContext.
  			 thePage := stackPages stackPageFor: theFP.
  			 "findSPOf:on: points to the word beneath the instructionPointer, but
  			  there is no instructionPointer on the top frame of the current page."
  			 self assert: thePage ~= stackPage.
  			 stackPointer := thePage headFP = theFP
  								ifTrue: [thePage headSP]
  								ifFalse: [(self findSPOf: theFP on: thePage) - objectMemory wordSize].
+ 			 framePointer := theFP.
+ 			 self assert: stackPointer < framePointer]
- 			 framePointer := theFP]
  		ifFalse:
+ 			[self assert: (debugCallbackPath := debugCallbackPath bitOr: 256) > 0.
+ 		 	 thePage := self makeBaseFrameFor: calloutMethodContext.
+ 			 self setStackPointersFromPage: thePage].
- 			[thePage := self makeBaseFrameFor: calloutMethodContext.
- 			 framePointer := thePage headFP.
- 			 stackPointer := thePage headSP].
  	instructionPointer := self popStack.
  	self setMethod: (objectMemory fetchPointer: MethodIndex ofObject: calloutMethodContext).
  	self setStackPageAndLimit: thePage.
  	self restoreCStackStateForCallbackContext: vmCallbackContext.
+ 	primitiveFunctionPointer := vmCallbackContext savedPrimFunctionPointer.
+ 	"N.B. siglongjmp is defined as _longjmp on non-win32 platforms.
- 	"N.B. siglongjmp is defines as _longjmp on non-win32 platforms.
  	  This matches the use of _setjmp in ia32abicc.c."
  	self siglong: vmCallbackContext trampoline jmp: (self integerValueOf: returnTypeOop).
  	"NOTREACHED"
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>sendInvokeCallbackContext: (in category 'callback support') -----
  sendInvokeCallbackContext: vmCallbackContext
+ 	"Send the calllback message to Alien class with the supplied arg(s).  Use either the 1 arg
+ 	 invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf: message,
+ 	 depending on what selector is installed in the specialObjectsArray. Note that if invoking the
+ 	 legacy invokeCallback:stack:registers:jmpbuf: we pass the vmCallbackContext as the jmpbuf
+ 	 argument (see reestablishContextPriorToCallback:). The arguments are raw C addresses and
+ 	 are converted to integer objects on the way. sendInvokeCallbackContext: &
+ 	 returnAs:ThroughCallback:Context: along with ownVM: and disownVM: conspire to save and
+ 	 restore newMethod, argumentCount and primitiveFunctionPointer around a callback.
+ 	 The VM depends on argumentCount being correct to cut-back the correct number of
+ 	 arguments on primitive return.  If a primitive that invokes a callback fails after invoking a
+ 	 callback (a bad idea, but s**t happens during development) then newMethod is required to
+ 	 activate the right faling method, and Spur expects primitiveFunctionPointer to be valid, so
+ 	 asserts will fail misleadingly if not."
- 	"Send the calllback message to Alien class with the supplied arg(s).  Use either the
- 	 1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf:
- 	 message, depending on what selector is installed in the specialObjectsArray.
- 	 Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the
- 	 vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:).
- 	 The arguments are raw C addresses and are converted to integer objects on the way."
  	<export: true>
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	| classTag |
+ 	vmCallbackContext savedPrimFunctionPointer: primitiveFunctionPointer.
+ 	classTag := self fetchClassTagOfNonImm: (objectMemory splObj: ClassAlien).
- 	classTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
  	messageSelector := self splObj: SelectorInvokeCallback.
  	(self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse:
  	 	[(self lookupOrdinaryNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  			[^false]].
  	primitiveFunctionPointer ~= 0 ifTrue:
+ 		[primitiveFunctionPointer := vmCallbackContext savedPrimFunctionPointer.
+ 		 ^false].
+ 	self assert: (debugCallbackInvokes := debugCallbackInvokes + 1) > 0.
+ 	"self assert: debugCallbackInvokes < 3802."
- 		[^false].
  	self saveCStackStateForCallbackContext: vmCallbackContext.
+ 	self push: (objectMemory splObj: ClassAlien). "receiver"
- 	self push: (self splObj: ClassAlien). "receiver"
  	(self argumentCountOf: newMethod) = 4 ifTrue:
  		[self push: (self positiveMachineIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
  		 self push: (self positiveMachineIntegerFor: vmCallbackContext stackp asUnsignedInteger).
  		 self push: (self positiveMachineIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
  	self push: (self positiveMachineIntegerFor: vmCallbackContext asUnsignedInteger).
  	self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
  	self justActivateNewMethod.
  	(self isMachineCodeFrame: framePointer) ifFalse:
  		[self maybeFlagMethodAsInterpreted: newMethod].
  	self checkForStackOverflow.
+ 	self assert: (self frameReceiver: framePointer) = (objectMemory splObj: ClassAlien).
  	self enterSmalltalkExecutiveFromCallback.
  	"not reached"
  	^true!

Item was changed:
  VMStructType subclass: #VMCallbackContext
+ 	instanceVariableNames: 'thunkp stackp intregargsp floatregargsp savedCStackPointer savedCFramePointer savedPrimFunctionPointer rvs trampoline savedReenterInterpreter'
- 	instanceVariableNames: 'thunkp stackp intregargsp floatregargsp savedCStackPointer savedCFramePointer rvs trampoline savedReenterInterpreter'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Support'!

Item was changed:
  ----- Method: VMCallbackContext class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  	"Define a CallbackContext, the argument to sendInvokeCallbackContext:
  	 self typedef"
  
  	self instVarNames do:
  		[:ivn|
  		aBinaryBlock
  			value: ivn
  			value: (ivn caseOf: {
+ 						['stackp']				-> [#'sqIntptr_t *'].
+ 						['intregargsp']			-> [#'sqIntptr_t *'].
+ 						['floatregargsp']		-> [#'double *'].
+ 						['rvs']					-> [
+ 							'union {
+ 								sqIntptr_t valword;
+ 								struct { int low, high; } valleint64;
+ 								struct { int high, low; } valbeint64;
+ 								double valflt64;
+ 								struct { void *addr; sqIntptr_t size; } valstruct;
+ 							}'].
+ 						['trampoline']				-> [#'jmp_buf'].
+ 						['savedReenterInterpreter']	-> [#'jmp_buf']}
+ 						otherwise: [#'void *'])]!
- 					['thunkp']				-> [#'void *'].
- 					['stackp']				-> [#'sqIntptr_t *'].
- 					['intregargsp']			-> [#'sqIntptr_t *'].
- 					['floatregargsp']		-> [#'double *'].
- 					['rvs']					-> [
- 						'union {
- 							sqIntptr_t valword;
- 							struct { int low, high; } valleint64;
- 							struct { int high, low; } valbeint64;
- 							double valflt64;
- 							struct { void *addr; sqIntptr_t size; } valstruct;
- 						}'].
- 					['savedCStackPointer']		-> [#'void *'].
- 					['savedCFramePointer']		-> [#'void *'].
- 					['trampoline']				-> [#'jmp_buf'].
- 					['savedReenterInterpreter']	-> [#'jmp_buf']})]!

Item was added:
+ ----- Method: VMCallbackContext>>savedPrimFunctionPointer (in category 'accessing') -----
+ savedPrimFunctionPointer
+ 	
+ 	^ savedPrimFunctionPointer
+ !

Item was added:
+ ----- Method: VMCallbackContext>>savedPrimFunctionPointer: (in category 'accessing') -----
+ savedPrimFunctionPointer: anObject
+ 	
+ 	^ savedPrimFunctionPointer := anObject.
+ !



More information about the Vm-dev mailing list