[m-dev.] for review: procedure bodies for the declarative debugger
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Sep 25 13:05:34 AEDT 2000
Note that this change puts a *lot* of static data into executables compiled
with declarative debugging; the output of size -A for the compiler itself is
stage2/compiler/mercury_compile :
section size addr
.init 49 134512820
.text 14729836 134512880
.fini 28 149242716
.rodata 25888588 149242752
__libc_atexit 4 175131340
__libc_subfreeres 36 175131344
__libc_subinit 12 175131380
.data 91932 175135488
.eh_frame 544 175227420
.ctors 8 175227964
.dtors 8 175227972
.got 356 175227980
.bss 47484 175228352
.comment 27683 0
.note.ABI-tag 32 134512788
.note 11780 175275836
.gnu.warning.llseek 63 175275840
Total 40798443
In addition, the stage 2 compiler takes five hours to build on traveller.
The culprit is not the Mercury compiler, but gcc; it takes more than half an
hour to compile one file. Granted, that file (rl_code.c) is 12.4 megabytes
in size (415,649 lines), but that is still excessive. I will look into the
cause of this later. However, Mark should still find this change useful,
and it doesn't harm anyone, since declarative debugging is not yet useful
on the compiler itself.
------------------------------------------------------
Make procedure bodies available to the declarative debugger.
browser/program_representation.m:
Add _rep suffixes to the function symbols, to make iit easier to
distinguish HLDS goals and goal representations.
compiler/static_layout.m:
If --trace-decl is specified, include a representation of the procedure
body in the procedure's layout structure.
compiler/prog_rep.m:
A new module, containing the code that converts goals from HLDS
to a term in the format we want to put in the layout structure.
compiler/static_term.m:
A new module, containing the code that converts Mercury terms
to the LLDS rval we need to give to llds_out.m.
compiler/code_gen.m:
compiler/continuation_info.m:
Preserve the information needed by prog_rep
compiler/Mmakefile:
Extend the search path to the browser directory, since the new file
prog_rep.m imports one of the submodules of mdb.m stored there.
library/std_util.m:
Add a mechanism for static_term.m to use in converting terms into
rvals. This mechanism uses RTTI information to desconstruct terms,
and return not only their arguments, but also information about how
the term can be constructed from its arguments.
runtime/mercury_type_info.h:
Add a couple of macros to make construction and deconstruction of univs
easier, for use in std_util.m.
trace/mercury_trace_internal.m:
Add a new command, "proc_body", that prints out the representation
of the body of the current procedure. This is meant only for developers
to use to check that the procedure body representation is OK; it is
deliberately not documented.
Also fix a bug: make sure that we do not pass a NULL pointer to fputs
when echoing a line of input that isn't there (because we got EOF).
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
Index: browser/program_representation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/program_representation.m,v
retrieving revision 1.1
diff -u -r1.1 program_representation.m
--- browser/program_representation.m 2000/09/01 09:13:46 1.1
+++ browser/program_representation.m 2000/09/24 04:29:03
@@ -7,8 +7,8 @@
% File: program_representation.m
% Authors: zs, dougl
%
-% This module defines the representation of procedure bodies used by
-% the declarative debugger.
+% This module defines the representation of procedure bodies
+% used by the declarative debugger.
%
% One of the things we want the declarative debugger to be able to do
% is to let the user specify which part of which output argument of an
@@ -27,6 +27,8 @@
% The current representation is intended to contain all the information
% we are pretty sure can be usefully exploited by the declarative debugger.
+%-----------------------------------------------------------------------------%
+
:- module mdb__program_representation.
:- interface.
@@ -41,27 +43,30 @@
% goal_reps, which are stored in reversed order.
:- type goal_rep
- ---> conj(
+ ---> conj_rep(
list(goal_rep) % The conjuncts in reverse
% order.
)
- ; disj(
+ ; disj_rep(
list(goal_rep) % The disjuncts in the original
% order.
)
- ; switch(
+ ; switch_rep(
list(goal_rep) % The switch arms in the
% original order.
)
- ; ite(
+ ; ite_rep(
goal_rep, % Condition.
goal_rep, % Then branch.
goal_rep % Else branch.
)
- ; negation(
+ ; negation_rep(
goal_rep % The negated goal.
+ )
+ ; some_rep(
+ goal_rep % The quantified goal.
)
- ; atomic_goal(
+ ; atomic_goal_rep(
detism_rep,
string, % Filename of context.
int, % Line number of context.
@@ -72,47 +77,54 @@
).
:- type atomic_goal_rep
- ---> unify_construct(
+ ---> unify_construct_rep(
var_rep,
+ cons_id_rep,
list(var_rep)
)
- ; unify_deconstruct(
+ ; unify_deconstruct_rep(
var_rep,
+ cons_id_rep,
list(var_rep)
)
- ; unify_assign(
- var_rep,
- var_rep
+ ; unify_assign_rep(
+ var_rep, % target
+ var_rep % source
)
- ; unify_simple_test(
+ ; unify_simple_test_rep(
var_rep,
var_rep
- )
- ; pragma_c_code(
- list(var_rep)
- )
- ; higher_order_call(
- var_rep,
- list(var_rep)
)
- ; method_call(
- var_rep,
- int,
- list(var_rep)
+ ; pragma_foreign_code_rep(
+ list(var_rep) % arguments
)
- ; plain_call(
- string,
- list(var_rep)
+ ; higher_order_call_rep(
+ var_rep, % the closure to call
+ list(var_rep) % arguments
+ )
+ ; method_call_rep(
+ var_rep, % typeclass info var
+ int, % method number
+ list(var_rep) % arguments
+ )
+ ; plain_call_rep(
+ string, % name of called pred
+ list(var_rep) % arguments
).
:- type var_rep == int.
+:- type cons_id_rep == string.
+
:- type detism_rep
- ---> det
- ; semidet
- ; nondet
- ; multidet
- ; cc_nondet
- ; cc_multidet
- ; erroneous
- ; failure.
+ ---> det_rep
+ ; semidet_rep
+ ; nondet_rep
+ ; multidet_rep
+ ; cc_nondet_rep
+ ; cc_multidet_rep
+ ; erroneous_rep
+ ; failure_rep.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Mmakefile,v
retrieving revision 1.29
diff -u -r1.29 Mmakefile
--- compiler/Mmakefile 2000/08/17 05:31:03 1.29
+++ compiler/Mmakefile 2000/09/07 05:56:50
@@ -11,7 +11,7 @@
MAIN_TARGET=mercury
-VPATH=$(LIBRARY_DIR)
+VPATH=$(LIBRARY_DIR) $(BROWSER_DIR)
#-----------------------------------------------------------------------------#
@@ -27,14 +27,15 @@
-I$(BOEHM_GC_DIR) \
-I$(BOEHM_GC_DIR)/include \
"
-MCD = $(M_ENV) $(MC) --generate-dependencies
-MCI = $(M_ENV) $(MC) --make-interface
-MCPI = $(M_ENV) $(MC) --make-private-interface
-MCSI = $(M_ENV) $(MC) --make-short-interface
-MCOI = $(M_ENV) $(MC) --make-optimization-interface
-MCTOI = $(M_ENV) $(MC) --make-transitive-optimization-interface
-MCG = $(M_ENV) $(MC) --compile-to-c
-MCS = $(M_ENV) $(MC) --split-c-files -c --cflags "$(ALL_CFLAGS)"
+SMC = $(MC) --search-directory $(BROWSER_DIR)
+MCD = $(M_ENV) $(SMC) --generate-dependencies
+MCI = $(M_ENV) $(SMC) --make-interface
+MCPI = $(M_ENV) $(SMC) --make-private-interface
+MCSI = $(M_ENV) $(SMC) --make-short-interface
+MCOI = $(M_ENV) $(SMC) --make-optimization-interface
+MCTOI = $(M_ENV) $(SMC) --make-transitive-optimization-interface
+MCG = $(M_ENV) $(SMC) --compile-to-c
+MCS = $(M_ENV) $(SMC) --split-c-files -c --cflags "$(ALL_CFLAGS)"
MGNUC = $(M_ENV) $(SCRIPTS_DIR)/mgnuc
C2INIT = MERCURY_MOD_LIB_MODS="$(BROWSER_DIR)/$(BROWSER_LIB_NAME).init $(LIBRARY_DIR)/$(STD_LIB_NAME).init $(RUNTIME_DIR)/$(RT_LIB_NAME).init" \
MERCURY_MKINIT=$(UTIL_DIR)/mkinit $(SCRIPTS_DIR)/c2init
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.82
diff -u -r1.82 code_gen.m
--- compiler/code_gen.m 2000/09/22 05:59:41 1.82
+++ compiler/code_gen.m 2000/09/23 01:42:46
@@ -233,7 +233,7 @@
),
module_info_globals(ModuleInfo, Globals),
continuation_info__basic_stack_layout_for_proc(PredInfo, Globals,
- BasicStackLayout, ForceProcId),
+ BasicStackLayout, ForceProcId),
( BasicStackLayout = yes ->
SaveSuccip = yes
;
@@ -282,10 +282,12 @@
code_info__get_layout_info(InternalMap, CodeInfo, _),
code_util__make_local_entry_label(ModuleInfo, PredId, ProcId,
no, EntryLabel),
+ proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap0),
proc_info_varset(ProcInfo, VarSet),
ProcLayout = proc_layout_info(EntryLabel, Detism, TotalSlots,
MaybeSuccipSlot, MaybeTraceCallLabel, MaxTraceReg,
- TraceSlotInfo, ForceProcId, VarSet, InternalMap),
+ Goal, InstMap0, TraceSlotInfo, ForceProcId,
+ VarSet, InternalMap),
global_data_add_new_proc_layout(GlobalData0,
proc(PredId, ProcId), ProcLayout, GlobalData1)
;
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.35
diff -u -r1.35 continuation_info.m
--- compiler/continuation_info.m 2000/09/22 05:59:43 1.35
+++ compiler/continuation_info.m 2000/09/22 06:08:37
@@ -83,6 +83,10 @@
max_trace_reg :: int,
% Info about the stack slots used
% for tracing.
+ proc_body :: hlds_goal,
+ initial_instmap :: instmap,
+ % The instmap at the start of the
+ % procedure body.
trace_slot_info :: trace_slot_info,
% Do we require the procedure id
% section of the procedure layout
Index: compiler/prog_rep.m
===================================================================
RCS file: prog_rep.m
diff -N prog_rep.m
--- /dev/null Thu Sep 2 15:00:04 1999
+++ prog_rep.m Sun Sep 24 13:08:05 2000
@@ -0,0 +1,239 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2000 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.
+%---------------------------------------------------------------------------%
+%
+% This module generates a representation of HLDS goals for the declarative
+% debugger. Since this representation is to be included in debuggable
+% executables, it should be as compact as possible, and therefore contains
+% only the information required by the declarative debugger. The structure
+% of this representation is defined by browser/program_representation.m.
+%
+% Author: zs.
+%
+%---------------------------------------------------------------------------%
+
+:- module prog_rep.
+
+:- interface.
+
+:- import_module hlds_goal, hlds_module, instmap.
+:- import_module mdb, mdb__program_representation.
+
+:- pred prog_rep__represent_goal(hlds_goal::in, instmap::in, module_info::in,
+ goal_rep::out) is det.
+
+:- implementation.
+
+:- import_module hlds_pred, hlds_data, prog_data.
+:- import_module string, list, set, std_util, require, term.
+
+prog_rep__represent_goal(GoalExpr - GoalInfo, InstMap0, ModuleInfo, Rep) :-
+ prog_rep__represent_goal_expr(GoalExpr, GoalInfo, InstMap0, ModuleInfo,
+ Rep).
+
+:- pred prog_rep__represent_atomic_goal(hlds_goal_info::in,
+ instmap::in, module_info::in, detism_rep::out,
+ string::out, int::out, list(var_rep)::out) is det.
+
+prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+ DetismRep, FilenameRep, LinenoRep, ChangedVarsRep) :-
+ goal_info_get_determinism(GoalInfo, Detism),
+ prog_rep__represent_detism(Detism, DetismRep),
+ goal_info_get_context(GoalInfo, Context),
+ term__context_file(Context, FilenameRep),
+ term__context_line(Context, LinenoRep),
+ goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
+ instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
+ instmap_changed_vars(InstMap0, InstMap, ModuleInfo, ChangedVars),
+ set__to_sorted_list(ChangedVars, ChangedVarsList),
+ list__map(term__var_to_int, ChangedVarsList, ChangedVarsRep).
+
+:- pred prog_rep__represent_detism(determinism::in,
+ detism_rep::out) is det.
+
+prog_rep__represent_detism(det, det_rep).
+prog_rep__represent_detism(semidet, semidet_rep).
+prog_rep__represent_detism(nondet, nondet_rep).
+prog_rep__represent_detism(multidet, multidet_rep).
+prog_rep__represent_detism(cc_nondet, cc_nondet_rep).
+prog_rep__represent_detism(cc_multidet, cc_multidet_rep).
+prog_rep__represent_detism(erroneous, erroneous_rep).
+prog_rep__represent_detism(failure, failure_rep).
+
+:- pred prog_rep__represent_cons_id(cons_id::in,
+ cons_id_rep::out) is det.
+
+prog_rep__represent_cons_id(cons(SymName, _), Rep) :-
+ prog_rep__represent_sym_name(SymName, Rep).
+prog_rep__represent_cons_id(int_const(Int), Rep) :-
+ string__int_to_string(Int, Rep).
+prog_rep__represent_cons_id(float_const(Float), Rep) :-
+ string__float_to_string(Float, Rep).
+prog_rep__represent_cons_id(string_const(String), Rep) :-
+ string__append_list(["""", String, """"], Rep).
+prog_rep__represent_cons_id(pred_const(_, _, _), Rep) :-
+ Rep = "$pred_const".
+prog_rep__represent_cons_id(code_addr_const(_, _), Rep) :-
+ Rep = "$code_addr_const".
+prog_rep__represent_cons_id(type_ctor_info_const(_, _, _), Rep) :-
+ Rep = "$type_ctor_info_const".
+prog_rep__represent_cons_id(base_typeclass_info_const(_, _, _, _), Rep) :-
+ Rep = "$base_typeclass_info_const".
+prog_rep__represent_cons_id(tabling_pointer_const(_, _), Rep) :-
+ Rep = "$tabling_pointer_const".
+
+:- pred prog_rep__represent_sym_name(sym_name::in, string::out) is det.
+
+prog_rep__represent_sym_name(unqualified(String), String).
+prog_rep__represent_sym_name(qualified(_, String), String).
+
+%---------------------------------------------------------------------------%
+
+:- pred prog_rep__represent_goal_expr(hlds_goal_expr::in, hlds_goal_info::in,
+ instmap::in, module_info::in, goal_rep::out) is det.
+
+prog_rep__represent_goal_expr(unify(_, _, _, Uni, _), GoalInfo, InstMap0,
+ ModuleInfo, Rep) :-
+ (
+ Uni = assign(Target, Source),
+ term__var_to_int(Target, TargetRep),
+ term__var_to_int(Source, SourceRep),
+ AtomicGoalRep = unify_assign_rep(TargetRep, SourceRep)
+ ;
+ Uni = construct(Var, ConsId, Args, _, _, _, _),
+ term__var_to_int(Var, VarRep),
+ prog_rep__represent_cons_id(ConsId, ConsIdRep),
+ list__map(term__var_to_int, Args, ArgsRep),
+ AtomicGoalRep = unify_construct_rep(VarRep, ConsIdRep, ArgsRep)
+ ;
+ Uni = deconstruct(Var, ConsId, Args, _, _),
+ term__var_to_int(Var, VarRep),
+ prog_rep__represent_cons_id(ConsId, ConsIdRep),
+ list__map(term__var_to_int, Args, ArgsRep),
+ AtomicGoalRep = unify_deconstruct_rep(VarRep, ConsIdRep,
+ ArgsRep)
+ ;
+ Uni = simple_test(Var1, Var2),
+ term__var_to_int(Var1, Var1Rep),
+ term__var_to_int(Var2, Var2Rep),
+ AtomicGoalRep = unify_simple_test_rep(Var1Rep, Var2Rep)
+ ;
+ Uni = complicated_unify(_, _, _),
+ error("prog_rep__represent_goal_expr: complicated_unify")
+ ),
+ prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+ DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
+ Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep, ChangedVarsRep,
+ AtomicGoalRep).
+prog_rep__represent_goal_expr(conj(Goals), _, InstMap0, ModuleInfo, Rep) :-
+ prog_rep__represent_conj(Goals, InstMap0, ModuleInfo, Reps),
+ list__reverse(Reps, ReverseReps),
+ Rep = conj_rep(ReverseReps).
+prog_rep__represent_goal_expr(par_conj(_, _), _, _, _, _) :-
+ error("Sorry, not yet implemented:\n\
+ parallel conjunctions and declarative debugging").
+prog_rep__represent_goal_expr(disj(Goals, _SM), _, InstMap0, ModuleInfo, Rep)
+ :-
+ prog_rep__represent_disj(Goals, InstMap0, ModuleInfo, DisjReps),
+ Rep = disj_rep(DisjReps).
+prog_rep__represent_goal_expr(not(Goal), _GoalInfo, InstMap0, ModuleInfo, Rep)
+ :-
+ prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, InnerRep),
+ Rep = negation_rep(InnerRep).
+prog_rep__represent_goal_expr(if_then_else(_, Cond, Then, Else, _SM),
+ _, InstMap0, ModuleInfo, Rep) :-
+ prog_rep__represent_goal(Cond, InstMap0, ModuleInfo, CondRep),
+ Cond = _ - CondGoalInfo,
+ goal_info_get_instmap_delta(CondGoalInfo, InstMapDelta),
+ instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
+ prog_rep__represent_goal(Then, InstMap1, ModuleInfo, ThenRep),
+ prog_rep__represent_goal(Else, InstMap0, ModuleInfo, ElseRep),
+ Rep = ite_rep(CondRep, ThenRep, ElseRep).
+prog_rep__represent_goal_expr(switch(_, _, Cases, _SM), _,
+ InstMap0, ModuleInfo, Rep) :-
+ prog_rep__represent_cases(Cases, InstMap0, ModuleInfo, CaseReps),
+ Rep = switch_rep(CaseReps).
+prog_rep__represent_goal_expr(some(_, _, Goal), _, InstMap0, ModuleInfo, Rep)
+ :-
+ prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, InnerRep),
+ Rep = some_rep(InnerRep).
+prog_rep__represent_goal_expr(generic_call(GenericCall, Args, _, _),
+ GoalInfo, InstMap0, ModuleInfo, Rep) :-
+ list__map(term__var_to_int, Args, ArgsRep),
+ (
+ GenericCall = higher_order(PredVar, _, _),
+ term__var_to_int(PredVar, PredVarRep),
+ AtomicGoalRep = higher_order_call_rep(PredVarRep, ArgsRep)
+ ;
+ GenericCall = class_method(Var, MethodNum, _, _),
+ term__var_to_int(Var, VarRep),
+ AtomicGoalRep = method_call_rep(VarRep, MethodNum, ArgsRep)
+ ;
+ GenericCall = aditi_builtin(_, _),
+ error("Sorry, not yet implemented\n\
+ Aditi and declarative debugging")
+ ),
+ prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+ DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
+ Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
+ ChangedVarsRep, AtomicGoalRep).
+prog_rep__represent_goal_expr(call(PredId, _, Args, _, _, _),
+ GoalInfo, InstMap0, ModuleInfo, Rep) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_name(PredInfo, PredName),
+ list__map(term__var_to_int, Args, ArgsRep),
+ AtomicGoalRep = plain_call_rep(PredName, ArgsRep),
+ prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+ DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
+ Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
+ ChangedVarsRep, AtomicGoalRep).
+prog_rep__represent_goal_expr(pragma_foreign_code(_, _,
+ _PredId, _, Args, _, _, _),
+ GoalInfo, InstMap0, ModuleInfo, Rep) :-
+ list__map(term__var_to_int, Args, ArgsRep),
+ AtomicGoalRep = pragma_foreign_code_rep(ArgsRep),
+ prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+ DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
+ Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
+ ChangedVarsRep, AtomicGoalRep).
+prog_rep__represent_goal_expr(bi_implication(_, _), _, _, _, _) :-
+ % these should have been expanded out by now
+ error("prog_rep__represent_goal: unexpected bi_implication").
+
+%---------------------------------------------------------------------------%
+
+:- pred prog_rep__represent_conj(hlds_goals::in, instmap::in, module_info::in,
+ list(goal_rep)::out) is det.
+
+prog_rep__represent_conj([], _, _, []).
+prog_rep__represent_conj([Goal | Goals], InstMap0, ModuleInfo, [Rep | Reps]) :-
+ prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep),
+ Goal = _ - GoalInfo,
+ goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
+ instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
+ prog_rep__represent_conj(Goals, InstMap1, ModuleInfo, Reps).
+
+%---------------------------------------------------------------------------%
+
+:- pred prog_rep__represent_disj(hlds_goals::in, instmap::in, module_info::in,
+ list(goal_rep)::out) is det.
+
+prog_rep__represent_disj([], _, _, []).
+prog_rep__represent_disj([Goal | Goals], InstMap0, ModuleInfo, [Rep | Reps]) :-
+ prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep),
+ prog_rep__represent_disj(Goals, InstMap0, ModuleInfo, Reps).
+
+%---------------------------------------------------------------------------%
+
+:- pred prog_rep__represent_cases(list(case)::in, instmap::in, module_info::in,
+ list(goal_rep)::out) is det.
+
+prog_rep__represent_cases([], _, _, []).
+prog_rep__represent_cases([case(_, Goal) | Cases], InstMap0, ModuleInfo,
+ [Rep | Reps]) :-
+ prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep),
+ prog_rep__represent_cases(Cases, InstMap0, ModuleInfo, Reps).
+
+%---------------------------------------------------------------------------%
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.50
diff -u -r1.50 stack_layout.m
--- compiler/stack_layout.m 2000/09/22 05:59:48 1.50
+++ compiler/stack_layout.m 2000/09/23 22:36:14
@@ -262,7 +262,9 @@
:- implementation.
:- import_module globals, options, llds_out, trace.
-:- import_module hlds_data, hlds_pred, prog_data, prog_util, prog_out.
+:- import_module hlds_data, hlds_goal, hlds_pred.
+:- import_module prog_data, prog_util, prog_out, instmap.
+:- import_module prog_rep, static_term.
:- import_module rtti, ll_pseudo_type_info, (inst), code_util.
:- import_module assoc_list, bool, string, int, require.
:- import_module map, term, set, varset.
@@ -278,8 +280,6 @@
list__filter(stack_layout__valid_proc_layout, ProcLayoutList0,
ProcLayoutList),
- module_info_name(ModuleInfo0, ModuleName),
- module_info_get_cell_counter(ModuleInfo0, CellCounter0),
module_info_globals(ModuleInfo0, Globals),
globals__lookup_bool_option(Globals, agc_stack_layout, AgcLayout),
globals__lookup_bool_option(Globals, trace_stack_layout, TraceLayout),
@@ -292,7 +292,7 @@
map__init(StringMap0),
map__init(LabelTables0),
StringTable0 = string_table(StringMap0, [], 0),
- LayoutInfo0 = stack_layout_info(ModuleName, CellCounter0,
+ LayoutInfo0 = stack_layout_info(ModuleInfo0,
AgcLayout, TraceLayout, ProcIdLayout, TraceDecl,
StaticCodeAddr, [], [], LayoutLabels0, [],
StringTable0, LabelTables0, map__init),
@@ -303,9 +303,12 @@
LayoutInfo2, LayoutInfo3),
% This version of the layout info structure is final in all
% respects except the cell count.
- LayoutInfo3 = stack_layout_info(_, _, _, _, _, _, _, ProcLayouts,
- InternalLayouts, LayoutLabels, ProcLayoutArgs,
- StringTable, LabelTables, _),
+ ProcLayouts = LayoutInfo3 ^ proc_layouts,
+ InternalLayouts = LayoutInfo3 ^ internal_layouts,
+ LayoutLabels = LayoutInfo3 ^ label_set,
+ ProcLayoutArgs = LayoutInfo3 ^ proc_layout_args,
+ StringTable = LayoutInfo3 ^ string_table,
+ LabelTables = LayoutInfo3 ^ label_tables,
StringTable = string_table(_, RevStringList, StringOffset),
list__reverse(RevStringList, StringList),
stack_layout__concat_string_list(StringList, StringOffset,
@@ -314,6 +317,7 @@
( TraceLayout = yes ->
Exported = no, % ignored; see linkage/2 in llds_out.m
list__length(ProcLayoutList, NumProcLayouts),
+ module_info_name(ModuleInfo0, ModuleName),
llds_out__sym_name_mangle(ModuleName, ModuleNameStr),
stack_layout__get_next_cell_number(ProcVectorCellNum,
LayoutInfo3, LayoutInfo4),
@@ -347,8 +351,7 @@
LayoutInfo = LayoutInfo3
),
PossiblyDynamicLayouts = ProcLayouts,
- stack_layout__get_cell_counter(CellCounter, LayoutInfo, _),
- module_info_set_cell_counter(ModuleInfo0, CellCounter, ModuleInfo).
+ stack_layout__get_module_info(ModuleInfo, LayoutInfo, _).
:- pred stack_layout__valid_proc_layout(proc_layout_info::in) is semidet.
@@ -546,7 +549,8 @@
stack_layout__construct_layouts(ProcLayoutInfo) -->
{ ProcLayoutInfo = proc_layout_info(EntryLabel, Detism,
StackSlots, SuccipLoc, MaybeCallLabel, MaxTraceReg,
- TraceSlotInfo, ForceProcIdLayout, VarSet, InternalMap) },
+ Goal, InstMap, TraceSlotInfo, ForceProcIdLayout,
+ VarSet, InternalMap) },
{ map__to_assoc_list(InternalMap, Internals) },
stack_layout__set_cur_proc_named_vars(map__init),
list__foldl(stack_layout__construct_internal_layout(EntryLabel),
@@ -558,7 +562,8 @@
stack_layout__set_label_tables(LabelTables),
stack_layout__construct_proc_layout(EntryLabel, Detism,
StackSlots, SuccipLoc, MaybeCallLabel, MaxTraceReg,
- TraceSlotInfo, ForceProcIdLayout, VarSet, NamedVars).
+ Goal, InstMap, TraceSlotInfo, ForceProcIdLayout,
+ VarSet, NamedVars).
%---------------------------------------------------------------------------%
@@ -653,12 +658,13 @@
:- pred stack_layout__construct_proc_layout(label::in, determinism::in,
int::in, maybe(int)::in, maybe(label)::in, int::in,
- trace_slot_info::in, bool::in, prog_varset::in, map(int, string)::in,
+ hlds_goal::in, instmap::in, trace_slot_info::in, bool::in,
+ prog_varset::in, map(int, string)::in,
stack_layout_info::in, stack_layout_info::out) is det.
stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots,
- MaybeSuccipLoc, MaybeCallLabel, MaxTraceReg, TraceSlotInfo,
- ForceProcIdLayout, VarSet, UsedVarNames) -->
+ MaybeSuccipLoc, MaybeCallLabel, MaxTraceReg, Goal, InstMap,
+ TraceSlotInfo, ForceProcIdLayout, VarSet, UsedVarNames) -->
{
MaybeSuccipLoc = yes(Location0)
->
@@ -721,8 +727,8 @@
{ stack_layout__construct_procid_rvals(ProcLabel, IdRvals,
IdArgTypes) },
stack_layout__construct_trace_layout(MaybeCallLabel,
- MaxTraceReg, TraceSlotInfo, VarSet, UsedVarNames,
- TraceRvals, TraceArgTypes),
+ MaxTraceReg, Goal, InstMap, TraceSlotInfo,
+ VarSet, UsedVarNames, TraceRvals, TraceArgTypes),
{ list__append(IdRvals, TraceRvals, IdTraceRvals) },
{ IdTraceArgTypes = initial(IdArgTypes, TraceArgTypes) }
;
@@ -745,18 +751,37 @@
stack_layout__add_proc_layout_data(CData, CDataName, EntryLabel).
:- pred stack_layout__construct_trace_layout(maybe(label)::in, int::in,
- trace_slot_info::in, prog_varset::in, map(int, string)::in,
+ hlds_goal::in, instmap::in, trace_slot_info::in,
+ prog_varset::in, map(int, string)::in,
list(maybe(rval))::out, create_arg_types::out,
stack_layout_info::in, stack_layout_info::out) is det.
stack_layout__construct_trace_layout(MaybeCallLabel, MaxTraceReg,
- TraceSlotInfo, VarSet, UsedVarNameMap, Rvals, ArgTypes) -->
- stack_layout__get_module_name(ModuleName),
+ Goal, InstMap, TraceSlotInfo, VarSet, UsedVarNameMap,
+ Rvals, ArgTypes) -->
stack_layout__get_trace_stack_layout(TraceLayout),
- stack_layout__construct_var_name_vector(VarSet, UsedVarNameMap,
- VarNameCount, VarNameVector),
- { TraceLayout = yes ->
+ ( { TraceLayout = yes } ->
+ stack_layout__construct_var_name_vector(VarSet, UsedVarNameMap,
+ VarNameCount, VarNameVector),
+ stack_layout__get_trace_decl(TraceDecl),
+ (
+ { TraceDecl = no },
+ { GoalRepRval = yes(const(int_const(0))) }
+ ;
+ { TraceDecl = yes },
+ stack_layout__get_module_info(ModuleInfo0),
+ { prog_rep__represent_goal(Goal, InstMap, ModuleInfo0,
+ GoalRep) },
+ { type_to_univ(GoalRep, GoalRepUniv) },
+ stack_layout__get_cell_counter(CellCounter0),
+ { static_term__term_to_rval(GoalRepUniv, GoalRepRval,
+ CellCounter0, CellCounter) },
+ stack_layout__set_cell_counter(CellCounter)
+ ),
+ stack_layout__get_module_info(ModuleInfo),
+ {
( MaybeCallLabel = yes(CallLabel) ->
+ module_info_name(ModuleInfo, ModuleName),
CallRval = yes(const(data_addr_const(
data_addr(ModuleName,
internal_layout(CallLabel)))))
@@ -765,7 +790,6 @@
),
ModuleRval = yes(const(data_addr_const(
data_addr(ModuleName, module_layout)))),
- ProcRepRval = yes(const(int_const(0))),
MaxTraceRegRval = yes(const(int_const(MaxTraceReg))),
TraceSlotInfo = trace_slot_info(MaybeFromFullSlot,
MaybeDeclSlots, MaybeTrailSlot),
@@ -784,7 +808,7 @@
;
TrailRval = yes(const(int_const(-1)))
),
- Rvals = [CallRval, ModuleRval, ProcRepRval, VarNameVector,
+ Rvals = [CallRval, ModuleRval, GoalRepRval, VarNameVector,
VarNameCount, MaxTraceRegRval,
FromFullRval, TrailRval, DeclRval],
ArgTypes = initial([
@@ -792,11 +816,12 @@
2 - yes(int_least16),
3 - yes(int_least8)],
none)
+ }
;
% Indicate the absence of the trace layout fields.
- Rvals = [yes(const(int_const(0)))],
- ArgTypes = initial([1 - yes(integer)], none)
- }.
+ { Rvals = [yes(const(int_const(0)))] },
+ { ArgTypes = initial([1 - yes(integer)], none) }
+ ).
:- pred stack_layout__construct_var_name_vector(prog_varset::in,
map(int, string)::in, maybe(rval)::out, maybe(rval)::out,
@@ -1719,8 +1744,7 @@
:- type stack_layout_info --->
stack_layout_info(
- module_name :: module_name,
- cell_counter :: counter,
+ module_info :: module_info,
agc_stack_layout :: bool, % generate agc info?
trace_stack_layout :: bool, % generate tracing info?
procid_stack_layout :: bool, % generate proc id info?
@@ -1749,12 +1773,9 @@
% name of that variable.
).
-:- pred stack_layout__get_module_name(module_name::out,
+:- pred stack_layout__get_module_info(module_info::out,
stack_layout_info::in, stack_layout_info::out) is det.
-:- pred stack_layout__get_cell_counter(counter::out,
- stack_layout_info::in, stack_layout_info::out) is det.
-
:- pred stack_layout__get_agc_stack_layout(bool::out,
stack_layout_info::in, stack_layout_info::out) is det.
@@ -1788,8 +1809,7 @@
:- pred stack_layout__get_cur_proc_named_vars(map(int, string)::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__get_module_name(LI ^ module_name, LI, LI).
-stack_layout__get_cell_counter(LI ^ cell_counter, LI, LI).
+stack_layout__get_module_info(LI ^ module_info, LI, LI).
stack_layout__get_agc_stack_layout(LI ^ agc_stack_layout, LI, LI).
stack_layout__get_trace_stack_layout(LI ^ trace_stack_layout, LI, LI).
stack_layout__get_procid_stack_layout(LI ^ procid_stack_layout, LI, LI).
@@ -1802,6 +1822,20 @@
stack_layout__get_label_tables(LI ^ label_tables, LI, LI).
stack_layout__get_cur_proc_named_vars(LI ^ cur_proc_named_vars, LI, LI).
+:- pred stack_layout__get_module_name(module_name::out,
+ stack_layout_info::in, stack_layout_info::out) is det.
+
+stack_layout__get_module_name(ModuleName) -->
+ stack_layout__get_module_info(ModuleInfo),
+ { module_info_name(ModuleInfo, ModuleName) }.
+
+:- pred stack_layout__get_cell_counter(counter::out,
+ stack_layout_info::in, stack_layout_info::out) is det.
+
+stack_layout__get_cell_counter(CellCounter) -->
+ stack_layout__get_module_info(ModuleInfo),
+ { module_info_get_cell_counter(ModuleInfo, CellCounter) }.
+
:- pred stack_layout__add_proc_layout_data(comp_gen_c_data::in, data_name::in,
label::in, stack_layout_info::in, stack_layout_info::out) is det.
@@ -1811,7 +1845,8 @@
ProcLayouts = [NewProcLayout | ProcLayouts0],
LabelSet0 = LI0 ^ label_set,
set_bbbtree__insert(LabelSet0, NewLabel, LabelSet),
- ModuleName = LI0 ^ module_name,
+ ModuleInfo = LI0 ^ module_info,
+ module_info_name(ModuleInfo, ModuleName),
NewProcLayoutArg = yes(const(data_addr_const(
data_addr(ModuleName, NewDataName)))),
ProcLayoutArgs0 = LI0 ^ proc_layout_args,
@@ -1834,14 +1869,23 @@
:- pred stack_layout__get_next_cell_number(int::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__get_next_cell_number(CN, LI0, LI) :-
- C0 = LI0 ^ cell_counter,
- counter__allocate(CN, C0, C),
- LI = LI0 ^ cell_counter := C.
+stack_layout__get_next_cell_number(CellNum) -->
+ stack_layout__get_cell_counter(CellCounter0),
+ { counter__allocate(CellNum, CellCounter0, CellCounter) },
+ stack_layout__set_cell_counter(CellCounter).
:- pred stack_layout__set_cell_counter(counter::in,
stack_layout_info::in, stack_layout_info::out) is det.
+stack_layout__set_cell_counter(CellCounter) -->
+ stack_layout__get_module_info(ModuleInfo0),
+ { module_info_set_cell_counter(ModuleInfo0, CellCounter,
+ ModuleInfo) },
+ stack_layout__set_module_info(ModuleInfo).
+
+:- pred stack_layout__set_module_info(module_info::in,
+ stack_layout_info::in, stack_layout_info::out) is det.
+
:- pred stack_layout__set_string_table(string_table::in,
stack_layout_info::in, stack_layout_info::out) is det.
@@ -1851,7 +1895,7 @@
:- pred stack_layout__set_cur_proc_named_vars(map(int, string)::in,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__set_cell_counter(CC, LI0, LI0 ^ cell_counter := CC).
+stack_layout__set_module_info(MI, LI0, LI0 ^ module_info := MI).
stack_layout__set_string_table(ST, LI0, LI0 ^ string_table := ST).
stack_layout__set_label_tables(LT, LI0, LI0 ^ label_tables := LT).
stack_layout__set_cur_proc_named_vars(NV, LI0,
Index: compiler/static_term.m
===================================================================
RCS file: static_term.m
diff -N static_term.m
--- /dev/null Thu Sep 2 15:00:04 1999
+++ static_term.m Sun Sep 24 02:32:48 2000
@@ -0,0 +1,92 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2000 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.
+%---------------------------------------------------------------------------%
+%
+% File: static_term.m.
+% Author: zs.
+%
+% This module handles the generation of XXX
+%
+%---------------------------------------------------------------------------%
+
+:- module static_term.
+
+:- interface.
+
+:- import_module llds.
+:- import_module counter, std_util.
+
+:- pred static_term__term_to_rval(univ::in, maybe(rval)::out,
+ counter::in, counter::out) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module builtin_ops.
+:- import_module list, require.
+
+static_term__term_to_rval(Univ, Rval, CellCounter0, CellCounter) :-
+ ( std_util__get_functor_info(Univ, FunctorInfo) ->
+ static_term__functor_info_to_rval(FunctorInfo, Rval,
+ CellCounter0, CellCounter)
+ ;
+ error("static_term__term_to_rval: unexpected kind of term")
+ ).
+
+:- pred static_term__functor_info_to_rval(functor_tag_info::in,
+ maybe(rval)::out, counter::in, counter::out) is det.
+
+static_term__functor_info_to_rval(FunctorInfo, MaybeRval,
+ CellCounter0, CellCounter) :-
+ (
+ FunctorInfo = functor_integer(Int),
+ MaybeRval = yes(const(int_const(Int))),
+ CellCounter = CellCounter0
+ ;
+ FunctorInfo = functor_float(Float),
+ MaybeRval = yes(const(float_const(Float))),
+ CellCounter = CellCounter0
+ ;
+ FunctorInfo = functor_string(String),
+ MaybeRval = yes(const(string_const(String))),
+ CellCounter = CellCounter0
+ ;
+ FunctorInfo = functor_enum(Enum),
+ MaybeRval = yes(const(int_const(Enum))),
+ CellCounter = CellCounter0
+ ;
+ FunctorInfo = functor_local(Ptag, Sectag),
+ MaybeRval = yes(mkword(Ptag,
+ unop(mkbody, const(int_const(Sectag))))),
+ CellCounter = CellCounter0
+ ;
+ FunctorInfo = functor_remote(Ptag, Sectag, Args),
+ MaybeSectagRval = yes(const(int_const(Sectag))),
+ list__map_foldl(static_term__term_to_rval,
+ Args, MaybeArgRvals, CellCounter0, CellCounter1),
+ counter__allocate(CNum, CellCounter1, CellCounter),
+ Reuse = no,
+ MaybeRval = yes(create(Ptag, [MaybeSectagRval | MaybeArgRvals],
+ uniform(no), must_be_static, CNum,
+ "static_term", Reuse))
+ ;
+ FunctorInfo = functor_unshared(Ptag, Args),
+ list__map_foldl(static_term__term_to_rval,
+ Args, MaybeArgRvals, CellCounter0, CellCounter1),
+ counter__allocate(CNum, CellCounter1, CellCounter),
+ Reuse = no,
+ MaybeRval = yes(create(Ptag, MaybeArgRvals,
+ uniform(no), must_be_static, CNum,
+ "static_term", Reuse))
+ ;
+ FunctorInfo = functor_notag(Univ),
+ static_term__term_to_rval(Univ, MaybeRval,
+ CellCounter0, CellCounter)
+ ;
+ FunctorInfo = functor_equiv(Univ),
+ static_term__term_to_rval(Univ, MaybeRval,
+ CellCounter0, CellCounter)
+ ).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing library
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.198
diff -u -r1.198 std_util.m
--- library/std_util.m 2000/09/20 03:27:34 1.198
+++ library/std_util.m 2000/09/24 02:45:49
@@ -508,6 +508,24 @@
%
:- pred deconstruct(T::in, string::out, int::out, list(univ)::out) is det.
+:- implementation.
+:- interface.
+
+% The rest of the interface is for use by implementors only.
+
+:- type functor_tag_info
+ ---> functor_integer(int)
+ ; functor_float(float)
+ ; functor_string(string)
+ ; functor_enum(int)
+ ; functor_local(int, int)
+ ; functor_remote(int, int, list(univ))
+ ; functor_unshared(int, list(univ))
+ ; functor_notag(univ)
+ ; functor_equiv(univ).
+
+:- pred get_functor_info(univ::in, functor_tag_info::out) is semidet.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -975,8 +993,10 @@
).
:- pragma c_code(univ_value(Univ::in) = (Value::out), will_not_call_mercury, "
- TypeInfo_for_T = MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO);
- Value = MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_DATA);
+ MR_TypeInfo typeinfo;
+
+ MR_unravel_univ(Univ, typeinfo, Value);
+ TypeInfo_for_T = (Word) typeinfo;
").
:- pragma c_header_code("
@@ -1004,26 +1024,20 @@
% Allocate heap space, set the first field to contain the address
% of the type_info for this type, and then store the input argument
% in the second field.
-:- pragma c_code(type_to_univ(Type::di, Univ::uo), will_not_call_mercury, "
+:- pragma c_code(type_to_univ(Value::di, Univ::uo), will_not_call_mercury, "
incr_hp_msg(Univ, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO)
- = (Word) TypeInfo_for_T;
- MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_DATA)
- = (Word) Type;
+ MR_define_univ_fields(Univ, TypeInfo_for_T, Value);
").
-:- pragma c_code(type_to_univ(Type::in, Univ::out), will_not_call_mercury, "
+:- pragma c_code(type_to_univ(Value::in, Univ::out), will_not_call_mercury, "
incr_hp_msg(Univ, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO)
- = (Word) TypeInfo_for_T;
- MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_DATA)
- = (Word) Type;
+ MR_define_univ_fields(Univ, TypeInfo_for_T, Value);
").
% Backward mode - convert from univ to type.
% We check that type_infos compare equal.
% The variable `TypeInfo_for_T' used in the C code
% is the compiler-introduced type-info variable.
-:- pragma c_code(type_to_univ(Type::out, Univ::in), will_not_call_mercury, "{
+:- pragma c_code(type_to_univ(Value::out, Univ::in), will_not_call_mercury, "{
Word univ_type_info;
int comp;
@@ -1033,7 +1047,7 @@
(MR_TypeInfo) TypeInfo_for_T);
restore_transient_registers();
if (comp == MR_COMPARE_EQUAL) {
- Type = MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_DATA);
+ Value = MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_DATA);
SUCCESS_INDICATOR = TRUE;
} else {
SUCCESS_INDICATOR = FALSE;
@@ -1925,7 +1939,7 @@
for (i = 0; i < arity; i++) {
MR_field(MR_mktag(0), new_data, i) =
MR_field(MR_mktag(0), MR_list_head(arg_list),
- UNIV_OFFSET_FOR_DATA);
+ UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
@@ -1946,10 +1960,7 @@
*/
incr_hp_msg(Term, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_field(MR_mktag(0), Term, UNIV_OFFSET_FOR_TYPEINFO) =
- (Word) type_info;
- MR_field(MR_mktag(0), Term, UNIV_OFFSET_FOR_DATA) =
- (Word) new_data;
+ MR_define_univ_fields(Term, type_info, new_data);
}
SUCCESS_INDICATOR = success;
@@ -1998,9 +2009,7 @@
** Create a univ.
*/
incr_hp_msg(Term, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_field(MR_mktag(0), Term, UNIV_OFFSET_FOR_TYPEINFO) =
- (Word) type_info;
- MR_field(MR_mktag(0), Term, UNIV_OFFSET_FOR_DATA) = new_data;
+ MR_define_univ_fields(Term, type_info, new_data);
}
").
@@ -3164,12 +3173,8 @@
if (success) {
/* Allocate enough room for a univ */
- incr_hp_msg(ArgumentUniv, 2, MR_PROC_LABEL,
- ""std_util:univ/0"");
- MR_field(MR_mktag(0), ArgumentUniv, UNIV_OFFSET_FOR_TYPEINFO) =
- (Word) arg_type_info;
- MR_field(MR_mktag(0), ArgumentUniv, UNIV_OFFSET_FOR_DATA)
- = *argument_ptr;
+ incr_hp_msg(ArgumentUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
+ MR_define_univ_fields(ArgumentUniv, arg_type_info, *argument_ptr);
}
SUCCESS_INDICATOR = success;
@@ -3242,12 +3247,10 @@
/* Create an argument on the heap */
incr_hp_msg(Argument, 2, MR_PROC_LABEL, ""std_util:univ/0"");
+ MR_define_univ_fields(Argument,
+ expand_info.arg_type_infos[i],
+ expand_info.arg_values[i + expand_info.num_extra_args]);
- MR_field(MR_mktag(0), Argument, UNIV_OFFSET_FOR_TYPEINFO) =
- (Word) expand_info.arg_type_infos[i];
- MR_field(MR_mktag(0), Argument, UNIV_OFFSET_FOR_DATA) =
- expand_info.arg_values[i + expand_info.num_extra_args];
-
/* Join the argument to the front of the list */
Arguments = MR_list_cons_msg(Argument, Arguments, MR_PROC_LABEL);
}
@@ -3259,6 +3262,219 @@
if (expand_info.can_free_arg_type_infos) {
MR_GC_free(expand_info.arg_type_infos);
+ }
+}").
+
+get_functor_info(Univ, FunctorInfo) :-
+ ( univ_to_type(Univ, Int) ->
+ FunctorInfo = functor_integer(Int)
+ ; univ_to_type(Univ, Float) ->
+ FunctorInfo = functor_float(Float)
+ ; univ_to_type(Univ, String) ->
+ FunctorInfo = functor_string(String)
+ ; get_enum_functor_info(Univ, Enum) ->
+ FunctorInfo = functor_enum(Enum)
+ ; get_du_functor_info(Univ, Where, Ptag, Sectag, Args) ->
+ ( Where = 0 ->
+ FunctorInfo = functor_unshared(Ptag, Args)
+ ; Where > 0 ->
+ FunctorInfo = functor_remote(Ptag, Sectag, Args)
+ ;
+ FunctorInfo = functor_local(Ptag, Sectag)
+ )
+ ; get_notag_functor_info(Univ, ExpUniv) ->
+ FunctorInfo = functor_notag(ExpUniv)
+ ; get_equiv_functor_info(Univ, ExpUniv) ->
+ FunctorInfo = functor_equiv(ExpUniv)
+ ;
+ fail
+ ).
+
+:- pred get_notag_functor_info(Univ::in, ExpUniv::out) is semidet.
+
+:- pragma c_code(get_notag_functor_info(Univ::in, ExpUniv::out),
+ will_not_call_mercury, "
+{
+ MR_TypeInfo type_info;
+ MR_TypeInfo exp_type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ MR_NotagFunctorDesc *functor_desc;
+ Word value;
+
+ MR_unravel_univ(Univ, type_info, value);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ switch (type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_NOTAG:
+ case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ functor_desc = type_ctor_info->type_functors.functors_notag;
+ exp_type_info = MR_pseudo_type_info_is_ground(
+ functor_desc->MR_notag_functor_arg_type);
+ incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
+ MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ SUCCESS_INDICATOR = TRUE;
+ break;
+
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+ functor_desc = type_ctor_info->type_functors.functors_notag;
+ exp_type_info = MR_create_type_info(
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ functor_desc->MR_notag_functor_arg_type);
+ incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
+ MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ SUCCESS_INDICATOR = TRUE;
+ break;
+
+ default:
+ SUCCESS_INDICATOR = FALSE;
+ break;
+ }
+}").
+
+:- pred get_equiv_functor_info(Univ::in, ExpUniv::out) is semidet.
+
+:- pragma c_code(get_equiv_functor_info(Univ::in, ExpUniv::out),
+ will_not_call_mercury, "
+{
+ MR_TypeInfo type_info;
+ MR_TypeInfo exp_type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ Word value;
+
+ MR_unravel_univ(Univ, type_info, value);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ switch (type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_EQUIV:
+ exp_type_info = MR_pseudo_type_info_is_ground(
+ type_ctor_info->type_layout.layout_equiv);
+ incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
+ MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ SUCCESS_INDICATOR = TRUE;
+ break;
+
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
+ exp_type_info = MR_create_type_info(
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ type_ctor_info->type_layout.layout_equiv);
+ incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
+ MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ SUCCESS_INDICATOR = TRUE;
+ break;
+
+ default:
+ SUCCESS_INDICATOR = FALSE;
+ break;
+ }
+}").
+
+:- pred get_enum_functor_info(Univ::in, Int::out) is semidet.
+
+:- pragma c_code(get_enum_functor_info(Univ::in, Enum::out),
+ will_not_call_mercury, "
+{
+ MR_TypeInfo type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ Word value;
+
+ MR_unravel_univ(Univ, type_info, value);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ switch (type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_ENUM:
+ case MR_TYPECTOR_REP_ENUM_USEREQ:
+ Enum = (Integer) value;
+ SUCCESS_INDICATOR = TRUE;
+ break;
+
+ default:
+ SUCCESS_INDICATOR = FALSE;
+ break;
+ }
+}").
+
+:- pred get_du_functor_info(univ::in, int::out, int::out, int::out,
+ list(univ)::out) is semidet.
+
+:- pragma c_code(get_du_functor_info(Univ::in, Where::out,
+ Ptag::out, Sectag::out, Args::out), will_not_call_mercury, "
+{
+ MR_TypeInfo type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ MR_DuPtagLayout *ptag_layout;
+ const MR_DuFunctorDesc *functor_desc;
+ Word value;
+ Word *arg_vector;
+ int i;
+
+ MR_unravel_univ(Univ, type_info, value);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ switch (type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_DU:
+ case MR_TYPECTOR_REP_DU_USEREQ:
+ SUCCESS_INDICATOR = TRUE;
+ Ptag = MR_tag(value);
+ ptag_layout = &type_ctor_info->type_layout.layout_du[Ptag];
+
+ switch(ptag_layout->MR_sectag_locn) {
+ case MR_SECTAG_LOCAL:
+ Where = -1;
+ Sectag = MR_unmkbody(value);
+ Args = MR_list_empty();
+ break;
+
+ case MR_SECTAG_REMOTE:
+ case MR_SECTAG_NONE:
+ if (ptag_layout->MR_sectag_locn == MR_SECTAG_NONE) {
+ Where = 0;
+ arg_vector = (Word *) MR_body(value, Ptag);
+ Sectag = 0;
+ } else {
+ Where = 1;
+ arg_vector = (Word *) MR_body(value, Ptag);
+ Sectag = arg_vector[0];
+ arg_vector++;
+ }
+
+ functor_desc = ptag_layout->MR_sectag_alternatives[Sectag];
+ if (functor_desc->MR_du_functor_exist_info != NULL) {
+ SUCCESS_INDICATOR = FALSE;
+ break;
+ }
+
+ Args = MR_list_empty_msg(MR_PROC_LABEL);
+ for (i = functor_desc->MR_du_functor_orig_arity - 1;
+ i >= 0; i--)
+ {
+ Word arg;
+ MR_TypeInfo arg_type_info;
+
+ if (MR_arg_type_may_contain_var(functor_desc, i)) {
+ arg_type_info = MR_create_type_info_maybe_existq(
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+ type_info),
+ functor_desc->MR_du_functor_arg_types[i],
+ (Word *) MR_body(value, Ptag),
+ functor_desc);
+ } else {
+ arg_type_info = MR_pseudo_type_info_is_ground(
+ functor_desc->MR_du_functor_arg_types[i]);
+ }
+
+ incr_hp_msg(arg, 2, MR_PROC_LABEL,
+ ""std_util:univ/0"");
+ MR_define_univ_fields(arg,
+ arg_type_info, arg_vector[i]);
+ Args = MR_list_cons_msg(arg, Args, MR_PROC_LABEL);
+ }
+ break;
+
+ default:
+ fatal_error(""get_du_functor_info: unknown sectag locn"");
+ }
+ break;
+
+ default:
+ SUCCESS_INDICATOR = FALSE;
+ break;
}
}").
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.55
diff -u -r1.55 mercury_type_info.h
--- runtime/mercury_type_info.h 2000/09/18 11:52:35 1.55
+++ runtime/mercury_type_info.h 2000/09/23 14:48:31
@@ -344,6 +344,22 @@
#define UNIV_OFFSET_FOR_TYPEINFO 0
#define UNIV_OFFSET_FOR_DATA 1
+#define MR_unravel_univ(univ, typeinfo, value) \
+ do { \
+ typeinfo = (MR_TypeInfo) MR_field(MR_mktag(0), (univ), \
+ UNIV_OFFSET_FOR_TYPEINFO); \
+ value = MR_field(MR_mktag(0), (univ), \
+ UNIV_OFFSET_FOR_DATA); \
+ } while (0)
+
+#define MR_define_univ_fields(univ, typeinfo, value) \
+ do { \
+ MR_field(MR_mktag(0), (univ), UNIV_OFFSET_FOR_TYPEINFO) \
+ = (Word) (typeinfo); \
+ MR_field(MR_mktag(0), (univ), UNIV_OFFSET_FOR_DATA) \
+ = (Word) (value); \
+ } while (0)
+
/*---------------------------------------------------------------------------*/
/*
@@ -616,7 +632,7 @@
} MR_Sectag_Locn;
typedef struct {
- MR_ConstString MR_du_functor_name;
+ MR_ConstString MR_du_functor_name;
MR_int_least16_t MR_du_functor_orig_arity;
MR_int_least16_t MR_du_functor_arg_type_contains_var;
MR_Sectag_Locn MR_du_functor_sectag_locn;
@@ -624,7 +640,7 @@
MR_int_least32_t MR_du_functor_secondary;
MR_int_least32_t MR_du_functor_ordinal;
const MR_PseudoTypeInfo *MR_du_functor_arg_types;
- const MR_ConstString *MR_du_functor_arg_names;
+ const MR_ConstString *MR_du_functor_arg_names;
const MR_DuExistInfo *MR_du_functor_exist_info;
} MR_DuFunctorDesc;
@@ -659,14 +675,14 @@
/*---------------------------------------------------------------------------*/
typedef struct {
- MR_ConstString MR_enum_functor_name;
+ MR_ConstString MR_enum_functor_name;
MR_int_least32_t MR_enum_functor_ordinal;
} MR_EnumFunctorDesc;
/*---------------------------------------------------------------------------*/
typedef struct {
- MR_ConstString MR_notag_functor_name;
+ MR_ConstString MR_notag_functor_name;
MR_PseudoTypeInfo MR_notag_functor_arg_type;
} MR_NotagFunctorDesc;
@@ -755,7 +771,7 @@
** XXX This should be `MR_Box', but MR_Box is not visible here
** (due to a cyclic dependency problem), so we use `void *' instead.
*/
- typedef void * MR_ProcAddr;
+ typedef void *MR_ProcAddr;
#else
typedef MR_Code *MR_ProcAddr;
#endif
@@ -820,16 +836,16 @@
*/
struct MR_TypeCtorInfo_Struct {
- MR_Integer arity;
+ MR_Integer arity;
MR_ProcAddr unify_pred;
MR_ProcAddr new_unify_pred;
MR_ProcAddr compare_pred;
MR_TypeCtorRep type_ctor_rep;
MR_ProcAddr solver_pred;
MR_ProcAddr init_pred;
- MR_ConstString type_ctor_module_name;
- MR_ConstString type_ctor_name;
- MR_Integer type_ctor_version;
+ MR_ConstString type_ctor_module_name;
+ MR_ConstString type_ctor_name;
+ MR_Integer type_ctor_version;
MR_TypeFunctors type_functors;
MR_TypeLayout type_layout;
MR_int_least32_t type_ctor_num_functors;
@@ -850,22 +866,22 @@
*/
#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, cm, n, a, cr, u, c) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_A(u, c) \
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_A(u, c) \
MR_PASTE6(mercury_data_, cm, __type_ctor_info_, n, _, a) = { \
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_B(m, n, a, cr, u, c)
- /* MSVC CPP doesn't like having an empty CM field. */
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(m, n, a, cr, u, c) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_A(u, c) \
- MR_PASTE5(mercury_data_, __type_ctor_info_, n, _, a) = { \
+ /* MSVC CPP doesn't like having an empty CM field. */
+#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(m, n, a, cr, u, c) \
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_A(u, c) \
+ MR_PASTE5(mercury_data_, __type_ctor_info_, n, _, a) = { \
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_B(m, n, a, cr, u, c)
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_A(u, c) \
+#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_A(u, c) \
Declare_entry(u); \
Declare_entry(c); \
MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct \
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_B(m, n, a, cr, u, c) \
+#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL_B(m, n, a, cr, u, c) \
a, \
MR_MAYBE_STATIC_CODE(ENTRY(u)), \
MR_MAYBE_STATIC_CODE(ENTRY(u)), \
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.80
diff -u -r1.80 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2000/09/11 07:10:16 1.80
+++ trace/mercury_trace_internal.c 2000/09/24 23:01:42
@@ -1603,6 +1603,20 @@
} else {
MR_trace_usage("help", "help");
}
+ } else if (streq(words[0], "proc_body")) {
+ extern const struct MR_TypeCtorInfo_Struct
+ mercury_data_mdb__program_representation__type_ctor_info_goal_rep_0;
+ const MR_Stack_Layout_Entry *entry;
+
+ entry = event_info->MR_event_sll->MR_sll_entry;
+ if (entry->MR_sle_proc_rep == 0) {
+ fprintf(MR_mdb_out,
+ "current procedure has no body info\n");
+ } else {
+ MR_trace_print_var(
+ (MR_Word) &mercury_data_mdb__program_representation__type_ctor_info_goal_rep_0,
+ entry->MR_sle_proc_rep);
+ }
#ifdef MR_TRACE_HISTOGRAM
} else if (streq(words[0], "histogram_all")) {
if (word_count == 2) {
@@ -2496,7 +2510,7 @@
/* if we're using readline, then readline does the echoing */
#ifdef MR_NO_USE_READLINE
- if (MR_echo_commands) {
+ if (MR_echo_commands && line != NULL) {
fputs(line, mdb_out);
putc('\n', mdb_out);
}
cvs diff: Diffing trax
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list