"====================================================================== | | C expression node support | | $Revision: 1.7.5$ | $Date: 2000/05/28 16:56:52$ | $Author: pb$ | ======================================================================" "====================================================================== | | Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc. | Written by Steve Byrne. | | This file is part of GNU Smalltalk. | | GNU Smalltalk is free software; you can redistribute it and/or modify it | under the terms of the GNU General Public License as published by the Free | Software Foundation; either version 2, or (at your option) any later version. | | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more | details. | | You should have received a copy of the GNU General Public License along with | GNU Smalltalk; see the file COPYING. If not, write to the Free Software | Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | ======================================================================" " | Change Log | ============================================================================ | Author Date Change | " Object subclass: #CExpressionNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: nil ! CExpressionNode subclass: #CBinaryExpressionNode instanceVariableNames: 'left op right' classVariableNames: '' poolDictionaries: '' category: nil ! CExpressionNode subclass: #CPrefixUnaryExpressionNode instanceVariableNames: 'op expr' classVariableNames: '' poolDictionaries: '' category: nil ! CExpressionNode subclass: #CPostfixUnaryExpressionNode instanceVariableNames: 'expr op' classVariableNames: '' poolDictionaries: '' category: nil ! !CExpressionNode class methodsFor: 'subclass creation'! subclass: subclassName ^self subclass: subclassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: nil ! ! !CExpressionNode methodsFor: 'evaluation'! evaluate ^self subclassResponsibility ! isCValueTrue: value ^value ~= 0 ! boolToCValue: aBoolean ^aBoolean ifTrue: [ 1 ] ifFalse: [ 0 ] ! ! !CPrefixUnaryExpressionNode class methodsFor: 'instance creation'! op: operator expr: anExpression ^self new op: operator expr: anExpression ! ! !CPrefixUnaryExpressionNode methodsFor: 'assignment'! op: operator expr: anExpression op _ operator. expr _ anExpression ! ! CPrefixUnaryExpressionNode subclass: #UMinusNode! CPrefixUnaryExpressionNode subclass: #UPlusNode! CPrefixUnaryExpressionNode subclass: #BitInvertNode! CPrefixUnaryExpressionNode subclass: #LogicalComplementNode "Why Dr. McCoy, you are indeed today looking every bit the splendid example of humanity at its finest" "What's got into you, you pointed eared Vulcan?"! CPrefixUnaryExpressionNode subclass: #DereferenceNode! CPrefixUnaryExpressionNode subclass: #AddressOfNode! CPrefixUnaryExpressionNode subclass: #SizeOfNode! CPrefixUnaryExpressionNode subclass: #CastNode! CPrefixUnaryExpressionNode subclass: #PreIncrementNode! CPrefixUnaryExpressionNode subclass: #PreDecrementNode! !UMinusNode methodsFor: 'evaluation'! evaluate ^expr evaluate negated ! ! !UPlusNode methodsFor: 'evaluation'! evaluate ^expr evaluate ! ! !BitInvertNode methodsFor: 'evaluation'! evaluate ^expr evaluate bitInvert ! ! !LogicalComplementNode methodsFor: 'evaluation'! evaluate (self isCValueTrue: (expr evaluate)) ifTrue: [ ^0 ] ifFalse: [ ^1 ] ! ! !DereferenceNode methodsFor: 'evaluation'! evaluate ^self error: 'Cannot yet evaluate a dereference!' ! ! !AddressOfNode methodsFor: 'evaluation'! evaluate ^self error: 'AddressOf operation not yet supported!' ! ! !SizeOfNode methodsFor: 'evaluation'! evaluate | value | (expr isKindOf: CExpressionNode) ifTrue: [ value _ expr evaluate. ^self error: 'sizeof expressions not yet done!' ] ifFalse: [ "must be a type, so ask the type what its size is" ^expr sizeOf ] ! ! !CastNode methodsFor: 'evaluation'! evaluate ^self error: 'Cast evaluation not yet supported!' ! ! !PreIncrementNode methodsFor: 'evaluation'! evaluate ^self error: 'Cannot evaluate a prefix increment!' ! ! !PreDecrementNode methodsFor: 'evaluation'! evaluate ^self error: 'Cannot evaluate a prefix decrement!' ! ! !CPostfixUnaryExpressionNode class methodsFor: 'instance creation'! expr: anExpression op: operator ^self new expr: anExpression op: operator ! ! !CPostfixUnaryExpressionNode methodsFor: 'assignment'! expr: anExpression op: operator expr _ anExpression. op _ operator. ! ! !CPostfixUnaryExpressionNode methodsFor: 'evaluation'! evaluate ^self error: 'Cannot evaluate a postfix unary operator currently!' ! ! CPostfixUnaryExpressionNode subclass: #PostIncrementNode! CPostfixUnaryExpressionNode subclass: #PostDecrementNode! !CBinaryExpressionNode class methodsFor: 'instance creation'! left: leftExpr op: operator right: rightExpr ^self new left: leftExpr op: operator right: rightExpr ! left: leftExpr op: operator ^self new left: leftExpr; op: operator; yourself ! ! !CBinaryExpressionNode methodsFor: 'assignment'! left: leftExpr op: operator right: rightExpr left _ leftExpr. op _ operator. right _ rightExpr ! left: leftExpr left _ leftExpr ! op: operator op _ operator ! right: rightExpr right _ rightExpr ! ! CBinaryExpressionNode subclass: #CommaNode! CBinaryExpressionNode subclass: #AssignNode! CBinaryExpressionNode subclass: #ConditionalNode! CBinaryExpressionNode subclass: #ColonNode! CBinaryExpressionNode subclass: #CorNode! CBinaryExpressionNode subclass: #CandNode! CBinaryExpressionNode subclass: #BitorNode! CBinaryExpressionNode subclass: #BitandNode! CBinaryExpressionNode subclass: #BitxorNode! CBinaryExpressionNode subclass: #EqNode! CBinaryExpressionNode subclass: #RelationNode! CBinaryExpressionNode subclass: #ShiftNode! CBinaryExpressionNode subclass: #AddNode! CBinaryExpressionNode subclass: #MultNode! !AssignNode methodsFor: 'evaluation'! evaluate ^self error: 'cannot assign in Smalltalk C expressions' ! ! !ConditionalNode methodsFor: 'evaluation'! evaluate | leftValue rightValue | leftValue _ left evaluate. (self isCValueTrue: leftValue) ifTrue: [ ^right evaluateLeft ] ifFalse: [ ^right evaluateRight ] . ! ! !ColonNode methodsFor: 'evaluation'! evaluateLeft ^left evaluate. ! evaluateRight ^right evaluate. ! ! !CorNode methodsFor: 'evaluation'! evaluate | leftValue rightValue | leftValue _ left evaluate. (self isCValueTrue: leftValue) ifTrue: [ ^1 ]. rightValue _ right evaluate. ^self boolToCValue: (self isCValueTrue: rightValue) ! ! !CandNode methodsFor: 'evaluation'! evaluate | leftValue rightValue | leftValue _ left evaluate. (self isCValueTrue: leftValue) ifFalse: [ ^0 ]. rightValue _ right evaluate. ^self boolToCValue: (self isCValueTrue: rightValue) ! ! !BitorNode methodsFor: 'evaluation'! evaluate ^left evaluate bitOr: right evaluate ! ! !BitandNode methodsFor: 'evaluation'! evaluate ^left evaluate bitAnd: right evaluate ! ! !BitxorNode methodsFor: 'evaluation'! evaluate ^left evaluate bitXor: right evaluate ! ! !EqNode methodsFor: 'evaluation'! evaluate | result | result _ left evaluate = right evaluate. op = '!=' ifTrue: [ result _ result not ]. ^self boolToCValue: result ! ! !RelationNode methodsFor: 'evaluation'! evaluate | leftValue rightValue | leftValue _ left evaluate. rightValue _ right evaluate. ^self boolToCValue: (leftValue perform: (op value asSymbol) with: rightValue) ! ! !ShiftNode methodsFor: 'evaluation'! evaluate | value shiftAmount | value _ left evaluate. shiftAmount _ right evaluate. op value = '>>' ifTrue: [ shiftAmount _ shiftAmount negated ]. ^value bitShift: shiftAmount ! ! !AddNode methodsFor: 'evaluation'! evaluate | leftValue rightValue | leftValue _ left evaluate. rightValue _ right evaluate. ^leftValue perform: (op value asSymbol) with: rightValue ! ! !MultNode methodsFor: 'evaluation'! evaluate | leftValue rightValue opStr | leftValue _ left evaluate. rightValue _ right evaluate. opStr _ op value. opStr = '*' ifTrue: [ ^leftValue * rightValue ]. opStr = '%' ifTrue: [ "??? not exactly sure about this, may have to do more special casing" ^leftValue \\ rightValue ]. "must be / by this point" ((leftValue class isInteger) and: [ rightValue class isInteger ]) ifTrue: [ ^leftValue // rightValue ] ifFalse: [ ^leftValue / rightValue ] ! !