diff options
| -rw-r--r-- | asmcomp/cmmgen.ml | 20 | ||||
| -rw-r--r-- | asmcomp/proc_alpha.ml | 4 | ||||
| -rw-r--r-- | asmcomp/selection.ml | 17 |
3 files changed, 28 insertions, 13 deletions
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 2e885183c..045f8408d 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -41,11 +41,13 @@ let add_const c n = if n = 0 then c else Cop(Caddi, [c; Cconst_int n]) let incr_int = function - Cop(Caddi, [c; Cconst_int n]) -> add_const c (n+1) + Cconst_int n -> Cconst_int(n+1) + | Cop(Caddi, [c; Cconst_int n]) -> add_const c (n+1) | c -> add_const c 1 let decr_int = function - Cop(Caddi, [c; Cconst_int n]) -> add_const c (n-1) + Cconst_int n -> Cconst_int(n-1) + | Cop(Caddi, [c; Cconst_int n]) -> add_const c (n-1) | c -> add_const c (-1) let add_int c1 c2 = @@ -152,11 +154,11 @@ let array_indexing ptr ofs = | Cop(Caddi, [Cop(Clsl, [c; Cconst_int 1]); Cconst_int 1]) -> Cop(Cadda, [ptr; lsl_const c log2_size_addr]) | Cop(Caddi, [c; Cconst_int n]) -> - Cop(Cadda, [ptr; add_const (lsl_const c (log2_size_addr - 1)) - ((n - 1) lsl (log2_size_addr - 1))]) + Cop(Cadda, [Cop(Cadda, [ptr; lsl_const c (log2_size_addr - 1)]); + Cconst_int((n-1) lsl (log2_size_addr - 1))]) | _ -> - Cop(Cadda, [ptr; add_const (lsl_const ofs (log2_size_addr - 1)) - ((-1) lsl (log2_size_addr - 1))]) + Cop(Cadda, [Cop(Cadda, [ptr; lsl_const ofs (log2_size_addr - 1)]); + Cconst_int((-1) lsl (log2_size_addr - 1))]) (* String length *) @@ -370,8 +372,12 @@ let rec transl = function (bind "ref" (transl arg) (fun arg -> Cop(Cstore, [arg; add_const (Cop(Cload typ_int, [arg])) (n lsl 1)]))) + | Uprim(Pfloatofint, [arg]) -> + box_float(Cop(Cfloatofint, [untag_int(transl arg)])) + | Uprim(Pintoffloat, [arg]) -> + tag_int(Cop(Cintoffloat, [transl_unbox_float arg])) | Uprim(Pnegfloat, [arg]) -> - box_float(Cop(Caddf, [Cconst_float "0.0"; + box_float(Cop(Csubf, [Cconst_float "0.0"; transl_unbox_float arg])) | Uprim(Paddfloat, [arg1; arg2]) -> box_float(Cop(Caddf, [transl_unbox_float arg1; transl_unbox_float arg2])) diff --git a/asmcomp/proc_alpha.ml b/asmcomp/proc_alpha.ml index d06b69139..1fd47742a 100644 --- a/asmcomp/proc_alpha.ml +++ b/asmcomp/proc_alpha.ml @@ -62,8 +62,8 @@ let is_immediate (n:int) = true $15 trap pointer $16 - $23 13 - 20 function arguments $24, $25 temporaries - $26-$30 stack ptr, global ptr, etc - $31 21 always zero + $26 - $30 stack ptr, global ptr, etc + $31 always zero $f0 - $f7 100 - 107 function results $f8 - $f15 108 - 115 general purpose ($f2 - $f9 preserved by C) diff --git a/asmcomp/selection.ml b/asmcomp/selection.ml index 71daa753b..b2c4a4f9b 100644 --- a/asmcomp/selection.ml +++ b/asmcomp/selection.ml @@ -48,11 +48,20 @@ let rec size_expr env = function | _ -> fatal_error "Selection.size_expr" -(* Says if an operation is "safe", i.e. without side-effects *) - -let safe_operation = function +(* Says if an operation is "cheap". A "cheap" operation is an operation + without side-effects and whose execution can be delayed until its value + is really needed. In the case of e.g. an [alloc] instruction, + the non-cheap parts of arguments are computed in right-to-left order + first, then the block is allocated, then the cheap parts are evaluated + and stored. *) + +let cheap_operation = function + (* The following may have side effects *) Capply _ | Cextcall(_, _, _) | Calloc | Cstore | Cstorechunk _ | Cmodify | Craise -> false + (* The following are expensive to compute, better start them early *) + | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat -> false + (* The remaining operations are cheap *) | _ -> true (* Default instruction selection for operators *) @@ -463,7 +472,7 @@ and emit_parts env exp seq = (Ctuple explist, env) | Clet(id, arg, body) -> emit_parts (emit_let env id arg seq) body seq - | Cop(op, args) when safe_operation op -> + | Cop(op, args) when cheap_operation op -> let (new_args, new_env) = emit_parts_list env args seq in (Cop(op, new_args), new_env) | _ -> |