David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.338.mcz
==================== Summary ====================
Name: VMMaker-dtl.338 Author: dtl Time: 20 January 2014, 7:13:23.86 pm UUID: 29946156-9015-45c9-83a2-c12d43f67ece Ancestors: VMMaker-dtl.337
VMMaker 4.12.14
C translation updates from oscog required for case statement code generation, e.g. shorten:toIndexableSize code generation.
Add shorten:toIndexableSize from oscog, presumed working for NewObjectMemory but not verified for ClassicObjectMemory
=============== Diff against VMMaker-dtl.337 ===============
Item was added: + ----- Method: BlockNode>>isPotentialCCaseLabel:in: (in category '*VMMaker-C translation') ----- + isPotentialCCaseLabel: stmt in: aTMethod + (stmt isVariableNode + or: [stmt isLiteralNode + and: [stmt isConstantNumber or: [stmt literalValue isSymbol]]]) ifTrue: + [^true]. + stmt isMessageNode ifTrue: + [| selector method | + selector := stmt selector key. + (#(* + -) includes: selector) ifTrue: + [^(self isPotentialCCaseLabel: stmt receiver in: aTMethod) + and: [self isPotentialCCaseLabel: stmt arguments first in: aTMethod]]. + + (selector = #asSymbol + and: [stmt receiver isLiteralNode + and: [stmt receiver literalValue isSymbol]]) ifTrue: + [^true]. + + (stmt arguments isEmpty + and: [method := (aTMethod definingClass whichClassIncludesSelector: selector) >> selector. + (method isQuick + or: [(method literalAt: 1) isInteger + and: [method numLiterals = 3]]) + and: [(aTMethod definingClass basicNew perform: selector) isInteger]]) ifTrue: + [^true]]. + ^false!
Item was added: + ----- Method: BlockNode>>isPotentialCCaseLabelIn: (in category '*VMMaker-C translation') ----- + isPotentialCCaseLabelIn: aTMethod + | stmt | + statements size ~= 1 ifTrue: [^false]. + stmt := statements first. + ^self isPotentialCCaseLabel: stmt in: aTMethod!
Item was added: + ----- Method: BraceNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') ----- + asTranslatorNodeIn: aTMethod + "make a CCodeGenerator equivalent of me" + self assert: (elements allSatisfy: + [:elem| + elem isMessageNode + and: [elem selector key = #-> + and: [elem receiver isBlockNode + and: [elem arguments first isBlockNode + and: [elem receiver isPotentialCCaseLabelIn: aTMethod]]]]]). + ^TBraceCaseNode new + caseLabels: (elements collect: [:elem| elem receiver asTranslatorNodeIn: aTMethod]); + cases: (elements collect: [:elem| elem arguments first asTranslatorNodeIn: aTMethod]); + comment: comment!
Item was added: + ----- Method: CCodeGenerator>>isBuiltinSelector: (in category 'utilities') ----- + isBuiltinSelector: sel + "Answer true if the given selector is one of the builtin selectors." + + ^(self isKernelSelector: sel) or: [translationDict includesKey: sel]!
Item was added: + ----- Method: CCodeGenerator>>isKernelSelector: (in category 'utilities') ----- + isKernelSelector: sel + "Answer true if the given selector is one of the kernel selectors that are implemented as macros." + + ^(#(error: + oopAt: oopAt:put: oopAtPointer: oopAtPointer:put: + byteAt: byteAt:put: byteAtPointer: byteAtPointer:put: + shortAt: shortAt:put: shortAtPointer: shortAtPointer:put: + intAt: intAt:put: intAtPointer: intAtPointer:put: + longAt: longAt:put: longAtPointer: longAtPointer:put: + longLongAt: longLongAt:put: longLongAtPointer: longLongAtPointer:put: + fetchFloatAt:into: storeFloatAt:from: + fetchFloatAtPointer:into: storeFloatAtPointer:from: + fetchSingleFloatAt:into: storeSingleFloatAt:from: + fetchSingleFloatAtPointer:into: storeSingleFloatAtPointer:from: + pointerForOop: oopForPointer: + cCoerce:to: cCoerceSimple:to:) + includes: sel)!
Item was added: + ----- Method: ClassicObjectMemory>>shorten:toIndexableSize: (in category 'allocation') ----- + shorten: obj toIndexableSize: nSlots + "Currently this works for pointer objects only, and is almost certainly wrong for 64 bits." + | deltaBytes desiredLength fixedFields fmt hdr totalLength | + (self isPointersNonInt: obj) ifFalse: + [^obj]. + hdr := self baseHeader: obj. + fmt := self formatOfHeader: hdr. + totalLength := self lengthOf: obj baseHeader: hdr format: fmt. + fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength. + + self cCode: ' printf("fixedFields is %d\n", fixedFields); fflush(stdout) '. + self cCode: ' printf("nSlots is %d\n", nSlots); fflush(stdout) '. + + desiredLength := fixedFields + nSlots. + deltaBytes := (totalLength - desiredLength) * self bytesPerWord. + + self cCode: ' printf("desiredLength is %d\n", desiredLength); fflush(stdout) '. + self cCode: ' printf("deltaBytes is %d\n", deltaBytes); fflush(stdout) '. + + self setSizeOfFree: obj + self baseHeaderSize + (desiredLength * self bytesPerWord) + to: deltaBytes. + (self headerType: obj) caseOf: { + [HeaderTypeSizeAndClass] -> + [ + self cCode: ' printf("HeaderTypeSizeAndClass\n"); fflush(stdout) '. + + self longAt: obj put: hdr - deltaBytes]. + [HeaderTypeClass] -> + [ + self cCode: ' printf("HeaderTypeClass\n"); fflush(stdout) '. + + self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)]. + [HeaderTypeShort] -> + [ + self cCode: ' printf("HeaderTypeShort\n"); fflush(stdout) '. + + self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)] }. + ^obj!
Item was added: + ----- Method: NewObjectMemory>>shorten:toIndexableSize: (in category 'allocation') ----- + shorten: obj toIndexableSize: nSlots + "Currently this works for pointer objects only, and is almost certainly wrong for 64 bits." + | deltaBytes desiredLength fixedFields fmt hdr totalLength | + (self isPointersNonImm: obj) ifFalse: + [^obj]. + hdr := self baseHeader: obj. + fmt := self formatOfHeader: hdr. + totalLength := self lengthOf: obj baseHeader: hdr format: fmt. + fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength. + desiredLength := fixedFields + nSlots. + deltaBytes := (totalLength - desiredLength) * self bytesPerWord. + obj + self baseHeaderSize + (totalLength * self bytesPerWord) = freeStart + ifTrue: "Shortening the last object. Need to reduce freeStart." + [self maybeFillWithAllocationCheckFillerFrom: obj + self baseHeaderSize + (desiredLength * self bytesPerWord) to: freeStart. + freeStart := obj + self baseHeaderSize + (desiredLength * self bytesPerWord)] + ifFalse: "Shortening some interior object. Need to create a free block." + [self setSizeOfFree: obj + self baseHeaderSize + (desiredLength * self bytesPerWord) + to: deltaBytes]. + (self headerType: obj) caseOf: { + [HeaderTypeSizeAndClass] -> + [self longAt: obj put: hdr - deltaBytes]. + [HeaderTypeClass] -> + [self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)]. + [HeaderTypeShort] -> + [self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)] }. + ^obj!
Item was added: + ----- Method: ObjectMemory>>shorten:toIndexableSize: (in category 'allocation') ----- + shorten: obj toIndexableSize: nSlots + "Shorten the length of a pointer object to nSlots, marking free memory and adjusting + end of memory as required." + + self subclassResponsibility!
Item was added: + ----- Method: TAssignmentNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + variable nodesDo: aBlock parent: self. + expression nodesDo: aBlock parent: self. + aBlock value: self value: parent!
Item was added: + ----- Method: TAssignmentNode>>structTargetKindIn: (in category 'testing') ----- + structTargetKindIn: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^variable structTargetKindIn: aCodeGen!
Item was added: + TParseNode subclass: #TBraceCaseNode + instanceVariableNames: 'caseLabels cases' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Translation to C'!
Item was added: + ----- Method: TBraceCaseNode>>bindVariableUsesIn: (in category 'transformations') ----- + bindVariableUsesIn: aDictionary + + caseLabels := caseLabels collect: [:node| node bindVariableUsesIn: aDictionary]. + cases := cases collect: [:node| node bindVariableUsesIn: aDictionary]!
Item was added: + ----- Method: TBraceCaseNode>>bindVariableUsesIn:andConstantFoldIf:in: (in category 'transformations') ----- + bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen + "Answer either the receiver, if it contains no references to the given variables, or a new node with the given variables rebound." + | newCaseLabels newCases | + newCaseLabels := caseLabels collect: [:node| node bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen]. + newCases := cases collect: [:node| node bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen]. + ^(newCaseLabels = caseLabels + and: [newCases = cases]) + ifTrue: [self] + ifFalse: [self shallowCopy + caseLabels: newCaseLabels; + cases: newCases; + yourself]!
Item was added: + ----- Method: TBraceCaseNode>>bindVariablesIn: (in category 'transformations') ----- + bindVariablesIn: aDictionary + + caseLabels := caseLabels collect: [:node| node bindVariablesIn: aDictionary]. + cases := cases collect: [:node| node bindVariablesIn: aDictionary]!
Item was added: + ----- Method: TBraceCaseNode>>caseLabels (in category 'accessing') ----- + caseLabels + "Answer the value of caseLabels" + + ^ caseLabels!
Item was added: + ----- Method: TBraceCaseNode>>caseLabels: (in category 'accessing') ----- + caseLabels: anObject + "Set the value of caseLabels" + + caseLabels := anObject!
Item was added: + ----- Method: TBraceCaseNode>>cases (in category 'accessing') ----- + cases + "Answer the value of cases" + + ^ cases!
Item was added: + ----- Method: TBraceCaseNode>>cases: (in category 'accessing') ----- + cases: anObject + "Set the value of cases" + + cases := anObject!
Item was added: + ----- Method: TBraceCaseNode>>copyTree (in category 'copying') ----- + copyTree + + self flag: #FIXME. "adopt from oscog - get rid of copyTree, use postCopy instead" + ^self copy + !
Item was added: + ----- Method: TBraceCaseNode>>nodesDo: (in category 'enumerating') ----- + nodesDo: aBlock + "Apply aBlock to all nodes in the receiver. + N.B. This is assumed to be bottom-up, leaves first." + caseLabels do: + [:node| node nodesDo: aBlock]. + cases do: + [:node| node nodesDo: aBlock]. + aBlock value: self!
Item was added: + ----- Method: TBraceCaseNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + caseLabels do: + [:node| node nodesDo: aBlock parent: self.]. + cases do: + [:node| node nodesDo: aBlock parent: self]. + aBlock value: self value: parent!
Item was added: + ----- Method: TBraceCaseNode>>nodesDo:unless: (in category 'enumerating') ----- + nodesDo: aBlock unless: cautionaryBlock + + (cautionaryBlock value: self) ifTrue: [^self]. + caseLabels do: + [:node| node nodesDo: aBlock unless: cautionaryBlock]. + cases do: + [:node| node nodesDo: aBlock unless: cautionaryBlock]. + aBlock value: self!
Item was added: + ----- Method: TBraceCaseNode>>replaceNodesIn: (in category 'enumerating') ----- + replaceNodesIn: aDictionary + + ^aDictionary at: self ifAbsent: [ + caseLabels := caseLabels collect: [:node| node replaceNodesIn: aDictionary]. + cases := cases collect: [:node| node replaceNodesIn: aDictionary]. + self]!
Item was added: + ----- Method: TCaseStmtNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + expression nodesDo: aBlock parent: self. + cases do: [:c| c nodesDo: aBlock parent: self]. + aBlock value: self value: parent!
Item was added: + ----- Method: TConstantNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + aBlock value: self value: parent!
Item was added: + ----- Method: TGoToNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + aBlock value: self value: parent!
Item was added: + ----- Method: TLabeledCommentNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + aBlock value: self value: parent!
Item was changed: Object subclass: #TMethod + instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels possibleSideEffectsCache complete export static sharedLabel sharedCase comment definingClass globalStructureBuildMethodHasFoo canAsmLabel mustAsmLabel properties cascadeVariableNumber extraVariableNumber' - instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels possibleSideEffectsCache complete export static sharedLabel sharedCase comment definingClass globalStructureBuildMethodHasFoo canAsmLabel mustAsmLabel properties cascadeVariableNumber' classVariableNames: 'CaseStatements' poolDictionaries: '' category: 'VMMaker-Translation to C'!
!TMethod commentStamp: 'dtl 9/15/2008 09:06' prior: 0! A TMethod is a translation method, representing a MethodNode that is to be translated to C source. It has a parseTree of translation nodes that mirrors the parse tree of the corresponding Smalltalk method.!
Item was added: + ----- Method: TMethod>>buildSwitchStmt:parent: (in category 'transformations') ----- + buildSwitchStmt: aSendNode parent: parentNode + "Build a switch statement node for the given send of caseOf: or caseOf:otherwise:." + | switch | + switch := TSwitchStmtNode new + expression: aSendNode receiver + cases: aSendNode args first + otherwiseOrNil: (aSendNode args at: 2 ifAbsent: [nil]). + (aSendNode receiver isVariable or: [parentNode isStmtList]) ifFalse: + [switch switchVariable: (locals add: (self extraVariableName: 'switch'))]. + ^switch!
Item was changed: + ----- Method: TMethod>>endsWithReturn (in category 'testing') ----- - ----- Method: TMethod>>endsWithReturn (in category 'inlining support') ----- endsWithReturn "Answer true if the last statement of this method is a return."
+ ^parseTree endsWithReturn! - ^ parseTree statements last isReturn!
Item was added: + ----- Method: TMethod>>isStructAccessor (in category 'testing') ----- + isStructAccessor + ^[definingClass isAccessor: selector] + on: MessageNotUnderstood + do: [:ex| false]!
Item was changed: ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') ----- prepareMethodIn: aCodeGen "Record sends of builtin operators, map sends of the special selector dispatchOn:in: with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements. - Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:]. - These must be top-level statements; they cannot appear in expressions. As a hack also update the types of variables introduced to implement cascades correctly. + This has to be done at the same time as this is done, so why not piggy back here?" + extraVariableNumber ifNotNil: - This has to be done at teh same time as this is done, so why not piggy back here?" - | replacements |. - cascadeVariableNumber ifNotNil: [declarations keysAndValuesDo: [:varName :decl| decl isBlock ifTrue: [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]). locals add: varName. self declarationAt: varName put: (decl value: self value: aCodeGen), ' ', varName]]]. - replacements := IdentityDictionary new. aCodeGen pushScope: declarations + while:"N.B. nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved." + [parseTree nodesWithParentsDo: + [:node :parent| - while: - [parseTree nodesDo: - [:node| node isSend ifTrue: + [(aCodeGen isBuiltinSelector: node selector) - [(aCodeGen builtin: node selector) ifTrue: [node isBuiltinOperator: true. "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args" (node selector = #to:by:do: and: [node args size = 4]) ifTrue: [| limitExpr | limitExpr := node args first. (limitExpr anySatisfy: [:subNode| subNode isSend + and: [(aCodeGen isBuiltinSelector: subNode selector) not + and: [(subNode isStructSendIn: aCodeGen) not]]]) - and: [(aCodeGen builtin: subNode selector) not - and: [(subNode isStructSend: aCodeGen) not]]]) ifTrue: [ | limitVar | limitVar := node args last name. "n.b. Two loops in the same method may share the same variable for loop limit, so add the variable declaration only if not already declared by a previous loop. Assumes that the name of the loop limit variable (e.g. 'iLimiT') is unlikely to have been used as an actual instance variable elsewhere." (locals includes: limitVar) ifFalse: [locals add: limitVar]] ifFalse: [node arguments: node args allButLast]]] ifFalse: [(CaseStatements includes: node selector) ifTrue: + [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node})]. - [replacements at: node put: (self buildCaseStmt: node)]. (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: + [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })]]]]]! - [replacements at: node put: (self buildSwitchStmt: node)]]]. - ((node isAssignment or: [node isReturn]) - and: [node expression isSwitch]) ifTrue: - [replacements at: node put: (self transformSwitchExpression: node)]]]. - replacements isEmpty ifFalse: - [parseTree := parseTree replaceNodesIn: replacements]!
Item was added: + ----- Method: TParseNode>>endsWithReturn (in category 'testing') ----- + endsWithReturn + + ^false!
Item was added: + ----- Method: TParseNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + self subclassResponsibility!
Item was added: + ----- Method: TParseNode>>nodesWithParentsDo: (in category 'enumerating') ----- + nodesWithParentsDo: aBlock + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + self nodesDo: aBlock parent: nil!
Item was added: + ----- Method: TParseNode>>structTargetKindIn: (in category 'testing') ----- + structTargetKindIn: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^nil!
Item was added: + ----- Method: TReturnNode>>endsWithReturn (in category 'testing') ----- + endsWithReturn + + ^true!
Item was added: + ----- Method: TReturnNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + expression nodesDo: aBlock parent: self. + aBlock value: self value: parent!
Item was added: + ----- Method: TSendNode>>endsWithReturn (in category 'testing') ----- + endsWithReturn + ^self isReturningIf!
Item was added: + ----- Method: TSendNode>>isStructSendIn: (in category 'testing') ----- + isStructSendIn: aCodeGen + "Answer if the recever is a send of a structure accessor. + This is tricky. We want + foo bar => foo->bar + foo bar => foo.bar + foo bar: expr => foo->bar = expr + foo bar: expr => foo.bar = expr + depending on whether foo is a struct or a pointer to a struct, + but only if both foo is a struct type and bar is a field accessor. + The tricky cases are self-sends within struct class methods. Here we need to + distinguish between self-sends of ordinary methods from self sends of accessors." + ^arguments size <= 1 + and: [(receiver structTargetKindIn: aCodeGen) notNil + and: [(aCodeGen methodNamed: selector) + ifNil: [false] + ifNotNil: [:method| method isStructAccessor]]]!
Item was added: + ----- Method: TSendNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + receiver nodesDo: aBlock parent: self. + arguments do: [:arg| arg nodesDo: aBlock parent: self]. + aBlock value: self value: parent!
Item was added: + ----- Method: TSendNode>>structTargetKindIn: (in category 'testing') ----- + structTargetKindIn: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil. Right now we don't need or support + structure return so this method answers either #pointer or nil." + selector == #cCoerceSimple:to: ifTrue: + [^(VMStructType isTypePointerToStruct: arguments last value) ifTrue: + [#pointer]]. + + selector == #addressOf: ifTrue: + [^#pointer]. + + selector == #at: ifTrue: + [receiver isVariable ifTrue: + [(aCodeGen typeOfVariable: receiver name) ifNotNil: + [:type| | derefType | + type last = $* ifFalse: + [^receiver structTargetKindIn: aCodeGen]. + (VMStructType isTypeStruct: (aCodeGen + extractTypeFor: receiver name + fromDeclaration: type allButLast)) ifTrue: + [^#struct]]]. + (receiver structTargetKindIn: aCodeGen) ifNotNil: + [:kind| ^kind]]. + + (aCodeGen selectorReturnsPointerToStruct: selector) ifTrue: + [^#pointer]. + + (aCodeGen selectorReturnsStruct: selector) ifTrue: + [^#struct]. + + ^nil!
Item was added: + ----- Method: TStmtListNode>>endsWithReturn (in category 'testing') ----- + endsWithReturn + "Answer true if the last statement of this lock is a return." + + ^statements last isReturn or: [statements last isReturningIf]!
Item was added: + ----- Method: TStmtListNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + statements do: [:s| s nodesDo: aBlock parent: self]. + aBlock value: self value: parent!
Item was added: + TParseNode subclass: #TSwitchStmtNode + instanceVariableNames: 'expression cases otherwiseOrNil switchVariable' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Translation to C'! + + !TSwitchStmtNode commentStamp: '<historical>' prior: 0! + I implement a Smalltalk + foo caseOf: { [IntegerConstant | GlobalVariable] -> [expr] } + statement converting it into a C switch statement. I make some effort to discover identical right-hand-side cases.!
Item was added: + ----- Method: TSwitchStmtNode>>bindVariableUsesIn: (in category 'transformations') ----- + bindVariableUsesIn: aDictionary + expression := expression bindVariableUsesIn: aDictionary. + cases := (cases collect: + [:pair| "<Array with: <Array with: ParseTreeNode> with: TStmtListNode" + { pair first collect: [:labelNode| labelNode bindVariableUsesIn: aDictionary]. + pair last bindVariableUsesIn: aDictionary }]). + otherwiseOrNil ifNotNil: + [otherwiseOrNil := otherwiseOrNil bindVariableUsesIn: aDictionary]!
Item was added: + ----- Method: TSwitchStmtNode>>bindVariableUsesIn:andConstantFoldIf:in: (in category 'transformations') ----- + bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen + "Answer either the receiver, if it contains no references to the given variables, or a new node with the given variables rebound." + | newExpression newCases newOtherwise | + newExpression := expression bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen. + newCases := cases collect: + [:pair| "<Array with: <Array with: ParseTreeNode> with: TStmtListNode" + { pair first collect: [:labelNode| labelNode bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen]. + pair last bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen}]. + newOtherwise := otherwiseOrNil ifNotNil: + [otherwiseOrNil bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen]. + ^(newExpression = expression + and: [newCases = cases + and: [newOtherwise = otherwiseOrNil]]) + ifTrue: [self] + ifFalse: + [self shallowCopy + expression: newExpression; + cases: newCases; + otherwiseOrNil: newOtherwise; + yourself]!
Item was added: + ----- Method: TSwitchStmtNode>>bindVariablesIn: (in category 'transformations') ----- + bindVariablesIn: aDictionary + expression := expression bindVariablesIn: aDictionary. + cases := (cases collect: + [:pair| "<Array with: <Array with: ParseTreeNode> with: TStmtListNode" + { pair first collect: [:labelNode| labelNode bindVariablesIn: aDictionary]. + pair last bindVariablesIn: aDictionary }]). + otherwiseOrNil ifNotNil: + [otherwiseOrNil := otherwiseOrNil bindVariablesIn: aDictionary]!
Item was added: + ----- Method: TSwitchStmtNode>>cases (in category 'accessing') ----- + cases + "Answer the value of cases" + + ^ cases!
Item was added: + ----- Method: TSwitchStmtNode>>cases: (in category 'accessing') ----- + cases: anObject + "Set the value of cases" + + cases := anObject!
Item was added: + ----- Method: TSwitchStmtNode>>copyTree (in category 'copying') ----- + copyTree + + self flag: #FIXME. "adopt from oscog - get rid of copyTree, use postCopy instead" + ^self copy + !
Item was added: + ----- Method: TSwitchStmtNode>>createCasesFromBraceNode: (in category 'instance initialization') ----- + createCasesFromBraceNode: aTBraceNode + | casesToStrings stringsToLabels newCases | + casesToStrings := Dictionary new. + stringsToLabels := Dictionary new. + newCases := OrderedCollection new: aTBraceNode caseLabels size. + aTBraceNode caseLabels with: aTBraceNode cases do: + [:label :case| | printString | + printString := casesToStrings at: case put: case printString. + (stringsToLabels at: printString ifAbsentPut: [OrderedCollection new]) addLast: label]. + + aTBraceNode caseLabels with: aTBraceNode cases do: + [:label :case| | printString labels | + printString := casesToStrings at: case. + label = (labels := (stringsToLabels at: printString) asArray) first ifTrue: + [newCases addLast: { labels collect: [:ea| ea statements first]. case}]]. + + ^newCases!
Item was added: + ----- Method: TSwitchStmtNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') ----- + emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen + "Emit the receiver as an if-the-else chain." + | varName n | + self assert: (expression isVariable or: [switchVariable notNil]). + aStream nextPut: $(. + switchVariable + ifNil: [varName := String streamContents: [:s| expression emitCCodeOn: s level: 0 generator: aCodeGen]. + aStream nextPutAll: varName] + ifNotNil: + [varName := switchVariable. + aStream nextPut: $(; nextPutAll: varName; nextPutAll: ' = '. + expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen. + aStream nextPut: $)]. + n := 0. + cases do: + [:tuple| + [:labels :case| + labels do: + [:label| + n > 0 ifTrue: + [aStream nextPutAll: varName]. + aStream nextPutAll: ' == '. + label emitCCodeAsArgumentOn: aStream level: level + 1 generator: aCodeGen. + aStream nextPut: $). + aStream crtab: level + n + 1. + aStream nextPutAll: '? ('. + (TStmtListNode new setArguments: #() statements: case statements) + emitCCodeAsArgumentOn: aStream + level: level + 2 + generator: aCodeGen. + aStream nextPut: $); crtab: level + n + 1; nextPutAll: ': ('. + n := n + 1]] + valueWithArguments: tuple]. + otherwiseOrNil + ifNotNil: [otherwiseOrNil emitCCodeAsArgumentOn: aStream level: level + 1 generator: aCodeGen] + ifNil: [aStream nextPutAll: 'error("Case not found and no otherwise clause"), 0']. + aStream next: n - 1 put: $)!
Item was added: + ----- Method: TSwitchStmtNode>>emitCCodeOn:addToEndOfCases:level:generator: (in category 'C code generation') ----- + emitCCodeOn: aStream addToEndOfCases: aNodeOrNil level: level generator: aCodeGen + + aStream crtab: level. + aStream nextPutAll: 'switch ('. + expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen. + aStream nextPutAll: ') {'. + cases do: + [:tuple| + [:labels :case| + labels do: + [:label| + aStream + crtab: level; + nextPutAll: 'case '. + label emitCCodeAsArgumentOn: aStream level: level + 1 generator: aCodeGen. + aStream nextPut: $:]. + aStream crtab: level + 1. + case emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level + 1 generator: aCodeGen] + valueWithArguments: tuple. + (aNodeOrNil notNil and: [aNodeOrNil isReturn]) ifFalse: + [aStream crtab: level + 1; nextPutAll: 'break;']]. + aStream + crtab: level; + nextPutAll: 'default:'; + crtab: level + 1. + otherwiseOrNil + ifNotNil: [otherwiseOrNil emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level + 1 generator: aCodeGen] + ifNil: [aStream nextPutAll: 'error("Case not found and no otherwise clause");'. + aNodeOrNil ifNotNil: + [aStream crtab: level + 1. + (aNodeOrNil copy setExpression: (TConstantNode new setValue: -1)) + emitCCodeOn: aStream level: level generator: aCodeGen. + aStream nextPut: $;]]. + aStream + crtab: level; + nextPut: $}!
Item was added: + ----- Method: TSwitchStmtNode>>emitCCodeOn:level:generator: (in category 'C code generation') ----- + emitCCodeOn: aStream level: level generator: aCodeGen + + aStream crtab: level. + aStream nextPutAll: 'switch ('. + expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen. + aStream nextPutAll: ') {'. + cases do: + [:tuple| + [:labels :case| + labels do: + [:label| + aStream + crtab: level; + nextPutAll: 'case '. + label emitCCodeAsArgumentOn: aStream level: level + 1 generator: aCodeGen. + aStream nextPut: $:]. + aStream crtab: level + 1. + case emitCCodeOn: aStream level: level + 1 generator: aCodeGen. + case endsWithReturn ifFalse: + [aStream tab: level + 1; nextPutAll: 'break;']] + valueWithArguments: tuple]. + aStream + crtab: level; + nextPutAll: 'default:'; + crtab: level + 1. + otherwiseOrNil + ifNotNil: + [otherwiseOrNil emitCCodeOn: aStream level: level + 1 generator: aCodeGen] + ifNil: [aStream nextPutAll: 'error("Case not found and no otherwise clause");']. + aStream + crtab: level; + nextPut: $}!
Item was added: + ----- Method: TSwitchStmtNode>>expression (in category 'accessing') ----- + expression + "Answer the value of expression" + + ^ expression!
Item was added: + ----- Method: TSwitchStmtNode>>expression: (in category 'accessing') ----- + expression: anObject + "Set the value of expression" + + expression := anObject!
Item was added: + ----- Method: TSwitchStmtNode>>expression:cases:otherwiseOrNil: (in category 'instance initialization') ----- + expression: expr cases: aTBraceNode otherwiseOrNil: otherwiseOrNilNode + + self expression: expr. + self cases: (self createCasesFromBraceNode: aTBraceNode). + self otherwiseOrNil: otherwiseOrNilNode!
Item was added: + ----- Method: TSwitchStmtNode>>isSwitch (in category 'testing') ----- + isSwitch + ^true!
Item was added: + ----- Method: TSwitchStmtNode>>nodesDo: (in category 'enumerating') ----- + nodesDo: aBlock + "Apply aBlock to all nodes in the receiver. + N.B. This is assumed to be bottom-up, leaves first." + expression nodesDo: aBlock. + cases do: + [:pair| + pair first do: [:node| node nodesDo: aBlock]. + pair last nodesDo: aBlock]. + otherwiseOrNil ifNotNil: + [otherwiseOrNil nodesDo: aBlock]. + aBlock value: self!
Item was added: + ----- Method: TSwitchStmtNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + expression nodesDo: aBlock parent: self.. + cases do: + [:pair| + pair first do: [:node| node nodesDo: aBlock parent: self.]. + pair last nodesDo: aBlock parent: self.]. + otherwiseOrNil ifNotNil: + [otherwiseOrNil nodesDo: aBlock parent: self]. + aBlock value: self value: parent!
Item was added: + ----- Method: TSwitchStmtNode>>nodesDo:unless: (in category 'enumerating') ----- + nodesDo: aBlock unless: cautionaryBlock + + (cautionaryBlock value: self) ifTrue: [^self]. + expression nodesDo: aBlock unless: cautionaryBlock. + cases do: + [:pair| + pair first do: [:node| node nodesDo: aBlock unless: cautionaryBlock]. + pair last nodesDo: aBlock unless: cautionaryBlock]. + otherwiseOrNil ifNotNil: + [otherwiseOrNil nodesDo: aBlock unless: cautionaryBlock]!
Item was added: + ----- Method: TSwitchStmtNode>>otherwiseOrNil (in category 'accessing') ----- + otherwiseOrNil + "Answer the value of otherwiseOrNil" + + ^ otherwiseOrNil!
Item was added: + ----- Method: TSwitchStmtNode>>otherwiseOrNil: (in category 'accessing') ----- + otherwiseOrNil: anObject + "Set the value of otherwiseOrNil" + + otherwiseOrNil := anObject!
Item was added: + ----- Method: TSwitchStmtNode>>postCopy (in category 'copying') ----- + postCopy + expression := expression copy. + cases := (cases collect: + [:pair| "<Array with: <Array with: ParseTreeNode> with: TStmtListNode" + { pair first collect: [:labelNode| labelNode copy]. + pair last copy }]). + otherwiseOrNil := otherwiseOrNil copy!
Item was added: + ----- Method: TSwitchStmtNode>>printOn:level: (in category 'printing') ----- + printOn: aStream level: level + + aStream crtab: level. + aStream nextPutAll: 'switch ('. + expression printOn: aStream level: level. + aStream nextPutAll: ') {'. + cases do: + [:tuple| + [:labels :case| + labels do: + [:label| + aStream + crtab: level; + nextPutAll: 'case '. + label printOn: aStream level: level + 1. + aStream nextPut: $:]. + aStream crtab: level + 1. + case printOn: aStream level: level + 1. + aStream crtab: level + 1; nextPutAll: 'break;'] + valueWithArguments: tuple]. + otherwiseOrNil ifNotNil: + [aStream + crtab: level; + nextPutAll: 'default:'; + crtab: level + 1. + otherwiseOrNil printOn: aStream level: level + 1]. + aStream + crtab: level; + nextPut: $}!
Item was added: + ----- Method: TSwitchStmtNode>>removeAssertions (in category 'transformations') ----- + removeAssertions + expression removeAssertions. + cases do: + [:pair| "<Array with: <Array with: ParseTreeNode> with: TStmtListNode" + pair first do: [:labelNode| labelNode removeAssertions]. + pair last removeAssertions]. + otherwiseOrNil ifNotNil: + [otherwiseOrNil removeAssertions]!
Item was added: + ----- Method: TSwitchStmtNode>>replaceNodesIn: (in category 'transformations') ----- + replaceNodesIn: aDictionary + ^aDictionary + at: self + ifAbsent: + [expression := expression replaceNodesIn: aDictionary. + cases := (cases collect: + [:pair| "<Array with: <Array with: ParseTreeNode> with: TStmtListNode" + { pair first collect: [:labelNode| labelNode replaceNodesIn: aDictionary]. + pair last replaceNodesIn: aDictionary }]). + otherwiseOrNil ifNotNil: + [otherwiseOrNil := otherwiseOrNil replaceNodesIn: aDictionary]. + self]!
Item was added: + ----- Method: TSwitchStmtNode>>switchVariable (in category 'accessing') ----- + switchVariable + "Answer the value of switchVariable" + + ^ switchVariable!
Item was added: + ----- Method: TSwitchStmtNode>>switchVariable: (in category 'accessing') ----- + switchVariable: anObject + "Set the value of switchVariable" + + switchVariable := anObject!
Item was added: + ----- Method: TVariableNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + aBlock value: self value: parent!
Item was added: + ----- Method: TVariableNode>>structTargetKindIn: (in category 'testing') ----- + structTargetKindIn: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^aCodeGen structTargetKindForVariableName: name!
Item was changed: ----- Method: VMMaker class>>versionString (in category 'version testing') ----- versionString
"VMMaker versionString"
+ ^'4.12.14'! - ^'4.12.13'!