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

commits at source.squeak.org commits at source.squeak.org
Wed Oct 31 17:33:53 UTC 2018


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

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

Name: VMMaker.oscog-eem.2480
Author: eem
Time: 31 October 2018, 10:33:03.858395 am
UUID: bb3ffda7-8241-4dea-b886-d656e474b6c1
Ancestors: VMMaker.oscog-eem.2479

Simulator:
Provide simulation stubs for the B3DAcceleratorPlugin C api.

Slang:
Provide some clean up of pointer types in TMethods and type extraction, ensuring there's a space before any trailing *'s.

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

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dDrawArrays:_:_:_: (in category 'simulation') -----
+ b3dDrawArrays: handle _: mode _: minIdx _: maxIdx
+ 	"int b3dDrawArrays(int handle, int mode, int minIdx, int maxIdx)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dDrawElements:_:_:_: (in category 'simulation') -----
+ b3dDrawElements: handle _: mode _: faceSize _: facePtr
+ 	"int b3dDrawElements(int handle, int mode, int nFaces, unsigned int *facePtr)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dDrawRangeElements:_:_:_:_:_: (in category 'simulation') -----
+ b3dDrawRangeElements: handle _: mode _: minIdx _: maxIdx _: faceSize _: facePtr
+ 	"int b3dDrawRangeElements(int handle, int mode, int minIdx, int maxIdx, int nFaces, unsigned int *facePtr)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dLoadClientState:_:_:_:_:_:_:_:_: (in category 'simulation') -----
+ b3dLoadClientState: handle _: vtxData _: vtxSize _: colorData _: colorSize _: normalData _: normalSize _: txData _: txSize
+ 	"int b3dLoadClientState(int handle, float *vtxData, int vtxSize, float *colorData, int colorSize, float *normalData, int normalSize, float *txData, int txSize)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxActualTextureDepth:_: (in category 'simulation') -----
+ b3dxActualTextureDepth: renderer _: handle
+ 	"int b3dxActualTextureDepth(int renderer, int handle)"
+ 	<doNotGenerate>
+ 	^-1!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxAllocateTexture:_:_:_: (in category 'simulation') -----
+ b3dxAllocateTexture: renderer _: w _: h _: d
+ 	"int b3dxAllocateTexture(int renderer, int w, int h, int d)"
+ 	<doNotGenerate>
+ 	^-1!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxCompositeTexture:_:_:_:_:_:_: (in category 'simulation') -----
+ b3dxCompositeTexture: rendererHandle _: texHandle _: x _: y _: w _: h _: translucent
+ 	"int b3dxCompositeTexture(int renderer, int handle, int x, int y, int w, int h, int translucent)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxDestroyRenderer: (in category 'simulation') -----
+ b3dxDestroyRenderer: handle
+ 	"int b3dxDestroyRenderer(int handle)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxDestroyTexture:_: (in category 'simulation') -----
+ b3dxDestroyTexture: renderer _: handle
+ 	"int b3dxDestroyTexture(int renderer, int handle)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxDisableLights: (in category 'simulation') -----
+ b3dxDisableLights: handle
+ 	"int b3dxDisableLights(int handle)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxFinishRenderer: (in category 'simulation') -----
+ b3dxFinishRenderer: handle
+ 	"int b3dxFinishRenderer(int handle)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxFlushRenderer: (in category 'simulation') -----
+ b3dxFlushRenderer: handle
+ 	"int b3dxFlushRenderer(int handle)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxGetRendererColorMasks:_: (in category 'simulation') -----
+ b3dxGetRendererColorMasks: handle _: masks
+ 	"int b3dxGetRendererColorMasks(int handle, int *masks)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxGetRendererSurfaceDepth: (in category 'simulation') -----
+ b3dxGetRendererSurfaceDepth: handle
+ 	"int b3dxGetRendererSurfaceDepth(int handle)"
+ 	<doNotGenerate>
+ 	^-1!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxGetRendererSurfaceHandle: (in category 'simulation') -----
+ b3dxGetRendererSurfaceHandle: handle
+ 	"int b3dxGetRendererSurfaceHandle(int handle)"
+ 	<doNotGenerate>
+ 	^-1!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxGetRendererSurfaceHeight: (in category 'simulation') -----
+ b3dxGetRendererSurfaceHeight: handle
+ 	"int b3dxGetRendererSurfaceHeight(int handle)"
+ 	<doNotGenerate>
+ 	^-1!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxGetRendererSurfaceWidth: (in category 'simulation') -----
+ b3dxGetRendererSurfaceWidth: handle
+ 	"int b3dxGetRendererSurfaceWidth(int handle)"
+ 	<doNotGenerate>
+ 	^-1!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxIsOverlayRenderer: (in category 'simulation') -----
+ b3dxIsOverlayRenderer: handle
+ 	"int b3dxIsOverlayRenderer(int handle)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxLoadLight:_:_: (in category 'simulation') -----
+ b3dxLoadLight: handle _: i _: light
+ 	"int b3dxLoadLight(int handle, int index, B3DPrimitiveLight *light)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxLoadMaterial:_: (in category 'simulation') -----
+ b3dxLoadMaterial: handle _: material
+ 	"int b3dxLoadMaterial(int handle, B3DPrimitiveMaterial *material)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxRenderVertexBuffer:_:_:_:_:_:_:_: (in category 'simulation') -----
+ b3dxRenderVertexBuffer: handle _: primType _: flags _: texHandle _: vtxArray _: vtxCount _: idxArray _: idxCount
+ 	"int b3dxRenderVertexBuffer(int handle, int primType, int flags, int texHandle, float *vtxArray, int vtxSize, int *idxArray, int idxSize)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxSwapRendererBuffers: (in category 'simulation') -----
+ b3dxSwapRendererBuffers: handle
+ 	"int b3dxSwapRendererBuffers(int handle)"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxTextureByteSex:_: (in category 'simulation') -----
+ b3dxTextureByteSex: renderer _: handle
+ 	"int b3dxTextureByteSex(int renderer, int handle)"
+ 	<doNotGenerate>
+ 	^-1!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxTextureColorMasks:_:_: (in category 'simulation') -----
+ b3dxTextureColorMasks: renderer _: handle _: masks
+ 	"int b3dxTextureColorMasks(int renderer, int handle, int masks[4])"
+ 	<doNotGenerate>
+ 	^false!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxTextureSurfaceHandle:_: (in category 'simulation') -----
+ b3dxTextureSurfaceHandle: renderer _: handle
+ 	"int b3dxTextureSurfaceHandle(int renderer, int handle)"
+ 	<doNotGenerate>
+ 	^-1!

