1: # 63 "./lpsrc/flx_use.ipk"
2: open Flx_util
3: open Flx_ast
4: open Flx_types
5: open Flx_print
6: open Flx_mtypes1
7: open Flx_mtypes2
8: open Flx_typing
9: open Flx_mbind
10: open Flx_srcref
11: open List
12: open Flx_unify
13: open Flx_treg
14: open Flx_generic
15: open Flx_maps
16: open Flx_exceptions
17:
18:
19: (* These routines find the absolute use closure of a symbol,
20: in particular they include variables which are initialised
21: but never used: these routine are intended to be used
22: to extract all the bound symbol table entries required
23: to process a set of roots.
24:
25: Contrast with the 'Flx_call' usage routines, which
26: find some symbols which are useful, this excludes
27: types, and it excludes LHS vals and perhaps vars,
28: which are not used in some expression.
29:
30: It seems a pity these routines are almost identical
31: (and the lot gets repeated yet again in the instantiator,
32: and weakly in the 'useless call eliminator', we hope
33: to find a better code reuse solution.. for now,
34: remember to update all three sets of routines when
35: changing the data structures.
36:
37: *)
38:
39: let nop x = ()
40:
41: let rec uses_type syms used bbdfns count_inits (t:btypecode_t) =
42: let ut t = uses_type syms used bbdfns count_inits t in
43: match t with
44: | `BTYP_inst (i,ts)
45: ->
46: uses syms used bbdfns count_inits i; (* don't care on uses inits? *)
47: iter ut ts
48:
49: (*
50: | `BTYP_type
51: ->
52: failwith "[uses_type] Unexpected metatype"
53: *)
54:
55: | _ -> iter_btype ut t
56:
57: and uses_exes syms used bbdfns count_inits exes =
58: iter (uses_exe syms used bbdfns count_inits) exes
59:
60: and uses_exe syms used bbdfns count_inits (exe:bexe_t) =
61: (*
62: print_endline ("EXE=" ^ string_of_bexe syms.dfns 0 exe);
63: *)
64: let ue e = uses_tbexpr syms used bbdfns count_inits e in
65: let ui i = uses syms used bbdfns count_inits i in
66: let ut t = uses_type syms used bbdfns count_inits t in
67: match exe,count_inits with
68: | `BEXE_init (_,i,e),false -> ue e
69: | _ ->
70: iter_bexe ui ue ut nop nop exe
71:
72:
73: and uses_tbexpr syms used bbdfns count_inits ((e,t) as x) =
74: let ue e = uses_tbexpr syms used bbdfns count_inits e in
75: let ut t = uses_type syms used bbdfns count_inits t in
76: let ui i = uses syms used bbdfns count_inits i in
77:
78: (* already done in the iter .. *)
79: (*
80: ut t;
81: *)
82: (* use a MAP now *)
83: iter_tbexpr ui ignore ut x;
84:
85: and uses_production syms used bbdfns count_inits p =
86: let uses_symbol (_,nt) = match nt with
87: | `Nonterm ii -> iter (uses syms used bbdfns count_inits) ii
88: | `Term i -> () (* HACK! This is a union constructor name we need to 'use' the union type!! *)
89: in
90: iter uses_symbol p
91:
92: and faulty_req syms i =
93: match Hashtbl.find syms.dfns i with {id=id; sr=sr } ->
94: clierr sr (id ^ " is used but has unsatisfied requirement")
95:
96: and uses syms used bbdfns count_inits i =
97: let ui i = uses syms used bbdfns count_inits i in
98: let ut t = uses_type syms used bbdfns count_inits t in
99: let rq reqs =
100: let ur (j,ts) =
101: if j = 0 then
102: faulty_req syms i
103: else begin ui j; iter ut ts end
104: in
105: iter ur reqs
106: in
107: let ux x = uses_exes syms used bbdfns count_inits x in
108: let ue e = uses_tbexpr syms used bbdfns count_inits e in
109: if not (IntSet.mem i !used) then
110: begin
111: match
112: try Some (Hashtbl.find bbdfns i)
113: with Not_found -> None
114: with
115: | Some (id,_,_,bbdcl) ->
116: used := IntSet.add i !used;
117: begin match bbdcl with
118: | `BBDCL_typeclass _ -> ()
119:
120: | `BBDCL_instance (_,_,con,i,ts) ->
121: ut con;
122: iter ut ts
123:
124: | `BBDCL_function (props,_,(ps,traint),ret,exes) ->
125: iter (fun {pindex=i;ptyp=t} -> ui i; ut t) ps;
126: ut ret;
127: ux exes
128:
129: | `BBDCL_procedure (props,_,(ps,traint), exes) ->
130: iter (fun {pindex=i;ptyp=t} -> ui i; ut t) ps;
131: ux exes
132:
133: | `BBDCL_glr (_,_,t,(p,e)) ->
134: ut t; ux e;
135: uses_production syms used bbdfns count_inits p
136:
137: | `BBDCL_regmatch (_,_,(ps,traint),t,(_,_,h,_)) ->
138: ut t; Hashtbl.iter (fun _ e -> ue e) h;
139: iter (fun {pindex=i;ptyp=t} -> ui i; ut t) ps;
140:
141: | `BBDCL_reglex (_,_,(ps,traint),i,t,(_,_,h,_)) ->
142: ut t; Hashtbl.iter (fun _ e -> ue e) h;
143: iter (fun {pindex=i;ptyp=t} -> ui i; ut t) ps;
144: ui i
145:
146: | `BBDCL_union (_,ps)
147: -> ()
148:
149: (* types of variant arguments are only used if constructed
150: .. OR .. matched against ??
151: *)
152:
153: | `BBDCL_struct (_,ps)
154: | `BBDCL_cstruct (_,ps)
155: ->
156: iter ut (map snd ps)
157:
158: | `BBDCL_class _ -> ()
159:
160: | `BBDCL_cclass (_,mems) -> ()
161:
162: | `BBDCL_val (_,t)
163: | `BBDCL_var (_,t)
164: | `BBDCL_tmp (_,t) -> ut t
165:
166: | `BBDCL_ref (_,t) -> ut (`BTYP_pointer t)
167:
168: | `BBDCL_const (_,t,_,reqs) -> ut t; rq reqs
169: | `BBDCL_fun (_,_,ps, ret, _,reqs,_) -> iter ut ps; ut ret; rq reqs
170:
171: | `BBDCL_callback (_,_,ps_cf, ps_c, _, ret, reqs,_) ->
172: iter ut ps_cf;
173: iter ut ps_c;
174: ut ret; rq reqs
175:
176: | `BBDCL_proc (_,_,ps, _, reqs) -> iter ut ps; rq reqs
177:
178: | `BBDCL_newtype (_,t) -> ut t
179: | `BBDCL_abs (_,_,_,reqs) -> rq reqs
180: | `BBDCL_insert (_,s,ikind,reqs) -> rq reqs
181: | `BBDCL_nonconst_ctor (_,_,unt,_,ct,evs, etraint) ->
182: ut unt; ut ct
183:
184: end
185: | None ->
186: let id =
187: try match Hashtbl.find syms.dfns i with {id=id} -> id
188: with Not_found -> "not found in unbound symbol table"
189: in
190: failwith
191: (
192: "[Flx_use.uses] Cannot find bound defn for " ^ id ^ "<"^si i ^ ">"
193: )
194: end
195:
196: let find_roots syms bbdfns
197: (root:bid_t)
198: (bifaces:biface_t list)
199: =
200:
201: (* make a list of the root and all exported functions,
202: add exported types and components thereof into the used
203: set now too
204: *)
205: let roots = ref (IntSet.singleton root) in
206: iter
207: (function
208: | `BIFACE_export_fun (_,x,_) -> roots := IntSet.add x !roots
209: | `BIFACE_export_type (_,t,_) ->
210: uses_type syms roots bbdfns true t
211: )
212: bifaces
213: ;
214: syms.roots := !roots
215:
216: let cal_use_closure syms bbdfns (count_inits:bool) =
217: let u = ref IntSet.empty in
218: let v : IntSet.t = !(syms.roots) in
219: let v = ref v in
220:
221: let add j =
222: if not (IntSet.mem j !u) then
223: begin
224: (*
225: print_endline ("Scanning " ^ si j);
226: *)
227: u:= IntSet.add j !u;
228: uses syms v bbdfns count_inits j
229: end
230: in
231: let ut t = uses_type syms u bbdfns count_inits t in
232: Hashtbl.iter
233: ( fun i entries ->
234: iter (fun (vs,con,ts,j) ->
235: add i; add j;
236: ut con;
237: iter ut ts
238: )
239: entries
240: )
241: syms.typeclass_to_instance
242: ;
243: while not (IntSet.is_empty !v) do
244: let j = IntSet.choose !v in
245: v := IntSet.remove j !v;
246: add j
247: done
248: ;
249: !u
250:
251: let full_use_closure syms bbdfns =
252: cal_use_closure syms bbdfns true
253:
254: let copy_used syms bbdfns =
255: if syms.compiler_options.print_flag then
256: print_endline "COPY USED";
257: let h = Hashtbl.create 97 in
258: let u = full_use_closure syms bbdfns in
259: IntSet.iter
260: begin fun i ->
261: (*
262: if syms.compiler_options.print_flag then
263: print_endline ("Copying " ^ si i);
264: *)
265: Hashtbl.add h i (Hashtbl.find bbdfns i)
266: end
267: u;
268: h
269:
1: # 28 "./lpsrc/flx_tailit.ipk"
2: open Flx_util
3: open Flx_ast
4: open Flx_types
5: open Flx_print
6: open Flx_mtypes1
7: open Flx_mtypes2
8: open Flx_typing
9: open Flx_mbind
10: open Flx_srcref
11: open List
12: open Flx_unify
13: open Flx_treg
14: open Flx_generic
15: open Flx_maps
16: open Flx_exceptions
17: open Flx_use
18: open Flx_child
19: open Flx_call
20:
21: let isvariable bbdfns i =
22: let id,_,_,entry = Hashtbl.find bbdfns i in match entry with
23: | `BBDCL_var _ | `BBDCL_val _ ->
24: (* print_endline ("Var/Val " ^ id ^ "<" ^ si i ^">"); *) true
25: | _ -> false
26:
27: let isfun bbdfns i =
28: let id,_,_,entry = Hashtbl.find bbdfns i in match entry with
29: | `BBDCL_function _ | `BBDCL_procedure _ ->
30: (*print_endline ("Fun/proc " ^ id ^ "<" ^ si i ^">"); *) true
31: | _ -> false
32:
33: let add_xclosure syms cls e =
34: (*
35: print_endline ("chk cls for " ^ sbe syms.dfns e);
36: *)
37: match e with
38: | `BEXPR_closure (i,ts),t -> cls := IntSet.add i !cls
39: | _ -> ()
40:
41: let ident x = x
42:
43: (* WARNING!! closure here has TWO meanings: a BEXPR_closure,
44: and ALSO the setwise closure of all such explicit closure
45: terms ..
46: *)
47:
48: let expr_find_xclosures syms cls e =
49: iter_tbexpr ignore (add_xclosure syms cls) ignore e
50:
51: let exe_find_xclosure syms cls exe =
52: iter_bexe ignore (expr_find_xclosures syms cls) ignore ignore ignore exe
53:
54: let exes_find_xclosure syms cls exes =
55: iter (exe_find_xclosure syms cls) exes
56:
57: let exes_get_xclosures syms exes =
58: let cls = ref IntSet.empty in
59: exes_find_xclosure syms cls exes;
60: !cls
61:
62: let function_find_xclosure syms cls bbdfns i =
63: let _,_,_,entry = Hashtbl.find bbdfns i in
64: let exes =
65: match entry with
66: | `BBDCL_procedure (_,_,_,exes)
67: | `BBDCL_function (_,_,_,_,exes) -> exes
68: | _ -> []
69: in
70: (*
71: print_endline ("ROUTINE " ^ si i);
72: iter (fun exe -> print_endline (string_of_bexe syms.dfns 0 exe)) exes;
73: *)
74: exes_find_xclosure syms cls exes
75:
76: let functions_find_xclosures syms cls bbdfns ii =
77: IntSet.iter
78: (function_find_xclosure syms cls bbdfns)
79: ii
80:
81: let tailit syms (uses,child_map,bbdfns) this sr ps vs exes : bexe_t list =
82: let ts' = map (fun (_,i) -> `BTYP_var (i,`BTYP_type 0)) vs in
83: let pset = fold_left (fun s {pindex=i} -> IntSet.add i s) IntSet.empty ps in
84: let parameters = ref [] in
85: let descend = descendants child_map this in
86: let children = try Hashtbl.find child_map this with Not_found -> [] in
87: let can_loop () =
88: let varlist = filter (isvariable bbdfns) children in
89: let funset = IntSet.filter (isfun bbdfns) descend in
90:
91: (*
92: print_endline ("Procedure has " ^ si (length varlist) ^ " variables");
93: print_endline ("Procedure has " ^ si (IntSet.cardinal funset) ^ " child funcs");
94: *)
95:
96: let cls = ref IntSet.empty in
97: functions_find_xclosures syms cls bbdfns funset;
98: (* THIS FUNCTION IS BEING INLINED .. WE CANNOT LOOKUP ITS EXES!! *)
99: exes_find_xclosure syms cls exes;
100: (*
101: print_endline ("Total xclosures " ^ si (IntSet.cardinal !cls));
102: *)
103: let kidcls = IntSet.inter !cls funset in
104: (*
105: print_endline ("Kid xclosures " ^ si (IntSet.cardinal kidcls));
106: *)
107: try
108: IntSet.iter
109: (fun i ->
110: let usage = Hashtbl.find uses i in
111: iter
112: (fun j ->
113: let usesj = mem_assoc j usage in
114: (*
115: if usesj then
116: print_endline (si i ^ " uses var " ^ si j)
117: ;
118: *)
119: if usesj then raise Not_found;
120: )
121: varlist
122: )
123: kidcls
124: ;
125: true
126: with
127: | Not_found -> false
128: in
129: let jump_done = ref false in
130: let lc = !(syms.counter) in incr (syms.counter);
131: let start_label = "start_" ^ si lc in
132:
133: (* note reverse order *)
134: (* Weirdly, this works for BOTH tail calls
135: and tail applies
136: *)
137: let cal_tail_call e =
138: match length ps with
139: | 0 ->
140: [
141: `BEXE_goto (sr,start_label);
142: `BEXE_comment (sr,"tail rec call (0)")
143: ]
144: | 1 ->
145: let {pindex=k} = hd ps in
146: [
147: `BEXE_goto (sr,start_label);
148: `BEXE_init (sr,k,e);
149: `BEXE_comment (sr,"tail rec call (1)")
150: ]
151: | _ ->
152: begin match e with
153: | `BEXPR_tuple ls,_ ->
154: (*
155: print_endline ("TUPLE ASSGN " ^ sbe syms.dfns e);
156: *)
157: (* Parallel Assignment algorithm.
158: Given a set of assignments, xi = ei,
159: we need a sequence of assignments of xi, ei, tj,
160: where tj are fresh variables, xi on left, ei on
161: right, and tj on either side, such that no RHS
162: term depends on a prior LHS term.
163:
164: A pair x1 = e1, x2 = e2 which are mutually dependent
165: can always by resolved as
166:
167: t1 = e1; x2 = e2; x1 = t1
168:
169: Here e1 doesn't depend on a prior term, vaccuously,
170: e2 can't depend on t1 since it is fresh, and
171: t1 can't depend on anything, since it just a fresh variable
172:
173: Let's start by taking the equations, and making
174: two lists -- a head list and a tail list.
175: Head assignments are done first, tails last,
176: the head list is in reverse order.
177:
178: Any equations setting variables no one depends on
179: can be moved into the head list, they can safely
180: be done first.
181:
182: Any equations whose RHS depend on nothing are
183: moved into the tail list, its safe to do them last.
184:
185: Any dependencies on variables set by equations
186: moved into the tail list can now be removed
187: from the remaining equations, since it is determined
188: now that these variables will be changed after
189: any of the remaining assignments are one.
190:
191: Repeat until the set of remaining equations is fixed.
192:
193: We can now pick (somehow!!) an equation, and break
194: it into two using a fresh temporary. The temporary
195: assignment goes on the head list, the variable
196: assignment from the temporary on the tail list,
197: and as above, any dependencies on the variable
198: can now be removed from the remaining equations.
199:
200: Repeat everything until the set of remaining
201: equations is empty, the result is the reverse
202: of the heap list plus the tail list.
203:
204: This process is certain to terminate, since
205: each outer step removes one equation,
206: and it is certain to be correct (obvious).
207:
208: What is NOT clear is that the result is minimal.
209: And it is NOT clear how to best 'choose' which
210: equation to split.
211:
212:
213: *)
214: assert (length ls = length ps);
215: let pinits =
216: map2
217: (fun {pid=name; pindex=i; ptyp=t} e ->
218: i,(name,t,e,expr_uses syms descend uses pset e)
219: )
220: ps ls
221: in
222: (* strip trivial assignments like x = x *)
223: let pinits =
224: filter
225: (fun (i,(name,t,e,u)) ->
226: match e with
227: | `BEXPR_name (j,_),_ when i = j -> false
228: | _ -> true
229: )
230: pinits
231: in
232: let fixdeps pinits =
233: let vars = fold_left (fun s (i,_) -> IntSet.add i s) IntSet.empty pinits in
234: map
235: (fun (i,(name,t,e,u)) ->
236: let u = IntSet.remove i (IntSet.inter u vars) in
237: i,(name,t,e,u)
238: )
239: pinits
240: in
241: (*
242: iter
243: (fun (i,(name,t,e,u)) ->
244: print_endline ("ASG " ^ name ^ "<"^si i ^ "> = " ^ sbe syms.dfns e);
245: print_string " Depends: ";
246: IntSet.iter (fun i -> print_string (si i ^ ", ")) u;
247: print_endline "";
248: )
249: pinits;
250: *)
251: (* this function measures if the expression assigning i
252: depends on the old value of j
253: *)
254: let depend pinits i j =
255: let u = match assoc i pinits with _,_,_,u -> u in
256: IntSet.mem j u
257: in
258: (* return true if an assignment in inits depends on j *)
259: let used j inits =
260: fold_left (fun r (i,_)-> r or depend inits i j) false inits
261: in
262: let rec aux ((head, middle, tail) as arg) = function
263: | [] -> arg
264: | (i,(name,ty,e,u)) as h :: ta ->
265: if IntSet.cardinal u = 0 then
266: aux (head,middle,h::tail) ta
267: else if not (used i (middle @ ta)) then
268: aux (h::head, middle, tail) ta
269: else
270: aux (head,h::middle,tail) ta
271: in
272:
273: let printem (h,m,t) =
274: print_endline "HEAD:";
275: iter
276: (fun (i,(name,t,e,u)) ->
277: print_endline ("ASG " ^ name ^ "<"^si i ^ "> = " ^ sbe syms.dfns e)
278: )
279: h;
280:
281: print_endline "MIDDLE:";
282: iter
283: (fun (i,(name,t,e,u)) ->
284: print_endline ("ASG " ^ name ^ "<"^si i ^ "> = " ^ sbe syms.dfns e)
285: )
286: m;
287:
288: print_endline "TAIL:";
289: iter
290: (fun (i,(name,t,e,u)) ->
291: print_endline ("ASG " ^ name ^ "<"^si i ^ "> = " ^ sbe syms.dfns e)
292: )
293: t
294: in
295:
296: let rec aux2 (hh,mm,tt) =
297: let h,m,t = aux ([],[],[]) (fixdeps mm) in
298: (* printem (h,m,t); *)
299: (* reached a fixpoint? *)
300: if length h = 0 && length t = 0 then hh,m,tt (* m = mm *)
301: else begin
302: (*
303: print_endline "Recursing on MIDDLE";
304: *)
305: aux2 (h @ hh, m, t @ tt)
306: end
307: in
308: let tmplist = ref [] in
309: let rec aux3 (hh,mm,tt) =
310: let h,m,t = aux2 (hh,mm,tt) in
311: (*
312: print_endline "SPLIT STEP result:";
313: printem(h,m,t);
314: *)
315: match m with
316: | [] -> rev h @ t
317: | [_] -> assert false
318: | (i,(name,ty,e,u)) :: ta ->
319: let k = !(syms.counter) in incr syms.counter;
320: let name2 = "_tmp_" ^ name in
321: parameters := (ty,k) :: !parameters;
322: tmplist := k :: !tmplist;
323: let h' = k,(name2,ty,e,IntSet.empty) in
324: let e' = `BEXPR_name (k,ts'),ty in
325: let t' = i,(name,ty,e',IntSet.empty) in
326: aux3 (h' :: h, ta, t' :: t)
327: in
328: let m = aux3 ([],pinits,[]) in
329: (*
330: print_endline "FINAL SPLIT UP:";
331: iter
332: (fun (i,(name,t,e,u)) ->
333: print_endline ("ASG " ^ name ^ "<"^si i ^ "> = " ^ sbe syms.dfns e)
334: )
335: m;
336: *)
337: let result = ref [] in
338: result := `BEXE_comment (sr,"tail rec call (3)") :: !result;
339: iter
340: (fun (i,(name,ty,e,_)) ->
341: if mem i !tmplist then
342: result := `BEXE_begin :: !result;
343: result := `BEXE_init (sr,i,e) :: !result;
344: )
345: m;
346: while length !tmplist > 0 do
347: result := `BEXE_end :: !result;
348: tmplist := tl !tmplist
349: done;
350: result := `BEXE_goto (sr,start_label) :: !result;
351: (*
352: print_endline "Tail opt code is:";
353: iter (fun x -> print_endline (string_of_bexe syms.dfns 0 x) ) (rev !result);
354: *)
355: !result
356:
357: | _ ->
358: print_endline "NON TUPLE TAIL CALL";
359: let t = snd e in
360: let pix =
361: try assoc t !parameters
362: with Not_found ->
363: let pix = !(syms.counter) in incr syms.counter;
364: parameters := (t,pix) :: !parameters;
365: pix
366: in
367: let p = `BEXPR_name (pix,ts'),t in
368: let n = ref 0 in
369: let param_decode =
370: map
371: (fun {pindex=ix; ptyp=prjt} ->
372: let prj = reduce_tbexpr bbdfns (`BEXPR_get_n (!n,p),prjt) in
373: incr n;
374: `BEXE_init (sr,ix,prj)
375: )
376: ps
377: in
378: [
379: `BEXE_goto (sr,start_label);
380: ]
381: @
382: param_decode
383: @
384: [
385: `BEXE_init (sr,pix,e);
386: `BEXE_comment (sr,"tail rec call (2)")
387: ]
388: end
389: in
390: let rec aux tail res = match tail with
391: | (`BEXE_call_direct (sr,i,ts,a)) as x :: tail -> assert false
392:
393: | (`BEXE_call (sr,(`BEXPR_closure(i,ts),_),a)) as x :: tail
394: when (i,ts)=(this,ts') && Flx_cflow.tailable exes [] tail
395: ->
396: if can_loop ()
397: then begin
398: (*
399: print_endline ("--> Tail rec call optimised " ^ si this);
400: *)
401: jump_done := true;
402: let res = cal_tail_call a @ res
403: in aux tail res
404: end else begin
405: (*
406: print_endline ("--> Tail rec call NOT optimised " ^ si this);
407: *)
408: aux tail (x::res)
409: end
410:
411: | `BEXE_fun_return (sr,(`BEXPR_apply_direct(i,ts,a),_)) :: tail -> assert false
412:
413: | `BEXE_fun_return (sr,(`BEXPR_apply((`BEXPR_closure (i,ts),_),a),_)) :: tail
414: when (i,ts)=(this,ts')
415: ->
416: (*
417: print_endline ("--> Tail rec apply " ^ si this);
418: *)
419: jump_done := true;
420: let res = cal_tail_call a @ res
421: in aux tail res
422:
423: | (`BEXE_call(sr,(`BEXPR_closure (i,ts),_),a)) as x :: tail ->
424: (*
425: print_endline ("Untailed call " ^ si i ^ "["^catmap "," (sbt syms.dfns) ts^"]");
426: print_endline ("This = " ^ si this);
427: print_endline ("ts'=" ^"["^catmap "," (sbt syms.dfns) ts'^"]");
428: print_endline "TAIL=";
429: iter (fun x -> print_endline (string_of_bexe syms.dfns 0 x)) tail;
430: print_endline "-- end of tail --";
431: *)
432: aux tail (x::res)
433:
434: | [] -> rev res (* forward order *)
435: | h :: t -> aux t (h::res)
436: in
437: let exes = aux exes [] in
438:
439: (* instantiate any parameter temporaries *)
440: iter
441: (fun (paramtype, parameter) ->
442: let entry = `BBDCL_tmp (vs,paramtype) in
443: let kids =
444: try Hashtbl.find child_map this
445: with Not_found -> []
446: in
447: Hashtbl.replace child_map this (parameter::kids);
448: let id = "_trp_" ^ si parameter in
449: Hashtbl.add bbdfns parameter (id,Some this,sr,entry);
450: )
451: !parameters
452: ;
453: (* return with posssible label at start *)
454: let exes =
455: if !jump_done
456: then `BEXE_label (sr,start_label) :: exes
457: else exes
458: in
459: (*
460: print_endline ("Tailed exes = ");
461: iter (fun exe -> print_endline (string_of_bexe syms.dfns 0 exe)) exes;
462: *)
463: exes
464: