diff --git a/compiler/add_pred.m b/compiler/add_pred.m index f9523e2ecc..0e4e7beba9 100644 --- a/compiler/add_pred.m +++ b/compiler/add_pred.m @@ -620,8 +620,10 @@ goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo1), ( if ModuleName = mercury_private_builtin_module, - % This predicate is incompatible with some backends. - Name = "store_at_ref_impure", + % These predicates are incompatible with some backends. + ( Name = "store_at_ref_impure" + ; Name = "store_at_field_offset_impure" + ), require_complete_switch [CompilationTarget] ( ( CompilationTarget = target_java diff --git a/compiler/builtin_ops.m b/compiler/builtin_ops.m index 80f902c43a..8a03dea09a 100644 --- a/compiler/builtin_ops.m +++ b/compiler/builtin_ops.m @@ -253,6 +253,14 @@ :- type simple_code(T) ---> assign(T, simple_assigned_expr(T)) ; ref_assign(T, T) + ; field_assign(T, T, T) + % field_assign(Cell, Offset, Value). + % Write Value into the heap cell pointed to by Cell, at the + % word offset given by Offset. The primary tag of Cell is + % stripped at the lowering site. Used by the LCMC pass under + % accurate GC, where capturing the address of a field would + % create an interior pointer that the collector cannot + % relocate. ; test(simple_test_expr(T)) ; noop(list(T)). @@ -412,6 +420,10 @@ PredName = "store_at_ref_impure", ProcNum = 0, Args = [X, Y], Code = ref_assign(X, Y) + ; + PredName = "store_at_field_offset_impure", + ProcNum = 0, Args = [Cell, Offset, Value], + Code = field_assign(Cell, Offset, Value) ; PredName = "unsafe_type_cast", ProcNum = 0, Args = [X, Y], % Note that the code we generate for unsafe_type_cast diff --git a/compiler/call_gen.m b/compiler/call_gen.m index 26f4900a98..f8a33efc24 100644 --- a/compiler/call_gen.m +++ b/compiler/call_gen.m @@ -713,6 +713,15 @@ StoreInstr = llds_instr(assign(mem_ref(AddrRval), ValueRval), ""), StoreCode = singleton(StoreInstr), Code = AddrVarCode ++ ValueVarCode ++ StoreCode + ; + SimpleCode = field_assign(CellVar, OffsetVar, ValueVar), + produce_variable(CellVar, CellVarCode, CellRval, !CLD), + produce_variable(OffsetVar, OffsetVarCode, OffsetRval, !CLD), + produce_variable(ValueVar, ValueVarCode, ValueRval, !CLD), + FieldLval = field(no, CellRval, OffsetRval), + StoreInstr = llds_instr(assign(FieldLval, ValueRval), ""), + StoreCode = singleton(StoreInstr), + Code = CellVarCode ++ OffsetVarCode ++ ValueVarCode ++ StoreCode ; SimpleCode = test(_), unexpected($pred, "malformed model_det builtin predicate") @@ -737,6 +746,9 @@ ; SimpleCode = ref_assign(_, _), unexpected($pred, "malformed model_semi builtin predicate") + ; + SimpleCode = field_assign(_, _, _), + unexpected($pred, "malformed model_semi builtin predicate") ; SimpleCode = noop(_), unexpected($pred, "malformed model_semi builtin predicate") diff --git a/compiler/handle_options.m b/compiler/handle_options.m index e4235ee409..2b1f3a1b91 100644 --- a/compiler/handle_options.m +++ b/compiler/handle_options.m @@ -691,15 +691,25 @@ OT_OptUnusedArgsIntermod = do_not_opt_unused_args_intermod ), - % XXX With accurate gc, we need to disable optimize-constructor-last-call - % as currently the collector (and tracing code generator) knows neither - % about the pre-constructed data structures nor the references into them - % that this optimisation uses. + % LCMC under accurate GC needs the cell-and-offset capture that + % lco.m's lci_use_field_path branch implements: the original LLD + % store_at_ref_type pointer is an interior pointer into a heap cell + % and the AGC collector cannot relocate it when the cell is + % evacuated. The high-level-data path passes the parent cell as a + % partial-inst term, so it is already safe under AGC. The low-level + % MLDS path uses the new store_at_field_offset_impure builtin to + % keep the cell pointer GC-traceable while still landing the field + % write at the right offset. The LLDS back-end has not yet been + % wired up to either alternative, so accurate GC + LLDS still + % disables LCMC entirely. + globals.lookup_bool_option(!.Globals, highlevel_code, OT_HighLevelCode), ( if AllowSrcChangesDebug = allow_src_changes, ProfileDeep = bool.no, AllowOptLCMCTermSize = bool.yes, - GC_Method \= gc_accurate + ( GC_Method \= gc_accurate + ; OT_HighLevelCode = yes + ) then OT_OptLCMC = OT_OptLCMC0 else diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m index 18991b4155..998c80001b 100644 --- a/compiler/hlds_pred.m +++ b/compiler/hlds_pred.m @@ -3577,7 +3577,9 @@ ( OptTuple ^ ot_inline_builtins = inline_builtins ; - PredName = "store_at_ref_impure", + ( PredName = "store_at_ref_impure" + ; PredName = "store_at_field_offset_impure" + ), ModuleName = mercury_private_builtin_module ) ; diff --git a/compiler/introduced_call_table.m b/compiler/introduced_call_table.m index 529e4b859d..b8654b71ad 100644 --- a/compiler/introduced_call_table.m +++ b/compiler/introduced_call_table.m @@ -261,6 +261,7 @@ mict_private_builtin("restore_hp", 1). mict_private_builtin("sorry", 1). mict_private_builtin("store_at_ref_impure", 2). +mict_private_builtin("store_at_field_offset_impure", 3). mict_private_builtin("store_ticket", 1). mict_private_builtin("superclass_from_typeclass_info", 3). mict_private_builtin("trace_evaluate_runtime_condition", 0). diff --git a/compiler/lco.m b/compiler/lco.m index a8e273369e..89e2f5c361 100644 --- a/compiler/lco.m +++ b/compiler/lco.m @@ -183,6 +183,7 @@ :- import_module hlds.inst_lookup. :- import_module hlds.inst_test. :- import_module hlds.instmap. +:- import_module hlds.make_goal. :- import_module hlds.mode_top_functor. :- import_module hlds.passes_aux. :- import_module hlds.pred_name. @@ -298,7 +299,22 @@ lci_cur_proc_outputs :: list(prog_var), lci_cur_proc_detism :: determinism, lci_allow_float_addr :: allow_float_addr, - lci_highlevel_data :: bool + lci_highlevel_data :: bool, + + % lci_use_field_path is yes in LLD-data MLDS grades that use + % accurate GC. In those grades we cannot capture the address + % of a heap-cell field as a Mercury value, because the + % collector has no representation for interior pointers and + % cannot relocate them when the parent cell moves. Instead, + % the address-of-field "AddrVar" carries the parent cell + % itself, and the variant's would-be-store-through-pointer + % calls are emitted as private_builtin.store_at_field_offset_impure( + % CellVar, OffsetIntLiteral, Value) so that the cell can be + % relocated normally by the collector. This mirrors the + % HLD path's pass-the-cell shape, but uses an explicit + % field-write builtin instead of a partial-inst unification, + % since LLD does not track per-field insts. + lci_use_field_path :: bool ). :- type var_to_target == assoc_list(prog_var, store_target). @@ -428,9 +444,28 @@ UnboxedFloat = yes, AllowFloatAddr = allow_float_addr ), + % The LLD address-of-field path is unsafe under accurate GC because the + % captured interior pointer cannot be relocated when its parent cell + % moves during a Cheney copy. In MLDS grades we have a cell-passing + % alternative: capture the parent cell instead of an interior pointer, + % and emit a per-store private_builtin.store_at_field_offset_impure + % call that walks from the cell pointer to the field at a static + % offset. This mirrors the HLD path's shape and lets the collector + % trace the cell normally. Switch to that path under LLD MLDS + AGC. + globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode), + globals.get_gc_method(Globals, GC_Method), + ( if + HighLevelData = no, + HighLevelCode = yes, + GC_Method = gc_accurate + then + UseFieldPath = yes + else + UseFieldPath = no + ), ConstInfo = lco_const_info(LowerSCCVariants, SCC, CurProc, PredInfo, ProcInfo0, OutputHeadVars, CurProcDetism, - AllowFloatAddr, HighLevelData), + AllowFloatAddr, HighLevelData, UseFieldPath), Info0 = lco_info(!.ModuleInfo, !.CurSCCVariants, VarTable0, lco_is_permitted_on_scc, proc_not_changed), proc_info_get_goal(ProcInfo0, Goal0), @@ -949,7 +984,9 @@ io.write_line(DebugStream, AddrFieldIdsAL, !IO) ), HighLevelData = ConstInfo ^ lci_highlevel_data, - make_variant_args(HighLevelData, AddrFieldIds, Mismatches, + UseFieldPath = ConstInfo ^ lci_use_field_path, + bool.or(HighLevelData, UseFieldPath, PassCell), + make_variant_args(PassCell, AddrFieldIds, Mismatches, VariantArgs), ensure_variant_exists(PredId, ProcId, VariantArgs, VariantPredProcId, VariantSymName, !Info) @@ -1152,12 +1189,18 @@ Name = var_entry_name_default(Var, VarEntry, "SCCcallarg"), VarEntry = vte(_, VarType, _VarTypeIsDummy), HighLevelData = ConstInfo ^ lci_highlevel_data, + UseFieldPath = ConstInfo ^ lci_use_field_path, + bool.or(HighLevelData, UseFieldPath, PassCell), ( - HighLevelData = no, + PassCell = no, AddrVarType = make_ref_type(VarType) ; - HighLevelData = yes, - % We set the actual type later when it is more convenient. + PassCell = yes, + % AddrVar will hold the parent cell, not an interior pointer. + % We do not yet know the parent type at this point, so leave + % the type as void_type; update_construct_args will rewrite + % the entry with the real cell type once the construction + % goal containing this field is processed. AddrVarType = void_type ), AddrName = "Addr" ++ Name, @@ -1177,12 +1220,16 @@ :- pred make_variant_args(bool::in, map(prog_var, field_id)::in, assoc_list(int, prog_var)::in, list(variant_arg)::out) is det. -make_variant_args(HighLevelData, AddrVarFieldIds, Mismatches, VariantArgs) :- + % PassCell = yes whenever the variant should take the parent cell as + % an input argument (with field-id metadata) rather than receiving an + % interior pointer through store_at_ref_type. That covers HLD always, + % and LLD MLDS+AGC where capturing a field address is unsafe. +make_variant_args(PassCell, AddrVarFieldIds, Mismatches, VariantArgs) :- ( - HighLevelData = no, + PassCell = no, MakeArg = (func(Pos - _Var) = variant_arg(Pos, no)) ; - HighLevelData = yes, + PassCell = yes, MakeArg = ( func(Pos - Var) = variant_arg(Pos, yes(FieldId)) :- map.lookup(AddrVarFieldIds, Var, FieldId) @@ -1303,11 +1350,13 @@ % partial instantiation is incomplete, instmaps for the assignments are % likely to be recomputed incorrectly. HighLevelData = ConstInfo ^ lci_highlevel_data, + UseFieldPath = ConstInfo ^ lci_use_field_path, + bool.or(HighLevelData, UseFieldPath, PassCell), VarTable0 = !.Info ^ lco_var_table, lookup_var_entry(VarTable0, Var, VarEntry), VarEntry = vte(_, VarType, IsDummy), InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0), - update_construct_args(Subst, HighLevelData, VarType, IsDummy, + update_construct_args(Subst, HighLevelData, PassCell, VarType, IsDummy, ConsId, 1, ArgVars, UpdatedArgVars, AddrFields, InstMapDelta0, InstMapDelta, !AddrVarFieldIds, VarTable0, VarTable), @@ -1346,30 +1395,45 @@ unexpected($pred, "not construct") ). -:- pred update_construct_args(map(prog_var, prog_var)::in, bool::in, +:- pred update_construct_args(map(prog_var, prog_var)::in, + bool::in, bool::in, mer_type::in, is_dummy_type::in, cons_id::in, int::in, list(prog_var)::in, list(prog_var)::out, list(int)::out, instmap_delta::in, instmap_delta::out, map(prog_var, field_id)::in, map(prog_var, field_id)::out, var_table::in, var_table::out) is det. -update_construct_args(_, _, _, _, _, _, [], [], [], +update_construct_args(_, _, _, _, _, _, _, [], [], [], !InstMapDelta, !AddrFieldIds, !VarTable). -update_construct_args(Subst, HighLevelData, VarType, IsDummyType, +update_construct_args(Subst, HighLevelData, PassCell, VarType, IsDummyType, ConsId, ArgNum, [OrigVar | OrigVars], [UpdatedVar | UpdatedVars], AddrArgs, !InstMapDelta, !AddrFieldIds, !VarTable) :- - update_construct_args(Subst, HighLevelData, VarType, IsDummyType, + update_construct_args(Subst, HighLevelData, PassCell, VarType, IsDummyType, ConsId, ArgNum + 1, OrigVars, UpdatedVars, AddrArgsTail, !InstMapDelta, !AddrFieldIds, !VarTable), ( if map.search(Subst, OrigVar, AddrVar) then UpdatedVar = AddrVar, ( - HighLevelData = no, + PassCell = no, FinalInst = ground_inst ; - HighLevelData = yes, - BoundFunctor = bound_functor_with_free_arg(ConsId, ArgNum), - FinalInst = bound(shared, inst_test_no_results, [BoundFunctor]), + PassCell = yes, + ( + HighLevelData = yes, + BoundFunctor = bound_functor_with_free_arg(ConsId, ArgNum), + FinalInst = + bound(shared, inst_test_no_results, [BoundFunctor]) + ; + HighLevelData = no, + % LLD does not track per-field insts at the mode-checker + % level. The cell is treated as ground from the moment it + % is allocated, even though one of its fields is + % temporarily set to NULL until the variant fills it in. + FinalInst = ground_inst + ), % We didn't do this when we initially created the variable. + % Update the placeholder void_type entry from make_address_var + % to the parent cell type so downstream passes see AddrVar + % as a regular cell pointer. lookup_var_entry(!.VarTable, AddrVar, AddrVarEntry0), AddrVarEntry0 = vte(AddrVarName, _, _), % XXX Why is it that VarType, and its IsDummyType companion, @@ -1481,7 +1545,12 @@ proc_info_get_var_table(ProcInfo, VarTable0), proc_info_get_headvars(ProcInfo, HeadVars0), proc_info_get_argmodes(ProcInfo, ArgModes0), - make_addr_vars(!.ModuleInfo, 1, HeadVars0, HeadVars, ArgModes0, ArgModes, + module_info_get_globals(!.ModuleInfo, Globals0), + globals.get_target(Globals0, TargetForVariant), + HighLevelDataForVariant = + compilation_target_high_level_data(TargetForVariant), + make_addr_vars(!.ModuleInfo, HighLevelDataForVariant, 1, + HeadVars0, HeadVars, ArgModes0, ArgModes, AddrOutArgs, VarToAddr, VarTable0, VarTable), proc_info_set_headvars(HeadVars, !VariantProcInfo), proc_info_set_argmodes(ArgModes, !VariantProcInfo), @@ -1528,19 +1597,19 @@ !VariantProcInfo, !ModuleInfo) ). -:- pred make_addr_vars(module_info::in, int::in, +:- pred make_addr_vars(module_info::in, bool::in, int::in, list(prog_var)::in, list(prog_var)::out, list(mer_mode)::in, list(mer_mode)::out, list(variant_arg)::in, var_to_target::out, var_table::in, var_table::out) is det. -make_addr_vars(_, _, [], [], [], [], AddrOutArgs, [], !VarTable) :- +make_addr_vars(_, _, _, [], [], [], [], AddrOutArgs, [], !VarTable) :- expect(unify(AddrOutArgs, []), $pred, "AddrOutArgs != []"). -make_addr_vars(_, _, [], _, [_ | _], _, _, _, !VarTable) :- +make_addr_vars(_, _, _, [], _, [_ | _], _, _, _, !VarTable) :- unexpected($pred, "mismatched lists"). -make_addr_vars(_, _, [_ | _], _, [], _, _, _, !VarTable) :- +make_addr_vars(_, _, _, [_ | _], _, [], _, _, _, !VarTable) :- unexpected($pred, "mismatched lists"). -make_addr_vars(ModuleInfo, NextOutArgNum, +make_addr_vars(ModuleInfo, HighLevelData, NextOutArgNum, [HeadVar0 | HeadVars0], [HeadVar | HeadVars], [Mode0 | Modes0], [Mode | Modes], !.AddrOutArgs, VarToAddr, !VarTable) :- @@ -1551,7 +1620,7 @@ TopFunctorMode = top_in, HeadVar = HeadVar0, Mode = Mode0, - make_addr_vars(ModuleInfo, NextOutArgNum, + make_addr_vars(ModuleInfo, HighLevelData, NextOutArgNum, HeadVars0, HeadVars, Modes0, Modes, !.AddrOutArgs, VarToAddr, !VarTable) ; @@ -1564,26 +1633,43 @@ AddrVarName = "AddrOf" ++ HeadVarName, ( MaybeFieldId = no, - % For low-level data we replace the output argument with a - % store_at_ref_type(T) input argument. + % For low-level data without accurate GC we replace the + % output argument with a store_at_ref_type(T) interior + % pointer. AddrVarType = make_ref_type(HeadVarType), AddrVarTypeIsDummy = is_not_dummy_type, Mode = in_mode ; MaybeFieldId = yes(field_id(AddrVarType, ConsId, ArgNum)), - % For high-level data we replace the output argument with a - % partially instantiated structure. The structure has one - % argument left unfilled. AddrVarTypeIsDummy = is_type_a_dummy(ModuleInfo, AddrVarType), - BoundFunctor = bound_functor_with_free_arg(ConsId, ArgNum), - InitialInst = - bound(shared, inst_test_no_results, [BoundFunctor]), - Mode = from_to_mode(InitialInst, ground_inst) + ( + HighLevelData = yes, + % For high-level data we replace the output argument + % with a partially instantiated structure. The + % structure has one argument left unfilled. + BoundFunctor = + bound_functor_with_free_arg(ConsId, ArgNum), + InitialInst = + bound(shared, inst_test_no_results, [BoundFunctor]), + Mode = from_to_mode(InitialInst, ground_inst) + ; + HighLevelData = no, + % LLD MLDS+AGC path: AddrVar is the parent cell pointer + % itself, not an interior pointer. The cell appears + % ground to mode-checking even though one field is + % temporarily NULL until store_at_field_offset_impure + % fills it; LLD does not track per-field insts so this + % is consistent with how partially-built cells behave + % in non-LCMC code. Mode is in_mode, not the HLD + % from_to_mode, because the inst does not change at + % the variant boundary. + Mode = in_mode + ) ), AddrVarEntry = vte(AddrVarName, AddrVarType, AddrVarTypeIsDummy), add_var_entry(AddrVarEntry, AddrVar, !VarTable), HeadVar = AddrVar, - make_addr_vars(ModuleInfo, NextOutArgNum + 1, + make_addr_vars(ModuleInfo, HighLevelData, NextOutArgNum + 1, HeadVars0, HeadVars, Modes0, Modes, !.AddrOutArgs, VarToAddrTail, !VarTable), VarToAddrHead = HeadVar0 - store_target(AddrVar, MaybeFieldId), @@ -1591,7 +1677,7 @@ else HeadVar = HeadVar0, Mode = Mode0, - make_addr_vars(ModuleInfo, NextOutArgNum + 1, + make_addr_vars(ModuleInfo, HighLevelData, NextOutArgNum + 1, HeadVars0, HeadVars, Modes0, Modes, !.AddrOutArgs, VarToAddr, !VarTable) ) @@ -1988,39 +2074,115 @@ !ProcInfo) :- StoreTarget = store_target(AddrVar, MaybeFieldId), ( - % Low-level data. + % Low-level data without accurate GC: the address-of-field + % captured by lco.m is a raw interior pointer; we just + % dereference and store. MaybeFieldId = no, generate_plain_call(ModuleInfo, pf_predicate, mercury_private_builtin_module, "store_at_ref_impure", [], [AddrVar, GroundVar], instmap_delta_bind_vars([]), only_mode, detism_det, purity_impure, [], dummy_context, Goal) ; - % High-level data. MaybeFieldId = yes(field_id(AddrVarType, ConsId, ArgNum)), - get_cons_id_arg_types(ModuleInfo, AddrVarType, ConsId, ArgTypes), - make_unification_args(ModuleInfo, GroundVar, ArgNum, 1, ArgTypes, - ArgVars, ArgModes, !ProcInfo), + module_info_get_globals(ModuleInfo, Globals), + globals.get_target(Globals, Target), + HighLevelData = compilation_target_high_level_data(Target), + ( + HighLevelData = yes, + % High-level data: build the missing argument value and let + % the partial-inst deconstruction unification fill in the + % hole. The MLDS code generator lowers this to a regular + % field write on the cell whose tail was free. + make_store_goal_hld_unify(ModuleInfo, InstMap, AddrVar, + AddrVarType, ConsId, ArgNum, GroundVar, Goal, !ProcInfo) + ; + HighLevelData = no, + % Low-level data with accurate GC (the lci_use_field_path + % regime). AddrVar holds the parent cell pointer rather + % than an interior pointer. Compute the cell offset of the + % hole at compile time, then emit a + % store_at_field_offset_impure call so the lowering walks + % the cell pointer at runtime. AddrVarType, recorded in + % the field_id, is not needed in this branch: the offset + % alone determines the field address. + make_store_goal_lld_field(ModuleInfo, AddrVar, + ConsId, ArgNum, GroundVar, Goal, !ProcInfo) + ) + ). - RHS = rhs_functor(ConsId, is_not_exist_constr, ArgVars), +:- pred make_store_goal_hld_unify(module_info::in, instmap::in, + prog_var::in, mer_type::in, cons_id::in, int::in, prog_var::in, + hlds_goal::out, proc_info::in, proc_info::out) is det. - instmap_lookup_var(InstMap, AddrVar, AddrVarInst0), - inst_expand(ModuleInfo, AddrVarInst0, AddrVarInst), - UnifyMode = unify_modes_li_lf_ri_rf(AddrVarInst, ground_inst, - ground_inst, ground_inst), +make_store_goal_hld_unify(ModuleInfo, InstMap, AddrVar, AddrVarType, + ConsId, ArgNum, GroundVar, Goal, !ProcInfo) :- + get_cons_id_arg_types(ModuleInfo, AddrVarType, ConsId, ArgTypes), + make_unification_args(ModuleInfo, GroundVar, ArgNum, 1, ArgTypes, + ArgVars, ArgModes, !ProcInfo), - Unification = deconstruct(AddrVar, ConsId, ArgVars, ArgModes, - cannot_fail, cannot_cgc), - UnifyContext = unify_context(umc_implicit("lcmc"), []), + RHS = rhs_functor(ConsId, is_not_exist_constr, ArgVars), - GoalExpr = unify(AddrVar, RHS, UnifyMode, Unification, UnifyContext), + instmap_lookup_var(InstMap, AddrVar, AddrVarInst0), + inst_expand(ModuleInfo, AddrVarInst0, AddrVarInst), + UnifyMode = unify_modes_li_lf_ri_rf(AddrVarInst, ground_inst, + ground_inst, ground_inst), - goal_info_init(GoalInfo0), - goal_info_set_determinism(detism_det, GoalInfo0, GoalInfo1), - goal_info_set_instmap_delta(instmap_delta_bind_var(AddrVar), - GoalInfo1, GoalInfo), + Unification = deconstruct(AddrVar, ConsId, ArgVars, ArgModes, + cannot_fail, cannot_cgc), + UnifyContext = unify_context(umc_implicit("lcmc"), []), - Goal = hlds_goal(GoalExpr, GoalInfo) - ). + GoalExpr = unify(AddrVar, RHS, UnifyMode, Unification, UnifyContext), + + goal_info_init(GoalInfo0), + goal_info_set_determinism(detism_det, GoalInfo0, GoalInfo1), + goal_info_set_instmap_delta(instmap_delta_bind_var(AddrVar), + GoalInfo1, GoalInfo), + + Goal = hlds_goal(GoalExpr, GoalInfo). + +:- pred make_store_goal_lld_field(module_info::in, prog_var::in, + cons_id::in, int::in, prog_var::in, hlds_goal::out, + proc_info::in, proc_info::out) is det. + +make_store_goal_lld_field(ModuleInfo, AddrVar, ConsId, ArgNum, + GroundVar, Goal, !ProcInfo) :- + % Look up the cell offset of the field. car_pos_width carries the + % cell_offset baked in by du_type_layout, including any sectag-word + % adjustment. apw_full is the only argument width that lco.m + % currently captures the address of (apw_partial_first / packed + % args fail the take-address pre-check earlier). + ( if ConsId = du_data_ctor(DuCtor) then + get_cons_repn_defn_det(ModuleInfo, DuCtor, ConsRepnDefn), + ConsArgRepns = ConsRepnDefn ^ cr_args, + list.det_index1(ConsArgRepns, ArgNum, ArgRepn), + ArgPosWidth = ArgRepn ^ car_pos_width + else + unexpected($pred, "non-DU cons_id in lcmc field path") + ), + ( if ArgPosWidth = apw_full(_, cell_offset(OffsetInt0)) then + OffsetInt = OffsetInt0 + else + unexpected($pred, "non-apw_full arg in lcmc field path") + ), + + % Materialise the offset as an int constant in a fresh local. + make_int_const_construction_alloc_in_proc(OffsetInt, + "AddrFieldOffset", OffsetGoal, OffsetVar, !ProcInfo), + + generate_plain_call(ModuleInfo, pf_predicate, + mercury_private_builtin_module, "store_at_field_offset_impure", + [], [AddrVar, OffsetVar, GroundVar], instmap_delta_bind_vars([]), + only_mode, detism_det, purity_impure, [], dummy_context, CallGoal), + + % Conjoin so the offset constant exists in scope when the call uses + % it. AddrVar's HLDS type is the parent cell type already, so + % type-checking is satisfied without any cast. + ConjGoalExpr = conj(plain_conj, [OffsetGoal, CallGoal]), + goal_info_init(ConjGoalInfo0), + goal_info_set_determinism(detism_det, ConjGoalInfo0, ConjGoalInfo1), + goal_info_set_instmap_delta(instmap_delta_bind_vars([OffsetVar]), + ConjGoalInfo1, ConjGoalInfo), + Goal = hlds_goal(ConjGoalExpr, ConjGoalInfo). :- pred make_unification_args(module_info::in, prog_var::in, int::in, int::in, list(mer_type)::in, list(prog_var)::out, list(unify_mode)::out, diff --git a/compiler/ml_accurate_gc.m b/compiler/ml_accurate_gc.m index 34ac80833f..c721ddef46 100644 --- a/compiler/ml_accurate_gc.m +++ b/compiler/ml_accurate_gc.m @@ -97,6 +97,7 @@ :- import_module mdbcomp.sym_name. :- import_module ml_backend.ml_code_gen. :- import_module ml_backend.ml_code_util. +:- import_module ml_backend.ml_unify_gen_construct. :- import_module parse_tree.builtin_lib_types. :- import_module parse_tree.prog_type. :- import_module parse_tree.set_of_var. @@ -383,10 +384,22 @@ not no_type_info_builtin(PredModule, PredName, PredFormArityInt) mlds_code_addr(QualFuncLabel, Signature))), % Generate the call - % `private_builtin.gc_trace(TypeInfo, (MR_C_Pointer) &Var);'. + % `private_builtin.gc_trace((MR_C_Pointer) TypeInfo, + % (MR_C_Pointer) &Var);'. + % + % The cast on TypeInfoRval is needed because TypeInfoRval may have + % an MLDS type that prints as a C pointer in some cases — most + % notably when the typeinfo source is itself a pointer-typed local + % (an existentially-typed output parameter, where TypeInfo_for_ArgT + % is passed as MR_Word *). gc_trace's first parameter is declared + % as MR_Word, so without the cast gcc rejects the call with + % `-Werror=int-conversion'. CPointerType prints as `MR_Word' under + % the C backend, so the cast is also a no-op for the common case + % where TypeInfoRval already has MR_Word-equivalent type. + CastTypeInfoRval = ml_cast(CPointerType, TypeInfoRval), CastVarAddr = ml_cast(CPointerType, ml_mem_addr(VarLval)), TraceStmt = ml_stmt_call(Signature, FuncAddr, - [TypeInfoRval, CastVarAddr], [], ordinary_call, Context). + [CastTypeInfoRval, CastVarAddr], [], ordinary_call, Context). % Generate HLDS code to construct the type_info for this type. % @@ -398,7 +411,13 @@ not no_type_info_builtin(PredModule, PredName, PredFormArityInt) ml_gen_info_get_module_info(!.Info, ModuleInfo0), ml_gen_info_get_pred_proc_id(!.Info, PredProcId), module_info_pred_proc_info(ModuleInfo0, PredProcId, PredInfo0, ProcInfo0), - % Generate the HLDS code to create the type_infos. + % Generate the HLDS code to create the type_infos. Note that this may + % insert new entries into the module's const_struct_db (when the type's + % type_info can be built from constant args), and the resulting HLDS goals + % may reference those new entries via type_info_const(N) cons_ids. + % Those references must be resolvable when MLDS is generated below, so we + % must extend the ConstStructMap and GlobalData in our ml_gen_info to + % cover any newly-inserted entries. polymorphism_make_type_info_var_mi(Type, Context, TypeInfoVar, TypeInfoGoals, ModuleInfo0, ModuleInfo1, PredInfo0, PredInfo, ProcInfo0, ProcInfo), @@ -407,7 +426,16 @@ not no_type_info_builtin(PredModule, PredName, PredFormArityInt) % Save the new information back in the ml_gen_info. proc_info_get_var_table(ProcInfo, VarTable), ml_gen_info_set_module_info(ModuleInfo, !Info), - ml_gen_info_set_var_table(VarTable, !Info). + ml_gen_info_set_var_table(VarTable, !Info), + + % Extend the const_struct_map with any newly-added entries. + ml_gen_info_get_const_struct_map(!.Info, ConstStructMap0), + ml_gen_info_get_target(!.Info, Target), + ml_gen_info_get_global_data(!.Info, GlobalData0), + ml_extend_const_struct_map(ModuleInfo, Target, + ConstStructMap0, ConstStructMap, GlobalData0, GlobalData), + ml_gen_info_set_const_struct_map(ConstStructMap, !Info), + ml_gen_info_set_global_data(GlobalData, !Info). %---------------------------------------------------------------------------% diff --git a/compiler/ml_call_gen.m b/compiler/ml_call_gen.m index 38a9234dc1..247500a06e 100644 --- a/compiler/ml_call_gen.m +++ b/compiler/ml_call_gen.m @@ -944,6 +944,35 @@ else unexpected($pred, "malformed ref_assign") ) + ; + SimpleCode = field_assign(CellLval, OffsetLval, ValueLval), + % Lower field_assign(Cell, Offset, Value) as + % *(Cell + Offset words) = Value + % stripping Cell's primary tag at runtime. We pass the + % offset as a runtime rval so that any future LCMC pattern + % that picks the offset dynamically still works; today the + % offset is always a compile-time literal that the C + % compiler folds into a constant displacement. + % The destination slot has mlds_generic_type (MR_Box = void *) + % but the value rval has its own concrete type (e.g. MR_Word + % for boxed cells, MR_Float for unboxed-float fields). Box + % the rval so the back-end emits the type-appropriate + % conversion: a cast for word-sized values, MR_box_float for + % floats, MR_box_int64/uint64 for 64-bit ints. A bare cast + % would mis-handle floats (gcc rejects float-to-pointer). + ( if + CellLval = ml_local_var(_CellVarName, CellType), + ValueLval = ml_local_var(_ValueVarName, ValueType) + then + FieldId = ml_field_offset(ml_lval(OffsetLval)), + FieldLval = ml_field(no, ml_lval(CellLval), CellType, + FieldId, mlds_generic_type), + BoxedValueRval = ml_box(ValueType, ml_lval(ValueLval)), + Stmt = ml_gen_assign(FieldLval, BoxedValueRval, Context), + Stmts = [Stmt] + else + unexpected($pred, "malformed field_assign") + ) ; SimpleCode = test(_), unexpected($pred, "malformed model_det builtin predicate") @@ -961,6 +990,7 @@ Stmts = [Stmt] ; ( SimpleCode = ref_assign(_, _) + ; SimpleCode = field_assign(_, _, _) ; SimpleCode = assign(_, _) ; SimpleCode = noop(_) ), diff --git a/compiler/ml_elim_nested.m b/compiler/ml_elim_nested.m index 2a4703f1d3..cb0a6910dc 100644 --- a/compiler/ml_elim_nested.m +++ b/compiler/ml_elim_nested.m @@ -580,16 +580,26 @@ use_envptr_in_gc_statements(Action, ElimInfo2, ElimInfo), elim_info_finish(ElimInfo, NestedFuncs0, Locals), - ( + ( if NestedFuncs0 = [], % When hoisting nested functions, if there were no nested % functions, we have nothing to do. % Likewise, when doing accurate GC, if there were no local - % variables (or arguments) that contained pointers, then we don't - % need to chain a stack frame for this function. + % variables (or arguments) that contained pointers (i.e. + % nothing was promoted into the per-frame environment by + % flatten_statement), then we don't need to chain a stack + % frame for this function. flatten_statement still rewrites + % accesses to pointer-typed locals into env-field references + % under chain_gc_stack_frames, so when Locals is non-empty + % we MUST fall through to ml_create_env even though there + % are no nested functions, otherwise the rewritten body + % refers to a frame_ptr that was never declared. + ( Action = hoist_nested_funcs + ; Action = chain_gc_stack_frames, Locals = [] + ) + then FuncBodyStmt = FuncBodyStmt1 - ; - NestedFuncs0 = [_ | _], + else % Create a struct to hold the local variables, and initialize % the environment pointers for both the containing function % and the nested functions. Also generate the GC tracing function, @@ -2609,7 +2619,32 @@ elim_info_finish(ElimInfo, NestedFuncs, LocalVars) :- NestedFuncs = cord.to_list(ElimInfo ^ ei_nested_funcs), - LocalVars = cord.to_list(ElimInfo ^ ei_local_vars). + LocalVarsRaw = cord.to_list(ElimInfo ^ ei_local_vars), + % Multiple disjoint MLDS scopes (e.g. arms of an if-then-else, or + % branches of a switch) can declare a local variable with the same + % name; flatten_nested_local_var_defn snocs each occurrence onto + % ei_local_vars without checking for duplicates. When the resulting + % list is converted into the per-procedure environment struct used + % by accurate-GC stack chaining, those duplicate names produce + % `duplicate member' errors from the C compiler. Keep only the + % first occurrence of each name; both occurrences refer to the same + % logical variable, the scopes are disjoint at run time, and the + % env struct is just a per-procedure home for it. + keep_first_local_var_per_name(LocalVarsRaw, set.init, LocalVars). + +:- pred keep_first_local_var_per_name(list(mlds_local_var_defn)::in, + set(mlds_local_var_name)::in, list(mlds_local_var_defn)::out) is det. + +keep_first_local_var_per_name([], _, []). +keep_first_local_var_per_name([Defn | Defns], !.Seen, Uniq) :- + Defn = mlds_local_var_defn(Name, _, _, _, _), + ( if set.contains(!.Seen, Name) then + keep_first_local_var_per_name(Defns, !.Seen, Uniq) + else + set.insert(Name, !Seen), + keep_first_local_var_per_name(Defns, !.Seen, TailUniq), + Uniq = [Defn | TailUniq] + ). %---------------------------------------------------------------------------% :- end_module ml_backend.ml_elim_nested. diff --git a/compiler/ml_gen_info.m b/compiler/ml_gen_info.m index 2d326c8e7a..2a3e321d3d 100644 --- a/compiler/ml_gen_info.m +++ b/compiler/ml_gen_info.m @@ -512,6 +512,8 @@ :- pred ml_gen_info_get_num_ptag_bits(ml_gen_info::in, uint8::out) is det. :- pred ml_gen_info_get_const_struct_map(ml_gen_info::in, map(int, ml_ground_term)::out) is det. +:- pred ml_gen_info_set_const_struct_map(map(int, ml_ground_term)::in, + ml_gen_info::in, ml_gen_info::out) is det. :- pred ml_gen_info_get_var_lvals(ml_gen_info::in, map(prog_var, mlds_lval)::out) is det. :- pred ml_gen_info_get_env_var_names(ml_gen_info::in, set(string)::out) @@ -1122,6 +1124,10 @@ X = Info ^ mgi_rare_info ^ mgri_num_ptag_bits. ml_gen_info_get_const_struct_map(Info, X) :- X = Info ^ mgi_rare_info ^ mgri_const_struct_map. +ml_gen_info_set_const_struct_map(X, !Info) :- + RareInfo0 = !.Info ^ mgi_rare_info, + RareInfo = RareInfo0 ^ mgri_const_struct_map := X, + !Info ^ mgi_rare_info := RareInfo. ml_gen_info_get_var_lvals(Info, X) :- X = Info ^ mgi_rare_info ^ mgri_var_lvals. ml_gen_info_get_env_var_names(Info, X) :- diff --git a/compiler/ml_proc_gen.m b/compiler/ml_proc_gen.m index 68832e4462..62c7155e70 100644 --- a/compiler/ml_proc_gen.m +++ b/compiler/ml_proc_gen.m @@ -572,6 +572,12 @@ % For example, for C it outputs a function declaration with no % corresponding definition, making sure that the function is % declared as `extern' rather than `static'. + % external preds have no body and so will never have + % a GC trace function emitted; the per-arg gc_statement + % updates to ml_gen_info that ml_gen_info_proc_params + % otherwise produces have no consumer here. (Contrast + % with the normal-procedure case below, where we MUST + % thread !Info.) ml_gen_info_proc_params(PredProcId, _Tuples, FuncParams, _ByRefOutputVars, _CopiedOutputVars, !.Info, _Info), FuncBody = body_external, @@ -583,8 +589,16 @@ % (rather than being passed by reference) and remove them from % the byref_output_vars field in the ml_gen_info. CodeModel = proc_info_interface_code_model(ProcInfo), + % Note: under --gc accurate the gc_statement annotation on + % each argument may add new entries to the module's + % const_struct_db (via polymorphism_make_type_info_var_mi) + % and to the ml_gen_info's ConstStructMap and GlobalData + % (via ml_extend_const_struct_map and ml_gen_goal_as_block). + % We must thread !Info here, otherwise the trace function + % emitted later for this procedure references scalar_common + % entries that the file emission never sees. ml_gen_info_proc_params(PredProcId, ArgTuples, FuncParams, - ByRefOutputVars, CopiedOutputVars, !.Info, _Info), + ByRefOutputVars, CopiedOutputVars, !Info), set_of_var.list_to_set(ByRefOutputVars, ByRefOutputVarsSet), ml_gen_info_set_byref_output_vars(ByRefOutputVarsSet, !Info), ( diff --git a/compiler/ml_unify_gen_construct.m b/compiler/ml_unify_gen_construct.m index 1065a445ca..e2284481be 100644 --- a/compiler/ml_unify_gen_construct.m +++ b/compiler/ml_unify_gen_construct.m @@ -77,6 +77,16 @@ :- pred ml_generate_const_structs(module_info::in, mlds_target_lang::in, ml_const_struct_map::out, ml_global_data::in, ml_global_data::out) is det. + % Extend an existing const_struct_map with any entries that are + % present in the module's const_struct_db but missing from the map, + % updating !GlobalData with their MLDS definitions. Used after MLDS-time + % calls (e.g. via ml_accurate_gc.m) that may insert new const_struct + % entries into the module_info after the initial ConstStructMap was built. + % +:- pred ml_extend_const_struct_map(module_info::in, mlds_target_lang::in, + ml_const_struct_map::in, ml_const_struct_map::out, + ml_global_data::in, ml_global_data::out) is det. + %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% @@ -94,6 +104,7 @@ :- import_module hlds.mode_top_functor. :- import_module hlds.type_util. :- import_module libs. +:- import_module libs.globals. :- import_module libs.optimization_options. :- import_module mdbcomp. :- import_module mdbcomp.sym_name. @@ -698,8 +709,17 @@ CellLval, CellType, MaybePtag, Context, Info, [Assign | Assigns]) :- TakeAddrInfo = take_addr_info(AddrVar, Offset, _ConsArgType, FieldType), ml_gen_info_get_high_level_data(Info, HighLevelData), - ( + ml_gen_info_get_gc(Info, GC), + ( if HighLevelData = no, + GC \= gc_accurate + then + AssignKind = lco_interior_pointer + else + AssignKind = lco_cell_value + ), + ( + AssignKind = lco_interior_pointer, % XXX I am not sure that the types specified here are always the right % ones, particularly in cases where the field whose address we are % taking has a non-du type such as int or float. However, I can't think @@ -719,16 +739,27 @@ CastSourceRval = ml_cast(MLDS_AddrVarType, SourceRval), Assign = ml_gen_assign(AddrLval, CastSourceRval, Context) ; - HighLevelData = yes, + AssignKind = lco_cell_value, % For high-level data lco.m uses a different transformation where we % simply pass the base address of the cell. The transformation does not % generate unifications. + % + % Under low-level data with accurate GC, lco.m takes the same shape + % (lci_use_field_path = yes): the AddrVar holds the parent cell + % pointer rather than an interior pointer, so that the collector + % can relocate it through the existing tagged-pointer machinery. + % The actual field write is emitted later, as a + % store_at_field_offset_impure call. ml_gen_var_direct(Info, AddrVar, AddrLval), Assign = ml_gen_assign(AddrLval, ml_lval(CellLval), Context) ), ml_gen_field_take_address_assigns(TakeAddrInfos, CellLval, CellType, MaybePtag, Context, Info, Assigns). +:- type ml_lco_assign_kind + ---> lco_interior_pointer + ; lco_cell_value. + %---------------------------------------------------------------------------% :- pred ml_gen_box_or_unbox_const_rval_list_hld(ml_gen_info::in, @@ -1578,6 +1609,29 @@ list.foldl2(ml_gen_const_struct(Info), ConstStructs, map.init, ConstStructMap, !GlobalData). +ml_extend_const_struct_map(ModuleInfo, Target, !ConstStructMap, !GlobalData) :- + HighLevelData = mlds_target_high_level_data(Target), + Info = ml_const_struct_info(ModuleInfo, Target, HighLevelData), + + module_info_get_const_struct_db(ModuleInfo, ConstStructDb), + const_struct_db_get_structs(ConstStructDb, ConstStructs), + list.foldl2(ml_gen_const_struct_if_new(Info), ConstStructs, + !ConstStructMap, !GlobalData). + +:- pred ml_gen_const_struct_if_new(ml_const_struct_info::in, + pair(int, const_struct)::in, + ml_const_struct_map::in, ml_const_struct_map::out, + ml_global_data::in, ml_global_data::out) is det. + +ml_gen_const_struct_if_new(Info, ConstNum - ConstStruct, + !ConstStructMap, !GlobalData) :- + ( if map.contains(!.ConstStructMap, ConstNum) then + true + else + ml_gen_const_struct(Info, ConstNum - ConstStruct, + !ConstStructMap, !GlobalData) + ). + :- type ml_const_struct_info ---> ml_const_struct_info( mcsi_module_info :: module_info, diff --git a/compiler/mlds.m b/compiler/mlds.m index 6d71ecd7ca..010239db1d 100644 --- a/compiler/mlds.m +++ b/compiler/mlds.m @@ -3303,7 +3303,12 @@ Str = "this_frame" ; CompVar = lvnc_stack_chain, - Str = "stack_chain" + % Match the C name of the runtime global declared in + % runtime/mercury.h. The MLDS-level identifier is kept as + % `stack_chain' (see the design discussion in + % compiler/ml_elim_nested.m), but the C output must refer + % to the actual fully-qualified extern. + Str = "mercury__private_builtin__stack_chain" ; CompVar = lvnc_saved_stack_chain(Id), Str = string.format("saved_stack_chain_%d", [i(Id)]) diff --git a/compiler/term_constr_initial.m b/compiler/term_constr_initial.m index 081df6e06c..5c49e1ec51 100644 --- a/compiler/term_constr_initial.m +++ b/compiler/term_constr_initial.m @@ -585,6 +585,7 @@ ( if ( PredName = "compare_local_uint_words" ; PredName = "semidet_call_3" + ; PredName = "store_at_field_offset_impure" ; PredName = "superclass_from_typeclass_info" ; PredName = "table_lookup_insert_typeclassinfo" ; PredName = "table_lookup_insert_typeinfo" diff --git a/library/private_builtin.m b/library/private_builtin.m index 763c8559ac..a87cdf759d 100644 --- a/library/private_builtin.m +++ b/library/private_builtin.m @@ -1411,6 +1411,22 @@ % :- impure pred store_at_ref_impure(store_at_ref_type(T)::in, T::in) is det. + % store_at_field_offset_impure(Cell, Offset, Value). + % Used internally by the compiler's last-call-modulo-cons (LCMC) + % transformation when accurate GC is in effect. Cell is a tagged + % heap-cell pointer whose field at the given word offset (counted + % from the cell body, after stripping the primary tag) is to be + % updated to Value. Cell's primary tag is recovered at runtime via + % MR_tag(Cell), so the caller does not have to thread it through. + % The cell-and-offset pair takes the place of the interior pointer + % that store_at_ref_impure expects; this lets the accurate-GC + % collector relocate the cell normally (it is just a regular tagged + % pointer) instead of having to follow an interior pointer it has + % no representation for. Bad things will happen if this is used + % outside the LCMC pass. + % +:- impure pred store_at_field_offset_impure(T::in, int::in, U::in) is det. + % This type should be used only by the program transformation that % introduces calls to store_at_ref_impure. Any other use will cause % bad things to happen. diff --git a/mdbcomp/program_representation.m b/mdbcomp/program_representation.m index 4dac36b321..a582ee1d17 100644 --- a/mdbcomp/program_representation.m +++ b/mdbcomp/program_representation.m @@ -2080,6 +2080,7 @@ ; PredName = "instance_constraint_from_typeclass_info", Arity = 3 ; PredName = "partial_inst_copy", Arity = 2 ; PredName = "store_at_ref_impure", Arity = 2 + ; PredName = "store_at_field_offset_impure", Arity = 3 ; PredName = "superclass_from_typeclass_info", Arity = 3 ; PredName = "type_info_from_typeclass_info", Arity = 3 ; PredName = "unconstrained_type_info_from_typeclass_info", Arity = 3 diff --git a/runtime/mercury_accurate_gc.c b/runtime/mercury_accurate_gc.c index b9cc603f3b..7a69dfe254 100644 --- a/runtime/mercury_accurate_gc.c +++ b/runtime/mercury_accurate_gc.c @@ -29,8 +29,7 @@ // - add code to support tracing the stack frames left by builtin__catch; // - fix issue with tight loops via tail calls (see XXX above); // - fix issue with tight loops via retries (see XXX above); -// - handle semidet existentially typed procedures properly (see XXX below); -// - use write() rather than fprintf() in signal handler (see XXX below). +// - handle semidet existentially typed procedures properly (see XXX below). #include "mercury_imp.h" @@ -133,6 +132,42 @@ MR_garbage_collect(void) new_heap = MR_ENGINE(MR_eng_heap_zone2); old_hp = MR_virtual_hp; + // Ensure the to-space is at least as large as the live data we are + // about to copy out of the from-space. Without this, programs whose + // working set grows past the initial --heap-size hit the to-space's + // hardmax mid-copy and abort with "memory zone heap2#... overflowed", + // even though the runtime has the machinery (MR_extend_zone) to grow + // a zone. The Cheney copy is bounded above by from-space usage, so + // sizing to-space to match from-space's used range guarantees the + // copy completes; the post-GC resize_and_reset_gc_threshold step then + // sets a sensible threshold for the next cycle. + { + // Cheney copy can allocate more in to-space than the from-space's + // used size, because deep_copy materialises new type-info cells on + // the fly when a slot's static pseudo type-info has free vars + // (see MR_make_type_info_maybe_existq calls in + // mercury_deep_copy_body.h). Each per-element type-info round-trip + // adds a small overhead. To keep the copy from hitting the + // to-space hardmax mid-pass, ensure to-space capacity is at least + // 2 * old_used. This matches the post-GC resize policy + // (MR_heap_expansion_factor defaults to 2) so steady-state we + // don't bounce extending and shrinking. + size_t old_used = + (char *) old_hp - (char *) old_heap->MR_zone_min; + size_t new_capacity = + (char *) new_heap->MR_zone_hardmax - + (char *) new_heap->MR_zone_min; + size_t needed = old_used * 2; + if (needed < old_used) { + // Overflow guard: cap at SIZE_MAX/2 worth of bytes. + needed = old_used; + } + if (needed > new_capacity) { + size_t target = MR_round_up(needed + MR_unit, MR_unit); + (void) MR_extend_zone(new_heap, target); + } + } + // Print some debugging messages. notify_gc_start(old_heap, new_heap); @@ -219,6 +254,91 @@ resize_and_reset_gc_threshold(MR_MemoryZone *old_heap, MR_MemoryZone *new_heap) #else // !MR_HIGHLEVEL_CODE +// Async-signal-safe stderr helpers. +// +// MR_schedule_agc below is invoked from the SIGSEGV redzone signal handler. +// Per POSIX async-signal-safety rules, stdio functions like fprintf are not +// safe to call in that context, so we use write(2) directly with stack +// buffers and avoid stdio, malloc, locale, and other unsafe primitives. + +#ifdef MR_HAVE_UNISTD_H + #include +#endif + +#ifndef STDERR_FILENO + #define STDERR_FILENO 2 +#endif + +static void +agc_safe_write_str(const char *s) +{ + size_t len = 0; + while (s[len] != '\0') { + len++; + } + if (len > 0) { + // Diagnostic output: best-effort; ignore short writes / EINTR. + // Assigning into a local to silence -Wunused-result on glibc, which + // marks write(2) with warn_unused_result. + ssize_t written = write(STDERR_FILENO, s, len); + (void) written; + } +} + +static void +agc_safe_write_uhex(uintptr_t x) +{ + char buf[sizeof(uintptr_t) * 2 + 1]; + char *p = buf + sizeof(buf); + *--p = '\0'; + if (x == 0) { + *--p = '0'; + } else { + while (x != 0) { + unsigned d = (unsigned) (x & 0xf); + *--p = (d < 10) ? (char) ('0' + d) : (char) ('a' + d - 10); + x >>= 4; + } + } + agc_safe_write_str(p); +} + +static void +agc_safe_write_ptr(const void *p) +{ + agc_safe_write_str("0x"); + agc_safe_write_uhex((uintptr_t) p); +} + +static void +agc_safe_write_udec(uintptr_t x) +{ + char buf[sizeof(uintptr_t) * 3 + 2]; + char *p = buf + sizeof(buf); + *--p = '\0'; + if (x == 0) { + *--p = '0'; + } else { + while (x != 0) { + *--p = (char) ('0' + (unsigned) (x % 10)); + x /= 10; + } + } + agc_safe_write_str(p); +} + +static void +agc_safe_write_sdec(intptr_t x) +{ + if (x < 0) { + // Avoid undefined behavior on INTPTR_MIN negation. + agc_safe_write_str("-"); + agc_safe_write_udec((uintptr_t) (- (x + 1)) + 1); + } else { + agc_safe_write_udec((uintptr_t) x); + } +} + // MR_schedule_agc: // // Schedule garbage collection. @@ -230,10 +350,10 @@ resize_and_reset_gc_threshold(MR_MemoryZone *old_heap, MR_MemoryZone *new_heap) // (We go to this trouble because then the stacks will be in a known state // -- each stack frame is described by information associated with the // continuation label that the code will return to). - -// XXX We should use write() rather than fprintf() here, since this code -// is called from a signal handler, and stdio is not guaranteed -// to be reentrant. +// +// This function is called from a signal handler, so it must restrict itself +// to async-signal-safe primitives -- no stdio, no malloc, no locale. +// Diagnostic output uses the agc_safe_write_* helpers above. void MR_schedule_agc(MR_Code *pc_at_signal, MR_Word *sp_at_signal, @@ -255,19 +375,26 @@ MR_schedule_agc(MR_Code *pc_at_signal, MR_Word *sp_at_signal, // in the destination heap (but only when the large problem of // handling collections with little garbage has been solved). - fprintf(stderr, "Mercury runtime: Garbage collection scheduled" + agc_safe_write_str("Mercury runtime: Garbage collection scheduled" " while collector is already running\n"); - fprintf(stderr, "Mercury_runtime: Trying to continue...\n"); + agc_safe_write_str("Mercury runtime: Trying to continue...\n"); return; } #ifdef MR_DEBUG_AGC_SCHEDULING - fprintf(stderr, "PC at signal: %ld (%lx)\n", - (long) pc_at_signal, (long) pc_at_signal); - fprintf(stderr, "SP at signal: %ld (%lx)\n", - (long) sp_at_signal, (long) sp_at_signal); - fprintf(stderr, "curfr at signal: %ld (%lx)\n", - (long) curfr_at_signal, (long) curfr_at_signal); - fflush(NULL); + agc_safe_write_str("PC at signal: "); + agc_safe_write_sdec((intptr_t) pc_at_signal); + agc_safe_write_str(" ("); + agc_safe_write_uhex((uintptr_t) pc_at_signal); + agc_safe_write_str(")\nSP at signal: "); + agc_safe_write_sdec((intptr_t) sp_at_signal); + agc_safe_write_str(" ("); + agc_safe_write_uhex((uintptr_t) sp_at_signal); + agc_safe_write_str(")\ncurfr at signal: "); + agc_safe_write_sdec((intptr_t) curfr_at_signal); + agc_safe_write_str(" ("); + agc_safe_write_uhex((uintptr_t) curfr_at_signal); + agc_safe_write_str(")\n"); + // No fflush needed: write() is unbuffered. #endif // Search for the entry label. @@ -281,40 +408,51 @@ MR_schedule_agc(MR_Code *pc_at_signal, MR_Word *sp_at_signal, // This means we have reached some handwritten code that has // no further information about the stack frame. - fprintf(stderr, "Mercury runtime: " + agc_safe_write_str("Mercury runtime: " "attempt to schedule garbage collection failed\n"); if (entry_label != NULL) { - fprintf(stderr, "Mercury runtime: the label "); + agc_safe_write_str("Mercury runtime: the label "); if (entry_label->MR_entry_name != NULL) { - fprintf(stderr, "%s has no stack layout info\n", - entry_label->MR_entry_name); + agc_safe_write_str(entry_label->MR_entry_name); + agc_safe_write_str(" has no stack layout info\n"); } else { - fprintf(stderr, "at address %p " - "has no stack layout info\n", entry_label->MR_entry_addr); + agc_safe_write_str("at address "); + agc_safe_write_ptr(entry_label->MR_entry_addr); + agc_safe_write_str(" has no stack layout info\n"); } - fprintf(stderr, "Mercury runtime: PC address = %p\n", pc_at_signal); - fprintf(stderr, "Mercury runtime: PC = label + 0x%zx\n", + agc_safe_write_str("Mercury runtime: PC address = "); + agc_safe_write_ptr(pc_at_signal); + agc_safe_write_str("\nMercury runtime: PC = label + 0x"); + agc_safe_write_uhex((uintptr_t) ((char *) pc_at_signal - (char *) entry_label->MR_entry_addr)); + agc_safe_write_str("\n"); } else { - fprintf(stderr, "Mercury runtime: no entry label "); - fprintf(stderr, "for PC address %p\n", pc_at_signal); + agc_safe_write_str("Mercury runtime: no entry label " + "for PC address "); + agc_safe_write_ptr(pc_at_signal); + agc_safe_write_str("\n"); } - fprintf(stderr, "Mercury runtime: Trying to continue...\n"); + agc_safe_write_str("Mercury runtime: Trying to continue...\n"); return; } #ifdef MR_DEBUG_AGC_SCHEDULING if (entry_label->MR_entry_name != NULL) { - fprintf(stderr, "scheduling called at: %s (%ld %lx)\n", - entry_label->MR_entry_name, - (long) entry_label->MR_entry_addr, - (long) entry_label->MR_entry_addr); + agc_safe_write_str("scheduling called at: "); + agc_safe_write_str(entry_label->MR_entry_name); + agc_safe_write_str(" ("); + agc_safe_write_sdec((intptr_t) entry_label->MR_entry_addr); + agc_safe_write_str(" "); + agc_safe_write_uhex((uintptr_t) entry_label->MR_entry_addr); + agc_safe_write_str(")\n"); } else { - fprintf(stderr, "scheduling called at: (%ld %lx)\n", - (long) entry_label->MR_entry_addr, - (long) entry_label->MR_entry_addr); + agc_safe_write_str("scheduling called at: ("); + agc_safe_write_sdec((intptr_t) entry_label->MR_entry_addr); + agc_safe_write_str(" "); + agc_safe_write_uhex((uintptr_t) entry_label->MR_entry_addr); + agc_safe_write_str(")\n"); } - fflush(NULL); + // No fflush needed: write() is unbuffered. #endif // If we have already scheduled a garbage collection, undo the last change, @@ -322,7 +460,7 @@ MR_schedule_agc(MR_Code *pc_at_signal, MR_Word *sp_at_signal, if (gc_scheduled) { #ifdef MR_DEBUG_AGC_SCHEDULING - fprintf(stderr, "GC scheduled again. Replacing old scheduling," + agc_safe_write_str("GC scheduled again. Replacing old scheduling," " and trying to schedule again.\n"); #endif *saved_success_location = saved_success; @@ -362,10 +500,15 @@ MR_schedule_agc(MR_Code *pc_at_signal, MR_Word *sp_at_signal, } #ifdef MR_DEBUG_AGC_SCHEDULING - fprintf(stderr, "old succip: %ld (%lx) new: %ld (%lx)\n", - (long) saved_success, (long) saved_success, - (long) MR_ENTRY(mercury__garbage_collect_0_0), - (long) MR_ENTRY(mercury__garbage_collect_0_0)); + agc_safe_write_str("old succip: "); + agc_safe_write_sdec((intptr_t) saved_success); + agc_safe_write_str(" ("); + agc_safe_write_uhex((uintptr_t) saved_success); + agc_safe_write_str(") new: "); + agc_safe_write_sdec((intptr_t) MR_ENTRY(mercury__garbage_collect_0_0)); + agc_safe_write_str(" ("); + agc_safe_write_uhex((uintptr_t) MR_ENTRY(mercury__garbage_collect_0_0)); + agc_safe_write_str(")\n"); #endif // Replace the old succip with the address of the garbage collector. @@ -373,7 +516,7 @@ MR_schedule_agc(MR_Code *pc_at_signal, MR_Word *sp_at_signal, *saved_success_location = MR_ENTRY(mercury__garbage_collect_0_0); #ifdef MR_DEBUG_AGC_SCHEDULING - fprintf(stderr, "Accurate GC scheduled.\n"); + agc_safe_write_str("Accurate GC scheduled.\n"); #endif } diff --git a/runtime/mercury_deep_copy.c b/runtime/mercury_deep_copy.c index c86d58f4a3..7360f30667 100644 --- a/runtime/mercury_deep_copy.c +++ b/runtime/mercury_deep_copy.c @@ -87,12 +87,23 @@ MR_Word *MR_has_forwarding_pointer; +// The bitmap shift uses ((MR_Word) 1) (not the literal 1, which is `int`) +// because fwdptr_bit can be up to MR_WORDBITS-1 = 63 on 64-bit platforms, +// and shifting an `int` by >= 32 is undefined behaviour in C. The aarch64 +// gcc lowering wraps the shift count modulo 32 for 32-bit operands, which +// causes bit 32 to alias bit 0, bit 33 to alias bit 1, etc. The result is +// false positives in if_forwarding_pointer: half of the cells in any +// 64-word region see another cell's forwarding mark and mistakenly treat +// the cell's first word as a forwarding pointer. For DU cells whose first +// word is the head value (e.g. an int), this returns the int as if it +// were a tagged pointer, which then gets dereferenced and segfaults. #define mark_as_forwarding_pointer(Data) \ do { \ size_t fwdptr_offset = (MR_Word *)(Data) - (MR_Word *) lower_limit; \ size_t fwdptr_word = fwdptr_offset / MR_WORDBITS; \ size_t fwdptr_bit = fwdptr_offset % MR_WORDBITS; \ - MR_has_forwarding_pointer[fwdptr_word] |= (1 << fwdptr_bit); \ + MR_has_forwarding_pointer[fwdptr_word] |= \ + (((MR_Word) 1) << fwdptr_bit); \ } while (0) #undef if_forwarding_pointer @@ -101,7 +112,9 @@ MR_Word *MR_has_forwarding_pointer; size_t fwdptr_offset = (MR_Word *)(Data) - (MR_Word *) lower_limit; \ size_t fwdptr_word = fwdptr_offset / MR_WORDBITS; \ size_t fwdptr_bit = fwdptr_offset % MR_WORDBITS; \ - if (MR_has_forwarding_pointer[fwdptr_word] & (1 << fwdptr_bit)) { \ + if (MR_has_forwarding_pointer[fwdptr_word] & \ + (((MR_Word) 1) << fwdptr_bit)) \ + { \ ACTION; \ } \ } while (0) diff --git a/runtime/mercury_deep_copy_body.h b/runtime/mercury_deep_copy_body.h index debc91c0f0..25e5d52e23 100644 --- a/runtime/mercury_deep_copy_body.h +++ b/runtime/mercury_deep_copy_body.h @@ -117,6 +117,125 @@ copy(MR_Word data, MR_TypeInfo type_info, ptag = MR_tag(data); MR_index_or_search_ptag_layout(ptag, ptag_layout); + // Right-spine tail-call elimination fast path. + // + // For DU values whose layout is MR_SECTAG_NONE with arity 2, no + // packed argument locations, and no existential info, and whose + // second argument's resolved type matches the parent's type ctor, + // iterate the spine instead of recursing through copy(). Without + // this path the right-leaning recursion `copy([X|Xs])` would use + // one C stack frame per cons cell, which overflows the default + // 8 MB stack for lists past ~80k elements. Under accurate GC, + // copy() runs from inside the collector itself, and a stack + // overflow there is unrecoverable. The TCO drops spine depth to + // O(1) frames; off-spine recursion (the head argument) still + // recurses normally, but is bounded by element type complexity. + if (ptag_layout->MR_sectag_locn == MR_SECTAG_NONE) { + const MR_DuFunctorDesc *fdesc; + + fdesc = ptag_layout->MR_sectag_alternatives[0]; + if (fdesc->MR_du_functor_orig_arity == 2 && + fdesc->MR_du_functor_arg_locns == NULL && + fdesc->MR_du_functor_exist_info == NULL) + { + MR_PseudoTypeInfo last_pseudo; + MR_TypeInfo last_ti; + MR_MemoryList allocated_for_ti = NULL; + + last_pseudo = fdesc->MR_du_functor_arg_types[1]; + if (MR_arg_type_may_contain_var(fdesc, 1)) { + last_ti = MR_make_type_info_maybe_existq( + MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info), + last_pseudo, NULL, fdesc, &allocated_for_ti); + } else { + last_ti = (MR_TypeInfo) + MR_pseudo_type_info_is_ground(last_pseudo); + } + + if (MR_TYPEINFO_GET_TYPE_CTOR_INFO(last_ti) == type_ctor_info) + { + MR_Word root_result = 0; + MR_Word *spine_dest = &root_result; + MR_Word cur_data = data; + int cur_ptag = ptag; + const MR_DuPtagLayout *cur_ptag_layout = ptag_layout; + const MR_DuFunctorDesc *cur_fdesc = fdesc; + + while (1) { + MR_Word *cur_data_value; + MR_AllocSiteInfoPtr attrib; + int cell_size; + MR_PseudoTypeInfo head_pseudo; + MR_Word tagged_new; + + cur_data_value = + (MR_Word *) MR_body(cur_data, cur_ptag); + if (!in_range(cur_data_value)) { + found_out_of_range_pointer(cur_data_value); + *spine_dest = cur_data; + MR_deallocate(allocated_for_ti); + return root_result; + } + if_forwarding_pointer(cur_data_value, { + *spine_dest = cur_data_value[0]; + MR_deallocate(allocated_for_ti); + return root_result; + }); + + attrib = maybe_attrib(cur_data_value); + cell_size = MR_SIZE_SLOT_SIZE + 2; + MR_offset_incr_saved_hp(new_data, MR_SIZE_SLOT_SIZE, + cell_size, attrib, NULL); + MR_copy_size_slot(0, new_data, cur_ptag, cur_data); + + head_pseudo = cur_fdesc->MR_du_functor_arg_types[0]; + if (MR_arg_type_may_contain_var(cur_fdesc, 0)) { + MR_field(0, new_data, 0) = copy_arg( + cur_data_value, cur_data_value[0], cur_fdesc, + MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR( + type_info), + head_pseudo, lower_limit, upper_limit); + } else { + MR_field(0, new_data, 0) = copy(cur_data_value[0], + (MR_TypeInfo) MR_pseudo_type_info_is_ground( + head_pseudo), + lower_limit, upper_limit); + } + + tagged_new = (MR_Word) MR_mkword(cur_ptag, new_data); + *spine_dest = tagged_new; + spine_dest = &MR_field(0, new_data, 1); + leave_forwarding_pointer(cur_data_value, 0, + tagged_new); + + cur_data = cur_data_value[1]; + cur_ptag = MR_tag(cur_data); + MR_index_or_search_ptag_layout(cur_ptag, + cur_ptag_layout); + if (cur_ptag_layout->MR_sectag_locn != + MR_SECTAG_NONE) { + break; + } + cur_fdesc = cur_ptag_layout->MR_sectag_alternatives[0]; + if (cur_fdesc != fdesc) { + // Different functor (different cell shape); + // fall back to a full copy() for this tail. + break; + } + } + + // Spine ended at a cell with a different shape (e.g. + // list nil with sectag_local). Recurse on the + // remaining tail using the resolved tail type info. + *spine_dest = copy(cur_data, last_ti, + lower_limit, upper_limit); + MR_deallocate(allocated_for_ti); + return root_result; + } + MR_deallocate(allocated_for_ti); + } + } + switch (ptag_layout->MR_sectag_locn) { case MR_SECTAG_LOCAL_REST_OF_WORD: // fall-through diff --git a/runtime/mercury_memory_zones.c b/runtime/mercury_memory_zones.c index b31c09e332..0a1ee5f46b 100644 --- a/runtime/mercury_memory_zones.c +++ b/runtime/mercury_memory_zones.c @@ -371,9 +371,17 @@ MR_init_offsets(void) fake_reg_offset = (MR_Unsigned) MR_fake_reg % MR_pcache_size; for (int i = 0; i < CACHE_SLICES - 1; i++) { - offset_vector[i] = - (fake_reg_offset + MR_pcache_size * i / CACHE_SLICES) + size_t off = (fake_reg_offset + MR_pcache_size * i / CACHE_SLICES) % MR_pcache_size; + // The heap zone's MR_zone_min is base + offset. Heap allocations + // expect MR_zone_min to be MR_Word-aligned (ptag bits in pointer + // values must come from MR_mkword(t, addr) = addr + t, which only + // works when addr is word-aligned). MR_fake_reg's link-time address + // can land at any byte alignment, so round the offset up to the + // next MR_Word boundary. Cache colouring is unaffected: we shift + // by at most sizeof(MR_Word) - 1 bytes per slice. + off = (off + sizeof(MR_Word) - 1) & ~(sizeof(MR_Word) - 1); + offset_vector[i] = off; } } @@ -654,8 +662,14 @@ MR_extend_zone(MR_MemoryZone *zone, size_t new_size) #endif old_base = zone->MR_zone_bottom; - copy_size = zone->MR_zone_end - zone->MR_zone_bottom; - offset = zone->MR_zone_min - zone->MR_zone_bottom; + // Pointer subtraction returns the difference in MR_Word-sized units, + // but copy_size and offset are byte counts. Cast to (char *) so the + // arithmetic is in bytes; otherwise extending a zone shifts MR_zone_min + // forward by a factor of 1/sizeof(MR_Word) on each call, eventually + // misaligning it. This matters because MR_zone_min must be word-aligned + // for MR_mkword(t, addr) to encode the correct ptag in heap allocations. + copy_size = (char *) zone->MR_zone_end - (char *) zone->MR_zone_bottom; + offset = (char *) zone->MR_zone_min - (char *) zone->MR_zone_bottom; #ifdef MR_PROFILE_ZONES MR_LOCK(&memory_zones_stats_lock, "MR_extend_zone"); @@ -680,7 +694,19 @@ MR_extend_zone(MR_MemoryZone *zone, size_t new_size) } #endif // MR_CHECK_OVERFLOW_VIA_MPROTECT - new_base = MR_realloc_zone_memory(old_base, copy_size, new_size); + // Reallocate the entire zone footprint, including the trailing + // page reserved for the hardzone (and an extra page on systems with + // MR_PROTECTPAGE). The zone struct claims [bottom, top) where top = + // bottom + new_total_size; passing only new_size used to leave the + // last page or two of that claimed range outside the actual + // allocation. MR_setup_redzones then mprotect()s a hardmax page + // that, by sheer virtual-memory layout, may overlap a neighbouring + // live allocation (e.g. the partner heap zone). Writes from the + // collector to those addresses then SIGSEGV with a fault address + // equal to our hardmax even though MR_virtual_hp is nowhere near + // it. Allocate new_total_size so every byte of [bottom, top) is + // actually ours. + new_base = MR_realloc_zone_memory(old_base, copy_size, new_total_size); if (new_base == NULL) { MR_fatal_error("unable reallocate memory zone: %s#%" MR_INTEGER_LENGTH_MODIFIER "d", diff --git a/runtime/mercury_wrapper.c b/runtime/mercury_wrapper.c index 6286982766..52baba8e23 100644 --- a/runtime/mercury_wrapper.c +++ b/runtime/mercury_wrapper.c @@ -90,7 +90,17 @@ ENDINIT #ifdef MR_DEBUG_AGC_SMALL_HEAP size_t MR_heap_size = 13 * sizeof(MR_Word); #else - size_t MR_heap_size = 8192 * sizeof(MR_Word); + // The default initial heap size. Under accurate GC the heap is split + // into two semispaces of this size each. The redzone+mprotect machinery + // and the pre-GC MR_extend_zone path in mercury_accurate_gc.c will grow + // the zones from here when programs need more, so this is just a + // starting point that avoids paying GC overhead for tiny programs. + // The previous default (8192 words = 64 KB) was small enough that any + // non-toy program triggered constant GCs and hit zone-extension paths + // immediately; bump to 1024 * 1024 words = 8 MB on 64-bit, which keeps + // hello-world cheap but lets `tests/hard_coded` programs run without + // requiring `--heap-size` to be set on the command line. + size_t MR_heap_size = 1024 * 1024 * sizeof(MR_Word); #endif #ifdef MR_STACK_SEGMENTS size_t MR_detstack_size = 64 * sizeof(MR_Word);