From 473c83961abe4e2fb52c8812e46bf19a41fe52cf Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 17 Jun 2020 21:50:25 +0200 Subject: src/ortho: add new_convert. --- src/ortho/mcode/Makefile | 2 +- src/ortho/mcode/ortho_code-disps.adb | 2 +- src/ortho/mcode/ortho_code-exprs.adb | 13 +++- src/ortho/mcode/ortho_code-exprs.ads | 2 + src/ortho/mcode/ortho_code-x86-abi.adb | 2 +- src/ortho/mcode/ortho_code-x86-emits.adb | 114 +++++++++++++++++++------------ src/ortho/mcode/ortho_code-x86-insns.adb | 3 +- src/ortho/mcode/ortho_mcode.adb | 11 ++- src/ortho/mcode/ortho_mcode.ads | 3 +- 9 files changed, 98 insertions(+), 54 deletions(-) (limited to 'src/ortho/mcode') diff --git a/src/ortho/mcode/Makefile b/src/ortho/mcode/Makefile index 284d155a4..791d1f307 100644 --- a/src/ortho/mcode/Makefile +++ b/src/ortho/mcode/Makefile @@ -15,7 +15,7 @@ $(ortho_exec): $(ortho_srcdir)/mcode/ortho_mcode.ads memsegs_c.o force memsegs_c.o: $(ortho_srcdir)/mcode/memsegs_c.c $(CC) -c $(CFLAGS) -o $@ $< -oread: force +oread: $(ortho_srcdir)/mcode/ortho_mcode.ads force $(GNATMAKE) -m -o $@ -g $(GNATFLAGS) -aI../oread ortho_code_main -aI.. -largs memsegs_c.o elfdump: force diff --git a/src/ortho/mcode/ortho_code-disps.adb b/src/ortho/mcode/ortho_code-disps.adb index b0b9a353a..45507a52e 100644 --- a/src/ortho/mcode/ortho_code-disps.adb +++ b/src/ortho/mcode/ortho_code-disps.adb @@ -291,7 +291,7 @@ package body Ortho_Code.Disps is Put ("alloca ("); Disp_Expr (Get_Expr_Operand (Expr)); Put (")"); - when OE_Conv => + when OE_Conv_Ov => Disp_Type (Get_Conv_Type (Expr)); Put ("'conv ("); Disp_Expr (Get_Expr_Operand (Expr)); diff --git a/src/ortho/mcode/ortho_code-exprs.adb b/src/ortho/mcode/ortho_code-exprs.adb index fd467e315..e580082c7 100644 --- a/src/ortho/mcode/ortho_code-exprs.adb +++ b/src/ortho/mcode/ortho_code-exprs.adb @@ -1034,9 +1034,18 @@ package body Ortho_Code.Exprs is Check_Ref (Val); end if; - return New_Enode (OE_Conv, Rtype, Val, O_Enode (Rtype)); + return New_Enode (OE_Conv_Ov, Rtype, Val, O_Enode (Rtype)); end New_Convert_Ov; + function New_Convert (Val : O_Enode; Rtype : O_Tnode) return O_Enode is + begin + if Flag_Debug_Assert then + Check_Ref (Val); + end if; + + return New_Enode (OE_Conv, Rtype, Val, O_Enode (Rtype)); + end New_Convert; + function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode is begin @@ -1194,7 +1203,7 @@ package body Ortho_Code.Exprs is raise Program_Error; end case; if N_Mode /= Mode and not Flag_Debug_Hli then - Res := New_Enode (OE_Conv, N_Mode, V_Type, Val, O_Enode (V_Type)); + Res := New_Enode (OE_Conv_Ov, N_Mode, V_Type, Val, O_Enode (V_Type)); else Res := Val; end if; diff --git a/src/ortho/mcode/ortho_code-exprs.ads b/src/ortho/mcode/ortho_code-exprs.ads index 0bb5ec2bb..b1d95e45e 100644 --- a/src/ortho/mcode/ortho_code-exprs.ads +++ b/src/ortho/mcode/ortho_code-exprs.ads @@ -75,6 +75,7 @@ package Ortho_Code.Exprs is -- ARG1 is expression. -- ARG2: type OE_Conv_Ptr, + OE_Conv_Ov, OE_Conv, -- Typed expression. @@ -478,6 +479,7 @@ package Ortho_Code.Exprs is -- Allowed conversions are: -- FIXME: to write. function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode; + function New_Convert (Val : O_Enode; Rtype : O_Tnode) return O_Enode; -- Get the address of LVALUE. -- ATYPE must be a type access whose designated type is the type of LVALUE. diff --git a/src/ortho/mcode/ortho_code-x86-abi.adb b/src/ortho/mcode/ortho_code-x86-abi.adb index ba9b437d9..a65a472ac 100644 --- a/src/ortho/mcode/ortho_code-x86-abi.adb +++ b/src/ortho/mcode/ortho_code-x86-abi.adb @@ -550,7 +550,7 @@ package body Ortho_Code.X86.Abi is end case; --Disp_Decl_Name (Get_Call_Subprg (Stmt)); New_Line; - when OE_Conv => + when OE_Conv_Ov => Disp_Reg_Op_Name ("conv"); Disp_Irm_Code (Get_Expr_Operand (Stmt)); New_Line; diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb index a8696d19f..91db6b54d 100644 --- a/src/ortho/mcode/ortho_code-x86-emits.adb +++ b/src/ortho/mcode/ortho_code-x86-emits.adb @@ -1715,7 +1715,7 @@ package body Ortho_Code.X86.Emits is end Emit_Move_Xmm; -- Convert U32 to xx. - procedure Gen_Conv_U32 (Stmt : O_Enode) + procedure Gen_Conv_U32 (Stmt : O_Enode; Ov : Boolean) is Op : constant O_Enode := Get_Expr_Operand (Stmt); Reg_Op : constant O_Reg := Get_Expr_Reg (Op); @@ -1727,8 +1727,10 @@ package body Ortho_Code.X86.Emits is if Reg_Op /= Reg_Res then Emit_Load (Reg_Res, Op, Sz_32); end if; - Emit_Tst (Reg_Res, Sz_32); - Gen_Ov_Check (R_Sge); + if Ov then + Emit_Tst (Reg_Res, Sz_32); + Gen_Ov_Check (R_Sge); + end if; when Mode_I64 => if Flags.M64 then Emit_Move (Op, Sz_32, Reg_Res); @@ -1744,21 +1746,23 @@ package body Ortho_Code.X86.Emits is if Reg_Op /= Reg_Res then Emit_Load (Reg_Res, Op, Sz_32); end if; - -- cmpl VAL, 0xff - Start_Insn; - Init_Modrm_Expr (Op, Sz_32); - Gen_8 (Opc_Grp1v_Rm_Imm32); - Gen_Mod_Rm_Opc (Opc2_Grp1_Cmp); - Gen_32 (16#00_00_00_Ff#); - End_Insn; - Gen_Ov_Check (R_Ule); + if Ov then + -- cmpl VAL, 0xff + Start_Insn; + Init_Modrm_Expr (Op, Sz_32); + Gen_8 (Opc_Grp1v_Rm_Imm32); + Gen_Mod_Rm_Opc (Opc2_Grp1_Cmp); + Gen_32 (16#00_00_00_Ff#); + End_Insn; + Gen_Ov_Check (R_Ule); + end if; when others => Error_Emit ("gen_conv_u32", Stmt); end case; end Gen_Conv_U32; -- Convert I32 to xxx - procedure Gen_Conv_I32 (Stmt : O_Enode) + procedure Gen_Conv_I32 (Stmt : O_Enode; Ov : Boolean) is Op : constant O_Enode := Get_Expr_Operand (Stmt); Reg_Op : constant O_Reg := Get_Expr_Reg (Op); @@ -1778,20 +1782,26 @@ package body Ortho_Code.X86.Emits is if Reg_Op /= Reg_Res then Emit_Load (Reg_Res, Op, Sz_32); end if; - Emit_Tst (Reg_Res, Sz_32); - Gen_Ov_Check (R_Sge); + if Ov then + Emit_Tst (Reg_Res, Sz_32); + Gen_Ov_Check (R_Sge); + end if; when Mode_B2 => if Reg_Op /= Reg_Res then Emit_Load (Reg_Res, Op, Sz_32); end if; - Gen_Cmp_Imm (Reg_Res, 1, Sz_32); - Gen_Ov_Check (R_Ule); + if Ov then + Gen_Cmp_Imm (Reg_Res, 1, Sz_32); + Gen_Ov_Check (R_Ule); + end if; when Mode_U8 => if Reg_Op /= Reg_Res then Emit_Load (Reg_Res, Op, Sz_32); end if; - Gen_Cmp_Imm (Reg_Res, 16#Ff#, Sz_32); - Gen_Ov_Check (R_Ule); + if Ov then + Gen_Cmp_Imm (Reg_Res, 16#Ff#, Sz_32); + Gen_Ov_Check (R_Ule); + end if; when Mode_F64 => if Reg_Res in Regs_Xmm then -- cvtsi2sd @@ -1878,7 +1888,7 @@ package body Ortho_Code.X86.Emits is end Gen_Conv_B2; -- Convert I64 to xxx - procedure Gen_Conv_I64 (Stmt : O_Enode) + procedure Gen_Conv_I64 (Stmt : O_Enode; Ov : Boolean) is Mode : constant Mode_Type := Get_Expr_Mode (Stmt); Op : constant O_Enode := Get_Expr_Operand (Stmt); @@ -1890,12 +1900,16 @@ package body Ortho_Code.X86.Emits is if Flags.M64 then -- movsxd src, dst Gen_Movsxd (Reg_Op, Reg_Res); - -- cmp src,dst - Start_Insn; - Init_Modrm_Reg (Reg_Op, Sz_64, Reg_Res, Sz_64); - Gen_8 (Opc_Cmpl_Rm_Reg); - Gen_Mod_Rm_Reg; - End_Insn; + if Ov then + -- cmp src,dst + Start_Insn; + Init_Modrm_Reg (Reg_Op, Sz_64, Reg_Res, Sz_64); + Gen_8 (Opc_Cmpl_Rm_Reg); + Gen_Mod_Rm_Reg; + End_Insn; + -- Overflow if extended value is different from initial one. + Gen_Ov_Check (R_Eq); + end if; else pragma Assert (Reg_Op = R_Edx_Eax); pragma Assert (Reg_Res = R_Ax); @@ -1906,14 +1920,16 @@ package body Ortho_Code.X86.Emits is End_Insn; -- Sign extend eax. Gen_Cdq (Sz_32); - -- cmp reg_helper, dx - Start_Insn; - Gen_8 (Opc_Cmpl_Rm_Reg); - Gen_8 (2#11_010_000# + To_Reg32 (Reg_Helper)); - End_Insn; + if Ov then + -- cmp reg_helper, dx + Start_Insn; + Gen_8 (Opc_Cmpl_Rm_Reg); + Gen_8 (2#11_010_000# + To_Reg32 (Reg_Helper)); + End_Insn; + -- Overflow if extended value is different from initial one. + Gen_Ov_Check (R_Eq); + end if; end if; - -- Overflow if extended value is different from initial value. - Gen_Ov_Check (R_Eq); when Mode_U8 | Mode_B2 => declare @@ -1927,15 +1943,20 @@ package body Ortho_Code.X86.Emits is if Flags.M64 then Emit_Load (Reg_Res, Op, Sz_64); - Start_Insn; - Init_Modrm_Reg (Reg_Res, Sz_64); - Gen_Insn_Grp1 (Opc2_Grp1_Cmp, Ubound); - End_Insn; + if Ov then + Start_Insn; + Init_Modrm_Reg (Reg_Res, Sz_64); + Gen_Insn_Grp1 (Opc2_Grp1_Cmp, Ubound); + End_Insn; + Gen_Ov_Check (R_Ule); + end if; else pragma Assert (Reg_Op in Regs_Pair); - -- Check MSB = 0 - Emit_Tst (Reg_Op, Sz_32h); - Gen_Ov_Check (R_Eq); + if Ov then + -- Check MSB = 0 + Emit_Tst (Reg_Op, Sz_32h); + Gen_Ov_Check (R_Eq); + end if; -- Check LSB <= 255 (U8) or LSB <= 1 (B2) if Reg_Op /= Reg_Res then -- Move reg_op -> reg_res @@ -1946,10 +1967,12 @@ package body Ortho_Code.X86.Emits is Gen_Mod_Rm_Reg; End_Insn; end if; - Gen_Cmp_Imm (Reg_Res, Ubound, Sz_32); + if Ov then + Gen_Cmp_Imm (Reg_Res, Ubound, Sz_32); + Gen_Ov_Check (R_Ule); + end if; end if; end; - Gen_Ov_Check (R_Ule); when Mode_F64 => if Flags.M64 then -- cvtsi2sd @@ -2586,19 +2609,20 @@ package body Ortho_Code.X86.Emits is Error_Emit ("emit_insn: indir", Stmt); end case; - when OE_Conv => + when OE_Conv_Ov + | OE_Conv => -- Call Gen_Conv_FROM case Get_Expr_Mode (Get_Expr_Operand (Stmt)) is when Mode_U32 => - Gen_Conv_U32 (Stmt); + Gen_Conv_U32 (Stmt, Kind = OE_Conv_Ov); when Mode_I32 => - Gen_Conv_I32 (Stmt); + Gen_Conv_I32 (Stmt, Kind = OE_Conv_Ov); when Mode_U8 => Gen_Conv_U8 (Stmt); when Mode_B2 => Gen_Conv_B2 (Stmt); when Mode_I64 => - Gen_Conv_I64 (Stmt); + Gen_Conv_I64 (Stmt, Kind = OE_Conv_Ov); when Mode_F32 | Mode_F64 => Gen_Conv_Fp (Stmt); diff --git a/src/ortho/mcode/ortho_code-x86-insns.adb b/src/ortho/mcode/ortho_code-x86-insns.adb index 013a201e7..a7327ac2b 100644 --- a/src/ortho/mcode/ortho_code-x86-insns.adb +++ b/src/ortho/mcode/ortho_code-x86-insns.adb @@ -2056,7 +2056,8 @@ package body Ortho_Code.X86.Insns is Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum)); Link_Stmt (Stmt); return Stmt; - when OE_Conv => + when OE_Conv_Ov + | OE_Conv => Left := Get_Expr_Operand (Stmt); declare -- Operand mode diff --git a/src/ortho/mcode/ortho_mcode.adb b/src/ortho/mcode/ortho_mcode.adb index 95f442c89..cd7131d73 100644 --- a/src/ortho/mcode/ortho_mcode.adb +++ b/src/ortho/mcode/ortho_mcode.adb @@ -284,12 +284,12 @@ package body Ortho_Mcode is end Finish_Record_Aggr; procedure Start_Array_Aggr - (List : out O_Array_Aggr_List; Arr_Type : O_Tnode; Len : Unsigned_32) + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32) is begin Ortho_Code.Consts.Start_Array_Aggr (Ortho_Code.Consts.O_Array_Aggr_List (List), - Ortho_Code.O_Tnode (Arr_Type), + Ortho_Code.O_Tnode (Atype), Len); end Start_Array_Aggr; @@ -450,6 +450,13 @@ package body Ortho_Mcode is Ortho_Code.O_Tnode (Rtype))); end New_Convert_Ov; + function New_Convert (Val : O_Enode; Rtype : O_Tnode) return O_Enode is + begin + return O_Enode + (Ortho_Code.Exprs.New_Convert (Ortho_Code.O_Enode (Val), + Ortho_Code.O_Tnode (Rtype))); + end New_Convert; + function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode is begin diff --git a/src/ortho/mcode/ortho_mcode.ads b/src/ortho/mcode/ortho_mcode.ads index 554b1ee19..ef24372e3 100644 --- a/src/ortho/mcode/ortho_mcode.ads +++ b/src/ortho/mcode/ortho_mcode.ads @@ -167,7 +167,7 @@ package Ortho_Mcode is Res : out O_Cnode); procedure Start_Array_Aggr - (List : out O_Array_Aggr_List; Arr_Type : O_Tnode; Len : Unsigned_32); + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32); procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; Value : O_Cnode); procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; @@ -320,6 +320,7 @@ package Ortho_Mcode is -- Allowed conversions are: -- FIXME: to write. function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode; + function New_Convert (Val : O_Enode; Rtype : O_Tnode) return O_Enode; -- Get the address of LVALUE. -- ATYPE must be a type access whose designated type is the type of LVALUE. -- cgit v1.2.3