1 //  Arithmetic sequences are generated by these routines.
  2 //  Last modified on 06/06/74 at 18:21:22 by R F Mabee.
  3 //  First installed as Version 3.4 by R F Mabee.
  4 //  Written in April 1973 to properly divide the work between Trans and CG.
  5 
  6 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
  7 
  8 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
  9 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 10 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 11 
 12 get "bcpl_cg_head"
 13 get "bcpl_opcodes"
 14 
 15 let ApplyDiadicOperator (Op, Result) be
 16      $(   let Reg = valof switchon Op into
 17                $(   case PLUS_S:
 18                               if Optimize then if TryDiadicRAR (Result, Asa) resultis 0
 19                               resultis ApplySymmetrical (Ada, AorQr)
 20 
 21                     case PLUS_F:
 22                               resultis ApplySymmetrical (Fad, EAQr)
 23 
 24                     case MINUS_S:
 25                               if Optimize do
 26                                    $(   if TryDiadicRAR (Result, Ssa) resultis 0
 27                                         if InRegister (Rrand, AorQr) & not InRegister (Lrand, AorQr) do
 28                                              $(   let r = ApplyRL (Sba, AorQr)
 29                                                   resultis ApplyNegate (r)
 30                                              $)
 31                                    $)
 32                               resultis ApplyLR (Sba, AorQr)
 33 
 34                     case MINUS_F:
 35                               if Optimize then if InRegister (Rrand, EAQr) do
 36                                              $(   ApplyRL (Fsb, EAQr)
 37                                                   resultis ApplyNegate (EAQr)
 38                                              $)
 39                               resultis ApplyLR (Fsb, EAQr)
 40 
 41                     case MULT_S:
 42                               if Optimize do
 43                                    $(   let r = TryShift (Lrand, Rrand)
 44                                         if r ne 0 resultis r
 45                                         r := TryShift (Rrand, Lrand)
 46                                         if r ne 0 resultis r
 47                                         if (InRegister (Lrand, Ar) & not InRegister (Rrand, Qr))
 48                                            | (InRegister (Rrand, Ar) & not InRegister (Lrand, Qr)) do SwapAandQ ()
 49                                    $)
 50                               GetRegister (Ar)              //  Overwritten by multiply hardware.
 51                               resultis ApplySymmetrical (Mpy, Qr)
 52 
 53                     case MULT_F:
 54                               resultis ApplySymmetrical (Fmp, EAQr)
 55 
 56                     case DIV_S:
 57                               if Optimize then if InRegister (Lrand, Ar) do SwapAandQ ()
 58                               GetRegister (Ar)              //  Overwritten by divide hardware.
 59                               resultis ApplyLR (Div, Qr)
 60 
 61                     case DIV_F:
 62                               if Optimize then if InRegister (Rrand, EAQr) do
 63                                         resultis ApplyRL (Fdi, EAQr)
 64                               resultis ApplyLR (Fdv, EAQr)
 65 
 66                     case REM_S:
 67                               if Optimize then if InRegister (Lrand, Ar) do SwapAandQ ()
 68                               GetRegister (Ar)              //  Remainder appears in Ar but operands do not.
 69                               ApplyLR (Div, Qr)
 70                               resultis Ar
 71 
 72                     case LOGOR_S:
 73                               if Optimize then if TryDiadicRAR (Result, Orsa) resultis 0
 74                               resultis ApplySymmetrical (Ora, AorQr)
 75 
 76                     case LOGAND_S:
 77                               if Optimize then if TryDiadicRAR (Result, Ansa) resultis 0
 78                               resultis ApplySymmetrical (Ana, AorQr)
 79 
 80                     case NEQV_S:
 81                               if Optimize then if TryDiadicRAR (Result, Ersa) resultis 0
 82                               resultis ApplySymmetrical (Era, AorQr)
 83 
 84                     case EQV_S:    $(   let r = ApplySymmetrical (Era, AorQr)
 85                                         Literal (true, "true")
 86                                         Outop (FormOpcode (Era, r))
 87                                         resultis r
 88                                    $)
 89 
 90                     default:  CGreport (UnexpectedCase, Op, "ApplyDiadicOperator")
 91                               resultis 0
 92                $)
 93           DisclaimRegister (Lrand)
 94           DisclaimRegister (Rrand)
 95           ClaimRegister (Reg, Result)
 96      $)
 97 
 98 and ApplyOffsetOperator (Op, Result, Offset) be
 99      $(   let Reg = valof switchon Op into
100                $(   case VECAP_S:
101                               if Result!0 = LV_TEMP goto RememberAddress
102                               let r = GetRegister (AorQr)
103                               CombineAddress (Lrand, Rrand, Offset)
104                               Outop (FormOpcode (Lda, r))
105                               IndicatorsSetBy := r
106                               resultis r
107 
108                     case LVECAP_S:
109                               if Result!0 = LV_TEMP goto RememberAddress
110                               if Optimize then if IsSameLoc (Result, Lrand) do
111                                    $(   let r = nil
112                                         test IsZero (Rrand)
113                                         then $(   if Offset = 1 do
114                                                        $(   SetupAddr (Result)
115                                                             Outop (Aos)
116                                                             IndicatorsSetBy := 0
117                                                             resultis 0
118                                                        $)
119                                                   r := LoadNumber (Offset, AorQr)
120                                              $)
121                                         or   $(   r := LoadRegister (Rrand, AorQr)
122                                                   unless Offset = 0 do
123                                                        $(   Literal (Offset)
124                                                             Outop (FormOpcode (Ada, r))
125                                                        $)
126                                              $)
127                                         SetupAddr (Result)
128                                         Outop (FormOpcode (Asa, r))
129                                         IndicatorsSetBy := 0
130                                         RegisterUsage!r := 0
131                                         resultis 0
132                                    $)
133                               r := GetRegister (AnyPr)
134                               CombineAddress (Lrand, Rrand, Offset)
135                               Outop (FormOpcode (Eapap, r))
136                               resultis r
137 
138                     RememberAddress:
139                               let h = MakeCgTemp (Result!1)
140                               h!1 := Op
141                               h!2, h!3, h!4 := Lrand!0, Lrand!1, Lrand!2
142                               h!5, h!6, h!7 := Rrand!0, Rrand!1, Rrand!2
143                               h!8 := Offset
144                               return
145 
146                     case LSHIFT_S:
147                     case RSHIFT_S:
148                                    $(   let r = LoadRegister (Lrand, AorQr)
149                                         let Xr = IsZero (Rrand) -> 0, LoadIndex (Rrand, AnyXr)
150                                         Outop3 (FormOpcode (Op = LSHIFT_S -> Als, Arl, r), Offset, FormTag (Xr))
151                                         IndicatorsSetBy := r
152                                         resultis r
153                                    $)
154 
155                     default:  CGreport (UnexpectedCase, Op, "ApplyAddressOperator")
156                               resultis 0
157                $)
158           DisclaimRegister (Lrand)
159           DisclaimRegister (Rrand)
160           ClaimRegister (Reg, Result)
161      $)
162 
163 and ApplyMonadicOperator (Op, Result) be
164      $(   let Reg = valof switchon Op into
165                $(   case POS_S:
166                     case POS_F:
167                     case ASSIGN_S:
168                               if Optimize then if Result!0 ne LV_TEMP do
169                                    $(   Store (Lrand, Result)
170                                         resultis 0
171                                    $)
172                               resultis LoadAppropriateRegister (Lrand, 0)
173 
174                     case NEG_S:
175                               if Optimize then if TryMonadicRAR (Result, Ssa, 0) resultis 0
176                               resultis LoadNegative (Lrand)
177 
178                     case NEG_F:
179                               resultis ApplyNegate (LoadRegister (Lrand, EAQr))
180 
181                     case NOT_S:
182                               if Optimize then if TryMonadicRAR (Result, Ersa, true) resultis 0
183                               let r = FindInRegister (Lrand, AorQr)
184                               test r = 0
185                               then $(   r := LoadNumber (true, AorQr, "true")
186                                         Makeaddressable (Lrand)
187                                    $)
188                               or Literal (true, "true")
189                               Outop (FormOpcode (Era, r))
190                               IndicatorsSetBy := r
191                               resultis r
192 
193                     default:  CGreport (UnexpectedCase, Op, "ApplyMonadicOperator")
194                               resultis 0
195                $)
196           DisclaimRegister (Lrand)
197           ClaimRegister (Reg, Result)
198      $)
199 
200 and ApplySymmetrical (Inst, Reg) = InRegister (Rrand, Reg) -> ApplyRL (Inst, Reg), ApplyLR (Inst, Reg)
201 and ApplyRL (Inst, Reg) = valof
202      $(   let t, u = Lrand, Rrand
203           Rrand, Lrand := t, u
204           let r = ApplyLR (Inst, Reg)
205           Lrand, Rrand := t, u
206           resultis r
207      $)
208 and ApplyLR (Inst, Reg) = valof
209      $(   let r = LoadRegister (Lrand, Reg)
210           Makeaddressable (Rrand)
211           Outop (FormOpcode (Inst, r))
212           IndicatorsSetBy := r
213           resultis r
214      $)
215 and ApplyNegate (r) = valof
216   switchon r into
217      $(   case Qr:  if RegisterTemps!Ar = 0 do
218                          $(   Outop3 (Negl, 0, Dl)
219                               IndicatorsSetBy := 0
220                               resultis Qr
221                          $)
222                     SwapAandQ ()
223           case Ar:  Outop3 (Neg, 0, Dl)
224                     IndicatorsSetBy := Ar
225                     resultis Ar
226           case EAQr:Outop3 (Fneg, 0, Dl)
227                     IndicatorsSetBy := EAQr
228                     resultis EAQr
229           default:  CGreport (UnexpectedCase, r, "ApplyNegate")
230                     resultis r
231      $)
232 and LoadNegative (t) = valof
233      $(   let r = FindInRegister (t, AorQr)
234           if r ne 0 resultis ApplyNegate (r)
235           r := GetRegister (AorQr)
236           Makeaddressable (t)
237           Outop (FormOpcode (Lca, r))
238           IndicatorsSetBy := r
239           resultis r
240      $)
241 
242 and TryShift (Rand, Const) = valof
243      $(   unless IsNumber (Const) resultis 0
244           let n, i = EvalNumber (Const!0, Const!1), 0
245           until n = (1 lshift i) do
246                $(   if i > 36 resultis 0
247                     i := i + 1
248                $)
249           let r = LoadRegister (Rand, AorQr)
250           Outop3 (FormOpcode (Als, r), i, 0)
251           IndicatorsSetBy := r
252           resultis r
253      $)
254 
255 and TryMonadicRAR (Result, Op, Const) = valof
256      $(   unless IsSameLoc (Result, Lrand) resultis false
257           let r = LoadNumber (Const, AorQr, 0)
258           SetupAddr (Result)
259           Outop (FormOpcode (Op, r))
260           IndicatorsSetBy := 0
261           RegisterUsage!r := 0
262           resultis true
263      $)
264 and TryDiadicRAR (Result, Op) = valof
265      $(   let X = Rrand
266           unless IsSameLoc (Result, Lrand) do
267                $(   X := Lrand
268                     unless IsSameLoc (Result, Rrand) resultis false
269                $)
270           if Op = Asa & IsNumber (X) then if EvalNumber (X!0, X!1) = 1 do
271                $(   SetupAddr (Result)
272                     Outop (Aos)
273                     IndicatorsSetBy := 0
274                     resultis true
275                $)
276           let r = nil
277           test Op = Ssa & X = Rrand
278           then r, Op := LoadNegative (X), Asa
279           or r := LoadRegister (X, AorQr)
280           SetupAddr (Result)
281           Outop (FormOpcode (Op, r))
282           IndicatorsSetBy := 0
283           RegisterUsage!r := 0
284           resultis true
285      $)
286 
287 and IsSameLoc (t, u) = valof
288   switchon t!0 into
289      $(   case LV_GLOBAL:
290                     resultis u!0 = GLOBAL_S & t!1 = u!1 -> true, false
291           case LV_LOCAL:
292                     resultis u!0 = LOCAL_S & t!1 = u!1 -> true, false
293           case LV_STATIC:
294                     resultis u!0 = STATIC_S & t!1 = u!1 -> true, false
295           case TEMP_S:
296                     unless u!0 = TEMP_S resultis false
297                     let g, h = LookupTemp (t!1), LookupTemp (u!1)
298                     if g = 0 | h = 0 resultis false
299                     unless g!1 = LVECAP_S & h!1 = VECAP_S resultis false
300                     resultis g!2 = h!2 & g!3 = h!3 & g!5 = h!5 & g!6 = h!6 & g!8 = h!8 -> true, false
301           default:  resultis false
302      $)
303 
304 and DiadicJumpcond (Op, L) be
305      $(   let Reversed = valof switchon Op into
306                $(   case EQ_S: case NE_S: case LS_S: case GR_S: case LE_S: case GE_S:
307                               if IsZero (Rrand) do
308                                    $(   CompareToZero (Lrand)
309                                         resultis false
310                                    $)
311                               if IsZero (Lrand) do
312                                    $(   CompareToZero (Rrand)
313                                         resultis true
314                                    $)
315                               if InRegister (Rrand, AorQr) do
316                                    $(   ApplyRL (Cmpa, AorQr)
317                                         IndicatorsSetBy := 0
318                                         resultis true
319                                    $)
320                               ApplyLR (Cmpa, AorQr)
321                               IndicatorsSetBy := 0
322                               resultis false
323 
324                     case EQ_F: case NE_F: case LS_F: case GR_F: case LE_F: case GE_F:
325                               if InRegister (Rrand, EAQr) do
326                                    $(   ApplyRL (Fcmp, EAQr)
327                                         IndicatorsSetBy := 0
328                                         resultis true
329                                    $)
330                               ApplyLR (Fcmp, EAQr)
331                               IndicatorsSetBy := 0
332                               resultis false
333 
334                     default:  CGreport (UnexpectedCase, Op, "DiadicJumpcond")
335                               return
336                $)
337 
338           let t = valof switchon Op into
339                $(   case EQ_S: case EQ_F:         resultis Tze
340                     case NE_S: case NE_F:         resultis Tnz
341                     case LS_S: case LS_F:         resultis Reversed -> Tpnz, Tmi
342                     case GR_S: case GR_F:         resultis Reversed -> Tmi, Tpnz
343                     case LE_S: case LE_F:         resultis Reversed -> Tpl, Tmoz
344                     case GE_S: case GE_F:         resultis Reversed -> Tmoz, Tpl
345                $)
346 
347           if Machine = 645 test t = Tmoz
348                     then $(   Outop2 (Tmi, L)
349                               t := Tze
350                          $)
351                     or if t = Tpnz do
352                          $(   Outop3 (Tze, 2, Ic)
353                               t := Tpl
354                          $)
355           Outop2 (t, L)
356           DisclaimRegister (Lrand)
357           DisclaimRegister (Rrand)
358      $)
359 
360 and MonadicJumpcond (Op, L) be
361      $(   CompareToZero (Lrand)
362           Outop2 (Op = TRUE_S -> Tnz, Tze, L)
363           DisclaimRegister (Lrand)
364      $)