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

commits at source.squeak.org commits at source.squeak.org
Wed Jan 20 01:56:49 UTC 2016


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

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

Name: VMMaker.oscog-eem.1656
Author: eem
Time: 20 January 2016, 5:55:10.847536 pm
UUID: 02086cbf-8db3-4035-9f0d-f2671db50748
Ancestors: VMMaker.oscog-tpr.1655

ARM Cogit:
Fix slip in new 16-bit aware dispatchCOncretize.

Interpreter: Provide an error code for immediate replacement

Slang: Remember to remove the declaration for a local that is introduced for inlining where the inlining uses the parse tree, not the local.  Otherwise, stale declarations can be left that will mistype subsequent inlines of a method with formals of the same name.

Use declatationAt:put:, not direct access to declarations, for debugging.

Don't transform the parse tree/collect new locals etc, when inlining withouty renaming, just to cut down on the garbage.

=============== Diff against VMMaker.oscog-tpr.1655 ===============

Item was changed:
  ----- Method: CogARMCompiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
  	<returnTypeC: #void>
  	conditionOrNil ifNotNil:
  		[self concretizeConditionalInstruction.
  		 ^self].
  		 
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^self concretizeLabel].
  		[Literal]					-> [^self concretizeLiteral].
  		[AlignmentNops]		-> [^self concretizeAlignmentNops].
  		[Fill32]					-> [^self concretizeFill32].
  		[Nop]					-> [^self concretizeNop].
  		"Control"
  		[Call]						-> [^self concretizeCall]. "call code within code space"
  		[CallFull]					-> [^self concretizeCallFull]. "call code anywhere in address space"
  		[JumpR]						-> [^self concretizeJumpR].
  		[JumpFull]					-> [^self concretizeJumpFull]."jump within address space"
  		[JumpLong]					-> [^self concretizeConditionalJump: AL]."jumps witihn code space"
  		[JumpLongZero]			-> [^self concretizeConditionalJump: EQ].
  		[JumpLongNonZero]		-> [^self concretizeConditionalJump: NE].
  		[Jump]						-> [^self concretizeConditionalJump: AL].
  		[JumpZero]					-> [^self concretizeConditionalJump: EQ].
  		[JumpNonZero]				-> [^self concretizeConditionalJump: NE].
  		[JumpNegative]				-> [^self concretizeConditionalJump: MI].
  		[JumpNonNegative]			-> [^self concretizeConditionalJump: PL].
  		[JumpOverflow]				-> [^self concretizeConditionalJump: VS].
  		[JumpNoOverflow]			-> [^self concretizeConditionalJump: VC].
  		[JumpCarry]				-> [^self concretizeConditionalJump: CS].
  		[JumpNoCarry]				-> [^self concretizeConditionalJump: CC].
  		[JumpLess]					-> [^self concretizeConditionalJump: LT].
  		[JumpGreaterOrEqual]		-> [^self concretizeConditionalJump: GE].
  		[JumpGreater]				-> [^self concretizeConditionalJump: GT].
  		[JumpLessOrEqual]			-> [^self concretizeConditionalJump: LE].
  		[JumpBelow]				-> [^self concretizeConditionalJump: CC]. "unsigned lower"
  		[JumpAboveOrEqual]		-> [^self concretizeConditionalJump: CS]. "unsigned greater or equal"
  		[JumpAbove]				-> [^self concretizeConditionalJump: HI].
  		[JumpBelowOrEqual]		-> [^self concretizeConditionalJump: LS].
  		[JumpFPEqual]				-> [^self concretizeFPConditionalJump: EQ].
  		[JumpFPNotEqual]			-> [^self concretizeFPConditionalJump: NE].
  		[JumpFPLess]				-> [^self concretizeFPConditionalJump: LT].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeFPConditionalJump: GE].
  		[JumpFPGreater]			-> [^self concretizeFPConditionalJump: GT].
  		[JumpFPLessOrEqual]		-> [^self concretizeFPConditionalJump: LE].
  		[JumpFPOrdered]			-> [^self concretizeFPConditionalJump: VC].
  		[JumpFPUnordered]			-> [^self concretizeFPConditionalJump: VS].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeNegateableDataOperationCqR: AddOpcode].
  		[AndCqR]					-> [^self concretizeInvertibleDataOperationCqR: AndOpcode].
  		[AndCqRR]					-> [^self concretizeAndCqRR].
  		[CmpCqR]					-> [^self concretizeNegateableDataOperationCqR: CmpOpcode].
  		[OrCqR]						-> [^self concretizeDataOperationCqR: OrOpcode].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[XorCqR]					-> [^self concretizeInvertibleDataOperationCqR: XorOpcode].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: AddOpcode].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: AndOpcode].
  		[CmpCwR]					-> [^self concretizeDataOperationCwR: CmpOpcode].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: OrOpcode].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: SubOpcode].
  		[XorCwR]					-> [^self concretizeDataOperationCwR: XorOpcode].
  		[AddRR]						-> [^self concretizeDataOperationRR: AddOpcode].
  		[AndRR]						-> [^self concretizeDataOperationRR: AndOpcode].
  		[CmpRR]					-> [^self concretizeDataOperationRR: CmpOpcode].
  		[OrRR]						-> [^self concretizeDataOperationRR: OrOpcode].
  		[SubRR]						-> [^self concretizeDataOperationRR: SubOpcode].
  		[XorRR]						-> [^self concretizeDataOperationRR: XorOpcode].
  		[AddRdRd]					-> [^self concretizeAddRdRd].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeDivRdRd].
  		[MulRdRd]					-> [^self concretizeMulRdRd].
  		[SubRdRd]					-> [^self concretizeSubRdRd].
  		[SqrtRd]					-> [^self concretizeSqrtRd].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		"ARM Specific Arithmetic" 
  		[SMULL]			-> [^self concretizeSMULL]	.
  		[CMPSMULL]		-> [^self concretizeCMPSMULL].
  		[MSR]				-> [^self concretizeMSR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveAbR] 			 -> [^self concretizeMoveAbR].
   		[MoveRAb]			-> [^self concretizeMoveRAb].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
