Skip to content

Instantly share code, notes, and snippets.

@thata

thata/min-caml_sparc_ppc.diff

Created March 21, 2019 11:07
Show Gist options
  • Save thata/0baf2240533ce112f1b117f5cfd65fb6 to your computer and use it in GitHub Desktop.
Save thata/0baf2240533ce112f1b117f5cfd65fb6 to your computer and use it in GitHub Desktop.
Download ZIP
MinCamlのSparcとPowerPCのdiff
Raw
min-caml_sparc_ppc.diff
diff -u SPARC/asm.ml PowerPC/asm.ml
--- SPARC/asm.ml 2019-03-19 21:12:59.000000000 +0900
+++ PowerPC/asm.ml 2019-03-19 21:12:59.000000000 +0900
@@ -1,4 +1,4 @@
-(* SPARC assembly with a few virtual instructions *)
+(* PowerPC assembly with a few virtual instructions *)
type id_or_imm = V of Id.t | C of int
type t = (* 命令の列 (caml2html: sparcasm_t) *)
@@ -6,23 +6,24 @@
| Let of (Id.t * Type.t) * exp * t
and exp = (* 一つ一つの命令に対応する式 (caml2html: sparcasm_exp) *)
| Nop
- | Set of int
+ | Li of int
+ | FLi of Id.l
| SetL of Id.l
- | Mov of Id.t
+ | Mr of Id.t
| Neg of Id.t
| Add of Id.t * id_or_imm
| Sub of Id.t * id_or_imm
- | SLL of Id.t * id_or_imm
- | Ld of Id.t * id_or_imm
- | St of Id.t * Id.t * id_or_imm
- | FMovD of Id.t
- | FNegD of Id.t
- | FAddD of Id.t * Id.t
- | FSubD of Id.t * Id.t
- | FMulD of Id.t * Id.t
- | FDivD of Id.t * Id.t
- | LdDF of Id.t * id_or_imm
- | StDF of Id.t * Id.t * id_or_imm
+ | Slw of Id.t * id_or_imm
+ | Lwz of Id.t * id_or_imm
+ | Stw of Id.t * Id.t * id_or_imm
+ | FMr of Id.t
+ | FNeg of Id.t
+ | FAdd of Id.t * Id.t
+ | FSub of Id.t * Id.t
+ | FMul of Id.t * Id.t
+ | FDiv of Id.t * Id.t
+ | Lfd of Id.t * id_or_imm
+ | Stfd of Id.t * Id.t * id_or_imm
| Comment of string
(* virtual instructions *)
| IfEq of Id.t * id_or_imm * t * t
@@ -42,30 +43,21 @@
let fletd(x, e1, e2) = Let((x, Type.Float), e1, e2)
let seq(e1, e2) = Let((Id.gentmp Type.Unit, Type.Unit), e1, e2)
-let regs = (* Array.init 16 (fun i -> Printf.sprintf "%%r%d" i) *)
- [| "%i2"; "%i3"; "%i4"; "%i5";
- "%l0"; "%l1"; "%l2"; "%l3"; "%l4"; "%l5"; "%l6"; "%l7";
- "%o0"; "%o1"; "%o2"; "%o3"; "%o4"; "%o5" |]
-let fregs = Array.init 16 (fun i -> Printf.sprintf "%%f%d" (i * 2))
+let regs = (* Array.init 27 (fun i -> Printf.sprintf "_R_%d" i) *)
+ [| "%r2"; "%r5"; "%r6"; "%r7"; "%r8"; "%r9"; "%r10";
+ "%r11"; "%r12"; "%r13"; "%r14"; "%r15"; "%r16"; "%r17"; "%r18";
+ "%r19"; "%r20"; "%r21"; "%r22"; "%r23"; "%r24"; "%r25"; "%r26";
+ "%r27"; "%r28"; "%r29"; "%r30" |]
+let fregs = Array.init 32 (fun i -> Printf.sprintf "%%f%d" i)
let allregs = Array.to_list regs
let allfregs = Array.to_list fregs
let reg_cl = regs.(Array.length regs - 1) (* closure address (caml2html: sparcasm_regcl) *)
let reg_sw = regs.(Array.length regs - 2) (* temporary for swap *)
let reg_fsw = fregs.(Array.length fregs - 1) (* temporary for swap *)
-let reg_sp = "%i0" (* stack pointer *)
-let reg_hp = "%i1" (* heap pointer (caml2html: sparcasm_reghp) *)
-let reg_ra = "%o7" (* return address *)
+let reg_sp = "%r3" (* stack pointer *)
+let reg_hp = "%r4" (* heap pointer (caml2html: sparcasm_reghp) *)
+let reg_tmp = "%r31" (* [XX] ad hoc *)
let is_reg x = (x.[0] = '%')
-let co_freg_table =
- let ht = Hashtbl.create 16 in
- for i = 0 to 15 do
- Hashtbl.add
- ht
- (Printf.sprintf "%%f%d" (i * 2))
- (Printf.sprintf "%%f%d" (i * 2 + 1))
- done;
- ht
-let co_freg freg = Hashtbl.find co_freg_table freg (* "companion" freg *)
(* super-tenuki *)
let rec remove_and_uniq xs = function
@@ -76,12 +68,12 @@
(* free variables in the order of use (for spilling) (caml2html: sparcasm_fv) *)
let fv_id_or_imm = function V(x) -> [x] | _ -> []
let rec fv_exp = function
- | Nop | Set(_) | SetL(_) | Comment(_) | Restore(_) -> []
- | Mov(x) | Neg(x) | FMovD(x) | FNegD(x) | Save(x, _) -> [x]
- | Add(x, y') | Sub(x, y') | SLL(x, y') | Ld(x, y') | LdDF(x, y') -> x :: fv_id_or_imm y'
- | St(x, y, z') | StDF(x, y, z') -> x :: y :: fv_id_or_imm z'
- | FAddD(x, y) | FSubD(x, y) | FMulD(x, y) | FDivD(x, y) -> [x; y]
- | IfEq(x, y', e1, e2) | IfLE(x, y', e1, e2) | IfGE(x, y', e1, e2) -> x :: fv_id_or_imm y' @ remove_and_uniq S.empty (fv e1 @ fv e2) (* uniq here just for efficiency *)
+ | Nop | Li(_) | FLi(_) | SetL(_) | Comment(_) | Restore(_) -> []
+ | Mr(x) | Neg(x) | FMr(x) | FNeg(x) | Save(x, _) -> [x]
+ | Add(x, y') | Sub(x, y') | Slw(x, y') | Lfd(x, y') | Lwz(x, y') -> x :: fv_id_or_imm y'
+ | Stw(x, y, z') | Stfd(x, y, z') -> x :: y :: fv_id_or_imm z'
+ | FAdd(x, y) | FSub(x, y) | FMul(x, y) | FDiv(x, y) -> [x; y]
+ | IfEq(x, y', e1, e2) | IfLE(x, y', e1, e2) | IfGE(x, y', e1, e2) -> x :: fv_id_or_imm y' @ remove_and_uniq S.empty (fv e1 @ fv e2) (* uniq here just for efficiency *)
| IfFEq(x, y, e1, e2) | IfFLE(x, y, e1, e2) -> x :: y :: remove_and_uniq S.empty (fv e1 @ fv e2) (* uniq here just for efficiency *)
| CallCls(x, ys, zs) -> x :: ys @ zs
| CallDir(_, ys, zs) -> ys @ zs
diff -u SPARC/asm.mli PowerPC/asm.mli
--- SPARC/asm.mli 2019-01-04 15:29:53.000000000 +0900
+++ PowerPC/asm.mli 2019-01-04 15:29:53.000000000 +0900
@@ -4,23 +4,24 @@
| Let of (Id.t * Type.t) * exp * t
and exp =
| Nop
- | Set of int
+ | Li of int
+ | FLi of Id.l
| SetL of Id.l
- | Mov of Id.t
+ | Mr of Id.t
| Neg of Id.t
| Add of Id.t * id_or_imm
| Sub of Id.t * id_or_imm
- | SLL of Id.t * id_or_imm
- | Ld of Id.t * id_or_imm
- | St of Id.t * Id.t * id_or_imm
- | FMovD of Id.t
- | FNegD of Id.t
- | FAddD of Id.t * Id.t
- | FSubD of Id.t * Id.t
- | FMulD of Id.t * Id.t
- | FDivD of Id.t * Id.t
- | LdDF of Id.t * id_or_imm
- | StDF of Id.t * Id.t * id_or_imm
+ | Slw of Id.t * id_or_imm
+ | Lwz of Id.t * id_or_imm
+ | Stw of Id.t * Id.t * id_or_imm
+ | FMr of Id.t
+ | FNeg of Id.t
+ | FAdd of Id.t * Id.t
+ | FSub of Id.t * Id.t
+ | FMul of Id.t * Id.t
+ | FDiv of Id.t * Id.t
+ | Lfd of Id.t * id_or_imm
+ | Stfd of Id.t * Id.t * id_or_imm
| Comment of string
(* virtual instructions *)
| IfEq of Id.t * id_or_imm * t * t
@@ -46,11 +47,10 @@
val reg_cl : Id.t
val reg_sw : Id.t
val reg_fsw : Id.t
-val reg_ra : Id.t
val reg_hp : Id.t
val reg_sp : Id.t
+val reg_tmp : Id.t
val is_reg : Id.t -> bool
-val co_freg : Id.t -> Id.t
val fv : t -> Id.t list
val concat : t -> Id.t * Type.t -> t -> t
diff -u SPARC/emit.ml PowerPC/emit.ml
--- SPARC/emit.ml 2019-03-19 21:12:59.000000000 +0900
+++ PowerPC/emit.ml 2019-03-19 21:12:59.000000000 +0900
@@ -24,9 +24,16 @@
let offset x = 4 * List.hd (locate x)
let stacksize () = align ((List.length !stackmap + 1) * 4)
-let pp_id_or_imm = function
- | V(x) -> x
- | C(i) -> string_of_int i
+let reg r =
+ if is_reg r
+ then String.sub r 1 (String.length r - 1)
+ else r
+
+let load_label r label =
+ let r' = reg r in
+ Printf.sprintf
+ "\tlis\t%s, ha16(%s)\n\taddi\t%s, %s, lo16(%s)\n"
+ r' label r' r' label
(* 関数呼び出しのために引数を並べ替える(register shuffling) (caml2html: emit_shuffle) *)
let rec shuffle sw xys =
@@ -52,139 +59,163 @@
and g' oc = function (* 各命令のアセンブリ生成 (caml2html: emit_gprime) *)
(* 末尾でなかったら計算結果をdestにセット (caml2html: emit_nontail) *)
| NonTail(_), Nop -> ()
- | NonTail(x), Set(i) -> Printf.fprintf oc "\tset\t%d, %s\n" i x
- | NonTail(x), SetL(Id.L(y)) -> Printf.fprintf oc "\tset\t%s, %s\n" y x
- | NonTail(x), Mov(y) when x = y -> ()
- | NonTail(x), Mov(y) -> Printf.fprintf oc "\tmov\t%s, %s\n" y x
- | NonTail(x), Neg(y) -> Printf.fprintf oc "\tneg\t%s, %s\n" y x
- | NonTail(x), Add(y, z') -> Printf.fprintf oc "\tadd\t%s, %s, %s\n" y (pp_id_or_imm z') x
- | NonTail(x), Sub(y, z') -> Printf.fprintf oc "\tsub\t%s, %s, %s\n" y (pp_id_or_imm z') x
- | NonTail(x), SLL(y, z') -> Printf.fprintf oc "\tsll\t%s, %s, %s\n" y (pp_id_or_imm z') x
- | NonTail(x), Ld(y, z') -> Printf.fprintf oc "\tld\t[%s + %s], %s\n" y (pp_id_or_imm z') x
- | NonTail(_), St(x, y, z') -> Printf.fprintf oc "\tst\t%s, [%s + %s]\n" x y (pp_id_or_imm z')
- | NonTail(x), FMovD(y) when x = y -> ()
- | NonTail(x), FMovD(y) ->
- Printf.fprintf oc "\tfmovs\t%s, %s\n" y x;
- Printf.fprintf oc "\tfmovs\t%s, %s\n" (co_freg y) (co_freg x)
- | NonTail(x), FNegD(y) ->
- Printf.fprintf oc "\tfnegs\t%s, %s\n" y x;
- if x <> y then Printf.fprintf oc "\tfmovs\t%s, %s\n" (co_freg y) (co_freg x)
- | NonTail(x), FAddD(y, z) -> Printf.fprintf oc "\tfaddd\t%s, %s, %s\n" y z x
- | NonTail(x), FSubD(y, z) -> Printf.fprintf oc "\tfsubd\t%s, %s, %s\n" y z x
- | NonTail(x), FMulD(y, z) -> Printf.fprintf oc "\tfmuld\t%s, %s, %s\n" y z x
- | NonTail(x), FDivD(y, z) -> Printf.fprintf oc "\tfdivd\t%s, %s, %s\n" y z x
- | NonTail(x), LdDF(y, z') -> Printf.fprintf oc "\tldd\t[%s + %s], %s\n" y (pp_id_or_imm z') x
- | NonTail(_), StDF(x, y, z') -> Printf.fprintf oc "\tstd\t%s, [%s + %s]\n" x y (pp_id_or_imm z')
- | NonTail(_), Comment(s) -> Printf.fprintf oc "\t! %s\n" s
+ | NonTail(x), Li(i) when -32768 <= i && i < 32768 -> Printf.fprintf oc "\tli\t%s, %d\n" (reg x) i
+ | NonTail(x), Li(i) ->
+ let n = i lsr 16 in
+ let m = i lxor (n lsl 16) in
+ let r = reg x in
+ Printf.fprintf oc "\tlis\t%s, %d\n" r n;
+ Printf.fprintf oc "\tori\t%s, %s, %d\n" r r m
+ | NonTail(x), FLi(Id.L(l)) ->
+ let s = load_label (reg reg_tmp) l in
+ Printf.fprintf oc "%s\tlfd\t%s, 0(%s)\n" s (reg x) (reg reg_tmp)
+ | NonTail(x), SetL(Id.L(y)) ->
+ let s = load_label x y in
+ Printf.fprintf oc "%s" s
+ | NonTail(x), Mr(y) when x = y -> ()
+ | NonTail(x), Mr(y) -> Printf.fprintf oc "\tmr\t%s, %s\n" (reg x) (reg y)
+ | NonTail(x), Neg(y) -> Printf.fprintf oc "\tneg\t%s, %s\n" (reg x) (reg y)
+ | NonTail(x), Add(y, V(z)) -> Printf.fprintf oc "\tadd\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), Add(y, C(z)) -> Printf.fprintf oc "\taddi\t%s, %s, %d\n" (reg x) (reg y) z
+ | NonTail(x), Sub(y, V(z)) -> Printf.fprintf oc "\tsub\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), Sub(y, C(z)) -> Printf.fprintf oc "\tsubi\t%s, %s, %d\n" (reg x) (reg y) z
+ | NonTail(x), Slw(y, V(z)) -> Printf.fprintf oc "\tslw\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), Slw(y, C(z)) -> Printf.fprintf oc "\tslwi\t%s, %s, %d\n" (reg x) (reg y) z
+ | NonTail(x), Lwz(y, V(z)) -> Printf.fprintf oc "\tlwzx\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), Lwz(y, C(z)) -> Printf.fprintf oc "\tlwz\t%s, %d(%s)\n" (reg x) z (reg y)
+ | NonTail(_), Stw(x, y, V(z)) -> Printf.fprintf oc "\tstwx\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(_), Stw(x, y, C(z)) -> Printf.fprintf oc "\tstw\t%s, %d(%s)\n" (reg x) z (reg y)
+ | NonTail(x), FMr(y) when x = y -> ()
+ | NonTail(x), FMr(y) -> Printf.fprintf oc "\tfmr\t%s, %s\n" (reg x) (reg y)
+ | NonTail(x), FNeg(y) -> Printf.fprintf oc "\tfneg\t%s, %s\n" (reg x) (reg y)
+ | NonTail(x), FAdd(y, z) -> Printf.fprintf oc "\tfadd\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), FSub(y, z) -> Printf.fprintf oc "\tfsub\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), FMul(y, z) -> Printf.fprintf oc "\tfmul\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), FDiv(y, z) -> Printf.fprintf oc "\tfdiv\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), Lfd(y, V(z)) -> Printf.fprintf oc "\tlfdx\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(x), Lfd(y, C(z)) -> Printf.fprintf oc "\tlfd\t%s, %d(%s)\n" (reg x) z (reg y)
+ | NonTail(_), Stfd(x, y, V(z)) -> Printf.fprintf oc "\tstfdx\t%s, %s, %s\n" (reg x) (reg y) (reg z)
+ | NonTail(_), Stfd(x, y, C(z)) -> Printf.fprintf oc "\tstfd\t%s, %d(%s)\n" (reg x) z (reg y)
+ | NonTail(_), Comment(s) -> Printf.fprintf oc "#\t%s\n" s
(* 退避の仮想命令の実装 (caml2html: emit_save) *)
| NonTail(_), Save(x, y) when List.mem x allregs && not (S.mem y !stackset) ->
save y;
- Printf.fprintf oc "\tst\t%s, [%s + %d]\n" x reg_sp (offset y)
+ Printf.fprintf oc "\tstw\t%s, %d(%s)\n" (reg x) (offset y) (reg reg_sp)
| NonTail(_), Save(x, y) when List.mem x allfregs && not (S.mem y !stackset) ->
savef y;
- Printf.fprintf oc "\tstd\t%s, [%s + %d]\n" x reg_sp (offset y)
+ Printf.fprintf oc "\tstfd\t%s, %d(%s)\n" (reg x) (offset y) (reg reg_sp)
| NonTail(_), Save(x, y) -> assert (S.mem y !stackset); ()
(* 復帰の仮想命令の実装 (caml2html: emit_restore) *)
| NonTail(x), Restore(y) when List.mem x allregs ->
- Printf.fprintf oc "\tld\t[%s + %d], %s\n" reg_sp (offset y) x
+ Printf.fprintf oc "\tlwz\t%s, %d(%s)\n" (reg x) (offset y) (reg reg_sp)
| NonTail(x), Restore(y) ->
assert (List.mem x allfregs);
- Printf.fprintf oc "\tldd\t[%s + %d], %s\n" reg_sp (offset y) x
+ Printf.fprintf oc "\tlfd\t%s, %d(%s)\n" (reg x) (offset y) (reg reg_sp)
(* 末尾だったら計算結果を第一レジスタにセットしてリターン (caml2html: emit_tailret) *)
- | Tail, (Nop | St _ | StDF _ | Comment _ | Save _ as exp) ->
+ | Tail, (Nop | Stw _ | Stfd _ | Comment _ | Save _ as exp) ->
g' oc (NonTail(Id.gentmp Type.Unit), exp);
- Printf.fprintf oc "\tretl\n";
- Printf.fprintf oc "\tnop\n"
- | Tail, (Set _ | SetL _ | Mov _ | Neg _ | Add _ | Sub _ | SLL _ | Ld _ as exp) ->
+ Printf.fprintf oc "\tblr\n";
+ | Tail, (Li _ | SetL _ | Mr _ | Neg _ | Add _ | Sub _ | Slw _ | Lwz _ as exp) ->
g' oc (NonTail(regs.(0)), exp);
- Printf.fprintf oc "\tretl\n";
- Printf.fprintf oc "\tnop\n"
- | Tail, (FMovD _ | FNegD _ | FAddD _ | FSubD _ | FMulD _ | FDivD _ | LdDF _ as exp) ->
+ Printf.fprintf oc "\tblr\n";
+ | Tail, (FLi _ | FMr _ | FNeg _ | FAdd _ | FSub _ | FMul _ | FDiv _ | Lfd _ as exp) ->
g' oc (NonTail(fregs.(0)), exp);
- Printf.fprintf oc "\tretl\n";
- Printf.fprintf oc "\tnop\n"
+ Printf.fprintf oc "\tblr\n";
| Tail, (Restore(x) as exp) ->
(match locate x with
| [i] -> g' oc (NonTail(regs.(0)), exp)
| [i; j] when i + 1 = j -> g' oc (NonTail(fregs.(0)), exp)
| _ -> assert false);
- Printf.fprintf oc "\tretl\n";
- Printf.fprintf oc "\tnop\n"
- | Tail, IfEq(x, y', e1, e2) ->
- Printf.fprintf oc "\tcmp\t%s, %s\n" x (pp_id_or_imm y');
- g'_tail_if oc e1 e2 "be" "bne"
- | Tail, IfLE(x, y', e1, e2) ->
- Printf.fprintf oc "\tcmp\t%s, %s\n" x (pp_id_or_imm y');
- g'_tail_if oc e1 e2 "ble" "bg"
- | Tail, IfGE(x, y', e1, e2) ->
- Printf.fprintf oc "\tcmp\t%s, %s\n" x (pp_id_or_imm y');
- g'_tail_if oc e1 e2 "bge" "bl"
+ Printf.fprintf oc "\tblr\n";
+ | Tail, IfEq(x, V(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_tail_if oc e1 e2 "beq" "bne"
+ | Tail, IfEq(x, C(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;
+ g'_tail_if oc e1 e2 "beq" "bne"
+ | Tail, IfLE(x, V(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_tail_if oc e1 e2 "ble" "bgt"
+ | Tail, IfLE(x, C(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;
+ g'_tail_if oc e1 e2 "ble" "bgt"
+ | Tail, IfGE(x, V(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_tail_if oc e1 e2 "bge" "blt"
+ | Tail, IfGE(x, C(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;
+ g'_tail_if oc e1 e2 "bge" "blt"
| Tail, IfFEq(x, y, e1, e2) ->
- Printf.fprintf oc "\tfcmpd\t%s, %s\n" x y;
- Printf.fprintf oc "\tnop\n";
- g'_tail_if oc e1 e2 "fbe" "fbne"
+ Printf.fprintf oc "\tfcmpu\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_tail_if oc e1 e2 "beq" "bne"
| Tail, IfFLE(x, y, e1, e2) ->
- Printf.fprintf oc "\tfcmpd\t%s, %s\n" x y;
- Printf.fprintf oc "\tnop\n";
- g'_tail_if oc e1 e2 "fble" "fbg"
- | NonTail(z), IfEq(x, y', e1, e2) ->
- Printf.fprintf oc "\tcmp\t%s, %s\n" x (pp_id_or_imm y');
- g'_non_tail_if oc (NonTail(z)) e1 e2 "be" "bne"
- | NonTail(z), IfLE(x, y', e1, e2) ->
- Printf.fprintf oc "\tcmp\t%s, %s\n" x (pp_id_or_imm y');
- g'_non_tail_if oc (NonTail(z)) e1 e2 "ble" "bg"
- | NonTail(z), IfGE(x, y', e1, e2) ->
- Printf.fprintf oc "\tcmp\t%s, %s\n" x (pp_id_or_imm y');
- g'_non_tail_if oc (NonTail(z)) e1 e2 "bge" "bl"
+ Printf.fprintf oc "\tfcmpu\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_tail_if oc e1 e2 "ble" "bgt"
+ | NonTail(z), IfEq(x, V(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_non_tail_if oc (NonTail(z)) e1 e2 "beq" "bne"
+ | NonTail(z), IfEq(x, C(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;
+ g'_non_tail_if oc (NonTail(z)) e1 e2 "beq" "bne"
+ | NonTail(z), IfLE(x, V(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_non_tail_if oc (NonTail(z)) e1 e2 "ble" "bgt"
+ | NonTail(z), IfLE(x, C(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;
+ g'_non_tail_if oc (NonTail(z)) e1 e2 "ble" "bgt"
+ | NonTail(z), IfGE(x, V(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_non_tail_if oc (NonTail(z)) e1 e2 "bge" "blt"
+ | NonTail(z), IfGE(x, C(y), e1, e2) ->
+ Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;
+ g'_non_tail_if oc (NonTail(z)) e1 e2 "bge" "blt"
| NonTail(z), IfFEq(x, y, e1, e2) ->
- Printf.fprintf oc "\tfcmpd\t%s, %s\n" x y;
- Printf.fprintf oc "\tnop\n";
- g'_non_tail_if oc (NonTail(z)) e1 e2 "fbe" "fbne"
+ Printf.fprintf oc "\tfcmpu\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_non_tail_if oc (NonTail(z)) e1 e2 "beq" "bne"
| NonTail(z), IfFLE(x, y, e1, e2) ->
- Printf.fprintf oc "\tfcmpd\t%s, %s\n" x y;
- Printf.fprintf oc "\tnop\n";
- g'_non_tail_if oc (NonTail(z)) e1 e2 "fble" "fbg"
+ Printf.fprintf oc "\tfcmpu\tcr7, %s, %s\n" (reg x) (reg y);
+ g'_non_tail_if oc (NonTail(z)) e1 e2 "ble" "bgt"
(* 関数呼び出しの仮想命令の実装 (caml2html: emit_call) *)
| Tail, CallCls(x, ys, zs) -> (* 末尾呼び出し (caml2html: emit_tailcall) *)
g'_args oc [(x, reg_cl)] ys zs;
- Printf.fprintf oc "\tld\t[%s + 0], %s\n" reg_cl reg_sw;
- Printf.fprintf oc "\tjmp\t%s\n" reg_sw;
- Printf.fprintf oc "\tnop\n"
+ Printf.fprintf oc "\tlwz\t%s, 0(%s)\n" (reg reg_sw) (reg reg_cl);
+ Printf.fprintf oc "\tmtctr\t%s\n\tbctr\n" (reg reg_sw);
| Tail, CallDir(Id.L(x), ys, zs) -> (* 末尾呼び出し *)
g'_args oc [] ys zs;
- Printf.fprintf oc "\tb\t%s\n" x;
- Printf.fprintf oc "\tnop\n"
+ Printf.fprintf oc "\tb\t%s\n" x
| NonTail(a), CallCls(x, ys, zs) ->
+ Printf.fprintf oc "\tmflr\t%s\n" (reg reg_tmp);
g'_args oc [(x, reg_cl)] ys zs;
let ss = stacksize () in
- Printf.fprintf oc "\tst\t%s, [%s + %d]\n" reg_ra reg_sp (ss - 4);
- Printf.fprintf oc "\tld\t[%s + 0], %s\n" reg_cl reg_sw;
- Printf.fprintf oc "\tcall\t%s\n" reg_sw;
- Printf.fprintf oc "\tadd\t%s, %d, %s\t! delay slot\n" reg_sp ss reg_sp;
- Printf.fprintf oc "\tsub\t%s, %d, %s\n" reg_sp ss reg_sp;
- Printf.fprintf oc "\tld\t[%s + %d], %s\n" reg_sp (ss - 4) reg_ra;
+ Printf.fprintf oc "\tstw\t%s, %d(%s)\n" (reg reg_tmp) (ss - 4) (reg reg_sp);
+ Printf.fprintf oc "\taddi\t%s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;
+ Printf.fprintf oc "\tlwz\t%s, 0(%s)\n" (reg reg_tmp) (reg reg_cl);
+ Printf.fprintf oc "\tmtctr\t%s\n" (reg reg_tmp);
+ Printf.fprintf oc "\tbctrl\n";
+ Printf.fprintf oc "\tsubi\t%s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;
+ Printf.fprintf oc "\tlwz\t%s, %d(%s)\n" (reg reg_tmp) (ss - 4) (reg reg_sp);
if List.mem a allregs && a <> regs.(0) then
- Printf.fprintf oc "\tmov\t%s, %s\n" regs.(0) a
+ Printf.fprintf oc "\tmr\t%s, %s\n" (reg a) (reg regs.(0))
else if List.mem a allfregs && a <> fregs.(0) then
- (Printf.fprintf oc "\tfmovs\t%s, %s\n" fregs.(0) a;
- Printf.fprintf oc "\tfmovs\t%s, %s\n" (co_freg fregs.(0)) (co_freg a))
- | NonTail(a), CallDir(Id.L(x), ys, zs) ->
+ Printf.fprintf oc "\tfmr\t%s, %s\n" (reg a) (reg fregs.(0));
+ Printf.fprintf oc "\tmtlr\t%s\n" (reg reg_tmp)
+ | (NonTail(a), CallDir(Id.L(x), ys, zs)) ->
+ Printf.fprintf oc "\tmflr\t%s\n" (reg reg_tmp);
g'_args oc [] ys zs;
let ss = stacksize () in
- Printf.fprintf oc "\tst\t%s, [%s + %d]\n" reg_ra reg_sp (ss - 4);
- Printf.fprintf oc "\tcall\t%s\n" x;
- Printf.fprintf oc "\tadd\t%s, %d, %s\t! delay slot\n" reg_sp ss reg_sp;
- Printf.fprintf oc "\tsub\t%s, %d, %s\n" reg_sp ss reg_sp;
- Printf.fprintf oc "\tld\t[%s + %d], %s\n" reg_sp (ss - 4) reg_ra;
+ Printf.fprintf oc "\tstw\t%s, %d(%s)\n" (reg reg_tmp) (ss - 4) (reg reg_sp);
+ Printf.fprintf oc "\taddi\t%s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;
+ Printf.fprintf oc "\tbl\t%s\n" x;
+ Printf.fprintf oc "\tsubi\t%s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;
+ Printf.fprintf oc "\tlwz\t%s, %d(%s)\n" (reg reg_tmp) (ss - 4) (reg reg_sp);
if List.mem a allregs && a <> regs.(0) then
- Printf.fprintf oc "\tmov\t%s, %s\n" regs.(0) a
+ Printf.fprintf oc "\tmr\t%s, %s\n" (reg a) (reg regs.(0))
else if List.mem a allfregs && a <> fregs.(0) then
- (Printf.fprintf oc "\tfmovs\t%s, %s\n" fregs.(0) a;
- Printf.fprintf oc "\tfmovs\t%s, %s\n" (co_freg fregs.(0)) (co_freg a))
+ Printf.fprintf oc "\tfmr\t%s, %s\n" (reg a) (reg fregs.(0));
+ Printf.fprintf oc "\tmtlr\t%s\n" (reg reg_tmp)
and g'_tail_if oc e1 e2 b bn =
let b_else = Id.genid (b ^ "_else") in
- Printf.fprintf oc "\t%s\t%s\n" bn b_else;
- Printf.fprintf oc "\tnop\n";
+ Printf.fprintf oc "\t%s\tcr7, %s\n" bn b_else;
let stackset_back = !stackset in
g oc (Tail, e1);
Printf.fprintf oc "%s:\n" b_else;
@@ -193,13 +224,11 @@
and g'_non_tail_if oc dest e1 e2 b bn =
let b_else = Id.genid (b ^ "_else") in
let b_cont = Id.genid (b ^ "_cont") in
- Printf.fprintf oc "\t%s\t%s\n" bn b_else;
- Printf.fprintf oc "\tnop\n";
+ Printf.fprintf oc "\t%s\tcr7, %s\n" bn b_else;
let stackset_back = !stackset in
g oc (dest, e1);
let stackset1 = !stackset in
Printf.fprintf oc "\tb\t%s\n" b_cont;
- Printf.fprintf oc "\tnop\n";
Printf.fprintf oc "%s:\n" b_else;
stackset := stackset_back;
g oc (dest, e2);
@@ -213,7 +242,7 @@
(0, x_reg_cl)
ys in
List.iter
- (fun (y, r) -> Printf.fprintf oc "\tmov\t%s, %s\n" y r)
+ (fun (y, r) -> Printf.fprintf oc "\tmr\t%s, %s\n" (reg r) (reg y))
(shuffle reg_sw yrs);
let (d, zfrs) =
List.fold_left
@@ -221,9 +250,7 @@
(0, [])
zs in
List.iter
- (fun (z, fr) ->
- Printf.fprintf oc "\tfmovs\t%s, %s\n" z fr;
- Printf.fprintf oc "\tfmovs\t%s, %s\n" (co_freg z) (co_freg fr))
+ (fun (z, fr) -> Printf.fprintf oc "\tfmr\t%s, %s\n" (reg fr) (reg z))
(shuffle reg_fsw zfrs)
let h oc { name = Id.L(x); args = _; fargs = _; body = e; ret = _ } =
@@ -234,21 +261,32 @@
let f oc (Prog(data, fundefs, e)) =
Format.eprintf "generating assembly...@.";
- Printf.fprintf oc ".section\t\".rodata\"\n";
- Printf.fprintf oc ".align\t8\n";
- List.iter
- (fun (Id.L(x), d) ->
- Printf.fprintf oc "%s:\t! %f\n" x d;
- Printf.fprintf oc "\t.long\t0x%lx\n" (gethi d);
- Printf.fprintf oc "\t.long\t0x%lx\n" (getlo d))
- data;
- Printf.fprintf oc ".section\t\".text\"\n";
+ if data <> [] then
+ (Printf.fprintf oc "\t.data\n\t.literal8\n";
+ List.iter
+ (fun (Id.L(x), d) ->
+ Printf.fprintf oc "\t.align 3\n";
+ Printf.fprintf oc "%s:\t # %f\n" x d;
+ Printf.fprintf oc "\t.long\t%ld\n" (gethi d);
+ Printf.fprintf oc "\t.long\t%ld\n" (getlo d))
+ data);
+ Printf.fprintf oc "\t.text\n";
+ Printf.fprintf oc "\t.globl _min_caml_start\n";
+ Printf.fprintf oc "\t.align 2\n";
List.iter (fun fundef -> h oc fundef) fundefs;
- Printf.fprintf oc ".global\tmin_caml_start\n";
- Printf.fprintf oc "min_caml_start:\n";
- Printf.fprintf oc "\tsave\t%%sp, -112, %%sp\n"; (* from gcc; why 112? *)
+ Printf.fprintf oc "_min_caml_start: # main entry point\n";
+ Printf.fprintf oc "\tmflr\tr0\n";
+ Printf.fprintf oc "\tstmw\tr30, -8(r1)\n";
+ Printf.fprintf oc "\tstw\tr0, 8(r1)\n";
+ Printf.fprintf oc "\tstwu\tr1, -96(r1)\n";
+ Printf.fprintf oc "#\tmain program starts\n";
stackset := S.empty;
stackmap := [];
- g oc (NonTail("%g0"), e);
- Printf.fprintf oc "\tret\n";
- Printf.fprintf oc "\trestore\n"
+ g oc (NonTail("_R_0"), e);
+ Printf.fprintf oc "#\tmain program ends\n";
+ (* Printf.fprintf oc "\tmr\tr3, %s\n" regs.(0); *)
+ Printf.fprintf oc "\tlwz\tr1, 0(r1)\n";
+ Printf.fprintf oc "\tlwz\tr0, 8(r1)\n";
+ Printf.fprintf oc "\tmtlr\tr0\n";
+ Printf.fprintf oc "\tlmw\tr30, -8(r1)\n";
+ Printf.fprintf oc "\tblr\n"
diff -u SPARC/libmincaml.S PowerPC/libmincaml.S
--- SPARC/libmincaml.S 2019-01-04 15:29:53.000000000 +0900
+++ PowerPC/libmincaml.S 2019-01-04 15:29:53.000000000 +0900
@@ -1,197 +1,636 @@
-.section ".text"
-.global min_caml_print_newline
+ .cstring
+ .align 2
+LC0:
+ .ascii "%d\0"
+ .align 2
+LC1:
+ .ascii "%lf\0"
+ .literal8
+ .align 3
+LC2:
+ .long 1127219200
+ .long -2147483648
+ .text
+ .align 2
+ .globl min_caml_print_newline
min_caml_print_newline:
- set 10, %o0
- st %o7, [%i0]
- call putchar
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_print_int
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -80(r1)
+ mr r30, r1
+ li r3, 10
+ bl putchar
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+putchar:
+ .indirect_symbol _putchar
+ mflr r0
+ bcl 20, 31, L1spb
+L1spb:
+ mflr r11
+ addis r11, r11, ha16(putchar_lazy-L1spb)
+ mtlr r0
+ lwzu r12, lo16(putchar_lazy-L1spb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+putchar_lazy:
+ .indirect_symbol _putchar
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# print_int
+ .text
+ .align 2
+ .globl min_caml_print_int
min_caml_print_int:
- set format_int, %o0
- mov %i2, %o1
- st %o7, [%i0]
- call printf
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_print_byte
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -80(r1)
+ mr r30, r1
+ bcl 20, 31, L2pb
+L2pb:
+ mflr r31
+ mr r4, r2
+ addis r2, r31, ha16(LC0 - L2pb)
+ la r3, lo16(LC0 - L2pb)(r2)
+ bl printf
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+printf:
+ .indirect_symbol _printf$LDBLStub
+ mflr r0
+ bcl 20, 31, L2spb
+L2spb:
+ mflr r11
+ addis r11, r11, ha16(printf_lazy-L2spb)
+ mtlr r0
+ lwzu r12, lo16(printf_lazy-L2spb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+printf_lazy:
+ .indirect_symbol _printf$LDBLStub
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# print_byte
+ .text
+ .align 2
+ .globl min_caml_print_byte
min_caml_print_byte:
- mov %i2, %o0
- st %o7, [%i0]
- call putchar
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_prerr_int
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -80(r1)
+ mr r30, r1
+ stw r3, 104(r30)
+ mr r3, r2
+ bl putchar
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+# prerr_int
+ .text
+ .align 2
+ .globl min_caml_prerr_int
min_caml_prerr_int:
- set min_caml_stderr, %o0
- set format_int, %o1
- mov %i2, %o2
- st %o7, [%i0]
- call fprintf
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_prerr_byte
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -80(r1)
+ mr r30, r1
+ bcl 20, 31, L3pb
+L3pb:
+ mflr r31
+ mr r6, r2
+ mr r2, r5
+ mr r5, r6
+ addis r2, r31, ha16(L - L3pb)
+ lwz r2, lo16(L - L3pb)(r2)
+ addi r0, r2, 176
+ mr r3, r0
+ addis r2, r31, ha16(LC0 - L3pb)
+ la r4, lo16(LC0 - L3pb)(r2)
+ bl fprintf
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .non_lazy_symbol_pointer
+L:
+ .indirect_symbol ___sF
+ .long 0
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+fprintf:
+ .indirect_symbol _fprintf$LDBLStub
+ mflr r0
+ bcl 20, 31, L3spb
+L3spb:
+ mflr r11
+ addis r11, r11, ha16(fprintf_lazy - L3spb)
+ mtlr r0
+ lwzu r12, lo16(fprintf_lazy - L3spb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+fprintf_lazy:
+ .indirect_symbol _fprintf$LDBLStub
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# prerr_byte
+ .text
+ .align 2
+ .globl min_caml_prerr_byte
min_caml_prerr_byte:
- mov %i2, %o0
- set min_caml_stderr, %o1
- st %o7, [%i0]
- call fputc
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_prerr_float
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -80(r1)
+ mr r30, r1
+ bcl 20, 31, L4pb
+L4pb:
+ mflr r31
+ mr r3, r2
+ addis r2, r31, ha16(L - L4pb)
+ lwz r2, lo16(L - L4pb)(r2)
+ addi r0, r2, 176
+ mr r4, r0
+ bl fputc
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+fputc:
+ .indirect_symbol _fputc
+ mflr r0
+ bcl 20, 31, L4spb
+L4spb:
+ mflr r11
+ addis r11, r11, ha16(fputc_lazy - L4spb)
+ mtlr r0
+ lwzu r12, lo16(fputc_lazy - L4spb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+fputc_lazy:
+ .indirect_symbol _fputc
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# prerr_float
+ .text
+ .align 2
+ .globl min_caml_prerr_float
min_caml_prerr_float:
- set min_caml_stderr, %o0
- set format_float, %o1
- std %f0, [%i0]
- ldd [%i0], %o2
- st %o7, [%i0]
- call fprintf
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_read_int
+ mflr r0
+ stmw r29, -12(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -96(r1)
+ mr r30, r1
+ bcl 20, 31, L5pb
+L5pb:
+ mflr r31
+ addis r2, r31, ha16(L - L5pb)
+ lwz r2, lo16(L - L5pb)(r2)
+ addi r29, r2, 176
+ stfd f0, 64(r30)
+ lwz r2, 64(r30)
+ lwz r3, 68(r30)
+ mr r10, r3
+ mr r9, r2
+ stw r2, 64(r30)
+ stw r3, 68(r30)
+ lfd f13, 64(r30)
+# fmr f0, f13
+ mr r3, r29
+ addis r2, r31, ha16(LC1 - L5pb)
+ la r4, lo16(LC1 - L5pb)(r2)
+ mr r5, r9
+ mr r6, r10
+ fmr f1, f0
+ bl fprintf
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r29, -12(r1)
+ blr
+# read_int
+ .text
+ .align 2
+ .globl min_caml_read_int
min_caml_read_int:
- set format_int, %o0
- st %o7, [%i0]
- call scanf, 0
- add %fp, -20, %o1 ! delay slot
- ld [%i0], %o7
- ld [%fp-20], %i2
- retl
- nop
-.global min_caml_read_float
-min_caml_read_float:
- set format_float, %o0
- st %o7, [%i0]
- call scanf, 0
- add %fp, -24, %o1 ! delay slot
- ld [%i0], %o7
- ldd [%fp-24], %f0
- retl
- nop
-.global min_caml_create_array
-min_caml_create_array:
- mov %i2, %i4
- mov %i1, %i2
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -96(r1)
+ mr r30, r1
+ bcl 20, 31, L6pb
+L6pb:
+ mflr r31
+ addis r2, r31, ha16(LC0 - L6pb)
+ la r3, lo16(LC0 - L6pb)(r2)
+ addi r4, r30, 56
+ bl scanf
+ lwz r2, 56(r30)
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+scanf:
+ .indirect_symbol _scanf$LDBLStub
+ mflr r0
+ bcl 20, 31, L6spb
+L6spb:
+ mflr r11
+ addis r11, r11, ha16(scanf_lazy - L6spb)
+ mtlr r0
+ lwzu r12, lo16(scanf_lazy - L6spb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+scanf_lazy:
+ .indirect_symbol _scanf$LDBLStub
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# read_float
+ .text
+ .align 2
+ .globl min_caml_read_float
+min_caml_read_float:
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -112(r1)
+ mr r30, r1
+ bcl 20, 31, L7pb
+L7pb:
+ mflr r31
+ addis r2, r31, ha16(LC1 - L7pb)
+ la r3, lo16(LC1 - L7pb)(r2)
+ addi r4, r30, 56
+ bl scanf
+ lfd f0, 56(r30)
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+# create_array
+ .text
+ .align 2
+ .globl min_caml_create_array
+min_caml_create_array:
+ mr r6, r2
+ mr r2, r4
create_array_loop:
- tst %i4
- bnz create_array_cont
- nop
- andcc %i1, 4, %g0
- bz create_array_exit
- nop
- add %i1, 4, %i1
+ cmpwi cr7, r6, 0
+ bne cr7, create_array_cont
+ b create_array_exit
create_array_exit:
- retl
- nop
+ blr
create_array_cont:
- st %i3, [%i1]
- dec %i4
- add %i1, 4, %i1
+ stw r5, 0(r4)
+ subi r6, r6, 1
+ addi r4, r4, 4
b create_array_loop
- nop
-.global min_caml_create_float_array
+# create_float_array
+ .globl min_caml_create_float_array
min_caml_create_float_array:
- mov %i2, %i3
- mov %i1, %i2
+ mr r5, r2
+ mr r2, r4
create_float_array_loop:
- tst %i3
- bnz create_float_array_cont
- nop
- retl
- nop
+ cmpwi cr7, r5, 0
+ bne cr7, create_float_array_cont
+ blr
create_float_array_cont:
- std %f0, [%i1]
- dec %i3
- add %i1, 8, %i1
+ stfd f0, 0(r4)
+ subi r5, r5, 1
+ addi r4, r4, 8
b create_float_array_loop
- nop
-.global min_caml_abs_float
+ .globl min_caml_abs_float
min_caml_abs_float:
- fabss %f0, %f0
- retl
- nop
-.global min_caml_sqrt
+ fabs f0, f0
+ blr
+# sqrt
+ .text
+ .align 2
+ .globl min_caml_sqrt
min_caml_sqrt:
- fsqrtd %f0, %f0
- retl
- nop
-.global min_caml_floor
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -96(r1)
+ mr r30, r1
+ bcl 20, 31, L8pb
+L8pb:
+ mflr r31
+ fmr f1, f0
+ bl sqrt
+ fmr f0, f1
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+sqrt:
+ .indirect_symbol _sqrt
+ mflr r0
+ bcl 20, 31, L8spb
+L8spb:
+ mflr r11
+ addis r11, r11, ha16(sqrt_lazy - L8spb)
+ mtlr r0
+ lwzu r12, lo16(sqrt_lazy - L8spb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+sqrt_lazy:
+ .indirect_symbol _sqrt
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# floor
+ .text
+ .align 2
+ .globl min_caml_floor
min_caml_floor:
- std %f0, [%i0]
- ldd [%i0], %o0
- st %o7, [%i0]
- call floor
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_int_of_float
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -80(r1)
+ mr r30, r1
+ fmr f1, f0
+ stfd f1, 56(r30)
+ lfd f1, 56(r30)
+ bl floor
+ fmr f0, f1
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+floor:
+ .indirect_symbol _floor
+ mflr r0
+ bcl 20, 31, L9spb
+L9spb:
+ mflr r11
+ addis r11, r11, ha16(floor_lazy - L9spb)
+ mtlr r0
+ lwzu r12, lo16(floor_lazy - L9spb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+floor_lazy:
+ .indirect_symbol _floor
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# int_of_float, truncate
+ .text
+ .align 2
+ .globl min_caml_int_of_float
min_caml_int_of_float:
-.global min_caml_truncate
+ .globl min_caml_truncate
min_caml_truncate:
- fdtoi %f0, %f0
- st %f0, [%i0]
- ld [%i0], %i2
- retl
- nop
-.global min_caml_float_of_int
+ stmw r30, -8(r1)
+ stwu r1, -64(r1)
+ mr r30, r1
+ stfd f0, 24(r30)
+ lfd f1, 24(r30)
+ fctiwz f1, f1
+ stfd f1, 32(r30)
+ lwz r31, 36(r30)
+ mr r2, r31
+ lwz r1, 0(r1)
+ lmw r30, -8(r1)
+ blr
+# float_of_int
+ .globl min_caml_float_of_int
min_caml_float_of_int:
- st %i2, [%i0]
- ld [%i0], %f0
- fitod %f0, %f0
- retl
- nop
-.global min_caml_cos
+ stmw r30, -8(r1)
+ stw r3, 8(r1)
+ stw r4, 12(r1)
+ stwu r1, -48(r1)
+ mr r30, r1
+ mflr r0
+ bcl 20, 31, Lapb
+Lapb:
+ mflr r10
+ mtlr r0
+ stw r2, 72(r30)
+ lwz r0, 72(r30)
+ lis r2, 0x4330
+ addis r9, r10, ha16(LC2 - Lapb)
+ lfd f13, lo16(LC2 - Lapb)(r9)
+ xoris r0, r0, 0x8000
+ stw r0, 28(r30)
+ stw r2, 24(r30)
+ lfd f0, 24(r30)
+ fsub f0, f0, f13
+ lwz r1, 0(r1)
+ lwz r3, 8(r1)
+ lwz r4, 12(r1)
+ lmw r30, -8(r1)
+ blr
+# cos
+ .text
+ .align 2
+ .globl min_caml_cos
min_caml_cos:
- std %f0, [%i0]
- ldd [%i0], %o0
- st %o7, [%i0]
- call cos
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_sin
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -96(r1)
+ mr r30, r1
+ bcl 20, 31, Lbpb
+Lbpb:
+ mflr r31
+ fmr f1, f0
+ bl cos
+ fmr f0, f1
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+cos:
+ .indirect_symbol _cos
+ mflr r0
+ bcl 20, 31, Lbspb
+Lbspb:
+ mflr r11
+ addis r11, r11, ha16(cos_lazy - Lbspb)
+ mtlr r0
+ lwzu r12,lo16(cos_lazy - Lbspb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+cos_lazy:
+ .indirect_symbol _cos
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# sin
+ .text
+ .align 2
+ .globl min_caml_sin
min_caml_sin:
- std %f0, [%i0]
- ldd [%i0], %o0
- st %o7, [%i0]
- call sin
- nop
- ld [%i0], %o7
- retl
- nop
-.global min_caml_atan
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -96(r1)
+ mr r30, r1
+ bcl 20, 31, Lcpb
+Lcpb:
+ mflr r31
+ fmr f1, f0
+ bl sin
+ fmr f0, f1
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+sin:
+ .indirect_symbol _sin
+ mflr r0
+ bcl 20, 31, Lcspb
+Lcspb:
+ mflr r11
+ addis r11, r11, ha16(sin_lazy - Lcspb)
+ mtlr r0
+ lwzu r12, lo16(sin_lazy - Lcspb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+sin_lazy:
+ .indirect_symbol _sin
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+# atan
+ .text
+ .align 2
+ .globl min_caml_atan
min_caml_atan:
- std %f0, [%i0]
- ldd [%i0], %o0
- st %o7, [%i0]
- call atan
- nop
- ld [%i0], %o7
- retl
- nop
-.section ".rodata"
-format_int:
- .asciz "%d"
-format_float:
- .asciz "%lf"
-.align 8
+ mflr r0
+ stmw r30, -8(r1)
+ stw r0, 8(r1)
+ stw r3, 12(r1)
+ stw r4, 16(r1)
+ stwu r1, -96(r1)
+ mr r30, r1
+ bcl 20, 31, Ldpb
+Ldpb:
+ mflr r31
+ fmr f1, f0
+ bl atan
+ fmr f0, f1
+ lwz r1, 0(r1)
+ lwz r0, 8(r1)
+ lwz r3, 12(r1)
+ lwz r4, 16(r1)
+ mtlr r0
+ lmw r30, -8(r1)
+ blr
+ .section __TEXT, __picsymbolstub1, symbol_stubs, pure_instructions, 32
+ .align 5
+atan:
+ .indirect_symbol _atan
+ mflr r0
+ bcl 20, 31, Ldspb
+Ldspb:
+ mflr r11
+ addis r11, r11, ha16(atan_lazy - Ldspb)
+ mtlr r0
+ lwzu r12, lo16(atan_lazy - Ldspb)(r11)
+ mtctr r12
+ bctr
+ .lazy_symbol_pointer
+atan_lazy:
+ .indirect_symbol _atan
+ .long dyld_stub_binding_helper
+ .subsections_via_symbols
+ .const
+ .align 8
float_0:
.long 0x0
.long 0x0
float_1:
.long 0x3ff00000
.long 0x0
+
+
diff -u SPARC/regAlloc.ml PowerPC/regAlloc.ml
--- SPARC/regAlloc.ml 2019-03-19 21:12:59.000000000 +0900
+++ PowerPC/regAlloc.ml 2019-03-19 21:12:59.000000000 +0900
@@ -4,11 +4,11 @@
(* [XXX] Callがあったら、そこから先は無意味というか逆効果なので追わない。
そのために「Callがあったかどうか」を返り値の第1要素に含める。 *)
let rec target' src (dest, t) = function
- | Mov(x) when x = src && is_reg dest ->
+ | Mr(x) when x = src && is_reg dest ->
assert (t <> Type.Unit);
assert (t <> Type.Float);
false, [dest]
- | FMovD(x) when x = src && is_reg dest ->
+ | FMr(x) when x = src && is_reg dest ->
assert (t = Type.Float);
false, [dest]
| IfEq(_, _, e1, e2) | IfLE(_, _, e1, e2) | IfGE(_, _, e1, e2)
@@ -44,10 +44,10 @@
assert (not (M.mem x regenv));
let all =
match t with
- | Type.Unit -> ["%g0"] (* dummy *)
+ | Type.Unit -> ["%r0"] (* dummy *)
| Type.Float -> allfregs
| _ -> allregs in
- if all = ["%g0"] then Alloc("%g0") else (* [XX] ad hoc optimization *)
+ if all = ["%r0"] then Alloc("%r0") else (* [XX] ad hoc optimization *)
if is_reg x then Alloc(x) else
let free = fv cont in
try
@@ -117,22 +117,22 @@
((* Format.eprintf "restoring %s@." x; *)
g dest cont regenv (Let((x, t), Restore(x), Ans(exp))))
and g' dest cont regenv = function (* 各命令のレジスタ割り当て (caml2html: regalloc_gprime) *)
- | Nop | Set _ | SetL _ | Comment _ | Restore _ as exp -> (Ans(exp), regenv)
- | Mov(x) -> (Ans(Mov(find x Type.Int regenv)), regenv)
+ | Nop | Li _ | SetL _ | Comment _ | Restore _ | FLi _ as exp -> (Ans(exp), regenv)
+ | Mr(x) -> (Ans(Mr(find x Type.Int regenv)), regenv)
| Neg(x) -> (Ans(Neg(find x Type.Int regenv)), regenv)
| Add(x, y') -> (Ans(Add(find x Type.Int regenv, find' y' regenv)), regenv)
| Sub(x, y') -> (Ans(Sub(find x Type.Int regenv, find' y' regenv)), regenv)
- | SLL(x, y') -> (Ans(SLL(find x Type.Int regenv, find' y' regenv)), regenv)
- | Ld(x, y') -> (Ans(Ld(find x Type.Int regenv, find' y' regenv)), regenv)
- | St(x, y, z') -> (Ans(St(find x Type.Int regenv, find y Type.Int regenv, find' z' regenv)), regenv)
- | FMovD(x) -> (Ans(FMovD(find x Type.Float regenv)), regenv)
- | FNegD(x) -> (Ans(FNegD(find x Type.Float regenv)), regenv)
- | FAddD(x, y) -> (Ans(FAddD(find x Type.Float regenv, find y Type.Float regenv)), regenv)
- | FSubD(x, y) -> (Ans(FSubD(find x Type.Float regenv, find y Type.Float regenv)), regenv)
- | FMulD(x, y) -> (Ans(FMulD(find x Type.Float regenv, find y Type.Float regenv)), regenv)
- | FDivD(x, y) -> (Ans(FDivD(find x Type.Float regenv, find y Type.Float regenv)), regenv)
- | LdDF(x, y') -> (Ans(LdDF(find x Type.Int regenv, find' y' regenv)), regenv)
- | StDF(x, y, z') -> (Ans(StDF(find x Type.Float regenv, find y Type.Int regenv, find' z' regenv)), regenv)
+ | Slw(x, y') -> (Ans(Slw(find x Type.Int regenv, find' y' regenv)), regenv)
+ | Lwz(x, y') -> (Ans(Lwz(find x Type.Int regenv, find' y' regenv)), regenv)
+ | Stw(x, y, z') -> (Ans(Stw(find x Type.Int regenv, find y Type.Int regenv, find' z' regenv)), regenv)
+ | FMr(x) -> (Ans(FMr(find x Type.Float regenv)), regenv)
+ | FNeg(x) -> (Ans(FNeg(find x Type.Float regenv)), regenv)
+ | FAdd(x, y) -> (Ans(FAdd(find x Type.Float regenv, find y Type.Float regenv)), regenv)
+ | FSub(x, y) -> (Ans(FSub(find x Type.Float regenv, find y Type.Float regenv)), regenv)
+ | FMul(x, y) -> (Ans(FMul(find x Type.Float regenv, find y Type.Float regenv)), regenv)
+ | FDiv(x, y) -> (Ans(FDiv(find x Type.Float regenv, find y Type.Float regenv)), regenv)
+ | Lfd(x, y') -> (Ans(Lfd(find x Type.Int regenv, find' y' regenv)), regenv)
+ | Stfd(x, y, z') -> (Ans(Stfd(find x Type.Float regenv, find y Type.Int regenv, find' z' regenv)), regenv)
| IfEq(x, y', e1, e2) as exp -> g'_if dest cont regenv exp (fun e1' e2' -> IfEq(find x Type.Int regenv, find' y' regenv, e1', e2')) e1 e2
| IfLE(x, y', e1, e2) as exp -> g'_if dest cont regenv exp (fun e1' e2' -> IfLE(find x Type.Int regenv, find' y' regenv, e1', e2')) e1 e2
| IfGE(x, y', e1, e2) as exp -> g'_if dest cont regenv exp (fun e1' e2' -> IfGE(find x Type.Int regenv, find' y' regenv, e1', e2')) e1 e2
@@ -209,7 +209,7 @@
| Type.Unit -> Id.gentmp Type.Unit
| Type.Float -> fregs.(0)
| _ -> regs.(0) in
- let (e', regenv') = g (a, t) (Ans(Mov(a))) regenv e in
+ let (e', regenv') = g (a, t) (Ans(Mr(a))) regenv e in
{ name = Id.L(x); args = arg_regs; fargs = farg_regs; body = e'; ret = t }
let f (Prog(data, fundefs, e)) = (* プログラム全体のレジスタ割り当て (caml2html: regalloc_f) *)
diff -u SPARC/simm.ml PowerPC/simm.ml
--- SPARC/simm.ml 2019-03-19 21:12:59.000000000 +0900
+++ PowerPC/simm.ml 2019-03-19 21:12:59.000000000 +0900
@@ -1,26 +1,26 @@
open Asm
-let rec g env = function (* 命令列の13bit即値最適化 (caml2html: simm13_g) *)
+let rec g env = function (* 命令列の16bit即値最適化 (caml2html: simm13_g) *)
| Ans(exp) -> Ans(g' env exp)
- | Let((x, t), Set(i), e) when -4096 <= i && i < 4096 ->
- (* Format.eprintf "found simm13 %s = %d@." x i; *)
+ | Let((x, t), Li(i), e) when -32768 <= i && i < 32768 ->
+ (* Format.eprintf "found simm16 %s = %d@." x i; *)
let e' = g (M.add x i env) e in
- if List.mem x (fv e') then Let((x, t), Set(i), e') else
+ if List.mem x (fv e') then Let((x, t), Li(i), e') else
((* Format.eprintf "erased redundant Set to %s@." x; *)
e')
- | Let(xt, SLL(y, C(i)), e) when M.mem y env -> (* for array access *)
- (* Format.eprintf "erased redundant SLL on %s@." x; *)
- g env (Let(xt, Set((M.find y env) lsl i), e))
+ | Let(xt, Slw(y, C(i)), e) when M.mem y env -> (* for array access *)
+ (* Format.eprintf "erased redundant Slw on %s@." x; *)
+ g env (Let(xt, Li((M.find y env) lsl i), e))
| Let(xt, exp, e) -> Let(xt, g' env exp, g env e)
-and g' env = function (* 各命令の13bit即値最適化 (caml2html: simm13_gprime) *)
+and g' env = function (* 各命令の16bit即値最適化 (caml2html: simm13_gprime) *)
| Add(x, V(y)) when M.mem y env -> Add(x, C(M.find y env))
| Add(x, V(y)) when M.mem x env -> Add(y, C(M.find x env))
| Sub(x, V(y)) when M.mem y env -> Sub(x, C(M.find y env))
- | SLL(x, V(y)) when M.mem y env -> SLL(x, C(M.find y env))
- | Ld(x, V(y)) when M.mem y env -> Ld(x, C(M.find y env))
- | St(x, y, V(z)) when M.mem z env -> St(x, y, C(M.find z env))
- | LdDF(x, V(y)) when M.mem y env -> LdDF(x, C(M.find y env))
- | StDF(x, y, V(z)) when M.mem z env -> StDF(x, y, C(M.find z env))
+ | Slw(x, V(y)) when M.mem y env -> Slw(x, C(M.find y env))
+ | Lwz(x, V(y)) when M.mem y env -> Lwz(x, C(M.find y env))
+ | Stw(x, y, V(z)) when M.mem z env -> Stw(x, y, C(M.find z env))
+ | Lfd(x, V(y)) when M.mem y env -> Lfd(x, C(M.find y env))
+ | Stfd(x, y, V(z)) when M.mem z env -> Stfd(x, y, C(M.find z env))
| IfEq(x, V(y), e1, e2) when M.mem y env -> IfEq(x, C(M.find y env), g env e1, g env e2)
| IfLE(x, V(y), e1, e2) when M.mem y env -> IfLE(x, C(M.find y env), g env e1, g env e2)
| IfGE(x, V(y), e1, e2) when M.mem y env -> IfGE(x, C(M.find y env), g env e1, g env e2)
@@ -34,8 +34,8 @@
| IfFLE(x, y, e1, e2) -> IfFLE(x, y, g env e1, g env e2)
| e -> e
-let h { name = l; args = xs; fargs = ys; body = e; ret = t } = (* トップレベル関数の13bit即値最適化 *)
+let h { name = l; args = xs; fargs = ys; body = e; ret = t } = (* トップレベル関数の16bit即値最適化 *)
{ name = l; args = xs; fargs = ys; body = g M.empty e; ret = t }
-let f (Prog(data, fundefs, e)) = (* プログラム全体の13bit即値最適化 *)
+let f (Prog(data, fundefs, e)) = (* プログラム全体の16bit即値最適化 *)
Prog(data, List.map h fundefs, g M.empty e)
diff -u SPARC/virtual.ml PowerPC/virtual.ml
--- SPARC/virtual.ml 2019-03-19 21:12:59.000000000 +0900
+++ PowerPC/virtual.ml 2019-03-19 21:12:59.000000000 +0900
@@ -1,4 +1,4 @@
-(* translation into SPARC assembly with infinite number of virtual registers *)
+(* translation into PowerPC assembly with infinite number of virtual registers *)
open Asm
@@ -33,7 +33,7 @@
let rec g env = function (* 式の仮想マシンコード生成 (caml2html: virtual_g) *)
| Closure.Unit -> Ans(Nop)
- | Closure.Int(i) -> Ans(Set(i))
+ | Closure.Int(i) -> Ans(Li(i))
| Closure.Float(d) ->
let l =
try
@@ -44,16 +44,15 @@
let l = Id.L(Id.genid "l") in
data := (l, d) :: !data;
l in
- let x = Id.genid "l" in
- Let((x, Type.Int), SetL(l), Ans(LdDF(x, C(0))))
+ Ans(FLi(l))
| Closure.Neg(x) -> Ans(Neg(x))
| Closure.Add(x, y) -> Ans(Add(x, V(y)))
| Closure.Sub(x, y) -> Ans(Sub(x, V(y)))
- | Closure.FNeg(x) -> Ans(FNegD(x))
- | Closure.FAdd(x, y) -> Ans(FAddD(x, y))
- | Closure.FSub(x, y) -> Ans(FSubD(x, y))
- | Closure.FMul(x, y) -> Ans(FMulD(x, y))
- | Closure.FDiv(x, y) -> Ans(FDivD(x, y))
+ | Closure.FNeg(x) -> Ans(FNeg(x))
+ | Closure.FAdd(x, y) -> Ans(FAdd(x, y))
+ | Closure.FSub(x, y) -> Ans(FSub(x, y))
+ | Closure.FMul(x, y) -> Ans(FMul(x, y))
+ | Closure.FDiv(x, y) -> Ans(FDiv(x, y))
| Closure.IfEq(x, y, e1, e2) ->
(match M.find x env with
| Type.Bool | Type.Int -> Ans(IfEq(x, V(y), g env e1, g env e2))
@@ -71,8 +70,8 @@
| Closure.Var(x) ->
(match M.find x env with
| Type.Unit -> Ans(Nop)
- | Type.Float -> Ans(FMovD(x))
- | _ -> Ans(Mov(x)))
+ | Type.Float -> Ans(FMr(x))
+ | _ -> Ans(Mr(x)))
| Closure.MakeCls((x, t), { Closure.entry = l; Closure.actual_fv = ys }, e2) -> (* クロージャの生成 (caml2html: virtual_makecls) *)
(* Closureのアドレスをセットしてから、自由変数の値をストア *)
let e2' = g (M.add x t env) e2 in
@@ -80,13 +79,13 @@
expand
(List.map (fun y -> (y, M.find y env)) ys)
(4, e2')
- (fun y offset store_fv -> seq(StDF(y, x, C(offset)), store_fv))
- (fun y _ offset store_fv -> seq(St(y, x, C(offset)), store_fv)) in
- Let((x, t), Mov(reg_hp),
+ (fun y offset store_fv -> seq(Stfd(y, x, C(offset)), store_fv))
+ (fun y _ offset store_fv -> seq(Stw(y, x, C(offset)), store_fv)) in
+ Let((x, t), Mr(reg_hp),
Let((reg_hp, Type.Int), Add(reg_hp, C(align offset)),
let z = Id.genid "l" in
Let((z, Type.Int), SetL(l),
- seq(St(z, x, C(0)),
+ seq(Stw(z, x, C(0)),
store_fv))))
| Closure.AppCls(x, ys) ->
let (int, float) = separate (List.map (fun y -> (y, M.find y env)) ys) in
@@ -99,10 +98,10 @@
let (offset, store) =
expand
(List.map (fun x -> (x, M.find x env)) xs)
- (0, Ans(Mov(y)))
- (fun x offset store -> seq(StDF(x, y, C(offset)), store))
- (fun x _ offset store -> seq(St(x, y, C(offset)), store)) in
- Let((y, Type.Tuple(List.map (fun x -> M.find x env) xs)), Mov(reg_hp),
+ (0, Ans(Mr(y)))
+ (fun x offset store -> seq(Stfd(x, y, C(offset)), store))
+ (fun x _ offset store -> seq(Stw(x, y, C(offset)), store)) in
+ Let((y, Type.Tuple(List.map (fun x -> M.find x env) xs)), Mr(reg_hp),
Let((reg_hp, Type.Int), Add(reg_hp, C(align offset)),
store))
| Closure.LetTuple(xts, y, e2) ->
@@ -113,32 +112,32 @@
(0, g (M.add_list xts env) e2)
(fun x offset load ->
if not (S.mem x s) then load else (* [XX] a little ad hoc optimization *)
- fletd(x, LdDF(y, C(offset)), load))
+ fletd(x, Lfd(y, C(offset)), load))
(fun x t offset load ->
if not (S.mem x s) then load else (* [XX] a little ad hoc optimization *)
- Let((x, t), Ld(y, C(offset)), load)) in
+ Let((x, t), Lwz(y, C(offset)), load)) in
load
| Closure.Get(x, y) -> (* 配列の読み出し (caml2html: virtual_get) *)
let offset = Id.genid "o" in
(match M.find x env with
| Type.Array(Type.Unit) -> Ans(Nop)
| Type.Array(Type.Float) ->
- Let((offset, Type.Int), SLL(y, C(3)),
- Ans(LdDF(x, V(offset))))
+ Let((offset, Type.Int), Slw(y, C(3)),
+ Ans(Lfd(x, V(offset))))
| Type.Array(_) ->
- Let((offset, Type.Int), SLL(y, C(2)),
- Ans(Ld(x, V(offset))))
+ Let((offset, Type.Int), Slw(y, C(2)),
+ Ans(Lwz(x, V(offset))))
| _ -> assert false)
| Closure.Put(x, y, z) ->
let offset = Id.genid "o" in
(match M.find x env with
| Type.Array(Type.Unit) -> Ans(Nop)
| Type.Array(Type.Float) ->
- Let((offset, Type.Int), SLL(y, C(3)),
- Ans(StDF(z, x, V(offset))))
+ Let((offset, Type.Int), Slw(y, C(3)),
+ Ans(Stfd(z, x, V(offset))))
| Type.Array(_) ->
- Let((offset, Type.Int), SLL(y, C(2)),
- Ans(St(z, x, V(offset))))
+ Let((offset, Type.Int), Slw(y, C(2)),
+ Ans(Stw(z, x, V(offset))))
| _ -> assert false)
| Closure.ExtArray(Id.L(x)) -> Ans(SetL(Id.L("min_caml_" ^ x)))
@@ -149,8 +148,8 @@
expand
zts
(4, g (M.add x t (M.add_list yts (M.add_list zts M.empty))) e)
- (fun z offset load -> fletd(z, LdDF(x, C(offset)), load))
- (fun z t offset load -> Let((z, t), Ld(x, C(offset)), load)) in
+ (fun z offset load -> fletd(z, Lfd(x, C(offset)), load))
+ (fun z t offset load -> Let((z, t), Lwz(x, C(offset)), load)) in
match t with
| Type.Fun(_, t2) ->
{ name = Id.L(x); args = int; fargs = float; body = load; ret = t2 }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment