[Vm-dev] VM Maker: VMMaker-tpr.300.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Feb 15 23:28:06 UTC 2013


tim Rowledge uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-tpr.300.mcz

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

Name: VMMaker-tpr.300
Author: tpr
Time: 15 February 2013, 3:26:56.447 pm
UUID: 2d4c7ece-80c7-4ed6-b819-638fbe64a983
Ancestors: VMMaker-dtl.298

Many small changes to correct C type clashes.
Primtives now declared as void foo() instead of sqInt foo().
PrimitiveTable corrected to suit and all prim calling & lookup matched.
isBytes() added to VMPluginCodeGenerator>emithCHeaderForPrimitivesOn: to support changed MiscPrimitivesPlugin

=============== Diff against VMMaker-dtl.298 ===============

Item was changed:
  ----- Method: FilePlugin>>primitiveFileStdioHandles (in category 'file primitives') -----
  primitiveFileStdioHandles
  	"Answer an Array of file handles for standard in, standard out and standard error,
  	 with nil in entries that are unvailable, e.g. because the platform does not provide
  	 standard error, etc.  Fail if there are no standard i/o facilities on the platform or
  	 if the security plugin denies access or if memory runs out."
  	| fileRecords result validMask |
  	<export: true>
  	<var: 'fileRecords' declareC: 'SQFile fileRecords[3]'>
  	sHFAfn ~= 0 ifTrue:
  		[(self cCode: ' ((sqInt (*)(void))sHFAfn)()' inSmalltalk: [true]) ifFalse:
  			[^interpreterProxy primitiveFail]].
+ 	validMask := self sqFileStdioHandlesInto: (fileRecords).
- 	validMask := self sqFileStdioHandlesInto: (self addressOf: fileRecords).
  	validMask = 0 ifTrue:
  		[^interpreterProxy primitiveFail].
  	result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3.
  	result = nil ifTrue:
  		[^interpreterProxy primitiveFail].
  	interpreterProxy pushRemappableOop: result.
  	0 to: 2 do:
  		[:index| | r |
  		(validMask bitAnd: (1 << index)) ~= 0 ifTrue:
  			[result := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize.
  			 result = nil ifTrue:
  				[interpreterProxy popRemappableOop.
  				^interpreterProxy primitiveFail].
  			r := interpreterProxy popRemappableOop.
  			interpreterProxy storePointer: index ofObject: r withValue: result.
  			interpreterProxy pushRemappableOop: r.
  			self mem: (interpreterProxy firstIndexableField: result)
  				cp: (self addressOf: (fileRecords at: index))
  				y: self fileRecordSize]].
  	result := interpreterProxy popRemappableOop.
  	interpreterProxy pop: 1 thenPush: result!

Item was changed:
  ----- Method: Interpreter class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator 
