1
2
3
4
5
6
7
8
9
10
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 $(
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
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
75
76 if c < n / 4 do
77 $( let r = Up!0 - Lp!0
78 if r < 0 do r := 30000000000
79
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
84
85
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 $)