[m-rev.] diff: another bug with static data on java

[Peter Wang]

Branches: main

Fix a problem with the Java backend, where static data structures could be
initialised with an unnecessary secondary tag if --common-struct is disabled
(e.g. at -O1).  A previous change fixed it when --common-struct is enabled.

compiler/ml_unify_gen.m:
        Don't initialise compound data structures with an extra secondary tag
        argument if --high-level-data is used.

compiler/mlds_to_java.m:
        Abort if asked to construct an object with a secondary tag instead of
        ignoring it explicitly.

diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m
index 95049d6..1226a96 100644
--- a/compiler/ml_unify_gen.m
+++ b/compiler/ml_unify_gen.m
@@ -584,26 +584,25 @@ ml_gen_compound(ConsId, Ptag, MaybeStag, UsesBaseClass, Var, ArgVars, ArgModes,
     % If there is a secondary tag, it goes in the first field.
     (
         MaybeStag = yes(Stag),
+        ml_gen_info_get_high_level_data(!.Info, HighLevelData),
+        (
+            HighLevelData = no,
         HasSecTag = yes,
         StagRval0 = ml_const(mlconst_int(Stag)),
         StagType0 = mlds_native_int_type,
-
         % With the low-level data representation, all fields -- even the
         % secondary tag -- are boxed, and so we need box it here.
-
-        ml_gen_info_get_high_level_data(!.Info, HighLevelData),
-        (
-            HighLevelData = no,
             StagRval = ml_unop(box(StagType0), StagRval0),
-            StagType = mlds_generic_type
-        ;
-            HighLevelData = yes,
-            StagRval = StagRval0,
-            StagType = StagType0
-        ),
+            StagType = mlds_generic_type,
         ExtraRvals = [StagRval],
         ExtraArgTypes = [StagType]
     ;
+            HighLevelData = yes,
+            HasSecTag = no,
+            ExtraRvals = [],
+            ExtraArgTypes = []
+        )
+    ;
         MaybeStag = no,
         HasSecTag = no,
         ExtraRvals = [],
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index bce3e23..9baee4a 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -3729,8 +3729,14 @@ output_atomic_stmt(_Indent, _, _FuncInfo, delete_object(_Lval), _, _, _) :-
 output_atomic_stmt(Indent, ModuleInfo, FuncInfo, NewObject, Context, !IO) :-
     NewObject = new_object(Target, _MaybeTag, HasSecTag, Type,
         _MaybeSize, MaybeCtorName, Args, ArgTypes, _MayUseAtomic),
-    ModuleName = FuncInfo ^ func_info_name ^ mod_name,
+    (
+        HasSecTag = yes,
+        unexpected(this_file, "output_atomic_stmt: has secondary tag")
+    ;
+        HasSecTag = no
+    ),
 
+    ModuleName = FuncInfo ^ func_info_name ^ mod_name,
     indent_line(Indent, !IO),
     io.write_string("{\n", !IO),
     indent_line(Context, Indent + 1, !IO),
@@ -3759,15 +3765,13 @@ output_atomic_stmt(Indent, ModuleInfo, FuncInfo, NewObject, Context, !IO) :-
         % The new object will be an array, so we need to initialise it
         % using array literals syntax.
         io.write_string(" {", !IO),
-        output_init_args(ModuleInfo, Args, ArgTypes, 0, HasSecTag, ModuleName,
-            !IO),
+        output_init_args(ModuleInfo, Args, ArgTypes, ModuleName, !IO),
         io.write_string("};\n", !IO)
     ;
         IsArray = not_array,
         % Generate constructor arguments.
         io.write_string("(", !IO),
-        output_init_args(ModuleInfo, Args, ArgTypes, 0, HasSecTag, ModuleName,
-            !IO),
+        output_init_args(ModuleInfo, Args, ArgTypes, ModuleName, !IO),
         io.write_string(");\n", !IO)
     ),
     indent_line(Indent, !IO),
@@ -3851,34 +3855,23 @@ output_target_code_component(ModuleInfo, ModuleName, _Context, TargetCode,
     % object's class constructor.
     %
 :- pred output_init_args(module_info::in, list(mlds_rval)::in,
-    list(mlds_type)::in, int::in, bool::in, mlds_module_name::in,
-    io::di, io::uo) is det.
+    list(mlds_type)::in, mlds_module_name::in, io::di, io::uo) is det.
 
-output_init_args(_, [], [], _, _, _, !IO).
-output_init_args(_, [_ | _], [], _, _, _, _, _) :-
+output_init_args(_, [], [], _, !IO).
+output_init_args(_, [_ | _], [], _, _, _) :-
     unexpected(this_file, "output_init_args: length mismatch.").
-output_init_args(_, [], [_ | _], _, _, _, _, _) :-
+output_init_args(_, [], [_ | _], _, _, _) :-
     unexpected(this_file, "output_init_args: length mismatch.").
-output_init_args(ModuleInfo, [Arg | Args], [_ArgType | ArgTypes], ArgNum,
-        HasSecTag, ModuleName, !IO) :-
-    (
-        ArgNum = 0,
-        HasSecTag = yes
-    ->
-        % This first argument is a `data_tag', It is set by
-        % the class constructor so this argument can be discarded.
-        true
-    ;
+output_init_args(ModuleInfo, [Arg | Args], [_ArgType | ArgTypes], ModuleName,
+        !IO) :-
         output_rval(ModuleInfo, Arg, ModuleName, !IO),
         (
             Args = []
         ;
             Args = [_ | _],
             io.write_string(", ", !IO)
-        )
     ),
-    output_init_args(ModuleInfo, Args, ArgTypes, ArgNum + 1, HasSecTag,
-        ModuleName, !IO).
+    output_init_args(ModuleInfo, Args, ArgTypes, ModuleName, !IO).
 
 %-----------------------------------------------------------------------------%
 %

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------