[Vm-dev] VM Maker: VMMaker.oscog-EstebanLorenzano.1955.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Sep 29 12:23:02 UTC 2016


Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-EstebanLorenzano.1955.mcz

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

Name: VMMaker.oscog-EstebanLorenzano.1955
Author: EstebanLorenzano
Time: 29 September 2016, 2:20:59.672732 pm
UUID: cb359d33-3a8c-4649-a89e-448090843137
Ancestors: VMMaker.oscog-cb.1954

fetch of sourceHandle may fail, provocking an crash on Pharo. Adding a simple guard to prevent it (as suggested by Peter Uhnak)

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

Item was changed:
  ----- Method: BitBltSimulation>>lockSurfaces (in category 'surface support') -----
  lockSurfaces
  	"Get a pointer to the bits of any OS surfaces."
  	"Notes: 
  	* For equal source/dest handles only one locking operation is performed.
  	This is to prevent locking of overlapping areas which does not work with
  	certain APIs (as an example, DirectDraw prevents locking of overlapping areas). 
  	A special case for non-overlapping but equal source/dest handle would 
  	be possible but we would have to transfer this information over to 
  	unlockSurfaces somehow (currently, only one unlock operation is 
  	performed for equal source and dest handles). Also, this would require
  	a change in the notion of ioLockSurface() which is right now interpreted
  	as a hint and not as a requirement to lock only the specific portion of
  	the surface.
  
  	* The arguments in ioLockSurface() provide the implementation with
  	an explicit hint what area is affected. It can be very useful to
  	know the max. affected area beforehand if getting the bits requires expensive
  	copy operations (e.g., like a roundtrip to the X server or a glReadPixel op).
  	However, the returned pointer *MUST* point to the virtual origin of the surface
  	and not to the beginning of the rectangle. The promise made by BitBlt
  	is to never access data outside the given rectangle (aligned to 4byte boundaries!!)
  	so it is okay to return a pointer to the virtual origin that is actually outside
  	the valid memory area.
  
  	* The area provided in ioLockSurface() is already clipped (e.g., it will always
  	be inside the source and dest boundingBox) but it is not aligned to word boundaries
  	yet. It is up to the support code to compute accurate alignment if necessary.
  
  	* Warping always requires the entire source surface to be locked because
  	there is no beforehand knowledge about what area will actually be traversed.
  
  	"
  	| sourceHandle destHandle l r t b fn |
  	<inline: true>
  	<var: #fn declareC:'sqInt (*fn)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'>
  	hasSurfaceLock := false.
  	destBits = 0 ifTrue:["Blitting *to* OS surface"
  		lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
  		fn := self cCoerce: lockSurfaceFn to: 'sqInt (*)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'.
  		destHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: destForm.
  		(sourceBits = 0 and:[noSource not]) ifTrue:[
  			sourceHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
  			"Handle the special case of equal source and dest handles"
  			(sourceHandle = destHandle) ifTrue:[
  				"If we have overlapping source/dest we lock the entire area
  				so that there is only one area transmitted"
  				isWarping ifFalse:[
  					"When warping we always need the entire surface for the source"
  					sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, 0,0, sourceWidth, sourceHeight)'.
  				] ifTrue:[
  					"Otherwise use overlapping area"
  					l := sx min: dx. r := (sx max: dx) + bbW.
  					t := sy min: dy. b := (sy max: dy) + bbH.
  					sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, l, t, r-l, b-t)'.
  				].
  				destBits := sourceBits.
  				destPitch := sourcePitch.
  				hasSurfaceLock := true.
  				^destBits ~~ 0
  			].
  			"Fall through - if not equal it'll be handled below"
  		].
  		destBits := self cCode:'fn(destHandle, &destPitch, dx, dy, bbW, bbH)'.
  		hasSurfaceLock := true.
  	].
  	(sourceBits == 0 and:[noSource not]) ifTrue:["Blitting *from* OS surface"
  		sourceHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
+ 		interpreterProxy failed ifTrue:[^nil]. "fetch sourceHandle could fail"
  		lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
  		fn := self cCoerce: lockSurfaceFn to: 'sqInt (*)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'.
  		"Warping requiring the entire surface"
  		isWarping ifTrue:[
  			sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, 0, 0, sourceWidth, sourceHeight)'.
  		] ifFalse:[
  			sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, sx, sy, bbW, bbH)'.
  		].
  		hasSurfaceLock := true.
  	].
  	^destBits ~~ 0 and:[sourceBits ~~ 0 or:[noSource]].!

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 isIntegerObject: returnTypeOop)
  	 and: [self isLiveContext: callbackMethodContext]) ifFalse:
  		[^false].
  	calloutMethodContext := self externalInstVar: SenderIndex ofContext: callbackMethodContext.
  	(self isLiveContext: calloutMethodContext) ifFalse:
  		[^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 markContextAsDead: callbackMethodContext]
  		ifFalse:
  			[theFP := self frameOfMarriedContext: callbackMethodContext.
  			 framePointer = theFP "common case"
  				ifTrue:
  					[(self isBaseFrame: theFP)
  						ifTrue: [stackPages freeStackPage: stackPage]
  						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.
  							 "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]]
  				ifFalse:
  					[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:
  			[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 := (self findSPOf: theFP on: thePage) - objectMemory wordSize.
  			 framePointer := theFP]
  		ifFalse:
  			[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.
  	 "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: StackToRegisterMappingCogit>>mapDeadDescriptorIfNeeded: (in category 'compile abstract instructions') -----
  mapDeadDescriptorIfNeeded: descriptor 
  	"insert nops for dead code that is mapped so that bc 
  	 to mc mapping is not many to one"
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	self flag: #annotateInstruction .
  	(descriptor isMapped
  		or: [inBlock > 0 and: [descriptor isMappedInBlock]]) 
  		ifTrue: [self annotateBytecode: self Nop].
  	^ 0!



More information about the Vm-dev mailing list