[m-rev.] diff: fix some things related to 64-bit integers

Julien Fischer jfischer at opturion.com
Sun Jan 28 20:32:58 AEDT 2018


Fix some things related to 64-bit integers.

Fix a bug that was causing the compiler to generate code that caused a
segmentation fault in the low-level C grades.

Add some code whose omission was causing the compiler to not treat int64 and
uint64 as builtin types.

compiler/builtin_ops.m:
     Generate "correctly typed" HLDS for unary minus expressions, in particular
     make sure that the integer type for the zero constant we use in those
     expressions is set properly.

     Not setting it properly was causing a segmentation fault with unary minus
     and (boxed) 64-bit integers, because the generated code was attempting to
     dereference the zero address.

     Extend the insts describing valid output expressions from this module to
     cover all of the recently added integer types.

compiler/bytecode.m:
compiler/bytecode_gen.m:
     Conform to the above change to builtin_ops.

compiler/prog_type.m:
     Add int64 and uint64 to the list of types that should lack an HLDS
     definition.

compiler/rtti.m:
compiler/type_ctor_info.m:
     Add int64 and uint64 to the list of builtn ctors.

compiler/typecheck.m:
     Add int64 and uint64 to the list of cons_ids corresponding to a builtin
     type.

compiler/erl_rtti.m:
     Conform to the above changes.

Julien.

diff --git a/compiler/builtin_ops.m b/compiler/builtin_ops.m
index 62e459e..8b7cc2b 100644
--- a/compiler/builtin_ops.m
+++ b/compiler/builtin_ops.m
@@ -2,7 +2,7 @@
  % vim: ft=mercury ts=4 sw=4 et
  %-----------------------------------------------------------------------------%
  % Copyright (C) 1999-2001, 2003-2006, 2009-2011 The University of Melbourne.
-% Copyright (C) 2014-2017 The Mercury team.
+% Copyright (C) 2014-2018 The Mercury team.
  % This file may only be copied under the terms of the GNU General
  % Public License - see the file COPYING in the Mercury distribution.
  %-----------------------------------------------------------------------------%
@@ -209,6 +209,15 @@
  :- inst simple_arg_expr for simple_expr/1
      --->    leaf(ground)
      ;       int_const(ground)
+    ;       uint_const(ground)
+    ;       int8_const(ground)
+    ;       uint8_const(ground)
+    ;       int16_const(ground)
+    ;       uint16_const(ground)
+    ;       int32_const(ground)
+    ;       uint32_const(ground)
+    ;       int64_const(ground)
+    ;       uint64_const(ground)
      ;       float_const(ground).

  %-----------------------------------------------------------------------------%
@@ -361,8 +370,9 @@ builtin_translation(ModuleName, PredName, ProcNum, Args, Code) :-
              ;
                  Args = [X, Y],
                  ProcNum = 0,
+                IntZeroConst = make_int_zero_const(IntType),
                  Code = assign(Y,
-                    binary(int_sub(IntType), int_const(0), leaf(X)))
+                    binary(int_sub(IntType), IntZeroConst, leaf(X)))
              )
          ;
              PredName = "xor", Args = [X, Y, Z],
@@ -450,5 +460,21 @@ builtin_translation(ModuleName, PredName, ProcNum, Args, Code) :-
      ).

  %-----------------------------------------------------------------------------%
+
+:- func make_int_zero_const(int_type::in)
+    = (simple_expr(T)::out(simple_arg_expr)) is det.
+
+make_int_zero_const(int_type_int)    = int_const(0).
+make_int_zero_const(int_type_int8)   = int8_const(0i8).
+make_int_zero_const(int_type_int16)  = int16_const(0i16).
+make_int_zero_const(int_type_int32)  = int32_const(0i32).
+make_int_zero_const(int_type_int64)  = int64_const(0).
+make_int_zero_const(int_type_uint)   = uint_const(0u).
+make_int_zero_const(int_type_uint8)  = uint8_const(0u8).
+make_int_zero_const(int_type_uint16) = uint16_const(0u16).
+make_int_zero_const(int_type_uint32) = uint32_const(0u32).
+make_int_zero_const(int_type_uint64) = uint64_const(0).
+
+%-----------------------------------------------------------------------------%
  :- end_module backend_libs.builtin_ops.
  %-----------------------------------------------------------------------------%
