· 9 years ago · Jan 23, 2017, 06:24 PM
1-: 0:Source:../../../racket/src/optimize.c
2 -: 0:Graph:optimize.gcno
3 -: 0:Data:optimize.gcda
4 -: 0:Runs:1115
5 -: 0:Programs:1
6 -: 1:/*
7 -: 2: Racket
8 -: 3: Copyright (c) 2004-2017 PLT Design Inc.
9 -: 4: Copyright (c) 1995-2001 Matthew Flatt
10 -: 5:
11 -: 6: This library is free software; you can redistribute it and/or
12 -: 7: modify it under the terms of the GNU Library General Public
13 -: 8: License as published by the Free Software Foundation; either
14 -: 9: version 2 of the License, or (at your option) any later version.
15 -: 10:
16 -: 11: This library is distributed in the hope that it will be useful,
17 -: 12: but WITHOUT ANY WARRANTY; without even the implied warranty of
18 -: 13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 -: 14: Library General Public License for more details.
20 -: 15:
21 -: 16: You should have received a copy of the GNU Library General Public
22 -: 17: License along with this library; if not, write to the Free
23 -: 18: Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 -: 19: Boston, MA 02110-1301 USA.
25 -: 20:
26 -: 21: libscheme
27 -: 22: Copyright (c) 1994 Brent Benson
28 -: 23: All rights reserved.
29 -: 24:*/
30 -: 25:
31 -: 26:/* This file implements bytecode optimization.
32 -: 27:
33 -: 28: See "eval.c" for an overview of compilation passes. */
34 -: 29:
35 -: 30:#include "schpriv.h"
36 -: 31:#include "schrunst.h"
37 -: 32:#include "schmach.h"
38 -: 33:
39 -: 34:/* Controls for inlining algorithm: */
40 -: 35:#define OPT_ESTIMATE_FUTURE_SIZES 1
41 -: 36:#define OPT_DISCOURAGE_EARLY_INLINE 1
42 -: 37:#define OPT_LIMIT_FUNCTION_RESIZE 0
43 -: 38:#define OPT_BRANCH_ADDS_NO_SIZE 1
44 -: 39:#define OPT_DELAY_GROUP_PROPAGATE 0
45 -: 40:#define OPT_PRE_OPTIMIZE_FOR_CROSS_MODULE(size_override) (size_override)
46 -: 41:
47 -: 42:#define MAX_PROC_INLINE_SIZE 256
48 -: 43:#define CROSS_MODULE_INLINE_SIZE 8
49 -: 44:
50 -: 45:/* Various kinds of fuel ensure that
51 -: 46: the compiler doesn't go into a loop
52 -: 47: or take non-linear time */
53 -: 48:#define INITIAL_INLINING_FUEL 32
54 -: 49:#define INITIAL_FLATTENING_FUEL 16
55 -: 50:
56 -: 51:/* Clasification for predicates.
57 -: 52: Each one implies the smaller. */
58 -: 53:#define RLV_IS_RELEVANT 1 /* The predicate is remembered by the optimizer */
59 -: 54:#define RLV_EQV_TESTEABLE 2 /* (equal? x <pred>) can be replaced by (eqv? x <pred>) */
60 -: 55:#define RLV_EQ_TESTEABLE 3 /* (equal? x <pred>) can be replaced by (eq? x <pred>) */
61 -: 56:#define RLV_SINGLETON 4 /* Recognizes a single value */
62 -: 57:
63 -: 58:struct Optimize_Info
64 -: 59:{
65 -: 60: MZTAG_IF_REQUIRED
66 -: 61: short flags;
67 -: 62: struct Optimize_Info *next;
68 -: 63: int original_frame, new_frame;
69 -: 64: Scheme_Object *consts;
70 -: 65: Comp_Prefix *cp;
71 -: 66: int init_kclock;
72 -: 67:
73 -: 68: /* Compilation context, used for unresolving for cross-module inlining: */
74 -: 69: Scheme_Env *env;
75 -: 70: Scheme_Object *insp;
76 -: 71:
77 -: 72: /* Propagated up and down the chain: */
78 -: 73: int size;
79 -: 74: int vclock; /* virtual clock that ticks for a side effect, a branch,
80 -: 75: observation of a side effect (such as an unbox),
81 -: 76: or a dependency on an earlier side effect (such as a
82 -: 77: previous guard on an unsafe operation's argument);
83 -: 78: the clock is only compared between binding sites and
84 -: 79: uses, so we can rewind the clock at a join after an
85 -: 80: increment that models a branch (if the branch is not
86 -: 81: taken or doesn't increment the clock) */
87 -: 82: int aclock; /* virtual clock that ticks for allocation without side effects,
88 -: 83: for constraining the reordering of operations that might
89 -: 84: capture a continuation */
90 -: 85: int kclock; /* virtual clock that ticks for a potential continuation capture,
91 -: 86: for constraining the movement of allocation operations */
92 -: 87: int sclock; /* virtual clock that ticks when space consumption is potentially observed */
93 -: 88: int psize;
94 -: 89: short inline_fuel, flatten_fuel;
95 -: 90: char letrec_not_twice, enforce_const, use_psize, has_nonleaf;
96 -: 91: Scheme_Hash_Table *top_level_consts;
97 -: 92:
98 -: 93: int maybe_values_argument; /* triggers an approximation for clock increments */
99 -: 94:
100 -: 95: /* Set by expression optimization: */
101 -: 96: int single_result, preserves_marks; /* negative means "tentative", due to fixpoint in progress */
102 -: 97: int escapes; /* flag to signal that the expression always escapes. When escapes is 1, it's assumed
103 -: 98: that single_result and preserves_marks are also 1, and that it's not necessary to
104 -: 99: use optimize_ignored before including the expression. */
105 -: 100:
106 -: 101: int lambda_depth; /* counts nesting depth under `lambda`s */
107 -: 102: int used_toplevel; /* tracks whether any non-local variables or syntax-object literals are used */
108 -: 103:
109 -: 104: Scheme_Hash_Table *uses; /* used variables, accumulated for closures */
110 -: 105:
111 -: 106: Scheme_IR_Local *transitive_use_var; /* set when optimizing a letrec-bound procedure
112 -: 107: to record variables that were added to `uses` */
113 -: 108:
114 -: 109: Scheme_Object *context; /* for logging */
115 -: 110: Scheme_Logger *logger;
116 -: 111: Scheme_Hash_Tree *types; /* maps position (from this frame) to predicate */
117 -: 112: int no_types; /* disables use of type info */
118 -: 113:};
119 -: 114:
120 -: 115:typedef struct Optimize_Info_Sequence {
121 -: 116: int init_flatten_fuel, min_flatten_fuel;
122 -: 117:} Optimize_Info_Sequence;
123 -: 118:
124 -: 119:static void merge_lambda_arg_types(Scheme_Lambda *lam1, Scheme_Lambda *lam2);
125 -: 120:static void check_lambda_arg_types_registered(Scheme_Lambda *lam, int app_count);
126 -: 121:static int lambda_body_size_plus_info(Scheme_Lambda *lam, int check_assign,
127 -: 122: Optimize_Info *info, int *is_leaf);
128 -: 123:static int lambda_has_top_level(Scheme_Lambda *lam);
129 -: 124:
130 -: 125:static Scheme_Object *make_sequence_2(Scheme_Object *a, Scheme_Object *b);
131 -: 126:
132 -: 127:static int wants_local_type_arguments(Scheme_Object *rator, int argpos);
133 -: 128:
134 -: 129:static void add_types_for_f_branch(Scheme_Object *t, Optimize_Info *info, int fuel);
135 -: 130:
136 -: 131:static void register_use(Scheme_IR_Local *var, Optimize_Info *info);
137 -: 132:static Scheme_Object *optimize_info_lookup(Scheme_Object *var);
138 -: 133:static Scheme_Object *optimize_info_propagate_local(Scheme_Object *var);
139 -: 134:static void optimize_info_used_top(Optimize_Info *info);
140 -: 135:static Scheme_Object *optimize_get_predicate(Optimize_Info *info, Scheme_Object *var, int ignore_no_types);
141 -: 136:static void add_type(Optimize_Info *info, Scheme_Object *var, Scheme_Object *pred);
142 -: 137:static void merge_types(Optimize_Info *src_info, Optimize_Info *info, Scheme_Hash_Tree *skip_vars);
143 -: 138:
144 -: 139:static Scheme_Object *expr_implies_predicate(Scheme_Object *expr, Optimize_Info *info);
145 -: 140:static Scheme_Object *do_expr_implies_predicate(Scheme_Object *expr, Optimize_Info *info,
146 -: 141: int *_involves_k_cross, int fuel,
147 -: 142: Scheme_Hash_Tree *ignore_vars);
148 -: 143:static int produces_local_type(Scheme_Object *rator, int argc);
149 -: 144:static int optimize_any_uses(Optimize_Info *info, Scheme_IR_Let_Value *at_irlv, int n);
150 -: 145:static void optimize_uses_of_mutable_imply_early_alloc(Scheme_IR_Let_Value *at_irlv, int n);
151 -: 146:static void propagate_used_variables(Optimize_Info *info);
152 -: 147:static int env_uses_toplevel(Optimize_Info *frame);
153 -: 148:static Scheme_IR_Local *clone_variable(Scheme_IR_Local *var);
154 -: 149:static void increment_use_count(Scheme_IR_Local *var, int as_rator);
155 -: 150:
156 -: 151:static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int current, int flags);
157 -: 152:static void optimize_info_done(Optimize_Info *info, Optimize_Info *parent);
158 -: 153:
159 -: 154:static void register_transitive_uses(Scheme_IR_Local *var, Optimize_Info *info);
160 -: 155:
161 -: 156:static void optimize_info_seq_init(Optimize_Info *info, Optimize_Info_Sequence *info_seq);
162 -: 157:static void optimize_info_seq_step(Optimize_Info *info, Optimize_Info_Sequence *info_seq);
163 -: 158:static void optimize_info_seq_done(Optimize_Info *info, Optimize_Info_Sequence *info_seq);
164 -: 159:
165 -: 160:static Scheme_Object *estimate_closure_size(Scheme_Object *e);
166 -: 161:static Scheme_Object *no_potential_size(Scheme_Object *value);
167 -: 162:
168 -: 163:static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, int context);
169 -: 164:
170 -: 165:static Scheme_Object *optimize_clone(int single_use, Scheme_Object *obj, Optimize_Info *info, Scheme_Hash_Tree *var_map, int as_rator);
171 -: 166:
172 -: 167:XFORM_NONGCING static int relevant_predicate(Scheme_Object *pred);
173 -: 168:XFORM_NONGCING static int predicate_implies(Scheme_Object *pred1, Scheme_Object *pred2);
174 -: 169:XFORM_NONGCING static int predicate_implies_not(Scheme_Object *pred1, Scheme_Object *pred2);
175 -: 170:static int single_valued_expression(Scheme_Object *expr, int fuel);
176 -: 171:static int single_valued_noncm_expression(Scheme_Object *expr, int fuel);
177 -: 172:static int noncm_expression(Scheme_Object *expr, int fuel);
178 -: 173:static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info,
179 -: 174: int expected_vals, int maybe_omittable,
180 -: 175: int fuel);
181 -: 176:static Scheme_Object *equivalent_exprs(Scheme_Object *a, Scheme_Object *b,
182 -: 177: Optimize_Info *a_info, Optimize_Info *b_info, int context);
183 -: 178:static int movable_expression(Scheme_Object *expr, Optimize_Info *info,
184 -: 179: int cross_lambda, int cross_k, int cross_s,
185 -: 180: int check_space, int fuel);
186 -: 181:Scheme_Object *optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
187 -: 182: Optimize_Info *info,
188 -: 183: int e_single_result,
189 -: 184: int context);
190 -: 185:
191 -: 186:#define SCHEME_LAMBDAP(vals_expr) (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_ir_lambda_type) \
192 -: 187: || SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type))
193 -: 188:
194 -: 189:#define SCHEME_WILL_BE_LAMBDAP(v) SAME_TYPE(SCHEME_TYPE(v), scheme_will_be_lambda_type)
195 -: 190:#define SCHEME_WILL_BE_LAMBDA_SIZE(v) SCHEME_PINT_VAL(v)
196 -: 191:#define SCHEME_WILL_BE_LAMBDA(v) SCHEME_IPTR_VAL(v)
197 -: 192:
198 -: 193:static int lambda_body_size(Scheme_Object *o, int less_args);
199 -: 194:
200 -: 195:typedef struct Scheme_Once_Used {
201 -: 196: Scheme_Object so;
202 -: 197: Scheme_Object *expr;
203 -: 198: Scheme_IR_Local *var;
204 -: 199: int vclock; /* record clocks at binding site */
205 -: 200: int aclock;
206 -: 201: int kclock;
207 -: 202: int sclock;
208 -: 203: int spans_k; /* potentially captures a continuation */
209 -: 204: int moved;
210 -: 205:} Scheme_Once_Used;
211 -: 206:
212 -: 207:static Scheme_Once_Used *make_once_used(Scheme_Object *val, Scheme_IR_Local *var,
213 -: 208: int vclock, int aclock, int kclock, int sclock, int spans_k);
214 -: 209:
215 -: 210:static ROSYM Scheme_Hash_Tree *empty_eq_hash_tree;
216 -: 211:
217 -: 212:#ifdef MZ_PRECISE_GC
218 -: 213:static void register_traversers(void);
219 -: 214:#endif
220 -: 215:
221 1115: 216:void scheme_init_optimize()
222 -: 217:{
223 1115: 218: REGISTER_SO(empty_eq_hash_tree);
224 1115: 219: empty_eq_hash_tree = scheme_make_hash_tree(SCHEME_hashtr_eq);
225 -: 220:
226 -: 221:#ifdef MZ_PRECISE_GC
227 -: 222: register_traversers();
228 -: 223:#endif
229 1115: 224:}
230 -: 225:
231 -: 226:/*========================================================================*/
232 -: 227:/* logging */
233 -: 228:/*========================================================================*/
234 -: 229:
235 1601244: 230:static void note_match(int actual, int expected, Optimize_Info *warn_info)
236 -: 231:{
237 1601244: 232: if (!warn_info || (expected == -1))
238 1433748: 233: return;
239 -: 234:
240 167496: 235: if (actual != expected) {
241 14: 236: scheme_log(warn_info->logger,
242 -: 237: SCHEME_LOG_WARNING,
243 -: 238: 0,
244 -: 239: "warning%s: %d values produced when %d expected",
245 -: 240: scheme_optimize_context_to_string(warn_info->context),
246 -: 241: actual, expected);
247 -: 242: }
248 -: 243:}
249 -: 244:
250 163032: 245:char *scheme_optimize_context_to_string(Scheme_Object *context)
251 -: 246:/* Convert a context to a string that is suitable for use in logging */
252 -: 247:{
253 163032: 248: if (context) {
254 -: 249: Scheme_Object *mod, *func;
255 -: 250: const char *ctx, *prefix, *mctx, *mprefix;
256 -: 251: char *all;
257 -: 252: int clen, plen, mclen, mplen, len;
258 -: 253:
259 147752: 254: if (SCHEME_PAIRP(context)) {
260 140586: 255: func = SCHEME_CAR(context);
261 140586: 256: mod = SCHEME_CDR(context);
262 7166: 257: } else if (SAME_TYPE(SCHEME_TYPE(context), scheme_module_type)) {
263 4699: 258: func = scheme_false;
264 4699: 259: mod = context;
265 -: 260: } else {
266 2467: 261: func = context;
267 2467: 262: mod = scheme_false;
268 -: 263: }
269 -: 264:
270 290804: 265: if (SAME_TYPE(SCHEME_TYPE(func), scheme_ir_lambda_type)) {
271 -: 266: Scheme_Object *name;
272 -: 267:
273 143053: 268: name = ((Scheme_Lambda *)func)->name;
274 143053: 269: if (name) {
275 281045: 270: if (SCHEME_VECTORP(name)) {
276 -: 271: Scheme_Object *port;
277 139205: 272: int print_width = 1024;
278 -: 273: intptr_t plen;
279 -: 274:
280 139205: 275: port = scheme_make_byte_string_output_port();
281 -: 276:
282 139205: 277: scheme_write_proc_context(port, print_width,
283 -: 278: SCHEME_VEC_ELS(name)[0],
284 -: 279: SCHEME_VEC_ELS(name)[1], SCHEME_VEC_ELS(name)[2],
285 -: 280: SCHEME_VEC_ELS(name)[3], SCHEME_VEC_ELS(name)[4],
286 139205: 281: SCHEME_TRUEP(SCHEME_VEC_ELS(name)[6]));
287 -: 282:
288 139204: 283: ctx = scheme_get_sized_byte_string_output(port, &plen);
289 139204: 284: prefix = " in: ";
290 -: 285: } else {
291 2636: 286: ctx = scheme_get_proc_name(func, &len, 0);
292 2636: 287: prefix = " in: ";
293 -: 288: }
294 -: 289: } else {
295 1212: 290: ctx = "";
296 1212: 291: prefix = "";
297 -: 292: }
298 -: 293: } else {
299 4699: 294: ctx = "";
300 4699: 295: prefix = "";
301 -: 296: }
302 -: 297:
303 147751: 298: if (SAME_TYPE(SCHEME_TYPE(mod), scheme_module_type)) {
304 144284: 299: mctx = scheme_display_to_string(((Scheme_Module *)mod)->modsrc, NULL);
305 144284: 300: mprefix = " in module: ";
306 -: 301: } else {
307 3467: 302: mctx = "";
308 3467: 303: mprefix = "";
309 -: 304: }
310 -: 305:
311 147751: 306: clen = strlen(ctx);
312 147751: 307: plen = strlen(prefix);
313 147751: 308: mclen = strlen(mctx);
314 147751: 309: mplen = strlen(mprefix);
315 -: 310:
316 147751: 311: if (!clen && !mclen)
317 1138: 312: return "";
318 -: 313:
319 146613: 314: all = scheme_malloc_atomic(clen + plen + mclen + mplen + 1);
320 146613: 315: memcpy(all, prefix, plen);
321 146613: 316: memcpy(all + plen, ctx, clen);
322 146613: 317: memcpy(all + plen + clen, mprefix, mplen);
323 146613: 318: memcpy(all + plen + clen + mplen, mctx, mclen);
324 146613: 319: all[clen + plen + mclen + mplen] = 0;
325 146613: 320: return all;
326 -: 321: } else
327 15280: 322: return "";
328 -: 323:}
329 -: 324:
330 110: 325:char *scheme_optimize_info_context(Optimize_Info *info)
331 -: 326:{
332 110: 327: return scheme_optimize_context_to_string(info->context);
333 -: 328:}
334 -: 329:
335 110: 330:Scheme_Logger *scheme_optimize_info_logger(Optimize_Info *info)
336 -: 331:{
337 110: 332: return info->logger;
338 -: 333:}
339 -: 334:
340 -: 335:/*========================================================================*/
341 -: 336:/* utils */
342 -: 337:/*========================================================================*/
343 -: 338:
344 465604: 339:static void set_optimize_mode(Scheme_IR_Local *var)
345 -: 340:{
346 -: 341: MZ_ASSERT(SAME_TYPE(var->so.type, scheme_ir_local_type));
347 465604: 342: memset(&var->optimize, 0, sizeof(var->optimize));
348 465604: 343: var->mode = SCHEME_VAR_MODE_OPTIMIZE;
349 465604: 344:}
350 -: 345:
351 -: 346:#define SCHEME_PRIM_IS_UNSAFE_NONMUTATING (SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL | SCHEME_PRIM_IS_UNSAFE_OMITABLE)
352 -: 347:
353 4462788: 348:int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals)
354 -: 349:/* A call to a functional, non-failing primitive (i.e., it accepts any argument)
355 -: 350: can be discarded if its results are ignored.
356 -: 351: Return 2 => true, and results are a constant when arguments are constants. */
357 -: 352:{
358 4462788: 353: if (SCHEME_PRIMP(rator)
359 3908317: 354: && (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE_ANY | SCHEME_PRIM_IS_UNSAFE_NONMUTATING))
360 1821012: 355: && (num_args >= ((Scheme_Primitive_Proc *)rator)->mina)
361 1821000: 356: && (num_args <= ((Scheme_Primitive_Proc *)rator)->mu.maxa)
362 1820968: 357: && ((expected_vals < 0)
363 1762943: 358: || ((expected_vals == 1) && !(SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_IS_MULTI_RESULT))
364 15549: 359: || (SAME_OBJ(scheme_values_proc, rator)
365 15549: 360: && (expected_vals == num_args)))) {
366 1820912: 361: if (SAME_OBJ(scheme_values_proc, rator))
367 46753: 362: return 2;
368 1774159: 363: return 1;
369 -: 364: } else
370 2641876: 365: return 0;
371 -: 366:}
372 -: 367:
373 1815686: 368:static Scheme_Object *get_struct_proc_shape(Scheme_Object *rator, Optimize_Info *info, int prop_ok)
374 -: 369:/* Determines whether `rator` is known to be a struct accessor, etc. */
375 -: 370:{
376 -: 371: Scheme_Object *c;
377 -: 372:
378 1815686: 373: if (info
379 1114842: 374: && (info->top_level_consts || info->cp->inline_variants)
380 962275: 375: && SAME_TYPE(SCHEME_TYPE(rator), scheme_ir_toplevel_type)) {
381 -: 376: int pos;
382 183153: 377: pos = SCHEME_TOPLEVEL_POS(rator);
383 183153: 378: c = NULL;
384 183153: 379: if (info->top_level_consts)
385 112064: 380: c = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos));
386 183153: 381: if (!c && info->cp->inline_variants)
387 146043: 382: c = scheme_hash_get(info->cp->inline_variants, scheme_make_integer(pos));
388 183153: 383: if (c && (SAME_TYPE(SCHEME_TYPE(c), scheme_struct_proc_shape_type)
389 16737: 384: || (prop_ok && SAME_TYPE(SCHEME_TYPE(c), scheme_struct_prop_proc_shape_type)))) {
390 27207: 385: return c;
391 -: 386: }
392 -: 387: }
393 -: 388:
394 1788479: 389: return NULL;
395 -: 390:}
396 -: 391:
397 485966: 392:int scheme_is_struct_functional(Scheme_Object *rator, int num_args, Optimize_Info *info, int vals)
398 -: 393:/* Determines whether `rator` is a functional, non-failing struct operation */
399 -: 394:{
400 -: 395: Scheme_Object *c;
401 -: 396:
402 485966: 397: if ((vals == 1) || (vals == -1)) {
403 483517: 398: c = get_struct_proc_shape(rator, info, 1);
404 483517: 399: if (c) {
405 2350: 400: if (SAME_TYPE(SCHEME_TYPE(c), scheme_struct_proc_shape_type)) {
406 1469: 401: int mode = (SCHEME_PROC_SHAPE_MODE(c) & STRUCT_PROC_SHAPE_MASK);
407 1469: 402: int field_count = (SCHEME_PROC_SHAPE_MODE(c) >> STRUCT_PROC_SHAPE_SHIFT);
408 1469: 403: if (((num_args == 1) && (mode == STRUCT_PROC_SHAPE_PRED))
409 1137: 404: || ((num_args == field_count) && (mode == STRUCT_PROC_SHAPE_CONSTR))) {
410 802: 405: return 1;
411 -: 406: }
412 214: 407: } else if (SAME_TYPE(SCHEME_TYPE(c), scheme_struct_prop_proc_shape_type)) {
413 214: 408: if ((SCHEME_PROP_PROC_SHAPE_MODE(c) == STRUCT_PROP_PROC_SHAPE_PRED)
414 191: 409: && (num_args == 1))
415 191: 410: return 1;
416 -: 411: }
417 -: 412: }
418 -: 413: }
419 -: 414:
420 484973: 415: return 0;
421 -: 416:}
422 -: 417:
423 6475674: 418:static Scheme_Object *extract_specialized_proc(Scheme_Object *le, Scheme_Object *default_val)
424 -: 419:/* Look through `(procedure-specialize <e>)` to get `<e>` */
425 -: 420:{
426 6475674: 421: if (SAME_TYPE(SCHEME_TYPE(le), scheme_application2_type)) {
427 110851: 422: Scheme_App2_Rec *app = (Scheme_App2_Rec *)le;
428 110851: 423: if (SAME_OBJ(app->rator, scheme_procedure_specialize_proc)) {
429 8: 424: if (SCHEME_PROCP(app->rand) || SCHEME_LAMBDAP(app->rand))
430 8: 425: return app->rand;
431 -: 426: }
432 -: 427: }
433 -: 428:
434 6475666: 429: return default_val;
435 -: 430:}
436 -: 431:
437 5160221: 432:int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags,
438 -: 433: Optimize_Info *opt_info, Optimize_Info *warn_info)
439 -: 434: /* Checks whether the bytecode `o` returns `vals` values with no
440 -: 435: side-effects and without pushing and using continuation marks.
441 -: 436: A -1 for `vals` means that any return count is ok.
442 -: 437: Also used with fully resolved expression by `module' to check
443 -: 438: for "functional" bodies, in which case `flags` includes
444 -: 439: `OMITTABLE_RESOLVED`.
445 -: 440: The `opt_info` argument is used only to access module-level
446 -: 441: information, not local bindings.
447 -: 442: If `warn_info` is supplied, complain when a mismatch is detected.
448 -: 443: We rely on the letrec-check pass to avoid omitting early references
449 -: 444: to letrec-bound variables, but `flags` can include `OMITTABLE_KEEP_VARS`
450 -: 445: to keep all variable references.
451 -: 446: If flags includes `OMITTABLE_KEEP_MUTABLE_VARS`, then references
452 -: 447: to mutable variables are kept, which allows this function to be
453 -: 448: a conservative approximation for "reorderable". */
454 -: 449:{
455 -: 450: Scheme_Type vtype;
456 -: 451:
457 -: 452: /* FIXME: can overflow the stack */
458 -: 453:
459 -: 454: try_again:
460 -: 455:
461 5160221: 456: vtype = SCHEME_TYPE(o);
462 -: 457:
463 5160221: 458: if ((vtype > _scheme_ir_values_types_)
464 4503511: 459: || ((vtype == scheme_ir_local_type)
465 107641: 460: && !(flags & OMITTABLE_KEEP_VARS)
466 100561: 461: && (!(flags & OMITTABLE_KEEP_MUTABLE_VARS)
467 #####: 462: || !SCHEME_VAR(o)->mutated))
468 4402950: 463: || ((vtype == scheme_local_type)
469 1838626: 464: && !(flags & OMITTABLE_KEEP_VARS)
470 1838626: 465: && !(SCHEME_GET_LOCAL_FLAGS(o) == SCHEME_LOCAL_CLEAR_ON_READ))
471 4228695: 466: || ((vtype == scheme_local_unbox_type)
472 2956: 467: && !(flags & (OMITTABLE_KEEP_VARS | OMITTABLE_KEEP_MUTABLE_VARS))
473 2956: 468: && !(SCHEME_GET_LOCAL_FLAGS(o) == SCHEME_LOCAL_CLEAR_ON_READ))
474 4225855: 469: || (vtype == scheme_lambda_type)
475 4103890: 470: || (vtype == scheme_ir_lambda_type)
476 4092107: 471: || (vtype == scheme_inline_variant_type)
477 4092107: 472: || (vtype == scheme_case_lambda_sequence_type)
478 4091481: 473: || (vtype == scheme_quote_syntax_type)
479 4091421: 474: || (vtype == scheme_varref_form_type)
480 4089020: 475: || (vtype == scheme_ir_quote_syntax_type)) {
481 1086486: 476: note_match(1, vals, warn_info);
482 1086486: 477: return ((vals == 1) || (vals < 0));
483 -: 478: }
484 -: 479:
485 4073735: 480: if (vtype == scheme_toplevel_type) {
486 159394: 481: note_match(1, vals, warn_info);
487 159394: 482: if (!(flags & OMITTABLE_KEEP_VARS) && (flags & OMITTABLE_RESOLVED) && ((vals == 1) || (vals < 0))) {
488 159394: 483: if (SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK)
489 154101: 484: return 1;
490 -: 485: else
491 5293: 486: return 0;
492 -: 487: }
493 -: 488: }
494 -: 489:
495 3914341: 490: if (vtype == scheme_ir_toplevel_type) {
496 7765: 491: note_match(1, vals, warn_info);
497 7765: 492: if ((vals == 1) || (vals < 0)) {
498 7765: 493: if (!(flags & OMITTABLE_KEEP_VARS)
499 4254: 494: && ((SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_READY))
500 4052: 495: return 1;
501 3713: 496: else if ((SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED)
502 1876: 497: return 1;
503 -: 498: else
504 1837: 499: return 0;
505 -: 500: }
506 -: 501: }
507 -: 502:
508 3906576: 503: if (vtype == scheme_branch_type) {
509 -: 504: Scheme_Branch_Rec *b;
510 411537: 505: b = (Scheme_Branch_Rec *)o;
511 823074: 506: return (scheme_omittable_expr(b->test, 1, fuel - 1, flags, opt_info, warn_info)
512 190307: 507: && scheme_omittable_expr(b->tbranch, vals, fuel - 1, flags, opt_info, warn_info)
513 498353: 508: && scheme_omittable_expr(b->fbranch, vals, fuel - 1, flags, opt_info, warn_info));
514 -: 509: }
515 -: 510:
516 3495039: 511: if (vtype == scheme_let_one_type) {
517 59478: 512: Scheme_Let_One *lo = (Scheme_Let_One *)o;
518 118956: 513: return (scheme_omittable_expr(lo->value, 1, fuel - 1, flags, opt_info, warn_info)
519 59478: 514: && scheme_omittable_expr(lo->body, vals, fuel - 1, flags, opt_info, warn_info));
520 -: 515: }
521 -: 516:
522 3435561: 517: if (vtype == scheme_let_void_type) {
523 726: 518: Scheme_Let_Void *lv = (Scheme_Let_Void *)o;
524 -: 519: /* recognize (letrec ([x <omittable>]) ...): */
525 -: 520: MZ_ASSERT(flags & OMITTABLE_RESOLVED);
526 1312: 521: if (SAME_TYPE(SCHEME_TYPE(lv->body), scheme_let_value_type)) {
527 586: 522: Scheme_Let_Value *lv2 = (Scheme_Let_Value *)lv->body;
528 586: 523: if ((lv2->count == 1)
529 28: 524: && (lv2->position == 0)
530 28: 525: && scheme_omittable_expr(lv2->value, 1, fuel - 1, flags, opt_info, warn_info)) {
531 #####: 526: o = lv2->body;
532 -: 527: } else
533 586: 528: o = lv->body;
534 -: 529: } else
535 140: 530: o = lv->body;
536 726: 531: goto try_again;
537 -: 532: }
538 -: 533:
539 3434835: 534: if (vtype == scheme_ir_let_header_type) {
540 -: 535: /* recognize another (let ([x <omittable>]) ...) pattern: */
541 12224: 536: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)o;
542 -: 537: int i;
543 -: 538: MZ_ASSERT(!(flags & OMITTABLE_RESOLVED));
544 12224: 539: o = lh->body;
545 18425: 540: for (i = 0; i < lh->num_clauses; i++) {
546 12996: 541: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)o;
547 12996: 542: if (!scheme_omittable_expr(lv->value, lv->count, fuel - 1, flags, opt_info, warn_info))
548 6795: 543: return 0;
549 6201: 544: o = lv->body;
550 -: 545: }
551 5429: 546: goto try_again;
552 -: 547: }
553 -: 548:
554 3422611: 549: if (vtype == scheme_letrec_type) {
555 -: 550: MZ_ASSERT(flags & OMITTABLE_RESOLVED);
556 140: 551: o = ((Scheme_Letrec *)o)->body;
557 140: 552: goto try_again;
558 -: 553: }
559 -: 554:
560 3422471: 555: if (vtype == scheme_application_type) {
561 166838: 556: Scheme_App_Rec *app = (Scheme_App_Rec *)o;
562 -: 557:
563 166838: 558: if ((app->num_args >= 4) && (app->num_args <= 11)
564 34795: 559: && SAME_OBJ(scheme_make_struct_type_proc, app->args[0])) {
565 1271: 560: note_match(5, vals, warn_info);
566 -: 561: }
567 -: 562:
568 166838: 563: if (scheme_is_functional_nonfailing_primitive(app->args[0], app->num_args, vals)
569 149441: 564: || scheme_is_struct_functional(app->args[0], app->num_args, opt_info, vals)
570 149115: 565: || ((SCHEME_APPN_FLAGS(app) & APPN_FLAG_OMITTABLE) && !(flags & OMITTABLE_IGNORE_APPN_OMIT))) {
571 -: 566: int i;
572 86134: 567: for (i = app->num_args; i--; ) {
573 52896: 568: if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, flags, opt_info, warn_info))
574 2442: 569: return 0;
575 -: 570: }
576 15398: 571: return 1;
577 148998: 572: } else if (SCHEME_PRIMP(app->args[0])) {
578 129592: 573: if (!(SCHEME_PRIM_PROC_FLAGS(app->args[0]) & SCHEME_PRIM_IS_MULTI_RESULT)) {
579 123909: 574: note_match(1, vals, warn_info);
580 5683: 575: } else if (SAME_OBJ(scheme_values_proc, app->args[0])) {
581 #####: 576: note_match(app->num_args, vals, warn_info);
582 -: 577: }
583 -: 578: }
584 -: 579:
585 148998: 580: if (!SAME_OBJ(scheme_make_struct_type_proc, app->args[0]))
586 147727: 581: return 0;
587 -: 582: }
588 -: 583:
589 3256904: 584: if (vtype == scheme_application2_type) {
590 524711: 585: Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
591 524711: 586: if (scheme_is_functional_nonfailing_primitive(app->rator, 1, vals)
592 240449: 587: || scheme_is_struct_functional(app->rator, 1, opt_info, vals)
593 239918: 588: || ((SCHEME_APPN_FLAGS(app) & APPN_FLAG_OMITTABLE) && !(flags & OMITTABLE_IGNORE_APPN_OMIT))) {
594 327902: 589: if (scheme_omittable_expr(app->rand, 1, fuel - 1, flags, opt_info, warn_info))
595 242476: 590: return 1;
596 239522: 591: } else if (SAME_OBJ(app->rator, scheme_make_vector_proc)
597 65: 592: && (vals == 1 || vals == -1)
598 65: 593: && (SCHEME_INTP(app->rand)
599 10: 594: && (SCHEME_INT_VAL(app->rand) >= 0))
600 2: 595: && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(app->rand))) {
601 2: 596: return 1;
602 239520: 597: } else if (SAME_OBJ(app->rator, scheme_procedure_specialize_proc)) {
603 2: 598: if ((vals == 1 || vals == -1) && extract_specialized_proc(o, NULL))
604 2: 599: return 1;
605 239518: 600: } else if (SCHEME_PRIMP(app->rator)) {
606 164505: 601: if (!(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT)
607 7860: 602: || SAME_OBJ(scheme_values_proc, app->rator)) {
608 156645: 603: note_match(1, vals, warn_info);
609 -: 604: }
610 -: 605: }
611 -: 606:
612 282231: 607: if (!SAME_OBJ(scheme_make_struct_type_property_proc, app->rator))
613 282139: 608: return 0;
614 -: 609: }
615 -: 610:
616 2732285: 611: if (vtype == scheme_application3_type) {
617 395191: 612: Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
618 395191: 613: if (scheme_is_functional_nonfailing_primitive(app->rator, 2, vals)
619 96076: 614: || scheme_is_struct_functional(app->rator, 2, opt_info, vals)
620 95940: 615: || ((SCHEME_APPN_FLAGS(app) & APPN_FLAG_OMITTABLE) && !(flags & OMITTABLE_IGNORE_APPN_OMIT))) {
621 346114: 616: if (scheme_omittable_expr(app->rand1, 1, fuel - 1, flags, opt_info, warn_info)
622 278952: 617: && scheme_omittable_expr(app->rand2, 1, fuel - 1, flags, opt_info, warn_info))
623 253316: 618: return 1;
624 95476: 619: } else if (SAME_OBJ(app->rator, scheme_make_vector_proc)
625 99: 620: && (vals == 1 || vals == -1)
626 99: 621: && (SCHEME_INTP(app->rand1)
627 19: 622: && (SCHEME_INT_VAL(app->rand1) >= 0)
628 19: 623: && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(app->rand1)))
629 19: 624: && scheme_omittable_expr(app->rand2, 1, fuel - 1, flags, opt_info, warn_info)) {
630 15: 625: return 1;
631 95461: 626: } else if (SCHEME_PRIMP(app->rator)) {
632 66841: 627: if (!(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT)) {
633 65726: 628: note_match(1, vals, warn_info);
634 1115: 629: } else if (SAME_OBJ(scheme_values_proc, app->rator)) {
635 48: 630: note_match(2, vals, warn_info);
636 -: 631: }
637 -: 632: }
638 -: 633:
639 141860: 634: if (!SAME_OBJ(scheme_make_struct_type_property_proc, app->rator))
640 141788: 635: return 0;
641 -: 636: }
642 -: 637:
643 -: 638: /* check for (set! x x) */
644 2337166: 639: if (vtype == scheme_set_bang_type) {
645 10831: 640: Scheme_Set_Bang *sb = (Scheme_Set_Bang *)o;
646 10831: 641: if (SAME_TYPE(scheme_local_type, SCHEME_TYPE(sb->var))
647 #####: 642: && SAME_TYPE(scheme_local_type, SCHEME_TYPE(sb->val))
648 #####: 643: && (SCHEME_LOCAL_POS(sb->var) == SCHEME_LOCAL_POS(sb->val)))
649 #####: 644: return 1;
650 10831: 645: else if (SAME_TYPE(scheme_ir_local_type, SCHEME_TYPE(sb->var))
651 3492: 646: && SAME_OBJ(sb->var, sb->val))
652 18: 647: return 1;
653 -: 648: }
654 -: 649:
655 -: 650: /* check for struct-type declaration: */
656 2337148: 651: if (!(flags & OMITTABLE_IGNORE_MAKE_STRUCT_TYPE)) {
657 -: 652: Scheme_Object *auto_e;
658 -: 653: int auto_e_depth;
659 4691500: 654: auto_e = scheme_is_simple_make_struct_type(o, vals,
660 2336303: 655: (((flags & OMITTABLE_RESOLVED) ? CHECK_STRUCT_TYPE_RESOLVED : 0)
661 -: 656: | CHECK_STRUCT_TYPE_ALWAYS_SUCCEED
662 -: 657: | CHECK_STRUCT_TYPE_DELAY_AUTO_CHECK),
663 -: 658: &auto_e_depth,
664 -: 659: NULL, NULL,
665 -: 660: (opt_info ? opt_info->top_level_consts : NULL),
666 18894: 661: ((opt_info && opt_info->cp) ? opt_info->cp->inline_variants : NULL),
667 -: 662: NULL, NULL, 0, NULL, NULL, NULL,
668 -: 663: 5);
669 2336303: 664: if (auto_e) {
670 406: 665: if (scheme_omittable_expr(auto_e, 1, fuel - 1, flags, opt_info, warn_info))
671 406: 666: return 1;
672 -: 667: }
673 -: 668: }
674 -: 669:
675 -: 670: /* check for struct-type property declaration: */
676 2336742: 671: if (!(flags & OMITTABLE_IGNORE_MAKE_STRUCT_TYPE)) {
677 4690284: 672: if (scheme_is_simple_make_struct_type_property(o, vals,
678 2335897: 673: (((flags & OMITTABLE_RESOLVED) ? CHECK_STRUCT_TYPE_RESOLVED : 0)
679 -: 674: | CHECK_STRUCT_TYPE_ALWAYS_SUCCEED),
680 -: 675: NULL,
681 -: 676: (opt_info ? opt_info->top_level_consts : NULL),
682 18490: 677: ((opt_info && opt_info->cp) ? opt_info->cp->inline_variants : NULL),
683 -: 678: NULL, NULL, 0, NULL, NULL,
684 -: 679: 5))
685 72: 680: return 1;
686 -: 681: }
687 -: 682:
688 2336670: 683: return 0;
689 -: 684:}
690 -: 685:
691 3778: 686:static Scheme_Object *ensure_single_value(Scheme_Object *e)
692 -: 687:/* Wrap `e` so that it either produces a single value or fails */
693 -: 688:{
694 -: 689: Scheme_App2_Rec *app2;
695 3778: 690: if (single_valued_expression(e, 5))
696 492: 691: return e;
697 -: 692:
698 3286: 693: app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec);
699 3286: 694: app2->iso.so.type = scheme_application2_type;
700 3286: 695: app2->rator = scheme_values_proc;
701 3286: 696: app2->rand = e;
702 3286: 697: SCHEME_APPN_FLAGS(app2) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
703 -: 698:
704 3286: 699: return (Scheme_Object *)app2;
705 -: 700:}
706 -: 701:
707 12377: 702:static Scheme_Object *ensure_single_value_noncm(Scheme_Object *e)
708 -: 703:/* Wrap `e` so that it either produces a single value or fails.
709 -: 704: Also, wrap `e` in case it may have a `with-continuation-mark`
710 -: 705: in tail position. */
711 -: 706:{
712 -: 707: Scheme_App2_Rec *app2;
713 12377: 708: if (single_valued_noncm_expression(e, 5))
714 11818: 709: return e;
715 -: 710:
716 559: 711: app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec);
717 559: 712: app2->iso.so.type = scheme_application2_type;
718 559: 713: app2->rator = scheme_values_proc;
719 559: 714: app2->rand = e;
720 559: 715: SCHEME_APPN_FLAGS(app2) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
721 -: 716:
722 559: 717: return (Scheme_Object *)app2;
723 -: 718:}
724 -: 719:
725 472: 720:static Scheme_Object *ensure_noncm(Scheme_Object *e)
726 -: 721:/* Wrap `e` in case it may have a `with-continuation-mark` form in tail
727 -: 722: position. This is useful when `e` escapes, and it is lifted and the
728 -: 723: surrounding is discarded, in which case the shift out of a nested
729 -: 724: position is observable. */
730 -: 725:{
731 -: 726: Scheme_Sequence *seq;
732 -: 727:
733 472: 728: if (noncm_expression(e, 5))
734 430: 729: return e;
735 -: 730:
736 42: 731: seq = scheme_malloc_sequence(1);
737 42: 732: seq->so.type = scheme_begin0_sequence_type;
738 42: 733: seq->count = 1;
739 42: 734: seq->array[0] = e;
740 -: 735:
741 42: 736: return (Scheme_Object *)seq;
742 -: 737:}
743 -: 738:
744 8745: 739:static Scheme_Object *do_make_discarding_sequence(Scheme_Object *e1, Scheme_Object *e2,
745 -: 740: Optimize_Info *info,
746 -: 741: int ignored, int rev)
747 -: 742:/* Evaluate `e1` then `e2` (or opposite order if rev), and each must
748 -: 743: produce a single value. The result of `e1` is ignored and the
749 -: 744: result is `e2` --- except that `e2` is ignored, too, if
750 -: 745: `ignored`. */
751 -: 746:{
752 8745: 747: if (ignored)
753 162: 748: e2 = optimize_ignored(e2, info, 1, 0, 5);
754 -: 749:
755 8745: 750: e2 = ensure_single_value_noncm(e2);
756 -: 751:
757 8745: 752: if (scheme_omittable_expr(e1, 1, 5, 0, info, NULL))
758 5181: 753: return e2;
759 -: 754:
760 3564: 755: e1 = ensure_single_value(optimize_ignored(e1, info, 1, 0, 5));
761 -: 756:
762 3564: 757: if (ignored && scheme_omittable_expr(e2, 1, 5, 0, info, NULL))
763 102: 758: return ensure_single_value_noncm(e1);
764 -: 759:
765 -: 760: /* use `begin` instead of `begin0` if we can swap the order: */
766 3462: 761: if (rev && movable_expression(e2, info, 0, 1, 1, 0, 50))
767 4: 762: rev = 0;
768 -: 763:
769 3462: 764: if (!rev && SAME_TYPE(SCHEME_TYPE(e1), scheme_sequence_type)) {
770 14: 765: Scheme_Sequence *seq = (Scheme_Sequence *)e1;
771 -: 766:
772 14: 767: if (SCHEME_TYPE(seq->array[seq->count - 1]) > _scheme_ir_values_types_) {
773 2: 768: seq->array[seq->count - 1] = e2;
774 2: 769: return e1;
775 -: 770: }
776 -: 771: }
777 -: 772:
778 3460: 773: return scheme_make_sequence_compilation(scheme_make_pair((rev ? e2 : e1),
779 -: 774: scheme_make_pair((rev ? e1 : e2), scheme_null)),
780 -: 775: rev ? -1 : 1,
781 -: 776: 0);
782 -: 777:}
783 -: 778:
784 8056: 779:static Scheme_Object *make_discarding_sequence(Scheme_Object *e1, Scheme_Object *e2,
785 -: 780: Optimize_Info *info)
786 -: 781:{
787 8056: 782: return do_make_discarding_sequence(e1, e2, info, 0, 0);
788 -: 783:}
789 -: 784:
790 527: 785:static Scheme_Object *make_discarding_reverse_sequence(Scheme_Object *e1, Scheme_Object *e2,
791 -: 786: Optimize_Info *info)
792 -: 787:{
793 527: 788: return do_make_discarding_sequence(e1, e2, info, 0, 1);
794 -: 789:}
795 -: 790:
796 251: 791:static Scheme_Object *make_discarding_sequence_3(Scheme_Object *e1, Scheme_Object *e2, Scheme_Object *e3,
797 -: 792: Optimize_Info *info)
798 -: 793:{
799 251: 794: return make_discarding_sequence(e1, make_discarding_sequence(e2, e3, info), info);
800 -: 795:}
801 -: 796:
802 28: 797:static Scheme_Object *make_discarding_app_sequence(Scheme_App_Rec *appr, int result_pos, Scheme_Object *result,
803 -: 798: Optimize_Info *info)
804 -: 799:/* Generalize do_make_discarding_sequence() to a sequence of argument
805 -: 800: expressions, where `result_pos` is the position of the returned
806 -: 801: argument. If `result_pos` is -1, then all argument results will be
807 -: 802: ignored. If `result`, then it is used as the result after all
808 -: 803: arguments are evaluated.*/
809 -: 804:{
810 -: 805: int i;
811 28: 806: Scheme_Object *l = scheme_null;
812 -: 807:
813 28: 808: result_pos = result_pos + 1;
814 28: 809: if (result)
815 #####: 810: l = scheme_make_pair(result, l);
816 -: 811:
817 120: 812: for (i = appr->num_args; i; i--) {
818 -: 813: Scheme_Object *e;
819 92: 814: e = appr->args[i];
820 92: 815: e = ensure_single_value(e);
821 92: 816: if (i == result_pos) {
822 4: 817: if (SCHEME_NULLP(l)) {
823 2: 818: e = ensure_single_value_noncm(e);
824 2: 819: l = scheme_make_pair(e, scheme_null);
825 -: 820: } else {
826 2: 821: l = scheme_make_sequence_compilation(scheme_make_pair(e, l), -1, 0);
827 2: 822: l = scheme_make_pair(l, scheme_null);
828 -: 823: }
829 -: 824: } else {
830 88: 825: e = optimize_ignored(e, info, 1, 1, 5);
831 88: 826: if (e)
832 36: 827: l = scheme_make_pair(e, l);
833 -: 828: }
834 -: 829: }
835 -: 830:
836 28: 831: if (SCHEME_NULLP(l))
837 #####: 832: return scheme_void;
838 -: 833:
839 28: 834: if (SCHEME_NULLP(SCHEME_CDR(l)))
840 22: 835: return SCHEME_CAR(l);
841 -: 836:
842 6: 837: return scheme_make_sequence_compilation(l, 1, 0);
843 -: 838:}
844 -: 839:
845 102271: 840:static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info,
846 -: 841: int expected_vals, int maybe_omittable,
847 -: 842: int fuel)
848 -: 843:/* Simplify an expression whose result will be ignored. The
849 -: 844: `expected_vals` is 1 or -1. If `maybe_omittable`, the result can be
850 -: 845: NULL to indicate that it can be omitted. */
851 -: 846:{
852 102271: 847: if (scheme_omittable_expr(e, expected_vals, 5, 0, info, NULL))
853 19527: 848: return maybe_omittable? NULL : scheme_false;
854 -: 849:
855 82744: 850: if (fuel) {
856 -: 851: /* We could do a lot more here, but for now, we just avoid purely
857 -: 852: functional, always successful operations --- especially allocating ones. */
858 81761: 853: switch (SCHEME_TYPE(e)) {
859 -: 854: case scheme_application2_type:
860 -: 855: {
861 19901: 856: Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
862 -: 857:
863 19901: 858: if (!SAME_OBJ(app->rator, scheme_values_proc)) /* `values` is probably here to ensure a single result */
864 17912: 859: if (scheme_is_functional_nonfailing_primitive(app->rator, 1, expected_vals))
865 42: 860: return do_make_discarding_sequence(app->rand, scheme_void, info, 1, 0);
866 -: 861:
867 -: 862: /* (make-vector <num>) => <void> */
868 19859: 863: if (SAME_OBJ(app->rator, scheme_make_vector_proc)
869 18: 864: && (SCHEME_INTP(app->rand)
870 2: 865: && (SCHEME_INT_VAL(app->rand) >= 0))
871 #####: 866: && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(app->rand)))
872 #####: 867: return (maybe_omittable ? NULL : scheme_void);
873 -: 868: }
874 19859: 869: break;
875 -: 870: case scheme_application3_type:
876 -: 871: {
877 8744: 872: Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
878 -: 873:
879 8744: 874: if (scheme_is_functional_nonfailing_primitive(app->rator, 2, expected_vals))
880 60: 875: return do_make_discarding_sequence(app->rand1,
881 -: 876: do_make_discarding_sequence(app->rand2,
882 -: 877: scheme_void,
883 -: 878: info,
884 -: 879: 1, 0),
885 -: 880: info,
886 -: 881: 1, 0);
887 -: 882:
888 -: 883: /* (make-vector <num> <expr>) => <expr> */
889 8684: 884: if (SAME_OBJ(app->rator, scheme_make_vector_proc)
890 14: 885: && (SCHEME_INTP(app->rand1)
891 2: 886: && (SCHEME_INT_VAL(app->rand1) >= 0))
892 2: 887: && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(app->rand1))) {
893 -: 888: Scheme_Object *val;
894 2: 889: val = ensure_single_value_noncm(app->rand2);
895 2: 890: return optimize_ignored(val, info, 1, maybe_omittable, 5);
896 -: 891: }
897 -: 892: }
898 8682: 893: break;
899 -: 894: case scheme_application_type:
900 -: 895: {
901 23030: 896: Scheme_App_Rec *app = (Scheme_App_Rec *)e;
902 -: 897:
903 23030: 898: if (scheme_is_functional_nonfailing_primitive(app->args[0], app->num_args, expected_vals))
904 24: 899: return make_discarding_app_sequence(app, -1, NULL, info);
905 -: 900: }
906 23006: 901: break;
907 -: 902: case scheme_branch_type:
908 -: 903: {
909 18723: 904: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)e;
910 -: 905: Scheme_Object *tb, *fb;
911 -: 906:
912 18723: 907: tb = optimize_ignored(b->tbranch, info, expected_vals, 1, fuel - 1);
913 18723: 908: fb = optimize_ignored(b->fbranch, info, expected_vals, 1, fuel - 1);
914 -: 909:
915 18723: 910: if (tb || fb) {
916 18715: 911: b->tbranch = tb ? tb : scheme_false;
917 18715: 912: b->fbranch = fb ? fb : scheme_false;
918 18715: 913: return (Scheme_Object*)b;
919 -: 914: } else {
920 -: 915: Scheme_Object *val;
921 8: 916: val = ensure_single_value_noncm(b->test);
922 8: 917: return optimize_ignored(val, info, 1, maybe_omittable, 5);
923 -: 918: }
924 -: 919: }
925 -: 920: break;
926 -: 921: case scheme_sequence_type:
927 -: 922: {
928 2828: 923: Scheme_Sequence *seq = (Scheme_Sequence *)e;
929 -: 924: Scheme_Object *last;
930 -: 925:
931 2828: 926: last = optimize_ignored(seq->array[seq->count - 1], info, expected_vals, 1, fuel - 1);
932 -: 927:
933 2828: 928: if (last) {
934 2649: 929: seq->array[seq->count - 1] = last;
935 2649: 930: return (Scheme_Object*)seq;
936 179: 931: } else if (seq->count == 2
937 137: 932: && (expected_vals == -1
938 41: 933: || single_valued_noncm_expression(seq->array[0], 5))) {
939 137: 934: return seq->array[0];
940 -: 935: } else {
941 42: 936: seq->array[seq->count - 1] = scheme_false;
942 42: 937: return (Scheme_Object*)seq;
943 -: 938: }
944 -: 939: }
945 -: 940: case scheme_begin0_sequence_type:
946 -: 941: {
947 8: 942: Scheme_Sequence *seq = (Scheme_Sequence *)e;
948 -: 943: Scheme_Object *first;
949 -: 944:
950 8: 945: first = optimize_ignored(seq->array[0], info, expected_vals, 1, fuel - 1);
951 -: 946:
952 8: 947: if (first) {
953 8: 948: seq->array[0] = first;
954 8: 949: return (Scheme_Object*)seq;
955 #####: 950: } else if (seq->count == 2
956 #####: 951: && (expected_vals == -1
957 #####: 952: || single_valued_noncm_expression(seq->array[1], 5))) {
958 #####: 953: return seq->array[1];
959 -: 954: } else {
960 #####: 955: seq->array[0] = scheme_false;
961 #####: 956: return (Scheme_Object*)seq;
962 -: 957: }
963 -: 958: }
964 -: 959: break;
965 -: 960: case scheme_ir_let_header_type:
966 -: 961: {
967 5348: 962: Scheme_IR_Let_Header *head = (Scheme_IR_Let_Header *)e;
968 -: 963: Scheme_IR_Let_Value *lv;
969 -: 964: Scheme_Object *body;
970 -: 965: int i;
971 -: 966:
972 5348: 967: body = head->body;
973 5348: 968: if (0 == head->num_clauses)
974 #####: 969: lv = (Scheme_IR_Let_Value *)body;
975 16513: 970: for (i = head->num_clauses; i--; ) {
976 5817: 971: lv = (Scheme_IR_Let_Value *)body;
977 5817: 972: body = lv->body;
978 -: 973: }
979 5348: 974: body = optimize_ignored(body, info, expected_vals, 0, fuel - 1);
980 5348: 975: lv->body = body;
981 5348: 976: return (Scheme_Object*)head;
982 -: 977: }
983 -: 978: break;
984 -: 979: }
985 -: 980: }
986 -: 981:
987 55709: 982: return e;
988 -: 983:}
989 -: 984:
990 95: 985:static Scheme_Object *make_sequence_2(Scheme_Object *a, Scheme_Object *b)
991 -: 986:{
992 95: 987: return scheme_make_sequence_compilation(scheme_make_pair(a, scheme_make_pair(b, scheme_null)), 1, 0);
993 -: 988:}
994 -: 989:
995 325: 990:static Scheme_Object *make_discarding_first_sequence(Scheme_Object *e1, Scheme_Object *e2,
996 -: 991: Optimize_Info *info)
997 -: 992:/* Like make_discarding_sequence(), but second expression is not constrained to
998 -: 993: a single result. */
999 -: 994:{
1000 325: 995: e1 = optimize_ignored(e1, info, 1, 1, 5);
1001 325: 996: if (!e1)
1002 231: 997: return e2;
1003 94: 998: e1 = ensure_single_value(e1);
1004 94: 999: return make_sequence_2(e1, e2);
1005 -: 1000:}
1006 -: 1001:
1007 641: 1002:static Scheme_Object *make_application_2(Scheme_Object *a, Scheme_Object *b, Optimize_Info *info)
1008 -: 1003:{
1009 641: 1004: return scheme_make_application(scheme_make_pair(a, scheme_make_pair(b, scheme_null)), info);
1010 -: 1005:}
1011 -: 1006:
1012 2388: 1007:static Scheme_Object *make_application_3(Scheme_Object *a, Scheme_Object *b, Scheme_Object *c,
1013 -: 1008: Optimize_Info *info)
1014 -: 1009:{
1015 2388: 1010: return scheme_make_application(scheme_make_pair(a, scheme_make_pair(b, scheme_make_pair(c, scheme_null))),
1016 -: 1011: info);
1017 -: 1012:}
1018 -: 1013:
1019 81768: 1014:static Scheme_Object *replace_tail_inside(Scheme_Object *alt, Scheme_Object *inside, Scheme_Object *orig)
1020 -: 1015:/* Installs a new expression in the result position of various forms, such as `begin`;
1021 -: 1016: extract_tail_inside() needs to be consistent with this function */
1022 -: 1017:{
1023 81768: 1018: if (inside) {
1024 6408: 1019: switch (SCHEME_TYPE(inside)) {
1025 -: 1020: case scheme_sequence_type:
1026 3217: 1021: if (((Scheme_Sequence *)inside)->count)
1027 3217: 1022: ((Scheme_Sequence *)inside)->array[((Scheme_Sequence *)inside)->count-1] = alt;
1028 -: 1023: else
1029 #####: 1024: scheme_signal_error("internal error: strange inside replacement");
1030 3217: 1025: break;
1031 -: 1026: case scheme_ir_let_header_type:
1032 #####: 1027: ((Scheme_IR_Let_Header *)inside)->body = alt;
1033 #####: 1028: break;
1034 -: 1029: case scheme_ir_let_value_type:
1035 3191: 1030: ((Scheme_IR_Let_Value *)inside)->body = alt;
1036 3191: 1031: break;
1037 -: 1032: default:
1038 #####: 1033: scheme_signal_error("internal error: strange inside replacement");
1039 -: 1034: }
1040 6408: 1035: return orig;
1041 -: 1036: }
1042 75360: 1037: return alt;
1043 -: 1038:}
1044 -: 1039:
1045 5342477: 1040:static void extract_tail_inside(Scheme_Object **_t2, Scheme_Object **_inside)
1046 -: 1041:/* Looks through various forms, like `begin` to extract a result expression;
1047 -: 1042: replace_tail_inside() needs to be consistent with this function */
1048 -: 1043:{
1049 -: 1044: while (1) {
1050 5354891: 1045: if (SAME_TYPE(SCHEME_TYPE(*_t2), scheme_ir_let_header_type)) {
1051 12414: 1046: Scheme_IR_Let_Header *head = (Scheme_IR_Let_Header *)*_t2;
1052 -: 1047: int i;
1053 12414: 1048: *_inside = *_t2;
1054 12414: 1049: *_t2 = head->body;
1055 37603: 1050: for (i = head->num_clauses; i--; ) {
1056 12775: 1051: *_inside = *_t2;
1057 12775: 1052: *_t2 = ((Scheme_IR_Let_Value *)*_t2)->body;
1058 -: 1053: }
1059 5330063: 1054: } else if (SAME_TYPE(SCHEME_TYPE(*_t2), scheme_sequence_type)) {
1060 3459: 1055: Scheme_Sequence *seq = (Scheme_Sequence *)*_t2;
1061 3459: 1056: if (seq->count) {
1062 3459: 1057: *_inside = *_t2;
1063 3459: 1058: *_t2 = seq->array[seq->count-1];
1064 -: 1059: } else
1065 #####: 1060: break;
1066 -: 1061: } else
1067 -: 1062: break;
1068 15873: 1063: }
1069 5326604: 1064:}
1070 -: 1065:
1071 339043: 1066:Scheme_Object *scheme_optimize_extract_tail_inside(Scheme_Object *t2)
1072 -: 1067:{
1073 -: 1068: Scheme_Object *inside;
1074 339043: 1069: extract_tail_inside(&t2, &inside);
1075 339043: 1070: return t2;
1076 -: 1071:}
1077 -: 1072:
1078 -: 1073:/*========================================================================*/
1079 -: 1074:/* detecting `make-struct-type` calls and struct shapes */
1080 -: 1075:/*========================================================================*/
1081 -: 1076:
1082 127267: 1077:static int is_inspector_call(Scheme_Object *a)
1083 -: 1078:/* Does `a` produce an inspector? */
1084 -: 1079:{
1085 127267: 1080: if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type)) {
1086 127075: 1081: Scheme_App_Rec *app = (Scheme_App_Rec *)a;
1087 127075: 1082: if (!app->num_args
1088 127075: 1083: && (SAME_OBJ(app->args[0], scheme_current_inspector_proc)
1089 #####: 1084: || SAME_OBJ(app->args[0], scheme_make_inspector_proc)))
1090 127075: 1085: return 1;
1091 -: 1086: }
1092 192: 1087: return 0;
1093 -: 1088:}
1094 -: 1089:
1095 39843: 1090:static int is_proc_spec_proc(Scheme_Object *p, int init_field_count)
1096 -: 1091:/* Does `p` produce a good `prop:procedure` value? */
1097 -: 1092:{
1098 -: 1093: Scheme_Type vtype;
1099 -: 1094:
1100 39843: 1095: if (SCHEME_INTP(p)
1101 21100: 1096: && (SCHEME_INT_VAL(p) >= 0)
1102 21100: 1097: && (SCHEME_INT_VAL(p) < init_field_count))
1103 21100: 1098: return 1;
1104 -: 1099:
1105 18743: 1100: if (SCHEME_PROCP(p)) {
1106 5618: 1101: p = scheme_get_or_check_arity(p, -1);
1107 5618: 1102: if (SCHEME_INTP(p)) {
1108 5618: 1103: return (SCHEME_INT_VAL(p) >= 1);
1109 #####: 1104: } else if (SCHEME_STRUCTP(p)
1110 #####: 1105: && scheme_is_struct_instance(scheme_arity_at_least, p)) {
1111 #####: 1106: p = ((Scheme_Structure *)p)->slots[0];
1112 #####: 1107: if (SCHEME_INTP(p))
1113 #####: 1108: return (SCHEME_INT_VAL(p) >= 1);
1114 -: 1109: }
1115 #####: 1110: return 0;
1116 -: 1111: }
1117 -: 1112:
1118 13125: 1113: vtype = SCHEME_TYPE(p);
1119 -: 1114:
1120 13125: 1115: if ((vtype == scheme_lambda_type) || (vtype == scheme_ir_lambda_type)) {
1121 1296: 1116: if (((Scheme_Lambda *)p)->num_params >= 1)
1122 1296: 1117: return 1;
1123 -: 1118: }
1124 -: 1119:
1125 11829: 1120: return 0;
1126 -: 1121:}
1127 -: 1122:
1128 374710: 1123:static int is_local_ref(Scheme_Object *e, int p, int r, Scheme_IR_Local **vars)
1129 -: 1124:/* Does `e` refer to...
1130 -: 1125: In resolved mode: variables at offet `p` though `p+r`?
1131 -: 1126: In optimizer IR mode: variables in `vars`? */
1132 -: 1127:{
1133 374710: 1128: if (!vars && SAME_TYPE(SCHEME_TYPE(e), scheme_local_type)) {
1134 267221: 1129: if ((SCHEME_LOCAL_POS(e) >= p)
1135 267200: 1130: && (SCHEME_LOCAL_POS(e) < (p + r)))
1136 267179: 1131: return 1;
1137 107510: 1132: } else if (vars && SAME_TYPE(SCHEME_TYPE(e), scheme_ir_local_type)) {
1138 -: 1133: int i;
1139 2085: 1134: for (i = p; i < p + r; i++) {
1140 2085: 1135: if (SAME_OBJ(e, (Scheme_Object *)vars[i]))
1141 2085: 1136: return 1;
1142 -: 1137: }
1143 -: 1138: }
1144 -: 1139:
1145 105446: 1140: return 0;
1146 -: 1141:}
1147 -: 1142:
1148 98727: 1143:static int is_int_list(Scheme_Object *o, int up_to)
1149 -: 1144:/* Is `o` a list of distinct integers that are less than `up_to`? */
1150 -: 1145:{
1151 98727: 1146: if (SCHEME_PAIRP(o)) {
1152 -: 1147: char *s, quick[8];
1153 -: 1148: Scheme_Object *e;
1154 87534: 1149: if (up_to <= 8)
1155 86188: 1150: s = quick;
1156 -: 1151: else
1157 1346: 1152: s = (char *)scheme_malloc_atomic(up_to);
1158 87534: 1153: memset(s, 0, up_to);
1159 405622: 1154: while (SCHEME_PAIRP(o)) {
1160 230554: 1155: e = SCHEME_CAR(o);
1161 230554: 1156: o = SCHEME_CDR(o);
1162 230554: 1157: if (!SCHEME_INTP(e)
1163 230554: 1158: || (SCHEME_INT_VAL(e) < 0)
1164 230554: 1159: || (SCHEME_INT_VAL(e) > up_to)
1165 230554: 1160: || s[SCHEME_INT_VAL(e)])
1166 #####: 1161: return 0;
1167 230554: 1162: s[SCHEME_INT_VAL(e)] = 1;
1168 -: 1163: }
1169 -: 1164: }
1170 -: 1165:
1171 98727: 1166: return SCHEME_NULLP(o);
1172 -: 1167:}
1173 -: 1168:
1174 105425: 1169:static int ok_proc_creator_args(Scheme_Object *rator, Scheme_Object *rand1, Scheme_Object *rand2, Scheme_Object *rand3,
1175 -: 1170: int delta2, int field_count, Scheme_IR_Local **vars)
1176 -: 1171:/* Does `rator` plus `rand1` and `rand2` create a struct accessor or mutator? */
1177 -: 1172:{
1178 105425: 1173: if ((SAME_OBJ(rator, scheme_make_struct_field_accessor_proc)
1179 103657: 1174: && is_local_ref(rand1, delta2+3, 1, vars))
1180 1768: 1175: || (SAME_OBJ(rator, scheme_make_struct_field_mutator_proc)
1181 1768: 1176: && is_local_ref(rand1, delta2+4, 1, vars))) {
1182 105425: 1177: if (SCHEME_INTP(rand2)
1183 105425: 1178: && (SCHEME_INT_VAL(rand2) >= 0)
1184 105425: 1179: && (SCHEME_INT_VAL(rand2) < field_count)
1185 105425: 1180: && (!rand3 || SCHEME_SYMBOLP(rand3))) {
1186 105425: 1181: return 1;
1187 -: 1182: }
1188 -: 1183: }
1189 -: 1184:
1190 #####: 1185: return 0;
1191 -: 1186:}
1192 -: 1187:
1193 55074: 1188:static int is_values_with_accessors_and_mutators(Scheme_Object *e, int vals, int resolved,
1194 -: 1189: Simple_Stuct_Type_Info *_stinfo,
1195 -: 1190: Scheme_IR_Local **vars)
1196 -: 1191:/* Does `e` produce values for a structure type, mutators, and accessors in the
1197 -: 1192: usual order? */
1198 -: 1193:{
1199 55074: 1194: if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
1200 54641: 1195: Scheme_App_Rec *app = (Scheme_App_Rec *)e;
1201 54641: 1196: int delta = (resolved ? app->num_args : 0);
1202 54641: 1197: if (SAME_OBJ(app->args[0], scheme_values_proc)
1203 54634: 1198: && (app->num_args == vals)
1204 54634: 1199: && (app->num_args >= 3)
1205 54634: 1200: && is_local_ref(app->args[1], delta, 1, vars)
1206 54613: 1201: && is_local_ref(app->args[2], delta+1, 1, vars)
1207 54613: 1202: && is_local_ref(app->args[3], delta+2, 1, vars)) {
1208 54613: 1203: int i, num_gets = 0, num_sets = 0, normal_ops = 1;
1209 160038: 1204: for (i = app->num_args; i > 3; i--) {
1210 105425: 1205: if (is_local_ref(app->args[i], delta, 5, vars)) {
1211 #####: 1206: normal_ops = 0;
1212 105425: 1207: } else if (SAME_TYPE(SCHEME_TYPE(app->args[i]), scheme_application_type)
1213 210834: 1208: && _stinfo->normal_ops && !_stinfo->indexed_ops) {
1214 105417: 1209: Scheme_App_Rec *app3 = (Scheme_App_Rec *)app->args[i];
1215 105417: 1210: int delta2 = delta + (resolved ? app3->num_args : 0);
1216 105417: 1211: if (app3->num_args == 3) {
1217 105417: 1212: if (!ok_proc_creator_args(app3->args[0], app3->args[1], app3->args[2], app3->args[3],
1218 -: 1213: delta2, _stinfo->field_count, vars))
1219 #####: 1214: break;
1220 105417: 1215: if (SAME_OBJ(app3->args[0], scheme_make_struct_field_mutator_proc)) {
1221 1768: 1216: if (num_gets) {
1222 -: 1217: /* Since we're alking backwards, it's not normal to hit a mutator
1223 -: 1218: after (i.e., before in argument order) a selector */
1224 #####: 1219: normal_ops = 0;
1225 -: 1220: }
1226 1768: 1221: num_sets++;
1227 -: 1222: } else {
1228 103649: 1223: if (SCHEME_INT_VAL(app3->args[2]) != (i - 4)) {
1229 -: 1224: /* selectors are not in the usual order */
1230 #####: 1225: normal_ops = 0;
1231 -: 1226: }
1232 103649: 1227: num_gets++;
1233 -: 1228: }
1234 -: 1229: } else
1235 #####: 1230: break;
1236 8: 1231: } else if (SAME_TYPE(SCHEME_TYPE(app->args[i]), scheme_application3_type)
1237 8: 1232: && _stinfo->normal_ops && !_stinfo->indexed_ops) {
1238 8: 1233: Scheme_App3_Rec *app3 = (Scheme_App3_Rec *)app->args[i];
1239 8: 1234: int delta2 = delta + (resolved ? 2 : 0);
1240 8: 1235: if (!ok_proc_creator_args(app3->rator, app3->rand1, app3->rand2, NULL,
1241 -: 1236: delta2, _stinfo->field_count, vars))
1242 #####: 1237: break;
1243 8: 1238: if (SAME_OBJ(app3->rator, scheme_make_struct_field_mutator_proc)) {
1244 #####: 1239: if (num_gets) normal_ops = 0;
1245 #####: 1240: num_sets++;
1246 -: 1241: } else {
1247 8: 1242: if (SCHEME_INT_VAL(app3->rand2) != (i - 4)) normal_ops = 0;
1248 8: 1243: num_gets++;
1249 -: 1244: }
1250 -: 1245: } else
1251 -: 1246: break;
1252 -: 1247: }
1253 54613: 1248: if (i <= 3) {
1254 54613: 1249: _stinfo->normal_ops = normal_ops;
1255 54613: 1250: _stinfo->indexed_ops = 1;
1256 54613: 1251: _stinfo->num_gets = num_gets;
1257 54613: 1252: _stinfo->num_sets = num_sets;
1258 54613: 1253: return 1;
1259 -: 1254: }
1260 -: 1255: }
1261 -: 1256: }
1262 -: 1257:
1263 461: 1258: return 0;
1264 -: 1259:}
1265 -: 1260:
1266 150459: 1261:static Scheme_Object *skip_clears(Scheme_Object *body)
1267 -: 1262:/* If `body` is a `begin` form that exists only to clear variables
1268 -: 1263: as installed by the SFS pass, then extract the result form. */
1269 -: 1264:{
1270 150459: 1265: if (SAME_TYPE(SCHEME_TYPE(body), scheme_sequence_type)) {
1271 49115: 1266: Scheme_Sequence *seq = (Scheme_Sequence *)body;
1272 -: 1267: int i;
1273 148196: 1268: for (i = seq->count - 1; i--; ) {
1274 49966: 1269: if (!SAME_TYPE(SCHEME_TYPE(seq->array[i]), scheme_local_type))
1275 -: 1270: break;
1276 -: 1271: }
1277 49115: 1272: if (i < 0)
1278 49115: 1273: return seq->array[seq->count-1];
1279 -: 1274: }
1280 101344: 1275: return body;
1281 -: 1276:}
1282 -: 1277:
1283 -: 1278:typedef int (*Ok_Value_Callback)(void *data, Scheme_Object *v, int mode);
1284 -: 1279:#define OK_CONSTANT_SHAPE 1
1285 -: 1280:#define OK_CONSTANT_ENCODED_SHAPE 2
1286 -: 1281:#define OK_CONSTANT_VALIDATE_SHAPE 3
1287 -: 1282:#define OK_CONSTANT_VARIANT 4
1288 -: 1283:#define OK_CONSTANT_VALUE 5
1289 -: 1284:
1290 120758: 1285:static int is_ok_value(Ok_Value_Callback ok_value, void *data,
1291 -: 1286: Scheme_Object *arg,
1292 -: 1287: Scheme_Hash_Table *top_level_consts,
1293 -: 1288: Scheme_Hash_Table *inline_variants,
1294 -: 1289: Scheme_Hash_Table *top_level_table,
1295 -: 1290: Scheme_Object **runstack, int rs_delta,
1296 -: 1291: Scheme_Object **symbols, Scheme_Hash_Table *symbol_table)
1297 -: 1292:/* Does `arg` produce a value that satisfies `ok_value`? */
1298 -: 1293:{
1299 -: 1294: int pos;
1300 -: 1295: Scheme_Object *v;
1301 -: 1296:
1302 120758: 1297: if (SAME_TYPE(SCHEME_TYPE(arg), scheme_ir_toplevel_type)) {
1303 632: 1298: pos = SCHEME_TOPLEVEL_POS(arg);
1304 673: 1299: if (top_level_consts || inline_variants) {
1305 -: 1300: /* This is optimize mode */
1306 627: 1301: v = NULL;
1307 627: 1302: if (top_level_consts)
1308 591: 1303: v = scheme_hash_get(top_level_consts, scheme_make_integer(pos));
1309 627: 1304: if (!v && inline_variants)
1310 187: 1305: v = scheme_hash_get(inline_variants, scheme_make_integer(pos));
1311 627: 1306: if (v)
1312 591: 1307: return ok_value(data, v, OK_CONSTANT_SHAPE);
1313 -: 1308: }
1314 120126: 1309: } else if (SAME_TYPE(SCHEME_TYPE(arg), scheme_toplevel_type)) {
1315 119512: 1310: pos = SCHEME_TOPLEVEL_POS(arg);
1316 119512: 1311: if (runstack) {
1317 -: 1312: /* This is eval mode; conceptually, this code belongs in
1318 -: 1313: define_execute_with_dynamic_state() */
1319 -: 1314: Scheme_Bucket *b;
1320 -: 1315: Scheme_Prefix *toplevels;
1321 79736: 1316: toplevels = (Scheme_Prefix *)runstack[SCHEME_TOPLEVEL_DEPTH(arg) - rs_delta];
1322 79736: 1317: b = (Scheme_Bucket *)toplevels->a[pos];
1323 79736: 1318: if (b->val && (((Scheme_Bucket_With_Flags *)b)->flags & GLOB_IS_CONSISTENT))
1324 69969: 1319: return ok_value(data, b->val, OK_CONSTANT_VALUE);
1325 -: 1320: }
1326 49543: 1321: if (symbols) {
1327 -: 1322: /* This is module-export mode; conceptually, this code belongs in
1328 -: 1323: setup_accessible_table() */
1329 -: 1324: Scheme_Object *name;
1330 17170: 1325: name = symbols[pos];
1331 17170: 1326: if (SCHEME_SYMBOLP(name)) {
1332 16343: 1327: v = scheme_hash_get(symbol_table, name);
1333 16343: 1328: if (v)
1334 16343: 1329: return ok_value(data, v, OK_CONSTANT_VARIANT);
1335 827: 1330: } else if (SAME_TYPE(SCHEME_TYPE(name), scheme_module_variable_type)) {
1336 827: 1331: if (((Module_Variable *)name)->shape)
1337 819: 1332: return ok_value(data, ((Module_Variable *)name)->shape, OK_CONSTANT_ENCODED_SHAPE);
1338 -: 1333: }
1339 -: 1334: }
1340 32381: 1335: if (top_level_table) {
1341 -: 1336: /* This is validate mode; conceptually, this code belongs in
1342 -: 1337: define_values_validate() */
1343 17065: 1338: v = scheme_hash_get(top_level_table, scheme_make_integer(pos));
1344 17065: 1339: if (v) {
1345 16799: 1340: return ok_value(data, v, OK_CONSTANT_VALIDATE_SHAPE);
1346 -: 1341: }
1347 -: 1342: }
1348 -: 1343: }
1349 -: 1344:
1350 16237: 1345: return 0;
1351 -: 1346:}
1352 -: 1347:
1353 104413: 1348:static int ok_constant_super_value(void *data, Scheme_Object *v, int mode)
1354 -: 1349:/* Is `v` a structure type (which can serve as a supertype)? */
1355 -: 1350:{
1356 104413: 1351: Scheme_Object **_parent_identity = (Scheme_Object **)data;
1357 -: 1352:
1358 104413: 1353: if (mode == OK_CONSTANT_SHAPE) {
1359 483: 1354: if (SAME_TYPE(SCHEME_TYPE(v), scheme_struct_proc_shape_type)) {
1360 483: 1355: int mode = (SCHEME_PROC_SHAPE_MODE(v) & STRUCT_PROC_SHAPE_MASK);
1361 483: 1356: int field_count = (SCHEME_PROC_SHAPE_MODE(v) >> STRUCT_PROC_SHAPE_SHIFT);
1362 483: 1357: if (mode == STRUCT_PROC_SHAPE_STRUCT) {
1363 483: 1358: if (_parent_identity)
1364 296: 1359: *_parent_identity = SCHEME_PROC_SHAPE_IDENTITY(v);
1365 483: 1360: return field_count + 1;
1366 -: 1361: }
1367 -: 1362: }
1368 103930: 1363: } else if (mode == OK_CONSTANT_ENCODED_SHAPE) {
1369 -: 1364: intptr_t k;
1370 819: 1365: if (scheme_decode_struct_shape(v, &k)) {
1371 742: 1366: if ((k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_STRUCT)
1372 742: 1367: return (k >> STRUCT_PROC_SHAPE_SHIFT) + 1;
1373 -: 1368: }
1374 103111: 1369: } else if (mode == OK_CONSTANT_VALIDATE_SHAPE) {
1375 16799: 1370: int k = SCHEME_INT_VAL(v);
1376 16799: 1371: if ((k >= 0)
1377 16799: 1372: && (k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_STRUCT)
1378 16799: 1373: return (k >> STRUCT_PROC_SHAPE_SHIFT) + 1;
1379 86312: 1374: } else if (mode == OK_CONSTANT_VARIANT) {
1380 16343: 1375: if (SCHEME_VECTORP(v) && (SCHEME_VEC_SIZE(v) == 3)) {
1381 16129: 1376: if (_parent_identity)
1382 16129: 1377: *_parent_identity = SCHEME_VEC_ELS(v)[2];
1383 16129: 1378: v = SCHEME_VEC_ELS(v)[1];
1384 16129: 1379: if (v && SCHEME_INTP(v)) {
1385 16129: 1380: int mode = (SCHEME_INT_VAL(v) & STRUCT_PROC_SHAPE_MASK);
1386 16129: 1381: int field_count = (SCHEME_INT_VAL(v) >> STRUCT_PROC_SHAPE_SHIFT);
1387 16129: 1382: if (mode == STRUCT_PROC_SHAPE_STRUCT)
1388 16129: 1383: return field_count + 1;
1389 -: 1384: }
1390 -: 1385: }
1391 69969: 1386: } else if (mode == OK_CONSTANT_VALUE) {
1392 69969: 1387: if (SCHEME_STRUCT_TYPEP(v)) {
1393 69969: 1388: Scheme_Struct_Type *st = (Scheme_Struct_Type *)v;
1394 69969: 1389: if (st->num_slots == st->num_islots)
1395 69969: 1390: return st->num_slots + 1;
1396 -: 1391: }
1397 -: 1392: }
1398 -: 1393:
1399 291: 1394: return 0;
1400 -: 1395:}
1401 -: 1396:
1402 120547: 1397:static int is_constant_super(Scheme_Object *arg,
1403 -: 1398: Scheme_Hash_Table *top_level_consts,
1404 -: 1399: Scheme_Hash_Table *inline_variants,
1405 -: 1400: Scheme_Hash_Table *top_level_table,
1406 -: 1401: Scheme_Object **runstack, int rs_delta,
1407 -: 1402: Scheme_Object **symbols, Scheme_Hash_Table *symbol_table,
1408 -: 1403: Scheme_Object **_parent_identity)
1409 -: 1404:/* Does `arg` produce another structure type (which can serve as a supertype)? */
1410 -: 1405:{
1411 120547: 1406: return is_ok_value(ok_constant_super_value, _parent_identity,
1412 -: 1407: arg,
1413 -: 1408: top_level_consts,
1414 -: 1409: inline_variants, top_level_table,
1415 -: 1410: runstack, rs_delta,
1416 -: 1411: symbols, symbol_table);
1417 -: 1412:}
1418 -: 1413:
1419 108: 1414:static int ok_constant_property_with_guard(void *data, Scheme_Object *v, int mode)
1420 -: 1415:{
1421 108: 1416: intptr_t k = 0;
1422 -: 1417:
1423 108: 1418: if (mode == OK_CONSTANT_SHAPE) {
1424 108: 1419: if (SAME_TYPE(SCHEME_TYPE(v), scheme_struct_prop_proc_shape_type)) {
1425 108: 1420: k = SCHEME_PROC_SHAPE_MODE(v);
1426 -: 1421: }
1427 #####: 1422: } else if (mode == OK_CONSTANT_ENCODED_SHAPE) {
1428 #####: 1423: if (!scheme_decode_struct_prop_shape(v, &k))
1429 #####: 1424: k = 0;
1430 #####: 1425: } else if (mode == OK_CONSTANT_VALIDATE_SHAPE) {
1431 #####: 1426: int k = SCHEME_INT_VAL(v);
1432 #####: 1427: if (k < 0)
1433 #####: 1428: k = -(k+1);
1434 -: 1429: else
1435 #####: 1430: k = 0;
1436 #####: 1431: } else if (mode == OK_CONSTANT_VARIANT) {
1437 #####: 1432: if (SCHEME_VECTORP(v) && (SCHEME_VEC_SIZE(v) == 4)) {
1438 #####: 1433: v = SCHEME_VEC_ELS(v)[1];
1439 #####: 1434: if (v && SCHEME_INTP(v))
1440 #####: 1435: k = SCHEME_INT_VAL(v);
1441 -: 1436: }
1442 #####: 1437: } else if (mode == OK_CONSTANT_VALUE) {
1443 #####: 1438: if (SAME_TYPE(SCHEME_TYPE(v), scheme_struct_property_type)) {
1444 #####: 1439: if (!((Scheme_Struct_Property *)v)->guard)
1445 #####: 1440: return 1;
1446 -: 1441: }
1447 -: 1442: }
1448 -: 1443:
1449 108: 1444: return (k == STRUCT_PROP_PROC_SHAPE_PROP);
1450 -: 1445:}
1451 -: 1446:
1452 211: 1447:static int is_struct_type_property_without_guard(Scheme_Object *arg,
1453 -: 1448: Scheme_Hash_Table *top_level_consts,
1454 -: 1449: Scheme_Hash_Table *inline_variants,
1455 -: 1450: Scheme_Hash_Table *top_level_table,
1456 -: 1451: Scheme_Object **runstack, int rs_delta,
1457 -: 1452: Scheme_Object **symbols, Scheme_Hash_Table *symbol_table)
1458 -: 1453:/* Does `arg` produce a structure type property that has no guard (so that any value is ok)? */
1459 -: 1454:{
1460 211: 1455: return is_ok_value(ok_constant_property_with_guard, NULL,
1461 -: 1456: arg,
1462 -: 1457: top_level_consts,
1463 -: 1458: inline_variants, top_level_table,
1464 -: 1459: runstack, rs_delta,
1465 -: 1460: symbols, symbol_table);
1466 -: 1461:}
1467 -: 1462:
1468 206: 1463:static int is_simple_property_list(Scheme_Object *a, int resolved,
1469 -: 1464: Scheme_Hash_Table *top_level_consts,
1470 -: 1465: Scheme_Hash_Table *inline_variants,
1471 -: 1466: Scheme_Hash_Table *top_level_table,
1472 -: 1467: Scheme_Object **runstack, int rs_delta,
1473 -: 1468: Scheme_Object **symbols, Scheme_Hash_Table *symbol_table)
1474 -: 1469:/* Does `a` produce a property list that always lets `make-struct-type` succeed? */
1475 -: 1470:{
1476 -: 1471: Scheme_Object *arg;
1477 -: 1472: int i, count;
1478 -: 1473:
1479 206: 1474: if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type)) {
1480 #####: 1475: if (!SAME_OBJ(((Scheme_App_Rec *)a)->args[0], scheme_list_proc))
1481 #####: 1476: return 0;
1482 #####: 1477: count = ((Scheme_App_Rec *)a)->num_args;
1483 206: 1478: } else if (SAME_TYPE(SCHEME_TYPE(a), scheme_application2_type)) {
1484 144: 1479: if (!SAME_OBJ(((Scheme_App2_Rec *)a)->rator, scheme_list_proc))
1485 #####: 1480: return 0;
1486 144: 1481: count = 1;
1487 62: 1482: } else if (SAME_TYPE(SCHEME_TYPE(a), scheme_application3_type)) {
1488 62: 1483: if (!SAME_OBJ(((Scheme_App3_Rec *)a)->rator, scheme_list_proc))
1489 #####: 1484: return 0;
1490 62: 1485: count = 2;
1491 -: 1486: } else
1492 #####: 1487: return 0;
1493 -: 1488:
1494 289: 1489: for (i = 0; i < count; i++) {
1495 211: 1490: if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type))
1496 #####: 1491: arg = ((Scheme_App_Rec *)a)->args[i+1];
1497 211: 1492: else if (SAME_TYPE(SCHEME_TYPE(a), scheme_application2_type))
1498 144: 1493: arg = ((Scheme_App2_Rec *)a)->rand;
1499 -: 1494: else {
1500 67: 1495: if (i == 0)
1501 62: 1496: arg = ((Scheme_App3_Rec *)a)->rand1;
1502 -: 1497: else
1503 5: 1498: arg = ((Scheme_App3_Rec *)a)->rand2;
1504 -: 1499: }
1505 -: 1500:
1506 294: 1501: if (SAME_TYPE(SCHEME_TYPE(arg), scheme_application3_type)) {
1507 211: 1502: Scheme_App3_Rec *a3 = (Scheme_App3_Rec *)arg;
1508 -: 1503:
1509 211: 1504: if (!SAME_OBJ(a3->rator, scheme_cons_proc))
1510 #####: 1505: return 0;
1511 211: 1506: if (is_struct_type_property_without_guard(a3->rand1,
1512 -: 1507: top_level_consts,
1513 -: 1508: inline_variants, top_level_table,
1514 -: 1509: runstack, rs_delta,
1515 -: 1510: symbols, symbol_table)) {
1516 83: 1511: if (!scheme_omittable_expr(a3->rand2, 1, 3, (resolved ? OMITTABLE_RESOLVED : 0), NULL, NULL))
1517 #####: 1512: return 0;
1518 -: 1513: } else
1519 128: 1514: return 0;
1520 -: 1515: } else
1521 #####: 1516: return 0;
1522 -: 1517: }
1523 -: 1518:
1524 78: 1519: return 1;
1525 -: 1520:}
1526 -: 1521:
1527 4034714: 1522:Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int flags,
1528 -: 1523: GC_CAN_IGNORE int *_auto_e_depth,
1529 -: 1524: Simple_Stuct_Type_Info *_stinfo,
1530 -: 1525: Scheme_Object **_parent_identity,
1531 -: 1526: Scheme_Hash_Table *top_level_consts,
1532 -: 1527: Scheme_Hash_Table *inline_variants,
1533 -: 1528: Scheme_Hash_Table *top_level_table,
1534 -: 1529: Scheme_Object **runstack, int rs_delta,
1535 -: 1530: Scheme_Object **symbols, Scheme_Hash_Table *symbol_table,
1536 -: 1531: Scheme_Object **_name,
1537 -: 1532: int fuel)
1538 -: 1533:/* Checks whether it's a `make-struct-type' call --- that, if `flags` includes
1539 -: 1534: `CHECK_STRUCT_TYPE_ALWAYS_SUCCEED`, certainly succeeds (i.e., no exception) ---
1540 -: 1535: pending a check of the auto-value argument if `flags` includes `CHECK_STRUCT_TYPE_DELAY_AUTO_CHECK`.
1541 -: 1536: The expression itself must have no side-effects except for errors (but the possibility
1542 -: 1537: of errors means that the expression is not necessarily omittable).
1543 -: 1538: The resulting *constructor* must always succeed (i.e., no guards).
1544 -: 1539: The result is the auto-value argument or scheme_true if it's simple, NULL if not.
1545 -: 1540: The first result of `e` will be a struct type, the second a constructor, and the third a predicate;
1546 -: 1541: the rest are selectors and mutators. */
1547 -: 1542:{
1548 4034714: 1543: int resolved = (flags & CHECK_STRUCT_TYPE_RESOLVED);
1549 -: 1544:
1550 4034714: 1545: if (!fuel) return NULL;
1551 -: 1546:
1552 4034714: 1547: if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
1553 367380: 1548: if ((vals == 5) || (vals < 0)) {
1554 272194: 1549: Scheme_App_Rec *app = (Scheme_App_Rec *)e;
1555 -: 1550:
1556 272194: 1551: if ((app->num_args >= 4) && (app->num_args <= 11)
1557 272194: 1552: && SAME_OBJ(scheme_make_struct_type_proc, app->args[0])) {
1558 -: 1553: int super_count_plus_one;
1559 -: 1554:
1560 272194: 1555: if (_parent_identity)
1561 44595: 1556: *_parent_identity = scheme_null;
1562 272194: 1557: if (!SCHEME_FALSEP(app->args[2]))
1563 120547: 1558: super_count_plus_one = is_constant_super(app->args[2],
1564 -: 1559: top_level_consts, inline_variants, top_level_table, runstack,
1565 120547: 1560: rs_delta + app->num_args,
1566 -: 1561: symbols, symbol_table, _parent_identity);
1567 -: 1562: else
1568 151647: 1563: super_count_plus_one = 0;
1569 -: 1564:
1570 272194: 1565: if (SCHEME_SYMBOLP(app->args[1])
1571 272173: 1566: && (SCHEME_FALSEP(app->args[2]) /* super */
1572 120547: 1567: || super_count_plus_one)
1573 255748: 1568: && SCHEME_INTP(app->args[3])
1574 255748: 1569: && (SCHEME_INT_VAL(app->args[3]) >= 0)
1575 255748: 1570: && SCHEME_INTP(app->args[4])
1576 255748: 1571: && (SCHEME_INT_VAL(app->args[4]) >= 0)
1577 255748: 1572: && ((app->num_args < 5)
1578 -: 1573: /* auto-field value: */
1579 251064: 1574: || (flags & CHECK_STRUCT_TYPE_DELAY_AUTO_CHECK)
1580 250539: 1575: || scheme_omittable_expr(app->args[5], 1, 3, (resolved ? OMITTABLE_RESOLVED : 0), NULL, NULL))
1581 255748: 1576: && ((app->num_args < 6)
1582 -: 1577: /* no properties... */
1583 240638: 1578: || SCHEME_NULLP(app->args[6])
1584 -: 1579: /* ... or properties that might make the `make-struct-type`
1585 -: 1580: call itself fail, but otherwise don't affect the constructor
1586 -: 1581: or selectors in a way that matters (although supplying the
1587 -: 1582: `prop:chaperone-unsafe-undefined` property can affect the
1588 -: 1583: constructor in an optimizer-irrelevant way) */
1589 164003: 1584: || (!(flags & CHECK_STRUCT_TYPE_ALWAYS_SUCCEED)
1590 163797: 1585: && scheme_omittable_expr(app->args[6], 1, 4, (resolved ? OMITTABLE_RESOLVED : 0), NULL, NULL))
1591 22158: 1586: || ((flags & CHECK_STRUCT_TYPE_ALWAYS_SUCCEED)
1592 206: 1587: && is_simple_property_list(app->args[6], resolved,
1593 -: 1588: top_level_consts, inline_variants,
1594 -: 1589: top_level_table,
1595 -: 1590: runstack, rs_delta,
1596 -: 1591: symbols, symbol_table)))
1597 233668: 1592: && ((app->num_args < 7)
1598 -: 1593: /* inspector: */
1599 138762: 1594: || SCHEME_FALSEP(app->args[7])
1600 132057: 1595: || (SCHEME_SYMBOLP(app->args[7])
1601 4790: 1596: && !strcmp("prefab", SCHEME_SYM_VAL(app->args[7]))
1602 4790: 1597: && !SCHEME_SYM_WEIRDP(app->args[7]))
1603 127267: 1598: || is_inspector_call(app->args[7]))
1604 233476: 1599: && ((app->num_args < 8)
1605 -: 1600: /* procedure property: */
1606 138570: 1601: || SCHEME_FALSEP(app->args[8])
1607 39843: 1602: || is_proc_spec_proc(app->args[8], SCHEME_INT_VAL(app->args[3])))
1608 221647: 1603: && ((app->num_args < 9)
1609 -: 1604: /* immutables: */
1610 98727: 1605: || is_int_list(app->args[9],
1611 98727: 1606: SCHEME_INT_VAL(app->args[3])))
1612 221613: 1607: && ((app->num_args < 10)
1613 -: 1608: /* guard: */
1614 77237: 1609: || SCHEME_FALSEP(app->args[10]))
1615 199740: 1610: && ((app->num_args < 11)
1616 -: 1611: /* constructor name: */
1617 55364: 1612: || SCHEME_FALSEP(app->args[11])
1618 55364: 1613: || SCHEME_SYMBOLP(app->args[11]))) {
1619 199740: 1614: if (_auto_e_depth)
1620 406: 1615: *_auto_e_depth = (resolved ? app->num_args : 0);
1621 199740: 1616: if (_name)
1622 35216: 1617: *_name = app->args[1];
1623 199740: 1618: if (_stinfo) {
1624 109199: 1619: int super_count = (super_count_plus_one
1625 -: 1620: ? (super_count_plus_one - 1)
1626 109199: 1621: : 0);
1627 109199: 1622: _stinfo->init_field_count = SCHEME_INT_VAL(app->args[3]) + super_count;
1628 218398: 1623: _stinfo->field_count = (SCHEME_INT_VAL(app->args[3])
1629 109199: 1624: + SCHEME_INT_VAL(app->args[4])
1630 -: 1625: + super_count);
1631 109199: 1626: _stinfo->uses_super = (super_count_plus_one ? 1 : 0);
1632 109199: 1627: _stinfo->super_field_count = (super_count_plus_one ? (super_count_plus_one - 1) : 0);
1633 109199: 1628: _stinfo->normal_ops = 1;
1634 109199: 1629: _stinfo->indexed_ops = 0;
1635 109199: 1630: _stinfo->num_gets = 1;
1636 109199: 1631: _stinfo->num_sets = 1;
1637 -: 1632: }
1638 199740: 1633: return ((app->num_args < 5) ? scheme_true : app->args[5]);
1639 -: 1634: }
1640 -: 1635: }
1641 -: 1636: }
1642 -: 1637: }
1643 -: 1638:
1644 3834974: 1639: if (SAME_TYPE(SCHEME_TYPE(e), scheme_ir_let_header_type)) {
1645 -: 1640: /* check for (let-values ([(: mk ? ref- set-!) (make-struct-type ...)]) (values ...))
1646 -: 1641: as generated by the expansion of `struct' */
1647 633: 1642: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)e;
1648 633: 1643: if ((lh->count == 5) && (lh->num_clauses == 1)) {
1649 597: 1644: if (SAME_TYPE(SCHEME_TYPE(lh->body), scheme_ir_let_value_type)) {
1650 597: 1645: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)lh->body;
1651 597: 1646: if (SAME_TYPE(SCHEME_TYPE(lv->value), scheme_application_type)) {
1652 -: 1647: Scheme_Object *auto_e;
1653 -: 1648: Simple_Stuct_Type_Info stinfo;
1654 597: 1649: if (!_stinfo) _stinfo = &stinfo;
1655 597: 1650: auto_e = scheme_is_simple_make_struct_type(lv->value, 5, flags,
1656 -: 1651: _auto_e_depth, _stinfo, _parent_identity,
1657 -: 1652: top_level_consts, inline_variants, top_level_table,
1658 -: 1653: runstack, rs_delta,
1659 -: 1654: symbols, symbol_table,
1660 -: 1655: _name,
1661 -: 1656: fuel-1);
1662 597: 1657: if (auto_e) {
1663 -: 1658: /* We have (let-values ([... (make-struct-type)]) ....), so make sure body
1664 -: 1659: just uses `make-struct-field-{accessor,mutator}'. */
1665 409: 1660: if (is_values_with_accessors_and_mutators(lv->body, vals, resolved, _stinfo, lv->vars)) {
1666 405: 1661: return auto_e;
1667 -: 1662: }
1668 -: 1663: }
1669 -: 1664: }
1670 -: 1665: }
1671 -: 1666: }
1672 -: 1667: }
1673 -: 1668:
1674 3834569: 1669: if (SAME_TYPE(SCHEME_TYPE(e), scheme_let_void_type)) {
1675 -: 1670: /* same thing, but in resolved form */
1676 96817: 1671: Scheme_Let_Void *lvd = (Scheme_Let_Void *)e;
1677 96817: 1672: if (lvd->count == 5) {
1678 95794: 1673: if (SAME_TYPE(SCHEME_TYPE(lvd->body), scheme_let_value_type)) {
1679 95794: 1674: Scheme_Let_Value *lv = (Scheme_Let_Value *)lvd->body;
1680 95794: 1675: if ((lv->position == 0) && (lv->count == 5)) {
1681 -: 1676: Scheme_Object *e2;
1682 95794: 1677: e2 = skip_clears(lv->value);
1683 95794: 1678: if (SAME_TYPE(SCHEME_TYPE(e2), scheme_application_type)) {
1684 -: 1679: Scheme_Object *auto_e;
1685 -: 1680: Simple_Stuct_Type_Info stinfo;
1686 95780: 1681: if (!_stinfo) _stinfo = &stinfo;
1687 191560: 1682: auto_e = scheme_is_simple_make_struct_type(e2, 5, flags,
1688 -: 1683: _auto_e_depth, _stinfo, _parent_identity,
1689 -: 1684: top_level_consts, inline_variants, top_level_table,
1690 95780: 1685: runstack, rs_delta + lvd->count,
1691 -: 1686: symbols, symbol_table,
1692 -: 1687: _name,
1693 -: 1688: fuel-1);
1694 95780: 1689: if (auto_e) {
1695 -: 1690: /* We have (let-values ([... (make-struct-type)]) ....), so make sure body
1696 -: 1691: just uses `make-struct-field-{accessor,mutator}'. */
1697 54665: 1692: e2 = skip_clears(lv->body);
1698 54665: 1693: if (is_values_with_accessors_and_mutators(e2, vals, resolved, _stinfo, NULL)) {
1699 54208: 1694: if (_auto_e_depth) *_auto_e_depth += lvd->count;
1700 54208: 1695: return auto_e;
1701 -: 1696: }
1702 -: 1697: }
1703 -: 1698: }
1704 -: 1699: }
1705 -: 1700: }
1706 -: 1701: }
1707 -: 1702: }
1708 -: 1703:
1709 3780361: 1704: return NULL;
1710 -: 1705:}
1711 -: 1706:
1712 3776771: 1707:int scheme_is_simple_make_struct_type_property(Scheme_Object *e, int vals, int flags,
1713 -: 1708: int *_has_guard,
1714 -: 1709: Scheme_Hash_Table *top_level_consts,
1715 -: 1710: Scheme_Hash_Table *inline_variants,
1716 -: 1711: Scheme_Hash_Table *top_level_table,
1717 -: 1712: Scheme_Object **runstack, int rs_delta,
1718 -: 1713: Scheme_Object **symbols, Scheme_Hash_Table *symbol_table,
1719 -: 1714: int fuel)
1720 -: 1715:/* Reports whether `app` is a call to `make-struct-type-property` to
1721 -: 1716: produce a propert with no guard. */
1722 -: 1717:{
1723 3776771: 1718: int resolved = (flags & CHECK_STRUCT_TYPE_RESOLVED);
1724 -: 1719:
1725 3776771: 1720: if ((vals != 3) && (vals >= 0)) return 0;
1726 -: 1721:
1727 2418491: 1722: if (SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
1728 31777: 1723: Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
1729 31777: 1724: if (SAME_OBJ(app->rator, scheme_make_struct_type_property_proc)) {
1730 30514: 1725: if (SCHEME_SYMBOLP(app->rand)) {
1731 30514: 1726: if (_has_guard) *_has_guard = 0;
1732 30514: 1727: return 1;
1733 -: 1728: }
1734 -: 1729: }
1735 -: 1730: }
1736 -: 1731:
1737 2387977: 1732: if (SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
1738 29349: 1733: Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
1739 29349: 1734: if (SAME_OBJ(app->rator, scheme_make_struct_type_property_proc)) {
1740 29328: 1735: if (SCHEME_SYMBOLP(app->rand1)
1741 29328: 1736: && (!(flags & CHECK_STRUCT_TYPE_ALWAYS_SUCCEED)
1742 34: 1737: || SCHEME_LAMBDAP(app->rand2))
1743 29319: 1738: && (scheme_omittable_expr(app->rator, 1, 4, (resolved ? OMITTABLE_RESOLVED : 0), NULL, NULL))) {
1744 29319: 1739: if (_has_guard) *_has_guard = 1;
1745 29319: 1740: return 1;
1746 -: 1741: }
1747 -: 1742: }
1748 -: 1743: }
1749 -: 1744:
1750 2358658: 1745: return 0;
1751 -: 1746:}
1752 -: 1747:
1753 -: 1748:/*========================================================================*/
1754 -: 1749:/* more utils */
1755 -: 1750:/*========================================================================*/
1756 -: 1751:
1757 342252: 1752:intptr_t scheme_get_struct_proc_shape(int k, Simple_Stuct_Type_Info *stinfo)
1758 -: 1753:{
1759 342252: 1754: switch (k) {
1760 -: 1755: case 0:
1761 69427: 1756: if (stinfo->field_count == stinfo->init_field_count)
1762 69411: 1757: return STRUCT_PROC_SHAPE_STRUCT | (stinfo->field_count << STRUCT_PROC_SHAPE_SHIFT);
1763 -: 1758: else
1764 16: 1759: return STRUCT_PROC_SHAPE_OTHER;
1765 -: 1760: break;
1766 -: 1761: case 1:
1767 69441: 1762: return STRUCT_PROC_SHAPE_CONSTR | (stinfo->init_field_count << STRUCT_PROC_SHAPE_SHIFT);
1768 -: 1763: break;
1769 -: 1764: case 2:
1770 69441: 1765: return STRUCT_PROC_SHAPE_PRED;
1771 -: 1766: break;
1772 -: 1767: default:
1773 133943: 1768: if (stinfo && stinfo->normal_ops && stinfo->indexed_ops) {
1774 32233: 1769: if (k - 3 < stinfo->num_gets) {
1775 -: 1770: /* record index of field */
1776 31735: 1771: return (STRUCT_PROC_SHAPE_GETTER
1777 31735: 1772: | ((stinfo->super_field_count + (k - 3)) << STRUCT_PROC_SHAPE_SHIFT));
1778 -: 1773: } else
1779 498: 1774: return (STRUCT_PROC_SHAPE_SETTER | (stinfo->field_count << STRUCT_PROC_SHAPE_SHIFT));
1780 -: 1775: }
1781 -: 1776: }
1782 -: 1777:
1783 101710: 1778: return STRUCT_PROC_SHAPE_OTHER;
1784 -: 1779:}
1785 -: 1780:
1786 14868: 1781:Scheme_Object *scheme_make_struct_proc_shape(intptr_t k, Scheme_Object *identity)
1787 -: 1782:{
1788 -: 1783: Scheme_Object *ps;
1789 -: 1784:
1790 14868: 1785: ps = scheme_malloc_small_tagged(sizeof(Scheme_Simple_Object));
1791 14868: 1786: ps->type = scheme_struct_proc_shape_type;
1792 14868: 1787: SCHEME_PROC_SHAPE_MODE(ps) = k;
1793 14868: 1788: SCHEME_PROC_SHAPE_IDENTITY(ps) = identity;
1794 -: 1789:
1795 14868: 1790: return ps;
1796 -: 1791:}
1797 -: 1792:
1798 73488: 1793:intptr_t scheme_get_struct_property_proc_shape(int k, int has_guard)
1799 -: 1794:{
1800 73488: 1795: switch (k) {
1801 -: 1796: case 0:
1802 24496: 1797: if (has_guard)
1803 13272: 1798: return STRUCT_PROP_PROC_SHAPE_GUARDED_PROP;
1804 -: 1799: else
1805 11224: 1800: return STRUCT_PROP_PROC_SHAPE_PROP;
1806 -: 1801: case 1:
1807 24496: 1802: return STRUCT_PROP_PROC_SHAPE_PRED;
1808 -: 1803: case 2:
1809 -: 1804: default:
1810 24496: 1805: return STRUCT_PROP_PROC_SHAPE_GETTER;
1811 -: 1806: }
1812 -: 1807:}
1813 -: 1808:
1814 528: 1809:Scheme_Object *scheme_make_struct_property_proc_shape(intptr_t k)
1815 -: 1810:{
1816 -: 1811: Scheme_Object *ps;
1817 -: 1812:
1818 528: 1813: ps = scheme_alloc_small_object();
1819 528: 1814: ps->type = scheme_struct_prop_proc_shape_type;
1820 528: 1815: SCHEME_PROP_PROC_SHAPE_MODE(ps) = k;
1821 -: 1816:
1822 528: 1817: return ps;
1823 -: 1818:}
1824 -: 1819:
1825 3249: 1820:XFORM_NONGCING static int is_struct_identity_subtype(Scheme_Object *sub, Scheme_Object *sup)
1826 -: 1821:{
1827 -: 1822: /* A structure identity is a list of symbols, but the symbols are
1828 -: 1823: just for debugging. Instead, the address of each pair forming the
1829 -: 1824: list represents an identiity. */
1830 7603: 1825: while (SCHEME_PAIRP(sub)) {
1831 3617: 1826: if (SAME_OBJ(sub, sup))
1832 2512: 1827: return 1;
1833 1105: 1828: sub = SCHEME_CDR(sub);
1834 -: 1829: }
1835 737: 1830: return 0;
1836 -: 1831:}
1837 -: 1832:
1838 11636: 1833:static int single_valued_noncm_function(Scheme_Object *rator, int num_args,
1839 -: 1834: int s_v, int non_cm)
1840 -: 1835:{
1841 11636: 1836: if (SCHEME_PRIMP(rator)) {
1842 -: 1837: int opt;
1843 5294: 1838: opt = ((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_OPT_MASK;
1844 5294: 1839: if (opt >= SCHEME_PRIM_OPT_NONCM)
1845 3566: 1840: return 1;
1846 -: 1841:
1847 1728: 1842: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_ALWAYS_ESCAPES)
1848 #####: 1843: return 1;
1849 -: 1844:
1850 -: 1845: /* special cases for values */
1851 1728: 1846: if (SAME_OBJ(rator, scheme_values_proc)) {
1852 129: 1847: if (s_v && (num_args != 1))
1853 10: 1848: return 0;
1854 119: 1849: return 1;
1855 -: 1850: }
1856 -: 1851: }
1857 -: 1852:
1858 7941: 1853: return 0;
1859 -: 1854:}
1860 -: 1855:
1861 21700: 1856:static int do_single_valued_noncm_expression(Scheme_Object *expr, int fuel, int s_v, int non_cm)
1862 -: 1857:/* Not necessarily omittable or copyable expression.
1863 -: 1858: If `s_v`, the expression must not be single-valued.
1864 -: 1859: If `non_cm`, the expression must be not sensitive to tail position. In particular,
1865 -: 1860: it has no with-continuation-mark in tail position, unless the body is omittable.
1866 -: 1861: The conservative answer is 0. */
1867 -: 1862:{
1868 21700: 1863: if (!s_v && !non_cm)
1869 #####: 1864: return 1;
1870 -: 1865:
1871 44083: 1866: while (fuel) {
1872 22289: 1867: switch (SCHEME_TYPE(expr)) {
1873 -: 1868: case scheme_ir_local_type:
1874 -: 1869: case scheme_local_type:
1875 -: 1870: case scheme_local_unbox_type:
1876 -: 1871: case scheme_ir_toplevel_type:
1877 519: 1872: return 1;
1878 -: 1873: break;
1879 -: 1874: case scheme_application_type:
1880 -: 1875: {
1881 606: 1876: Scheme_App_Rec *app = (Scheme_App_Rec *)expr;
1882 606: 1877: return single_valued_noncm_function(app->args[0], app->num_args, s_v, non_cm);
1883 -: 1878: }
1884 -: 1879: break;
1885 -: 1880: case scheme_application2_type:
1886 -: 1881: {
1887 8076: 1882: Scheme_App2_Rec *app = (Scheme_App2_Rec *)expr;
1888 8076: 1883: return single_valued_noncm_function(app->rator, 1, s_v, non_cm);
1889 -: 1884: }
1890 -: 1885: break;
1891 -: 1886: case scheme_application3_type:
1892 -: 1887: {
1893 2954: 1888: Scheme_App3_Rec *app = (Scheme_App3_Rec *)expr;
1894 2954: 1889: return single_valued_noncm_function(app->rator, 2, s_v, non_cm);
1895 -: 1890: }
1896 -: 1891: break;
1897 -: 1892: case scheme_branch_type:
1898 -: 1893: {
1899 471: 1894: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)expr;
1900 942: 1895: return (do_single_valued_noncm_expression(b->tbranch, fuel - 1, s_v, non_cm)
1901 471: 1896: && do_single_valued_noncm_expression(b->fbranch, fuel - 1, s_v, non_cm));
1902 -: 1897: }
1903 -: 1898: break;
1904 -: 1899: case scheme_ir_let_header_type:
1905 -: 1900: {
1906 270: 1901: Scheme_IR_Let_Header *hl = (Scheme_IR_Let_Header *)expr;
1907 270: 1902: expr = hl->body;
1908 -: 1903: }
1909 270: 1904: break;
1910 -: 1905: case scheme_ir_let_value_type:
1911 -: 1906: {
1912 275: 1907: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)expr;
1913 275: 1908: expr = lv->body;
1914 -: 1909: }
1915 275: 1910: break;
1916 -: 1911: case scheme_sequence_type:
1917 -: 1912: {
1918 134: 1913: Scheme_Sequence *seq = (Scheme_Sequence *)expr;
1919 134: 1914: expr = seq->array[seq->count-1];
1920 -: 1915: }
1921 134: 1916: break;
1922 -: 1917: case scheme_begin0_sequence_type:
1923 -: 1918: {
1924 #####: 1919: Scheme_Sequence *seq = (Scheme_Sequence *)expr;
1925 #####: 1920: expr = seq->array[0];
1926 -: 1921: }
1927 #####: 1922: break;
1928 -: 1923: case scheme_with_cont_mark_type:
1929 -: 1924: {
1930 99: 1925: Scheme_With_Continuation_Mark * wcm = (Scheme_With_Continuation_Mark *)expr;
1931 99: 1926: if (non_cm) {
1932 -: 1927: /* To avoid being sensitive to tail position, the body must not inspect
1933 -: 1928: the continuation at all. */
1934 95: 1929: return scheme_omittable_expr(wcm->body, s_v ? 1 : -1, 5, 0, NULL, NULL);
1935 -: 1930: } else {
1936 4: 1931: expr = wcm->body;
1937 -: 1932: }
1938 -: 1933: }
1939 4: 1934: break;
1940 -: 1935: case scheme_ir_lambda_type:
1941 -: 1936: case scheme_case_lambda_sequence_type:
1942 -: 1937: case scheme_set_bang_type:
1943 499: 1938: return 1;
1944 -: 1939: break;
1945 -: 1940: default:
1946 8386: 1941: if (SCHEME_TYPE(expr) > _scheme_ir_values_types_)
1947 8386: 1942: return 1;
1948 #####: 1943: break;
1949 -: 1944: }
1950 683: 1945: fuel--;
1951 -: 1946: }
1952 -: 1947:
1953 94: 1948: return 0;
1954 -: 1949:}
1955 -: 1950:
1956 16753: 1951:static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
1957 -: 1952:{
1958 16753: 1953: return do_single_valued_noncm_expression(expr, fuel, 1, 1);
1959 -: 1954:}
1960 -: 1955:
1961 3778: 1956:static int single_valued_expression(Scheme_Object *expr, int fuel)
1962 -: 1957:{
1963 3778: 1958: return do_single_valued_noncm_expression(expr, fuel, 1, 0);
1964 -: 1959:}
1965 -: 1960:
1966 472: 1961:static int noncm_expression(Scheme_Object *expr, int fuel)
1967 -: 1962:{
1968 472: 1963: return do_single_valued_noncm_expression(expr, fuel, 0, 1);
1969 -: 1964:}
1970 -: 1965:
1971 50501: 1966:static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda, int cross_k, Optimize_Info *info)
1972 -: 1967:/* Can we move a call to `rator` relative to other function calls?
1973 -: 1968: A -1 return means that the arguments must be movable without
1974 -: 1969: changing space complexity (which is the case for `cons`, for example). */
1975 -: 1970:{
1976 50501: 1971: if (rator && SCHEME_PRIMP(rator)) {
1977 42707: 1972: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL) {
1978 -: 1973: /* Although it's semantically ok to return -1 even when cross_lambda,
1979 -: 1974: doing so risks duplicating a computation if the relevant `lambda'
1980 -: 1975: is later inlined. */
1981 17176: 1976: if (cross_lambda) return 0;
1982 16575: 1977: if (cross_k
1983 9884: 1978: && !(SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_UNSAFE_NONALLOCATE)
1984 #####: 1979: && (produces_local_type(rator, n) != SCHEME_LOCAL_TYPE_FIXNUM)) {
1985 #####: 1980: return 0;
1986 -: 1981: }
1987 16575: 1982: return -1;
1988 -: 1983: }
1989 -: 1984: }
1990 -: 1985:
1991 33325: 1986: if (SAME_OBJ(scheme_void_proc, rator))
1992 #####: 1987: return -1;
1993 -: 1988:
1994 33325: 1989: if (!cross_lambda
1995 29911: 1990: && !cross_k /* because all calls below allocate */
1996 -: 1991: /* Note that none of these have space-safety issues, since they
1997 -: 1992: return values that contain all arguments: */
1998 12537: 1993: && (SAME_OBJ(scheme_list_proc, rator)
1999 12487: 1994: || (SAME_OBJ(scheme_cons_proc, rator) && (n == 2))
2000 12333: 1995: || (SAME_OBJ(scheme_mcons_proc, rator) && (n == 2))
2001 12329: 1996: || (SAME_OBJ(scheme_unsafe_cons_list_proc, rator) && (n == 2))
2002 12329: 1997: || SAME_OBJ(scheme_list_star_proc, rator)
2003 12325: 1998: || SAME_OBJ(scheme_vector_proc, rator)
2004 12319: 1999: || SAME_OBJ(scheme_vector_immutable_proc, rator)
2005 12319: 2000: || (SAME_OBJ(scheme_box_proc, rator) && (n == 1))
2006 12313: 2001: || (SAME_OBJ(scheme_box_immutable_proc, rator) && (n == 1))))
2007 226: 2002: return 1;
2008 -: 2003:
2009 33099: 2004: return 0;
2010 -: 2005:}
2011 -: 2006:
2012 97572: 2007:static int movable_expression(Scheme_Object *expr, Optimize_Info *info,
2013 -: 2008: int cross_lambda, int cross_k, int cross_s,
2014 -: 2009: int check_space, int fuel)
2015 -: 2010:/* A movable expression can't necessarily be constant-folded,
2016 -: 2011: but can be delayed because it has no side-effects (or is unsafe),
2017 -: 2012: produces a single value,
2018 -: 2013: and is not sensitive to being in tail position */
2019 -: 2014:{
2020 -: 2015: int can_move;
2021 -: 2016:
2022 97572: 2017: if (fuel < 0) return 0;
2023 -: 2018:
2024 97572: 2019: switch (SCHEME_TYPE(expr)) {
2025 -: 2020: case scheme_toplevel_type:
2026 #####: 2021: return ((SCHEME_TOPLEVEL_FLAGS(expr) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED);
2027 -: 2022: case scheme_ir_quote_syntax_type:
2028 14393: 2023: return 1;
2029 -: 2024: case scheme_ir_local_type:
2030 -: 2025: {
2031 -: 2026: /* Ok if not mutable */
2032 22285: 2027: if (!SCHEME_VAR(expr)->mutated) {
2033 22265: 2028: if (check_space) {
2034 10747: 2029: if (SCHEME_VAR(expr)->val_type)
2035 #####: 2030: return 1;
2036 -: 2031: /* the value of the identifier might be something that would
2037 -: 2032: retain significant memory, so we can't delay evaluation */
2038 10747: 2033: return 0;
2039 -: 2034: }
2040 11518: 2035: return 1;
2041 -: 2036: }
2042 -: 2037: }
2043 20: 2038: break;
2044 -: 2039: case scheme_application_type:
2045 2487: 2040: if (!cross_lambda
2046 1649: 2041: && !cross_k
2047 890: 2042: && (SCHEME_APPN_FLAGS((Scheme_App_Rec *)expr) & APPN_FLAG_OMITTABLE))
2048 1: 2043: can_move = -1;
2049 -: 2044: else
2050 2486: 2045: can_move = is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args,
2051 -: 2046: cross_lambda, cross_k, info);
2052 2487: 2047: if (can_move) {
2053 -: 2048: int i;
2054 137: 2049: for (i = ((Scheme_App_Rec *)expr)->num_args; i--; ) {
2055 84: 2050: if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info,
2056 -: 2051: cross_lambda, cross_k, cross_s,
2057 #####: 2052: check_space || (cross_s && (can_move < 0)), fuel - 1))
2058 15: 2053: return 0;
2059 -: 2054: }
2060 19: 2055: return 1;
2061 -: 2056: }
2062 2453: 2057: break;
2063 -: 2058: case scheme_application2_type:
2064 30604: 2059: if (!cross_lambda
2065 28209: 2060: && !cross_k
2066 11393: 2061: && (SCHEME_APPN_FLAGS((Scheme_App2_Rec *)expr) & APPN_FLAG_OMITTABLE))
2067 58: 2062: can_move = -1;
2068 -: 2063: else
2069 30546: 2064: can_move = is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1, cross_lambda, cross_k, info);
2070 30604: 2065: if (can_move) {
2071 21955: 2066: if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info,
2072 -: 2067: cross_lambda, cross_k, cross_s,
2073 8895: 2068: check_space || (cross_s && (can_move < 0)), fuel - 1))
2074 4157: 2069: return 1;
2075 -: 2070: }
2076 26447: 2071: break;
2077 -: 2072: case scheme_application3_type:
2078 17491: 2073: if (!cross_lambda
2079 16709: 2074: && !cross_k
2080 7026: 2075: && (SCHEME_APPN_FLAGS((Scheme_App3_Rec *)expr) & APPN_FLAG_OMITTABLE))
2081 22: 2076: can_move = -1;
2082 -: 2077: else
2083 17469: 2078: can_move = is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2, cross_lambda, cross_k, info);
2084 17491: 2079: if (can_move) {
2085 4895: 2080: if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info,
2086 -: 2081: cross_lambda, cross_k, cross_s,
2087 1103: 2082: check_space || (cross_s && (can_move < 0)), fuel - 1)
2088 2679: 2083: && movable_expression(((Scheme_App3_Rec *)expr)->rand2, info,
2089 -: 2084: cross_lambda, cross_k, cross_s,
2090 #####: 2085: check_space || (cross_s && (can_move < 0)), fuel - 1))
2091 2661: 2086: return 1;
2092 -: 2087: }
2093 14830: 2088: break;
2094 -: 2089: case scheme_branch_type:
2095 -: 2090: {
2096 5670: 2091: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)expr;
2097 5670: 2092: if (movable_expression(b->test, info, cross_lambda, cross_k, cross_s, check_space, fuel-1)
2098 -: 2093: /* Check space for branches if cross_s, because evaluating `if` eliminates one of them */
2099 4220: 2094: && movable_expression(b->tbranch, info, cross_lambda, cross_k, cross_s, check_space || cross_s, fuel-1)
2100 350: 2095: && movable_expression(b->fbranch, info, cross_lambda, cross_k, cross_s, check_space || cross_s, fuel-1))
2101 105: 2096: return 1;
2102 -: 2097: }
2103 5565: 2098: break;
2104 -: 2099: case scheme_ir_lambda_type:
2105 -: 2100: case scheme_case_lambda_sequence_type:
2106 -: 2101: /* Can't move across lambda or continuation if not closed, since
2107 -: 2102: that changes allocation of a closure. */
2108 206: 2103: return !cross_lambda && !cross_k;
2109 -: 2104: default:
2110 4436: 2105: if (SCHEME_TYPE(expr) > _scheme_ir_values_types_)
2111 3923: 2106: return 1;
2112 -: 2107: }
2113 -: 2108:
2114 49828: 2109: return 0;
2115 -: 2110:}
2116 -: 2111:
2117 8244: 2112:int scheme_is_ir_lambda(Scheme_Object *o, int can_be_closed, int can_be_liftable)
2118 -: 2113:{
2119 8244: 2114: if (SAME_TYPE(SCHEME_TYPE(o), scheme_ir_lambda_type)) {
2120 7708: 2115: if (!can_be_closed || !can_be_liftable) {
2121 -: 2116: Scheme_Lambda *lam;
2122 #####: 2117: lam = (Scheme_Lambda *)o;
2123 -: 2118: /* Because == 0 is like a constant */
2124 #####: 2119: if (!can_be_closed && !lam->closure_size)
2125 #####: 2120: return 0;
2126 -: 2121: /* Because procs that reference only globals are lifted: */
2127 #####: 2122: if (!can_be_liftable && (lam->closure_size == 1) && lambda_has_top_level(lam))
2128 #####: 2123: return 0;
2129 -: 2124: }
2130 7708: 2125: return 1;
2131 -: 2126: } else
2132 536: 2127: return 0;
2133 -: 2128:}
2134 -: 2129:
2135 413: 2130:XFORM_NONGCING static int small_inline_number(Scheme_Object *o)
2136 -: 2131:{
2137 413: 2132: if (SCHEME_BIGNUMP(o))
2138 #####: 2133: return SCHEME_BIGLEN(o) < 32;
2139 413: 2134: else if (SCHEME_COMPLEXP(o))
2140 #####: 2135: return (small_inline_number(scheme_complex_real_part(o))
2141 #####: 2136: && small_inline_number(scheme_complex_imaginary_part(o)));
2142 413: 2137: else if (SCHEME_RATIONALP(o))
2143 42: 2138: return (small_inline_number(scheme_rational_numerator(o))
2144 21: 2139: && small_inline_number(scheme_rational_denominator(o)));
2145 -: 2140: else
2146 392: 2141: return 1;
2147 -: 2142:}
2148 -: 2143:
2149 -: 2144:#define STR_INLINE_LIMIT 256
2150 -: 2145:
2151 1414072: 2146:int scheme_ir_duplicate_ok(Scheme_Object *fb, int cross_module)
2152 -: 2147:/* Is the constant a value that we can "copy" in the code? */
2153 -: 2148:{
2154 1414072: 2149: return (SCHEME_VOIDP(fb)
2155 1405852: 2150: || SAME_OBJ(fb, scheme_true)
2156 1388108: 2151: || SCHEME_FALSEP(fb)
2157 1338492: 2152: || (SCHEME_SYMBOLP(fb)
2158 14935: 2153: && (!cross_module || (!SCHEME_SYM_WEIRDP(fb)
2159 1857: 2154: && (SCHEME_SYM_LEN(fb) < STR_INLINE_LIMIT))))
2160 1323557: 2155: || (SCHEME_KEYWORDP(fb)
2161 656: 2156: && (!cross_module || (SCHEME_KEYWORD_LEN(fb) < STR_INLINE_LIMIT)))
2162 1322901: 2157: || SCHEME_EOFP(fb)
2163 1322815: 2158: || SCHEME_INTP(fb)
2164 1284487: 2159: || SCHEME_NULLP(fb)
2165 1268720: 2160: || (!cross_module && SAME_TYPE(SCHEME_TYPE(fb), scheme_ir_toplevel_type))
2166 1268711: 2161: || (!cross_module && SAME_TYPE(SCHEME_TYPE(fb), scheme_ir_local_type))
2167 1205457: 2162: || SCHEME_PRIMP(fb)
2168 -: 2163: /* Values that are hashed by the printer and/or interned on
2169 -: 2164: read to avoid duplication: */
2170 893490: 2165: || SCHEME_CHARP(fb)
2171 893213: 2166: || (SCHEME_CHAR_STRINGP(fb)
2172 24077: 2167: && (!cross_module || (SCHEME_CHAR_STRLEN_VAL(fb) < STR_INLINE_LIMIT)))
2173 869136: 2168: || (SCHEME_BYTE_STRINGP(fb)
2174 533: 2169: && (!cross_module || (SCHEME_BYTE_STRLEN_VAL(fb) < STR_INLINE_LIMIT)))
2175 868603: 2170: || SAME_TYPE(SCHEME_TYPE(fb), scheme_regexp_type)
2176 865852: 2171: || (SCHEME_NUMBERP(fb)
2177 1812: 2172: && (!cross_module || small_inline_number(fb)))
2178 2278112: 2173: || SAME_TYPE(SCHEME_TYPE(fb), scheme_ctype_type));
2179 -: 2174:}
2180 -: 2175:
2181 -: 2176:/*========================================================================*/
2182 -: 2177:/* applications, branches, sequences */
2183 -: 2178:/*========================================================================*/
2184 -: 2179:
2185 -: 2180:static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_Info *info, int context);
2186 -: 2181:static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimize_Info *info, int context);
2187 -: 2182:static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimize_Info *info, int context);
2188 -: 2183:
2189 115506: 2184:static Scheme_Object *try_optimize_fold(Scheme_Object *f, Scheme_Object *args, Scheme_Object *o, Optimize_Info *info)
2190 -: 2185:/* If `args` is NULL, extract arguments from `o` */
2191 -: 2186:{
2192 115506: 2187: if (scheme_is_foldable_prim(f)) {
2193 -: 2188:
2194 4475: 2189: if (!args) {
2195 4433: 2190: switch (SCHEME_TYPE(o)) {
2196 -: 2191: case scheme_application_type:
2197 -: 2192: {
2198 10: 2193: Scheme_App_Rec *app = (Scheme_App_Rec *)o;
2199 -: 2194: int i;
2200 -: 2195:
2201 10: 2196: args = scheme_null;
2202 38: 2197: for (i = app->num_args; i--; ) {
2203 18: 2198: args = scheme_make_pair(app->args[i + 1], args);
2204 -: 2199: }
2205 -: 2200: }
2206 10: 2201: break;
2207 -: 2202: case scheme_application2_type:
2208 -: 2203: {
2209 2540: 2204: Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
2210 2540: 2205: args = scheme_make_pair(app->rand, scheme_null);
2211 -: 2206: }
2212 2540: 2207: break;
2213 -: 2208: case scheme_application3_type:
2214 -: 2209: default:
2215 -: 2210: {
2216 1883: 2211: Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
2217 1883: 2212: args = scheme_make_pair(app->rand1,
2218 -: 2213: scheme_make_pair(app->rand2,
2219 -: 2214: scheme_null));
2220 -: 2215: }
2221 1883: 2216: break;
2222 -: 2217: }
2223 -: 2218: }
2224 -: 2219:
2225 4475: 2220: return scheme_try_apply(f, args, info);
2226 -: 2221: }
2227 -: 2222:
2228 111031: 2223: return NULL;
2229 -: 2224:}
2230 -: 2225:
2231 735091: 2226:static int estimate_expr_size(Scheme_Object *expr, int sz, int fuel)
2232 -: 2227:{
2233 -: 2228: Scheme_Type t;
2234 -: 2229:
2235 735091: 2230: if (sz > 128)
2236 9701: 2231: return sz;
2237 725390: 2232: if (fuel < 0)
2238 38: 2233: return sz + 128;
2239 -: 2234:
2240 725352: 2235: t = SCHEME_TYPE(expr);
2241 -: 2236:
2242 725352: 2237: switch(t) {
2243 -: 2238: case scheme_ir_local_type:
2244 -: 2239: {
2245 223491: 2240: sz += 1;
2246 223491: 2241: break;
2247 -: 2242: }
2248 -: 2243: case scheme_case_lambda_sequence_type:
2249 -: 2244: {
2250 267: 2245: int max_sz = sz + 1, a_sz;
2251 267: 2246: Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)expr;
2252 -: 2247: int i;
2253 1170: 2248: for (i = cl->count; i--; ) {
2254 636: 2249: a_sz = estimate_expr_size(cl->array[i], sz, fuel);
2255 636: 2250: if (a_sz > max_sz) max_sz = a_sz;
2256 -: 2251: }
2257 267: 2252: sz = max_sz;
2258 -: 2253: }
2259 267: 2254: break;
2260 -: 2255: case scheme_application2_type:
2261 -: 2256: {
2262 102231: 2257: Scheme_App2_Rec *app = (Scheme_App2_Rec *)expr;
2263 -: 2258:
2264 102231: 2259: sz = estimate_expr_size(app->rator, sz, fuel - 1);
2265 102231: 2260: sz = estimate_expr_size(app->rand, sz, fuel - 1);
2266 102231: 2261: sz++;
2267 -: 2262:
2268 102231: 2263: break;
2269 -: 2264: }
2270 -: 2265: case scheme_application_type:
2271 -: 2266: {
2272 24448: 2267: Scheme_App_Rec *app = (Scheme_App_Rec *)expr;
2273 -: 2268: int i;
2274 -: 2269:
2275 145892: 2270: for (i = app->num_args + 1; i--; ) {
2276 96996: 2271: sz = estimate_expr_size(app->args[i], sz, fuel - 1);
2277 -: 2272: }
2278 24448: 2273: sz++;
2279 -: 2274:
2280 24448: 2275: break;
2281 -: 2276: }
2282 -: 2277: case scheme_application3_type:
2283 -: 2278: {
2284 48129: 2279: Scheme_App3_Rec *app = (Scheme_App3_Rec *)expr;
2285 -: 2280:
2286 48129: 2281: sz = estimate_expr_size(app->rator, sz, fuel - 1);
2287 48129: 2282: sz = estimate_expr_size(app->rand1, sz, fuel - 1);
2288 48129: 2283: sz = estimate_expr_size(app->rand2, sz, fuel - 1);
2289 48129: 2284: sz++;
2290 -: 2285:
2291 48129: 2286: break;
2292 -: 2287: }
2293 -: 2288: case scheme_ir_let_header_type:
2294 -: 2289: {
2295 37760: 2290: Scheme_IR_Let_Header *head = (Scheme_IR_Let_Header *)expr;
2296 -: 2291: Scheme_Object *body;
2297 -: 2292: Scheme_IR_Let_Value *lv;
2298 -: 2293: int i;
2299 -: 2294:
2300 37760: 2295: body = head->body;
2301 121297: 2296: for (i = head->num_clauses; i--; ) {
2302 45777: 2297: lv = (Scheme_IR_Let_Value *)body;
2303 45777: 2298: sz = estimate_expr_size(lv->value, sz, fuel - 1);
2304 45777: 2299: body = lv->body;
2305 45777: 2300: sz++;
2306 -: 2301: }
2307 37760: 2302: sz = estimate_expr_size(body, sz, fuel - 1);
2308 37760: 2303: break;
2309 -: 2304: }
2310 -: 2305: case scheme_sequence_type:
2311 -: 2306: case scheme_begin0_sequence_type:
2312 -: 2307: {
2313 7407: 2308: Scheme_Sequence *seq = (Scheme_Sequence *)expr;
2314 -: 2309: int i;
2315 -: 2310:
2316 33002: 2311: for (i = seq->count; i--; ) {
2317 18188: 2312: sz = estimate_expr_size(seq->array[i], sz, fuel - 1);
2318 -: 2313: }
2319 -: 2314:
2320 7407: 2315: break;
2321 -: 2316: }
2322 -: 2317: case scheme_branch_type:
2323 -: 2318: {
2324 49211: 2319: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)expr;
2325 -: 2320:
2326 49211: 2321: sz = estimate_expr_size(b->test, sz, fuel - 1);
2327 49211: 2322: sz = estimate_expr_size(b->tbranch, sz, fuel - 1);
2328 49211: 2323: sz = estimate_expr_size(b->fbranch, sz, fuel - 1);
2329 49211: 2324: break;
2330 -: 2325: }
2331 -: 2326: case scheme_ir_lambda_type:
2332 -: 2327: {
2333 24204: 2328: sz = estimate_expr_size(((Scheme_Lambda *)expr)->body, sz, fuel - 1);
2334 24204: 2329: sz++;
2335 24204: 2330: break;
2336 -: 2331: }
2337 -: 2332: case scheme_ir_toplevel_type:
2338 -: 2333: case scheme_ir_quote_syntax_type:
2339 -: 2334: /* FIXME: other syntax types not covered */
2340 -: 2335: default:
2341 208204: 2336: sz += 1;
2342 208204: 2337: break;
2343 -: 2338: }
2344 -: 2339:
2345 725352: 2340: return sz;
2346 -: 2341:}
2347 -: 2342:
2348 15048: 2343:static Scheme_Object *estimate_closure_size(Scheme_Object *e)
2349 -: 2344:{
2350 -: 2345: Scheme_Object *wbl;
2351 -: 2346: int sz;
2352 15048: 2347: sz = estimate_expr_size(e, 0, 32);
2353 -: 2348:
2354 15048: 2349: wbl = scheme_alloc_object();
2355 15048: 2350: wbl->type = scheme_will_be_lambda_type;
2356 15048: 2351: SCHEME_WILL_BE_LAMBDA_SIZE(wbl) = sz;
2357 15048: 2352: SCHEME_WILL_BE_LAMBDA(wbl) = e;
2358 -: 2353:
2359 15048: 2354: return wbl;
2360 -: 2355:}
2361 -: 2356:
2362 189411: 2357:static Scheme_Object *no_potential_size(Scheme_Object *v)
2363 -: 2358:{
2364 189411: 2359: if (v && SCHEME_WILL_BE_LAMBDAP(v))
2365 9515: 2360: return NULL;
2366 -: 2361: else
2367 179896: 2362: return v;
2368 -: 2363:}
2369 -: 2364:
2370 56446: 2365:static Scheme_Object *apply_inlined(Scheme_Lambda *lam, Optimize_Info *info,
2371 -: 2366: int argc, Scheme_App_Rec *app, Scheme_App2_Rec *app2, Scheme_App3_Rec *app3,
2372 -: 2367: int context, Scheme_Object *orig, Scheme_Object *le_prev,
2373 -: 2368: int single_use)
2374 -: 2369:/* Optimize the body of `lam` given the known arguments in `app`, `app2`, or `app3` */
2375 -: 2370:{
2376 -: 2371: Scheme_IR_Let_Header *lh;
2377 56446: 2372: Scheme_IR_Let_Value *lv, *prev = NULL;
2378 -: 2373: Scheme_Object *val;
2379 -: 2374: int i, expected;
2380 -: 2375: Optimize_Info *sub_info;
2381 -: 2376: Scheme_IR_Local **vars;
2382 56446: 2377: Scheme_Object *p = lam->body;
2383 -: 2378:
2384 56446: 2379: expected = lam->num_params;
2385 -: 2380:
2386 56446: 2381: if (!expected) {
2387 -: 2382: /* No arguments, so no need for a `let` wrapper: */
2388 3007: 2383: sub_info = optimize_info_add_frame(info, 0, 0, 0);
2389 3007: 2384: if (!single_use || lam->ir_info->is_dup)
2390 2302: 2385: sub_info->inline_fuel >>= 1;
2391 3007: 2386: p = scheme_optimize_expr(p, sub_info, context);
2392 3007: 2387: info->single_result = sub_info->single_result;
2393 3007: 2388: info->preserves_marks = sub_info->preserves_marks;
2394 3007: 2389: optimize_info_done(sub_info, NULL);
2395 3007: 2390: merge_types(sub_info, info, NULL);
2396 -: 2391:
2397 3007: 2392: return replace_tail_inside(p, le_prev, orig);
2398 -: 2393: }
2399 -: 2394:
2400 53439: 2395: lh = MALLOC_ONE_TAGGED(Scheme_IR_Let_Header);
2401 53439: 2396: lh->iso.so.type = scheme_ir_let_header_type;
2402 53439: 2397: lh->count = expected;
2403 53439: 2398: lh->num_clauses = expected;
2404 -: 2399:
2405 164922: 2400: for (i = 0; i < expected; i++) {
2406 111483: 2401: lv = MALLOC_ONE_TAGGED(Scheme_IR_Let_Value);
2407 111483: 2402: lv->iso.so.type = scheme_ir_let_value_type;
2408 111483: 2403: lv->count = 1;
2409 -: 2404:
2410 111483: 2405: vars = MALLOC_N(Scheme_IR_Local*, 1);
2411 111483: 2406: vars[0] = lam->ir_info->vars[i];
2412 111483: 2407: lv->vars = vars;
2413 -: 2408:
2414 111483: 2409: if ((i == expected - 1)
2415 54319: 2410: && (SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_HAS_REST)) {
2416 -: 2411: int j;
2417 880: 2412: Scheme_Object *l = scheme_null;
2418 -: 2413:
2419 3827: 2414: for (j = argc; j-- > i; ) {
2420 2067: 2415: if (app)
2421 1813: 2416: val = app->args[j + 1];
2422 254: 2417: else if (app3)
2423 243: 2418: val = (j ? app3->rand2 : app3->rand1);
2424 11: 2419: else if (app2)
2425 11: 2420: val = app2->rand;
2426 -: 2421: else
2427 #####: 2422: val = scheme_false;
2428 -: 2423:
2429 2067: 2424: l = scheme_make_pair(val, l);
2430 -: 2425: }
2431 880: 2426: l = scheme_make_pair(scheme_list_proc, l);
2432 880: 2427: val = scheme_make_application(l, info);
2433 110603: 2428: } else if (app)
2434 40763: 2429: val = app->args[i + 1];
2435 69840: 2430: else if (app3)
2436 52553: 2431: val = (i ? app3->rand2 : app3->rand1);
2437 -: 2432: else
2438 17287: 2433: val = app2->rand;
2439 -: 2434:
2440 111483: 2435: lv->value = val;
2441 -: 2436:
2442 111483: 2437: if (prev)
2443 58044: 2438: prev->body = (Scheme_Object *)lv;
2444 -: 2439: else
2445 53439: 2440: lh->body = (Scheme_Object *)lv;
2446 111483: 2441: prev = lv;
2447 -: 2442: }
2448 -: 2443:
2449 53439: 2444: if (prev)
2450 53439: 2445: prev->body = p;
2451 -: 2446: else
2452 #####: 2447: lh->body = p;
2453 -: 2448:
2454 53439: 2449: sub_info = optimize_info_add_frame(info, 0, 0, 0);
2455 53439: 2450: if (!single_use || lam->ir_info->is_dup)
2456 52899: 2451: sub_info->inline_fuel >>= 1;
2457 -: 2452:
2458 53439: 2453: p = optimize_lets((Scheme_Object *)lh, sub_info, context);
2459 -: 2454:
2460 53439: 2455: info->single_result = sub_info->single_result;
2461 53439: 2456: info->preserves_marks = sub_info->preserves_marks;
2462 53439: 2457: optimize_info_done(sub_info, NULL);
2463 53439: 2458: merge_types(sub_info, info, NULL);
2464 -: 2459:
2465 53439: 2460: return replace_tail_inside(p, le_prev, orig);
2466 -: 2461:}
2467 -: 2462:
2468 1429673: 2463:int scheme_check_leaf_rator(Scheme_Object *le)
2469 -: 2464:{
2470 1429673: 2465: if (le && SCHEME_PRIMP(le)) {
2471 -: 2466: int opt;
2472 1310914: 2467: opt = ((Scheme_Prim_Proc_Header *)le)->flags & SCHEME_PRIM_OPT_MASK;
2473 1310914: 2468: if (opt >= SCHEME_PRIM_OPT_IMMEDIATE)
2474 1022939: 2469: return 1;
2475 -: 2470: }
2476 406734: 2471: return 0;
2477 -: 2472:}
2478 -: 2473:
2479 941968: 2474:int scheme_get_rator_flags(Scheme_Object *le)
2480 -: 2475:{
2481 941968: 2476: if (!le) {
2482 231188: 2477: return 0;
2483 789439: 2478: } else if (SCHEME_PRIMP(le)) {
2484 -: 2479: int opt;
2485 637475: 2480: opt = ((Scheme_Prim_Proc_Header *)le)->flags & SCHEME_PRIM_OPT_MASK;
2486 637475: 2481: if (opt >= SCHEME_PRIM_OPT_NONCM) {
2487 558816: 2482: return (LAMBDA_PRESERVES_MARKS | LAMBDA_SINGLE_RESULT);
2488 -: 2483: }
2489 73305: 2484: } else if (SAME_TYPE(SCHEME_TYPE(le), scheme_ir_lambda_type)) {
2490 72788: 2485: Scheme_Lambda *lam = (Scheme_Lambda *)le;
2491 72788: 2486: return SCHEME_LAMBDA_FLAGS(lam);
2492 -: 2487: }
2493 79176: 2488: return 0;
2494 -: 2489:}
2495 -: 2490:
2496 1309863: 2491:int check_single_use(Scheme_Object *var)
2497 -: 2492:{
2498 1309863: 2493: Scheme_IR_Local *v = SCHEME_VAR(var);
2499 -: 2494:
2500 2619726: 2495: return ((v->use_count == 1)
2501 -: 2496: /* If we're outside the binding, then the binding
2502 -: 2497: itself will remain as a used: */
2503 125162: 2498: && !v->optimize_outside_binding
2504 -: 2499: /* To help avoid infinite unrolling,
2505 -: 2500: don't count a self use as "single" use. */
2506 1434876: 2501: && !v->optimize_unready);
2507 -: 2502:}
2508 -: 2503:
2509 #####: 2504:int check_potential_size(Scheme_Object *var)
2510 -: 2505:{
2511 -: 2506: Scheme_Object* n;
2512 -: 2507:
2513 #####: 2508: n = SCHEME_VAR(var)->optimize.known_val;
2514 #####: 2509: if (n && SCHEME_WILL_BE_LAMBDAP(n)) {
2515 #####: 2510: return SCHEME_WILL_BE_LAMBDA_SIZE(n);
2516 -: 2511: }
2517 -: 2512:
2518 #####: 2513: return 0;
2519 -: 2514:}
2520 -: 2515:
2521 4202113: 2516:Scheme_Object *do_lookup_constant_proc(Optimize_Info *info, Scheme_Object *le,
2522 -: 2517: int argc, int for_inline, int *_single_use)
2523 -: 2518:/* Return a known procedure, if any.
2524 -: 2519: When argc == -1 it may return a case-lambda. Else, it will check the arity
2525 -: 2520: and split a case-lambda to extact the relevant lambda. If the arity is
2526 -: 2521: wrong the result is scheme_true.
2527 -: 2522: If for_inline, it may return a potential size. Else, itwill go inside
2528 -: 2523: potecial sizes, noinline procedures, lets, begins and other construction,
2529 -: 2524: so the result can't be inlined and must be used only to get the properties
2530 -: 2525: of the actual procedure.*/
2531 -: 2526:
2532 -: 2527:{
2533 4202113: 2528: Scheme_Object *prev = NULL;
2534 -: 2529:
2535 4202113: 2530: *_single_use = 0;
2536 -: 2531:
2537 -: 2532: /* Move inside `let' bindings to get the inner procedure */
2538 4202113: 2533: if (!for_inline)
2539 2248895: 2534: extract_tail_inside(&le, &prev);
2540 -: 2535:
2541 4202113: 2536: le = extract_specialized_proc(le, le);
2542 -: 2537:
2543 4202113: 2538: if (SCHEME_LAMBDAP(le)) {
2544 -: 2539: /* Found a `((lambda' */
2545 1001: 2540: *_single_use = 1;
2546 -: 2541: }
2547 -: 2542:
2548 4202113: 2543: if (SAME_TYPE(SCHEME_TYPE(le), scheme_ir_local_type)) {
2549 -: 2544: int tmp;
2550 1309863: 2545: tmp = check_single_use(le);
2551 1309863: 2546: *_single_use = tmp;
2552 1309863: 2547: if ((SCHEME_VAR(le)->mode != SCHEME_VAR_MODE_OPTIMIZE)) {
2553 -: 2548: /* We got a local that is bound in a let that is not yet optimized. */
2554 #####: 2549: return NULL;
2555 -: 2550: }
2556 1309863: 2551: le = SCHEME_VAR(le)->optimize.known_val;
2557 1309863: 2552: if (!le)
2558 1109635: 2553: return NULL;
2559 -: 2554: }
2560 -: 2555:
2561 6283215: 2556: while (SAME_TYPE(SCHEME_TYPE(le), scheme_ir_toplevel_type)) {
2562 -: 2557: int pos;
2563 805541: 2558: pos = SCHEME_TOPLEVEL_POS(le);
2564 805541: 2559: *_single_use = 0;
2565 805541: 2560: if (info->cp->inline_variants) {
2566 -: 2561: Scheme_Object *iv;
2567 507217: 2562: iv = scheme_hash_get(info->cp->inline_variants, scheme_make_integer(pos));
2568 507217: 2563: if (iv && SCHEME_TRUEP(iv)) {
2569 64022: 2564: Scheme_Hash_Table *iv_ht = NULL;
2570 64022: 2565: if (SCHEME_HASHTP(iv)) {
2571 10029: 2566: iv_ht = (Scheme_Hash_Table *)iv;
2572 10029: 2567: iv = scheme_hash_get(iv_ht, scheme_make_integer(argc));
2573 10029: 2568: if (!iv)
2574 303: 2569: iv = scheme_hash_get(iv_ht, scheme_false);
2575 -: 2570: }
2576 64022: 2571: if (SAME_TYPE(SCHEME_TYPE(iv), scheme_vector_type)) { /* inline variant + shift info */
2577 20427: 2572: int has_cases = 0;
2578 20427: 2573: Scheme_Object *orig_iv = iv;
2579 -: 2574: MZ_ASSERT(SAME_TYPE(scheme_inline_variant_type, SCHEME_TYPE(SCHEME_VEC_ELS(iv)[0])));
2580 -: 2575: /* unresolving may add new top-levels to `info->cp`: */
2581 40854: 2576: iv = scheme_unresolve(SCHEME_VEC_ELS(iv)[0], argc, &has_cases,
2582 20427: 2577: info->cp, info->env, info->insp, SCHEME_INT_VAL(SCHEME_VEC_ELS(iv)[3]),
2583 -: 2578: SCHEME_VEC_ELS(iv)[1], SCHEME_VEC_ELS(iv)[2]);
2584 20427: 2579: if (has_cases) {
2585 1372: 2580: if (!iv_ht) {
2586 1069: 2581: iv_ht = scheme_make_hash_table(SCHEME_hash_ptr);
2587 1069: 2582: scheme_hash_set(iv_ht, scheme_false, orig_iv);
2588 1069: 2583: scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), (Scheme_Object *)iv_ht);
2589 -: 2584: }
2590 1372: 2585: scheme_hash_set(iv_ht, scheme_make_integer(argc), iv ? iv : scheme_false);
2591 -: 2586: } else
2592 19055: 2587: scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), iv ? iv : scheme_false);
2593 -: 2588: }
2594 64022: 2589: if (iv && SCHEME_TRUEP(iv)) {
2595 61766: 2590: le = iv;
2596 61766: 2591: break;
2597 -: 2592: }
2598 -: 2593: }
2599 -: 2594: }
2600 743775: 2595: if (SAME_TYPE(SCHEME_TYPE(le), scheme_ir_toplevel_type) && info->top_level_consts) {
2601 285661: 2596: le = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos));
2602 285661: 2597: if (!le)
2603 187402: 2598: return NULL;
2604 -: 2599: } else
2605 -: 2600: break;
2606 -: 2601: }
2607 -: 2602:
2608 2905076: 2603: if (SCHEME_WILL_BE_LAMBDAP(le)) {
2609 95756: 2604: if (for_inline)
2610 39716: 2605: return le;
2611 -: 2606: else
2612 56040: 2607: le = SCHEME_WILL_BE_LAMBDA(le);
2613 -: 2608: }
2614 -: 2609:
2615 2865360: 2610: if (!for_inline && SAME_TYPE(scheme_noninline_proc_type, SCHEME_TYPE(le))) {
2616 3923: 2611: le = SCHEME_BOX_VAL(le);
2617 -: 2612: }
2618 -: 2613:
2619 -: 2614:
2620 2865360: 2615: if (SAME_TYPE(SCHEME_TYPE(le), scheme_case_lambda_sequence_type)) {
2621 2425: 2616: Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)le;
2622 -: 2617: Scheme_Object *cp;
2623 -: 2618: int i, count;
2624 -: 2619:
2625 2425: 2620: if (argc == -1)
2626 854: 2621: return le;
2627 -: 2622:
2628 1571: 2623: count = cl->count;
2629 2890: 2624: for (i = 0; i < count; i++) {
2630 2874: 2625: cp = cl->array[i];
2631 4193: 2626: if (SAME_TYPE(SCHEME_TYPE(cp), scheme_ir_lambda_type)) {
2632 2874: 2627: Scheme_Lambda *lam = (Scheme_Lambda *)cp;
2633 2874: 2628: if ((lam->num_params == argc)
2634 1375: 2629: || ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_HAS_REST)
2635 56: 2630: && (argc + 1 >= lam->num_params))) {
2636 1555: 2631: return cp;
2637 -: 2632: }
2638 -: 2633: } else {
2639 #####: 2634: scheme_signal_error("internal error: strange case-lambda");
2640 -: 2635: }
2641 -: 2636: }
2642 16: 2637: if (i >= count) {
2643 16: 2638: return scheme_true;
2644 -: 2639: }
2645 -: 2640: }
2646 -: 2641:
2647 2862935: 2642: if (SAME_TYPE(SCHEME_TYPE(le), scheme_ir_lambda_type)) {
2648 278894: 2643: Scheme_Lambda *lam = (Scheme_Lambda *)le;
2649 -: 2644:
2650 278894: 2645: if (argc == -1)
2651 47409: 2646: return le;
2652 -: 2647:
2653 231485: 2648: if ((lam->num_params == argc)
2654 2467: 2649: || ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_HAS_REST)
2655 2003: 2650: && (argc + 1 >= lam->num_params))) {
2656 231017: 2651: return le;
2657 -: 2652: } else {
2658 468: 2653: return scheme_true;
2659 -: 2654: }
2660 -: 2655: }
2661 -: 2656:
2662 2584041: 2657: if (SCHEME_PROCP(le)) {
2663 -: 2658: Scheme_Object *a[1];
2664 -: 2659:
2665 1926729: 2660: if (argc == -1)
2666 701: 2661: return le;
2667 -: 2662:
2668 1926028: 2663: a[0] = le;
2669 1926028: 2664: if (scheme_check_proc_arity(NULL, argc, 0, 1, a))
2670 1925049: 2665: return le;
2671 -: 2666: else
2672 979: 2667: return scheme_true;
2673 -: 2668: }
2674 -: 2669:
2675 657312: 2670: return NULL;
2676 -: 2671:}
2677 -: 2672:
2678 2248895: 2673:Scheme_Object *lookup_constant_proc(Optimize_Info *info, Scheme_Object *le, int argc)
2679 -: 2674:{
2680 2248895: 2675: int single_use = 0;
2681 2248895: 2676: return do_lookup_constant_proc(info, le, argc, 0, &single_use);
2682 -: 2677:}
2683 -: 2678:
2684 -: 2679:#if 0
2685 -: 2680:# define LOG_INLINE(x) x
2686 -: 2681:#else
2687 -: 2682:# define LOG_INLINE(x) /*empty*/
2688 -: 2683:#endif
2689 -: 2684:
2690 1953372: 2685:Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int argc,
2691 -: 2686: Scheme_App_Rec *app, Scheme_App2_Rec *app2, Scheme_App3_Rec *app3,
2692 -: 2687: int context, int optimized_rator)
2693 -: 2688:/* One of app, app2 and app3 should be non-NULL.
2694 -: 2689: If app, we're inlining a general application. If app2, we're inlining an
2695 -: 2690: application with a single argument and if app3, we're inlining an
2696 -: 2691: application with two arguments. */
2697 -: 2692:{
2698 1953372: 2693: int single_use = 0, psize = 0;
2699 1953372: 2694: Scheme_Object *prev = NULL, *orig_le = le, *le2;
2700 1953372: 2695: int already_opt = optimized_rator;
2701 -: 2696:
2702 1953372: 2697: if ((info->inline_fuel < 0) && info->has_nonleaf)
2703 124: 2698: return NULL;
2704 -: 2699:
2705 -: 2700: /* Move inside `let' bindings, so we can convert ((let (....) proc) arg ...)
2706 -: 2701: to (let (....) (proc arg ...)) */
2707 1953248: 2702: if (already_opt)
2708 948508: 2703: extract_tail_inside(&le, &prev);
2709 -: 2704:
2710 1953248: 2705: le = extract_specialized_proc(le, le);
2711 -: 2706:
2712 1953248: 2707: if (!already_opt
2713 1004740: 2708: && SCHEME_LAMBDAP(le)) {
2714 -: 2709: /* We have an immediate `lambda' that wasn't optimized, yet.
2715 -: 2710: Go optimize it, first. */
2716 30: 2711: return NULL;
2717 -: 2712: }
2718 -: 2713:
2719 1953218: 2714: le2 = le;
2720 1953218: 2715: le = do_lookup_constant_proc(info, le, argc, 1, &single_use);
2721 -: 2716:
2722 1953218: 2717: if (!le) {
2723 466621: 2718: info->has_nonleaf = 1;
2724 466621: 2719: return NULL;
2725 -: 2720: }
2726 -: 2721:
2727 1486597: 2722: if (SCHEME_WILL_BE_LAMBDAP(le)) {
2728 39716: 2723: psize = SCHEME_WILL_BE_LAMBDA_SIZE(le);
2729 -: 2724: LOG_INLINE(fprintf(stderr, "Potential inline %d %d\n", psize, info->inline_fuel * (argc + 2)));
2730 -: 2725: /* If we inline, the enclosing function will get larger, so we increase
2731 -: 2726: its potential size. */
2732 39716: 2727: if (psize <= (info->inline_fuel * (argc + 2)))
2733 2848: 2728: info->psize += psize;
2734 39716: 2729: info->has_nonleaf = 1;
2735 39716: 2730: return NULL;
2736 -: 2731: }
2737 -: 2732:
2738 1446881: 2733: if (SAME_OBJ(le, scheme_true)) {
2739 -: 2734: /* wrong arity */
2740 -: 2735: int len;
2741 -: 2736: const char *pname, *context;
2742 846: 2737: info->escapes = 1;
2743 846: 2738: le2 = lookup_constant_proc(info, le2, -1);
2744 846: 2739: pname = scheme_get_proc_name(le2, &len, 0);
2745 846: 2740: context = scheme_optimize_context_to_string(info->context);
2746 846: 2741: scheme_log(info->logger,
2747 -: 2742: SCHEME_LOG_WARNING,
2748 -: 2743: 0,
2749 -: 2744: "warning%s: optimizer detects procedure incorrectly applied to %d arguments%s%s",
2750 -: 2745: context,
2751 -: 2746: argc,
2752 -: 2747: pname ? ": " : "",
2753 -: 2748: pname ? pname : "");
2754 846: 2749: return NULL;
2755 -: 2750: }
2756 -: 2751:
2757 1446035: 2752: if (SAME_TYPE(SCHEME_TYPE(le), scheme_ir_lambda_type) && (info->inline_fuel >= 0)) {
2758 158439: 2753: Scheme_Lambda *lam = (Scheme_Lambda *)le;
2759 158439: 2754: int sz, threshold, is_leaf = 0;
2760 -: 2755:
2761 158439: 2756: sz = lambda_body_size_plus_info(lam, 1, info, &is_leaf);
2762 158439: 2757: if (is_leaf) {
2763 -: 2758: /* encourage inlining of leaves: */
2764 5385: 2759: sz >>= 2;
2765 -: 2760: }
2766 158439: 2761: threshold = info->inline_fuel * (2 + argc);
2767 -: 2762:
2768 -: 2763: /* Do we have enough fuel? */
2769 162421: 2764: if ((sz >= 0) && (single_use || (sz <= threshold))) {
2770 -: 2765: Optimize_Info *sub_info;
2771 60429: 2766: sub_info = info;
2772 -: 2767:
2773 -: 2768: /* If optimize_clone succeeds, inlining succeeds. */
2774 60429: 2769: le = optimize_clone(single_use, (Scheme_Object *)lam, sub_info, empty_eq_hash_tree, 0);
2775 -: 2770:
2776 60429: 2771: if (le) {
2777 -: 2772: LOG_INLINE(fprintf(stderr, "Inline %d[%d]<=%d@%d %d %s\n", sz, is_leaf, threshold, info->inline_fuel,
2778 -: 2773: single_use, scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL)));
2779 112893: 2774: scheme_log(info->logger,
2780 -: 2775: SCHEME_LOG_DEBUG,
2781 -: 2776: 0,
2782 -: 2777: "inlining %s size: %d threshold: %d#<separator>%s",
2783 56446: 2778: scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL),
2784 -: 2779: sz,
2785 -: 2780: threshold,
2786 -: 2781: scheme_optimize_context_to_string(info->context));
2787 56446: 2782: le = apply_inlined((Scheme_Lambda *)le, sub_info, argc, app, app2, app3, context,
2788 -: 2783: orig_le, prev, single_use);
2789 56446: 2784: return le;
2790 -: 2785: } else {
2791 -: 2786: LOG_INLINE(fprintf(stderr, "No inline %s\n", scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL)));
2792 7964: 2787: scheme_log(info->logger,
2793 -: 2788: SCHEME_LOG_DEBUG,
2794 -: 2789: 0,
2795 -: 2790: "no-inlining %s size: %d threshold: %d#<separator>%s",
2796 3982: 2791: scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL),
2797 -: 2792: sz,
2798 -: 2793: threshold,
2799 -: 2794: scheme_optimize_context_to_string(info->context));
2800 -: 2795: }
2801 -: 2796: } else {
2802 -: 2797: LOG_INLINE(fprintf(stderr, "No fuel %s %d[%d]>%d@%d %d\n", scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL),
2803 -: 2798: sz, is_leaf, threshold,
2804 -: 2799: info->inline_fuel, info->use_psize));
2805 196020: 2800: scheme_log(info->logger,
2806 -: 2801: SCHEME_LOG_DEBUG,
2807 -: 2802: 0,
2808 -: 2803: "out-of-fuel %s size: %d threshold: %d#<separator>%s",
2809 98010: 2804: scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL),
2810 -: 2805: sz,
2811 -: 2806: threshold,
2812 -: 2807: scheme_optimize_context_to_string(info->context));
2813 -: 2808: }
2814 -: 2809: }
2815 -: 2810:
2816 1389588: 2811: if (!scheme_check_leaf_rator(le))
2817 372196: 2812: info->has_nonleaf = 1;
2818 -: 2813:
2819 1389588: 2814: return NULL;
2820 -: 2815:}
2821 -: 2816:
2822 76: 2817:static int is_local_type_expression(Scheme_Object *expr, Optimize_Info *info)
2823 -: 2818:/* Get an unboxing type (e.g., flonum) for `expr` */
2824 -: 2819:{
2825 76: 2820: return scheme_predicate_to_local_type(expr_implies_predicate(expr, info));
2826 -: 2821:}
2827 -: 2822:
2828 945197: 2823:static void register_local_argument_types(Scheme_App_Rec *app, Scheme_App2_Rec *app2, Scheme_App3_Rec *app3,
2829 -: 2824: Optimize_Info *info)
2830 -: 2825:/* If `rator` is a variable bound to a `lambda`, record the types of actual arguments
2831 -: 2826: provided in a function call. If all calls are consistent with unboxing, then the
2832 -: 2827: procedure will accept unboxed arguments at run time. */
2833 -: 2828:{
2834 -: 2829: Scheme_Object *rator, *rand, *le;
2835 -: 2830: int n, i, nth_app;
2836 -: 2831:
2837 945197: 2832: if (app) {
2838 147682: 2833: rator = app->args[0];
2839 147682: 2834: n = app->num_args;
2840 147682: 2835: nth_app = SCHEME_APPN_FLAGS(app) & APPN_POSITION_MASK;
2841 797515: 2836: } else if (app2) {
2842 526479: 2837: rator = app2->rator;
2843 526479: 2838: n = 1;
2844 526479: 2839: nth_app = SCHEME_APPN_FLAGS(app2) & APPN_POSITION_MASK;
2845 -: 2840: } else {
2846 271036: 2841: rator = app3->rator;
2847 271036: 2842: n = 2;
2848 271036: 2843: nth_app = SCHEME_APPN_FLAGS(app3) & APPN_POSITION_MASK;
2849 -: 2844: }
2850 -: 2845:
2851 945197: 2846: if (SAME_TYPE(SCHEME_TYPE(rator), scheme_ir_local_type)) {
2852 115224: 2847: le = optimize_info_lookup(rator);
2853 115224: 2848: if (le && SCHEME_WILL_BE_LAMBDAP(le))
2854 15909: 2849: le = SCHEME_WILL_BE_LAMBDA(le);
2855 -: 2850:
2856 115224: 2851: if (le && SAME_TYPE(SCHEME_TYPE(le), scheme_ir_lambda_type)) {
2857 63258: 2852: Scheme_Lambda *lam = (Scheme_Lambda *)le;
2858 63258: 2853: if ((lam->num_params == n)
2859 62810: 2854: && !(SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_HAS_REST)) {
2860 -: 2855: Scheme_Object *pred;
2861 -: 2856:
2862 62510: 2857: if (!lam->ir_info->arg_types) {
2863 -: 2858: Scheme_Object **arg_types;
2864 -: 2859: short *contributors;
2865 6454: 2860: arg_types = MALLOC_N(Scheme_Object*, n);
2866 6454: 2861: lam->ir_info->arg_types = arg_types;
2867 6454: 2862: contributors = MALLOC_N_ATOMIC(short, n);
2868 6454: 2863: memset(contributors, 0, sizeof(short) * n);
2869 6454: 2864: lam->ir_info->arg_type_contributors = contributors;
2870 -: 2865: }
2871 -: 2866:
2872 174959: 2867: for (i = 0; i < n; i++) {
2873 112449: 2868: if (app)
2874 51011: 2869: rand = app->args[i+1];
2875 61438: 2870: else if (app2)
2876 28516: 2871: rand = app2->rand;
2877 -: 2872: else {
2878 32922: 2873: if (!i)
2879 16461: 2874: rand = app3->rand1;
2880 -: 2875: else
2881 16461: 2876: rand = app3->rand2;
2882 -: 2877: }
2883 -: 2878:
2884 112449: 2879: if (lam->ir_info->arg_types[i]
2885 83059: 2880: || !lam->ir_info->arg_type_contributors[i]) {
2886 61405: 2881: int widen_to_top = 0;
2887 -: 2882:
2888 61405: 2883: pred = expr_implies_predicate(rand, info);
2889 -: 2884:
2890 61405: 2885: if (pred) {
2891 28020: 2886: if (!lam->ir_info->arg_type_contributors[i]) {
2892 5882: 2887: lam->ir_info->arg_types[i] = pred;
2893 5882: 2888: if (nth_app)
2894 4459: 2889: lam->ir_info->arg_type_contributors[i] |= (1 << (nth_app-1));
2895 22138: 2890: } else if (predicate_implies(pred, lam->ir_info->arg_types[i])) {
2896 -: 2891: /* ok */
2897 20166: 2892: if (nth_app)
2898 10567: 2893: lam->ir_info->arg_type_contributors[i] |= (1 << (nth_app-1));
2899 1972: 2894: } else if (predicate_implies(lam->ir_info->arg_types[i], pred)) {
2900 -: 2895: /* widen */
2901 208: 2896: lam->ir_info->arg_types[i] = pred;
2902 208: 2897: if (nth_app)
2903 183: 2898: lam->ir_info->arg_type_contributors[i] |= (1 << (nth_app-1));
2904 -: 2899: } else
2905 1764: 2900: widen_to_top = 1;
2906 -: 2901: } else
2907 33385: 2902: widen_to_top = 1;
2908 -: 2903:
2909 61405: 2904: if (widen_to_top) {
2910 35149: 2905: if (nth_app) {
2911 -: 2906: /* Since we cant provide a nice type right now, just
2912 -: 2907: don't check in, in case a future iteration provides
2913 -: 2908: better information. If we never check in with a type,
2914 -: 2909: it will count as widening in the end. */
2915 -: 2910: } else {
2916 -: 2911: /* since we don't have an identity, the lambda won't
2917 -: 2912: be able to tell whether all apps have checked in,
2918 -: 2913: so we have to registers a "top" as an anonymous
2919 -: 2914: contributor. */
2920 7238: 2915: lam->ir_info->arg_type_contributors[i] |= (1 << (SCHEME_USE_COUNT_INF-1));
2921 7238: 2916: lam->ir_info->arg_types[i] = NULL;
2922 -: 2917: }
2923 -: 2918: }
2924 -: 2919: }
2925 -: 2920: }
2926 -: 2921: }
2927 -: 2922: }
2928 -: 2923: }
2929 945197: 2924:}
2930 -: 2925:
2931 17513: 2926:static void reset_rator(Scheme_Object *app, Scheme_Object *a)
2932 -: 2927:{
2933 17513: 2928: switch (SCHEME_TYPE(app)) {
2934 -: 2929: case scheme_application_type:
2935 628: 2930: ((Scheme_App_Rec *)app)->args[0] = a;
2936 628: 2931: break;
2937 -: 2932: case scheme_application2_type:
2938 14875: 2933: ((Scheme_App2_Rec *)app)->rator = a;
2939 14875: 2934: break;
2940 -: 2935: case scheme_application3_type:
2941 2010: 2936: ((Scheme_App3_Rec *)app)->rator = a;
2942 2010: 2937: break;
2943 -: 2938: }
2944 17513: 2939:}
2945 -: 2940:
2946 18118: 2941:static void set_application_omittable(Scheme_Object *app, Scheme_Object *a)
2947 -: 2942:{
2948 18118: 2943: switch (SCHEME_TYPE(app)) {
2949 -: 2944: case scheme_application_type:
2950 483: 2945: SCHEME_APPN_FLAGS((Scheme_App_Rec *)app) |= APPN_FLAG_OMITTABLE;
2951 483: 2946: break;
2952 -: 2947: case scheme_application2_type:
2953 9455: 2948: SCHEME_APPN_FLAGS((Scheme_App2_Rec *)app) |= APPN_FLAG_OMITTABLE;
2954 9455: 2949: break;
2955 -: 2950: case scheme_application3_type:
2956 8180: 2951: SCHEME_APPN_FLAGS((Scheme_App3_Rec *)app) |= APPN_FLAG_OMITTABLE;
2957 8180: 2952: break;
2958 -: 2953: }
2959 18118: 2954:}
2960 -: 2955:
2961 1007919: 2956:static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rator, Optimize_Info *info,
2962 -: 2957: int argc, int context)
2963 -: 2958:/* Convert ((let (....) E) arg ...) to (let (....) (E arg ...)) and
2964 -: 2959: ((begin .... E) arg ...) to (begin .... (E arg ...)), in case
2965 -: 2960: the `let' or `begin' is immediately apparent. We check for this
2966 -: 2961: pattern again in optimize_for_inline() after optimizing a rator. */
2967 -: 2962:{
2968 1007919: 2963: Scheme_Object *orig_rator = rator, *inside = NULL;
2969 -: 2964:
2970 1007919: 2965: extract_tail_inside(&rator, &inside);
2971 -: 2966:
2972 1007919: 2967: if (!inside)
2973 1004790: 2968: return NULL;
2974 -: 2969:
2975 -: 2970: /* Moving a variable into application position: */
2976 3129: 2971: if (SAME_TYPE(SCHEME_TYPE(rator), scheme_ir_local_type)) {
2977 3103: 2972: Scheme_IR_Local *var = SCHEME_VAR(rator);
2978 3103: 2973: if (var->non_app_count < SCHEME_USE_COUNT_INF)
2979 3103: 2974: --var->non_app_count;
2980 -: 2975: }
2981 -: 2976:
2982 3129: 2977: reset_rator(app, rator);
2983 3129: 2978: orig_rator = replace_tail_inside(app, inside, orig_rator);
2984 -: 2979:
2985 3129: 2980: return scheme_optimize_expr(orig_rator, info, context);
2986 -: 2981:}
2987 -: 2982:
2988 952120: 2983:static int is_nonmutating_nondependant_primitive(Scheme_Object *rator, int n)
2989 -: 2984:/* Does not include SCHEME_PRIM_IS_UNSAFE_OMITABLE, because those can
2990 -: 2985: depend on earlier tests (explicit or implicit) for whether the
2991 -: 2986: unsafe operation is defined */
2992 -: 2987:{
2993 952120: 2988: if (SCHEME_PRIMP(rator)
2994 647048: 2989: && ((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE | SCHEME_PRIM_IS_OMITABLE_ALLOCATION))
2995 214062: 2990: && !(SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_UNSAFE_OMITABLE)))
2996 200825: 2991: && (n >= ((Scheme_Primitive_Proc *)rator)->mina)
2997 200813: 2992: && (n <= ((Scheme_Primitive_Proc *)rator)->mu.maxa))
2998 200777: 2993: return 1;
2999 -: 2994:
3000 751343: 2995: return 0;
3001 -: 2996:}
3002 -: 2997:
3003 200777: 2998:static int is_primitive_allocating(Scheme_Object *rator, int n)
3004 -: 2999:{
3005 200777: 3000: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE_ALLOCATION))
3006 77421: 3001: return 1;
3007 -: 3002:
3008 123356: 3003: return 0;
3009 -: 3004:}
3010 -: 3005:
3011 952120: 3006:static int is_noncapturing_primitive(Scheme_Object *rator, int n)
3012 -: 3007:{
3013 952120: 3008: if (SCHEME_PRIMP(rator)) {
3014 -: 3009: int opt, t;
3015 647048: 3010: opt = ((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_OPT_MASK;
3016 647048: 3011: if (opt >= SCHEME_PRIM_OPT_IMMEDIATE)
3017 511417: 3012: return 1;
3018 135631: 3013: if (opt >= SCHEME_PRIM_OPT_NONCM) {
3019 55812: 3014: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_ALWAYS_ESCAPES) {
3020 -: 3015: /* even if a continuation is captured, it won't get back */
3021 19151: 3016: return 1;
3022 -: 3017: }
3023 -: 3018: }
3024 116480: 3019: t = (((Scheme_Primitive_Proc *)rator)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK);
3025 116480: 3020: if (!n && (t == SCHEME_PRIM_TYPE_PARAMETER))
3026 3502: 3021: return 1;
3027 112978: 3022: if (SAME_OBJ(rator, scheme_values_proc))
3028 18933: 3023: return 1;
3029 -: 3024: }
3030 -: 3025:
3031 399117: 3026: return 0;
3032 -: 3027:}
3033 -: 3028:
3034 952120: 3029:static int is_nonsaving_primitive(Scheme_Object *rator, int n)
3035 -: 3030:{
3036 952120: 3031: if (SCHEME_PRIMP(rator)) {
3037 -: 3032: int opt;
3038 647048: 3033: opt = ((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_OPT_MASK;
3039 647048: 3034: if (opt >= SCHEME_PRIM_OPT_IMMEDIATE)
3040 511417: 3035: return 1;
3041 135631: 3036: if (SAME_OBJ(rator, scheme_values_proc))
3042 18933: 3037: return 1;
3043 -: 3038: }
3044 -: 3039:
3045 421770: 3040: return 0;
3046 -: 3041:}
3047 -: 3042:
3048 934357: 3043:static int is_always_escaping_primitive(Scheme_Object *rator)
3049 -: 3044:{
3050 934357: 3045: if (SCHEME_PRIMP(rator)
3051 632485: 3046: && (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_ALWAYS_ESCAPES)) {
3052 19151: 3047: return 1;
3053 -: 3048: }
3054 915206: 3049: return 0;
3055 -: 3050:}
3056 -: 3051:
3057 -: 3052:#define IS_NAMED_PRIM(p, nm) (!strcmp(((Scheme_Primitive_Proc *)p)->name, nm))
3058 -: 3053:
3059 1570447: 3054:static int wants_local_type_arguments(Scheme_Object *rator, int argpos)
3060 -: 3055:{
3061 1570447: 3056: if (SCHEME_PRIMP(rator)) {
3062 -: 3057: int flags;
3063 1024392: 3058: flags = SCHEME_PRIM_PROC_OPT_FLAGS(rator);
3064 -: 3059:
3065 1024392: 3060: if (argpos == 0) {
3066 622465: 3061: if (flags & SCHEME_PRIM_WANTS_FLONUM_FIRST)
3067 410: 3062: return SCHEME_LOCAL_TYPE_FLONUM;
3068 622055: 3063: if (flags & SCHEME_PRIM_WANTS_EXTFLONUM_FIRST)
3069 114: 3064: return SCHEME_LOCAL_TYPE_EXTFLONUM;
3070 401927: 3065: } else if (argpos == 1) {
3071 264917: 3066: if (flags & SCHEME_PRIM_WANTS_FLONUM_SECOND)
3072 406: 3067: return SCHEME_LOCAL_TYPE_FLONUM;
3073 264511: 3068: if (flags & SCHEME_PRIM_WANTS_EXTFLONUM_SECOND)
3074 110: 3069: return SCHEME_LOCAL_TYPE_EXTFLONUM;
3075 137010: 3070: } else if (argpos == 2) {
3076 66601: 3071: if (flags & SCHEME_PRIM_WANTS_FLONUM_THIRD)
3077 270: 3072: return SCHEME_LOCAL_TYPE_FLONUM;
3078 66331: 3073: if (flags & SCHEME_PRIM_WANTS_EXTFLONUM_THIRD)
3079 76: 3074: return SCHEME_LOCAL_TYPE_EXTFLONUM;
3080 -: 3075: }
3081 -: 3076: }
3082 -: 3077:
3083 1569061: 3078: return 0;
3084 -: 3079:}
3085 -: 3080:
3086 578941: 3081:static int produces_local_type(Scheme_Object *rator, int argc)
3087 -: 3082:{
3088 578941: 3083: if (SCHEME_PRIMP(rator)
3089 578941: 3084: && (argc >= ((Scheme_Primitive_Proc *)rator)->mina)
3090 578913: 3085: && (argc <= ((Scheme_Primitive_Proc *)rator)->mu.maxa)) {
3091 -: 3086: int flags;
3092 578913: 3087: flags = SCHEME_PRIM_PROC_OPT_FLAGS(rator);
3093 578913: 3088: return SCHEME_PRIM_OPT_TYPE(flags);
3094 -: 3089: }
3095 -: 3090:
3096 28: 3091: return 0;
3097 -: 3092:}
3098 -: 3093:
3099 1832417: 3094:static Scheme_Object *local_type_to_predicate(int t)
3100 -: 3095:{
3101 1832417: 3096: switch (t) {
3102 -: 3097: case SCHEME_LOCAL_TYPE_FLONUM:
3103 1178: 3098: return scheme_flonum_p_proc;
3104 -: 3099: case SCHEME_LOCAL_TYPE_FIXNUM:
3105 142096: 3100: return scheme_fixnum_p_proc;
3106 -: 3101: case SCHEME_LOCAL_TYPE_EXTFLONUM:
3107 262: 3102: return scheme_extflonum_p_proc;
3108 -: 3103: }
3109 1688881: 3104: return NULL;
3110 -: 3105:}
3111 -: 3106:
3112 1262600: 3107:int scheme_predicate_to_local_type(Scheme_Object *pred)
3113 -: 3108:{
3114 1262600: 3109: if (!pred)
3115 1039351: 3110: return 0;
3116 223249: 3111: if (SAME_OBJ(scheme_flonum_p_proc, pred))
3117 1625: 3112: return SCHEME_LOCAL_TYPE_FLONUM;
3118 221624: 3113: if (SAME_OBJ(scheme_fixnum_p_proc, pred))
3119 104659: 3114: return SCHEME_LOCAL_TYPE_FIXNUM;
3120 116965: 3115: if (SAME_OBJ(scheme_extflonum_p_proc, pred))
3121 130: 3116: return SCHEME_LOCAL_TYPE_EXTFLONUM;
3122 116835: 3117: return 0;
3123 -: 3118:}
3124 -: 3119:
3125 1258564: 3120:int scheme_expr_produces_local_type(Scheme_Object *expr, int *_involves_k_cross)
3126 -: 3121:{
3127 1258564: 3122: if (_involves_k_cross) *_involves_k_cross = 0;
3128 1258564: 3123: return scheme_predicate_to_local_type(do_expr_implies_predicate(expr, NULL, _involves_k_cross,
3129 -: 3124: 10, empty_eq_hash_tree));
3130 -: 3125:}
3131 -: 3126:
3132 1146975: 3127:static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Info *info, int argc)
3133 -: 3128:{
3134 1146975: 3129: if (SCHEME_PRIMP(rator)) {
3135 913430: 3130: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_PRODUCES_REAL)
3136 3220: 3131: return scheme_real_p_proc;
3137 910210: 3132: else if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_PRODUCES_NUMBER)
3138 73621: 3133: return scheme_number_p_proc;
3139 836589: 3134: else if (SAME_OBJ(rator, scheme_cons_proc))
3140 14963: 3135: return scheme_pair_p_proc;
3141 821626: 3136: else if (SAME_OBJ(rator, scheme_unsafe_cons_list_proc))
3142 2: 3137: return scheme_list_pair_p_proc;
3143 821624: 3138: else if (SAME_OBJ(rator, scheme_mcons_proc))
3144 69: 3139: return scheme_mpair_p_proc;
3145 821555: 3140: else if (SAME_OBJ(rator, scheme_list_proc)) {
3146 6920: 3141: if (argc >= 1)
3147 6920: 3142: return scheme_list_pair_p_proc;
3148 -: 3143: else
3149 #####: 3144: return scheme_null_p_proc;
3150 814635: 3145: } else if (SAME_OBJ(rator, scheme_list_star_proc)) {
3151 10521: 3146: if (argc > 2)
3152 6172: 3147: return scheme_pair_p_proc;
3153 804114: 3148: } else if (IS_NAMED_PRIM(rator, "vector->list")
3154 802135: 3149: || IS_NAMED_PRIM(rator, "map")) {
3155 3029: 3150: return scheme_list_p_proc;
3156 801085: 3151: } else if (IS_NAMED_PRIM(rator, "string-ref")) {
3157 59: 3152: return scheme_char_p_proc;
3158 801026: 3153: } else if (IS_NAMED_PRIM(rator, "string-append")
3159 800483: 3154: || IS_NAMED_PRIM(rator, "string->immutable-string")
3160 800464: 3155: || IS_NAMED_PRIM(rator, "symbol->string")
3161 799941: 3156: || IS_NAMED_PRIM(rator, "keyword->string")) {
3162 1124: 3157: return scheme_string_p_proc;
3163 799902: 3158: } else if (IS_NAMED_PRIM(rator, "bytes-append")
3164 799659: 3159: || IS_NAMED_PRIM(rator, "bytes->immutable-bytes")) {
3165 245: 3160: return scheme_byte_string_p_proc;
3166 799657: 3161: } else if (SAME_OBJ(rator, scheme_vector_proc)
3167 799542: 3162: || SAME_OBJ(rator, scheme_vector_immutable_proc)
3168 799512: 3163: || SAME_OBJ(rator, scheme_make_vector_proc)
3169 799098: 3164: || SAME_OBJ(rator, scheme_list_to_vector_proc)
3170 799004: 3165: || SAME_OBJ(rator, scheme_struct_to_vector_proc)
3171 798590: 3166: || IS_NAMED_PRIM(rator, "vector->immutable-vector"))
3172 1069: 3167: return scheme_vector_p_proc;
3173 798588: 3168: else if (SAME_OBJ(rator, scheme_box_proc)
3174 798415: 3169: || SAME_OBJ(rator, scheme_box_immutable_proc))
3175 203: 3170: return scheme_box_p_proc;
3176 798385: 3171: else if (SAME_OBJ(rator, scheme_void_proc))
3177 3: 3172: return scheme_void_p_proc;
3178 798382: 3173: else if (SAME_OBJ(rator, scheme_procedure_specialize_proc))
3179 6: 3174: return scheme_procedure_p_proc;
3180 798376: 3175: else if (IS_NAMED_PRIM(rator, "vector-set!")
3181 798374: 3176: || IS_NAMED_PRIM(rator, "string-set!")
3182 798372: 3177: || IS_NAMED_PRIM(rator, "bytes-set!")
3183 798370: 3178: || IS_NAMED_PRIM(rator, "set-box!"))
3184 8: 3179: return scheme_void_p_proc;
3185 798368: 3180: else if (IS_NAMED_PRIM(rator, "vector-set!")
3186 798368: 3181: || IS_NAMED_PRIM(rator, "string-set!")
3187 798368: 3182: || IS_NAMED_PRIM(rator, "bytes-set!"))
3188 #####: 3183: return scheme_void_p_proc;
3189 798368: 3184: else if (IS_NAMED_PRIM(rator, "string->symbol")
3190 797481: 3185: || IS_NAMED_PRIM(rator, "gensym"))
3191 1235: 3186: return scheme_symbol_p_proc;
3192 797133: 3187: else if (IS_NAMED_PRIM(rator, "string->keyword"))
3193 2: 3188: return scheme_keyword_p_proc;
3194 797131: 3189: else if (IS_NAMED_PRIM(rator, "pair?")
3195 750499: 3190: || IS_NAMED_PRIM(rator, "mpair?")
3196 750105: 3191: || IS_NAMED_PRIM(rator, "list?")
3197 738048: 3192: || IS_NAMED_PRIM(rator, "list-pair?")
3198 738010: 3193: || IS_NAMED_PRIM(rator, "vector?")
3199 734912: 3194: || IS_NAMED_PRIM(rator, "box?")
3200 734239: 3195: || IS_NAMED_PRIM(rator, "number?")
3201 732543: 3196: || IS_NAMED_PRIM(rator, "real?")
3202 731338: 3197: || IS_NAMED_PRIM(rator, "complex?")
3203 731332: 3198: || IS_NAMED_PRIM(rator, "rational?")
3204 731326: 3199: || IS_NAMED_PRIM(rator, "integer?")
3205 730281: 3200: || IS_NAMED_PRIM(rator, "exact-integer?")
3206 729859: 3201: || IS_NAMED_PRIM(rator, "exact-nonnegative-integer?")
3207 728443: 3202: || IS_NAMED_PRIM(rator, "exact-positive-integer?")
3208 727895: 3203: || IS_NAMED_PRIM(rator, "inexact-real?")
3209 727889: 3204: || IS_NAMED_PRIM(rator, "fixnum?")
3210 726979: 3205: || IS_NAMED_PRIM(rator, "flonum?")
3211 726973: 3206: || IS_NAMED_PRIM(rator, "single-flonum?")
3212 726967: 3207: || IS_NAMED_PRIM(rator, "null?")
3213 662197: 3208: || IS_NAMED_PRIM(rator, "void?")
3214 661945: 3209: || IS_NAMED_PRIM(rator, "symbol?")
3215 658506: 3210: || IS_NAMED_PRIM(rator, "keyword?")
3216 657035: 3211: || IS_NAMED_PRIM(rator, "string?")
3217 653260: 3212: || IS_NAMED_PRIM(rator, "bytes?")
3218 650966: 3213: || IS_NAMED_PRIM(rator, "path?")
3219 649160: 3214: || IS_NAMED_PRIM(rator, "char?")
3220 648854: 3215: || IS_NAMED_PRIM(rator, "interned-char?")
3221 648840: 3216: || IS_NAMED_PRIM(rator, "boolean?")
3222 648485: 3217: || IS_NAMED_PRIM(rator, "chaperone?")
3223 648451: 3218: || IS_NAMED_PRIM(rator, "impersonator?")
3224 648421: 3219: || IS_NAMED_PRIM(rator, "procedure?")
3225 644371: 3220: || IS_NAMED_PRIM(rator, "eof-object?")
3226 642332: 3221: || IS_NAMED_PRIM(rator, "immutable?")
3227 641554: 3222: || IS_NAMED_PRIM(rator, "not")
3228 634197: 3223: || IS_NAMED_PRIM(rator, "true-object?")
3229 633557: 3224: || IS_NAMED_PRIM(rator, "zero?")
3230 628278: 3225: || IS_NAMED_PRIM(rator, "procedure-arity-includes?")
3231 624279: 3226: || IS_NAMED_PRIM(rator, "variable-reference-constant?")
3232 624149: 3227: || IS_NAMED_PRIM(rator, "eq?")
3233 592105: 3228: || IS_NAMED_PRIM(rator, "eqv?")
3234 591448: 3229: || IS_NAMED_PRIM(rator, "equal?")
3235 586990: 3230: || IS_NAMED_PRIM(rator, "string=?")
3236 586356: 3231: || IS_NAMED_PRIM(rator, "bytes=?")
3237 586250: 3232: || IS_NAMED_PRIM(rator, "char=?")
3238 586024: 3233: || IS_NAMED_PRIM(rator, "free-identifier=?")
3239 575740: 3234: || IS_NAMED_PRIM(rator, "bound-identifier=?")
3240 574596: 3235: || IS_NAMED_PRIM(rator, "procedure-closure-contents-eq?")) {
3241 222539: 3236: return scheme_boolean_p_proc;
3242 -: 3237: }
3243 -: 3238:
3244 -: 3239: {
3245 -: 3240: Scheme_Object *p;
3246 578941: 3241: p = local_type_to_predicate(produces_local_type(rator, argc));
3247 578941: 3242: if (p)
3248 120602: 3243: return p;
3249 -: 3244: }
3250 -: 3245: }
3251 -: 3246:
3252 -: 3247: {
3253 -: 3248: Scheme_Object *shape;
3254 691884: 3249: shape = get_struct_proc_shape(rator, info, 1);
3255 691884: 3250: if (shape) {
3256 10894: 3251: if (SAME_TYPE(SCHEME_TYPE(shape), scheme_struct_proc_shape_type)) {
3257 14053: 3252: if (((SCHEME_PROC_SHAPE_MODE(shape) & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_PRED)) {
3258 5271: 3253: return scheme_boolean_p_proc;
3259 -: 3254: }
3260 1232: 3255: } else if (SAME_TYPE(SCHEME_TYPE(shape), scheme_struct_prop_proc_shape_type)) {
3261 1232: 3256: if (SCHEME_PROP_PROC_SHAPE_MODE(shape) == STRUCT_PROP_PROC_SHAPE_PRED) {
3262 900: 3257: return scheme_boolean_p_proc;
3263 -: 3258: }
3264 -: 3259: }
3265 -: 3260: }
3266 -: 3261: }
3267 -: 3262:
3268 685713: 3263: return NULL;
3269 -: 3264:}
3270 -: 3265:
3271 4883326: 3266:static Scheme_Object *do_expr_implies_predicate(Scheme_Object *expr, Optimize_Info *info,
3272 -: 3267: int *_involves_k_cross, int fuel,
3273 -: 3268: Scheme_Hash_Tree *ignore_vars)
3274 -: 3269:/* can be called by the JIT with info = NULL;
3275 -: 3270: in that case, beware that the validator must be
3276 -: 3271: able to reconstruct the result in a shallow way, so don't
3277 -: 3272: make the result of a function call depend on its arguments */
3278 -: 3273:{
3279 4883326: 3274: if (fuel <= 0)
3280 6257: 3275: return NULL;
3281 -: 3276:
3282 4877069: 3277: switch (SCHEME_TYPE(expr)) {
3283 -: 3278: case scheme_ir_local_type:
3284 -: 3279: {
3285 1765349: 3280: if (scheme_hash_tree_get(ignore_vars, expr))
3286 9178: 3281: return NULL;
3287 -: 3282:
3288 1756171: 3283: if (!SCHEME_VAR(expr)->mutated) {
3289 -: 3284: Scheme_Object *p;
3290 -: 3285:
3291 1753743: 3286: if (info) {
3292 1672921: 3287: p = optimize_get_predicate(info, expr, 0);
3293 1672921: 3288: if (p)
3294 500267: 3289: return p;
3295 -: 3290: }
3296 -: 3291:
3297 1253476: 3292: p = local_type_to_predicate(SCHEME_VAR(expr)->val_type);
3298 1253476: 3293: if (p) {
3299 22934: 3294: if (_involves_k_cross
3300 19: 3295: && SCHEME_VAR(expr)->escapes_after_k_tick)
3301 19: 3296: *_involves_k_cross = 1;
3302 22934: 3297: return p;
3303 -: 3298: }
3304 -: 3299:
3305 1230542: 3300: if ((SCHEME_VAR(expr)->mode == SCHEME_VAR_MODE_OPTIMIZE)
3306 1200595: 3301: && SCHEME_VAR(expr)->optimize.known_val)
3307 193911: 3302: return do_expr_implies_predicate(SCHEME_VAR(expr)->optimize.known_val, info, _involves_k_cross,
3308 -: 3303: fuel-1, ignore_vars);
3309 -: 3304: }
3310 -: 3305: }
3311 1039059: 3306: break;
3312 -: 3307: case scheme_application2_type:
3313 -: 3308: {
3314 685024: 3309: Scheme_App2_Rec *app = (Scheme_App2_Rec *)expr;
3315 -: 3310:
3316 685024: 3311: if (SCHEME_PRIMP(app->rator)
3317 543696: 3312: && SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_CLOSED_ON_REALS) {
3318 -: 3313: Scheme_Object *p;
3319 34156: 3314: p = do_expr_implies_predicate(app->rand, info, NULL, fuel-1, ignore_vars);
3320 34156: 3315: if (p && predicate_implies(p, scheme_real_p_proc))
3321 8413: 3316: return scheme_real_p_proc;
3322 -: 3317: }
3323 -: 3318:
3324 676611: 3319: if (SAME_OBJ(app->rator, scheme_cdr_proc)
3325 605315: 3320: || SAME_OBJ(app->rator, scheme_unsafe_cdr_proc)) {
3326 -: 3321: Scheme_Object *p;
3327 151905: 3322: p = do_expr_implies_predicate(app->rand, info, NULL, fuel-1, ignore_vars);
3328 151905: 3323: if (SAME_OBJ(p, scheme_list_pair_p_proc))
3329 4478: 3324: return scheme_list_p_proc;
3330 -: 3325: }
3331 -: 3326:
3332 672133: 3327: return rator_implies_predicate(app->rator, info, 1);
3333 -: 3328: }
3334 -: 3329: break;
3335 -: 3330: case scheme_application3_type:
3336 -: 3331: {
3337 245343: 3332: Scheme_App3_Rec *app = (Scheme_App3_Rec *)expr;
3338 245343: 3333: if (SCHEME_PRIMP(app->rator)
3339 217796: 3334: && (SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_IS_BINARY_INLINED)
3340 147708: 3335: && IS_NAMED_PRIM(app->rator, "bitwise-and")) {
3341 -: 3336: /* Assume that a fixnum argument to bitwise-and will never get lost,
3342 -: 3337: and so the validator will be able to confirm that a `bitwise-and`
3343 -: 3338: combination produces a fixnum if either argument is a literal,
3344 -: 3339: nonnegative fixnum. */
3345 307: 3340: if ((SCHEME_INTP(app->rand1)
3346 10: 3341: && (SCHEME_INT_VAL(app->rand1) >= 0)
3347 10: 3342: && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(app->rand1)))
3348 307: 3343: || (SCHEME_INTP(app->rand2)
3349 204: 3344: && (SCHEME_INT_VAL(app->rand2) >= 0)
3350 202: 3345: && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(app->rand2)))) {
3351 22: 3346: return scheme_fixnum_p_proc;
3352 -: 3347: }
3353 -: 3348: }
3354 -: 3349:
3355 245321: 3350: if (SCHEME_PRIMP(app->rator)
3356 217774: 3351: && SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_CLOSED_ON_REALS) {
3357 -: 3352: Scheme_Object *p;
3358 49642: 3353: p = do_expr_implies_predicate(app->rand1, info, NULL, fuel-1, ignore_vars);
3359 49642: 3354: if (p && predicate_implies(p, scheme_real_p_proc)) {
3360 3264: 3355: p = do_expr_implies_predicate(app->rand2, info, NULL, fuel-1, ignore_vars);
3361 3264: 3356: if (p && predicate_implies(p, scheme_real_p_proc)) {
3362 2006: 3357: return scheme_real_p_proc;
3363 -: 3358: }
3364 -: 3359: }
3365 -: 3360: }
3366 -: 3361:
3367 243315: 3362: if (SAME_OBJ(app->rator, scheme_cons_proc)) {
3368 -: 3363: Scheme_Object *p;
3369 16506: 3364: p = do_expr_implies_predicate(app->rand2, info, NULL, fuel-1, ignore_vars);
3370 16506: 3365: if (SAME_OBJ(p, scheme_list_pair_p_proc)
3371 15907: 3366: || SAME_OBJ(p, scheme_list_p_proc)
3372 15870: 3367: || SAME_OBJ(p, scheme_null_p_proc))
3373 1565: 3368: return scheme_list_pair_p_proc;
3374 -: 3369: }
3375 -: 3370:
3376 241750: 3371: if (SCHEME_PRIMP(app->rator)
3377 214203: 3372: && IS_NAMED_PRIM(app->rator, "append")) {
3378 -: 3373: Scheme_Object *p;
3379 1342: 3374: p = do_expr_implies_predicate(app->rand2, info, NULL, fuel-1, ignore_vars);
3380 1342: 3375: if (SAME_OBJ(p, scheme_list_pair_p_proc))
3381 211: 3376: return scheme_list_pair_p_proc;
3382 1131: 3377: if (SAME_OBJ(p, scheme_list_p_proc)
3383 1111: 3378: || SAME_OBJ(p, scheme_null_p_proc))
3384 32: 3379: return scheme_list_p_proc;
3385 -: 3380: }
3386 -: 3381:
3387 241507: 3382: return rator_implies_predicate(app->rator, info, 2);
3388 -: 3383: }
3389 -: 3384: break;
3390 -: 3385: case scheme_application_type:
3391 -: 3386: {
3392 45610: 3387: Scheme_App_Rec *app = (Scheme_App_Rec *)expr;
3393 -: 3388:
3394 45610: 3389: if (SCHEME_PRIMP(app->args[0])
3395 28657: 3390: && SCHEME_PRIM_PROC_OPT_FLAGS(app->args[0]) & SCHEME_PRIM_CLOSED_ON_REALS) {
3396 -: 3391: Scheme_Object *p;
3397 -: 3392: int i;
3398 266: 3393: for (i = 0; i < app->num_args; i++) {
3399 260: 3394: p = do_expr_implies_predicate(app->args[i+1], info, NULL, fuel-1, ignore_vars);
3400 260: 3395: if (!p || !predicate_implies(p, scheme_real_p_proc))
3401 -: 3396: break;
3402 -: 3397: }
3403 248: 3398: if (i >= app->num_args)
3404 6: 3399: return scheme_real_p_proc;
3405 -: 3400: }
3406 -: 3401:
3407 45604: 3402: if (SCHEME_PRIMP(app->args[0])
3408 28651: 3403: && IS_NAMED_PRIM(app->args[0], "append")) {
3409 -: 3404: Scheme_Object *p;
3410 174: 3405: p = do_expr_implies_predicate(app->args[app->num_args], info, NULL, fuel-1, ignore_vars);
3411 174: 3406: if (SAME_OBJ(p, scheme_list_pair_p_proc))
3412 #####: 3407: return scheme_list_pair_p_proc;
3413 174: 3408: if (SAME_OBJ(p, scheme_list_p_proc)
3414 158: 3409: || SAME_OBJ(p, scheme_null_p_proc))
3415 16: 3410: return scheme_list_p_proc;
3416 -: 3411: }
3417 -: 3412:
3418 45588: 3413: return rator_implies_predicate(app->args[0], info, app->num_args);
3419 -: 3414: }
3420 -: 3415: break;
3421 -: 3416: case scheme_ir_lambda_type:
3422 100902: 3417: return scheme_procedure_p_proc;
3423 -: 3418: break;
3424 -: 3419: case scheme_case_lambda_sequence_type:
3425 532: 3420: return scheme_procedure_p_proc;
3426 -: 3421: break;
3427 -: 3422: case scheme_ir_quote_syntax_type:
3428 31069: 3423: return scheme_syntax_p_proc;
3429 -: 3424: break;
3430 -: 3425: case scheme_branch_type:
3431 -: 3426: {
3432 -: 3427: Scheme_Object *l, *r;
3433 138434: 3428: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)expr;
3434 138434: 3429: l = do_expr_implies_predicate(b->tbranch, info, _involves_k_cross, fuel-1, ignore_vars);
3435 138434: 3430: if (l) {
3436 44520: 3431: r = do_expr_implies_predicate(b->fbranch, info, _involves_k_cross, fuel-1, ignore_vars);
3437 44520: 3432: if (predicate_implies(l, r))
3438 8449: 3433: return r;
3439 36071: 3434: else if (predicate_implies(r, l))
3440 15035: 3435: return l;
3441 -: 3436: else
3442 21036: 3437: return NULL;
3443 -: 3438: }
3444 -: 3439: }
3445 93914: 3440: break;
3446 -: 3441: case scheme_sequence_type:
3447 -: 3442: {
3448 11360: 3443: Scheme_Sequence *seq = (Scheme_Sequence *)expr;
3449 -: 3444:
3450 11360: 3445: return do_expr_implies_predicate(seq->array[seq->count-1], info, _involves_k_cross, fuel-1, ignore_vars);
3451 -: 3446: }
3452 -: 3447: case scheme_with_cont_mark_type:
3453 -: 3448: {
3454 165: 3449: Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)expr;
3455 -: 3450:
3456 165: 3451: return do_expr_implies_predicate(wcm->body, info, _involves_k_cross, fuel-1, ignore_vars);
3457 -: 3452: }
3458 -: 3453: case scheme_ir_let_header_type:
3459 -: 3454: {
3460 31129: 3455: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)expr;
3461 -: 3456: Scheme_IR_Let_Value *irlv;
3462 -: 3457: int i, j;
3463 31129: 3458: expr = lh->body;
3464 68493: 3459: for (i = 0; i < lh->num_clauses; i++) {
3465 37364: 3460: irlv = (Scheme_IR_Let_Value *)expr;
3466 75614: 3461: for (j = 0; j < irlv->count; j++) {
3467 38250: 3462: ignore_vars = scheme_hash_tree_set(ignore_vars, (Scheme_Object *)irlv->vars[j],
3468 -: 3463: scheme_true);
3469 -: 3464: }
3470 37364: 3465: expr = irlv->body;
3471 -: 3466: }
3472 31129: 3467: return do_expr_implies_predicate(expr, info, _involves_k_cross, fuel-1, ignore_vars);
3473 -: 3468: }
3474 -: 3469: break;
3475 -: 3470: case scheme_begin0_sequence_type:
3476 -: 3471: {
3477 48: 3472: Scheme_Sequence *seq = (Scheme_Sequence *)expr;
3478 -: 3473:
3479 48: 3474: return do_expr_implies_predicate(seq->array[0], info, _involves_k_cross, fuel-1, ignore_vars);
3480 -: 3475: }
3481 -: 3476: case scheme_vector_type:
3482 2375: 3477: return scheme_vector_p_proc;
3483 -: 3478: break;
3484 -: 3479: case scheme_box_type:
3485 #####: 3480: return scheme_box_p_proc;
3486 -: 3481: break;
3487 -: 3482: default:
3488 1819729: 3483: if (SCHEME_FLOATP(expr))
3489 1277: 3484: return scheme_flonum_p_proc;
3490 1818452: 3485: if (SCHEME_LONG_DBLP(expr))
3491 32: 3486: return scheme_extflonum_p_proc;
3492 1818420: 3487: if (SCHEME_INTP(expr)
3493 30287: 3488: && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(expr)))
3494 30038: 3489: return scheme_fixnum_p_proc;
3495 1788382: 3490: if (SCHEME_REALP(expr))
3496 457: 3491: return scheme_real_p_proc;
3497 1787925: 3492: if (SCHEME_NUMBERP(expr))
3498 10: 3493: return scheme_number_p_proc;
3499 -: 3494:
3500 1787915: 3495: if (SCHEME_NULLP(expr))
3501 7626: 3496: return scheme_null_p_proc;
3502 1780289: 3497: if (scheme_is_list(expr))
3503 2047: 3498: return scheme_list_pair_p_proc;
3504 1778242: 3499: if (SCHEME_PAIRP(expr))
3505 24: 3500: return scheme_pair_p_proc;
3506 1778218: 3501: if (SCHEME_MPAIRP(expr))
3507 #####: 3502: return scheme_mpair_p_proc;
3508 1778218: 3503: if (SCHEME_CHAR_STRINGP(expr))
3509 5537: 3504: return scheme_string_p_proc;
3510 1772681: 3505: if (SCHEME_BYTE_STRINGP(expr))
3511 482: 3506: return scheme_byte_string_p_proc;
3512 1772199: 3507: if (SCHEME_VOIDP(expr))
3513 98: 3508: return scheme_void_p_proc;
3514 1772101: 3509: if (SCHEME_EOFP(expr))
3515 54: 3510: return scheme_eof_object_p_proc;
3516 1772047: 3511: if (SCHEME_KEYWORDP(expr))
3517 3348: 3512: return scheme_keyword_p_proc;
3518 1768699: 3513: if (SCHEME_SYMBOLP(expr))
3519 9969: 3514: return scheme_symbol_p_proc;
3520 1758730: 3515: if (SCHEME_CHARP(expr) && SCHEME_CHAR_VAL(expr) < 256)
3521 166: 3516: return scheme_interned_char_p_proc;
3522 1758564: 3517: if (SCHEME_CHARP(expr))
3523 26: 3518: return scheme_char_p_proc;
3524 1758538: 3519: if (SAME_OBJ(expr, scheme_true))
3525 7242: 3520: return scheme_true_object_p_proc;
3526 1751296: 3521: if (SCHEME_FALSEP(expr))
3527 26970: 3522: return scheme_not_proc;
3528 1724326: 3523: if (SCHEME_PROCP(expr))
3529 634911: 3524: return scheme_procedure_p_proc;
3530 -: 3525: }
3531 -: 3526:
3532 -: 3527: /* This test is slower, so put it at the end */
3533 2222388: 3528: if (info
3534 1301296: 3529: && lookup_constant_proc(info, expr, -1)) {
3535 47753: 3530: return scheme_procedure_p_proc;
3536 -: 3531: }
3537 -: 3532:
3538 2174635: 3533: return NULL;
3539 -: 3534:}
3540 -: 3535:
3541 2947946: 3536:static Scheme_Object *expr_implies_predicate(Scheme_Object *expr, Optimize_Info *info)
3542 -: 3537:{
3543 2947946: 3538: return do_expr_implies_predicate(expr, info, NULL, 5, empty_eq_hash_tree);
3544 -: 3539:}
3545 -: 3540:
3546 676: 3541:static Scheme_Object *finish_optimize_app(Scheme_Object *o, Optimize_Info *info, int context)
3547 -: 3542:{
3548 676: 3543: switch(SCHEME_TYPE(o)) {
3549 -: 3544: case scheme_application_type:
3550 612: 3545: return finish_optimize_application((Scheme_App_Rec *)o, info, context);
3551 -: 3546: case scheme_application2_type:
3552 31: 3547: return finish_optimize_application2((Scheme_App2_Rec *)o, info, context);
3553 -: 3548: case scheme_application3_type:
3554 33: 3549: return finish_optimize_application3((Scheme_App3_Rec *)o, info, context);
3555 -: 3550: default:
3556 #####: 3551: return o; /* may be a constant due to constant-folding */
3557 -: 3552: }
3558 -: 3553:}
3559 -: 3554:
3560 878904: 3555:static Scheme_Object *direct_apply(Scheme_Object *expr, Scheme_Object *rator, Scheme_Object *last_rand, Optimize_Info *info)
3561 -: 3556:/* Convert `(apply f arg1 ... (list arg2 ...))` to `(f arg1 ... arg2 ...)` */
3562 -: 3557:{
3563 878904: 3558: if (SAME_OBJ(rator, scheme_apply_proc)) {
3564 10269: 3559: switch(SCHEME_TYPE(last_rand)) {
3565 -: 3560: case scheme_application_type:
3566 816: 3561: rator = ((Scheme_App_Rec *)last_rand)->args[0];
3567 816: 3562: break;
3568 -: 3563: case scheme_application2_type:
3569 616: 3564: rator = ((Scheme_App2_Rec *)last_rand)->rator;
3570 616: 3565: break;
3571 -: 3566: case scheme_application3_type:
3572 2060: 3567: rator = ((Scheme_App3_Rec *)last_rand)->rator;
3573 2060: 3568: break;
3574 -: 3569: case scheme_pair_type:
3575 24: 3570: if (scheme_is_list(last_rand))
3576 24: 3571: rator = scheme_list_proc;
3577 -: 3572: else
3578 #####: 3573: rator = NULL;
3579 24: 3574: break;
3580 -: 3575: case scheme_null_type:
3581 227: 3576: rator = scheme_list_proc;
3582 227: 3577: break;
3583 -: 3578: default:
3584 6526: 3579: rator = NULL;
3585 6526: 3580: break;
3586 -: 3581: }
3587 -: 3582:
3588 10269: 3583: if (rator && SAME_OBJ(rator, scheme_list_proc)) {
3589 -: 3584: /* Convert (apply f arg1 ... (list arg2 ...))
3590 -: 3585: to (f arg1 ... arg2 ...) */
3591 820: 3586: Scheme_Object *l = scheme_null;
3592 -: 3587: int i;
3593 -: 3588:
3594 820: 3589: switch(SCHEME_TYPE(last_rand)) {
3595 -: 3590: case scheme_application_type:
3596 1547: 3591: for (i = ((Scheme_App_Rec *)last_rand)->num_args; i--; ) {
3597 945: 3592: l = scheme_make_pair(((Scheme_App_Rec *)last_rand)->args[i+1], l);
3598 -: 3593: }
3599 301: 3594: break;
3600 -: 3595: case scheme_application2_type:
3601 89: 3596: l = scheme_make_pair(((Scheme_App2_Rec *)last_rand)->rand, l);
3602 89: 3597: break;
3603 -: 3598: case scheme_application3_type:
3604 179: 3599: l = scheme_make_pair(((Scheme_App3_Rec *)last_rand)->rand2, l);
3605 179: 3600: l = scheme_make_pair(((Scheme_App3_Rec *)last_rand)->rand1, l);
3606 179: 3601: break;
3607 -: 3602: case scheme_pair_type:
3608 24: 3603: l = last_rand;
3609 24: 3604: break;
3610 -: 3605: case scheme_null_type:
3611 227: 3606: l = scheme_null;
3612 227: 3607: break;
3613 -: 3608: }
3614 -: 3609:
3615 820: 3610: switch(SCHEME_TYPE(expr)) {
3616 -: 3611: case scheme_application_type:
3617 3648: 3612: for (i = ((Scheme_App_Rec *)expr)->num_args - 1; i--; ) {
3618 2148: 3613: l = scheme_make_pair(((Scheme_App_Rec *)expr)->args[i+1], l);
3619 -: 3614: }
3620 750: 3615: break;
3621 -: 3616: default:
3622 -: 3617: case scheme_application3_type:
3623 70: 3618: l = scheme_make_pair(((Scheme_App3_Rec *)expr)->rand1, l);
3624 70: 3619: break;
3625 -: 3620: }
3626 -: 3621:
3627 820: 3622: return scheme_make_application(l, info);
3628 -: 3623: }
3629 -: 3624: }
3630 -: 3625:
3631 878084: 3626: return NULL;
3632 -: 3627:}
3633 -: 3628:
3634 371664: 3629:static Scheme_Object *call_with_immed_mark(Scheme_Object *rator,
3635 -: 3630: Scheme_Object *rand1,
3636 -: 3631: Scheme_Object *rand2,
3637 -: 3632: Scheme_Object *rand3,
3638 -: 3633: Optimize_Info *info)
3639 -: 3634:/* Convert `(call-with-immediate-continuation-mark (lambda (arg) M))`
3640 -: 3635: to the with-immediate-mark bytecode form. */
3641 -: 3636:{
3642 371664: 3637: if (SAME_OBJ(rator, scheme_call_with_immed_mark_proc)
3643 131: 3638: && SAME_TYPE(SCHEME_TYPE(rand2), scheme_ir_lambda_type)
3644 131: 3639: && (((Scheme_Lambda *)rand2)->num_params == 1)
3645 131: 3640: && !(SCHEME_LAMBDA_FLAGS(((Scheme_Lambda *)rand2)) & LAMBDA_HAS_REST)) {
3646 -: 3641: Scheme_With_Continuation_Mark *wcm;
3647 -: 3642: Scheme_Object *e;
3648 -: 3643:
3649 131: 3644: wcm = MALLOC_ONE_TAGGED(Scheme_With_Continuation_Mark);
3650 131: 3645: wcm->so.type = scheme_with_immed_mark_type;
3651 -: 3646:
3652 131: 3647: wcm->key = rand1;
3653 131: 3648: wcm->val = (rand3 ? rand3 : scheme_false);
3654 -: 3649:
3655 131: 3650: e = (Scheme_Object *)((Scheme_Lambda *)rand2)->ir_info->vars[0];
3656 131: 3651: e = scheme_make_mutable_pair(e, ((Scheme_Lambda *)rand2)->body);
3657 131: 3652: wcm->body = e;
3658 -: 3653:
3659 131: 3654: return (Scheme_Object *)wcm;
3660 -: 3655: }
3661 -: 3656:
3662 371533: 3657: return NULL;
3663 -: 3658:}
3664 -: 3659:
3665 162027: 3660:static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info, int context)
3666 -: 3661:{
3667 -: 3662: Scheme_Object *le;
3668 -: 3663: Scheme_App_Rec *app;
3669 162027: 3664: int i, n, rator_apply_escapes = 0, sub_context = 0;
3670 -: 3665: Optimize_Info_Sequence info_seq;
3671 -: 3666:
3672 162027: 3667: app = (Scheme_App_Rec *)o;
3673 -: 3668:
3674 -: 3669: /* Check for (apply ... (list ...)) early: */
3675 162027: 3670: le = direct_apply((Scheme_Object *)app, app->args[0], app->args[app->num_args], info);
3676 162027: 3671: if (le)
3677 124: 3672: return scheme_optimize_expr(le, info, context);
3678 -: 3673:
3679 161903: 3674: if (app->num_args == 3) {
3680 73609: 3675: le = call_with_immed_mark(app->args[0], app->args[1], app->args[2], app->args[3], info);
3681 73609: 3676: if (le)
3682 #####: 3677: return scheme_optimize_expr(le, info, context);
3683 -: 3678: }
3684 -: 3679:
3685 161903: 3680: le = check_app_let_rator(o, app->args[0], info, app->num_args, context);
3686 161903: 3681: if (le)
3687 628: 3682: return le;
3688 -: 3683:
3689 161275: 3684: n = app->num_args + 1;
3690 -: 3685:
3691 161275: 3686: optimize_info_seq_init(info, &info_seq);
3692 -: 3687:
3693 815309: 3688: for (i = 0; i < n; i++) {
3694 666807: 3689: if (!i) {
3695 161275: 3690: le = optimize_for_inline(info, app->args[i], n - 1, app, NULL, NULL, context, 0);
3696 161275: 3691: if (le)
3697 12699: 3692: return le;
3698 -: 3693: }
3699 -: 3694:
3700 654108: 3695: sub_context = OPT_CONTEXT_SINGLED;
3701 654108: 3696: if (i > 0) {
3702 -: 3697: int ty;
3703 505532: 3698: ty = wants_local_type_arguments(app->args[0], i - 1);
3704 505532: 3699: if (ty)
3705 346: 3700: sub_context |= (ty << OPT_CONTEXT_TYPE_SHIFT);
3706 -: 3701: }
3707 -: 3702:
3708 654108: 3703: optimize_info_seq_step(info, &info_seq);
3709 654108: 3704: le = scheme_optimize_expr(app->args[i], info, sub_context);
3710 654108: 3705: app->args[i] = le;
3711 654108: 3706: if (info->escapes) {
3712 -: 3707: int j;
3713 -: 3708: Scheme_Object *e, *l;
3714 23: 3709: optimize_info_seq_done(info, &info_seq);
3715 -: 3710:
3716 23: 3711: l = scheme_make_pair(app->args[i], scheme_null);
3717 -: 3712:
3718 88: 3713: for (j = i - 1; j >= 0; j--) {
3719 65: 3714: e = app->args[j];
3720 65: 3715: e = optimize_ignored(e, info, 1, 1, 5);
3721 65: 3716: if (e) {
3722 24: 3717: e = ensure_single_value(e);
3723 24: 3718: l = scheme_make_pair(e, l);
3724 -: 3719: }
3725 -: 3720: }
3726 23: 3721: return ensure_noncm(scheme_make_sequence_compilation(l, 1, 0));
3727 -: 3722: }
3728 -: 3723:
3729 654085: 3724: if (!i) {
3730 -: 3725: /* Maybe found "((lambda" after optimizing; try again */
3731 148574: 3726: le = optimize_for_inline(info, app->args[i], n - 1, app, NULL, NULL, context, 1);
3732 148574: 3727: if (le)
3733 51: 3728: return le;
3734 148523: 3729: if (SAME_OBJ(app->args[0], scheme_values_proc)
3735 139814: 3730: || SAME_OBJ(app->args[0], scheme_apply_proc))
3736 11606: 3731: info->maybe_values_argument = 1;
3737 148523: 3732: rator_apply_escapes = info->escapes;
3738 -: 3733: }
3739 -: 3734: }
3740 -: 3735:
3741 148502: 3736: optimize_info_seq_done(info, &info_seq);
3742 -: 3737:
3743 -: 3738: /* Check for (apply ... (list ...)) after some optimizations: */
3744 148502: 3739: le = direct_apply((Scheme_Object *)app, app->args[0], app->args[app->num_args], info);
3745 148502: 3740: if (le) return finish_optimize_app(le, info, context);
3746 -: 3741:
3747 -: 3742: /* Convert (hash-ref '#hash... key (lambda () literal))
3748 -: 3743: to (hash-ref '#hash... key literal) */
3749 147876: 3744: if ((app->num_args == 3)
3750 68416: 3745: && SAME_OBJ(scheme_hash_ref_proc, app->args[0])
3751 2028: 3746: && SCHEME_HASHTRP(app->args[1])
3752 37: 3747: && SAME_TYPE(scheme_ir_lambda_type, SCHEME_TYPE(app->args[3]))
3753 12: 3748: && (SCHEME_TYPE(((Scheme_Lambda *)app->args[3])->body) > _scheme_ir_values_types_)
3754 12: 3749: && !SCHEME_PROCP(((Scheme_Lambda *)app->args[3])->body)) {
3755 10: 3750: app->args[3] = ((Scheme_Lambda *)app->args[3])->body;
3756 -: 3751: }
3757 -: 3752:
3758 147876: 3753: if (rator_apply_escapes) {
3759 311: 3754: info->escapes = 1;
3760 311: 3755: SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
3761 -: 3756: }
3762 -: 3757:
3763 147876: 3758: return finish_optimize_application(app, info, context);
3764 -: 3759:}
3765 -: 3760:
3766 1204726: 3761:static int appn_flags(Scheme_Object *rator, Optimize_Info *info)
3767 -: 3762:/* Record some properties of an application that are useful to the SFS pass. */
3768 -: 3763:{
3769 1204726: 3764: if (SAME_TYPE(SCHEME_TYPE(rator), scheme_ir_toplevel_type)) {
3770 235465: 3765: if (info->top_level_consts) {
3771 -: 3766: int pos;
3772 90654: 3767: pos = SCHEME_TOPLEVEL_POS(rator);
3773 90654: 3768: rator = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos));
3774 90654: 3769: rator = no_potential_size(rator);
3775 90654: 3770: if (!rator) return 0;
3776 20538: 3771: if (SAME_TYPE(SCHEME_TYPE(rator), scheme_proc_shape_type)) {
3777 #####: 3772: return APPN_FLAG_SFS_TAIL;
3778 20538: 3773: } else if (SAME_TYPE(SCHEME_TYPE(rator), scheme_struct_proc_shape_type)) {
3779 6415: 3774: int ps = SCHEME_PROC_SHAPE_MODE(rator);
3780 6415: 3775: if ((ps == STRUCT_PROC_SHAPE_PRED)
3781 4508: 3776: || (ps == STRUCT_PROC_SHAPE_GETTER)
3782 3548: 3777: || (ps == STRUCT_PROC_SHAPE_SETTER))
3783 2867: 3778: return (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
3784 3548: 3779: return 0;
3785 -: 3780: }
3786 -: 3781: }
3787 -: 3782: }
3788 -: 3783:
3789 1128195: 3784: if (SCHEME_PRIMP(rator)) {
3790 830841: 3785: int opt = (SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_OPT_MASK);
3791 830841: 3786: if (opt >= SCHEME_PRIM_OPT_IMMEDIATE)
3792 663926: 3787: return (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
3793 166915: 3788: return 0;
3794 -: 3789: }
3795 -: 3790:
3796 297354: 3791: if (SCHEME_LAMBDAP(rator)
3797 286081: 3792: || SAME_TYPE(scheme_noninline_proc_type, SCHEME_TYPE(rator)))
3798 13392: 3793: return APPN_FLAG_SFS_TAIL;
3799 -: 3794:
3800 283962: 3795: return 0;
3801 -: 3796:}
3802 -: 3797:
3803 19336462: 3798:static int check_known_variant(Optimize_Info *info, Scheme_Object *app,
3804 -: 3799: Scheme_Object *rator, Scheme_Object *rand,
3805 -: 3800: const char *who, Scheme_Object *expect_pred, Scheme_Object *unsafe,
3806 -: 3801: Scheme_Object *implies_pred)
3807 -: 3802:/* Replace the rator with an unsafe version if we know that it's ok:
3808 -: 3803: if the argument is consistent with `expect_pred`; if `unsafe` is
3809 -: 3804: #t, then just mark the application as omittable. Alternatively, the
3810 -: 3805: rator implies a check, so add type information for subsequent
3811 -: 3806: expressions: the argument is consistent with `implies_pred` (which
3812 -: 3807: must be itself implied by `expected_pred`, but might be weaker). If
3813 -: 3808: the rand has already an incompatible type, mark that this will
3814 -: 3809: generate an error. If unsafe is NULL then rator has no unsafe
3815 -: 3810: version, so only check the type. */
3816 -: 3811:{
3817 19336462: 3812: if (SCHEME_PRIMP(rator) && (!who || IS_NAMED_PRIM(rator, who))) {
3818 -: 3813: Scheme_Object *pred;
3819 -: 3814:
3820 269261: 3815: pred = expr_implies_predicate(rand, info);
3821 269261: 3816: if (pred) {
3822 164693: 3817: if (predicate_implies(pred, expect_pred)) {
3823 157303: 3818: if (unsafe) {
3824 31203: 3819: if (SAME_OBJ(unsafe, scheme_true))
3825 17635: 3820: set_application_omittable(app, unsafe);
3826 -: 3821: else
3827 13568: 3822: reset_rator(app, unsafe);
3828 -: 3823: }
3829 157303: 3824: return 1;
3830 7390: 3825: } else if (predicate_implies_not(pred, implies_pred)) {
3831 117: 3826: info->escapes = 1;
3832 -: 3827: }
3833 -: 3828: } else {
3834 104568: 3829: if (SAME_TYPE(SCHEME_TYPE(rand), scheme_ir_local_type))
3835 85326: 3830: add_type(info, rand, implies_pred);
3836 -: 3831: }
3837 -: 3832: }
3838 -: 3833:
3839 19179159: 3834: return 0;
3840 -: 3835:}
3841 -: 3836:
3842 18573498: 3837:static void check_known(Optimize_Info *info, Scheme_Object *app,
3843 -: 3838: Scheme_Object *rator, Scheme_Object *rand,
3844 -: 3839: const char *who, Scheme_Object *expect_pred, Scheme_Object *unsafe)
3845 -: 3840:/* When the expected predicate for unsafe substitution is the same as the implied predicate. */
3846 -: 3841:{
3847 18573498: 3842: (void)check_known_variant(info, app, rator, rand, who, expect_pred, unsafe, expect_pred);
3848 18573498: 3843:}
3849 -: 3844:
3850 934476: 3845:static void check_known_rator(Optimize_Info *info, Scheme_Object *rator)
3851 -: 3846:/* Check that rator is a procedure or add type information for subsequent expressions. */
3852 -: 3847:{
3853 -: 3848: Scheme_Object *pred;
3854 -: 3849:
3855 934476: 3850: pred = expr_implies_predicate(rator, info);
3856 934476: 3851: if (pred) {
3857 721873: 3852: if (predicate_implies_not(pred, scheme_procedure_p_proc))
3858 2: 3853: info->escapes = 1;
3859 -: 3854: } else {
3860 212603: 3855: if (SAME_TYPE(SCHEME_TYPE(rator), scheme_ir_local_type))
3861 33499: 3856: add_type(info, rator, scheme_procedure_p_proc);
3862 -: 3857: }
3863 934476: 3858:}
3864 -: 3859:
3865 2744826: 3860:static void check_known_both_try(Optimize_Info *info, Scheme_Object *app,
3866 -: 3861: Scheme_Object *rator, Scheme_Object *rand1, Scheme_Object *rand2,
3867 -: 3862: const char *who, Scheme_Object *expect_pred, Scheme_Object *unsafe)
3868 -: 3863:/* Replace the rator with an unsafe version if both rands have the right type.
3869 -: 3864: If not, don't save the type, nor mark this as an error */
3870 -: 3865:{
3871 2744826: 3866: if (SCHEME_PRIMP(rator) && (!who || IS_NAMED_PRIM(rator, who))) {
3872 -: 3867: Scheme_Object *pred1, *pred2;
3873 -: 3868:
3874 10703: 3869: pred1 = expr_implies_predicate(rand1, info);
3875 10703: 3870: if (pred1 && SAME_OBJ(pred1, expect_pred)) {
3876 1883: 3871: pred2 = expr_implies_predicate(rand2, info);
3877 1883: 3872: if (pred2 && SAME_OBJ(pred2, expect_pred)) {
3878 816: 3873: reset_rator(app, unsafe);
3879 -: 3874: }
3880 -: 3875: }
3881 -: 3876: }
3882 2744826: 3877:}
3883 -: 3878:
3884 1588296: 3879:static void check_known_both_variant(Optimize_Info *info, Scheme_Object *app,
3885 -: 3880: Scheme_Object *rator, Scheme_Object *rand1, Scheme_Object *rand2,
3886 -: 3881: const char *who, Scheme_Object *expect_pred, Scheme_Object *unsafe,
3887 -: 3882: Scheme_Object *implies_pred)
3888 -: 3883:{
3889 1588296: 3884: if (SCHEME_PRIMP(rator) && (!who || IS_NAMED_PRIM(rator, who))) {
3890 -: 3885: int ok1;
3891 21599: 3886: ok1 = check_known_variant(info, app, rator, rand1, who, expect_pred, NULL, implies_pred);
3892 21599: 3887: check_known_variant(info, app, rator, rand2, who, expect_pred, (ok1 ? unsafe : NULL), implies_pred);
3893 -: 3888: }
3894 1588296: 3889:}
3895 -: 3890:
3896 411942: 3891:static void check_known_both(Optimize_Info *info, Scheme_Object *app,
3897 -: 3892: Scheme_Object *rator, Scheme_Object *rand1, Scheme_Object *rand2,
3898 -: 3893: const char *who, Scheme_Object *expect_pred, Scheme_Object *unsafe)
3899 -: 3894:{
3900 411942: 3895: check_known_both_variant(info, app, rator, rand1, rand2, who, expect_pred, unsafe, expect_pred);
3901 411942: 3896:}
3902 -: 3897:
3903 -: 3898:
3904 563450: 3899:static void check_known_all(Optimize_Info *info, Scheme_Object *_app, int skip_head, int skip_tail,
3905 -: 3900: const char *who, Scheme_Object *expect_pred, Scheme_Object *unsafe)
3906 -: 3901:{
3907 563450: 3902: Scheme_App_Rec *app = (Scheme_App_Rec *)_app;
3908 563450: 3903: if (SCHEME_PRIMP(app->args[0]) && (!who || IS_NAMED_PRIM(app->args[0], who))) {
3909 2794: 3904: int ok_so_far = 1, i;
3910 -: 3905:
3911 10858: 3906: for (i = skip_head; i < app->num_args - skip_tail; i++) {
3912 8064: 3907: if (!check_known_variant(info, _app, app->args[0], app->args[i+1], who, expect_pred,
3913 -: 3908: NULL, expect_pred))
3914 4670: 3909: ok_so_far = 0;
3915 -: 3910: }
3916 -: 3911:
3917 2794: 3912: if (ok_so_far && unsafe) {
3918 483: 3913: if (SAME_OBJ(unsafe, scheme_true))
3919 483: 3914: set_application_omittable(_app, unsafe);
3920 -: 3915: else
3921 #####: 3916: reset_rator(_app, unsafe);
3922 -: 3917: }
3923 -: 3918: }
3924 563450: 3919:}
3925 -: 3920:
3926 934476: 3921:static Scheme_Object *finish_optimize_any_application(Scheme_Object *app, Scheme_Object *rator, int argc,
3927 -: 3922: Optimize_Info *info, int context)
3928 -: 3923:{
3929 934476: 3924: check_known_rator(info, rator);
3930 -: 3925:
3931 934476: 3926: if ((context & OPT_CONTEXT_BOOLEAN) && !info->escapes) {
3932 -: 3927: Scheme_Object *pred;
3933 187747: 3928: pred = rator_implies_predicate(rator, info, argc);
3934 187747: 3929: if (pred && predicate_implies_not(pred, scheme_not_proc))
3935 25: 3930: return make_discarding_sequence(app, scheme_true, info);
3936 187722: 3931: else if (pred && predicate_implies(pred, scheme_not_proc))
3937 #####: 3932: return make_discarding_sequence(app, scheme_false, info);
3938 -: 3933: }
3939 -: 3934:
3940 934451: 3935: if (SAME_OBJ(rator, scheme_void_proc))
3941 94: 3936: return make_discarding_sequence(app, scheme_void, info);
3942 -: 3937:
3943 934357: 3938: if (is_always_escaping_primitive(rator)) {
3944 19151: 3939: info->escapes = 1;
3945 -: 3940: }
3946 -: 3941:
3947 934357: 3942: return app;
3948 -: 3943:}
3949 -: 3944:
3950 952120: 3945:static void increment_clock_counts_for_application(GC_CAN_IGNORE int *_vclock,
3951 -: 3946: GC_CAN_IGNORE int *_aclock,
3952 -: 3947: GC_CAN_IGNORE int *_kclock,
3953 -: 3948: GC_CAN_IGNORE int *_sclock,
3954 -: 3949: Scheme_Object *rator,
3955 -: 3950: int argc)
3956 -: 3951:{
3957 952120: 3952: if (!is_nonmutating_nondependant_primitive(rator, argc))
3958 751343: 3953: *_vclock += 1;
3959 200777: 3954: else if (is_primitive_allocating(rator, argc))
3960 77421: 3955: *_aclock += 1;
3961 -: 3956:
3962 952120: 3957: if (!is_noncapturing_primitive(rator, argc))
3963 399117: 3958: *_kclock += 1;
3964 -: 3959:
3965 952120: 3960: if (!is_nonsaving_primitive(rator, argc))
3966 421770: 3961: *_sclock += 1;
3967 952120: 3962:}
3968 -: 3963:
3969 946855: 3964:static void increment_clocks_for_application(Optimize_Info *info,
3970 -: 3965: Scheme_Object *rator,
3971 -: 3966: int argc)
3972 -: 3967:{
3973 -: 3968: int v, a, k, s;
3974 -: 3969:
3975 946855: 3970: v = info->vclock;
3976 946855: 3971: a = info->aclock;
3977 946855: 3972: k = info->kclock;
3978 946855: 3973: s = info->sclock;
3979 -: 3974:
3980 946855: 3975: increment_clock_counts_for_application(&v, &a, &k, &s, rator, argc);
3981 -: 3976:
3982 946855: 3977: info->vclock = v;
3983 946855: 3978: info->aclock = a;
3984 946855: 3979: info->kclock = k;
3985 946855: 3980: info->sclock = s;
3986 946855: 3981:}
3987 -: 3982:
3988 148488: 3983:static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_Info *info, int context)
3989 -: 3984:{
3990 -: 3985: Scheme_Object *le;
3991 148488: 3986: Scheme_Object *rator = app->args[0], *rator_for_flags;
3992 148488: 3987: int all_vals = 1, i, flags, rator_flags;
3993 -: 3988:
3994 802412: 3989: for (i = app->num_args; i--; ) {
3995 505436: 3990: if (SCHEME_TYPE(app->args[i+1]) < _scheme_ir_values_types_)
3996 327954: 3991: all_vals = 0;
3997 -: 3992: }
3998 -: 3993:
3999 148488: 3994: info->size += 1;
4000 148488: 3995: increment_clocks_for_application(info, rator, app->num_args);
4001 -: 3996:
4002 148488: 3997: if (all_vals) {
4003 37146: 3998: le = try_optimize_fold(rator, NULL, (Scheme_Object *)app, info);
4004 37146: 3999: if (le)
4005 2: 4000: return le;
4006 -: 4001: }
4007 -: 4002:
4008 148486: 4003: if (!app->num_args
4009 28414: 4004: && (SAME_OBJ(rator, scheme_list_proc)
4010 26089: 4005: || (SCHEME_PRIMP(rator) && IS_NAMED_PRIM(rator, "append")))) {
4011 2334: 4006: info->preserves_marks = 1;
4012 2334: 4007: info->single_result = 1;
4013 2334: 4008: return scheme_null;
4014 -: 4009: }
4015 -: 4010:
4016 146152: 4011: rator_for_flags = lookup_constant_proc(info, rator, app->num_args);
4017 146152: 4012: rator_flags = scheme_get_rator_flags(rator_for_flags);
4018 146152: 4013: info->preserves_marks = !!(rator_flags & LAMBDA_PRESERVES_MARKS);
4019 146152: 4014: info->single_result = !!(rator_flags & LAMBDA_SINGLE_RESULT);
4020 146152: 4015: if (rator_flags & LAMBDA_RESULT_TENTATIVE) {
4021 6358: 4016: info->preserves_marks = -info->preserves_marks;
4022 6358: 4017: info->single_result = -info->single_result;
4023 -: 4018: }
4024 -: 4019:
4025 146152: 4020: if (SCHEME_PRIMP(app->args[0])
4026 80694: 4021: && (app->num_args >= ((Scheme_Primitive_Proc *)app->args[0])->mina)
4027 80425: 4022: && (app->num_args <= ((Scheme_Primitive_Proc *)app->args[0])->mu.maxa)) {
4028 80405: 4023: Scheme_Object *app_o = (Scheme_Object *)app, *rator = app->args[0];
4029 80405: 4024: Scheme_Object *rand1 = NULL, *rand2 = NULL, *rand3 = NULL;
4030 -: 4025:
4031 80405: 4026: if (app->num_args >= 1)
4032 66537: 4027: rand1 = app->args[1];
4033 -: 4028:
4034 80405: 4029: if (app->num_args >= 2)
4035 66537: 4030: rand2 = app->args[2];
4036 -: 4031:
4037 80405: 4032: if (app->num_args >= 3)
4038 66537: 4033: rand3 = app->args[3];
4039 -: 4034:
4040 80405: 4035: check_known(info, app_o, rator, rand1, "vector-set!", scheme_vector_p_proc, NULL);
4041 80405: 4036: check_known(info, app_o, rator, rand2, "vector-set!", scheme_fixnum_p_proc, NULL);
4042 -: 4037:
4043 80405: 4038: check_known(info, app_o, rator, rand1, "procedure-arity-includes?", scheme_procedure_p_proc, NULL);
4044 -: 4039:
4045 80405: 4040: check_known(info, app_o, rator, rand1, "map", scheme_procedure_p_proc, NULL);
4046 80405: 4041: check_known(info, app_o, rator, rand1, "for-each", scheme_procedure_p_proc, NULL);
4047 80405: 4042: check_known(info, app_o, rator, rand1, "andmap", scheme_procedure_p_proc, NULL);
4048 80405: 4043: check_known(info, app_o, rator, rand1, "ormap", scheme_procedure_p_proc, NULL);
4049 80405: 4044: check_known_all(info, app_o, 1, 0, "map", scheme_list_p_proc, NULL);
4050 80405: 4045: check_known_all(info, app_o, 1, 0, "for-each", scheme_list_p_proc, NULL);
4051 80405: 4046: check_known_all(info, app_o, 1, 0, "andmap", scheme_list_p_proc, NULL);
4052 80405: 4047: check_known_all(info, app_o, 1, 0, "ormap", scheme_list_p_proc, NULL);
4053 -: 4048:
4054 80405: 4049: check_known(info, app_o, rator, rand1, "string-set!", scheme_string_p_proc, NULL);
4055 80405: 4050: check_known(info, app_o, rator, rand2, "string-set!", scheme_fixnum_p_proc, NULL);
4056 80405: 4051: check_known(info, app_o, rator, rand3, "string-set!", scheme_char_p_proc, NULL);
4057 80405: 4052: check_known(info, app_o, rator, rand1, "bytes-set!", scheme_byte_string_p_proc, NULL);
4058 80405: 4053: check_known(info, app_o, rator, rand2, "bytes-set!", scheme_fixnum_p_proc, NULL);
4059 80405: 4054: check_known(info, app_o, rator, rand3, "bytes-set!", scheme_fixnum_p_proc, NULL);
4060 -: 4055:
4061 80405: 4056: check_known_all(info, app_o, 0, 0, "string-append", scheme_string_p_proc, scheme_true);
4062 80405: 4057: check_known_all(info, app_o, 0, 0, "bytes-append", scheme_byte_string_p_proc, scheme_true);
4063 -: 4058:
4064 80405: 4059: check_known_all(info, app_o, 0, 1, "append", scheme_list_p_proc, scheme_true);
4065 -: 4060:
4066 80405: 4061: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_REAL)
4067 282: 4062: check_known_all(info, app_o, 0, 0, NULL, scheme_real_p_proc,
4068 282: 4063: (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS) ? scheme_true : NULL);
4069 80405: 4064: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_NUMBER)
4070 333: 4065: check_known_all(info, app_o, 0, 0, NULL, scheme_number_p_proc,
4071 333: 4066: (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS) ? scheme_true : NULL);
4072 -: 4067: }
4073 -: 4068:
4074 146152: 4069: register_local_argument_types(app, NULL, NULL, info);
4075 -: 4070:
4076 146152: 4071: flags = appn_flags(app->args[0], info);
4077 146152: 4072: SCHEME_APPN_FLAGS(app) |= flags;
4078 -: 4073:
4079 146152: 4074: return finish_optimize_any_application((Scheme_Object *)app, app->args[0], app->num_args,
4080 -: 4075: info, context);
4081 -: 4076:}
4082 -: 4077:
4083 359941: 4078:static Scheme_Object *try_reduce_predicate(Scheme_Object *rator, Scheme_Object *rand,
4084 -: 4079: Optimize_Info *info)
4085 -: 4080:/* Change (pair? (list X complex-Y Z)) => (begin complex-Y #t), etc.
4086 -: 4081: It's especially nice to avoid the constructions. */
4087 -: 4082:{
4088 -: 4083: Scheme_Object *pred;
4089 -: 4084:
4090 359941: 4085: if (!relevant_predicate(rator))
4091 271327: 4086: return NULL;
4092 -: 4087:
4093 88614: 4088: pred = expr_implies_predicate(rand, info);
4094 -: 4089:
4095 88614: 4090: if (!pred)
4096 78393: 4091: return NULL;
4097 -: 4092:
4098 10221: 4093: if (predicate_implies(pred, rator))
4099 2433: 4094: return make_discarding_sequence(rand, scheme_true, info);
4100 7788: 4095: else if (predicate_implies_not(pred, rator))
4101 768: 4096: return make_discarding_sequence(rand, scheme_false, info);
4102 -: 4097:
4103 7020: 4098: return NULL;
4104 -: 4099:}
4105 -: 4100:
4106 546746: 4101:static Scheme_Object *check_ignored_call_cc(Scheme_Object *rator, Scheme_Object *rand,
4107 -: 4102: Optimize_Info *info, int context)
4108 -: 4103:/* Convert (call/cc (lambda (ignored) body ...)) to (begin body ...) */
4109 -: 4104:{
4110 546746: 4105: if (SCHEME_PRIMP(rator)
4111 361918: 4106: && (IS_NAMED_PRIM(rator, "call-with-current-continuation")
4112 361914: 4107: || IS_NAMED_PRIM(rator, "call-with-composable-continuation")
4113 361905: 4108: || IS_NAMED_PRIM(rator, "call-with-escape-continuation"))) {
4114 -: 4109: Scheme_Object *proc;
4115 -: 4110:
4116 587: 4111: proc = lookup_constant_proc(info, rand, 1);
4117 -: 4112:
4118 587: 4113: if (proc && SAME_TYPE(SCHEME_TYPE(proc), scheme_ir_lambda_type)) {
4119 587: 4114: Scheme_Lambda *lam = (Scheme_Lambda *)proc;
4120 587: 4115: if (lam->num_params == 1) {
4121 587: 4116: Scheme_IR_Lambda_Info *cl = lam->ir_info;
4122 587: 4117: if (!cl->vars[0]->use_count) {
4123 -: 4118: Scheme_Object *expr;
4124 8: 4119: info->vclock++;
4125 8: 4120: expr = make_application_2(rand, scheme_void, info);
4126 8: 4121: if (IS_NAMED_PRIM(rator, "call-with-escape-continuation")) {
4127 -: 4122: Scheme_Sequence *seq;
4128 -: 4123:
4129 2: 4124: seq = scheme_malloc_sequence(1);
4130 2: 4125: seq->so.type = scheme_begin0_sequence_type;
4131 2: 4126: seq->count = 1;
4132 2: 4127: seq->array[0] = expr;
4133 -: 4128:
4134 2: 4129: expr = (Scheme_Object *)seq;
4135 -: 4130: }
4136 8: 4131: return scheme_optimize_expr(expr, info, context);
4137 -: 4132: }
4138 -: 4133: }
4139 -: 4134: }
4140 -: 4135: }
4141 546738: 4136: return NULL;
4142 -: 4137:}
4143 -: 4138:
4144 605: 4139:static Scheme_Object *make_optimize_prim_application2(Scheme_Object *prim, Scheme_Object *rand,
4145 -: 4140: Optimize_Info *info, int context)
4146 -: 4141:/* make (prim rand) and optimize it. rand must be already optimized */
4147 -: 4142:{
4148 -: 4143: Scheme_Object *alt;
4149 605: 4144: alt = make_application_2(prim, rand, info);
4150 -: 4145: /* scheme_make_application may use constant folding, check that alt is not a constant */
4151 605: 4146: if (SAME_TYPE(SCHEME_TYPE(alt), scheme_application2_type)) {
4152 605: 4147: return finish_optimize_application2((Scheme_App2_Rec *)alt, info, context);
4153 -: 4148: } else
4154 #####: 4149: return alt;
4155 -: 4150:}
4156 -: 4151:
4157 -: 4152:
4158 548092: 4153:static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *info, int context)
4159 -: 4154:{
4160 -: 4155: Scheme_App2_Rec *app;
4161 -: 4156: Scheme_Object *le;
4162 -: 4157: int rator_apply_escapes, sub_context, ty;
4163 -: 4158: Optimize_Info_Sequence info_seq;
4164 -: 4159:
4165 548092: 4160: app = (Scheme_App2_Rec *)o;
4166 -: 4161:
4167 548092: 4162: le = check_app_let_rator(o, app->rator, info, 1, context);
4168 548092: 4163: if (le)
4169 1346: 4164: return le;
4170 -: 4165:
4171 546746: 4166: le = check_ignored_call_cc(app->rator, app->rand, info, context);
4172 546746: 4167: if (le)
4173 8: 4168: return le;
4174 -: 4169:
4175 546738: 4170: le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, context, 0);
4176 546737: 4171: if (le)
4177 17109: 4172: return le;
4178 -: 4173:
4179 529628: 4174: optimize_info_seq_init(info, &info_seq);
4180 -: 4175:
4181 529628: 4176: sub_context = OPT_CONTEXT_SINGLED;
4182 -: 4177:
4183 529628: 4178: le = scheme_optimize_expr(app->rator, info, sub_context);
4184 529628: 4179: app->rator = le;
4185 529628: 4180: if (info->escapes) {
4186 2: 4181: optimize_info_seq_done(info, &info_seq);
4187 2: 4182: return ensure_noncm(app->rator);
4188 -: 4183: }
4189 -: 4184:
4190 -: 4185: {
4191 -: 4186: /* Maybe found "((lambda" after optimizing; try again */
4192 529626: 4187: le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, context, 1);
4193 529626: 4188: if (le)
4194 189: 4189: return le;
4195 529437: 4190: rator_apply_escapes = info->escapes;
4196 -: 4191: }
4197 -: 4192:
4198 529437: 4193: if (SAME_PTR(scheme_not_proc, app->rator)){
4199 5223: 4194: sub_context |= OPT_CONTEXT_BOOLEAN;
4200 -: 4195: } else {
4201 524214: 4196: ty = wants_local_type_arguments(app->rator, 0);
4202 524214: 4197: if (ty)
4203 8: 4198: sub_context |= (ty << OPT_CONTEXT_TYPE_SHIFT);
4204 -: 4199: }
4205 -: 4200:
4206 529437: 4201: optimize_info_seq_step(info, &info_seq);
4207 -: 4202:
4208 529437: 4203: le = scheme_optimize_expr(app->rand, info, sub_context);
4209 529437: 4204: app->rand = le;
4210 529437: 4205: optimize_info_seq_done(info, &info_seq);
4211 529437: 4206: if (info->escapes) {
4212 18: 4207: info->size += 1;
4213 18: 4208: return ensure_noncm(make_discarding_first_sequence(app->rator, app->rand, info));
4214 -: 4209: }
4215 -: 4210:
4216 529419: 4211: if (rator_apply_escapes) {
4217 10: 4212: info->escapes = 1;
4218 10: 4213: SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
4219 -: 4214: }
4220 -: 4215:
4221 529419: 4216: return finish_optimize_application2(app, info, context);
4222 -: 4217:}
4223 -: 4218:
4224 530055: 4219:static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimize_Info *info, int context)
4225 -: 4220:{
4226 -: 4221: int flags, rator_flags;
4227 530055: 4222: Scheme_Object *rator = app->rator, *rator_for_flags;
4228 530055: 4223: Scheme_Object *rand, *inside = NULL, *alt;
4229 -: 4224:
4230 530055: 4225: info->size += 1;
4231 -: 4226:
4232 -: 4227: /* Path for direct constant folding */
4233 530055: 4228: if (SCHEME_TYPE(app->rand) > _scheme_ir_values_types_) {
4234 -: 4229: Scheme_Object *le;
4235 36360: 4230: le = try_optimize_fold(rator, NULL, (Scheme_Object *)app, info);
4236 36360: 4231: if (le)
4237 2510: 4232: return le;
4238 -: 4233: }
4239 -: 4234:
4240 527545: 4235: rand = app->rand;
4241 -: 4236:
4242 -: 4237: /* We can go inside a `begin' and a `let', which is useful in case
4243 -: 4238: the argument was a function call that has been inlined. */
4244 527545: 4239: extract_tail_inside(&rand, &inside);
4245 -: 4240:
4246 527545: 4241: if (SCHEME_TYPE(rand) > _scheme_ir_values_types_) {
4247 -: 4242: Scheme_Object *le;
4248 33862: 4243: le = try_optimize_fold(rator, scheme_make_pair(rand, scheme_null), NULL, info);
4249 33862: 4244: if (le)
4250 12: 4245: return replace_tail_inside(le, inside, app->rand);
4251 -: 4246: }
4252 -: 4247:
4253 527533: 4248: increment_clocks_for_application(info, rator, 1);
4254 -: 4249:
4255 527533: 4250: rator_for_flags = lookup_constant_proc(info, rator, 1);
4256 527533: 4251: rator_flags = scheme_get_rator_flags(rator_for_flags);
4257 527533: 4252: info->preserves_marks = !!(rator_flags & LAMBDA_PRESERVES_MARKS);
4258 527533: 4253: info->single_result = !!(rator_flags & LAMBDA_SINGLE_RESULT);
4259 527533: 4254: if (rator_flags & LAMBDA_RESULT_TENTATIVE) {
4260 8530: 4255: info->preserves_marks = -info->preserves_marks;
4261 8530: 4256: info->single_result = -info->single_result;
4262 -: 4257: }
4263 -: 4258:
4264 527533: 4259: if (SAME_OBJ(scheme_values_proc, rator)
4265 522564: 4260: || SAME_OBJ(scheme_list_star_proc, rator)
4266 522558: 4261: || (SCHEME_PRIMP(rator) && IS_NAMED_PRIM(rator, "append"))) {
4267 4991: 4262: SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
4268 4991: 4263: info->preserves_marks = 1;
4269 4991: 4264: info->single_result = 1;
4270 4991: 4265: if ((context & OPT_CONTEXT_SINGLED)
4271 4499: 4266: || scheme_omittable_expr(rand, 1, -1, 0, info, info)
4272 4299: 4267: || single_valued_noncm_expression(rand, 5)) {
4273 740: 4268: return replace_tail_inside(rand, inside, app->rand);
4274 -: 4269: }
4275 4251: 4270: app->rator = scheme_values_proc;
4276 4251: 4271: rator = scheme_values_proc;
4277 -: 4272: }
4278 -: 4273:
4279 526793: 4274: if (SCHEME_PRIMP(rator)) {
4280 -: 4275: /* Check for things like (cXr (cons X Y)): */
4281 360101: 4276: switch (SCHEME_TYPE(rand)) {
4282 -: 4277: case scheme_application2_type:
4283 -: 4278: {
4284 30263: 4279: Scheme_App2_Rec *app2 = (Scheme_App2_Rec *)rand;
4285 30263: 4280: if (IS_NAMED_PRIM(rator, "car")
4286 28663: 4281: || IS_NAMED_PRIM(rator, "unsafe-car")) {
4287 3198: 4282: if (SAME_OBJ(scheme_list_proc, app2->rator)) {
4288 -: 4283: /* (car (list X)) */
4289 2: 4284: alt = ensure_single_value_noncm(app2->rand);
4290 2: 4285: return replace_tail_inside(alt, inside, app->rand);
4291 -: 4286: }
4292 28663: 4287: } else if (IS_NAMED_PRIM(rator, "cdr")
4293 27593: 4288: || IS_NAMED_PRIM(rator, "unsafe-cdr")) {
4294 2112: 4289: if (SAME_OBJ(scheme_list_proc, app2->rator)) {
4295 -: 4290: /* (cdr (list X)) */
4296 28: 4291: alt = make_discarding_sequence(app2->rand, scheme_null, info);
4297 28: 4292: return replace_tail_inside(alt, inside, app->rand);
4298 -: 4293: }
4299 27593: 4294: } else if (IS_NAMED_PRIM(rator, "unbox")
4300 27353: 4295: || IS_NAMED_PRIM(rator, "unsafe-unbox")
4301 27351: 4296: || IS_NAMED_PRIM(rator, "unsafe-unbox*")) {
4302 244: 4297: if (SAME_OBJ(scheme_box_proc, app2->rator)) {
4303 -: 4298: /* (unbox (box X)) */
4304 6: 4299: alt = ensure_single_value_noncm(app2->rand);
4305 6: 4300: return replace_tail_inside(alt, inside, app->rand);
4306 -: 4301: }
4307 -: 4302: }
4308 30227: 4303: break;
4309 -: 4304: }
4310 -: 4305: case scheme_application3_type:
4311 -: 4306: {
4312 23365: 4307: Scheme_App3_Rec *app3 = (Scheme_App3_Rec *)rand;
4313 23365: 4308: if (IS_NAMED_PRIM(rator, "car")
4314 23264: 4309: || IS_NAMED_PRIM(rator, "unsafe-car")) {
4315 154: 4310: if (SAME_OBJ(scheme_cons_proc, app3->rator)
4316 65: 4311: || SAME_OBJ(scheme_unsafe_cons_list_proc, app3->rator)
4317 63: 4312: || SAME_OBJ(scheme_list_proc, app3->rator)
4318 55: 4313: || SAME_OBJ(scheme_list_star_proc, app3->rator)) {
4319 -: 4314: /* (car ({cons|list|list*} X Y)) */
4320 52: 4315: alt = make_discarding_reverse_sequence(app3->rand2, app3->rand1, info);
4321 52: 4316: return replace_tail_inside(alt, inside, app->rand);
4322 -: 4317: }
4323 23262: 4318: } else if (IS_NAMED_PRIM(rator, "cdr")
4324 22977: 4319: || IS_NAMED_PRIM(rator, "unsafe-cdr")) {
4325 730: 4320: if (SAME_OBJ(scheme_cons_proc, app3->rator)
4326 367: 4321: || SAME_OBJ(scheme_unsafe_cons_list_proc, app3->rator)
4327 365: 4322: || SAME_OBJ(scheme_list_star_proc, app3->rator)) {
4328 -: 4323: /* (cdr ({cons|list*} X Y)) */
4329 32: 4324: alt = make_discarding_sequence(app3->rand1, app3->rand2, info);
4330 32: 4325: return replace_tail_inside(alt, inside, app->rand);
4331 363: 4326: } else if (SAME_OBJ(scheme_list_proc, app3->rator)) {
4332 -: 4327: /* (cdr (list X Y)) */
4333 28: 4328: alt = make_application_2(scheme_list_proc, app3->rand2, info);
4334 28: 4329: SCHEME_APPN_FLAGS(((Scheme_App_Rec *)alt)) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
4335 28: 4330: alt = make_discarding_sequence(app3->rand1, alt, info);
4336 28: 4331: return replace_tail_inside(alt, inside, app->rand);
4337 -: 4332: }
4338 22867: 4333: } else if (IS_NAMED_PRIM(rator, "cadr")) {
4339 34: 4334: if (SAME_OBJ(scheme_list_proc, app3->rator)) {
4340 -: 4335: /* (cadr (list X Y)) */
4341 2: 4336: alt = make_discarding_sequence(app3->rand1, app3->rand2, info);
4342 2: 4337: return replace_tail_inside(alt, inside, app->rand);
4343 -: 4338: }
4344 -: 4339: }
4345 23251: 4340: break;
4346 -: 4341: }
4347 -: 4342: case scheme_application_type:
4348 -: 4343: {
4349 3214: 4344: Scheme_App_Rec *appr = (Scheme_App_Rec *)rand;
4350 3214: 4345: Scheme_Object *r = appr->args[0];
4351 3214: 4346: if (IS_NAMED_PRIM(rator, "car")
4352 3202: 4347: || IS_NAMED_PRIM(rator, "unsafe-car")) {
4353 20: 4348: if ((appr->args > 0)
4354 12: 4349: && (SAME_OBJ(scheme_list_proc, r)
4355 10: 4350: || SAME_OBJ(scheme_list_star_proc, r))) {
4356 -: 4351: /* (car ({list|list*} X Y ...)) */
4357 4: 4352: alt = make_discarding_app_sequence(appr, 0, NULL, info);
4358 4: 4353: return replace_tail_inside(alt, inside, app->rand);
4359 -: 4354: }
4360 3202: 4355: } else if (IS_NAMED_PRIM(rator, "cdr")
4361 3185: 4356: || IS_NAMED_PRIM(rator, "unsafe-cdr")) {
4362 -: 4357: /* (cdr ({list|list*} X Y ...)) */
4363 17: 4358: if ((appr->args > 0)
4364 17: 4359: && (SAME_OBJ(scheme_list_proc, r)
4365 13: 4360: || SAME_OBJ(scheme_list_star_proc, r))) {
4366 6: 4361: Scheme_Object *al = scheme_null;
4367 -: 4362: int k;
4368 18: 4363: for (k = appr->num_args; k > 1; k--) {
4369 12: 4364: al = scheme_make_pair(appr->args[k], al);
4370 -: 4365: }
4371 6: 4366: al = scheme_make_pair(r, al);
4372 6: 4367: alt = scheme_make_application(al, info);
4373 6: 4368: SCHEME_APPN_FLAGS(((Scheme_App_Rec *)alt)) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
4374 6: 4369: alt = make_discarding_sequence(appr->args[1], alt, info);
4375 6: 4370: return replace_tail_inside(alt, inside, app->rand);
4376 -: 4371: }
4377 -: 4372: }
4378 3204: 4373: break;
4379 -: 4374: }
4380 -: 4375: }
4381 -: 4376:
4382 359941: 4377: alt = try_reduce_predicate(rator, rand, info);
4383 359941: 4378: if (alt)
4384 3201: 4379: return replace_tail_inside(alt, inside, app->rand);
4385 -: 4380:
4386 356740: 4381: if (SAME_OBJ(scheme_struct_type_p_proc, rator)) {
4387 -: 4382: Scheme_Object *c;
4388 148: 4383: c = get_struct_proc_shape(rand, info, 0);
4389 148: 4384: if (c && ((SCHEME_PROC_SHAPE_MODE(c) & STRUCT_PROC_SHAPE_MASK)
4390 -: 4385: == STRUCT_PROC_SHAPE_STRUCT)) {
4391 4: 4386: info->preserves_marks = 1;
4392 4: 4387: info->single_result = 1;
4393 4: 4388: return replace_tail_inside(scheme_true, inside, app->rand);
4394 -: 4389: }
4395 -: 4390: }
4396 -: 4391:
4397 356736: 4392: if (SAME_OBJ(scheme_varref_const_p_proc, rator)
4398 840: 4393: && SAME_TYPE(SCHEME_TYPE(rand), scheme_varref_form_type)) {
4399 840: 4394: Scheme_Object *var = SCHEME_PTR1_VAL(rand);
4400 840: 4395: if (SAME_OBJ(var, scheme_true)) {
4401 6: 4396: info->preserves_marks = 1;
4402 6: 4397: info->single_result = 1;
4403 6: 4398: return replace_tail_inside(scheme_true, inside, app->rand);
4404 834: 4399: } else if (SAME_OBJ(var, scheme_false)) {
4405 4: 4400: info->preserves_marks = 1;
4406 4: 4401: info->single_result = 1;
4407 4: 4402: return replace_tail_inside(scheme_false, inside, app->rand);
4408 -: 4403: } else {
4409 830: 4404: if (var && scheme_ir_propagate_ok(var, info)) {
4410 -: 4405: /* can propagate => is a constant */
4411 765: 4406: info->preserves_marks = 1;
4412 765: 4407: info->single_result = 1;
4413 765: 4408: return replace_tail_inside(scheme_true, inside, app->rand);
4414 -: 4409: }
4415 -: 4410: }
4416 -: 4411: }
4417 -: 4412:
4418 -: 4413:
4419 355961: 4414: if (SCHEME_PRIMP(rator) && IS_NAMED_PRIM(rator, "zero?")) {
4420 -: 4415: Scheme_Object* pred;
4421 -: 4416: Scheme_App3_Rec *new;
4422 -: 4417:
4423 2804: 4418: pred = expr_implies_predicate(rand, info);
4424 2804: 4419: if (pred && SAME_OBJ(pred, scheme_fixnum_p_proc)) {
4425 110: 4420: new = (Scheme_App3_Rec *)make_application_3(scheme_unsafe_fx_eq_proc, app->rand, scheme_make_integer(0), info);
4426 110: 4421: SCHEME_APPN_FLAGS(new) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
4427 110: 4422: return finish_optimize_application3(new, info, context);
4428 -: 4423: }
4429 -: 4424: }
4430 -: 4425:
4431 -: 4426: {
4432 -: 4427: /* Try to check the argument's type, and use the unsafe versions if possible. */
4433 355851: 4428: Scheme_Object *app_o = (Scheme_Object *)app;
4434 -: 4429:
4435 355851: 4430: check_known_variant(info, app_o, rator, rand, "bitwise-not", scheme_fixnum_p_proc, scheme_unsafe_fxnot_proc, scheme_real_p_proc);
4436 355851: 4431: check_known_variant(info, app_o, rator, rand, "fxnot", scheme_fixnum_p_proc, scheme_unsafe_fxnot_proc, scheme_real_p_proc);
4437 -: 4432:
4438 355851: 4433: check_known(info, app_o, rator, rand, "car", scheme_pair_p_proc, scheme_unsafe_car_proc);
4439 355851: 4434: check_known(info, app_o, rator, rand, "unsafe-car", scheme_pair_p_proc, NULL);
4440 355851: 4435: check_known(info, app_o, rator, rand, "cdr", scheme_pair_p_proc, scheme_unsafe_cdr_proc);
4441 355851: 4436: check_known(info, app_o, rator, rand, "unsafe-cdr", scheme_pair_p_proc, NULL);
4442 355851: 4437: check_known(info, app_o, rator, rand, "mcar", scheme_mpair_p_proc, scheme_unsafe_mcar_proc);
4443 355851: 4438: check_known(info, app_o, rator, rand, "unsafe-mcar", scheme_mpair_p_proc, NULL);
4444 355851: 4439: check_known(info, app_o, rator, rand, "mcdr", scheme_mpair_p_proc, scheme_unsafe_mcdr_proc);
4445 355851: 4440: check_known(info, app_o, rator, rand, "unsafe-mcdr", scheme_mpair_p_proc, NULL);
4446 355851: 4441: check_known(info, app_o, rator, rand, "string-length", scheme_string_p_proc, scheme_unsafe_string_length_proc);
4447 355851: 4442: check_known(info, app_o, rator, rand, "bytes-length", scheme_byte_string_p_proc, scheme_unsafe_byte_string_length_proc);
4448 -: 4443: /* It's not clear that these are useful, since a chaperone check is needed anyway: */
4449 355851: 4444: check_known(info, app_o, rator, rand, "unbox", scheme_box_p_proc, scheme_unsafe_unbox_proc);
4450 355851: 4445: check_known(info, app_o, rator, rand, "unsafe-unbox", scheme_box_p_proc, NULL);
4451 355851: 4446: check_known(info, app_o, rator, rand, "unsafe-unbox*", scheme_box_p_proc, NULL);
4452 355851: 4447: check_known(info, app_o, rator, rand, "vector-length", scheme_vector_p_proc, scheme_unsafe_vector_length_proc);
4453 -: 4448:
4454 355851: 4449: check_known(info, app_o, rator, rand, "length", scheme_list_p_proc, scheme_true);
4455 -: 4450:
4456 355851: 4451: check_known(info, app_o, rator, rand, "string-append", scheme_string_p_proc, scheme_true);
4457 355851: 4452: check_known(info, app_o, rator, rand, "bytes-append", scheme_byte_string_p_proc, scheme_true);
4458 355851: 4453: check_known(info, app_o, rator, rand, "string->immutable-string", scheme_string_p_proc, scheme_true);
4459 355851: 4454: check_known(info, app_o, rator, rand, "bytes->immutable-bytes", scheme_byte_string_p_proc, scheme_true);
4460 -: 4455:
4461 355851: 4456: check_known(info, app_o, rator, rand, "string->symbol", scheme_string_p_proc, scheme_true);
4462 355851: 4457: check_known(info, app_o, rator, rand, "symbol->string", scheme_symbol_p_proc, scheme_true);
4463 355851: 4458: check_known(info, app_o, rator, rand, "string->keyword", scheme_string_p_proc, scheme_true);
4464 355851: 4459: check_known(info, app_o, rator, rand, "keyword->string", scheme_keyword_p_proc, scheme_true);
4465 -: 4460:
4466 355851: 4461: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_REAL)
4467 512: 4462: check_known(info, app_o, rator, rand, NULL, scheme_real_p_proc,
4468 512: 4463: (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS) ? scheme_true : NULL);
4469 355851: 4464: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_NUMBER)
4470 11669: 4465: check_known(info, app_o, rator, rand, NULL, scheme_number_p_proc,
4471 11669: 4466: (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS) ? scheme_true : NULL);
4472 -: 4467:
4473 -: 4468: /* These operation don't have an unsafe replacement. Check to record types and detect errors: */
4474 355851: 4469: check_known(info, app_o, rator, rand, "caar", scheme_pair_p_proc, NULL);
4475 355851: 4470: check_known(info, app_o, rator, rand, "cadr", scheme_pair_p_proc, NULL);
4476 355851: 4471: check_known(info, app_o, rator, rand, "cdar", scheme_pair_p_proc, NULL);
4477 355851: 4472: check_known(info, app_o, rator, rand, "cddr", scheme_pair_p_proc, NULL);
4478 -: 4473:
4479 355851: 4474: check_known(info, app_o, rator, rand, "caddr", scheme_pair_p_proc, NULL);
4480 355851: 4475: check_known(info, app_o, rator, rand, "cdddr", scheme_pair_p_proc, NULL);
4481 355851: 4476: check_known(info, app_o, rator, rand, "cadddr", scheme_pair_p_proc, NULL);
4482 355851: 4477: check_known(info, app_o, rator, rand, "cddddr", scheme_pair_p_proc, NULL);
4483 -: 4478:
4484 355851: 4479: check_known(info, app_o, rator, rand, "list->vector", scheme_list_p_proc, scheme_true);
4485 355851: 4480: check_known(info, app_o, rator, rand, "vector->list", scheme_vector_p_proc, NULL);
4486 355851: 4481: check_known(info, app_o, rator, rand, "vector->values", scheme_vector_p_proc, NULL);
4487 355851: 4482: check_known(info, app_o, rator, rand, "vector->immutable-vector", scheme_vector_p_proc, NULL);
4488 355851: 4483: check_known(info, app_o, rator, rand, "make-vector", scheme_fixnum_p_proc, NULL);
4489 -: 4484:
4490 -: 4485: /* Some of these may have changed app->rator. */
4491 355851: 4486: rator = app->rator;
4492 -: 4487: }
4493 -: 4488: }
4494 -: 4489:
4495 -: 4490: /* Using a struct getter or predicate? */
4496 522543: 4491: alt = get_struct_proc_shape(rator, info, 0);
4497 522543: 4492: if (alt) {
4498 11220: 4493: int mode = (SCHEME_PROC_SHAPE_MODE(alt) & STRUCT_PROC_SHAPE_MASK);
4499 -: 4494:
4500 11220: 4495: if ((mode == STRUCT_PROC_SHAPE_PRED)
4501 8392: 4496: || (mode == STRUCT_PROC_SHAPE_GETTER)) {
4502 -: 4497: Scheme_Object *pred;
4503 9887: 4498: pred = expr_implies_predicate(rand, info);
4504 -: 4499:
4505 9887: 4500: if (pred
4506 2578: 4501: && SAME_TYPE(SCHEME_TYPE(pred), scheme_struct_proc_shape_type)
4507 2548: 4502: && is_struct_identity_subtype(SCHEME_PROC_SHAPE_IDENTITY(pred),
4508 -: 4503: SCHEME_PROC_SHAPE_IDENTITY(alt))) {
4509 2296: 4504: if (mode == STRUCT_PROC_SHAPE_PRED) {
4510 -: 4505: /* We know that the predicate will succeed */
4511 18: 4506: return replace_tail_inside(make_discarding_sequence(rand, scheme_true, info),
4512 -: 4507: inside,
4513 -: 4508: app->rand);
4514 -: 4509: } else {
4515 -: 4510: /* Struct type matches, so use `unsafe-struct-ref` */
4516 -: 4511: Scheme_App3_Rec *new;
4517 2278: 4512: new = (Scheme_App3_Rec *)make_application_3(scheme_unsafe_struct_ref_proc,
4518 -: 4513: app->rand,
4519 2278: 4514: scheme_make_integer(SCHEME_PROC_SHAPE_MODE(alt) >> STRUCT_PROC_SHAPE_SHIFT),
4520 -: 4515: info);
4521 2278: 4516: SCHEME_APPN_FLAGS(new) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
4522 2278: 4517: return finish_optimize_application3(new, info, context);
4523 -: 4518: }
4524 -: 4519: }
4525 -: 4520:
4526 -: 4521: /* Register type based on getter succeeding: */
4527 7591: 4522: if ((mode == STRUCT_PROC_SHAPE_GETTER)
4528 4781: 4523: && SCHEME_PAIRP(SCHEME_PROC_SHAPE_IDENTITY(alt))
4529 4781: 4524: && SAME_TYPE(SCHEME_TYPE(rand), scheme_ir_local_type))
4530 3489: 4525: add_type(info, rand, scheme_make_struct_proc_shape(STRUCT_PROC_SHAPE_PRED,
4531 -: 4526: SCHEME_PROC_SHAPE_IDENTITY(alt)));
4532 -: 4527: }
4533 -: 4528: }
4534 -: 4529:
4535 520247: 4530: register_local_argument_types(NULL, app, NULL, info);
4536 -: 4531:
4537 520247: 4532: flags = appn_flags(rator, info);
4538 520247: 4533: SCHEME_APPN_FLAGS(app) |= flags;
4539 -: 4534:
4540 520247: 4535: return finish_optimize_any_application((Scheme_Object *)app, rator, 1, info, context);
4541 -: 4536:}
4542 -: 4537:
4543 298075: 4538:static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *info, int context)
4544 -: 4539:{
4545 -: 4540: Scheme_App3_Rec *app;
4546 -: 4541: Scheme_Object *le;
4547 -: 4542: int rator_apply_escapes, sub_context, ty, flags;
4548 -: 4543: Optimize_Info_Sequence info_seq;
4549 -: 4544:
4550 298075: 4545: app = (Scheme_App3_Rec *)o;
4551 -: 4546:
4552 298075: 4547: if (SAME_OBJ(app->rator, scheme_check_not_undefined_proc)
4553 178: 4548: && SCHEME_SYMBOLP(app->rand2)) {
4554 178: 4549: scheme_log(info->logger,
4555 -: 4550: SCHEME_LOG_DEBUG,
4556 -: 4551: 0,
4557 -: 4552: "warning%s: use-before-definition check inserted on variable: %S",
4558 -: 4553: scheme_optimize_context_to_string(info->context),
4559 -: 4554: app->rand2);
4560 -: 4555: }
4561 -: 4556:
4562 -: 4557: /* Check for (apply ... (list ...)) early: */
4563 298075: 4558: le = direct_apply((Scheme_Object *)app, app->rator, app->rand2, info);
4564 298075: 4559: if (le)
4565 20: 4560: return scheme_optimize_expr(le, info, context);
4566 -: 4561:
4567 298055: 4562: le = call_with_immed_mark(app->rator, app->rand1, app->rand2, NULL, info);
4568 298055: 4563: if (le)
4569 131: 4564: return scheme_optimize_expr(le, info, context);
4570 -: 4565:
4571 297924: 4566: le = check_app_let_rator(o, app->rator, info, 2, context);
4572 297924: 4567: if (le)
4573 1155: 4568: return le;
4574 -: 4569:
4575 296769: 4570: le = optimize_for_inline(info, app->rator, 2, NULL, NULL, app, context, 0);
4576 296769: 4571: if (le)
4577 26377: 4572: return le;
4578 -: 4573:
4579 270392: 4574: optimize_info_seq_init(info, &info_seq);
4580 -: 4575:
4581 270392: 4576: sub_context = OPT_CONTEXT_SINGLED;
4582 -: 4577:
4583 270392: 4578: le = scheme_optimize_expr(app->rator, info, sub_context);
4584 270392: 4579: app->rator = le;
4585 270392: 4580: if (info->escapes) {
4586 2: 4581: optimize_info_seq_done(info, &info_seq);
4587 2: 4582: return ensure_noncm(app->rator);
4588 -: 4583: }
4589 -: 4584:
4590 -: 4585: {
4591 -: 4586: /* Maybe found "((lambda" after optimizing; try again */
4592 270390: 4587: le = optimize_for_inline(info, app->rator, 2, NULL, NULL, app, context, 1);
4593 270390: 4588: if (le)
4594 21: 4589: return le;
4595 270369: 4590: rator_apply_escapes = info->escapes;
4596 -: 4591: }
4597 -: 4592:
4598 270369: 4593: if (SAME_OBJ(app->rator, scheme_values_proc)
4599 265140: 4594: || SAME_OBJ(app->rator, scheme_apply_proc))
4600 7395: 4595: info->maybe_values_argument = 1;
4601 -: 4596:
4602 -: 4597: /* 1st arg */
4603 -: 4598:
4604 270369: 4599: ty = wants_local_type_arguments(app->rator, 0);
4605 270369: 4600: if (ty)
4606 516: 4601: sub_context |= (ty << OPT_CONTEXT_TYPE_SHIFT);
4607 -: 4602:
4608 270369: 4603: optimize_info_seq_step(info, &info_seq);
4609 -: 4604:
4610 270369: 4605: le = scheme_optimize_expr(app->rand1, info, sub_context);
4611 270369: 4606: app->rand1 = le;
4612 270369: 4607: if (info->escapes) {
4613 37: 4608: info->size += 1;
4614 37: 4609: return ensure_noncm(make_discarding_first_sequence(app->rator, app->rand1, info));
4615 -: 4610: }
4616 -: 4611:
4617 -: 4612: /* 2nd arg */
4618 -: 4613:
4619 270332: 4614: ty = wants_local_type_arguments(app->rator, 1);
4620 270332: 4615: if (ty)
4621 516: 4616: sub_context |= (ty << OPT_CONTEXT_TYPE_SHIFT);
4622 -: 4617: else
4623 269816: 4618: sub_context &= ~OPT_CONTEXT_TYPE_MASK;
4624 -: 4619:
4625 270332: 4620: optimize_info_seq_step(info, &info_seq);
4626 -: 4621:
4627 270332: 4622: le = scheme_optimize_expr(app->rand2, info, sub_context);
4628 270332: 4623: app->rand2 = le;
4629 270332: 4624: optimize_info_seq_done(info, &info_seq);
4630 270332: 4625: if (info->escapes) {
4631 32: 4626: info->size += 1;
4632 32: 4627: le = make_discarding_first_sequence(app->rator,
4633 -: 4628: make_discarding_first_sequence(app->rand1, app->rand2,
4634 -: 4629: info),
4635 -: 4630: info);
4636 32: 4631: return ensure_noncm(le);
4637 -: 4632: }
4638 -: 4633:
4639 -: 4634: /* Check for (apply ... (list ...)) after some optimizations: */
4640 270300: 4635: le = direct_apply((Scheme_Object *)app, app->rator, app->rand2, info);
4641 270300: 4636: if (le) return finish_optimize_app(le, info, context);
4642 -: 4637:
4643 270250: 4638: flags = appn_flags(app->rator, info);
4644 270250: 4639: SCHEME_APPN_FLAGS(app) |= flags;
4645 -: 4640:
4646 270250: 4641: if (rator_apply_escapes) {
4647 102: 4642: info->escapes = 1;
4648 102: 4643: SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
4649 -: 4644: }
4650 -: 4645:
4651 270250: 4646: return finish_optimize_application3(app, info, context);
4652 -: 4647:}
4653 -: 4648:
4654 272671: 4649:static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimize_Info *info, int context)
4655 -: 4650:{
4656 -: 4651: int flags, rator_flags;
4657 -: 4652: Scheme_Object *le, *rator_for_flags;
4658 272671: 4653: int all_vals = 1;
4659 -: 4654:
4660 272671: 4655: info->size += 1;
4661 -: 4656:
4662 272671: 4657: if (SCHEME_TYPE(app->rand1) < _scheme_ir_values_types_)
4663 217418: 4658: all_vals = 0;
4664 272671: 4659: if (SCHEME_TYPE(app->rand2) < _scheme_ir_values_types_)
4665 203641: 4660: all_vals = 0;
4666 -: 4661:
4667 -: 4662:
4668 272671: 4663: if (all_vals) {
4669 8134: 4664: le = try_optimize_fold(app->rator, NULL, (Scheme_Object *)app, info);
4670 8134: 4665: if (le)
4671 1837: 4666: return le;
4672 -: 4667: }
4673 -: 4668:
4674 270834: 4669: increment_clocks_for_application(info, app->rator, 2);
4675 -: 4670:
4676 -: 4671: /* Check for (call-with-values (lambda () M) N): */
4677 270834: 4672: if (SAME_OBJ(app->rator, scheme_call_with_values_proc)) {
4678 1027: 4673: if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_ir_lambda_type)) {
4679 959: 4674: Scheme_Lambda *lam = (Scheme_Lambda *)app->rand1;
4680 -: 4675:
4681 959: 4676: if (!lam->num_params) {
4682 -: 4677: /* Convert to apply-values form: */
4683 1461: 4678: return optimize_apply_values(app->rand2, lam->body, info,
4684 959: 4679: ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_SINGLE_RESULT)
4685 502: 4680: ? ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_RESULT_TENTATIVE)
4686 -: 4681: ? -1
4687 502: 4682: : 1)
4688 -: 4683: : 0),
4689 -: 4684: context);
4690 -: 4685: }
4691 -: 4686: }
4692 -: 4687: }
4693 -: 4688:
4694 269875: 4689: if (SAME_OBJ(scheme_procedure_arity_includes_proc, app->rator)) {
4695 2754: 4690: if (SCHEME_INTP(app->rand2) && SCHEME_INT_VAL(app->rand2) >= 0) {
4696 -: 4691: Scheme_Object *proc;
4697 -: 4692:
4698 2502: 4693: proc = lookup_constant_proc(info, app->rand1, SCHEME_INT_VAL(app->rand2));
4699 2502: 4694: if (proc) {
4700 826: 4695: info->preserves_marks = 1;
4701 826: 4696: info->single_result = 1;
4702 826: 4697: return make_discarding_sequence(app->rand1,
4703 -: 4698: SAME_OBJ(proc, scheme_true) ? scheme_false : scheme_true,
4704 -: 4699: info);
4705 -: 4700: }
4706 -: 4701: }
4707 -: 4702: }
4708 -: 4703:
4709 269049: 4704: if (SAME_OBJ(app->rator, scheme_equal_proc)
4710 265183: 4705: || SAME_OBJ(app->rator, scheme_eqv_proc)
4711 264807: 4706: || SAME_OBJ(app->rator, scheme_eq_proc)) {
4712 19943: 4707: if (equivalent_exprs(app->rand1, app->rand2, NULL, NULL, 0)) {
4713 207: 4708: info->preserves_marks = 1;
4714 207: 4709: info->single_result = 1;
4715 207: 4710: return make_discarding_sequence_3(app->rand1, app->rand2, scheme_true, info);
4716 -: 4711: }
4717 -: 4712: {
4718 19736: 4713: Scheme_Object *pred1, *pred2, *pred_new = NULL;
4719 19736: 4714: int rel1=0, rel2=0, rel_max, eq_type=0;
4720 -: 4715:
4721 19736: 4716: pred1 = expr_implies_predicate(app->rand1, info);
4722 19736: 4717: pred2 = expr_implies_predicate(app->rand2, info);
4723 19736: 4718: rel1 = relevant_predicate(pred1);
4724 19736: 4719: rel2 = relevant_predicate(pred2);
4725 19736: 4720: if ((pred1 && pred2)
4726 1176: 4721: && (predicate_implies_not(pred1, pred2)
4727 1132: 4722: || predicate_implies_not(pred2, pred1))) {
4728 44: 4723: info->preserves_marks = 1;
4729 44: 4724: info->single_result = 1;
4730 44: 4725: return make_discarding_sequence_3(app->rand1, app->rand2, scheme_false, info);
4731 -: 4726: }
4732 -: 4727:
4733 -: 4728: /* Try to transform it into a predicate */
4734 19692: 4729: if (rel1 >= RLV_SINGLETON) {
4735 -: 4730: Scheme_Object *new_app;
4736 36: 4731: new_app = make_optimize_prim_application2(pred1, app->rand2, info, context);
4737 36: 4732: return make_discarding_sequence(app->rand1, new_app, info);
4738 -: 4733: }
4739 19656: 4734: if (rel2 >= RLV_SINGLETON) {
4740 -: 4735: Scheme_Object *new_app;
4741 475: 4736: new_app = make_optimize_prim_application2(pred2, app->rand1, info, context);
4742 475: 4737: return make_discarding_reverse_sequence(app->rand2, new_app, info);
4743 -: 4738: }
4744 -: 4739:
4745 -: 4740: /* Optimize `equal?' or `eqv?' test on certain types
4746 -: 4741: to `eqv?` or `eq?'. This is especially helpful for the JIT. */
4747 19181: 4742: if (SAME_OBJ(app->rator, scheme_eqv_proc))
4748 354: 4743: eq_type = RLV_EQV_TESTEABLE;
4749 19181: 4744: if (SAME_OBJ(app->rator, scheme_eq_proc))
4750 15389: 4745: eq_type = RLV_EQ_TESTEABLE;
4751 -: 4746:
4752 19181: 4747: rel_max = (rel1 >= rel2) ? rel1 : rel2;
4753 19181: 4748: if (rel_max >= RLV_EQ_TESTEABLE && eq_type < RLV_EQ_TESTEABLE)
4754 1131: 4749: pred_new = scheme_eq_proc;
4755 18050: 4750: else if (rel_max >= RLV_EQV_TESTEABLE && eq_type < RLV_EQV_TESTEABLE)
4756 71: 4751: pred_new = scheme_eqv_proc;
4757 -: 4752:
4758 19181: 4753: if (pred_new) {
4759 1202: 4754: app->rator = pred_new;
4760 1202: 4755: SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
4761 -: 4756:
4762 -: 4757: /* eq? and eqv? are foldable */
4763 1202: 4758: if (all_vals) {
4764 4: 4759: le = try_optimize_fold(app->rator, NULL, (Scheme_Object *)app, info);
4765 4: 4760: if (le)
4766 4: 4761: return le;
4767 -: 4762: }
4768 -: 4763: }
4769 -: 4764: }
4770 -: 4765: }
4771 -: 4766:
4772 268283: 4767: rator_for_flags = lookup_constant_proc(info, app->rator, 2);
4773 268283: 4768: rator_flags = scheme_get_rator_flags(rator_for_flags);
4774 268283: 4769: info->preserves_marks = !!(rator_flags & LAMBDA_PRESERVES_MARKS);
4775 268283: 4770: info->single_result = !!(rator_flags & LAMBDA_SINGLE_RESULT);
4776 268283: 4771: if (rator_flags & LAMBDA_RESULT_TENTATIVE) {
4777 6421: 4772: info->preserves_marks = -info->preserves_marks;
4778 6421: 4773: info->single_result = -info->single_result;
4779 -: 4774: }
4780 -: 4775:
4781 -: 4776: /* Ad hoc optimization of (unsafe-+ <x> 0), etc. */
4782 268283: 4777: if (SCHEME_PRIMP(app->rator)
4783 229402: 4778: && (SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_IS_UNSAFE_NONMUTATING)) {
4784 -: 4779: int z1, z2;
4785 -: 4780:
4786 33331: 4781: z1 = SAME_OBJ(app->rand1, scheme_make_integer(0));
4787 33331: 4782: z2 = SAME_OBJ(app->rand2, scheme_make_integer(0));
4788 33331: 4783: if (IS_NAMED_PRIM(app->rator, "unsafe-fx+")) {
4789 6538: 4784: if (z1)
4790 52: 4785: return ensure_single_value_noncm(app->rand2);
4791 6486: 4786: else if (z2)
4792 122: 4787: return ensure_single_value_noncm(app->rand1);
4793 26793: 4788: } else if (IS_NAMED_PRIM(app->rator, "unsafe-fx-")) {
4794 326: 4789: if (z2)
4795 2: 4790: return ensure_single_value_noncm(app->rand1);
4796 26467: 4791: } else if (IS_NAMED_PRIM(app->rator, "unsafe-fx*")) {
4797 4: 4792: if (z1 || z2) {
4798 #####: 4793: if (z1 && z2)
4799 #####: 4794: return scheme_make_integer(0);
4800 #####: 4795: else if (z2)
4801 #####: 4796: return make_discarding_sequence(app->rand1, scheme_make_integer(0), info);
4802 -: 4797: else
4803 #####: 4798: return make_discarding_sequence(app->rand2, scheme_make_integer(0), info);
4804 -: 4799: }
4805 4: 4800: if (SAME_OBJ(app->rand1, scheme_make_integer(1)))
4806 2: 4801: return ensure_single_value_noncm(app->rand2);
4807 2: 4802: if (SAME_OBJ(app->rand2, scheme_make_integer(1)))
4808 2: 4803: return ensure_single_value_noncm(app->rand1);
4809 26463: 4804: } else if (IS_NAMED_PRIM(app->rator, "unsafe-fxquotient")) {
4810 2: 4805: if (z1)
4811 #####: 4806: return make_discarding_sequence(app->rand2, scheme_make_integer(0), info);
4812 2: 4807: if (SAME_OBJ(app->rand2, scheme_make_integer(1)))
4813 2: 4808: return ensure_single_value_noncm(app->rand1);
4814 26461: 4809: } else if (IS_NAMED_PRIM(app->rator, "unsafe-fxremainder")
4815 26461: 4810: || IS_NAMED_PRIM(app->rator, "unsafe-fxmodulo")) {
4816 #####: 4811: if (z1)
4817 #####: 4812: return make_discarding_sequence(app->rand2, scheme_make_integer(0), info);
4818 #####: 4813: if (SAME_OBJ(app->rand2, scheme_make_integer(1)))
4819 #####: 4814: return make_discarding_sequence(app->rand1, scheme_make_integer(0), info);
4820 -: 4815: }
4821 -: 4816:
4822 33149: 4817: z1 = (SCHEME_FLOATP(app->rand1) && (SCHEME_FLOAT_VAL(app->rand1) == 0.0));
4823 33149: 4818: z2 = (SCHEME_FLOATP(app->rand2) && (SCHEME_FLOAT_VAL(app->rand2) == 0.0));
4824 -: 4819:
4825 33149: 4820: if (IS_NAMED_PRIM(app->rator, "unsafe-fl+")) {
4826 20: 4821: if (z1)
4827 2: 4822: return ensure_single_value_noncm(app->rand2);
4828 18: 4823: else if (z2)
4829 2: 4824: return ensure_single_value_noncm(app->rand1);
4830 33129: 4825: } else if (IS_NAMED_PRIM(app->rator, "unsafe-fl-")) {
4831 4: 4826: if (z2)
4832 2: 4827: return ensure_single_value_noncm(app->rand1);
4833 33125: 4828: } else if (IS_NAMED_PRIM(app->rator, "unsafe-fl*")) {
4834 22: 4829: if (SCHEME_FLOATP(app->rand1) && (SCHEME_FLOAT_VAL(app->rand1) == 1.0))
4835 2: 4830: return ensure_single_value_noncm(app->rand2);
4836 20: 4831: if (SCHEME_FLOATP(app->rand2) && (SCHEME_FLOAT_VAL(app->rand2) == 1.0))
4837 2: 4832: return ensure_single_value_noncm(app->rand1);
4838 33103: 4833: } else if (IS_NAMED_PRIM(app->rator, "unsafe-fl/")) {
4839 2: 4834: if (SCHEME_FLOATP(app->rand2) && (SCHEME_FLOAT_VAL(app->rand2) == 1.0))
4840 2: 4835: return ensure_single_value_noncm(app->rand1);
4841 -: 4836: }
4842 -: 4837:
4843 -: 4838: /* Possible improvement: detect 0 and 1 constants even when general
4844 -: 4839: extflonum operations are not supported. */
4845 -: 4840:#ifdef MZ_LONG_DOUBLE
4846 33137: 4841: z1 = (SCHEME_LONG_DBLP(app->rand1) && long_double_is_zero(SCHEME_LONG_DBL_VAL(app->rand1)));
4847 33137: 4842: z2 = (SCHEME_LONG_DBLP(app->rand2) && long_double_is_zero(SCHEME_LONG_DBL_VAL(app->rand2)));
4848 -: 4843:
4849 33137: 4844: if (IS_NAMED_PRIM(app->rator, "unsafe-extfl+")) {
4850 16: 4845: if (z1)
4851 #####: 4846: return ensure_single_value_noncm(app->rand2);
4852 16: 4847: else if (z2)
4853 #####: 4848: return ensure_single_value_noncm(app->rand1);
4854 33121: 4849: } else if (IS_NAMED_PRIM(app->rator, "unsafe-extfl-")) {
4855 #####: 4850: if (z2)
4856 #####: 4851: return ensure_single_value_noncm(app->rand1);
4857 33121: 4852: } else if (IS_NAMED_PRIM(app->rator, "unsafe-extfl*")) {
4858 18: 4853: if (SCHEME_LONG_DBLP(app->rand1) && long_double_is_1(SCHEME_LONG_DBL_VAL(app->rand1)))
4859 #####: 4854: return ensure_single_value_noncm(app->rand2);
4860 18: 4855: if (SCHEME_LONG_DBLP(app->rand2) && long_double_is_1(SCHEME_LONG_DBL_VAL(app->rand2)))
4861 #####: 4856: return ensure_single_value_noncm(app->rand1);
4862 33103: 4857: } else if (IS_NAMED_PRIM(app->rator, "unsafe-extfl/")) {
4863 #####: 4858: if (SCHEME_LONG_DBLP(app->rand2) && long_double_is_1(SCHEME_LONG_DBL_VAL(app->rand2)))
4864 #####: 4859: return ensure_single_value_noncm(app->rand1);
4865 -: 4860: }
4866 -: 4861:#endif
4867 234952: 4862: } else if (SCHEME_PRIMP(app->rator)
4868 162934: 4863: && (SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_IS_BINARY_INLINED)) {
4869 109779: 4864: if (IS_NAMED_PRIM(app->rator, "arithmetic-shift")) {
4870 287: 4865: if (SCHEME_INTP(app->rand2) && (SCHEME_INT_VAL(app->rand2) <= 0)
4871 76: 4866: && (is_local_type_expression(app->rand1, info) == SCHEME_LOCAL_TYPE_FIXNUM)) {
4872 1: 4867: app->rator = scheme_unsafe_fxrshift_proc;
4873 1: 4868: app->rand2 = scheme_make_integer(-(SCHEME_INT_VAL(app->rand2)));
4874 -: 4869: }
4875 109492: 4870: } else if (IS_NAMED_PRIM(app->rator, "string=?")) {
4876 377: 4871: if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_char_string_type)
4877 282: 4872: && SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_char_string_type)) {
4878 6: 4873: return scheme_string_eq_2(app->rand1, app->rand2);
4879 -: 4874: }
4880 109115: 4875: } else if (IS_NAMED_PRIM(app->rator, "bytes=?")) {
4881 60: 4876: if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_byte_string_type)
4882 8: 4877: && SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_byte_string_type)) {
4883 6: 4878: return scheme_byte_string_eq_2(app->rand1, app->rand2);
4884 -: 4879: }
4885 109055: 4880: } else if (IS_NAMED_PRIM(app->rator, "char=?")) {
4886 113: 4881: if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_char_type)
4887 72: 4882: && SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_char_type)) {
4888 #####: 4883: return (SCHEME_CHAR_VAL(app->rand1) == SCHEME_CHAR_VAL(app->rand2)) ? scheme_true : scheme_false;
4889 -: 4884: }
4890 -: 4885: }
4891 -: 4886: }
4892 -: 4887:
4893 268077: 4888: if (SCHEME_PRIMP(app->rator)) {
4894 196059: 4889: Scheme_Object *app_o = (Scheme_Object *)app, *rator = app->rator, *rand1 = app->rand1, *rand2 = app->rand2;
4895 -: 4890:
4896 196059: 4891: check_known_both_variant(info, app_o, rator, rand1, rand2, "bitwise-and", scheme_fixnum_p_proc, scheme_unsafe_fxand_proc, scheme_real_p_proc);
4897 196059: 4892: check_known_both_variant(info, app_o, rator, rand1, rand2, "bitwise-ior", scheme_fixnum_p_proc, scheme_unsafe_fxior_proc, scheme_real_p_proc);
4898 196059: 4893: check_known_both_variant(info, app_o, rator, rand1, rand2, "bitwise-xor", scheme_fixnum_p_proc, scheme_unsafe_fxxor_proc, scheme_real_p_proc);
4899 -: 4894:
4900 196059: 4895: check_known_both_variant(info, app_o, rator, rand1, rand2, "fxand", scheme_fixnum_p_proc, scheme_unsafe_fxand_proc, scheme_real_p_proc);
4901 196059: 4896: check_known_both_variant(info, app_o, rator, rand1, rand2, "fxior", scheme_fixnum_p_proc, scheme_unsafe_fxior_proc, scheme_real_p_proc);
4902 196059: 4897: check_known_both_variant(info, app_o, rator, rand1, rand2, "fxxor", scheme_fixnum_p_proc, scheme_unsafe_fxxor_proc, scheme_real_p_proc);
4903 -: 4898:
4904 196059: 4899: check_known_both_try(info, app_o, rator, rand1, rand2, "=", scheme_fixnum_p_proc, scheme_unsafe_fx_eq_proc);
4905 196059: 4900: check_known_both_try(info, app_o, rator, rand1, rand2, "<", scheme_fixnum_p_proc, scheme_unsafe_fx_lt_proc);
4906 196059: 4901: check_known_both_try(info, app_o, rator, rand1, rand2, ">", scheme_fixnum_p_proc, scheme_unsafe_fx_gt_proc);
4907 196059: 4902: check_known_both_try(info, app_o, rator, rand1, rand2, "<=", scheme_fixnum_p_proc, scheme_unsafe_fx_lt_eq_proc);
4908 196059: 4903: check_known_both_try(info, app_o, rator, rand1, rand2, ">=", scheme_fixnum_p_proc, scheme_unsafe_fx_gt_eq_proc);
4909 196059: 4904: check_known_both_try(info, app_o, rator, rand1, rand2, "min", scheme_fixnum_p_proc, scheme_unsafe_fx_min_proc);
4910 196059: 4905: check_known_both_try(info, app_o, rator, rand1, rand2, "max", scheme_fixnum_p_proc, scheme_unsafe_fx_max_proc);
4911 -: 4906:
4912 196059: 4907: check_known_both_try(info, app_o, rator, rand1, rand2, "fx=", scheme_fixnum_p_proc, scheme_unsafe_fx_eq_proc);
4913 196059: 4908: check_known_both_try(info, app_o, rator, rand1, rand2, "fx<", scheme_fixnum_p_proc, scheme_unsafe_fx_lt_proc);
4914 196059: 4909: check_known_both_try(info, app_o, rator, rand1, rand2, "fx>", scheme_fixnum_p_proc, scheme_unsafe_fx_gt_proc);
4915 196059: 4910: check_known_both_try(info, app_o, rator, rand1, rand2, "fx<=", scheme_fixnum_p_proc, scheme_unsafe_fx_lt_eq_proc);
4916 196059: 4911: check_known_both_try(info, app_o, rator, rand1, rand2, "fx>=", scheme_fixnum_p_proc, scheme_unsafe_fx_gt_eq_proc);
4917 196059: 4912: check_known_both_try(info, app_o, rator, rand1, rand2, "fxmin", scheme_fixnum_p_proc, scheme_unsafe_fx_min_proc);
4918 196059: 4913: check_known_both_try(info, app_o, rator, rand1, rand2, "fxmax", scheme_fixnum_p_proc, scheme_unsafe_fx_max_proc);
4919 -: 4914:
4920 196059: 4915: rator = app->rator; /* in case it was updated */
4921 -: 4916:
4922 196059: 4917: check_known_both(info, app_o, rator, rand1, rand2, "string-append", scheme_string_p_proc, scheme_true);
4923 196059: 4918: check_known_both(info, app_o, rator, rand1, rand2, "bytes-append", scheme_byte_string_p_proc, scheme_true);
4924 196059: 4919: check_known(info, app_o, rator, rand1, "string-ref", scheme_string_p_proc, NULL);
4925 196059: 4920: check_known(info, app_o, rator, rand2, "string-ref", scheme_fixnum_p_proc, NULL);
4926 196059: 4921: check_known(info, app_o, rator, rand1, "bytes-ref", scheme_byte_string_p_proc, NULL);
4927 196059: 4922: check_known(info, app_o, rator, rand2, "bytes-ref", scheme_fixnum_p_proc, NULL);
4928 -: 4923:
4929 196059: 4924: check_known(info, app_o, rator, rand1, "append", scheme_list_p_proc, scheme_true);
4930 196059: 4925: check_known(info, app_o, rator, rand1, "list-ref", scheme_pair_p_proc, NULL);
4931 196059: 4926: check_known(info, app_o, rator, rand2, "list-ref", scheme_fixnum_p_proc, NULL);
4932 -: 4927:
4933 196059: 4928: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_REAL)
4934 7125: 4929: check_known_both(info, app_o, rator, rand1, rand2, NULL, scheme_real_p_proc,
4935 7125: 4930: (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS) ? scheme_true : NULL);
4936 196059: 4931: if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_NUMBER)
4937 12699: 4932: check_known_both(info, app_o, rator, rand1, rand2, NULL, scheme_number_p_proc,
4938 12699: 4933: (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS) ? scheme_true : NULL);
4939 -: 4934:
4940 196059: 4935: check_known(info, app_o, rator, rand1, "vector-ref", scheme_vector_p_proc, NULL);
4941 196059: 4936: check_known(info, app_o, rator, rand2, "vector-ref", scheme_fixnum_p_proc, NULL);
4942 196059: 4937: check_known(info, app_o, rator, rand1, "make-vector", scheme_fixnum_p_proc, NULL);
4943 -: 4938:
4944 196059: 4939: check_known(info, app_o, rator, rand1, "set-box!", scheme_box_p_proc, NULL);
4945 196059: 4940: check_known(info, app_o, rator, rand1, "unsafe-set-box!", scheme_box_p_proc, NULL);
4946 196059: 4941: check_known(info, app_o, rator, rand1, "unsafe-set-box*!", scheme_box_p_proc, NULL);
4947 -: 4942:
4948 196059: 4943: check_known(info, app_o, rator, rand1, "procedure-closure-contents-eq?", scheme_procedure_p_proc, NULL);
4949 196059: 4944: check_known(info, app_o, rator, rand2, "procedure-closure-contents-eq?", scheme_procedure_p_proc, NULL);
4950 196059: 4945: check_known(info, app_o, rator, rand1, "procedure-arity-includes?", scheme_procedure_p_proc, NULL);
4951 -: 4946:
4952 196059: 4947: check_known(info, app_o, rator, rand1, "map", scheme_procedure_p_proc, NULL);
4953 196059: 4948: check_known(info, app_o, rator, rand1, "for-each", scheme_procedure_p_proc, NULL);
4954 196059: 4949: check_known(info, app_o, rator, rand1, "andmap", scheme_procedure_p_proc, NULL);
4955 196059: 4950: check_known(info, app_o, rator, rand1, "ormap", scheme_procedure_p_proc, NULL);
4956 196059: 4951: check_known(info, app_o, rator, rand2, "map", scheme_list_p_proc, NULL);
4957 196059: 4952: check_known(info, app_o, rator, rand2, "for-each", scheme_list_p_proc, NULL);
4958 196059: 4953: check_known(info, app_o, rator, rand2, "andmap", scheme_list_p_proc, NULL);
4959 196059: 4954: check_known(info, app_o, rator, rand2, "ormap", scheme_list_p_proc, NULL);
4960 -: 4955:
4961 196059: 4956: rator = app->rator; /* in case it was updated */
4962 -: 4957: }
4963 -: 4958:
4964 268077: 4959: register_local_argument_types(NULL, NULL, app, info);
4965 -: 4960:
4966 268077: 4961: flags = appn_flags(app->rator, info);
4967 268077: 4962: SCHEME_APPN_FLAGS(app) |= flags;
4968 -: 4963:
4969 268077: 4964: return finish_optimize_any_application((Scheme_Object *)app, app->rator, 2,
4970 -: 4965: info, context);
4971 -: 4966:}
4972 -: 4967:
4973 -: 4968:/*========================================================================*/
4974 -: 4969:/* the apply-values bytecode form */
4975 -: 4970:/*========================================================================*/
4976 -: 4971:
4977 1696: 4972:Scheme_Object *optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
4978 -: 4973: Optimize_Info *info,
4979 -: 4974: int e_single_result,
4980 -: 4975: int context)
4981 -: 4976:/* f and e are already optimized */
4982 -: 4977:{
4983 -: 4978: Scheme_Object *o_f;
4984 -: 4979:
4985 1696: 4980: info->preserves_marks = 0;
4986 1696: 4981: info->single_result = 0;
4987 -: 4982:
4988 1696: 4983: o_f = lookup_constant_proc(info, f, (e_single_result > 0) ? 1 : -1);
4989 1696: 4984: if (o_f) {
4990 375: 4985: if (SAME_TYPE(SCHEME_TYPE(o_f), scheme_ir_lambda_type)) {
4991 126: 4986: Scheme_Lambda *lam = (Scheme_Lambda *)o_f;
4992 126: 4987: int flags = SCHEME_LAMBDA_FLAGS(lam);
4993 126: 4988: info->preserves_marks = !!(flags & LAMBDA_PRESERVES_MARKS);
4994 126: 4989: info->single_result = !!(flags & LAMBDA_SINGLE_RESULT);
4995 126: 4990: if (flags & LAMBDA_RESULT_TENTATIVE) {
4996 #####: 4991: info->preserves_marks = -info->preserves_marks;
4997 #####: 4992: info->single_result = -info->single_result;
4998 -: 4993: }
4999 -: 4994: }
5000 -: 4995: }
5001 -: 4996:
5002 1696: 4997: if (o_f && (e_single_result > 0)) {
5003 -: 4998: /* Just make it an application (N M): */
5004 -: 4999: Scheme_App2_Rec *app2;
5005 -: 5000: Scheme_Object *e_cloned, *f_cloned;
5006 -: 5001:
5007 10: 5002: app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec);
5008 10: 5003: app2->iso.so.type = scheme_application2_type;
5009 -: 5004:
5010 -: 5005: /* Try to inline... */
5011 -: 5006:
5012 10: 5007: e_cloned = optimize_clone(1, e, info, empty_eq_hash_tree, 0);
5013 10: 5008: if (e_cloned) {
5014 10: 5009: if (SAME_TYPE(SCHEME_TYPE(f), scheme_ir_lambda_type))
5015 #####: 5010: f_cloned = optimize_clone(1, f, info, empty_eq_hash_tree, 0);
5016 -: 5011: else {
5017 -: 5012: /* Otherwise, no clone is needed. */
5018 10: 5013: f_cloned = f;
5019 -: 5014: }
5020 -: 5015:
5021 10: 5016: if (f_cloned) {
5022 10: 5017: app2->rator = f_cloned;
5023 10: 5018: app2->rand = e_cloned;
5024 10: 5019: info->inline_fuel >>= 1; /* because we've already optimized the rand */
5025 10: 5020: return optimize_application2((Scheme_Object *)app2, info, context);
5026 -: 5021: }
5027 -: 5022: }
5028 -: 5023:
5029 #####: 5024: app2->rator = f;
5030 #####: 5025: app2->rand = e;
5031 #####: 5026: return (Scheme_Object *)app2;
5032 -: 5027: }
5033 -: 5028:
5034 -: 5029: {
5035 -: 5030: Scheme_Object *av;
5036 1686: 5031: av = scheme_alloc_object();
5037 1686: 5032: av->type = scheme_apply_values_type;
5038 1686: 5033: SCHEME_PTR1_VAL(av) = f;
5039 1686: 5034: SCHEME_PTR2_VAL(av) = e;
5040 1686: 5035: return av;
5041 -: 5036: }
5042 -: 5037:}
5043 -: 5038:
5044 -: 5039:/*========================================================================*/
5045 -: 5040:/* begin and begin0 */
5046 -: 5041:/*========================================================================*/
5047 -: 5042:
5048 -: 5043:static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, int context, int sub_opt);
5049 -: 5044:
5050 32527: 5045:static Scheme_Object *flatten_sequence(Scheme_Object *o, Optimize_Info *info, int context)
5051 -: 5046:{
5052 32527: 5047: Scheme_Sequence *s = (Scheme_Sequence *)o, *s2, *s3;
5053 -: 5048: Scheme_Object *o3;
5054 32527: 5049: int i, j, k, count, extra = 0, split = 0, b0, new_count;
5055 -: 5050:
5056 32527: 5051: if (SAME_TYPE(SCHEME_TYPE(o), scheme_splice_sequence_type))
5057 38: 5052: return o;
5058 -: 5053:
5059 32489: 5054: if (!info->flatten_fuel)
5060 15: 5055: return o;
5061 -: 5056:
5062 32474: 5057: b0 = SAME_TYPE(SCHEME_TYPE(o), scheme_begin0_sequence_type);
5063 32474: 5058: count = s->count;
5064 -: 5059:
5065 -: 5060: /* exceptions: (begin ... (begin0 ...)) and (begin0 (begin ...) ...) */
5066 115726: 5061: for (i = 0; i < count; i++) {
5067 83252: 5062: o3 = s->array[i];
5068 83252: 5063: if ((SAME_TYPE(SCHEME_TYPE(o3), scheme_sequence_type) && !(!i && b0))
5069 82226: 5064: || (SAME_TYPE(SCHEME_TYPE(o3), scheme_begin0_sequence_type) && !(i == count - 1 && !b0))) {
5070 1036: 5065: s3 = (Scheme_Sequence *)o3;
5071 1036: 5066: extra += s3->count;
5072 1036: 5067: split++;
5073 -: 5068: }
5074 -: 5069: }
5075 -: 5070:
5076 32474: 5071: if (!split)
5077 31461: 5072: return o;
5078 -: 5073:
5079 1013: 5074: info->flatten_fuel--;
5080 1013: 5075: info->size -= split;
5081 -: 5076:
5082 1013: 5077: new_count = s->count + extra - split;
5083 1013: 5078: if (new_count > 0) {
5084 1013: 5079: s2 = scheme_malloc_sequence(new_count);
5085 1013: 5080: s2->so.type = s->so.type;
5086 1013: 5081: s2->count = new_count;
5087 -: 5082: } else
5088 #####: 5083: s2 = NULL;
5089 1013: 5084: k = 0;
5090 -: 5085:
5091 -: 5086: /* exceptions: (begin ... (begin0 ...)) and (begin0 (begin ...) ...) */
5092 3497: 5087: for (i = 0; i < count; i++) {
5093 2484: 5088: o3 = s->array[i];
5094 3520: 5089: if ((SAME_TYPE(SCHEME_TYPE(o3), scheme_sequence_type) && !(!i && b0))
5095 1458: 5090: || (SAME_TYPE(SCHEME_TYPE(o3), scheme_begin0_sequence_type) && !(i == count - 1 && !b0))) {
5096 1036: 5091: s3 = (Scheme_Sequence *)o3;
5097 5044: 5092: for (j = 0; j < s3->count; j++) {
5098 4008: 5093: s2->array[k++] = s3->array[j];
5099 -: 5094: }
5100 -: 5095: } else {
5101 1448: 5096: s2->array[k++] = o3;
5102 -: 5097: }
5103 -: 5098: }
5104 -: 5099:
5105 -: 5100: MZ_ASSERT(k == new_count);
5106 -: 5101:
5107 1013: 5102: if (s2->count == 1)
5108 #####: 5103: return s2->array[0];
5109 -: 5104:
5110 1013: 5105: if (SAME_TYPE(SCHEME_TYPE(s2), scheme_sequence_type))
5111 1002: 5106: return optimize_sequence((Scheme_Object *)s2, info, context, 0);
5112 -: 5107: else
5113 11: 5108: return (Scheme_Object *)s2;
5114 -: 5109:}
5115 -: 5110:
5116 33101: 5111:static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, int context, int sub_opt)
5117 -: 5112:{
5118 33101: 5113: Scheme_Sequence *s = (Scheme_Sequence *)o;
5119 -: 5114: Scheme_Object *le;
5120 -: 5115: int i, count, prev_size;
5121 33101: 5116: int drop = 0, preserves_marks = 0, single_result = 0;
5122 -: 5117: Optimize_Info_Sequence info_seq;
5123 -: 5118:
5124 -: 5119: /* If !sub_opt, then just inspect already-optimized results. Note
5125 -: 5120: that `info` doesn't change in this mode, so we shouldn't try to
5126 -: 5121: check whether an expression escapes, for example. */
5127 -: 5122:
5128 33101: 5123: if (sub_opt)
5129 31869: 5124: optimize_info_seq_init(info, &info_seq);
5130 -: 5125: else
5131 1232: 5126: memset(&info_seq, 0, sizeof(info_seq));
5132 -: 5127:
5133 33101: 5128: count = s->count;
5134 118083: 5129: for (i = 0; i < count; i++) {
5135 85144: 5130: prev_size = info->size;
5136 -: 5131:
5137 85144: 5132: if (sub_opt) {
5138 79271: 5133: optimize_info_seq_step(info, &info_seq);
5139 79271: 5134: le = scheme_optimize_expr(s->array[i], info,
5140 79271: 5135: ((i + 1 == count)
5141 -: 5136: ? scheme_optimize_tail_context(context)
5142 -: 5137: : 0));
5143 -: 5138: } else
5144 5873: 5139: le = s->array[i];
5145 -: 5140:
5146 85144: 5141: if (i + 1 == count) {
5147 32939: 5142: single_result = info->single_result;
5148 32939: 5143: preserves_marks = info->preserves_marks;
5149 32939: 5144: s->array[i] = le;
5150 -: 5145: } else {
5151 52205: 5146: if (!sub_opt || !info->escapes) {
5152 -: 5147: /* Inlining and constant propagation can expose omittable expressions. */
5153 52043: 5148: le = optimize_ignored(le, info, -1, 1, 5);
5154 104086: 5149: if (!le) {
5155 1251: 5150: drop++;
5156 1251: 5151: info->size = prev_size;
5157 1251: 5152: s->array[i] = NULL;
5158 -: 5153: } else {
5159 50792: 5154: s->array[i] = le;
5160 -: 5155: }
5161 -: 5156: } else {
5162 -: 5157: int j;
5163 -: 5158:
5164 162: 5159: single_result = info->single_result;
5165 162: 5160: preserves_marks = info->preserves_marks;
5166 -: 5161: /* Move to last position in case the begin form is dropped */
5167 162: 5162: s->array[count - 1] = le;
5168 326: 5163: for (j = i; j < count - 1; j++) {
5169 164: 5164: drop++;
5170 164: 5165: s->array[j] = NULL;
5171 -: 5166: }
5172 162: 5167: break;
5173 -: 5168: }
5174 -: 5169: }
5175 -: 5170: }
5176 -: 5171:
5177 33101: 5172: if (sub_opt)
5178 31869: 5173: optimize_info_seq_done(info, &info_seq);
5179 -: 5174:
5180 33101: 5175: info->preserves_marks = preserves_marks;
5181 33101: 5176: info->single_result = single_result;
5182 -: 5177:
5183 33101: 5178: if (drop + 1 == s->count) {
5184 892: 5179: le = s->array[drop];
5185 892: 5180: if (info->escapes)
5186 146: 5181: le = ensure_noncm(le);
5187 892: 5182: return le;
5188 -: 5183: }
5189 -: 5184:
5190 32209: 5185: if (drop) {
5191 -: 5186: Scheme_Sequence *s2;
5192 327: 5187: int j = 0;
5193 -: 5188:
5194 327: 5189: s2 = scheme_malloc_sequence(s->count - drop);
5195 327: 5190: s2->so.type = s->so.type;
5196 327: 5191: s2->count = s->count - drop;
5197 -: 5192:
5198 1615: 5193: for (i = 0; i < s->count; i++) {
5199 1288: 5194: if (s->array[i]) {
5200 920: 5195: s2->array[j++] = s->array[i];
5201 -: 5196: }
5202 -: 5197: }
5203 -: 5198:
5204 327: 5199: s = s2;
5205 -: 5200: }
5206 -: 5201:
5207 32209: 5202: return flatten_sequence((Scheme_Object *)s, info, context);
5208 -: 5203:}
5209 -: 5204:
5210 -: 5205:/*========================================================================*/
5211 -: 5206:/* conditionals and types */
5212 -: 5207:/*========================================================================*/
5213 -: 5208:
5214 1077353: 5209:static Scheme_Object *collapse_local(Scheme_Object *var, Optimize_Info *info, int context)
5215 -: 5210:/* Replace `var` in the given context with a constant, if possible based on its type */
5216 -: 5211:{
5217 1077353: 5212: if (!SCHEME_VAR(var)->mutated) {
5218 -: 5213: Scheme_Object *pred;
5219 -: 5214:
5220 1077332: 5215: pred = expr_implies_predicate(var, info);
5221 1077332: 5216: if (pred) {
5222 344999: 5217: if (predicate_implies(pred, scheme_not_proc))
5223 723: 5218: return scheme_false;
5224 -: 5219:
5225 344276: 5220: if (context & OPT_CONTEXT_BOOLEAN) {
5226 6323: 5221: if (predicate_implies_not(pred, scheme_not_proc))
5227 242: 5222: return scheme_true;
5228 -: 5223: }
5229 -: 5224:
5230 344034: 5225: if (SAME_OBJ(pred, scheme_true_object_p_proc))
5231 114: 5226: return scheme_true;
5232 343920: 5227: if (SAME_OBJ(pred, scheme_null_p_proc))
5233 774: 5228: return scheme_null;
5234 343146: 5229: if (SAME_OBJ(pred, scheme_void_p_proc))
5235 25: 5230: return scheme_void;
5236 343121: 5231: if (SAME_OBJ(pred, scheme_eof_object_p_proc))
5237 7: 5232: return scheme_eof;
5238 -: 5233: }
5239 -: 5234: }
5240 1075468: 5235: return NULL;
5241 -: 5236:}
5242 -: 5237:
5243 -: 5238:/* This function is used to reduce:
5244 -: 5239: (if <x> a b) => (begin <x> <result-a-or-b>)
5245 -: 5240: (if a b #f) => a , and similar
5246 -: 5241: (eq? a b) => (begin a b #t)
5247 -: 5242: The function considers only values and variable references, so <a> and <b> don't have side effects.
5248 -: 5243: But each reduction has a very different behavior for expressions with side effects. */
5249 604984: 5244:static Scheme_Object *equivalent_exprs(Scheme_Object *a, Scheme_Object *b,
5250 -: 5245: Optimize_Info *a_info, Optimize_Info *b_info, int context)
5251 -: 5246:{
5252 604984: 5247: if (SAME_OBJ(a, b))
5253 422: 5248: return a;
5254 -: 5249:
5255 604562: 5250: if (SAME_TYPE(SCHEME_TYPE(a), scheme_ir_toplevel_type)
5256 1121: 5251: && SAME_TYPE(SCHEME_TYPE(b), scheme_ir_toplevel_type)
5257 294: 5252: && (SCHEME_TOPLEVEL_POS(a) == SCHEME_TOPLEVEL_POS(b)))
5258 41: 5253: return a;
5259 -: 5254:
5260 604521: 5255: if (b_info
5261 231379: 5256: && SAME_TYPE(SCHEME_TYPE(a), scheme_ir_local_type)
5262 20959: 5257: && (SCHEME_TYPE(b) > _scheme_ir_values_types_)) {
5263 -: 5258: Scheme_Object *n;
5264 5843: 5259: n = collapse_local(a, b_info, context);
5265 5843: 5260: if (n && SAME_OBJ(n, b))
5266 24: 5261: return a;
5267 -: 5262: }
5268 -: 5263:
5269 604497: 5264: if (a_info
5270 231355: 5265: && SAME_TYPE(SCHEME_TYPE(b), scheme_ir_local_type)
5271 16333: 5266: && (SCHEME_TYPE(a) > _scheme_ir_values_types_)) {
5272 -: 5267: Scheme_Object *n;
5273 666: 5268: n = collapse_local(b, a_info, context);
5274 666: 5269: if (n && SAME_OBJ(n, a))
5275 6: 5270: return b;
5276 -: 5271: }
5277 -: 5272:
5278 604491: 5273: return NULL;
5279 -: 5274:}
5280 -: 5275:
5281 407859: 5276:static void add_type(Optimize_Info *info, Scheme_Object *var, Scheme_Object *pred)
5282 -: 5277:/* This is conceptually an intersection, but `Any` is represented by a
5283 -: 5278: missing entry, so the implementation looks like an union. */
5284 -: 5279:{
5285 407859: 5280: Scheme_Hash_Tree *new_types = info->types;
5286 -: 5281: Scheme_Object *old_pred;
5287 -: 5282:
5288 407859: 5283: if (SCHEME_VAR(var)->mutated)
5289 1760: 5284: return;
5290 -: 5285:
5291 -: 5286: /* Don't add the type if something is already there, which may happen when no_types,
5292 -: 5287: as long as the existing predicate implies the new one. */
5293 406099: 5288: if (SCHEME_VAR(var)->val_type) /* => more specific than other predicates */
5294 5578: 5289: return;
5295 400521: 5290: old_pred = optimize_get_predicate(info, var, 1);
5296 400521: 5291: if (old_pred && predicate_implies(old_pred, pred))
5297 31899: 5292: return;
5298 -: 5293:
5299 -: 5294: /* special case: list? and pair? => list-pair? */
5300 368622: 5295: if (old_pred) {
5301 23220: 5296: if ((SAME_OBJ(old_pred, scheme_list_p_proc)
5302 9466: 5297: && (SAME_OBJ(pred, scheme_pair_p_proc)))
5303 21528: 5298: || (SAME_OBJ(old_pred, scheme_pair_p_proc)
5304 281: 5299: && (SAME_OBJ(pred, scheme_list_p_proc)))) {
5305 1891: 5300: pred = scheme_list_pair_p_proc;
5306 -: 5301: }
5307 -: 5302: }
5308 -: 5303:
5309 368622: 5304: if (!new_types)
5310 305626: 5305: new_types = scheme_make_hash_tree(SCHEME_hashtr_eq);
5311 368622: 5306: new_types = scheme_hash_tree_set(new_types, var, pred);
5312 368622: 5307: info->types = new_types;
5313 -: 5308:}
5314 -: 5309:
5315 121656: 5310:static void add_type_no(Optimize_Info *info, Scheme_Object *var, Scheme_Object *pred)
5316 -: 5311:/* Currently only check a few special cases for lists and booleans. */
5317 -: 5312:{
5318 -: 5313: Scheme_Object *old_pred;
5319 -: 5314:
5320 121656: 5315: if (SCHEME_VAR(var)->mutated)
5321 551: 5316: return;
5322 -: 5317:
5323 121105: 5318: old_pred = optimize_get_predicate(info, var, 1);
5324 -: 5319:
5325 121105: 5320: if (old_pred && SAME_OBJ(old_pred, scheme_list_p_proc)) {
5326 -: 5321: /* list? but not null? => list-pair? */
5327 4556: 5322: if (SAME_OBJ(pred, scheme_null_p_proc))
5328 2943: 5323: add_type(info, var, scheme_list_pair_p_proc);
5329 -: 5324:
5330 -: 5325: /* list? but not pair? => null? */
5331 -: 5326: /* list? but not list-pair? => null? */
5332 4556: 5327: if (SAME_OBJ(pred, scheme_pair_p_proc)
5333 2964: 5328: ||SAME_OBJ(pred, scheme_list_pair_p_proc))
5334 1596: 5329: add_type(info, var, scheme_null_p_proc);
5335 -: 5330: }
5336 -: 5331:
5337 121105: 5332: if (old_pred && SAME_OBJ(old_pred, scheme_boolean_p_proc)) {
5338 -: 5333: /* boolean? but not `not` => true-object? */
5339 6429: 5334: if (SAME_OBJ(pred, scheme_not_proc))
5340 6425: 5335: add_type(info, var, scheme_true_object_p_proc);
5341 -: 5336:
5342 -: 5337: /* boolean? but not true-object? => `not` */
5343 6429: 5338: if (SAME_OBJ(pred, scheme_true_object_p_proc))
5344 4: 5339: add_type(info, var, scheme_not_proc);
5345 -: 5340: }
5346 -: 5341:}
5347 -: 5342:
5348 312727: 5343:static void merge_types(Optimize_Info *src_info, Optimize_Info *info, Scheme_Hash_Tree *skip_vars)
5349 -: 5344:{
5350 312727: 5345: Scheme_Hash_Tree *types = src_info->types;
5351 -: 5346: Scheme_Object *var, *pred;
5352 -: 5347: intptr_t i;
5353 -: 5348:
5354 312727: 5349: if (!types)
5355 211903: 5350: return;
5356 -: 5351:
5357 100824: 5352: i = scheme_hash_tree_next(types, -1);
5358 333856: 5353: while (i != -1) {
5359 132208: 5354: scheme_hash_tree_index(types, i, &var, &pred);
5360 132208: 5355: if (!skip_vars || !scheme_hash_tree_get(skip_vars, var))
5361 78226: 5356: add_type(info, var, pred);
5362 132208: 5357: i = scheme_hash_tree_next(types, i);
5363 -: 5358: }
5364 -: 5359:}
5365 -: 5360:
5366 215873: 5361:static void merge_branchs_types(Optimize_Info *t_info, Optimize_Info *f_info,
5367 -: 5362: Optimize_Info *base_info)
5368 -: 5363:/* This is conceptually an union, but `Any` is represented by a
5369 -: 5364: missing entry, so the implementation looks like an intersection.
5370 -: 5365: This adds to base_info the "intersection" of the types of t_info and f_info */
5371 -: 5366:{
5372 215873: 5367: Scheme_Hash_Tree *t_types = t_info->types, *f_types = f_info->types;
5373 -: 5368: Scheme_Object *var, *t_pred, *f_pred;
5374 -: 5369: intptr_t i;
5375 -: 5370:
5376 215873: 5371: if (!t_types || !f_types)
5377 166576: 5372: return;
5378 -: 5373:
5379 49297: 5374: if (f_types->count > t_types->count) {
5380 4804: 5375: Scheme_Hash_Tree *swap = f_types;
5381 4804: 5376: f_types = t_types;
5382 4804: 5377: t_types = swap;
5383 -: 5378: }
5384 -: 5379:
5385 49297: 5380: i = scheme_hash_tree_next(f_types, -1);
5386 149875: 5381: while (i != -1) {
5387 51281: 5382: scheme_hash_tree_index(f_types, i, &var, &f_pred);
5388 51281: 5383: t_pred = scheme_hash_tree_get(t_types, var);
5389 51281: 5384: if (t_pred) {
5390 47418: 5385: if (predicate_implies(f_pred, t_pred))
5391 6306: 5386: add_type(base_info, var, t_pred);
5392 41112: 5387: else if (predicate_implies(t_pred, f_pred))
5393 142: 5388: add_type(base_info, var, f_pred);
5394 -: 5389: else {
5395 -: 5390: /* special case: null? or list-pair? => list? */
5396 40970: 5391: if ((SAME_OBJ(t_pred, scheme_null_p_proc)
5397 18448: 5392: && (SAME_OBJ(f_pred, scheme_list_pair_p_proc)))
5398 38254: 5393: || (SAME_OBJ(t_pred, scheme_list_pair_p_proc)
5399 1611: 5394: && (SAME_OBJ(f_pred, scheme_null_p_proc)))) {
5400 4327: 5395: add_type(base_info, var, scheme_list_p_proc);
5401 -: 5396: }
5402 -: 5397: /* special case: true-object? or `not` => boolean? */
5403 40970: 5398: if ((SAME_OBJ(t_pred, scheme_not_proc)
5404 345: 5399: && (SAME_OBJ(f_pred, scheme_true_object_p_proc)))
5405 40751: 5400: || (SAME_OBJ(t_pred, scheme_true_object_p_proc)
5406 6129: 5401: && (SAME_OBJ(f_pred, scheme_not_proc)))) {
5407 6348: 5402: add_type(base_info, var, scheme_boolean_p_proc);
5408 -: 5403: }
5409 -: 5404: }
5410 -: 5405: }
5411 51281: 5406: i = scheme_hash_tree_next(f_types, i);
5412 -: 5407: }
5413 -: 5408:}
5414 -: 5409:
5415 563990: 5410:static int relevant_predicate(Scheme_Object *pred)
5416 -: 5411:{
5417 -: 5412: /* Relevant predicates need to be disjoint for try_reduce_predicate(),
5418 -: 5413: finish_optimize_application3() and add_types_for_t_branch().
5419 -: 5414: The predicate_implies() and predicate_implies_not() functions must
5420 -: 5415: be kept in sync with this list. */
5421 -: 5416:
5422 563990: 5417: if (SAME_OBJ(pred, scheme_pair_p_proc)
5423 497210: 5418: || SAME_OBJ(pred, scheme_list_p_proc)
5424 478345: 5419: || SAME_OBJ(pred, scheme_list_pair_p_proc)
5425 478153: 5420: || SAME_OBJ(pred, scheme_mpair_p_proc)
5426 477560: 5421: || SAME_OBJ(pred, scheme_box_p_proc)
5427 476513: 5422: || SAME_OBJ(pred, scheme_string_p_proc)
5428 470674: 5423: || SAME_OBJ(pred, scheme_byte_string_p_proc)
5429 467163: 5424: || SAME_OBJ(pred, scheme_vector_p_proc)
5430 462133: 5425: || SAME_OBJ(pred, scheme_procedure_p_proc)
5431 453724: 5426: || SAME_OBJ(pred, scheme_syntax_p_proc)
5432 443431: 5427: || SAME_OBJ(pred, scheme_extflonum_p_proc))
5433 120574: 5428: return RLV_IS_RELEVANT;
5434 443416: 5429: if (SAME_OBJ(pred, scheme_char_p_proc)
5435 442944: 5430: || SAME_OBJ(pred, scheme_flonum_p_proc)
5436 442794: 5431: || SAME_OBJ(pred, scheme_number_p_proc)
5437 439848: 5432: || SAME_OBJ(pred, scheme_real_p_proc))
5438 5739: 5433: return RLV_EQV_TESTEABLE;
5439 437677: 5434: if (SAME_OBJ(pred, scheme_symbol_p_proc)
5440 427050: 5435: || SAME_OBJ(pred, scheme_keyword_p_proc)
5441 422820: 5436: || SAME_OBJ(pred, scheme_fixnum_p_proc)
5442 419387: 5437: || SAME_OBJ(pred, scheme_interned_char_p_proc)
5443 419275: 5438: || SAME_OBJ(pred, scheme_boolean_p_proc))
5444 19012: 5439: return RLV_EQ_TESTEABLE;
5445 418665: 5440: if (SAME_OBJ(pred, scheme_null_p_proc)
5446 330511: 5441: || SAME_OBJ(pred, scheme_void_p_proc)
5447 330133: 5442: || SAME_OBJ(pred, scheme_eof_object_p_proc)
5448 327216: 5443: || SAME_OBJ(pred, scheme_true_object_p_proc)
5449 326335: 5444: || SAME_OBJ(pred, scheme_not_proc))
5450 98054: 5445: return RLV_SINGLETON;
5451 -: 5446:
5452 320611: 5447: return 0;
5453 -: 5448:}
5454 -: 5449:
5455 2240313: 5450:static int predicate_implies(Scheme_Object *pred1, Scheme_Object *pred2)
5456 -: 5451:{
5457 2240313: 5452: if (!pred1 || !pred2)
5458 23924: 5453: return 0;
5459 -: 5454:
5460 -: 5455: /* P => P */
5461 2216389: 5456: if (SAME_OBJ(pred1, pred2))
5462 936155: 5457: return 1;
5463 -: 5458:
5464 -: 5459: /* null? => list? */
5465 1280234: 5460: if (SAME_OBJ(pred2, scheme_list_p_proc)
5466 6233: 5461: && SAME_OBJ(pred1, scheme_null_p_proc))
5467 4044: 5462: return 1;
5468 -: 5463:
5469 -: 5464: /* list-pair? => list? */
5470 1276190: 5465: if (SAME_OBJ(pred2, scheme_list_p_proc)
5471 2189: 5466: && SAME_OBJ(pred1, scheme_list_pair_p_proc))
5472 808: 5467: return 1;
5473 -: 5468:
5474 -: 5469: /* list-pair? => pair? */
5475 1275382: 5470: if (SAME_OBJ(pred2, scheme_pair_p_proc)
5476 47065: 5471: && SAME_OBJ(pred1, scheme_list_pair_p_proc))
5477 11292: 5472: return 1;
5478 -: 5473:
5479 -: 5474: /* interned-char? => char? */
5480 1264090: 5475: if (SAME_OBJ(pred2, scheme_char_p_proc)
5481 31: 5476: && SAME_OBJ(pred1, scheme_interned_char_p_proc))
5482 6: 5477: return 1;
5483 -: 5478:
5484 -: 5479: /* not, true-object? => boolean? */
5485 1264084: 5480: if (SAME_OBJ(pred2, scheme_boolean_p_proc)
5486 248933: 5481: && (SAME_OBJ(pred1, scheme_not_proc)
5487 2327: 5482: || SAME_OBJ(pred1, scheme_true_object_p_proc)))
5488 248919: 5483: return 1;
5489 -: 5484:
5490 -: 5485: /* real?, fixnum?, or flonum? => number? */
5491 1015165: 5486: if (SAME_OBJ(pred2, scheme_number_p_proc)
5492 22347: 5487: && (SAME_OBJ(pred1, scheme_real_p_proc)
5493 15219: 5488: || SAME_OBJ(pred1, scheme_fixnum_p_proc)
5494 2521: 5489: || SAME_OBJ(pred1, scheme_flonum_p_proc)))
5495 19914: 5490: return 1;
5496 -: 5491:
5497 -: 5492: /* fixnum? or flonum? => real? */
5498 995251: 5493: if (SAME_OBJ(pred2, scheme_real_p_proc)
5499 31098: 5494: && (SAME_OBJ(pred1, scheme_fixnum_p_proc)
5500 15038: 5495: || SAME_OBJ(pred1, scheme_flonum_p_proc)))
5501 16210: 5496: return 1;
5502 -: 5497:
5503 -: 5498: /* structure subtype? */
5504 979041: 5499: if (SAME_TYPE(SCHEME_TYPE(pred1), scheme_struct_proc_shape_type)
5505 9740: 5500: && SAME_TYPE(SCHEME_TYPE(pred2), scheme_struct_proc_shape_type)
5506 701: 5501: && is_struct_identity_subtype(SCHEME_PROC_SHAPE_IDENTITY(pred1),
5507 -: 5502: SCHEME_PROC_SHAPE_IDENTITY(pred2)))
5508 216: 5503: return 1;
5509 -: 5504:
5510 978825: 5505: return 0;
5511 -: 5506:}
5512 -: 5507:
5513 970117: 5508:static int predicate_implies_not(Scheme_Object *pred1, Scheme_Object *pred2)
5514 -: 5509:{
5515 970117: 5510: if (SAME_OBJ(pred1, scheme_pair_p_proc) && SAME_OBJ(pred2, scheme_list_p_proc))
5516 948: 5511: return 0;
5517 969169: 5512: if (SAME_OBJ(pred1, scheme_list_p_proc) && SAME_OBJ(pred2, scheme_pair_p_proc))
5518 3453: 5513: return 0;
5519 -: 5514:
5520 -: 5515: /* we don't track structure-type identity precisely enough to know
5521 -: 5516: that structures don't rule out other structures --- or even other
5522 -: 5517: prdicates (such as `procedure?`) */
5523 965716: 5518: if (SAME_TYPE(SCHEME_TYPE(pred1), scheme_struct_proc_shape_type)
5524 965644: 5519: || SAME_TYPE(SCHEME_TYPE(pred2), scheme_struct_proc_shape_type))
5525 72: 5520: return 0;
5526 -: 5521:
5527 -: 5522: /* Otherwise, with our current set of predicates, overlapping matches happen
5528 -: 5523: only when one implies the other: */
5529 965644: 5524: return (!predicate_implies(pred1, pred2) && !predicate_implies(pred2, pred1));
5530 -: 5525:}
5531 -: 5526:
5532 266566: 5527:static void add_types_for_t_branch(Scheme_Object *t, Optimize_Info *info, int fuel)
5533 -: 5528:{
5534 266566: 5529: if (fuel < 0)
5535 48: 5530: return;
5536 -: 5531:
5537 266518: 5532: if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type)) {
5538 54356: 5533: add_type_no(info, t, scheme_not_proc);
5539 349543: 5534: } else if (SAME_TYPE(SCHEME_TYPE(t), scheme_application2_type)) {
5540 137381: 5535: Scheme_App2_Rec *app = (Scheme_App2_Rec *)t;
5541 137381: 5536: if (SCHEME_PRIMP(app->rator)
5542 99024: 5537: && SAME_TYPE(SCHEME_TYPE(app->rand), scheme_ir_local_type)
5543 84948: 5538: && relevant_predicate(app->rator)) {
5544 -: 5539: /* Looks like a predicate on a local variable. Record that the
5545 -: 5540: predicate succeeded, which may allow conversion of safe
5546 -: 5541: operations to unsafe operations. */
5547 72834: 5542: add_type(info, app->rand, app->rator);
5548 -: 5543: }
5549 137381: 5544: if (SAME_OBJ(app->rator, scheme_not_proc)) {
5550 1450: 5545: add_types_for_f_branch(app->rand, info, fuel-1);
5551 -: 5546: }
5552 -: 5547:
5553 137381: 5548: if (SAME_TYPE(SCHEME_TYPE(app->rand), scheme_ir_local_type)) {
5554 -: 5549: Scheme_Object *shape;
5555 117594: 5550: shape = get_struct_proc_shape(app->rator, info, 0);
5556 117594: 5551: if (shape
5557 3406: 5552: && ((SCHEME_PROC_SHAPE_MODE(shape) & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_PRED)
5558 2634: 5553: && SCHEME_PAIRP(SCHEME_PROC_SHAPE_IDENTITY(shape))) {
5559 2634: 5554: add_type(info, app->rand, shape);
5560 -: 5555: }
5561 -: 5556: }
5562 119349: 5557: } else if (SAME_TYPE(SCHEME_TYPE(t), scheme_application3_type)) {
5563 44568: 5558: Scheme_App3_Rec *app = (Scheme_App3_Rec *)t;
5564 -: 5559: Scheme_Object *pred1, *pred2;
5565 44568: 5560: if (SAME_OBJ(app->rator, scheme_eq_proc)
5566 29914: 5561: || SAME_OBJ(app->rator, scheme_eqv_proc)
5567 29640: 5562: || SAME_OBJ(app->rator, scheme_equal_proc)) {
5568 17172: 5563: if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_ir_local_type)) {
5569 6973: 5564: pred1 = expr_implies_predicate(app->rand1, info);
5570 6973: 5565: if (!pred1) {
5571 5916: 5566: pred2 = expr_implies_predicate(app->rand2, info);
5572 5916: 5567: if (pred2)
5573 3567: 5568: add_type(info, app->rand1, pred2);
5574 -: 5569: }
5575 -: 5570: }
5576 17172: 5571: if (SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_ir_local_type)) {
5577 2654: 5572: pred2 = expr_implies_predicate(app->rand2, info);
5578 2654: 5573: if (!pred2) {
5579 2457: 5574: pred1 = expr_implies_predicate(app->rand1, info);
5580 2457: 5575: if (pred1)
5581 278: 5576: add_type(info, app->rand2, pred1);
5582 -: 5577: }
5583 -: 5578: }
5584 -: 5579: }
5585 -: 5580:
5586 30213: 5581: } else if (SAME_TYPE(SCHEME_TYPE(t), scheme_branch_type)) {
5587 21951: 5582: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)t;
5588 21951: 5583: if (SCHEME_FALSEP(b->fbranch)) {
5589 14725: 5584: add_types_for_t_branch(b->test, info, fuel-1);
5590 14725: 5585: add_types_for_t_branch(b->tbranch, info, fuel-1);
5591 -: 5586: }
5592 21951: 5587: if (SCHEME_FALSEP(b->tbranch)) {
5593 585: 5588: add_types_for_f_branch(b->test, info, fuel-1);
5594 585: 5589: add_types_for_t_branch(b->fbranch, info, fuel-1);
5595 -: 5590: }
5596 -: 5591: }
5597 -: 5592:}
5598 -: 5593:
5599 245163: 5594:static void add_types_for_f_branch(Scheme_Object *t, Optimize_Info *info, int fuel)
5600 -: 5595:{
5601 245163: 5596: if (fuel < 0)
5602 106: 5597: return;
5603 -: 5598:
5604 245057: 5599: if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type)) {
5605 50478: 5600: add_type(info, t, scheme_not_proc);
5606 -: 5601:
5607 323490: 5602: } else if (SAME_TYPE(SCHEME_TYPE(t), scheme_application2_type)) {
5608 128911: 5603: Scheme_App2_Rec *app = (Scheme_App2_Rec *)t;
5609 128911: 5604: if (SCHEME_PRIMP(app->rator)
5610 91525: 5605: && SAME_TYPE(SCHEME_TYPE(app->rand), scheme_ir_local_type)
5611 79629: 5606: && relevant_predicate(app->rator)) {
5612 -: 5607: /* Looks like a predicate on a local variable. Record that the
5613 -: 5608: predicate failed, this is currently useful only for lists. */
5614 67300: 5609: add_type_no(info, app->rand, app->rator);
5615 -: 5610: }
5616 -: 5611:
5617 65668: 5612: } else if (SAME_TYPE(SCHEME_TYPE(t), scheme_branch_type)) {
5618 19400: 5613: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)t;
5619 19400: 5614: if (SAME_OBJ(b->fbranch, scheme_true)) {
5620 2851: 5615: add_types_for_t_branch(b->test, info, fuel-1);
5621 2851: 5616: add_types_for_f_branch(b->tbranch, info, fuel-1);
5622 -: 5617: }
5623 19400: 5618: if (SAME_OBJ(b->tbranch, scheme_true)) {
5624 3299: 5619: add_types_for_f_branch(b->test, info, fuel-1);
5625 3299: 5620: add_types_for_f_branch(b->fbranch, info, fuel-1);
5626 -: 5621: }
5627 -: 5622: }
5628 -: 5623:}
5629 -: 5624:
5630 431746: 5625:static int or_tentative(int x, int y)
5631 -: 5626:{
5632 431746: 5627: if (x && y) {
5633 295990: 5628: if ((x < 0) || (y < 0))
5634 52306: 5629: return -1;
5635 -: 5630: else
5636 243684: 5631: return 1;
5637 -: 5632: } else {
5638 135756: 5633: return 0;
5639 -: 5634: }
5640 -: 5635:}
5641 -: 5636:
5642 248868: 5637:static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int context)
5643 -: 5638:{
5644 -: 5639: Scheme_Branch_Rec *b;
5645 -: 5640: Scheme_Object *t, *tb, *fb;
5646 -: 5641: int init_vclock, init_aclock, init_kclock, init_sclock;
5647 -: 5642: Optimize_Info *then_info, *else_info;
5648 -: 5643: Optimize_Info *then_info_init, *else_info_init;
5649 -: 5644: Optimize_Info_Sequence info_seq;
5650 -: 5645:
5651 248868: 5646: b = (Scheme_Branch_Rec *)o;
5652 -: 5647:
5653 248868: 5648: t = b->test;
5654 248868: 5649: tb = b->tbranch;
5655 248868: 5650: fb = b->fbranch;
5656 -: 5651:
5657 -: 5652: /* Convert (if <id> expr <id>) to (if <id> expr #f) */
5658 248868: 5653: if (equivalent_exprs(t, fb, NULL, NULL, 0)) {
5659 26: 5654: fb = scheme_false;
5660 -: 5655: }
5661 -: 5656:
5662 -: 5657: /* For test position, convert (if <id> <id> expr) to (if <id> #t expr) */
5663 248868: 5658: if ((context & OPT_CONTEXT_BOOLEAN)
5664 40277: 5659: && equivalent_exprs(t, tb, NULL, NULL, 0)) {
5665 97: 5660: tb = scheme_true;
5666 -: 5661: }
5667 -: 5662:
5668 248868: 5663: optimize_info_seq_init(info, &info_seq);
5669 -: 5664:
5670 248868: 5665: t = scheme_optimize_expr(t, info, OPT_CONTEXT_BOOLEAN | OPT_CONTEXT_SINGLED);
5671 -: 5666:
5672 248868: 5667: if (info->escapes) {
5673 8: 5668: optimize_info_seq_done(info, &info_seq);
5674 8: 5669: return ensure_noncm(t);
5675 -: 5670: }
5676 -: 5671:
5677 -: 5672: /* Try to lift out `let`s and `begin`s around a test: */
5678 -: 5673: {
5679 248860: 5674: Scheme_Object *inside = NULL, *t2 = t;
5680 -: 5675:
5681 -: 5676: while (1) {
5682 250618: 5677: extract_tail_inside(&t2, &inside);
5683 -: 5678:
5684 -: 5679: /* Try optimize: (if (not x) y z) => (if x z y) */
5685 250618: 5680: if (SAME_TYPE(SCHEME_TYPE(t2), scheme_application2_type)) {
5686 124267: 5681: Scheme_App2_Rec *app = (Scheme_App2_Rec *)t2;
5687 -: 5682:
5688 124267: 5683: if (SAME_PTR(scheme_not_proc, app->rator)) {
5689 1758: 5684: t2 = tb;
5690 1758: 5685: tb = fb;
5691 1758: 5686: fb = t2;
5692 -: 5687:
5693 1758: 5688: t2 = app->rand;
5694 1758: 5689: t = replace_tail_inside(t2, inside, t);
5695 -: 5690: } else
5696 122509: 5691: break;
5697 -: 5692: } else
5698 -: 5693: break;
5699 1758: 5694: }
5700 -: 5695:
5701 248860: 5696: if (!(SCHEME_TYPE(t2) > _scheme_ir_values_types_)) {
5702 -: 5697: /* (if (let (...) (cons x y)) a b) => (if (begin (let (...) (begin x y #<void>)) #t/#f) a b)
5703 -: 5698: but don't expand (if (let (...) (begin x K)) a b) */
5704 -: 5699: Scheme_Object *pred;
5705 -: 5700:
5706 233681: 5701: pred = expr_implies_predicate(t2, info);
5707 233681: 5702: if (pred) {
5708 114337: 5703: Scheme_Object *test_val = NULL;
5709 -: 5704:
5710 114337: 5705: if (predicate_implies(pred, scheme_not_proc))
5711 1: 5706: test_val = scheme_false;
5712 114336: 5707: else if (predicate_implies_not(pred, scheme_not_proc))
5713 #####: 5708: test_val = scheme_true;
5714 -: 5709:
5715 114337: 5710: if (test_val) {
5716 1: 5711: t2 = optimize_ignored(t2, info, 1, 0, 5);
5717 1: 5712: t = replace_tail_inside(t2, inside, t);
5718 -: 5713:
5719 1: 5714: t2 = test_val;
5720 1: 5715: if (scheme_omittable_expr(t, 1, 5, 0, info, NULL)) {
5721 #####: 5716: t = test_val;
5722 #####: 5717: inside = NULL;
5723 -: 5718: } else {
5724 1: 5719: t = make_sequence_2(t, test_val);
5725 1: 5720: inside = t;
5726 -: 5721: }
5727 -: 5722: }
5728 -: 5723: }
5729 -: 5724: }
5730 -: 5725:
5731 248860: 5726: if (SCHEME_TYPE(t2) > _scheme_ir_values_types_) {
5732 -: 5727: /* Branch is statically known */
5733 -: 5728: Scheme_Object *xb;
5734 -: 5729:
5735 15180: 5730: optimize_info_seq_done(info, &info_seq);
5736 15180: 5731: info->size -= 1;
5737 -: 5732:
5738 15180: 5733: if (SCHEME_FALSEP(t2))
5739 4119: 5734: xb = scheme_optimize_expr(fb, info, scheme_optimize_tail_context(context));
5740 -: 5735: else
5741 11061: 5736: xb = scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context));
5742 -: 5737:
5743 15179: 5738: optimize_info_seq_done(info, &info_seq);
5744 15179: 5739: return replace_tail_inside(xb, inside, t);
5745 -: 5740: }
5746 -: 5741: }
5747 -: 5742:
5748 233680: 5743: optimize_info_seq_step(info, &info_seq);
5749 -: 5744:
5750 233680: 5745: info->vclock += 1; /* model branch as clock increment */
5751 -: 5746:
5752 233680: 5747: init_vclock = info->vclock;
5753 233680: 5748: init_aclock = info->aclock;
5754 233680: 5749: init_kclock = info->kclock;
5755 233680: 5750: init_sclock = info->sclock;
5756 -: 5751:
5757 233680: 5752: then_info = optimize_info_add_frame(info, 0, 0, 0);
5758 233680: 5753: add_types_for_t_branch(t, then_info, 5);
5759 233680: 5754: then_info_init = optimize_info_add_frame(then_info, 0, 0, 0);
5760 233680: 5755: tb = scheme_optimize_expr(tb, then_info, scheme_optimize_tail_context(context));
5761 233679: 5756: optimize_info_done(then_info, NULL);
5762 -: 5757:
5763 233679: 5758: info->escapes = 0;
5764 233679: 5759: info->vclock = init_vclock;
5765 233679: 5760: info->aclock = init_aclock;
5766 233679: 5761: info->kclock = init_kclock;
5767 233679: 5762: info->sclock = init_sclock;
5768 -: 5763:
5769 233679: 5764: optimize_info_seq_step(info, &info_seq);
5770 -: 5765:
5771 233679: 5766: else_info = optimize_info_add_frame(info, 0, 0, 0);
5772 233679: 5767: add_types_for_f_branch(t, else_info, 5);
5773 233679: 5768: else_info_init = optimize_info_add_frame(else_info, 0, 0, 0);
5774 233679: 5769: fb = scheme_optimize_expr(fb, else_info, scheme_optimize_tail_context(context));
5775 233678: 5770: optimize_info_done(else_info, NULL);
5776 -: 5771:
5777 233678: 5772: if (then_info->escapes && else_info->escapes) {
5778 -: 5773: /* both branches escaped */
5779 1012: 5774: info->preserves_marks = 1;
5780 1012: 5775: info->single_result = 1;
5781 1012: 5776: info->kclock = init_kclock;
5782 -: 5777:
5783 232666: 5778: } else if (info->escapes) {
5784 14538: 5779: info->preserves_marks = then_info->preserves_marks;
5785 14538: 5780: info->single_result = then_info->single_result;
5786 14538: 5781: info->kclock = then_info->kclock;
5787 14538: 5782: merge_types(then_info, info, NULL);
5788 14538: 5783: info->escapes = 0;
5789 -: 5784:
5790 218128: 5785: } else if (then_info->escapes) {
5791 2255: 5786: info->preserves_marks = else_info->preserves_marks;
5792 2255: 5787: info->single_result = else_info->single_result;
5793 2255: 5788: merge_types(else_info, info, NULL);
5794 2255: 5789: info->escapes = 0;
5795 -: 5790:
5796 -: 5791: } else {
5797 -: 5792: int new_preserves_marks, new_single_result;
5798 -: 5793:
5799 215873: 5794: new_preserves_marks = or_tentative(then_info->preserves_marks, else_info->preserves_marks);
5800 215873: 5795: info->preserves_marks = new_preserves_marks;
5801 215873: 5796: new_single_result = or_tentative(then_info->single_result, else_info->single_result);
5802 215873: 5797: info->single_result = new_single_result;
5803 215873: 5798: if (then_info->kclock > info->kclock)
5804 78806: 5799: info->kclock = then_info->kclock;
5805 215873: 5800: merge_branchs_types(then_info, else_info, info);
5806 -: 5801: }
5807 -: 5802:
5808 233678: 5803: if (then_info->sclock > info->sclock)
5809 83827: 5804: info->sclock = then_info->sclock;
5810 233678: 5805: if (then_info->aclock > info->aclock)
5811 28492: 5806: info->aclock = then_info->aclock;
5812 -: 5807:
5813 233678: 5808: if ((init_vclock == then_info->vclock) && (init_vclock == info->vclock)) {
5814 -: 5809: /* we can rewind the vclock to just after the test, because the
5815 -: 5810: `if` as a whole has no effect */
5816 24091: 5811: info->vclock--;
5817 -: 5812: }
5818 -: 5813:
5819 233678: 5814: optimize_info_seq_done(info, &info_seq);
5820 -: 5815:
5821 -: 5816: /* Try optimize: (if x #f #t) => (not x) */
5822 233678: 5817: if (SCHEME_FALSEP(tb)
5823 13538: 5818: && SAME_OBJ(fb, scheme_true)) {
5824 94: 5819: info->size -= 2;
5825 94: 5820: return make_optimize_prim_application2(scheme_not_proc, t, info, context);
5826 -: 5821: }
5827 -: 5822:
5828 -: 5823: /* Convert (if <boolean> #t #f) to <boolean>
5829 -: 5824: and, for test position, convert (if <expr> #t #f) to <expr> */
5830 233584: 5825: if (SAME_OBJ(tb, scheme_true) && SAME_OBJ(fb, scheme_false)) {
5831 -: 5826: Scheme_Object *pred;
5832 -: 5827:
5833 2199: 5828: if (context & OPT_CONTEXT_BOOLEAN)
5834 -: 5829: /* In a boolean context, any expression can be extrated. */
5835 2069: 5830: pred = scheme_boolean_p_proc;
5836 -: 5831: else
5837 130: 5832: pred = expr_implies_predicate(t, info);
5838 -: 5833:
5839 2199: 5834: if (pred && predicate_implies(pred, scheme_boolean_p_proc)) {
5840 2087: 5835: info->size -= 2;
5841 2087: 5836: return ensure_single_value_noncm(t);
5842 -: 5837: }
5843 -: 5838: }
5844 -: 5839:
5845 -: 5840: /* Try optimize: (if <expr> v v) => (begin <expr> v) */
5846 -: 5841: {
5847 -: 5842: Scheme_Object *nb;
5848 -: 5843:
5849 231497: 5844: nb = equivalent_exprs(tb, fb, then_info_init, else_info_init, context);
5850 231497: 5845: if (nb) {
5851 148: 5846: info->size -= 1;
5852 148: 5847: return make_discarding_first_sequence(t, nb, info);
5853 -: 5848: }
5854 -: 5849: }
5855 -: 5850:
5856 -: 5851: /* Try optimize: (if x x #f) => x
5857 -: 5852: This pattern is included in the previous reduction,
5858 -: 5853: but this is still useful if x is mutable or a top level*/
5859 231349: 5854: if (SCHEME_FALSEP(fb)
5860 64357: 5855: && equivalent_exprs(t, tb, NULL, NULL, 0)) {
5861 4: 5856: info->size -= 2;
5862 4: 5857: return ensure_single_value(t);
5863 -: 5858: }
5864 -: 5859:
5865 -: 5860: /* Convert: expressions like
5866 -: 5861: (if (if M N #f) P K) => (if M (if N P K) K)
5867 -: 5862: for simple constants K. This is useful to expose simple
5868 -: 5863: tests to the JIT. */
5869 231345: 5864: if (SAME_TYPE(SCHEME_TYPE(t), scheme_branch_type)) {
5870 17528: 5865: Scheme_Branch_Rec *b2 = (Scheme_Branch_Rec *)t;
5871 17528: 5866: Scheme_Object *ntb, *nfb, *nt2 = NULL;
5872 17528: 5867: if (SCHEME_FALSEP(b2->fbranch)
5873 11407: 5868: && scheme_ir_duplicate_ok(fb, 0)) {
5874 -: 5869: /* (if (if M N #f) P K) => (if M (if N P K) K) */
5875 1137: 5870: ntb = (Scheme_Object *)b2;
5876 1137: 5871: nfb = optimize_clone(0, fb, info, empty_eq_hash_tree, 0);
5877 1137: 5872: nt2 = b2->tbranch;
5878 16391: 5873: } else if (SCHEME_FALSEP(b2->tbranch)
5879 377: 5874: && scheme_ir_duplicate_ok(fb, 0)) {
5880 -: 5875: /* (if (if M #f N) P K) => (if M K (if N P K)) */
5881 72: 5876: ntb = optimize_clone(0, fb, info, empty_eq_hash_tree, 0);
5882 72: 5877: nfb = (Scheme_Object *)b2;
5883 72: 5878: nt2 = b2->fbranch;
5884 16319: 5879: } else if (SAME_OBJ(b2->fbranch, scheme_true)
5885 2731: 5880: && scheme_ir_duplicate_ok(tb, 0)) {
5886 -: 5881: /* (if (if M N #t) K P) => (if M (if N K P) K) */
5887 288: 5882: ntb = (Scheme_Object *)b2;
5888 288: 5883: nfb = optimize_clone(0, tb, info, empty_eq_hash_tree, 0);
5889 288: 5884: nt2 = b2->tbranch;
5890 16031: 5885: } else if (SAME_OBJ(b2->tbranch, scheme_true)
5891 2523: 5886: && scheme_ir_duplicate_ok(tb, 0)) {
5892 -: 5887: /* (if (if M #t N) K P) => (if M K (if N K P)) */
5893 630: 5888: ntb = optimize_clone(0, tb, info, empty_eq_hash_tree, 0);
5894 630: 5889: nfb = (Scheme_Object *)b2;
5895 630: 5890: nt2 = b2->fbranch;
5896 -: 5891: }
5897 17528: 5892: if (nt2) {
5898 2127: 5893: t = b2->test;
5899 2127: 5894: b2->test = nt2;
5900 2127: 5895: b2->tbranch = tb;
5901 2127: 5896: b2->fbranch = fb;
5902 2127: 5897: tb = ntb;
5903 2127: 5898: fb = nfb;
5904 -: 5899: }
5905 -: 5900: }
5906 -: 5901:
5907 231345: 5902: b->test = t;
5908 231345: 5903: b->tbranch = tb;
5909 231345: 5904: b->fbranch = fb;
5910 -: 5905:
5911 -: 5906: if (OPT_BRANCH_ADDS_NO_SIZE) {
5912 -: 5907: /* Seems to work better to not to increase the size
5913 -: 5908: specifically for `if' */
5914 -: 5909: } else {
5915 -: 5910: info->size += 1;
5916 -: 5911: }
5917 -: 5912:
5918 231345: 5913: return o;
5919 -: 5914:}
5920 -: 5915:
5921 -: 5916:/*========================================================================*/
5922 -: 5917:/* with-continuation-marks */
5923 -: 5918:/*========================================================================*/
5924 -: 5919:
5925 3505: 5920:static int omittable_key(Scheme_Object *k, Optimize_Info *info)
5926 -: 5921:{
5927 -: 5922: /* A key is not omittable if it might refer to a chaperoned/impersonated
5928 -: 5923: continuation mark key, so that's why we pass OMITTABLE_KEEP_VARS: */
5929 3505: 5924: return scheme_omittable_expr(k, 1, 20, OMITTABLE_KEEP_VARS, info, info);
5930 -: 5925:}
5931 -: 5926:
5932 3509: 5927:static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int context)
5933 -: 5928:{
5934 3509: 5929: Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)o;
5935 -: 5930: Scheme_Object *k, *v, *b;
5936 -: 5931: int init_vclock;
5937 -: 5932: Optimize_Info_Sequence info_seq;
5938 -: 5933:
5939 3509: 5934: optimize_info_seq_init(info, &info_seq);
5940 -: 5935:
5941 3509: 5936: k = scheme_optimize_expr(wcm->key, info, OPT_CONTEXT_SINGLED);
5942 -: 5937:
5943 3509: 5938: if (info->escapes) {
5944 2: 5939: optimize_info_seq_done(info, &info_seq);
5945 2: 5940: return ensure_noncm(k);
5946 -: 5941: }
5947 -: 5942:
5948 3507: 5943: optimize_info_seq_step(info, &info_seq);
5949 -: 5944:
5950 3507: 5945: v = scheme_optimize_expr(wcm->val, info, OPT_CONTEXT_SINGLED);
5951 -: 5946:
5952 3507: 5947: if (info->escapes) {
5953 2: 5948: optimize_info_seq_done(info, &info_seq);
5954 2: 5949: info->size += 1;
5955 2: 5950: return ensure_noncm(make_discarding_first_sequence(k, v, info));
5956 -: 5951: }
5957 -: 5952:
5958 -: 5953: /* The presence of a key can be detected by other expressions,
5959 -: 5954: to increment vclock to prevent expressions incorrectly
5960 -: 5955: moving under the mark: */
5961 3505: 5956: info->vclock++;
5962 3505: 5957: init_vclock = info->vclock;
5963 -: 5958:
5964 3505: 5959: optimize_info_seq_step(info, &info_seq);
5965 -: 5960:
5966 3505: 5961: b = scheme_optimize_expr(wcm->body, info, scheme_optimize_tail_context(context));
5967 -: 5962:
5968 3505: 5963: if (init_vclock == info->vclock) {
5969 -: 5964: /* body has no effect itself, so we can rewind the clock */
5970 22: 5965: info->vclock--;
5971 -: 5966: }
5972 -: 5967:
5973 3505: 5968: optimize_info_seq_done(info, &info_seq);
5974 -: 5969:
5975 -: 5970: /* If the body cannot inspect the continution, and if the key is not
5976 -: 5971: a chaperone, no need to add the mark: */
5977 3505: 5972: if (omittable_key(k, info)
5978 2044: 5973: && scheme_omittable_expr(b, -1, 20, 0, info, info))
5979 50: 5974: return make_discarding_first_sequence(v, b, info);
5980 -: 5975:
5981 -: 5976: /* info->single_result is already set */
5982 3455: 5977: info->preserves_marks = 0;
5983 -: 5978:
5984 3455: 5979: wcm->key = k;
5985 3455: 5980: wcm->val = v;
5986 3455: 5981: wcm->body = b;
5987 -: 5982:
5988 3455: 5983: info->size += 1;
5989 -: 5984:
5990 -: 5985: /* Simplify (with-continuation-mark <same-key> <val1>
5991 -: 5986: (with-continuation-mark <same-key> <val2>
5992 -: 5987: <body>))
5993 -: 5988: to (begin
5994 -: 5989: <val1>
5995 -: 5990: (with-continuation-mark <same-key> <val2>
5996 -: 5991: <body>))
5997 -: 5992: as long as <val2> doesn't inspect the continuation. */
5998 3455: 5993: if (SAME_TYPE(SCHEME_TYPE(wcm->body), scheme_with_cont_mark_type)
5999 21: 5994: && equivalent_exprs(wcm->key, ((Scheme_With_Continuation_Mark *)wcm->body)->key, NULL, NULL, 0)
6000 11: 5995: && scheme_omittable_expr(((Scheme_With_Continuation_Mark *)wcm->body)->val, 1, 20, 0, info, info))
6001 4: 5996: return make_discarding_first_sequence(wcm->val, wcm->body, info);
6002 -: 5997:
6003 3451: 5998: return (Scheme_Object *)wcm;
6004 -: 5999:}
6005 -: 6000:
6006 -: 6001:/*========================================================================*/
6007 -: 6002:/* other syntax */
6008 -: 6003:/*========================================================================*/
6009 -: 6004:
6010 -: 6005:static Scheme_Object *
6011 16194: 6006:define_values_optimize(Scheme_Object *data, Optimize_Info *info, int context)
6012 -: 6007:{
6013 16194: 6008: Scheme_Object *vars = SCHEME_VEC_ELS(data)[0];
6014 16194: 6009: Scheme_Object *val = SCHEME_VEC_ELS(data)[1];
6015 -: 6010:
6016 16194: 6011: optimize_info_used_top(info);
6017 16194: 6012: val = scheme_optimize_expr(val, info, 0);
6018 -: 6013:
6019 16193: 6014: SCHEME_VEC_ELS(data)[0] = vars;
6020 16193: 6015: SCHEME_VEC_ELS(data)[1] = val;
6021 -: 6016:
6022 16193: 6017: return data;
6023 -: 6018:}
6024 -: 6019:
6025 -: 6020:static Scheme_Object *
6026 2845: 6021:set_optimize(Scheme_Object *data, Optimize_Info *info, int context)
6027 -: 6022:{
6028 2845: 6023: Scheme_Set_Bang *sb = (Scheme_Set_Bang *)data;
6029 -: 6024: Scheme_Object *var, *val;
6030 -: 6025:
6031 2845: 6026: var = sb->var;
6032 2845: 6027: val = sb->val;
6033 -: 6028:
6034 2845: 6029: val = scheme_optimize_expr(val, info, OPT_CONTEXT_SINGLED);
6035 -: 6030:
6036 2845: 6031: if (info->escapes)
6037 10: 6032: return ensure_noncm(val);
6038 -: 6033:
6039 2835: 6034: info->preserves_marks = 1;
6040 2835: 6035: info->single_result = 1;
6041 -: 6036:
6042 2835: 6037: if (SAME_TYPE(SCHEME_TYPE(var), scheme_ir_local_type)) {
6043 2542: 6038: register_use(SCHEME_VAR(var), info);
6044 -: 6039: } else {
6045 293: 6040: optimize_info_used_top(info);
6046 -: 6041: }
6047 -: 6042:
6048 2835: 6043: info->vclock++;
6049 -: 6044:
6050 2835: 6045: sb->var = var;
6051 2835: 6046: sb->val = val;
6052 -: 6047:
6053 2835: 6048: return (Scheme_Object *)sb;
6054 -: 6049:}
6055 -: 6050:
6056 -: 6051:static Scheme_Object *
6057 1696: 6052:set_clone(int single_use, Scheme_Object *data, Optimize_Info *info, Scheme_Hash_Tree *var_map)
6058 -: 6053:{
6059 1696: 6054: Scheme_Set_Bang *sb = (Scheme_Set_Bang *)data, *naya;
6060 -: 6055: Scheme_Object *var, *val;
6061 -: 6056:
6062 1696: 6057: naya = MALLOC_ONE_TAGGED(Scheme_Set_Bang);
6063 1696: 6058: memcpy(naya, sb, sizeof(Scheme_Set_Bang));
6064 -: 6059:
6065 1696: 6060: var = naya->var;
6066 1696: 6061: val = naya->val;
6067 -: 6062:
6068 1696: 6063: val = optimize_clone(single_use, val, info, var_map, 0);
6069 1696: 6064: if (!val) return NULL;
6070 1672: 6065: if (SAME_TYPE(SCHEME_TYPE(var), scheme_ir_local_type)) {
6071 1524: 6066: var = optimize_clone(single_use, var, info, var_map, 0);
6072 1524: 6067: if (!var) return NULL;
6073 -: 6068: }
6074 -: 6069:
6075 1672: 6070: naya->var = var;
6076 1672: 6071: naya->val = val;
6077 -: 6072:
6078 1672: 6073: return (Scheme_Object *)naya;
6079 -: 6074:}
6080 -: 6075:
6081 -: 6076:static Scheme_Object *
6082 1114: 6077:ref_optimize(Scheme_Object *data, Optimize_Info *info, int context)
6083 -: 6078:{
6084 -: 6079: Scheme_Object *v;
6085 -: 6080:
6086 1114: 6081: optimize_info_used_top(info);
6087 -: 6082:
6088 1114: 6083: v = SCHEME_PTR1_VAL(data);
6089 1114: 6084: if (SAME_TYPE(SCHEME_TYPE(v), scheme_ir_local_type)) {
6090 18: 6085: SCHEME_PTR1_VAL(data) = (SCHEME_VAR(v)->mutated ? scheme_false : scheme_true);
6091 1096: 6086: } else if (SAME_TYPE(SCHEME_TYPE(v), scheme_ir_toplevel_type)) {
6092 -: 6087: /* Knowing whether a top-level variable is fixed lets up optimize
6093 -: 6088: uses of `variable-reference-constant?` */
6094 1096: 6089: if (info->top_level_consts) {
6095 922: 6090: int pos = SCHEME_TOPLEVEL_POS(v);
6096 922: 6091: int fixed = 0;
6097 -: 6092:
6098 922: 6093: if (scheme_hash_get(info->top_level_consts, scheme_make_integer(pos)))
6099 #####: 6094: fixed = 1;
6100 -: 6095: else {
6101 -: 6096: GC_CAN_IGNORE Scheme_Object *t;
6102 922: 6097: t = scheme_hash_get(info->top_level_consts, scheme_false);
6103 922: 6098: if (t) {
6104 697: 6099: if (scheme_hash_get((Scheme_Hash_Table *)t, scheme_make_integer(pos)))
6105 57: 6100: fixed = 1;
6106 -: 6101: }
6107 -: 6102: }
6108 -: 6103:
6109 922: 6104: if (fixed) {
6110 57: 6105: v = scheme_toplevel_to_flagged_toplevel(v, SCHEME_TOPLEVEL_FIXED);
6111 57: 6106: SCHEME_PTR1_VAL(data) = v;
6112 -: 6107: }
6113 -: 6108: }
6114 -: 6109: }
6115 -: 6110:
6116 1114: 6111: info->preserves_marks = 1;
6117 1114: 6112: info->single_result = 1;
6118 1114: 6113: info->size++;
6119 -: 6114:
6120 1114: 6115: return data;
6121 -: 6116:}
6122 -: 6117:
6123 -: 6118:static Scheme_Object *
6124 150: 6119:ref_clone(int single_use, Scheme_Object *data, Optimize_Info *info, Scheme_Hash_Tree *var_map)
6125 -: 6120:{
6126 -: 6121: Scheme_Object *naya;
6127 -: 6122: Scheme_Object *a, *b;
6128 -: 6123:
6129 150: 6124: a = SCHEME_PTR1_VAL(data);
6130 150: 6125: a = optimize_clone(single_use, a, info, var_map, 0);
6131 150: 6126: if (!a) return NULL;
6132 -: 6127:
6133 150: 6128: b = SCHEME_PTR2_VAL(data);
6134 150: 6129: b = optimize_clone(single_use, b, info, var_map, 0);
6135 150: 6130: if (!b) return NULL;
6136 -: 6131:
6137 150: 6132: naya = scheme_alloc_object();
6138 150: 6133: naya->type = scheme_varref_form_type;
6139 150: 6134: SCHEME_PTR1_VAL(naya) = a;
6140 150: 6135: SCHEME_PTR2_VAL(naya) = b;
6141 -: 6136:
6142 150: 6137: return naya;
6143 -: 6138:}
6144 -: 6139:
6145 -: 6140:static Scheme_Object *
6146 739: 6141:apply_values_optimize(Scheme_Object *data, Optimize_Info *info, int context)
6147 -: 6142:{
6148 -: 6143: Scheme_Object *f, *e;
6149 -: 6144: Optimize_Info_Sequence info_seq;
6150 -: 6145:
6151 739: 6146: f = SCHEME_PTR1_VAL(data);
6152 739: 6147: e = SCHEME_PTR2_VAL(data);
6153 -: 6148:
6154 739: 6149: optimize_info_seq_init(info, &info_seq);
6155 -: 6150:
6156 739: 6151: f = scheme_optimize_expr(f, info, OPT_CONTEXT_SINGLED);
6157 -: 6152:
6158 739: 6153: if (info->escapes) {
6159 #####: 6154: optimize_info_seq_done(info, &info_seq);
6160 #####: 6155: return ensure_noncm(f);
6161 -: 6156: }
6162 739: 6157: optimize_info_seq_step(info, &info_seq);
6163 -: 6158:
6164 739: 6159: e = scheme_optimize_expr(e, info, 0);
6165 -: 6160:
6166 739: 6161: optimize_info_seq_done(info, &info_seq);
6167 -: 6162:
6168 739: 6163: if (info->escapes) {
6169 2: 6164: info->size += 1;
6170 2: 6165: return ensure_noncm(make_discarding_first_sequence(f, e, info));
6171 -: 6166: }
6172 -: 6167:
6173 737: 6168: info->size += 1;
6174 737: 6169: info->vclock += 1;
6175 737: 6170: info->kclock += 1;
6176 737: 6171: info->sclock += 1;
6177 -: 6172:
6178 737: 6173: return optimize_apply_values(f, e, info, info->single_result, context);
6179 -: 6174:}
6180 -: 6175:
6181 -: 6176:static Scheme_Object *
6182 340: 6177:apply_values_clone(int single_use, Scheme_Object *data, Optimize_Info *info, Scheme_Hash_Tree *var_map)
6183 -: 6178:{
6184 -: 6179: Scheme_Object *f, *e;
6185 -: 6180:
6186 340: 6181: f = SCHEME_PTR1_VAL(data);
6187 340: 6182: e = SCHEME_PTR2_VAL(data);
6188 -: 6183:
6189 340: 6184: f = optimize_clone(single_use, f, info, var_map, 0);
6190 340: 6185: if (!f) return NULL;
6191 340: 6186: e = optimize_clone(single_use, e, info, var_map, 0);
6192 340: 6187: if (!e) return NULL;
6193 -: 6188:
6194 340: 6189: data = scheme_alloc_object();
6195 340: 6190: data->type = scheme_apply_values_type;
6196 340: 6191: SCHEME_PTR1_VAL(data) = f;
6197 340: 6192: SCHEME_PTR2_VAL(data) = e;
6198 -: 6193:
6199 340: 6194: return data;
6200 -: 6195:}
6201 -: 6196:
6202 -: 6197:static Scheme_Object *
6203 267: 6198:with_immed_mark_optimize(Scheme_Object *data, Optimize_Info *info, int context)
6204 -: 6199:{
6205 267: 6200: Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)data;
6206 -: 6201: Scheme_Object *key, *val, *body;
6207 -: 6202: Optimize_Info_Sequence info_seq;
6208 -: 6203: Optimize_Info *body_info;
6209 -: 6204: Scheme_IR_Local *var;
6210 -: 6205:
6211 267: 6206: optimize_info_seq_init(info, &info_seq);
6212 -: 6207:
6213 267: 6208: key = scheme_optimize_expr(wcm->key, info, OPT_CONTEXT_SINGLED);
6214 267: 6209: optimize_info_seq_step(info, &info_seq);
6215 267: 6210: if (info->escapes) {
6216 #####: 6211: optimize_info_seq_done(info, &info_seq);
6217 #####: 6212: return ensure_noncm(key);
6218 -: 6213: }
6219 -: 6214:
6220 267: 6215: val = scheme_optimize_expr(wcm->val, info, OPT_CONTEXT_SINGLED);
6221 267: 6216: optimize_info_seq_step(info, &info_seq);
6222 267: 6217: if (info->escapes) {
6223 #####: 6218: optimize_info_seq_done(info, &info_seq);
6224 #####: 6219: return ensure_noncm(make_discarding_first_sequence(key, val, info));
6225 -: 6220: }
6226 -: 6221:
6227 267: 6222: optimize_info_seq_done(info, &info_seq);
6228 -: 6223:
6229 267: 6224: body_info = optimize_info_add_frame(info, 1, 1, 0);
6230 267: 6225: var = SCHEME_VAR(SCHEME_CAR(wcm->body));
6231 267: 6226: set_optimize_mode(var);
6232 267: 6227: var->optimize.lambda_depth = body_info->lambda_depth;
6233 267: 6228: var->optimize_used = 0;
6234 267: 6229: var->optimize.init_kclock = info->kclock;
6235 -: 6230:
6236 267: 6231: body = scheme_optimize_expr(SCHEME_CDR(wcm->body), body_info, 0);
6237 -: 6232:
6238 267: 6233: optimize_info_done(body_info, NULL);
6239 -: 6234:
6240 267: 6235: wcm->key = key;
6241 267: 6236: wcm->val = val;
6242 267: 6237: SCHEME_CDR(wcm->body) = body;
6243 -: 6238:
6244 267: 6239: return data;
6245 -: 6240:}
6246 -: 6241:
6247 -: 6242:static Scheme_Object *
6248 112: 6243:with_immed_mark_clone(int single_use, Scheme_Object *data, Optimize_Info *info, Scheme_Hash_Tree *var_map)
6249 -: 6244:{
6250 112: 6245: Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)data;
6251 -: 6246: Scheme_With_Continuation_Mark *wcm2;
6252 -: 6247: Scheme_Object *e;
6253 -: 6248: Scheme_IR_Local *var;
6254 -: 6249:
6255 112: 6250: wcm2 = MALLOC_ONE_TAGGED(Scheme_With_Continuation_Mark);
6256 112: 6251: wcm2->so.type = scheme_with_immed_mark_type;
6257 -: 6252:
6258 112: 6253: e = optimize_clone(single_use, wcm->key, info, var_map, 0);
6259 112: 6254: if (!e) return NULL;
6260 112: 6255: wcm2->key = e;
6261 -: 6256:
6262 112: 6257: e = optimize_clone(single_use, wcm->val, info, var_map, 0);
6263 112: 6258: if (!e) return NULL;
6264 112: 6259: wcm2->val = e;
6265 -: 6260:
6266 112: 6261: var = clone_variable(SCHEME_VAR(SCHEME_CAR(wcm->body)));
6267 112: 6262: var_map = scheme_hash_tree_set(var_map, SCHEME_CAR(wcm->body), (Scheme_Object *)var);
6268 -: 6263:
6269 112: 6264: e = optimize_clone(single_use, SCHEME_CDR(wcm->body), info, var_map, 0);
6270 112: 6265: if (!e) return NULL;
6271 112: 6266: e = scheme_make_mutable_pair((Scheme_Object *)var, e);
6272 112: 6267: wcm2->body = e;
6273 -: 6268:
6274 112: 6269: return (Scheme_Object *)wcm2;
6275 -: 6270:}
6276 -: 6271:
6277 -: 6272:static Scheme_Object *
6278 2026: 6273:case_lambda_optimize(Scheme_Object *expr, Optimize_Info *info, int context)
6279 -: 6274:{
6280 -: 6275: Scheme_Object *le;
6281 -: 6276: int i;
6282 2026: 6277: Scheme_Case_Lambda *seq = (Scheme_Case_Lambda *)expr;
6283 -: 6278:
6284 6785: 6279: for (i = 0; i < seq->count; i++) {
6285 4759: 6280: le = seq->array[i];
6286 4759: 6281: le = scheme_optimize_expr(le, info, 0);
6287 4759: 6282: seq->array[i] = le;
6288 -: 6283: }
6289 -: 6284:
6290 2026: 6285: info->preserves_marks = 1;
6291 2026: 6286: info->single_result = 1;
6292 2026: 6287: info->size += 1;
6293 -: 6288:
6294 2026: 6289: return expr;
6295 -: 6290:}
6296 -: 6291:
6297 -: 6292:static Scheme_Object *
6298 764: 6293:case_lambda_clone(int single_use, Scheme_Object *data, Optimize_Info *info, Scheme_Hash_Tree *var_map)
6299 -: 6294:{
6300 -: 6295: Scheme_Object *le;
6301 -: 6296: int i, sz;
6302 764: 6297: Scheme_Case_Lambda *seq = (Scheme_Case_Lambda *)data;
6303 -: 6298: Scheme_Case_Lambda *seq2;
6304 -: 6299:
6305 764: 6300: sz = sizeof(Scheme_Case_Lambda) + ((seq->count - mzFLEX_DELTA) * sizeof(Scheme_Object*));
6306 764: 6301: seq2 = (Scheme_Case_Lambda *)scheme_malloc_tagged(sz);
6307 764: 6302: memcpy(seq2, seq, sz);
6308 -: 6303:
6309 2529: 6304: for (i = 0; i < seq->count; i++) {
6310 1765: 6305: le = seq->array[i];
6311 1765: 6306: le = optimize_clone(single_use, le, info, var_map, 0);
6312 1765: 6307: if (!le) return NULL;
6313 1765: 6308: seq2->array[i] = le;
6314 -: 6309: }
6315 -: 6310:
6316 764: 6311: return (Scheme_Object *)seq2;
6317 -: 6312:}
6318 -: 6313:
6319 370: 6314:static Scheme_Object *begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context)
6320 -: 6315:{
6321 370: 6316: int i, count, drop = 0, prev_size, single_result = 0, preserves_marks = 0, kclock = 0, sclock = 0;
6322 370: 6317: Scheme_Sequence *s = (Scheme_Sequence *)obj;
6323 370: 6318: Scheme_Object *inside = NULL, *expr, *orig_first;
6324 -: 6319: Scheme_Object *le;
6325 -: 6320: Optimize_Info_Sequence info_seq;
6326 -: 6321:
6327 370: 6322: count = s->count;
6328 370: 6323: optimize_info_seq_init(info, &info_seq);
6329 -: 6324:
6330 1087: 6325: for (i = 0; i < count; i++) {
6331 747: 6326: prev_size = info->size;
6332 -: 6327:
6333 747: 6328: optimize_info_seq_step(info, &info_seq);
6334 -: 6329:
6335 747: 6330: le = scheme_optimize_expr(s->array[i],
6336 -: 6331: info,
6337 -: 6332: (!i
6338 -: 6333: ? scheme_optimize_result_context(context)
6339 -: 6334: : 0));
6340 -: 6335:
6341 747: 6336: if (!i) {
6342 370: 6337: single_result = info->single_result;
6343 370: 6338: preserves_marks = info->preserves_marks;
6344 370: 6339: kclock = info->kclock;
6345 370: 6340: sclock = info->sclock;
6346 370: 6341: s->array[0] = le;
6347 -: 6342: } else {
6348 -: 6343: /* Inlining and constant propagation can expose omittable expressions: */
6349 377: 6344: le = optimize_ignored(le, info, -1, 1, 5);
6350 377: 6345: if (!le) {
6351 99: 6346: drop++;
6352 99: 6347: info->size = prev_size;
6353 99: 6348: s->array[i] = NULL;
6354 -: 6349: } else {
6355 278: 6350: s->array[i] = le;
6356 -: 6351: }
6357 -: 6352: }
6358 -: 6353:
6359 747: 6354: if (info->escapes) {
6360 -: 6355: int j;
6361 30: 6356: single_result = info->single_result;
6362 30: 6357: preserves_marks = info->preserves_marks;
6363 42: 6358: for (j = i + 1; j < count; j++) {
6364 12: 6359: drop++;
6365 12: 6360: s->array[j] = NULL;
6366 -: 6361: }
6367 30: 6362: break;
6368 -: 6363: }
6369 -: 6364: }
6370 -: 6365:
6371 370: 6366: optimize_info_seq_done(info, &info_seq);
6372 -: 6367:
6373 370: 6368: if (info->escapes) {
6374 -: 6369: /* In case of an error, optimize (begin0 ... <error> ...) => (begin ... <error>) */
6375 -: 6370: Scheme_Sequence *s2;
6376 30: 6371: int j = 0;
6377 -: 6372:
6378 30: 6373: info->single_result = 1;
6379 30: 6374: info->preserves_marks = 1;
6380 -: 6375:
6381 30: 6376: if (i != 0) {
6382 -: 6377: /* We will ignore the first expression too */
6383 6: 6378: le = optimize_ignored(s->array[0], info, -1, 1, 5);
6384 6: 6379: if (!le) {
6385 2: 6380: drop++;
6386 2: 6381: info->size = prev_size;
6387 2: 6382: s->array[0] = NULL;
6388 -: 6383: } else {
6389 4: 6384: s->array[0] = le;
6390 -: 6385: }
6391 -: 6386: }
6392 -: 6387:
6393 30: 6388: if ((count - drop) == 1) {
6394 -: 6389: /* If it's only one expression we can drop the begin0 */
6395 26: 6390: return ensure_noncm(s->array[i]);
6396 -: 6391: }
6397 -: 6392:
6398 4: 6393: s2 = scheme_malloc_sequence(count - drop);
6399 4: 6394: s2->so.type = scheme_sequence_type;
6400 4: 6395: s2->count = count - drop;
6401 -: 6396:
6402 20: 6397: for (i = 0; i < count; i++) {
6403 16: 6398: if (s->array[i]) {
6404 12: 6399: s2->array[j++] = s->array[i];
6405 -: 6400: }
6406 -: 6401: }
6407 4: 6402: return flatten_sequence((Scheme_Object *)s2, info, context);
6408 -: 6403: }
6409 -: 6404:
6410 340: 6405: info->preserves_marks = 1;
6411 340: 6406: info->single_result = single_result;
6412 -: 6407:
6413 340: 6408: if ((s->count - drop) == 1 && (preserves_marks == 1)) {
6414 -: 6409: /* If the first expression preserves marks we can drop the begin0 */
6415 26: 6410: return s->array[0];
6416 -: 6411: }
6417 -: 6412:
6418 314: 6413: expr = s->array[0];
6419 314: 6414: orig_first = s->array[0];
6420 314: 6415: extract_tail_inside(&expr, &inside);
6421 -: 6416:
6422 -: 6417: /* Try optimize (begin0 <movable> ...) => (begin ... <movable>) */
6423 314: 6418: if (movable_expression(expr, info, 0, kclock != info->kclock,
6424 314: 6419: sclock != info->sclock, 0, 50)) {
6425 12: 6420: if ((s->count - drop) == 1) {
6426 -: 6421: /* drop the begin0 */
6427 #####: 6422: info->size -= 1;
6428 -: 6423: /* expr = expr */
6429 -: 6424: } else {
6430 -: 6425: Scheme_Sequence *s2;
6431 12: 6426: int j = 0;
6432 -: 6427:
6433 12: 6428: s2 = scheme_malloc_sequence(s->count - drop);
6434 12: 6429: s2->so.type = scheme_sequence_type;
6435 12: 6430: s2->count = s->count - drop;
6436 -: 6431:
6437 24: 6432: for (i = 1; i < s->count; i++) {
6438 12: 6433: if (s->array[i]) {
6439 12: 6434: s2->array[j++] = s->array[i];
6440 -: 6435: }
6441 -: 6436: }
6442 12: 6437: s2->array[j++] = expr;
6443 -: 6438:
6444 12: 6439: expr = (Scheme_Object *)s2;
6445 -: 6440: }
6446 -: 6441: } else {
6447 302: 6442: if (drop) {
6448 -: 6443: Scheme_Sequence *s2;
6449 15: 6444: int j = 0;
6450 -: 6445:
6451 15: 6446: s2 = scheme_malloc_sequence(s->count - drop);
6452 15: 6447: s2->so.type = s->so.type;
6453 15: 6448: s2->count = s->count - drop;
6454 -: 6449:
6455 15: 6450: s2->array[j++] = expr;
6456 89: 6451: for (i = 1; i < s->count; i++) {
6457 74: 6452: if (s->array[i]) {
6458 1: 6453: s2->array[j++] = s->array[i];
6459 -: 6454: }
6460 -: 6455: }
6461 -: 6456:
6462 15: 6457: expr = (Scheme_Object *)s2;
6463 -: 6458: } else {
6464 287: 6459: s->array[0] = expr;
6465 287: 6460: expr = (Scheme_Object *)s;
6466 -: 6461: }
6467 -: 6462: }
6468 -: 6463:
6469 314: 6464: info->size += 1;
6470 314: 6465: expr = flatten_sequence(expr, info, context);
6471 314: 6466: return replace_tail_inside(expr, inside, orig_first);
6472 -: 6467:}
6473 -: 6468:
6474 7: 6469:static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info)
6475 -: 6470:{
6476 -: 6471: Scheme_Object *val;
6477 -: 6472: Optimize_Info *einfo;
6478 -: 6473:
6479 7: 6474: val = SCHEME_VEC_ELS(data)[3];
6480 -: 6475:
6481 7: 6476: einfo = scheme_optimize_info_create(info->cp, info->env, info->insp, 0);
6482 7: 6477: if (info->inline_fuel < 0)
6483 #####: 6478: einfo->inline_fuel = -1;
6484 7: 6479: einfo->logger = info->logger;
6485 -: 6480:
6486 7: 6481: val = scheme_optimize_expr(val, einfo, 0);
6487 -: 6482:
6488 7: 6483: SCHEME_VEC_ELS(data)[3] = val;
6489 -: 6484:
6490 7: 6485: return data;
6491 -: 6486:}
6492 -: 6487:
6493 7: 6488:static Scheme_Object *define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info, int context)
6494 -: 6489:{
6495 7: 6490: return do_define_syntaxes_optimize(data, info);
6496 -: 6491:}
6497 -: 6492:
6498 #####: 6493:static Scheme_Object *begin_for_syntax_optimize(Scheme_Object *data, Optimize_Info *info, int context)
6499 -: 6494:{
6500 -: 6495: Scheme_Object *l, *a;
6501 -: 6496: Optimize_Info *einfo;
6502 -: 6497:
6503 #####: 6498: l = SCHEME_VEC_ELS(data)[2];
6504 -: 6499:
6505 #####: 6500: while (!SCHEME_NULLP(l)) {
6506 #####: 6501: einfo = scheme_optimize_info_create(info->cp, info->env, info->insp, 0);
6507 #####: 6502: if (info->inline_fuel < 0)
6508 #####: 6503: einfo->inline_fuel = -1;
6509 #####: 6504: einfo->logger = info->logger;
6510 -: 6505:
6511 #####: 6506: a = SCHEME_CAR(l);
6512 #####: 6507: a = scheme_optimize_expr(a, einfo, 0);
6513 #####: 6508: SCHEME_CAR(l) = a;
6514 -: 6509:
6515 #####: 6510: l = SCHEME_CDR(l);
6516 -: 6511: }
6517 -: 6512:
6518 #####: 6513: return data;
6519 -: 6514:}
6520 -: 6515:
6521 -: 6516:/*========================================================================*/
6522 -: 6517:/* let, let-values, letrec, etc. */
6523 -: 6518:/*========================================================================*/
6524 -: 6519:
6525 439: 6520:static int is_liftable_prim(Scheme_Object *v, int or_escape)
6526 -: 6521:/* Can we lift a call to `v` out of a `letrec` to a wrapping `let`? */
6527 -: 6522:{
6528 439: 6523: if (SCHEME_PRIMP(v)) {
6529 254: 6524: int opt = (((Scheme_Primitive_Proc *)v)->pp.flags & SCHEME_PRIM_OPT_MASK);
6530 254: 6525: if (opt >= SCHEME_PRIM_OPT_IMMEDIATE)
6531 112: 6526: return 1;
6532 142: 6527: if (or_escape && (opt >= SCHEME_PRIM_OPT_NONCM)) {
6533 24: 6528: if (SCHEME_PRIM_PROC_OPT_FLAGS(v) & SCHEME_PRIM_ALWAYS_ESCAPES)
6534 20: 6529: return 1;
6535 -: 6530: }
6536 -: 6531: }
6537 -: 6532:
6538 307: 6533: if (SAME_OBJ(v, scheme_values_proc))
6539 16: 6534: return 1;
6540 -: 6535:
6541 291: 6536: return 0;
6542 -: 6537:}
6543 -: 6538:
6544 16574: 6539:int scheme_is_liftable(Scheme_Object *o, Scheme_Hash_Tree *exclude_vars, int fuel, int as_rator, int or_escape)
6545 -: 6540: /* Can we lift `o` out of a `letrec` to a wrapping `let`? Refences
6546 -: 6541: to `exclude_vars` are not allowed, since those are the LHS. */
6547 -: 6542:{
6548 16574: 6543: Scheme_Type t = SCHEME_TYPE(o);
6549 -: 6544:
6550 16574: 6545: if (!fuel) return 0;
6551 -: 6546:
6552 16574: 6547: switch (t) {
6553 -: 6548: case scheme_ir_lambda_type:
6554 15337: 6549: return !as_rator;
6555 -: 6550: case scheme_case_lambda_sequence_type:
6556 32: 6551: return !as_rator;
6557 -: 6552: case scheme_ir_toplevel_type:
6558 3: 6553: return 1;
6559 -: 6554: case scheme_ir_local_type:
6560 80: 6555: if (!scheme_hash_tree_get(exclude_vars, o))
6561 67: 6556: return 1;
6562 13: 6557: break;
6563 -: 6558: case scheme_branch_type:
6564 -: 6559: {
6565 33: 6560: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)o;
6566 33: 6561: if (scheme_is_liftable(b->test, exclude_vars, fuel - 1, 0, or_escape)
6567 26: 6562: && scheme_is_liftable(b->tbranch, exclude_vars, fuel - 1, as_rator, or_escape)
6568 2: 6563: && scheme_is_liftable(b->fbranch, exclude_vars, fuel - 1, as_rator, or_escape))
6569 2: 6564: return 1;
6570 -: 6565: }
6571 31: 6566: break;
6572 -: 6567: case scheme_application_type:
6573 -: 6568: {
6574 149: 6569: Scheme_App_Rec *app = (Scheme_App_Rec *)o;
6575 -: 6570: int i;
6576 149: 6571: if (!is_liftable_prim(app->args[0], or_escape))
6577 124: 6572: return 0;
6578 74: 6573: for (i = app->num_args + 1; i--; ) {
6579 25: 6574: if (!scheme_is_liftable(app->args[i], exclude_vars, fuel - 1, 1, or_escape))
6580 1: 6575: return 0;
6581 -: 6576: }
6582 24: 6577: return 1;
6583 -: 6578: }
6584 -: 6579: break;
6585 -: 6580: case scheme_application2_type:
6586 -: 6581: {
6587 166: 6582: Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
6588 166: 6583: if (!is_liftable_prim(app->rator, or_escape))
6589 129: 6584: return 0;
6590 37: 6585: if (scheme_is_liftable(app->rator, exclude_vars, fuel - 1, 1, or_escape)
6591 37: 6586: && scheme_is_liftable(app->rand, exclude_vars, fuel - 1, 1, or_escape))
6592 34: 6587: return 1;
6593 -: 6588: }
6594 3: 6589: break;
6595 -: 6590: case scheme_application3_type:
6596 -: 6591: {
6597 124: 6592: Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
6598 124: 6593: if (!is_liftable_prim(app->rator, or_escape))
6599 38: 6594: return 0;
6600 86: 6595: if (scheme_is_liftable(app->rator, exclude_vars, fuel - 1, 1, or_escape)
6601 86: 6596: && scheme_is_liftable(app->rand1, exclude_vars, fuel - 1, 1, or_escape)
6602 65: 6597: && scheme_is_liftable(app->rand2, exclude_vars, fuel - 1, 1, or_escape))
6603 65: 6598: return 1;
6604 -: 6599: }
6605 21: 6600: break;
6606 -: 6601: case scheme_ir_let_header_type:
6607 -: 6602: {
6608 53: 6603: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)o;
6609 -: 6604: int i;
6610 -: 6605:
6611 53: 6606: o = lh->body;
6612 129: 6607: for (i = lh->num_clauses; i--; ) {
6613 56: 6608: if (!scheme_is_liftable(((Scheme_IR_Let_Value *)o)->value, exclude_vars, fuel - 1, as_rator, or_escape))
6614 33: 6609: return 0;
6615 23: 6610: o = ((Scheme_IR_Let_Value *)o)->body;
6616 -: 6611: }
6617 20: 6612: if (scheme_is_liftable(o, exclude_vars, fuel - 1, as_rator, or_escape))
6618 7: 6613: return 1;
6619 13: 6614: break;
6620 -: 6615: }
6621 -: 6616: default:
6622 597: 6617: if (t > _scheme_ir_values_types_)
6623 421: 6618: return 1;
6624 -: 6619: }
6625 -: 6620:
6626 257: 6621: return 0;
6627 -: 6622:}
6628 -: 6623:
6629 344859: 6624:int scheme_ir_propagate_ok(Scheme_Object *value, Optimize_Info *info)
6630 -: 6625:/* Can we constant-propagate the expression `value`? */
6631 -: 6626:{
6632 344859: 6627: if (SAME_TYPE(SCHEME_TYPE(value), scheme_ir_lambda_type)) {
6633 -: 6628: int sz;
6634 41437: 6629: sz = lambda_body_size_plus_info((Scheme_Lambda *)value, 1, info, NULL);
6635 41437: 6630: if ((sz >= 0) && (sz <= MAX_PROC_INLINE_SIZE))
6636 37992: 6631: return 1;
6637 -: 6632: else {
6638 3445: 6633: Scheme_Lambda *lam = (Scheme_Lambda *)value;
6639 3445: 6634: if (sz < 0)
6640 52: 6635: scheme_log(info->logger,
6641 -: 6636: SCHEME_LOG_DEBUG,
6642 -: 6637: 0,
6643 -: 6638: /* contains non-copyable body elements that prevent inlining */
6644 -: 6639: "non-copyable %s size: %d threshold: %d#<separator>%s",
6645 26: 6640: scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL),
6646 -: 6641: sz,
6647 -: 6642: 0, /* no sensible threshold here */
6648 -: 6643: scheme_optimize_context_to_string(info->context));
6649 -: 6644: else
6650 6838: 6645: scheme_log(info->logger,
6651 -: 6646: SCHEME_LOG_DEBUG,
6652 -: 6647: 0,
6653 -: 6648: /* too large to be an inlining candidate */
6654 -: 6649: "too-large %s size: %d threshold: %d#<separator>%s",
6655 3419: 6650: scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL),
6656 -: 6651: sz,
6657 -: 6652: 0, /* no sensible threshold here */
6658 -: 6653: scheme_optimize_context_to_string(info->context));
6659 3445: 6654: return 0;
6660 -: 6655: }
6661 -: 6656: }
6662 -: 6657:
6663 303422: 6658: if (SAME_TYPE(scheme_case_lambda_sequence_type, SCHEME_TYPE(value))) {
6664 755: 6659: Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)value;
6665 -: 6660: int i;
6666 3230: 6661: for (i = cl->count; i--; ) {
6667 1759: 6662: if (!scheme_ir_propagate_ok(cl->array[i], info))
6668 39: 6663: return 0;
6669 -: 6664: }
6670 716: 6665: return 1;
6671 -: 6666: }
6672 -: 6667:
6673 302667: 6668: if (SAME_TYPE(SCHEME_TYPE(value), scheme_ir_toplevel_type)) {
6674 3761: 6669: if ((SCHEME_TOPLEVEL_FLAGS(value) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED)
6675 3312: 6670: return 1;
6676 449: 6671: if (info->top_level_consts) {
6677 -: 6672: int pos;
6678 358: 6673: pos = SCHEME_TOPLEVEL_POS(value);
6679 358: 6674: value = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos));
6680 358: 6675: value = no_potential_size(value);
6681 358: 6676: if (SAME_OBJ(value, scheme_constant_key)
6682 358: 6677: || (value && SAME_TYPE(SCHEME_TYPE(value), scheme_struct_proc_shape_type)))
6683 #####: 6678: return 0;
6684 358: 6679: if (value)
6685 #####: 6680: return 1;
6686 -: 6681: }
6687 449: 6682: return 0;
6688 -: 6683: }
6689 -: 6684:
6690 -: 6685: /* Test this after the specific cases,
6691 -: 6686: because it recognizes locals and toplevels. */
6692 298906: 6687: if (scheme_ir_duplicate_ok(value, 0))
6693 101872: 6688: return 1;
6694 -: 6689:
6695 197034: 6690: return 0;
6696 -: 6691:}
6697 -: 6692:
6698 2807001: 6693:int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info, int flags)
6699 -: 6694:/* Does `value` definitely produce a procedure of a specific shape?
6700 -: 6695: This function can be used on resolved (and SFS) forms, too, and it
6701 -: 6696: must be consistent with (i.e., as least as accepting as)
6702 -: 6697: optimization-time decisions. The `flags` argument is for
6703 -: 6698: scheme_omittable_expr(). */
6704 -: 6699:{
6705 -: 6700: while (1) {
6706 2807001: 6701: if (SCHEME_LAMBDAP(value)
6707 2757109: 6702: || SCHEME_PROCP(value)
6708 2341514: 6703: || SAME_TYPE(SCHEME_TYPE(value), scheme_lambda_type)
6709 451743: 6704: || SAME_TYPE(SCHEME_TYPE(value), scheme_case_lambda_sequence_type)
6710 451743: 6705: || SAME_TYPE(SCHEME_TYPE(value), scheme_inline_variant_type))
6711 2594915: 6706: return 1;
6712 212197: 6707: else if (SAME_TYPE(SCHEME_TYPE(value), scheme_ir_let_header_type)) {
6713 -: 6708: /* Look for (let ([x <omittable>]) <proc>), which is generated for optional arguments. */
6714 262: 6709: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)value;
6715 262: 6710: if (lh->num_clauses == 1) {
6716 247: 6711: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)lh->body;
6717 247: 6712: if (scheme_omittable_expr(lv->value, lv->count, 20, flags, info, NULL)) {
6718 111: 6713: value = lv->body;
6719 -: 6714: } else
6720 136: 6715: break;
6721 -: 6716: } else
6722 15: 6717: break;
6723 217322: 6718: } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_let_one_type)) {
6724 12204: 6719: Scheme_Let_One *lo = (Scheme_Let_One *)value;
6725 12204: 6720: if (scheme_omittable_expr(lo->value, 1, 20, flags, info, NULL)) {
6726 5498: 6721: value = lo->body;
6727 -: 6722: } else
6728 6706: 6723: break;
6729 199620: 6724: } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_boxenv_type)) {
6730 1553: 6725: value = SCHEME_PTR2_VAL(value);
6731 198067: 6726: } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_sequence_type)
6732 -: 6727: /* Handle a sequence for resolved mode, because it might
6733 -: 6728: be for safe-for-space clears around a procedure */
6734 7: 6729: && (flags & OMITTABLE_RESOLVED)) {
6735 7: 6730: Scheme_Sequence *seq = (Scheme_Sequence *)value;
6736 -: 6731: int i;
6737 7: 6732: for (i = 0; i < seq->count-1; i++) {
6738 7: 6733: if (!scheme_omittable_expr(seq->array[i], 1, 5, flags, info, NULL))
6739 7: 6734: break;
6740 -: 6735: }
6741 7: 6736: if (i == seq->count-1) {
6742 #####: 6737: value = seq->array[i];
6743 -: 6738: } else
6744 7: 6739: break;
6745 -: 6740: } else
6746 -: 6741: break;
6747 7162: 6742: }
6748 -: 6743:
6749 204924: 6744: return 0;
6750 -: 6745:}
6751 -: 6746:
6752 312: 6747:Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e)
6753 -: 6748:/* Make a record that presents a procedure of a known shape, but
6754 -: 6749: that should not be inlined. */
6755 -: 6750:{
6756 -: 6751: Scheme_Object *ni;
6757 -: 6752:
6758 703: 6753: while (SAME_TYPE(SCHEME_TYPE(e), scheme_ir_let_header_type)) {
6759 -: 6754: /* This must be (let ([x <omittable>]) <proc>); see scheme_is_statically_proc() */
6760 79: 6755: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)e;
6761 79: 6756: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)lh->body;
6762 -: 6757: MZ_ASSERT(lh->num_clauses == 1);
6763 79: 6758: e = lv->body;
6764 -: 6759: }
6765 -: 6760:
6766 312: 6761: ni = scheme_alloc_small_object();
6767 312: 6762: ni->type = scheme_noninline_proc_type;
6768 312: 6763: SCHEME_PTR_VAL(ni) = e;
6769 -: 6764:
6770 312: 6765: return ni;
6771 -: 6766:}
6772 -: 6767:
6773 10391: 6768:static int is_values_apply(Scheme_Object *e, int n, Optimize_Info *info, Scheme_Hash_Tree *except_vars, int fuel)
6774 -: 6769:/* Is `e` a `(values ...)` form --- or, in the case of `if`, can be be
6775 -: 6770: converted to one, so that we can split apart the results
6776 -: 6771: statically? */
6777 -: 6772:{
6778 10391: 6773: if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
6779 4345: 6774: Scheme_App_Rec *app = (Scheme_App_Rec *)e;
6780 4345: 6775: if (n != app->num_args) return 0;
6781 1446: 6776: return SAME_OBJ(scheme_values_proc, app->args[0]);
6782 6046: 6777: } else if ((n == 1) && SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
6783 #####: 6778: Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
6784 #####: 6779: return SAME_OBJ(scheme_values_proc, app->rator);
6785 6046: 6780: } else if ((n == 2) && SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
6786 1149: 6781: Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
6787 1149: 6782: return SAME_OBJ(scheme_values_proc, app->rator);
6788 4897: 6783: } else if (fuel && SAME_TYPE(SCHEME_TYPE(e), scheme_branch_type)) {
6789 762: 6784: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)e;
6790 762: 6785: if (SAME_TYPE(SCHEME_TYPE(b->test), scheme_ir_local_type)
6791 176: 6786: && !scheme_hash_tree_get(except_vars, b->test)
6792 176: 6787: && !SCHEME_VAR(b->test)->mutated) {
6793 352: 6788: return (is_values_apply(b->tbranch, n, info, except_vars, 0)
6794 176: 6789: && is_values_apply(b->fbranch, n, info, except_vars, 0));
6795 -: 6790: }
6796 -: 6791: }
6797 -: 6792:
6798 4721: 6793: return 0;
6799 -: 6794:}
6800 -: 6795:
6801 1546: 6796:static int no_mutable_bindings(Scheme_IR_Let_Value *irlv)
6802 -: 6797:/* Check whether a `let` clause has any mutable bindings */
6803 -: 6798:{
6804 -: 6799: int i;
6805 -: 6800:
6806 4312: 6801: for (i = irlv->count; i--; ) {
6807 1224: 6802: if (irlv->vars[i]->mutated)
6808 4: 6803: return 0;
6809 -: 6804: }
6810 -: 6805:
6811 1542: 6806: return 1;
6812 -: 6807:}
6813 -: 6808:
6814 1249: 6809:static void update_rhs_value(Scheme_IR_Let_Value *naya, Scheme_Object *e,
6815 -: 6810: Optimize_Info *info, Scheme_IR_Local *tst)
6816 -: 6811:/* Install an expression from a split `(values ...)` */
6817 -: 6812:{
6818 1249: 6813: if (tst) {
6819 -: 6814: Scheme_Object *n;
6820 -: 6815:
6821 21: 6816: n = equivalent_exprs(naya->value, e, NULL, NULL, 0);
6822 21: 6817: if (!n) {
6823 -: 6818: Scheme_Branch_Rec *b;
6824 -: 6819:
6825 -: 6820: /* We're duplicating the test */
6826 21: 6821: increment_use_count(tst, 0);
6827 -: 6822:
6828 21: 6823: b = MALLOC_ONE_TAGGED(Scheme_Branch_Rec);
6829 21: 6824: b->so.type = scheme_branch_type;
6830 21: 6825: b->test = (Scheme_Object *)tst;
6831 21: 6826: b->tbranch = naya->value;
6832 21: 6827: b->fbranch = e;
6833 -: 6828:
6834 21: 6829: naya->value = (Scheme_Object *)b;
6835 -: 6830: } else
6836 #####: 6831: naya->value = n;
6837 -: 6832: } else
6838 1228: 6833: naya->value = e;
6839 1249: 6834:}
6840 -: 6835:
6841 407: 6836:static void unpack_values_application(Scheme_Object *e, Scheme_IR_Let_Value *naya,
6842 -: 6837: Optimize_Info *info, Scheme_IR_Local *branch_test)
6843 -: 6838:/* Install the expressions from a split `values` form into new `let` clauses */
6844 -: 6839:{
6845 542: 6840: if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
6846 135: 6841: Scheme_App_Rec *app = (Scheme_App_Rec *)e;
6847 -: 6842: int i;
6848 860: 6843: for (i = 0; i < app->num_args; i++) {
6849 725: 6844: update_rhs_value(naya, app->args[i + 1], info, branch_test);
6850 725: 6845: naya = (Scheme_IR_Let_Value *)naya->body;
6851 -: 6846: }
6852 272: 6847: } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
6853 #####: 6848: Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
6854 #####: 6849: update_rhs_value(naya, app->rand, info, branch_test);
6855 534: 6850: } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
6856 262: 6851: Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
6857 262: 6852: update_rhs_value(naya, app->rand1, info, branch_test);
6858 262: 6853: naya = (Scheme_IR_Let_Value *)naya->body;
6859 262: 6854: update_rhs_value(naya, app->rand2, info, branch_test);
6860 10: 6855: } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_branch_type)) {
6861 10: 6856: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)e;
6862 -: 6857:
6863 -: 6858: MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(b->test), scheme_ir_local_type));
6864 -: 6859:
6865 10: 6860: unpack_values_application(b->tbranch, naya, info, NULL);
6866 10: 6861: unpack_values_application(b->fbranch, naya, info, SCHEME_VAR(b->test));
6867 -: 6862: }
6868 407: 6863:}
6869 -: 6864:
6870 8824: 6865:static Scheme_Object *make_clones(Scheme_IR_Let_Value *retry_start,
6871 -: 6866: Scheme_IR_Let_Value *pre_body,
6872 -: 6867: Optimize_Info *body_info)
6873 -: 6868:/* Clone `lambda`s for re-optimization and for a fixpoint computation of
6874 -: 6869: procedure properties */
6875 -: 6870:{
6876 -: 6871: Scheme_IR_Let_Value *irlv;
6877 -: 6872: Scheme_Object *value, *clone, *pr;
6878 8824: 6873: Scheme_Object *last = NULL, *first = NULL;
6879 -: 6874:
6880 8824: 6875: irlv = retry_start;
6881 -: 6876: while (1) {
6882 9720: 6877: value = irlv->value;
6883 9720: 6878: if (SCHEME_LAMBDAP(value)) {
6884 9525: 6879: clone = optimize_clone(1, value, body_info, empty_eq_hash_tree, 0);
6885 9525: 6880: if (clone) {
6886 9525: 6881: pr = scheme_make_raw_pair(scheme_make_raw_pair(value, clone), NULL);
6887 -: 6882: } else
6888 #####: 6883: pr = scheme_make_raw_pair(NULL, NULL);
6889 9525: 6884: if (last)
6890 732: 6885: SCHEME_CDR(last) = pr;
6891 -: 6886: else
6892 8793: 6887: first = pr;
6893 9525: 6888: last = pr;
6894 -: 6889: }
6895 9720: 6890: if (irlv == pre_body)
6896 8824: 6891: break;
6897 896: 6892: irlv = (Scheme_IR_Let_Value *)irlv->body;
6898 896: 6893: }
6899 -: 6894:
6900 8824: 6895: return first;
6901 -: 6896:}
6902 -: 6897:
6903 43848: 6898:static int set_one_code_flags(Scheme_Object *value, int flags,
6904 -: 6899: Scheme_Object *first, Scheme_Object *second,
6905 -: 6900: int set_flags, int mask_flags, int just_tentative,
6906 -: 6901: int merge_local_typed)
6907 -: 6902:/* Set, record, or merge procedure-property flags */
6908 -: 6903:{
6909 -: 6904: Scheme_Case_Lambda *cl, *cl2, *cl3;
6910 -: 6905: Scheme_Lambda *lam, *lam2, *lam3;
6911 -: 6906: int i, count;
6912 -: 6907:
6913 43848: 6908: if (SAME_TYPE(scheme_ir_lambda_type, SCHEME_TYPE(value))) {
6914 42879: 6909: count = 1;
6915 42879: 6910: cl = NULL;
6916 42879: 6911: cl2 = NULL;
6917 42879: 6912: cl3 = NULL;
6918 -: 6913: } else {
6919 969: 6914: cl = (Scheme_Case_Lambda *)value;
6920 969: 6915: cl2 = (Scheme_Case_Lambda *)first;
6921 969: 6916: cl3 = (Scheme_Case_Lambda *)second;
6922 969: 6917: count = cl->count;
6923 -: 6918: }
6924 -: 6919:
6925 89106: 6920: for (i = 0; i < count; i++) {
6926 45258: 6921: if (cl) {
6927 2379: 6922: lam = (Scheme_Lambda *)cl->array[i];
6928 2379: 6923: lam2 = (Scheme_Lambda *)cl2->array[i];
6929 2379: 6924: lam3 = (Scheme_Lambda *)cl3->array[i];
6930 -: 6925: } else {
6931 42879: 6926: lam = (Scheme_Lambda *)value;
6932 42879: 6927: lam2 = (Scheme_Lambda *)first;
6933 42879: 6928: lam3 = (Scheme_Lambda *)second;
6934 -: 6929: }
6935 -: 6930:
6936 45258: 6931: if (merge_local_typed) {
6937 9549: 6932: merge_lambda_arg_types(lam, lam2);
6938 9549: 6933: merge_lambda_arg_types(lam, lam3);
6939 9549: 6934: merge_lambda_arg_types(lam, lam2);
6940 -: 6935: }
6941 -: 6936:
6942 45258: 6937: if (!just_tentative || (SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_RESULT_TENTATIVE)) {
6943 39402: 6938: flags = (flags & SCHEME_LAMBDA_FLAGS(lam));
6944 39402: 6939: SCHEME_LAMBDA_FLAGS(lam2) = set_flags | (SCHEME_LAMBDA_FLAGS(lam2) & mask_flags);
6945 39402: 6940: SCHEME_LAMBDA_FLAGS(lam3) = set_flags | (SCHEME_LAMBDA_FLAGS(lam3) & mask_flags);
6946 -: 6941: }
6947 -: 6942: }
6948 -: 6943:
6949 43848: 6944: return flags;
6950 -: 6945:}
6951 -: 6946:
6952 26472: 6947:static int set_code_flags(Scheme_IR_Let_Value *retry_start,
6953 -: 6948: Scheme_IR_Let_Value *pre_body,
6954 -: 6949: Scheme_Object *clones,
6955 -: 6950: int set_flags, int mask_flags, int just_tentative,
6956 -: 6951: int merge_local_typed)
6957 -: 6952:/* Set, record, or merge procedure-property flags */
6958 -: 6953:{
6959 -: 6954: Scheme_IR_Let_Value *irlv;
6960 -: 6955: Scheme_Object *value, *first;
6961 26472: 6956: int flags = LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS;
6962 -: 6957:
6963 -: 6958: /* The first in a clone pair is the one that is consulted for
6964 -: 6959: references. The second one is the clone, and it's the one whose
6965 -: 6960: flags are updated by optimization. So consult the clone, and set
6966 -: 6961: flags in both. */
6967 -: 6962:
6968 26472: 6963: irlv = retry_start;
6969 55515: 6964: while (clones) {
6970 28896: 6965: value = irlv->value;
6971 28896: 6966: if (SCHEME_LAMBDAP(value)) {
6972 28575: 6967: first = SCHEME_CAR(clones);
6973 -: 6968:
6974 28575: 6969: if (first)
6975 28575: 6970: flags = set_one_code_flags(value, flags,
6976 28575: 6971: SCHEME_CAR(first), SCHEME_CDR(first),
6977 -: 6972: set_flags, mask_flags, just_tentative,
6978 -: 6973: merge_local_typed);
6979 -: 6974:
6980 28575: 6975: clones = SCHEME_CDR(clones);
6981 -: 6976: }
6982 -: 6977:
6983 28896: 6978: if (irlv == pre_body)
6984 26325: 6979: break;
6985 2571: 6980: irlv = (Scheme_IR_Let_Value *)irlv->body;
6986 -: 6981: }
6987 -: 6982:
6988 26472: 6983: return flags;
6989 -: 6984:}
6990 -: 6985:
6991 161168: 6986:static int lambda_body_size(Scheme_Object *o, int less_args)
6992 -: 6987:{
6993 -: 6988: int bsz;
6994 -: 6989:
6995 161168: 6990: if (SAME_TYPE(SCHEME_TYPE(o), scheme_ir_lambda_type)) {
6996 17133: 6991: bsz = lambda_body_size_plus_info((Scheme_Lambda *)o, 0, NULL, NULL);
6997 17133: 6992: if (less_args) bsz -= ((Scheme_Lambda *)o)->num_params;
6998 17133: 6993: return bsz;
6999 144035: 6994: } else if (SAME_TYPE(SCHEME_TYPE(o), scheme_case_lambda_sequence_type)) {
7000 358: 6995: Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)o;
7001 358: 6996: int i, sz = 0;
7002 1597: 6997: for (i = cl->count; i--; ) {
7003 881: 6998: bsz = lambda_body_size_plus_info((Scheme_Lambda *)cl->array[i], 0, NULL, NULL);
7004 881: 6999: if (less_args) {
7005 762: 7000: bsz -= ((Scheme_Lambda *)cl->array[i])->num_params;
7006 762: 7001: if (bsz > sz) sz = bsz;
7007 -: 7002: } else
7008 119: 7003: sz += bsz;
7009 -: 7004: }
7010 358: 7005: return sz;
7011 -: 7006: } else
7012 143677: 7007: return 0;
7013 -: 7008:}
7014 -: 7009:
7015 146308: 7010:static int expr_size(Scheme_Object *o)
7016 -: 7011:{
7017 146308: 7012: return lambda_body_size(o, 0) + 1;
7018 -: 7013:}
7019 -: 7014:
7020 15549: 7015:int scheme_might_invoke_call_cc(Scheme_Object *value)
7021 -: 7016:{
7022 15549: 7017: return !scheme_is_liftable(value, empty_eq_hash_tree, 10, 0, 1);
7023 -: 7018:}
7024 -: 7019:
7025 -: 7020:#define ADVANCE_CLOCKS_INIT_FUEL 3
7026 -: 7021:
7027 14742: 7022:void advance_clocks_for_optimized(Scheme_Object *o,
7028 -: 7023: GC_CAN_IGNORE int *_vclock,
7029 -: 7024: GC_CAN_IGNORE int *_aclock,
7030 -: 7025: GC_CAN_IGNORE int *_kclock,
7031 -: 7026: GC_CAN_IGNORE int *_sclock,
7032 -: 7027: Optimize_Info *info,
7033 -: 7028: int fuel)
7034 -: 7029:/* It's ok for this function to advance clocks *less* than
7035 -: 7030: accurately, but not more than accurately */
7036 -: 7031:{
7037 14742: 7032: Scheme_Object *rator = NULL;
7038 14742: 7033: int argc = 0;
7039 -: 7034:
7040 14742: 7035: if (!fuel) return;
7041 -: 7036:
7042 14250: 7037: switch (SCHEME_TYPE(o)) {
7043 -: 7038: case scheme_application_type:
7044 -: 7039: {
7045 791: 7040: Scheme_App_Rec *app = (Scheme_App_Rec *)o;
7046 -: 7041: int i;
7047 3760: 7042: for (i = 0; i < app->num_args; i++) {
7048 2969: 7043: advance_clocks_for_optimized(app->args[i+1],
7049 -: 7044: _vclock, _aclock, _kclock, _sclock,
7050 -: 7045: info, fuel - 1);
7051 -: 7046: }
7052 791: 7047: rator = app->args[0];
7053 791: 7048: argc = app->num_args;
7054 -: 7049: }
7055 791: 7050: break;
7056 -: 7051: case scheme_application2_type:
7057 -: 7052: {
7058 2180: 7053: Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
7059 2180: 7054: advance_clocks_for_optimized(app->rand,
7060 -: 7055: _vclock, _aclock, _kclock, _sclock,
7061 -: 7056: info, fuel - 1);
7062 2180: 7057: rator = app->rator;
7063 2180: 7058: argc = 1;
7064 2180: 7059: break;
7065 -: 7060: }
7066 -: 7061: case scheme_application3_type:
7067 -: 7062: {
7068 2294: 7063: Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
7069 2294: 7064: advance_clocks_for_optimized(app->rand1,
7070 -: 7065: _vclock, _aclock, _kclock, _sclock,
7071 -: 7066: info, fuel - 1);
7072 2294: 7067: advance_clocks_for_optimized(app->rand2,
7073 -: 7068: _vclock, _aclock, _kclock, _sclock,
7074 -: 7069: info, fuel - 1);
7075 2294: 7070: rator = app->rator;
7076 2294: 7071: argc = 2;
7077 -: 7072: }
7078 2294: 7073: break;
7079 -: 7074: default:
7080 8985: 7075: break;
7081 -: 7076: }
7082 -: 7077:
7083 14250: 7078: if (rator)
7084 5265: 7079: increment_clock_counts_for_application(_vclock, _aclock, _kclock, _sclock, rator, argc);
7085 -: 7080:
7086 14250: 7081: if ((*_vclock > info->vclock)
7087 14250: 7082: || (*_aclock > info->aclock)
7088 14250: 7083: || (*_kclock > info->kclock)
7089 14250: 7084: || (*_sclock > info->sclock))
7090 #####: 7085: scheme_signal_error("internal error: optimizer clock tracking has gone wrong");
7091 -: 7086:}
7092 -: 7087:
7093 39111: 7088:static void set_application_types(Scheme_Object *o, Optimize_Info *info, int fuel)
7094 -: 7089:/* Peek ahead in an expression to set readily apparent type information
7095 -: 7090: for function calls. This information is useful for type-invariant loop
7096 -: 7091: arguments, for example. */
7097 -: 7092:{
7098 39111: 7093: if (!fuel) return;
7099 -: 7094:
7100 38431: 7095: switch (SCHEME_TYPE(o)) {
7101 -: 7096: case scheme_application_type:
7102 -: 7097: {
7103 1530: 7098: Scheme_App_Rec *app = (Scheme_App_Rec *)o;
7104 -: 7099: int i;
7105 1530: 7100: register_local_argument_types(app, NULL, NULL, info);
7106 7274: 7101: for (i = 0; i < app->num_args+1; i++) {
7107 5744: 7102: set_application_types(app->args[i], info, fuel - 1);
7108 -: 7103: }
7109 -: 7104: }
7110 1530: 7105: break;
7111 -: 7106: case scheme_application2_type:
7112 -: 7107: {
7113 6232: 7108: Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
7114 6232: 7109: register_local_argument_types(NULL, app, NULL, info);
7115 6232: 7110: set_application_types(app->rator, info, fuel - 1);
7116 6232: 7111: set_application_types(app->rand, info, fuel - 1);
7117 6232: 7112: break;
7118 -: 7113: }
7119 -: 7114: case scheme_application3_type:
7120 -: 7115: {
7121 2959: 7116: Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
7122 2959: 7117: register_local_argument_types(NULL, NULL, app, info);
7123 2959: 7118: set_application_types(app->rator, info, fuel - 1);
7124 2959: 7119: set_application_types(app->rand1, info, fuel - 1);
7125 2959: 7120: set_application_types(app->rand2, info, fuel - 1);
7126 -: 7121: }
7127 2959: 7122: break;
7128 -: 7123: case scheme_sequence_type:
7129 -: 7124: case scheme_begin0_sequence_type:
7130 -: 7125: {
7131 188: 7126: Scheme_Sequence *seq = (Scheme_Sequence *)o;
7132 -: 7127: int i;
7133 -: 7128:
7134 644: 7129: for (i = 0; i < seq->count; i++) {
7135 456: 7130: set_application_types(seq->array[i], info, fuel - 1);
7136 -: 7131: }
7137 -: 7132: }
7138 188: 7133: break;
7139 -: 7134: case scheme_branch_type:
7140 -: 7135: {
7141 945: 7136: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)o;
7142 945: 7137: set_application_types(b->test, info, fuel - 1);
7143 945: 7138: set_application_types(b->tbranch, info, fuel - 1);
7144 945: 7139: set_application_types(b->fbranch, info, fuel - 1);
7145 -: 7140: }
7146 945: 7141: break;
7147 -: 7142: default:
7148 26577: 7143: break;
7149 -: 7144: }
7150 -: 7145:}
7151 -: 7146:
7152 34416: 7147:static void flip_transitive(Scheme_Hash_Table *ht, int on)
7153 -: 7148:/* Adjust usage flags based on recorded tentative uses */
7154 -: 7149:{
7155 -: 7150: Scheme_IR_Local *tvar;
7156 -: 7151: int j;
7157 34416: 7152: Scheme_Object *to_remove = scheme_null;
7158 -: 7153:
7159 334680: 7154: for (j = 0; j < ht->size; j++) {
7160 300264: 7155: if (ht->vals[j]) {
7161 71837: 7156: tvar = SCHEME_VAR(ht->keys[j]);
7162 71837: 7157: if (on) {
7163 18245: 7158: if (tvar->optimize_used) {
7164 -: 7159: /* use of `tvar` is no longer dependent on anohter variable */
7165 #####: 7160: to_remove = scheme_make_pair((Scheme_Object *)tvar,
7166 -: 7161: to_remove);
7167 -: 7162: } else
7168 18245: 7163: tvar->optimize_used = 1;
7169 -: 7164: } else {
7170 -: 7165: MZ_ASSERT(tvar->optimize_used);
7171 53592: 7166: tvar->optimize_used = 0;
7172 -: 7167: }
7173 -: 7168: }
7174 -: 7169: }
7175 -: 7170:
7176 68832: 7171: while (!SCHEME_NULLP(to_remove)) {
7177 #####: 7172: scheme_hash_set(ht, SCHEME_CAR(to_remove), NULL);
7178 #####: 7173: to_remove = SCHEME_CDR(to_remove);
7179 -: 7174: }
7180 34416: 7175:}
7181 -: 7176:
7182 29751: 7177:static void start_transitive_use_record(Optimize_Info *to_info, Optimize_Info *info, Scheme_IR_Local *var)
7183 -: 7178:/* Start recording uses as tentative. Uses in a `lambda` as the RHS of
7184 -: 7179: the binding of `var` will only be used in the end of `var` itself
7185 -: 7180: is used. */
7186 -: 7181:{
7187 29751: 7182: if (var->optimize_used)
7188 #####: 7183: return;
7189 -: 7184:
7190 29751: 7185: info->transitive_use_var = var;
7191 -: 7186:
7192 -: 7187: /* Restore use flags, if any, saved from before: */
7193 29751: 7188: if (var->optimize.transitive_uses)
7194 9348: 7189: flip_transitive(var->optimize.transitive_uses, 1);
7195 -: 7190:}
7196 -: 7191:
7197 343956: 7192:static void end_transitive_use_record(Optimize_Info *info)
7198 -: 7193:/* Stop recording uses as tentative. */
7199 -: 7194:{
7200 343956: 7195: Scheme_IR_Local *var = info->transitive_use_var;
7201 -: 7196:
7202 343956: 7197: if (var != info->next->transitive_use_var) {
7203 29751: 7198: info->transitive_use_var = info->next->transitive_use_var;
7204 -: 7199:
7205 29751: 7200: if (var->optimize.transitive_uses)
7206 25068: 7201: flip_transitive(var->optimize.transitive_uses, 0);
7207 -: 7202: }
7208 343956: 7203:}
7209 -: 7204:
7210 243569: 7205:static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, int context)
7211 -: 7206:/* This is the main entry point for optimizing a `let[rec]-values` form. */
7212 -: 7207:{
7213 -: 7208: Optimize_Info *body_info, *rhs_info;
7214 -: 7209: Optimize_Info_Sequence info_seq;
7215 243569: 7210: Scheme_IR_Let_Header *head = (Scheme_IR_Let_Header *)form;
7216 -: 7211: Scheme_IR_Let_Value *irlv, *pre_body, *retry_start, *prev_body;
7217 243569: 7212: Scheme_Object *body, *value, *ready_pairs = NULL, *rp_last = NULL, *ready_pairs_start;
7218 243569: 7213: Scheme_Object *escape_body = scheme_false;
7219 -: 7214: Scheme_Once_Used *once_used;
7220 -: 7215: Scheme_Hash_Tree *merge_skip_vars;
7221 243569: 7216: int i, j, is_rec, not_simply_let_star = 0, undiscourage, skip_opts = 0;
7222 -: 7217: int did_set_value, found_escapes;
7223 243569: 7218: int remove_last_one = 0, inline_fuel;
7224 243569: 7219: int pre_vclock, pre_aclock, pre_kclock, pre_sclock, increments_kclock = 0;
7225 243569: 7220: int once_vclock, once_aclock, once_kclock, once_sclock, once_increments_kclock = 0;
7226 -: 7221:
7227 -: 7222: /* Special case: (let ([x M]) (if x x N)), where x is not in N,
7228 -: 7223: to (if M #t N), when the expression is in a test position
7229 -: 7224: or the result of M is a boolean?. */
7230 243569: 7225: if (!(SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE)
7231 232352: 7226: && (head->count == 1)
7232 164269: 7227: && (head->num_clauses == 1)) {
7233 164252: 7228: irlv = (Scheme_IR_Let_Value *)head->body;
7234 164252: 7229: if (SAME_TYPE(SCHEME_TYPE(irlv->body), scheme_branch_type)
7235 67685: 7230: && (irlv->vars[0]->use_count == 2)) {
7236 26087: 7231: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)irlv->body;
7237 26087: 7232: if (SAME_OBJ(b->test, (Scheme_Object *)irlv->vars[0])
7238 14275: 7233: && SAME_OBJ(b->tbranch, (Scheme_Object *)irlv->vars[0])) {
7239 -: 7234: Scheme_Object *pred;
7240 -: 7235:
7241 5125: 7236: if (context & OPT_CONTEXT_BOOLEAN)
7242 -: 7237: /* In a boolean context, any expression can be moved. */
7243 1710: 7238: pred = scheme_boolean_p_proc;
7244 -: 7239: else
7245 3415: 7240: pred = expr_implies_predicate(irlv->value, info);
7246 -: 7241:
7247 5125: 7242: if (pred && predicate_implies(pred, scheme_boolean_p_proc)) {
7248 -: 7243: Scheme_Branch_Rec *b3;
7249 -: 7244:
7250 2076: 7245: b3 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec);
7251 2076: 7246: b3->so.type = scheme_branch_type;
7252 2076: 7247: b3->test = irlv->value;
7253 2076: 7248: b3->tbranch = scheme_true;
7254 2076: 7249: b3->fbranch = b->fbranch;
7255 -: 7250:
7256 2076: 7251: form = scheme_optimize_expr((Scheme_Object *)b3, info, context);
7257 -: 7252:
7258 2076: 7253: return form;
7259 -: 7254: }
7260 -: 7255: }
7261 -: 7256: }
7262 -: 7257: }
7263 -: 7258:
7264 241493: 7259: is_rec = (SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE);
7265 -: 7260:
7266 -: 7261: /* Special case: (let ([x E]) x) => E or (values E) */
7267 241493: 7262: if (!is_rec
7268 230276: 7263: && (head->count == 1)
7269 162193: 7264: && (head->num_clauses == 1)) {
7270 162176: 7265: irlv = (Scheme_IR_Let_Value *)head->body;
7271 162176: 7266: if (SAME_OBJ((Scheme_Object *)irlv->vars[0], irlv->body)) {
7272 851: 7267: body = irlv->value;
7273 851: 7268: body = ensure_single_value_noncm(body);
7274 851: 7269: return scheme_optimize_expr(body, info, context);
7275 -: 7270: }
7276 -: 7271: }
7277 -: 7272:
7278 240642: 7273: if (!is_rec) {
7279 -: 7274: int try_again;
7280 -: 7275: do {
7281 240877: 7276: try_again = 0;
7282 -: 7277: /* (let ([x (let ([y M]) N)]) P) => (let ([y M]) (let ([x N]) P))
7283 -: 7278: or (let ([x (begin M ... N)]) P) => (begin M ... (let ([x N]) P)) */
7284 240877: 7279: if (head->num_clauses) {
7285 240877: 7280: irlv = (Scheme_IR_Let_Value *)head->body; /* ([x ...]) */
7286 252798: 7281: if (SAME_TYPE(SCHEME_TYPE(irlv->value), scheme_ir_let_header_type)) {
7287 11921: 7282: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)irlv->value; /* (let ([y ...]) ...) */
7288 -: 7283:
7289 11921: 7284: if (!lh->num_clauses) {
7290 #####: 7285: irlv->value = lh->body;
7291 #####: 7286: lh->body = (Scheme_Object *)head;
7292 -: 7287: } else {
7293 11921: 7288: body = lh->body;
7294 24816: 7289: for (i = lh->num_clauses - 1; i--; ) {
7295 974: 7290: body = ((Scheme_IR_Let_Value *)body)->body;
7296 -: 7291: }
7297 11921: 7292: irlv->value = ((Scheme_IR_Let_Value *)body)->body; /* N */
7298 11921: 7293: ((Scheme_IR_Let_Value *)body)->body = (Scheme_Object *)head;
7299 -: 7294: }
7300 -: 7295:
7301 11921: 7296: head = lh;
7302 11921: 7297: form = (Scheme_Object *)head;
7303 11921: 7298: is_rec = (SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE);
7304 11921: 7299: try_again = !is_rec;
7305 228956: 7300: } else if (SAME_TYPE(SCHEME_TYPE(irlv->value), scheme_sequence_type)) {
7306 1143: 7301: Scheme_Sequence *seq = (Scheme_Sequence *)irlv->value; /* (begin M ... N) */
7307 -: 7302:
7308 1143: 7303: irlv->value = seq->array[seq->count - 1];
7309 1143: 7304: seq->array[seq->count - 1] = (Scheme_Object *)head;
7310 -: 7305:
7311 1143: 7306: return scheme_optimize_expr((Scheme_Object *)seq, info, context);
7312 -: 7307: }
7313 -: 7308: }
7314 239734: 7309: } while (try_again);
7315 -: 7310: }
7316 -: 7311:
7317 239499: 7312: body_info = optimize_info_add_frame(info, head->count, head->count, 0);
7318 239499: 7313: rhs_info = body_info;
7319 -: 7314:
7320 239499: 7315: merge_skip_vars = scheme_make_hash_tree(SCHEME_hashtr_eq);
7321 239499: 7316: body = head->body;
7322 812565: 7317: for (i = head->num_clauses; i--; ) {
7323 333567: 7318: pre_body = (Scheme_IR_Let_Value *)body;
7324 1018600: 7319: for (j = pre_body->count; j--; ) {
7325 351466: 7320: merge_skip_vars = scheme_hash_tree_set(merge_skip_vars, (Scheme_Object *)pre_body->vars[j], scheme_true);
7326 351466: 7321: set_optimize_mode(pre_body->vars[j]);
7327 351466: 7322: pre_body->vars[j]->optimize.lambda_depth = body_info->lambda_depth;
7328 351466: 7323: pre_body->vars[j]->optimize_used = 0;
7329 351466: 7324: pre_body->vars[j]->optimize_outside_binding = 0;
7330 351466: 7325: if (!pre_body->vars[j]->mutated && is_rec) {
7331 -: 7326: /* Indicate that it's not yet ready, so it cannot be inlined: */
7332 -: 7327: Scheme_Object *rp;
7333 12894: 7328: pre_body->vars[j]->optimize_unready = 1;
7334 12894: 7329: rp = scheme_make_raw_pair((Scheme_Object *)pre_body->vars[j], NULL);
7335 12894: 7330: if (rp_last)
7336 1210: 7331: SCHEME_CDR(rp_last) = rp;
7337 -: 7332: else
7338 11684: 7333: ready_pairs = rp;
7339 12894: 7334: rp_last = rp;
7340 -: 7335: }
7341 -: 7336: }
7342 333567: 7337: body = pre_body->body;
7343 -: 7338: }
7344 -: 7339:
7345 -: 7340: if (OPT_ESTIMATE_FUTURE_SIZES) {
7346 239499: 7341: if (is_rec && !body_info->letrec_not_twice) {
7347 -: 7342: /* For each identifier bound to a procedure, register an initial
7348 -: 7343: size estimate, which is used to discourage early loop unrolling
7349 -: 7344: at the expense of later inlining. */
7350 9281: 7345: body = head->body;
7351 9281: 7346: pre_body = NULL;
7352 29090: 7347: for (i = head->num_clauses; i--; ) {
7353 10528: 7348: pre_body = (Scheme_IR_Let_Value *)body;
7354 -: 7349:
7355 10528: 7350: if ((pre_body->count == 1)
7356 10344: 7351: && SCHEME_LAMBDAP(pre_body->value)
7357 9991: 7352: && !pre_body->vars[0]->mutated) {
7358 -: 7353: Scheme_Object *sz;
7359 9987: 7354: sz = estimate_closure_size(pre_body->value);
7360 9987: 7355: pre_body->vars[0]->optimize.known_val = sz;
7361 -: 7356: }
7362 -: 7357:
7363 10528: 7358: body = pre_body->body;
7364 -: 7359: }
7365 9281: 7360: rhs_info->use_psize = 1;
7366 -: 7361: }
7367 -: 7362: }
7368 -: 7363:
7369 239499: 7364: optimize_info_seq_init(rhs_info, &info_seq);
7370 -: 7365:
7371 239499: 7366: prev_body = NULL;
7372 239499: 7367: body = head->body;
7373 239499: 7368: pre_body = NULL;
7374 239499: 7369: retry_start = NULL;
7375 239499: 7370: ready_pairs_start = NULL;
7376 239499: 7371: did_set_value = 0;
7377 239499: 7372: found_escapes = 0;
7378 812248: 7373: for (i = head->num_clauses; i--; ) {
7379 334431: 7374: pre_body = (Scheme_IR_Let_Value *)body;
7380 -: 7375:
7381 334431: 7376: if ((pre_body->count == 1)
7382 324249: 7377: && SCHEME_LAMBDAP(pre_body->value)
7383 20234: 7378: && !pre_body->vars[0]->optimize_used)
7384 20232: 7379: start_transitive_use_record(body_info, rhs_info, pre_body->vars[0]);
7385 -: 7380:
7386 334431: 7381: if (is_rec && OPT_DISCOURAGE_EARLY_INLINE && !rhs_info->letrec_not_twice
7387 10534: 7382: && SCHEME_LAMBDAP(pre_body->value)) {
7388 9993: 7383: inline_fuel = rhs_info->inline_fuel;
7389 9993: 7384: if (inline_fuel > 2)
7390 7254: 7385: rhs_info->inline_fuel = 2;
7391 9993: 7386: rhs_info->letrec_not_twice++;
7392 9993: 7387: undiscourage = 1;
7393 -: 7388: } else {
7394 324438: 7389: inline_fuel = 0;
7395 324438: 7390: undiscourage = 0;
7396 -: 7391: }
7397 -: 7392:
7398 334431: 7393: if (!skip_opts) {
7399 333567: 7394: pre_vclock = rhs_info->vclock;
7400 333567: 7395: pre_aclock = rhs_info->aclock;
7401 333567: 7396: pre_kclock = rhs_info->kclock;
7402 333567: 7397: pre_sclock = rhs_info->sclock;
7403 333567: 7398: if (!found_escapes) {
7404 333527: 7399: optimize_info_seq_step(rhs_info, &info_seq);
7405 333527: 7400: value = scheme_optimize_expr(pre_body->value, rhs_info,
7406 333527: 7401: (((pre_body->count == 1)
7407 -: 7402: ? OPT_CONTEXT_SINGLED
7408 333527: 7403: : 0)
7409 333527: 7404: | (((pre_body->count == 1)
7410 323356: 7405: && !pre_body->vars[0]->non_app_count)
7411 30725: 7406: ? (pre_body->vars[0]->use_count << OPT_CONTEXT_APP_COUNT_SHIFT)
7412 364252: 7407: : 0)));
7413 333527: 7408: pre_body->value = value;
7414 333527: 7409: if (rhs_info->escapes)
7415 94: 7410: found_escapes = 1;
7416 -: 7411: } else {
7417 40: 7412: optimize_info_seq_step(rhs_info, &info_seq);
7418 40: 7413: value = scheme_false;
7419 40: 7414: pre_body->value = value;
7420 40: 7415: body_info->single_result = 1;
7421 40: 7416: body_info->preserves_marks = 1;
7422 40: 7417: body_info->escapes = 1;
7423 40: 7418: body_info->size++;
7424 -: 7419: }
7425 333567: 7420: once_vclock = rhs_info->vclock;
7426 333567: 7421: once_aclock = rhs_info->aclock;
7427 333567: 7422: once_kclock = rhs_info->kclock;
7428 333567: 7423: once_sclock = rhs_info->sclock;
7429 333567: 7424: increments_kclock = (once_kclock > pre_kclock);
7430 333567: 7425: once_increments_kclock = increments_kclock;
7431 -: 7426: } else {
7432 864: 7427: value = pre_body->value;
7433 864: 7428: --skip_opts;
7434 864: 7429: if (skip_opts) {
7435 -: 7430: /* when a `values` group is split, we've lost track of the
7436 -: 7431: clock values for points between the `values` arguments;
7437 -: 7432: we can conservatively assume the clock before the whole group
7438 -: 7433: for the purpose of registering once-used variables,
7439 -: 7434: but we can also conservatively advance the clock: */
7440 458: 7435: if (!found_escapes)
7441 458: 7436: advance_clocks_for_optimized(value,
7442 -: 7437: &pre_vclock, &pre_aclock, &pre_kclock, &pre_sclock,
7443 -: 7438: rhs_info,
7444 -: 7439: ADVANCE_CLOCKS_INIT_FUEL);
7445 458: 7440: once_vclock = pre_vclock;
7446 458: 7441: once_aclock = pre_aclock;
7447 458: 7442: once_kclock = pre_kclock;
7448 458: 7443: once_sclock = pre_sclock;
7449 -: 7444: } else {
7450 -: 7445: /* end of split group, so rhs_info clock is right */
7451 406: 7446: once_vclock = rhs_info->vclock;
7452 406: 7447: once_aclock = rhs_info->aclock;
7453 406: 7448: once_kclock = rhs_info->kclock;
7454 406: 7449: once_sclock = rhs_info->sclock;
7455 -: 7450: }
7456 864: 7451: if (increments_kclock) {
7457 -: 7452: /* note that we conservatively assume that a member of a split
7458 -: 7453: advance the kclock, unless we can easily show otherwise */
7459 347: 7454: once_increments_kclock = 1;
7460 -: 7455: }
7461 -: 7456: }
7462 -: 7457:
7463 334431: 7458: if (undiscourage) {
7464 9993: 7459: rhs_info->inline_fuel = inline_fuel;
7465 9993: 7460: --rhs_info->letrec_not_twice;
7466 -: 7461: }
7467 -: 7462:
7468 334431: 7463: end_transitive_use_record(rhs_info);
7469 -: 7464:
7470 334431: 7465: if (is_rec && !not_simply_let_star) {
7471 -: 7466: /* Keep track of whether we can simplify to let*: */
7472 11719: 7467: if (scheme_might_invoke_call_cc(value)
7473 11660: 7468: || optimize_any_uses(body_info, pre_body, i+1))
7474 11650: 7469: not_simply_let_star = 1;
7475 -: 7470: }
7476 -: 7471:
7477 -: 7472: /* Change (let-values ([(id ...) (values e ...)]) body)
7478 -: 7473: to (let-values ([id e] ...) body) for simple e.
7479 -: 7474: The is_values_apply() and related functions also handle
7480 -: 7475: (if id (values e1 ...) (values e2 ...)) to effectively convert to
7481 -: 7476: (values (if id e1 e2) ...) and then split the values call, since
7482 -: 7477: duplicating the id use and test is likely to pay off. */
7483 334431: 7478: if ((pre_body->count != 1)
7484 10182: 7479: && ((!is_rec && found_escapes)
7485 10130: 7480: || (is_values_apply(value, pre_body->count, rhs_info, merge_skip_vars, 1)
7486 1552: 7481: && ((!is_rec && no_mutable_bindings(pre_body))
7487 -: 7482: /* If the right-hand side is omittable, then there are
7488 -: 7483: no side effects, so mutation and recursiveness are ok */
7489 10: 7484: || scheme_omittable_expr(value, pre_body->count, -1, 0, rhs_info, info))))) {
7490 1600: 7485: if (!pre_body->count && !i) {
7491 -: 7486: /* We want to drop the clause entirely, but doing it
7492 -: 7487: here messes up the loop for letrec. So wait and
7493 -: 7488: remove it at the end. */
7494 1181: 7489: remove_last_one = 1;
7495 -: 7490: /* If `found_escapes`, either this expression is the
7496 -: 7491: one that escaped, or `value` should have been simplified
7497 -: 7492: to `#f`. So, if it's not `#f`, we'll need to keep
7498 -: 7493: the expression part */
7499 1181: 7494: if (!found_escapes)
7500 1161: 7495: value = scheme_false;
7501 1181: 7496: pre_body->value = value;
7502 -: 7497: } else {
7503 -: 7498: Scheme_IR_Let_Value *naya;
7504 419: 7499: Scheme_Object *rest = pre_body->body;
7505 -: 7500: int j;
7506 -: 7501:
7507 2108: 7502: for (j = pre_body->count; j--; ) {
7508 -: 7503: Scheme_IR_Local **new_vars;
7509 1270: 7504: naya = MALLOC_ONE_TAGGED(Scheme_IR_Let_Value);
7510 1270: 7505: naya->iso.so.type = scheme_ir_let_value_type;
7511 1270: 7506: naya->body = rest;
7512 1270: 7507: naya->count = 1;
7513 1270: 7508: new_vars = MALLOC_N(Scheme_IR_Local *, 1);
7514 1270: 7509: new_vars[0] = pre_body->vars[j];
7515 1270: 7510: naya->vars = new_vars;
7516 1270: 7511: rest = (Scheme_Object *)naya;
7517 -: 7512: }
7518 -: 7513:
7519 419: 7514: naya = (Scheme_IR_Let_Value *)rest;
7520 419: 7515: if (!found_escapes) {
7521 387: 7516: unpack_values_application(value, naya, rhs_info, NULL);
7522 -: 7517: } else {
7523 32: 7518: Scheme_IR_Let_Value *naya2 = naya;
7524 74: 7519: for (j = 0; j < pre_body->count; j++) {
7525 42: 7520: if (!j)
7526 21: 7521: naya2->value = value;
7527 -: 7522: else
7528 21: 7523: naya2->value = scheme_false;
7529 42: 7524: naya2 = (Scheme_IR_Let_Value *)naya2->body;
7530 -: 7525: }
7531 -: 7526:
7532 32: 7527: if (!pre_body->count && !SCHEME_FALSEP(value)) {
7533 -: 7528: /* Since `value` is not false, this clause must be the one
7534 -: 7529: that is escaping. We'll end up dropping the remaining
7535 -: 7530: clauses and the original body, but we need to keep the
7536 -: 7531: erroring expression. */
7537 11: 7532: escape_body = value;
7538 -: 7533: }
7539 -: 7534: }
7540 -: 7535:
7541 419: 7536: if (prev_body)
7542 20: 7537: prev_body->body = (Scheme_Object *)naya;
7543 -: 7538: else
7544 399: 7539: head->body = (Scheme_Object *)naya;
7545 419: 7540: head->num_clauses += (pre_body->count - 1);
7546 419: 7541: i += (pre_body->count - 1);
7547 419: 7542: if (pre_body->count) {
7548 -: 7543: /* We're backing up. Since the RHSs have been optimized
7549 -: 7544: already, don't re-optimize. */
7550 406: 7545: skip_opts = pre_body->count - 1;
7551 406: 7546: pre_body = naya;
7552 406: 7547: body = (Scheme_Object *)naya;
7553 406: 7548: value = pre_body->value;
7554 -: 7549:
7555 406: 7550: if (skip_opts) {
7556 -: 7551: /* Use "pre" clocks: */
7557 406: 7552: if (!found_escapes)
7558 385: 7553: advance_clocks_for_optimized(value,
7559 -: 7554: &pre_vclock, &pre_aclock, &pre_kclock, &pre_sclock,
7560 -: 7555: rhs_info,
7561 -: 7556: ADVANCE_CLOCKS_INIT_FUEL);
7562 406: 7557: once_vclock = pre_vclock;
7563 406: 7558: once_aclock = pre_aclock;
7564 406: 7559: once_kclock = pre_kclock;
7565 406: 7560: once_sclock = pre_sclock;
7566 -: 7561: }
7567 -: 7562: } else {
7568 -: 7563: /* We've dropped this clause entirely. */
7569 13: 7564: i++;
7570 13: 7565: if (i > 0) {
7571 13: 7566: body = (Scheme_Object *)naya;
7572 13: 7567: continue;
7573 -: 7568: } else
7574 #####: 7569: break;
7575 -: 7570: }
7576 -: 7571: }
7577 -: 7572: }
7578 -: 7573:
7579 334418: 7574: if ((pre_body->count == 1) && !pre_body->vars[0]->mutated) {
7580 323867: 7575: int indirect = 0, indirect_binding = 0;
7581 -: 7576:
7582 651737: 7577: while (indirect < 10) {
7583 328038: 7578: if (SAME_TYPE(SCHEME_TYPE(value), scheme_sequence_type)) {
7584 168: 7579: Scheme_Sequence *seq = (Scheme_Sequence *)value;
7585 168: 7580: value = seq->array[seq->count - 1];
7586 168: 7581: indirect++;
7587 327937: 7582: } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_with_cont_mark_type)) {
7588 235: 7583: Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)value;
7589 235: 7584: value = wcm->body;
7590 235: 7585: indirect++;
7591 327467: 7586: } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_ir_let_header_type)) {
7592 3600: 7587: Scheme_IR_Let_Header *head2 = (Scheme_IR_Let_Header *)value;
7593 -: 7588: int i;
7594 -: 7589:
7595 3600: 7590: if (head2->num_clauses < 10) {
7596 3600: 7591: value = head2->body;
7597 11005: 7592: for (i = head2->num_clauses; i--; ) {
7598 3805: 7593: value = ((Scheme_IR_Let_Value *)value)->body;
7599 -: 7594: }
7600 -: 7595: }
7601 3600: 7596: indirect++;
7602 3600: 7597: if (head2->count)
7603 3600: 7598: indirect_binding = 1;
7604 -: 7599: } else
7605 -: 7600: break;
7606 -: 7601: }
7607 -: 7602:
7608 323867: 7603: if (indirect_binding) {
7609 -: 7604: /* only allow constants */
7610 3243: 7605: if (SCHEME_TYPE(value) < _scheme_ir_values_types_)
7611 3243: 7606: value = NULL;
7612 -: 7607: }
7613 -: 7608:
7614 323867: 7609: if (value && SAME_TYPE(SCHEME_TYPE(value), scheme_ir_local_type)) {
7615 -: 7610: /* Don't optimize reference to a local that's mutable; also,
7616 -: 7611: double-check that the value is ready, because we might be
7617 -: 7612: nested in the RHS of a `letrec': */
7618 63159: 7613: if (SCHEME_VAR(value)->mutated || SCHEME_VAR(value)->optimize_unready)
7619 313: 7614: value = NULL;
7620 -: 7615: }
7621 -: 7616:
7622 323867: 7617: if (value)
7623 320311: 7618: value = extract_specialized_proc(value, value);
7624 -: 7619:
7625 323867: 7620: if (value && (scheme_ir_propagate_ok(value, body_info))) {
7626 122606: 7621: pre_body->vars[0]->optimize.known_val = value;
7627 122606: 7622: did_set_value = 1;
7628 201261: 7623: } else if (value && !is_rec) {
7629 -: 7624: int cnt, ct, involves_k_cross;
7630 -: 7625: Scheme_Object *pred;
7631 -: 7626:
7632 196807: 7627: ct = scheme_expr_produces_local_type(value, &involves_k_cross);
7633 196807: 7628: if (ct) {
7634 5578: 7629: SCHEME_VAR(pre_body->vars[0])->val_type = ct;
7635 5578: 7630: if (involves_k_cross) {
7636 -: 7631: /* Although this variable's uses do not necessarily cross
7637 -: 7632: a continuation capture, the inference of its type
7638 -: 7633: depends on that crossing, so we treat as having a crossing.
7639 -: 7634: This is an accommodation to the bytecode format and
7640 -: 7635: validator, which has no way to distinguish between
7641 -: 7636: a known type and unboxing capability for that type. */
7642 #####: 7637: SCHEME_VAR(pre_body->vars[0])->escapes_after_k_tick = 1;
7643 -: 7638: }
7644 -: 7639: }
7645 -: 7640:
7646 196807: 7641: pred = expr_implies_predicate(value, rhs_info);
7647 -: 7642:
7648 196807: 7643: if (pred)
7649 45829: 7644: add_type(body_info, (Scheme_Object *)pre_body->vars[0], pred);
7650 -: 7645:
7651 196807: 7646: if (!indirect) {
7652 196613: 7647: cnt = pre_body->vars[0]->use_count;
7653 196613: 7648: if (cnt == 1) {
7654 -: 7649: /* used only once; we may be able to shift the expression to the use
7655 -: 7650: site, instead of binding to a temporary */
7656 74487: 7651: once_used = make_once_used(value, pre_body->vars[0],
7657 -: 7652: once_vclock, once_aclock, once_kclock, once_sclock,
7658 -: 7653: once_increments_kclock);
7659 74487: 7654: pre_body->vars[0]->optimize.known_val = (Scheme_Object *)once_used;
7660 -: 7655: }
7661 -: 7656: }
7662 -: 7657: }
7663 -: 7658: }
7664 -: 7659:
7665 334418: 7660: if (!retry_start) {
7666 239824: 7661: retry_start = pre_body;
7667 239824: 7662: ready_pairs_start = ready_pairs;
7668 -: 7663: }
7669 -: 7664:
7670 -: 7665: /* Re-optimize to inline letrec bindings? */
7671 334418: 7666: if (is_rec
7672 13056: 7667: && !body_info->letrec_not_twice
7673 10534: 7668: && ((i < 1)
7674 1253: 7669: || (!scheme_is_ir_lambda(((Scheme_IR_Let_Value *)pre_body->body)->value, 1, 1)
7675 474: 7670: && !scheme_is_liftable(((Scheme_IR_Let_Value *)pre_body->body)->value, merge_skip_vars, 5, 1, 0)))) {
7676 9606: 7671: Scheme_Object *prop_later = NULL;
7677 -: 7672:
7678 9606: 7673: if (did_set_value) {
7679 -: 7674: /* Next RHS ends a reorderable sequence.
7680 -: 7675: Re-optimize from retry_start to pre_body, inclusive.
7681 -: 7676: For procedures, assume LAMBDA_SINGLE_RESULT and LAMBDA_PRESERVES_MARKS for all,
7682 -: 7677: but then assume not for all if any turn out not (i.e., approximate fix point). */
7683 -: 7678: int flags;
7684 -: 7679: Scheme_Object *clones, *cl, *cl_first;
7685 -: 7680:
7686 -: 7681: /* If this is the last binding, peek ahead in the body to
7687 -: 7682: check for easy type info in function calls */
7688 8824: 7683: if (!i)
7689 8735: 7684: set_application_types(pre_body->body, body_info, 5);
7690 -: 7685:
7691 -: 7686: /* Reset "unready" flags: */
7692 9645: 7687: for (rp_last = ready_pairs_start; !SAME_OBJ(rp_last, ready_pairs); rp_last = SCHEME_CDR(rp_last)) {
7693 821: 7688: SCHEME_VAR(SCHEME_CAR(rp_last))->optimize_unready = 1;
7694 -: 7689: }
7695 -: 7690: /* Set-flags loop: */
7696 8824: 7691: clones = make_clones(retry_start, pre_body, rhs_info);
7697 8824: 7692: (void)set_code_flags(retry_start, pre_body, clones,
7698 -: 7693: LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_RESULT_TENTATIVE,
7699 -: 7694: 0xFFFF,
7700 -: 7695: 0,
7701 -: 7696: 0);
7702 -: 7697: /* Re-optimize loop: */
7703 8824: 7698: irlv = retry_start;
7704 8824: 7699: cl = clones;
7705 -: 7700: while (1) {
7706 9720: 7701: value = irlv->value;
7707 9720: 7702: if (cl) {
7708 9632: 7703: cl_first = SCHEME_CAR(cl);
7709 9632: 7704: if (!cl_first)
7710 #####: 7705: cl = SCHEME_CDR(cl);
7711 -: 7706: } else
7712 88: 7707: cl_first = NULL;
7713 9720: 7708: if (cl_first && SAME_OBJ(value, SCHEME_CAR(cl_first))) {
7714 -: 7709: /* Try optimization. */
7715 -: 7710: Scheme_Object *self_value;
7716 -: 7711: int sz;
7717 -: 7712: char use_psize;
7718 -: 7713:
7719 9525: 7714: if ((irlv->count == 1)
7720 9525: 7715: && !irlv->vars[0]->optimize_used)
7721 9519: 7716: start_transitive_use_record(body_info, rhs_info, irlv->vars[0]);
7722 -: 7717:
7723 9525: 7718: cl = SCHEME_CDR(cl);
7724 9525: 7719: self_value = SCHEME_CDR(cl_first);
7725 -: 7720:
7726 -: 7721: /* Drop old size, and remove old inline fuel: */
7727 9525: 7722: sz = lambda_body_size(value, 0);
7728 9525: 7723: rhs_info->size -= (sz + 1);
7729 -: 7724:
7730 -: 7725: /* Setting letrec_not_twice prevents inlinining
7731 -: 7726: of letrec bindings in this RHS. There's a small
7732 -: 7727: chance that we miss some optimizations, but we
7733 -: 7728: avoid the possibility of N^2 behavior. */
7734 -: 7729: if (!OPT_DISCOURAGE_EARLY_INLINE)
7735 -: 7730: rhs_info->letrec_not_twice++;
7736 9525: 7731: use_psize = rhs_info->use_psize;
7737 9525: 7732: rhs_info->use_psize = info->use_psize;
7738 -: 7733:
7739 9525: 7734: optimize_info_seq_step(rhs_info, &info_seq);
7740 9525: 7735: value = scheme_optimize_expr(self_value, rhs_info,
7741 9525: 7736: (((irlv->count == 1)
7742 -: 7737: ? OPT_CONTEXT_SINGLED
7743 9525: 7738: : 0)
7744 9525: 7739: | (((irlv->count == 1)
7745 9525: 7740: && !irlv->vars[0]->non_app_count)
7746 9216: 7741: ? (irlv->vars[0]->use_count << OPT_CONTEXT_APP_COUNT_SHIFT)
7747 18741: 7742: : 0)));
7748 -: 7743:
7749 -: 7744: if (!OPT_DISCOURAGE_EARLY_INLINE)
7750 -: 7745: --rhs_info->letrec_not_twice;
7751 9525: 7746: rhs_info->use_psize = use_psize;
7752 -: 7747:
7753 9525: 7748: irlv->value = value;
7754 -: 7749:
7755 9525: 7750: if (!irlv->vars[0]->mutated) {
7756 9523: 7751: if (scheme_ir_propagate_ok(value, rhs_info)) {
7757 -: 7752: /* Register re-optimized as the value for the binding, but
7758 -: 7753: maybe only if it didn't grow too much: */
7759 -: 7754: int new_sz;
7760 -: 7755: if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE)
7761 -: 7756: new_sz = lambda_body_size(value, 0);
7762 -: 7757: else
7763 8694: 7758: new_sz = 0;
7764 8694: 7759: if (new_sz <= sz) {
7765 8694: 7760: irlv->vars[0]->optimize.known_val = value;
7766 -: 7761: }
7767 -: 7762: else if (!OPT_LIMIT_FUNCTION_RESIZE
7768 -: 7763: || (new_sz < 4 * sz))
7769 #####: 7764: prop_later = scheme_make_raw_pair(scheme_make_pair((Scheme_Object *)irlv->vars[0],
7770 -: 7765: value),
7771 -: 7766: prop_later);
7772 -: 7767: }
7773 -: 7768: }
7774 -: 7769:
7775 9525: 7770: end_transitive_use_record(rhs_info);
7776 -: 7771: }
7777 9720: 7772: if (irlv == pre_body)
7778 8824: 7773: break;
7779 -: 7774: {
7780 -: 7775: /* Since letrec is really letrec*, the variables
7781 -: 7776: for this binding are now ready: */
7782 -: 7777: int i;
7783 2667: 7778: for (i = irlv->count; i--; ) {
7784 875: 7779: if (!irlv->vars[i]->mutated) {
7785 821: 7780: SCHEME_VAR(SCHEME_CAR(ready_pairs_start))->optimize_unready = 0;
7786 821: 7781: ready_pairs_start = SCHEME_CDR(ready_pairs_start);
7787 -: 7782: }
7788 -: 7783: }
7789 -: 7784: }
7790 896: 7785: irlv = (Scheme_IR_Let_Value *)irlv->body;
7791 896: 7786: }
7792 -: 7787: /* Check flags loop: */
7793 8824: 7788: flags = set_code_flags(retry_start, pre_body, clones, 0, 0xFFFF, 0, 0);
7794 -: 7789: /* Reset-flags loop: */
7795 8824: 7790: (void)set_code_flags(retry_start, pre_body, clones,
7796 -: 7791: (flags & (LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS)),
7797 -: 7792: ~(LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_RESULT_TENTATIVE),
7798 -: 7793: 1,
7799 -: 7794: 1);
7800 -: 7795: }
7801 9606: 7796: retry_start = NULL;
7802 9606: 7797: ready_pairs_start = NULL;
7803 9606: 7798: did_set_value = 0;
7804 -: 7799:
7805 19212: 7800: while (prop_later) {
7806 #####: 7801: value = SCHEME_CAR(prop_later);
7807 #####: 7802: SCHEME_VAR(SCHEME_CAR(value))->optimize.known_val = SCHEME_CDR(value);
7808 #####: 7803: prop_later = SCHEME_CDR(prop_later);
7809 -: 7804: }
7810 -: 7805: }
7811 -: 7806:
7812 334418: 7807: if (is_rec) {
7813 -: 7808: /* Since letrec is really letrec*, the variables
7814 -: 7809: for this binding are now ready: */
7815 -: 7810: int i;
7816 39094: 7811: for (i = pre_body->count; i--; ) {
7817 12982: 7812: pre_body->vars[i]->optimize.init_kclock = rhs_info->kclock;
7818 12982: 7813: if (!pre_body->vars[i]->mutated) {
7819 12894: 7814: SCHEME_VAR(SCHEME_CAR(ready_pairs))->optimize_unready = 0;
7820 12894: 7815: ready_pairs = SCHEME_CDR(ready_pairs);
7821 -: 7816: }
7822 -: 7817: }
7823 -: 7818: }
7824 -: 7819:
7825 334418: 7820: if (remove_last_one) {
7826 1181: 7821: head->num_clauses -= 1;
7827 1181: 7822: body = (Scheme_Object *)pre_body->body;
7828 -: 7823:
7829 1181: 7824: if (found_escapes && !SCHEME_FALSEP(pre_body->value)) {
7830 -: 7825: /* Since `pre_body->value` wasn't simplified to #f,
7831 -: 7826: keep this as the new body */
7832 13: 7827: escape_body = pre_body->value;
7833 -: 7828: }
7834 -: 7829:
7835 1181: 7830: if (prev_body) {
7836 13: 7831: prev_body->body = body;
7837 13: 7832: pre_body = prev_body;
7838 -: 7833: } else {
7839 1168: 7834: head->body = body;
7840 1168: 7835: pre_body = NULL;
7841 -: 7836: }
7842 1181: 7837: break;
7843 -: 7838: }
7844 -: 7839:
7845 333237: 7840: prev_body = pre_body;
7846 333237: 7841: body = pre_body->body;
7847 -: 7842: }
7848 -: 7843:
7849 239499: 7844: if (!is_rec) {
7850 -: 7845: /* All `let`-bound variables are now allocated: */
7851 227813: 7846: body = head->body;
7852 775807: 7847: for (i = head->num_clauses; i--; ) {
7853 320181: 7848: pre_body = (Scheme_IR_Let_Value *)body;
7854 978846: 7849: for (j = pre_body->count; j--; ) {
7855 338484: 7850: pre_body->vars[j]->optimize.init_kclock = body_info->kclock;
7856 -: 7851: }
7857 320181: 7852: body = pre_body->body;
7858 -: 7853: }
7859 -: 7854: }
7860 -: 7855:
7861 239499: 7856: optimize_info_seq_done(body_info, &info_seq);
7862 -: 7857:
7863 239499: 7858: if (!found_escapes) {
7864 239405: 7859: body = scheme_optimize_expr(body, body_info, scheme_optimize_tail_context(context));
7865 -: 7860: } else {
7866 94: 7861: body = ensure_noncm(escape_body);
7867 94: 7862: body_info->single_result = 1;
7868 94: 7863: body_info->preserves_marks = 1;
7869 94: 7864: body_info->escapes = 1;
7870 94: 7865: body_info->size++;
7871 -: 7866: }
7872 239488: 7867: if (head->num_clauses)
7873 238320: 7868: pre_body->body = body;
7874 -: 7869: else
7875 1168: 7870: head->body = body;
7876 -: 7871:
7877 -: 7872: /* Propagate any use from formerly tentative uses: */
7878 -: 7873: while (1) {
7879 253487: 7874: int changed = 0;
7880 253487: 7875: body = head->body;
7881 858118: 7876: for (i = head->num_clauses; i--; ) {
7882 351144: 7877: pre_body = (Scheme_IR_Let_Value *)body;
7883 1071237: 7878: for (j = pre_body->count; j--; ) {
7884 368949: 7879: if (pre_body->vars[j]->optimize_used
7885 212088: 7880: && pre_body->vars[j]->optimize.transitive_uses) {
7886 14668: 7881: register_transitive_uses(pre_body->vars[j], body_info);
7887 14668: 7882: changed = 1;
7888 14668: 7883: pre_body->vars[j]->optimize.transitive_uses = NULL;
7889 -: 7884: }
7890 -: 7885: }
7891 351144: 7886: body = pre_body->body;
7892 -: 7887: }
7893 253487: 7888: if (!changed)
7894 239488: 7889: break;
7895 13999: 7890: }
7896 -: 7891:
7897 239488: 7892: info->single_result = body_info->single_result;
7898 239488: 7893: info->preserves_marks = body_info->preserves_marks;
7899 239488: 7894: info->vclock = body_info->vclock;
7900 239488: 7895: info->aclock = body_info->aclock;
7901 239488: 7896: info->kclock = body_info->kclock;
7902 239488: 7897: info->sclock = body_info->sclock;
7903 -: 7898:
7904 -: 7899: /* Clear used flags where possible, clear once-used references, etc. */
7905 239488: 7900: body = head->body;
7906 239488: 7901: prev_body = NULL;
7907 812200: 7902: for (i = head->num_clauses; i--; ) {
7908 333224: 7903: int used = 0, j;
7909 -: 7904:
7910 333224: 7905: pre_body = (Scheme_IR_Let_Value *)body;
7911 -: 7906:
7912 333224: 7907: if (pre_body->count == 1) {
7913 -: 7908: /* If the right-hand side is a function, make sure all use sites
7914 -: 7909: are accounted for toward type inference of arguments. */
7915 324643: 7910: if (pre_body->vars[0]->optimize.known_val
7916 192249: 7911: && SAME_TYPE(SCHEME_TYPE(pre_body->vars[0]->optimize.known_val), scheme_lambda_type)) {
7917 #####: 7912: check_lambda_arg_types_registered((Scheme_Lambda *)pre_body->vars[0]->optimize.known_val,
7918 #####: 7913: pre_body->vars[0]->use_count);
7919 -: 7914: }
7920 -: 7915: }
7921 -: 7916:
7922 820472: 7917: for (j = pre_body->count; j--; ) {
7923 336882: 7918: if (pre_body->vars[j]->optimize_used) {
7924 182858: 7919: used = 1;
7925 182858: 7920: break;
7926 -: 7921: }
7927 -: 7922: }
7928 -: 7923:
7929 -: 7924: /* once-used moved implies not optimize_used: */
7930 -: 7925: MZ_ASSERT(!(used
7931 -: 7926: && (pre_body->count == 1)
7932 -: 7927: && pre_body->vars[0]->optimize.known_val
7933 -: 7928: && SAME_TYPE(scheme_once_used_type, SCHEME_TYPE(pre_body->vars[0]->optimize.known_val))
7934 -: 7929: && ((Scheme_Once_Used *)pre_body->vars[0]->optimize.known_val)->moved));
7935 -: 7930:
7936 333224: 7931: if (!used
7937 150366: 7932: && (scheme_omittable_expr(pre_body->value, pre_body->count, -1, 0, info, info)
7938 15901: 7933: || ((pre_body->count == 1)
7939 15605: 7934: && pre_body->vars[0]->optimize.known_val
7940 11941: 7935: && SAME_TYPE(scheme_once_used_type, SCHEME_TYPE(pre_body->vars[0]->optimize.known_val))
7941 11916: 7936: && ((Scheme_Once_Used *)pre_body->vars[0]->optimize.known_val)->moved))) {
7942 -: 7937: /* Drop the binding(s) */
7943 438924: 7938: for (j = pre_body->count; j--; ) {
7944 146308: 7939: pre_body->vars[j]->mode = SCHEME_VAR_MODE_NONE;
7945 -: 7940: }
7946 146308: 7941: head->num_clauses -= 1;
7947 146308: 7942: head->count -= pre_body->count;
7948 146308: 7943: if (prev_body)
7949 8644: 7944: prev_body->body = pre_body->body;
7950 -: 7945: else
7951 137664: 7946: head->body = pre_body->body;
7952 -: 7947: /* Deduct from size to aid further inlining. */
7953 146308: 7948: {
7954 -: 7949: int sz;
7955 146308: 7950: sz = expr_size(pre_body->value);
7956 146308: 7951: body_info->size -= sz;
7957 -: 7952: }
7958 -: 7953: } else {
7959 186916: 7954: if (!used && (pre_body->count == 1)) {
7960 -: 7955: /* The whole binding is not omittable, but maybe the tail is omittable: */
7961 3762: 7956: Scheme_Object *v2 = pre_body->value, *inside;
7962 3762: 7957: extract_tail_inside(&v2, &inside);
7963 3762: 7958: if (scheme_omittable_expr(v2, pre_body->count, -1, 0, info, info)) {
7964 25: 7959: replace_tail_inside(scheme_false, inside, pre_body->value);
7965 -: 7960: }
7966 -: 7961: }
7967 -: 7962:
7968 578973: 7963: for (j = pre_body->count; j--; ) {
7969 -: 7964: int ct;
7970 -: 7965:
7971 205141: 7966: pre_body->vars[j]->optimize_outside_binding = 1;
7972 205141: 7967: if (pre_body->vars[j]->optimize.known_val
7973 47549: 7968: && SAME_TYPE(scheme_once_used_type, SCHEME_TYPE(pre_body->vars[j]->optimize.known_val))) {
7974 -: 7969: /* We're keeping this clause here, so don't allow movement of the once-used
7975 -: 7970: value when peeking under bindings via extract_tail_inside(): */
7976 30894: 7971: pre_body->vars[j]->optimize.known_val = NULL;
7977 -: 7972: }
7978 -: 7973:
7979 205141: 7974: ct = pre_body->vars[j]->arg_type;
7980 205141: 7975: if (ct) {
7981 298: 7976: if (ALWAYS_PREFER_UNBOX_TYPE(ct)
7982 298: 7977: || !pre_body->vars[j]->escapes_after_k_tick)
7983 260: 7978: pre_body->vars[j]->arg_type = ct;
7984 -: 7979: }
7985 -: 7980: }
7986 186916: 7981: info->size += 1;
7987 186916: 7982: prev_body = pre_body;
7988 -: 7983: }
7989 333224: 7984: body = pre_body->body;
7990 -: 7985: }
7991 -: 7986:
7992 239488: 7987: optimize_info_done(body_info, NULL);
7993 239488: 7988: merge_types(body_info, info, merge_skip_vars);
7994 -: 7989:
7995 239488: 7990: if (is_rec && !not_simply_let_star) {
7996 -: 7991: /* We can simplify letrec to let* */
7997 36: 7992: SCHEME_LET_FLAGS(head) -= SCHEME_LET_RECURSIVE;
7998 36: 7993: is_rec = 0;
7999 36: 7994: optimize_uses_of_mutable_imply_early_alloc((Scheme_IR_Let_Value *)head->body, head->num_clauses);
8000 -: 7995: }
8001 -: 7996:
8002 -: 7997: /* Optimized away all clauses? */
8003 239488: 7998: if (!head->num_clauses) {
8004 83489: 7999: return body;
8005 -: 8000: }
8006 -: 8001:
8007 155999: 8002: if (!is_rec
8008 144396: 8003: && ((SCHEME_TYPE(body) > _scheme_ir_values_types_)
8009 141058: 8004: || SAME_TYPE(SCHEME_TYPE(body), scheme_ir_toplevel_type)
8010 141058: 8005: || SAME_TYPE(SCHEME_TYPE(body), scheme_ir_local_type))) {
8011 -: 8006: /* If the body is a constant, toplevel or another local, the last binding
8012 -: 8007: is unused, so reduce (let ([x <expr>]) K) => (begin <expr> K).
8013 -: 8008: As a special case, include a second check for (let ([x E]) x) => E or (values E). */
8014 -: 8009: Scheme_Object *inside;
8015 -: 8010:
8016 3930: 8011: inside = (Scheme_Object *)head;
8017 3930: 8012: pre_body = (Scheme_IR_Let_Value *)head->body;
8018 7863: 8013: for (i = head->num_clauses - 1; i--; ) {
8019 3: 8014: inside = (Scheme_Object *)pre_body;
8020 3: 8015: pre_body = (Scheme_IR_Let_Value *)pre_body->body;
8021 -: 8016: }
8022 -: 8017:
8023 3930: 8018: if (pre_body->count == 1) {
8024 3401: 8019: if (!SAME_OBJ((Scheme_Object *)pre_body->vars[0], body)
8025 3326: 8020: && !found_escapes) {
8026 3258: 8021: body = make_discarding_sequence(pre_body->value, body, info);
8027 -: 8022: } else {
8028 -: 8023: /* Special case for (let ([x E]) x) and (let ([x <error>]) #f) */
8029 143: 8024: body = pre_body->value;
8030 143: 8025: body = ensure_single_value_noncm(body);
8031 143: 8026: if (found_escapes) {
8032 68: 8027: found_escapes = 0; /* Perhaps the error is moved to the body. */
8033 68: 8028: body = ensure_noncm(body);
8034 -: 8029: }
8035 -: 8030: }
8036 -: 8031:
8037 3401: 8032: if (head->num_clauses == 1)
8038 3400: 8033: return body;
8039 -: 8034:
8040 1: 8035: (void)replace_tail_inside(body, inside, NULL);
8041 1: 8036: head->count--;
8042 1: 8037: head->num_clauses--;
8043 -: 8038: }
8044 -: 8039: }
8045 -: 8040:
8046 152599: 8041: if (!is_rec) {
8047 -: 8042: /* One last pass to peel off unused bindings */
8048 140996: 8043: Scheme_Object *prev = NULL, *rhs;
8049 -: 8044:
8050 140996: 8045: body = head->body;
8051 282227: 8046: for (i = head->num_clauses; i--; ) {
8052 141009: 8047: pre_body = (Scheme_IR_Let_Value *)body;
8053 141009: 8048: if ((pre_body->count == 1)
8054 132811: 8049: && !pre_body->vars[0]->optimize_used) {
8055 -: 8050: Scheme_Sequence *seq;
8056 -: 8051: Scheme_Object *new_body;
8057 -: 8052:
8058 235: 8053: pre_body->vars[0]->mode = SCHEME_VAR_MODE_NONE;
8059 -: 8054:
8060 235: 8055: seq = scheme_malloc_sequence(2);
8061 235: 8056: seq->so.type = scheme_sequence_type;
8062 235: 8057: seq->count = 2;
8063 -: 8058:
8064 235: 8059: rhs = pre_body->value;
8065 235: 8060: rhs = ensure_single_value_noncm(rhs);
8066 235: 8061: seq->array[0] = rhs;
8067 -: 8062:
8068 235: 8063: head->count--;
8069 235: 8064: head->num_clauses--;
8070 235: 8065: head->body = pre_body->body;
8071 -: 8066:
8072 235: 8067: new_body = (Scheme_Object *)seq;
8073 -: 8068:
8074 235: 8069: if (head->num_clauses)
8075 13: 8070: seq->array[1] = (Scheme_Object *)head;
8076 222: 8071: else if (found_escapes && SCHEME_FALSEP(head->body)) {
8077 -: 8072: /* don't need the `#f` for the body, because some RHS escapes */
8078 #####: 8073: new_body = ensure_noncm(rhs);
8079 -: 8074: } else
8080 222: 8075: seq->array[1] = head->body;
8081 -: 8076:
8082 235: 8077: if (prev)
8083 5: 8078: (void)replace_tail_inside(new_body, prev, NULL);
8084 -: 8079: else
8085 230: 8080: form = new_body;
8086 235: 8081: prev = new_body;
8087 -: 8082:
8088 235: 8083: body = pre_body->body;
8089 -: 8084: } else
8090 -: 8085: break;
8091 -: 8086: }
8092 -: 8087:
8093 140996: 8088: if (prev && SAME_TYPE(SCHEME_TYPE(prev), scheme_sequence_type))
8094 230: 8089: form = optimize_sequence(form, info, context, 0);
8095 -: 8090: }
8096 -: 8091:
8097 152599: 8092: return form;
8098 -: 8093:}
8099 -: 8094:
8100 -: 8095:/*========================================================================*/
8101 -: 8096:/* lambda */
8102 -: 8097:/*========================================================================*/
8103 -: 8098:
8104 -: 8099:static Scheme_Object *
8105 75354: 8100:optimize_lambda(Scheme_Object *_lam, Optimize_Info *info, int context)
8106 -: 8101:{
8107 -: 8102: Scheme_Lambda *lam;
8108 -: 8103: Scheme_Object *code, *ctx;
8109 -: 8104: Scheme_IR_Lambda_Info *cl;
8110 -: 8105: int i, init_vclock, init_aclock, init_kclock, init_sclock;
8111 -: 8106: Scheme_Hash_Table *ht;
8112 75354: 8107: int app_count = OPT_CONTEXT_APP_COUNT(context);
8113 -: 8108:
8114 75354: 8109: lam = (Scheme_Lambda *)_lam;
8115 -: 8110:
8116 75354: 8111: info->single_result = 1;
8117 75354: 8112: info->preserves_marks = 1;
8118 -: 8113:
8119 75354: 8114: info = optimize_info_add_frame(info, lam->num_params, lam->num_params,
8120 -: 8115: SCHEME_LAMBDA_FRAME);
8121 -: 8116:
8122 75354: 8117: ht = scheme_make_hash_table(SCHEME_hash_ptr);
8123 75354: 8118: info->uses = ht;
8124 -: 8119:
8125 75354: 8120: init_vclock = info->vclock;
8126 75354: 8121: init_aclock = info->aclock;
8127 75354: 8122: init_kclock = info->kclock;
8128 75354: 8123: init_sclock = info->sclock;
8129 -: 8124:
8130 75354: 8125: info->vclock += 1; /* model delayed evaluation as vclock increment */
8131 75354: 8126: info->kclock += 1;
8132 75354: 8127: info->sclock += 1;
8133 -: 8128:
8134 -: 8129: /* For reporting warnings: */
8135 75354: 8130: if (info->context && SCHEME_PAIRP(info->context))
8136 48037: 8131: ctx = scheme_make_pair((Scheme_Object *)lam,
8137 48037: 8132: SCHEME_CDR(info->context));
8138 27317: 8133: else if (info->context)
8139 21372: 8134: ctx = scheme_make_pair((Scheme_Object *)lam, info->context);
8140 -: 8135: else
8141 5945: 8136: ctx = (Scheme_Object *)lam;
8142 75354: 8137: info->context = ctx;
8143 -: 8138:
8144 75354: 8139: cl = lam->ir_info;
8145 189225: 8140: for (i = 0; i < lam->num_params; i++) {
8146 113871: 8141: set_optimize_mode(cl->vars[i]);
8147 113871: 8142: cl->vars[i]->optimize.lambda_depth = info->lambda_depth;
8148 113871: 8143: cl->vars[i]->optimize_used = 0;
8149 113871: 8144: cl->vars[i]->optimize.init_kclock = info->kclock;
8150 113871: 8145: if (app_count
8151 40770: 8146: && (app_count < SCHEME_USE_COUNT_INF)
8152 38911: 8147: && cl->arg_types
8153 26376: 8148: && cl->arg_types[i]
8154 10384: 8149: && (cl->arg_type_contributors[i] == ((1 << app_count) - 1))) {
8155 -: 8150: /* All uses accounted for, so we can rely on type info */
8156 3608: 8151: add_type(info, (Scheme_Object *)cl->vars[i], cl->arg_types[i]);
8157 -: 8152: }
8158 -: 8153: }
8159 -: 8154:
8160 75354: 8155: code = scheme_optimize_expr(lam->body, info, 0);
8161 -: 8156:
8162 75353: 8157: propagate_used_variables(info);
8163 -: 8158:
8164 75353: 8159: if (info->single_result)
8165 40768: 8160: SCHEME_LAMBDA_FLAGS(lam) |= LAMBDA_SINGLE_RESULT;
8166 34585: 8161: else if (SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_SINGLE_RESULT)
8167 5376: 8162: SCHEME_LAMBDA_FLAGS(lam) -= LAMBDA_SINGLE_RESULT;
8168 -: 8163:
8169 75353: 8164: if (info->preserves_marks)
8170 40095: 8165: SCHEME_LAMBDA_FLAGS(lam) |= LAMBDA_PRESERVES_MARKS;
8171 35258: 8166: else if (SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_PRESERVES_MARKS)
8172 5378: 8167: SCHEME_LAMBDA_FLAGS(lam) -= LAMBDA_PRESERVES_MARKS;
8173 -: 8168:
8174 75353: 8169: if ((info->single_result > 0) && (info->preserves_marks > 0)
8175 34858: 8170: && (SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_RESULT_TENTATIVE))
8176 5856: 8171: SCHEME_LAMBDA_FLAGS(lam) -= LAMBDA_RESULT_TENTATIVE;
8177 -: 8172:
8178 75353: 8173: lam->body = code;
8179 -: 8174:
8180 -: 8175: /* Remembers positions of used vars (and unsets usage for this level) */
8181 75353: 8176: cl->base_closure = info->uses;
8182 75353: 8177: if (env_uses_toplevel(info))
8183 36010: 8178: cl->has_tl = 1;
8184 -: 8179: else
8185 39343: 8180: cl->has_tl = 0;
8186 75353: 8181: cl->body_size = info->size;
8187 75353: 8182: cl->body_psize = info->psize;
8188 75353: 8183: cl->has_nonleaf = info->has_nonleaf;
8189 -: 8184:
8190 -: 8185: /* closure itself is not an effect */
8191 75353: 8186: info->vclock = init_vclock;
8192 75353: 8187: info->aclock = init_aclock;
8193 75353: 8188: info->kclock = init_kclock;
8194 75353: 8189: info->sclock = init_sclock;
8195 75353: 8190: info->escapes = 0;
8196 -: 8191:
8197 75353: 8192: info->size++;
8198 -: 8193:
8199 150706: 8194: lam->closure_size = (cl->base_closure->count
8200 75353: 8195: + (cl->has_tl ? 1 : 0));
8201 -: 8196:
8202 75353: 8197: optimize_info_done(info, NULL);
8203 -: 8198:
8204 75353: 8199: return (Scheme_Object *)lam;
8205 -: 8200:}
8206 -: 8201:
8207 28647: 8202:static void merge_lambda_arg_types(Scheme_Lambda *lam1, Scheme_Lambda *lam2)
8208 -: 8203:{
8209 28647: 8204: Scheme_IR_Lambda_Info *cl1 = lam1->ir_info;
8210 28647: 8205: Scheme_IR_Lambda_Info *cl2 = lam2->ir_info;
8211 -: 8206: int i;
8212 -: 8207:
8213 28647: 8208: if (!cl1->arg_types) {
8214 980: 8209: if (cl2->arg_types) {
8215 2: 8210: cl1->arg_types = cl2->arg_types;
8216 2: 8211: cl1->arg_type_contributors = cl2->arg_type_contributors;
8217 -: 8212: }
8218 -: 8213: } else {
8219 27667: 8214: if (cl2->arg_types) {
8220 99281: 8215: for (i = lam1->num_params; i--; ) {
8221 43947: 8216: if (!cl1->arg_type_contributors[i]) {
8222 9216: 8217: cl1->arg_types[i] = cl2->arg_types[i];
8223 9216: 8218: cl1->arg_type_contributors[i] = cl2->arg_type_contributors[i];
8224 34731: 8219: } else if (cl2->arg_type_contributors[i]) {
8225 34714: 8220: if (!cl2->arg_types[i])
8226 22118: 8221: cl1->arg_types[i] = NULL;
8227 12596: 8222: else if (predicate_implies(cl1->arg_types[i], cl2->arg_types[i]))
8228 12589: 8223: cl1->arg_types[i] = cl2->arg_types[i];
8229 7: 8224: else if (!predicate_implies(cl2->arg_types[i], cl1->arg_types[i])) {
8230 7: 8225: cl1->arg_types[i] = NULL;
8231 7: 8226: cl1->arg_type_contributors[i] |= (1 << (SCHEME_USE_COUNT_INF-1));
8232 -: 8227: }
8233 34714: 8228: cl1->arg_type_contributors[i] |= cl2->arg_type_contributors[i];
8234 -: 8229: }
8235 -: 8230: }
8236 -: 8231: }
8237 -: 8232:
8238 27667: 8233: cl2->arg_types = cl1->arg_types;
8239 27667: 8234: cl2->arg_type_contributors = cl1->arg_type_contributors;
8240 -: 8235: }
8241 28647: 8236:}
8242 -: 8237:
8243 #####: 8238:static void check_lambda_arg_types_registered(Scheme_Lambda *lam, int app_count)
8244 -: 8239:{
8245 #####: 8240: if (lam->ir_info->arg_types) {
8246 -: 8241: int i;
8247 #####: 8242: for (i = lam->num_params; i--; ) {
8248 #####: 8243: if (lam->ir_info->arg_types[i]) {
8249 #####: 8244: if ((lam->ir_info->arg_type_contributors[i] & (1 << (SCHEME_USE_COUNT_INF-1)))
8250 #####: 8245: || (lam->ir_info->arg_type_contributors[i] < ((1 << app_count) - 1))) {
8251 -: 8246: /* someone caller didn't weigh in with a type,
8252 -: 8247: of an anonymous caller had no type to record */
8253 #####: 8248: lam->ir_info->arg_types[i] = NULL;
8254 -: 8249: }
8255 -: 8250: }
8256 -: 8251: }
8257 -: 8252: }
8258 #####: 8253:}
8259 -: 8254:
8260 273013: 8255:static Scheme_IR_Local *clone_variable(Scheme_IR_Local *var)
8261 -: 8256:{
8262 -: 8257: Scheme_IR_Local *var2;
8263 -: 8258: MZ_ASSERT(SAME_TYPE(var->so.type, scheme_ir_local_type));
8264 273013: 8259: var2 = MALLOC_ONE_TAGGED(Scheme_IR_Local);
8265 273013: 8260: memcpy(var2, var, sizeof(Scheme_IR_Local));
8266 273013: 8261: return var2;
8267 -: 8262:}
8268 -: 8263:
8269 185547: 8264:static Scheme_IR_Local **clone_variable_array(Scheme_IR_Local **vars,
8270 -: 8265: int sz,
8271 -: 8266: Scheme_Hash_Tree **_var_map)
8272 -: 8267:{
8273 -: 8268: Scheme_IR_Local **new_vars, *var;
8274 185547: 8269: Scheme_Hash_Tree *var_map = *_var_map;
8275 -: 8270: int j;
8276 -: 8271:
8277 185547: 8272: new_vars = MALLOC_N(Scheme_IR_Local*, sz);
8278 643995: 8273: for (j = sz; j--; ) {
8279 272901: 8274: var = clone_variable(vars[j]);
8280 272901: 8275: var->mode = SCHEME_VAR_MODE_NONE;
8281 272901: 8276: new_vars[j] = var;
8282 272901: 8277: var_map = scheme_hash_tree_set(var_map, (Scheme_Object *)vars[j], (Scheme_Object *)new_vars[j]);
8283 -: 8278: }
8284 -: 8279:
8285 185547: 8280: *_var_map = var_map;
8286 185547: 8281: return new_vars;
8287 -: 8282:}
8288 -: 8283:
8289 96325: 8284:static Scheme_Object *clone_lambda(int single_use, Scheme_Object *_lam, Optimize_Info *info, Scheme_Hash_Tree *var_map)
8290 -: 8285:{
8291 -: 8286: Scheme_Lambda *lam, *lam2;
8292 -: 8287: Scheme_Object *body, *var;
8293 -: 8288: Scheme_Hash_Table *ht;
8294 -: 8289: Scheme_IR_Lambda_Info *cl;
8295 -: 8290: Scheme_IR_Local **vars;
8296 -: 8291: int sz;
8297 -: 8292: Scheme_Object **arg_types;
8298 -: 8293: short *arg_type_contributors;
8299 -: 8294:
8300 96325: 8295: lam = (Scheme_Lambda *)_lam;
8301 -: 8296:
8302 96325: 8297: lam2 = MALLOC_ONE_TAGGED(Scheme_Lambda);
8303 96325: 8298: memcpy(lam2, lam, sizeof(Scheme_Lambda));
8304 -: 8299:
8305 96325: 8300: cl = MALLOC_ONE_RT(Scheme_IR_Lambda_Info);
8306 96325: 8301: memcpy(cl, lam->ir_info, sizeof(Scheme_IR_Lambda_Info));
8307 96325: 8302: lam2->ir_info = cl;
8308 -: 8303:
8309 96325: 8304: vars = clone_variable_array(cl->vars, lam2->num_params, &var_map);
8310 96325: 8305: cl->vars = vars;
8311 -: 8306:
8312 96325: 8307: cl->is_dup |= !single_use;
8313 -: 8308:
8314 96325: 8309: body = optimize_clone(single_use, lam->body, info, var_map, 0);
8315 96325: 8310: if (!body) return NULL;
8316 -: 8311:
8317 91889: 8312: lam2->body = body;
8318 -: 8313:
8319 91889: 8314: if (cl->arg_types) {
8320 32507: 8315: sz = lam2->num_params;
8321 32507: 8316: arg_types = MALLOC_N(Scheme_Object*, sz);
8322 32507: 8317: arg_type_contributors = MALLOC_N_ATOMIC(short, sz);
8323 32507: 8318: memcpy(arg_types, cl->arg_types, sz * sizeof(Scheme_Object*));
8324 32507: 8319: memcpy(arg_type_contributors, cl->arg_type_contributors, sz * sizeof(short));
8325 32507: 8320: cl->arg_types = arg_types;
8326 32507: 8321: cl->arg_type_contributors = arg_type_contributors;
8327 -: 8322: }
8328 -: 8323:
8329 91889: 8324: if (cl->base_closure && var_map->count) {
8330 -: 8325: int i;
8331 63100: 8326: ht = scheme_make_hash_table(SCHEME_hash_ptr);
8332 441140: 8327: for (i = 0; i < cl->base_closure->size; i++) {
8333 378040: 8328: if (cl->base_closure->vals[i]) {
8334 118681: 8329: var = scheme_hash_tree_get(var_map, cl->base_closure->keys[i]);
8335 204339: 8330: scheme_hash_set(ht,
8336 -: 8331: (var
8337 -: 8332: ? var
8338 85658: 8333: : cl->base_closure->keys[i]),
8339 118681: 8334: cl->base_closure->vals[i]);
8340 -: 8335: }
8341 -: 8336: }
8342 63100: 8337: cl->base_closure = ht;
8343 -: 8338: }
8344 -: 8339:
8345 91889: 8340: return (Scheme_Object *)lam2;
8346 -: 8341:}
8347 -: 8342:
8348 217890: 8343:static int lambda_body_size_plus_info(Scheme_Lambda *lam, int check_assign,
8349 -: 8344: Optimize_Info *info, int *is_leaf)
8350 -: 8345:{
8351 -: 8346: int i;
8352 -: 8347: Scheme_IR_Lambda_Info *cl;
8353 -: 8348:
8354 217890: 8349: cl = lam->ir_info;
8355 -: 8350:
8356 217890: 8351: if (check_assign) {
8357 -: 8352: /* Don't try to inline if any arguments are mutated: */
8358 774805: 8353: for (i = lam->num_params; i--; ) {
8359 375079: 8354: if (cl->vars[i]->mutated)
8360 26: 8355: return -1;
8361 -: 8356: }
8362 -: 8357: }
8363 -: 8358:
8364 217864: 8359: if (is_leaf)
8365 158439: 8360: *is_leaf = !cl->has_nonleaf;
8366 -: 8361:
8367 217864: 8362: return cl->body_size + ((info && info->use_psize) ? cl->body_psize : 0);
8368 -: 8363:}
8369 -: 8364:
8370 #####: 8365:static int lambda_has_top_level(Scheme_Lambda *lam)
8371 -: 8366:{
8372 #####: 8367: return lam->ir_info->has_tl;
8373 -: 8368:}
8374 -: 8369:
8375 -: 8370:/*========================================================================*/
8376 -: 8371:/* modules */
8377 -: 8372:/*========================================================================*/
8378 -: 8373:
8379 5613: 8374:static int set_code_closure_flags(Scheme_Object *clones,
8380 -: 8375: int set_flags, int mask_flags,
8381 -: 8376: int just_tentative)
8382 -: 8377:{
8383 -: 8378: Scheme_Object *clone, *orig, *first;
8384 5613: 8379: int flags = LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS;
8385 -: 8380:
8386 -: 8381: /* The first in a clone pair is the one that is consulted for
8387 -: 8382: references. The second one is the original, and its the one whose
8388 -: 8383: flags are updated by optimization. So consult the original, and set
8389 -: 8384: flags in both. */
8390 -: 8385:
8391 26499: 8386: while (clones) {
8392 15273: 8387: first = SCHEME_CAR(clones);
8393 15273: 8388: clone = SCHEME_CAR(first);
8394 15273: 8389: orig = SCHEME_CDR(first);
8395 -: 8390:
8396 15273: 8391: flags = set_one_code_flags(orig, flags,
8397 -: 8392: orig, clone,
8398 -: 8393: set_flags, mask_flags, just_tentative,
8399 -: 8394: 0);
8400 -: 8395:
8401 15273: 8396: clones = SCHEME_CDR(clones);
8402 -: 8397: }
8403 -: 8398:
8404 5613: 8399: return flags;
8405 -: 8400:}
8406 -: 8401:
8407 7359: 8402:static Scheme_Object *is_cross_module_inline_candidiate(Scheme_Object *e, Optimize_Info *info,
8408 -: 8403: int size_override)
8409 -: 8404:{
8410 7359: 8405: if (SCHEME_LAMBDAP(e)) {
8411 5365: 8406: if (size_override || (lambda_body_size(e, 1) < CROSS_MODULE_INLINE_SIZE))
8412 1237: 8407: return optimize_clone(0, e, info, empty_eq_hash_tree, 0);
8413 -: 8408: }
8414 -: 8409:
8415 6122: 8410: return NULL;
8416 -: 8411:}
8417 -: 8412:
8418 8385: 8413:static int is_general_lambda(Scheme_Object *e, Optimize_Info *info)
8419 -: 8414:{
8420 -: 8415: /* recognize (begin <omitable>* <proc>) */
8421 8385: 8416: if (SCHEME_TYPE(e) == scheme_sequence_type) {
8422 13: 8417: Scheme_Sequence *seq = (Scheme_Sequence *)e;
8423 13: 8418: if (seq->count > 0) {
8424 -: 8419: int i;
8425 26: 8420: for (i = seq->count - 1; i--; ) {
8426 13: 8421: if (!scheme_omittable_expr(seq->array[i], -1, 20, 0, info, NULL))
8427 13: 8422: return 0;
8428 -: 8423: }
8429 -: 8424: }
8430 #####: 8425: e = seq->array[seq->count - 1];
8431 -: 8426: }
8432 -: 8427:
8433 -: 8428: /* recognize (let ([x <proc>]) x) */
8434 8372: 8429: if (SCHEME_TYPE(e) == scheme_ir_let_header_type) {
8435 1315: 8430: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)e;
8436 1315: 8431: if (!(SCHEME_LET_FLAGS(lh) & SCHEME_LET_RECURSIVE)
8437 1314: 8432: && (lh->count == 1)
8438 575: 8433: && (lh->num_clauses == 1)
8439 575: 8434: && SAME_TYPE(SCHEME_TYPE(lh->body), scheme_ir_let_value_type)) {
8440 575: 8435: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)lh->body;
8441 575: 8436: if (SCHEME_LAMBDAP(lv->value))
8442 315: 8437: return SAME_OBJ(lv->body, (Scheme_Object *)lv->vars[0]);
8443 -: 8438: }
8444 -: 8439: }
8445 -: 8440:
8446 8057: 8441: if (SCHEME_LAMBDAP(e))
8447 5061: 8442: return 1;
8448 -: 8443:
8449 2996: 8444: return 0;
8450 -: 8445:}
8451 -: 8446:
8452 50: 8447:void install_definition(Scheme_Object *vec, int pos, Scheme_Object *var, Scheme_Object *rhs)
8453 -: 8448:{
8454 -: 8449: Scheme_Object *def;
8455 -: 8450:
8456 50: 8451: var = scheme_make_pair(var, scheme_null);
8457 50: 8452: def = scheme_make_vector(2, NULL);
8458 50: 8453: SCHEME_VEC_ELS(def)[0] = var;
8459 50: 8454: SCHEME_VEC_ELS(def)[1] = rhs;
8460 50: 8455: def->type = scheme_define_values_type;
8461 -: 8456:
8462 50: 8457: SCHEME_VEC_ELS(vec)[pos] = def;
8463 50: 8458:}
8464 -: 8459:
8465 1092: 8460:int split_define_values(Scheme_Object *e, int n, Scheme_Object *vars, Scheme_Object *vec, int offset)
8466 -: 8461:{
8467 1729: 8462: if (SAME_TYPE(SCHEME_TYPE(e), scheme_ir_let_header_type)) {
8468 -: 8463: /* This is a tedious case to recognize the pattern
8469 -: 8464: (let ([x rhs] ...) (values x ...))
8470 -: 8465: which might be the result of expansion that involved a local
8471 -: 8466: macro to define the `x's */
8472 653: 8467: Scheme_IR_Let_Header *lh = (Scheme_IR_Let_Header *)e;
8473 653: 8468: if ((lh->count == n) && (lh->num_clauses == n)
8474 16: 8469: && !(SCHEME_LET_FLAGS(lh) & SCHEME_LET_RECURSIVE)) {
8475 16: 8470: Scheme_Object *body = lh->body;
8476 -: 8471: int i;
8477 68: 8472: for (i = 0; i < n; i++) {
8478 104: 8473: if (SAME_TYPE(SCHEME_TYPE(body), scheme_ir_let_value_type)) {
8479 52: 8474: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)body;
8480 52: 8475: if (lv->count == 1) {
8481 52: 8476: if (!scheme_omittable_expr(lv->value, 1, 5, 0, NULL, NULL))
8482 #####: 8477: return 0;
8483 52: 8478: body = lv->body;
8484 -: 8479: } else
8485 #####: 8480: return 0;
8486 -: 8481: } else
8487 #####: 8482: return 0;
8488 -: 8483: }
8489 16: 8484: if ((n == 2) && SAME_TYPE(SCHEME_TYPE(body), scheme_application3_type)) {
8490 4: 8485: Scheme_App3_Rec *app = (Scheme_App3_Rec *)body;
8491 4: 8486: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)lh->body;
8492 4: 8487: if (SAME_OBJ(app->rator, scheme_values_proc)
8493 4: 8488: && SAME_OBJ(app->rand1, (Scheme_Object *)lv->vars[0])
8494 4: 8489: && SAME_OBJ(app->rand2, (Scheme_Object *)((Scheme_IR_Let_Value *)lv->body)->vars[0])) {
8495 4: 8490: if (vars) {
8496 2: 8491: install_definition(vec, offset, SCHEME_CAR(vars), lv->value);
8497 2: 8492: vars = SCHEME_CDR(vars);
8498 2: 8493: lv = (Scheme_IR_Let_Value *)lv->body;
8499 2: 8494: install_definition(vec, offset+1, SCHEME_CAR(vars), lv->value);
8500 -: 8495: }
8501 4: 8496: return 1;
8502 -: 8497: }
8503 12: 8498: } else if (SAME_TYPE(SCHEME_TYPE(body), scheme_application_type)
8504 12: 8499: && ((Scheme_App_Rec *)body)->num_args == n) {
8505 12: 8500: Scheme_App_Rec *app = (Scheme_App_Rec *)body;
8506 12: 8501: Scheme_IR_Let_Value *lv = (Scheme_IR_Let_Value *)lh->body;
8507 12: 8502: if (SAME_OBJ(app->args[0], scheme_values_proc)) {
8508 56: 8503: for (i = 0; i < n; i++) {
8509 44: 8504: if (!SAME_TYPE(SCHEME_TYPE(app->args[i+1]), scheme_ir_local_type)
8510 44: 8505: || !SAME_OBJ((Scheme_Object *)lv->vars[0], app->args[i+1]))
8511 #####: 8506: return 0;
8512 44: 8507: lv = (Scheme_IR_Let_Value *)lv->body;
8513 -: 8508: }
8514 12: 8509: if (vars) {
8515 6: 8510: body = lh->body;
8516 28: 8511: for (i = 0; i < n; i++) {
8517 22: 8512: Scheme_IR_Let_Value *lv2 = (Scheme_IR_Let_Value *)body;
8518 22: 8513: install_definition(vec, offset+i, SCHEME_CAR(vars), lv2->value);
8519 22: 8514: vars = SCHEME_CDR(vars);
8520 22: 8515: body = lv2->body;
8521 -: 8516: }
8522 -: 8517: }
8523 12: 8518: return 1;
8524 -: 8519: }
8525 -: 8520: }
8526 -: 8521: }
8527 439: 8522: } else if ((n == 2) && SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
8528 4: 8523: Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
8529 4: 8524: if (SAME_OBJ(app->rator, scheme_values_proc)
8530 4: 8525: && scheme_omittable_expr(app->rand1, 1, 5, 0, NULL, NULL)
8531 4: 8526: && scheme_omittable_expr(app->rand2, 1, 5, 0, NULL, NULL)) {
8532 4: 8527: if (vars) {
8533 2: 8528: install_definition(vec, offset, SCHEME_CAR(vars), app->rand1);
8534 2: 8529: vars = SCHEME_CDR(vars);
8535 2: 8530: install_definition(vec, offset+1, SCHEME_CAR(vars), app->rand2);
8536 -: 8531: }
8537 4: 8532: return 1;
8538 -: 8533: }
8539 435: 8534: } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)
8540 344: 8535: && ((Scheme_App_Rec *)e)->num_args == n) {
8541 37: 8536: Scheme_App_Rec *app = (Scheme_App_Rec *)e;
8542 37: 8537: if (SAME_OBJ(app->args[0], scheme_values_proc)) {
8543 -: 8538: int i;
8544 52: 8539: for (i = 0; i < n; i++) {
8545 40: 8540: if (!scheme_omittable_expr(app->args[i+1], 1, 5, 0, NULL, NULL))
8546 #####: 8541: return 0;
8547 -: 8542: }
8548 12: 8543: if (vars) {
8549 26: 8544: for (i = 0; i < n; i++) {
8550 20: 8545: install_definition(vec, offset+i, SCHEME_CAR(vars), app->args[i+1]);
8551 20: 8546: vars = SCHEME_CDR(vars);
8552 -: 8547: }
8553 -: 8548: }
8554 12: 8549: return 1;
8555 -: 8550: }
8556 -: 8551: }
8557 -: 8552:
8558 1060: 8553: return 0;
8559 -: 8554:}
8560 -: 8555:
8561 2076: 8556:static Scheme_Hash_Table *set_as_fixed(Scheme_Hash_Table *fixed_table, Optimize_Info *info, int pos)
8562 -: 8557:{
8563 2076: 8558: if (!fixed_table) {
8564 410: 8559: fixed_table = scheme_make_hash_table(SCHEME_hash_ptr);
8565 410: 8560: if (!info->top_level_consts) {
8566 -: 8561: Scheme_Hash_Table *consts;
8567 181: 8562: consts = scheme_make_hash_table(SCHEME_hash_ptr);
8568 181: 8563: info->top_level_consts = consts;
8569 -: 8564: }
8570 410: 8565: scheme_hash_set(info->top_level_consts, scheme_false, (Scheme_Object *)fixed_table);
8571 -: 8566: }
8572 -: 8567:
8573 2076: 8568: scheme_hash_set(fixed_table, scheme_make_integer(pos), scheme_true);
8574 -: 8569:
8575 2076: 8570: return fixed_table;
8576 -: 8571:}
8577 -: 8572:
8578 -: 8573:static Scheme_Object *
8579 6331: 8574:module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
8580 -: 8575:{
8581 6331: 8576: Scheme_Module *m = (Scheme_Module *)data;
8582 -: 8577: Scheme_Object *e, *vars, *old_context;
8583 6331: 8578: int start_simultaneous = 0, i_m, cnt;
8584 6331: 8579: Scheme_Object *cl_first = NULL, *cl_last = NULL;
8585 6331: 8580: Scheme_Hash_Table *consts = NULL, *fixed_table = NULL, *re_consts = NULL;
8586 6331: 8581: Scheme_Hash_Table *originals = NULL;
8587 6331: 8582: int cont, next_pos_ready = -1, inline_fuel, is_proc_def;
8588 -: 8583: Comp_Prefix *prev_cp;
8589 -: 8584: Optimize_Info *limited_info;
8590 -: 8585: Optimize_Info_Sequence info_seq;
8591 -: 8586:
8592 6331: 8587: if (!m->comp_prefix) {
8593 -: 8588: /* already resolved */
8594 1586: 8589: return (Scheme_Object *)m;
8595 -: 8590: }
8596 -: 8591:
8597 4745: 8592: if (m->phaseless) {
8598 5: 8593: scheme_log(info->logger,
8599 -: 8594: SCHEME_LOG_DEBUG,
8600 -: 8595: 0,
8601 -: 8596: "compilation of cross-phase persistent module: %D",
8602 -: 8597: m->modname);
8603 -: 8598: }
8604 -: 8599:
8605 4745: 8600: old_context = info->context;
8606 4745: 8601: info->context = (Scheme_Object *)m;
8607 -: 8602:
8608 4745: 8603: optimize_info_seq_init(info, &info_seq);
8609 -: 8604:
8610 4745: 8605: prev_cp = info->cp;
8611 4745: 8606: info->cp = m->comp_prefix;
8612 -: 8607:
8613 -: 8608: /* Use `limited_info` for optimization decisions that need to be
8614 -: 8609: rediscovered by the validator. The validator knows shape
8615 -: 8610: information for imported variables, and it knows about structure
8616 -: 8611: bindings for later forms. */
8617 4745: 8612: limited_info = MALLOC_ONE_RT(Optimize_Info);
8618 -: 8613:#ifdef MZTAG_REQUIRED
8619 -: 8614: limited_info->type = scheme_rt_optimize_info;
8620 -: 8615:#endif
8621 4745: 8616: limited_info->cp = info->cp;
8622 -: 8617:
8623 4745: 8618: cnt = SCHEME_VEC_SIZE(m->bodies[0]);
8624 -: 8619:
8625 -: 8620: /* First, flatten `(define-values (x ...) (values e ...))'
8626 -: 8621: to `(define (x) e) ...' when possible. */
8627 -: 8622: {
8628 4745: 8623: int inc = 0;
8629 16872: 8624: for (i_m = 0; i_m < cnt; i_m++) {
8630 12127: 8625: e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
8631 12127: 8626: if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
8632 -: 8627: int n;
8633 8351: 8628: vars = SCHEME_VEC_ELS(e)[0];
8634 8351: 8629: n = scheme_list_length(vars);
8635 8351: 8630: if (n > 1) {
8636 1072: 8631: e = SCHEME_VEC_ELS(e)[1];
8637 1072: 8632: if (split_define_values(e, n, NULL, NULL, 0))
8638 16: 8633: inc += (n - 1);
8639 -: 8634: }
8640 -: 8635: }
8641 -: 8636: }
8642 -: 8637:
8643 4745: 8638: if (inc > 0) {
8644 -: 8639: Scheme_Object *new_vec;
8645 16: 8640: int j = 0;
8646 16: 8641: new_vec = scheme_make_vector(cnt+inc, NULL);
8647 132: 8642: for (i_m = 0; i_m < cnt; i_m++) {
8648 116: 8643: e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
8649 232: 8644: if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
8650 -: 8645: int n;
8651 116: 8646: vars = SCHEME_VEC_ELS(e)[0];
8652 116: 8647: n = scheme_list_length(vars);
8653 116: 8648: if (n > 1) {
8654 20: 8649: if (split_define_values(SCHEME_VEC_ELS(e)[1], n, vars, new_vec, j)) {
8655 16: 8650: j += n;
8656 -: 8651: } else
8657 4: 8652: SCHEME_VEC_ELS(new_vec)[j++] = e;
8658 -: 8653: } else
8659 96: 8654: SCHEME_VEC_ELS(new_vec)[j++] = e;
8660 -: 8655: } else
8661 #####: 8656: SCHEME_VEC_ELS(new_vec)[j++] = e;
8662 -: 8657: }
8663 16: 8658: cnt += inc;
8664 16: 8659: m->bodies[0] = new_vec;
8665 -: 8660: }
8666 -: 8661: }
8667 -: 8662:
8668 -: 8663: if (OPT_ESTIMATE_FUTURE_SIZES) {
8669 4745: 8664: if (info->enforce_const) {
8670 -: 8665: /* For each identifier bound to a procedure, register an initial
8671 -: 8666: size estimate, which is used to discourage early loop unrolling
8672 -: 8667: at the expense of later inlining. */
8673 16906: 8668: for (i_m = 0; i_m < cnt; i_m++) {
8674 12161: 8669: e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
8675 12161: 8670: if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
8676 -: 8671: int n;
8677 -: 8672:
8678 8385: 8673: vars = SCHEME_VEC_ELS(e)[0];
8679 8385: 8674: e = SCHEME_VEC_ELS(e)[1];
8680 -: 8675:
8681 8385: 8676: n = scheme_list_length(vars);
8682 8385: 8677: if ((n == 1) && SCHEME_LAMBDAP(e)) {
8683 -: 8678: Scheme_Toplevel *tl;
8684 -: 8679:
8685 5061: 8680: tl = (Scheme_Toplevel *)SCHEME_CAR(vars);
8686 -: 8681:
8687 5061: 8682: if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) {
8688 -: 8683: int pos;
8689 5061: 8684: if (!consts)
8690 1020: 8685: consts = scheme_make_hash_table(SCHEME_hash_ptr);
8691 5061: 8686: pos = tl->position;
8692 10122: 8687: scheme_hash_set(consts,
8693 5061: 8688: scheme_make_integer(pos),
8694 -: 8689: estimate_closure_size(e));
8695 -: 8690: }
8696 -: 8691: }
8697 -: 8692: }
8698 -: 8693: }
8699 -: 8694:
8700 4745: 8695: if (consts) {
8701 1020: 8696: info->top_level_consts = consts;
8702 1020: 8697: consts = NULL;
8703 -: 8698: }
8704 -: 8699: }
8705 -: 8700: }
8706 -: 8701:
8707 16906: 8702: for (i_m = 0; i_m < cnt; i_m++) {
8708 -: 8703: /* Optimize this expression: */
8709 12161: 8704: e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
8710 -: 8705:
8711 12161: 8706: is_proc_def = 0;
8712 12161: 8707: if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) {
8713 12161: 8708: if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
8714 -: 8709: Scheme_Object *e2;
8715 8385: 8710: e2 = SCHEME_VEC_ELS(e)[1];
8716 8385: 8711: if (is_general_lambda(e2, info))
8717 5190: 8712: is_proc_def = 1;
8718 -: 8713: }
8719 -: 8714: }
8720 -: 8715:
8721 12161: 8716: if (is_proc_def && OPT_DISCOURAGE_EARLY_INLINE) {
8722 5190: 8717: info->use_psize = 1;
8723 5190: 8718: inline_fuel = info->inline_fuel;
8724 5190: 8719: if (inline_fuel > 2)
8725 5190: 8720: info->inline_fuel = 2;
8726 -: 8721: } else
8727 6971: 8722: inline_fuel = 0;
8728 12161: 8723: optimize_info_seq_step(info, &info_seq);
8729 12161: 8724: e = scheme_optimize_expr(e, info, 0);
8730 12161: 8725: if (is_proc_def && OPT_DISCOURAGE_EARLY_INLINE) {
8731 5190: 8726: info->use_psize = 0;
8732 5190: 8727: info->inline_fuel = inline_fuel;
8733 -: 8728: }
8734 12161: 8729: SCHEME_VEC_ELS(m->bodies[0])[i_m] = e;
8735 -: 8730:
8736 12161: 8731: if (info->enforce_const) {
8737 -: 8732: /* If this expression/definition can't have any side effect
8738 -: 8733: (including raising an exception), then continue the group of
8739 -: 8734: simultaneous definitions: */
8740 20546: 8735: if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
8741 8385: 8736: int n, cnst = 0, sproc = 0, sprop = 0, has_guard = 0;
8742 8385: 8737: Scheme_Object *sstruct = NULL, *parent_identity = NULL;
8743 -: 8738: Simple_Stuct_Type_Info stinfo;
8744 -: 8739:
8745 8385: 8740: vars = SCHEME_VEC_ELS(e)[0];
8746 8385: 8741: e = SCHEME_VEC_ELS(e)[1];
8747 -: 8742:
8748 8385: 8743: n = scheme_list_length(vars);
8749 8385: 8744: cont = scheme_omittable_expr(e, n, -1,
8750 -: 8745: /* ignore APPN_FLAG_OMITTABLE, because the
8751 -: 8746: validator won't be able to reconstruct it
8752 -: 8747: in general; also, don't recognize struct-type
8753 -: 8748: functions, since they weren't recognized
8754 -: 8749: as immediate calls */
8755 -: 8750: (OMITTABLE_IGNORE_APPN_OMIT
8756 -: 8751: | OMITTABLE_IGNORE_MAKE_STRUCT_TYPE),
8757 -: 8752: /* similarly, use `limited_info` instead of `info'
8758 -: 8753: here, because the decision
8759 -: 8754: of omittable should not depend on
8760 -: 8755: information that's only available at
8761 -: 8756: optimization time: */
8762 -: 8757: limited_info,
8763 -: 8758: info);
8764 -: 8759:
8765 8385: 8760: if (n == 1) {
8766 7329: 8761: if (scheme_ir_propagate_ok(e, info))
8767 5520: 8762: cnst = 1;
8768 1809: 8763: else if (scheme_is_statically_proc(e, info, OMITTABLE_IGNORE_APPN_OMIT)) {
8769 312: 8764: cnst = 1;
8770 312: 8765: sproc = 1;
8771 -: 8766: }
8772 1056: 8767: } else if (scheme_is_simple_make_struct_type(e, n, 0, NULL,
8773 -: 8768: &stinfo, &parent_identity,
8774 -: 8769: info->top_level_consts,
8775 1056: 8770: info->cp->inline_variants,
8776 -: 8771: NULL, NULL, 0, NULL, NULL,
8777 -: 8772: &sstruct,
8778 -: 8773: 5)) {
8779 532: 8774: sstruct = scheme_make_pair(sstruct, parent_identity);
8780 532: 8775: cnst = 1;
8781 524: 8776: } else if (scheme_is_simple_make_struct_type_property(e, n, 0,
8782 -: 8777: &has_guard,
8783 -: 8778: info->top_level_consts,
8784 524: 8779: info->cp->inline_variants,
8785 -: 8780: NULL, NULL, 0, NULL, NULL,
8786 -: 8781: 5)) {
8787 79: 8782: sprop = 1;
8788 79: 8783: cnst = 1;
8789 -: 8784: } else
8790 445: 8785: sstruct = NULL;
8791 -: 8786:
8792 8385: 8787: if ((sstruct || sprop) && !cont) {
8793 -: 8788: /* Since the `make-struct-type` or `make-struct-tye-property` form is immediate
8794 -: 8789: enough that the validator can see it, re-check whether we can continue
8795 -: 8790: a group of simultaneously defined variables. */
8796 611: 8791: cont = scheme_omittable_expr(e, n, 5, OMITTABLE_IGNORE_APPN_OMIT, limited_info, NULL);
8797 -: 8792: }
8798 -: 8793:
8799 8385: 8794: if (cnst) {
8800 -: 8795: Scheme_Toplevel *tl;
8801 -: 8796: int i;
8802 15232: 8797: for (i = 0; i < n; i++) {
8803 8789: 8798: tl = (Scheme_Toplevel *)SCHEME_CAR(vars);
8804 8789: 8799: vars = SCHEME_CDR(vars);
8805 -: 8800:
8806 8789: 8801: if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) {
8807 -: 8802: Scheme_Object *e2;
8808 -: 8803:
8809 8715: 8804: if (sstruct) {
8810 2720: 8805: e2 = scheme_make_struct_proc_shape(scheme_get_struct_proc_shape(i, &stinfo),
8811 -: 8806: sstruct);
8812 5995: 8807: } else if (sprop) {
8813 237: 8808: e2 = scheme_make_struct_property_proc_shape(scheme_get_struct_property_proc_shape(i, has_guard));
8814 5758: 8809: } else if (sproc) {
8815 312: 8810: e2 = scheme_make_noninline_proc(e);
8816 5446: 8811: } else if (SCHEME_LAMBDAP(e)) {
8817 5091: 8812: e2 = optimize_clone(1, e, info, empty_eq_hash_tree, 0);
8818 10182: 8813: if (e2) {
8819 -: 8814: Scheme_Object *pr;
8820 5091: 8815: pr = scheme_make_raw_pair(scheme_make_raw_pair(e2, e), NULL);
8821 5091: 8816: if (cl_last)
8822 3676: 8817: SCHEME_CDR(cl_last) = pr;
8823 -: 8818: else
8824 1415: 8819: cl_first = pr;
8825 5091: 8820: cl_last = pr;
8826 -: 8821: } else
8827 #####: 8822: e2 = scheme_make_noninline_proc(e);
8828 -: 8823: } else {
8829 355: 8824: e2 = e;
8830 -: 8825: }
8831 -: 8826:
8832 8715: 8827: if (e2) {
8833 -: 8828: int pos;
8834 8715: 8829: pos = tl->position;
8835 -: 8830:
8836 8715: 8831: consts = info->top_level_consts;
8837 8715: 8832: if (!consts) {
8838 157: 8833: consts = scheme_make_hash_table(SCHEME_hash_ptr);
8839 157: 8834: info->top_level_consts = consts;
8840 -: 8835: }
8841 8715: 8836: scheme_hash_set(consts, scheme_make_integer(pos), e2);
8842 -: 8837:
8843 8715: 8838: if (sstruct || sprop) {
8844 -: 8839: /* include in `limited_info` */
8845 2957: 8840: Scheme_Hash_Table *limited_consts = limited_info->top_level_consts;
8846 2957: 8841: if (!limited_consts) {
8847 207: 8842: limited_consts = scheme_make_hash_table(SCHEME_hash_ptr);
8848 207: 8843: limited_info->top_level_consts = limited_consts;
8849 -: 8844: }
8850 2957: 8845: scheme_hash_set(limited_consts, scheme_make_integer(pos), e2);
8851 -: 8846: }
8852 -: 8847:
8853 8715: 8848: if (sstruct || (SCHEME_TYPE(e2) > _scheme_ir_values_types_)) {
8854 -: 8849: /* No use re-optimizing */
8855 -: 8850: } else {
8856 5107: 8851: if (!re_consts)
8857 1418: 8852: re_consts = scheme_make_hash_table(SCHEME_hash_ptr);
8858 5107: 8853: scheme_hash_set(re_consts, scheme_make_integer(i_m),
8859 5107: 8854: scheme_make_integer(pos));
8860 -: 8855: }
8861 -: 8856: } else {
8862 -: 8857: /* At least mark it as fixed */
8863 #####: 8858: fixed_table = set_as_fixed(fixed_table, info, tl->position);
8864 -: 8859: }
8865 -: 8860: }
8866 -: 8861: }
8867 -: 8862: } else {
8868 -: 8863: /* The binding is not inlinable/propagatable, but unless it's
8869 -: 8864: set!ed, it is constant after evaluating the definition. We
8870 -: 8865: map the top-level position to indicate constantness --- immediately
8871 -: 8866: if `cont`, and later if not. */
8872 -: 8867: Scheme_Object *l, *a;
8873 -: 8868: int pos;
8874 -: 8869:
8875 4976: 8870: for (l = vars; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
8876 3034: 8871: a = SCHEME_CAR(l);
8877 -: 8872:
8878 -: 8873: /* Test for set!: */
8879 3034: 8874: if (!(SCHEME_TOPLEVEL_FLAGS(a) & SCHEME_TOPLEVEL_MUTATED)) {
8880 3017: 8875: pos = SCHEME_TOPLEVEL_POS(a);
8881 -: 8876:
8882 3017: 8877: if (cont)
8883 459: 8878: fixed_table = set_as_fixed(fixed_table, info, pos);
8884 -: 8879: else
8885 2558: 8880: next_pos_ready = pos;
8886 -: 8881: }
8887 -: 8882: }
8888 -: 8883: }
8889 -: 8884: } else {
8890 3776: 8885: cont = scheme_omittable_expr(e, -1, -1, 0, NULL, NULL);
8891 -: 8886: }
8892 12161: 8887: if (i_m + 1 == cnt)
8893 4625: 8888: cont = 0;
8894 -: 8889: } else
8895 #####: 8890: cont = 1;
8896 -: 8891:
8897 12161: 8892: if (!cont) {
8898 6729: 8893: Scheme_Object *prop_later = NULL;
8899 -: 8894: /* If we have new constants, re-optimize to inline: */
8900 6729: 8895: if (consts) {
8901 -: 8896: int flags;
8902 -: 8897:
8903 -: 8898: /* Same as in letrec: assume LAMBDA_SINGLE_RESULT and
8904 -: 8899: LAMBDA_PRESERVES_MARKS for all, but then assume not for all
8905 -: 8900: if any turn out not (i.e., approximate fix point). */
8906 1871: 8901: (void)set_code_closure_flags(cl_first,
8907 -: 8902: LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_RESULT_TENTATIVE,
8908 -: 8903: 0xFFFF,
8909 -: 8904: 0);
8910 -: 8905:
8911 -: 8906: while (1) {
8912 -: 8907: /* Re-optimize this expression. */
8913 -: 8908: int old_sz, new_sz;
8914 -: 8909:
8915 7279: 8910: e = SCHEME_VEC_ELS(m->bodies[0])[start_simultaneous];
8916 -: 8911:
8917 -: 8912: if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE) {
8918 -: 8913: if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
8919 -: 8914: Scheme_Object *sub_e;
8920 -: 8915: sub_e = SCHEME_VEC_ELS(e)[1];
8921 -: 8916: old_sz = lambda_body_size(sub_e, 0);
8922 -: 8917: } else
8923 -: 8918: old_sz = 0;
8924 -: 8919: } else
8925 7279: 8920: old_sz = 0;
8926 -: 8921:
8927 7279: 8922: optimize_info_seq_step(info, &info_seq);
8928 7279: 8923: e = scheme_optimize_expr(e, info, 0);
8929 7279: 8924: SCHEME_VEC_ELS(m->bodies[0])[start_simultaneous] = e;
8930 -: 8925:
8931 7279: 8926: if (re_consts) {
8932 -: 8927: /* Install optimized closures into constant table ---
8933 -: 8928: unless, maybe, they grow too much: */
8934 -: 8929: Scheme_Object *rpos;
8935 6462: 8930: rpos = scheme_hash_get(re_consts, scheme_make_integer(start_simultaneous));
8936 6462: 8931: if (rpos) {
8937 -: 8932: Scheme_Object *old_e;
8938 -: 8933:
8939 5107: 8934: e = SCHEME_VEC_ELS(e)[1];
8940 -: 8935:
8941 5107: 8936: old_e = scheme_hash_get(info->top_level_consts, rpos);
8942 5107: 8937: if (old_e && SCHEME_LAMBDAP(old_e) && OPT_PRE_OPTIMIZE_FOR_CROSS_MODULE(1)) {
8943 5091: 8938: if (!originals)
8944 1038: 8939: originals = scheme_make_hash_table(SCHEME_hash_ptr);
8945 5091: 8940: scheme_hash_set(originals, scheme_make_integer(start_simultaneous), old_e);
8946 -: 8941: }
8947 -: 8942:
8948 5107: 8943: if (!scheme_ir_propagate_ok(e, info)
8949 520: 8944: && scheme_is_statically_proc(e, info, 0)) {
8950 -: 8945: /* If we previously installed a procedure for inlining,
8951 -: 8946: don't replace that with a worse approximation. */
8952 520: 8947: if (SCHEME_LAMBDAP(old_e))
8953 520: 8948: e = NULL;
8954 -: 8949: else
8955 #####: 8950: e = scheme_make_noninline_proc(e);
8956 -: 8951: }
8957 -: 8952:
8958 5107: 8953: if (e) {
8959 -: 8954: if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE)
8960 -: 8955: new_sz = lambda_body_size(e, 0);
8961 -: 8956: else
8962 4587: 8957: new_sz = 0;
8963 -: 8958:
8964 -: 8959: if (!old_sz
8965 -: 8960: || (new_sz <= old_sz)
8966 -: 8961: || (!OPT_DELAY_GROUP_PROPAGATE && !OPT_LIMIT_FUNCTION_RESIZE))
8967 4587: 8962: scheme_hash_set(info->top_level_consts, rpos, e);
8968 -: 8963: else if (!OPT_LIMIT_FUNCTION_RESIZE
8969 -: 8964: || (new_sz < 4 * old_sz))
8970 -: 8965: prop_later = scheme_make_raw_pair(scheme_make_pair(rpos, e), prop_later);
8971 -: 8966: }
8972 -: 8967: }
8973 -: 8968: }
8974 -: 8969:
8975 7279: 8970: if (start_simultaneous == i_m)
8976 1871: 8971: break;
8977 5408: 8972: start_simultaneous++;
8978 5408: 8973: }
8979 -: 8974:
8980 1871: 8975: flags = set_code_closure_flags(cl_first, 0, 0xFFFF, 0);
8981 1871: 8976: (void)set_code_closure_flags(cl_first,
8982 -: 8977: (flags & (LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS)),
8983 -: 8978: ~(LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_RESULT_TENTATIVE),
8984 -: 8979: 1);
8985 -: 8980: }
8986 -: 8981:
8987 6729: 8982: cl_last = cl_first = NULL;
8988 6729: 8983: consts = NULL;
8989 6729: 8984: re_consts = NULL;
8990 6729: 8985: start_simultaneous = i_m + 1;
8991 -: 8986:
8992 13458: 8987: while (prop_later) {
8993 #####: 8988: e = SCHEME_CAR(prop_later);
8994 #####: 8989: scheme_hash_set(info->top_level_consts, SCHEME_CAR(e), SCHEME_CDR(e));
8995 #####: 8990: prop_later = SCHEME_CDR(prop_later);
8996 -: 8991: }
8997 -: 8992: }
8998 -: 8993:
8999 12161: 8994: if (next_pos_ready > -1) {
9000 1617: 8995: fixed_table = set_as_fixed(fixed_table, info, next_pos_ready);
9001 1617: 8996: next_pos_ready = -1;
9002 -: 8997: }
9003 -: 8998: }
9004 -: 8999:
9005 -: 9000: /* For functions that are potentially inlineable, perhaps
9006 -: 9001: before optimization, insert inline_variant records: */
9007 4745: 9002: if (info->enforce_const) {
9008 16906: 9003: for (i_m = 0; i_m < cnt; i_m++) {
9009 -: 9004: /* Optimize this expression: */
9010 12161: 9005: e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
9011 12161: 9006: if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
9012 -: 9007: int size_override;
9013 8385: 9008: size_override = SCHEME_IMMUTABLEP(e);
9014 8385: 9009: vars = SCHEME_VEC_ELS(e)[0];
9015 8385: 9010: if (SCHEME_PAIRP(vars) && SCHEME_NULLP(SCHEME_CDR(vars))) {
9016 -: 9011: Scheme_Object *sub_e, *alt_e;
9017 7329: 9012: sub_e = SCHEME_VEC_ELS(e)[1];
9018 7329: 9013: alt_e = is_cross_module_inline_candidiate(sub_e, info, 0);
9019 7329: 9014: if (!alt_e && originals && OPT_PRE_OPTIMIZE_FOR_CROSS_MODULE(size_override)) {
9020 30: 9015: alt_e = scheme_hash_get(originals, scheme_make_integer(i_m));
9021 30: 9016: if (SAME_OBJ(alt_e, sub_e) && !size_override)
9022 #####: 9017: alt_e = NULL;
9023 30: 9018: else if (alt_e)
9024 30: 9019: alt_e = is_cross_module_inline_candidiate(alt_e, info, size_override);
9025 -: 9020: }
9026 7329: 9021: if (alt_e) {
9027 -: 9022: Scheme_Object *iv;
9028 1233: 9023: iv = scheme_make_vector(3, scheme_false);
9029 1233: 9024: iv->type = scheme_inline_variant_type;
9030 1233: 9025: SCHEME_VEC_ELS(iv)[0] = sub_e;
9031 1233: 9026: SCHEME_VEC_ELS(iv)[1] = alt_e;
9032 1233: 9027: SCHEME_VEC_ELS(e)[1] = iv;
9033 -: 9028: }
9034 -: 9029: }
9035 -: 9030: }
9036 -: 9031: }
9037 -: 9032: }
9038 -: 9033:
9039 -: 9034: /* Check one more time for expressions that we can omit: */
9040 -: 9035: {
9041 4745: 9036: int can_omit = 0;
9042 16906: 9037: for (i_m = 0; i_m < cnt; i_m++) {
9043 -: 9038: /* Optimize this expression: */
9044 12161: 9039: e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
9045 12161: 9040: if (scheme_omittable_expr(e, -1, -1, 0, info, NULL)) {
9046 #####: 9041: can_omit++;
9047 -: 9042: }
9048 -: 9043: }
9049 4745: 9044: if (can_omit) {
9050 -: 9045: Scheme_Object *vec;
9051 #####: 9046: int j = 0;
9052 #####: 9047: vec = scheme_make_vector(cnt - can_omit, NULL);
9053 #####: 9048: for (i_m = 0; i_m < cnt; i_m++) {
9054 -: 9049: /* Optimize this expression: */
9055 #####: 9050: e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
9056 #####: 9051: if (!scheme_omittable_expr(e, -1, -1, 0, info, NULL)) {
9057 #####: 9052: SCHEME_VEC_ELS(vec)[j++] = e;
9058 -: 9053: }
9059 -: 9054: }
9060 #####: 9055: m->bodies[0] = vec;
9061 -: 9056: }
9062 4745: 9057: cnt -= can_omit;
9063 -: 9058: }
9064 -: 9059:
9065 4745: 9060: info->context = old_context;
9066 4745: 9061: info->cp = prev_cp;
9067 -: 9062:
9068 -: 9063: /* Exp-time body was optimized during compilation */
9069 -: 9064:
9070 -: 9065: {
9071 -: 9066: /* optimize submodules */
9072 -: 9067: int k;
9073 -: 9068: Scheme_Object *p;
9074 14235: 9069: for (k = 0; k < 2; k++) {
9075 9490: 9070: p = (k ? m->post_submodules : m->pre_submodules);
9076 9490: 9071: if (p) {
9077 4680: 9072: while (!SCHEME_NULLP(p)) {
9078 1586: 9073: optimize_info_seq_step(info, &info_seq);
9079 1586: 9074: scheme_optimize_expr(SCHEME_CAR(p), info, 0);
9080 1586: 9075: p = SCHEME_CDR(p);
9081 -: 9076: }
9082 -: 9077: }
9083 -: 9078: }
9084 -: 9079: }
9085 -: 9080:
9086 4745: 9081: optimize_info_seq_done(info, &info_seq);
9087 -: 9082:
9088 4745: 9083: info->escapes = 0;
9089 -: 9084:
9090 4745: 9085: return data;
9091 -: 9086:}
9092 -: 9087:
9093 -: 9088:static Scheme_Object *
9094 51: 9089:top_level_require_optimize(Scheme_Object *data, Optimize_Info *info, int context)
9095 -: 9090:{
9096 51: 9091: return data;
9097 -: 9092:}
9098 -: 9093:
9099 -: 9094:/*========================================================================*/
9100 -: 9095:/* expressions */
9101 -: 9096:/*========================================================================*/
9102 -: 9097:
9103 #####: 9098:static Scheme_Object *optimize_k(void)
9104 -: 9099:{
9105 #####: 9100: Scheme_Thread *p = scheme_current_thread;
9106 #####: 9101: Scheme_Object *expr = (Scheme_Object *)p->ku.k.p1;
9107 #####: 9102: Optimize_Info *info = (Optimize_Info *)p->ku.k.p2;
9108 #####: 9103: int context = p->ku.k.i1;
9109 -: 9104:
9110 #####: 9105: p->ku.k.p1 = NULL;
9111 #####: 9106: p->ku.k.p2 = NULL;
9112 -: 9107:
9113 #####: 9108: return scheme_optimize_expr(expr, info, context);
9114 -: 9109:}
9115 -: 9110:
9116 4313896: 9111:Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, int context)
9117 -: 9112:{
9118 4313896: 9113: Scheme_Type type = SCHEME_TYPE(expr);
9119 -: 9114:
9120 -: 9115:#ifdef DO_STACK_CHECK
9121 -: 9116:# include "mzstkchk.h"
9122 -: 9117: {
9123 #####: 9118: Scheme_Thread *p = scheme_current_thread;
9124 -: 9119:
9125 #####: 9120: p->ku.k.p1 = (void *)expr;
9126 #####: 9121: p->ku.k.p2 = (void *)info;
9127 #####: 9122: p->ku.k.i1 = context;
9128 -: 9123:
9129 #####: 9124: return scheme_handle_stack_overflow(optimize_k);
9130 -: 9125: }
9131 -: 9126:#endif
9132 -: 9127:
9133 4313896: 9128: info->preserves_marks = 1;
9134 4313896: 9129: info->single_result = 1;
9135 4313896: 9130: info->escapes = 0;
9136 -: 9131:
9137 4313896: 9132: switch (type) {
9138 -: 9133: case scheme_ir_local_type:
9139 -: 9134: {
9140 -: 9135: Scheme_Object *val;
9141 -: 9136:
9142 1256435: 9137: info->size += 1;
9143 -: 9138:
9144 1256435: 9139: if (SCHEME_VAR(expr)->mutated) {
9145 3983: 9140: info->vclock += 1;
9146 3983: 9141: register_use(SCHEME_VAR(expr), info);
9147 3983: 9142: return expr;
9148 -: 9143: }
9149 -: 9144:
9150 1252452: 9145: val = optimize_info_propagate_local(expr);
9151 1252452: 9146: if (val) {
9152 181608: 9147: info->size -= 1;
9153 181608: 9148: return scheme_optimize_expr(val, info, context);
9154 -: 9149: }
9155 -: 9150:
9156 1070844: 9151: val = collapse_local(expr, info, context);
9157 1070844: 9152: if (val)
9158 1481: 9153: return val;
9159 -: 9154:
9160 1069363: 9155: if (!(context & OPT_CONTEXT_NO_SINGLE)) {
9161 1069363: 9156: val = SCHEME_VAR(expr)->optimize.known_val;
9162 -: 9157:
9163 1069363: 9158: if (val && SAME_TYPE(SCHEME_TYPE(val), scheme_once_used_type)) {
9164 82975: 9159: Scheme_Once_Used *o = (Scheme_Once_Used *)val;
9165 -: 9160:
9166 -: 9161: MZ_ASSERT(!o->moved);
9167 -: 9162: MZ_ASSERT(!SCHEME_VAR(expr)->optimize_outside_binding);
9168 -: 9163:
9169 -: 9164: /* In case this variable was tentatively used before: */
9170 82975: 9165: SCHEME_VAR(expr)->optimize_used = 0;
9171 -: 9166:
9172 82975: 9167: if (((o->vclock == info->vclock)
9173 15677: 9168: && ((o->aclock == info->aclock)
9174 189: 9169: || !o->spans_k)
9175 15600: 9170: && ((context & OPT_CONTEXT_SINGLED)
9176 36: 9171: || single_valued_noncm_expression(o->expr, 5)))
9177 202131: 9172: || movable_expression(o->expr, info,
9178 67377: 9173: o->var->optimize.lambda_depth != info->lambda_depth,
9179 67377: 9174: o->kclock != info->kclock,
9180 67377: 9175: o->sclock != info->sclock,
9181 -: 9176: 0, 5)) {
9182 38161: 9177: int save_fuel = info->inline_fuel, save_no_types = info->no_types;
9183 -: 9178: int save_vclock, save_aclock, save_kclock, save_sclock;
9184 38161: 9179: info->size -= 1;
9185 38161: 9180: info->inline_fuel = 0; /* no more inlining; o->expr was already optimized */
9186 38161: 9181: info->no_types = 1; /* cannot used inferred types, in case `val' inferred them */
9187 38161: 9182: save_vclock = info->vclock; /* allowed to move => no change to clocks */
9188 38161: 9183: save_aclock = info->aclock;
9189 38161: 9184: save_kclock = info->kclock;
9190 38161: 9185: save_sclock = info->sclock;
9191 -: 9186:
9192 38161: 9187: o->moved = 1;
9193 -: 9188:
9194 38161: 9189: val = scheme_optimize_expr(o->expr, info, context);
9195 -: 9190:
9196 38161: 9191: if (info->maybe_values_argument) {
9197 -: 9192: /* Although `val` could be counted as taking 0 time, we advance
9198 -: 9193: the clock conservatively to be consistent with `values`
9199 -: 9194: splitting. */
9200 4162: 9195: advance_clocks_for_optimized(val,
9201 -: 9196: &save_vclock, &save_aclock, &save_kclock, &save_sclock,
9202 -: 9197: info,
9203 -: 9198: ADVANCE_CLOCKS_INIT_FUEL);
9204 -: 9199: }
9205 -: 9200:
9206 38161: 9201: info->inline_fuel = save_fuel;
9207 38161: 9202: info->no_types = save_no_types;
9208 38161: 9203: info->vclock = save_vclock;
9209 38161: 9204: info->aclock = save_aclock;
9210 38161: 9205: info->kclock = save_kclock;
9211 38161: 9206: info->sclock = save_sclock;
9212 38161: 9207: return val;
9213 -: 9208: }
9214 -: 9209: }
9215 -: 9210: }
9216 -: 9211:
9217 -: 9212: /* If everything fails, mark it as used. */
9218 1031202: 9213: if (OPT_CONTEXT_TYPE(context))
9219 722: 9214: SCHEME_VAR(expr)->arg_type = OPT_CONTEXT_TYPE(context);
9220 1031202: 9215: if (info->kclock > SCHEME_VAR(expr)->optimize.init_kclock)
9221 548376: 9216: SCHEME_VAR(expr)->escapes_after_k_tick = 1;
9222 1031202: 9217: register_use(SCHEME_VAR(expr), info);
9223 1031202: 9218: return expr;
9224 -: 9219: }
9225 -: 9220: case scheme_application_type:
9226 162027: 9221: return optimize_application(expr, info, context);
9227 -: 9222: case scheme_application2_type:
9228 548082: 9223: return optimize_application2(expr, info, context);
9229 -: 9224: case scheme_application3_type:
9230 298075: 9225: return optimize_application3(expr, info, context);
9231 -: 9226: case scheme_sequence_type:
9232 -: 9227: case scheme_splice_sequence_type:
9233 31869: 9228: return optimize_sequence(expr, info, context, 1);
9234 -: 9229: case scheme_branch_type:
9235 248868: 9230: return optimize_branch(expr, info, context);
9236 -: 9231: case scheme_with_cont_mark_type:
9237 3509: 9232: return optimize_wcm(expr, info, context);
9238 -: 9233: case scheme_ir_lambda_type:
9239 75380: 9234: if (context & OPT_CONTEXT_BOOLEAN)
9240 26: 9235: return scheme_true;
9241 -: 9236: else
9242 75354: 9237: return optimize_lambda(expr, info, context);
9243 -: 9238: case scheme_ir_let_header_type:
9244 190130: 9239: return optimize_lets(expr, info, context);
9245 -: 9240: case scheme_ir_toplevel_type:
9246 218436: 9241: info->size += 1;
9247 218436: 9242: if (info->top_level_consts) {
9248 -: 9243: int pos;
9249 -: 9244: Scheme_Object *c;
9250 -: 9245:
9251 -: 9246: while (1) {
9252 98399: 9247: pos = SCHEME_TOPLEVEL_POS(expr);
9253 98399: 9248: c = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos));
9254 98399: 9249: c = no_potential_size(c);
9255 98399: 9250: if (c && SAME_TYPE(SCHEME_TYPE(c), scheme_ir_toplevel_type))
9256 25: 9251: expr = c;
9257 -: 9252: else
9258 -: 9253: break;
9259 25: 9254: }
9260 -: 9255:
9261 98374: 9256: if (c) {
9262 23322: 9257: if (context & OPT_CONTEXT_BOOLEAN)
9263 20: 9258: return (SCHEME_FALSEP(c) ? scheme_false : scheme_true);
9264 -: 9259:
9265 23302: 9260: if (scheme_ir_duplicate_ok(c, 0))
9266 361: 9261: return c;
9267 -: 9262:
9268 -: 9263: /* We can't inline, but mark the top level as a constant,
9269 -: 9264: so we can direct-jump and avoid null checks in JITed code: */
9270 22941: 9265: expr = scheme_toplevel_to_flagged_toplevel(expr, SCHEME_TOPLEVEL_CONST);
9271 -: 9266: } else {
9272 -: 9267: /* false is mapped to a table of non-constant ready values: */
9273 75052: 9268: c = scheme_hash_get(info->top_level_consts, scheme_false);
9274 75052: 9269: if (c) {
9275 52389: 9270: c = scheme_hash_get((Scheme_Hash_Table *)c, scheme_make_integer(pos));
9276 -: 9271:
9277 52389: 9272: if (c) {
9278 -: 9273: /* We can't inline, but mark the top level as ready and fixed,
9279 -: 9274: so we can avoid null checks in JITed code, etc: */
9280 7431: 9275: expr = scheme_toplevel_to_flagged_toplevel(expr, SCHEME_TOPLEVEL_FIXED);
9281 -: 9276: }
9282 -: 9277: }
9283 75052: 9278: if (!c)
9284 67621: 9279: info->vclock += 1;
9285 -: 9280: }
9286 -: 9281: } else {
9287 120062: 9282: info->vclock += 1;
9288 -: 9283: }
9289 218055: 9284: optimize_info_used_top(info);
9290 218055: 9285: return expr;
9291 -: 9286: case scheme_ir_quote_syntax_type:
9292 77011: 9287: if (context & OPT_CONTEXT_BOOLEAN)
9293 #####: 9288: return scheme_true;
9294 -: 9289: else {
9295 77011: 9290: info->size += 1;
9296 77011: 9291: optimize_info_used_top(info);
9297 -: 9292: }
9298 77011: 9293: return expr;
9299 -: 9294: case scheme_variable_type:
9300 -: 9295: case scheme_module_variable_type:
9301 #####: 9296: scheme_signal_error("got top-level in wrong place");
9302 #####: 9297: return 0;
9303 -: 9298: case scheme_define_values_type:
9304 16194: 9299: return define_values_optimize(expr, info, context);
9305 -: 9300: case scheme_varref_form_type:
9306 1114: 9301: return ref_optimize(expr, info, context);
9307 -: 9302: case scheme_set_bang_type:
9308 2845: 9303: return set_optimize(expr, info, context);
9309 -: 9304: case scheme_define_syntaxes_type:
9310 7: 9305: return define_syntaxes_optimize(expr, info, context);
9311 -: 9306: case scheme_begin_for_syntax_type:
9312 #####: 9307: return begin_for_syntax_optimize(expr, info, context);
9313 -: 9308: case scheme_case_lambda_sequence_type:
9314 2026: 9309: if (context & OPT_CONTEXT_BOOLEAN)
9315 #####: 9310: return scheme_true;
9316 -: 9311: else
9317 2026: 9312: return case_lambda_optimize(expr, info, context);
9318 -: 9313: case scheme_begin0_sequence_type:
9319 370: 9314: return begin0_optimize(expr, info, context);
9320 -: 9315: case scheme_apply_values_type:
9321 739: 9316: return apply_values_optimize(expr, info, context);
9322 -: 9317: case scheme_with_immed_mark_type:
9323 267: 9318: return with_immed_mark_optimize(expr, info, context);
9324 -: 9319: case scheme_require_form_type:
9325 51: 9320: return top_level_require_optimize(expr, info, context);
9326 -: 9321: case scheme_module_type:
9327 6331: 9322: return module_optimize(expr, info, context);
9328 -: 9323: default:
9329 1174130: 9324: info->size += 1;
9330 1174130: 9325: if ((context & OPT_CONTEXT_BOOLEAN)
9331 46459: 9326: && (SCHEME_TYPE(expr) > _scheme_ir_values_types_)
9332 46459: 9327: && SCHEME_TRUEP(expr))
9333 17041: 9328: return scheme_true;
9334 -: 9329: else
9335 1157089: 9330: return expr;
9336 -: 9331: }
9337 -: 9332:}
9338 -: 9333:
9339 179654: 9334:static void increment_use_count(Scheme_IR_Local *var, int as_rator)
9340 -: 9335:{
9341 179654: 9336: if (var->use_count < SCHEME_USE_COUNT_INF)
9342 98991: 9337: var->use_count++;
9343 179654: 9338: if (!as_rator && (var->non_app_count < SCHEME_USE_COUNT_INF))
9344 81127: 9339: var->non_app_count++;
9345 -: 9340:
9346 179654: 9341: if (var->optimize.known_val
9347 31047: 9342: && SAME_TYPE(SCHEME_TYPE(var->optimize.known_val), scheme_once_used_type))
9348 5398: 9343: var->optimize.known_val = NULL;
9349 179654: 9344:}
9350 -: 9345:
9351 2273029: 9346:Scheme_Object *optimize_clone(int single_use, Scheme_Object *expr, Optimize_Info *info, Scheme_Hash_Tree *var_map, int as_rator)
9352 -: 9347:/* If single_use is 1, then the old copy will be dropped --- so it's ok to "duplicate"
9353 -: 9348: any constant, and local-variable use counts should not be incremented. */
9354 -: 9349:{
9355 -: 9350: int t;
9356 -: 9351:
9357 2273029: 9352: t = SCHEME_TYPE(expr);
9358 -: 9353:
9359 2273029: 9354: switch(t) {
9360 -: 9355: case scheme_ir_local_type:
9361 -: 9356: {
9362 -: 9357: Scheme_Object *v;
9363 693424: 9358: v = scheme_hash_tree_get(var_map, expr);
9364 693424: 9359: if (v)
9365 565194: 9360: return v;
9366 128230: 9361: else if (!single_use)
9367 72013: 9362: increment_use_count(SCHEME_VAR(expr), as_rator);
9368 128230: 9363: return expr;
9369 -: 9364: }
9370 -: 9365: case scheme_application2_type:
9371 -: 9366: {
9372 313391: 9367: Scheme_App2_Rec *app = (Scheme_App2_Rec *)expr, *app2;
9373 -: 9368:
9374 313391: 9369: app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec);
9375 313391: 9370: app2->iso.so.type = scheme_application2_type;
9376 -: 9371:
9377 313391: 9372: expr = optimize_clone(single_use, app->rator, info, var_map, 1);
9378 313391: 9373: if (!expr) return NULL;
9379 313383: 9374: app2->rator = expr;
9380 -: 9375:
9381 313383: 9376: expr = optimize_clone(single_use, app->rand, info, var_map, 0);
9382 313383: 9377: if (!expr) return NULL;
9383 313121: 9378: app2->rand = expr;
9384 -: 9379:
9385 313121: 9380: SCHEME_APPN_FLAGS(app2) |= (SCHEME_APPN_FLAGS(app) & APPN_FLAG_MASK);
9386 313121: 9381: if (single_use)
9387 117822: 9382: SCHEME_APPN_FLAGS(app2) |= (SCHEME_APPN_FLAGS(app) & APPN_POSITION_MASK);
9388 -: 9383:
9389 313121: 9384: return (Scheme_Object *)app2;
9390 -: 9385: }
9391 -: 9386: case scheme_application_type:
9392 -: 9387: {
9393 78452: 9388: Scheme_App_Rec *app = (Scheme_App_Rec *)expr, *app2;
9394 -: 9389: int i;
9395 -: 9390:
9396 78452: 9391: app2 = scheme_malloc_application(app->num_args + 1);
9397 -: 9392:
9398 477190: 9393: for (i = app->num_args + 1; i--; ) {
9399 323652: 9394: expr = optimize_clone(single_use, app->args[i], info, var_map, !i);
9400 323652: 9395: if (!expr) return NULL;
9401 320286: 9396: app2->args[i] = expr;
9402 -: 9397: }
9403 -: 9398:
9404 75086: 9399: SCHEME_APPN_FLAGS(app2) |= (SCHEME_APPN_FLAGS(app) & APPN_FLAG_MASK);
9405 75086: 9400: if (single_use)
9406 29879: 9401: SCHEME_APPN_FLAGS(app2) |= (SCHEME_APPN_FLAGS(app) & APPN_POSITION_MASK);
9407 -: 9402:
9408 75086: 9403: return (Scheme_Object *)app2;
9409 -: 9404: }
9410 -: 9405: case scheme_application3_type:
9411 -: 9406: {
9412 162234: 9407: Scheme_App3_Rec *app = (Scheme_App3_Rec *)expr, *app2;
9413 -: 9408:
9414 162234: 9409: app2 = MALLOC_ONE_TAGGED(Scheme_App3_Rec);
9415 162234: 9410: app2->iso.so.type = scheme_application3_type;
9416 -: 9411:
9417 162234: 9412: expr = optimize_clone(single_use, app->rator, info, var_map, 1);
9418 162234: 9413: if (!expr) return NULL;
9419 162234: 9414: app2->rator = expr;
9420 -: 9415:
9421 162234: 9416: expr = optimize_clone(single_use, app->rand1, info, var_map, 0);
9422 162234: 9417: if (!expr) return NULL;
9423 161062: 9418: app2->rand1 = expr;
9424 -: 9419:
9425 161062: 9420: expr = optimize_clone(single_use, app->rand2, info, var_map, 0);
9426 161062: 9421: if (!expr) return NULL;
9427 159250: 9422: app2->rand2 = expr;
9428 -: 9423:
9429 159250: 9424: SCHEME_APPN_FLAGS(app2) |= (SCHEME_APPN_FLAGS(app) & APPN_FLAG_MASK);
9430 159250: 9425: if (single_use)
9431 56748: 9426: SCHEME_APPN_FLAGS(app2) |= (SCHEME_APPN_FLAGS(app) & APPN_POSITION_MASK);
9432 -: 9427:
9433 159250: 9428: return (Scheme_Object *)app2;
9434 -: 9429: }
9435 -: 9430: case scheme_ir_let_header_type:
9436 -: 9431: {
9437 76304: 9432: Scheme_IR_Let_Header *head = (Scheme_IR_Let_Header *)expr, *head2;
9438 -: 9433: Scheme_Object *body;
9439 76304: 9434: Scheme_IR_Let_Value *lv, *lv2, *prev = NULL;
9440 -: 9435: Scheme_IR_Local **vars;
9441 -: 9436: int i;
9442 -: 9437:
9443 76304: 9438: head2 = MALLOC_ONE_TAGGED(Scheme_IR_Let_Header);
9444 76304: 9439: head2->iso.so.type = scheme_ir_let_header_type;
9445 76304: 9440: head2->count = head->count;
9446 76304: 9441: head2->num_clauses = head->num_clauses;
9447 76304: 9442: SCHEME_LET_FLAGS(head2) = SCHEME_LET_FLAGS(head);
9448 -: 9443:
9449 -: 9444: /* Build let-value change: */
9450 76304: 9445: body = head->body;
9451 241830: 9446: for (i = head->num_clauses; i--; ) {
9452 89222: 9447: lv = (Scheme_IR_Let_Value *)body;
9453 -: 9448:
9454 89222: 9449: vars = clone_variable_array(lv->vars, lv->count, &var_map);
9455 -: 9450:
9456 89222: 9451: lv2 = MALLOC_ONE_TAGGED(Scheme_IR_Let_Value);
9457 89222: 9452: SCHEME_IRLV_FLAGS(lv2) |= (SCHEME_IRLV_FLAGS(lv) & 0x1);
9458 89222: 9453: lv2->iso.so.type = scheme_ir_let_value_type;
9459 89222: 9454: lv2->count = lv->count;
9460 89222: 9455: lv2->vars = vars;
9461 89222: 9456: lv2->value = lv->value;
9462 -: 9457:
9463 89222: 9458: if (prev)
9464 12918: 9459: prev->body = (Scheme_Object *)lv2;
9465 -: 9460: else
9466 76304: 9461: head2->body = (Scheme_Object *)lv2;
9467 89222: 9462: prev = lv2;
9468 -: 9463:
9469 89222: 9464: body = lv->body;
9470 -: 9465: }
9471 76304: 9466: if (prev)
9472 76304: 9467: prev->body = body;
9473 -: 9468: else
9474 #####: 9469: head2->body = body;
9475 -: 9470:
9476 76304: 9471: body = head2->body;
9477 240798: 9472: for (i = head->num_clauses; i--; ) {
9478 88992: 9473: lv2 = (Scheme_IR_Let_Value *)body;
9479 -: 9474:
9480 88992: 9475: expr = optimize_clone(single_use, lv2->value, info, var_map, 0);
9481 88992: 9476: if (!expr) return NULL;
9482 88190: 9477: lv2->value = expr;
9483 -: 9478:
9484 88190: 9479: body = lv2->body;
9485 -: 9480: }
9486 -: 9481:
9487 75502: 9482: expr = optimize_clone(single_use, body, info, var_map, 0);
9488 75502: 9483: if (!expr) return NULL;
9489 -: 9484:
9490 70776: 9485: if (prev)
9491 70776: 9486: prev->body = expr;
9492 -: 9487: else
9493 #####: 9488: head2->body = expr;
9494 -: 9489:
9495 70776: 9490: return (Scheme_Object *)head2;
9496 -: 9491: }
9497 -: 9492: case scheme_sequence_type:
9498 -: 9493: case scheme_begin0_sequence_type:
9499 -: 9494: case scheme_splice_sequence_type:
9500 -: 9495: {
9501 20305: 9496: Scheme_Sequence *seq = (Scheme_Sequence *)expr, *seq2;
9502 -: 9497: int i;
9503 -: 9498:
9504 20305: 9499: seq2 = scheme_malloc_sequence(seq->count);
9505 20305: 9500: seq2->so.type = seq->so.type;
9506 20305: 9501: seq2->count = seq->count;
9507 -: 9502:
9508 88304: 9503: for (i = seq->count; i--; ) {
9509 49210: 9504: expr = optimize_clone(single_use, seq->array[i], info, var_map, 0);
9510 49210: 9505: if (!expr) return NULL;
9511 47694: 9506: seq2->array[i] = expr;
9512 -: 9507: }
9513 -: 9508:
9514 18789: 9509: return (Scheme_Object *)seq2;
9515 -: 9510: }
9516 -: 9511: case scheme_branch_type:
9517 -: 9512: {
9518 146822: 9513: Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)expr, *b2;
9519 -: 9514:
9520 146822: 9515: b2 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec);
9521 146822: 9516: b2->so.type = scheme_branch_type;
9522 -: 9517:
9523 146822: 9518: expr = optimize_clone(single_use, b->test, info, var_map, 0);
9524 146822: 9519: if (!expr) return NULL;
9525 145966: 9520: b2->test = expr;
9526 -: 9521:
9527 145966: 9522: expr = optimize_clone(single_use, b->tbranch, info, var_map, 0);
9528 145966: 9523: if (!expr) return NULL;
9529 144726: 9524: b2->tbranch = expr;
9530 -: 9525:
9531 144726: 9526: expr = optimize_clone(single_use, b->fbranch, info, var_map, 0);
9532 144726: 9527: if (!expr) return NULL;
9533 143684: 9528: b2->fbranch = expr;
9534 -: 9529:
9535 143684: 9530: return (Scheme_Object *)b2;
9536 -: 9531: }
9537 -: 9532: case scheme_with_cont_mark_type:
9538 -: 9533: {
9539 1634: 9534: Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)expr, *wcm2;
9540 -: 9535:
9541 1634: 9536: wcm2 = MALLOC_ONE_TAGGED(Scheme_With_Continuation_Mark);
9542 1634: 9537: wcm2->so.type = scheme_with_cont_mark_type;
9543 -: 9538:
9544 1634: 9539: expr = optimize_clone(single_use, wcm->key, info, var_map, 0);
9545 1634: 9540: if (!expr) return NULL;
9546 1634: 9541: wcm2->key = expr;
9547 -: 9542:
9548 1634: 9543: expr = optimize_clone(single_use, wcm->val, info, var_map, 0);
9549 1634: 9544: if (!expr) return NULL;
9550 1542: 9545: wcm2->val = expr;
9551 -: 9546:
9552 1542: 9547: expr = optimize_clone(single_use, wcm->body, info, var_map, 0);
9553 1542: 9548: if (!expr) return NULL;
9554 1478: 9549: wcm2->body = expr;
9555 -: 9550:
9556 1478: 9551: return (Scheme_Object *)wcm2;
9557 -: 9552: }
9558 -: 9553: case scheme_ir_lambda_type:
9559 96325: 9554: return clone_lambda(single_use, expr, info, var_map);
9560 -: 9555: case scheme_ir_toplevel_type:
9561 -: 9556: case scheme_ir_quote_syntax_type:
9562 88682: 9557: return expr;
9563 -: 9558: case scheme_define_values_type:
9564 -: 9559: case scheme_define_syntaxes_type:
9565 -: 9560: case scheme_begin_for_syntax_type:
9566 -: 9561: case scheme_boxenv_type:
9567 #####: 9562: return NULL;
9568 -: 9563: case scheme_require_form_type:
9569 #####: 9564: return NULL;
9570 -: 9565: case scheme_varref_form_type:
9571 150: 9566: return ref_clone(single_use, expr, info, var_map);
9572 -: 9567: case scheme_set_bang_type:
9573 1696: 9568: return set_clone(single_use, expr, info, var_map);
9574 -: 9569: case scheme_apply_values_type:
9575 340: 9570: return apply_values_clone(single_use, expr, info, var_map);
9576 -: 9571: case scheme_with_immed_mark_type:
9577 112: 9572: return with_immed_mark_clone(single_use, expr, info, var_map);
9578 -: 9573: case scheme_case_lambda_sequence_type:
9579 764: 9574: return case_lambda_clone(single_use, expr, info, var_map);
9580 -: 9575: case scheme_module_type:
9581 #####: 9576: return NULL;
9582 -: 9577: default:
9583 592394: 9578: if (t > _scheme_ir_values_types_) {
9584 592394: 9579: if (single_use || scheme_ir_duplicate_ok(expr, 0))
9585 588408: 9580: return expr;
9586 -: 9581: }
9587 -: 9582: }
9588 -: 9583:
9589 3986: 9584: return NULL;
9590 -: 9585:}
9591 -: 9586:
9592 -: 9587:/*========================================================================*/
9593 -: 9588:/* compile-time env for optimization */
9594 -: 9589:/*========================================================================*/
9595 -: 9590:
9596 1338796: 9591:Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp, Scheme_Env *env, Scheme_Object *insp, int get_logger)
9597 -: 9592:{
9598 -: 9593: Optimize_Info *info;
9599 -: 9594:
9600 1338796: 9595: info = MALLOC_ONE_RT(Optimize_Info);
9601 -: 9596:#ifdef MZTAG_REQUIRED
9602 -: 9597: info->type = scheme_rt_optimize_info;
9603 -: 9598:#endif
9604 1338796: 9599: info->inline_fuel = INITIAL_INLINING_FUEL;
9605 1338796: 9600: info->flatten_fuel = INITIAL_FLATTENING_FUEL;
9606 1338796: 9601: info->cp = cp;
9607 1338796: 9602: info->env = env;
9608 1338796: 9603: info->insp = insp;
9609 -: 9604:
9610 1338796: 9605: if (get_logger) {
9611 -: 9606: Scheme_Logger *logger;
9612 32505: 9607: logger = (Scheme_Logger *)scheme_get_param(scheme_current_config(), MZCONFIG_LOGGER);
9613 32505: 9608: logger = scheme_make_logger(logger, scheme_intern_symbol("optimizer"));
9614 32505: 9609: info->logger = logger;
9615 -: 9610: }
9616 -: 9611:
9617 1338796: 9612: return info;
9618 -: 9613:}
9619 -: 9614:
9620 1491161: 9615:static void optimize_info_seq_init(Optimize_Info *info, Optimize_Info_Sequence *info_seq)
9621 -: 9616:{
9622 1491161: 9617: info_seq->init_flatten_fuel = info->flatten_fuel;
9623 1491161: 9618: info_seq->min_flatten_fuel = info->flatten_fuel;
9624 1491161: 9619:}
9625 -: 9620:
9626 2644026: 9621:static void optimize_info_seq_step(Optimize_Info *info, Optimize_Info_Sequence *info_seq)
9627 -: 9622:{
9628 2644026: 9623: if (info->flatten_fuel < info_seq->min_flatten_fuel)
9629 695: 9624: info_seq->min_flatten_fuel = info->flatten_fuel;
9630 2644026: 9625: info->flatten_fuel = info_seq->init_flatten_fuel;
9631 2644026: 9626:}
9632 -: 9627:
9633 1493341: 9628:static void optimize_info_seq_done(Optimize_Info *info, Optimize_Info_Sequence *info_seq)
9634 -: 9629:{
9635 1493341: 9630: if (info->flatten_fuel > info_seq->min_flatten_fuel)
9636 653: 9631: info->flatten_fuel = info_seq->min_flatten_fuel;
9637 1493341: 9632:}
9638 -: 9633:
9639 11423: 9634:void scheme_optimize_info_enforce_const(Optimize_Info *oi, int enforce_const)
9640 -: 9635:{
9641 11423: 9636: oi->enforce_const = enforce_const;
9642 11423: 9637:}
9643 -: 9638:
9644 2943: 9639:void scheme_optimize_info_set_context(Optimize_Info *oi, Scheme_Object *ctx)
9645 -: 9640:{
9646 2943: 9641: oi->context = ctx;
9647 2943: 9642:}
9648 -: 9643:
9649 20: 9644:void scheme_optimize_info_never_inline(Optimize_Info *oi)
9650 -: 9645:{
9651 20: 9646: oi->inline_fuel = -1;
9652 20: 9647:}
9653 -: 9648:
9654 75353: 9649:static void propagate_used_variables(Optimize_Info *info)
9655 -: 9650:{
9656 -: 9651: Scheme_Hash_Table *ht;
9657 -: 9652: Scheme_IR_Local *tvar;
9658 -: 9653: int j;
9659 -: 9654:
9660 75353: 9655: if (info->next->uses) {
9661 48697: 9656: ht = info->uses;
9662 437601: 9657: for (j = 0; j < ht->size; j++) {
9663 388904: 9658: if (ht->vals[j]) {
9664 129265: 9659: tvar = SCHEME_VAR(ht->keys[j]);
9665 129265: 9660: if (tvar->optimize.lambda_depth < info->next->lambda_depth)
9666 42014: 9661: scheme_hash_set(info->next->uses, (Scheme_Object *)tvar, scheme_true);
9667 -: 9662: }
9668 -: 9663: }
9669 -: 9664: }
9670 75353: 9665:}
9671 -: 9666:
9672 75353: 9667:static int env_uses_toplevel(Optimize_Info *frame)
9673 -: 9668:{
9674 -: 9669: int used;
9675 -: 9670:
9676 75353: 9671: used = frame->used_toplevel;
9677 -: 9672:
9678 75353: 9673: if (used) {
9679 -: 9674: /* Propagate use to an enclosing lambda, if any: */
9680 36010: 9675: frame = frame->next;
9681 293539: 9676: while (frame) {
9682 241042: 9677: if (frame->flags & SCHEME_LAMBDA_FRAME) {
9683 19523: 9678: frame->used_toplevel = 1;
9684 19523: 9679: break;
9685 -: 9680: }
9686 221519: 9681: frame = frame->next;
9687 -: 9682: }
9688 -: 9683: }
9689 -: 9684:
9690 75353: 9685: return used;
9691 -: 9686:}
9692 -: 9687:
9693 312667: 9688:static void optimize_info_used_top(Optimize_Info *info)
9694 -: 9689:{
9695 2883742: 9690: while (info) {
9696 2466321: 9691: if (info->flags & SCHEME_LAMBDA_FRAME) {
9697 207913: 9692: info->used_toplevel = 1;
9698 207913: 9693: break;
9699 -: 9694: }
9700 2258408: 9695: info = info->next;
9701 -: 9696: }
9702 312667: 9697:}
9703 -: 9698:
9704 74487: 9699:static Scheme_Once_Used *make_once_used(Scheme_Object *val, Scheme_IR_Local *var,
9705 -: 9700: int vclock, int aclock, int kclock, int sclock, int spans_k)
9706 -: 9701:{
9707 -: 9702: Scheme_Once_Used *o;
9708 -: 9703:
9709 74487: 9704: o = MALLOC_ONE_TAGGED(Scheme_Once_Used);
9710 74487: 9705: o->so.type = scheme_once_used_type;
9711 -: 9706:
9712 74487: 9707: o->expr = val;
9713 74487: 9708: o->var = var;
9714 74487: 9709: o->vclock = vclock;
9715 74487: 9710: o->aclock = aclock;
9716 74487: 9711: o->kclock = kclock;
9717 74487: 9712: o->sclock = sclock;
9718 74487: 9713: o->spans_k = spans_k;
9719 -: 9714:
9720 74487: 9715: return o;
9721 -: 9716:}
9722 -: 9717:
9723 11660: 9718:static int optimize_any_uses(Optimize_Info *info, Scheme_IR_Let_Value *at_irlv, int n)
9724 -: 9719:{
9725 -: 9720: int i, j;
9726 11660: 9721: Scheme_IR_Let_Value *irlv = at_irlv;
9727 -: 9722:
9728 23706: 9723: while (n--) {
9729 24342: 9724: for (i = irlv->count; i--; ) {
9730 11979: 9725: if (irlv->vars[i]->optimize_used)
9731 10: 9726: return 1;
9732 24334: 9727: for (j = at_irlv->count; j--; ) {
9733 11977: 9728: if (at_irlv->vars[j]->optimize.transitive_uses) {
9734 11862: 9729: if (scheme_hash_get(at_irlv->vars[j]->optimize.transitive_uses,
9735 11862: 9730: (Scheme_Object *)irlv->vars[i]))
9736 11581: 9731: return 1;
9737 -: 9732: }
9738 -: 9733: }
9739 -: 9734: }
9740 386: 9735: irlv = (Scheme_IR_Let_Value *)irlv->body;
9741 -: 9736: }
9742 -: 9737:
9743 69: 9738: return 0;
9744 -: 9739:}
9745 -: 9740:
9746 36: 9741:static void optimize_uses_of_mutable_imply_early_alloc(Scheme_IR_Let_Value *at_irlv, int n)
9747 -: 9742:{
9748 -: 9743: int i, j;
9749 36: 9744: Scheme_IR_Let_Value *irlv = at_irlv;
9750 -: 9745:
9751 -: 9746: /* We we're reinterpreting a `letrec` as `let*`, and when it realy
9752 -: 9747: must be `let*` instead of `let`, and when a mutable variable is
9753 -: 9748: involved, then we need to tell the `resolve` pass that the
9754 -: 9749: mutable varaiable's value must be boxed immediately, instead of
9755 -: 9750: delaying to the body of the `let*`. */
9756 -: 9751:
9757 101: 9752: while (n--) {
9758 87: 9753: for (i = irlv->count; i--; ) {
9759 29: 9754: if (irlv->vars[i]->mutated) {
9760 #####: 9755: int used = 0;
9761 #####: 9756: if (irlv->vars[i]->optimize_used)
9762 #####: 9757: used = 1;
9763 -: 9758: else {
9764 #####: 9759: for (j = at_irlv->count; j--; ) {
9765 #####: 9760: if (at_irlv->vars[j]->optimize.transitive_uses) {
9766 #####: 9761: if (scheme_hash_get(at_irlv->vars[j]->optimize.transitive_uses,
9767 #####: 9762: (Scheme_Object *)irlv->vars[i]))
9768 #####: 9763: used = 1;
9769 -: 9764: }
9770 -: 9765: }
9771 -: 9766: }
9772 #####: 9767: if (used)
9773 #####: 9768: irlv->vars[i]->must_allocate_immediately = 1;
9774 -: 9769: }
9775 -: 9770: }
9776 29: 9771: irlv = (Scheme_IR_Let_Value *)irlv->body;
9777 -: 9772: }
9778 36: 9773:}
9779 -: 9774:
9780 1070786: 9775:static void register_use(Scheme_IR_Local *var, Optimize_Info *info)
9781 -: 9776:{
9782 -: 9777: MZ_ASSERT(SCHEME_VAR(var)->mode == SCHEME_VAR_MODE_OPTIMIZE);
9783 -: 9778: MZ_ASSERT(SCHEME_VAR(var)->use_count);
9784 -: 9779:
9785 1070786: 9780: if (var->optimize.lambda_depth < info->lambda_depth)
9786 227621: 9781: scheme_hash_set(info->uses, (Scheme_Object *)var, scheme_true);
9787 -: 9782:
9788 1070786: 9783: if (!var->optimize_used) {
9789 348310: 9784: var->optimize_used = 1;
9790 -: 9785:
9791 348310: 9786: if (info->transitive_use_var
9792 413446: 9787: && (var->optimize.lambda_depth
9793 206723: 9788: <= info->transitive_use_var->optimize.lambda_depth)) {
9794 36349: 9789: Scheme_Hash_Table *ht = info->transitive_use_var->optimize.transitive_uses;
9795 -: 9790:
9796 36349: 9791: if (!ht) {
9797 15720: 9792: ht = scheme_make_hash_table(SCHEME_hash_ptr);
9798 15720: 9793: info->transitive_use_var->optimize.transitive_uses = ht;
9799 -: 9794: }
9800 36349: 9795: scheme_hash_set(ht, (Scheme_Object *)var, scheme_true);
9801 -: 9796: }
9802 -: 9797: }
9803 1070786: 9798:}
9804 -: 9799:
9805 14668: 9800:static void register_transitive_uses(Scheme_IR_Local *var, Optimize_Info *info)
9806 -: 9801:{
9807 -: 9802: Scheme_Hash_Table *ht;
9808 -: 9803: Scheme_IR_Local *tvar;
9809 -: 9804: int j;
9810 -: 9805:
9811 14668: 9806: ht = var->optimize.transitive_uses;
9812 -: 9807:
9813 144132: 9808: for (j = 0; j < ht->size; j++) {
9814 129464: 9809: if (ht->vals[j]) {
9815 33059: 9810: tvar = SCHEME_VAR(ht->keys[j]);
9816 33059: 9811: register_use(tvar, info);
9817 -: 9812: }
9818 -: 9813: }
9819 14668: 9814:}
9820 -: 9815:
9821 115224: 9816:static Scheme_Object *optimize_info_lookup(Scheme_Object *var)
9822 -: 9817:{
9823 -: 9818: MZ_ASSERT(SCHEME_VAR(var)->mode == SCHEME_VAR_MODE_OPTIMIZE);
9824 -: 9819: MZ_ASSERT(SCHEME_VAR(var)->use_count);
9825 -: 9820:
9826 115224: 9821: return SCHEME_VAR(var)->optimize.known_val;
9827 -: 9822:}
9828 -: 9823:
9829 1252452: 9824:static Scheme_Object *optimize_info_propagate_local(Scheme_Object *var)
9830 -: 9825:{
9831 1252452: 9826: Scheme_Object *last, *val = var;
9832 -: 9827:
9833 1252452: 9828: last = val; /* Avoid compiler warning */
9834 -: 9829:
9835 3891388: 9830: while (val && SAME_TYPE(SCHEME_TYPE(val), scheme_ir_local_type)) {
9836 -: 9831: MZ_ASSERT(SCHEME_VAR(val)->mode == SCHEME_VAR_MODE_OPTIMIZE);
9837 -: 9832: MZ_ASSERT(SCHEME_VAR(val)->use_count);
9838 1386484: 9833: last = val;
9839 1386484: 9834: val = SCHEME_VAR(val)->optimize.known_val;
9840 -: 9835: }
9841 -: 9836:
9842 1252452: 9837: if (!val
9843 205870: 9838: || SCHEME_WILL_BE_LAMBDAP(val)
9844 189714: 9839: || SCHEME_LAMBDAP(val)
9845 141809: 9840: || SAME_TYPE(SCHEME_TYPE(val), scheme_once_used_type)) {
9846 1204876: 9841: if (SAME_OBJ(last, var))
9847 1070844: 9842: return NULL;
9848 -: 9843:
9849 134032: 9844: if (SCHEME_VAR(var)->use_count != 1)
9850 107620: 9845: increment_use_count(SCHEME_VAR(last), 0);
9851 -: 9846:
9852 134032: 9847: return last;
9853 -: 9848: }
9854 -: 9849:
9855 47576: 9850: return val;
9856 -: 9851:}
9857 -: 9852:
9858 2194547: 9853:Scheme_Object *optimize_get_predicate(Optimize_Info *info, Scheme_Object *var, int ignore_no_types)
9859 -: 9854:{
9860 -: 9855: Scheme_Object *pred;
9861 -: 9856:
9862 2194547: 9857: if (info->no_types && !ignore_no_types) return NULL;
9863 -: 9858:
9864 48769512: 9859: while (info) {
9865 45219509: 9860: if (info->types) {
9866 10480348: 9861: pred = scheme_hash_tree_get(info->types, var);
9867 10480348: 9862: if (pred)
9868 566587: 9863: return pred;
9869 -: 9864: }
9870 44652922: 9865: info = info->next;
9871 -: 9866: }
9872 -: 9867:
9873 1491708: 9868: return NULL;
9874 -: 9869:}
9875 -: 9870:
9876 1306284: 9871:static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int current, int flags)
9877 -: 9872:{
9878 -: 9873: Optimize_Info *naya;
9879 -: 9874:
9880 1306284: 9875: naya = scheme_optimize_info_create(info->cp, info->env, info->insp, 0);
9881 1306284: 9876: naya->flags = (short)flags;
9882 1306284: 9877: naya->next = info;
9883 1306284: 9878: naya->original_frame = orig;
9884 1306284: 9879: naya->new_frame = current;
9885 1306284: 9880: naya->inline_fuel = info->inline_fuel;
9886 1306284: 9881: naya->flatten_fuel = info->flatten_fuel;
9887 1306284: 9882: naya->letrec_not_twice = info->letrec_not_twice;
9888 1306284: 9883: naya->enforce_const = info->enforce_const;
9889 1306284: 9884: naya->top_level_consts = info->top_level_consts;
9890 1306284: 9885: naya->context = info->context;
9891 1306284: 9886: naya->vclock = info->vclock;
9892 1306284: 9887: naya->aclock = info->aclock;
9893 1306284: 9888: naya->kclock = info->kclock;
9894 1306284: 9889: naya->sclock = info->sclock;
9895 1306284: 9890: naya->escapes = info->escapes;
9896 1306284: 9891: naya->init_kclock = info->kclock;
9897 1306284: 9892: naya->maybe_values_argument = info->maybe_values_argument;
9898 1306284: 9893: naya->use_psize = info->use_psize;
9899 1306284: 9894: naya->logger = info->logger;
9900 1306284: 9895: naya->no_types = info->no_types;
9901 1306284: 9896: naya->lambda_depth = info->lambda_depth + ((flags & SCHEME_LAMBDA_FRAME) ? 1 : 0);
9902 1306284: 9897: naya->uses = info->uses;
9903 1306284: 9898: naya->transitive_use_var = info->transitive_use_var;
9904 -: 9899:
9905 1306284: 9900: return naya;
9906 -: 9901:}
9907 -: 9902:
9908 838911: 9903:static void optimize_info_done(Optimize_Info *info, Optimize_Info *parent)
9909 -: 9904:{
9910 838911: 9905: if (!parent) parent = info->next;
9911 -: 9906:
9912 838911: 9907: parent->size += info->size;
9913 838911: 9908: parent->vclock = info->vclock;
9914 838911: 9909: parent->aclock = info->aclock;
9915 838911: 9910: parent->kclock = info->kclock;
9916 838911: 9911: parent->sclock = info->sclock;
9917 838911: 9912: parent->escapes = info->escapes;
9918 838911: 9913: parent->psize += info->psize;
9919 838911: 9914: parent->flatten_fuel = info->flatten_fuel;
9920 838911: 9915: if (info->has_nonleaf)
9921 580005: 9916: parent->has_nonleaf = 1;
9922 838911: 9917:}
9923 -: 9918:
9924 -: 9919:/*========================================================================*/
9925 -: 9920:/* precise GC traversers */
9926 -: 9921:/*========================================================================*/
9927 -: 9922:
9928 -: 9923:#ifdef MZ_PRECISE_GC
9929 -: 9924:
9930 -: 9925:START_XFORM_SKIP;
9931 -: 9926:
9932 -: 9927:#include "mzmark_optimize.inc"
9933 -: 9928:
9934 -: 9929:static void register_traversers(void)
9935 -: 9930:{
9936 -: 9931: GC_REG_TRAV(scheme_once_used_type, mark_once_used);
9937 -: 9932: GC_REG_TRAV(scheme_rt_optimize_info, mark_optimize_info);
9938 -: 9933:}
9939 -: 9934:
9940 -: 9935:END_XFORM_SKIP;
9941 -: 9936:
9942 -: 9937:#endif