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

commits at source.squeak.org commits at source.squeak.org
Wed Feb 18 00:25:45 UTC 2015


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

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

Name: VMMaker.oscog-eem.1070
Author: eem
Time: 17 February 2015, 4:24:04.463 pm
UUID: 080caffc-cd6c-4da2-934b-8c477c1f0c1f
Ancestors: VMMaker.oscog-eem.1069

Fix inferTypesForImplicitlyTypedVariablesIn: for
variables assigned arguments.  This rescues at
least BitBlt plugin.  Fix typeFor:in: to provide sqInt
as the default type for arguments.

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

Item was added:
+ ----- Method: ADPCMCodecPlugin class>>methodsToBePruned (in category 'translation') -----
+ methodsToBePruned
+ 	"Since sharing between plugins means that normal pruning
+ 	 can't be done, allow plugins that want to prune specific methods."
+ 	^#(indexForDeltaFrom:to: nextBits: nextBits:put:)!

Item was removed:
- ----- Method: ADPCMCodecPlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
- translateInDirectory: directory doInlining: inlineFlag
- "handle a special case code string rather than generated code"
- "Not currently hooked into the timeStamp mechanism for VMMaker since this would mean replicating code from InterpreterPlugin; waiting for a more elegant solution to appear. In the meantime this means that this plugin will always get regenerated even if the file is uptodate"
- 	| cg |
- 	self initialize.
- 
- 	cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
- 
- 	cg addMethodsForPrimitives: ADPCMCodec translatedPrimitives.
- 	inlineFlag ifTrue:[
- 		"now remove a few which will be inlined but not pruned"
- 		cg pruneMethods: #(indexForDeltaFrom:to: nextBits: nextBits:put:)].
- 	self pruneUnusedInterpreterPluginMethodsIn: cg.
- 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: self moduleName, '.c').
- 	^cg exportedPrimitiveNames asArray
- !

Item was added:
+ ----- Method: ADPCMCodecPlugin class>>translatedPrimitives (in category 'translation') -----
+ translatedPrimitives
+ 	"Answer an Array of Class, selector pair Arrays for any primitives to
+ 	 be translated from Smalltalk methods elsewhere in the system."
+ 	^ADPCMCodec translatedPrimitives!

Item was changed:
  ----- Method: CCodeGenerator>>accessorChainsForMethod:interpreterClass: (in category 'spur primitive compilation') -----
  accessorChainsForMethod: method interpreterClass: interpreterClass
  	"Answer a set of access paths from arguments through objects, in the method, assuming
  	 it is a primitive. This is in support of Spur's lazy become.  A primitive may fail because it
  	 may encounter a forwarder.  The primitive failure code needs to know to what depth it
  	 must follow arguments to follow forwarders and, if any are found and followed, retry the
  	 primitive. This method determines that depth. It starts by collecting references to the
  	 stack and then follows these through assignments to variables and use of accessor
  	 methods such as fetchPointer:ofObject:. For example
  		| obj field  |
  		obj := self stackTop.
  		field := objectMemory fetchPointer: 1 ofObject: obj.
  		self storePointer: 1 ofObject: field withValue: (self stackValue: 1)
  	has depth 2, since field is accessed, and field is an element of obj."
  
  	| accessors assignments roots chains extendedChains extended lastPass |
  	self accessorsAndAssignmentsForMethod: method
+ 		actuals: (self actualsForMethod: method)
- 		actuals: {}
  		depth: 0
  		interpreterClass: interpreterClass
  		into: [:theRoots :theAccessors :theAssignments|
  			roots := theRoots.
  			accessors := theAccessors.
  			assignments := theAssignments].
  	"Compute the transitive closure of assignments of accessor sends or variables to variables from the roots.
  	 Start from the stack accesses (the roots).
  	 On the last pass look only for accessors of the targets of the tip assignments."
  	chains := OrderedCollection new.
  	roots do: [:root| chains addAll: (assignments
  									select: [:assignment| assignment expression = root]
  									thenCollect: [:assignment| OrderedCollection with: assignment])].
  	lastPass := false.
  	[extended := false.
  	 extendedChains := OrderedCollection new: chains size * 2.
  	 chains do:
  		[:chain| | tip refs accessorRefs variableRefs |
  		tip := chain last variable.
  		refs := accessors select: [:send| send args anySatisfy: [:arg| tip isSameAs: arg]].
  		lastPass ifFalse:
  			[accessorRefs := refs collect: [:send|
  											assignments
  												detect: [:assignment|
  														assignment expression = send
  														and: [(chain includes: assignment) not]]
  												ifNone: []]
  									thenSelect: [:assignmentOrNil| assignmentOrNil notNil].
  			 variableRefs := assignments select:
  								[:assignment|
  								 (tip isSameAs: assignment expression)
  								 and: [(tip isSameAs: assignment variable) not
  								 and: [(chain includes: assignment) not]]].
  			 refs := (Set withAll: accessorRefs) addAll: variableRefs; yourself].
  		refs isEmpty
  			ifTrue:
  				[extendedChains add: chain]
  			ifFalse:
  				[lastPass ifFalse: [extended := true].
  				 self assert: (refs noneSatisfy: [:assignment| chain includes: assignment]).
  				 extendedChains addAll: (refs collect: [:assignment| chain, {assignment}])]].
  	 extended or: [lastPass not]] whileTrue:
  		[chains := extendedChains.
  		 extended ifFalse: [lastPass := true]].
  	^chains!

Item was added:
+ ----- Method: CCodeGenerator>>actualsForMethod: (in category 'spur primitive compilation') -----
+ actualsForMethod: aTMethod
+ 	"Normal primitives have no arguments, but translated primitives do.
+ 	 This class doesn't handle translated primitives and so smply answers an empty array.
+ 	 Subclasses override as required."
+ 	^#()!