diff --git a/compiler/bytecode.m b/compiler/bytecode.m
index 79dd218..f1dbea1 100644
--- a/compiler/bytecode.m
+++ b/compiler/bytecode.m
@@ -1,7 +1,8 @@
  %---------------------------------------------------------------------------%
  % vim: ft=mercury ts=4 sw=4 et
  %---------------------------------------------------------------------------%
-% Copyright (C) 1996-2007, 2009-2011 The University of Melbourne.
+% Copyright (C) 1996-2007, 2009-2012 The University of Melbourne.
+% Copyright (C) 2014-2018 The Mercury team.
  % This file may only be copied under the terms of the GNU General
  % Public License - see the file COPYING in the Mercury distribution.
  %---------------------------------------------------------------------------%
@@ -116,7 +117,16 @@
  :- type byte_arg
      --->    byte_arg_var(byte_var)
      ;       byte_arg_int_const(int)
-    ;       byte_arg_float_const(float).
+    ;       byte_arg_float_const(float)
+    ;       byte_arg_uint_const(uint)
+    ;       byte_arg_int8_const(int8)
+    ;       byte_arg_uint8_const(uint8)
+    ;       byte_arg_int16_const(int16)
+    ;       byte_arg_uint16_const(uint16)
+    ;       byte_arg_int32_const(int32)
+    ;       byte_arg_uint32_const(uint32)
+    ;       byte_arg_int64_const(int)   % XXX INT64
+    ;       byte_arg_uint64_const(int). % XXX INT64

  :- type byte_dir
      --->    to_arg
@@ -593,6 +603,24 @@ output_arg(byte_arg_int_const(IntVal), !IO) :-
  output_arg(byte_arg_float_const(FloatVal), !IO) :-
      output_byte(2, !IO),
      output_float(FloatVal, !IO).
+output_arg(byte_arg_uint_const(_), _, _) :-
+    unexpected($pred, "NYI uint constants in bytecode").
+output_arg(byte_arg_int8_const(_), _, _) :-
+    unexpected($pred, "NYI int8 constants in bytecode").
+output_arg(byte_arg_uint8_const(_), _, _) :-
+    unexpected($pred, "NYI uint8 constants in bytecode").
+output_arg(byte_arg_int16_const(_), _, _) :-
+    unexpected($pred, "NYI int16 constants in bytecode").
+output_arg(byte_arg_uint16_const(_), _, _) :-
+    unexpected($pred, "NYI uint16 constants in bytecode").
+output_arg(byte_arg_int32_const(_), _, _) :-
+    unexpected($pred, "NYI int32 constants in bytecode").
+output_arg(byte_arg_uint32_const(_), _, _) :-
+    unexpected($pred, "NYI uint32 constants in bytecode").
+output_arg(byte_arg_int64_const(_), _, _) :-
+    unexpected($pred, "NYI int64 constants in bytecode").
+output_arg(byte_arg_uint64_const(_), _, _) :-
+    unexpected($pred, "NYI uint64 constants in bytecode").

  :- pred debug_arg(byte_arg::in, io::di, io::uo) is det.

@@ -602,6 +630,33 @@ debug_arg(byte_arg_var(Var), !IO) :-
  debug_arg(byte_arg_int_const(IntVal), !IO) :-
      debug_string("int", !IO),
      debug_int(IntVal, !IO).
