Conversation
guillep
commented
Jun 24, 2026
Comment on lines
-3714
to
5181
| and: [(self methodNamed: aTSendNode selector) | ||
| and: [ | ||
| (self methodNamed: aTSendNode selector) | ||
| ifNil: [false] | ||
| ifNotNil: [:method| method isStructAccessor]]] | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> isVoidPointer: aCType [ "<String>" | ||
| "sigh..." | ||
| ^#('void *' 'void*') includes: aCType asString | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> localizeGlobalVariables [ | ||
|
|
||
| | candidates elected localized | | ||
| "find all globals used in only one method" | ||
| candidates := globalVariableUsage select: [ :e | e size = 1 ]. | ||
| "Don't localize globals" | ||
| (candidates keys select: [ :k | self mustBeGlobal: k ]) do: [ :k | | ||
| candidates removeKey: k ]. | ||
| elected := Set new. | ||
| localized := Dictionary new. "for an ordered report" | ||
| "move any suitable global to be local to the single method using it" | ||
| candidates keysAndValuesDo: [ :key :targets | | ||
| targets do: [ :name | | ||
| (methods at: name ifAbsent: [ ]) ifNotNil: [ :procedure | | ||
| | newDeclaration | | ||
| (procedure isRealMethod and: [ | ||
| self shouldGenerateMethod: procedure ]) ifTrue: [ | ||
| (localized at: name ifAbsentPut: [ SortedCollection new ]) add: | ||
| key. | ||
| elected add: (procedure addLocal: key). | ||
| newDeclaration := variableDeclarations | ||
| at: key | ||
| ifAbsent: [ 'sqInt ' , key ]. | ||
| (self | ||
| initializerForInstVar: key | ||
| inStartClass: procedure definingClass) ifNotNil: [ | ||
| :initializerNode | | ||
| newDeclaration := String streamContents: [ :s | | ||
| s | ||
| nextPutAll: newDeclaration; | ||
| nextPutAll: ' = '. | ||
| (initializerNode asCASTIn: self) | ||
| prettyPrintOn: s ] ]. | ||
| procedure declarationAt: key put: newDeclaration ] ] ] ]. | ||
| logger ifNotNil: [ | ||
| localized keys asSortedCollection do: [ :name | | ||
| (localized at: name) do: [ :var | | ||
| logger | ||
| newLine; | ||
| show: var , ' localised to ' , name; | ||
| cr ] ] ]. | ||
|
|
||
| elected do: [ :var | self removeVariable: var ] | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> localizeVariables: varsList inMethod: m [ | ||
|
|
||
| self validateLocalizationOfGlobals: varsList exceptMethod: m selector. | ||
| m localizeVariables: varsList. | ||
| varsList do: [ :v | | ||
| | varString | | ||
| varString := v asString. | ||
| (variableDeclarations includesKey: varString) ifTrue: [ | ||
| m | ||
| declarationAt: v asString | ||
| put: (variableDeclarations at: varString) ]. | ||
| self removeVariable: varString ] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> logger [ | ||
| ^logger | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> logger: aTranscriptStream [ | ||
| logger := aTranscriptStream | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> mayInline: sel [ | ||
| "Answer if the method with the given selector may be inlined." | ||
|
|
||
| ^ (self isAssertSelector: sel) not and: [ inlineList includes: sel ] | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> maybeBreakForInlineOf: aNode in: aTMethod [ | ||
| "convenient for debugging..." | ||
| (aNode isSend | ||
| and: [breakSrcInlineSelectors size + breakDestInlineSelectors size > 0 | ||
| and: [(breakSrcInlineSelectors isEmpty or: [breakSrcInlineSelectors includes: aNode selector]) | ||
| and: [(breakDestInlineSelectors isEmpty or: [(breakDestInlineSelectors includes: aTMethod selector)]) | ||
| and: [breakOnInline ~~ false]]]]) ifTrue: | ||
| [aTMethod halt: aTMethod selector, ' ', aNode selector] | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> maybeBreakForTestOfInliningOf: aNodeOrSelector [ | ||
| "convenient for debugging..." | ||
| | selector | | ||
| selector := aNodeOrSelector isSymbol | ||
| ifTrue: [aNodeOrSelector] | ||
| ifFalse: | ||
| [aNodeOrSelector isSend | ||
| ifTrue: [aNodeOrSelector selector] | ||
| ifFalse: [^self]]. | ||
| ((breakSrcInlineSelectors includes: selector) | ||
| and: [breakDestInlineSelectors isEmpty | ||
| and: [breakOnInline == true]]) ifTrue: | ||
| [self halt: selector] | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> maybeBreakForTestToInline: aNodeOrSelector in: aTMethod [ | ||
| "convenient for debugging..." | ||
| | selector | | ||
| selector := aNodeOrSelector isSymbol | ||
| ifTrue: [aNodeOrSelector] | ||
| ifFalse: | ||
| [aNodeOrSelector isSend | ||
| ifTrue: [aNodeOrSelector selector] | ||
| ifFalse: [^self]]. | ||
| (breakSrcInlineSelectors size + breakDestInlineSelectors size > 0 | ||
| and: [(breakSrcInlineSelectors isEmpty or: [breakSrcInlineSelectors includes: selector]) | ||
| and: [(breakDestInlineSelectors isEmpty or: [(breakDestInlineSelectors includes: aTMethod selector)]) | ||
| and: [breakOnInline ~~ true]]]) ifTrue: | ||
| [aTMethod halt: aTMethod selector, ' ', selector] | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> maybePutPreambleFor: aClass on: aStream [ | ||
| aClass preambleCCode ifNotNil: | ||
| [:preamble| | actualClass | | ||
| actualClass := aClass class whichClassIncludesSelector: #preambleCCode. | ||
| aStream | ||
| newLine; newLine; | ||
| nextPutAll: '/* '; print: actualClass; nextPutAll: '>>preambleCCode */'; cr; | ||
| nextPutAll: preamble; cr; | ||
| nextPutAll: '/* end '; print: actualClass; nextPutAll: '>>preambleCCode */'; cr] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> messageReceiverIsInterpreterProxy: sendNode [ | ||
| ^self isGeneratingPluginCode | ||
| and: [sendNode receiver isVariable | ||
| and: ['interpreterProxy' = sendNode receiver name | ||
| and: [(self isKernelSelector: sendNode selector) not]]] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> methodNamed: selector [ | ||
| "Answer the method in the code base with the given selector." | ||
| ^ methods at: selector ifAbsent: [ nil ] | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> methods [ | ||
|
|
||
| ^ methods | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> methodsForDefiningClass: dc [ | ||
| "Answer a collection of methods that refer to the given global variable." | ||
|
|
||
| ^methods select: [:tMethod| tMethod definingClass == dc] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> methodsReferringToGlobal: v [ | ||
| "Return a collection of methods that refer to the given global variable." | ||
|
|
||
| | out | | ||
| out := OrderedCollection new. | ||
| methods associationsDo: [ :assoc | | ||
| (assoc value freeVariableReferences includes: v) ifTrue: [ | ||
| out add: assoc key. | ||
| ]. | ||
| ]. | ||
| ^ out | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> methodsThatCanInvoke: aSelectorList [ | ||
| "Return a set of methods that can invoke one of the given selectors, either directly or via a sequence of intermediate methods." | ||
|
|
||
| | out todo sel | | ||
| out := Set new. | ||
| todo := aSelectorList copy asOrderedCollection. | ||
| [todo isEmpty] whileFalse: [ | ||
| sel := todo removeFirst. | ||
| out add: sel. | ||
| methods do: [ :m | | mSelector | | ||
| (m allCalls includes: sel) ifTrue: [ | ||
| mSelector := m selector. | ||
| ((out includes: mSelector) or: | ||
| [todo includes: mSelector]) ifFalse: [ | ||
| todo add: mSelector. | ||
| ]. | ||
| ]. | ||
| ]. | ||
| ]. | ||
| ^ out | ||
|
|
||
| ] | ||
|
|
||
| { #category : 'translating' } | ||
| CCodeGenerator >> mostBasicConstantSelectors [ | ||
| "Returns a list of selectors that should be translated as macros" | ||
| ^ #() | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> mustBeGlobal: aName [ | ||
|
|
||
| ^ false | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> mustBeGlobalAndExport: aName [ | ||
| ^ false | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> needToGenerateHeader: headerName file: interpHdrPath contents: newContentsArg [ | ||
| "Check if we need to regenerate a header file. We always need to if the contents have changed. | ||
| But if not we can avoid needless recompilations by not regenerating. So only regenerate if the | ||
| package stamp is dirty and the monticello stamp is clean." | ||
|
|
||
| | newContents oldContents dirtyStamp | | ||
| interpHdrPath asFileReference exists ifFalse: [ ^ true ]. | ||
| newContents := newContentsArg. | ||
| oldContents := interpHdrPath asFileReference contents. | ||
| oldContents := oldContents | ||
| copyReplaceAll: { | ||
| Character cr. | ||
| Character lf } | ||
| with: { Character cr }. | ||
| oldContents replaceAll: Character lf with: Character cr. | ||
| dirtyStamp := (oldContents indexOfSubCollection: '* VMMaker') ~= 0. | ||
| (newContents beginsWith: '/*') = (oldContents beginsWith: '/*') | ||
| ifFalse: [ | ||
| (newContents beginsWith: '/*') ifTrue: [ | ||
| newContents := newContents readStream | ||
| upToAll: '*/'; | ||
| skipSeparators; | ||
| upToEnd ]. | ||
| (oldContents beginsWith: '/*') ifTrue: [ | ||
| oldContents := oldContents readStream | ||
| upToAll: '*/'; | ||
| skipSeparators; | ||
| upToEnd ] ]. | ||
| ^ oldContents ~= newContents or: [ | ||
| (dirtyStamp and: [ self shouldGenerateHeader ]) or: [ | ||
| self confirm: headerName | ||
| , | ||
| ' contents are unchanged.\Writing the file may cause recompilation of support files.\Do you want to write the header file?' | ||
| withCRs ] "If no stamp don't worry" ] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> nilOrBooleanConditionFor: nodeOrNil [ | ||
|
|
||
| "If nodeOrNil is one of the conditional sends for which we do translation-time dead code elimination | ||
| (i.e. cppIf:ifTrue: et al or ifTrue: et al) and the conditional does evaluate to a translation-time | ||
| boolean constant, answer that constant, otherwise answer nil. Used to prune dead code, | ||
| either for code generaton or dead variable elimination." | ||
|
|
||
| generateDeadCode ifTrue: [ ^ nil ]. | ||
| nodeOrNil ifNil: [ ^ nil ]. | ||
| nodeOrNil isSend ifFalse: [ ^ nil ]. | ||
| (#( ifTrue: ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue: ) includes: | ||
| nodeOrNil selector) ifTrue: [ | ||
| ^ self nilOrBooleanConstantReceiverOf: nodeOrNil receiver ]. | ||
| (#( and: or: ) includes: nodeOrNil selector) ifTrue: [ | ||
| ^ self nilOrBooleanConstantReceiverOf: nodeOrNil ]. | ||
| (#( #cppIf:ifTrue: #cppIf:ifTrue:ifFalse: ) includes: | ||
| nodeOrNil selector) ifTrue: [ | ||
| | maybeName value | | ||
| value := nodeOrNil arguments first value. | ||
| self validateCppIf: nodeOrNil withValue: value. | ||
| maybeName := nodeOrNil arguments first isConstant ifTrue: [ | ||
| nodeOrNil arguments first nameOrValue ]. | ||
| ^ (optionsDictionary notNil and: [ | ||
| nodeOrNil arguments first isConstant and: [ | ||
| (#( true false ) includes: | ||
| (optionsDictionary at: maybeName ifAbsent: [ nil ])) and: [ | ||
| (self defineAtCompileTime: maybeName) not ] ] ]) ifTrue: [ | ||
| optionsDictionary at: nodeOrNil arguments first name ] ]. | ||
| ^ nil | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> nilOrBooleanConstantReceiverOf: aNode [ | ||
|
|
||
| "Answer nil or the boolean constant that is the receiver of the given message send. | ||
| Used to suppress conditional code when the condition is a translation-time constant." | ||
|
|
||
| | val receiver argument arms | | ||
| generateDeadCode ifTrue: [ ^ nil ]. | ||
| ((self isConstantNode: aNode valueInto: [ :v | val := v ]) and: [ | ||
| #( true false ) includes: val ]) ifTrue: [ ^ val ]. | ||
| aNode isSend ifTrue: [ | ||
| aNode selector == #not ifTrue: [ | ||
| (self nilOrBooleanConstantReceiverOf: aNode receiver) ifNotNil: [ | ||
| :bool | ^ bool not ] ]. | ||
| ((#( isNil notNil ) includes: aNode selector) and: [ | ||
| self isNilConstantReceiverOf: aNode ]) ifTrue: [ | ||
| ^ aNode selector == #isNil ]. | ||
| ((#( or: and: ) includes: aNode selector) and: [ | ||
| aNode arguments last isStatementList and: [ | ||
| aNode arguments last statements size = 1 ] ]) ifTrue: [ | ||
| (self nilOrBooleanConstantReceiverOf: aNode receiver) ifNotNil: [ | ||
| :rcvr | | ||
| ((rcvr == false and: [ aNode selector == #and: ]) or: [ | ||
| rcvr == true and: [ aNode selector == #or: ] ]) ifTrue: [ | ||
| ^ rcvr ]. | ||
| (self nilOrBooleanConstantReceiverOf: | ||
| aNode arguments last statements first) ifNotNil: [ :arg | | ||
| ^ rcvr perform: aNode selector with: [ arg ] ] ]. | ||
| "We can also eliminate expr and: [false], expr or: [true], but only if expr is side-effect free. | ||
| This is a weak test; we don't traverse calls. Caveat emptor!" | ||
| ((aNode receiver noneSatisfy: [ :node | node isAssignment ]) and: [ | ||
| aNode arguments last statements size = 1 ]) ifTrue: [ "No side-effects in the elided expression" | ||
| (self nilOrBooleanConstantReceiverOf: | ||
| aNode arguments last statements first) ifNotNil: [ :arg | | ||
| ((arg == false and: [ aNode selector == #and: ]) or: [ | ||
| arg == true and: [ aNode selector == #or: ] ]) ifTrue: [ ^ arg ] ] ] ]. | ||
| "Look for Const ifTrue: [self foo] ifFalse: [false] => false" | ||
| ((#( #ifTrue:ifFalse: #ifFalse:ifTrue: ) includes: aNode selector) | ||
| and: [ | ||
| (self isConstantNode: aNode receiver valueInto: [ :v | val := v ]) | ||
| and: [ | ||
| (#( true false ) includes: val) and: [ | ||
| arms := aNode arguments collect: [ :altBlock | | ||
| | bval | | ||
| (altBlock statements size = 1 and: [ | ||
| (self | ||
| isConstantNode: altBlock statements last | ||
| valueInto: [ :v | bval := v ]) and: [ | ||
| #( true false ) includes: bval ] ]) ifTrue: [ | ||
| bval ] ]. | ||
| arms asArray ~= #( nil nil ) ] ] ]) ifTrue: [ | ||
| | arm | | ||
| arm := aNode selector == #ifTrue:ifFalse: == val | ||
| ifTrue: [ arms first ] | ||
| ifFalse: [ arms last ]. | ||
| (#( true false ) includes: arm) ifTrue: [ ^ arm ] ]. | ||
| ((#( = ~= < > <= >= ) includes: aNode selector) and: [ | ||
| (self | ||
| isConstantNode: aNode receiver | ||
| valueInto: [ :v | receiver := v ]) and: [ | ||
| receiver isInteger and: [ | ||
| (self | ||
| isConstantNode: aNode arguments first | ||
| valueInto: [ :v | argument := v ]) and: [ argument isInteger ] ] ] ]) | ||
| ifTrue: [ ^ receiver perform: aNode selector with: argument ]. | ||
| "Inlining for e.g. CharacterTable ifNil: [...] ifNotNil: [...]], which compiles to CharacterTable == nil ifTrue: [...] ifFalse: [...]" | ||
| (aNode selector == #== and: [ | ||
| aNode arguments first isConstant and: [ | ||
| aNode arguments first value = nil and: [ | ||
| aNode receiver isConstant and: [ aNode receiver value == nil ] ] ] ]) | ||
| ifTrue: [ ^ true ] ]. | ||
| ^ nil | ||
| ] | ||
|
|
||
| { #category : 'translation support' } | ||
| CCodeGenerator >> nilTranslation [ | ||
| "Defined in some header file as a macro?" | ||
| ^ 'NULL' | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> node: exprNode typeCompatibleWith: argName inliningInto: targetMethod in: aTMethod [ | ||
| "Answer either exprNode or, if required, a cast of exprNode to the type of argName. | ||
| The cast is required if | ||
| - argName is typed and exprNode is untyped | ||
| - argName is untyped and exprNode is an arithmetic type of size > #sqInt | ||
| - both argName and exprNode are typed but they are incompatible" | ||
| | formalType actualType | | ||
| formalType := targetMethod typeFor: argName in: self. | ||
| actualType := self typeFor: exprNode in: aTMethod. | ||
| ^((exprNode isSend or: [exprNode isVariable]) | ||
| and: [(formalType notNil and: [actualType isNil]) | ||
| or: [(formalType isNil and: [actualType notNil and: [(self isIntegralCType: actualType) and: [(self sizeOfIntegralCType: actualType) > (self sizeOfIntegralCType: #sqInt)]]]) | ||
| or: [(self variableOfType: formalType acceptsValue: exprNode ofType: actualType) not]]]) | ||
| ifTrue: [self nodeToCast: exprNode to: (formalType ifNil: [#sqInt])] | ||
| ifFalse: | ||
| [((exprNode isSend or: [exprNode isVariable]) | ||
| and: [(self | ||
| variableOfType: (targetMethod typeFor: argName in: self) | ||
| acceptsValue: exprNode | ||
| ofType: (self typeFor: exprNode in: aTMethod)) not]) ifTrue: | ||
| [logger | ||
| nextPutAll: | ||
| 'type mismatch for formal ', argName, ' and actual "', exprNode asString, | ||
| '" when inlining ', targetMethod selector, ' in ', aTMethod selector, '. Use a cast.'; | ||
| cr; flush]. | ||
| exprNode] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> nodeIsDeadCode: aNode withParent: parentNode [ | ||
|
|
||
| "Answer if aNode would not be generated due to dead code elimination." | ||
|
|
||
| ^ (self nilOrBooleanConditionFor: parentNode) | ||
| ifNil: [ false ] | ||
| ifNotNil: [ :cond | | ||
| | filter | | ||
| filter := parentNode selector caseOf: { | ||
| ([ #ifFalse: ] -> [ #( first nil ) ]). | ||
| ([ #ifFalse:ifTrue: ] -> [ #( first last ) ]). | ||
| ([ #ifTrue: ] -> [ #( nil first ) ]). | ||
| ([ #ifTrue:ifFalse: ] -> [ #( last first ) ]). | ||
| ([ #and: ] -> [ #( nil first ) ]). | ||
| ([ #or: ] -> [ #( last nil ) ]). | ||
| ([ #cppIf:ifTrue: ] -> [ #( nil #second ) ]). | ||
| ([ #cppIf:ifTrue:ifFalse: ] -> [ #( third #second ) ]) }. "First element is accessor for filtered (eliminated) node if expression is true. | ||
| Second element is accessor for filtered (eliminated) node if expression is false." | ||
| (cond | ||
| ifTrue: [ filter first ] | ||
| ifFalse: [ filter last ]) | ||
| ifNil: [ false ] | ||
| ifNotNil: [ :accessor | | ||
| aNode == (parentNode arguments perform: accessor) ] ] | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> nodeToCast: exprNode to: cType [ | ||
| ^TSendNode new | ||
| setSelector: #cCoerceSimple:to: | ||
| receiver: (TVariableNode new setName: 'self') | ||
| arguments: { exprNode. TConstantNode value: cType } | ||
| isBuiltInOp: true | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> nonStructClassesForTranslationClasses: classes [ | ||
| "Answer in superclass order (any superclass precedes any subclass) | ||
| the ancilliaryClasses that are not struct classes for all the given classes." | ||
|
|
||
| | nonStructClasses | | ||
| nonStructClasses := OrderedCollection new. | ||
| classes do: [ :aTranslationClass | | ||
| aTranslationClass ancilliaryClasses do: [ :class | | ||
| (self isAcceptableAncilliaryClass: class) ifTrue: [ | ||
| (class isStructClass or: [ | ||
| (nonStructClasses includes: class) or: [ | ||
| classes includes: class ] ]) ifFalse: [ | ||
| nonStructClasses addLast: class ] ] ] ]. | ||
| ^ self superclassOrder: nonStructClasses | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> noteUsedVariableName: variableName [ | ||
|
|
||
| self currentScope noteUsedVariableName: variableName | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> optionIsTrue: pragma in: aClass [ | ||
| "Answer whether an option: or notOption: pragma is true in the context of aClass. | ||
| The argument to the option: pragma is interpreted as either a Cogit class name | ||
| or a class variable name or a variable name in VMBasicConstants." | ||
| | key | | ||
| key := pragma argumentAt: 1. | ||
| (self defineAtCompileTime: key) | ||
| ifTrue: [ ^ true ]. | ||
|
|
||
| ^ false | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> options [ | ||
| ^optionsDictionary | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> options: aDictionary [ | ||
| "Set optionsDictionary to the argument and scan it for accessors on the receiver, | ||
| performing the accessor with the value, allowing one to specify things like | ||
| generateDeadCode: false in the options." | ||
| optionsDictionary := aDictionary. | ||
| optionsDictionary keysAndValuesDo: | ||
| [:k :v| | accessor | | ||
| ((self class instVarNames includes: k) | ||
| and: [(Symbol hasInterned: k, ':' ifTrue: [:s| accessor := s]) | ||
| and: [self class canUnderstand: accessor]]) ifTrue: | ||
| [self perform: accessor with: v]] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> outputAsmLabel: selector on: aStream [ | ||
| | count | | ||
| suppressAsmLabels ifTrue: [^self]. | ||
| asmLabelCounts ifNil: | ||
| [asmLabelCounts := Dictionary new]. | ||
| count := asmLabelCounts | ||
| at: selector | ||
| put: 1 + (asmLabelCounts at: selector ifAbsent: [-1]). | ||
| aStream | ||
| nextPutAll: 'VM_LABEL('; | ||
| nextPutAll: (self cFunctionNameFor: selector); | ||
| nextPutAll: (count = 0 ifTrue: [''] ifFalse: [count printString]); | ||
| nextPut: $); | ||
| nextPut: $; | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> popScope [ | ||
|
|
||
| scopeStack removeLast | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> preDeclareInterpreterProxyOn: aStream [ | ||
| "Put the necessary #defines needed before interpreterProxy. Basically | ||
| internal plugins use the VM's interpreterProxy variable and external plugins use | ||
| their own. In addition the VMPluginCodeGenerator can choose to keep local copies | ||
| all functions." | ||
| aStream cr; nextPutAll: '#ifdef SQUEAK_BUILTIN_PLUGIN'. | ||
| aStream cr; nextPutAll: 'extern'. | ||
| aStream cr; nextPutAll: '#endif'; cr | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> prepareMethods [ | ||
|
|
||
| | globals | | ||
| globals := Set new: 200. | ||
| globals addAll: variables | ||
| , (apiVariables ifNotNil: [ apiVariables keys ] ifNil: [ #( ) ]). | ||
| methods do: [ :m | | ||
| m | ||
| renameLocalVariablesGivenClassVariables: constants | ||
| andGlobalVariables: globals | ||
| inCodeGenerator: self. | ||
| m allLocals , m args do: [ :var | | ||
| self checkForVariableNameConflict: var inMethod: m ]. | ||
| m prepareMethodIn: self ] | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> previousCommentMarksInlining [ | ||
| ^previousCommentMarksInlining | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> previousCommentMarksInlining: aBoolean [ | ||
| | previousValue | | ||
| previousValue := previousCommentMarksInlining. | ||
| previousCommentMarksInlining := aBoolean. | ||
| ^previousValue | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> previousCommenter [ | ||
| ^previousCommenter | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> previousCommenter: aTParseNodeOrNil [ | ||
| | previousValue | | ||
| previousValue := previousCommenter. | ||
| previousCommenter := aTParseNodeOrNil. | ||
| ^previousValue | ||
| ] | ||
|
|
||
| { #category : 'error notification' } | ||
| CCodeGenerator >> printUnboundCallWarnings [ | ||
| "Print a warning message for every unbound method call in the code base." | ||
|
|
||
| | knownSelectors undefinedCalls | | ||
| undefinedCalls := Dictionary new. | ||
| knownSelectors := castTranslationDict keys asSet. | ||
| knownSelectors add: #error:. | ||
| methods do: [ :m | knownSelectors add: m selector ]. | ||
| methods do: [ :m | | ||
| m allCalls do: [ :sel | | ||
| (knownSelectors includes: sel) ifFalse: [ | ||
| (undefinedCalls includesKey: sel) | ||
| ifTrue: [ (undefinedCalls at: sel) add: m selector ] | ||
| ifFalse: [ undefinedCalls at: sel put: (OrderedCollection with: m selector) ]. | ||
| ]. | ||
| ]. | ||
| ]. | ||
|
|
||
| logger cr. | ||
| (self sortStrings: undefinedCalls keys) do: [ :undefined | | ||
| logger show: undefined, ' -- undefined method sent by:'; cr. | ||
| (undefinedCalls at: undefined) do: [ :caller | | ||
| logger tab; show: caller; cr. | ||
| ]. | ||
| ]. | ||
| ] | ||
|
|
||
| { #category : 'error notification' } | ||
| CCodeGenerator >> printUnboundVariableReferenceWarnings [ | ||
| "Print a warning message for every unbound variable reference in the code base." | ||
|
|
||
| | undefinedRefs globalVars | | ||
| undefinedRefs := Dictionary new. | ||
| globalVars := Set new: 100. | ||
| globalVars addAll: variables. | ||
| methods do: [ :m | | knownVars | | ||
| knownVars := globalVars copy. | ||
| m args do: [ :var | knownVars add: var ]. | ||
| m allLocals do: [ :var | knownVars add: var ]. | ||
| m freeVariableReferences do: [ :varName | | ||
| (knownVars includes: varName) ifFalse: [ | ||
| (undefinedRefs includesKey: varName) | ||
| ifTrue: [ (undefinedRefs at: varName) add: m selector ] | ||
| ifFalse: [ undefinedRefs at: varName put: (OrderedCollection with: m selector) ]. | ||
| ]. | ||
| ]. | ||
| ]. | ||
|
|
||
| logger cr. | ||
| (self sortStrings: undefinedRefs keys) do: [ :var | | ||
| logger show: var, ' -- undefined variable used in:'; cr. | ||
| (undefinedRefs at: var) do: [ :sel | | ||
| logger tab; show: sel; cr. | ||
| ]. | ||
| ]. | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> promoteArithmeticTypes: firstType and: secondType [ | ||
|
|
||
| "If either type is unknown, answer nil." | ||
| (firstType isNil or: [secondType isNil]) ifTrue: | ||
| [^nil]. | ||
|
|
||
| "Answer the return type for an arithmetic send. This is so that the inliner can still inline | ||
| simple expressions. Deal with pointer arithmetic, floating point arithmetic and promotion. | ||
| It is important to choose deterministically to get stable source generation. | ||
| Also, the behaviour of inlined and non inlined code should be unchanged." | ||
| ((#(#double float) includes: firstType) | ||
| or: [#(#double float) includes: secondType]) ifTrue: | ||
| [^(firstType = #double or: [secondType = #double]) | ||
| ifTrue: [#double] | ||
| ifFalse: [#float] "in C99 6.3.1.8, float+int, int is converted as a float"]. | ||
|
|
||
| "Deal with integer promotion and arithmetic conversion" | ||
| ^self promoteIntegerArithmeticTypes: firstType and: secondType | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> promoteIntegerArithmeticTypes: firstType and: secondType [ | ||
| "Answer the return type for an arithmetic send. | ||
| Deal with integer promotion rules of C99. | ||
| See section 6.3 Conversions of the standard. | ||
|
|
||
| 6.3.1.1 ...snip... | ||
| If an int can represent all values of the original type, the value is converted to an int; | ||
| otherwise, it is converted to an unsigned int. These are called the integer promotions. | ||
| All other types are unchanged by the integer promotions | ||
|
|
||
| 6.3.1.8 ...snip... | ||
| Otherwise, the integer promotions are performed on both operands | ||
| Then the following rules are applied to the promoted operands: | ||
|
|
||
| If both operands have the same type, then no further conversion is needed. | ||
|
|
||
| Otherwise, if both operands have signed integer types or both have unsigned integer | ||
| types, the operand with the type of lesser integer conversion rank is converted to the | ||
| type of the operand with greater rank. | ||
|
|
||
| Otherwise, if the operand that has unsigned integer type has rank greater or equal to | ||
| the rank of the type of the other operand, then the operand with signed integer type | ||
| is converted to the type of the operand with unsigned integer type. | ||
|
|
||
| Otherwise, if the type of the operand with signed integer type can represent all of the | ||
| values of the type of the operand with unsigned integer type, then the operand with | ||
| unsigned integer type is converted to the type of the operand with signed integer type. | ||
|
|
||
| Otherwise, both operands are converted to the unsigned integer type corresponding to | ||
| the type of the operand with signed integer type. | ||
|
|
||
| This is so that the generated code behaviour is insensitive to inlining." | ||
| | length1 length2 intSize | | ||
| length1 := self sizeOfIntegralCType: firstType. | ||
| length2 := self sizeOfIntegralCType: secondType. | ||
| intSize := self sizeOfIntegralCType: #int. | ||
| (length1 < intSize and: [length2 < intSize]) ifTrue: [^#int]. "Integer promotion" | ||
| length1 > length2 ifTrue: [^firstType]. | ||
| length2 > length1 ifTrue: [^secondType]. | ||
| firstType first = $u ifTrue: [^firstType]. | ||
| secondType first = $u ifTrue: [^secondType]. | ||
| ^firstType | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> pruneUnreachableMethods [ | ||
| "Remove any methods that are not reachable. Retain methods needed by the translated classes - see implementors of requiredMethodNames" | ||
|
|
||
| | neededSelectors newMethods previousSize visited | | ||
| "add all the exported methods and all the called methods to the requiredSelectors" | ||
| "keep all the fake methods (macros and struct accessors; these are needed | ||
| to ensure correct code generation." | ||
|
|
||
| neededSelectors := Set withAll: requiredSelectors. | ||
| methods do: [ :m | | ||
| m export ifTrue: | ||
| [neededSelectors add: m selector]. | ||
| m isAPIMethod ifTrue: | ||
| [neededSelectors add: m selector]. | ||
| m isRealMethod ifFalse: | ||
| [neededSelectors add: m selector]]. | ||
|
|
||
| "Now compute the transitive closure..." | ||
| previousSize := neededSelectors size. | ||
| visited := IdentitySet new: methods size. | ||
| [neededSelectors do: | ||
| [:s| | ||
| (methods at: s ifAbsent: []) ifNotNil: | ||
| [:m| | ||
| (visited includes: m) ifFalse: | ||
| [visited add: m. | ||
| (m isRealMethod | ||
| and: [self shouldGenerateMethod: m]) ifTrue: | ||
| [ | ||
| self haltIf: [ m allCalls includes: #respondToUnknownBytecode ]. | ||
| neededSelectors addAll: m allCalls]]]]. | ||
| neededSelectors size > previousSize] | ||
| whileTrue: | ||
| [previousSize := neededSelectors size]. | ||
|
|
||
| "build a new dictionary of methods from the collection of all the ones to keep" | ||
| newMethods := Dictionary new: neededSelectors size. | ||
| neededSelectors do: | ||
| [:sel| | ||
| methods at: sel ifPresent: [:meth| newMethods at: sel put: meth]]. | ||
| methods := newMethods | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> pushScope: aScope [ | ||
|
|
||
| scopeStack addLast: aScope | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> pushScope: aScope while: aBlock [ | ||
|
|
||
| self pushScope: aScope. | ||
| ^aBlock ensure: [scopeStack removeLast] | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> putConditionalDefineOf: aConstantNameString as: valueOrValueString comment: commentOrNil on: aStream [ | ||
| self withConditionalDefineOf: aConstantNameString | ||
| comment: commentOrNil | ||
| on: aStream | ||
| do: [| valueAsString | | ||
| valueAsString := valueOrValueString asString. | ||
| valueAsString first ~= $# ifTrue: | ||
| [aStream nextPutAll: '# define '; nextPutAll: aConstantNameString; space]. | ||
| aStream nextPutAll: valueAsString; cr] | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> putDefineOf: aConstantNameString as: valueOrValueString on: aStream [ | ||
| aStream | ||
| nextPutAll: '#define '; | ||
| nextPutAll: aConstantNameString; | ||
| space; | ||
| nextPutAll: valueOrValueString asString; | ||
| cr | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> removeAssertions [ | ||
| "Remove all assertions in method bodies. This is for the benefit of inlining, which | ||
| fails to recognise and disregard empty method bodies when checking the inlinability | ||
| of sends." | ||
|
|
||
| | newMethods | | ||
| newMethods := Dictionary new. | ||
| methods doWithIndex: [ :m :i | | ||
| m isAssertion ifFalse: [ | ||
| newMethods at: m selector put: m. | ||
| m removeAssertions]]. | ||
| methods := newMethods. | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> removeConstant: aName [ | ||
| "mark the given (class or library) variable as already define." | ||
| constants at: aName ifPresent: [ :val | val shouldBeGenerated: false ] ifAbsent: [] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> removeMethodForSelector: aSelector [ | ||
| "Remove the given method from the code base" | ||
| ((breakSrcInlineSelectors includes: aSelector) | ||
| or: [(breakDestInlineSelectors includes: aSelector)]) ifTrue: | ||
| [self halt]. | ||
| methods removeKey: aSelector ifAbsent: [] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> removeVariable: aName [ | ||
| "Remove the given (instance) variable from the code base." | ||
|
|
||
| self | ||
| removeVariable: aName | ||
| ifAbsent: [ self error: 'variable missing: ' , aName ] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> removeVariable: aName ifAbsent: ifAbsentBlock [ | ||
| "Remove the given (instance) variable from the code base." | ||
|
|
||
| variableDeclarations removeKey: aName ifAbsent: [ ]. | ||
| globalVariableUsage removeKey: aName ifAbsent: [ ]. | ||
| ^ variables remove: aName ifAbsent: ifAbsentBlock | ||
| ] | ||
|
|
||
| { #category : 'renaming' } | ||
| CCodeGenerator >> renameConflictingMethods [ | ||
|
|
||
| | cFunctionNames toRename | | ||
| cFunctionNames := IdentityDictionary new. | ||
|
|
||
| methods reject: [ :m | m isStructAccessor ] thenDo: [ :m | | ||
| | functionName conflicts | | ||
| functionName := self cFunctionNameFor: m selector. | ||
|
|
||
| conflicts := cFunctionNames at: functionName ifAbsent: [ #( ) ]. | ||
|
|
||
| cFunctionNames at: functionName put: (conflicts copyWith: m) ]. | ||
|
|
||
| toRename := cFunctionNames select: [ :conflicts | conflicts size > 1 ]. | ||
|
|
||
| toRename keysAndValuesDo: [ :key :conflictingMethods | | ||
| (conflictingMethods select: [ :m | m isAPIMethod ]) size > 1 | ||
| ifTrue: [ "api methods cannot be renamed" | ||
| TranslationError signal: | ||
| 'Conflicting API methods would be translated to "' , key , '"' ]. | ||
|
|
||
| conflictingMethods | ||
| reject: [ :m | m isAPIMethod ] | ||
| thenDo: [ :m | | ||
| self | ||
| addSelectorTranslation: m selector | ||
| to: key , m args size asString ] ] | ||
| ] | ||
|
|
||
| { #category : 'renaming' } | ||
| CCodeGenerator >> renameKeywordsConflicts [ | ||
|
|
||
| methods do: [ :method | | ||
| | localRewording cSelector | | ||
| "rename locals" | ||
| localRewording := Dictionary new. | ||
|
|
||
|
|
||
| method allLocals | ||
| select: [ :local | self reservedWords includes: local ] | ||
| thenDo: [ :local | localRewording at: local put: (self sanitizeKeyword: local) ]. | ||
|
|
||
| localRewording ifNotEmpty: [ | ||
| method renameVariablesUsing: localRewording ]. | ||
|
|
||
| "translate selector" | ||
| cSelector := self cFunctionNameFor: method selector. | ||
|
|
||
| (self reservedWords includes: cSelector) ifTrue: [ | ||
| self | ||
| addSelectorTranslation: method selector | ||
| to: (self sanitizeKeyword: cSelector) ] ]. | ||
|
|
||
| "translate structs instance variables" | ||
| self structClasses do: [ :struct | | ||
| struct instVarTypeDeclarationsDo: [ :ivn :type | | ||
| (self reservedWords includes: ivn) ifTrue: [ | ||
| self | ||
| addStructInstanceVariableTranslation: ivn | ||
| to: (self sanitizeKeyword: ivn) ] ] ] | ||
| ] | ||
|
|
||
| { #category : 'C translation support' } | ||
| CCodeGenerator >> reservedWords [ | ||
| ^ self class reservedWords | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> retainMethods: aListOfSelectorsToKeep [ | ||
| "add aListOfSelectorsToKeep to requiredSelectors so that they will not be pruned" | ||
| requiredSelectors ifNil:[requiredSelectors := Set new:100]. | ||
| requiredSelectors addAll: aListOfSelectorsToKeep. | ||
| ^aListOfSelectorsToKeep | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> returnPrefixFromVariable: aName [ | ||
| ^aName | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> returnTypeForSend: sendNode in: aTMethod boundTo: aCalledMethod typeIfNil: 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." | ||
|
|
||
| ^ sendNode selector | ||
| 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 arguments last value ]). | ||
| ([ #cCoerceSimple:to: ] | ||
| -> [ | ||
| self conventionalTypeForType: sendNode arguments 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 arguments 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." | ||
| aCalledMethod ifNotNil: [ nil ] ifNil: [ typeIfNil ] ] | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> 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]. | ||
|
|
||
| ^ self | ||
| returnTypeForSend: sendNode | ||
| in: aTMethod | ||
| boundTo: methodOrNil | ||
| typeIfNil: typeIfNil | ||
| ] | ||
|
|
||
| { #category : 'translation support' } | ||
| CCodeGenerator >> sanitizeKeyword: aKeyword [ | ||
|
|
||
| ^ aKeyword , '_1' | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> selectAPIMethods [ | ||
| ^methods select: [:m| m isAPIMethod] | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> selectAPIVariables [ | ||
| ^variableDeclarations reject: [:decl| decl includesSubstring: 'static '] | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> selectorReturnsPointerToStruct: selector [ "<Symbol>" | ||
| | tMethod | | ||
| ^(tMethod := methods | ||
| at: selector | ||
| ifAbsent: | ||
| [apiMethods ifNotNil: | ||
| [apiMethods at: selector ifAbsent: []]]) notNil | ||
| and: [SlangStructType isTypePointerToStruct: tMethod returnType] | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> selectorReturnsStruct: selector [ "<Symbol>" | ||
| | tMethod | | ||
| ^(tMethod := methods | ||
| at: selector | ||
| ifAbsent: | ||
| [apiMethods ifNotNil: | ||
| [apiMethods at: selector ifAbsent: []]]) notNil | ||
| and: [SlangStructType isTypeStruct: tMethod returnType] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> selectorsAndMethodsDo: aBinaryBlock [ | ||
| methods keysAndValuesDo: aBinaryBlock | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> shortMonticelloDescriptionForClass: aClass [ | ||
| "Answer a suitable Monticello package stamp to include in a moduleName." | ||
| ^self class shortMonticelloDescriptionForClass: aClass | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> shouldGenerateAsInterpreterProxySend: aSendNode [ | ||
| ^ false | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> shouldGenerateHeader [ | ||
| ^ false | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> shouldGenerateMethod: aTMethod [ | ||
|
|
||
| ^(self isBuiltinSelector: aTMethod selector) | ||
| ifTrue: [requiredSelectors includes: aTMethod selector] | ||
| ifFalse: [aTMethod inline ~~ #always] | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> shouldGenerateStruct: structClass [ | ||
|
|
||
| ^ structClass isAbstract not | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> shouldIncludeMethodFor: aClass selector: selector [ | ||
| "Answer whether a method shoud be translated. Process optional methods by | ||
| interpreting the argument to the option: pragma as either a Cogit class name | ||
| or a class variable name or a variable name in VMBasicConstants. Exclude | ||
| methods with the doNotGenerate pragma." | ||
|
|
||
| | optionPragmas notOptionPragmas | | ||
| (aClass >> selector pragmaAt: #doNotGenerate) ifNotNil: [ ^ false ]. | ||
|
|
||
| "where is pragmasAt: ??" | ||
| optionPragmas := (aClass >> selector) pragmas select: [ :p | | ||
| p selector == #option: ]. | ||
| notOptionPragmas := (aClass >> selector) pragmas select: [ :p | | ||
| p selector == #notOption: ]. | ||
| (optionPragmas notEmpty or: [ notOptionPragmas notEmpty ]) ifTrue: [ | ||
| ^ (optionPragmas allSatisfy: [ :pragma | | ||
| self optionIsTrue: pragma in: aClass ]) and: [ | ||
| notOptionPragmas noneSatisfy: [ :pragma | | ||
| self optionIsTrue: pragma in: aClass ] ] ]. | ||
| ^ true | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> signedTypeForIntegralType: aCTypeString [ | ||
| (aCTypeString beginsWith: 'unsigned ') ifTrue: | ||
| [^aCTypeString allButFirst: 8]. | ||
|
|
||
| (aCTypeString beginsWith: 'usq') ifTrue: | ||
| [^aCTypeString allButFirst]. | ||
|
|
||
| aCTypeString = 'size_t' ifTrue: [^#usqIntptr_t]. | ||
|
|
||
| self error: 'unknown type'. | ||
| ^#long | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> sizeOfIntegralCType: anIntegralCType [ "<String>" | ||
| "N.B. Only works for values for which isIntegralCType: answers true." | ||
| | prunedCType index | | ||
| (anIntegralCType beginsWith: 'register ') ifTrue: | ||
| [^self sizeOfIntegralCType: (anIntegralCType allButFirst: 9)]. | ||
| prunedCType := (anIntegralCType beginsWith: 'unsigned ') | ||
| ifTrue: [(anIntegralCType allButFirst: 9) trimBoth] | ||
| ifFalse: [(anIntegralCType beginsWith: 'signed ') | ||
| ifTrue: [(anIntegralCType allButFirst: 7) trimBoth] | ||
| ifFalse: [anIntegralCType]]. | ||
|
|
||
| ^prunedCType asString caseOf: { | ||
| ['sqLong'] -> [8]. | ||
| ['usqLong'] -> [8]. | ||
| ['long long'] -> [8]. | ||
| ['sqInt'] -> [self bytesPerOop]. | ||
| ['usqInt'] -> [self bytesPerOop]. | ||
| ['sqIntptr_t'] -> [self bytesPerWord]. | ||
| ['usqIntptr_t'] -> [self bytesPerWord]. | ||
| ['int'] -> [4]. | ||
| ['short'] -> [2]. | ||
| ['short int'] -> [2]. | ||
| ['char'] -> [1]. | ||
| ['long'] -> [self bytesPerWord]. "It's ambiguous on LLP64 and we'll later remove it" | ||
| ['size_t'] -> [self bytesPerWord]. | ||
| ['pid_t'] -> [self bytesPerWord]. | ||
|
|
||
| "Standard C types" | ||
| ['int64_t'] -> [8]. | ||
| ['uint64_t'] -> [8]. | ||
| ['uint32_t'] -> [4]. | ||
| ['uint16_t'] -> [2]. | ||
| ['uint8_t'] -> [1]. | ||
| } | ||
| otherwise: | ||
| [((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned : 8'" | ||
| and: [(anIntegralCType includesAnyOf: '[*]') not | ||
| and: [(index := anIntegralCType indexOf: $:) > 0]]) | ||
| ifTrue: [(Integer readFrom: (anIntegralCType copyFrom: index + 1 to: anIntegralCType size) trimBoth readStream) + 7 // 8] | ||
| ifFalse: [self error: 'unrecognized integral type']] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> sortMethods: aTMethodCollection [ | ||
| "We need to define this since different Squeak versions answer different results | ||
| for asSortedCollection and if sort order changes, generated code changes too. | ||
| When generating VM code, use class name as major sort index as this groups | ||
| some methods by functionality (e.g. SpurGenerationScavenger) and that makes | ||
| the VMProfiler more useful." | ||
| ^aTMethodCollection asSortedCollection: | ||
| (self isGeneratingPluginCode | ||
| ifTrue: | ||
| [[:a :b| a selector caseSensitiveLessOrEqual: b selector]] | ||
| ifFalse: | ||
| [[:a :b| | ||
| a definingClass = b definingClass | ||
| ifTrue: [a selector caseSensitiveLessOrEqual: b selector] | ||
| ifFalse: [a definingClass name caseSensitiveLessOrEqual: b definingClass name]]]) | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> sortStrings: aStringOrSymbolCollection [ | ||
| "We need to define this since different Squeak versions answer different results | ||
| for asSortedCollection and if sort order changes, generated code changes too." | ||
| ^aStringOrSymbolCollection asSortedCollection: [:a :b| a caseSensitiveLessOrEqual: b] | ||
| ] | ||
|
|
||
| { #category : 'public' } | ||
| CCodeGenerator >> sortedExportMethods [ | ||
| "Answer a suitably-sorted array of all exported TMethods" | ||
| ^(methods select: [:m| m export]) asSortedCollection: [:a :b| a selector caseSensitiveLessOrEqual: b selector] | ||
| ] | ||
|
|
||
| { #category : 'public' } | ||
| CCodeGenerator >> staticallyResolveMethodNamed: selector forClass: aClass to: staticallyResolvedSelector [ | ||
| "We allow a limited amount of polymorphism; if a class chooses, its selectoers can be | ||
| prefixed with a given string to disambiguate. This hack allows us to use two different | ||
| compaction algorithms with the same API at the same time; the selection being done | ||
| by a class which holds the flag stating which algorithm is in effect at the current time." | ||
|
|
||
| | method | | ||
|
|
||
| 1halt. | ||
|
|
||
| method selector: staticallyResolvedSelector. | ||
| methods at: staticallyResolvedSelector put: method | ||
| ] | ||
|
|
||
| { #category : 'public' } | ||
| CCodeGenerator >> staticallyResolvedPolymorphicReceiver: variableName to: aClass [ | ||
| "We allow a limited amount of polymorphism; if a class chooses, its selectoers can be | ||
| prefixed with a given string to disambiguate. This hack allows us to use two different | ||
| compaction algorithms with the same API at the same time; the selection being done | ||
| by a class which holds the flag stating which algorithm is in effect at the current time." | ||
| (staticallyResolvedPolymorphicReceivers ifNil: [staticallyResolvedPolymorphicReceivers := Dictionary new]) | ||
| at: variableName | ||
| put: aClass. | ||
|
|
||
| "When the variable is statically defined it should be implicit" | ||
| self declareVar: variableName type: #implicit | ||
|
|
||
| ] | ||
|
|
||
| { #category : 'C translation support' } | ||
| CCodeGenerator >> stepExpressionIsNegative: aNode [ | ||
| "Answer if the step expression (the by: argument in a to:by:do:) is negative." | ||
| self isConstantNode: aNode valueInto: [:stepValue| ^stepValue < 0]. | ||
| (aNode isSend and: [aNode selector == #negated]) ifTrue: | ||
| [self isConstantNode: aNode receiver valueInto: [:stepValue| ^stepValue > 0]]. | ||
| ^false | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> stopOnErrors: aBoolean [ | ||
| stopOnErrors := aBoolean | ||
| ] | ||
|
|
||
| { #category : 'public' } | ||
| CCodeGenerator >> storeCodeOnFile: fileName doInlining: inlineFlag [ | ||
| "Store C code for this code base on the given file." | ||
|
|
||
| self storeCodeOnFile: fileName doInlining: inlineFlag doAssertions: true | ||
| ] | ||
|
|
||
| { #category : 'public' } | ||
| CCodeGenerator >> storeCodeOnFile: fileName doInlining: inlineFlag doAssertions: assertionFlag [ | ||
| "Store C code for this code base on the given file." | ||
|
|
||
| | stream | | ||
| stream := VMMaker forceNewFileNamed: fileName. | ||
| stream ifNil: [Error signal: 'Could not open C code file: ', fileName]. | ||
| self emitCCodeOn: stream doInlining: inlineFlag doAssertions: assertionFlag. | ||
| stream close | ||
| ] | ||
|
|
||
| { #category : 'public' } | ||
| CCodeGenerator >> storeHeaderOnFile: fileName contents: contents [ | ||
| "Store C header code on the given file. Evaluate | ||
| aBlock with the stream to generate its contents." | ||
|
|
||
| | aStream fileNameGuard | | ||
| aStream := VMMaker forceNewFileNamed: fileName. | ||
|
|
||
| fileNameGuard := (fileName asFileReference basename asUppercase replaceAll: $. with: $_) , '__'. | ||
|
|
||
| aStream ifNil: [ self error: 'Could not open C header file: ', fileName]. | ||
|
|
||
| [(contents beginsWith: '/* Automatic') ifFalse: | ||
| [ | ||
| aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr]. | ||
| aStream nextPutAll: ('#ifndef {1} | ||
| #define {1} | ||
| ' format: {fileNameGuard}). | ||
| aStream nextPutAll: contents. | ||
| aStream nextPutAll: '#endif'] | ||
| ensure: [aStream close] | ||
| ] | ||
|
|
||
| { #category : 'inlining' } | ||
| CCodeGenerator >> structAccessorSelectors [ | ||
|
|
||
| ^ methods | ||
| select: [ :m | m isStructAccessor ] | ||
| thenCollect: [ :m | m selector] | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> structClasses [ | ||
|
|
||
| ^ structClasses ifNil: [ #() ] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> structClassesForTranslationClasses: classes [ | ||
| "Answer in superclass order (any superclass precedes any subclass) | ||
| the ancilliaryClasses that are struct classes for all the given classes." | ||
|
|
||
| | theStructClasses | | ||
| theStructClasses := OrderedCollection new. | ||
| classes do: [ :aTranslationClass | | ||
| aTranslationClass ancilliaryClasses do: [ :class | | ||
| (class isStructClass and: [ | ||
| (self isAcceptableAncilliaryClass: class) and: [ | ||
| (theStructClasses includes: class) not ] ]) ifTrue: [ | ||
| theStructClasses addLast: class ] ] ]. | ||
| ^ self superclassOrder: theStructClasses | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> structTargetKindForDeclaration: typeName [ "<String>" | ||
| ^SlangStructType structTargetKindForDeclaration: typeName | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> structTargetKindForVariableName: varName [ "<String>" | ||
| ^(self typeOfVariable: varName) ifNotNil: | ||
| [:declaration| | ||
| self structTargetKindForDeclaration: declaration] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> superclassOrder: classes [ | ||
|
|
||
| ^ Class superclassOrder: classes | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> suppressAsmLabels [ | ||
| ^suppressAsmLabels | ||
| ] | ||
|
|
||
| { #category : 'accessing' } | ||
| CCodeGenerator >> suppressAsmLabels: aBoolean [ | ||
| suppressAsmLabels := aBoolean | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> suppressAsmLabelsWhile: aBlock [ | ||
| | oldSuppressAsmLabels | | ||
| oldSuppressAsmLabels := suppressAsmLabels. | ||
| suppressAsmLabels := true. | ||
| ^aBlock ensure: [suppressAsmLabels := oldSuppressAsmLabels] | ||
| ] | ||
|
|
||
| { #category : 'utilities' } | ||
| CCodeGenerator >> translationMethodClass [ | ||
| "return the class used to produce C translation methods from MethodNodes" | ||
| ^TMethod | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> typeFor: aNode in: aTMethod [ | ||
| ^aNode typeFrom: self in: aTMethod | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> typeForArithmetic: sendNode in: aTMethod [ | ||
|
|
||
| "Answer the return type for an arithmetic sendThis is so that the inliner can still | ||
| inline simple expressions. Deal with pointer arithmetic, floating point arithmetic | ||
| and promotion." | ||
|
|
||
| | rcvrType argType arg | | ||
| rcvrType := sendNode receiver typeOrNilFrom: self in: aTMethod. | ||
| argType := (arg := sendNode arguments first) | ||
| typeOrNilFrom: self | ||
| in: aTMethod. | ||
| "deal with pointer arithmetic" | ||
| ((rcvrType notNil and: [ rcvrType last == $* ]) or: [ | ||
| argType notNil and: [ argType last == $* ] ]) ifTrue: [ | ||
| (rcvrType isNil or: [ argType isNil ]) ifTrue: [ ^ nil ]. | ||
| (rcvrType last == $* and: [ argType last == $* ]) ifTrue: [ | ||
| sendNode selector == #- ifTrue: [ ^ #int ]. | ||
| self error: 'invalid pointer arithmetic' ]. | ||
| ^ rcvrType last == $* | ||
| ifTrue: [ rcvrType ] | ||
| ifFalse: [ argType ] ]. | ||
| ^ (self promoteArithmeticTypes: rcvrType and: argType) ifNotNil: [ | ||
| :promotedType | "We have to be very careful with subtraction. The difference between two unsigned types is signed. | ||
| But we don't want unsigned - constant to be signed. We almost always want this to stay unsigned." | ||
| (sendNode selector == #- and: [ | ||
| promotedType first == $u and: [ | ||
| (arg isConstant and: [ arg value isInteger ]) not ] ]) | ||
| ifTrue: [ | ||
| promotedType allButFirst: | ||
| ((promotedType beginsWith: 'unsigned') | ||
| ifTrue: [ 9 ] | ||
| ifFalse: [ 1 ]) ] | ||
| ifFalse: [ promotedType ] ] | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> typeForConditional: sendNode in: aTMethod [ | ||
|
|
||
| "Answer the return type for a conditional, ifTrue:ifFalse: et al" | ||
|
|
||
| | firstType secondType | | ||
| firstType := self | ||
| typeFor: sendNode arguments first statements last | ||
| in: aTMethod. | ||
| sendNode selector numArgs = 1 ifTrue: [ ^ firstType ]. | ||
| secondType := self | ||
| typeFor: sendNode arguments second statements last | ||
| in: aTMethod. | ||
| ((firstType notNil and: [ | ||
| (self isIntegralCType: firstType) or: [ | ||
| self isFloatingPointCType: firstType ] ]) and: [ | ||
| secondType notNil and: [ | ||
| (self isIntegralCType: secondType) or: [ | ||
| self isFloatingPointCType: secondType ] ] ]) ifTrue: [ | ||
| ^ self promoteArithmeticTypes: firstType and: secondType ]. | ||
| ^ firstType ifNil: [ secondType ] | ||
| ] | ||
|
|
||
| { #category : 'type inference' } | ||
| CCodeGenerator >> typeForDereference: sendNode in: aTMethod [ | ||
| (self typeFor: sendNode receiver in: aTMethod) ifNotNil: | ||
| [:type| | ||
| type last = $* ifTrue: | ||
| [^type allButLast trimBoth]]. | ||
| "It would be nice to warn here, but there are contexts when the type is unknown, for example determining | ||
| the return types of apiMethods. inferTypesForImplicitlyTypedVariablesAndMethods could provide a signal | ||
| handler to suppress the warnings in that case but that's too fancy. Instead we live with the default." | ||
| "logger | ||
| nextPutAll: 'warning, cannot determine type of at: for ', sendNode receiver asString, ' in ', aTMethod selector; | ||
| cr." | ||
| ^#sqInt | ||
| ] | ||
|
|
||
| { #category : 'C code generator' } | ||
| CCodeGenerator >> typeOfVariable: varName [ | ||
| "<String>" | ||
|
|
||
| self assert: varName isString. |
Member
Author
There was a problem hiding this comment.
I will revert this, it's a degugging leftover
guillep
commented
Jul 10, 2026
- use simStackStateField: - move up addressOf:
guillep
force-pushed
the
cleanup-stack-state
branch
from
August 18, 2026 12:34
084adb0 to
ad619b3
Compare
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
1 participant
Add this suggestion to a batch that can be applied as a single commit.This suggestion is invalid because no changes were made to the code.Suggestions cannot be applied while the pull request is closed.Suggestions cannot be applied while viewing a subset of changes.Only one suggestion per line can be applied in a batch.Add this suggestion to a batch that can be applied as a single commit.Applying suggestions on deleted lines is not supported.You must change the existing code in this line in order to create a valid suggestion.Outdated suggestions cannot be applied.This suggestion has been applied or marked resolved.Suggestions cannot be applied from pending reviews.Suggestions cannot be applied on multi-line comments.Suggestions cannot be applied while the pull request is queued to merge.Suggestion cannot be applied right now. Please check back later.
Several cleanups.
Start extracting compiler state to a struct, to isolate transient effects from VM runtime state.