+ 	aCCodeGenerator addHeaderFile: '<setjmp.h>'.
+ 	aCCodeGenerator var: #interpreterProxy type: #'struct VirtualMachine*'.
+ 	aCCodeGenerator var: #primitiveTable declareC: 'void (*primitiveTable[' , (MaxPrimitiveIndex + 2) printString , '] )(void)= ' , self primitiveTableString.
+ 	"declare primitiveTable as an array of pointers to a function returning void, taking no arguments"
+ 	aCCodeGenerator var: #primitiveFunctionPointer declareC: 'void (*primitiveFunctionPointer)(void)'.
+ 	"keep this matching the declaration for primitiveTable"
+ 	self primitiveTable do:
+ 		[:symbolOrNot|
+ 		(symbolOrNot isSymbol
+ 		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
+ 			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
+ 				[:tMethod| tMethod returnType: #void]]].
+ 	"make sure al the primitves are declared returning void"
+ 	aCCodeGenerator var: #methodCache declareC: 'long methodCache[' , (MethodCacheSize + 1) printString , ']'.
+ 	aCCodeGenerator var: #atCache declareC: 'sqInt atCache[' , (AtCacheTotalSize + 1) printString , ']'.
+ 	aCCodeGenerator var: #statGCTime type: #sqLong.
+ 	aCCodeGenerator var: #statFullGCMSecs type: #sqLong.
+ 	aCCodeGenerator var: #statIGCDeltaTime type: #sqLong.
+ 	aCCodeGenerator var: #statIncrGCMSecs type: #sqLong.
- declareCVarsIn: aCCodeGenerator
- 	aCCodeGenerator addHeaderFile:'<setjmp.h>'.
- 	aCCodeGenerator 
- 		var: #interpreterProxy 
- 		type: #'struct VirtualMachine*'.
- 	aCCodeGenerator
- 		var: #primitiveTable
- 		declareC: 'void *primitiveTable[', (MaxPrimitiveIndex +2) printString, '] = ',	self primitiveTableString.
- 	aCCodeGenerator
- 		var: #primitiveFunctionPointer
- 		declareC: 'void (*primitiveFunctionPointer)()'.
- 	aCCodeGenerator
- 		var: #methodCache
- 		declareC: 'long methodCache[', (MethodCacheSize + 1) printString, ']'.
- 	aCCodeGenerator
- 		var: #atCache
- 		declareC: 'sqInt atCache[', (AtCacheTotalSize + 1) printString, ']'.
- 	aCCodeGenerator var: #statGCTime type: #'sqLong'.
- 	aCCodeGenerator var: #statFullGCMSecs type: #'sqLong'.
- 	aCCodeGenerator var: #statIGCDeltaTime type: #'sqLong'.
- 	aCCodeGenerator var: #statIncrGCMSecs type: #'sqLong'.
  	aCCodeGenerator var: #localIP type: #'char*'.
  	aCCodeGenerator var: #localSP type: #'char*'.
  	aCCodeGenerator var: #showSurfaceFn type: #'void*'.
+ 	aCCodeGenerator var: 'semaphoresToSignalA' declareC: 'sqInt semaphoresToSignalA[' , (SemaphoresToSignalSize + 1) printString , ']'.
+ 	aCCodeGenerator var: 'semaphoresToSignalB' declareC: 'sqInt semaphoresToSignalB[' , (SemaphoresToSignalSize + 1) printString , ']'.
+ 	aCCodeGenerator var: #compilerHooks declareC: 'sqInt (*compilerHooks[' , (CompilerHooksSize + 1) printString , '])()'.
+ 	aCCodeGenerator var: #interpreterVersion declareC: 'const char *interpreterVersion = "' , SmalltalkImage current datedVersion , ' [' , SmalltalkImage current lastUpdateString , ']"'.
+ 	aCCodeGenerator var: #externalPrimitiveTable declareC: 'void (*externalPrimitiveTable[' , (MaxExternalPrimitiveTableSize + 1) printString , '])(void)'.
+ 	self declareCAsOop: {#instructionPointer. #method. #newMethod. #activeContext. #theHomeContext. #stackPointer} in: aCCodeGenerator.
+ 	aCCodeGenerator var: #jmpBuf declareC: 'jmp_buf jmpBuf[' , (MaxJumpBuf + 1) printString , ']'.
+ 	aCCodeGenerator var: #suspendedCallbacks declareC: 'sqInt suspendedCallbacks[' , (MaxJumpBuf + 1) printString , ']'.
+ 	aCCodeGenerator var: #suspendedMethods declareC: 'sqInt suspendedMethods[' , (MaxJumpBuf + 1) printString , ']'.
- 	aCCodeGenerator var: 'semaphoresToSignalA'
- 		declareC: 'sqInt semaphoresToSignalA[', (SemaphoresToSignalSize + 1) printString, ']'.
- 	aCCodeGenerator var: 'semaphoresToSignalB'
- 		declareC: 'sqInt semaphoresToSignalB[', (SemaphoresToSignalSize + 1) printString, ']'.
- 	aCCodeGenerator
- 		var: #compilerHooks
- 		declareC: 'sqInt (*compilerHooks[', (CompilerHooksSize + 1) printString, '])()'.
- 	aCCodeGenerator
- 		var: #interpreterVersion
- 		declareC: 'const char *interpreterVersion = "', SmalltalkImage current datedVersion, ' [', SmalltalkImage current lastUpdateString,']"'.
- 	aCCodeGenerator
- 		var: #externalPrimitiveTable
- 		declareC: 'void *externalPrimitiveTable[', (MaxExternalPrimitiveTableSize + 1) printString, ']'.
- 
- 	self declareCAsOop: {
- 			#instructionPointer .
- 			#method .
- 			#newMethod .
- 			#activeContext .
- 			#theHomeContext .
- 			#stackPointer }
- 		in: aCCodeGenerator.
- 		
- 	aCCodeGenerator
- 		var: #jmpBuf
- 		declareC: 'jmp_buf jmpBuf[', (MaxJumpBuf + 1) printString, ']'.
- 	aCCodeGenerator
- 		var: #suspendedCallbacks
- 		declareC: 'sqInt suspendedCallbacks[', (MaxJumpBuf + 1) printString, ']'.
- 	aCCodeGenerator
- 		var: #suspendedMethods
- 		declareC: 'sqInt suspendedMethods[', (MaxJumpBuf + 1) printString, ']'.
- 
  	"Reinitialized at interpreter entry by #initializeImageFormatVersion"
+ 	aCCodeGenerator var: #imageFormatVersionNumber declareC: 'sqInt imageFormatVersionNumber = 0'.
+ 	"Declared here to prevent inclusion in foo struct by
+ 	CCodeGeneratorGlobalStructure"
+ 	aCCodeGenerator var: #imageFormatInitialVersion declareC: 'sqInt imageFormatInitialVersion = 0'!
- 	aCCodeGenerator
- 		var: #imageFormatVersionNumber
- 		declareC: 'sqInt imageFormatVersionNumber = 0'.
- 	"Declared here to prevent inclusion in foo struct by CCodeGeneratorGlobalStructure"
- 	aCCodeGenerator
- 		var: #imageFormatInitialVersion
- 		declareC: 'sqInt imageFormatInitialVersion = 0'
- !

Item was changed:
  ----- Method: Interpreter class>>primitiveTableString (in category 'initialization') -----
  primitiveTableString
  	"Interpreter initializePrimitiveTable primitiveTableString"
  	| table |
  	table := self primitiveTable.
  	^ String
  		streamContents: [:s | 
  			s nextPut: ${.
  			table
  				withIndexDo: [:primSpec :index | s cr; tab;
  					nextPutAll: '/* ';
  					nextPutAll: (index - 1) printString;
  					nextPutAll: '*/ ';
+ 					nextPutAll: '(void (*)(void))'; "keep this matching the declaration of primitiveTable in Interpreter class>declareCVarsIn:"
- 					nextPutAll: '(void *)';
  					nextPutAll: primSpec;
  					nextPut: $,].
  			s cr; nextPutAll: ' 0 }']!

Item was changed:
  ----- Method: Interpreter>>addToExternalPrimitiveTable: (in category 'plugin support') -----
  addToExternalPrimitiveTable: functionAddress
  	"Add the given function address to the external primitive table and return the index where it's stored. This function doesn't need to be fast since it is only called when an external primitive has been looked up (which takes quite a bit of time itself). So there's nothing specifically complicated here.
  	Note: Return index will be one-based (ST convention)"
  
+ 	<var: #functionAddress declareC: 'void (*functionAddress)(void)'>
- 	<var: #functionAddress declareC: 'void *functionAddress'>
  
  	0 to: MaxExternalPrimitiveTableSize-1 do: [ :i |
  		(externalPrimitiveTable at: i) = 0 ifTrue: [
  			externalPrimitiveTable at: i put: functionAddress.
  			^i+1]].
  	"if no space left, return zero so it'll looked up again"
  	^0!

Item was changed:
  ----- Method: Interpreter>>callExternalPrimitive: (in category 'plugin primitive support') -----
  callExternalPrimitive: functionID
  	"Call the external plugin function identified. In the VM this is an address, see 	InterpreterSimulator for it's version. "
  
+ 	<var: #functionID declareC: 'void *functionID(void)'>
- 	<var: #functionID type: 'void *'>
  	self dispatchFunctionPointer: functionID!

Item was changed:
  ----- Method: Interpreter>>dispatchFunctionPointer: (in category 'message sending') -----
+ dispatchFunctionPointer: aFunctionPointer 
+ 	<var: #aFunctionPointer declareC: 'void (*aFunctionPointer)(void)'>
+ 	self
+ 		cCode: '(aFunctionPointer)()'
+ 		inSmalltalk: [self error: 'my simulator should simulate me']!
- dispatchFunctionPointer: aFunctionPointer
- 
- 	<var: #aFunctionPointer type: 'void *'>
- 	self cCode: '((void (*)(void))aFunctionPointer)()'
- 			inSmalltalk: [self error: 'my simulator should simulate me']!

Item was changed:
  ----- Method: Interpreter>>dispatchFunctionPointerOn:in: (in category 'message sending') -----
  dispatchFunctionPointerOn: primIdx in: primTable
  	"Call the primitive at index primIdx in the primitiveTable."
  
+ 	<var: #primTable declareC: 'void (*primTable[])(void)'>
- 	<var: #primTable declareC: 'void *primTable[]'>
  	^self dispatchFunctionPointer: (primTable at: primIdx)!

Item was changed:
  ----- Method: Interpreter>>lookupInMethodCacheSel:class: (in category 'method lookup cache') -----
  lookupInMethodCacheSel: selector class: class
  	"This method implements a simple method lookup cache. If an entry for the given selector and class is found in the cache, set the values of 'newMethod' and 'primitiveIndex' and return true. Otherwise, return false."
  	"About the re-probe scheme: The hash is the low bits of the XOR of two large addresses, minus their useless lowest two bits. If a probe doesn't get a hit, the hash is shifted right one bit to compute the next probe, introducing a new randomish bit. The cache is probed CacheProbeMax times before giving up."
  	"WARNING: Since the hash computation is based on the object addresses of the class and selector, we must rehash or flush when compacting storage. We've chosen to flush, since that also saves the trouble of updating the addresses of the objects in the cache."
  
  	| hash probe |
  	<inline: true>
  	hash := selector bitXor: class.  "shift drops two low-order zeros from addresses"
  
  	probe := hash bitAnd: MethodCacheMask.  "first probe"
  	(((methodCache at: probe + MethodCacheSelector) = selector) and:
  		 [(methodCache at: probe + MethodCacheClass) = class]) ifTrue:
  			[newMethod := methodCache at: probe + MethodCacheMethod.
  			primitiveIndex := methodCache at: probe + MethodCachePrim.
  			newNativeMethod := methodCache at: probe + MethodCacheNative.
+ 			primitiveFunctionPointer := self cCoerce: (methodCache at: probe + MethodCachePrimFunction) to: 'void (*)(void)'.
- 			primitiveFunctionPointer := self cCoerce: (methodCache at: probe + MethodCachePrimFunction) to: 'void *'.
  			^ true	"found entry in cache; done"].
  
  	probe := (hash >> 1) bitAnd: MethodCacheMask.  "second probe"
  	(((methodCache at: probe + MethodCacheSelector) = selector) and:
  		 [(methodCache at: probe + MethodCacheClass) = class]) ifTrue:
  			[newMethod := methodCache at: probe + MethodCacheMethod.
  			primitiveIndex := methodCache at: probe + MethodCachePrim.
  			newNativeMethod := methodCache at: probe + MethodCacheNative.
+ 			primitiveFunctionPointer := self cCoerce: (methodCache at: probe + MethodCachePrimFunction) to: 'void (*)(void)'.
- 			primitiveFunctionPointer := self cCoerce: (methodCache at: probe + MethodCachePrimFunction) to: 'void *'.
  			^ true	"found entry in cache; done"].
  
  	probe := (hash >> 2) bitAnd: MethodCacheMask.
  	(((methodCache at: probe + MethodCacheSelector) = selector) and:
  		 [(methodCache at: probe + MethodCacheClass) = class]) ifTrue:
  			[newMethod := methodCache at: probe + MethodCacheMethod.
  			primitiveIndex := methodCache at: probe + MethodCachePrim.
  			newNativeMethod := methodCache at: probe + MethodCacheNative.
+ 			primitiveFunctionPointer := self cCoerce: (methodCache at: probe + MethodCachePrimFunction) to: 'void (*)(void)'.
- 			primitiveFunctionPointer := self cCoerce: (methodCache at: probe + MethodCachePrimFunction) to: 'void *'.
  			^ true	"found entry in cache; done"].
  
  	^ false
  !

Item was changed:
  ----- Method: Interpreter>>primitiveExternalCall (in category 'plugin primitives') -----
  primitiveExternalCall
  	"Call an external primitive. The external primitive methods 
  	contain as first literal an array consisting of: 
  	* The module name (String | Symbol) 
  	* The function name (String | Symbol) 
  	* The session ID (SmallInteger) [OBSOLETE] 
  	* The function index (Integer) in the externalPrimitiveTable 
  	For fast failures the primitive index of any method where the 
  	external prim is not found is rewritten in the method cache 
  	with zero. This allows for ultra fast responses as long as the 
  	method stays in the cache. 
  	The fast failure response relies on lkupClass being properly 
  	set. This is done in 
  	#addToMethodCacheSel:class:method:primIndex: to 
  	compensate for execution of methods that are looked up in a 
  	superclass (such as in primitivePerformAt). 
  	With the latest modifications (e.g., actually flushing the 
  	function addresses from the VM), the session ID is obsolete. 
  	But for backward compatibility it is still kept around. Also, a 
  	failed lookup is reported specially. If a method has been 
  	looked up and not been found, the function address is stored 
  	as -1 (e.g., the SmallInteger -1 to distinguish from 
  	16rFFFFFFFF which may be returned from the lookup). 
  	It is absolutely okay to remove the rewrite if we run into any 
  	problems later on. It has an approximate speed difference of 
  	30% per failed primitive call which may be noticable but if, 
  	for any reasons, we run into problems (like with J3) we can 
  	always remove the rewrite. 
  	"
+ 	| lit extFnAddr moduleName functionName moduleLength functionLength index |
+ 	<var: #extFnAddr declareC: 'void (*extFnAddr)(void)'>
- 	| lit addr moduleName functionName moduleLength functionLength index |
- 	<var: #addr type: 'void *'>
  	
  	"Fetch the first literal of the method"
  	self success: (self literalCountOf: newMethod) > 0. "@@: Could this be omitted for speed?!!"
  	self successful ifFalse: [^ nil].
  
  	lit := self literal: 0 ofMethod: newMethod. 
  	"Check if it's an array of length 4"
  	self success: ((objectMemory isArray: lit) and: [(self lengthOf: lit) = 4]).
  	self successful ifFalse: [^ nil].
  
  	"Look at the function index in case it has been loaded before"
  	index := objectMemory fetchPointer: 3 ofObject: lit.
  	index := self checkedIntegerValueOf: index.
  	self successful ifFalse: [^ nil].
  	"Check if we have already looked up the function and failed."
  	index < 0
  		ifTrue: ["Function address was not found in this session, 
  			Rewrite the mcache entry with a zero primitive index."
  			self
  				rewriteMethodCacheSel: messageSelector
  				class: lkupClass
  				primIndex: 0.
  			^ self success: false].
  
  	"Try to call the function directly"
  	(index > 0 and: [index <= MaxExternalPrimitiveTableSize])
+ 		ifTrue: [extFnAddr := externalPrimitiveTable at: index - 1.
+ 			extFnAddr ~= 0
+ 				ifTrue: [self rewriteMethodCacheSel: messageSelector class: lkupClass primIndex: (1000 + index) primFunction: extFnAddr.
+ 					self callExternalPrimitive: extFnAddr.
- 		ifTrue: [addr := externalPrimitiveTable at: index - 1.
- 			addr ~= 0
- 				ifTrue: [self rewriteMethodCacheSel: messageSelector class: lkupClass primIndex: (1000 + index) primFunction: addr.
- 					self callExternalPrimitive: addr.
  					^ nil].
  			"if we get here, then an index to the external prim was 
  			kept on the ST side although the underlying prim 
  			table was already flushed"
  			^ self primitiveFail].
  
  	"Clean up session id and external primitive index"
  	objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
  	objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: lit.
  	moduleName = objectMemory nilObj
  		ifTrue: [moduleLength := 0]
  		ifFalse: [self success: (objectMemory isBytes: moduleName).
  				moduleLength := self lengthOf: moduleName.
  				self cCode: '' inSmalltalk:
  					[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName))
  						ifTrue: [moduleLength := 0  "Cause all of these to fail"]]].
  	functionName := objectMemory fetchPointer: 1 ofObject: lit.
  	self success: (objectMemory isBytes: functionName).
  	functionLength := self lengthOf: functionName.
  	self successful ifFalse: [^ nil].
  
+ 	extFnAddr := self cCoerce: (self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
- 	addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
  				OfLength: functionLength
  				FromModule: moduleName + objectMemory baseHeaderSize
+ 				OfLength: moduleLength) to: 'void (*)(void)'.
+ 	extFnAddr = 0
- 				OfLength: moduleLength.
- 	addr = 0
  		ifTrue: [index := -1]
  		ifFalse: ["add the function to the external primitive table"
+ 			index := self addToExternalPrimitiveTable: extFnAddr].
- 			index := self addToExternalPrimitiveTable: addr].
  	self success: index >= 0.
  	"Store the index (or -1 if failure) back in the literal"
  	objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
  
  	"If the function has been successfully loaded process it"
+ 	(self successful and: [extFnAddr ~= 0])
+ 		ifTrue: [self rewriteMethodCacheSel: messageSelector class: lkupClass primIndex: (1000 + index) primFunction: extFnAddr.
+ 				self callExternalPrimitive: extFnAddr]
- 	(self successful and: [addr ~= 0])
- 		ifTrue: [self rewriteMethodCacheSel: messageSelector class: lkupClass primIndex: (1000 + index) primFunction: addr.
- 				self callExternalPrimitive: addr]
  		ifFalse: ["Otherwise rewrite the primitive index"
  			self
  				rewriteMethodCacheSel: messageSelector
  				class: lkupClass
  				primIndex: 0]!

Item was changed:
  ----- Method: Interpreter>>rewriteMethodCacheSel:class:primIndex: (in category 'method lookup cache') -----
  rewriteMethodCacheSel: selector class: class primIndex: localPrimIndex
  
  	"Rewrite the cache entry with the given primitive index and matching function pointer"
  	| primPtr |
+ 	<var: #primPtr declareC: 'void (*primPtr)(void)'>
- 	<var: #primPtr type: 'void *'>
  	<inline: false>
  	localPrimIndex = 0
  		ifTrue: [primPtr := 0]
  		ifFalse: [primPtr := primitiveTable at: localPrimIndex].
  	self
  		rewriteMethodCacheSel: selector class: class
  		primIndex: localPrimIndex primFunction: primPtr!

Item was changed:
  ----- Method: Interpreter>>rewriteMethodCacheSel:class:primIndex:primFunction: (in category 'method lookup cache') -----
  rewriteMethodCacheSel: selector class: class primIndex: localPrimIndex primFunction: localPrimAddress
  	"Rewrite an existing entry in the method cache with a new primitive 
  	index & function address. Used by primExternalCall to make direct jumps to found external prims"
  	| probe hash |
  	<inline: false>
+ 	<var: #localPrimAddress declareC: 'void (*localPrimAddress)(void)'>
- 	<var: #localPrimAddress type: 'void *'>
  	hash := selector bitXor: class.
  	0 to: CacheProbeMax - 1 do: [:p | 
  			probe := hash >> p bitAnd: MethodCacheMask.
  			((methodCache at: probe + MethodCacheSelector) = selector
  					and: [(methodCache at: probe + MethodCacheClass) = class])
  				ifTrue: [methodCache at: probe + MethodCachePrim put: localPrimIndex.
  					methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: localPrimAddress to: 'long').
  					^ nil]]!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.10.12'!
- 	^'4.10.11'!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>emitCHeaderForPrimitivesOn: (in category 'C code generator') -----
  emitCHeaderForPrimitivesOn: aStream
  	"Write a C file header for compiled primitives onto the given stream."
  
  	self emitCHeaderOn: aStream.
  	aStream nextPutAll: '
  /*** Proxy Functions ***/
  #define stackValue(i) (interpreterProxy->stackValue(i))
  #define stackIntegerValue(i) (interpreterProxy->stackIntegerValue(i))
  #define successFlag (!!interpreterProxy->failed())
  #define success(bool) (interpreterProxy->success(bool))
  #define arrayValueOf(oop) (interpreterProxy->arrayValueOf(oop))
  #define checkedIntegerValueOf(oop) (interpreterProxy->checkedIntegerValueOf(oop))
  #define fetchArrayofObject(idx,oop) (interpreterProxy->fetchArrayofObject(idx,oop))
  #define fetchFloatofObject(idx,oop) (interpreterProxy->fetchFloatofObject(idx,oop))
  #define fetchIntegerofObject(idx,oop) (interpreterProxy->fetchIntegerofObject(idx,oop))
  #define floatValueOf(oop) (interpreterProxy->floatValueOf(oop))
+ #define isBytes(oop) (interpreterProxy->isBytes(oop))
  #define pop(n) (interpreterProxy->pop(n))
  #define pushInteger(n) (interpreterProxy->pushInteger(n))
  #define sizeOfSTArrayFromCPrimitive(cPtr) (interpreterProxy->sizeOfSTArrayFromCPrimitive(cPtr))
  #define storeIntegerofObjectwithValue(idx,oop,value) (interpreterProxy->storeIntegerofObjectwithValue(idx,oop,value))
  #define primitiveFail() interpreterProxy->primitiveFail()
  /* allows accessing Strings in both C and Smalltalk */
  #define asciiValue(c) c
  
  '.
  	aStream cr.!



More information about the Vm-dev mailing list