Item was added:
+ ----- Method: B3DAcceleratorPlugin>>b3dxUploadTexture:_:_:_:_:_: (in category 'simulation') -----
+ b3dxUploadTexture: renderer _: handle _: w _: h _: d _: bitsPtr
+ 	"int b3dxUploadTexture(int renderer, int handle, int w, int h, int d, void* bits)"
+ 	<doNotGenerate>
+ 	^false!

Item was changed:
  ----- Method: CCodeGenerator>>baseTypeForType: (in category 'utilities') -----
  baseTypeForType: aCType
  	"Reduce various declarations to the most basic type we can determine."
+ 	| type fpIndex closeidx openidx |
- 	| type fpIndex closeidx openidx index |
  	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].
  	"collapse e.g. void (*foo(int bar))(void) to void (*)(void)"
  	(fpIndex := type indexOfSubCollection: '(*') > 0 ifTrue:
  		["elide the function arguments after *, if there are any"
  		 type := type copyReplaceFrom: (type indexOf: $( startingAt: fpIndex + 1)
  					to: (type indexOf: $) startingAt: fpIndex + 1)
  					with: ''.
  		 "elide the function name after *, if there is one"
  		 type := type copyReplaceFrom: fpIndex + 2
  					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: '*'].
+ 
+ 	"map foo* to foo *"
+ 	^self conventionalTypeForType: type!
- 	type := type withBlanksTrimmed.
- 	index := type size.
- 	"Ensure there is a space between the type and any trailing *'s"
- 	[(type at: index) == $*] whileTrue:
- 		[index := index - 1].
- 	(index < type size
- 	 and: [(type at: index) ~~ Character space]) ifTrue:
- 		[type := (type copyFrom: 1 to: index), ' ', (type copyFrom: index + 1 to: type size)].
- 	^type!

