1 //  These routines generate the code for switchons.
  2 //  Last modified on 06/06/74 at 18:22:41 by R F Mabee.
  3 //  Converted to 6180 and installed in Version 3.4, R F Mabee.
  4 //  First installed in Version 2.7 by R F Mabee.
  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 global
 16      $(   NoDefault : GlobalTemp  $)
 17 
 18 let Compswitch (Val, CaseList, DefaultL, EndcaseL) be
 19      $(             //  Copy cases into a vector, evaluated and sorted.
 20           let CaseV = vec 1000 + 2
 21           and CaseP = 0
 22           let t = CaseList
 23           until t = 0 do
 24                $(   for i = EvalNumber (t!2, t!3) to EvalNumber (t!4, t!5) do
 25                          $(   let j = CaseP
 26                               while j > 0 & CaseV!j > i do j := j - 2
 27                               if j > 0 & CaseV!j = i do
 28                                    $(   CGreport (DupCase, i)
 29                                         loop
 30                                    $)
 31                               for k = CaseP to j + 2 by -2 do CaseV!(k + 2), CaseV!(k + 3) := CaseV!k, CaseV!(k + 1)
 32                               CaseV!(j + 2), CaseV!(j + 3) := i, t!1
 33                               test CaseP ge 1000
 34                               then CGreport (OverCase, 1000 / 2)
 35                               or CaseP := CaseP + 2
 36                          $)
 37                     t := t!0
 38                $)
 39           NoDefault := DefaultL = 0 & Optimize
 40           let Min, Max = 1 lshift 35, not (1 lshift 35)
 41           if NoDefault do Min, Max := CaseV!2, CaseV!CaseP
 42           SectionHeader ("*nBegin switchon")
 43           LoadRegister (Val, Ar)
 44           AnySwitch (lv CaseV!2, lv CaseV!CaseP, Min, Max, DefaultL = 0 -> EndcaseL, DefaultL)
 45           DisclaimRegister (Val)
 46      $)
 47 and AnySwitch (Lp, Up, Ll, Ul, DefaultL) be
 48      $(   let n = (Up - Lp) / 2 + 1
 49                     // Number of cases.
 50           if NoDefault -> n < 4, n < 3 do
 51                $(   LinearSwitch (Lp, Up, Ll, Ul, DefaultL)
 52                     return
 53                $)
 54           let a, b, c, d = 0, Lp + (n & Even), 0, 0
 55           if Optimize do
 56                $(   let u, w, x, y, z = 0, 0, 0, 0, 0
 57                     let v = vec 2000
 58                     w := Lp!0
 59                     for p = Lp to Up by 2 do
 60                          $(   let q, r = p!1, p!0 - w
 61                               for i = 1 to a do if q = v!i goto L
 62                               a := a + 1
 63                               v!a := q
 64                          L:   test q = x & (NoDefault | r = 1)
 65                               then z := z + 1
 66                               or   $(   if z ge c do b, c := y, z
 67                                         x, y, z := q, p, 0
 68                                    $)
 69                               if r > u do d, u := p, r
 70                               w := p!0
 71                          $)
 72                     if z > c do b, c := y, z
 73                     if c = 0 do b := u ge n -> d, Lp + (n & Even)
 74                               // Here a is the number of distinct labels
 75                               // and b points to c adjacent cases.
 76                     if c < n / 4 do
 77                          $(   let r = Up!0 - Lp!0
 78                               if r < 0 do r := 30000000000
 79                                         // Now r is the range of cases covered.
 80                               let i, j, k = a, n * 4, r - 2
 81                               unless NoDefault do i, j, k := n, n * 2, k / 2 + 2
 82                               if j > k do j := k
 83                                         // Here i is the minimum hash table size,
 84                                         // j is a reasonable limit for i,
 85                                         // and k is the size beyond which a direct switch is better.
 86                               while i < j do
 87                                    $(   for m = 0 to i do v!m := 0
 88                                         for p = Lp to Up by 2 do
 89                                              $(   let m = p!0
 90                                                   for s = 35 to 0 by -1 do if (m rshift s) ge i do m := m - (i lshift s)
 91                                                   let t = p!1
 92                                                   unless v!m = 0 | v!m = t & NoDefault goto M
 93                                                   v!m := t
 94                                              $)
 95                                         HashSwitch (Lp, Up, i, DefaultL)
 96                                         return
 97                                    M:   i := i + 1
 98                                    $)
 99                               if k le j & u < n do
100                                    $(   DirectSwitch (Lp, Up, Ll, Ul, DefaultL)
101                                         return
102                                    $)
103                          $)
104                $)
105           BinarySwitch (Lp, Up, Ll, Ul, b, c, DefaultL)
106      $)
107 and LinearSwitch (Lp, Up, Ll, Ul, DefaultL) be
108      $(   let LastL = DefaultL
109           if NoDefault | (Lp!0 = Ll & Up!0 = Ul & Ul - Ll = (Up - Lp) / 2) do
110                $(   LastL := Up!1
111                     Up := Up - 2
112                $)
113           for p = Lp to Up by 2 do Swjump (p!0, Tze, p!1)
114           Compjump (LastL)
115      $)
116 and HashSwitch (Lp, Up, i, DefaultL) be
117      $(   let v = vec 2000
118           and w = vec 2000
119           for j = 0 to i do v!j, w!j := DefaultL, 0
120           for p = Lp to Up by 2 do
121                $(   let m, n = p!0, 0
122                     for s = 35 to 0 by -1 do
123                          $(   n := n lshift 1
124                               if (m rshift s) ge i do m, n := m - (i lshift s), n + 1
125                          $)
126                     v!m, w!m := p!1, n
127                $)
128           Outop3 (Lrl, 35, 0)
129           Literal (i, "hash table size")
130           Outop (Dvf)
131           let Tl = 0
132           unless NoDefault do
133                $(   Tl := Nextparam ()
134                     Address, Tag, Param, Reloc := 0, Ql, Tl, RelText lshift Left
135                     Outop (Cmpa)
136                     Outop2 (Tnz, DefaultL)
137                $)
138           let Lab = Nextparam ()
139           Address, Tag, Param, Reloc := 0, Ql, Lab, RelText lshift Left
140           Outop (Tra)
141           Complab (Lab)
142           for j = 0 to i - 1 do Outop2 (Tra, v!j)
143           unless NoDefault do
144                $(   Complab (Tl)
145                     for j = 0 to i - 1 do OutData (w!j)
146                $)
147      $)
148 and DirectSwitch (Lp, Up, Ll, Ul, DefaultL) be
149      $(   let n = (Up - Lp) / 10 + 2
150           let x = 0
151           test NoDefault
152           then Ll, Ul := Lp!0, Up!0
153           or test Ul - n ge Up!0
154           then $(   let r, t = Up!0, Tpl
155                     Ul := r
156                     if Ll + n < Lp!0 do
157                          $(   test 0 le Lp!0 le n
158                               then Ll := 0
159                               or   $(   Outop3 (Sba, Lp!0, Dl)
160                                         Ll := Lp!0
161                                         x, r := Ll, Ul - Ll
162                                    $)
163                               t := Trc
164                          $)
165                     Swjump (r + 1, t, DefaultL)
166                $)
167           or if Ll + n < Lp!0 do
168                $(   Ll := Lp!0
169                     Swjump (Ll, Tmi, DefaultL)
170                $)
171           let Lab = Nextparam ()
172           Address, Param, Tag, Reloc := x - Ll, Lab, Al, RelText lshift Left
173           Outop (Tra)
174           Complab (Lab)
175           for i = Ll to Ul do
176                     test Lp!0 = i
177                     then $(   Outop2 (Tra, Lp!1)
178                               Lp := Lp + 2
179                          $)
180                     or Outop2 (Tra, DefaultL)
181      $)
182 and BinarySwitch (Lp, Up, Ll, Ul, b, c, DefaultL) be
183      $(   let Tl = 0
184           let d = b + c + c
185           let s, t = false, false
186           unless b = Lp & (NoDefault | Ll = Lp!0) do
187                $(   test b le Lp + 2 & (NoDefault | b = Lp | Ll = Lp!0 & b!0 = Ll + 1)
188                     then Swjump (b!0, Tmi, b = Lp -> DefaultL, Lp!1)
189                     or   $(   Tl := Nextparam ()
190                               Swjump (b!0, Tmi, Tl)
191                          $)
192                     s := true
193                $)
194           test d = Up & (NoDefault | Ul = Up!0)
195           then $(   Compjump (d!1)
196                     t := true
197                $)
198           or test c = 0 & s
199              then Outop2 (Tze, b!1)
200              or Swjump (d!0 + 1, Tmi, d!1)
201           unless t test d = Up
202           then unless NoDefault | Ul = Up!0 do Compjump (DefaultL)
203           or AnySwitch (d + 2, Up, d!0 + 1, Ul, DefaultL)
204           unless Tl = 0 do
205                $(   Complab (Tl)
206                     AnySwitch (Lp, b - 2, Ll, b!0 - 1, DefaultL)
207                $)
208      $)
209 and Swjump (n, t, l) be
210      $(   Literal (n, 0)
211           Outop (Cmpa)
212           Outop2 (t, l)
213      $)