1 //  Expression evaluation routines.
  2 //  Last modified on 06/06/74 at 18:26:51 by R F Mabee.
  3 //  Prepared for installation as part of Version 3.4 by R F Mabee.
  4 //  Greatly revised during 6180 bootstrap to simplify interface to code generator.
  5 //  First installed as Version 2.7, by R F Mabee.
  6 
  7 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
  8 
  9 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
 10 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 11 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 12 
 13 get "bcpl_trans_head"
 14 get "bcpl_metering_head"
 15 
 16 
 17 let CompileExpression (Result, x) be
 18      $(   let UsageTemp = nil
 19           if Metering do UsageTemp := SaveOldUsage ()
 20           let Op = x!0 & Right
 21           switchon Op into
 22                $(   default:  Transreport (UnrecognizedExpression, x)
 23                     case NIL_S:
 24                               endcase
 25 
 26                     case NAME_S:
 27                     case NUMBER_S:
 28                     case CHARCONST_S:
 29                     case STRINGCONST_S:
 30                     case CONSTANT_S:
 31                     case TRUE_S:
 32                     case FALSE_S:
 33                     case LV_S:
 34                     case VEC_S:
 35                     case LIST_S:
 36                     case TABLE_S:
 37                     case LOCAL_S:
 38                               Monadic (ASSIGN_S, Result, x)
 39                               endcase
 40 
 41                     case POS_S: case POS_F:
 42                     case NEG_S: case NEG_F:
 43                     case NOT_S:
 44                               if Optimize then if IsConst (x) goto AssignConstant
 45                               Monadic (Op, Result, x!1)
 46                               endcase
 47 
 48                     AssignConstant:
 49                               Monadic (ASSIGN_S, Result, x)
 50                               endcase
 51 
 52 
 53                     case PLUS_S: case PLUS_F:
 54                     case MINUS_S: case MINUS_F:
 55                     case MULT_S: case MULT_F:
 56                     case DIV_S: case DIV_F:
 57                     case REM_S:
 58                     case LOGOR_S:
 59                     case LOGAND_S:
 60                     case EQV_S:
 61                     case NEQV_S:
 62                               if Optimize then if IsConst (x) goto AssignConstant
 63                                    $(   let Order = DecideOrder (Result, x!1, x!2)
 64                                         and Desc1, Desc2, Desc3 = vec DescSize, vec DescSize, vec DescSize
 65                                         for i = 1 to 3 do
 66                                              $(   test (Order & $81) ne 0
 67                                                   then CompileLmode (Result, Desc1)
 68                                                   or test (Order & $82) ne 0
 69                                                      then CompileOperand (x!1, Desc2)
 70                                                      or CompileOperand (x!2, Desc3)
 71                                                   Order := Order rshift 3
 72                                              $)
 73                                         GenerateDiadicOperator (Op, Desc1, Desc2, Desc3)
 74                                         endcase
 75                                    $)
 76 
 77                     case LSHIFT_S:
 78                     case RSHIFT_S:
 79                     case VECAP_S:
 80                               CompileWithOffset (Op, Result, x!1, x!2)
 81                               endcase
 82 
 83                     case RV_S:
 84                                    $(   let Zero = list CONSTANT_S, 0
 85                                         CompileWithOffset (VECAP_S, Result, x!1, Zero)
 86                                         endcase
 87                                    $)
 88 
 89                     case REL_S:    $(   let T, F = TRUE_S, FALSE_S
 90                                         let Xprime = list COND_S, x, lv T, lv F
 91                                         CompileExpression (Result, Xprime)
 92                                         endcase
 93                                    $)
 94 
 95                     case COND_S:
 96                               if Optimize then if IsConst (x!1) do
 97                                    $(   let B = Evalconst (x!1)
 98                                         CompileExpression (Result, (B -> x!2, x!3))
 99                                         endcase
100                                    $)
101 
102                                    $(   let L, M = Nextparam (), Nextparam ()
103                                         GenerateResultBlock ()
104                                         TransConditional (x!1, false, L)
105                                         SetResult (x!2)
106                                         GenerateJump (M)
107                                         GenerateLabel (L)
108                                         SetResult (x!3)
109                                         GenerateLabel (M)
110                                         ClaimResult (Result)
111                                         endcase
112                                    $)
113 
114                     case VALOF_S:
115                                    $(   let s = SSP
116                                         let Rl, Rf = ValofLabel, ValofFlag
117                                         ValofLabel, ValofFlag := Nextparam (), true
118                                         GenerateResultBlock ()
119                                         Transbody (x!1)
120                                         GenerateLabel (ValofLabel)
121                                         ClaimResult (Result)
122                                         ValofLabel, ValofFlag := Rl, Rf
123                                         ResetSSP (s)
124                                         endcase
125                                    $)
126 
127                     case FNAP_S:
128                                    $(   let Desc1, Desc2 = vec DescSize, vec DescSize
129                                         test (Result!0 & Right) = NAME_S
130                                         then $(   CompileLmode (Result, Desc1)
131                                                   TransFnap (Desc1, x!1, x!2)
132                                              $)
133                                         or   $(   let T = MakeTemp ()
134                                                   CompileLmode (T, Desc1)
135                                                   TransFnap (Desc1, x!1, x!2)
136                                                   Monadic (ASSIGN_S, Result, T)
137                                              $)
138                                         endcase
139                                    $)
140                $)
141           if Metering do RecordUsage (CompileExpression_Meter, UsageTemp)
142      $)
143 and Monadic (Op, Result, x) be
144      $(   let Desc1, Desc2 = vec DescSize, vec DescSize
145           and Order = ChooseOrder (CountTemporaries (Result), CountTemporaries (x))
146           if Order do CompileLmode (Result, Desc1)
147           CompileOperand (x, Desc2)
148           unless Order do CompileLmode (Result, Desc1)
149           GenerateMonadicOperator (Op, Desc1, Desc2)
150      $)
151 and ChooseOrder (a, b) = a = b -> (RandomI () & $81) = 0, a > b
152 and DecideOrder (a, b, c) = valof
153      $(   let Min, Max = 0, 0
154           and T = list CountTemporaries (a), CountTemporaries (b), CountTemporaries (c)
155           for i = 1 to 2 test ChooseOrder (T!i, T!Max) then Max := i
156                     or unless ChooseOrder (T!i, T!Min) do Min := i
157           if Min = Max do Min := (Max + 1) rem 3
158           let Middle = 3 - Min - Max
159           resultis ($81 lshift (Min + 6)) | ($81 lshift (Middle + 3)) | ($81 lshift Max)
160      $)
161 
162 and SetResult (x) be
163      $(   let Desc = vec DescSize
164           CompileOperand (x, Desc)
165           GenerateResultValue (Desc)
166      $)
167 and ClaimResult (x) be
168      $(   let T, Desc = MakeTemp (), vec DescSize
169           CompileLmode (T, Desc)
170           GenerateClaimResult (Desc)
171           Monadic (ASSIGN_S, x, T)
172      $)
173 
174 and CompileOperand (x, Desc) be
175      $(   let Op = x!0 & Right
176           switchon Op into
177                $(   case NAME_S:
178                               let T = Cellwithname (x)
179                               Desc!0, Desc!1, Desc!2 := T!1, T!2, x!1
180                               if Desc!0 = LOCAL_S do
181                                    $(   unless (Desc!1 rshift Left) = RtdefNesting do Transreport (FreeVar, x)
182                                         Desc!1 := Desc!1 & Right
183                                    $)
184                               return
185 
186                     case LOCAL_S:
187                     case TEMP_S:
188                               Desc!0, Desc!1, Desc!2 := Op, x!1, 0
189                               return
190 
191                     case NUMBER_S:
192                     case CHARCONST_S:
193                     case STRINGCONST_S:
194                               Desc!0, Desc!1, Desc!2 := Op, x!1, x!1
195                               return
196 
197                     case CONSTANT_S:
198                               Desc!0, Desc!1, Desc!2 := CONSTANT_S, x!1, 0
199                               return
200 
201                     case TRUE_S:
202                               Desc!0, Desc!1, Desc!2 := TRUE_S, true, "true"
203                               return
204 
205                     case FALSE_S:
206                               Desc!0, Desc!1, Desc!2 := FALSE_S, false, "false"
207                               return
208 
209                     case LV_S:
210                               CompileLmode (x!1, Desc)
211                               return
212 
213                     case VEC_S:
214                               let n = Evalconst (x!1)
215                               if n < 0 do
216                                    $(   Transreport (NegVector, x!1)
217                                         n := 0
218                                    $)
219                               let p = AllocateLocal (n + 1)
220                               Desc!0, Desc!1, Desc!2 := LV_LOCAL, p, "a vector"
221                               return
222 
223                     case LIST_S:
224                               p := AllocateLocal (ListSize (x!1))
225                               WalkList (x!1, LoadListItem, p)
226                               Desc!0, Desc!1, Desc!2 := LV_LOCAL, p, "a list"
227                               return
228 
229                     case TABLE_S:
230                               n := ListSize (x!1)
231                               p := TableCell
232                               TableCell := Newvec (n * 2)
233                               TableCell!0 := n
234                               WalkList (x!1, StoreTableItem, 0)
235                               Desc!0, Desc!1, Desc!2 := TABLE_S, TableCell, "a table"
236                               TableCell := p
237                               return
238 
239                     default:  if Optimize then if IsConst (x) do
240                                    $(   Desc!0, Desc!1, Desc!2 := CONSTANT_S, Evalconst (x), 0
241                                         return
242                                    $)
243                               let Result = MakeTemp ()
244                               CompileExpression (Result, x)
245                               CompileOperand (Result, Desc)
246                               return
247                $)
248      $)
249 and LoadListItem (x, p) be
250      $(   let Cell = list LOCAL_S, p
251           CompileExpression (Cell, x)
252      $)
253 and StoreTableItem (x, n) be
254           PartialEvalconst (x, lv TableCell!(n * 2 + 1))
255 
256 and CompileLmode (x, Desc) be
257   switchon x!0 & Right into
258      $(   case RV_S:
259                     CompileOperand (x!1, Desc)
260                     return
261 
262           case VECAP_S:
263                     let Result = MakeTemp ()
264                     CompileWithOffset (LVECAP_S, Result, x!1, x!2)
265                     CompileOperand (Result, Desc)
266                     return
267 
268           case NAME_S:
269                     let T = Cellwithname (x)
270                     Desc!1, Desc!2 := T!2, x!1
271                     Desc!0 := valof switchon T!1 into
272                          $(   case GLOBAL_S:
273                                         resultis LV_GLOBAL
274                               case STATIC_S:
275                                         resultis LV_STATIC
276                               case LOCAL_S:
277                                         unless (Desc!1 rshift Left) = RtdefNesting do Transreport (FreeVar, x)
278                                         Desc!1 := Desc!1 & Right
279                                         resultis LV_LOCAL
280                               default:  Transreport (LmodeRequired, x)
281                                         resultis T!1
282                          $)
283                     return
284 
285           case LOCAL_S:
286           case TEMP_S:
287                     Desc!0, Desc!1, Desc!2 := ((x!0 & Right) = LOCAL_S -> LV_LOCAL, LV_TEMP), x!1, 0
288                     return
289 
290           default:  Transreport (LmodeRequired, x)
291                     CompileOperand (x, Desc)
292      $)
293 
294 and CompileWithOffset (Op, Result, a, b) be
295      $(   let Desc1, Desc2, Desc3 = vec DescSize, vec DescSize, vec DescSize
296           and Order = DecideOrder (Result, a, b)
297           and Offset = 0
298           for i = 1 to 3 do
299                $(   test (Order & $81) ne 0
300                     then CompileLmode (Result, Desc1)
301                     or test (Order & $82) ne 0
302                        then CompileOperand (a, Desc2)
303                        or CompileOffsetOperand (b, Desc3, lv Offset)
304                     Order := Order rshift 3
305                $)
306           GenerateOffsetOperator (Op, Desc1, Desc2, Desc3, Offset)
307      $)
308 and CompileOffsetOperand (x, Desc, LvN) be
309      $(   let Op = Op
310           switchon Op into
311                $(   case PLUS_S:
312                               if Optimize then if IsConst (x!1) do
313                                    $(   CompileOffsetOperand (x!2, Desc, LvN)
314                                         rv LvN := EvaluateOperator (PLUS_S, Evalconst (x!1), rv LvN)
315                                         endcase
316                                    $)
317 
318                     case MINUS_S:
319                               if Optimize then if IsConst (x!2) do
320                                    $(   CompileOffsetOperand (x!1, Desc, LvN)
321                                         rv LvN := EvaluateOperator (Op, rv LvN, Evalconst (x!2))
322                               endcase
323                                    $)
324 
325                     default:  if Optimize then if IsConst (x) do
326                                   $(    Desc!0, Desc!1, Desc!2 := CONSTANT_S, 0, 0
327                                         rv LvN := Evalconst (x)
328                                         endcase
329                                    $)
330                               CompileOperand (x, Desc)
331                     rv LvN := 0
332                $)
333      $)