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

commits at source.squeak.org commits at source.squeak.org
Thu May 31 02:14:48 UTC 2018

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:

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

Name: VMMaker.oscog-eem.2396
Author: eem
Time: 30 May 2018, 7:14:15.813634 pm
UUID: 01a9f048-84c7-4af6-b5a6-bbeee10cbdba
Ancestors: VMMaker.oscog-eem.2395

Fix some compiler warnings in the interpreter (including unused variables).
Make methodReturnString: safe in the presence of allocation failures, but note that, because it may fail on returning a result (which implies the primitive has done its work) this is dubious at best.

Fix Slang not emitting variable declarations for 'extern ...' declarations.

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveBeDisplay (in category 'I/O primitives') -----
  	"Record the system Display object in the specialObjectsTable,
  	 and if possible pin the display bitmap.  Further, invoke ioBeDisplay
  	 to alow the VM to record the location, width heigth & depth of the bitmap."
  	| rcvr bitsOop depthOop heightOop widthOop |
  	rcvr := self stackTop.
  	((objectMemory isPointers: rcvr)
  	and: [(objectMemory lengthOf: rcvr) >= 4
  	and: [bitsOop := objectMemory fetchPointer: 0 ofObject: rcvr.
  		((objectMemory isWordsOrBytes: bitsOop)
  		or: [objectMemory isIntegerObject: bitsOop]) "for surface plugin handles"
  	and: [(objectMemory isIntegerObject: (widthOop := objectMemory fetchPointer: 1 ofObject: rcvr))
  	and: [(objectMemory isIntegerObject: (heightOop := objectMemory fetchPointer: 2 ofObject: rcvr))
  	and: [(objectMemory isIntegerObject: (depthOop := objectMemory fetchPointer: 3 ofObject: rcvr))]]]]]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	objectMemory splObj: TheDisplay put: rcvr.
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [(objectMemory isNonImmediate: bitsOop)
  	 and: [(objectMemory isPinned: bitsOop) not]]) ifTrue:
  		[rcvr := objectMemory pinObject: bitsOop. "Answers 0 if memory required to pin bit not enough memory available."
  		 rcvr ~= 0 ifTrue: [bitsOop := rcvr]].
+ 	self ioBeDisplay: ((objectMemory isNonImmediate: bitsOop)
+ 						ifTrue: [objectMemory firstIndexableField: bitsOop]
+ 						ifFalse: [bitsOop asVoidPointer])
- 	self ioBeDisplay: ((objectMemory isNonImmediate: bitsOop) ifTrue: [objectMemory firstIndexableField: bitsOop] ifFalse: [bitsOop])
  		width: (objectMemory integerValueOf: widthOop)
  		height: (objectMemory integerValueOf: heightOop)
  		depth: (objectMemory integerValueOf: depthOop)!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveGetenv (in category 'other primitives') -----
  	"Access to environment variables via getenv.  No putenv or setenv as yet."
+ 	| key var result |
- 	| var result |
  	<export: true>
+ 	<var: #key type: #'char *'>
  	<var: #var type: #'char *'>
- 	<var: #result type: #'char *'>
  	sHEAFn ~= 0 ifTrue: "secHasEnvironmentAccess"
  		[self sHEAFn ifFalse: [^self primitiveFailFor: PrimErrInappropriate]].
+ 	key := self cStringOrNullFor: self stackTop.
+ 	key = 0 ifTrue:
- 	var := self cStringOrNullFor: self stackTop.
- 	var = 0 ifTrue:
  		[self successful ifTrue:
  			[^self primitiveFailFor: PrimErrBadArgument].
  		 ^self primitiveFailFor: primFailCode].