Item was removed:
- ----- Method: CCodeGenerator>>addMethodsForPrimitives: (in category 'public') -----
- addMethodsForPrimitives: classAndSelectorList 
- 	| verbose |
- 	verbose := false.
- 	classAndSelectorList do:
- 		[:classAndSelector | | aClass selector meth |
- 		aClass := Smalltalk at: classAndSelector first.
- 		selector := classAndSelector last.
- 		self addAllClassVarsFor: aClass.
- "TPR - should pool vars also be added here?"
- 
- 		"compile the method source and convert to a suitable translation method.
- 		 find the method in either the class or the metaclass"
- 		meth := self
- 					compileToTMethodSelector: selector
- 					in: ((aClass includesSelector: selector)
- 							ifTrue: [aClass]
- 							ifFalse: [aClass class]).
- 		meth primitive > 0 ifTrue:[meth preparePrimitiveName].
- 		"for old-style array accessing: 
- 		meth covertToZeroBasedArrayReferences."
- 		meth replaceSizeMessages.
- 		self addMethod: meth].
- 
- 	self prepareMethods.
- 	verbose
- 		ifTrue: 
- 			[self printUnboundCallWarnings.
- 			self printUnboundVariableReferenceWarnings.
- 			logger cr].
- 
- 	"code generation"
- 	self doInlining: true.
- 
- 	methods do:[:m|
- 		"if this method is supposed to be a primitive (rather than a helper 
- 		routine), add assorted prolog and epilog items"
- 		m primitive > 0 ifTrue: [m preparePrimitivePrologue]].!

Item was added:
+ ----- Method: CCodeGenerator>>addMethodsForTranslatedPrimitives: (in category 'public') -----
+ addMethodsForTranslatedPrimitives: classAndSelectorList 
+ 	| verbose |
+ 	verbose := false.
+ 	classAndSelectorList do:
+ 		[:classAndSelector | | aClass selector meth |
+ 		aClass := Smalltalk at: classAndSelector first.
+ 		selector := classAndSelector last.
+ 		self addAllClassVarsFor: aClass.
+ 
+ 		"compile the method source and convert to a suitable translation method.
+ 		 find the method in either the class or the metaclass"
+ 		meth := self
+ 					compileToTMethodSelector: selector
+ 					in: ((aClass includesSelector: selector)
+ 							ifTrue: [aClass]
+ 							ifFalse: [aClass class]).
+ 		meth primitive > 0 ifTrue:
+ 			[meth preparePrimitiveName].
+ 		meth replaceSizeMessages.
+ 		self addMethod: meth].
+ 
+ 	self prepareMethods!

Item was added:
+ ----- Method: CCodeGenerator>>baseTypeForType: (in category 'utilities') -----
+ baseTypeForType: aCType
+ 	"Reduce various declarations to the most basic type we can determine."
+ 	| type fpIndex closeidx openidx |
+ 	type := aCType.
+ 	((openidx := type indexOfSubCollection: 'const ') > 0
+ 	and: [openidx = 1 or: [(type at: openidx) isSeparator]]) ifTrue:
+ 		[type := type copyReplaceFrom: openidx to: openidx + 5 with: ''].
+ 	((type beginsWith: 'unsigned') and: [(type includes: $:) and: [type last isDigit]]) ifTrue:
+ 		[^#usqInt].
+ 	(fpIndex := type indexOfSubCollection: '(*') > 0 ifTrue:
+ 		[type := type copyReplaceFrom: (type indexOf: $( startingAt: fpIndex + 1)
+ 					to: (type indexOf: $) startingAt: fpIndex + 1)
+ 					with: ''].
+ 	"collapse [size] to *"
+ 	openidx := 0.
+ 	[(openidx := type indexOf: $[ startingAt: openidx + 1) > 0
+ 	 and: [(closeidx := type indexOf: $] startingAt: openidx + 1) > 0]] whileTrue:
+ 		[type := type copyReplaceFrom: openidx to: closeidx with: '*'].
+ 	^type withBlanksTrimmed!

Item was changed:
  ----- Method: CCodeGenerator>>extractTypeFor:fromDeclaration: (in category 'utilities') -----
  extractTypeFor: aVariable fromDeclaration: aVariableDeclaration
  	"Eliminate inessentials from aVariableDeclaration to answer a C type without the variable,
  	 or initializations etc"
+ 	| decl |
- 	| decl fpIndex closeidx openidx |
  	decl := aVariableDeclaration.
  	(decl beginsWith: 'static') ifTrue:
  		[decl := decl allButFirst: 6].
  	(decl indexOf: $= ifAbsent: []) ifNotNil:
  		[:index| decl := decl copyFrom: 1 to: index - 1].
  	decl := decl copyReplaceAll: aVariable with: '' tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]].
+ 	^self baseTypeForType: decl!
- 	(fpIndex := decl indexOfSubCollection: '(*') > 0 ifTrue:
- 		[decl := decl copyReplaceFrom: (decl indexOf: $( startingAt: fpIndex + 1)
- 					to: (decl indexOf: $) startingAt: fpIndex + 1)
- 					with: ''].
- 	"collapse [size] to *"
- 	openidx := 0.
- 	[(openidx := decl indexOf: $[ startingAt: openidx + 1) > 0
- 	 and: [(closeidx := decl indexOf: $] startingAt: openidx + 1) > 0]] whileTrue:
- 		[decl := decl copyReplaceFrom: openidx to: closeidx with: '*'].
- 	^decl withBlanksTrimmed!

