src/ortho: add new_convert.

9 files changed, 98 insertions, 54 deletions

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.