+ 		[MoveRM16r]		-> [^self concretizeMoveRM16r].
- 		[MoveRM16r]		-> [^self concretizeMoveRMbr].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveRXbrR]		-> [^self concretizeMoveRXbrR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCq]			-> [^self concretizePushCq].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd]}!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveStringReplace (in category 'indexing primitives') -----
  primitiveStringReplace
  	" 
  	<array> primReplaceFrom: start to: stop with: replacement 
  	startingAt: repStart  
  	<primitive: 105>
  	"
  	| array start stop repl replStart hdr arrayFmt totalLength arrayInstSize replFmt replInstSize srcIndex |
  	array := self stackValue: 4.
  	start := self stackIntegerValue: 3.
  	stop := self stackIntegerValue: 2.
  	repl := self stackValue: 1.
  	replStart := self stackIntegerValue: 0.
  
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	(objectMemory isImmediate: repl) ifTrue: "can happen in LgInt copy"
+ 		[^self primitiveFailFor: PrimErrBadArgument].
- 		[^self primitiveFail].
  	self cppIf: IMMUTABILITY ifTrue:
  			[(objectMemory isImmutable: array) ifTrue:
  				[^self primitiveFailFor: PrimErrNoModification]].
  
  	hdr := objectMemory baseHeader: array.
  	arrayFmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: array baseHeader: hdr format: arrayFmt.
  	arrayInstSize := objectMemory fixedFieldsOf: array format: arrayFmt length: totalLength.
  	(start >= 1 and: [start - 1 <= stop and: [stop + arrayInstSize <= totalLength]]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  
  	hdr := objectMemory baseHeader: repl.
  	replFmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: repl baseHeader: hdr format: replFmt.
  	replInstSize := objectMemory fixedFieldsOf: repl format: replFmt length: totalLength.
  	(replStart >= 1 and: [stop - start + replStart + replInstSize <= totalLength]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  
  	"Still to do: rewrite the below to accomodate short & long access"
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [(arrayFmt between: objectMemory firstShortFormat and: objectMemory firstLongFormat - 1)
  		or: [arrayFmt = objectMemory sixtyFourBitIndexableFormat]]) ifTrue:
  		[^self primitiveFailFor: PrimErrUnsupported].
  
  	"Array formats (without byteSize bits, if bytes array) must be the same"
  	arrayFmt < objectMemory firstByteFormat
  		ifTrue: [arrayFmt = replFmt ifFalse:
  					[^self primitiveFailFor: PrimErrInappropriate]]
  		ifFalse: [(arrayFmt bitAnd: objectMemory byteFormatMask) = (replFmt bitAnd: objectMemory byteFormatMask) ifFalse:
  					[^self primitiveFailFor: PrimErrInappropriate]].
  
  	srcIndex := replStart + replInstSize - 1.
  	"- 1 for 0-based access"
  
  	arrayFmt <= objectMemory lastPointerFormat
  		ifTrue:
  			[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
  				[:i |
  				objectMemory storePointer: i ofObject: array withValue: (objectMemory fetchPointer: srcIndex ofObject: repl).
  				srcIndex := srcIndex + 1]]
  		ifFalse:
  			[arrayFmt < objectMemory firstByteFormat
  				ifTrue: "32-bit-word type objects"
  					[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
  						[:i |
  						objectMemory storeLong32: i ofObject: array withValue: (objectMemory fetchLong32: srcIndex ofObject: repl).
  						srcIndex := srcIndex + 1]]
  				ifFalse: "byte-type objects"
  					[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
  						[:i |
  						objectMemory storeByte: i ofObject: array withValue: (objectMemory fetchByte: srcIndex ofObject: repl).
  						srcIndex := srcIndex + 1]]].
  	"We might consider comparing stop - start to some value here and using forceInterruptCheck"
  
  	self pop: argumentCount "leave rcvr on stack"!

Item was changed:
  ----- Method: TMethod>>argAssignmentsFor:send:in: (in category 'inlining') -----
  argAssignmentsFor: meth send: aSendNode in: aCodeGen
  	"Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method."
  	"Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals."
  
  	| stmtList substitutionDict argList |
  	meth args size > (argList := aSendNode args) size ifTrue:
  		[self assert: (meth args first beginsWith: 'self_in_').
  		 argList := {aSendNode receiver}, aSendNode args].
  	
  	stmtList := OrderedCollection new: argList size.
  	substitutionDict := Dictionary new: argList size.
  	meth args with: argList do:
+ 		[:argName :exprNode |
- 		[ :argName :exprNode |
  		(self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
  			ifTrue:
  				[substitutionDict
  					at: argName
  					put: (aCodeGen
  							node: exprNode
  							typeCompatibleWith: argName
  							inliningInto: meth
  							in: self).
+ 				 locals remove: argName.
+ 				declarations removeKey: argName ifAbsent: nil]
- 				 locals remove: argName]
  			ifFalse:
  				[stmtList addLast:
  					(TAssignmentNode new
  						setVariable: (TVariableNode new setName: argName)
  						expression: (aCodeGen
  										node: exprNode copy
  										typeCompatibleWith: argName
  										inliningInto: meth
  										in: self))]].
  	meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
  	^stmtList!

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
  	 This for debugging:
  		(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
  	| alreadyExplicitlyTyped effectiveNodes |
  	aCodeGen maybeBreakForTestToInline: selector in: self.
  	alreadyExplicitlyTyped := 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: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by inferred unsigned types"
  		 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:
+ 			[self declarationAt: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var.
- 			[declarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var.
  			 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.
  		 Only observe known sends (methods in the current set) and typed local variables."
  		(node isAssignment
  		 and: [(locals includes: (var := node variable name))
  		 and: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by previously inferred types"
  		 and: [(type := node expression isSend
  						ifTrue: [aCodeGen returnTypeOrNilForSend: node expression in: self]
  						ifFalse: [self typeFor: node expression in: aCodeGen]) notNil
  		 and: [aCodeGen isSimpleType: type]]]]) ifTrue:
  			[aCodeGen mergeTypeOf: var in: declarations with: type method: self.
  			 effectiveNodes at: var put: { declarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]].
  	^effectiveNodes!

Item was changed:
  ----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') -----
  inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen
  	"Answer a collection of statements to replace the given send.  directReturn indicates
  	 that the send is the expression in a return statement, so returns can be left in the
  	 body of the inlined method. If exitVar is nil, the value returned by the send is not
  	 used; thus, returns need not assign to the output variable.
  
  	 Types are propagated to as-yet-untyped variables when inlining a send that is assigned,
  	 otherwise the assignee variable type must match the return type of the inlinee.  Return
  	 types are not propagated."
  
  	| sel meth methArgs exitLabel inlineStmts label exitType |
  	sel := aSendNode selector.
  	meth := aCodeGen methodNamed: sel.
  	methArgs := meth args.
  	"convenient for debugging..."
  	aCodeGen maybeBreakForInlineOf: aSendNode in: self.
  	(methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue:
  		[methArgs := methArgs allButFirst].
  	methArgs size = aSendNode args size ifFalse:
  		[^nil].
  	meth := meth copy.
  
  	"Propagate the return type of an inlined method"
  	(directReturn or: [exitVar notNil]) ifTrue:
  		[exitType := directReturn 
  						ifTrue: [returnType] 
  						ifFalse: [(self typeFor: exitVar in: aCodeGen) ifNil: [#sqInt]].
  		(exitType = #void or: [exitType = meth returnType]) ifFalse:
  			[meth propagateReturnIn: aCodeGen]].
  
  	"Propagate any unusual argument types to untyped argument variables"
  	methArgs
  		with: aSendNode args
  		do: [:formal :actual|
  			(meth declarationAt: formal ifAbsent: nil) ifNil:
  				[(self typeFor: actual in: aCodeGen) ifNotNil:
  					[:type|
  					type ~= #sqInt ifTrue:
+ 						[meth declarationAt: formal put: (type last = $* ifTrue: [type, formal] ifFalse: [type, ' ', formal])]]]].
- 						[meth declarationAt: formal put: type, ' ', formal]]]].
  
  	meth renameVarsForInliningInto: self except: #() in: aCodeGen.
  	meth renameLabelsForInliningInto: self.
  	self addVarsDeclarationsAndLabelsOf: meth except: #().
  	meth hasReturn ifTrue:
  		[directReturn ifFalse:
  			[exitLabel := self unusedLabelForInliningInto: self.
  			 (meth exitVar: exitVar label: exitLabel) "is label used?"
  				ifTrue: [ labels add: exitLabel ]
  				ifFalse: [ exitLabel := nil ]]].
  	(inlineStmts := OrderedCollection new: 100)
  		add: (label := TLabeledCommentNode new setComment: 'begin ', sel);
  		addAll: (self argAssignmentsFor: meth send: aSendNode in: aCodeGen);
  		addAll: meth statements.  "method body"
  	(directReturn
  	 and: [meth endsWithReturn not]) ifTrue:
  		[inlineStmts add:
  			(TReturnNode new setExpression: (TVariableNode new setName: 'nil'))].
  	exitLabel ~= nil ifTrue:
  		[inlineStmts add:
  			(TLabeledCommentNode new setLabel:
  				exitLabel comment: 'end ', meth selector)].
  	^inlineStmts!

Item was changed:
  ----- Method: TMethod>>newCascadeTempFor: (in category 'initialization') -----
  newCascadeTempFor: aTParseNode
  	| varName varNode |
  	varName := self extraVariableName: 'cascade'.
  	varNode := TVariableNode new setName: varName.
  	aTParseNode isLeaf ifFalse:
+ 		[self
+ 			declarationAt: varName
- 		[declarations
- 			at: varName
  			put: [:tm :cg| | type |
  				type := tm determineTypeFor: aTParseNode in: cg.
  				(VMStructType structTargetKindForType: type) == #struct ifTrue:
  					["can't copy structs into cascade temps; the struct is not updated.
  					  must change to a pointer."
  					type := type, ' *'.
  					parseTree nodesDo:
  						[:node|
  						(node isAssignment
  						 and: [node variable name = varName]) ifTrue:
  							[node setExpression: (TSendNode new
  													setSelector: #addressOf:
  													receiver: (TVariableNode new setName: 'self')
  													arguments: {node expression})]]].
  				type]].
  	^varNode!

Item was changed:
  ----- Method: TMethod>>renameLabelsUsing: (in category 'inlining support') -----
  renameLabelsUsing: aDictionary
  	"Rename all labels according to the old->new mappings of the given dictionary."
  
+ 	aDictionary isEmpty ifTrue:
+ 		[^self].
+ 	labels := labels collect: [ :label | aDictionary at: label ifAbsent: [label]].
- 	labels := labels collect: [ :label |
- 		(aDictionary includesKey: label) ifTrue: [ aDictionary at: label ] ifFalse: [ label ].
- 	].
  
+ 	parseTree nodesDo:
+ 		[ :node |
+ 		(node isGoTo and: [aDictionary includesKey: node label]) ifTrue:
+ 			[node setLabel: (aDictionary at: node label)].
+ 		(node isLabel and: [aDictionary includesKey: node label]) ifTrue:
+ 			[node setLabel: (aDictionary at: node label)]]!
- 	parseTree nodesDo: [ :node |
- 		(node isGoTo and: [aDictionary includesKey: node label]) ifTrue: [
- 			node setLabel: (aDictionary at: node label).
- 		].
- 		(node isLabel and: [aDictionary includesKey: node label]) ifTrue: [
- 			node setLabel: (aDictionary at: node label).
- 		].
- 	].!

Item was changed:
  ----- Method: TMethod>>renameVariablesUsing: (in category 'inlining support') -----
  renameVariablesUsing: aDictionary
  	"Rename all variables according to old->new mappings of the given dictionary."
  
  	| newDecls newProperties |
+ 	aDictionary isEmpty ifTrue: [^self].
+ 
  	"map args and locals"
  	args := args collect: [ :arg | aDictionary at: arg ifAbsent: [ arg ]].
  	locals := locals collect: [ :v | aDictionary at: v ifAbsent: [ v ]].
  
  	"map declarations"
  	newDecls := declarations species new.
  	declarations keysAndValuesDo:
  		[:oldName :decl|
  		(aDictionary at: oldName ifAbsent: nil)
  			ifNotNil:
  				[:newName| | index |
  				index := decl indexOfWord: oldName.
  				 newDecls
  					at: newName
  					put: (index ~= 0
  							ifTrue: [decl copyReplaceFrom: index to: index + oldName size - 1 with: newName]
  							ifFalse: [decl])]
  			ifNil: [newDecls at: oldName put: decl]].
  	self newDeclarations: newDecls.
  
  	newProperties := properties copy.
  	newProperties pragmas do:
  		[:pragma| | mappedArgs |
  		mappedArgs := pragma arguments collect: [:arg| arg isString ifTrue: [aDictionary at: arg ifAbsent: arg] ifFalse: [arg]].
  		mappedArgs ~= pragma arguments ifTrue:
  			[pragma setArguments: mappedArgs]].
  	self properties: newProperties.
  
  	"map variable names in parse tree"
  	parseTree nodesDo:
  		[ :node |
  		(node isVariable
  		and: [aDictionary includesKey: node name]) ifTrue:
  			[node setName: (aDictionary at: node name)].
  		(node isStmtList and: [node args size > 0]) ifTrue:
  			[node setArguments: (node args collect: [ :arg | aDictionary at: arg ifAbsent: [ arg ]])]]!



More information about the Vm-dev mailing list