+ 	var := self getenv: (self cCode: [key] inSmalltalk: [key allButLast]).
+ 	self free: key.
+ 	var ~= 0 ifTrue:
+ 		[result := objectMemory stringForCString: var.
- 	result := self getenv: (self cCode: [var] inSmalltalk: [var allButLast]).
- 	self free: var.
- 	result ~= 0 ifTrue:
- 		[result := objectMemory stringForCString: result.
  		 result ifNil:
  			[^self primitiveFailFor: PrimErrNoMemory]].
  	self assert: primFailCode = 0.
+ 	self pop: 2 thenPush: (var = 0 ifTrue: [objectMemory nilObject] ifFalse: [result])!
- 	self pop: 2 thenPush: (result = 0 ifTrue: [objectMemory nilObject] ifFalse: [result])!

Item was changed:
  ----- Method: InterpreterProxy>>methodReturnString: (in category 'stack access') -----
  methodReturnString: aCString
+ 	"Sets the return value for a method."
- 	"Sets the return value for a method"
  	<var: 'aCString' type: #'char *'>
+ 	(self stringForCString: aCString)
+ 		ifNil: [primFailCode := PrimErrNoMemory]
+ 		ifNotNil: [:result| self pop: argumentCount+1 thenPush: result].
- 	self pop: argumentCount+1 thenPush: (self stringForCString: aCString).

Item was changed:
  ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	| vmClass |
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
  		addHeaderFile:'<stddef.h> /* for e.g. alloca */';
  		addHeaderFile:'<wchar.h> /* for wint_t */';
  	LowcodeVM ifTrue: [ aCCodeGenerator addHeaderFile:'"sqLowcodeFFI.h"'].
  	vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
  		var: #interpreterProxy  type: #'struct VirtualMachine*'.
  		declareVar: #sendTrace type: 'volatile int';
  		declareVar: #byteCount type: #usqInt.
  	"These need to be pointers or unsigned."
  	self declareC: #(instructionPointer method newMethod)
  		as: #usqInt
  		in: aCCodeGenerator.
  	"These are all pointers; char * because Slang has no support for C pointer arithmetic."
+ 	self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit breakSelector)
- 	self declareC: #(localIP localSP localFP nativeSP stackPointer framePointer stackLimit breakSelector nativeStackPointer nativeFramePointer shadowCallStack)
  		as: #'char *'
  		in: aCCodeGenerator.
  		var: #breakSelectorLength
  		declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
  	self declareC: #(stackPage overflowedPage)
  		as: #'StackPage *'
  		in: aCCodeGenerator.
  	aCCodeGenerator removeVariable: 'stackPages'.  "this is an implicit receiver in the translated code."
  	"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
  	 is not defined, for the benefit of the interpreter on slow machines."
  	aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
  			removeVariable: 'bytecodeSetSelector'].
  	BytecodeSetHasExtensions == false ifTrue:
  			removeVariable: 'extA';
  			removeVariable: 'extB'].
  		var: #methodCache
  		declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  				var: #nsMethodCache
  				declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]']
+ 				removeVariable: #nsMethodCache;
  				removeVariable: 'localAbsentReceiver';
  				removeVariable: 'localAbsentReceiverOrZero'].
  	AtCacheTotalSize isInteger ifTrue:
  			var: #atCache
  			declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'].
  		var: #primitiveTable
  		declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
  	vmClass primitiveTable do:
  		(symbolOrNot isSymbol
  		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  				[:tMethod| tMethod returnType: #void]]].
  	vmClass objectMemoryClass hasSpurMemoryManagerAPI
  				var: #primitiveAccessorDepthTable
  				type: 'signed char'
  				sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
  				array: vmClass primitiveAccessorDepthTable]
  			[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
  		var: #displayBits type: #'void *'.
  	self declareC: #(displayWidth displayHeight displayDepth) as: #int in: aCCodeGenerator.
  		var: #primitiveFunctionPointer
  			declareC: 'void (*primitiveFunctionPointer)()';
  		var: #externalPrimitiveTable
  			declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)';
  		var: #interruptCheckChain
  			declareC: 'void (*interruptCheckChain)(void) = 0';
  		var: #showSurfaceFn
  			declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)';
  		var: #jmpBuf
  			declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
  		var: #suspendedCallbacks
  			declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
  		var: #suspendedMethods
  			declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
  								longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
  								"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
  								statProcessSwitch statIOProcessEvents statForceInterruptCheck
  								statCheckForEvents statStackOverflow statStackPageDivorce
  		in: aCCodeGenerator.
  	aCCodeGenerator var: #nextProfileTick type: #sqLong.
+ 	LowcodeVM
+ 		ifTrue:
+ 			[aCCodeGenerator
+ 				var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*'.
+ 			 self declareC: #(nativeSP nativeStackPointer shadowCallStackPointer)
+ 				as: #'char *'
+ 				in: aCCodeGenerator]
+ 		ifFalse:
+ 			[#(lowcodeCalloutState nativeSP nativeStackPointer shadowCallStackPointer) do:
+ 				[:var| aCCodeGenerator removeVariable: var]]!
- 	LowcodeVM ifTrue:
- 		[aCCodeGenerator
- 			var: #shadowCallStackPointer type: #'char *';
- 			var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*']!

Item was changed:
  ----- Method: TMethod>>emitCLocalsOn:generator: (in category 'C code generation') -----
  emitCLocalsOn: aStream generator: aCodeGen
  	"Emit a C function header for this method onto the given stream."
  	| volatileVariables |
  	volatileVariables := properties includesKey: #volatile.
  	self refersToGlobalStruct ifTrue:
  			next: 3 put: Character space; "there's already an opening ${ on this line; see sender"
  			nextPutAll: (volatileVariables
  						ifFalse: ['DECL_MAYBE_SQ_GLOBAL_STRUCT'])].
  	aStream cr.
  	locals isEmpty ifFalse:
  		[(aCodeGen sortStrings: locals) do:
  			[ :var | | decl |
  			decl := self declarationAt: var.
+ 			(volatileVariables
+ 			 or: [(decl beginsWith: 'static')
+ 			 or: [(decl beginsWith: 'extern')
+ 			 or: [usedVariablesCache includes: var]]]) ifTrue:
- 			(volatileVariables or: [(decl beginsWith: 'static') or: [usedVariablesCache includes: var]]) ifTrue:
  				[aStream next: 4 put: Character space.
  				 volatileVariables ifTrue:
  					[aStream nextPutAll: #volatile; space].
  					nextPutAll: decl;
  					nextPut: $;;
  		 aStream cr]!

More information about the Vm-dev mailing list