1
2
3
4
5
6
7
8
9
10
11
12 get "bcpl_trans_head"
13
14 let CountTemporaries (x) = valof
15 $( switchon x!0 & Right into
16 $( case NAME_S:
17 resultis IsNameConst (Cellwithname (x)) -> 0, 1
18
19 case NUMBER_S:
20 case CHARCONST_S:
21 case CONSTANT_S:
22 case TRUE_S:
23 case FALSE_S:
24 case NIL_S:
25 resultis 0
26
27 case STRINGCONST_S:
28 case TABLE_S:
29 case VEC_S:
30 resultis 1
31
32 case POS_S: case POS_F:
33 case NEG_S: case NEG_F:
34 case NOT_S:
35 case RV_S:
36 case LV_S:
37 let C = CountTemporaries (x!1)
38 if C = 1 resultis 2
39 resultis C
40
41 case PLUS_S: case PLUS_F:
42 case MINUS_S: case MINUS_F:
43 case MULT_S: case MULT_F:
44 case DIV_S: case DIV_F:
45 case REM_S:
46 case LOGOR_S:
47 case LOGAND_S:
48 case EQV_S:
49 case NEQV_S:
50 case LSHIFT_S:
51 case RSHIFT_S:
52 case VECAP_S:
53 let C1, C2 = CountTemporaries (x!1), CountTemporaries (x!2)
54 if C1 = 0 do
55 $( if C2 = 0 resultis 0
56 C1 := 1
57 $)
58 if C1 > C2 resultis C1
59 if C1 < C2 resultis C2
60 resultis C1 + 1
61
62 case FNAP_S:
63 case VALOF_S:
64 case COND_S:
65 case REL_S:
66 case LIST_S:
67 default: resultis 100
68 $)
69 $)
70 and IsNameConst (T) = valof
71 switchon T!1 into
72 $( case CONSTANT_S: case NUMBER_S: case CHARCONST_S: case TRUE_S: case FALSE_S:
73 resultis true
74 default: resultis false
75 $)
76 let PartialEvalconst (x, v) be
77 $( let Op = x!0 & Right
78 switchon Op into
79 $( case NAME_S:
80 let T = Cellwithname (x)
81 unless IsNameConst (T) endcase
82 v!0, v!1 := T!1, T!2
83 return
84 case NUMBER_S:
85 case CHARCONST_S:
86 v!0, v!1 := Op, x!1
87 return
88 case TRUE_S:
89 case FALSE_S:
90 v!0, v!1 := Op, Op = TRUE_S
91 return
92 default:
93 $)
94 v!0, v!1 := CONSTANT_S, Evalconst (x)
95 $)
96 and FinalEvalconst (Op, N) = valof
97 switchon Op into
98 $( case NUMBER_S: resultis ConvertStoN (N)
99 case CHARCONST_S: resultis FormCharconst (N)
100 case TRUE_S: resultis true
101 case FALSE_S: resultis false
102 case CONSTANT_S: resultis N
103 default: CGreport (UnexpectedCase, Op, "FinalEvalconst")
104 resultis N
105 $)
106
107 and Evalconst (x) = valof
108 $( let Op = x!0 & Right
109 switchon Op into
110 $( case NAME_S:
111 $( let T = Cellwithname (x)
112 unless IsNameConst (T) endcase
113 resultis FinalEvalconst (T!1, T!2)
114 $)
115
116 case NUMBER_S:
117 case CHARCONST_S:
118 case TRUE_S:
119 case FALSE_S:
120 resultis FinalEvalconst (Op, x!1)
121
122 case CONSTANT_S:
123 resultis x!1
124
125 case POS_S: case POS_F:
126 case NEG_S: case NEG_F:
127 case NOT_S:
128 resultis EvaluateOperator (Op, Evalconst (x!1))
129
130 case PLUS_S: case PLUS_F:
131 case MINUS_S: case MINUS_F:
132 case MULT_S: case MULT_F:
133 case DIV_S: case DIV_F:
134 case REM_S:
135 case LOGOR_S:
136 case LOGAND_S:
137 case EQV_S:
138 case NEQV_S:
139 case LSHIFT_S:
140 case RSHIFT_S:
141 resultis EvaluateOperator (Op, Evalconst (x!1), Evalconst (x!2))
142
143 case COND_S:
144 resultis Evalconst (Evalconst (x!1) -> x!2, x!3)
145
146 case REL_S:
147 x := x!1
148 $( let A = Evalconst (x!1)
149 while IsRelational (x!2) do
150 $( let Middle = Evalconst (x!2!1)
151 unless EvaluateOperator (x!0 & Right, A, Middle) resultis false
152 x, A := x!2, Middle
153 $)
154 resultis EvaluateOperator (x!0 & Right, A, Evalconst (x!2))
155 $)
156
157 case VECAP_S:
158 if (x!1!0 & Right) = STRINGCONST_S do
159 $( let v = vec Vmax
160 let Len = FormStringconst (x!1!1, v)
161 let i = Evalconst (x!2)
162 if 0 le i le Len resultis v!i
163 $)
164 endcase
165
166 default:
167 $)
168
169 Transreport (NotConstant, x)
170 resultis RandomI ()
171 $)
172
173 and IsRelational (x) = valof
174 switchon x!0 & Right into
175 $( case EQ_S: case EQ_F:
176 case NE_S: case NE_F:
177 case LS_S: case LS_F:
178 case LE_S: case LE_F:
179 case GR_S: case GR_F:
180 resultis true
181
182 default: resultis false
183 $)
184
185 and EvaluateOperator (Op, a, b) = valof switchon Op into
186 $( default: CGreport (UnexpectedCase, Op, "EvaluateOperator")
187 resultis RandomI ()
188
189 case POS_S: resultis + a
190 case POS_F: resultis .+ a
191 case NEG_S: resultis - a
192 case NEG_F: resultis .- a
193 case NOT_S: resultis not a
194
195 case PLUS_S: resultis a + b
196 case PLUS_F: resultis a .+ b
197 case MINUS_S: resultis a - b
198 case MINUS_F: resultis a .- b
199 case MULT_S: resultis a * b
200 case MULT_F: resultis a .* b
201 case DIV_S: resultis a / b
202 case DIV_F: resultis a ./ b
203 case REM_S: resultis a rem b
204 case EQV_S: resultis a eqv b
205 case NEQV_S: resultis a neqv b
206 case LOGOR_S: resultis a logor b
207 case LOGAND_S: resultis a logand b
208
209 case LSHIFT_S: resultis a lshift b
210 case RSHIFT_S: resultis a rshift b
211 case EQ_S: resultis a = b
212 case EQ_F: resultis a .= b
213 case NE_S: resultis a ne b
214 case NE_F: resultis a .ne b
215 case LS_S: resultis a < b
216 case LS_F: resultis a .< b
217 case LE_S: resultis a le b
218 case LE_F: resultis a .le b
219 case GR_S: resultis a > b
220 case GR_F: resultis a .> b
221 case GE_S: resultis a ge b
222 case GE_F: resultis a .ge b
223 $)
224
225 let IsConst (x) = valof
226 $(
227 Top: switchon x!0 & Right into
228 $( case NAME_S:
229 resultis IsNameConst (Cellwithname (x))
230
231 case NUMBER_S:
232 case CHARCONST_S:
233 case CONSTANT_S:
234 case TRUE_S:
235 case FALSE_S:
236 resultis true
237
238 case POS_S: case POS_F:
239 case NEG_S: case NEG_F:
240 case NOT_S:
241 case REL_S:
242 x := x!1
243 goto Top
244
245 case PLUS_S: case PLUS_F:
246 case MINUS_S: case MINUS_F:
247 case MULT_S: case MULT_F:
248 case DIV_S: case DIV_F:
249 case REM_S:
250 case LOGOR_S:
251 case LOGAND_S:
252 case EQV_S:
253 case NEQV_S:
254 case LSHIFT_S:
255 case RSHIFT_S:
256 case EQ_S: case EQ_F:
257 case NE_S: case NE_F:
258 case LS_S: case LS_F:
259 case LE_S: case LE_F:
260 case GR_S: case GR_F:
261 case GE_S: case GE_F:
262 unless IsConst (x!1) resultis false
263 x := x!2
264 goto Top
265
266 case COND_S:
267 if IsConst (x!1) resultis IsConst (Evalconst (x!1) -> x!2, x!3)
268 resultis false
269
270 default: resultis false
271 $)
272 $)