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

commits at source.squeak.org commits at source.squeak.org
Tue Jul 27 19:19:50 UTC 2021


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

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

Name: VMMaker.oscog-eem.3002
Author: eem
Time: 27 July 2021, 12:19:43.47378 pm
UUID: 618f5960-8dbf-452c-8709-f8201ee6433b
Ancestors: VMMaker.oscog-eem.3001

SmartSyntaxPlugins: generate better code for prologues, avoiding all use of success: and failed. Eliminate unnecessary failed sends.

LargeIntegersPlugin: use byteSizeOf: instead of slotSizeOf:; it is simpler and faster, and allows e.g. LargeIntegers to use what ever unit size they want.

Slang: provide buildCodeGeneratorInto: and a breakpoint in compileToTMethodSelector:in: so we can catch translation of a specific SmartSyntaxPlugin method; all the transformations occur in compileToTMethodSelector:in:.

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

Item was changed:
  ----- Method: CCodeGenerator>>compileToTMethodSelector:in: (in category 'utilities') -----
  compileToTMethodSelector: selector in: aClass
  	"Compile a method to a TMethod"
+ 	(breakSrcInlineSelectors notNil
+ 	 and: [(breakSrcInlineSelectors includes: selector)
+ 	 and: [breakOnInline ~~ true]]) ifTrue:
+ 		[self halt].
+ 
  	^(aClass >> selector) asTranslationMethodOfClass: self translationMethodClass
  
  	"was:
  	| implementingClass |
  	implementingClass := aClass.
  	^(Compiler new
  		parse: ([aClass sourceCodeAt: selector]
  					on: KeyNotFound
  					do: [:ex| ""Quick hack for simulating Pharo images...""
  						(PharoVM and: [aClass == String class and: [selector == #findSubstringViaPrimitive:in:startingAt:matchTable:]]) ifFalse:
  							[ex pass].
  						(implementingClass := ByteString) sourceCodeAt: #findSubstring:in:startingAt:matchTable:])
  		in: implementingClass
  		notifying: nil)
  			asTranslationMethodOfClass: self translationMethodClass"!

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

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

Item was added:
+ ----- Method: InterpreterProxy class>>checkingStackLoads (in category 'translation') -----
+ checkingStackLoads
+ 	"Answer the checking stack loads that set the primitive failure flag if validation fails.
+ 	 Used by a SmartSyntaxPluginTMethod to generate minimal prologue code."
+ 
+ 	 ^#(stackFloatValue: stackIntegerValue: stackObjectValue: stackPositiveMachineIntegerValue: stackSignedMachineIntegerValue:) !

Item was removed:
- ----- Method: LargeIntegersPlugin>>byteSizeOfLargeInt: (in category 'util') -----
- byteSizeOfLargeInt: bytesOop 
- 	"Answer the number of bytes required to represent a LargeInteger.
- 	Precondition: bytesOop is not a small integer."
- 	<inline: #always>
- 	^ interpreterProxy slotSizeOf: bytesOop!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitBitLogic:with:opIndex: (in category 'oop functions') -----
  digitBitLogic: firstInteger with: secondInteger opIndex: opIx 
  	"Bit logic here is only implemented for positive integers or Zero;
  	if rec or arg is negative, it fails."
  	| firstLarge secondLarge firstLen secondLen shortLen shortLarge longLen longLarge result |
  	(interpreterProxy isIntegerObject: firstInteger)
  		ifTrue: 
  			[(interpreterProxy integerValueOf: firstInteger) < 0 ifTrue:
+ 				[^interpreterProxy primitiveFail].
- 				[^ interpreterProxy primitiveFail].
  			"convert it to a not normalized LargeInteger"
+ 			self remapOop: secondInteger in:
+ 				[firstLarge := self createLargeFromSmallInteger: firstInteger]]
- 			self remapOop: secondInteger in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
  		ifFalse: 
+ 			[(interpreterProxy isLargePositiveIntegerObject: firstInteger) ifFalse:
+ 				[^interpreterProxy primitiveFail].
- 			[(interpreterProxy isLargePositiveIntegerObject: firstInteger) ifFalse: [^ interpreterProxy primitiveFail].
  			firstLarge := firstInteger].
  	(interpreterProxy isIntegerObject: secondInteger)
  		ifTrue: 
  			[(interpreterProxy integerValueOf: secondInteger) < 0 ifTrue:
+ 				[^interpreterProxy primitiveFail].
- 				[^ interpreterProxy primitiveFail].
  			"convert it to a not normalized LargeInteger"
+ 			self remapOop: firstLarge in:
+ 				[secondLarge := self createLargeFromSmallInteger: secondInteger]]
- 			self remapOop: firstLarge in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
  		ifFalse: 
+ 			[(interpreterProxy isLargePositiveIntegerObject: secondInteger) ifFalse:
+ 				[^interpreterProxy primitiveFail].
- 			[(interpreterProxy isLargePositiveIntegerObject: secondInteger) ifFalse: [^ interpreterProxy primitiveFail].
  			secondLarge := secondInteger].
+ 	firstLen := interpreterProxy byteSizeOf: firstLarge.
+ 	secondLen := interpreterProxy byteSizeOf: secondLarge.
- 	firstLen := self byteSizeOfLargeInt: firstLarge.
- 	secondLen := self byteSizeOfLargeInt: secondLarge.
  	firstLen < secondLen
  		ifTrue: 
  			[shortLen := firstLen.
  			shortLarge := firstLarge.
  			longLen := secondLen.
  			longLarge := secondLarge]
  		ifFalse: 
  			[shortLen := secondLen.
  			shortLarge := secondLarge.
  			longLen := firstLen.
  			longLarge := firstLarge].
  	self remapOop: #(shortLarge longLarge) in:
  		[result := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: longLen].
  	result ifNil: [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	self
  		cDigitOp: opIx
  		short: (self pointerToFirstDigitOfLargeInt: shortLarge)
  		len: shortLen + 3 // 4
  		long: (self pointerToFirstDigitOfLargeInt: longLarge)
  		len: longLen + 3 // 4
  		into: (self pointerToFirstDigitOfLargeInt: result).
  	interpreterProxy failed ifTrue: [^ 0].
  	^self normalizePositive: result!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitMultiplyLarge:with:negative: (in category 'oop functions') -----
  digitMultiplyLarge: firstInteger with: secondInteger negative: neg 
  	"Normalizes."
  	| firstLen secondLen shortInt shortLen longInt longLen prod |
+ 	firstLen := interpreterProxy byteSizeOf: firstInteger.
+ 	secondLen := interpreterProxy byteSizeOf: secondInteger.
- 	firstLen := self byteSizeOfLargeInt: firstInteger.
- 	secondLen := self byteSizeOfLargeInt: secondInteger.
  	firstLen <= secondLen
  		ifTrue: 
  			[shortInt := firstInteger.
  			shortLen := firstLen.
  			longInt := secondInteger.
  			longLen := secondLen]
  		ifFalse: 
  			[shortInt := secondInteger.
  			shortLen := secondLen.
  			longInt := firstInteger.
  			longLen := firstLen].
+ 	self remapOop: #(shortInt longInt) in:
+ 		[prod := self createLargeIntegerNeg: neg byteLength: longLen + shortLen].
- 	self remapOop: #(shortInt longInt) in: [prod := self createLargeIntegerNeg: neg byteLength: longLen + shortLen].
  	prod ifNil: [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	self
  		cDigitMultiply: (self pointerToFirstDigitOfLargeInt: shortInt)
  		len: shortLen + 3 // 4
  		with: (self pointerToFirstDigitOfLargeInt: longInt)
  		len: longLen + 3 // 4
  		into: (self pointerToFirstDigitOfLargeInt: prod)
  		len: longLen + shortLen + 3 // 4.
  	^neg 
  		ifTrue: [self normalizeNegative: prod]
  		ifFalse: [self normalizePositive: prod]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitSizeOfLargeInt: (in category 'util') -----
  digitSizeOfLargeInt: anOop
  	"answer number of 32 bits digits of a Large Integer"
  	<inline: true>
+ 	^(interpreterProxy byteSizeOf: anOop) + 3 // 4!
- 	^(self byteSizeOfLargeInt: anOop) + 3 // 4!

Item was changed:
  ----- Method: LargeIntegersPlugin>>isNormalized: (in category 'oop functions') -----
  isNormalized: aLargeInteger 
  	| len |
  	"Check for leading zero of LargeInteger"
+ 	len := interpreterProxy byteSizeOf: aLargeInteger.
- 	len := self byteSizeOfLargeInt: aLargeInteger.
  	len = 0 ifTrue:
  		[^ false].
  	(self unsafeByteOfLargeInt: aLargeInteger at: len) = 0 ifTrue:
  		[^ false].
  	^true!

Item was changed:
  ----- Method: LargeIntegersPlugin>>normalizeNegative: (in category 'oop functions') -----
  normalizeNegative: aLargeNegativeInteger 
  	"Check for leading zeroes and return shortened copy if so."
  	"First establish len = significant length."
  	| val val2 sLen digitLen byteLen oldByteLen minVal |
  	<var: #val type: #usqInt>
  	<var: #val2 type: #usqInt>
  	<var: #minVal type: #usqInt>
  	digitLen := self digitSizeOfLargeInt: aLargeNegativeInteger.
  	[digitLen ~= 0 and: [(self unsafeDigitOfLargeInt: aLargeNegativeInteger at: digitLen) = 0]]
  		whileTrue: [digitLen := digitLen - 1].
  	digitLen = 0 ifTrue: [^ 0 asOop: SmallInteger].
  	"Now check if in SmallInteger range"
  	val := self unsafeDigitOfLargeInt: aLargeNegativeInteger at: digitLen.
  	sLen := interpreterProxy minSmallInteger < -16r40000000
  				ifTrue: [2]
  				ifFalse: [1]. "SmallInteger minVal digitLength"
  	digitLen <= sLen
  		ifTrue: 
  			[minVal := 0 - interpreterProxy minSmallInteger.
  			val2 := val.
  			digitLen > 1 ifTrue: [val2 := val2 << 32 + (self unsafeDigitOfLargeInt: aLargeNegativeInteger at: 1)].
  			val2 <= minVal
  				ifTrue: [^0 -  val2 asOop: SmallInteger]].
  	"Return self, or a shortened copy"
  	byteLen := digitLen * 4.
  	val <= 16rFFFF
  		ifTrue: [byteLen := byteLen - 2]
  		ifFalse: [val := val >> 16].
  	val <= 16rFF
  		ifTrue: [byteLen := byteLen - 1].
+ 	oldByteLen := interpreterProxy byteSizeOf: aLargeNegativeInteger.
- 	oldByteLen := self byteSizeOfLargeInt: aLargeNegativeInteger.
  	byteLen < oldByteLen
  		ifTrue: [^ self largeInt: aLargeNegativeInteger growTo: byteLen]
  		ifFalse: [^ aLargeNegativeInteger]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>normalizePositive: (in category 'oop functions') -----
  normalizePositive: aLargePositiveInteger 
  	"Check for leading zeroes and return shortened copy if so."
  	"First establish len = significant length."
  	| val val2 sLen digitLen byteLen oldByteLen maxVal |
  	<var: #val type: #usqInt>
  	<var: #val2 type: #usqInt>
  	<var: #maxVal type: #usqInt>
  	digitLen := self digitSizeOfLargeInt: aLargePositiveInteger.
  	[digitLen ~= 0 and: [(self unsafeDigitOfLargeInt: aLargePositiveInteger at: digitLen) = 0]]
  		whileTrue: [digitLen := digitLen - 1].
  	digitLen = 0 ifTrue: [^ 0 asOop: SmallInteger].
  	"Now check if in SmallInteger range"
  	val := self unsafeDigitOfLargeInt: aLargePositiveInteger at: digitLen.
  	sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF
  				ifTrue: [2]
  				ifFalse: [1]. "SmallInteger maxVal digitLength"
  	digitLen <= sLen
  		ifTrue: 
  			[maxVal := interpreterProxy maxSmallInteger.
  			val2 := val.
  			digitLen > 1 ifTrue:
  				["Note: asUnsignedLongLong is not necessary because this branch is for 64 bits only.
  				but we want to avoid a C Compiler warning on 32 bits"
  				val2 := val2 asUnsignedLongLong << 32 + (self unsafeDigitOfLargeInt: aLargePositiveInteger at: 1)].
  			val2 <= maxVal
  				ifTrue: [^val2 asOop: SmallInteger]].
  	"Return self, or a shortened copy"
  	byteLen := digitLen * 4.
  	val <= 16rFFFF
  		ifTrue: [byteLen := byteLen - 2]
  		ifFalse: [val := val >> 16].
  	val <= 16rFF
  		ifTrue: [byteLen := byteLen - 1].
+ 	oldByteLen := interpreterProxy byteSizeOf: aLargePositiveInteger.
- 	oldByteLen := self byteSizeOfLargeInt: aLargePositiveInteger.
  	byteLen < oldByteLen
  		ifTrue: [^ self largeInt: aLargePositiveInteger growTo: byteLen]
  		ifFalse: [^ aLargePositiveInteger]!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asKindOf:from: (in category 'coercing') -----
+ ccgLoad: aBlock expr: variableName asKindOf: aClass from: stackIndex
+ 	^self
+ 		load: (self ccgLoad: aBlock expr: variableName asRawOopFrom: stackIndex)
+ 		validatingWith: #is:KindOf:
+ 		on: { variableName. aClass asString }
+ 		from: stackIndex!
- ccgLoad: aBlock expr: aString asKindOf: aClass from: anInteger
- 
- 	^String streamContents: [:aStream | aStream
- 		nextPutAll: 'interpreterProxy success: (interpreterProxy';
- 		crtab: 2;
- 		nextPutAll: 'is: (interpreterProxy stackValue: ';
- 		nextPutAll: anInteger asString;
- 		nextPutAll: ')';
- 		crtab: 2;
- 		nextPutAll: 	'KindOf: ''';
- 		nextPutAll:	aClass asString;
- 		nextPutAll: ''').';
- 		crtab;
- 		nextPutAll: (self 
- 						ccgLoad: aBlock 
- 						expr: aString 
- 						asRawOopFrom: anInteger)]!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asKindOfIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: variableName asKindOfIntegerFrom: stackIndex
+ 	^self
+ 		load: (self ccgLoad: aBlock expr: variableName asRawOopFrom: stackIndex)
+ 		validatingWith: #isKindOfInteger:
+ 		on: variableName
+ 		from: stackIndex!
- ccgLoad: aBlock expr: aString asKindOfIntegerFrom: anInteger 
- 
- 	^String streamContents: [:aStream | aStream
- 		nextPutAll: 'interpreterProxy success: (interpreterProxy isKindOfInteger: (interpreterProxy stackValue: ';
- 		nextPutAll: anInteger asString;
- 		nextPutAll: ')).';
- 		crtab;
- 		nextPutAll: (self 
- 						ccgLoad: aBlock 
- 						expr: aString 
- 						asRawOopFrom: anInteger)]!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asMemberOf:from: (in category 'coercing') -----
+ ccgLoad: aBlock expr: variableName asMemberOf: aClass from: stackIndex
+ 	^self
+ 		load: (self ccgLoad: aBlock expr: variableName asRawOopFrom: stackIndex)
+ 		validatingWith: #is:MemberOf:
+ 		on: { variableName. aClass asString }
+ 		from: stackIndex!
- ccgLoad: aBlock expr: aString asMemberOf: aClass from: anInteger
- 
- 	^String streamContents: [:aStream | aStream
- 		nextPutAll: 'interpreterProxy success: (interpreterProxy';
- 		crtab: 2;
- 		nextPutAll: 'is: (interpreterProxy stackValue: ';
- 		nextPutAll: anInteger asString;
- 		nextPutAll: ')';
- 		crtab: 2;
- 		nextPutAll: 	'MemberOf: ''';
- 		nextPutAll:	aClass asString;
- 		nextPutAll: ''').';
- 		crtab;
- 		nextPutAll: (self 
- 						ccgLoad: aBlock 
- 						expr: aString 
- 						asRawOopFrom: anInteger)]!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asMemberOfLargeNegativeIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: variableName asMemberOfLargeNegativeIntegerFrom: stackIndex
+ 	^self
+ 		load: (self ccgLoad: aBlock expr: variableName asRawOopFrom: stackIndex)
+ 		validatingWith: #isLargeNegativeIntegerObject:
+ 		on: variableName
+ 		from: stackIndex!
- ccgLoad: aBlock expr: aString asMemberOfLargeNegativeIntegerFrom: anInteger 
- 
- 	^String streamContents: [:aStream | aStream
- 		nextPutAll: 'interpreterProxy success: (interpreterProxy isLargeNegativeIntegerObject: (interpreterProxy stackValue: ';
- 		nextPutAll: anInteger asString;
- 		nextPutAll: ')).';
- 		crtab;
- 		nextPutAll: (self 
- 						ccgLoad: aBlock 
- 						expr: aString 
- 						asRawOopFrom: anInteger)]!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asMemberOfLargePositiveIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: variableName asMemberOfLargePositiveIntegerFrom: stackIndex
+ 	^self
+ 		load: (self ccgLoad: aBlock expr: variableName asRawOopFrom: stackIndex)
+ 		validatingWith: #isLargePositiveIntegerObject:
+ 		on: variableName
+ 		from: stackIndex!
- ccgLoad: aBlock expr: aString asMemberOfLargePositiveIntegerFrom: anInteger 
- 
- 	^String streamContents: [:aStream | aStream
- 		nextPutAll: 'interpreterProxy success: (interpreterProxy isLargePositiveIntegerObject: (interpreterProxy stackValue: ';
- 		nextPutAll: anInteger asString;
- 		nextPutAll: ')).';
- 		crtab;
- 		nextPutAll: (self 
- 						ccgLoad: aBlock 
- 						expr: aString 
- 						asRawOopFrom: anInteger)]!

Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>load:validatingWith:on:from: (in category 'coercing') -----
+ load: loadExpr validatingWith: testSelector on: variableOrVariables from: stackIndex
+ 
+ 	^String streamContents:
+ 		[:aStream |
+ 		aStream
+ 			nextPutAll: loadExpr;
+ 			nextPut: $.; cr; 
+ 			nextPutAll: '(interpreterProxy '.
+ 		testSelector numArgs = 1
+ 			ifTrue:
+ 				[aStream nextPutAll: testSelector; nextPutAll: variableOrVariables]
+ 			ifFalse:
+ 				[testSelector keywords with: variableOrVariables do:
+ 					[:keyword :variable|
+ 					aStream nextPutAll: keyword; nextPutAll: variable; space]].
+ 		aStream nextPutAll: ') ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]']!

Item was changed:
  ----- Method: SmartSyntaxPluginSimulator>>doesNotUnderstand: (in category 'message forwarding') -----
  doesNotUnderstand: aMessage
  	| signature selector parameters result sp |
  	signature := signatureMap
  					at: aMessage selector
  					ifAbsent: [^super doesNotUnderstand: aMessage].
  	self log: [interpreterProxy coInterpreter printExternalHeadFrame; print: aMessage selector; cr].
  	"record the stack pointer to avoid cutting back the stack twice in plugins that mix smart syntax and traditional style."
  	sp := interpreterProxy getStackPointer.
  	selector := signature first.
  	parameters := signature second.
  	signature third "receiver block" value: (interpreterProxy stackValue: parameters size).
  	interpreterProxy failed ifTrue:
+ 		[self log: 'failed in receiver marshalling'.
- 		[self log: 'failed in marshalling'.
  		 ^nil].
+ 	result := [| pluginArgs |
+ 			   pluginArgs := parameters withIndexCollect:
- 	result := [actualPlugin
- 					perform: selector
- 					withArguments: (parameters withIndexCollect:
  										[:block :index|
+ 										block value: (interpreterProxy stackValue: parameters size - index)].
+ 			   interpreterProxy failed ifTrue:
+ 				[self log: 'failed in argument marshalling'.
+ 				 ^nil].
+ 			   actualPlugin perform: selector withArguments: pluginArgs]
- 										block value: (interpreterProxy stackValue: parameters size - index)])]
  					on: Notification
  					do: [:ex|
  						ex tag == #getInterpreter ifTrue: [ex resume: interpreterProxy] ifFalse:
  						[ex tag == #getSimulator ifTrue: [ex resume: self]
  							ifFalse: [ex pass]]].
  	interpreterProxy failed ifTrue:
  		[self log: 'failed in execution'.
  		 ^nil].
  	result == actualPlugin ifTrue:
  		[self log: '^self'.
  		 "For methods in BitBltSimulator that do their own marshalling, don't double pop"
  		 sp = interpreterProxy getStackPointer ifTrue:
  			[interpreterProxy pop: interpreterProxy methodArgumentCount].
  		 ^nil].
  	self log: [interpreterProxy coInterpreter print: '^'; shortPrintOop: result; flush].
  	"For methods in BitBltSimulator that do their own marshalling, don't double pop"
  	sp = interpreterProxy getStackPointer ifTrue:
  		[interpreterProxy
  			pop: interpreterProxy methodArgumentCount + 1
  			thenPush: result].
  	^nil "SmartSyntaxPluginPrimitives return null"!

Item was changed:
  ----- Method: SmartSyntaxPluginTMethod>>handlePrimitiveDirective:on: (in category 'specifying primitives') -----
  handlePrimitiveDirective: aStmt on: sStream
+ 	| needsCheckSuccessExpr loadExpressionSource |
- 
  	isPrimitive := true.
  	fullArgs := args.
  	locals addAll: args.
  	args := OrderedCollection new.
  	fullArgs with: parmSpecs do:
  		[:argName :spec |
  		self declarationAt: argName
  			put: (spec ccgDeclareCForVar: argName)].
+ 	needsCheckSuccessExpr := false.
  	aStmt isAssignment ifTrue:
  		[self declarationAt: aStmt variable name
  			put: (rcvrSpec ccgDeclareCForVar: aStmt variable name).
+ 		 loadExpressionSource := rcvrSpec
+ 									ccg:	SmartSyntaxPluginCodeGenerator new
+ 									prolog:  [:expr | aStmt variable name, ' := ', expr]
+ 									expr: 	aStmt variable name
+ 									index: 	fullArgs size.
+ 		 needsCheckSuccessExpr := (loadExpressionSource includesSubstring: ' success:')
+ 									or: [InterpreterProxy checkingStackLoads anySatisfy:
+ 											[:checkingSelector|
+ 											loadExpressionSource includesSubstring: checkingSelector]].
+ 		 sStream nextPutAll: (self statementsFor: loadExpressionSource varName: '')].
- 		 sStream nextPutAll: (self
- 			statementsFor:
- 				(rcvrSpec
- 					ccg:	SmartSyntaxPluginCodeGenerator new
- 					prolog:  [:expr | aStmt variable name, ' := ', expr]
- 					expr: 	aStmt variable name
- 					index: 	fullArgs size)
- 			varName: '')].
  
+ 	"only add the failure guard if required"
+ 	needsCheckSuccessExpr ifTrue:
- 	"only add the failure guard if there are args or it is an assignment"
- 	(fullArgs isEmpty not or: [aStmt isAssignment]) ifTrue:
  		[sStream nextPutAll: self checkSuccessExpr].
+ 	^true!
- 	^true.
- !

Item was changed:
  ----- Method: SmartSyntaxPluginTMethod>>namedPrimitiveProlog (in category 'specifying primitives') -----
  namedPrimitiveProlog
  	"Generate the code for a primitive:parameters:... send.  This is in two parts.
  	 The first is validation; the second is coercing assignment."
  	| statements validator validations assigner |
  	fullArgs isEmpty ifTrue:
  		[^#()].
  	validator := SmartSyntaxPluginValidationCodeGenerator new.
  	statements := OrderedCollection new.
  	validations := fullArgs withIndexCollect:
  					[:arg :i|
  					(parmSpecs at: i) 
  							ccg: 	validator
  							prolog:  nil
  							expr: arg
  							index: (fullArgs size - i)].
  	validations := validations reject: [:validation| validation isNil].
  	validations isEmpty ifFalse:
  		[statements addAllLast: (self statementsFor:
  									(String streamContents:
  										[:s|
  										s nextPut: $(.
  										validations
  											do: [:validation| s nextPut: $(; nextPutAll: validation; nextPut: $)]
  											separatedBy: [s crtab; nextPutAll: 'and: ['].
  										s next: validations size - 1 put: $].
+ 										s nextPutAll: ') ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]'])
- 										s	nextPutAll: ') ifFalse:';
- 											crtab: 2;
- 											nextPutAll: '[interpreterProxy primitiveFailFor: PrimErrBadArgument.';
- 											crtab: 2;
- 											nextPutAll: '^nil';
- 											crtab: 2;
- 											nextPut: $]])
  									varName: '')].
  	assigner := SmartSyntaxPluginAssignmentCodeGenerator new.
  	fullArgs withIndexDo:
  		[:arg :i|
  		statements addAllLast:
  			(self 
  				statementsFor: 
  					((parmSpecs at: i) 
  						ccg: 	assigner
  						prolog:  nil
+ 						expr:	arg
+ 						index:	(fullArgs size - i))
- 						expr: arg
- 						index: (fullArgs size - i))
  				varName: '')].
  	^statements!



More information about the Vm-dev mailing list