+debug_arg(byte_arg_uint_const(UIntVal), !IO) :-
+    debug_string("uint", !IO),
+    debug_uint(UIntVal, !IO).
+debug_arg(byte_arg_int8_const(Int8Val), !IO) :-
+    debug_string("int8", !IO),
+    debug_int8(Int8Val, !IO).
+debug_arg(byte_arg_uint8_const(UInt8Val), !IO) :-
+    debug_string("uint8", !IO),
+    debug_uint8(UInt8Val, !IO).
+debug_arg(byte_arg_int16_const(Int16Val), !IO) :-
+    debug_string("int16", !IO),
+    debug_int16(Int16Val, !IO).
+debug_arg(byte_arg_uint16_const(UInt16Val), !IO) :-
+    debug_string("uint16", !IO),
+    debug_uint16(UInt16Val, !IO).
+debug_arg(byte_arg_int32_const(Int32Val), !IO) :-
+    debug_string("int32", !IO),
+    debug_int32(Int32Val, !IO).
+debug_arg(byte_arg_uint32_const(UInt32Val), !IO) :-
+    debug_string("uint32", !IO),
+    debug_uint32(UInt32Val, !IO).
+debug_arg(byte_arg_int64_const(Int64Val), !IO) :-
+    debug_string("int64", !IO),
+    debug_int64(Int64Val, !IO).
+debug_arg(byte_arg_uint64_const(UInt64Val), !IO) :-
+    debug_string("uint64", !IO),
+    debug_uint64(UInt64Val, !IO).
  debug_arg(byte_arg_float_const(FloatVal), !IO) :-
      debug_string("float", !IO),
      debug_float(FloatVal, !IO).
@@ -1492,6 +1547,60 @@ debug_int(Val, !IO) :-
      io.write_int(Val, !IO),
      io.write_char(' ', !IO).

+:- pred debug_uint(uint::in, io::di, io::uo) is det.
+
+debug_uint(Val, !IO) :-
+    io.write_uint(Val, !IO),
+    io.write_char(' ', !IO).
+
+:- pred debug_int8(int8::in, io::di, io::uo) is det.
+
+debug_int8(Val, !IO) :-
+    io.write_int8(Val, !IO),
+    io.write_char(' ', !IO).
+
+:- pred debug_uint8(uint8::in, io::di, io::uo) is det.
+
+debug_uint8(Val, !IO) :-
+    io.write_uint8(Val, !IO),
+    io.write_char(' ', !IO).
+
+:- pred debug_int16(int16::in, io::di, io::uo) is det.
+
+debug_int16(Val, !IO) :-
+    io.write_int16(Val, !IO),
+    io.write_char(' ', !IO).
+
+:- pred debug_uint16(uint16::in, io::di, io::uo) is det.
+
+debug_uint16(Val, !IO) :-
+    io.write_uint16(Val, !IO),
+    io.write_char(' ', !IO).
+
+:- pred debug_int32(int32::in, io::di, io::uo) is det.
+
+debug_int32(Val, !IO) :-
+    io.write_int32(Val, !IO),
+    io.write_char(' ', !IO).
+
+:- pred debug_uint32(uint32::in, io::di, io::uo) is det.
+
+debug_uint32(Val, !IO) :-
+    io.write_uint32(Val, !IO),
+    io.write_char(' ', !IO).
+
+:- pred debug_int64(int::in, io::di, io::uo) is det.
+
+debug_int64(Val, !IO) :-
+    io.write_int(Val, !IO),
+    io.write_char(' ', !IO).
+
+:- pred debug_uint64(int::in, io::di, io::uo) is det.
+
+debug_uint64(Val, !IO) :-
+    io.write_int(Val, !IO),
+    io.write_char(' ', !IO).
+
  :- pred debug_float(float::in, io::di, io::uo) is det.

  debug_float(Val, !IO) :-
diff --git a/compiler/bytecode_gen.m b/compiler/bytecode_gen.m
index 227b7e1..bf73d42 100644
--- a/compiler/bytecode_gen.m
+++ b/compiler/bytecode_gen.m
@@ -2,6 +2,7 @@
  % vim: ft=mercury ts=4 sw=4 et
  %---------------------------------------------------------------------------%
  % Copyright (C) 1996-2012 The University of Melbourne.
+% Copyright (C) 2014-2018 The Mercury team.
  % This file may only be copied under the terms of the GNU General
  % Public License - see the file COPYING in the Mercury distribution.
  %---------------------------------------------------------------------------%
@@ -507,6 +508,33 @@ map_arg(ByteInfo, Expr, ByteArg) :-
      ;
          Expr = float_const(FloatVal),
          ByteArg = byte_arg_float_const(FloatVal)
