diff --git a/compiler/call_gen.m b/compiler/call_gen.m index 7742791cb..69094d4b4 100644 --- a/compiler/call_gen.m +++ b/compiler/call_gen.m @@ -632,38 +632,38 @@ call_gen__generate_return_livevals(OutArgs, OutputArgs, AfterCallInstMap, code_info__generate_stack_livelvals(OutArgs, AfterCallInstMap, LiveVals0), code_info__get_globals(Globals), - { globals__get_gc_method(Globals, GC_Method) }, - call_gen__insert_arg_livelvals(OutputArgs, GC_Method, AfterCallInstMap, - LiveVals0, LiveVals). - + { globals__want_return_layouts(Globals, WantReturnLayout) }, + call_gen__insert_arg_livelvals(OutputArgs, WantReturnLayout, + AfterCallInstMap, LiveVals0, LiveVals). % Maybe a varlist to type_id list would be a better way to do this... %---------------------------------------------------------------------------% -:- pred call_gen__insert_arg_livelvals(list(pair(var, arg_loc)), gc_method, +:- pred call_gen__insert_arg_livelvals(list(pair(var, arg_loc)), bool, instmap, list(liveinfo), list(liveinfo), code_info, code_info). :- mode call_gen__insert_arg_livelvals(in, in, in, in, out, in, out) is det. call_gen__insert_arg_livelvals([], _, _, LiveVals, LiveVals) --> []. -call_gen__insert_arg_livelvals([Var - L | As], GC_Method, AfterCallInstMap, - LiveVals0, LiveVals) --> +call_gen__insert_arg_livelvals([Var - L | As], WantReturnLayout, + AfterCallInstMap, LiveVals0, LiveVals) --> code_info__get_varset(VarSet), { varset__lookup_name(VarSet, Var, Name) }, ( - { GC_Method = accurate } + { WantReturnLayout = yes } -> { instmap__lookup_var(AfterCallInstMap, Var, Inst) }, code_info__variable_type(Var, Type), { type_util__vars(Type, TypeVars) }, code_info__find_type_infos(TypeVars, TypeParams), - { LiveVal = live_lvalue(R, var(Type, Inst), Name, TypeParams) } + { VarInfo = var(Var, Name, Type, Inst) }, + { LiveVal = live_lvalue(R, VarInfo, TypeParams) } ; - { LiveVal = live_lvalue(R, unwanted, Name, []) } + { LiveVal = live_lvalue(R, unwanted, []) } ), { code_util__arg_loc_to_register(L, R) }, - call_gen__insert_arg_livelvals(As, GC_Method, AfterCallInstMap, + call_gen__insert_arg_livelvals(As, WantReturnLayout, AfterCallInstMap, [LiveVal | LiveVals0], LiveVals). %---------------------------------------------------------------------------% diff --git a/compiler/code_gen.m b/compiler/code_gen.m index 85640e9f9..c57df275c 100644 --- a/compiler/code_gen.m +++ b/compiler/code_gen.m @@ -202,7 +202,8 @@ generate_proc_code(ProcInfo, ProcId, PredId, ModuleInfo, Globals, % execution tracing. code_info__init(VarSet, Liveness, StackSlots, SaveSuccip, Globals, PredId, ProcId, ProcInfo, InitialInst, FollowVars, - ModuleInfo, CellCount0, OutsideResumePoint, CodeInfo0), + ModuleInfo, CellCount0, OutsideResumePoint, MaybeFromFullSlot, + CodeInfo0), % Generate code for the procedure. generate_category_code(CodeModel, Goal, OutsideResumePoint, @@ -234,7 +235,8 @@ generate_proc_code(ProcInfo, ProcId, PredId, ModuleInfo, Globals, no, EntryLabel), continuation_info__add_proc_info(proc(PredId, ProcId), EntryLabel, TotalSlots, Detism, MaybeSuccipSlot, - MaybeTraceCallLabel, LayoutInfo, ContInfo0, ContInfo) + MaybeTraceCallLabel, MaybeFromFullSlot, + LayoutInfo, ContInfo0, ContInfo) ; ContInfo = ContInfo0 ), @@ -487,7 +489,7 @@ code_gen__generate_entry(CodeModel, Goal, OutsideResumePoint, ), code_info__get_maybe_trace_info(MaybeTraceInfo), ( { MaybeTraceInfo = yes(TraceInfo) } -> - { trace__generate_slot_fill_code(TraceInfo, TraceFillCode) } + trace__generate_slot_fill_code(TraceInfo, TraceFillCode) ; { TraceFillCode = empty } ), @@ -693,14 +695,21 @@ code_gen__generate_exit(CodeModel, FrameInfo, RestoreDeallocCode, ExitCode) --> } ; { CodeModel = model_non }, + { MaybeTraceInfo = yes(TraceInfo2) -> + trace__maybe_setup_redo_event(TraceInfo2, + SetupRedoCode) + ; + SetupRedoCode = empty + }, { SuccessCode = node([ livevals(LiveArgs) - "", goto(do_succeed(no)) - "Return from procedure call" ]) }, { AllSuccessCode = + tree(SetupRedoCode, tree(TraceExitCode, - SuccessCode) + SuccessCode)) } ), { ExitCode = @@ -878,7 +887,7 @@ code_gen__add_saved_succip([Instrn0 - Comment | Instrns0 ], StackLoc, Instrn0 = call(Target, ReturnLabel, LiveVals0, CM) -> Instrn = call(Target, ReturnLabel, - [live_lvalue(stackvar(StackLoc), succip, "", []) | + [live_lvalue(stackvar(StackLoc), succip, []) | LiveVals0], CM) ; Instrn = Instrn0 diff --git a/compiler/code_info.m b/compiler/code_info.m index b61a08fe0..70b6d8993 100644 --- a/compiler/code_info.m +++ b/compiler/code_info.m @@ -61,12 +61,14 @@ :- type code_info. - % Create a new code_info structure. + % Create a new code_info structure. Also return the + % outermost resumption point, and the number of stack slot + % (if any) that contains the from_full tracing flag. :- pred code_info__init(varset, set(var), stack_slots, bool, globals, pred_id, proc_id, proc_info, instmap, follow_vars, module_info, - int, resume_point_info, code_info). + int, resume_point_info, maybe(int), code_info). :- mode code_info__init(in, in, in, in, in, in, in, in, in, in, in, in, - out, out) is det. + out, out, out) is det. % Get the globals table. :- pred code_info__get_globals(globals, code_info, code_info). @@ -265,10 +267,11 @@ %---------------------------------------------------------------------------% code_info__init(Varset, Liveness, StackSlots, SaveSuccip, Globals, - PredId, ProcId, ProcInfo, Instmap, FollowVars, - ModuleInfo, CellCount, ResumePoint, CodeInfo) :- + PredId, ProcId, ProcInfo, Instmap, FollowVars, ModuleInfo, + CellCount, ResumePoint, MaybeFromFullSlot, CodeInfo) :- proc_info_headvars(ProcInfo, HeadVars), proc_info_arg_info(ProcInfo, ArgInfos), + proc_info_interface_code_model(ProcInfo, CodeModel), assoc_list__from_corresponding_lists(HeadVars, ArgInfos, Args), arg_info__build_input_arg_list(Args, ArgList), globals__get_options(Globals, Options), @@ -289,15 +292,9 @@ code_info__init(Varset, Liveness, StackSlots, SaveSuccip, Globals, map__init(TempsInUse), set__init(Zombies), map__init(LayoutMap), - code_info__max_var_slot(StackSlots, VarSlotCount0), - proc_info_interface_code_model(ProcInfo, CodeModel), - ( - CodeModel = model_non - -> - VarSlotCount is VarSlotCount0 + 1 - ; - VarSlotCount = VarSlotCount0 - ), + code_info__max_var_slot(StackSlots, VarSlotMax), + trace__reserved_slots(ProcInfo, Globals, FixedSlots), + int__max(VarSlotMax, FixedSlots, SlotMax), CodeInfo0 = code_info( Globals, ModuleInfo, @@ -305,7 +302,7 @@ code_info__init(Varset, Liveness, StackSlots, SaveSuccip, Globals, ProcId, ProcInfo, Varset, - VarSlotCount, + SlotMax, no, Liveness, @@ -322,25 +319,26 @@ code_info__init(Varset, Liveness, StackSlots, SaveSuccip, Globals, 0, AvailSlots ), - globals__get_trace_level(Globals, TraceLevel), - code_info__init_maybe_trace_info(TraceLevel, ModuleInfo, ProcInfo, - MaybeFailVars, CodeInfo0, CodeInfo1), + code_info__init_maybe_trace_info(Globals, ModuleInfo, ProcInfo, + MaybeFailVars, MaybeFromFullSlot, CodeInfo0, CodeInfo1), code_info__init_fail_info(CodeModel, MaybeFailVars, ResumePoint, CodeInfo1, CodeInfo). -:- pred code_info__init_maybe_trace_info(trace_level, module_info, proc_info, - maybe(set(var)), code_info, code_info). -:- mode code_info__init_maybe_trace_info(in, in, in, out, in, out) is det. +:- pred code_info__init_maybe_trace_info(globals, module_info, proc_info, + maybe(set(var)), maybe(int), code_info, code_info). +:- mode code_info__init_maybe_trace_info(in, in, in, out, out, in, out) is det. -code_info__init_maybe_trace_info(TraceLevel, ModuleInfo, ProcInfo, - MaybeFailVars) --> - ( { trace_level_trace_interface(TraceLevel, yes) } -> - trace__setup(TraceLevel, TraceInfo), +code_info__init_maybe_trace_info(Globals, ModuleInfo, ProcInfo, + MaybeFailVars, MaybeFromFullSlot) --> + { globals__get_trace_level(Globals, TraceLevel) }, + ( { TraceLevel \= none } -> + trace__setup(Globals, MaybeFromFullSlot, TraceInfo), code_info__set_maybe_trace_info(yes(TraceInfo)), { trace__fail_vars(ModuleInfo, ProcInfo, FailVars) }, { MaybeFailVars = yes(FailVars) } ; - { MaybeFailVars = no } + { MaybeFailVars = no }, + { MaybeFromFullSlot = no } ). %---------------------------------------------------------------------------% @@ -575,6 +573,11 @@ code_info__set_avail_temp_slots(PF, CI0, CI) :- code_info, code_info). :- mode code_info__get_pred_proc_arginfo(in, in, out, in, out) is det. + % Get the set of variables currently needed by the resume + % points of enclosing goals. +:- pred code_info__current_resume_point_vars(set(var), code_info, code_info). +:- mode code_info__current_resume_point_vars(out, in, out) is det. + :- pred code_info__variable_to_string(var, string, code_info, code_info). :- mode code_info__variable_to_string(in, out, in, out) is det. @@ -755,11 +758,6 @@ code_info__get_pred_proc_arginfo(PredId, ProcId, ArgInfo) --> { module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo) }, { proc_info_arg_info(ProcInfo, ArgInfo) }. -%---------------------------------------------------------------------------% - -:- pred code_info__current_resume_point_vars(set(var), code_info, code_info). -:- mode code_info__current_resume_point_vars(out, in, out) is det. - code_info__current_resume_point_vars(ResumeVars) --> code_info__get_fail_info(FailInfo), { FailInfo = fail_info(ResumePointStack, _, _, _, _) }, @@ -768,8 +766,6 @@ code_info__current_resume_point_vars(ResumeVars) --> { map__keys(ResumeMap, ResumeMapVarList) }, { set__list_to_set(ResumeMapVarList, ResumeVars) }. -%---------------------------------------------------------------------------% - code_info__variable_to_string(Var, Name) --> code_info__get_varset(Varset), { varset__lookup_name(Varset, Var, Name) }. @@ -3088,18 +3084,8 @@ code_info__generate_stack_livelvals(Args, AfterCallInstMap, LiveVals) --> code_info__generate_var_livelvals(VarList, LiveVals0, LiveVals1), { set__to_sorted_list(LiveVals1, LiveVals2) }, code_info__get_globals(Globals), - { globals__get_gc_method(Globals, GC_Method) }, - { globals__get_trace_level(Globals, TraceLevel) }, - { - ( GC_Method = accurate - ; trace_level_trace_returns(TraceLevel, yes) - ) - -> - NeedVarInfo = yes - ; - NeedVarInfo = no - }, - code_info__livevals_to_livelvals(LiveVals2, NeedVarInfo, + { globals__want_return_layouts(Globals, WantReturnLayout) }, + code_info__livevals_to_livelvals(LiveVals2, WantReturnLayout, AfterCallInstMap, LiveVals3), code_info__get_temps_in_use(TempsSet), { map__to_assoc_list(TempsSet, Temps) }, @@ -3121,7 +3107,7 @@ code_info__generate_var_livelvals([V | Vs], Vals0, Vals) --> code_info__generate_temp_livelvals([], LiveInfo, LiveInfo). code_info__generate_temp_livelvals([Slot - StoredLval | Slots], LiveInfo0, - [live_lvalue(Slot, LiveValueType, "", []) | LiveInfo1]) :- + [live_lvalue(Slot, LiveValueType, []) | LiveInfo1]) :- code_info__get_live_value_type(StoredLval, LiveValueType), code_info__generate_temp_livelvals(Slots, LiveInfo0, LiveInfo1). @@ -3130,25 +3116,25 @@ code_info__generate_temp_livelvals([Slot - StoredLval | Slots], LiveInfo0, :- mode code_info__livevals_to_livelvals(in, in, in, out, in, out) is det. code_info__livevals_to_livelvals([], _, _, []) --> []. -code_info__livevals_to_livelvals([Lval - Var | Ls], NeedVarInfo, +code_info__livevals_to_livelvals([Lval - Var | Ls], WantReturnLayout, AfterCallInstMap, [LiveLval | Lives]) --> code_info__get_varset(VarSet), { varset__lookup_name(VarSet, Var, Name) }, ( - { NeedVarInfo = yes } + { WantReturnLayout = yes } -> { instmap__lookup_var(AfterCallInstMap, Var, Inst) }, code_info__variable_type(Var, Type), { type_util__vars(Type, TypeVars) }, code_info__find_type_infos(TypeVars, TypeParams), - { LiveLval = live_lvalue(Lval, var(Type, Inst), Name, + { LiveLval = live_lvalue(Lval, var(Var, Name, Type, Inst), TypeParams) } ; - { LiveLval = live_lvalue(Lval, unwanted, Name, []) } + { LiveLval = live_lvalue(Lval, unwanted, []) } ), - code_info__livevals_to_livelvals(Ls, NeedVarInfo, AfterCallInstMap, - Lives). + code_info__livevals_to_livelvals(Ls, WantReturnLayout, + AfterCallInstMap, Lives). :- pred code_info__get_live_value_type(slot_contents, live_value_type). :- mode code_info__get_live_value_type(in, out) is det. @@ -3320,10 +3306,9 @@ code_info__max_var_slot_2([L | Ls], Max0, Max) :- code_info__stack_variable(Num, Lval) --> code_info__get_proc_model(CodeModel), ( { CodeModel = model_non } -> - { Num1 is Num - 1 }, % framevars start at zero - { Lval = framevar(Num1) } + { Lval = framevar(Num) } ; - { Lval = stackvar(Num) } % stackvars start at one + { Lval = stackvar(Num) } ). :- pred code_info__stack_variable_reference(int, rval, code_info, code_info). @@ -3332,10 +3317,9 @@ code_info__stack_variable(Num, Lval) --> code_info__stack_variable_reference(Num, mem_addr(Ref)) --> code_info__get_proc_model(CodeModel), ( { CodeModel = model_non } -> - { Num1 is Num - 1 }, % framevars start at zero - { Ref = framevar_ref(Num1) } + { Ref = framevar_ref(Num) } ; - { Ref = stackvar_ref(Num) } % stackvars start at one + { Ref = stackvar_ref(Num) } ). %---------------------------------------------------------------------------% diff --git a/compiler/continuation_info.m b/compiler/continuation_info.m index 3107f17f9..ee7395cff 100644 --- a/compiler/continuation_info.m +++ b/compiler/continuation_info.m @@ -63,18 +63,23 @@ % :- type proc_layout_info ---> proc_layout_info( - label, % the entry label - determinism, % determines which stack is used - int, % number of stack slots - maybe(int), % location of succip on stack - maybe(label), % if generate_trace is set, + label, % The entry label. + determinism, % Determines which stack is used. + int, % Number of stack slots. + maybe(int), % Location of succip on stack. + maybe(label), % If the trace level is not none, % this contains the label associated % with the call event, whose stack % layout says which variables were - % live and where on entry + % live and where on entry. + maybe(int), % If the trace level is shallow, + % this contains the number of the + % stack slot containing the + % value of MR_trace_from_full + % at the time of the call. proc_label_layout_info - % info for each internal label, - % needed for basic_stack_layouts + % Info for each internal label, + % needed for basic_stack_layouts. ). % @@ -159,8 +164,7 @@ :- type var_info ---> var_info( lval, % the location of the variable - live_value_type,% pseudo-typeinfo giving the var's type - string % the var's name + live_value_type % info about the variable ). % Return an initialized continuation info structure. @@ -176,7 +180,7 @@ % :- pred continuation_info__add_proc_info(pred_proc_id::in, label::in, int::in, determinism::in, maybe(int)::in, maybe(label)::in, - proc_label_layout_info::in, continuation_info::in, + maybe(int)::in, proc_label_layout_info::in, continuation_info::in, continuation_info::out) is det. % @@ -227,13 +231,14 @@ continuation_info__init(ContInfo) :- % continuation_info. % continuation_info__add_proc_info(PredProcId, EntryLabel, StackSize, - Detism, SuccipLocation, MaybeTraceCallLabel, InternalMap, - ContInfo0, ContInfo) :- + Detism, SuccipLocation, MaybeTraceCallLabel, + MaybeFromFullSlot, InternalMap, ContInfo0, ContInfo) :- ( map__contains(ContInfo0, PredProcId) -> error("duplicate continuation_info for proc.") ; LayoutInfo = proc_layout_info(EntryLabel, Detism, StackSize, - SuccipLocation, MaybeTraceCallLabel, InternalMap), + SuccipLocation, MaybeTraceCallLabel, + MaybeFromFullSlot, InternalMap), map__det_insert(ContInfo0, PredProcId, LayoutInfo, ContInfo) ). @@ -259,7 +264,7 @@ continuation_info__process_instructions(PredProcId, Instructions, % Get all the continuation info from the call instructions. map__lookup(ContInfo0, PredProcId, ProcLayoutInfo0), - ProcLayoutInfo0 = proc_layout_info(A, B, C, D, E, Internals0), + ProcLayoutInfo0 = proc_layout_info(A, B, C, D, E, F, Internals0), GetCallLivevals = lambda([Instr::in, Pair::out] is semidet, ( Instr = call(_, label(Label), LiveInfo, _) - _Comment, Pair = Label - LiveInfo @@ -270,7 +275,7 @@ continuation_info__process_instructions(PredProcId, Instructions, list__foldl(continuation_info__process_continuation(WantReturnInfo), Calls, Internals0, Internals), - ProcLayoutInfo = proc_layout_info(A, B, C, D, E, Internals), + ProcLayoutInfo = proc_layout_info(A, B, C, D, E, F, Internals), map__det_update(ContInfo0, PredProcId, ProcLayoutInfo, ContInfo). %-----------------------------------------------------------------------------% @@ -320,12 +325,12 @@ continuation_info__process_continuation(WantReturnInfo, Label - LiveInfoList, continuation_info__convert_return_data(LiveInfos, VarInfoSet, TypeInfoSet) :- GetVarInfo = lambda([LiveLval::in, VarInfo::out] is det, ( - LiveLval = live_lvalue(Lval, LiveValueType, Name, _), - VarInfo = var_info(Lval, LiveValueType, Name) + LiveLval = live_lvalue(Lval, LiveValueType, _), + VarInfo = var_info(Lval, LiveValueType) )), list__map(GetVarInfo, LiveInfos, VarInfoList), GetTypeInfo = lambda([LiveLval::in, TypeInfos::out] is det, ( - LiveLval = live_lvalue(_, _, _, TypeInfos) + LiveLval = live_lvalue(_, _, TypeInfos) )), list__map(GetTypeInfo, LiveInfos, TypeInfoListList), list__condense(TypeInfoListList, TypeInfoList), @@ -340,7 +345,8 @@ continuation_info__filter_named_vars([], []). continuation_info__filter_named_vars([LiveInfo | LiveInfos], Filtered) :- continuation_info__filter_named_vars(LiveInfos, Filtered1), ( - LiveInfo = live_lvalue(_, _, Name, _), + LiveInfo = live_lvalue(_, LiveType, _), + LiveType = var(_, Name, _, _), Name \= "" -> Filtered = [LiveInfo | Filtered1] diff --git a/compiler/globals.m b/compiler/globals.m index 6d47b9d24..3c0d374b5 100644 --- a/compiler/globals.m +++ b/compiler/globals.m @@ -46,11 +46,10 @@ ; num_data_elems ; size_data_elems. -:- type trace_level. - -:- pred trace_level_trace_interface(trace_level::in, bool::out) is det. -:- pred trace_level_trace_ports(trace_level::in, bool::out) is det. -:- pred trace_level_trace_returns(trace_level::in, bool::out) is det. +:- type trace_level + ---> none + ; shallow + ; deep. :- pred convert_gc_method(string::in, gc_method::out) is semidet. :- pred convert_tags_method(string::in, tags_method::out) is semidet. @@ -100,10 +99,14 @@ % More complex options % Check if static code addresses are available in the - % current grade of compilation + % current grade of compilation. :- pred globals__have_static_code_addresses(globals::in, bool::out) is det. + % Check if we should generate stack layouts at call return sites. + +:- pred globals__want_return_layouts(globals::in, bool::out) is det. + %-----------------------------------------------------------------------------% % Access predicates for storing a `globals' structure in the @@ -169,29 +172,6 @@ :- import_module exprn_aux. :- import_module map, std_util, io, require. -:- type trace_level - ---> none - ; interface - ; interface_ports - ; interface_ports_returns. - -trace_level_trace_interface(none, no). -trace_level_trace_interface(interface, yes). -trace_level_trace_interface(interface_ports, yes). -trace_level_trace_interface(interface_ports_returns, yes). - -trace_level_trace_ports(none, no). -trace_level_trace_ports(interface, no). -trace_level_trace_ports(interface_ports, yes). -trace_level_trace_ports(interface_ports_returns, yes). - -trace_level_trace_returns(none, no). -trace_level_trace_returns(interface, no). -trace_level_trace_returns(interface_ports, no). -trace_level_trace_returns(interface_ports_returns, yes). - -%-----------------------------------------------------------------------------% - convert_gc_method("none", none). convert_gc_method("conservative", conservative). convert_gc_method("accurate", accurate). @@ -223,12 +203,11 @@ convert_termination_norm("num-data-elems", num_data_elems). convert_termination_norm("size-data-elems", size_data_elems). convert_trace_level("minimum", no, none). -convert_trace_level("minimum", yes, interface). -convert_trace_level("interfaces", _, interface). -convert_trace_level("most", _, interface_ports). -convert_trace_level("all", _, interface_ports_returns). +convert_trace_level("minimum", yes, shallow). +convert_trace_level("shallow", _, shallow). +convert_trace_level("deep", _, deep). convert_trace_level("default", no, none). -convert_trace_level("default", yes, interface_ports). +convert_trace_level("default", yes, deep). %-----------------------------------------------------------------------------% @@ -317,6 +296,26 @@ globals__have_static_code_addresses_2(OptionTable, IsConst) :- getopt__lookup_bool_option(OptionTable, asm_labels, AsmLabels), exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst). +globals__want_return_layouts(Globals, WantReturnLayouts) :- + % We need to generate layout info for call return labels + % if we are using accurate gc or if the user wants uplevel printing. + ( + ( + globals__get_gc_method(Globals, GC_Method), + GC_Method = accurate + ; + globals__lookup_bool_option(Globals, trace_return, + TraceReturn), + TraceReturn = yes, + globals__get_trace_level(Globals, TraceLevel), + TraceLevel \= none + ) + -> + WantReturnLayouts = yes + ; + WantReturnLayouts = no + ). + %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/compiler/llds.m b/compiler/llds.m index 40304d8be..21ac90872 100644 --- a/compiler/llds.m +++ b/compiler/llds.m @@ -427,10 +427,6 @@ % refer to? live_value_type, % What is the type of this live value? - string, - % What is the name of the variable stored here? - % The empty string if this lval does not - % store a variable. assoc_list(tvar, lval) % Where are the typeinfos that determine the % types of the actual parameters of the type @@ -442,16 +438,22 @@ % live_value_type describes the different sorts of data that % can be considered live. :- type live_value_type - ---> succip % a stored succip - ; curfr % a stored curfr - ; maxfr % a stored maxfr - ; redoip - ; redofr - ; hp - ; var(type, inst) % a variable - ; unwanted. % something we don't need, or used as - % a placeholder for non-accurate gc. - + ---> succip % A stored succip. + ; curfr % A stored curfr. + ; maxfr % A stored maxfr. + ; redoip % A stored redoip. + ; redofr % A stored redofr. + ; hp % A stored heap pointer. + ; var(var, string, type, inst) % A variable (the var number + % and name are for execution + % tracing; we have to store + % the name here because when + % we want to use the + % live_value_type, we won't + % have access to the varset). + ; unwanted. % Something we don't need, + % or at least don't need + % information about. % An lval represents a data location or register that can be used % as the target of an assignment. @@ -707,22 +709,28 @@ ; exported(proc_label). % exported from Mercury module :- type code_addr - ---> label(label) % a label defined in this Mercury module - ; imported(proc_label) % a label from another Mercury module - ; succip % the address in the `succip' register - ; do_succeed(bool) % the bool is `yes' if there are any + ---> label(label) % A label defined in this Mercury + % module. + ; imported(proc_label) % A label from another Mercury module. + ; succip % The address in the `succip' + % register. + ; do_succeed(bool) % The bool is `yes' if there are any % alternatives left. If the bool is % `no', we do a succeed_discard() % rather than a succeed(). ; do_redo ; do_fail + ; do_trace_redo_fail + % A label in the runtime, the code + % at which calls MR_trace with a + % REDO event and then fails. ; do_det_closure ; do_semidet_closure ; do_nondet_closure ; do_det_class_method ; do_semidet_class_method ; do_nondet_class_method - ; do_not_reached. % we should never jump to this address + ; do_not_reached. % We should never jump to this address. % A proc_label is a label used for the entry point to a procedure. % The defining module is the module that provides the code for the diff --git a/compiler/stack_layout.m b/compiler/stack_layout.m index d032507eb..47342d944 100644 --- a/compiler/stack_layout.m +++ b/compiler/stack_layout.m @@ -68,11 +68,13 @@ % The meanings of the fields in both forms are the same as in procedure labels. % % If the option trace_stack_layout is set, i.e. if we are doing execution -% tracing, the table will also include one extra field: +% tracing, the table will also include two extra fields: % % call trace info (Word *) - pointer to label stack layout +% maybe from full (Integer) - stack slot of the from_full +% flag, if the procedure is shallow traced % -% This will point to the per-label layout info for the label associated +% The first will point to the per-label layout info for the label associated % with the call event at the entry to the procedure. The purpose of this % information is to allow the runtime debugger to find out which variables % are where on entry, so it can reexecute the procedure if asked to do so @@ -80,6 +82,13 @@ % (If trace_stack_layout is not set, this field will be present, % but it will be set to NULL.) % +% If the procedure is compiled with deep tracing, the last field will contain +% a negative number. If it is compiled with shallow tracing, it will contain +% the number of the stack slot that holds the flag that says whether this +% incarnation of the procedure was called from deeply traced code or not. +% (The determinism of the procedure decides whether the stack slot refers +% to a stackvar or a framevar.) +% % If the option basic_stack_layout is set, we generate stack layout tables % for some labels internal to the procedure. This table will be stored in the % global variable whose name is @@ -222,9 +231,10 @@ stack_layout__generate_llds(ModuleInfo0, ModuleInfo, CModules, stack_layout__construct_layouts(ProcLayoutInfo) --> { ProcLayoutInfo = proc_layout_info(EntryLabel, Detism, - StackSlots, SuccipLoc, CallLabel, InternalMap) }, + StackSlots, SuccipLoc, MaybeCallLabel, MaybeFromFullSlot, + InternalMap) }, stack_layout__construct_proc_layout(EntryLabel, Detism, - StackSlots, SuccipLoc, CallLabel), + StackSlots, SuccipLoc, MaybeCallLabel, MaybeFromFullSlot), { map__to_assoc_list(InternalMap, Internals) }, list__foldl(stack_layout__construct_internal_layout(EntryLabel), Internals). @@ -235,10 +245,10 @@ stack_layout__construct_layouts(ProcLayoutInfo) --> :- pred stack_layout__construct_proc_layout(label::in, determinism::in, int::in, maybe(int)::in, maybe(label)::in, - stack_layout_info::in, stack_layout_info::out) is det. + maybe(int)::in, stack_layout_info::in, stack_layout_info::out) is det. stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots, - MaybeSuccipLoc, MaybeCallLabel) --> + MaybeSuccipLoc, MaybeCallLabel, MaybeFromFullSlot) --> { MaybeSuccipLoc = yes(Location0) -> @@ -298,21 +308,27 @@ stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots, stack_layout__get_module_name(ModuleName), stack_layout__get_trace_stack_layout(TraceLayout), - ( - { TraceLayout = yes } + { + TraceLayout = yes -> - ( { MaybeCallLabel = yes(CallLabel) } -> - { CallRval = yes(const(data_addr_const( - data_addr(ModuleName, - stack_layout(CallLabel))))) }, - { list__append(MaybeRvals1, [CallRval], MaybeRvals) } + ( MaybeCallLabel = yes(CallLabel) -> + CallRval = yes(const(data_addr_const( + data_addr(ModuleName, + stack_layout(CallLabel))))) ; - { error("stack_layout__construct_proc_layout: call label not present") } - ) + error("stack_layout__construct_proc_layout: call label not present") + ), + ( MaybeFromFullSlot = yes(FromFullSlot) -> + FromFullRval = yes(const(int_const(FromFullSlot))) + ; + FromFullRval = yes(const(int_const(-1))) + ), + list__append(MaybeRvals1, [CallRval, FromFullRval], + MaybeRvals) ; - { NoCallRval = yes(const(int_const(0))) }, - { list__append(MaybeRvals1, [NoCallRval], MaybeRvals) } - ), + NoCallRval = yes(const(int_const(0))), + list__append(MaybeRvals1, [NoCallRval], MaybeRvals) + }, { Exported = no }, % XXX With the new profiler, we will need to % set this to `yes' if the profiling option @@ -507,8 +523,8 @@ stack_layout__construct_livelval_rvals(LiveLvalSet, TVarLocnSet, RvalList) --> stack_layout__select_trace_return(Infos, TVars, TraceReturnInfos, TVars) :- IsNamedReturnVar = lambda([LvalInfo::in] is semidet, ( - LvalInfo = var_info(Lval, LvalType, Name), - LvalType = var(_, _), + LvalInfo = var_info(Lval, LvalType), + LvalType = var(_, Name, _, _), Name \= "", ( Lval = stackvar(_) ; Lval = framevar(_) ) )), @@ -529,14 +545,16 @@ stack_layout__select_trace_return(Infos, TVars, TraceReturnInfos, TVars) :- stack_layout__sort_livevals(OrigInfos, FinalInfos) :- IsNamedVar = lambda([LvalInfo::in] is semidet, ( - LvalInfo = var_info(_Lval, LvalType, Name), - LvalType = var(_, _), + LvalInfo = var_info(_Lval, LvalType), + LvalType = var(_, Name, _, _), Name \= "" )), list__filter(IsNamedVar, OrigInfos, NamedVarInfos0, OtherInfos0), CompareVarInfos = lambda([Var1::in, Var2::in, Result::out] is det, ( - Var1 = var_info(Lval1, _, Name1), - Var2 = var_info(Lval2, _, Name2), + Var1 = var_info(Lval1, LiveType1), + Var2 = var_info(Lval2, LiveType2), + stack_layout__get_name_from_live_value_type(LiveType1, Name1), + stack_layout__get_name_from_live_value_type(LiveType2, Name2), compare(NameResult, Name1, Name2), ( NameResult = (=) -> compare(Result, Lval1, Lval2) @@ -548,6 +566,16 @@ stack_layout__sort_livevals(OrigInfos, FinalInfos) :- list__sort(CompareVarInfos, OtherInfos0, OtherInfos), list__append(NamedVarInfos, OtherInfos, FinalInfos). +:- pred stack_layout__get_name_from_live_value_type(live_value_type::in, + string::out) is det. + +stack_layout__get_name_from_live_value_type(LiveType, Name) :- + ( LiveType = var(_, NamePrime, _, _) -> + Name = NamePrime + ; + Name = "" + ). + %---------------------------------------------------------------------------% % Given a association list of type variables and their locations @@ -605,7 +633,7 @@ stack_layout__construct_liveval_pairs(LiveLvals, LocnVector, NameVector) --> list(maybe(rval))::out, stack_layout_info::in, stack_layout_info::out) is det. -stack_layout__construct_liveval_pair(var_info(Lval, LiveValueType, _), +stack_layout__construct_liveval_pair(var_info(Lval, LiveValueType), MaybeRvals) --> { stack_layout__represent_lval(Lval, Rval0) }, stack_layout__represent_live_value_type(LiveValueType, Rval1), @@ -614,13 +642,26 @@ stack_layout__construct_liveval_pair(var_info(Lval, LiveValueType, _), :- pred stack_layout__construct_liveval_name(var_info::in, maybe(rval)::out) is det. -stack_layout__construct_liveval_name(var_info(_, _, Name), MaybeRval) :- - ( Name = "" -> +stack_layout__construct_liveval_name(var_info(_, VarInfo), MaybeRval) :- + ( + VarInfo = var(Var, Name, _, _), + Name \= "" + -> + % We include a representation of the variable number at the + % start of the variable name, because some functions of the + % debugger (e.g. restart) require it to be able to distinguish + % between distinct variables that happen to have the same name. + % We represent the number as a string, because most variable + % numbers are so small that this is a very compact + % representation. + term__var_to_int(Var, Int), + string__int_to_string(Int, IntStr), + string__append_list([IntStr, ":", Name], NumberedName), + Rval = const(string_const(NumberedName)) + ; % We prefer a null pointer to a pointer to an empty string, % since this way we don't need many copies of the empty string. Rval = const(int_const(0)) - ; - Rval = const(string_const(Name)) ), MaybeRval = yes(Rval). @@ -631,7 +672,7 @@ stack_layout__construct_liveval_name(var_info(_, _, Name), MaybeRval) :- % mercury_stack_layout.h - contains macros to access these % constants. - % Construct a representation of a live_value_type. + % Construct a representation of a live_value_type without the name. % % Low integers for special values, a pointer for other values. % (Remember to keep the low integers below the max varint value in @@ -655,7 +696,7 @@ stack_layout__represent_live_value_type(redoip, Rval) --> { Rval = const(int_const(5)) }. stack_layout__represent_live_value_type(unwanted, Rval) --> { Rval = const(int_const(6)) }. -stack_layout__represent_live_value_type(var(Type, _Inst), Rval) --> +stack_layout__represent_live_value_type(var(_, _, Type, _Inst), Rval) --> stack_layout__get_cell_number(CNum0), { base_type_layout__construct_pseudo_type_info(Type, Rval0, CNum0, CNum1) }, diff --git a/compiler/trace.m b/compiler/trace.m index 86e5b4188..02b81a074 100644 --- a/compiler/trace.m +++ b/compiler/trace.m @@ -47,8 +47,12 @@ :- import_module hlds_goal, hlds_pred, hlds_module. :- import_module globals, prog_data, llds, code_info. -:- import_module assoc_list, set, term. +:- import_module std_util, assoc_list, set, term. + % The kinds of external ports for which the code we generate will + % call MR_trace. The redo port is not on this list, because for that + % port the code that calls MR_trace is not in compiler-generated code, + % but in the runtime system. :- type external_trace_port ---> call ; exit @@ -68,16 +72,27 @@ % layouts). :- pred trace__fail_vars(module_info::in, proc_info::in, set(var)::out) is det. - % Reserve the stack slots for the call number, call depth and - % (for interface tracing) for the flag that says whether this call - % should be traced. Return our (abstract) struct that says which - % slots these are, so that it can be made part of the code generator - % state. -:- pred trace__setup(trace_level::in, trace_info::out, + % Return the number of slots reserved for tracing information. + % If there are N slots, the reserved slots will be 1 through N. +:- pred trace__reserved_slots(proc_info::in, globals::in, int::out) is det. + + % Reserve the non-fixed stack slots needed for tracing. + % The fixed slots for the event number, call number, call depth and + % (for trace levels that specify redo events) the stack layout of + % the redo event are reserved in live_vars.m; this predicate reserves + % only the slots that do not need to be in fixed slots. At the moment + % the only such slot is the flag that says whether this call should be + % traced, which is required only for shallow tracing. + % + % The predicate returns the number of this slot if it is used, + % and an abstract struct that represents the tracing-specific part + % of the code generator state. +:- pred trace__setup(globals::in, maybe(int)::out, trace_info::out, code_info::in, code_info::out) is det. % Generate code to fill in the reserevd stack slots. -:- pred trace__generate_slot_fill_code(trace_info::in, code_tree::out) is det. +:- pred trace__generate_slot_fill_code(trace_info::in, code_tree::out, + code_info::in, code_info::out) is det. % If we are doing execution tracing, generate code to prepare for % a call. @@ -104,6 +119,12 @@ trace_info::in, label::out, assoc_list(tvar, lval)::out, code_tree::out, code_info::in, code_info::out) is det. + % If the trace level calls for redo events, generate code that pushes + % a temporary nondet stack frame whose redoip slot contains the + % address of one of the labels in the runtime that calls MR_trace + % for a redo event. Otherwise, generate empty code. +:- pred trace__maybe_setup_redo_event(trace_info::in, code_tree::out) is det. + :- pred trace__path_to_string(goal_path::in, string::out) is det. %-----------------------------------------------------------------------------% @@ -111,9 +132,11 @@ :- implementation. :- import_module continuation_info, type_util, llds_out, tree. -:- import_module (inst), instmap, inst_match, mode_util. +:- import_module (inst), instmap, inst_match, mode_util, options. :- import_module list, bool, int, string, map, std_util, varset, require. + % The redo port is not included in this type; see the comment + % on the type external_trace_port above. :- type trace_port ---> call ; exit @@ -136,8 +159,8 @@ ; nondet_pragma. :- type trace_type - ---> full_trace - ; interface_trace(lval). % This holds the saved value of a bool + ---> deep_trace + ; shallow_trace(lval). % This holds the saved value of a bool % that is true iff we were called from % code with full tracing. @@ -145,9 +168,20 @@ % of a procedure. :- type trace_info ---> trace_info( - lval, % stack slot of call sequence number - lval, % stack slot of call depth - trace_type + trace_type, % The trace level (which cannot be + % none), and if it is shallow, the + % lval of the slot that holds the + % from-full flag. + bool, % The value of --trace-internal. + bool, % The value of --trace-return. + maybe(label) % If we are generating redo events, + % this has the label associated with + % the fail event, which we then reserve + % in advance, so we can put the + % address of its layout struct + % into the slot which holds the + % layout for the redo event (the + % two events have identical layouts). ). trace__fail_vars(ModuleInfo, ProcInfo, FailVars) :- @@ -164,67 +198,151 @@ trace__fail_vars(ModuleInfo, ProcInfo, FailVars) :- error("length mismatch in trace__fail_vars") ). -trace__setup(TraceLevel, TraceInfo) --> - code_info__acquire_temp_slot(trace_data, CallNumSlot), - code_info__acquire_temp_slot(trace_data, CallDepthSlot), - ( { trace_level_trace_ports(TraceLevel, yes) } -> - { TraceType = full_trace } +trace__reserved_slots(ProcInfo, Globals, ReservedSlots) :- + globals__get_trace_level(Globals, TraceLevel), + ( + TraceLevel = none + -> + ReservedSlots = 0 ; - code_info__acquire_temp_slot(trace_data, CallFromFullSlot), - { TraceType = interface_trace(CallFromFullSlot) } - ), - { TraceInfo = trace_info(CallNumSlot, CallDepthSlot, TraceType) }. + globals__lookup_bool_option(Globals, trace_redo, yes), + proc_info_interface_code_model(ProcInfo, model_non) + -> + ( TraceLevel = deep -> + % event#, call#, call depth, redo layout + ReservedSlots = 4 + ; + % event#, call#, call depth, redo layout, from full + ReservedSlots = 5 + ) + ; + ( TraceLevel = deep -> + % event#, call#, call depth + ReservedSlots = 3 + ; + % event#, call#, call depth, from full + ReservedSlots = 4 + ) + ). -trace__generate_slot_fill_code(TraceInfo, TraceCode) :- - TraceInfo = trace_info(CallNumLval, CallDepthLval, TraceType), +trace__setup(Globals, MaybeFromFullSlot, TraceInfo) --> + % These slots were reserved by allocate_stack_slots in live_vars.m. + code_info__get_proc_model(CodeModel), + { globals__lookup_bool_option(Globals, trace_return, TraceReturn) }, + { globals__lookup_bool_option(Globals, trace_redo, TraceRedo) }, + ( + { TraceRedo = yes }, + { CodeModel = model_non } + -> + code_info__get_next_label(RedoLayoutLabel), + { MaybeRedoLayoutSlot = yes(RedoLayoutLabel) } + ; + { MaybeRedoLayoutSlot = no } + ), + { globals__get_trace_level(Globals, deep) -> + TraceType = deep_trace, + globals__lookup_bool_option(Globals, trace_internal, + TraceInternal), + MaybeFromFullSlot = no + ; + % Trace level must be shallow. + % + % Debugger code in the runtime is not interested in the + % call-from-full flag, so does not have to be in a fixed slot. + % Even if we put in a fixed slot, the runtime won't know + % whether a procedure has interface or full tracing, and so it + % wouldn't know whether the slot was used for this purpose + % or not. + ( CodeModel = model_non -> + ( TraceRedo = yes -> + CallFromFullSlot = framevar(5), + MaybeFromFullSlot = yes(4) + ; + CallFromFullSlot = framevar(4), + MaybeFromFullSlot = yes(4) + ) + ; + CallFromFullSlot = stackvar(4), + MaybeFromFullSlot = yes(4) + ), + TraceType = shallow_trace(CallFromFullSlot), + % Shallow traced procs never generate internal events. + TraceInternal = no + }, + { TraceInfo = trace_info(TraceType, TraceInternal, TraceReturn, + MaybeRedoLayoutSlot) }. + +trace__generate_slot_fill_code(TraceInfo, TraceCode) --> + code_info__get_proc_model(CodeModel), + { + TraceInfo = trace_info(TraceType, _, _, MaybeRedoLayoutSlot), + trace__event_num_slot(CodeModel, EventNumLval), + trace__call_num_slot(CodeModel, CallNumLval), + trace__call_depth_slot(CodeModel, CallDepthLval), + trace__stackref_to_string(EventNumLval, EventNumStr), trace__stackref_to_string(CallNumLval, CallNumStr), trace__stackref_to_string(CallDepthLval, CallDepthStr), + string__append_list([ + "\t\t", EventNumStr, " = MR_trace_event_number;\n", + "\t\t", CallNumStr, " = MR_trace_incr_seq();\n", + "\t\t", CallDepthStr, " = MR_trace_incr_depth();" + ], FillThreeSlots), + ( MaybeRedoLayoutSlot = yes(RedoLayoutLabel) -> + trace__redo_layout_slot(CodeModel, RedoLayoutLval), + trace__stackref_to_string(RedoLayoutLval, RedoLayoutStr), + llds_out__make_stack_layout_name(RedoLayoutLabel, + LayoutAddrStr), + string__append_list([ + FillThreeSlots, "\n", + "\t\t", RedoLayoutStr, " = (Word) (const Word *) &", + LayoutAddrStr, ";" + ], FillFourSlots) + ; + FillFourSlots = FillThreeSlots + ), ( - TraceType = interface_trace(CallFromFullSlot), + TraceType = shallow_trace(CallFromFullSlot), trace__stackref_to_string(CallFromFullSlot, CallFromFullSlotStr), string__append_list([ "\t\t", CallFromFullSlotStr, " = MR_trace_from_full;\n", "\t\tif (MR_trace_from_full) {\n", - "\t\t\t", CallNumStr, " = MR_trace_incr_seq();\n", - "\t\t\t", CallDepthStr, " = MR_trace_incr_depth();\n", + FillFourSlots, "\n", "\t\t}" ], TraceStmt) ; - TraceType = full_trace, - string__append_list([ - "\t\t", CallNumStr, " = MR_trace_incr_seq();\n", - "\t\t", CallDepthStr, " = MR_trace_incr_depth();" - ], TraceStmt) + TraceType = deep_trace, + TraceStmt = FillFourSlots ), TraceCode = node([ pragma_c([], [pragma_c_raw_code(TraceStmt)], will_not_call_mercury, no, yes) - "" - ]). + ]) + }. trace__prepare_for_call(TraceCode) --> code_info__get_maybe_trace_info(MaybeTraceInfo), + code_info__get_proc_model(CodeModel), { MaybeTraceInfo = yes(TraceInfo) -> - TraceInfo = trace_info(_CallNumLval, CallDepthLval, TraceType), + TraceInfo = trace_info(TraceType, _, _, _), + trace__call_depth_slot(CodeModel, CallDepthLval), trace__stackref_to_string(CallDepthLval, CallDepthStr), - string__append_list(["MR_trace_reset_depth(", CallDepthStr, - ");\n"], - ResetDepthStmt), + string__append_list([ + "MR_trace_reset_depth(", CallDepthStr, ");\n" + ], ResetDepthStmt), ( - TraceType = interface_trace(_), - TraceCode = node([ - c_code("MR_trace_from_full = FALSE;\n") - "", - c_code(ResetDepthStmt) - "" - ]) + TraceType = shallow_trace(_), + ResetFromFullStmt = "MR_trace_from_full = FALSE;\n" ; - TraceType = full_trace, - TraceCode = node([ - c_code("MR_trace_from_full = TRUE;\n") - "", - c_code(ResetDepthStmt) - "" - ]) - ) + TraceType = deep_trace, + ResetFromFullStmt = "MR_trace_from_full = TRUE;\n" + ), + TraceCode = node([ + c_code(ResetFromFullStmt) - "", + c_code(ResetDepthStmt) - "" + ]) ; TraceCode = empty }. @@ -233,7 +351,7 @@ trace__maybe_generate_internal_event_code(Goal, Code) --> code_info__get_maybe_trace_info(MaybeTraceInfo), ( { MaybeTraceInfo = yes(TraceInfo) }, - { TraceInfo = trace_info(_, _, full_trace) } + { TraceInfo = trace_info(_, yes, _, _) } -> { Goal = _ - GoalInfo }, { goal_info_get_goal_path(GoalInfo, Path) }, @@ -268,7 +386,7 @@ trace__maybe_generate_pragma_event_code(PragmaPort, Code) --> code_info__get_maybe_trace_info(MaybeTraceInfo), ( { MaybeTraceInfo = yes(TraceInfo) }, - { TraceInfo = trace_info(_, _, full_trace) } + { TraceInfo = trace_info(_, yes, _, _) } -> { trace__convert_nondet_pragma_port_type(PragmaPort, Port) }, trace__generate_event_code(Port, nondet_pragma, TraceInfo, @@ -289,22 +407,41 @@ trace__generate_external_event_code(ExternalPort, TraceInfo, trace__generate_event_code(Port, PortInfo, TraceInfo, Label, TvarDataList, Code) --> - code_info__get_next_label(Label), + ( + { Port = fail }, + { TraceInfo = trace_info(_, _, _, yes(RedoLabel)) } + -> + % The layout information for the redo event is the same as + % for the fail event; all the non-clobbered inputs in their + % stack slots. It is convenient to generate this common layout + % when the code generator state is set up for the fail event; + % generating it for the redo event would be much harder. + % On the other hand, the address of the layout structure + % for the redo event should be put into its fixed stack slot + % at procedure entry. Therefore trace__setup reserves a label + % whose layout structure serves for both the fail and redo + % events. + { Label = RedoLabel } + ; + code_info__get_next_label(Label) + ), code_info__get_known_variables(LiveVars0), - { - PortInfo = external, - LiveVars = LiveVars0, - PathStr = "" + ( + { PortInfo = external }, + { LiveVars = LiveVars0 }, + { PathStr = "" } ; - PortInfo = internal(Path, PreDeaths), - set__to_sorted_list(PreDeaths, PreDeathList), - list__delete_elems(LiveVars0, PreDeathList, LiveVars), - trace__path_to_string(Path, PathStr) + { PortInfo = internal(Path, PreDeaths) }, + code_info__current_resume_point_vars(ResumeVars), + { set__difference(PreDeaths, ResumeVars, RealPreDeaths) }, + { set__to_sorted_list(RealPreDeaths, RealPreDeathList) }, + { list__delete_elems(LiveVars0, RealPreDeathList, LiveVars) }, + { trace__path_to_string(Path, PathStr) } ; - PortInfo = nondet_pragma, - LiveVars = [], - PathStr = "" - }, + { PortInfo = nondet_pragma }, + { LiveVars = [] }, + { PathStr = "" } + ), code_info__get_varset(VarSet), code_info__get_instmap(InstMap), { set__init(TvarSet0) }, @@ -322,32 +459,23 @@ trace__generate_event_code(Port, PortInfo, TraceInfo, Label, TvarDataList, set__list_to_set(TvarDataList, TvarDataSet), LayoutLabelInfo = layout_label_info(VarInfoSet, TvarDataSet), llds_out__get_label(Label, yes, LabelStr), - TraceInfo = trace_info(CallNumLval, CallDepthLval, TraceType), - trace__stackref_to_string(CallNumLval, CallNumStr), - trace__stackref_to_string(CallDepthLval, CallDepthStr), Quote = """", Comma = ", ", trace__port_to_string(Port, PortStr), - ( - TraceType = full_trace, - FlagStr = "TRUE" - ; - TraceType = interface_trace(CallFromFullLval), - trace__stackref_to_string(CallFromFullLval, FlagStr) - ), + DeclStmt = "\t\tCode *MR_jumpaddr;\n", SaveStmt = "\t\tsave_transient_registers();\n", - RestoreStmt = "\t\trestore_transient_registers();", + RestoreStmt = "\t\trestore_transient_registers();\n", string__int_to_string(MaxReg, MaxRegStr), string__append_list([ - "\t\tMR_trace((const MR_Stack_Layout_Label *)\n", + "\t\tMR_jumpaddr = MR_trace(\n", + "\t\t\t(const MR_Stack_Layout_Label *)\n", "\t\t\t&mercury_data__layout__", LabelStr, Comma, "\n", - "\t\t\t", PortStr, Comma, - CallNumStr, Comma, - CallDepthStr, Comma, "\n", - "\t\t\t", Quote, PathStr, Quote, Comma, - MaxRegStr, Comma, FlagStr, ");\n"], + "\t\t\t", PortStr, Comma, Quote, PathStr, Quote, Comma, + MaxRegStr, ");\n"], CallStmt), - string__append_list([SaveStmt, CallStmt, RestoreStmt], TraceStmt), + GotoStmt = "\t\tif (MR_jumpaddr != NULL) GOTO(MR_jumpaddr);", + string__append_list([DeclStmt, SaveStmt, CallStmt, RestoreStmt, + GotoStmt], TraceStmt), TraceCode = node([ label(Label) @@ -367,6 +495,18 @@ trace__generate_event_code(Port, PortInfo, TraceInfo, Label, TvarDataList, }, code_info__add_trace_layout_for_label(Label, LayoutLabelInfo). +trace__maybe_setup_redo_event(TraceInfo, Code) :- + TraceInfo = trace_info(_, _, _, TraceRedo), + ( TraceRedo = yes(_) -> + Code = node([ + mkframe(temp_frame(nondet_stack_proc), + do_trace_redo_fail) + - "set up deep redo event" + ]) + ; + Code = empty + ). + :- pred trace__produce_vars(list(var)::in, varset::in, instmap::in, set(tvar)::in, set(tvar)::out, list(var_info)::out, code_tree::out, code_info::in, code_info::out) is det. @@ -388,8 +528,8 @@ trace__produce_vars([Var | Vars], VarSet, InstMap, Tvars0, Tvars, ), varset__lookup_name(VarSet, Var, "V_", Name), instmap__lookup_var(InstMap, Var, Inst), - LiveType = var(Type, Inst), - VarInfo = var_info(Lval, LiveType, Name), + LiveType = var(Var, Name, Type, Inst), + VarInfo = var_info(Lval, LiveType), type_util__vars(Type, TypeVars), set__insert_list(Tvars0, TypeVars, Tvars1) }, @@ -469,8 +609,7 @@ trace__stackref_to_string(Lval, LvalStr) :- string__int_to_string(Slot, SlotString), string__append_list(["MR_stackvar(", SlotString, ")"], LvalStr) ; Lval = framevar(Slot) -> - Slot1 is Slot + 1, - string__int_to_string(Slot1, SlotString), + string__int_to_string(Slot, SlotString), string__append_list(["MR_framevar(", SlotString, ")"], LvalStr) ; error("non-stack lval in stackref_to_string") @@ -521,3 +660,40 @@ trace__convert_nondet_pragma_port_type(nondet_pragma_first, nondet_pragma_first). trace__convert_nondet_pragma_port_type(nondet_pragma_later, nondet_pragma_later). + +%-----------------------------------------------------------------------------% + +:- pred trace__event_num_slot(code_model::in, lval::out) is det. +:- pred trace__call_num_slot(code_model::in, lval::out) is det. +:- pred trace__call_depth_slot(code_model::in, lval::out) is det. +:- pred trace__redo_layout_slot(code_model::in, lval::out) is det. + +trace__event_num_slot(CodeModel, EventNumSlot) :- + ( CodeModel = model_non -> + EventNumSlot = framevar(1) + ; + EventNumSlot = stackvar(1) + ). + +trace__call_num_slot(CodeModel, CallNumSlot) :- + ( CodeModel = model_non -> + CallNumSlot = framevar(2) + ; + CallNumSlot = stackvar(2) + ). + +trace__call_depth_slot(CodeModel, CallDepthSlot) :- + ( CodeModel = model_non -> + CallDepthSlot = framevar(3) + ; + CallDepthSlot = stackvar(3) + ). + +trace__redo_layout_slot(CodeModel, RedoLayoutSlot) :- + ( CodeModel = model_non -> + RedoLayoutSlot = framevar(4) + ; + error("attempt to access redo layout slot for det or semi procedure") + ). + +%-----------------------------------------------------------------------------% diff --git a/doc/generate_mdb_command_list b/doc/generate_mdb_command_list new file mode 100755 index 000000000..f035f2f47 --- /dev/null +++ b/doc/generate_mdb_command_list @@ -0,0 +1,16 @@ +#!/bin/sh +#---------------------------------------------------------------------------# +# Copyright (C) 1995-1998 The University of Melbourne. +# This file may only be copied under the terms of the GNU General +# Public License - see the file COPYING in the Mercury distribution. +#---------------------------------------------------------------------------# + +# Given the automatically generated mdb_doc file, this script generates +# a C code fragment (part of an array initializer) that lists the valid +# commands. + +awk ' +$1 == "document" && $2 != "concepts" && $2 != "CATEGORY" { + printf "\t{ \"%s\", \"%s\" },\n", $2, $4; + } +' diff --git a/doc/generate_mdb_command_test b/doc/generate_mdb_command_test new file mode 100755 index 000000000..2d4ec65bd --- /dev/null +++ b/doc/generate_mdb_command_test @@ -0,0 +1,36 @@ +#!/bin/sh +#---------------------------------------------------------------------------# +# Copyright (C) 1998 The University of Melbourne. +# This file may only be copied under the terms of the GNU General +# Public License - see the file COPYING in the Mercury distribution. +#---------------------------------------------------------------------------# + +# Given the automatically generated mdb_doc file, this script generates +# a scripts that exercises the error messages for the improper invocations +# of mdb commands. + +awk ' +$1 == "document" { + # the items in the "concepts" category are not commands + if ($2 == "concepts") + next; + + # this line is from the "documentation" of the "document" cmd + if ($2 == "CATEGORY") + next; + + # the following commands cannot be tested with xyzzy args + if ($4 == "alias") + next; + if ($4 == "help") + next; + if ($4 == "document") + next; + if ($4 == "document_category") + next; + + # for all the other commands, try to execute them with + # illegal arguments + printf "%-20s xyzzy xyzzy xyzzy xyzzy xyzzy\n", $4; + } +' diff --git a/doc/generate_mdb_doc b/doc/generate_mdb_doc new file mode 100755 index 000000000..d53d89d82 --- /dev/null +++ b/doc/generate_mdb_doc @@ -0,0 +1,22 @@ +#!/bin/sh +#---------------------------------------------------------------------------# +# Copyright (C) 1998 The University of Melbourne. +# This file may only be copied under the terms of the GNU General +# Public License - see the file COPYING in the Mercury distribution. +#---------------------------------------------------------------------------# + +# the info menu items that get us to the chapter on debugger commands +cat mdb_categories > mdb_doc + +tmp="mdb_doc_tmp.$$" +trap '/bin/rm -f $tmp' 0 1 2 3 15 + +info -f mercury_user_guide.info -o $tmp -n "Mercury debugger concepts" +../util/info_to_mdb concepts $tmp >> mdb_doc + +debug_cmd_path="debug debugger" +for section in forward backward browsing breakpoint parameter help exp developer misc +do + info -f mercury_user_guide.info -o $tmp $debug_cmd_path $section + ../util/info_to_mdb $section $tmp >> mdb_doc +done diff --git a/runtime/Mmakefile b/runtime/Mmakefile index 189ae267c..20697dab7 100644 --- a/runtime/Mmakefile +++ b/runtime/Mmakefile @@ -25,6 +25,7 @@ MOD2C = $(SCRIPTS_DIR)/mod2c HDRS = \ mercury_accurate_gc.h \ mercury_agc_debug.h \ + mercury_array_macros.h \ mercury_calls.h \ mercury_conf.h \ mercury_conf_param.h \ @@ -45,6 +46,7 @@ HDRS = \ mercury_imp.h \ mercury_init.h \ mercury_label.h \ + mercury_layout_util.h \ mercury_library_types.h \ mercury_memory.h \ mercury_memory_zones.h \ @@ -70,7 +72,6 @@ HDRS = \ mercury_thread.h \ mercury_timing.h \ mercury_trace_base.h \ - mercury_trace_util.h \ mercury_trail.h \ mercury_types.h \ mercury_type_info.h \ @@ -108,6 +109,7 @@ CFILES = \ mercury_heap_profile.c \ mercury_ho_call.c \ mercury_label.c \ + mercury_layout_util.c \ mercury_memory.c \ mercury_memory_zones.c \ mercury_memory_handlers.c \ @@ -124,7 +126,6 @@ CFILES = \ mercury_thread.c \ mercury_timing.c \ mercury_trace_base.c \ - mercury_trace_util.c \ mercury_trail.c \ mercury_type_info.c \ mercury_wrapper.c diff --git a/runtime/mercury_accurate_gc.c b/runtime/mercury_accurate_gc.c index cad29037b..d4383ccc0 100644 --- a/runtime/mercury_accurate_gc.c +++ b/runtime/mercury_accurate_gc.c @@ -12,8 +12,8 @@ #ifdef NATIVE_GC -#include "mercury_trace_util.h" #include "mercury_deep_copy.h" +#include "mercury_layout_util.h" #include "mercury_agc_debug.h" /* @@ -144,7 +144,7 @@ MR_schedule_agc(Code *pc_at_signal, Word *sp_at_signal) /* ** Save the old succip and its location. */ - saved_success_location = &based_detstackvar(sp_at_signal, + saved_success_location = &MR_based_stackvar(sp_at_signal, number); saved_success = (Code *) *saved_success_location; @@ -292,8 +292,10 @@ garbage_collect(Code *success_ip, Word *stack_pointer, Word *current_frame) /* Get the type parameters from the stack frame. */ - type_params = MR_trace_materialize_typeinfos_base(vars, - top_frame, stack_pointer, current_frame); + /* XXX We must pass NULL since the registers have not been saved */ + /* XXX This is probably a bug; Tyson should look into it */ + type_params = MR_materialize_typeinfos_base(vars, + NULL, stack_pointer, current_frame); /* Copy each live variable */ @@ -392,8 +394,8 @@ copy_value(MR_Live_Lval locn, Word *type_info, bool copy_regs, break; case MR_LVAL_TYPE_STACKVAR: - based_detstackvar(stack_pointer, locn_num) = - agc_deep_copy(&based_detstackvar( + MR_based_stackvar(stack_pointer, locn_num) = + agc_deep_copy(&MR_based_stackvar( stack_pointer,locn_num), type_info, MR_ENGINE(heap_zone2->min), MR_ENGINE(heap_zone2->hardmax)); diff --git a/runtime/mercury_agc_debug.c b/runtime/mercury_agc_debug.c index aecb2d80a..cc92dff9e 100644 --- a/runtime/mercury_agc_debug.c +++ b/runtime/mercury_agc_debug.c @@ -9,7 +9,7 @@ */ #include "mercury_imp.h" -#include "mercury_trace_util.h" +#include "mercury_layout_util.h" #include "mercury_deep_copy.h" #include "mercury_agc_debug.h" @@ -28,6 +28,8 @@ static void dump_live_value(MR_Live_Lval locn, MemoryZone *heap_zone, void MR_agc_dump_roots(MR_RootList roots) { + Word saved_regs[MAX_FAKE_REG]; + fflush(NULL); fprintf(stderr, "Dumping roots\n"); @@ -42,17 +44,19 @@ MR_agc_dump_roots(MR_RootList roots) ** the saved registers). */ restore_registers(); - MR_copy_regs_to_saved_regs(MAX_REAL_REG + NUM_SPECIAL_REG); + MR_copy_regs_to_saved_regs(MAX_REAL_REG + NUM_SPECIAL_REG, + saved_regs); MR_hp = MR_ENGINE(debug_heap_zone->min); MR_virtual_hp = MR_ENGINE(debug_heap_zone->min); fflush(NULL); - MR_trace_write_variable((Word) roots->type_info, *roots->root); + MR_write_variable((Word) roots->type_info, *roots->root); fflush(NULL); fprintf(stderr, "\n"); - MR_copy_saved_regs_to_regs(MAX_REAL_REG + NUM_SPECIAL_REG); + MR_copy_saved_regs_to_regs(MAX_REAL_REG + NUM_SPECIAL_REG, + saved_regs); save_registers(); roots = roots->next; } @@ -63,6 +67,7 @@ void MR_agc_dump_stack_frames(MR_Internal *label, MemoryZone *heap_zone, Word *stack_pointer, Word *current_frame) { + Word saved_regs[MAX_FAKE_REG]; int i, var_count; const MR_Stack_Layout_Vars *vars; Word *type_params, type_info, value; @@ -89,8 +94,14 @@ MR_agc_dump_stack_frames(MR_Internal *label, MemoryZone *heap_zone, var_count = layout->MR_sll_var_count; vars = &(layout->MR_sll_var_info); - type_params = MR_trace_materialize_typeinfos_base(vars, - top_frame, stack_pointer, current_frame); + /* + ** XXX For the top stack frame, we should pass a pointer to + ** a filled-in saved_regs instead of NULL. For other stack + ** frames, passing NULL is fine, since output arguments are + ** not live yet for any call except the top one. + */ + type_params = MR_materialize_typeinfos_base(vars, + NULL, stack_pointer, current_frame); for (i = 0; i < var_count; i++) { MR_Stack_Layout_Var sl_var; @@ -116,22 +127,27 @@ MR_agc_dump_stack_frames(MR_Internal *label, MemoryZone *heap_zone, */ restore_registers(); MR_copy_regs_to_saved_regs(MAX_REAL_REG + - NUM_SPECIAL_REG); + NUM_SPECIAL_REG, saved_regs); MR_hp = MR_ENGINE(debug_heap_zone->min); MR_virtual_hp = MR_ENGINE(debug_heap_zone->min); - if (MR_trace_get_type_and_value_base(&sl_var, - top_frame, stack_pointer, + /* + ** XXX We must pass NULL here because the registers + ** have not been saved. This is probably a bug; + ** Tyson should look into it. + */ + if (MR_get_type_and_value_base(&sl_var, + NULL, stack_pointer, current_frame, type_params, &type_info, &value)) { printf("\t"); - MR_trace_write_variable(type_info, value); + MR_write_variable(type_info, value); printf("\n"); } MR_copy_saved_regs_to_regs(MAX_REAL_REG + - NUM_SPECIAL_REG); + NUM_SPECIAL_REG, saved_regs); save_registers(); #endif /* MR_DEBUG_AGC_PRINT_VARS */ @@ -156,7 +172,7 @@ MR_agc_dump_stack_frames(MR_Internal *label, MemoryZone *heap_zone, } success_ip = (Code *) - based_detstackvar(stack_pointer, number); + MR_based_stackvar(stack_pointer, number); stack_pointer = stack_pointer - entry_layout->MR_sle_stack_slots; label = MR_lookup_internal_by_addr(success_ip); @@ -193,7 +209,7 @@ dump_live_value(MR_Live_Lval locn, MemoryZone *heap_zone, Word *stack_pointer, break; case MR_LVAL_TYPE_STACKVAR: - value = based_detstackvar(stack_pointer, locn_num); + value = MR_based_stackvar(stack_pointer, locn_num); have_value = TRUE; fprintf(stderr, "stackvar%d", locn_num); break; diff --git a/runtime/mercury_conf.h.in b/runtime/mercury_conf.h.in index c4c7c5838..ae2532123 100644 --- a/runtime/mercury_conf.h.in +++ b/runtime/mercury_conf.h.in @@ -227,6 +227,12 @@ */ #undef MR_CANNOT_GROK_ASM_TYPE_DIRECTIVE +/* +** On some platforms, structure assignments can cause gcc to abort +** with the message "fixed or forbidden register was spilled." in some grades. +*/ +#undef MR_CANNOT_USE_STRUCTURE_ASSIGNMENT + /*---------------------------------------------------------------------------*/ #include "mercury_conf_param.h" diff --git a/runtime/mercury_conf_param.h b/runtime/mercury_conf_param.h index bdd6083a2..fa2a35f8d 100644 --- a/runtime/mercury_conf_param.h +++ b/runtime/mercury_conf_param.h @@ -187,6 +187,14 @@ ** Enables profiling of memory usage. */ +/* +** Experimental options: +** +** MR_TRACE_HISTOGRAM +** Enable this if you want to count the number of execution tracing events +** at various call depths. +*/ + /*---------------------------------------------------------------------------*/ /* ** Settings of configuration parameters which can be passed on diff --git a/runtime/mercury_trace_util.c b/runtime/mercury_layout_util.c similarity index 60% rename from runtime/mercury_trace_util.c rename to runtime/mercury_layout_util.c index 83e686e13..5a5e3ae86 100644 --- a/runtime/mercury_trace_util.c +++ b/runtime/mercury_layout_util.c @@ -13,31 +13,24 @@ #include "mercury_imp.h" #include "mercury_stack_layout.h" -#include "mercury_trace_util.h" - -Word MR_saved_regs[MAX_FAKE_REG]; +#include "mercury_layout_util.h" void -MR_copy_regs_to_saved_regs(int max_mr_num) +MR_copy_regs_to_saved_regs(int max_mr_num, Word *saved_regs) { /* - ** In the process of browsing, we call Mercury code, + ** In the process of browsing within the debugger, we call Mercury, ** which may clobber the contents of the virtual machine registers, ** both control and general purpose, and both real and virtual ** registers. We must therefore save and restore these. - ** We store them in the MR_saved_regs array. + ** We store them in the saved_regs array. ** ** The call to MR_trace will clobber the transient registers ** on architectures that have them. The compiler generated code ** will therefore call save_transient_registers to save the transient ** registers in the fake_reg array. We here restore them to the ** real registers, save them with the other registers back in - ** fake_reg, and then copy all fake_reg entries to MR_saved_regs. - ** - ** If any code invoked by MR_trace is itself traced, - ** MR_saved_regs will be overwritten, leading to a crash later on. - ** This is one reason (but not the only one) why we turn off - ** tracing when we call back Mercury code from this file. + ** fake_reg, and then copy all fake_reg entries to saved_regs. */ int i; @@ -46,12 +39,12 @@ MR_copy_regs_to_saved_regs(int max_mr_num) save_registers(); for (i = 0; i <= max_mr_num; i++) { - MR_saved_regs[i] = MR_fake_reg[i]; + saved_regs[i] = MR_fake_reg[i]; } } void -MR_copy_saved_regs_to_regs(int max_mr_num) +MR_copy_saved_regs_to_regs(int max_mr_num, Word *saved_regs) { /* ** We execute the converse procedure to MR_copy_regs_to_saved_regs. @@ -63,7 +56,7 @@ MR_copy_saved_regs_to_regs(int max_mr_num) int i; for (i = 0; i <= max_mr_num; i++) { - MR_fake_reg[i] = MR_saved_regs[i]; + MR_fake_reg[i] = saved_regs[i]; } restore_registers(); @@ -71,15 +64,16 @@ MR_copy_saved_regs_to_regs(int max_mr_num) } Word * -MR_trace_materialize_typeinfos(const MR_Stack_Layout_Vars *vars) +MR_materialize_typeinfos(const MR_Stack_Layout_Vars *vars, + Word *saved_regs) { - return MR_trace_materialize_typeinfos_base(vars, TRUE, - MR_saved_sp(MR_saved_regs), MR_saved_curfr(MR_saved_regs)); + return MR_materialize_typeinfos_base(vars, saved_regs, + MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs)); } Word * -MR_trace_materialize_typeinfos_base(const MR_Stack_Layout_Vars *vars, - bool saved_regs_valid, Word *base_sp, Word *base_curfr) +MR_materialize_typeinfos_base(const MR_Stack_Layout_Vars *vars, + Word *saved_regs, Word *base_sp, Word *base_curfr) { Word *type_params; bool succeeded; @@ -96,12 +90,12 @@ MR_trace_materialize_typeinfos_base(const MR_Stack_Layout_Vars *vars, */ for (i = 1; i <= count; i++) { if (vars->MR_slvs_tvars[i] != 0) { - type_params[i] = MR_trace_lookup_live_lval_base( + type_params[i] = MR_lookup_live_lval_base( vars->MR_slvs_tvars[i], - saved_regs_valid, base_sp, base_curfr, + saved_regs, base_sp, base_curfr, &succeeded); - if (!succeeded) { - fatal_error("missing type param in MR_trace_materialize_typeinfos_base"); + if (! succeeded) { + fatal_error("missing type param in MR_materialize_typeinfos_base"); } } } @@ -113,7 +107,7 @@ MR_trace_materialize_typeinfos_base(const MR_Stack_Layout_Vars *vars, } Word -MR_trace_make_var_list(const MR_Stack_Layout_Label *layout) +MR_make_var_list(const MR_Stack_Layout_Label *layout, Word *saved_regs) { int var_count; const MR_Stack_Layout_Vars *vars; @@ -151,8 +145,8 @@ MR_trace_make_var_list(const MR_Stack_Layout_Label *layout) ** at the moment due to the lack of a true browser. */ - if (!MR_trace_get_type_and_value_filtered(var, name, - &type_info, &value)) + if (! MR_get_type_and_value_filtered(var, saved_regs, + name, &type_info, &value)) { continue; } @@ -162,7 +156,7 @@ MR_trace_make_var_list(const MR_Stack_Layout_Label *layout) ** and cons it onto the list. ** Note that the calls to save/restore transient registers ** can't be hoisted out of the loop, because - ** MR_trace_get_type_and_value() calls MR_create_type_info() + ** MR_get_type_and_value() calls MR_create_type_info() ** which may allocate memory using incr_saved_hp. */ @@ -178,19 +172,29 @@ MR_trace_make_var_list(const MR_Stack_Layout_Label *layout) return univ_list; } +int +MR_get_register_number(MR_Live_Lval locn) +{ + if (MR_LIVE_LVAL_TYPE(locn) == MR_LVAL_TYPE_R) { + return MR_LIVE_LVAL_NUMBER(locn); + } else { + return -1; + } +} + /* if you want to debug this code, you may want to set this var to TRUE */ -static bool MR_trace_print_locn = FALSE; +static bool MR_print_locn = FALSE; Word -MR_trace_lookup_live_lval(MR_Live_Lval locn, bool *succeeded) +MR_lookup_live_lval(MR_Live_Lval locn, Word *saved_regs, bool *succeeded) { - return MR_trace_lookup_live_lval_base(locn, TRUE, - MR_saved_sp(MR_saved_regs), MR_saved_curfr(MR_saved_regs), + return MR_lookup_live_lval_base(locn, saved_regs, + MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs), succeeded); } Word -MR_trace_lookup_live_lval_base(MR_Live_Lval locn, bool saved_regs_valid, +MR_lookup_live_lval_base(MR_Live_Lval locn, Word *saved_regs, Word *base_sp, Word *base_curfr, bool *succeeded) { int locn_num; @@ -202,75 +206,75 @@ MR_trace_lookup_live_lval_base(MR_Live_Lval locn, bool saved_regs_valid, locn_num = (int) MR_LIVE_LVAL_NUMBER(locn); switch (MR_LIVE_LVAL_TYPE(locn)) { case MR_LVAL_TYPE_R: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("r%d", locn_num); } - if (saved_regs_valid) { - value = saved_reg(MR_saved_regs, locn_num); + if (saved_regs != NULL) { + value = saved_reg(saved_regs, locn_num); *succeeded = TRUE; } break; case MR_LVAL_TYPE_F: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("f%d", locn_num); } break; case MR_LVAL_TYPE_STACKVAR: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("stackvar%d", locn_num); } - value = based_detstackvar(base_sp, locn_num); + value = MR_based_stackvar(base_sp, locn_num); *succeeded = TRUE; break; case MR_LVAL_TYPE_FRAMEVAR: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("framevar%d", locn_num); } - value = based_framevar(base_curfr, locn_num); + value = MR_based_framevar(base_curfr, locn_num); *succeeded = TRUE; break; case MR_LVAL_TYPE_SUCCIP: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("succip"); } break; case MR_LVAL_TYPE_MAXFR: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("maxfr"); } break; case MR_LVAL_TYPE_CURFR: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("curfr"); } break; case MR_LVAL_TYPE_HP: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("hp"); } break; case MR_LVAL_TYPE_SP: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("sp"); } break; case MR_LVAL_TYPE_UNKNOWN: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("unknown"); } break; default: - if (MR_trace_print_locn) { + if (MR_print_locn) { printf("DEFAULT"); } break; @@ -280,17 +284,17 @@ MR_trace_lookup_live_lval_base(MR_Live_Lval locn, bool saved_regs_valid, } bool -MR_trace_get_type_and_value(const MR_Stack_Layout_Var *var, - Word *type_params, Word *type_info, Word *value) +MR_get_type_and_value(const MR_Stack_Layout_Var *var, + Word *saved_regs, Word *type_params, Word *type_info, Word *value) { - return MR_trace_get_type_and_value_base(var, TRUE, - MR_saved_sp(MR_saved_regs), MR_saved_curfr(MR_saved_regs), + return MR_get_type_and_value_base(var, saved_regs, + MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs), type_params, type_info, value); } bool -MR_trace_get_type_and_value_base(const MR_Stack_Layout_Var *var, - bool saved_regs_valid, Word *base_sp, Word *base_curfr, +MR_get_type_and_value_base(const MR_Stack_Layout_Var *var, + Word *saved_regs, Word *base_sp, Word *base_curfr, Word *type_params, Word *type_info, Word *value) { bool succeeded; @@ -303,23 +307,23 @@ MR_trace_get_type_and_value_base(const MR_Stack_Layout_Var *var, pseudo_type_info = MR_LIVE_TYPE_GET_VAR_TYPE(var->MR_slv_live_type); *type_info = (Word) MR_create_type_info(type_params, pseudo_type_info); - *value = MR_trace_lookup_live_lval_base(var->MR_slv_locn, - saved_regs_valid, base_sp, base_curfr, &succeeded); + *value = MR_lookup_live_lval_base(var->MR_slv_locn, + saved_regs, base_sp, base_curfr, &succeeded); return succeeded; } bool -MR_trace_get_type(const MR_Stack_Layout_Var *var, +MR_get_type(const MR_Stack_Layout_Var *var, Word *saved_regs, Word *type_params, Word *type_info) { - return MR_trace_get_type_base(var, TRUE, - MR_saved_sp(MR_saved_regs), MR_saved_curfr(MR_saved_regs), + return MR_get_type_base(var, saved_regs, + MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs), type_params, type_info); } bool -MR_trace_get_type_base(const MR_Stack_Layout_Var *var, - bool saved_regs_valid, Word *base_sp, Word *base_curfr, +MR_get_type_base(const MR_Stack_Layout_Var *var, + Word *saved_regs, Word *base_sp, Word *base_curfr, Word *type_params, Word *type_info) { bool succeeded; @@ -336,35 +340,6 @@ MR_trace_get_type_base(const MR_Stack_Layout_Var *var, return TRUE; } -void -MR_trace_write_variable(Word type_info, Word value) -{ - - /* - ** XXX It would be nice if we could call an exported C function - ** version of the browser predicate, and thus avoid going - ** through call_engine, but for some unknown reason, that seemed - ** to cause the Mercury code in the browser to clobber part of - ** the C stack. - ** - ** Probably that was due to a bug which has since been fixed, so - ** we should change the code below back again... - ** - ** call_engine() expects the transient registers to be in - ** fake_reg, others in their normal homes. That is the case on - ** entry to this function. But r1 or r2 may be transient, so we - ** need to save/restore transient regs around the assignments to - ** them. - */ - - restore_transient_registers(); - r1 = type_info; - r2 = value; - save_transient_registers(); - call_engine(MR_library_trace_browser); -} - - /* ** get_type_and_value() and get_type() will succeed to retrieve "variables" ** that we do not want to send to the user; "variables" beginning with @@ -377,23 +352,32 @@ MR_trace_write_variable(Word type_info, Word value) */ bool -MR_trace_get_type_and_value_filtered(const MR_Stack_Layout_Var *var, - const char *name, - Word *type_info, Word *value) +MR_get_type_and_value_filtered(const MR_Stack_Layout_Var *var, + Word *saved_regs, const char *name, Word *type_info, Word *value) { return ((strncmp(name, "TypeInfo", 8) != 0) && (strncmp(name, "ModuleInfo", 10) != 0) && (strncmp(name, "HLDS", 4) != 0) - && MR_trace_get_type_and_value(var, NULL, type_info, value)); + && MR_get_type_and_value(var, saved_regs, NULL, + type_info, value)); } bool -MR_trace_get_type_filtered(const MR_Stack_Layout_Var *var, - const char *name, Word *type_info) +MR_get_type_filtered(const MR_Stack_Layout_Var *var, Word *saved_regs, + const char *name, Word *type_info) { return ((strncmp(name, "TypeInfo", 8) != 0) && (strncmp(name, "ModuleInfo", 10) != 0) && (strncmp(name, "HLDS", 4) != 0) - && MR_trace_get_type(var, NULL, type_info)); + && MR_get_type(var, saved_regs, NULL, type_info)); +} + +void +MR_write_variable(Word type_info, Word value) +{ + Word stdout_stream; + + (*MR_io_stdout_stream)(&stdout_stream); + (*MR_io_print_to_stream)(type_info, stdout_stream, value); } diff --git a/runtime/mercury_stack_layout.h b/runtime/mercury_stack_layout.h index 8f16c3056..9aced55ae 100644 --- a/runtime/mercury_stack_layout.h +++ b/runtime/mercury_stack_layout.h @@ -9,7 +9,7 @@ /* ** mercury_stack_layout.h - -** Definitions for the stack layout data structures. +** Definitions for the stack layout data structures. ** ** NOTE: The constants and data-structures used here need to be kept in ** sync with the ones generated in the compiler. If you change anything here, @@ -70,7 +70,7 @@ typedef Word MR_Determinism; ** - stack slots, registers, and special lvals such as succip, hp, ** etc. ** -** MR_Live_Lval is encoded using an 8 bit low tag, the rest of the word is a +** MR_Live_Lval is encoded using an 8 bit low tag, the rest of the word is a ** data field describing which stack slot number or register number. ** ** Lval Tag Rest @@ -93,7 +93,7 @@ typedef Word MR_Determinism; typedef Word MR_Live_Lval; -typedef enum { +typedef enum { MR_LVAL_TYPE_R, MR_LVAL_TYPE_F, MR_LVAL_TYPE_STACKVAR, @@ -103,7 +103,7 @@ typedef enum { MR_LVAL_TYPE_CURFR, MR_LVAL_TYPE_HP, MR_LVAL_TYPE_SP, - MR_LVAL_TYPE_UNKNOWN + MR_LVAL_TYPE_UNKNOWN } MR_Lval_Type; #define MR_LIVE_LVAL_TAGBITS 8 @@ -126,7 +126,7 @@ typedef enum { ** ** The data is encoded such that low values (less than ** TYPELAYOUT_MAX_VARINT) represent succip, hp, etc. Higher values -** represent data variables, and are pointers to a 2 word cell, +** represent data variables, and are pointers to a 2 word cell, ** containing a pseudo type_info and an instantiation represention. ** ** This data is generated in compiler/stack_layout.m, which must be kept @@ -135,16 +135,16 @@ typedef enum { typedef Word MR_Live_Type; -typedef enum { +typedef enum { MR_LIVE_TYPE_SUCCIP, MR_LIVE_TYPE_HP, MR_LIVE_TYPE_CURFR, MR_LIVE_TYPE_MAXFR, MR_LIVE_TYPE_REDOIP, - MR_LIVE_TYPE_UNWANTED + MR_LIVE_TYPE_UNWANTED } MR_Lval_NonVar; -typedef struct { +typedef struct { Word *pseudo_type_info; Word inst; /* not yet used; currently always -1 */ } MR_Var_Shape_Info; @@ -189,10 +189,16 @@ typedef struct MR_Stack_Layout_Vars_Struct { MR_Live_Lval *MR_slvs_tvars; } MR_Stack_Layout_Vars; -#define MR_name_if_present(vars, i) \ - ((vars->MR_slvs_names != NULL \ - && vars->MR_slvs_names[(i)] != NULL) \ - ? vars->MR_slvs_names[(i)] \ +#define MR_name_if_present(vars, i) \ + ((vars->MR_slvs_names != NULL \ + && vars->MR_slvs_names[(i)] != NULL) \ + ? strchr(vars->MR_slvs_names[(i)], ':') + 1 \ + : "") + +#define MR_numbered_name_if_present(vars, i) \ + ((vars->MR_slvs_names != NULL \ + && vars->MR_slvs_names[(i)] != NULL) \ + ? vars->MR_slvs_names[(i)] \ : "") /*-------------------------------------------------------------------------*/ @@ -222,6 +228,12 @@ typedef struct MR_Stack_Layout_Vars_Struct { ** if MR_ENTRY_LAYOUT_HAS_PROC_ID(entry) evaluates to true. ** Group (3) is present and meaningful ** if MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry) evaluates to true. +** +** Group (2) fields have a different interpretation if the procedure is +** compiler-generated. You can test for this via the macro +** MR_ENTRY_LAYOUT_COMPILER_GENERATED. +** +** For further details on the semantics of the fields, see stack_layout.m. */ typedef struct MR_Stack_Layout_Entry_Struct { @@ -242,15 +254,19 @@ typedef struct MR_Stack_Layout_Entry_Struct { /* exec trace group */ struct MR_Stack_Layout_Label_Struct *MR_sle_call_label; + int MR_sle_maybe_from_full; } MR_Stack_Layout_Entry; #define MR_ENTRY_LAYOUT_HAS_PROC_ID(entry) \ - ((int) entry->MR_sle_pred_or_func >= 0) + ((Word) entry->MR_sle_pred_or_func != -1) #define MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry) \ (MR_ENTRY_LAYOUT_HAS_PROC_ID(entry) \ && entry->MR_sle_call_label != NULL) +#define MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry) \ + ((Unsigned) entry->MR_sle_pred_or_func > MR_FUNCTION) + /* ** Define a stack layout for a label that you know very little about. ** It is just a generic entry label, no useful information, except @@ -276,6 +292,44 @@ typedef struct MR_Stack_Layout_Entry_Struct { #define MR_MAKE_STACK_LAYOUT_ENTRY(l) #endif /* MR_USE_STACK_LAYOUTS */ +/* +** In procedures compiled with execution tracing, three items are stored +** in stack slots with fixed numbers. They are: +** +** the event number of the call event, +** the call number, and +** the call depth. +** +** The following macros will access them. They can be used whenever +** MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry) is true; which set you should use +** depends on the determinism of the procedure. +** +** These macros have to be kept in sync with compiler/trace.m. +*/ + +#define MR_event_num_framevar(base_curfr) MR_based_framevar(base_curfr, 1) +#define MR_call_num_framevar(base_curfr) MR_based_framevar(base_curfr, 2) +#define MR_call_depth_framevar(base_curfr) MR_based_framevar(base_curfr, 3) + +#define MR_event_num_stackvar(base_sp) MR_based_stackvar(base_sp, 1) +#define MR_call_num_stackvar(base_sp) MR_based_stackvar(base_sp, 2) +#define MR_call_depth_stackvar(base_sp) MR_based_stackvar(base_sp, 3) + +/* +** In model_non procedures compiled with an execution trace options that +** require REDO events, one other item is stored in a fixed stack slot. +** This is +** +** the address of the layout structure for the redo event +** +** The following macro will access it. This macro should be used only from +** within the code that calls MR_trace for the REDO event. +** +** This macros have to be kept in sync with compiler/trace.m. +*/ + +#define MR_redo_layout_framevar(base_curfr) MR_based_framevar(base_curfr, 4) + /*-------------------------------------------------------------------------*/ /* ** Definitions for MR_Stack_Layout_Label diff --git a/runtime/mercury_trace_util.h b/runtime/mercury_trace_util.h deleted file mode 100644 index 74b7ebd92..000000000 --- a/runtime/mercury_trace_util.h +++ /dev/null @@ -1,48 +0,0 @@ -/* -** Copyright (C) 1998 The University of Melbourne. -** This file may only be copied under the terms of the GNU Library General -** Public License - see the file COPYING.LIB in the Mercury distribution. -*/ - -#ifndef MERCURY_TRACE_UTIL_H -#define MERCURY_TRACE_UTIL_H - -extern Word MR_saved_regs[MAX_FAKE_REG]; -extern void MR_copy_regs_to_saved_regs(int max_mr_num); -extern void MR_copy_saved_regs_to_regs(int max_mr_num); - -extern Word *MR_trace_materialize_typeinfos(const MR_Stack_Layout_Vars - *vars); -extern Word *MR_trace_materialize_typeinfos_base(const MR_Stack_Layout_Vars - *vars, bool saved_regs_valid, - Word *base_sp, Word *base_curfr); - -extern Word MR_trace_make_var_list(const MR_Stack_Layout_Label *layout); -extern Word MR_trace_lookup_live_lval(MR_Live_Lval locn, bool *succeeded); -extern Word MR_trace_lookup_live_lval_base(MR_Live_Lval locn, - bool saved_regs_valid, Word *base_sp, Word *base_curfr, - bool *succeeded); -extern bool MR_trace_get_type_and_value(const MR_Stack_Layout_Var *var, - Word *type_params, Word *type_info, Word *value); -extern bool MR_trace_get_type_and_value_base(const MR_Stack_Layout_Var *var, - bool saved_regs_valid, Word *base_sp, Word *base_curfr, - Word *type_params, Word *type_info, Word *value); -extern bool MR_trace_get_type(const MR_Stack_Layout_Var *var, - Word *type_params, Word *type_info); -extern bool MR_trace_get_type_base(const MR_Stack_Layout_Var *var, - bool saved_regs_valid, Word *base_sp, Word *base_curfr, - Word *type_params, Word *type_info); -extern bool MR_trace_get_type_and_value_filtered( - const MR_Stack_Layout_Var *var, const char *name, - Word *type_info, Word *value); -extern bool MR_trace_get_type_filtered(const MR_Stack_Layout_Var *var, - const char *name, Word *type_info); - - -/* -** MR_trace_write_variable: -** Write a variable to stdout. -*/ -extern void MR_trace_write_variable(Word type_info, Word value); - -#endif /* MERCURY_TRACE_UTIL_H */ diff --git a/runtime/mercury_wrapper.c b/runtime/mercury_wrapper.c index 1672bf95c..f2b2ef968 100644 --- a/runtime/mercury_wrapper.c +++ b/runtime/mercury_wrapper.c @@ -138,8 +138,13 @@ void (*MR_library_initializer)(void); /* normally ML_io_init_state (io__init_state/2)*/ void (*MR_library_finalizer)(void); /* normally ML_io_finalize_state (io__finalize_state/2) */ -Code *MR_library_trace_browser; - /* normally mercury__io__print_3_0 (io__print/3) */ + +void (*MR_io_stderr_stream)(Word *); +void (*MR_io_stdout_stream)(Word *); +void (*MR_io_stdin_stream)(Word *); +void (*MR_io_print_to_cur_stream)(Word, Word); +void (*MR_io_print_to_stream)(Word, Word, Word); + void (*MR_DI_output_current_ptr)(Integer, Integer, Integer, Word, String, String, Integer, Integer, Integer, Word, String, Word, Word); /* normally ML_DI_output_current (output_current/13) */ @@ -148,8 +153,17 @@ bool (*MR_DI_found_match)(Integer, Integer, Integer, Word, String, String, /* normally ML_DI_found_match (output_current/12) */ void (*MR_DI_read_request_from_socket)(Word, Word *, Integer *); -void (*MR_trace_func_ptr)(const MR_Stack_Layout_Label *, MR_trace_port, - Word, Word, const char *, int); +/* +** This variable has been replaced by MR_io_print_to_*_stream, +** but the installed mkinit executable may still generate references to it. +** We must therefore keep it until all obsolete mkinit executables have +** been retired. +*/ + +Code *MR_library_trace_browser; + +Code *(*MR_trace_func_ptr)(const MR_Stack_Layout_Label *, MR_Trace_Port, + Unsigned, Unsigned, const char *, int); #ifdef USE_GCC_NONLOCAL_GOTOS diff --git a/scripts/Mmakefile b/scripts/Mmakefile index 933615fa5..6ad93a556 100644 --- a/scripts/Mmakefile +++ b/scripts/Mmakefile @@ -17,6 +17,7 @@ include $(MERCURY_DIR)/Mmake.common SCRIPTS = mmake mmc mdb c2init mgnuc ml mprof mprof_merge_runs \ sicstus_conv mtags vpath_find mercury_update_interface \ mkfifo_using_mknod +DEBUGGER_SCRIPTS = mdbrc NUPROLOG_SCRIPTS = mnc mnl mnp SICSTUS_SCRIPTS = msc msl msp @@ -32,16 +33,20 @@ SICSTUS_SCRIPTS = msc msl msp #-----------------------------------------------------------------------------# .PHONY: all -all: $(SCRIPTS) $(NUPROLOG_SCRIPTS) $(SICSTUS_SCRIPTS) Mmake.vars +all: $(SCRIPTS) $(DEBUGGER_SCRIPTS) +all: $(NUPROLOG_SCRIPTS) $(SICSTUS_SCRIPTS) Mmake.vars #-----------------------------------------------------------------------------# -ml mgnuc: init_grade_options.sh-subr parse_grade_options.sh-subr +ml mgnuc: init_grade_options.sh-subr +ml mgnuc: parse_grade_options.sh-subr +ml mgnuc: final_grade_options.sh-subr #-----------------------------------------------------------------------------# .PHONY: install -install: install_mmake install_scripts $(INSTALL_NUPROLOG) $(INSTALL_SICSTUS) +install: install_mmake install_scripts install_debugger_scripts +install: $(INSTALL_NUPROLOG) $(INSTALL_SICSTUS) .PHONY: install_mmake install_mmake: Mmake.vars Mmake.rules @@ -57,6 +62,11 @@ install_scripts: $(SCRIPTS) chmod u+w $(INSTALL_BINDIR)/$$file ;\ done +.PHONY: install_debugger_scripts +install_debugger_scripts: $(DEBUGGER_SCRIPTS) + [ -d $(INSTALL_LIBDIR/mdb) ] || mkdir -p $(INSTALL_LIBDIR/mdb) + cp $(DEBUGGER_SCRIPTS) $(INSTALL_LIBDIR/mdb) + .PHONY: install_nuprolog install_nuprolog: $(NUPROLOG_SCRIPTS) [ -d $(INSTALL_BINDIR) ] || mkdir -p $(INSTALL_BINDIR) @@ -79,7 +89,8 @@ install_sicstus: $(SICSTUS_SCRIPTS) uninstall: -rm -r $(INSTALL_LIBDIR)/mmake -cd $(INSTALL_BINDIR) && \ - rm $(SCRIPTS) $(SICSTUS_SCRIPTS) $(NUPROLOG_SCRIPTS) + rm $(SCRIPTS) $(SICSTUS_SCRIPTS) $(NUPROLOG_SCRIPTS) + -cd $(INSTALL_LIBDIR/mdb) && rm $(DEBUGGER_SCRIPTS) #-----------------------------------------------------------------------------# diff --git a/scripts/final_grade_options.sh-subr b/scripts/final_grade_options.sh-subr new file mode 100644 index 000000000..39f2f2328 --- /dev/null +++ b/scripts/final_grade_options.sh-subr @@ -0,0 +1,25 @@ +#---------------------------------------------------------------------------# +# Copyright (C) 1998 The University of Melbourne. +# This file may only be copied under the terms of the GNU General +# Public License - see the file COPYING in the Mercury distribution. +#---------------------------------------------------------------------------# +# +# final_grade_options.sh-subr: +# An `sh' subroutine for handling implications between grade-related +# options. Used by the `ml' and `mgnuc' scripts. +# +# The code here should be inserted after a script's option-parsing +# loop. +# +#---------------------------------------------------------------------------# + +# +# .debug grade implies --use-trail +# (see comment in compiler/handle_options.m for rationale) +# +case $stack_trace,$require_tracing in + true,true) + use_trail=true ;; +esac + +#---------------------------------------------------------------------------# diff --git a/scripts/mdb b/scripts/mdb deleted file mode 100755 index f84258575..000000000 --- a/scripts/mdb +++ /dev/null @@ -1,39 +0,0 @@ -#!/bin/sh -#---------------------------------------------------------------------------# -# Copyright (C) 1998 The University of Melbourne. -# This file may only be copied under the terms of the GNU General -# Public License - see the file COPYING in the Mercury distribution. -#---------------------------------------------------------------------------# -# -# IMPORTANT: the manpage is produced automatically from this help -# message, so if you change the help message, don't forget to check -# that the manpage still looks OK. -Help="\ -Name: mdb - Mercury debugger -Usage: mdb []... -Description: - The arguments of this command form a command line. - If the executable named by this command line is a Mercury program - compiled with debugging enabled (e.g. via the \`--debug' option), - or if it invokes such a program, then mdb will cause the program - to be executed under the supervision of the Mercury internal debugger. - Otherwise, mdb will execute the command line as if the mdb prefix - weren't there. -Environment variables: - MERCURY_OPTIONS. -" - -case $# in - 0) echo "Usage: mdb [ ...]" 1>&2 - exit 1;; -esac - -case $1 in - --help) - echo "$Help" - exit 0;; -esac - -MERCURY_OPTIONS="$MERCURY_OPTIONS -Di" -export MERCURY_OPTIONS -exec "$@" diff --git a/tests/debugger/Mmakefile b/tests/debugger/Mmakefile index 96249478d..f96ea4a2a 100644 --- a/tests/debugger/Mmakefile +++ b/tests/debugger/Mmakefile @@ -1,6 +1,6 @@ #-----------------------------------------------------------------------------# -main_target: check +main_target: check include ../Mmake.common @@ -15,9 +15,9 @@ RM_C=: DEBUGGER_PROGS= \ debugger_regs \ interpreter \ -# queens + queens -MCFLAGS = --trace all +MCFLAGS = --trace deep C2INITFLAGS = -t # Base grades `jump' and `fast' cannot be used with @@ -38,7 +38,7 @@ else endif LIBPROGS= $(PROGS:%=%_lib) -ALLPROGS= $(PROGS) $(LIBPROGS) +ALLPROGS= $(PROGS) #-----------------------------------------------------------------------------# @@ -60,14 +60,21 @@ interpreter_lib.out: interpreter_lib interpreter_lib.inp queens_lib.out: queens_lib queens_lib.inp mdb ./queens_lib < queens_lib.inp > queens_lib.out +# We ignore the result of this action because +# the exit status of grep is not useful in this case +mdb_command_test.out: queens mdb_command_test.inp + -mdb ./queens < mdb_command_test.inp \ + | egrep "internal error in the trace help system" \ + > mdb_command_test.out + #-----------------------------------------------------------------------------# DEPS= $(ALLPROGS:%=$(deps_subdir)%.dep) DEPENDS= $(ALLPROGS:%=%.depend) OUTS= $(PROGS:%=%.out) LIBOUTS= $(LIBPROGS:%=%.out) -RESS= $(PROGS:%=%.res) -LIBRESS= $(LIBPROGS:%=%.res) +RESS= $(PROGS:%=%.res) mdb_command_test.res +LIBRESS= $(LIBPROGS:%=%.res) mdb_command_test.res #-----------------------------------------------------------------------------# diff --git a/tests/debugger/debugger_regs.inp b/tests/debugger/debugger_regs.inp index d92a98592..ce291b478 100644 --- a/tests/debugger/debugger_regs.inp +++ b/tests/debugger/debugger_regs.inp @@ -1,4 +1,5 @@ +echo on -p * -c +print * +continue diff --git a/tests/debugger/debugger_regs_lib.inp b/tests/debugger/debugger_regs_lib.inp index d92a98592..ce291b478 100644 --- a/tests/debugger/debugger_regs_lib.inp +++ b/tests/debugger/debugger_regs_lib.inp @@ -1,4 +1,5 @@ +echo on -p * -c +print * +continue diff --git a/tests/debugger/mdb_command_test.exp b/tests/debugger/mdb_command_test.exp new file mode 100644 index 000000000..e69de29bb diff --git a/tests/debugger/queens.inp b/tests/debugger/queens.inp index 0787750d1..ed76dda7a 100644 --- a/tests/debugger/queens.inp +++ b/tests/debugger/queens.inp @@ -1,87 +1,48 @@ -p * +echo on +print * -p * +print * -p * +print * -p * +print * -p * +print * -p * +print * -p * +print * -p * -l 1 -p * -l 2 -v -p * +print * +level 1 +print * +up 1 +vars +print * -p * +print * -p * +print * -p * +print * -p * +print * -p * +print * -p * +print * -p * +goto -a 20 +print * -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * - -p * -C +retry +print * +finish -a +register --quiet +break print_list +break qdelete +continue -a +step -aS 5 +disable 1 +continue -n +continue -n -S diff --git a/tests/hard_coded/typeclasses/Mmakefile b/tests/hard_coded/typeclasses/Mmakefile index 1db5f6b9e..bdc200097 100644 --- a/tests/hard_coded/typeclasses/Mmakefile +++ b/tests/hard_coded/typeclasses/Mmakefile @@ -59,7 +59,7 @@ MCFLAGS-extra_typeinfo = --optimize-higher-order --no-type-specialization \ --typeinfo-liveness MCFLAGS-inference_test = --infer-all MCFLAGS-inference_test_2 = --infer-all -MCFLAGS-existential_type_classes = --infer-all --trace all +MCFLAGS-existential_type_classes = --infer-all --trace deep MCFLAGS-lambda_multi_constraint_same_tvar = --infer-all #-----------------------------------------------------------------------------# diff --git a/trace/mercury_trace_alias.c b/trace/mercury_trace_alias.c new file mode 100644 index 000000000..41f60e950 --- /dev/null +++ b/trace/mercury_trace_alias.c @@ -0,0 +1,149 @@ +/* +** Copyright (C) 1998 The University of Melbourne. +** This file may only be copied under the terms of the GNU Library General +** Public License - see the file COPYING.LIB in the Mercury distribution. +*/ + +/* +** mercury_trace_alias.c - implements the table of aliases for the +** internal debugger. +** +** Author: zs. +*/ + +#include "mercury_imp.h" +#include "mercury_trace_alias.h" +#include "mercury_array_macros.h" + +static MR_Alias *MR_alias_records = NULL; +static int MR_alias_record_max = 0; +static int MR_alias_record_next = 0; + +/* The initial size of the alias table. */ +#define INIT_ALIAS_COUNT 32 + +static void MR_trace_print_alias_num(FILE *fp, int slot); + +void +MR_trace_add_alias(char *name, char **words, int word_count) +{ + bool found; + int slot; + int i; + int count; + + MR_bsearch(MR_alias_record_next, slot, found, + strcmp(MR_alias_records[slot].MR_alias_name, name)); + if (found) { + count = MR_alias_records[slot].MR_alias_word_count; + for (i = 0; i < count; i++) { + free(MR_alias_records[slot].MR_alias_words[i]); + } + + free(MR_alias_records[slot].MR_alias_name); + free(MR_alias_records[slot].MR_alias_words); + } else { + MR_ensure_room_for_next(MR_alias_record, MR_Alias, + INIT_ALIAS_COUNT); + MR_prepare_insert_into_sorted(MR_alias_records, + MR_alias_record_next, slot, + strcmp(MR_alias_records[slot].MR_alias_name, + name)); + } + + MR_alias_records[slot].MR_alias_name = MR_copy_string(name); + MR_alias_records[slot].MR_alias_word_count = word_count; + MR_alias_records[slot].MR_alias_words = checked_malloc(word_count + * sizeof(char *)); + for (i = 0; i < word_count; i++) { + MR_alias_records[slot].MR_alias_words[i] + = MR_copy_string(words[i]); + } +} + +bool +MR_trace_remove_alias(const char *name) +{ + bool found; + int slot; + int i; + int count; + + MR_bsearch(MR_alias_record_next, slot, found, + strcmp(MR_alias_records[slot].MR_alias_name, name)); + if (! found) { + return FALSE; + } else { + count = MR_alias_records[slot].MR_alias_word_count; + for (i = 0; i < count; i++) { + free(MR_alias_records[slot].MR_alias_words[i]); + } + + free(MR_alias_records[slot].MR_alias_name); + free(MR_alias_records[slot].MR_alias_words); + + for (i = slot; i < MR_alias_record_next - 1; i++) { + MR_alias_records[slot] = MR_alias_records[slot+1]; + } + + MR_alias_record_next--; + + return TRUE; + } +} + +bool +MR_trace_lookup_alias(const char *name, + char ***words_ptr, int *word_count_ptr) +{ + bool found; + int slot; + + MR_bsearch(MR_alias_record_next, slot, found, + strcmp(MR_alias_records[slot].MR_alias_name, name)); + if (found) { + *word_count_ptr = MR_alias_records[slot].MR_alias_word_count; + *words_ptr = MR_alias_records[slot].MR_alias_words; + return TRUE; + } else { + return FALSE; + } +} + +void +MR_trace_print_alias(FILE *fp, const char *name) +{ + bool found; + int slot; + + MR_bsearch(MR_alias_record_next, slot, found, + strcmp(MR_alias_records[slot].MR_alias_name, name)); + if (found) { + MR_trace_print_alias_num(fp, slot); + } else { + fprintf(fp, "There is no such alias.\n"); + } +} + +void +MR_trace_print_all_aliases(FILE *fp) +{ + int slot; + + for (slot = 0; slot < MR_alias_record_next; slot++) { + MR_trace_print_alias_num(fp, slot); + } +} + +static void +MR_trace_print_alias_num(FILE *fp, int slot) +{ + int i; + + fprintf(fp, "%-6s => ", MR_alias_records[slot].MR_alias_name); + for (i = 0; i < MR_alias_records[slot].MR_alias_word_count; i++) { + fprintf(fp, " %s", MR_alias_records[slot].MR_alias_words[i]); + } + + fprintf(fp, "\n"); +} diff --git a/trace/mercury_trace_alias.h b/trace/mercury_trace_alias.h new file mode 100644 index 000000000..c27557f90 --- /dev/null +++ b/trace/mercury_trace_alias.h @@ -0,0 +1,67 @@ +/* +** Copyright (C) 1998 The University of Melbourne. +** This file may only be copied under the terms of the GNU Library General +** Public License - see the file COPYING.LIB in the Mercury distribution. +*/ + +/* +** mercury_trace_alias.h +** +** Defines the interface of the alias system for the internal debugger. +*/ + +#ifndef MERCURY_TRACE_ALIAS_H +#define MERCURY_TRACE_ALIAS_H + +#include + +typedef struct { + char *MR_alias_name; + char **MR_alias_words; + int MR_alias_word_count; +} MR_Alias; + +/* +** Add an alias with the given name and expansion to the list. +** The name, the words in the expansion and the array of pointers to the +** expansion will all be copied, so their storage can be released +** when MR_trace_add_alias returns. +** +** Overwrites any previous alias with the same name. +*/ + +extern void MR_trace_add_alias(char *name, char **words, + int word_count); + +/* +** Remove the given alias from the list. Returns FALSE if there is no +** such alias, and TRUE if there was such an alias and the removal was +** successful. +*/ + +extern bool MR_trace_remove_alias(const char *name); + +/* +** Looks up whether the given alias exists. If yes, returns TRUE, and +** sets *words_ptr to point to a vector of words forming the alias expansion, +** and *word_count_ptr to the number of words in the expansion. If no, +** returns FALSE. +*/ + +extern bool MR_trace_lookup_alias(const char *name, + char ***words_ptr, int *word_count_ptr); + +/* +** Print the alias of the given name, if it exists, and an error message +** if it does not. +*/ + +extern void MR_trace_print_alias(FILE *fp, const char *name); + +/* +** Print all the aliases to the given file. +*/ + +extern void MR_trace_print_all_aliases(FILE *fp); + +#endif /* MERCURY_TRACE_ALIAS_H */ diff --git a/trace/mercury_trace_external.h b/trace/mercury_trace_external.h index c02695768..4ef50fe35 100644 --- a/trace/mercury_trace_external.h +++ b/trace/mercury_trace_external.h @@ -11,10 +11,10 @@ extern void MR_trace_init_external(void); extern void MR_trace_final_external(void); -extern void MR_trace_event_external(MR_trace_cmd_info *cmd, +extern void MR_trace_event_external(MR_Trace_Cmd_Info *cmd, const MR_Stack_Layout_Label *layout, - MR_trace_port port, Unsigned seqno, Unsigned depth, - const char *path); + Word *saved_regs, MR_Trace_Port port, Unsigned seqno, + Unsigned depth, const char *path); #endif /* MR_USE_EXTERNAL_DEBUGGER */ diff --git a/trace/mercury_trace_help.h b/trace/mercury_trace_help.h new file mode 100644 index 000000000..4d06ea409 --- /dev/null +++ b/trace/mercury_trace_help.h @@ -0,0 +1,43 @@ +/* +** Copyright (C) 1998 The University of Melbourne. +** This file may only be copied under the terms of the GNU Library General +** Public License - see the file COPYING.LIB in the Mercury distribution. +*/ + +/* +** mercury_trace_help.h +** +** Defines the interface of the help system for the internal debugger. +*/ + +#ifndef MERCURY_TRACE_HELP_H +#define MERCURY_TRACE_HELP_H + +/* +** These function add a help node, which must a category or an item +** within a category. It returns NULL if the addition was successful, +** and a pointer to an error message otherwise. +*/ + +extern const char *MR_trace_add_cat(const char *category, int slot, + const char *text); + +extern const char *MR_trace_add_item(const char *category, + const char *item, int slot, const char *text); + +/* +** These functions print help to standard output. +** +** MR_trace_help prints a list of the top-level help nodes. +** MR_trace_help_word prints the text of all the help nodes with the given +** name. If there are none, it prints a list of the top-level help nodes. +** MR_trace_help_cat_item prints the text of the node at path cat/item. +*/ + +extern void MR_trace_help(void); +extern void MR_trace_help_word(const char *word); + +extern void MR_trace_help_cat_item(const char *cat, + const char *item); + +#endif /* MERCURY_TRACE_HELP_H */ diff --git a/trace/mercury_trace_spy.h b/trace/mercury_trace_spy.h new file mode 100644 index 000000000..cfb952055 --- /dev/null +++ b/trace/mercury_trace_spy.h @@ -0,0 +1,65 @@ +/* +** Copyright (C) 1998 The University of Melbourne. +** This file may only be copied under the terms of the GNU Library General +** Public License - see the file COPYING.LIB in the Mercury distribution. +*/ + +/* +** This file contains the declarations of the types and functions that +** the internal and external debuggers can use to manipulate spy points. +** +** Main author: Zoltan Somogyi. +*/ + +#ifndef MERCURY_TRACE_SPY_H +#define MERCURY_TRACE_SPY_H + +typedef enum { + MR_SPY_PRINT, MR_SPY_STOP +} MR_Spy_Action; + +#define MR_spy_action_string(a) ((a == MR_SPY_STOP) ? "stop" : \ + (a == MR_SPY_PRINT) ? "print" : \ + "unknown spy action") + +typedef enum { + MR_SPY_ALL, MR_SPY_INTERFACE, MR_SPY_ENTRY, MR_SPY_SPECIFIC +} MR_Spy_When; + +#define MR_spy_when_string(w) ((w == MR_SPY_ALL) ? "all" : \ + (w == MR_SPY_INTERFACE) ? "interface":\ + (w == MR_SPY_ENTRY) ? "entry" : \ + (w == MR_SPY_SPECIFIC) ? "specific" : \ + "unknown spy when") + +typedef struct MR_Spy_Point_Struct MR_Spy_Point; + +struct MR_Spy_Point_Struct { + MR_Spy_When spy_when; + bool spy_enabled; + MR_Spy_Action spy_action; + const MR_Stack_Layout_Entry *spy_proc; + const MR_Stack_Layout_Label *spy_label; /* if MR_SPY_SPECIFIC */ + MR_Spy_Point *spy_next; +}; + +/* +** Check whether the event described by the given label layout and port +** matches any spy points. If yes, return TRUE and set *action to say what +** action should be executed for the spy point. +*/ + +extern bool MR_event_matches_spy_point(const MR_Stack_Layout_Label + *layout, MR_Trace_Port port, + MR_Spy_Action *action); + +/* +** Add a new spy point to the table. +*/ + +extern MR_Spy_Point *MR_add_spy_point(MR_Spy_When when, + MR_Spy_Action action, + const MR_Stack_Layout_Entry *entry, + const MR_Stack_Layout_Label *label); + +#endif /* not MERCURY_TRACE_SPY_H */