From dc096a3e540ad3410f90b0da7e8af0f5e411eb96 Mon Sep 17 00:00:00 2001 From: Martin Elsman Date: Thu, 2 Jan 2025 16:52:26 +0100 Subject: [PATCH] further cleanup --- src/Compiler/Backend/CodeGenUtil.sml | 179 +++++++++++++------- src/Compiler/Backend/X64/CodeGenUtilX64.sml | 79 +++------ src/Compiler/Backend/X64/INSTS_X64.sml | 62 +------ src/Compiler/Backend/X64/InstsX64.sml | 171 ++++++++++--------- 4 files changed, 238 insertions(+), 253 deletions(-) diff --git a/src/Compiler/Backend/CodeGenUtil.sml b/src/Compiler/Backend/CodeGenUtil.sml index 39a5abaf..55ee319a 100644 --- a/src/Compiler/Backend/CodeGenUtil.sml +++ b/src/Compiler/Backend/CodeGenUtil.sml @@ -1,37 +1,10 @@ -signature INSTS_COMMON = sig - - include INSTS_BASE - - type lvar = Lvars.lvar - eqtype reg - val tmp_reg0 : reg - val tmp_reg1 : reg - val tmp_freg0 : reg - val tmp_freg1 : reg - val sp_reg : reg - - datatype ea = R of reg (* register *) - | L of lab (* label *) - | LA of lab (* label address *) - | I of string (* immediate *) - | D of string * reg (* displaced *) - | DD of string * reg * reg * string (* double displaced *) - val pr_ea : ea -> string - val eq_ea : ea * ea -> bool +signature INSTS_GENERIC = sig type inst type code = inst list - datatype top_decl = FUN of label * code - | FN of label * code - - type AsmPrg = {top_decls: top_decl list, - init_code: code, - static_data: code} - - structure RI : REGISTER_INFO - where type reg = reg - where type lvar = lvar + eqtype reg + type ea and lab and Offset val copy : reg * reg * code -> code val load_indexed : ea * reg * Offset * code -> code @@ -42,10 +15,57 @@ signature INSTS_COMMON = sig val move_num : string * ea * code -> code val move_num_boxed : (unit -> lab) -> (code -> unit) -> (unit -> string) -> string * ea * code -> code val move_ea_to_reg : ea * reg * code -> code - val move_reg_to_ea : reg * ea * code -> code + val move_reg_to_ea : reg * ea -> code -> code val comment_str : string * code -> code + val push_ea : ea -> code -> code + val pop_ea : ea -> code -> code + + val add : reg * reg -> code -> code + val add_num : string * reg -> code -> code +end +signature INSTS_COMMON = sig + + include INSTS_BASE + + structure RI : REGISTER_INFO + + datatype ea = R of RI.reg (* register *) + | L of lab (* label *) + | LA of lab (* label address *) + | I of string (* immediate *) + | D of string * RI.reg (* displaced *) + | DD of string * RI.reg * RI.reg * string (* double displaced *) + + structure G : INSTS_GENERIC where type reg = RI.reg + where type Offset = Offset + where type ea = ea + where type lab = lab + + val tmp_reg0 : RI.reg + val tmp_reg1 : RI.reg + val tmp_freg0 : RI.reg + val tmp_freg1 : RI.reg + val sp_reg : RI.reg + val pr_ea : ea -> string + val eq_ea : ea * ea -> bool + + type code = G.inst list val rem_dead_code : code -> code + + datatype top_decl = FUN of label * code + | FN of label * code + + type AsmPrg = {top_decls: top_decl list, + init_code: code, + static_data: code} + + val emit : AsmPrg * string -> unit (* may raise IO *) + val optimise : AsmPrg -> AsmPrg + + type StringTree + val layout : AsmPrg -> StringTree + end functor CodeGenUtil(structure Insts : INSTS_COMMON @@ -60,12 +80,13 @@ functor CodeGenUtil(structure Insts : INSTS_COMMON where type ('a,'b,'c) LinePrg = ('a,'b,'c) LineStmt.LinePrg where type lvar = Lvars.lvar where type place = Effect.effect - where type reg = Insts.reg + where type reg = Insts.RI.reg where type label = AddressLabels.label ) = struct structure I = Insts + structure G = I.G structure PP = PrettyPrint structure Labels = AddressLabels structure RI = I.RI @@ -78,16 +99,20 @@ struct type AtySS = SubstAndSimplify.Aty type AsmPrg = I.AsmPrg - type reg = I.reg + type reg = I.RI.reg datatype ea = datatype I.ea datatype lab = datatype I.lab datatype Offset = datatype I.Offset type offset = int + type code = G.code (* ------------------------ * Some utilities * ------------------------ *) + infixr $ + fun f $ a = f a + fun member r nil = false | member r (x::xs) = r = x orelse member r xs @@ -133,9 +158,9 @@ struct * Some code generation utilities * ---------------------------------- *) - fun comment (str,C) = if !comments_in_asmcode then I.comment_str (str, C) + fun comment (str,C) = if !comments_in_asmcode then G.comment_str (str, C) else C - fun comment_fn (f, C) = if !comments_in_asmcode then I.comment_str (f(), C) + fun comment_fn (f, C) = if !comments_in_asmcode then G.comment_str (f(), C) else C (* ---------------------------------- @@ -168,14 +193,14 @@ struct end (* Static Data inserted at the beginning of the code. *) - local val static_data : I.inst list ref = ref [] + local val static_data : G.inst list ref = ref [] in fun add_static_data insts = (static_data := insts @ !static_data) fun reset_static_data () = static_data := [] fun get_static_data C = !static_data @ C end (* Additional code blocks added at the end of functions (for avoiding jumping over blocks) *) - local val code_blocks : I.inst list ref = ref [] + local val code_blocks : G.inst list ref = ref [] in fun add_code_block insts = (code_blocks := insts @ !code_blocks) fun reset_code_blocks () = code_blocks := [] fun get_code_blocks () = !code_blocks @@ -186,15 +211,15 @@ struct val tmp_freg0 = I.tmp_freg0 val tmp_freg1 = I.tmp_freg1 - val copy = I.copy - val store_indexed = I.store_indexed - val load_indexed = I.load_indexed - val base_plus_offset = I.base_plus_offset - val store_immed = I.store_immed - val move_immed = I.move_immed - val move_num = I.move_num - val move_ea_to_reg = I.move_ea_to_reg - val move_reg_to_ea = I.move_reg_to_ea + val copy = G.copy + val store_indexed = G.store_indexed + val load_indexed = G.load_indexed + val base_plus_offset = G.base_plus_offset + val store_immed = G.store_immed + val move_immed = G.move_immed + val move_num = G.move_num + val move_ea_to_reg = G.move_ea_to_reg + val move_reg_to_ea = G.move_reg_to_ea fun mkIntAty i = SS.INTEGER_ATY {value=IntInf.fromInt i, precision=if BI.tag_values() then 63 else 64} @@ -231,7 +256,7 @@ struct if not(BI.tag_values()) then die "move_num_boxed.boxed integers/words necessary only when tagging is enabled" else - I.move_num_boxed new_num_lab add_static_data + G.move_num_boxed new_num_lab add_static_data (fn () => BI.pr_tag_w(BI.tag_word_boxed true)) (x,ea,C) @@ -289,18 +314,18 @@ struct (* dst_aty = &lab *) fun load_label_addr (lab,dst_aty,t:reg,size_ff,C) = case dst_aty of - SS.PHREG_ATY d => I.move_ea_to_reg(LA lab, d, C) + SS.PHREG_ATY d => move_ea_to_reg(LA lab, d, C) | SS.STACK_ATY offset => - I.move_ea_to_reg(LA lab, t, + move_ea_to_reg(LA lab, t, store_indexed(I.sp_reg, WORDS(size_ff-offset-1), R t, C)) | _ => die "load_label_addr.wrong ATY" (* dst_aty = lab[0] *) fun load_from_label (lab,dst_aty,t:reg,size_ff,C) = case dst_aty of - SS.PHREG_ATY d => I.move_ea_to_reg(L lab, d, C) + SS.PHREG_ATY d => move_ea_to_reg(L lab, d, C) | SS.STACK_ATY offset => - I.move_ea_to_reg(L lab, t, + move_ea_to_reg(L lab, t, store_indexed(I.sp_reg, WORDS(size_ff-offset-1), R t, C)) | SS.UNIT_ATY => C | _ => die "load_from_label.wrong ATY" @@ -310,7 +335,7 @@ struct case src_aty of SS.PHREG_ATY s => move_ea_to_reg (LA lab, tmp1, - move_reg_to_ea (s, D("0",tmp1), C)) + move_reg_to_ea (s, D("0",tmp1)) C) | SS.INTEGER_ATY i => move_ea_to_reg(LA lab, tmp1, move_num_generic (#precision i, fmtInt i, D("0",tmp1), C)) @@ -321,7 +346,7 @@ struct move_ea_to_reg(LA lab,tmp1, move_unit(D("0",tmp1), C)) | _ => move_aty_into_reg(src_aty,tmp1,size_ff, - move_reg_to_ea(tmp1, L lab,C)) + move_reg_to_ea(tmp1, L lab) C) fun store_aty_indexed (b:reg,n:Offset,aty,t:reg,size_ff,C) = let fun ea () = D(I.offset_bytes n,b) @@ -347,7 +372,7 @@ struct | _ => die "store_aty_indexed.direct_int - weird precision" in case aty of - SS.PHREG_ATY s => move_reg_to_ea(s,ea(),C) + SS.PHREG_ATY s => move_reg_to_ea(s,ea()) C | SS.INTEGER_ATY i => if direct_int i then move_num_generic (#precision i, fmtInt i, ea(), C) else default() @@ -386,7 +411,7 @@ struct store_indexed(t2,offset,R t1,C))) (* Returns a register with arg and a continuation function. *) - fun resolve_arg_aty (arg:SS.Aty,t:reg,size_ff:int) : reg * (I.inst list -> I.inst list) = + fun resolve_arg_aty (arg:SS.Aty,t:reg,size_ff:int) : reg * (code -> code) = case arg of SS.PHREG_ATY r => (r, fn C => C) | _ => (t, fn C => move_aty_into_reg(arg,t,size_ff,C)) @@ -395,7 +420,7 @@ struct fun rep8bit (i: IntInf.int) = ~0x80 <= i andalso i <= 0x7F fun rep16bit (i: IntInf.int) = ~0x8000 <= i andalso i <= 0x7FFF - fun protect_arg_aty (arg:SS.Aty,t:reg,size_ff:int,{avoid:SS.Aty}) : ea * (I.inst list -> I.inst list) = + fun protect_arg_aty (arg:SS.Aty,t:reg,size_ff:int,{avoid:SS.Aty}) : ea * (code -> code) = let fun default () = (R t, fn C => move_aty_into_reg(arg,t,size_ff,C)) in case arg of SS.PHREG_ATY r => @@ -415,7 +440,7 @@ struct | _ => default() end - fun resolve_arg_aty_ea (arg:SS.Aty,t:reg,size_ff:int) : ea * (I.inst list -> I.inst list) = + fun resolve_arg_aty_ea (arg:SS.Aty,t:reg,size_ff:int) : ea * (code -> code) = let fun default () = (R t, fn C => move_aty_into_reg(arg,t,size_ff,C)) in case arg of SS.PHREG_ATY r => (R r, Id) @@ -444,8 +469,8 @@ struct fun store_real (base_reg,t:reg,freg,C) = if BI.tag_values() then store_immed(BI.tag_real false, base_reg, WORDS 0, - move_reg_to_ea (freg,D("8",base_reg),C)) - else move_reg_to_ea (freg,D("0",base_reg),C) + move_reg_to_ea (freg,D("8",base_reg)) C) + else move_reg_to_ea (freg,D("0",base_reg)) C (* When tag free collection of pairs is enabled, a bit is stored in the region descriptor if the region is an infinite region @@ -493,9 +518,9 @@ struct (* move a number of arguments into the appropriate registers *) fun shuffle_args (size_ff:int) - (mv_aty_to_reg: SS.Aty * 'a * reg * int * I.inst list -> I.inst list) + (mv_aty_to_reg: SS.Aty * 'a * reg * int * code -> code) (args:(SS.Aty * 'a * reg)list) - (C:I.inst list) : I.inst list = + (C:code) : code = let (*val args = List.filter (fn (aty,_,r) => not(SS.eq_aty (aty,SS.PHREG_ATY r))) args*) val regs = regs_atys (List.map #1 args) nil fun loop nil acc = acc @@ -511,6 +536,29 @@ struct | (_,_,r)::_ => die "shuffle_args: not quite done" end + (* push_aty, i.e., rsp-=8; rsp[0] = aty *) + (* size_ff is for rsp before rsp is moved. *) + fun push_aty (aty,t:reg,size_ff,C) = + let fun default () = move_aty_into_reg(aty,t,size_ff, + G.push_ea (R t) C) + in case aty of + SS.PHREG_ATY aty_reg => G.push_ea (R aty_reg) C + | SS.INTEGER_ATY i => + if boxedNum (#precision i) + orelse #value i > 0x3FFFFFFF + orelse #value i <= ~0x40000000 then default() + else G.push_ea (I(fmtInt i)) C + | SS.WORD_ATY w => + if boxedNum (#precision w) orelse #value w > 0x7FFFFFFF then default() + else G.push_ea (I(fmtWord w)) C + | _ => default() + end + + (* pop(aty), i.e., aty=rsp[0]; rsp+=8 *) + (* size_ff is for sp after pop *) + fun pop_aty (SS.PHREG_ATY aty_reg,t:reg,size_ff,C) = G.pop_ea (R aty_reg) C + | pop_aty (aty,t:reg,size_ff,C) = G.pop_ea (R t) $ move_reg_into_aty(t,aty,size_ff,C) + local fun basic_sw basic_lss (LS.SWITCH(_,xlsss,lss)) = @@ -675,5 +723,14 @@ struct val basic_lss = basic_lss end + fun add_aty_to_reg (arg:SS.Aty,tmp:reg,t:reg,size_ff:int,C:code) : code = + case arg of + SS.PHREG_ATY r => G.add(r,t) C + | _ => move_aty_into_reg(arg,tmp,size_ff, G.add(tmp,t) C) + + (* better alignment technique that allows for arguments on the stack *) + fun maybe_align nargs F C = + if nargs = 0 then F C + else F (G.add_num(I.i2s(8*nargs),I.sp_reg) C) end diff --git a/src/Compiler/Backend/X64/CodeGenUtilX64.sml b/src/Compiler/Backend/X64/CodeGenUtilX64.sml index f2d82b3d..79f9a842 100644 --- a/src/Compiler/Backend/X64/CodeGenUtilX64.sml +++ b/src/Compiler/Backend/X64/CodeGenUtilX64.sml @@ -19,6 +19,7 @@ struct in open X end + infixr $ structure I = InstsX64 datatype reg = datatype I.reg datatype Offset = datatype I.Offset @@ -44,39 +45,6 @@ struct | r12 => 12 | r13 => 13 | r14 => 14 | r15 => 15 | r => die ("lv_to_reg.no: " ^ I.pr_reg r) - (* push_aty, i.e., rsp-=8; rsp[0] = aty (different than on hp) *) - (* size_ff is for rsp before rsp is moved. *) - fun push_aty (aty,t:reg,size_ff,C) = - let - fun default () = move_aty_into_reg(aty,t,size_ff, - I.push(R t) :: C) - in case aty of - SS.PHREG_ATY aty_reg => - if I.is_xmm aty_reg then - I.subq(I "8", R rsp) :: I.movsd(R aty_reg, D("",rsp)) :: C - else I.push(R aty_reg) :: C - | SS.INTEGER_ATY i => - if boxedNum (#precision i) - orelse #value i > 0x3FFFFFFF - orelse #value i <= ~0x40000000 then default() - else I.push(I (fmtInt i)) :: C - | SS.WORD_ATY w => - if boxedNum (#precision w) orelse #value w > 0x7FFFFFFF then default() - else I.push(I (fmtWord w)) :: C - | _ => default() - end - - (* pop(aty), i.e., aty=rsp[0]; rsp+=8 *) - (* size_ff is for sp after pop *) - fun pop_aty (SS.PHREG_ATY aty_reg,t:reg,size_ff,C) = I.pop(R aty_reg) :: C - | pop_aty (aty,t:reg,size_ff,C) = (I.pop(R t) :: - move_reg_into_aty(t,aty,size_ff,C)) - - fun add_aty_to_reg (arg:SS.Aty,tmp:reg,t:reg,size_ff:int,C:I.inst list) : I.inst list = - case arg - of SS.PHREG_ATY r => I.addq(R r, R t) :: C - | _ => move_aty_into_reg(arg,tmp,size_ff, I.addq(R tmp, R t) :: C) - (* Generate a string label *) fun gen_string_lab str = let val string_lab = new_string_lab() @@ -150,11 +118,6 @@ struct | _ => I.call(NameLab name) :: C in - (* better alignment technique that allows for arguments on the stack *) - fun maybe_align nargs F C = - if nargs = 0 then F C - else F (I.addq(I(i2s(8*nargs)),R rsp):: C) - (* 1. push stack arguments 2. shuffle register arguments (adjust size_ff) 3. align rsp (and modify location of stack arguments) @@ -328,12 +291,12 @@ struct I.je l_gc_do :: I.lab l_gc_done :: C, I.lab l_gc_do :: - I.movq(I reg_map_immed, R tmp_reg1) :: (* tmp_reg1 = reg_map *) + G.move_num(reg_map_immed, R tmp_reg1, (* tmp_reg1 = reg_map *) load_label_addr(l_gc_done,SS.PHREG_ATY tmp_reg0,tmp_reg0,size_ff, (* tmp_reg0 = return address *) - I.push(I (i2s size_ccf)) :: - I.push(I (i2s size_rcf)) :: - I.push(I (i2s size_spilled_region_and_float_args)) :: - I.jmp(L gc_stub_lab) :: nil)) + G.push_ea(I (i2s size_ccf)) $ + G.push_ea(I (i2s size_rcf)) $ + G.push_ea(I (i2s size_spilled_region_and_float_args)) $ + I.jmp(L gc_stub_lab) :: nil))) end else (fn C => C, nil) @@ -357,10 +320,10 @@ struct let val n = n0 + BI.objectDescSizeP fun post_prof C = (* tmp_reg1 now points at the object descriptor; initialize it *) - I.movq(I (i2s pp), D("0",tmp_reg1)) :: (* first word is pp *) - I.movq(I (i2s n0), D("8",tmp_reg1)) :: (* second word is object size *) + G.move_num(i2s pp, D("0",tmp_reg1), (* first word is pp *) + G.move_num(i2s n0, D("8",tmp_reg1), (* second word is object size *) I.leaq(D (i2s (8*BI.objectDescSizeP), tmp_reg1), R tmp_reg1) :: - C (* make tmp_reg1 point at object *) + C)) (* make tmp_reg1 point at object *) in copy(t,tmp_reg1, move_immed(IntInf.fromInt n, R tmp_reg0, I.call (NameLab "__allocate") :: (* assumes args in tmp_reg1 and tmp_reg0; result in tmp_reg1 *) @@ -456,7 +419,7 @@ struct fun store_pp_prof (obj_ptr:reg, pp:LS.pp, C) = if region_profiling() then if pp < 2 then die ("store_pp_prof.pp (" ^ Int.toString pp ^ ") is less than two.") - else I.movq(I(i2s pp), D("-16", obj_ptr)) :: C (* two words offset *) + else G.move_num(i2s pp, D("-16", obj_ptr), C) (* two words offset *) else C fun alloc_ap_kill_tmp01 (sma, dst_reg:reg, n, size_ff, C) = @@ -575,7 +538,7 @@ struct *) fun prefix_sm (sma,dst_reg:reg,size_ff,C) = - let fun zero () = I.movq(I "0", R dst_reg) :: C + let fun zero () = G.move_num("0", R dst_reg, C) in case sma of LS.ATTOP_LI(SS.DROPPED_RVAR_ATY,pp) => zero() | LS.ATTOP_LF(SS.DROPPED_RVAR_ATY,pp) => zero() @@ -674,7 +637,7 @@ struct val sels = map (fn (i,e) => (toInt i, e)) sels fun cmp (i,opr,C) = if rep16bit i then I.cmpq(I (I.intToStr i),opr) :: C - else I.movq(I (I.intToStr i), R tmp_reg0) :: I.cmpq(R tmp_reg0,opr) :: C + else G.move_immed(i, R tmp_reg0, I.cmpq(R tmp_reg0,opr) :: C) fun if_not_equal_go_lab (lab,i,C) = cmp(i, opr, I.jne lab :: C) fun if_less_than_go_lab (lab,i,C) = cmp(i, opr, I.jl lab :: C) fun if_greater_than_go_lab (lab,i,C) = cmp(i, opr, I.jg lab :: C) @@ -758,10 +721,10 @@ struct x_C( y_C( compare ( - I.movq(I (i2s BI.ml_false), R d_reg) :: - I.movq(I (i2s BI.ml_true), R tmp_reg1) :: + G.move_num(i2s BI.ml_false, R d_reg, + G.move_num(i2s BI.ml_true, R tmp_reg1, cmov(R tmp_reg1, R d_reg) :: - C'))) + C'))))) end fun doubleOfQuadEa ea = @@ -1398,10 +1361,10 @@ struct val () = if I.is_xmm y then () else die ("cmpf64_kill_tmp01_cmov: wrong y register") val (d_reg, C') = resolve_aty_def(d, tmp_reg0, size_ff, C) in x_C(y_C(I.ucomisd (R y, R x) :: - I.movq(I (i2s BI.ml_false), R d_reg) :: - I.movq(I (i2s BI.ml_true), R tmp_reg1) :: + G.move_num(i2s BI.ml_false, R d_reg, + G.move_num(i2s BI.ml_true, R tmp_reg1, cmov(R tmp_reg1, R d_reg) :: - C')) + C')))) end local @@ -1478,10 +1441,10 @@ struct val load_args = x_C o y_C in load_args(I.ucomisd (R tmp_freg1, R tmp_freg0) :: - I.movq(I (i2s BI.ml_false), R d_reg) :: - I.movq(I (i2s BI.ml_true), R tmp_reg1) :: + G.move_num(i2s BI.ml_false, R d_reg, + G.move_num(i2s BI.ml_true, R tmp_reg1, cmov(R tmp_reg1, R d_reg) :: - C') + C'))) end fun bin_op_kill_tmp01 {quad} inst (x,y,d,size_ff,C) = diff --git a/src/Compiler/Backend/X64/INSTS_X64.sml b/src/Compiler/Backend/X64/INSTS_X64.sml index 6dce566d..a2da964f 100644 --- a/src/Compiler/Backend/X64/INSTS_X64.sml +++ b/src/Compiler/Backend/X64/INSTS_X64.sml @@ -1,9 +1,7 @@ signature INSTS_X64 = sig - include INSTS_BASE - - type lvar + include INSTS_COMMON datatype reg = rax | rbx | rcx | rdx | rsi | rdi | rbp | rsp | r8 | r9 | r10 | r11 | r12 | r13 | r14 | r15 @@ -19,29 +17,12 @@ signature INSTS_X64 = | xmm8 | xmm9 | xmm10 | xmm11 | xmm12 | xmm13 | xmm14 | xmm15 - val pr_reg : reg -> string - val is_xmm : reg -> bool - - val tmp_reg0 : reg (*=r10*) - val tmp_reg1 : reg (*=r11*) - - val tmp_freg0 : reg (*=xmm0*) - val tmp_freg1 : reg (*=xmm1*) - val sp_reg : reg - + val pr_reg : reg -> string + val is_xmm : reg -> bool val doubleOfQuadReg : reg -> reg (* fails if given a non-quad register *) type freg - datatype ea = R of reg (* register *) - | L of lab (* label *) - | LA of lab (* label address *) - | I of string (* immediate *) - | D of string * reg (* displaced *) - | DD of string * reg * reg * string (* double displaced *) - val pr_ea : ea -> string - val eq_ea : ea * ea -> bool - datatype ty = OBJ | FUNC (* @object or @function *) datatype inst = (* general instructions *) @@ -154,41 +135,6 @@ signature INSTS_X64 = | lab of lab | comment of string - type code = inst list - - datatype top_decl = - FUN of label * code - | FN of label * code - - type AsmPrg = {top_decls: top_decl list, - init_code: code, - static_data: code} - - - val emit : AsmPrg * string -> unit (* may raise IO *) - - structure RI : REGISTER_INFO - where type reg = reg - where type lvar = lvar - - val rem_dead_code : inst list -> inst list - - val optimise : AsmPrg -> AsmPrg - - type StringTree - val layout : AsmPrg -> StringTree - - (* Abbreviations *) - val copy : reg * reg * code -> code - val load_indexed : ea * reg * Offset * code -> code - val store_indexed : reg * Offset * ea * code -> code - val base_plus_offset : reg * Offset * reg * code -> code - val store_immed : word * reg * Offset * code -> code - val move_immed : IntInf.int * ea * code -> code - val move_num : string * ea * code -> code - val move_num_boxed : (unit -> lab) -> (code -> unit) -> (unit -> string) -> string * ea * code -> code - val move_ea_to_reg : ea * reg * code -> code - val move_reg_to_ea : reg * ea * code -> code - val comment_str : string * code -> code + sharing type inst = G.inst end diff --git a/src/Compiler/Backend/X64/InstsX64.sml b/src/Compiler/Backend/X64/InstsX64.sml index b7df5fe4..7b7a7071 100644 --- a/src/Compiler/Backend/X64/InstsX64.sml +++ b/src/Compiler/Backend/X64/InstsX64.sml @@ -944,82 +944,101 @@ structure InstsX64 : INSTS_X64 = val pr_ea = pr_ea (LabSet.empty()) - (* Abbreviations *) - fun copy (r1, r2, C) = if r1 = r2 then C - else case (is_xmm r1, is_xmm r2) of - (true, true) => movsd (R r1, R r2) :: C - | (false, false) => movq(R r1, R r2) :: C - | _ => die "copy: incompatible registers" - - fun is_xmm_ea (R r) = is_xmm r - | is_xmm_ea _ = false - - (* Can be used to load from the stack or from a record *) - (* d = b[n] *) - fun load_indexed (d:ea,b:reg,n:Offset,C) = - if is_xmm b then die ("load_indexed: wrong kind of register") - else if is_xmm_ea d then movsd(D(offset_bytes n,b), d) :: C - else movq(D(offset_bytes n,b), d) :: C - - (* Can be used to update the stack or store in a record *) - (* b[n] = s *) - fun store_indexed (b:reg,n:Offset,s:ea,C) = - if is_xmm_ea s then movsd(s,D(offset_bytes n,b)) :: C - else movq(s,D(offset_bytes n,b)) :: C - - (* Calculate an address given a base and an offset *) - (* dst = base + x *) - fun base_plus_offset (b:reg,n:Offset,d:reg,C) = - if d = b andalso isZeroOffset n then C - else leaq(D(offset_bytes n, b), R d) :: C - - (* Store a constant in an address specified by a register and an offset *) - fun store_immed (w:word,r:reg,offset:Offset,C) = - movq(I (wordToStr (Word.toLargeInt w)), D(offset_bytes offset,r)) :: C - - (* Move a constant into an EA *) - fun move_immed (0,R d,C) = xorq(R d, R d) :: C - | move_immed (x,d:ea,C) = movq(I (intToStr x), d) :: C - - (* Move a constant, formatted as a string, into an EA *) - fun move_num (x,ea:ea,C) = - if (x = "0" orelse x = "0x0") andalso (case ea of R _ => true | _ => false) - then xorq(ea, ea) :: C - else movq(I x, ea) :: C - - fun move_num_boxed new_num_lab add_static_data tag (x,ea:ea,C) = - let val num_lab = new_num_lab() - val () = add_static_data [dot_data, - dot_align 8, - lab num_lab, - dot_quad(tag()), - dot_quad x] - in movq(LA num_lab, ea) :: C - end - - fun move_ea_to_reg (ea,r:reg,C) = - let val mv = if is_xmm r then movsd else movq - in case ea of - LA l => mv(LA l, R r) :: C - | L l => if is_xmm r then die "move_ea_to_reg" - else movq(LA l, R r) :: movq(D("0",r),R r) :: C - | D _ => mv(ea,R r) :: C - | R r' => if r = r' then C else mv(ea,R r) :: C - | DD _ => mv(ea,R r) :: C - | I _ => mv(ea,R r) :: C - end - - fun move_reg_to_ea (r:reg,ea,C) = - let val mv = if is_xmm r then movsd else movq - in case ea of - R r' => if r = r' then C else mv(R r,ea) :: C - | L _ => mv(R r,ea) :: C - | D _ => mv(R r,ea) :: C - | DD _ => mv(R r,ea) :: C - | _ => die "move_reg_to_ea.not supported ea" - end - - fun comment_str (s,C) = comment s :: C + structure G : INSTS_GENERIC = struct + type reg = reg and ea = ea and lab = lab + type inst = inst and code = code + type Offset = Offset + fun copy (r1, r2, C) = if r1 = r2 then C + else case (is_xmm r1, is_xmm r2) of + (true, true) => movsd (R r1, R r2) :: C + | (false, false) => movq(R r1, R r2) :: C + | _ => die "copy: incompatible registers" + + fun is_xmm_ea (R r) = is_xmm r + | is_xmm_ea _ = false + + (* Can be used to load from the stack or from a record *) + (* d = b[n] *) + fun load_indexed (d:ea,b:reg,n:Offset,C) = + if is_xmm b then die ("load_indexed: wrong kind of register") + else if is_xmm_ea d then movsd(D(offset_bytes n,b), d) :: C + else movq(D(offset_bytes n,b), d) :: C + + (* Can be used to update the stack or store in a record *) + (* b[n] = s *) + fun store_indexed (b:reg,n:Offset,s:ea,C) = + if is_xmm_ea s then movsd(s,D(offset_bytes n,b)) :: C + else movq(s,D(offset_bytes n,b)) :: C + + (* Calculate an address given a base and an offset *) + (* dst = base + x *) + fun base_plus_offset (b:reg,n:Offset,d:reg,C) = + if d = b andalso isZeroOffset n then C + else leaq(D(offset_bytes n, b), R d) :: C + + (* Store a constant in an address specified by a register and an offset *) + fun store_immed (w:word,r:reg,offset:Offset,C) = + movq(I (wordToStr (Word.toLargeInt w)), D(offset_bytes offset,r)) :: C + + (* Move a constant into an EA *) + fun move_immed (0,R d,C) = xorq(R d, R d) :: C + | move_immed (x,d:ea,C) = movq(I (intToStr x), d) :: C + + (* Move a constant, formatted as a string, into an EA *) + fun move_num (x,ea:ea,C) = + if (x = "0" orelse x = "0x0") andalso (case ea of R _ => true | _ => false) + then xorq(ea, ea) :: C + else movq(I x, ea) :: C + + fun move_num_boxed new_num_lab add_static_data tag (x,ea:ea,C) = + let val num_lab = new_num_lab() + val () = add_static_data [dot_data, + dot_align 8, + lab num_lab, + dot_quad(tag()), + dot_quad x] + in movq(LA num_lab, ea) :: C + end + + fun move_ea_to_reg (ea,r:reg,C) = + let val mv = if is_xmm r then movsd else movq + in case ea of + LA l => mv(LA l, R r) :: C + | L l => if is_xmm r then die "move_ea_to_reg" + else movq(LA l, R r) :: movq(D("0",r),R r) :: C + | D _ => mv(ea,R r) :: C + | R r' => if r = r' then C else mv(ea,R r) :: C + | DD _ => mv(ea,R r) :: C + | I _ => mv(ea,R r) :: C + end + + fun move_reg_to_ea (r:reg,ea) C = + let val mv = if is_xmm r then movsd else movq + in case ea of + R r' => if r = r' then C else mv(R r,ea) :: C + | L _ => mv(R r,ea) :: C + | D _ => mv(R r,ea) :: C + | DD _ => mv(R r,ea) :: C + | _ => die "move_reg_to_ea.not supported ea" + end + + fun comment_str (s,C) = comment s :: C + + fun push_ea ea C = + case ea of + R r => + if is_xmm r then + subq(I "8", R rsp) :: movsd(R r, D("",rsp)) :: C + else push(R r) :: C + | I _ => push ea :: C + | _ => die "push_ea: may be applied only to I or R" + + fun pop_ea ea C = pop ea :: C + + fun add (r1,r2) C = addq(R r1, R r2) :: C + + fun add_num (n,r) C = addq(I n,R r) :: C + end end