MessageNode.st
changeset 639 f3dce3a697f0
parent 627 b29a02258247
child 676 69d1fe23a2b4
equal deleted inserted replaced
638:f0ae0eb10226 639:f3dce3a697f0
    37 "
    37 "
    38     node for parse-trees, representing message sends
    38     node for parse-trees, representing message sends
    39     This is a helper class for the compiler.
    39     This is a helper class for the compiler.
    40 
    40 
    41     [author:]
    41     [author:]
    42         Claus Gittinger
    42 	Claus Gittinger
    43 "
    43 "
    44 ! !
    44 ! !
    45 
    45 
    46 !MessageNode class methodsFor:'instance creation'!
    46 !MessageNode class methodsFor:'instance creation'!
    47 
    47 
    60      allowing constant arrays of complex objects.
    60      allowing constant arrays of complex objects.
    61 
    61 
    62      Notice: this method is normally disabled - its just a demo after all.
    62      Notice: this method is normally disabled - its just a demo after all.
    63     "
    63     "
    64     folding notNil ifTrue:[
    64     folding notNil ifTrue:[
    65         "/
    65 	"/
    66         "/ do constant folding ...
    66 	"/ do constant folding ...
    67         "/
    67 	"/
    68         (recNode isConstant and:[argNode1 isConstant]) ifTrue:[
    68 	(recNode isConstant and:[argNode1 isConstant]) ifTrue:[
    69             "check if we can do it ..."
    69 	    "check if we can do it ..."
    70             selector := selectorString asSymbolIfInterned.
    70 	    selector := selectorString asSymbolIfInterned.
    71             selector notNil ifTrue:[
    71 	    selector notNil ifTrue:[
    72                 recVal := recNode evaluate.
    72 		recVal := recNode evaluate.
    73                 (recVal respondsTo:selector) ifTrue:[
    73 		(recVal respondsTo:selector) ifTrue:[
    74                     "
    74 		    "
    75                      we could do much more here - but then, we need a dependency from
    75 		     we could do much more here - but then, we need a dependency from
    76                      the folded selectors method to the method we generate code for ...
    76 		     the folded selectors method to the method we generate code for ...
    77                      limit optimizations to those that will never change
    77 		     limit optimizations to those that will never change
    78                      (or - if you change them - you will crash so bad ...)
    78 		     (or - if you change them - you will crash so bad ...)
    79                     "
    79 		    "
    80                     argVal := argNode1 evaluate.
    80 		    argVal := argNode1 evaluate.
    81                     ((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[
    81 		    ((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[
    82                         folding == #full ifTrue:[
    82 			folding == #full ifTrue:[
    83                             (selector == #with:collect:) ifTrue:[
    83 			    (selector == #with:collect:) ifTrue:[
    84                                 (argNode2 isBlock) ifTrue:[
    84 				(argNode2 isBlock) ifTrue:[
    85                                     SignalSet anySignal handle:[:ex |
    85 				    SignalSet anySignal handle:[:ex |
    86                                         ^ 'error in constant expression (' , ex errorString , ')'
    86 					^ 'error in constant expression (' , ex errorString , ')'
    87                                     ] do:[
    87 				    ] do:[
    88                                         result := recVal perform:selector with:argVal with:(argNode2 evaluate).
    88 					result := recVal perform:selector with:argVal with:(argNode2 evaluate).
    89                                     ].
    89 				    ].
    90                                     ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
    90 				    ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
    91                                 ]
    91 				]
    92                             ]
    92 			    ]
    93                         ]
    93 			]
    94                     ]
    94 		    ]
    95                 ]
    95 		]
    96             ]
    96 	    ]
    97         ]
    97 	]
    98     ].
    98     ].
    99     ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode1 with:argNode2) lineno:0
    99     ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode1 with:argNode2) lineno:0
   100 
   100 
   101     "Modified: 28.6.1997 / 15:16:01 / cg"
   101     "Modified: 28.6.1997 / 15:16:01 / cg"
   102 !
   102 !
   108 receiver:recNode selector:selectorString arg:argNode fold:folding
   108 receiver:recNode selector:selectorString arg:argNode fold:folding
   109     |result recVal argVal selector globalName canFold|
   109     |result recVal argVal selector globalName canFold|
   110 
   110 
   111    "
   111    "
   112      The constant folding code can usually not optimize much
   112      The constant folding code can usually not optimize much
   113      - this may change when some kind of constant/macro declaration is added to smalltalk.
   113      - this may change when some kind of constant/macro declaration is added to smalltalk,
       
   114      so that constant classVars can be inlined.
   114     "
   115     "
   115     folding notNil ifTrue:[
   116     folding notNil ifTrue:[
   116         selector := selectorString asSymbolIfInterned.
   117 	selector := selectorString asSymbolIfInterned.
   117         selector notNil ifTrue:[
   118 	selector notNil ifTrue:[
   118 
   119 
   119             "/
   120 	    "/
   120             "/ do constant folding ...
   121 	    "/ do constant folding ...
   121             "/
   122 	    "/
   122             canFold := false.
   123 	    canFold := false.
   123 
   124 
   124             (recNode isGlobal and:[argNode isConstant]) ifTrue:[
   125 	    (recNode isGlobal and:[argNode isConstant]) ifTrue:[
   125                 globalName := recNode name.
   126 		globalName := recNode name.
   126                 recVal := recNode evaluate.
   127 		recVal := recNode evaluate.
   127 
   128 
   128                 (globalName = 'SmallInteger') ifTrue:[
   129 		(globalName = 'SmallInteger') ifTrue:[
   129                     ( #( bitMaskFor: ) includes:selector)
   130 		    ( #( bitMaskFor: ) includes:selector)
   130                     ifTrue:[
   131 		    ifTrue:[
   131                         canFold := true
   132 			canFold := true
   132                     ]
   133 		    ]
   133                 ].
   134 		].
   134                 (globalName = 'Float') ifTrue:[
   135 		(globalName = 'Float') ifTrue:[
   135                     ( #( pi unity zero ) includes:selector)
   136 		    ( #( pi unity zero ) includes:selector)
   136                     ifTrue:[
   137 		    ifTrue:[
   137                         (recVal respondsTo:selector) ifTrue:[
   138 			(recVal respondsTo:selector) ifTrue:[
   138                             canFold := true
   139 			    canFold := true
   139                         ]
   140 			]
   140                     ]
   141 		    ]
   141                 ]
   142 		]
   142             ].
   143 	    ].
   143 
   144 
   144             (recNode isConstant and:[argNode isConstant]) ifTrue:[
   145 	    (recNode isConstant and:[argNode isConstant]) ifTrue:[
   145                 "check if we can do it ..."
   146 		"check if we can do it ..."
   146                 recVal := recNode evaluate.
   147 		recVal := recNode evaluate.
   147                 "
   148 		"
   148                  we could do much more here - but then, we need a dependency from
   149 		 we could do much more here - but then, we need a dependency from
   149                  the folded selectors method to the method we generate code for ...
   150 		 the folded selectors method to the method we generate code for ...
   150                  limit optimizations to those that will never change
   151 		 limit optimizations to those that will never change
   151                  (or - if you change them - you will crash so bad ...)
   152 		 (or - if you change them - you will crash so bad ...)
   152                 "
   153 		"
   153                 argVal := argNode evaluate.
   154 		argVal := argNode evaluate.
   154                 (recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
   155 		(recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
   155                     ( #( + - * / // \\ min: max: quo:) includes:selector) ifTrue:[
   156 		    ( #( + - * / // \\ min: max: quo:) includes:selector) ifTrue:[
   156                         (#( / // \\ ) includes:selector) ifTrue:[
   157 			(#( / // \\ ) includes:selector) ifTrue:[
   157                             argVal = 0 ifTrue:[
   158 			    argVal = 0 ifTrue:[
   158                                 ^ 'division by zero in constant expression'
   159 				^ 'division by zero in constant expression'
   159                             ].
   160 			    ].
   160                         ].
   161 			].
   161                         canFold := true
   162 			canFold := true
   162                     ].
   163 		    ].
   163                     ( #( @ ) includes:selector) ifTrue:[
   164 		    ( #( @ ) includes:selector) ifTrue:[
   164                         canFold := (folding == #full)
   165 			canFold := (folding == #full)
   165                     ]
   166 		    ]
   166                 ].
   167 		].
   167                 (recVal isInteger and:[argVal isInteger]) ifTrue:[
   168 		(recVal isInteger and:[argVal isInteger]) ifTrue:[
   168                     ( #( bitShift: bitOr: ) includes:selector) ifTrue:[
   169 		    ( #( bitShift: bitOr: ) includes:selector) ifTrue:[
   169                         canFold := true
   170 			canFold := true
   170                     ]
   171 		    ]
   171                 ].
   172 		].
   172                 (recVal isMemberOf:String) ifTrue:[
   173 		(recVal isMemberOf:String) ifTrue:[
   173                     (argVal isInteger and:[selector == #at:]) ifTrue:[
   174 		    (argVal isInteger and:[selector == #at:]) ifTrue:[
   174                         canFold := (folding >= #level2) or:[folding == #full].
   175 			canFold := (folding >= #level2) or:[folding == #full].
   175                     ].
   176 		    ].
   176                     ((argVal isMemberOf:String) and:[selector == #',']) ifTrue:[
   177 		    ((argVal isMemberOf:String) and:[selector == #',']) ifTrue:[
   177                         canFold := (folding >= #level2) or:[folding == #full].
   178 			canFold := (folding >= #level2) or:[folding == #full].
   178                     ]
   179 		    ]
   179                 ].
   180 		].
   180             ].
   181 	    ].
   181 
   182 
   182             canFold ifTrue:[
   183 	    canFold ifTrue:[
   183                 (recVal respondsTo:selector) ifTrue:[
   184 		(recVal respondsTo:selector) ifTrue:[
   184                     SignalSet anySignal handle:[:ex |
   185 		    SignalSet anySignal handle:[:ex |
   185                         ^ 'error in constant expression (' , ex errorString , ')'
   186 			^ 'error in constant expression (' , ex errorString , ')'
   186                     ] do:[
   187 		    ] do:[
   187                         result := recVal perform:selector with:argVal.
   188 			result := recVal perform:selector with:argVal.
   188                     ].
   189 		    ].
   189                     ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
   190 		    ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
   190                 ]
   191 		]
   191             ]
   192 	    ]
   192         ]
   193 	].
       
   194 
       
   195 	"/
       
   196 	"/ #perform with a constant selector
       
   197 	"/
       
   198 	(selector == #perform: 
       
   199 	and:[argNode isConstant]) ifTrue:[
       
   200 	    argVal := argNode evaluate.
       
   201 	    argVal isSymbol ifTrue:[
       
   202 		^ UnaryNode receiver:recNode selector:argVal fold:folding
       
   203 	    ]
       
   204 	].
   193     ].
   205     ].
   194 
   206 
   195     ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0
   207     ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0
   196 
   208 
   197     "Modified: 2.7.1997 / 18:06:42 / cg"
   209     "Modified: / 15.1.1998 / 15:04:27 / cg"
   198 !
   210 !
   199 
   211 
   200 receiver:recNode selector:selectorString args:anArray
   212 receiver:recNode selector:selectorString args:anArray
   201     ^ self receiver:recNode selector:selectorString args:anArray fold:nil
   213     ^ self receiver:recNode selector:selectorString args:anArray fold:nil
   202 !
   214 !
   203 
   215 
   204 receiver:recNode selector:selectorString args:argArray fold:folding
   216 receiver:recNode selector:selectorString args:argArray fold:folding
   205     |numArgs|
   217     |numArgs arg1 arg1Val|
   206 
   218 
   207     folding notNil ifTrue:[
   219     folding notNil ifTrue:[
   208         numArgs := argArray size.
   220 	numArgs := argArray size.
   209         (numArgs == 1) ifTrue:[
   221 	arg1 := (argArray at:1).
   210             ^ self receiver:recNode selector:selectorString arg:(argArray at:1) fold:folding 
   222 	(numArgs == 1) ifTrue:[
   211         ].
   223 	    ^ self receiver:recNode selector:selectorString arg:arg1 fold:folding 
   212 
   224 	].
   213         "uncomment the follwoing for a nice array initializer optimization ..."
   225 
   214         (numArgs == 2) ifTrue:[
   226 	"/
   215             ^ self receiver:recNode selector:selectorString arg1:(argArray at:1) arg2:(argArray at:2) fold:folding 
   227 	"/ #perform:... with a constant selector
   216         ].
   228 	"/
   217         numArgs > Method maxNumberOfArguments ifTrue:[
   229 	numArgs <= 6 ifTrue:[
   218             ^ 'too many arguments for current VM implementation'.
   230 	    (#(nil
   219         ].
   231 	       #'perform:with:'
       
   232 	       #'perform:with:with:'
       
   233 	       #'perform:with:with:with:'
       
   234 	       #'perform:with:with:with:with:'
       
   235 	       #'perform:with:with:with:with:with:'
       
   236 	       #'perform:with:with:with:with:with:with:'
       
   237 	    ) at:numArgs) = selectorString 
       
   238 	    ifTrue:[
       
   239 		arg1 isConstant ifTrue:[    
       
   240 		    arg1Val := arg1 evaluate.
       
   241 		    arg1Val isSymbol ifTrue:[
       
   242 			^ MessageNode 
       
   243 				receiver:recNode 
       
   244 				selector:arg1Val
       
   245 				args:(argArray copyFrom:2)
       
   246 				fold:folding
       
   247 		    ]
       
   248 		]
       
   249 	    ]
       
   250 	].
       
   251 
       
   252 	(numArgs == 2) ifTrue:[
       
   253 	    ^ self receiver:recNode selector:selectorString arg1:arg1 arg2:(argArray at:2) fold:folding 
       
   254 	].
       
   255 	numArgs > Method maxNumberOfArguments ifTrue:[
       
   256 	    ^ 'too many arguments for current VM implementation'.
       
   257 	].
   220     ].
   258     ].
   221 
   259 
   222     ^ (self basicNew) receiver:recNode selector:selectorString args:argArray lineno:0
   260     ^ (self basicNew) receiver:recNode selector:selectorString args:argArray lineno:0
   223 
   261 
   224     "Modified: 3.9.1995 / 16:41:39 / claus"
   262     "Modified: / 3.9.1995 / 16:41:39 / claus"
   225     "Modified: 21.3.1996 / 16:07:34 / cg"
   263     "Modified: / 15.1.1998 / 15:20:00 / cg"
   226 ! !
   264 ! !
   227 
   265 
   228 !MessageNode methodsFor:'accessing'!
   266 !MessageNode methodsFor:'accessing'!
   229 
   267 
   230 arg1
   268 arg1
   290     "early check for possible inlinability"
   328     "early check for possible inlinability"
   291 
   329 
   292     |numArgs arg1 arg2 arg3|
   330     |numArgs arg1 arg2 arg3|
   293 
   331 
   294     (numArgs := argArray size) >= 1 ifTrue:[
   332     (numArgs := argArray size) >= 1 ifTrue:[
   295         arg1 := argArray at:1.
   333 	arg1 := argArray at:1.
   296     ].
   334     ].
   297     numArgs == 0 ifTrue:[
   335     numArgs == 0 ifTrue:[
   298         (selector == #whileTrue 
   336 	(selector == #whileTrue 
   299         or:[selector == #whileFalse]) ifTrue:[
   337 	or:[selector == #whileFalse]) ifTrue:[
   300             receiver isBlock ifTrue:[
   338 	    receiver isBlock ifTrue:[
   301                 receiver possiblyInlined:true
   339 		receiver possiblyInlined:true
   302             ].
   340 	    ].
   303         ].
   341 	].
   304         (selector == #value) ifTrue:[
   342 	(selector == #value) ifTrue:[
   305             receiver isBlock ifTrue:[
   343 	    receiver isBlock ifTrue:[
   306                 receiver possiblyInlined:true
   344 		receiver possiblyInlined:true
   307             ].
   345 	    ].
   308         ].
   346 	].
   309         (selector == #repeat) ifTrue:[
   347 	(selector == #repeat) ifTrue:[
   310             receiver isBlock ifTrue:[
   348 	    receiver isBlock ifTrue:[
   311                 receiver possiblyInlined:true
   349 		receiver possiblyInlined:true
   312             ].
   350 	    ].
   313         ].
   351 	].
   314     ].
   352     ].
   315 
   353 
   316     numArgs == 1 ifTrue:[
   354     numArgs == 1 ifTrue:[
   317         (selector == #or: 
   355 	(selector == #or: 
   318         or:[selector == #and:]) ifTrue:[
   356 	or:[selector == #and:]) ifTrue:[
   319             arg1 isBlock ifTrue:[
   357 	    arg1 isBlock ifTrue:[
   320                 arg1 possiblyInlined:true
   358 		arg1 possiblyInlined:true
   321             ].
   359 	    ].
   322         ].
   360 	].
   323 
   361 
   324         (selector == #ifTrue: 
   362 	(selector == #ifTrue: 
   325         or:[selector == #ifFalse:]) ifTrue:[
   363 	or:[selector == #ifFalse:]) ifTrue:[
   326             arg1 isBlock ifTrue:[
   364 	    arg1 isBlock ifTrue:[
   327                 arg1 possiblyInlined:true
   365 		arg1 possiblyInlined:true
   328             ].
   366 	    ].
   329         ].
   367 	].
   330 
   368 
   331         (selector == #whileTrue: 
   369 	(selector == #whileTrue: 
   332         or:[selector == #whileFalse:]) ifTrue:[
   370 	or:[selector == #whileFalse:]) ifTrue:[
   333             arg1 isBlock ifTrue:[
   371 	    arg1 isBlock ifTrue:[
   334                 arg1 possiblyInlined:true
   372 		arg1 possiblyInlined:true
   335             ].
   373 	    ].
   336             receiver isBlock ifTrue:[
   374 	    receiver isBlock ifTrue:[
   337                 receiver possiblyInlined:true
   375 		receiver possiblyInlined:true
   338             ].
   376 	    ].
   339         ].
   377 	].
   340         selector == #timesRepeat: ifTrue:[
   378 	selector == #timesRepeat: ifTrue:[
   341             arg1 isBlock ifTrue:[
   379 	    arg1 isBlock ifTrue:[
   342                 arg1 possiblyInlined:true       
   380 		arg1 possiblyInlined:true       
   343             ]
   381 	    ]
   344         ].
   382 	].
   345         ^ self
   383 	^ self
   346     ].
   384     ].
   347     numArgs >= 2 ifTrue:[
   385     numArgs >= 2 ifTrue:[
   348         arg2 := argArray at:2.
   386 	arg2 := argArray at:2.
   349     ].    
   387     ].    
   350     numArgs == 2 ifTrue:[
   388     numArgs == 2 ifTrue:[
   351         (selector == #ifTrue:ifFalse:
   389 	(selector == #ifTrue:ifFalse:
   352         or:[selector == #ifFalse:ifTrue:]) ifTrue:[
   390 	or:[selector == #ifFalse:ifTrue:]) ifTrue:[
   353             (arg1 isBlock 
   391 	    (arg1 isBlock 
   354             and:[arg2 isBlock]) ifTrue:[
   392 	    and:[arg2 isBlock]) ifTrue:[
   355                 arg1 possiblyInlined:true.
   393 		arg1 possiblyInlined:true.
   356                 arg2 possiblyInlined:true.
   394 		arg2 possiblyInlined:true.
   357             ].
   395 	    ].
   358         ].
   396 	].
   359         selector == #to:do: ifTrue:[
   397 	selector == #to:do: ifTrue:[
   360             arg2 isBlock ifTrue:[
   398 	    arg2 isBlock ifTrue:[
   361                 arg2 possiblyInlined:true.
   399 		arg2 possiblyInlined:true.
   362             ].
   400 	    ].
   363         ].
   401 	].
   364         ^ self
   402 	^ self
   365     ].
   403     ].
   366     numArgs >= 3 ifTrue:[
   404     numArgs >= 3 ifTrue:[
   367         arg3 := argArray at:3.
   405 	arg3 := argArray at:3.
   368     ].    
   406     ].    
   369     numArgs == 3 ifTrue:[
   407     numArgs == 3 ifTrue:[
   370         selector == #to:by:do: ifTrue:[
   408 	selector == #to:by:do: ifTrue:[
   371             arg3 isBlock ifTrue:[
   409 	    arg3 isBlock ifTrue:[
   372                 arg3 possiblyInlined:true.
   410 		arg3 possiblyInlined:true.
   373             ].
   411 	    ].
   374         ].
   412 	].
   375         ^ self
   413 	^ self
   376     ].
   414     ].
   377     ^ self
   415     ^ self
   378 
   416 
   379     "Created: 2.7.1997 / 17:01:10 / cg"
   417     "Created: 2.7.1997 / 17:01:10 / cg"
   380     "Modified: 29.8.1997 / 08:20:57 / cg"
   418     "Modified: 29.8.1997 / 08:20:57 / cg"
   477 
   515 
   478     theByteCode := #falseJump.
   516     theByteCode := #falseJump.
   479     theReceiver := receiver receiver.
   517     theReceiver := receiver receiver.
   480 
   518 
   481     optByteCode := self optimizedConditionFor:theReceiver
   519     optByteCode := self optimizedConditionFor:theReceiver
   482                                          with:theByteCode.
   520 					 with:theByteCode.
   483     optByteCode notNil ifTrue:[
   521     optByteCode notNil ifTrue:[
   484         ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
   522 	((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
   485             theArg := theReceiver arg1
   523 	    theArg := theReceiver arg1
   486         ].
   524 	].
   487         theReceiver := theReceiver receiver.
   525 	theReceiver := theReceiver receiver.
   488         theByteCode := optByteCode
   526 	theByteCode := optByteCode
   489     ].
   527     ].
   490     "/ code the left-of the and-part
   528     "/ code the left-of the and-part
   491     theReceiver codeOn:aStream inBlock:b for:aCompiler.
   529     theReceiver codeOn:aStream inBlock:b for:aCompiler.
   492     theArg notNil ifTrue:[
   530     theArg notNil ifTrue:[
   493         theArg codeOn:aStream inBlock:b for:aCompiler
   531 	theArg codeOn:aStream inBlock:b for:aCompiler
   494     ].
   532     ].
   495     aStream nextPut:theByteCode.
   533     aStream nextPut:theByteCode.
   496     pos1 := aStream position.   "/ remember branch target of left-fail branch
   534     pos1 := aStream position.   "/ remember branch target of left-fail branch
   497     aStream nextPut:0.
   535     aStream nextPut:0.
   498 
   536 
   499     "/ code the right of the and-part
   537     "/ code the right of the and-part
   500     theReceiver := receiver arg1.
   538     theReceiver := receiver arg1.
   501     theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
   539     theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
   502     (selector == #ifTrue:ifFalse:) ifTrue:[
   540     (selector == #ifTrue:ifFalse:) ifTrue:[
   503         jmp := #falseJump
   541 	jmp := #falseJump
   504     ] ifFalse:[
   542     ] ifFalse:[
   505         jmp := #trueJump
   543 	jmp := #trueJump
   506     ].
   544     ].
   507     aStream nextPut:jmp.
   545     aStream nextPut:jmp.
   508     pos2 := aStream position.   "/ remember branch target of right-fail branch 
   546     pos2 := aStream position.   "/ remember branch target of right-fail branch 
   509     aStream nextPut:0.
   547     aStream nextPut:0.
   510 
   548 
   511     code := aStream contents.
   549     code := aStream contents.
   512     (selector == #ifFalse:ifTrue:) ifTrue:[
   550     (selector == #ifFalse:ifTrue:) ifTrue:[
   513         code at:pos1 put:(aStream position)
   551 	code at:pos1 put:(aStream position)
   514     ].
   552     ].
   515 
   553 
   516     "/ code the if-block
   554     "/ code the if-block
   517     (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   555     (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   518 
   556 
   520     pos3 := aStream position.
   558     pos3 := aStream position.
   521     aStream nextPut:0.
   559     aStream nextPut:0.
   522 
   560 
   523     here := aStream position.
   561     here := aStream position.
   524     (selector == #ifTrue:ifFalse:) ifTrue:[
   562     (selector == #ifTrue:ifFalse:) ifTrue:[
   525         code at:pos1 put:here
   563 	code at:pos1 put:here
   526     ].
   564     ].
   527     code at:pos2 put:here.
   565     code at:pos2 put:here.
   528 
   566 
   529     "/ code the else-block
   567     "/ code the else-block
   530     (argArray at: 2) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   568     (argArray at: 2) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   602 
   640 
   603     |pos1 rightExpr|
   641     |pos1 rightExpr|
   604 
   642 
   605     receiver codeOn:aStream inBlock:b for:aCompiler.
   643     receiver codeOn:aStream inBlock:b for:aCompiler.
   606     valueNeeded ifTrue:[
   644     valueNeeded ifTrue:[
   607         aStream nextPut:#dup.
   645 	aStream nextPut:#dup.
   608     ].
   646     ].
   609     aStream nextPut:#falseJump.
   647     aStream nextPut:#falseJump.
   610     pos1 := aStream position.
   648     pos1 := aStream position.
   611     aStream nextPut:0.
   649     aStream nextPut:0.
   612     valueNeeded ifTrue:[
   650     valueNeeded ifTrue:[
   613         aStream nextPut:#drop.
   651 	aStream nextPut:#drop.
   614     ].
   652     ].
   615     rightExpr := argArray at:1.
   653     rightExpr := argArray at:1.
   616     rightExpr codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   654     rightExpr codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   617 
   655 
   618     (aStream contents) at:pos1 put:(aStream position)
   656     (aStream contents) at:pos1 put:(aStream position)
   625     "like codeOn, but always leave the receiver instead of the result"
   663     "like codeOn, but always leave the receiver instead of the result"
   626 
   664 
   627     |nargs isBuiltIn code codeL litIndex cls clsLitIndex|
   665     |nargs isBuiltIn code codeL litIndex cls clsLitIndex|
   628 
   666 
   629     argArray isNil ifTrue:[
   667     argArray isNil ifTrue:[
   630         nargs := 0
   668 	nargs := 0
   631     ] ifFalse:[
   669     ] ifFalse:[
   632         nargs := argArray size
   670 	nargs := argArray size
   633     ].
   671     ].
   634 
   672 
   635     isBuiltIn := false.
   673     isBuiltIn := false.
   636 
   674 
   637     (nargs == 0) ifTrue:[
   675     (nargs == 0) ifTrue:[
   638         isBuiltIn := aCompiler isBuiltInUnarySelector:selector forReceiver:receiver
   676 	isBuiltIn := aCompiler isBuiltInUnarySelector:selector forReceiver:receiver
   639     ].
   677     ].
   640     (nargs == 1) ifTrue:[
   678     (nargs == 1) ifTrue:[
   641         isBuiltIn := aCompiler isBuiltIn1ArgSelector:selector forReceiver:receiver
   679 	isBuiltIn := aCompiler isBuiltIn1ArgSelector:selector forReceiver:receiver
   642     ].
   680     ].
   643     (nargs == 2) ifTrue:[
   681     (nargs == 2) ifTrue:[
   644         isBuiltIn := aCompiler isBuiltIn2ArgSelector:selector forReceiver:receiver
   682 	isBuiltIn := aCompiler isBuiltIn2ArgSelector:selector forReceiver:receiver
   645     ].
   683     ].
   646 
   684 
   647     receiver codeOn:aStream inBlock:b for:aCompiler.
   685     receiver codeOn:aStream inBlock:b for:aCompiler.
   648     aStream nextPut:#dup.
   686     aStream nextPut:#dup.
   649 
   687 
   650     "can we use a send-bytecode ?"
   688     "can we use a send-bytecode ?"
   651     isBuiltIn ifTrue:[
   689     isBuiltIn ifTrue:[
   652         receiver isSuper ifFalse:[
   690 	receiver isSuper ifFalse:[
   653             (nargs > 0) ifTrue:[
   691 	    (nargs > 0) ifTrue:[
   654                 (argArray at:1) codeOn:aStream inBlock:b for:aCompiler.
   692 		(argArray at:1) codeOn:aStream inBlock:b for:aCompiler.
   655                 (nargs > 1) ifTrue:[
   693 		(nargs > 1) ifTrue:[
   656                     (argArray at:2) codeOn:aStream inBlock:b for:aCompiler
   694 		    (argArray at:2) codeOn:aStream inBlock:b for:aCompiler
   657                 ]
   695 		]
   658             ].
   696 	    ].
   659             aStream nextPut:selector.
   697 	    aStream nextPut:selector.
   660             (aCompiler hasLineNumber:selector) ifTrue:[
   698 	    (aCompiler hasLineNumber:selector) ifTrue:[
   661                 aStream nextPut:lineNr.
   699 		aStream nextPut:lineNr.
   662             ].
   700 	    ].
   663             aStream nextPut:#drop.
   701 	    aStream nextPut:#drop.
   664             ^ self
   702 	    ^ self
   665         ]
   703 	]
   666     ].
   704     ].
   667 
   705 
   668     "no - generate a send"
   706     "no - generate a send"
   669     argArray notNil ifTrue:[
   707     argArray notNil ifTrue:[
   670         argArray do:[:arg |
   708 	argArray do:[:arg |
   671             arg codeOn:aStream inBlock:b for:aCompiler
   709 	    arg codeOn:aStream inBlock:b for:aCompiler
   672         ]
   710 	]
   673     ].
   711     ].
   674     litIndex := aCompiler addLiteral:selector.
   712     litIndex := aCompiler addLiteral:selector.
   675 
   713 
   676     receiver isSuper ifTrue:[
   714     receiver isSuper ifTrue:[
   677         cls := aCompiler targetClass.
   715 	cls := aCompiler targetClass.
   678         receiver isHere ifTrue:[
   716 	receiver isHere ifTrue:[
   679             code := #hereSend.
   717 	    code := #hereSend.
   680             codeL := #hereSendL.
   718 	    codeL := #hereSendL.
   681         ] ifFalse:[
   719 	] ifFalse:[
   682             code := #superSend.
   720 	    code := #superSend.
   683             codeL := #superSendL.
   721 	    codeL := #superSendL.
   684             cls := cls superclass.
   722 	    cls := cls superclass.
   685         ].
   723 	].
   686         clsLitIndex := aCompiler addLiteral:cls.
   724 	clsLitIndex := aCompiler addLiteral:cls.
   687 
   725 
   688         (litIndex <= 255 and:[clsLitIndex <= 255]) ifTrue:[
   726 	(litIndex <= 255 and:[clsLitIndex <= 255]) ifTrue:[
   689             aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:clsLitIndex; nextPut:#drop.
   727 	    aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:clsLitIndex; nextPut:#drop.
   690             ^ self
   728 	    ^ self
   691         ].
   729 	].
   692 
   730 
   693         "need 16bit litIndex"
   731 	"need 16bit litIndex"
   694         aStream nextPut:codeL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:clsLitIndex; nextPut:0; nextPut:#drop.
   732 	aStream nextPut:codeL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:clsLitIndex; nextPut:0; nextPut:#drop.
   695         ^ self
   733 	^ self
   696     ].
   734     ].
   697 
   735 
   698     litIndex <= 255 ifTrue:[
   736     litIndex <= 255 ifTrue:[
   699         (nargs <= 3) ifTrue:[
   737 	(nargs <= 3) ifTrue:[
   700             code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
   738 	    code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
   701             aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
   739 	    aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
   702             ^ self
   740 	    ^ self
   703         ].
   741 	].
   704 
   742 
   705         aStream nextPut:#sendDrop; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
   743 	aStream nextPut:#sendDrop; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
   706         ^ self
   744 	^ self
   707     ].
   745     ].
   708     "need 16bit litIndex"
   746     "need 16bit litIndex"
   709     aStream nextPut:#sendDropL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
   747     aStream nextPut:#sendDropL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
   710 
   748 
   711     "Modified: 17.4.1996 / 22:33:24 / cg"
   749     "Modified: 17.4.1996 / 22:33:24 / cg"
   722      needJump block1|
   760      needJump block1|
   723 
   761 
   724     theReceiver := receiver.
   762     theReceiver := receiver.
   725 
   763 
   726     (theReceiver isMessage) ifTrue:[
   764     (theReceiver isMessage) ifTrue:[
   727         subsel := theReceiver selector.
   765 	subsel := theReceiver selector.
   728         (subsel == #and:) ifTrue:[
   766 	(subsel == #and:) ifTrue:[
   729             self codeAndIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   767 	    self codeAndIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   730             ^ self
   768 	    ^ self
   731         ].
   769 	].
   732         (subsel == #or:) ifTrue:[
   770 	(subsel == #or:) ifTrue:[
   733             self codeOrIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   771 	    self codeOrIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   734             ^ self
   772 	    ^ self
   735         ]
   773 	]
   736     ].
   774     ].
   737     (selector == #ifTrue:ifFalse:) ifTrue:[
   775     (selector == #ifTrue:ifFalse:) ifTrue:[
   738         theByteCode := #falseJump
   776 	theByteCode := #falseJump
   739     ] ifFalse:[
   777     ] ifFalse:[
   740         (selector == #ifFalse:ifTrue:) ifTrue:[
   778 	(selector == #ifFalse:ifTrue:) ifTrue:[
   741             theByteCode := #trueJump
   779 	    theByteCode := #trueJump
   742         ]
   780 	]
   743     ].
   781     ].
   744     optByteCode := self optimizedConditionFor:theReceiver
   782     optByteCode := self optimizedConditionFor:theReceiver
   745                                          with:theByteCode.
   783 					 with:theByteCode.
   746     optByteCode notNil ifTrue:[
   784     optByteCode notNil ifTrue:[
   747         ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
   785 	((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
   748             theArg := theReceiver arg1
   786 	    theArg := theReceiver arg1
   749         ].
   787 	].
   750         theReceiver := theReceiver receiver.
   788 	theReceiver := theReceiver receiver.
   751         theByteCode := optByteCode
   789 	theByteCode := optByteCode
   752     ].
   790     ].
   753     theByteCode notNil ifTrue:[
   791     theByteCode notNil ifTrue:[
   754         theReceiver codeOn:aStream inBlock:b for:aCompiler.
   792 	theReceiver codeOn:aStream inBlock:b for:aCompiler.
   755 
   793 
   756         needLineNr := true.
   794 	needLineNr := true.
   757         theArg isNil ifTrue:[
   795 	theArg isNil ifTrue:[
   758             theReceiver isMessage ifTrue:[
   796 	    theReceiver isMessage ifTrue:[
   759                 (aCompiler hasLineNumber:(theReceiver selector)) ifTrue:[
   797 		(aCompiler hasLineNumber:(theReceiver selector)) ifTrue:[
   760                     theReceiver lineNumber == lineNr ifTrue:[
   798 		    theReceiver lineNumber == lineNr ifTrue:[
   761                         needLineNr := false
   799 			needLineNr := false
   762                     ]
   800 		    ]
   763                 ]
   801 		]
   764             ]
   802 	    ]
   765         ] ifFalse:[
   803 	] ifFalse:[
   766             theArg codeOn:aStream inBlock:b for:aCompiler
   804 	    theArg codeOn:aStream inBlock:b for:aCompiler
   767         ].
   805 	].
   768 
   806 
   769         needLineNr ifTrue:[
   807 	needLineNr ifTrue:[
   770             (lineNr between:1 and:255) ifTrue:[
   808 	    (lineNr between:1 and:255) ifTrue:[
   771                 aStream nextPut:#lineno; nextPut:lineNr.
   809 		aStream nextPut:#lineno; nextPut:lineNr.
   772             ]
   810 	    ]
   773         ].
   811 	].
   774 
   812 
   775         aStream nextPut:theByteCode.
   813 	aStream nextPut:theByteCode.
   776         pos := aStream position.
   814 	pos := aStream position.
   777         aStream nextPut:0.
   815 	aStream nextPut:0.
   778         block1 := argArray at:1.
   816 	block1 := argArray at:1.
   779         block1 codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   817 	block1 codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   780         needJump := true.
   818 	needJump := true.
   781         (block1 isBlock and:[block1 endsWithReturn]) ifTrue:[
   819 	(block1 isBlock and:[block1 endsWithReturn]) ifTrue:[
   782             needJump := false
   820 	    needJump := false
   783         ].
   821 	].
   784         needJump ifTrue:[
   822 	needJump ifTrue:[
   785             aStream nextPut:#jump.
   823 	    aStream nextPut:#jump.
   786             pos2 := aStream position.
   824 	    pos2 := aStream position.
   787             aStream nextPut:0.
   825 	    aStream nextPut:0.
   788         ].
   826 	].
   789         code := aStream contents.
   827 	code := aStream contents.
   790         code at:pos put:(aStream position).
   828 	code at:pos put:(aStream position).
   791         (argArray at:2) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   829 	(argArray at:2) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   792         needJump ifTrue:[
   830 	needJump ifTrue:[
   793             code at:pos2 put:(aStream position)
   831 	    code at:pos2 put:(aStream position)
   794         ]
   832 	]
   795     ]
   833     ]
   796 
   834 
   797     "Modified: 9.11.1996 / 19:53:52 / cg"
   835     "Modified: 9.11.1996 / 19:53:52 / cg"
   798 !
   836 !
   799 
   837 
   804      needLineNr|
   842      needLineNr|
   805 
   843 
   806     theReceiver := receiver.
   844     theReceiver := receiver.
   807 
   845 
   808     (theReceiver isMessage) ifTrue:[
   846     (theReceiver isMessage) ifTrue:[
   809         subsel := theReceiver selector.
   847 	subsel := theReceiver selector.
   810 
   848 
   811         (subsel == #and:) ifTrue:[
   849 	(subsel == #and:) ifTrue:[
   812             theReceiver arg1 isBlock ifTrue:[
   850 	    theReceiver arg1 isBlock ifTrue:[
   813                 self codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   851 		self codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   814                 ^ self
   852 		^ self
   815             ]
   853 	    ]
   816         ].
   854 	].
   817         (subsel == #or:) ifTrue:[
   855 	(subsel == #or:) ifTrue:[
   818             theReceiver arg1 isBlock ifTrue:[
   856 	    theReceiver arg1 isBlock ifTrue:[
   819                 self codeOrIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   857 		self codeOrIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   820                 ^ self
   858 		^ self
   821             ]
   859 	    ]
   822         ].
   860 	].
   823     ].
   861     ].
   824     (selector == #ifTrue:) ifTrue:[
   862     (selector == #ifTrue:) ifTrue:[
   825         theByteCode := #falseJump
   863 	theByteCode := #falseJump
   826     ] ifFalse:[
   864     ] ifFalse:[
   827         theByteCode := #trueJump
   865 	theByteCode := #trueJump
   828     ].
   866     ].
   829     optByteCode := self optimizedConditionFor:theReceiver
   867     optByteCode := self optimizedConditionFor:theReceiver
   830                                          with:theByteCode.
   868 					 with:theByteCode.
   831     optByteCode notNil ifTrue:[
   869     optByteCode notNil ifTrue:[
   832         ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
   870 	((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
   833             theArg := theReceiver arg1
   871 	    theArg := theReceiver arg1
   834         ].
   872 	].
   835         theReceiver := theReceiver receiver.
   873 	theReceiver := theReceiver receiver.
   836         theByteCode := optByteCode
   874 	theByteCode := optByteCode
   837     ].
   875     ].
   838 
   876 
   839     theReceiver codeOn:aStream inBlock:b for:aCompiler.
   877     theReceiver codeOn:aStream inBlock:b for:aCompiler.
   840     theArg notNil ifTrue:[
   878     theArg notNil ifTrue:[
   841         theArg codeOn:aStream inBlock:b for:aCompiler
   879 	theArg codeOn:aStream inBlock:b for:aCompiler
   842     ].
   880     ].
   843 
   881 
   844     needLineNr := true.
   882     needLineNr := true.
   845     theArg isNil ifTrue:[
   883     theArg isNil ifTrue:[
   846         theReceiver isMessage ifTrue:[
   884 	theReceiver isMessage ifTrue:[
   847             (aCompiler hasLineNumber:(theReceiver selector)) ifTrue:[
   885 	    (aCompiler hasLineNumber:(theReceiver selector)) ifTrue:[
   848                 theReceiver lineNumber == lineNr ifTrue:[
   886 		theReceiver lineNumber == lineNr ifTrue:[
   849                     needLineNr := false
   887 		    needLineNr := false
   850                 ]
   888 		]
   851             ]
   889 	    ]
   852         ]
   890 	]
   853     ].
   891     ].
   854 
   892 
   855     needLineNr ifTrue:[
   893     needLineNr ifTrue:[
   856         (lineNr between:1 and:255) ifTrue:[
   894 	(lineNr between:1 and:255) ifTrue:[
   857             aStream nextPut:#lineno; nextPut:lineNr.
   895 	    aStream nextPut:#lineno; nextPut:lineNr.
   858         ]
   896 	]
   859     ].
   897     ].
   860 
   898 
   861     aStream nextPut:theByteCode.
   899     aStream nextPut:theByteCode.
   862     pos := aStream position.
   900     pos := aStream position.
   863     aStream nextPut:0.
   901     aStream nextPut:0.
   864     (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   902     (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   865 
   903 
   866     code := aStream contents.
   904     code := aStream contents.
   867     valueNeeded ifTrue:[
   905     valueNeeded ifTrue:[
   868         aStream nextPut:#jump.
   906 	aStream nextPut:#jump.
   869         pos2 := aStream position.
   907 	pos2 := aStream position.
   870         aStream nextPut:0.
   908 	aStream nextPut:0.
   871         code at:pos put:(aStream position).
   909 	code at:pos put:(aStream position).
   872         aStream nextPut:#pushNil.
   910 	aStream nextPut:#pushNil.
   873         code at:pos2 put:(aStream position)
   911 	code at:pos2 put:(aStream position)
   874     ] ifFalse:[
   912     ] ifFalse:[
   875         code at:pos put:(aStream position)
   913 	code at:pos put:(aStream position)
   876     ]
   914     ]
   877 
   915 
   878     "Modified: / 28.10.1997 / 18:33:42 / cg"
   916     "Modified: / 28.10.1997 / 18:33:42 / cg"
   879 !
   917 !
   880 
   918 
   885 codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
   923 codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
   886     |recType nargs isBuiltIn litIndex cls clsLitIndex code isSpecial
   924     |recType nargs isBuiltIn litIndex cls clsLitIndex code isSpecial
   887      specialCode stackTop arg1 arg2 arg3|
   925      specialCode stackTop arg1 arg2 arg3|
   888 
   926 
   889     argArray isNil ifTrue:[
   927     argArray isNil ifTrue:[
   890         nargs := 0
   928 	nargs := 0
   891     ] ifFalse:[
   929     ] ifFalse:[
   892         nargs := argArray size.
   930 	nargs := argArray size.
   893         nargs > 0 ifTrue:[
   931 	nargs > 0 ifTrue:[
   894             arg1 := argArray at:1.
   932 	    arg1 := argArray at:1.
   895             nargs > 1 ifTrue:[
   933 	    nargs > 1 ifTrue:[
   896                 arg2 := argArray at:2.
   934 		arg2 := argArray at:2.
   897                 nargs > 2 ifTrue:[
   935 		nargs > 2 ifTrue:[
   898                     arg3 := argArray at:3.
   936 		    arg3 := argArray at:3.
   899                 ]
   937 		]
   900             ]    
   938 	    ]    
   901         ].
   939 	].
   902     ].
   940     ].
   903 
   941 
   904     isBuiltIn := isSpecial := false.
   942     isBuiltIn := isSpecial := false.
   905     recType := receiver type.
   943     recType := receiver type.
   906 
   944 
   907     (nargs == 0) ifTrue:[
   945     (nargs == 0) ifTrue:[
   908         (recType == #ThisContext) ifTrue:[
   946 	(recType == #ThisContext) ifTrue:[
   909             valueNeeded ifFalse:[
   947 	    valueNeeded ifFalse:[
   910                 "for now, only do it in methods"
   948 		"for now, only do it in methods"
   911                 b isNil ifTrue:[
   949 		b isNil ifTrue:[
   912                     (selector == #restart) ifTrue:[
   950 		    (selector == #restart) ifTrue:[
   913                         aStream nextPut:#jump; nextPut:1.      "jump to start"
   951 			aStream nextPut:#jump; nextPut:1.      "jump to start"
   914                         ^ self
   952 			^ self
   915                     ].
   953 		    ].
   916                 ].
   954 		].
   917                 (selector == #return) ifTrue:[  "^ nil"
   955 		(selector == #return) ifTrue:[  "^ nil"
   918                     aStream nextPut:#retNil.
   956 		    aStream nextPut:#retNil.
   919                     ^ self
   957 		    ^ self
   920                 ].
   958 		].
   921             ]
   959 	    ]
   922         ].
   960 	].
   923 
   961 
   924         receiver isBlock ifTrue:[
   962 	receiver isBlock ifTrue:[
   925             selector == #value ifTrue:[
   963 	    selector == #value ifTrue:[
   926                 receiver codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   964 		receiver codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   927                 ^ self
   965 		^ self
   928             ].
   966 	    ].
   929             ((selector == #whileTrue) or:[selector == #whileFalse]) ifTrue:[
   967 	    ((selector == #whileTrue) or:[selector == #whileFalse]) ifTrue:[
   930                 receiver isInlinable ifTrue:[
   968 		receiver isInlinable ifTrue:[
   931                     ^ self codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   969 		    ^ self codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   932                 ]
   970 		]
   933             ].
   971 	    ].
   934             (selector == #repeat) ifTrue:[
   972 	    (selector == #repeat) ifTrue:[
   935                 receiver isInlinable ifTrue:[
   973 		receiver isInlinable ifTrue:[
   936                     valueNeeded ifFalse:[
   974 		    valueNeeded ifFalse:[
   937                         ^ self codeRepeatOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   975 			^ self codeRepeatOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   938                     ]
   976 		    ]
   939                 ]
   977 		]
   940             ].
   978 	    ].
   941         ].
   979 	].
   942 
   980 
   943         isBuiltIn := aCompiler isBuiltInUnarySelector:selector forReceiver:receiver.
   981 	isBuiltIn := aCompiler isBuiltInUnarySelector:selector forReceiver:receiver.
   944     ].
   982     ].
   945 
   983 
   946     (nargs == 1) ifTrue:[
   984     (nargs == 1) ifTrue:[
   947         (recType == #ThisContext) ifTrue:[
   985 	(recType == #ThisContext) ifTrue:[
   948             valueNeeded ifFalse:[
   986 	    valueNeeded ifFalse:[
   949                 (selector == #return:) ifTrue:[
   987 		(selector == #return:) ifTrue:[
   950                     arg1 codeOn:aStream inBlock:b for:aCompiler.  "^ value"
   988 		    arg1 codeOn:aStream inBlock:b for:aCompiler.  "^ value"
   951                     aStream nextPut:#retTop.
   989 		    aStream nextPut:#retTop.
   952                     ^ self
   990 		    ^ self
   953                 ].
   991 		].
   954              ].
   992 	     ].
   955         ].
   993 	].
   956 
   994 
   957         (arg1 isBlock and:[arg1 isInlinable]) ifTrue:[
   995 	(arg1 isBlock and:[arg1 isInlinable]) ifTrue:[
   958             ((selector == #ifTrue:) or:[selector == #ifFalse:]) ifTrue:[
   996 	    ((selector == #ifTrue:) or:[selector == #ifFalse:]) ifTrue:[
   959                 receiver isBlock ifFalse:[
   997 		receiver isBlock ifFalse:[
   960                     ^ self codeIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   998 		    ^ self codeIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   961                 ].
   999 		].
   962             ].
  1000 	    ].
   963 
  1001 
   964             (selector == #or:) ifTrue:[
  1002 	    (selector == #or:) ifTrue:[
   965                 ^ self codeOrOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1003 		^ self codeOrOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   966             ].
  1004 	    ].
   967 
  1005 
   968             (selector == #and:) ifTrue:[
  1006 	    (selector == #and:) ifTrue:[
   969                 ^ self codeAndOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1007 		^ self codeAndOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   970             ].
  1008 	    ].
   971 
  1009 
   972             (selector == #timesRepeat:) ifTrue:[
  1010 	    (selector == #timesRepeat:) ifTrue:[
   973                 "/ now, always inline #timesRepeat:;
  1011 		"/ now, always inline #timesRepeat:;
   974                 "/ the receiver must understand #> and #-
  1012 		"/ the receiver must understand #> and #-
   975                 
  1013                 
   976                ^ self codeTimesRepeatOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1014 	       ^ self codeTimesRepeatOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   977             ].
  1015 	    ].
   978 
  1016 
   979             ((selector == #whileTrue:) or:[selector == #whileFalse:]) ifTrue:[
  1017 	    ((selector == #whileTrue:) or:[selector == #whileFalse:]) ifTrue:[
   980                 (receiver isBlock and:[receiver isInlinable]) ifTrue:[
  1018 		(receiver isBlock and:[receiver isInlinable]) ifTrue:[
   981                     ^ self codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1019 		    ^ self codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   982                 ]
  1020 		]
   983             ]
  1021 	    ]
   984         ].
  1022 	].
   985 
  1023 
   986         selector == #? ifTrue:[
  1024 	selector == #? ifTrue:[
   987             "/ only do short-circuit optimization, if arg is not a message;
  1025 	    "/ only do short-circuit optimization, if arg is not a message;
   988             "/ (could have side-effects)
  1026 	    "/ (could have side-effects)
   989             "/
  1027 	    "/
   990             arg1 isMessage ifFalse:[
  1028 	    arg1 isMessage ifFalse:[
   991                 ^ self codeQuestOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1029 		^ self codeQuestOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
   992             ]
  1030 	    ]
   993         ].
  1031 	].
   994 
  1032 
   995         isBuiltIn := aCompiler isBuiltIn1ArgSelector:selector forReceiver:receiver.
  1033 	isBuiltIn := aCompiler isBuiltIn1ArgSelector:selector forReceiver:receiver.
   996     ].
  1034     ].
   997 
  1035 
   998     (nargs == 2) ifTrue:[
  1036     (nargs == 2) ifTrue:[
   999         ((selector == #ifTrue:ifFalse:) or:[selector == #ifFalse:ifTrue:]) ifTrue:[
  1037 	((selector == #ifTrue:ifFalse:) or:[selector == #ifFalse:ifTrue:]) ifTrue:[
  1000             receiver isBlock ifFalse:[
  1038 	    receiver isBlock ifFalse:[
  1001                 (arg1 isBlock and:[arg1 isInlinable]) ifTrue:[
  1039 		(arg1 isBlock and:[arg1 isInlinable]) ifTrue:[
  1002                     (arg2 isBlock and:[arg2 isInlinable]) ifTrue:[
  1040 		    (arg2 isBlock and:[arg2 isInlinable]) ifTrue:[
  1003                         ^ self codeIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1041 			^ self codeIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1004                     ]
  1042 		    ]
  1005                 ]
  1043 		]
  1006             ]
  1044 	    ]
  1007         ].
  1045 	].
  1008 
  1046 
  1009         selector == #to:do: ifTrue:[
  1047 	selector == #to:do: ifTrue:[
  1010             (arg2 isBlock and:[arg2 isInlinable and:[arg2 numArgs == 1]]) ifTrue:[
  1048 	    (arg2 isBlock and:[arg2 isInlinable and:[arg2 numArgs == 1]]) ifTrue:[
  1011                 ^ self codeToDoOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
  1049 		^ self codeToDoOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
  1012             ]
  1050 	    ]
  1013         ].
  1051 	].
  1014 
  1052 
  1015         isBuiltIn := aCompiler isBuiltIn2ArgSelector:selector forReceiver:receiver.
  1053 	isBuiltIn := aCompiler isBuiltIn2ArgSelector:selector forReceiver:receiver.
  1016     ].
  1054     ].
  1017 
  1055 
  1018     (nargs == 3) ifTrue:[
  1056     (nargs == 3) ifTrue:[
  1019         selector == #to:by:do: ifTrue:[
  1057 	selector == #to:by:do: ifTrue:[
  1020             "/ step must be a constant (need to know how to compare)
  1058 	    "/ step must be a constant (need to know how to compare)
  1021             (arg2 isConstant 
  1059 	    (arg2 isConstant 
  1022             and:[arg2 type == #Integer]) ifTrue:[
  1060 	    and:[arg2 type == #Integer]) ifTrue:[
  1023                 (arg3 isBlock 
  1061 		(arg3 isBlock 
  1024                 and:[arg3 isInlinable 
  1062 		and:[arg3 isInlinable 
  1025                 and:[arg3 numArgs == 1]]) ifTrue:[
  1063 		and:[arg3 numArgs == 1]]) ifTrue:[
  1026                     ^ self codeToByDoOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
  1064 		    ^ self codeToByDoOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
  1027                 ]
  1065 		]
  1028             ]
  1066 	    ]
  1029         ].
  1067 	].
  1030     ].
  1068     ].
  1031 
  1069 
  1032     isBuiltIn ifFalse:[
  1070     isBuiltIn ifFalse:[
  1033         specialCode := aCompiler specialSendCodeFor:selector.
  1071 	specialCode := aCompiler specialSendCodeFor:selector.
  1034         isSpecial := specialCode notNil.
  1072 	isSpecial := specialCode notNil.
  1035     ].
  1073     ].
  1036 
  1074 
  1037     "can we use a send-bytecode ?"
  1075     "can we use a send-bytecode ?"
  1038     (isBuiltIn or:[isSpecial]) ifTrue:[
  1076     (isBuiltIn or:[isSpecial]) ifTrue:[
  1039         receiver isSuper ifFalse:[
  1077 	receiver isSuper ifFalse:[
  1040             receiver codeOn:aStream inBlock:b for:aCompiler.
  1078 	    receiver codeOn:aStream inBlock:b for:aCompiler.
  1041             (nargs > 0) ifTrue:[
  1079 	    (nargs > 0) ifTrue:[
  1042                 arg1 codeOn:aStream inBlock:b for:aCompiler.
  1080 		arg1 codeOn:aStream inBlock:b for:aCompiler.
  1043                 (nargs > 1) ifTrue:[
  1081 		(nargs > 1) ifTrue:[
  1044                     arg2 codeOn:aStream inBlock:b for:aCompiler
  1082 		    arg2 codeOn:aStream inBlock:b for:aCompiler
  1045                 ]
  1083 		]
  1046             ].
  1084 	    ].
  1047             aStream nextPut:selector.
  1085 	    aStream nextPut:selector.
  1048             (aCompiler hasLineNumber:selector) ifTrue:[
  1086 	    (aCompiler hasLineNumber:selector) ifTrue:[
  1049                 aStream nextPut:lineNr.
  1087 		aStream nextPut:lineNr.
  1050             ].
  1088 	    ].
  1051             isSpecial ifTrue:[
  1089 	    isSpecial ifTrue:[
  1052                 aStream nextPut:specialCode
  1090 		aStream nextPut:specialCode
  1053             ].
  1091 	    ].
  1054             valueNeeded ifFalse:[
  1092 	    valueNeeded ifFalse:[
  1055                 aStream nextPut:#drop
  1093 		aStream nextPut:#drop
  1056             ].
  1094 	    ].
  1057             ^ self
  1095 	    ^ self
  1058         ]
  1096 	]
  1059     ].
  1097     ].
  1060 
  1098 
  1061     ((nargs == 0) and:[selector == #yourself]) ifTrue:[
  1099     ((nargs == 0) and:[selector == #yourself]) ifTrue:[
  1062         "yourself is often added to get the receiver -
  1100 	"yourself is often added to get the receiver -
  1063          we get it without the yourself-message"
  1101 	 we get it without the yourself-message"
  1064 
  1102 
  1065         valueNeeded ifTrue:[
  1103 	valueNeeded ifTrue:[
  1066             receiver codeOn:aStream inBlock:b for:aCompiler
  1104 	    receiver codeOn:aStream inBlock:b for:aCompiler
  1067         ].
  1105 	].
  1068         ^ self
  1106 	^ self
  1069     ].
  1107     ].
  1070 
  1108 
  1071     "no - generate a send"
  1109     "no - generate a send"
  1072 
  1110 
  1073     receiver isSuper ifTrue:[
  1111     receiver isSuper ifTrue:[
  1074         cls := aCompiler targetClass.
  1112 	cls := aCompiler targetClass.
  1075         receiver isHere ifTrue:[
  1113 	receiver isHere ifTrue:[
  1076             code := #hereSend.
  1114 	    code := #hereSend.
  1077         ] ifFalse:[
  1115 	] ifFalse:[
  1078             code := #superSend.
  1116 	    code := #superSend.
  1079             cls := cls superclass.
  1117 	    cls := cls superclass.
  1080         ].
  1118 	].
  1081         clsLitIndex := aCompiler addLiteral:cls.
  1119 	clsLitIndex := aCompiler addLiteral:cls.
  1082     ] ifFalse:[
  1120     ] ifFalse:[
  1083         clsLitIndex := 0.
  1121 	clsLitIndex := 0.
  1084     ].
  1122     ].
  1085 
  1123 
  1086     litIndex := aCompiler addLiteral:selector.
  1124     litIndex := aCompiler addLiteral:selector.
  1087     (litIndex <= 255 and:[clsLitIndex <= 255]) ifTrue:[
  1125     (litIndex <= 255 and:[clsLitIndex <= 255]) ifTrue:[
  1088         stackTop := nil.
  1126 	stackTop := nil.
  1089 
  1127 
  1090         (recType ~~ #Self) ifTrue:[
  1128 	(recType ~~ #Self) ifTrue:[
  1091             receiver codeOn:aStream inBlock:b for:aCompiler.
  1129 	    receiver codeOn:aStream inBlock:b for:aCompiler.
  1092             receiver isConstant ifTrue:[ 
  1130 	    receiver isConstant ifTrue:[ 
  1093                 stackTop := receiver
  1131 		stackTop := receiver
  1094             ]
  1132 	    ]
  1095         ].
  1133 	].
  1096         argArray notNil ifTrue:[
  1134 	argArray notNil ifTrue:[
  1097             argArray do:[:arg |
  1135 	    argArray do:[:arg |
  1098                 (stackTop notNil 
  1136 		(stackTop notNil 
  1099                 and:[arg canReuseAsArg:stackTop]) ifTrue:[
  1137 		and:[arg canReuseAsArg:stackTop]) ifTrue:[
  1100                     aStream nextPut:#dup.
  1138 		    aStream nextPut:#dup.
  1101 "/ 'reuse:' print. stackTop print. ' in ' print. aCompiler selector printNL.
  1139 "/ 'reuse:' print. stackTop print. ' in ' print. aCompiler selector printNL.
  1102                 ] ifFalse:[
  1140 		] ifFalse:[
  1103                     arg codeOn:aStream inBlock:b for:aCompiler.
  1141 		    arg codeOn:aStream inBlock:b for:aCompiler.
  1104                     stackTop := arg.
  1142 		    stackTop := arg.
  1105                 ]
  1143 		]
  1106             ]
  1144 	    ]
  1107         ].
  1145 	].
  1108 
  1146 
  1109         receiver isSuper ifTrue:[
  1147 	receiver isSuper ifTrue:[
  1110             aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:clsLitIndex.
  1148 	    aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:clsLitIndex.
  1111             valueNeeded ifFalse:[
  1149 	    valueNeeded ifFalse:[
  1112                 aStream nextPut:#drop
  1150 		aStream nextPut:#drop
  1113             ].
  1151 	    ].
  1114             ^ self
  1152 	    ^ self
  1115         ].
  1153 	].
  1116 
  1154 
  1117         (nargs <= 3) ifTrue:[
  1155 	(nargs <= 3) ifTrue:[
  1118             |codes|
  1156 	    |codes|
  1119 
  1157 
  1120             valueNeeded ifTrue:[
  1158 	    valueNeeded ifTrue:[
  1121                 (receiver type == #Self) ifTrue:[
  1159 		(receiver type == #Self) ifTrue:[
  1122                     codes := #(sendSelf0 sendSelf1 sendSelf2 sendSelf3)
  1160 		    codes := #(sendSelf0 sendSelf1 sendSelf2 sendSelf3)
  1123                 ] ifFalse:[
  1161 		] ifFalse:[
  1124                     codes := #(send0 send1 send2 send3)
  1162 		    codes := #(send0 send1 send2 send3)
  1125                 ]
  1163 		]
  1126             ] ifFalse:[
  1164 	    ] ifFalse:[
  1127                 (receiver type == #Self) ifTrue:[
  1165 		(receiver type == #Self) ifTrue:[
  1128                     codes := #(sendSelfDrop0 sendSelfDrop1 sendSelfDrop2 sendSelfDrop3)
  1166 		    codes := #(sendSelfDrop0 sendSelfDrop1 sendSelfDrop2 sendSelfDrop3)
  1129                 ] ifFalse:[
  1167 		] ifFalse:[
  1130                     codes := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3)
  1168 		    codes := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3)
  1131                 ]
  1169 		]
  1132             ].
  1170 	    ].
  1133             aStream nextPut:(codes at:(nargs + 1)); nextPut:lineNr; nextPut:litIndex.
  1171 	    aStream nextPut:(codes at:(nargs + 1)); nextPut:lineNr; nextPut:litIndex.
  1134             ^ self
  1172 	    ^ self
  1135         ].
  1173 	].
  1136 
  1174 
  1137         (recType == #Self) ifTrue:[
  1175 	(recType == #Self) ifTrue:[
  1138             code := #sendSelf
  1176 	    code := #sendSelf
  1139         ] ifFalse:[
  1177 	] ifFalse:[
  1140             valueNeeded ifTrue:[
  1178 	    valueNeeded ifTrue:[
  1141                 code := #send
  1179 		code := #send
  1142             ] ifFalse:[
  1180 	    ] ifFalse:[
  1143                 code := #sendDrop
  1181 		code := #sendDrop
  1144             ]
  1182 	    ]
  1145         ].
  1183 	].
  1146         aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
  1184 	aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
  1147         valueNeeded ifFalse:[
  1185 	valueNeeded ifFalse:[
  1148             (recType == #Self) ifTrue:[
  1186 	    (recType == #Self) ifTrue:[
  1149                 aStream nextPut:#drop
  1187 		aStream nextPut:#drop
  1150             ]
  1188 	    ]
  1151         ].
  1189 	].
  1152         ^ self
  1190 	^ self
  1153     ].
  1191     ].
  1154 
  1192 
  1155     "needs 16bit literal index"
  1193     "needs 16bit literal index"
  1156 
  1194 
  1157     receiver isSuper ifTrue:[
  1195     receiver isSuper ifTrue:[
  1158         argArray notNil ifTrue:[
  1196 	argArray notNil ifTrue:[
  1159             argArray do:[:arg |
  1197 	    argArray do:[:arg |
  1160                 arg codeOn:aStream inBlock:b for:aCompiler
  1198 		arg codeOn:aStream inBlock:b for:aCompiler
  1161             ]
  1199 	    ]
  1162         ].
  1200 	].
  1163         receiver isHere ifTrue:[
  1201 	receiver isHere ifTrue:[
  1164             code := #hereSendL
  1202 	    code := #hereSendL
  1165         ] ifFalse:[
  1203 	] ifFalse:[
  1166             code := #superSendL.
  1204 	    code := #superSendL.
  1167         ].
  1205 	].
  1168         aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:clsLitIndex; nextPut:0.
  1206 	aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:clsLitIndex; nextPut:0.
  1169     ] ifFalse:[
  1207     ] ifFalse:[
  1170         recType ~~ #Self ifTrue:[
  1208 	recType ~~ #Self ifTrue:[
  1171             receiver codeOn:aStream inBlock:b for:aCompiler.
  1209 	    receiver codeOn:aStream inBlock:b for:aCompiler.
  1172         ].
  1210 	].
  1173         argArray notNil ifTrue:[
  1211 	argArray notNil ifTrue:[
  1174             argArray do:[:arg |
  1212 	    argArray do:[:arg |
  1175                 arg codeOn:aStream inBlock:b for:aCompiler
  1213 		arg codeOn:aStream inBlock:b for:aCompiler
  1176             ]
  1214 	    ]
  1177         ].
  1215 	].
  1178 
  1216 
  1179         recType == #Self ifTrue:[
  1217 	recType == #Self ifTrue:[
  1180             code := #sendSelfL
  1218 	    code := #sendSelfL
  1181         ] ifFalse:[
  1219 	] ifFalse:[
  1182             code := #sendL
  1220 	    code := #sendL
  1183         ].
  1221 	].
  1184         aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs.
  1222 	aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs.
  1185     ].
  1223     ].
  1186     valueNeeded ifFalse:[
  1224     valueNeeded ifFalse:[
  1187         aStream nextPut:#drop
  1225 	aStream nextPut:#drop
  1188     ].
  1226     ].
  1189 
  1227 
  1190     "Modified: / 3.9.1995 / 12:55:42 / claus"
  1228     "Modified: / 3.9.1995 / 12:55:42 / claus"
  1191     "Modified: / 28.10.1997 / 18:15:33 / cg"
  1229     "Modified: / 28.10.1997 / 18:15:33 / cg"
  1192 !
  1230 !
  1198 
  1236 
  1199     theByteCode := #trueJump.
  1237     theByteCode := #trueJump.
  1200     theReceiver := receiver receiver.
  1238     theReceiver := receiver receiver.
  1201 
  1239 
  1202     optByteCode := self optimizedConditionFor:theReceiver
  1240     optByteCode := self optimizedConditionFor:theReceiver
  1203                                          with:theByteCode.
  1241 					 with:theByteCode.
  1204     optByteCode notNil ifTrue:[
  1242     optByteCode notNil ifTrue:[
  1205         ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
  1243 	((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
  1206             theArg := theReceiver arg1
  1244 	    theArg := theReceiver arg1
  1207         ].
  1245 	].
  1208         theReceiver := theReceiver receiver.
  1246 	theReceiver := theReceiver receiver.
  1209         theByteCode := optByteCode
  1247 	theByteCode := optByteCode
  1210     ].
  1248     ].
  1211     "/ code the left-of the or-part
  1249     "/ code the left-of the or-part
  1212     theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1250     theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1213     theArg notNil ifTrue:[
  1251     theArg notNil ifTrue:[
  1214         theArg codeOn:aStream inBlock:b for:aCompiler
  1252 	theArg codeOn:aStream inBlock:b for:aCompiler
  1215     ].
  1253     ].
  1216     aStream nextPut:theByteCode.
  1254     aStream nextPut:theByteCode.
  1217     pos1 := aStream position.   "/ remember branch target of left-ok branch
  1255     pos1 := aStream position.   "/ remember branch target of left-ok branch
  1218     aStream nextPut:0.
  1256     aStream nextPut:0.
  1219 
  1257 
  1220     "/ code the right of the and-part
  1258     "/ code the right of the and-part
  1221     theReceiver := receiver arg1.
  1259     theReceiver := receiver arg1.
  1222     theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
  1260     theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
  1223     (selector == #ifTrue:ifFalse:) ifTrue:[
  1261     (selector == #ifTrue:ifFalse:) ifTrue:[
  1224         jmp := #falseJump
  1262 	jmp := #falseJump
  1225     ] ifFalse:[
  1263     ] ifFalse:[
  1226         jmp := #trueJump
  1264 	jmp := #trueJump
  1227     ].
  1265     ].
  1228     aStream nextPut:jmp.
  1266     aStream nextPut:jmp.
  1229     pos2 := aStream position.   "/ remember branch target of right-fail branch 
  1267     pos2 := aStream position.   "/ remember branch target of right-fail branch 
  1230     aStream nextPut:0.
  1268     aStream nextPut:0.
  1231 
  1269 
  1232     code := aStream contents.
  1270     code := aStream contents.
  1233     (selector == #ifTrue:ifFalse:) ifTrue:[
  1271     (selector == #ifTrue:ifFalse:) ifTrue:[
  1234         code at:pos1 put:(aStream position)
  1272 	code at:pos1 put:(aStream position)
  1235     ].
  1273     ].
  1236 
  1274 
  1237     "/ code the if-block
  1275     "/ code the if-block
  1238     (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1276     (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1239 
  1277 
  1241     pos3 := aStream position.
  1279     pos3 := aStream position.
  1242     aStream nextPut:0.
  1280     aStream nextPut:0.
  1243 
  1281 
  1244     here := aStream position.
  1282     here := aStream position.
  1245     (selector == #ifFalse:ifTrue:) ifTrue:[
  1283     (selector == #ifFalse:ifTrue:) ifTrue:[
  1246         code at:pos1 put:here
  1284 	code at:pos1 put:here
  1247     ].
  1285     ].
  1248     code at:pos2 put:here.
  1286     code at:pos2 put:here.
  1249 
  1287 
  1250     "/ code the else-block
  1288     "/ code the else-block
  1251     (argArray at: 2) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1289     (argArray at: 2) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1263     theByteCode := #trueJump.
  1301     theByteCode := #trueJump.
  1264     theReceiver := receiver receiver.
  1302     theReceiver := receiver receiver.
  1265 
  1303 
  1266     optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
  1304     optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
  1267     optByteCode notNil ifTrue:[
  1305     optByteCode notNil ifTrue:[
  1268         ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
  1306 	((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
  1269             theArg := theReceiver arg1
  1307 	    theArg := theReceiver arg1
  1270         ].
  1308 	].
  1271         theReceiver := theReceiver receiver.
  1309 	theReceiver := theReceiver receiver.
  1272         theByteCode := optByteCode
  1310 	theByteCode := optByteCode
  1273     ].
  1311     ].
  1274     theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1312     theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1275     theArg notNil ifTrue:[
  1313     theArg notNil ifTrue:[
  1276         theArg codeOn:aStream inBlock:b for:aCompiler
  1314 	theArg codeOn:aStream inBlock:b for:aCompiler
  1277     ].
  1315     ].
  1278     aStream nextPut:theByteCode.
  1316     aStream nextPut:theByteCode.
  1279     pos1 := aStream position.
  1317     pos1 := aStream position.
  1280     aStream nextPut:0.
  1318     aStream nextPut:0.
  1281 
  1319 
  1283     theReceiver := receiver arg1.
  1321     theReceiver := receiver arg1.
  1284     theArg := nil.
  1322     theArg := nil.
  1285 
  1323 
  1286 "new:"
  1324 "new:"
  1287     (selector == #ifTrue:) ifTrue:[
  1325     (selector == #ifTrue:) ifTrue:[
  1288         theByteCode := #falseJump
  1326 	theByteCode := #falseJump
  1289     ] ifFalse:[
  1327     ] ifFalse:[
  1290         theByteCode := #trueJump
  1328 	theByteCode := #trueJump
  1291     ].
  1329     ].
  1292     optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
  1330     optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
  1293     optByteCode notNil ifTrue:[
  1331     optByteCode notNil ifTrue:[
  1294         theReceiver isBlock ifTrue:[
  1332 	theReceiver isBlock ifTrue:[
  1295             theReceiver := theReceiver statements expression
  1333 	    theReceiver := theReceiver statements expression
  1296         ].
  1334 	].
  1297         ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
  1335 	((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
  1298             theArg := theReceiver arg1
  1336 	    theArg := theReceiver arg1
  1299         ].
  1337 	].
  1300         theReceiver := theReceiver receiver.
  1338 	theReceiver := theReceiver receiver.
  1301         theByteCode := optByteCode.
  1339 	theByteCode := optByteCode.
  1302 
  1340 
  1303         theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1341 	theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1304         theArg notNil ifTrue:[
  1342 	theArg notNil ifTrue:[
  1305             theArg codeOn:aStream inBlock:b for:aCompiler
  1343 	    theArg codeOn:aStream inBlock:b for:aCompiler
  1306         ].
  1344 	].
  1307         aStream nextPut:theByteCode.
  1345 	aStream nextPut:theByteCode.
  1308 
  1346 
  1309     ] ifFalse:[
  1347     ] ifFalse:[
  1310 "org"
  1348 "org"
  1311         theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
  1349 	theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
  1312         (selector == #ifTrue:) ifTrue:[
  1350 	(selector == #ifTrue:) ifTrue:[
  1313             jmp := #falseJump
  1351 	    jmp := #falseJump
  1314         ] ifFalse:[
  1352 	] ifFalse:[
  1315             jmp := #trueJump
  1353 	    jmp := #trueJump
  1316         ].
  1354 	].
  1317         aStream nextPut:jmp
  1355 	aStream nextPut:jmp
  1318     ].
  1356     ].
  1319     pos2 := aStream position.
  1357     pos2 := aStream position.
  1320     aStream nextPut:0.
  1358     aStream nextPut:0.
  1321     (selector == #ifTrue:) ifTrue:[
  1359     (selector == #ifTrue:) ifTrue:[
  1322         (aStream contents) at:pos1 put:(aStream position)
  1360 	(aStream contents) at:pos1 put:(aStream position)
  1323     ].
  1361     ].
  1324     (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1362     (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1325 
  1363 
  1326     code := aStream contents.
  1364     code := aStream contents.
  1327     valueNeeded ifTrue:[
  1365     valueNeeded ifTrue:[
  1328         aStream nextPut:#jump.
  1366 	aStream nextPut:#jump.
  1329         pos3 := aStream position.
  1367 	pos3 := aStream position.
  1330         aStream nextPut:0.
  1368 	aStream nextPut:0.
  1331         here := aStream position.
  1369 	here := aStream position.
  1332         (selector == #ifFalse:) ifTrue:[
  1370 	(selector == #ifFalse:) ifTrue:[
  1333             code at:pos1 put:here
  1371 	    code at:pos1 put:here
  1334         ].
  1372 	].
  1335         code at:pos2 put:here.
  1373 	code at:pos2 put:here.
  1336         aStream nextPut:#pushNil.
  1374 	aStream nextPut:#pushNil.
  1337         code at:pos3 put:(aStream position)
  1375 	code at:pos3 put:(aStream position)
  1338     ] ifFalse:[
  1376     ] ifFalse:[
  1339         here := aStream position.
  1377 	here := aStream position.
  1340         (selector == #ifFalse:) ifTrue:[
  1378 	(selector == #ifFalse:) ifTrue:[
  1341             code at:pos1 put:here
  1379 	    code at:pos1 put:here
  1342         ].
  1380 	].
  1343         code at:pos2 put:here
  1381 	code at:pos2 put:here
  1344     ]
  1382     ]
  1345 
  1383 
  1346     "Modified: 9.11.1996 / 19:52:26 / cg"
  1384     "Modified: 9.11.1996 / 19:52:26 / cg"
  1347 !
  1385 !
  1348 
  1386 
  1351 
  1389 
  1352     |pos1 rightExpr|
  1390     |pos1 rightExpr|
  1353 
  1391 
  1354     receiver codeOn:aStream inBlock:b for:aCompiler.
  1392     receiver codeOn:aStream inBlock:b for:aCompiler.
  1355     valueNeeded ifTrue:[
  1393     valueNeeded ifTrue:[
  1356         aStream nextPut:#dup.
  1394 	aStream nextPut:#dup.
  1357     ].
  1395     ].
  1358     aStream nextPut:#trueJump.
  1396     aStream nextPut:#trueJump.
  1359     pos1 := aStream position.
  1397     pos1 := aStream position.
  1360     aStream nextPut:0.
  1398     aStream nextPut:0.
  1361     valueNeeded ifTrue:[
  1399     valueNeeded ifTrue:[
  1362         aStream nextPut:#drop.
  1400 	aStream nextPut:#drop.
  1363     ].
  1401     ].
  1364     rightExpr := argArray at:1.
  1402     rightExpr := argArray at:1.
  1365     rightExpr codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1403     rightExpr codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.
  1366 
  1404 
  1367     (aStream contents) at:pos1 put:(aStream position)
  1405     (aStream contents) at:pos1 put:(aStream position)
  1409      coded onto stack - needed for cascade"
  1447      coded onto stack - needed for cascade"
  1410 
  1448 
  1411     |nargs isBuiltIn code codeL litIndex cls clsLitIndex|
  1449     |nargs isBuiltIn code codeL litIndex cls clsLitIndex|
  1412 
  1450 
  1413     argArray isNil ifTrue:[
  1451     argArray isNil ifTrue:[
  1414         nargs := 0
  1452 	nargs := 0
  1415     ] ifFalse:[
  1453     ] ifFalse:[
  1416         nargs := argArray size
  1454 	nargs := argArray size
  1417     ].
  1455     ].
  1418 
  1456 
  1419     isBuiltIn := false.
  1457     isBuiltIn := false.
  1420 
  1458 
  1421     (nargs == 0) ifTrue:[
  1459     (nargs == 0) ifTrue:[
  1422         isBuiltIn := aCompiler isBuiltInUnarySelector:selector forReceiver:receiver
  1460 	isBuiltIn := aCompiler isBuiltInUnarySelector:selector forReceiver:receiver
  1423     ].
  1461     ].
  1424     (nargs == 1) ifTrue:[
  1462     (nargs == 1) ifTrue:[
  1425         isBuiltIn := aCompiler isBuiltIn1ArgSelector:selector forReceiver:receiver
  1463 	isBuiltIn := aCompiler isBuiltIn1ArgSelector:selector forReceiver:receiver
  1426     ].
  1464     ].
  1427     (nargs == 2) ifTrue:[
  1465     (nargs == 2) ifTrue:[
  1428         isBuiltIn := aCompiler isBuiltIn2ArgSelector:selector forReceiver:receiver
  1466 	isBuiltIn := aCompiler isBuiltIn2ArgSelector:selector forReceiver:receiver
  1429     ].
  1467     ].
  1430 
  1468 
  1431     "can we use a send-bytecode ?"
  1469     "can we use a send-bytecode ?"
  1432     isBuiltIn ifTrue:[
  1470     isBuiltIn ifTrue:[
  1433         receiver isSuper ifFalse:[
  1471 	receiver isSuper ifFalse:[
  1434             (nargs > 0) ifTrue:[
  1472 	    (nargs > 0) ifTrue:[
  1435                 (argArray at:1) codeOn:aStream inBlock:b for:aCompiler.
  1473 		(argArray at:1) codeOn:aStream inBlock:b for:aCompiler.
  1436                 (nargs > 1) ifTrue:[
  1474 		(nargs > 1) ifTrue:[
  1437                     (argArray at:2) codeOn:aStream inBlock:b for:aCompiler
  1475 		    (argArray at:2) codeOn:aStream inBlock:b for:aCompiler
  1438                 ]
  1476 		]
  1439             ].
  1477 	    ].
  1440             aStream nextPut:selector.
  1478 	    aStream nextPut:selector.
  1441             (aCompiler hasLineNumber:selector) ifTrue:[
  1479 	    (aCompiler hasLineNumber:selector) ifTrue:[
  1442                 aStream nextPut:lineNr.
  1480 		aStream nextPut:lineNr.
  1443             ].
  1481 	    ].
  1444             valueNeeded ifFalse:[
  1482 	    valueNeeded ifFalse:[
  1445                 aStream nextPut:#drop
  1483 		aStream nextPut:#drop
  1446             ].
  1484 	    ].
  1447             ^ self
  1485 	    ^ self
  1448         ]
  1486 	]
  1449     ].
  1487     ].
  1450 
  1488 
  1451     argArray notNil ifTrue:[
  1489     argArray notNil ifTrue:[
  1452         argArray do:[:arg |
  1490 	argArray do:[:arg |
  1453             arg codeOn:aStream inBlock:b for:aCompiler
  1491 	    arg codeOn:aStream inBlock:b for:aCompiler
  1454         ]
  1492 	]
  1455     ].
  1493     ].
  1456 
  1494 
  1457     receiver isSuper ifTrue:[
  1495     receiver isSuper ifTrue:[
  1458 
  1496 
  1459         cls := aCompiler targetClass.
  1497 	cls := aCompiler targetClass.
  1460         receiver isHere ifTrue:[
  1498 	receiver isHere ifTrue:[
  1461             code := #hereSend.
  1499 	    code := #hereSend.
  1462             codeL := #hereSendL
  1500 	    codeL := #hereSendL
  1463         ] ifFalse:[
  1501 	] ifFalse:[
  1464             code := #superSend.
  1502 	    code := #superSend.
  1465             codeL := #superSend.
  1503 	    codeL := #superSend.
  1466             cls := cls superclass.
  1504 	    cls := cls superclass.
  1467         ].
  1505 	].
  1468         clsLitIndex := aCompiler addLiteral:cls.
  1506 	clsLitIndex := aCompiler addLiteral:cls.
  1469 
  1507 
  1470         litIndex := aCompiler addLiteral:selector.
  1508 	litIndex := aCompiler addLiteral:selector.
  1471         (litIndex <= 255 and:[clsLitIndex <= 255]) ifTrue:[
  1509 	(litIndex <= 255 and:[clsLitIndex <= 255]) ifTrue:[
  1472             aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:clsLitIndex.
  1510 	    aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs; nextPut:clsLitIndex.
  1473         ] ifFalse:[
  1511 	] ifFalse:[
  1474             aStream nextPut:codeL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:clsLitIndex; nextPut:0.
  1512 	    aStream nextPut:codeL; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs; nextPut:clsLitIndex; nextPut:0.
  1475         ].
  1513 	].
  1476         valueNeeded ifFalse:[
  1514 	valueNeeded ifFalse:[
  1477             aStream nextPut:#drop
  1515 	    aStream nextPut:#drop
  1478         ].
  1516 	].
  1479         ^ self
  1517 	^ self
  1480     ].
  1518     ].
  1481     (nargs == 0) ifTrue:[
  1519     (nargs == 0) ifTrue:[
  1482         (selector == #yourself) ifTrue:[
  1520 	(selector == #yourself) ifTrue:[
  1483             "yourself is often added to get the receiver -
  1521 	    "yourself is often added to get the receiver -
  1484              we get it without the yourself-message"
  1522 	     we get it without the yourself-message"
  1485 
  1523 
  1486             valueNeeded ifFalse:[
  1524 	    valueNeeded ifFalse:[
  1487                 aStream nextPut:#drop
  1525 		aStream nextPut:#drop
  1488             ].
  1526 	    ].
  1489             ^ self
  1527 	    ^ self
  1490         ].
  1528 	].
  1491     ].
  1529     ].
  1492 
  1530 
  1493     litIndex := aCompiler addLiteral:selector.
  1531     litIndex := aCompiler addLiteral:selector.
  1494     litIndex <= 255 ifTrue:[
  1532     litIndex <= 255 ifTrue:[
  1495         (nargs <= 3) ifTrue:[
  1533 	(nargs <= 3) ifTrue:[
  1496             valueNeeded ifTrue:[
  1534 	    valueNeeded ifTrue:[
  1497                 code := #(send0 send1 send2 send3) at:(nargs+1).
  1535 		code := #(send0 send1 send2 send3) at:(nargs+1).
  1498             ] ifFalse:[
  1536 	    ] ifFalse:[
  1499                 code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
  1537 		code := #(sendDrop0 sendDrop1 sendDrop2 sendDrop3) at:(nargs+1).
  1500             ].
  1538 	    ].
  1501             aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
  1539 	    aStream nextPut:code; nextPut:lineNr; nextPut:litIndex.
  1502             ^ self
  1540 	    ^ self
  1503         ].
  1541 	].
  1504 
  1542 
  1505         valueNeeded ifTrue:[
  1543 	valueNeeded ifTrue:[
  1506             code := #send
  1544 	    code := #send
  1507         ] ifFalse:[
  1545 	] ifFalse:[
  1508             code := #sendDrop
  1546 	    code := #sendDrop
  1509         ].
  1547 	].
  1510         aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
  1548 	aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:nargs.
  1511         ^ self
  1549 	^ self
  1512     ].
  1550     ].
  1513 
  1551 
  1514     valueNeeded ifTrue:[
  1552     valueNeeded ifTrue:[
  1515         code := #sendL
  1553 	code := #sendL
  1516     ] ifFalse:[
  1554     ] ifFalse:[
  1517         code := #sendDropL
  1555 	code := #sendDropL
  1518     ].
  1556     ].
  1519     aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
  1557     aStream nextPut:code; nextPut:lineNr; nextPut:litIndex; nextPut:0; nextPut:nargs
  1520 
  1558 
  1521     "Modified: 17.4.1996 / 22:33:35 / cg"
  1559     "Modified: 17.4.1996 / 22:33:35 / cg"
  1522 !
  1560 !
  1530     theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1568     theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1531 
  1569 
  1532     lateEval := false.
  1570     lateEval := false.
  1533 
  1571 
  1534     valueNeeded ifTrue:[
  1572     valueNeeded ifTrue:[
  1535         "/ easily reconstructable - no need to keep on stack
  1573 	"/ easily reconstructable - no need to keep on stack
  1536         theReceiver isConstant ifTrue:[
  1574 	theReceiver isConstant ifTrue:[
  1537             (theReceiver evaluate isMemberOf:SmallInteger) ifTrue:[
  1575 	    (theReceiver evaluate isMemberOf:SmallInteger) ifTrue:[
  1538                 lateEval := true.
  1576 		lateEval := true.
  1539             ]
  1577 	    ]
  1540         ].
  1578 	].
  1541         lateEval ifFalse:[
  1579 	lateEval ifFalse:[
  1542             aStream nextPut:#dup
  1580 	    aStream nextPut:#dup
  1543         ].
  1581 	].
  1544     ].
  1582     ].
  1545 
  1583 
  1546     pos := aStream position.
  1584     pos := aStream position.
  1547     aStream nextPut:#pushgt0; nextPut:lineNr; nextPut:#falseJump.
  1585     aStream nextPut:#pushgt0; nextPut:lineNr; nextPut:#falseJump.
  1548     pos2 := aStream position.
  1586     pos2 := aStream position.
  1552     aStream nextPut:#minus1; nextPut:lineNr; nextPut:#jump; nextPut:pos.
  1590     aStream nextPut:#minus1; nextPut:lineNr; nextPut:#jump; nextPut:pos.
  1553 
  1591 
  1554     (aStream contents) at:pos2 put:(aStream position).
  1592     (aStream contents) at:pos2 put:(aStream position).
  1555     aStream nextPut:#drop.  "/ drop run variable
  1593     aStream nextPut:#drop.  "/ drop run variable
  1556     lateEval ifTrue:[
  1594     lateEval ifTrue:[
  1557         theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1595 	theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1558     ]
  1596     ]
  1559 
  1597 
  1560     "Modified: 27.5.1997 / 14:28:49 / cg"
  1598     "Modified: 27.5.1997 / 14:28:49 / cg"
  1561 !
  1599 !
  1562 
  1600 
  1585     start codeOn:aStream inBlock:b for:aCompiler.
  1623     start codeOn:aStream inBlock:b for:aCompiler.
  1586 
  1624 
  1587     lateEval := false.
  1625     lateEval := false.
  1588 
  1626 
  1589     valueNeeded ifTrue:[
  1627     valueNeeded ifTrue:[
  1590         "/ easily reconstructable - no need to keep on stack
  1628 	"/ easily reconstructable - no need to keep on stack
  1591         start isConstant ifTrue:[
  1629 	start isConstant ifTrue:[
  1592             (start evaluate isMemberOf:SmallInteger) ifTrue:[
  1630 	    (start evaluate isMemberOf:SmallInteger) ifTrue:[
  1593                 lateEval := true.
  1631 		lateEval := true.
  1594             ]
  1632 	    ]
  1595         ].
  1633 	].
  1596         lateEval ifFalse:[
  1634 	lateEval ifFalse:[
  1597             aStream nextPut:#dup
  1635 	    aStream nextPut:#dup
  1598         ].
  1636 	].
  1599     ].
  1637     ].
  1600 
  1638 
  1601     "/ if stop is not constant, and not an argVar,
  1639     "/ if stop is not constant, and not an argVar,
  1602     "/  evaluate it into a temp slot ...
  1640     "/  evaluate it into a temp slot ...
  1603 
  1641 
  1604     (stop isConstant and:[stop type == #Integer]) ifFalse:[
  1642     (stop isConstant and:[stop type == #Integer]) ifFalse:[
  1605         "/ a method/blockArg is constant as well ...
  1643 	"/ a method/blockArg is constant as well ...
  1606         (stop isVariable and:[stop isArgument]) ifFalse:[
  1644 	(stop isVariable and:[stop isArgument]) ifFalse:[
  1607             stop codeOn:aStream inBlock:b for:aCompiler.
  1645 	    stop codeOn:aStream inBlock:b for:aCompiler.
  1608 
  1646 
  1609             b isNil ifTrue:[
  1647 	    b isNil ifTrue:[
  1610                 stopVarIndex := aCompiler addTempVar.
  1648 		stopVarIndex := aCompiler addTempVar.
  1611                 aStream nextPut:#storeMethodVar; nextPut:stopVarIndex.
  1649 		aStream nextPut:#storeMethodVar; nextPut:stopVarIndex.
  1612             ] ifFalse:[
  1650 	    ] ifFalse:[
  1613                 stopVarIndex := b addTempVar.
  1651 		stopVarIndex := b addTempVar.
  1614                 aStream nextPut:#storeBlockVar; nextPut:stopVarIndex.
  1652 		aStream nextPut:#storeBlockVar; nextPut:stopVarIndex.
  1615             ].
  1653 	    ].
  1616         ]
  1654 	]
  1617     ].
  1655     ].
  1618 
  1656 
  1619     pos := aStream position.
  1657     pos := aStream position.
  1620 
  1658 
  1621     aStream nextPut:#dup.
  1659     aStream nextPut:#dup.
  1622     stopVarIndex notNil ifTrue:[
  1660     stopVarIndex notNil ifTrue:[
  1623         b isNil ifTrue:[
  1661 	b isNil ifTrue:[
  1624             aStream nextPut:#pushMethodVar; nextPut:stopVarIndex.
  1662 	    aStream nextPut:#pushMethodVar; nextPut:stopVarIndex.
  1625         ] ifFalse:[
  1663 	] ifFalse:[
  1626             aStream nextPut:#pushBlockVar; nextPut:stopVarIndex.
  1664 	    aStream nextPut:#pushBlockVar; nextPut:stopVarIndex.
  1627         ]
  1665 	]
  1628     ] ifFalse:[
  1666     ] ifFalse:[
  1629         stop codeOn:aStream inBlock:b for:aCompiler.
  1667 	stop codeOn:aStream inBlock:b for:aCompiler.
  1630     ].
  1668     ].
  1631     stepVal > 0 ifTrue:[
  1669     stepVal > 0 ifTrue:[
  1632         aStream nextPut:#>.
  1670 	aStream nextPut:#>.
  1633     ] ifFalse:[
  1671     ] ifFalse:[
  1634         aStream nextPut:#<.
  1672 	aStream nextPut:#<.
  1635     ].
  1673     ].
  1636     (aCompiler hasLineNumber:selector) ifTrue:[
  1674     (aCompiler hasLineNumber:selector) ifTrue:[
  1637         aStream nextPut:lineNr.
  1675 	aStream nextPut:lineNr.
  1638     ].
  1676     ].
  1639     aStream nextPut:#trueJump.
  1677     aStream nextPut:#trueJump.
  1640     pos2 := aStream position.
  1678     pos2 := aStream position.
  1641     aStream nextPut:0.
  1679     aStream nextPut:0.
  1642 
  1680 
  1643     theBlock := argArray at:3.
  1681     theBlock := argArray at:3.
  1644 
  1682 
  1645     "/ need a temporary in the outer context for
  1683     "/ need a temporary in the outer context for
  1646     "/ the loop ...
  1684     "/ the loop ...
  1647     b isNil ifTrue:[
  1685     b isNil ifTrue:[
  1648         loopVarIndex := aCompiler addTempVar.
  1686 	loopVarIndex := aCompiler addTempVar.
  1649         aStream nextPut:#dup.
  1687 	aStream nextPut:#dup.
  1650         aStream nextPut:#storeMethodVar; nextPut:loopVarIndex.
  1688 	aStream nextPut:#storeMethodVar; nextPut:loopVarIndex.
  1651     ] ifFalse:[
  1689     ] ifFalse:[
  1652         loopVarIndex := b addTempVar.
  1690 	loopVarIndex := b addTempVar.
  1653         aStream nextPut:#dup.
  1691 	aStream nextPut:#dup.
  1654         aStream nextPut:#storeBlockVar; nextPut:loopVarIndex.
  1692 	aStream nextPut:#storeBlockVar; nextPut:loopVarIndex.
  1655     ].
  1693     ].
  1656     theBlock indexOfFirstTemp:loopVarIndex.
  1694     theBlock indexOfFirstTemp:loopVarIndex.
  1657 
  1695 
  1658     theBlock codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
  1696     theBlock codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
  1659 
  1697 
  1660     "/ increment/decrement counter & jump back.
  1698     "/ increment/decrement counter & jump back.
  1661 
  1699 
  1662     stepVal == 1 ifTrue:[
  1700     stepVal == 1 ifTrue:[
  1663         aStream nextPut:#plus1; nextPut:lineNr.
  1701 	aStream nextPut:#plus1; nextPut:lineNr.
  1664     ] ifFalse:[
  1702     ] ifFalse:[
  1665         stepVal == -1 ifTrue:[
  1703 	stepVal == -1 ifTrue:[
  1666             aStream nextPut:#minus1; nextPut:lineNr.
  1704 	    aStream nextPut:#minus1; nextPut:lineNr.
  1667         ] ifFalse:[
  1705 	] ifFalse:[
  1668             step codeOn:aStream inBlock:b for:aCompiler.
  1706 	    step codeOn:aStream inBlock:b for:aCompiler.
  1669             aStream nextPut:#+.
  1707 	    aStream nextPut:#+.
  1670             (aCompiler hasLineNumber:#+) ifTrue:[
  1708 	    (aCompiler hasLineNumber:#+) ifTrue:[
  1671                 aStream nextPut:lineNr.
  1709 		aStream nextPut:lineNr.
  1672             ].
  1710 	    ].
  1673         ]
  1711 	]
  1674     ].
  1712     ].
  1675 
  1713 
  1676     aStream nextPut:#jump; nextPut:pos.
  1714     aStream nextPut:#jump; nextPut:pos.
  1677 
  1715 
  1678     (aStream contents) at:pos2 put:(aStream position).
  1716     (aStream contents) at:pos2 put:(aStream position).
  1679     aStream nextPut:#drop.  "/ drop run variable
  1717     aStream nextPut:#drop.  "/ drop run variable
  1680     lateEval ifTrue:[
  1718     lateEval ifTrue:[
  1681         start codeOn:aStream inBlock:b for:aCompiler.
  1719 	start codeOn:aStream inBlock:b for:aCompiler.
  1682     ].
  1720     ].
  1683 
  1721 
  1684     "/ no need to nil-out loop-tempVar to help GC
  1722     "/ no need to nil-out loop-tempVar to help GC
  1685     "/ (its integer, anyway).
  1723     "/ (its integer, anyway).
  1686 
  1724 
  1687     b isNil ifTrue:[
  1725     b isNil ifTrue:[
  1688         aCompiler removeTempVar
  1726 	aCompiler removeTempVar
  1689     ] ifFalse:[
  1727     ] ifFalse:[
  1690         b removeTempVar
  1728 	b removeTempVar
  1691     ].
  1729     ].
  1692 
  1730 
  1693     stopVarIndex notNil ifTrue:[
  1731     stopVarIndex notNil ifTrue:[
  1694         b isNil ifTrue:[
  1732 	b isNil ifTrue:[
  1695             aCompiler removeTempVar
  1733 	    aCompiler removeTempVar
  1696         ] ifFalse:[
  1734 	] ifFalse:[
  1697             b removeTempVar
  1735 	    b removeTempVar
  1698         ]
  1736 	]
  1699     ].
  1737     ].
  1700 
  1738 
  1701     "Created: 27.6.1997 / 12:48:18 / cg"
  1739     "Created: 27.6.1997 / 12:48:18 / cg"
  1702     "Modified: 27.6.1997 / 13:43:06 / cg"
  1740     "Modified: 27.6.1997 / 13:43:06 / cg"
  1703 !
  1741 !
  1721     start codeOn:aStream inBlock:b for:aCompiler.
  1759     start codeOn:aStream inBlock:b for:aCompiler.
  1722 
  1760 
  1723     lateEval := false.
  1761     lateEval := false.
  1724 
  1762 
  1725     valueNeeded ifTrue:[
  1763     valueNeeded ifTrue:[
  1726         "/ easily reconstructable - no need to keep on stack
  1764 	"/ easily reconstructable - no need to keep on stack
  1727         start isConstant ifTrue:[
  1765 	start isConstant ifTrue:[
  1728             (start evaluate isMemberOf:SmallInteger) ifTrue:[
  1766 	    (start evaluate isMemberOf:SmallInteger) ifTrue:[
  1729                 lateEval := true.
  1767 		lateEval := true.
  1730             ]
  1768 	    ]
  1731         ].
  1769 	].
  1732         lateEval ifFalse:[
  1770 	lateEval ifFalse:[
  1733             aStream nextPut:#dup
  1771 	    aStream nextPut:#dup
  1734         ].
  1772 	].
  1735     ].
  1773     ].
  1736 
  1774 
  1737     "/ if stop is not constant, and not an argVar,
  1775     "/ if stop is not constant, and not an argVar,
  1738     "/  evaluate it into a temp slot ...
  1776     "/  evaluate it into a temp slot ...
  1739 
  1777 
  1740     (stop isConstant and:[stop type == #Integer]) ifFalse:[
  1778     (stop isConstant and:[stop type == #Integer]) ifFalse:[
  1741         "/ a method/blockArg is constant as well ...
  1779 	"/ a method/blockArg is constant as well ...
  1742         (stop isVariable and:[stop isArgument]) ifFalse:[
  1780 	(stop isVariable and:[stop isArgument]) ifFalse:[
  1743             stop codeOn:aStream inBlock:b for:aCompiler.
  1781 	    stop codeOn:aStream inBlock:b for:aCompiler.
  1744 
  1782 
  1745             b isNil ifTrue:[
  1783 	    b isNil ifTrue:[
  1746                 stopVarIndex := aCompiler addTempVar.
  1784 		stopVarIndex := aCompiler addTempVar.
  1747                 aStream nextPut:#storeMethodVar; nextPut:stopVarIndex.
  1785 		aStream nextPut:#storeMethodVar; nextPut:stopVarIndex.
  1748             ] ifFalse:[
  1786 	    ] ifFalse:[
  1749                 stopVarIndex := b addTempVar.
  1787 		stopVarIndex := b addTempVar.
  1750                 aStream nextPut:#storeBlockVar; nextPut:stopVarIndex.
  1788 		aStream nextPut:#storeBlockVar; nextPut:stopVarIndex.
  1751             ].
  1789 	    ].
  1752         ]
  1790 	]
  1753     ].
  1791     ].
  1754 
  1792 
  1755     pos := aStream position.
  1793     pos := aStream position.
  1756 
  1794 
  1757     aStream nextPut:#lineno; nextPut:lineNr.
  1795     aStream nextPut:#lineno; nextPut:lineNr.
  1758 
  1796 
  1759     aStream nextPut:#dup.
  1797     aStream nextPut:#dup.
  1760     stopVarIndex notNil ifTrue:[
  1798     stopVarIndex notNil ifTrue:[
  1761         b isNil ifTrue:[
  1799 	b isNil ifTrue:[
  1762             aStream nextPut:#pushMethodVar; nextPut:stopVarIndex.
  1800 	    aStream nextPut:#pushMethodVar; nextPut:stopVarIndex.
  1763         ] ifFalse:[
  1801 	] ifFalse:[
  1764             aStream nextPut:#pushBlockVar; nextPut:stopVarIndex.
  1802 	    aStream nextPut:#pushBlockVar; nextPut:stopVarIndex.
  1765         ]
  1803 	]
  1766     ] ifFalse:[
  1804     ] ifFalse:[
  1767         stop codeOn:aStream inBlock:b for:aCompiler.
  1805 	stop codeOn:aStream inBlock:b for:aCompiler.
  1768     ].
  1806     ].
  1769     aStream nextPut:#>.
  1807     aStream nextPut:#>.
  1770     (aCompiler hasLineNumber:selector) ifTrue:[
  1808     (aCompiler hasLineNumber:selector) ifTrue:[
  1771         aStream nextPut:lineNr.
  1809 	aStream nextPut:lineNr.
  1772     ].
  1810     ].
  1773     aStream nextPut:#trueJump.
  1811     aStream nextPut:#trueJump.
  1774     pos2 := aStream position.
  1812     pos2 := aStream position.
  1775     aStream nextPut:0.
  1813     aStream nextPut:0.
  1776 
  1814 
  1777     theBlock := argArray at:2.
  1815     theBlock := argArray at:2.
  1778 
  1816 
  1779     "/ need a temporary in the outer context for
  1817     "/ need a temporary in the outer context for
  1780     "/ the loop ...
  1818     "/ the loop ...
  1781     b isNil ifTrue:[
  1819     b isNil ifTrue:[
  1782         loopVarIndex := aCompiler addTempVar.
  1820 	loopVarIndex := aCompiler addTempVar.
  1783         aStream nextPut:#dup.
  1821 	aStream nextPut:#dup.
  1784         aStream nextPut:#storeMethodVar; nextPut:loopVarIndex.
  1822 	aStream nextPut:#storeMethodVar; nextPut:loopVarIndex.
  1785     ] ifFalse:[
  1823     ] ifFalse:[
  1786         loopVarIndex := b addTempVar.
  1824 	loopVarIndex := b addTempVar.
  1787         aStream nextPut:#dup.
  1825 	aStream nextPut:#dup.
  1788         aStream nextPut:#storeBlockVar; nextPut:loopVarIndex.
  1826 	aStream nextPut:#storeBlockVar; nextPut:loopVarIndex.
  1789     ].
  1827     ].
  1790     theBlock indexOfFirstTemp:loopVarIndex.
  1828     theBlock indexOfFirstTemp:loopVarIndex.
  1791 
  1829 
  1792     theBlock codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
  1830     theBlock codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
  1793 
  1831 
  1796     aStream nextPut:#plus1; nextPut:lineNr; nextPut:#jump; nextPut:pos.
  1834     aStream nextPut:#plus1; nextPut:lineNr; nextPut:#jump; nextPut:pos.
  1797 
  1835 
  1798     (aStream contents) at:pos2 put:(aStream position).
  1836     (aStream contents) at:pos2 put:(aStream position).
  1799     aStream nextPut:#drop.  "/ drop run variable
  1837     aStream nextPut:#drop.  "/ drop run variable
  1800     lateEval ifTrue:[
  1838     lateEval ifTrue:[
  1801         start codeOn:aStream inBlock:b for:aCompiler.
  1839 	start codeOn:aStream inBlock:b for:aCompiler.
  1802     ].
  1840     ].
  1803 
  1841 
  1804     "/ no need to nil-out loop-tempVar to help GC
  1842     "/ no need to nil-out loop-tempVar to help GC
  1805     "/ (its integer, anyway).
  1843     "/ (its integer, anyway).
  1806 
  1844 
  1807     b isNil ifTrue:[
  1845     b isNil ifTrue:[
  1808         aCompiler removeTempVar
  1846 	aCompiler removeTempVar
  1809     ] ifFalse:[
  1847     ] ifFalse:[
  1810         b removeTempVar
  1848 	b removeTempVar
  1811     ].
  1849     ].
  1812 
  1850 
  1813     stopVarIndex notNil ifTrue:[
  1851     stopVarIndex notNil ifTrue:[
  1814         b isNil ifTrue:[
  1852 	b isNil ifTrue:[
  1815             aCompiler removeTempVar
  1853 	    aCompiler removeTempVar
  1816         ] ifFalse:[
  1854 	] ifFalse:[
  1817             b removeTempVar
  1855 	    b removeTempVar
  1818         ]
  1856 	]
  1819     ].
  1857     ].
  1820 
  1858 
  1821     "Created: 26.6.1997 / 10:58:47 / cg"
  1859     "Created: 26.6.1997 / 10:58:47 / cg"
  1822     "Modified: 19.10.1997 / 01:31:40 / cg"
  1860     "Modified: 19.10.1997 / 01:31:40 / cg"
  1823 !
  1861 !
  1824 
  1862 
  1825 codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
  1863 codeWhileOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
  1826     "generate code for
  1864     "generate code for
  1827         [...] whileXXX:[ ... ] 
  1865 	[...] whileXXX:[ ... ] 
  1828      and also 
  1866      and also 
  1829         [...] whileXXX
  1867 	[...] whileXXX
  1830     "
  1868     "
  1831 
  1869 
  1832     |pos pos2 theReceiver theArg theByteCode optByteCode needLineNr blockExpr
  1870     |pos pos2 theReceiver theArg theByteCode optByteCode needLineNr blockExpr
  1833      hasLoopBlock fastReceiver|
  1871      hasLoopBlock fastReceiver|
  1834 
  1872 
  1835     hasLoopBlock := true.
  1873     hasLoopBlock := true.
  1836     (selector == #whileTrue:) ifTrue:[
  1874     (selector == #whileTrue:) ifTrue:[
  1837         theByteCode := #falseJump.
  1875 	theByteCode := #falseJump.
  1838     ] ifFalse:[
  1876     ] ifFalse:[
  1839         (selector == #whileFalse:) ifTrue:[
  1877 	(selector == #whileFalse:) ifTrue:[
  1840             theByteCode := #trueJump
  1878 	    theByteCode := #trueJump
  1841         ] ifFalse:[
  1879 	] ifFalse:[
  1842             hasLoopBlock := false.
  1880 	    hasLoopBlock := false.
  1843             (selector == #whileTrue) ifTrue:[
  1881 	    (selector == #whileTrue) ifTrue:[
  1844                 theByteCode := #trueJump
  1882 		theByteCode := #trueJump
  1845             ] ifFalse:[
  1883 	    ] ifFalse:[
  1846                 theByteCode := #falseJump
  1884 		theByteCode := #falseJump
  1847             ].
  1885 	    ].
  1848         ]
  1886 	]
  1849     ].
  1887     ].
  1850 
  1888 
  1851     theReceiver := receiver.
  1889     theReceiver := receiver.
  1852 
  1890 
  1853 (receiver isBlock
  1891 (receiver isBlock
  1854 and:[receiver statements notNil
  1892 and:[receiver statements notNil
  1855 and:[receiver statements nextStatement isNil
  1893 and:[receiver statements nextStatement isNil
  1856 and:[receiver statements expression notNil]]])
  1894 and:[receiver statements expression notNil]]])
  1857     ifTrue:[
  1895     ifTrue:[
  1858         fastReceiver := receiver statements expression.
  1896 	fastReceiver := receiver statements expression.
  1859         optByteCode := self optimizedConditionFor:fastReceiver with:theByteCode.
  1897 	optByteCode := self optimizedConditionFor:fastReceiver with:theByteCode.
  1860     ] ifFalse:[
  1898     ] ifFalse:[
  1861         optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
  1899 	optByteCode := self optimizedConditionFor:theReceiver with:theByteCode.
  1862     ].
  1900     ].
  1863 
  1901 
  1864     optByteCode notNil ifTrue:[
  1902     optByteCode notNil ifTrue:[
  1865         ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
  1903 	((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[
  1866             theArg := receiver statements expression arg1
  1904 	    theArg := receiver statements expression arg1
  1867         ].
  1905 	].
  1868         theReceiver := receiver statements expression receiver.
  1906 	theReceiver := receiver statements expression receiver.
  1869         theByteCode := optByteCode
  1907 	theByteCode := optByteCode
  1870     ].
  1908     ].
  1871 
  1909 
  1872 "/ OLD:
  1910 "/ OLD:
  1873 "/    valueNeeded ifTrue:[aStream nextPut:#pushNil].
  1911 "/    valueNeeded ifTrue:[aStream nextPut:#pushNil].
  1874 "/
  1912 "/
  1875     needLineNr := true.
  1913     needLineNr := true.
  1876 
  1914 
  1877     pos := aStream position.
  1915     pos := aStream position.
  1878 
  1916 
  1879 "/    aCompiler lineNumberInfo == #full ifTrue:[
  1917 "/    aCompiler lineNumberInfo == #full ifTrue:[
  1880         ParseNode codeLineNumber:lineNr on:aStream for:aCompiler.
  1918 	ParseNode codeLineNumber:lineNr on:aStream for:aCompiler.
  1881         needLineNr := false.
  1919 	needLineNr := false.
  1882 "/    ].
  1920 "/    ].
  1883 
  1921 
  1884     optByteCode notNil ifTrue:[
  1922     optByteCode notNil ifTrue:[
  1885         theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1923 	theReceiver codeOn:aStream inBlock:b for:aCompiler.
  1886         theArg notNil ifTrue:[
  1924 	theArg notNil ifTrue:[
  1887             theArg codeOn:aStream inBlock:b for:aCompiler
  1925 	    theArg codeOn:aStream inBlock:b for:aCompiler
  1888         ]
  1926 	]
  1889     ] ifFalse:[
  1927     ] ifFalse:[
  1890         fastReceiver notNil ifTrue:[
  1928 	fastReceiver notNil ifTrue:[
  1891             theByteCode == #trueJump ifTrue:[
  1929 	    theByteCode == #trueJump ifTrue:[
  1892                 fastReceiver isConstant ifTrue:[
  1930 		fastReceiver isConstant ifTrue:[
  1893                     fastReceiver evaluate == true ifTrue:[
  1931 		    fastReceiver evaluate == true ifTrue:[
  1894                         theByteCode := #jump
  1932 			theByteCode := #jump
  1895                     ] ifFalse:[
  1933 		    ] ifFalse:[
  1896                         fastReceiver evaluate == false ifTrue:[
  1934 			fastReceiver evaluate == false ifTrue:[
  1897                             theByteCode := #never
  1935 			    theByteCode := #never
  1898                         ]
  1936 			]
  1899                     ]
  1937 		    ]
  1900                 ]
  1938 		]
  1901             ] ifFalse:[
  1939 	    ] ifFalse:[
  1902                 theByteCode == #falseJump ifTrue:[
  1940 		theByteCode == #falseJump ifTrue:[
  1903                     fastReceiver isConstant ifTrue:[
  1941 		    fastReceiver isConstant ifTrue:[
  1904                         fastReceiver evaluate == false ifTrue:[
  1942 			fastReceiver evaluate == false ifTrue:[
  1905                             theByteCode := #jump
  1943 			    theByteCode := #jump
  1906                         ] ifFalse:[
  1944 			] ifFalse:[
  1907                             fastReceiver evaluate == true ifTrue:[
  1945 			    fastReceiver evaluate == true ifTrue:[
  1908                                 theByteCode := #never
  1946 				theByteCode := #never
  1909                             ]
  1947 			    ]
  1910                         ]
  1948 			]
  1911                     ]
  1949 		    ]
  1912                 ]
  1950 		]
  1913             ]
  1951 	    ]
  1914         ].
  1952 	].
  1915 
  1953 
  1916         (theByteCode ~~ #jump
  1954 	(theByteCode ~~ #jump
  1917         and:[theByteCode ~~ #never]) ifTrue:[
  1955 	and:[theByteCode ~~ #never]) ifTrue:[
  1918             theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
  1956 	    theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.
  1919         ].
  1957 	].
  1920 
  1958 
  1921         "/
  1959 	"/
  1922         "/ cannot enable code below 
  1960 	"/ cannot enable code below 
  1923         "/ (tiny loops would not be debuggable with next, since lineNo remains the same)
  1961 	"/ (tiny loops would not be debuggable with next, since lineNo remains the same)
  1924         "/ think about it ...
  1962 	"/ think about it ...
  1925         "/
  1963 	"/
  1926         blockExpr := theReceiver simpleSendBlockExpression.
  1964 	blockExpr := theReceiver simpleSendBlockExpression.
  1927         blockExpr notNil ifTrue:[
  1965 	blockExpr notNil ifTrue:[
  1928             blockExpr isMessage ifTrue:[
  1966 	    blockExpr isMessage ifTrue:[
  1929                 (aCompiler hasLineNumber:(blockExpr selector)) ifTrue:[
  1967 		(aCompiler hasLineNumber:(blockExpr selector)) ifTrue:[
  1930                     blockExpr lineNumber == lineNr ifTrue:[
  1968 		    blockExpr lineNumber == lineNr ifTrue:[
  1931                         needLineNr := false
  1969 			needLineNr := false
  1932                     ]
  1970 		    ]
  1933                 ]
  1971 		]
  1934             ]
  1972 	    ]
  1935         ].
  1973 	].
  1936     ].
  1974     ].
  1937 
  1975 
  1938     needLineNr ifTrue:[
  1976     needLineNr ifTrue:[
  1939         ParseNode codeLineNumber:lineNr on:aStream for:aCompiler.
  1977 	ParseNode codeLineNumber:lineNr on:aStream for:aCompiler.
  1940     ].
  1978     ].
  1941 
  1979 
  1942     hasLoopBlock ifFalse:[
  1980     hasLoopBlock ifFalse:[
  1943         "/ simple [...] whileXXX
  1981 	"/ simple [...] whileXXX
  1944         theByteCode ~~ #never ifTrue:[
  1982 	theByteCode ~~ #never ifTrue:[
  1945             aStream nextPut:theByteCode; nextPut:pos.
  1983 	    aStream nextPut:theByteCode; nextPut:pos.
  1946         ].
  1984 	].
  1947 
  1985 
  1948         valueNeeded ifTrue:[aStream nextPut:#pushNil].
  1986 	valueNeeded ifTrue:[aStream nextPut:#pushNil].
  1949         ^ self
  1987 	^ self
  1950     ].
  1988     ].
  1951 
  1989 
  1952     "/ [...] whileXXX:[...]
  1990     "/ [...] whileXXX:[...]
  1953 
  1991 
  1954     theByteCode ~~ #never ifTrue:[
  1992     theByteCode ~~ #never ifTrue:[
  1955         aStream nextPut:theByteCode.
  1993 	aStream nextPut:theByteCode.
  1956         pos2 := aStream position.
  1994 	pos2 := aStream position.
  1957         aStream nextPut:0.
  1995 	aStream nextPut:0.
  1958     ].
  1996     ].
  1959 
  1997 
  1960     (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
  1998     (argArray at:1) codeInlineOn:aStream inBlock:b valueNeeded:false for:aCompiler.
  1961     aStream nextPut:#jump; nextPut:pos.
  1999     aStream nextPut:#jump; nextPut:pos.
  1962     theByteCode ~~ #never ifTrue:[
  2000     theByteCode ~~ #never ifTrue:[
  1963         (aStream contents) at:pos2 put:(aStream position).
  2001 	(aStream contents) at:pos2 put:(aStream position).
  1964     ].
  2002     ].
  1965 
  2003 
  1966     valueNeeded ifTrue:[aStream nextPut:#pushNil].
  2004     valueNeeded ifTrue:[aStream nextPut:#pushNil].
  1967 
  2005 
  1968     "Modified: 22.10.1996 / 21:34:37 / cg"
  2006     "Modified: 22.10.1996 / 21:34:37 / cg"
  2243 !MessageNode methodsFor:'queries'!
  2281 !MessageNode methodsFor:'queries'!
  2244 
  2282 
  2245 collectBlocksInto:aCollection
  2283 collectBlocksInto:aCollection
  2246     receiver collectBlocksInto:aCollection.
  2284     receiver collectBlocksInto:aCollection.
  2247     argArray size > 0 ifTrue:[
  2285     argArray size > 0 ifTrue:[
  2248         argArray do:[:arg |
  2286 	argArray do:[:arg |
  2249             arg collectBlocksInto:aCollection.
  2287 	    arg collectBlocksInto:aCollection.
  2250         ]
  2288 	]
  2251     ].
  2289     ].
  2252 
  2290 
  2253     "Created: 23.10.1996 / 15:44:49 / cg"
  2291     "Created: 23.10.1996 / 15:44:49 / cg"
  2254     "Modified: 23.10.1996 / 16:03:46 / cg"
  2292     "Modified: 23.10.1996 / 16:03:46 / cg"
  2255 !
  2293 !
  2259 ! !
  2297 ! !
  2260 
  2298 
  2261 !MessageNode class methodsFor:'documentation'!
  2299 !MessageNode class methodsFor:'documentation'!
  2262 
  2300 
  2263 version
  2301 version
  2264     ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.83 1997-10-28 18:16:37 cg Exp $'
  2302     ^ '$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.84 1998-01-16 15:06:45 cg Exp $'
  2265 ! !
  2303 ! !