--- a/BCompiler.st Fri Feb 09 19:01:33 1996 +0100
+++ b/BCompiler.st Sat Feb 10 19:33:23 1996 +0100
@@ -77,6 +77,8 @@
controls when stc compilation is wanted
ShareCode <Boolean> reuse byteArrays for common (simple) code sequences
+ This is normally a 'good' optimization,
+ expect if you plan to modify the byteCodes.
"
! !
@@ -1142,11 +1144,18 @@
checkForCommonCode:symbolicCodeArray
"hook to return the code for common code sequences.
- Not yet fully implemented - just an idea ..."
+ This reduces the in-memory number of byteArrays somewhat.
+
+ Not yet fully implemented - just an idea ... theres certainly more to do here
+ (does it make sense to scan all methods, collect code in a set and unify things
+ automatically in the background - or upon request ?)"
|sz insn1|
(sz := symbolicCodeArray size) == 2 ifTrue:[
+ "/
+ "/ a very common sequence: return the first literal
+ "/
(insn1 := symbolicCodeArray at:1) == #pushLit1 ifTrue:[
(symbolicCodeArray at:2) == #retTop ifTrue:[
^ #[222 0]
@@ -1154,9 +1163,18 @@
]
].
sz == 1 ifTrue:[
+ "/
+ "/ another common sequence: return the receiver
+ "/
(insn1 := symbolicCodeArray at:1) == #retSelf ifTrue:[
^ #[5]
- ]
+ ].
+ insn1 == #retTrue ifTrue:[
+ ^ #[2]
+ ].
+ insn1 == #retFalse ifTrue:[
+ ^ #[3]
+ ].
].
^ nil
!
@@ -2119,6 +2137,6 @@
!ByteCodeCompiler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.65 1996-02-09 18:01:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.66 1996-02-10 18:33:10 cg Exp $'
! !
ByteCodeCompiler initialize!
--- a/BlockNode.st Fri Feb 09 19:01:33 1996 +0100
+++ b/BlockNode.st Sat Feb 10 19:33:23 1996 +0100
@@ -106,8 +106,10 @@
|numArgs kludgeBlock|
(Block implements:(aMessage selector)) ifTrue:[
- "mhmh - a message which I dont understand, but Block implements
- send it to a kludgeblock, which will evaluate me again ..."
+
+ "/ mhmh - a message which I dont understand, but Block implements
+ "/ send it to a kludgeblock, which will evaluate me again ..."
+
numArgs := blockArgs size.
numArgs == 0 ifTrue:[
kludgeBlock := [self value]
@@ -558,5 +560,5 @@
!BlockNode class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.24 1996-01-17 18:39:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.25 1996-02-10 18:33:14 cg Exp $'
! !
--- a/ByteCodeCompiler.st Fri Feb 09 19:01:33 1996 +0100
+++ b/ByteCodeCompiler.st Sat Feb 10 19:33:23 1996 +0100
@@ -77,6 +77,8 @@
controls when stc compilation is wanted
ShareCode <Boolean> reuse byteArrays for common (simple) code sequences
+ This is normally a 'good' optimization,
+ expect if you plan to modify the byteCodes.
"
! !
@@ -1142,11 +1144,18 @@
checkForCommonCode:symbolicCodeArray
"hook to return the code for common code sequences.
- Not yet fully implemented - just an idea ..."
+ This reduces the in-memory number of byteArrays somewhat.
+
+ Not yet fully implemented - just an idea ... theres certainly more to do here
+ (does it make sense to scan all methods, collect code in a set and unify things
+ automatically in the background - or upon request ?)"
|sz insn1|
(sz := symbolicCodeArray size) == 2 ifTrue:[
+ "/
+ "/ a very common sequence: return the first literal
+ "/
(insn1 := symbolicCodeArray at:1) == #pushLit1 ifTrue:[
(symbolicCodeArray at:2) == #retTop ifTrue:[
^ #[222 0]
@@ -1154,9 +1163,18 @@
]
].
sz == 1 ifTrue:[
+ "/
+ "/ another common sequence: return the receiver
+ "/
(insn1 := symbolicCodeArray at:1) == #retSelf ifTrue:[
^ #[5]
- ]
+ ].
+ insn1 == #retTrue ifTrue:[
+ ^ #[2]
+ ].
+ insn1 == #retFalse ifTrue:[
+ ^ #[3]
+ ].
].
^ nil
!
@@ -2119,6 +2137,6 @@
!ByteCodeCompiler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.65 1996-02-09 18:01:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.66 1996-02-10 18:33:10 cg Exp $'
! !
ByteCodeCompiler initialize!
--- a/MessageNd.st Fri Feb 09 19:01:33 1996 +0100
+++ b/MessageNd.st Sat Feb 10 19:33:23 1996 +0100
@@ -53,12 +53,14 @@
This was inspired by some discussion in c.l.s about enhancing the language - I prefer
enhancing the compiler ....
The following optimization will convert '#(...) with:#(...) collect:[...]' into an array constant,
- allowing a constant arrays of complex objects.
+ allowing constant arrays of complex objects.
Notice: this method is normally disabled - its just a demo after all.
"
- folding ifTrue:[
- "do constant folding ..."
+ folding notNil ifTrue:[
+ "/
+ "/ do constant folding ...
+ "/
(recNode isConstant and:[argNode1 isConstant]) ifTrue:[
"check if we can do it ..."
selector := selectorString asSymbolIfInterned.
@@ -73,14 +75,16 @@
"
argVal := argNode1 evaluate.
((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[
- (selector == #with:collect:) ifTrue:[
- (argNode2 isMemberOf:BlockNode) ifTrue:[
- SignalSet anySignal handle:[:ex |
- ^ 'error in constant expression (' , ex errorString , ')'
- ] do:[
- result := recVal perform:selector with:argVal with:(argNode2 evaluate).
- ].
- ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+ folding == #full ifTrue:[
+ (selector == #with:collect:) ifTrue:[
+ (argNode2 isMemberOf:BlockNode) ifTrue:[
+ SignalSet anySignal handle:[:ex |
+ ^ 'error in constant expression (' , ex errorString , ')'
+ ] do:[
+ result := recVal perform:selector with:argVal with:(argNode2 evaluate).
+ ].
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+ ]
]
]
]
@@ -92,105 +96,111 @@
!
receiver:recNode selector:selectorString arg:argNode
- ^ self receiver:recNode selector:selectorString arg:argNode fold:true
+ ^ self receiver:recNode selector:selectorString arg:argNode fold:nil
!
receiver:recNode selector:selectorString arg:argNode fold:folding
- |result recVal argVal selector canFold|
+ |result recVal argVal selector globalName canFold|
"
The constant folding code can usually not optimize much
- this may change when some kind of constant/macro declaration is added to smalltalk.
"
- folding ifTrue:[
- "do constant folding ..."
- (recNode isConstant and:[argNode isConstant]) ifTrue:[
- "check if we can do it ..."
- selector := selectorString asSymbolIfInterned.
- selector notNil ifTrue:[
+ folding notNil ifTrue:[
+ selector := selectorString asSymbolIfInterned.
+ selector notNil ifTrue:[
+
+ "/
+ "/ do constant folding ...
+ "/
+ canFold := false.
+
+ (recNode isGlobal and:[argNode isConstant]) ifTrue:[
+ globalName := recNode name.
+ recVal := recNode evaluate.
+
+ (globalName = 'SmallInteger') ifTrue:[
+ ( #( bitMaskFor: ) includes:selector)
+ ifTrue:[
+ canFold := true
+ ]
+ ].
+ (globalName = 'Float') ifTrue:[
+ ( #( pi unity zero ) includes:selector)
+ ifTrue:[
+ (recVal respondsTo:selector) ifTrue:[
+ canFold := true
+ ]
+ ]
+ ]
+ ].
+
+ (recNode isConstant and:[argNode isConstant]) ifTrue:[
+ "check if we can do it ..."
recVal := recNode evaluate.
+ "
+ we could do much more here - but then, we need a dependency from
+ the folded selectors method to the method we generate code for ...
+ limit optimizations to those that will never change
+ (or - if you change them - you will crash so bad ...)
+ "
+ argVal := argNode evaluate.
+ (recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
+ ( #( + - * / // \\ min: max: quo:) includes:selector) ifTrue:[
+ (#( / // \\ ) includes:selector) ifTrue:[
+ argVal = 0 ifTrue:[
+ ^ 'division by zero in constant expression'
+ ].
+ ].
+ canFold := true
+ ].
+ ( #( @ ) includes:selector) ifTrue:[
+ canFold := (folding == #full)
+ ]
+ ].
+ (recVal isMemberOf:String) ifTrue:[
+ (argVal isInteger and:[selector == #at:]) ifTrue:[
+ canFold := (folding >= #level2) or:[folding == #full].
+ ].
+ ((argVal isMemberOf:String) and:[selector == #',']) ifTrue:[
+ canFold := (folding >= #level2) or:[folding == #full].
+ ]
+ ].
+ ].
+
+ canFold ifTrue:[
(recVal respondsTo:selector) ifTrue:[
- canFold := false.
- "
- we could do much more here - but then, we need a dependency from
- the folded selectors method to the method we generate code for ...
- limit optimizations to those that will never change
- (or - if you change them - you will crash so bad ...)
- "
- argVal := argNode evaluate.
- (recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
- (#( @ + - * / // \\ min: max: quo:) includes:selector) ifTrue:[
- (#( / // \\ ) includes:selector) ifTrue:[
- argVal = 0 ifTrue:[
- ^ 'division by zero in constant expression'
- ].
- ].
- canFold := true
- ]
+ SignalSet anySignal handle:[:ex |
+ ^ 'error in constant expression (' , ex errorString , ')'
+ ] do:[
+ result := recVal perform:selector with:argVal.
].
- (recVal isMemberOf:String) ifTrue:[
- (argVal isInteger and:[selector == #at:]) ifTrue:[
- canFold := true
- ].
- ((argVal isMemberOf:String) and:[selector == #',']) ifTrue:[
- canFold := true
- ]
- ].
- canFold ifTrue:[
- SignalSet anySignal handle:[:ex |
- ^ 'error in constant expression (' , ex errorString , ')'
- ] do:[
- result := recVal perform:selector with:argVal.
- ].
- ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
- ]
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
]
]
- ].
- "
- the folloing optimization cannot be done (although it would be nice)
- since the array may be modified later.
- "
-"/ (recNode isGlobal and:[argNode isConstant])ifTrue:[
-"/ selectorString knownAsSymbol ifTrue:[
-"/ selector := selectorString asSymbol.
-"/ recVal := recNode evaluate.
-"/ (recVal respondsTo:selector) ifTrue:[
-"/ (recVal == FloatArray) ifTrue:[
-"/ argVal := argNode evaluate.
-"/ (argVal isMemberOf:Array) ifTrue:[
-"/ (SignalSet anySignal catch:[
-"/ result := recVal perform:selector with:argVal with:argVal.
-"/ ]) ifTrue:[
-"/ ^ 'error in constant expression'
-"/ ].
-"/ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
-"/ ]
-"/ ]
-"/ ]
-"/ ]
-"/ ]
+ ]
].
+
^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0
!
receiver:recNode selector:selectorString args:anArray
- ^ self receiver:recNode selector:selectorString args:anArray fold:true
+ ^ self receiver:recNode selector:selectorString args:anArray fold:nil
!
receiver:recNode selector:selectorString args:argArray fold:folding
|numArgs|
numArgs := argArray size.
- folding ifTrue:[
+ folding notNil ifTrue:[
(numArgs == 1) ifTrue:[
- ^ self receiver:recNode selector:selectorString arg:(argArray at:1) fold:true
+ ^ self receiver:recNode selector:selectorString arg:(argArray at:1) fold:folding
].
"uncomment the follwoing for a nice array initializer optimization ..."
-"/ (numArgs == 2) ifTrue:[
-"/ ^ self receiver:recNode selector:selectorString arg1:(argArray at:1) arg2:(argArray at:2) fold:true
-"/ ].
+ (numArgs == 2) ifTrue:[
+ ^ self receiver:recNode selector:selectorString arg1:(argArray at:1) arg2:(argArray at:2) fold:folding
+ ].
numArgs > Method maxNumberOfArguments ifTrue:[
^ 'too many arguments for current VM implementation'.
].
@@ -1550,5 +1560,5 @@
!MessageNode class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/MessageNd.st,v 1.41 1996-02-02 16:23:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/MessageNd.st,v 1.42 1996-02-10 18:33:16 cg Exp $'
! !
--- a/MessageNode.st Fri Feb 09 19:01:33 1996 +0100
+++ b/MessageNode.st Sat Feb 10 19:33:23 1996 +0100
@@ -53,12 +53,14 @@
This was inspired by some discussion in c.l.s about enhancing the language - I prefer
enhancing the compiler ....
The following optimization will convert '#(...) with:#(...) collect:[...]' into an array constant,
- allowing a constant arrays of complex objects.
+ allowing constant arrays of complex objects.
Notice: this method is normally disabled - its just a demo after all.
"
- folding ifTrue:[
- "do constant folding ..."
+ folding notNil ifTrue:[
+ "/
+ "/ do constant folding ...
+ "/
(recNode isConstant and:[argNode1 isConstant]) ifTrue:[
"check if we can do it ..."
selector := selectorString asSymbolIfInterned.
@@ -73,14 +75,16 @@
"
argVal := argNode1 evaluate.
((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[
- (selector == #with:collect:) ifTrue:[
- (argNode2 isMemberOf:BlockNode) ifTrue:[
- SignalSet anySignal handle:[:ex |
- ^ 'error in constant expression (' , ex errorString , ')'
- ] do:[
- result := recVal perform:selector with:argVal with:(argNode2 evaluate).
- ].
- ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+ folding == #full ifTrue:[
+ (selector == #with:collect:) ifTrue:[
+ (argNode2 isMemberOf:BlockNode) ifTrue:[
+ SignalSet anySignal handle:[:ex |
+ ^ 'error in constant expression (' , ex errorString , ')'
+ ] do:[
+ result := recVal perform:selector with:argVal with:(argNode2 evaluate).
+ ].
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+ ]
]
]
]
@@ -92,105 +96,111 @@
!
receiver:recNode selector:selectorString arg:argNode
- ^ self receiver:recNode selector:selectorString arg:argNode fold:true
+ ^ self receiver:recNode selector:selectorString arg:argNode fold:nil
!
receiver:recNode selector:selectorString arg:argNode fold:folding
- |result recVal argVal selector canFold|
+ |result recVal argVal selector globalName canFold|
"
The constant folding code can usually not optimize much
- this may change when some kind of constant/macro declaration is added to smalltalk.
"
- folding ifTrue:[
- "do constant folding ..."
- (recNode isConstant and:[argNode isConstant]) ifTrue:[
- "check if we can do it ..."
- selector := selectorString asSymbolIfInterned.
- selector notNil ifTrue:[
+ folding notNil ifTrue:[
+ selector := selectorString asSymbolIfInterned.
+ selector notNil ifTrue:[
+
+ "/
+ "/ do constant folding ...
+ "/
+ canFold := false.
+
+ (recNode isGlobal and:[argNode isConstant]) ifTrue:[
+ globalName := recNode name.
+ recVal := recNode evaluate.
+
+ (globalName = 'SmallInteger') ifTrue:[
+ ( #( bitMaskFor: ) includes:selector)
+ ifTrue:[
+ canFold := true
+ ]
+ ].
+ (globalName = 'Float') ifTrue:[
+ ( #( pi unity zero ) includes:selector)
+ ifTrue:[
+ (recVal respondsTo:selector) ifTrue:[
+ canFold := true
+ ]
+ ]
+ ]
+ ].
+
+ (recNode isConstant and:[argNode isConstant]) ifTrue:[
+ "check if we can do it ..."
recVal := recNode evaluate.
+ "
+ we could do much more here - but then, we need a dependency from
+ the folded selectors method to the method we generate code for ...
+ limit optimizations to those that will never change
+ (or - if you change them - you will crash so bad ...)
+ "
+ argVal := argNode evaluate.
+ (recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
+ ( #( + - * / // \\ min: max: quo:) includes:selector) ifTrue:[
+ (#( / // \\ ) includes:selector) ifTrue:[
+ argVal = 0 ifTrue:[
+ ^ 'division by zero in constant expression'
+ ].
+ ].
+ canFold := true
+ ].
+ ( #( @ ) includes:selector) ifTrue:[
+ canFold := (folding == #full)
+ ]
+ ].
+ (recVal isMemberOf:String) ifTrue:[
+ (argVal isInteger and:[selector == #at:]) ifTrue:[
+ canFold := (folding >= #level2) or:[folding == #full].
+ ].
+ ((argVal isMemberOf:String) and:[selector == #',']) ifTrue:[
+ canFold := (folding >= #level2) or:[folding == #full].
+ ]
+ ].
+ ].
+
+ canFold ifTrue:[
(recVal respondsTo:selector) ifTrue:[
- canFold := false.
- "
- we could do much more here - but then, we need a dependency from
- the folded selectors method to the method we generate code for ...
- limit optimizations to those that will never change
- (or - if you change them - you will crash so bad ...)
- "
- argVal := argNode evaluate.
- (recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
- (#( @ + - * / // \\ min: max: quo:) includes:selector) ifTrue:[
- (#( / // \\ ) includes:selector) ifTrue:[
- argVal = 0 ifTrue:[
- ^ 'division by zero in constant expression'
- ].
- ].
- canFold := true
- ]
+ SignalSet anySignal handle:[:ex |
+ ^ 'error in constant expression (' , ex errorString , ')'
+ ] do:[
+ result := recVal perform:selector with:argVal.
].
- (recVal isMemberOf:String) ifTrue:[
- (argVal isInteger and:[selector == #at:]) ifTrue:[
- canFold := true
- ].
- ((argVal isMemberOf:String) and:[selector == #',']) ifTrue:[
- canFold := true
- ]
- ].
- canFold ifTrue:[
- SignalSet anySignal handle:[:ex |
- ^ 'error in constant expression (' , ex errorString , ')'
- ] do:[
- result := recVal perform:selector with:argVal.
- ].
- ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
- ]
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
]
]
- ].
- "
- the folloing optimization cannot be done (although it would be nice)
- since the array may be modified later.
- "
-"/ (recNode isGlobal and:[argNode isConstant])ifTrue:[
-"/ selectorString knownAsSymbol ifTrue:[
-"/ selector := selectorString asSymbol.
-"/ recVal := recNode evaluate.
-"/ (recVal respondsTo:selector) ifTrue:[
-"/ (recVal == FloatArray) ifTrue:[
-"/ argVal := argNode evaluate.
-"/ (argVal isMemberOf:Array) ifTrue:[
-"/ (SignalSet anySignal catch:[
-"/ result := recVal perform:selector with:argVal with:argVal.
-"/ ]) ifTrue:[
-"/ ^ 'error in constant expression'
-"/ ].
-"/ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
-"/ ]
-"/ ]
-"/ ]
-"/ ]
-"/ ]
+ ]
].
+
^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0
!
receiver:recNode selector:selectorString args:anArray
- ^ self receiver:recNode selector:selectorString args:anArray fold:true
+ ^ self receiver:recNode selector:selectorString args:anArray fold:nil
!
receiver:recNode selector:selectorString args:argArray fold:folding
|numArgs|
numArgs := argArray size.
- folding ifTrue:[
+ folding notNil ifTrue:[
(numArgs == 1) ifTrue:[
- ^ self receiver:recNode selector:selectorString arg:(argArray at:1) fold:true
+ ^ self receiver:recNode selector:selectorString arg:(argArray at:1) fold:folding
].
"uncomment the follwoing for a nice array initializer optimization ..."
-"/ (numArgs == 2) ifTrue:[
-"/ ^ self receiver:recNode selector:selectorString arg1:(argArray at:1) arg2:(argArray at:2) fold:true
-"/ ].
+ (numArgs == 2) ifTrue:[
+ ^ self receiver:recNode selector:selectorString arg1:(argArray at:1) arg2:(argArray at:2) fold:folding
+ ].
numArgs > Method maxNumberOfArguments ifTrue:[
^ 'too many arguments for current VM implementation'.
].
@@ -1550,5 +1560,5 @@
!MessageNode class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.41 1996-02-02 16:23:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.42 1996-02-10 18:33:16 cg Exp $'
! !
--- a/Parser.st Fri Feb 09 19:01:33 1996 +0100
+++ b/Parser.st Sat Feb 10 19:33:23 1996 +0100
@@ -71,6 +71,37 @@
One instance of Parser is created to parse one method or expression - i.e.
its not suggested to reuse parsers.
+
+ Constant folding:
+
+ The parser has various modes for constant folding; by default, only numeric
+ expressions involving integers and floats are constant folded
+ (i.e. something like 'Float pi sin' or '1.5 + 0.3' will be reduced to a constant).
+
+ Constant folding can be turned off completely (setting FoldConstants to nil)
+ to ``secure folding'', which only folds constant numbers (#level1) or to #full.
+ In full mode, more constant expressions are folded (for example: '1.0 @ 1.0' is
+ reduced to a constant point), but the resulting code may not be compatible with other
+ smalltalk systems (consider the case, where the point is modified using #x: or #y: messages).
+ Therefore, this mode is a bit dangerous and disabled by default.
+
+
+ Immutable arrays:
+
+ Immutable arrays are experimental and being evaluated.
+ Consider the case of a method returning '#(1 2 3 4)', and that array being modified
+ by some other method (using #at:put:). Since the array-return is actually a return of
+ a reference to the compiler created array, the next invokation of the method will
+ return the modified array. These are hard to find bugs.
+ By an option, the compiler can generate immutable arrays, which dont allow modification
+ of its elements. For clean code, you should enable this option during development.
+
+ As mentioned above, this is experimental. If it is reported to be a useful feature,
+ the immutable feature will be extended to strings, point-literals etc. in a future version
+ of st/x.
+
+
+
Instance variables:
classToCompileFor <Class> the class (or nil) we are compiling for
@@ -152,6 +183,22 @@
ST-80 directives (resource defs)
which are ignored in st/x.
defaults to false.
+
+ FoldConstants <Symbol> controls how constant folding should be
+ done.
+ Can be one of:
+ nil - no constant folding
+ #level1 - numeric optimizations only
+ #level2 - secure optimizations only
+ #full - full folding
+
+ level1: arithmetic on constant numbers
+
+ level2: above PLUS array conversions with #asFloatArray,
+ #asDoubleArray, string concatenation
+
+ full: constant points.
+
"
! !
@@ -241,17 +288,22 @@
!
foldConstants
- "return true if constant folding is enabled"
+ "return a symbol describing how constants are to be folded"
^ FoldConstants
"Created: 9.2.1996 / 17:40:13 / cg"
!
-foldConstants:aBoolean
- "enable/disable constant folding"
-
- FoldConstants := aBoolean
+foldConstants:aSymbol
+ "set the symbol describing how constants are to be folded.
+ It can be:
+ nil - no constant folding
+ #level1 - numeric constants only
+ #level2 - level1 PLUS array conversions PLUS string concatenation
+ #full - level2 PLUS constant points, constant rectangles (dangerous)"
+
+ FoldConstants := aSymbol
"Created: 9.2.1996 / 17:40:34 / cg"
!
@@ -586,7 +638,7 @@
ArraysAreImmutable := false. "/ usually left true for ST-80 compatibility
ImplicitSelfSends := false.
WarnST80Directives := false.
- FoldConstants := true.
+ FoldConstants := #level1.
"Modified: 9.2.1996 / 17:33:49 / cg"
! !
@@ -3298,6 +3350,6 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.68 1996-02-09 17:38:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.69 1996-02-10 18:33:20 cg Exp $'
! !
Parser initialize!
--- a/UnaryNd.st Fri Feb 09 19:01:33 1996 +0100
+++ b/UnaryNd.st Sat Feb 10 19:33:23 1996 +0100
@@ -45,93 +45,100 @@
"return a new UnaryNode for sending selector s to receiver r.
Fold constants."
- ^ self receiver:r selector:s fold:true
+ ^ self receiver:r selector:s fold:nil
!
receiver:r selector:selectorString fold:folding
"return a new UnaryNode for sending selector selectorString to receiver r.
If folding is true, fold constant expressions."
- |result recVal selector|
+ |result recVal selector canFold globalName|
"
The constant folding code can usually not optimize things - this may change
when some kind of constant declaration is added to smalltalk.
"
- folding ifTrue:[
- "do constant folding ..."
- r isGlobal ifTrue:[
- (r name = 'Character') ifTrue:[
+
+ canFold := false.
+
+ folding notNil ifTrue:[
+ selector := selectorString asSymbolIfInterned.
+ selector notNil ifTrue:[
+ "/
+ "/ do constant folding ...
+ "/
+ r isGlobal ifTrue:[
+ globalName := r name.
recVal := r evaluate.
- selector := selectorString asSymbolIfInterned.
- selector notNil ifTrue:[
- (#( tab cr space) includes:selector)
+
+ (globalName = 'Character') ifTrue:[
+ ( #( tab cr space backspace esc ) includes:selector)
+ ifTrue:[
+ canFold := true
+ ]
+ ].
+ (globalName = 'Float') ifTrue:[
+ ( #( pi unity zero ) includes:selector)
ifTrue:[
(recVal respondsTo:selector) ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
+ canFold := true
]
]
+ ]
+ ].
+
+ r isConstant ifTrue:[
+ "check if we can do it ..."
+ recVal := r evaluate.
+
+ "
+ we could do much more here - but then, we need a dependency from
+ the folded selectors method to the method we generate code for ...
+ limit optimizations to those that will never change
+ (or, if you change them, it will crash badly anyway ...)
+ "
+ recVal respondsToArithmetic ifTrue:[
+ (#( negated abs asPoint degreesToRadians radiansToDegrees
+ exp ln log sqrt reciprocal
+ arcCos arcSin arcTan sin cos tan) includes:selector)
+ ifTrue:[
+ canFold := true
+ ]
+ ].
+ recVal isCharacter ifTrue:[
+ (#( asciiValue asInteger digitValue) includes:selector)
+ ifTrue:[
+ canFold := true
+ ]
+ ].
+ recVal isString ifTrue:[
+ (selector == #withCRs) ifTrue:[
+ canFold := (folding >= #level2) or:[folding == #full]
+ ]
+ ].
+ (recVal isMemberOf:Array) ifTrue:[
+ (#(asFloatArray asDoubleArray) includes:selector) ifTrue:[
+ canFold := (folding >= #level2) or:[folding == #full]
+ ]
]
]
].
- r isConstant ifTrue:[
- "check if we can do it ..."
- recVal := r evaluate.
- selector := selectorString asSymbolIfInterned.
- selector notNil ifTrue:[
- (recVal respondsTo:selector) ifTrue:[
- "
- we could do much more here - but then, we need a dependency from
- the folded selectors method to the method we generate code for ...
- limit optimizations to those that will never change
- (or, if you change them, it will crash badly anyway ...)
- "
- SignalSet anySignal "Number domainErrorSignal" handle:[:ex |
- "in case of an error, abort fold and return original"
- ex return
- ] do:[
- recVal respondsToArithmetic ifTrue:[
- (#( negated abs asPoint degreesToRadians radiansToDegrees
- exp ln log sqrt reciprocal
- arcCos arcSin arcTan sin cos tan) includes:selector)
- ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
- ]
- ].
- recVal isCharacter ifTrue:[
- (#( asciiValue asInteger digitValue) includes:selector)
- ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
- ]
- ].
- recVal isString ifTrue:[
- (selector == #withCRs) ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
- ]
- ].
- (recVal isMemberOf:Array) ifTrue:[
- (#(asFloatArray asDoubleArray) includes:selector) ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
- ]
- ].
- ^ (self basicNew) receiver:r selector:selector args:nil lineno:0
- ].
- "when we reach here, something went wrong (something like 0.0 log)"
- ^ 'error occured when evaluating constant expression'
- ]
- ]
- ]
+
+ canFold ifTrue:[
+ (recVal respondsTo:selector) ifTrue:[
+ SignalSet anySignal "Number domainErrorSignal" handle:[:ex |
+ "in case of an error, abort fold and return original"
+ ex return
+ ] do:[
+ result := recVal perform:selector.
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+ ].
+ "when we reach here, something went wrong (something like 0.0 log)"
+ ^ 'error occured when evaluating constant expression'
+ ].
+ ].
].
+
^ (self basicNew) receiver:r selector:selectorString args:nil lineno:0
! !
@@ -247,5 +254,5 @@
!UnaryNode class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/UnaryNd.st,v 1.19 1995-12-03 12:16:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/UnaryNd.st,v 1.20 1996-02-10 18:33:23 cg Exp $'
! !
--- a/UnaryNode.st Fri Feb 09 19:01:33 1996 +0100
+++ b/UnaryNode.st Sat Feb 10 19:33:23 1996 +0100
@@ -45,93 +45,100 @@
"return a new UnaryNode for sending selector s to receiver r.
Fold constants."
- ^ self receiver:r selector:s fold:true
+ ^ self receiver:r selector:s fold:nil
!
receiver:r selector:selectorString fold:folding
"return a new UnaryNode for sending selector selectorString to receiver r.
If folding is true, fold constant expressions."
- |result recVal selector|
+ |result recVal selector canFold globalName|
"
The constant folding code can usually not optimize things - this may change
when some kind of constant declaration is added to smalltalk.
"
- folding ifTrue:[
- "do constant folding ..."
- r isGlobal ifTrue:[
- (r name = 'Character') ifTrue:[
+
+ canFold := false.
+
+ folding notNil ifTrue:[
+ selector := selectorString asSymbolIfInterned.
+ selector notNil ifTrue:[
+ "/
+ "/ do constant folding ...
+ "/
+ r isGlobal ifTrue:[
+ globalName := r name.
recVal := r evaluate.
- selector := selectorString asSymbolIfInterned.
- selector notNil ifTrue:[
- (#( tab cr space) includes:selector)
+
+ (globalName = 'Character') ifTrue:[
+ ( #( tab cr space backspace esc ) includes:selector)
+ ifTrue:[
+ canFold := true
+ ]
+ ].
+ (globalName = 'Float') ifTrue:[
+ ( #( pi unity zero ) includes:selector)
ifTrue:[
(recVal respondsTo:selector) ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
+ canFold := true
]
]
+ ]
+ ].
+
+ r isConstant ifTrue:[
+ "check if we can do it ..."
+ recVal := r evaluate.
+
+ "
+ we could do much more here - but then, we need a dependency from
+ the folded selectors method to the method we generate code for ...
+ limit optimizations to those that will never change
+ (or, if you change them, it will crash badly anyway ...)
+ "
+ recVal respondsToArithmetic ifTrue:[
+ (#( negated abs asPoint degreesToRadians radiansToDegrees
+ exp ln log sqrt reciprocal
+ arcCos arcSin arcTan sin cos tan) includes:selector)
+ ifTrue:[
+ canFold := true
+ ]
+ ].
+ recVal isCharacter ifTrue:[
+ (#( asciiValue asInteger digitValue) includes:selector)
+ ifTrue:[
+ canFold := true
+ ]
+ ].
+ recVal isString ifTrue:[
+ (selector == #withCRs) ifTrue:[
+ canFold := (folding >= #level2) or:[folding == #full]
+ ]
+ ].
+ (recVal isMemberOf:Array) ifTrue:[
+ (#(asFloatArray asDoubleArray) includes:selector) ifTrue:[
+ canFold := (folding >= #level2) or:[folding == #full]
+ ]
]
]
].
- r isConstant ifTrue:[
- "check if we can do it ..."
- recVal := r evaluate.
- selector := selectorString asSymbolIfInterned.
- selector notNil ifTrue:[
- (recVal respondsTo:selector) ifTrue:[
- "
- we could do much more here - but then, we need a dependency from
- the folded selectors method to the method we generate code for ...
- limit optimizations to those that will never change
- (or, if you change them, it will crash badly anyway ...)
- "
- SignalSet anySignal "Number domainErrorSignal" handle:[:ex |
- "in case of an error, abort fold and return original"
- ex return
- ] do:[
- recVal respondsToArithmetic ifTrue:[
- (#( negated abs asPoint degreesToRadians radiansToDegrees
- exp ln log sqrt reciprocal
- arcCos arcSin arcTan sin cos tan) includes:selector)
- ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
- ]
- ].
- recVal isCharacter ifTrue:[
- (#( asciiValue asInteger digitValue) includes:selector)
- ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
- ]
- ].
- recVal isString ifTrue:[
- (selector == #withCRs) ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
- ]
- ].
- (recVal isMemberOf:Array) ifTrue:[
- (#(asFloatArray asDoubleArray) includes:selector) ifTrue:[
- result := recVal perform:selector.
- ^ ConstantNode type:(ConstantNode typeOfConstant:result)
- value:result
- ]
- ].
- ^ (self basicNew) receiver:r selector:selector args:nil lineno:0
- ].
- "when we reach here, something went wrong (something like 0.0 log)"
- ^ 'error occured when evaluating constant expression'
- ]
- ]
- ]
+
+ canFold ifTrue:[
+ (recVal respondsTo:selector) ifTrue:[
+ SignalSet anySignal "Number domainErrorSignal" handle:[:ex |
+ "in case of an error, abort fold and return original"
+ ex return
+ ] do:[
+ result := recVal perform:selector.
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+ ].
+ "when we reach here, something went wrong (something like 0.0 log)"
+ ^ 'error occured when evaluating constant expression'
+ ].
+ ].
].
+
^ (self basicNew) receiver:r selector:selectorString args:nil lineno:0
! !
@@ -247,5 +254,5 @@
!UnaryNode class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/UnaryNode.st,v 1.19 1995-12-03 12:16:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/UnaryNode.st,v 1.20 1996-02-10 18:33:23 cg Exp $'
! !