Item was changed:
  ----- Method: CCodeGenerator>>inferTypesForImplicitlyTypedVariablesAndMethods (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesAndMethods
  	"Infer the return tupe and the types of untyped variables.
  	 As far as variables go, for now we try only to infer variables
  	 assigned the result of #longLongAt:, but much more could be
  	 done here."
  
  	"Iterate over all methods, inferring #void return types, until we reach a fixed point."
  	| firstTime allMethods |
  	firstTime := true.
  	allMethods := apiMethods
  					ifNil: [methods]
  					ifNotNil: [(Set withAll: methods)
  								addAll: apiMethods;
  								yourself].
+ 	"Make an initial pass to assign the return types of all simple methods that return constants."						
- 	"Make an initial pass to assign the return types of all simple mehtods that return constants."						
  	allMethods do:
  		[:m|
  		m isReturnConstant ifTrue:
  			[m inferReturnTypeIn: self]].
  	[| changedReturnType |
  	 changedReturnType := false.
  	 allMethods do:
  		[:m|
  		 firstTime ifTrue:
  			[m removeFinalSelfReturnIn: self. "must preceed recordDeclarationsIn: because it may set returnType"
  			 m recordDeclarationsIn: self].
  		 m inferTypesForImplicitlyTypedVariablesIn: self.
  		 (m inferReturnTypeIn: self) ifTrue:
  			[changedReturnType := true]].
  	 firstTime := false.
  	 changedReturnType] whileTrue.
  
  	"Type all as-yet-untyped methods as the default"
  	methods do:
  		[:m|
  		m returnType ifNil:
  			[m returnType: (self implicitReturnTypeFor: m selector)]]!

Item was changed:
  ----- Method: CCodeGenerator>>isActualType:compatibleWithFormalType: (in category 'inlining') -----
  isActualType: actualTypeOrNil compatibleWithFormalType: formalTypeOrNil 
  	| actualType formalType |
  	actualType := actualTypeOrNil ifNil: [#sqInt].
  	formalType := formalTypeOrNil ifNil: [#sqInt].
  	((self isIntegralCType: actualType)
  	 and: [self isIntegralCType: formalType]) ifFalse:
+ 		[^actualType = formalType
+ 		 or: [formalType = 'double' and: [actualType = 'float']]].
- 		[^actualType = formalType].
  	"For now, insist that the signedness agrees."
  	^(actualType first = $u) = (formalType first = $u)
  	 or: [actualTypeOrNil isNil or: [formalTypeOrNil isNil]]!

Item was changed:
  ----- Method: CCodeGenerator>>maybeBreakForTestToInline:in: (in category 'inlining') -----
  maybeBreakForTestToInline: aNode in: aTMethod
  	"convenient for debugging..."
  	(aNode isSend
  	and: [(breakSrcInlineSelector notNil or: [breakDestInlineSelector notNil])
  	and: [(breakSrcInlineSelector ifNil: [true] ifNotNil: [:srcSel| srcSel = aNode selector])
+ 	and: [(breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = aTMethod selector])
+ 	and: [breakOnInline ~~ true]]]]) ifTrue:
- 	and: [breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = aTMethod selector
- 	and: [breakOnInline ~~ true]]]]]) ifTrue:
  		[aTMethod halt: aTMethod selector, ' ', aNode selector]!

