[Vm-dev] VM Maker: Cog-eem.354.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Mar 16 20:44:09 UTC 2019


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

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

Name: Cog-eem.354
Author: eem
Time: 16 March 2019, 1:44:07.412059 pm
UUID: 46932143-1042-4836-b362-84b799def68d
Ancestors: Cog-eem.353

Provide an edit script to map cCode: 'func(...)''s to the new _: style.

=============== Diff against Cog-eem.353 ===============

Item was added:
+ ----- Method: CogScripts class>>eliminateCCodeInSmalltalkFrom: (in category 'plugin scripts') -----
+ eliminateCCodeInSmalltalkFrom: aPluginClass
+ 	"Edit any self cCode: 'something that looks like a C call' [ inSmalltalk: [ ...] ]
+ 	 into the function: arg1 _: arg2 style, ensuring that if the class has (a) simulator
+ 	 subclass(es), that a stub implementation exists in the subclass. Write any failures
+ 	 to the transcript."
+ 
+ 	"(Smalltalk organization classesInCategory: #'3DICC-Plugins') do:
+ 		[:aPluginClass|
+ 		CogScripts eliminateCCodeInSmalltalkFrom: aPluginClass]"
+ 
+ 	| transformations |
+ 	transformations := Dictionary new.
+ 	aPluginClass selectorsAndMethodsDo:
+ 		[:selector :method|
+ 		(self mapCCodeToSmalltalkIn: method)
+ 			ifNotNil: [:edit| transformations at: selector put: edit]
+ 			ifNil: [((method sendsSelector: #cCode:) or: [method sendsSelector: #cCode:inSmalltalk:]) ifTrue:
+ 					[Transcript cr; show: 'mapCCodeToSmalltalkIn: failed to edit cCode:... in ', aPluginClass name, '>>', selector]]].
+ 	transformations keys sort do:
+ 		[:selector|
+ 		[:code :messages|
+ 		(aPluginClass compile: code notifying: nil)
+ 			ifNil: [Transcript cr; show: 'Failed to compile mapCCodeToSmalltalkIn: transformation for ', aPluginClass name, '>>', selector]
+ 			ifNotNil:
+ 				[(aPluginClass allSubclasses select: [:sc| sc name endsWith: 'Simulator']) do:
+ 					[:sc|
+ 					messages do:
+ 						[:msg|
+ 						(sc includesSelector: msg selector) ifFalse:
+ 							[sc compile: msg createStubMethod classified: 'simulation']]]]]
+ 			valueWithArguments: (transformations at: selector)]!

Item was added:
+ ----- Method: CogScripts class>>mapCCodeToSmalltalkIn: (in category 'plugin scripts') -----
+ mapCCodeToSmalltalkIn: aMethod
+ 	"Answer new source code for aMethod where cCode: strings have been mapped to the new foo: arg1 _: arg2
+ 	 format and any inSmalltalk: code is included in a trailing comment."
+ 	| methodNode edits text |
+ 	methodNode := aMethod methodNode.
+ 	edits := Dictionary new.
+ 	methodNode block nodesDo:
+ 		[:n| | cCode |
+ 		(n isMessage
+ 		 and: [(#(cCode: cCode:inSmalltalk:) includes: n selector key)
+ 		 and: [(cCode := n arguments first value key) isString
+ 		 and: [cCode notEmpty]]]) ifTrue:
+ 			[| argVec |
+ 			argVec := self processedCCodeCallFor: cCode.
+ 			edits at: (methodNode encoder sourceRangeFor: n)
+ 				put: (String streamContents:
+ 						[:s| | first |
+ 						argVec size > 2 ifTrue:
+ 							[s nextPutAll: 'cCoerce: (self '].
+ 						s nextPutAll: argVec first.
+ 						argVec size > 1 ifTrue:
+ 							[first := true.
+ 							 argVec second do:
+ 								[:thing| | param |
+ 								thing ~~ #, ifTrue:
+ 									[s nextPutAll: (first
+ 													ifTrue: [': ']
+ 													ifFalse: [' _: ']).
+ 									 first := false.
+ 									 param := thing isArray
+ 												ifTrue: [s nextPutAll: '(self cCoerce: '. thing first]
+ 												ifFalse: [thing].
+ 									(methodNode encoder lookupVariable: param ifAbsent: [])
+ 										ifNotNil: [s nextPutAll: param]
+ 										ifNil: [s store: param]].
+ 									thing isArray ifTrue:
+ 										[(self printTypeFor: thing last on: s) ifFalse:
+ 											[^nil].
+ 										 s nextPut: $)]]].
+ 						argVec size > 2 ifTrue:
+ 							[s nextPut: $).
+ 							 (self printTypeFor: argVec last on: s) ifFalse:
+ 								[^nil]].
+ 						#cCode:inSmalltalk: == n selector key ifTrue:
+ 							[| r |
+ 							 r := methodNode encoder sourceRangeFor: n arguments last.
+ 							 s space; nextPutAll: ' "inSmalltalk: '; nextPutAll: (methodNode sourceText copyFrom: r first to: r last); nextPut: $"]])]].
+ 	edits ifEmpty: [^nil].
+ 	text := methodNode sourceText asString.
+ 	(edits keys asSortedCollection: [:a :b| a first > b first]) do:
+ 		[:range|
+ 		text := text copyReplaceFrom: range first to: range last with: (edits at: range)].
+ 	^{ text.
+ 		(edits collect:
+ 			[:string| | selectorString index |
+ 			selectorString := (string beginsWith: 'cCoerce:') ifTrue: [string allButFirst: 10] ifFalse: [string].
+ 			(index := selectorString indexOfSubCollection: '"inSmalltalk') > 0 ifTrue:
+ 				[selectorString := selectorString first: index - 1].
+ 			(selectorString occurrencesOf: $)) > (selectorString occurrencesOf: $() ifTrue:
+ 				[selectorString := selectorString first: (selectorString lastIndexOf: $)) - 1].
+ 			(selectorString beginsWith: 'self') ifTrue:
+ 				[selectorString := selectorString allButFirst: 4].
+ 			selectorString := selectorString extractSelector.
+ 			Message
+ 				selector: selectorString asSymbol
+ 				arguments: (1 to: selectorString numArgs) asArray]) }!

Item was added:
+ ----- Method: CogScripts class>>printTypeFor:on: (in category 'plugin scripts') -----
+ printTypeFor: anArray on: aWriteStream
+ 	| type |
+ 	type := String streamContents:
+ 				[:s|
+ 				anArray
+ 					do: [:ea| [s nextPutAll: ea] on: Error do: [:ex| ^false]]
+ 					separatedBy: [s space]].
+ 	aWriteStream nextPutAll: ' to: '; store: type asSymbol.
+ 	^true!

Item was added:
+ ----- Method: CogScripts class>>processedCCodeCallFor: (in category 'plugin scripts') -----
+ processedCCodeCallFor: aCCodeString
+ 	"Take a cCode: string containing a C call and answer a literal array encoding the parameter
+ 	 list with any casts moved to the back, for ease of generating self cCoerce: thing to: type.
+ 
+ 		'func(a,b)'		=> #(func #(a b))
+ 		'(type)func()'	=> #(func #() #(type))
+ 		'func((type)a)')	=> #(func #(#(a #(type))))) 
+ 	"
+ 	| argVec parameterList |
+ 	argVec := Compiler evaluate: '#(', aCCodeString, ')'.
+ 	[argVec size > 2 and: [argVec last == #';']] whileTrue: [argVec := argVec allButLast].
+ 	argVec last notEmpty ifTrue:
+ 		[parameterList := (argVec last splitBy: #(#,)) collect: [:p| p size > 1 ifTrue: [{p last. p first}] ifFalse: [p first]].
+ 		 argVec at: argVec size put: parameterList].
+ 	^argVec first isArray
+ 		ifTrue: [argVec allButFirst, {argVec first}]
+ 		ifFalse: [argVec]!

Item was added:
+ ----- Method: String>>extractSelector (in category '*Cog-script support') -----
+ extractSelector
+ 	"Dan's code for hunting down selectors with keyword parts; while this doesn't give a true parse,
+ 	 in most cases it does what we want, and where it doesn't, we're none the worse for it.
+ 	 Unlike findSelector this doesn't require that the poutative selector has been interned."
+ 	| sel possibleParens |
+ 	sel := self withBlanksTrimmed.
+ 	(sel includes: $:) ifTrue:
+ 		[sel := sel copyReplaceAll: ':' with: ': '.	"for the style (aa max:bb) with no space"
+ 		sel := sel copyReplaceAll: '[:' with: '[ :'.    "for the style ([:a) with no space"  
+ 		possibleParens := sel findTokens: Character separators.
+ 		sel := self class streamContents:
+ 			[:s | | level |
+ 			level := 0.
+ 			possibleParens do:
+ 				[:token |
+ 				(level = 0 and: [token endsWith: ':'])
+ 					ifTrue: [s nextPutAll: token]
+ 					ifFalse: [level := level
+ 							+ (token occurrencesOf: $() - (token occurrencesOf: $))
+ 							+ (token occurrencesOf: $[) - (token occurrencesOf: $])
+ 							+ (token occurrencesOf: ${) - (token occurrencesOf: $})]]]].
+ 	sel isEmpty ifTrue: [^ nil].
+ 	^sel!



More information about the Vm-dev mailing list