+    ;
+        Expr = uint_const(UIntVal),
+        ByteArg = byte_arg_uint_const(UIntVal)
+    ;
+        Expr = int8_const(Int8Val),
+        ByteArg = byte_arg_int8_const(Int8Val)
+    ;
+        Expr = uint8_const(UInt8Val),
+        ByteArg = byte_arg_uint8_const(UInt8Val)
+    ;
+        Expr = int16_const(Int16Val),
+        ByteArg = byte_arg_int16_const(Int16Val)
+    ;
+        Expr = uint16_const(UInt16Val),
+        ByteArg = byte_arg_uint16_const(UInt16Val)
+    ;
+        Expr = int32_const(Int32Val),
+        ByteArg = byte_arg_int32_const(Int32Val)
+    ;
+        Expr = uint32_const(UInt32Val),
+        ByteArg = byte_arg_uint32_const(UInt32Val)
+    ;
+        Expr = int64_const(Int64Val),
+        ByteArg = byte_arg_int64_const(Int64Val)
+    ;
+        Expr = uint64_const(UInt64Val),
+        ByteArg = byte_arg_uint64_const(UInt64Val)
      ).

  %---------------------------------------------------------------------------%
diff --git a/compiler/erl_rtti.m b/compiler/erl_rtti.m
index 480682b..8fd3ea1 100644
--- a/compiler/erl_rtti.m
+++ b/compiler/erl_rtti.m
@@ -1,7 +1,8 @@
  %-----------------------------------------------------------------------------%
  % vim: ft=mercury ts=4 sw=4 et
  %-----------------------------------------------------------------------------%
-% Copyright (C) 2007, 2009-2011 The University of Melbourne.
+% Copyright (C) 2007, 2009-2012 The University of Melbourne.
+% Copyright (C) 2014-2018 The Mercury team.
  % This file may only be copied under the terms of the GNU General
  % Public License - see the file COPYING in the Mercury distribution.
  %-----------------------------------------------------------------------------%
@@ -623,6 +624,10 @@ erlang_type_ctor_rep(erlang_builtin(builtin_ctor_int32)) =
      elds_term(make_enum_alternative("etcr_int32")).
  erlang_type_ctor_rep(erlang_builtin(builtin_ctor_uint32)) =
      elds_term(make_enum_alternative("etcr_uint32")).
+erlang_type_ctor_rep(erlang_builtin(builtin_ctor_int64)) =
+    elds_term(make_enum_alternative("etcr_int64")).
+erlang_type_ctor_rep(erlang_builtin(builtin_ctor_uint64)) =
+    elds_term(make_enum_alternative("etcr_uint64")).
  erlang_type_ctor_rep(erlang_builtin(builtin_ctor_float)) =
      elds_term(make_enum_alternative("etcr_float")).
  erlang_type_ctor_rep(erlang_builtin(builtin_ctor_char)) =
diff --git a/compiler/prog_type.m b/compiler/prog_type.m
index e7c39b3..acfdf1f 100644
--- a/compiler/prog_type.m
+++ b/compiler/prog_type.m
@@ -2,6 +2,7 @@
  % vim: ft=mercury ts=4 sw=4 et
  %-----------------------------------------------------------------------------%
  % Copyright (C) 2005-2012 The University of Melbourne.
+% Copyright (C) 2014-2018 The Mercury team.
  % This file may only be copied under the terms of the GNU General
  % Public License - see the file COPYING in the Mercury distribution.
  %-----------------------------------------------------------------------------%
@@ -794,6 +795,8 @@ builtin_type_ctors_with_no_hlds_type_defn =
        type_ctor(qualified(mercury_public_builtin_module, "uint16"), 0),
        type_ctor(qualified(mercury_public_builtin_module, "int32"), 0),
        type_ctor(qualified(mercury_public_builtin_module, "uint32"), 0),
+      type_ctor(qualified(mercury_public_builtin_module, "int64"), 0),
+      type_ctor(qualified(mercury_public_builtin_module, "uint64"), 0),
        type_ctor(qualified(mercury_public_builtin_module, "string"), 0),
        type_ctor(qualified(mercury_public_builtin_module, "character"), 0),
        type_ctor(qualified(mercury_public_builtin_module, "float"), 0),
diff --git a/compiler/rtti.m b/compiler/rtti.m
index 4d60d86..5ffda6d 100644
--- a/compiler/rtti.m
+++ b/compiler/rtti.m
@@ -440,6 +440,8 @@
      ;       builtin_ctor_uint16
      ;       builtin_ctor_int32
      ;       builtin_ctor_uint32
