" -*- Smalltalk -*- " ParseNode : Object ( location ) ParseNode location [ ^location ] ParseNode isOpenBlock [ ^false ] ParseNode forTopLevel [ ^self ] ParseNode encodeIn: unit [ self subclassResponsibility: 'encodeIn:' ] ParseNode encode: scope [ self subclassResponsibility: 'encode:' ] ParseNode gen: scope [ self subclassResponsibility: 'gen:' ] ParseNode printOn: aStream indent: indent [ ^super printOn: aStream ] " ---------------------------------------------------------------- " ValueNode : ParseNode ( value ) ValueNode withValue: aNode [ self := super new. value := aNode. ] ValueNode value [ ^value ] ValueNode encode: aScope [ value encode: aScope. location := value location. ] " ---------------------------------------------------------------- " BlockReturnNode : ValueNode () Object isReturnNode [ ^false ] BlockReturnNode isReturnNode [ ^true ] BlockReturnNode gen: unit [ value gen: unit. unit outputStream gen: ' return _'; print: location; gen: ';'; nl ] " ---- " ReturnNode : BlockReturnNode ( level ) ReturnNode initialise [ super initialise. level := 0. ] ReturnNode encode: aScope [ (level := aScope level - 1) > 0 ifTrue: [aScope noteExportNLR]. ^super encode: aScope. ] ReturnNode gen: unit [ level > 0 ifTrue: [| stream | stream := unit outputStream. value gen: unit. stream gen: ' return _nlReturn(_self, ((struct t_BlockClosureNLR *)'. level - 1 timesRepeat: [stream gen: '((struct t_BlockClosure *)']. stream gen: '_self)'. level - 1 timesRepeat: [stream gen: '->outer)']. stream gen: '->_envp, _'; print: value location;gen: ');'; nl] ifFalse: [super gen: unit] ] ReturnNode printOn: aStream indent: indent [ aStream space: indent * 2; nextPut: $^; nl. value printOn: aStream indent: indent + 1 ] " ---------------------------------------------------------------- " LiteralNode : ValueNode ( tag ) LiteralNodeTag : Object () [LiteralNodeTag := 0] LiteralNode initialise [ self := super initialise. tag := (LiteralNodeTag := LiteralNodeTag + 1). ] LiteralNode tag [^tag] LiteralNode encode: aScope [ location := aScope newTemp. aScope lookupClass: self literalClass; declareSelector: self literalSelector; declareLiteral: self. ] LiteralNode genDefinition: unit [ unit outputStream gen: 'static oop l_'; print: tag; gen: '= 0;'; nl ] LiteralNode gen: unit [ unit outputStream gen: ' _'; print: location; gen: '= l_'; print: tag; gen: ';'; nl ] " ---------------------------------------------------------------- " SymbolNode : LiteralNode () SymbolNode fromString: aString [ ^self withValue: aString ] SymbolNode literalClass [ ^'Symbol' ] SymbolNode literalSelector [ ^'_value:' ] SymbolNode genInitialisation: unit [ unit outputStream gen: ' l_'; print: tag; gen: '= _bind(v_Symbol, s__5fvalue_)(v_Symbol, (oop)"'; gen: value; gen: '");'; nl. ] " ---------------------------------------------------------------- " StringNode : LiteralNode () StringNode fromString: aString [ ^self withValue: aString ] StringNode literalClass [ ^'ImmutableString' ] StringNode literalSelector [ ^'_value:' ] StringNode genInitialisation: unit [ | stream | stream := unit outputStream. stream gen: ' l_'; print: tag; gen: '= _bind(v_ImmutableString, s__5fvalue_)(v_ImmutableString, (oop)"'. value do: [:char | char = $" ifTrue: [stream gen: '\\"'] ifFalse: [(char < $ or: [char = $\\ or: [char asciiValue > 126]]) ifTrue: [stream gen: '\\'; gen: char asciiValue octal3] ifFalse: [stream nextPut: char]]]. stream gen: '");'; nl. ] StringNode printOn: aStream indent: indent [ aStream space: indent * 2; print: value; nl ] " ---------------------------------------------------------------- " IntegerNode : LiteralNode () IntegerNode fromString: aString [ | base aStream | aStream := aString readStream. (aString beginsWith: '0x') ifTrue: [base := 16. aStream skip: 2] ifFalse: [base := 10]. ^self withValue: (Integer readFrom: aStream base: base). ] IntegerNode literalClass [ ^'SmallInteger' ] IntegerNode literalSelector [ ^'_value:' ] IntegerNode genInitialisation: unit [ unit outputStream gen: ' l_'; print: tag; gen: '= _bind(v_SmallInteger, s__5fvalue_)(v_SmallInteger, (oop)'; print: value; gen: ');'; nl. ] IntegerNode genByte: unit [ (value between: 0 and: 255) ifFalse: [self error: 'ByteArray element out of range: ', value printString]. unit outputStream gen: '\\', value octal3. ] IntegerNode genWord: unit [ unit outputStream print: value ] " ---------------------------------------------------------------- " CharacterNode : LiteralNode () CharacterNode literalClass [ ^'Character' ] CharacterNode literalSelector [ ^'_value:' ] CharacterNode genInitialisation: unit [ unit outputStream gen: ' l_'; print: tag; gen: '= _bind(v_Character, s__5fvalue_)(v_Character, (oop)'; print: value asciiValue; gen: ');'; nl ] " ---------------------------------------------------------------- " ArrayNode : LiteralNode () ArrayNode withElements: aCollection [ ^super withValue: aCollection. ] ArrayNode literalClass [ ^'ImmutableArray' ] ArrayNode literalSelector [ ^'_size:value:' ] ArrayNode genDefinition: unit [ | stream | stream := unit outputStream. value do: [:element | element genDefinition: unit]. super genDefinition: unit. stream gen: 'static oop *_l_'; print: tag; gen: '['; print: value size; gen: ']= {'; nl. value do: [:element | stream gen: ' &l_'; print: element tag; gen: ','; nl]. stream gen: '};'; nl. ] ArrayNode genInitialisation: unit [ value do: [:element | element genInitialisation: unit]. unit outputStream gen: ' l_'; print: tag; gen: '= _bind(v_ImmutableArray, s__5fsize_value_)(v_ImmutableArray, (oop)'; print: value size; gen: ', (oop)_l_'; print: tag; gen: ');'; nl ] ArrayNode printOn: aStream [ super printOn: aStream. aStream nextPut: $(; print: value; nextPut: $) ] " ---------------------------------------------------------------- " ByteArrayNode : LiteralNode () ByteArrayNode literalClass [ ^'ImmutableByteArray' ] ByteArrayNode literalSelector [ ^'_size:value:' ] ByteArrayNode withElements: aCollection [ ^super withValue: aCollection. ] ByteArrayNode genInitialisation: unit [ | stream | stream := unit outputStream. stream gen: ' l_'; print: tag; gen: '= _bind(v_ImmutableByteArray, s__5fsize_value_)(v_ImmutableByteArray, (oop)'; print: value size; gen: ', (oop)"'. value do: [:byte | byte genByte: unit]. stream gen: '");'; nl. ] ByteArrayNode printOn: aStream [ super printOn: aStream. aStream nextPut: $[; print: value; nextPut: $] ] " ---------------------------------------------------------------- " WordArrayNode : LiteralNode () WordArrayNode literalClass [ ^'ImmutableWordArray' ] WordArrayNode literalSelector [ ^'_size:value:' ] WordArrayNode withElements: aCollection [ ^super withValue: aCollection. ] WordArrayNode genDefinition: unit [ | stream | stream := unit outputStream. super genDefinition: unit. stream gen: 'int _l_'; print: tag; gen: '['; print: value size; gen: ']= {'; nl. value do: [:word | stream space: 2. word genWord: unit. stream gen: ','; nl]. stream gen: '};'; nl. ] WordArrayNode genInitialisation: unit [ unit outputStream gen: ' l_'; print: tag; gen: '= _bind(v_WordArray, s__5fsize_value_)(v_WordArray, (oop)'; print: value size; gen: ', (oop)_l_'; print: tag; gen: ');'; nl. ] WordArrayNode printOn: aStream [ super printOn: aStream. aStream nextPut: ${; print: value; nextPut: $} ] " ---------------------------------------------------------------- " VariableNode : ParseNode ( name variable ) Object isVariableNode [ ^false ] VariableNode isVariableNode [ ^true ] VariableNode withName: nameString [ self := self new. name := nameString. variable := nil. ] VariableNode name [ ^name ] VariableNode beSelf [ self assert: [name = 'super']. name := 'self'. ] VariableNode encodeLvalue: aScope [ variable := aScope lookup: name. ] VariableNode encode: aScope [ variable := aScope lookup: name. location := aScope newTemp. ] VariableNode genLvalue: unit [ variable gen: unit ] VariableNode gen: unit [ | stream | stream := unit outputStream. stream gen: ' _'; print: location; gen: '= '. variable gen: unit. stream gen: ';'; nl. ] VariableNode printOn: aStream indent: indent [ aStream space: indent * 2; nextPutAll: 'VAR('; nextPutAll: name; nextPut: $); nl ] " ---------------------------------------------------------------- " AssignmentNode : ParseNode ( variable value ) AssignmentNode withVariable: variableNode value: valueNode [ self := self new. variable := variableNode. value := valueNode. ] AssignmentNode encode: scope [ variable encodeLvalue: scope. value encode: scope. location := value location. ] AssignmentNode gen: unit [ | stream | stream := unit outputStream. value gen: unit. stream gen: ' '. variable genLvalue: unit. stream gen: '= _'; print: location; gen: ';'; nl. ] AssignmentNode printOn: aStream indent: indent [ aStream space: indent * 2; print: variable; nextPutAll: ' :='; nl. value printOn: aStream indent: indent + 1 ] " ---------------------------------------------------------------- " ExternNode : ParseNode ( code ) Object isExternNode [ ^false ] ExternNode isExternNode [ ^true ] ExternNode withCode: aString [ self := self _clone. code := aString. ] ExternNode forTopLevel [ ^ExecNode withStatement: self ] ExternNode encode: aScope [ location := aScope newTemp. ^self ] ExternNode gen: unit [ unit outputStream gen: ' '; gen: code; nl; gen: ' ; _'; print: location; gen: '= 0;'; nl ] ExternNode printOn: aStream [ super printOn: aStream. aStream nextPut: ${; nextPutAll: code; nextPut: $} ] " ---------------------------------------------------------------- " SendNode : ParseNode ( receiver selector mangled arguments cascade supered macro ) Object isSendNode [ ^false ] SendNode isSendNode [ ^true ] SendNode withReceiver: rcv selector: sel [ self := self new. receiver := rcv. selector := sel. mangled := sel. arguments := OrderedCollection new. cascade := nil. supered := nil. macro := nil. ] SendNode cascade [ ^cascade ] SendNode addKeyword: keyword [ selector := selector , keyword ] SendNode addArgument: argument [ arguments add: argument ] SendNode addCascade: sendNode [ cascade isNil ifTrue: [cascade := sendNode] ifFalse: [cascade addCascade: sendNode] ] SendNode supered: base [ supered := base. cascade notNil ifTrue: [cascade supered: base] ] MacroEncoders : Dictionary () [(MacroEncoders := MacroEncoders new) at: #+ put: #encodeAdd:; at: #- put: #encodeSub:; at: #* put: #encodeMul:; at: #// put: #encodeDiv:; at: #\\\\ put: #encodeMod:; at: #< put: #encodeLT:; at: #<= put: #encodeLE:; at: #= put: #encodeEQ:; at: #== put: #encodeID:; at: #~~ put: #encodeNI:; at: #~= put: #encodeNE:; at: #>= put: #encodeGE:; at: #> put: #encodeGT:; at: #bitAnd: put: #encodeBitAnd:; at: #bitOr: put: #encodeBitOr:; at: #bitXor: put: #encodeBitXor:; at: #value put: #encodeValue:; at: #and: put: #encodeAnd:; at: #or: put: #encodeOr:; at: #ifTrue: put: #encodeIfTrue:; at: #ifTrue:ifFalse: put: #encodeIfTrueIfFalse:; at: #ifFalse: put: #encodeIfFalse:; at: #ifFalse:ifTrue: put: #encodeIfFalseIfTrue:; at: #whileTrue put: #encodeWhileTrue:; at: #whileTrue: put: #encodeWhileTrueArg:; at: #whileFalse put: #encodeWhileFalse:; at: #whileFalse: put: #encodeWhileFalseArg: ] SendNode encodeBinary: aScope [ receiver encode: aScope. arguments first encode: aScope. aScope freeTemp. location := receiver location. ] SendNode encodeAdd: aScope [ macro := #genAdd:. ^self encodeBinary: aScope ] SendNode encodeSub: aScope [ macro := #genSub:. ^self encodeBinary: aScope ] SendNode encodeMul: aScope [ macro := #genMul:. ^self encodeBinary: aScope ] SendNode encodeDiv: aScope [ macro := #genDiv:. ^self encodeBinary: aScope ] SendNode encodeMod: aScope [ macro := #genMod:. ^self encodeBinary: aScope ] SendNode encodeBitAnd: aScope [ macro := #genBitAnd:. ^self encodeBinary: aScope ] SendNode encodeBitOr: aScope [ macro := #genBitOr:. ^self encodeBinary: aScope ] SendNode encodeBitXor: aScope [ macro := #genBitXor:. ^self encodeBinary: aScope ] SendNode encodeLT: aScope [ macro := #genLT:. ^self encodeBinary: aScope ] SendNode encodeLE: aScope [ macro := #genLE:. ^self encodeBinary: aScope ] SendNode encodeEQ: aScope [ macro := #genEQ:. ^self encodeBinary: aScope ] SendNode encodeID: aScope [ macro := #genID:. ^self encodeBinary: aScope ] SendNode encodeNI: aScope [ macro := #genNI:. ^self encodeBinary: aScope ] SendNode encodeNE: aScope [ macro := #genNE:. ^self encodeBinary: aScope ] SendNode encodeGE: aScope [ macro := #genGE:. ^self encodeBinary: aScope ] SendNode encodeGT: aScope [ macro := #genGT:. ^self encodeBinary: aScope ] SendNode encodeValue: aScope [ ^receiver isOpenBlock ifTrue: [macro := #genValue. receiver encodeOpen: aScope. location := receiver location. self] ifFalse: [nil] ] SendNode warnBlockReceiver [ receiver isBlockNode ifTrue: ['WARNING: sending ', selector, ' to a literal block is probably not what you intended' println] ] SendNode encodeAnd: aScope [ self warnBlockReceiver. ^arguments first isOpenBlock ifTrue: [macro := #genAnd:. receiver encode: aScope. arguments first encodeOpen: aScope. aScope freeTemp. location := receiver location. self] ifFalse: [nil] ] SendNode encodeOr: aScope [ self warnBlockReceiver. ^arguments first isOpenBlock ifTrue: [macro := #genOr:. receiver encode: aScope. arguments first encodeOpen: aScope. aScope freeTemp. location := receiver location. self] ifFalse: [nil] ] SendNode encodeIfTrue: aScope [ self warnBlockReceiver. ^arguments first isOpenBlock ifTrue: [macro := #genIfTrue:. receiver encode: aScope. arguments first encodeOpen: aScope. aScope freeTemp. location := receiver location. self] ifFalse: [nil] ] SendNode encodeIfFalse: aScope [ self warnBlockReceiver. ^arguments first isOpenBlock ifTrue: [macro := #genIfFalse:. receiver encode: aScope. arguments first encodeOpen: aScope. aScope freeTemp. location := receiver location. self] ifFalse: [nil] ] SendNode encodeIfTrueIfFalse: aScope [ self warnBlockReceiver. ^(arguments first isOpenBlock and: [arguments second isOpenBlock]) ifTrue: [macro := #genIfTrueIfFalse:. receiver encode: aScope. arguments first encodeOpen: aScope. aScope freeTemp. arguments second encodeOpen: aScope. aScope freeTemp. location := receiver location. self assert: [arguments first location = arguments second location]. self] ifFalse: [nil] ] SendNode encodeIfFalseIfTrue: aScope [ self error: 'SendNode cowardly refusing to encode #ifFalse:ifTrue:' ] SendNode encodeWhileTrue: aScope [ ^receiver isOpenBlock ifTrue: [macro := #genWhileTrue:. receiver encodeOpen: aScope. location := receiver location. self] ifFalse: [nil] ] SendNode encodeWhileTrueArg: aScope [ ^(receiver isOpenBlock and: [arguments first isOpenBlock]) ifTrue: [macro := #genWhileTrueArg:. receiver encodeOpen: aScope. aScope freeTemp. arguments first encodeOpen: aScope. location := arguments first location. self] ifFalse: [nil] ] SendNode encodeWhileFalse: aScope [ ^receiver isOpenBlock ifTrue: [macro := #genWhileFalse:. receiver encodeOpen: aScope. location := receiver location. self] ifFalse: [nil] ] SendNode encodeWhileFalseArg: aScope [ ^(receiver isOpenBlock and: [arguments first isOpenBlock]) ifTrue: [macro := #genWhileFalseArg:. receiver encodeOpen: aScope. aScope freeTemp. arguments first encodeOpen: aScope. location := arguments first location. self] ifFalse: [nil] ] SendNode encodeMacro: aScope [ cascade notNil ifTrue: [^nil]. ^self perform: (MacroEncoders at: selector ifAbsent: [^nil]) with: aScope ] SendNode encodeCascade: aScope location: aLocation [ location := aLocation. mangled := aScope declareSelector: selector. arguments do: [:arg | arg encode: aScope]. aScope freeTemps: arguments size. cascade notNil ifTrue: [cascade encodeCascade: aScope location: aLocation] ] SendNode encode: aScope [ | encoded | mangled := aScope declareSelector: selector. (encoded := self encodeMacro: aScope) notNil ifTrue: [^encoded]. (receiver isVariableNode and: [receiver name = 'super']) ifTrue: [| base | (base := aScope class base) isNil ifTrue: [self error: 'cannot send to super at root of hierarchy']. self supered: base. receiver beSelf]. receiver encode: aScope. location := receiver location. self encodeCascade: aScope location: location. ] SendNode genAdd: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= (oop)((int)_'; print: receiver location; gen: ' + (int)_'; print: arg location; gen: ' - 1);'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genSub: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= (oop)((int)_'; print: receiver location; gen: ' - (int)_'; print: arg location; gen: ' + 1);'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genMul: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= _integerObject(_integerValue(_'; print: receiver location; gen: ') * _integerValue(_'; print: arg location; gen: '));'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genDiv: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= _integerObject(_integerValue(_'; print: receiver location; gen: ') / _integerValue(_'; print: arg location; gen: '));'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genMod: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= _integerObject(_integerValue(_'; print: receiver location; gen: ') % _integerValue(_'; print: arg location; gen: '));'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genBitAnd: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= (oop)(((int)_'; print: receiver location; gen: ' & (int)_'; print: arg location; gen: ') | 1);'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genBitOr: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= (oop)((int)_'; print: receiver location; gen: ' | (int)_'; print: arg location; gen: ');'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genBitXor: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= (oop)(((int)_'; print: receiver location; gen: ' ^ (int)_'; print: arg location; gen: ') | 1);'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genLT: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= ((int)_'; print: receiver location; gen: ' < (int)_'; print: arg location; gen: ')'; gen: ' ? v_true : v_false;'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genLE: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= ((int)_'; print: receiver location; gen: ' <= (int)_'; print: arg location; gen: ')'; gen: ' ? v_true : v_false;'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genEQ: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= ((int)_'; print: receiver location; gen: ' == (int)_'; print: arg location; gen: ')'; gen: ' ? v_true : v_false;'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genID: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' _'; print: location; gen: '= (_'; print: receiver location; gen: ' == _'; print: arg location; gen: ')'; gen: ' ? v_true : v_false;'; nl. ] SendNode genNI: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' _'; print: location; gen: '= (_'; print: receiver location; gen: ' != _'; print: arg location; gen: ')'; gen: ' ? v_true : v_false;'; nl. ] SendNode genNE: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= ((int)_'; print: receiver location; gen: ' != (int)_'; print: arg location; gen: ')'; gen: ' ? v_true : v_false;'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genGE: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= ((int)_'; print: receiver location; gen: ' >= (int)_'; print: arg location; gen: ')'; gen: ' ? v_true : v_false;'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genGT: unit [ | stream arg | stream := unit outputStream. arg := arguments first. receiver gen: unit. arg gen: unit. stream gen: ' if (_areIntegerObjects(_'; print: receiver location; gen: ', _'; print: arg location; gen: '))'; nl; gen: ' _'; print: location; gen: '= ((int)_'; print: receiver location; gen: ' > (int)_'; print: arg location; gen: ')'; gen: ' ? v_true : v_false;'; nl; gen: ' else'; nl; gen: ' _'; print: location; gen: '= _bind(_'; print: receiver location; gen: ', '; gen: mangled; gen: ')'; gen: '(_'; print: receiver location; gen: ', _'; print: arg location; gen: ');'; nl. ] SendNode genAnd: unit [ | stream | stream := unit outputStream. receiver gen: unit. stream gen: ' if (_'; print: location; gen: ') {'; nl. arguments first genSequence: unit. stream gen: ' _'; print: location; gen: '= _'; print: arguments first location; gen: ';'; nl. stream gen: ' }'; nl. ] SendNode genOr: unit [ | stream | stream := unit outputStream. receiver gen: unit. stream gen: ' if (!_'; print: location; gen: ') {'; nl. arguments first genSequence: unit. stream gen: ' _'; print: location; gen: '= _'; print: arguments first location; gen: ';'; nl. stream gen: ' }'; nl. ] SendNode genIfTrue: unit [ | stream | stream := unit outputStream. receiver gen: unit. stream gen: ' if (_'; print: location; gen: ') {'; nl. arguments first genSequence: unit. stream gen: ' _'; print: location; gen: '= _'; print: arguments first location; gen: ';'; nl. stream gen: ' } else _'; print: location; gen: '= 0;'; nl. ] SendNode genIfTrueIfFalse: unit [ | stream | stream := unit outputStream. receiver gen: unit. stream gen: ' if (_'; print: location; gen: ') {'; nl. arguments first genSequence: unit. stream gen: ' } else {'; nl. arguments second genSequence: unit. stream gen: ' } _'; print: location; gen: '= _'; print: arguments second location; gen: ';'; nl. ] SendNode genIfFalse: unit [ | stream | stream := unit outputStream. receiver gen: unit. stream gen: ' if (!_'; print: location; gen: ') {'; nl. arguments first genSequence: unit. stream gen: ' _'; print: location; gen: '= _'; print: arguments first location; gen: ';'; nl. stream gen: ' } else _'; print: location; gen: '= 0;'; nl. ] SendNode genWhileFalseArg: unit [ | stream | stream := unit outputStream. stream gen: ' for (;;) {'; nl. receiver genSequence: unit. stream gen: ' if (_'; print: location; gen: ') break;'; nl. arguments first genSequence: unit. stream gen: ' };'; nl. ] SendNode genWhileTrueArg: unit [ | stream | stream := unit outputStream. stream gen: ' for (;;) {'; nl. receiver genSequence: unit. stream gen: ' if (!_'; print: location; gen: ') break;'; nl. arguments first genSequence: unit. stream gen: ' };'; nl. ] SendNode gen: unit [ macro notNil ifTrue: [self perform: macro with: unit] ifFalse: [receiver gen: unit. self genCascade: unit]. ] SendNode genCascade: unit [ | stream | stream := unit outputStream. arguments do: [:arg | arg gen: unit]. stream gen: ' '. cascade isNil ifTrue: [stream gen: '_'; print: location; gen: '= ']. supered isNil ifTrue: [stream gen: '_bind(_'; print: location; gen: ', '; gen: mangled; gen: ')(_'; print: location] ifFalse: [stream gen: '_rebind(v_'; gen: supered name; gen: ', '; gen: mangled; gen: ')(_'; print: location]. arguments do: [:arg | stream gen: ', _'; print: arg location]. stream gen: ');'; nl. cascade notNil ifTrue: [cascade genCascade: unit] ] SendNode printOn: aStream indent: indent [ aStream space: indent * 2; nextPutAll: 'SEND '; nextPutAll: selector; nl. receiver notNil ifTrue: [receiver printOn: aStream indent: indent + 1]. arguments do: [:arg | arg printOn: aStream indent: indent + 1]. [(self := self cascade) notNil] whileTrue: [aStream space: indent * 2; nextPut: $;; nl. self printOn: aStream indent: indent + 1] ] " ---------------------------------------------------------------- " SequenceNode : ParseNode ( temporaries statements literals scope ) SequenceNode initialise [ super initialise. temporaries := OrderedCollection new. statements := OrderedCollection new. literals := IdentitySet new. scope := nil. ] SequenceNode addTemporary: node [ temporaries add: node ] SequenceNode addStatement: node [ statements add: node ] SequenceNode lastStatement [ ^statements last ] SequenceNode external: externNode [ statements add: externNode ] SequenceNode encodeOpen: aScope [ scope := aScope. temporaries := temporaries collect: [:temp | scope declareLocal: temp]. statements do: [:stmt | (stmt encode: scope) location notNil ifTrue: [scope freeTemp]]. location := aScope newTemp ] SequenceNode encodeSequence: aScope [ self assert: [scope == aScope]. temporaries := temporaries collect: [:temp | scope declareLocal: temp]. statements do: [:stmt | (stmt encode: scope) location notNil ifTrue: [scope freeTemp]] ] SequenceNode genImplementation: unit [self notImplemented: 'genImplementation:'] SequenceNode genInitialisationIn: unit [self notImplemented: 'genInitialisationIn:'] SequenceNode gen: unit [self notImplemented: 'gen:'] SequenceNode genSequence: unit [ | stream nTemps | stream := unit outputStream. nTemps := scope isNil ifTrue: [0] ifFalse: [scope tempCount]. stream gen: ' {'; nl. temporaries do: [:temp | temp isExported ifFalse: [stream gen: ' oop '; gen: temp mangledName; gen: ';'; nl]]. nTemps > 0 ifTrue: [stream gen: ' oop _1'. 2 to: nTemps do: [:n | stream gen: ', _'; print: n]. stream gen: ';'; nl. scope resetTemps]. statements do: [:stmt | stmt gen: unit]. stream gen: ' }'; nl. ] " ---------------------------------------------------------------- " BlockNode : SequenceNode ( arguments variadic tag ) BlockNodeTag : Object () [BlockNodeTag := 0] BlockNode initialise [ super initialise. arguments := OrderedCollection new. variadic := false. tag := 0. ] Object isBlockNode [ ^false ] BlockNode isBlockNode [ ^true ] BlockNode beVariadic [ variadic := true ] BlockNode addArgument: node [ arguments add: node ] BlockNode isOpenBlock [ ^arguments isEmpty and: [statements isEmpty or: [statements last isReturnNode not]] ] BlockNode ensureReturn [ statements isEmpty ifTrue: [statements add: (BlockReturnNode withValue: (VariableNode withName: 'nil'))] ifFalse: [(statements last isReturnNode) ifFalse: [| last | last := statements removeLast. statements addLast: (BlockReturnNode withValue: last)]] ] BlockNode encode: aScope [ tag := (BlockNodeTag := BlockNodeTag + 1). aScope addBlock: self. location := aScope newTemp. self assert: [scope isNil]. scope := aScope innerScopeFor: self. self encodeBlock: scope. ] BlockNode encodeBlock: aScope [ self assert: [scope notNil]. arguments := arguments collect: [:arg | scope declareLocal: arg]. self ensureReturn; encodeSequence: scope. ] BlockNode genDefinition: unit [ scope genDefinitions: unit. scope isStatic ifTrue: [unit outputStream gen: 'static oop c_'; print: tag; gen: '= 0;'; nl] ] BlockNode genImplementation: unit [ | stream | scope genImplementations: unit. stream := unit outputStream. stream gen: 'static oop b_'; print: tag; gen: '(oop _self'. arguments do: [:arg | stream gen: ', oop '; gen: arg mangledName]. stream gen: ')'; nl; gen: '{'; nl. scope exports > 0 ifTrue: [stream gen: ' oop *_state= (oop *)_newPointers(sizeof(oop) * '; print: scope exports; gen: ');'; nl. arguments do: [:arg | arg isExported ifTrue: [stream gen: ' _state['; print: arg offset; gen: ']= '; gen: arg mangledName; gen: ';'; nl]]]. self genSequence: unit. stream gen: '}'; nl; nl ] BlockNode genInitialisationIn: unit [self notImplemented: 'genInitialisationIn:'] BlockNode genInitialisation: unit [ scope genInitialisations: unit. scope isStatic ifTrue: [unit outputStream gen: ' c_'; print: tag; gen: '= _bind(v_StaticBlock, s__5fentry__5farity_)'; gen: '(v_StaticBlock, b_'; print: tag; gen: ', '; print: arguments size; gen: ');'; nl] ] BlockNode genStatic: unit [ unit outputStream gen: ' _'; print: location; gen: '= c_'; print: tag; gen: ';'; nl ] BlockNode genFull: unit [ | parent | parent := scope parent. unit outputStream gen: ' _'; print: location; gen: '= _bind(v_BlockClosure, s__5fentry__5farity_receiver_state_outer_)('; gen: 'v_BlockClosure, '; "receiver" gen: 'b_'; print: tag; gen: ', '; "entry" print: arguments size; gen: ', '; "arity" gen: (parent isMethod "self" ifTrue: ['self, '] ifFalse: ['((struct t_BlockClosure *)_self)->receiver, ']); gen: (parent exports > 0 ifTrue: ['_state, '] ifFalse: ['0, ']); "state" gen: (parent isMethod ifTrue: ['0'] ifFalse: ['_self']); "outer" gen: ');'; nl ] BlockNode genNLR: unit [ | parent | parent := scope parent. unit outputStream gen: ' _'; print: location; gen: '= _bind(v_BlockClosureNLR, s__5fentry__5farity_receiver_state_envp_)('; gen: 'v_BlockClosureNLR, '; "receiver" gen: 'b_'; print: tag; gen: ', '; "entry" print: arguments size; gen: ', '; "arity" gen: (parent isMethod "self" ifTrue: ['self, '] ifFalse: ['((struct t_BlockClosure *)_self)->receiver, ']); gen: (parent exports > 0 ifTrue: ['_state, '] ifFalse: ['0, ']); "state" gen: '&_env);'; "envp" nl ] BlockNode gen: unit [ scope isStatic ifTrue: [self genStatic: unit] ifFalse: [scope parent exportNLR ifTrue: [self genNLR: unit] ifFalse: [self genFull: unit]] ] BlockNode printOn: aStream indent: indent [ aStream space: indent; nextPutAll: '[ :'. arguments printElementsOn: aStream. aStream nextPutAll: ' | '. temporaries printElementsOn: aStream. aStream nextPutAll: ' |'; nl. statements do: [:stmt | stmt printOn: aStream indent: indent + 1]. ] " ---------------------------------------------------------------- " MethodNode : BlockNode ( class selector ) ParseNode isMethod [^false] MethodNode isMethod [^true] MethodNode withClass: classString selector: selectorString arguments: argumentCollection [ self := super new. class := classString. selector := selectorString. arguments := argumentCollection. ] MethodNode class [ ^class ] MethodNode ensureReturn [ (statements isEmpty or: [statements last isReturnNode not]) ifTrue: [statements add: (BlockReturnNode withValue: (VariableNode withName: 'self'))] ] MethodNode encodeIn: aScope [ self assert: [scope isNil]. scope := aScope innerScopeFor: self. selector := scope declareSelector: selector. class := scope lookupClass: class. scope declareState: class. scope declare: 'self' as: SelfVariable new. super encodeBlock: aScope. ] MethodNode genDeclarationIn: unit [ scope genDefinitions: unit ] MethodNode genDefinition: unit [ self notImplemented: 'genDefinition:' ] MethodNode genImplementationIn: unit [ | stream | scope genImplementations: unit. stream := unit outputStream. stream gen: 'static oop '; gen: class name; gen: '__'; gen: selector; gen: '(oop self'. arguments do: [:arg | stream gen: ', oop '; gen: arg mangledName]. variadic ifTrue: [stream gen: ', ...']. stream gen: ')'; nl; gen: '{'; nl. scope exportNLR ifTrue: [stream gen: ' jmp_buf _env;'; nl]. scope exports > 0 ifTrue: [ stream gen: ' oop *_state= (oop *)_newPointers(sizeof(oop) * '; print: scope exports; gen: ');'; nl. arguments do: [:arg | arg isExported ifTrue: [stream gen: ' _state['; print: arg offset; gen: ']= '; gen: arg mangledName; gen: ';'; nl]] ]. scope exportNLR ifTrue: [stream gen: ' if (setjmp(_env)) { return _nlAnswer; };'; nl]. self genSequence: unit. stream gen: '}'; nl; nl. ] MethodNode genInitialisationIn: unit [ scope genInitialisations: unit. unit outputStream gen: ' _method('; gen: class mangledName; gen: ', '; gen: selector; gen: ', (imp_t)'; gen: class name; gen: '__'; gen: selector; gen: ');'; nl ] MethodNode genImplementation: unit [self notImplemented: 'genImplementation:'] MethodNode gen: unit [self notImplemented: 'gen:'] MethodNode printOn: aStream [ aStream print: class; nextPutAll: '>>'; nextPutAll: selector. arguments printElementsOn: aStream. aStream nextPutAll: ' | '. temporaries printElementsOn: aStream. aStream nextPutAll: ' | #'. literals printElementsOn: aStream. ] MethodNode printOn: aStream indent: indent [ aStream space: indent * 2. self printOn: aStream. aStream nl. statements do: [:stmt | stmt printOn: aStream indent: indent + 1]. aStream nl. ] " ---------------------------------------------------------------- " ExecNode : SequenceNode () ExecNode withStatement: parseNode [ ^self new addStatement: parseNode ] ExecNode isMethod [^true] ExecNode encodeIn: aScope [ scope := aScope innerScopeFor: self. scope declare: 'self' as: (LocalVariable withName: 'self' mangledName: 'nil' level: 1). self encodeSequence: scope. ] ExecNode genDeclarationIn: unit [ scope genDefinitions: unit ] ExecNode genDefinition: unit [ self notImplemented: 'genDefinition:' ] ExecNode genImplementationIn: unit [ scope genImplementations: unit. ] ExecNode genInitialisationIn: unit [ | stream | scope genInitialisations: unit. stream := unit outputStream. stream gen: ' {'; nl. scope exports > 0 ifTrue: [stream gen: ' oop *_state= (oop *)_newPointers(sizeof(oop) * '; print: scope exports; gen: ');'; nl]. self genSequence: unit. stream gen: ' }'; nl. ] ExecNode genImplementation: unit [self notImplemented: 'genImplementation:'] ExecNode gen: unit [self notImplemented: 'gen:'] ExecNode printOn: aStream [ aStream nextPutAll: 'Exec('. super printOn: aStream. aStream nextPut: $). ] " ---------------------------------------------------------------- " ClassNode : ParseNode ( name mangledName typeName base slots ) ClassNode name [ ^name ] ClassNode base [ ^base ] ClassNode mangledName [ ^mangledName ] ClassNode typeName [ ^typeName ] ClassNode slots [ ^slots ] Object isClassNode [ ^false ] ClassNode isClassNode [ ^true ] ClassNode withName: nameString base: baseString slots: slotCollection [ self := self new. name := nameString. base := baseString. slots := slotCollection. ] ClassNode = aClassNode [ ^aClassNode isClassNode and: [name = aClassNode name and: [base = aClassNode base and: [slots = aClassNode slots]]] ] ClassNode declareIn: aScope [ slots do: [:slot | aScope declare: slot name as: slot]. ] ClassNode encodeIn: translationUnit [ | members declaration | mangledName := translationUnit mangleVariable: name. typeName := 't_' , name. members := OrderedCollection new. base notNil ifTrue: [ base := translationUnit lookupClass: base. base isClassNode ifFalse: [self error: 'base is not a prototype: ' , base printString]. members addAll: base slots ]. slots do: [ :slotName | | var | var := ReceiverVariable withName: slotName mangledName: (translationUnit mangleSlot: slotName) class: self. (members includes: var) ifTrue: [self error: 'slot name ' , slotName , ' already used']. members add: var]. slots := members asArray. (declaration := translationUnit declareClass: self) == self ifTrue: [translationUnit declareSelector: '_sizeof'; declareSelector: '_debugName'. " declareSelector: 'is' , name."] ifFalse: [name := nil]. ^declaration ] ClassNode genDeclarationIn: unit [ name isNil ifFalse: [ | stream | stream := unit outputStream. stream nextPutAll: 'struct t_'; nextPutAll: name ; nl; nextPutAll: '{' ; nl; nextPutAll: ' vtbl_t _vtbl[0];' ; nl. slots do: [:slot | stream nextPutAll: ' oop ', slot name, ';' ; nl]. stream nextPutAll: '};' ; nl; nl ] ] ClassNode genImplementationIn: unit [ name isNil ifFalse: [unit outputStream gen: 'static int '; gen: name; gen: '__5fsizeof(oop self) { return sizeof(struct t_'; gen: name; gen: '); }' ; nl; gen: 'static char *'; gen: name; gen: '__5fdebugName(oop self) { return "'; gen: name; gen: '"; }' ; nl; nl "gen: 'static oop '; gen: name; gen: '_is'; gen: name; gen: '(oop self) { return v_true; }' ; nl; nl"] ] ClassNode genInitialisationIn: unit [ name isNil ifFalse: [ | stream | stream := unit outputStream. base notNil ifTrue: [stream gen: ' '; gen: mangledName; gen: '=_proto('; gen: base mangledName; gen: ');'; nl] ifFalse: [stream gen: ' '; gen: mangledName; gen: '=_proto(0);'; nl]. " name = 'SmallInteger' ifTrue: [stream gen: ' '; gen: mangledName; gen: '=_tagged('; gen: mangledName; gen: ');'; nl]. name = 'UndefinedObject' ifTrue: [stream gen: ' '; gen: mangledName; gen: '=_undefined('; gen: mangledName; gen: ');'; nl]. " stream gen: ' _method('; gen: mangledName; gen: ', s__5fsizeof, (imp_t)'; gen: name; gen: '__5fsizeof);'; nl; gen: ' _method('; gen: mangledName; gen: ', s__5fdebugName, (imp_t)'; gen: name; gen: '__5fdebugName);'; nl ] ] ClassNode printOn: aStream [ aStream nextPutAll: (name isNil ifTrue: ['nil'] ifFalse: [name]); nextPut: $:. base isNil ifTrue: [aStream print: base] ifFalse: [aStream nextPutAll: (base isString ifTrue: [base] ifFalse: [base name])]. slots printElementsOn: aStream. ]