Item was added:
+ ----- Method: CCodeGenerator>>conventionalTypeForType: (in category 'utilities') -----
+ conventionalTypeForType: aCTypeString
+ 	"The pointer type convention in this version of VMMaker is to have a space between the base type and any *'s.
+ 	 C type comparisons are simple string comparisons; therefore the convention matters.
+ 	 Ensure there is a space between the base type and any trailing *'s. Trim whitespace."
+ 	| type index |
+ 	type := aCTypeString withBlanksTrimmed.
+ 	index := type size.
+ 	[(type at: index) == $*] whileTrue:
+ 		[index := index - 1].
+ 	(index < type size
+ 	 and: [(type at: index) ~~ Character space]) ifTrue:
+ 		[type := (type copyFrom: 1 to: index), ' ', (type copyFrom: index + 1 to: type size)].
+ 	^type!

Item was changed:
  ----- Method: CCodeGenerator>>returnTypeForSend:in:ifNil: (in category 'type inference') -----
  returnTypeForSend: sendNode in: aTMethod ifNil: typeIfNil
  	"Answer the return type for a send.  Unbound sends default to typeIfNil.
  	 Methods with types as yet unknown have a type determined either by the
  	 kernelReturnTypes or the table below, or, if they are in neither set, then nil.
  	 The inferred type should match as closely as possible the C type of
  	 generated expessions so that inlining would not change the expression.
  	 If there is a method for sel but its return type is as yet unknown it mustn't
  	 be defaulted, since on a subsequent pass its type may be computable."
  	| sel methodOrNil |
  	methodOrNil := self anyMethodNamed: (sel := sendNode selector).
  	(methodOrNil notNil and: [methodOrNil returnType notNil]) ifTrue:
  		[^self baseTypeForType: methodOrNil returnType].
  	^kernelReturnTypes
  		at: sel
  		ifAbsent:
  			[sel
  				caseOf: {
  				[#integerValueOf:]		->	[#sqInt].
  				[#isIntegerObject:]		->	[#int].
  				[#negated]				->	[self promoteArithmeticTypes: (sendNode receiver typeFrom: self in: aTMethod) and: #int].
  				[#+]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#-]						->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#*]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#/]						->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#//]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#\\]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#rem:]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#quo:]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				"C99 Sec Bitwise shift operators ... 3 Sematics ...
  				 The integer promotions are performed on each of the operands. The type of the result is that of the promoted left operand..."
  				[#>>]					->	[sendNode receiver typeFrom: self in: aTMethod].
  				[#<<]					->	[sendNode receiver typeFrom: self in: aTMethod].
  				[#addressOf:]			->	[(sendNode receiver typeFrom: self in: aTMethod)
  												ifNil: [#sqInt]
  												ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
  				[#at:]					->	[self typeForDereference: sendNode in: aTMethod].
  				[#bitAnd:]				->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#bitOr:]				->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#bitXor:]				->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#bitClear:]				->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#bitInvert32]			->	[#'unsigned int'].
  				[#bitInvert64]			->	[self promoteArithmeticTypes: (sendNode receiver typeFrom: self in: aTMethod) and: #int].
  				[#byteSwap32]			->	[#'unsigned int'].
  				[#byteSwap64]			->	[#'unsigned long long'].
  				[#byteSwapped32IfBigEndian:]	->	[#'unsigned int'].
  				[#byteSwapped64IfBigEndian:]	->	[#'unsigned long long'].
  				[#=]					->	[#int].
  				[#~=]					->	[#int].
  				[#==]					->	[#int].
  				[#~~]					->	[#int].
  				[#<]					->	[#int].
  				[#<=]					->	[#int].
  				[#>]					->	[#int].
  				[#>=]					->	[#int].
  				[#between:and:]		->	[#int].
  				[#anyMask:]				->	[#int].
  				[#allMask:]				->	[#int].
  				[#noMask:]				->	[#int].
  				[#isNil]					->	[#int].
  				[#notNil]				->	[#int].
  				[#&]					->	[#int].
  				[#|]						->	[#int].
  				[#not]					->	[#int].
  				[#asFloat]				->	[#double].
  				[#atan]					->	[#double].
  				[#exp]					->	[#double].
  				[#log]					->	[#double].
  				[#sin]					->	[#double].
  				[#sqrt]					->	[#double].
  				[#asLong]				->	[#long].
  				[#asInteger]			->	[#sqInt].
  				[#asIntegerPtr]			->	[#'sqIntptr_t'].
  				[#asUnsignedInteger]	->	[#usqInt].
  				[#asUnsignedIntegerPtr]->	[#'usqIntptr_t'].
  				[#asUnsignedLong]		->	[#'unsigned long'].
  				[#asUnsignedLongLong]		->	[#'unsigned long long'].
  				[#asVoidPointer]		->	[#'void *'].
  				[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
  				[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
+ 				[#cCoerce:to:]			->	[self conventionalTypeForType: sendNode args last value].
+ 				[#cCoerceSimple:to:]	->	[self conventionalTypeForType: sendNode args last value].
- 				[#cCoerce:to:]			->	[sendNode args last value].
- 				[#cCoerceSimple:to:]	->	[sendNode args last value].
  				[#sizeof:]				->	[#'usqIntptr_t']. "Technically it's a size_t but it matches on target architectures so far..."
  				[#ifTrue:ifFalse:]		->	[self typeForConditional: sendNode in: aTMethod].
  				[#ifFalse:ifTrue:]		->	[self typeForConditional: sendNode in: aTMethod].
  				[#ifTrue:]				->	[self typeForConditional: sendNode in: aTMethod].
  				[#ifFalse:]				->	[self typeForConditional: sendNode in: aTMethod].
  				[#and:]					->	[#sqInt].
  				[#or:]					->	[#sqInt].
  				[#caseOf:]				->	[self typeFor: sendNode args first in: aTMethod] }
  				otherwise: "If there /is/ a method for sel but its return type is as yet unknown it /mustn't/ be defaulted,
  							since on a subsequent pass its type may be computable.  Only default unbound selectors."
  					[methodOrNil ifNotNil: [nil] ifNil: [typeIfNil]]]!

Item was changed:
  ----- Method: SmartSyntaxPluginTMethod>>recordDeclarationsIn: (in category 'transforming') -----
  recordDeclarationsIn: aCCodeGen
  	"Record C type declarations of the forms
  		<returnTypeC: 'float'>
  		<var: #foo declareC: 'float foo'>
  		<var: #foo type:'float'>
  		<var: #foo as: Class>
  	 or the older, obsolete
  		self returnTypeC: 'float'.
  		self var: #foo declareC: 'float foo'
  		self var: #foo type:'float'.
  		self var: #foo as: Class
  	 and remove the declarations from the method body."
  
  	| newStatements |
  	properties pragmas notEmpty ifTrue:
  		[properties pragmas do:
  			[:pragma|
+ 			pragma keyword == #var:declareC: ifTrue:
- 			pragma keyword = #var:declareC: ifTrue:
  				[self checkedDeclarationAt: pragma arguments first asString
  					put: pragma arguments last
  					in: aCCodeGen].
+ 			pragma keyword == #var:type: ifTrue:
- 			pragma keyword = #var:type: ifTrue:
  				[| varName varType |
  				varName := pragma arguments first asString.
+ 				varType := aCCodeGen conventionalTypeForType: pragma arguments last.
+ 				varType last == $* ifFalse: [varType := varType, ' '].
- 				varType := pragma arguments last.
- 				varType last = $* ifFalse: [varType := varType, ' '].
  				self checkedDeclarationAt: varName
  					put: varType, varName
  					in: aCCodeGen].
+ 			 pragma keyword == #var:as: ifTrue:
- 			 pragma keyword = #var:as: ifTrue:
  				[| theClass |
  				 theClass := Smalltalk at: pragma arguments last name asSymbol ifAbsent: [nil].
  				 theClass isBehavior ifFalse:
  					[^self error: 'declarator must be a Behavior'].
  				 self checkedDeclarationAt: pragma arguments first value asString 
  					put: (theClass ccgDeclareCForVar: pragma arguments first asString)
  					in: aCCodeGen].
+ 			pragma keyword == #returnTypeC: ifTrue:
- 			pragma keyword = #returnTypeC: ifTrue:
  				[self returnType: pragma arguments last].
  			pragma keyword = #doNotGenerate: ifTrue:
  				[locals removeKey: pragma arguments last]].
  		^self].
  	newStatements := OrderedCollection new: parseTree statements size.
  	parseTree statements do: 
  		[:stmt | | isDeclaration |
  		 isDeclaration := false.
  		 stmt isSend ifTrue: 
+ 			[stmt selector == #var:declareC: ifTrue:
- 			[stmt selector = #var:declareC: ifTrue:
  				[isDeclaration := true.
  				self declarationAt: stmt args first value asString put: stmt args last value].
+ 			stmt selector = #var:type: ifTrue:
+ 				[| varName varType |
- 			stmt selector = #var:type: ifTrue: [
- 				| varName varType |
  				isDeclaration := true.
  				varName := stmt args first value asString.
+ 				varType := aCCodeGen conventionalTypeForType: stmt args last value.
+ 				varType last == $* ifFalse: [varType := varType, ' '].
+ 				self declarationAt: varName put: varType, varName].
+ 			 stmt selector == #var:as: ifTrue:
- 				varType := stmt args last value.
- 				varType last = $* ifFalse: [varType := varType, ' '].
- 				self declarationAt: varName put: varType, varName.
- 			].
- 			 stmt selector = #var:as: ifTrue:
  				[| theClass |
  				 isDeclaration := true.
  				 theClass := Smalltalk  at: stmt args last name asSymbol ifAbsent: [nil].
  				 theClass isBehavior ifFalse:
  					[^self error: 'declarator must be a Behavior'].
  				 self declarationAt: stmt args first value asString 
  					put: (theClass ccgDeclareCForVar: stmt args first value asString)].
+ 			 stmt selector == #returnTypeC: ifTrue: 
- 			 stmt selector = #returnTypeC: ifTrue: 
  				[isDeclaration := true.
  				 returnType := stmt args last value]].
  		 isDeclaration ifFalse: [newStatements add: stmt]].
  	parseTree setStatements: newStatements asArray!

Item was changed:
  ----- Method: SmartSyntaxPluginTMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initialization') -----
  setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment
  	"Initialize this method using the given information."
  
  	selector := sel.
  	definingClass := class.
  	returnType := #sqInt. 	 "assume return type is sqInt for now"
  	args := argList asOrderedCollection collect: [:arg | arg key].
  	locals := (localList collect: [:arg | arg key]) asSet.
  	declarations := Dictionary new.
  	primitive := aNumber.
  	properties := methodProperties.
  	comment := aComment.
  	parseTree := aBlockNode asTranslatorNodeIn: self.
  	labels := Set new.
  	complete := false.  "set to true when all possible inlining has been done"
  	export := self extractExportDirective.
  	static := self extractStaticDirective.
  	self extractSharedCase.
  	isPrimitive := false.  "set to true only if you find a primtive direction."
  	suppressingFailureGuards := self extractSuppressFailureGuardDirective.
+ 	self recordDeclarationsIn: CCodeGenerator basicNew. "Just for conventionalTypeForType:"
- 	self recordDeclarationsIn: nil.
  	self extractPrimitiveDirectives.
  !

Item was changed:
  ----- Method: TMethod>>recordDeclarationsIn: (in category 'transformations') -----
  recordDeclarationsIn: aCCodeGen
  	"Record C type declarations of the forms
  		<returnTypeC: 'float'>
  		<var: #foo declareC: 'float foo'>
  		<var: #foo type:'float'>
  	 or the older, obsolete
  		self returnTypeC: 'float'.
  		self var: #foo declareC: 'float foo'
  		self var: #foo type:'float'.
  	 and remove the declarations from the method body."
  
  	| newStatements |
  	properties pragmas notEmpty ifTrue:
  		[properties pragmas do:
  			[:pragma|
+ 			pragma keyword == #var:declareC: ifTrue:
- 			pragma keyword = #var:declareC: ifTrue:
  				[self checkedDeclarationAt: pragma arguments first asString
  					put: pragma arguments last
  					in: aCCodeGen].
+ 			pragma keyword == #var:type: ifTrue:
- 			pragma keyword = #var:type: ifTrue:
  				[| varName varType |
  				varName := pragma arguments first asString.
+ 				varType := aCCodeGen conventionalTypeForType: pragma arguments last.
+ 				varType last == $* ifFalse: [varType := varType, ' '].
- 				varType := pragma arguments last.
- 				varType last = $* ifFalse: [varType := varType, ' '].
  				self checkedDeclarationAt: varName
  					put: varType, varName
  					in: aCCodeGen].
  			pragma keyword = #returnTypeC: ifTrue:
  				[self returnType: pragma arguments last].
  			pragma keyword = #doNotGenerate: ifTrue:
  				[locals remove: pragma arguments last]].
  		^self].
  	newStatements := OrderedCollection new: parseTree statements size.
+ 	parseTree statements do:
+ 		[ :stmt | | isDeclaration |
- 	parseTree statements do: [ :stmt |
- 		| isDeclaration |
  		isDeclaration := false.
+ 		stmt isSend ifTrue:
+ 			[stmt selector == #var:declareC: ifTrue:
+ 				[isDeclaration := true.
+ 				self declarationAt: stmt args first value asString put: stmt args last value].
+ 			stmt selector == #var:type: ifTrue:
+ 				[| varName varType |
- 		stmt isSend ifTrue: [
- 			stmt selector = #var:declareC: ifTrue: [
  				isDeclaration := true.
- 				self declarationAt: stmt args first value asString put: stmt args last value.
- 			].
- 			stmt selector = #var:type: ifTrue: [
- 				| varName varType |
- 				isDeclaration := true.
  				varName := stmt args first value asString.
+ 				varType := aCCodeGen conventionalTypeForType: stmt args last value.
+ 				varType last == $* ifFalse: [varType := varType, ' '].
+ 				self declarationAt: varName put: varType, varName].
+ 			stmt selector = #returnTypeC: ifTrue:
+ 				[isDeclaration := true.
+ 				returnType := stmt args last value]].
+ 		isDeclaration ifFalse:
+ 			[newStatements add: stmt]].
- 				varType := stmt args last value.
- 				varType last = $* ifFalse: [varType := varType, ' '].
- 				self declarationAt: varName put: varType, varName.
- 			].
- 			stmt selector = #returnTypeC: ifTrue: [
- 				isDeclaration := true.
- 				returnType := stmt args last value.
- 			].
- 		].
- 		isDeclaration ifFalse: [
- 			newStatements add: stmt.
- 		].
- 	].
  	parseTree setStatements: newStatements asArray.!



More information about the Vm-dev mailing list