+    ;       builtin_ctor_int64
+    ;       builtin_ctor_uint64
      ;       builtin_ctor_float
      ;       builtin_ctor_char
      ;       builtin_ctor_string
@@ -1764,6 +1766,8 @@ builtin_ctor_rep_to_string(builtin_ctor_int16, "MR_TYPECTOR_REP_INT16").
  builtin_ctor_rep_to_string(builtin_ctor_uint16, "MR_TYPECTOR_REP_UINT16").
  builtin_ctor_rep_to_string(builtin_ctor_int32, "MR_TYPECTOR_REP_INT32").
  builtin_ctor_rep_to_string(builtin_ctor_uint32, "MR_TYPECTOR_REP_UINT32").
+builtin_ctor_rep_to_string(builtin_ctor_int64, "MR_TYPECTOR_REP_INT64").
+builtin_ctor_rep_to_string(builtin_ctor_uint64, "MR_TYPECTOR_REP_UINT64").
  builtin_ctor_rep_to_string(builtin_ctor_string, "MR_TYPECTOR_REP_STRING").
  builtin_ctor_rep_to_string(builtin_ctor_float, "MR_TYPECTOR_REP_FLOAT").
  builtin_ctor_rep_to_string(builtin_ctor_char, "MR_TYPECTOR_REP_CHAR").
diff --git a/compiler/type_ctor_info.m b/compiler/type_ctor_info.m
index 0ed5d86..394fa45 100644
--- a/compiler/type_ctor_info.m
+++ b/compiler/type_ctor_info.m
@@ -2,6 +2,7 @@
  % vim: ft=mercury ts=4 sw=4 et
  %---------------------------------------------------------------------------%
  % Copyright (C) 1996-2012 The University of Melbourne.
+% Copyright (C) 2014-2018 The Mercury team.
  % This file may only be copied under the terms of the GNU General
  % Public License - see the file COPYING in the Mercury distribution.
  %---------------------------------------------------------------------------%
@@ -427,6 +428,8 @@ builtin_type_ctor("builtin", "int16", 0, builtin_ctor_int16).
  builtin_type_ctor("builtin", "uint16", 0, builtin_ctor_uint16).
  builtin_type_ctor("builtin", "int32", 0, builtin_ctor_int32).
  builtin_type_ctor("builtin", "uint32", 0, builtin_ctor_uint32).
+builtin_type_ctor("builtin", "int64", 0, builtin_ctor_int64).
+builtin_type_ctor("builtin", "uint64", 0, builtin_ctor_uint64).
  builtin_type_ctor("builtin", "string", 0, builtin_ctor_string).
  builtin_type_ctor("builtin", "float", 0, builtin_ctor_float).
  builtin_type_ctor("builtin", "character", 0, builtin_ctor_char).
diff --git a/compiler/typecheck.m b/compiler/typecheck.m
index ee99e26..1a9a4fc 100644
--- a/compiler/typecheck.m
+++ b/compiler/typecheck.m
@@ -2,6 +2,7 @@
  % vim: ft=mercury ts=4 sw=4 et
  %---------------------------------------------------------------------------%
  % Copyright (C) 1993-2012 The University of Melbourne.
+% Copyright (C) 2014-2018 The Mercury team.
  % This file may only be copied under the terms of the GNU General
  % Public License - see the file COPYING in the Mercury distribution.
  %---------------------------------------------------------------------------%
@@ -2264,6 +2265,14 @@ cons_id_must_be_builtin_type(ConsId, ConsType, BuiltinTypeName) :-
          BuiltinTypeName = "uint32",
          BuiltinType = builtin_type_int(int_type_uint32)
      ;
+        ConsId = int64_const(_),
+        BuiltinTypeName = "int64",
+        BuiltinType = builtin_type_int(int_type_int64)
+    ;
+        ConsId = uint64_const(_),
+        BuiltinTypeName = "uint64",
+        BuiltinType = builtin_type_int(int_type_uint64)
+    ;
          ConsId = float_const(_),
          BuiltinTypeName = "float",
          BuiltinType = builtin_type_float


More information about the reviews mailing list