Item was changed:
  ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') -----
  returnTypeForSend: sendNode in: aTMethod
  	"Answer the return type for a send.  Absent sends default to #sqInt.
  	 The bitwise operators answer unsigned versions of their argument types, at least in gcc
  	 although this author can't find that in the C99 spec.  If you can find this, please let me know."
  	| sel |
  	^(self anyMethodNamed: (sel := sendNode selector))
  		ifNil: [kernelReturnTypes
  				at: sel
  				ifAbsent:
  					[^sel
  						caseOf: {
  						[#+]					->	[self typeForArithmetic: sendNode in: aTMethod].
  						[#-]						->	[self typeForArithmetic: sendNode in: aTMethod].
  						[#*]					->	[self typeForArithmetic: sendNode in: aTMethod].
  						[#/]						->	[self typeForArithmetic: sendNode in: aTMethod].
+ 						[#addressOf:]			->	[(self typeFor: sendNode receiver in: aTMethod)
+ 														ifNil: [#sqInt]
+ 														ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
  						[#at:]					->	[self typeForDereference: sendNode in: aTMethod].
  						[#bitAnd:]				->	[self unsignedTypeForBitwiseSend: sendNode in: aTMethod].
  						[#bitOr:]				->	[self unsignedTypeForBitwiseSend: sendNode in: aTMethod].
  						[#bitXor:]				->	[self unsignedTypeForBitwiseSend: sendNode in: aTMethod].
  						[#asVoidPointer]		->	[#'void *'].
  						[#asVoidPointer]		->	[#'void *'].
  						[#asUnsignedInteger]	->	[#usqInt].
  						[#asLong]				->	[#long].
  						[#asUnsignedLong]		->	[#'unsigned long'].
  						[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
  						[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
  						[#cCoerce:to:]			->	[sendNode args last value].
  						[#cCoerceSimple:to:]	->	[sendNode args last value] }
  						otherwise: [#sqInt]]]
  		ifNotNil:
  			[:m|
+ 			 m returnType ifNotNil:
+ 				[:type|
+ 				 self baseTypeForType: type]]!
- 			m returnType ifNotNil:
- 				[:type| "map fields to #usqInt"
- 				((type beginsWith: 'unsigned')
- 				 and: [(type includes: $:)
- 				 and: [type last isDigit]])
- 					ifTrue: [#usqInt]
- 					ifFalse: [type]]]!

Item was changed:
  ----- Method: CCodeGenerator>>typeForArithmetic:in: (in category 'type inference') -----
  typeForArithmetic: sendNode in: aTMethod
  	"Answer the return type for an arithmetic sendThis is so that the inliner can still
  	 inline simple expressions.  Deal with pointer arithmetic and floating point arithmetic"
+ 	| rcvrType argType |
+ 	argType := self typeFor: sendNode args first in: aTMethod.
+ 	argType = #double ifTrue:
- 	(self typeFor: sendNode args first in: aTMethod) = #double ifTrue:
  		[^#double].
+ 	rcvrType := self typeFor: sendNode receiver in: aTMethod.
+ 	(sendNode selector == #-
+ 	 and: [rcvrType notNil and: [rcvrType last = $*
+ 	 and: [argType notNil and: [argType last = $*]]]]) ifTrue:
+ 		[^#int].
+ 	^rcvrType!
- 	^self typeFor: sendNode receiver in: aTMethod!

Item was changed:
  ----- Method: CCodeGenerator>>typeForDereference:in: (in category 'type inference') -----
  typeForDereference: sendNode in: aTMethod
+ 	(self typeFor: sendNode receiver in: aTMethod) ifNotNil:
+ 		[:type|
+ 		 type last = $* ifTrue:
+ 			[^type allButLast withBlanksTrimmed]].
+ 	"It would be nice to warn here, but there are contexts when the type is unknown, for example determining
+ 	 the return types of apiMethods.  inferTypesForImplicitlyTypedVariablesAndMethods could provide a signal
+ 	 handler to suppress the warnings in that case but that's too fancy.  Instead we live with the default."
+ 	"logger
+ 		nextPutAll: 'warning, cannot determine type of at: for ', sendNode receiver asString, ' in ', aTMethod selector;
+ 		cr."
+ 	^#sqInt!
- 	| type |
- 	type := self typeFor: sendNode receiver in: aTMethod.
- 	type last = $* ifTrue:
- 		[^type allButLast withBlanksTrimmed].
- 	self error: 'cannot determine type'.
- 	^nil!

Item was added:
+ ----- Method: InterpreterPlugin class>>allCodeOlderThan: (in category 'translation') -----
+ allCodeOlderThan: modificationTime
+ 	^((self pluginClassesUpTo: self) allSatisfy:
+ 			[:aPluginClass| aPluginClass timeStamp < modificationTime])
+ 	  and: [self translatedPrimitives allSatisfy:
+ 			[:pair| | c m stamp |
+ 			c := Smalltalk classNamed: pair first.
+ 			m := c compiledMethodAt: pair last ifAbsent: [c class >> pair last].
+ 			stamp := (m timeStamp subStrings: {Character space}) last: 2.
+ 			stamp := TimeStamp date: (Date fromString: stamp first) time: (Time fromString: stamp last).
+ 			stamp asSeconds < modificationTime]]!

Item was changed:
  ----- Method: InterpreterPlugin class>>buildCodeGeneratorUpTo: (in category 'translation') -----
  buildCodeGeneratorUpTo: aPluginClass
  	"Build a CCodeGenerator for the plugin"
  	| cg pluginClasses |
  	cg := self codeGeneratorClass new initialize.
  	cg pluginClass: self.
  	(pluginClasses := self pluginClassesUpTo: aPluginClass) do:
  		[:aClass| cg addClass: aClass].
  	(cg structClassesForTranslationClasses: pluginClasses) do:
  		[:structClasss| cg addStructClass: structClasss].
+ 	cg addMethodsForTranslatedPrimitives: self translatedPrimitives.
  	^cg!

Item was added:
+ ----- Method: InterpreterPlugin class>>methodsToBePruned (in category 'translation') -----
+ methodsToBePruned
+ 	"Since sharing between plugins means that normal pruning
+ 	 can't be done, allow plugins that want to prune specific methods."
+ 	^#()!

Item was changed:
  ----- Method: InterpreterPlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
  translateInDirectory: directory doInlining: inlineFlag
  "This is the default method for writing out sources for a plugin. Several classes need special handling, so look at all implementors of this message"
+ 	| cg fname |
- 	| cg fname fstat |
  	 fname := self moduleName, '.c'.
  
  	"don't translate if the file is newer than my timeStamp"
+ 	(directory entryAt: fname ifAbsent: nil) ifNotNil:
+ 		[:fstat|
+ 		 (self allCodeOlderThan: fstat modificationTime) ifTrue:
- 	fstat := directory entryAt: fname ifAbsent:[nil].
- 	fstat ifNotNil:
- 		[((self pluginClassesUpTo: self) allSatisfy:
- 				[:aPluginClass| aPluginClass timeStamp < fstat modificationTime]) ifTrue:
  			[^nil]].
  
  	self initialize.
  	cg := self buildCodeGeneratorUpTo: self.
  	cg inferTypesForImplicitlyTypedVariablesAndMethods.
  	self pruneUnusedInterpreterPluginMethodsIn: cg.
  	cg storeCodeOnFile:  (directory fullNameFor: fname) doInlining: inlineFlag.
  	^cg exportedPrimitiveNames asArray!

Item was added:
+ ----- Method: InterpreterPlugin class>>translatedPrimitives (in category 'translation') -----
+ translatedPrimitives
+ 	"Answer an Array of Class, selector pair Arrays for any primitives to
+ 	 be translated from Smalltalk methods elsewhere in the system.
+ 	 By default answer none.  Some subclasses redefine as required."
+ 	^#()!

Item was changed:
  ----- Method: InterpreterProxy>>fullGC (in category 'other') -----
  fullGC
+ 	<returnTypeC: #sqInt>
+ 	Smalltalk garbageCollect!
- 	Smalltalk garbageCollect.!

Item was changed:
  ----- Method: InterpreterProxy>>pop: (in category 'stack access') -----
  pop: nItems
+ 	<returnTypeC: #sqInt>
  	1 to: nItems do:[:i| stack removeLast].!

Item was changed:
  ----- Method: InterpreterProxy>>pop:thenPush: (in category 'stack access') -----
  pop: nItems thenPush: oop
+ 	<returnTypeC: #sqInt>
  	self pop: nItems.
+ 	self push: oop!
- 	self push: oop.!

Item was changed:
  ----- Method: InterpreterProxy>>push: (in category 'stack access') -----
  push: object
+ 	<returnTypeC: #sqInt>
  	stack addLast: object!

Item was changed:
  ----- Method: InterpreterProxy>>pushBool: (in category 'stack access') -----
  pushBool: trueOrFalse
+ 	<returnTypeC: #sqInt>
  	(trueOrFalse == true or:[trueOrFalse == false]) ifFalse:[self error:'Not a Boolean'].
  	self push: trueOrFalse!

Item was changed:
  ----- Method: InterpreterProxy>>pushFloat: (in category 'stack access') -----
  pushFloat: f
+ 	<returnTypeC: #sqInt>
  	<var: #f type: 'double '>
  	f isFloat ifFalse:[^self error:'Not a Float'].
  	self push: f.!

Item was changed:
  ----- Method: InterpreterProxy>>pushInteger: (in category 'stack access') -----
  pushInteger: integerValue
+ 	<returnTypeC: #sqInt>
  	self push: (self integerObjectOf: integerValue).!

Item was changed:
  ----- Method: InterpreterProxy>>pushRemappableOop: (in category 'instance creation') -----
  pushRemappableOop: oop
+ 	<returnTypeC: #sqInt>
  	remapBuffer addLast: oop!

Item was changed:
  ----- Method: InterpreterProxy>>returnAs:ThroughCallback:Context: (in category 'callback support') -----
  returnAs: returnTypeOop ThroughCallback: vmCallbackContext Context: callbackMethodContext
+ 	<returnTypeC: #sqInt>
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	"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."
  	self notYetImplemented!

Item was changed:
  ----- Method: InterpreterProxy>>signalSemaphoreWithIndex: (in category 'other') -----
  signalSemaphoreWithIndex: semaIndex
+ 	<returnTypeC: #sqInt>
  	((Smalltalk externalObjects) at: semaIndex) signal!

Item was changed:
  ----- Method: InterpreterProxy>>success: (in category 'other') -----
  success: aBoolean
+ 	<returnTypeC: #sqInt>
  	aBoolean ifTrue: [^self].
  	primFailCode = 0 ifTrue: [self primitiveFailFor: 1]!

Item was changed:
  ----- Method: InterpreterProxy>>tenuringIncrementalGC (in category 'other') -----
  tenuringIncrementalGC
+ 	<returnTypeC: #sqInt>
  	Smalltalk forceTenuring; garbageCollectMost!

Item was removed:
- ----- Method: MiscPrimitivePlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
- translateInDirectory: directory doInlining: inlineFlag
- "handle a special case code string rather than normal generated code."
- 	| cg fname fstat |
- 	 fname := self moduleName, '.c'.
- 
- 	"don't translate if the file is newer than my timeStamp"
- 	fstat := directory entryAt: fname ifAbsent:[nil].
- 	fstat ifNotNil:[self timeStamp < fstat modificationTime ifTrue:[^nil]].
- 
- 	self initialize.
- 	cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
- 	cg addMethodsForPrimitives: self translatedPrimitives.
- 	self pruneUnusedInterpreterPluginMethodsIn: cg.
- 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: fname).
- 	^cg exportedPrimitiveNames asArray
- !

Item was added:
+ ----- Method: MiscPrimitivePlugin>>asciiValue: (in category 'helper functions') -----
+ asciiValue: aCharacter
+ 	<cmacro: '(aCharacter) aCharacter'>
+ 	^aCharacter asciiValue!

Item was changed:
  ----- Method: SmartSyntaxPluginTMethod>>printTempsAndVar:on: (in category 'private') -----
  printTempsAndVar: varName on: aStream 
  	"add the required temps and the varname to the stream"
  	aStream nextPutAll: '| '.
+ 	(#('rcvr' 'stackPointer' 'interpreterProxy') reject: [:each | locals includes: each])
- 	(#('rcvr' 'stackPointer' 'successFlag' 'interpreterProxy' ) reject: [:each | locals includes: each])
  		do: [:each | aStream nextPutAll: each;
  			 space].
  	(locals reject: [:each | each first = $_])
  		do: [:each | aStream nextPutAll: each;
  			 space].
  "don't add varName twice. Probably a deeper reason for this, but WTH. TPR"
  	(locals includes: varName) ifFalse:[aStream nextPutAll: varName].
  	aStream nextPutAll: '|';
  	 cr!

Item was removed:
- ----- Method: SoundGenerationPlugin class>>translateInDirectory:doInlining: (in category 'accessing') -----
- translateInDirectory: directory doInlining: inlineFlag
- "handle a special case code string rather than generated code. 
- NB sqOldSoundsPrims IS NOT FULLY INTEGRATED - it still isn't included in the exports list"
- 	| cg |
- 	self initialize.
- 
- 	cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
- 
- 	cg addMethodsForPrimitives: AbstractSound translatedPrimitives.
- 	self pruneUnusedInterpreterPluginMethodsIn: cg.
- 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: self moduleName, '.c').
- 	"What we need here is some way to derive the prim names from sqOldSoundPrims - or dump it entirely. Perhaps add this class (without then generating the file again) using fake entry points like SurfacePlugin does"
- 
- 	^cg exportedPrimitiveNames asArray
- !

Item was added:
+ ----- Method: SoundGenerationPlugin class>>translatedPrimitives (in category 'translation') -----
+ translatedPrimitives
+ 	"Answer an Array of Class, selector pair Arrays for any primitives to
+ 	 be translated from Smalltalk methods elsewhere in the system."
+ 	^AbstractSound translatedPrimitives!

Item was changed:
  ----- Method: TMethod>>checkSuccessExpr (in category 'primitive compilation') -----
  checkSuccessExpr
+ 	"Answer the parse tree for an expression that aborts the primitive if there has been a failure."
+ 	^self
+ 		statementsFor: 'interpreterProxy failed ifTrue: [^nil]'
+ 		varName: ''!
- 	"Return the parse tree for an expression that aborts the primitive if the successFlag is not true."
- 
- 	| expr |
- 	expr := 'successFlag ifFalse: [^ nil ]'.
- 	^ self statementsFor: expr varName: ''
- !

Item was removed:
- ----- Method: TMethod>>covertToZeroBasedArrayReferences (in category 'primitive compilation') -----
- covertToZeroBasedArrayReferences
- 	"Replace the index expressions in at: and at:put: messages with (<expr> - 1), since C uses zero-based array indexing."
- 	"Note: Up through release 1.31, generated primitives used the convention that array variables pointed to the first element. That meant that Smalltalk one-based index expressions had to have one subtracted to yield a zero-based index. Later, we decided to adjust the base address by -1 once in the primitive prolog rather on every array access. This resulted in a five percent performance increase for the bitmap compress/decompress primitives. This method is retained as documentation and in case we choose to revert the the previous scheme."
- 
- 	| oldIndexExpr newIndexExpr |
- 	parseTree nodesDo: [ :n |
- 		(n isSend and: [(n selector = #at:) or: [ n selector = #at:put: ]]) ifTrue: [
- 			oldIndexExpr := n args first.
- 			oldIndexExpr isConstant ifTrue: [
- 				"index expression is a constant: decrement the constant now"
- 				newIndexExpr := TConstantNode new setValue: (n args first value - 1).
- 			] ifFalse: [
- 				"index expression is complex: build an expression to decrement result at runtime"
- 				newIndexExpr := TSendNode new
- 					setSelector: #-
- 					receiver: oldIndexExpr
- 					arguments: (Array with: (TConstantNode new setValue: 1)).
- 			].
- 			n args at: 1 put: newIndexExpr.
- 		].
- 	].
- !

Item was changed:
  ----- Method: TMethod>>determineTypeFor:in: (in category 'C code generation') -----
  determineTypeFor: aNode in: aCodeGen
  	aNode isSend ifTrue:
+ 		[^(aCodeGen returnTypeForSend: aNode in: self) ifNil: [#sqInt]].
- 		[aNode selector == #addressOf: ifTrue:
- 			[^(self determineTypeFor: aNode args first in: aCodeGen)
- 				ifNil: [#sqInt]
- 				ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
- 		(aNode selector == #at:
- 		 and: [aNode receiver isVariable]) ifTrue:
- 			[(aCodeGen typeOfVariable: aNode receiver name) ifNotNil:
- 				[:type|
- 				^type last = $*
- 					ifTrue: [aCodeGen
- 								extractTypeFor: aNode receiver name
- 								fromDeclaration: type allButLast]
- 					ifFalse: [type]]].
- 		^(aCodeGen anyMethodNamed: aNode selector)
- 			ifNil: [#sqInt]
- 			ifNotNil: [:method| method returnType]].
  	aNode isAssignment ifTrue:
  		[^self determineTypeFor: aNode expression in: aCodeGen].
  	self error: 'don''t know how to extract return type from this kind of node'!

Item was changed:
  ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesIn: aCodeGen
+ 	"infer types for untyped variables from assignments and arithmetic uses.
+ 	 For debugging answer a Dictionary from var to the nodes that determined types
- 	"infer types for untyped variables form assignments and arithmetic uses.
  	 This for debugging:
  		(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
  	| explicitlyTyped effectiveNodes |
  	explicitlyTyped := declarations keys asSet.
  	effectiveNodes := Dictionary new. "this for debugging"
  	parseTree nodesDo:
  		[:node| | type var |
  		"If there is something of the form i >= 0, then i should be signed, not unsigned."
  		(node isSend
  		 and: [(locals includes: (var := node receiver variableNameOrNil))
  		 and: [(explicitlyTyped includes: var) not
  		 and: [(#(<= < >= >) includes: node selector)
  		 and: [node args first isConstant
  		 and: [node args first value = 0
  		 and: [(type := self typeFor: var in: aCodeGen) notNil
  		 and: [type first == $u]]]]]]]) ifTrue:
+ 			[declarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var.
- 			[declarations at: var put: (declarations at: var) allButFirst.
  			 effectiveNodes at: var put: { declarations at: var. node }].
+ 		"if an assignment to an untyped local of a known type, set the local's type to that type."
- 		"if an assignment of a known send, set the variable's type to the return type of the send."
  		(node isAssignment
  		 and: [(locals includes: (var := node variable name))
  		 and: [(declarations includesKey: var) not
+ 		 and: [(type := self typeFor: node expression in: aCodeGen) notNil
+ 		 and: [type ~= #void]]]]) ifTrue:
+ 			[declarations at: var put: type, ' ', var.
+ 			 effectiveNodes at: var put: { declarations at: var. node }]].
- 		 and: [node expression isSend
- 		 and: [(type := aCodeGen returnTypeForSend: node expression in: self) notNil]]]]) ifTrue:
- 			[(#(sqInt void) includes: type) ifFalse:
- 				["the $: is to map things like unsigned field : 3 to usqInt"
- 				 declarations
- 					at: var
- 					put: ((type includes: $:) ifTrue: [#usqInt] ifFalse: [type]), ' ', var.
- 				 effectiveNodes at: var put: { declarations at: var. node }]]].
  	^effectiveNodes!

Item was added:
+ ----- Method: TMethod>>isConditionalToBeTransformedForAssignment:in: (in category 'inlining') -----
+ isConditionalToBeTransformedForAssignment: aSend in: aCodeGen
+ 	"Answer if a send is of the form
+ 		e1
+ 			ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]]
+ 			ifFalse: [self m3]
+ 	 such that at least one of the sends mN may be inlined.."
+ 
+ 	^(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: aSend selector)
+ 	   and: [aSend args anySatisfy:
+ 			[:arg| | stmt |
+ 			self assert: arg isStmtList.
+ 			arg statements size > 1
+ 			or: [(stmt := arg statements first) isSend
+ 				and: [(aCodeGen mayInline: stmt selector)
+ 					or: [self isConditionalToBeTransformedForAssignment: stmt in: aCodeGen]]]]]!

Item was added:
+ ----- Method: TMethod>>mapSendsFromSelfToInterpreterProxy: (in category 'transformations') -----
+ mapSendsFromSelfToInterpreterProxy: selectors
+ 	| interpreterProxyNode |
+ 	interpreterProxyNode := TVariableNode new setName: 'interpreterProxy'.
+ 	parseTree nodesDo:
+ 		[:node|
+ 		(node isSend
+ 		and: [node receiver isVariable
+ 		and: [node receiver name = 'self'
+ 		and: [selectors includes: node selector]]]) ifTrue:
+ 			[node receiver: interpreterProxyNode]]!

Item was changed:
  ----- Method: TMethod>>printTempsAndVar:on: (in category 'private') -----
  printTempsAndVar: varName on: aStream 
  	"add the required temps and the varname to the stream"
+ 	aStream nextPutAll: '| rcvr stackPointer interpreterProxy ' , varName , ' |'; cr!
- 	aStream nextPutAll: '| rcvr stackPointer successFlag ' , varName , ' |';
- 	 cr!

Item was changed:
  ----- Method: TMethod>>transformConditionalAssignment:in: (in category 'inlining') -----
  transformConditionalAssignment: node in: aCodeGen
+ 	"If possible answer the transformation of code of the form
- 	"If possible asnwer the transformation of code of the form
  		var := e1
+ 				ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]]
+ 				ifFalse: [self m3]
- 				ifTrue: [e2 ifTrue: [v1] ifFalse: [v2]]
- 				ifFalse: [v3]
  	 into
  		e1
+ 			ifTrue: [e2 ifTrue: [var := self m1] ifFalse: [var := self m2]]
+ 			ifFalse: [var := self m3]
+ 	 to allow inlining of m1, m2, et al.  Otherwise answer nil."
- 			ifTrue: [e2 ifTrue: [var := v1] ifFalse: [var := v2]]
- 			ifFalse: [var := v3]
- 	 to allow inlining of v1, v2, et al.  Otherwise answer nil."
  
  	| expr |
  	^(node isAssignment
  	   and: [(expr := node expression) isSend
+ 	   and: [(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector)
+ 	   and: [self isConditionalToBeTransformedForAssignment: expr  in: aCodeGen]]]) ifTrue:
- 	   and: [#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector]]) ifTrue:
  		[expr copy
  			arguments:
  				(expr args collect:
  					[:stmtList| stmtList copy assignLastExpressionTo: node variable]);
  			yourself]!

Item was changed:
  ----- Method: TMethod>>typeFor:in: (in category 'utilities') -----
  typeFor: aVariable in: aCodeGen
  	"Answer the type for aVariable, deferring to aCodeGen (which defers to the vmClass)
  	 if no type is found and the variable is global (not an arg or a local).  Expect the
  	 cCodeGen to answer nil for variables without types. nil for typelessness is required
  	 by the type propagation logic in inlineSend:directReturn:exitVar:in:."
+ 	| varName |
+ 	varName := aVariable asString.
  	^(declarations
+ 			at: varName
+ 			ifAbsent:
+ 				[(args includes: varName) "arg types default to sqInt"
+ 					ifTrue: ['sqInt ', varName]
+ 					ifFalse:
+ 						[(locals includes: varName) ifFalse: "don't provide type for locals"
+ 							[aCodeGen typeOfVariable: varName]]]) ifNotNil:
- 			at: aVariable asString
- 			ifAbsent: [((locals includes: aVariable) or: [args includes: aVariable]) ifFalse:
- 						[aCodeGen typeOfVariable: aVariable asString]]) ifNotNil:
  		[:decl|
+ 		aCodeGen extractTypeFor: varName fromDeclaration: decl]!
- 		aCodeGen extractTypeFor: aVariable asString fromDeclaration: decl]!

Item was changed:
  CCodeGenerator subclass: #VMPluginCodeGenerator
+ 	instanceVariableNames: 'pluginClass pluginName pluginFunctionsUsed inProgressSelectors inliningDone'
- 	instanceVariableNames: 'pluginClass pluginName pluginFunctionsUsed inProgressSelectors'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Translation to C'!
  
  !VMPluginCodeGenerator commentStamp: '<historical>' prior: 0!
  I generate code that can be loaded dynamically from external libraries (e.g., DSOs on Unix or DLLs on Windows)!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>actualsForMethod: (in category 'spur primitive compilation') -----
+ actualsForMethod: aTMethod
+ 	"Normal primitives have no arguments, but translated primitives do.
+ 	 Override to answer actuals for translated primitives."
+ 	^(aTMethod args size - 1 to: 0 by: -1) collect:
+ 		[:i|
+ 		 TSendNode new
+ 			setSelector: #stackValue:
+ 			receiver: (TVariableNode new setName: 'interpreterProxy')
+ 			arguments: {TConstantNode new setValue: i}]!

Item was removed:
- ----- Method: VMPluginCodeGenerator>>compileToTMethodSelector:in: (in category 'utilities') -----
- compileToTMethodSelector: selector in: aClass
- 	"Compile a method to a TMethod. Override to eagerly record declarations etc
- 	 that happen in a later phase in the main VM's CCodeGenerator."
- 
- 	| m |
- 	m := (Compiler new
- 			parse: (aClass sourceCodeAt: selector)
- 			in: aClass
- 			notifying: nil)
- 				asTranslationMethodOfClass: self translationMethodClass.
- 	m removeFinalSelfReturnIn: self.
- 	m recordDeclarationsIn: self.
- 	m inferReturnTypeIn: self.
- 	m returnType ifNil:
- 		[m returnType: (self implicitReturnTypeFor: selector)].
- 	^m!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>doInlining: (in category 'inlining') -----
  doInlining: inlineFlag
+ 	"do inlining for a plugin; avoid doing it twice and make sure that
+ 	 primitive prolog preparation is done immediately after inlining.
+ 	 Also, since sharing between plugins means that normal pruning
+ 	 can't be done, allow plugins that want to prune specific methods."
+ 	inliningDone ifFalse:
+ 		[self doBasicInlining: inlineFlag.
+ 		 self prepareTranslatedPrimitives.
+ 		 pluginClass methodsToBePruned do:
+ 			[:sel|
+ 			methods removeKey: sel].
+ 		 inliningDone := true]!
- "do inlining for a plugin"
- 	^self doBasicInlining: inlineFlag!

Item was removed:
- ----- 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 ***/
- #if defined(SQUEAK_BUILTIN_PLUGIN)
- extern sqInt stackValue(sqInt offset);
- extern sqInt stackIntegerValue(sqInt offset);
- extern sqInt failed(void);
- # define successFlag (!!failed())
- extern sqInt success(sqInt aBoolean);
- extern void * arrayValueOf(sqInt oop);
- extern void * fetchArrayofObject(sqInt fieldIndex, sqInt objectPointer);
- extern double fetchFloatofObject(sqInt fieldIndex, sqInt objectPointer);
- extern sqInt fetchIntegerofObject(sqInt fieldIndex, sqInt objectPointer);
- extern double floatValueOf(sqInt oop);
- extern sqInt pop(sqInt nItems);
- extern sqInt pushInteger(sqInt integerValue);
- extern sqInt sizeOfSTArrayFromCPrimitive(void *cPtr);
- extern sqInt storeIntegerofObjectwithValue(sqInt index, sqInt oop, sqInt integer);
- extern sqInt primitiveFail(void);
- #else /* SQUEAK_BUILTIN_PLUGIN */
- # 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 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 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()
- #endif /* SQUEAK_BUILTIN_PLUGIN */
- 
- /* allows accessing Strings in both C and Smalltalk */
- #define asciiValue(c) c
- 
- 
- '!

Item was removed:
- ----- Method: VMPluginCodeGenerator>>generateCodeStringForPrimitives (in category 'public') -----
- generateCodeStringForPrimitives
- "TPR - moved down from CCodeGenerator"
- 	| s methodList |
- 	s := ReadWriteStream on: (String new: 1000).
- 	methodList := methods asSortedCollection: [:m1 :m2 | m1 selector < m2 selector].
- 	self emitCHeaderForPrimitivesOn: s.
- 	self emitCConstantsOn: s.
- 	self emitCVariablesOn: s.
- 	self emitCFunctionPrototypes: methodList on: s.
- 	methodList do: [:m | m emitCCodeOn: s generator: self].
- 	self emitExportsOn: s.
- 	^ s contents
- !

Item was changed:
  ----- Method: VMPluginCodeGenerator>>initialize (in category 'public') -----
  initialize
  	super initialize.
+ 	pluginFunctionsUsed := Set new.
+ 	inliningDone := false!
- 	pluginFunctionsUsed := Set new!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>preDeclareInterpreterProxyOn: (in category 'C code generator') -----
  preDeclareInterpreterProxyOn: aStream
  	"Put the necessary #defines needed before interpreterProxy.  Basically
  	 internal plugins use the VM's interpreterProxy variable and external plugins
  	 use their own.  Override to keep local copies of all functions in external
  	 prims, and link directly in internal plugins."
  	"| pcc |
  	pcc := self new.
  	(InterpreterProxy selectors reject: [:s| #(initialize private) includes: (InterpreterProxy whichCategoryIncludesSelector: s)]) do:
  		[:s| pcc noteUsedPluginFunction: s].
  	pcc preDeclareInterpreterProxyOn: Transcript.
  	Transcript flush"
  	| pluginFuncs interpreterClass objectMemoryClass |
  	(pluginFuncs := self pluginFunctionsToClone) isEmpty ifTrue:
  		[^super preDeclareInterpreterProxyOn: aStream].
  	aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'; cr.
  	interpreterClass := self referenceInterpreterClass.
  	objectMemoryClass := self referenceObjectMemoryClass.
  	pluginFuncs := pluginFuncs collect:
  						[:selector| | reference actual |
  						reference := self compileToTMethodSelector: selector
  										in: ((interpreterClass whichClassIncludesSelector: selector) ifNil:
  											[(objectMemoryClass whichClassIncludesSelector: selector) ifNil:
  												[InterpreterProxy]]).
  						actual := self compileToTMethodSelector: selector in: InterpreterProxy.
  						(reference returnType ~= actual returnType
  						 or: [(1 to: reference args size) anySatisfy:
  								[:i| (reference typeFor: (reference args at: i) in: self)
  								  ~= (actual typeFor: (actual args at: i) in: self)]]) ifTrue:
  							[self logger
  								nextPutAll: 'warning, signature of InterpreterProxy>>';
  								nextPutAll: selector;
  								nextPutAll: ' does not match reference implementation.';
  								cr].
  						actual].
  	pluginFuncs do:
+ 		[:tMethod|
+ 		 tMethod recordDeclarationsIn: self.
+ 		 tMethod returnType ifNil:
+ 			[tMethod inferReturnTypeIn: self]].
+ 	pluginFuncs do:
  		[:tMethod| | functionName |
  		functionName := self cFunctionNameFor: tMethod selector.
  		aStream nextPutAll:
  			((String streamContents:
  					[:s|
  					tMethod
  						static: true;
  						emitCFunctionPrototype: s generator: self])
  				copyReplaceAll: functionName
  				with: '(*', functionName, ')'
  				tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]]).
  		aStream nextPut: $;; cr].
  	aStream nextPutAll: '#else /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'.
  	pluginFuncs do:
  		[:tMethod|
  		self withOptionalVerbiageFor: tMethod selector
  			on: aStream
  			do: [aStream cr; nextPutAll: 'extern '.
  				tMethod static: false; export: false; emitCFunctionPrototype: aStream generator: self.
  				aStream nextPut: $;]
  			ifOptionalDo:
  				[aStream cr; nextPutAll: '# define '.
  				 (TSendNode new
  					setSelector: tMethod selector
  						receiver: (TVariableNode new setName: 'interpreterProxy')
  							arguments: (tMethod args collect: [:a| TVariableNode new setName: a]))
  					emitCCodeAsArgumentOn: aStream
  						level: 0
  							generator: self.
  				 aStream nextPutAll: ' 0']].
  	aStream cr; nextPutAll: 'extern'.
  	aStream cr; nextPutAll: '#endif'; cr!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>prepareTranslatedPrimitives (in category 'C code generator') -----
+ prepareTranslatedPrimitives
+ 	"Translated primitives need their prolog and epilog adding and all
+ 	 sends to self that should be sends to interpreterproxy changing."
+ 	methods do:
+ 		[:meth|
+ 		 meth primitive > 0 ifTrue:
+ 			[meth
+ 				preparePrimitivePrologue;
+ 				mapSendsFromSelfToInterpreterProxy: InterpreterProxy selectors]]!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>typeFor:in: (in category 'type inference') -----
+ typeFor: aNode in: aTMethod
+ 	"Override to provide the type for InterpreterProxy's implicit stack variable."
+ 	aNode isVariable ifTrue:
+ 		[^(aTMethod typeFor: aNode in: self) ifNil:
+ 			[aNode name = 'stack'
+ 				ifTrue: [#'sqInt *']
+ 				ifFalse: [#sqInt]]].
+ 	^super typeFor: aNode in: aTMethod!



More information about the Vm-dev mailing list