[m-dev.] for review: removing --args simple
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon May 31 13:36:49 AEST 1999
For review by anyone.
Estimated hours taken: 4
Remove support for --args simple. We don't use it, we won't use it even for
experiments, and it is unnecessary complication.
If anybody were using --args simple, this would need bootstrapping, but
since nobody does, there is no need, and this can be committed as an
ordinary change.
compiler/options.m:
doc/user_guide.texi:
scripts/*.in:
scripts/*.sh-subr:
Remove the --args option.
compiler/globals.m:
Remove the args_method global and its access predicates.
compiler/handle_options.m:
Don't set the args_method global from the option.
compiler/arg_info.m:
Remove support for --args simple. This allows us to remove a now
redundant argument from an exported predicate.
compiler/mercury_compile.m:
Remove the code for passing -DCOMPACT_ARGS to the C compiler.
compiler/bytecode_gen.m:
compiler/fact_table.m:
compiler/follow_vars.m:
compiler/live_vars.m:
compiler/call_gen.m:
Don't pass the unnecessary argument to arg_info.
compiler/call_gen.m:
compiler/unify_gen.m:
Remove now unnecessary assertions.
compiler/hlds_pred.m:
Don't include an args_method in proc_infos; instead, include
a bool that says whether the procedure's address is taken or not.
(In most cases, this determined whether the args_method was
simple or compact.) We will need this bool in the near future
(when we generate layout structures for procedures whose address
is taken).
Modify the signatures of exported predicates to accommodate
this change to the data structure.
compiler/hlds_out.m:
Print the bool, not the args_method.
compiler/lambda.m:
When creating procedures from lambdas, set the address-taken bool
to true instead of setting up its args_method.
compiler/check_typeclass.m:
compiler/clause_to_proc.m:
compiler/dnf.m:
compiler/magic.m:
compiler/magic_util.m:
compiler/make_hlds.m:
compiler/modecheck_call.m:
compiler/pd_info.m:
compiler/post_typecheck.m:
compiler/unify_gen.m:
Minor changes to conform to the changes in the signatures of
the predicates exported from hlds_pred.m.
runtime/mercury_type_info.h:
Remove the conditional definition of the macros that provided
an argument-method-independent way of referring to the registers
holding the inputs and outputs of e.g. unification procedures.
We don't need the independence anymore, and using registers instead
of macros in the code ensures that maintainers are aware of register
reuse issues (e.g. they copy an input from r1 before overwriting it
with an output).
runtime/mercury_conf_param.h:
runtime/mercury_grade.h:
Remove support for the args method component of the grade.
runtime/mercury_ho_call.c:
runtime/mercury_tabling.c:
library/*.m:
Conform to the changes in runtime/mercury_type_info.h by effectively
applying the #defines appropriate to compact args by hand.
Remove code and data structures only needed for simple args.
Remove comments needed only in the presence of uncertainty about
the args method.
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
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/arg_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/arg_info.m,v
retrieving revision 1.31
diff -u -b -u -r1.31 arg_info.m
--- arg_info.m 1998/12/06 23:42:57 1.31
+++ arg_info.m 1999/05/28 11:10:28
@@ -13,37 +13,22 @@
% argument is input/output/unused, and which register it is supposed to
% go into.
-% Possible optimization: at the moment, each argument is assigned a
-% different register. We could try putting both an input and an output
-% argument into a single register, which should improve performance
-% a bit.
-
%-----------------------------------------------------------------------------%
:- module arg_info.
:- interface.
-:- import_module hlds_module, hlds_pred, llds, globals, prog_data.
-:- import_module bool, list, assoc_list.
+:- import_module hlds_module, hlds_pred, llds, prog_data.
+:- import_module list, assoc_list.
:- pred generate_arg_info(module_info, module_info).
:- mode generate_arg_info(in, out) is det.
-
-:- pred arg_info__unify_arg_info(args_method, code_model, list(arg_info)).
-:- mode arg_info__unify_arg_info(in, in, out) is det.
-:- pred make_arg_infos(args_method, list(type), list(mode), code_model,
- module_info, list(arg_info)).
-:- mode make_arg_infos(in, in, in, in, in, out) is det.
+:- pred arg_info__unify_arg_info(code_model, list(arg_info)).
+:- mode arg_info__unify_arg_info(in, out) is det.
- % Return yes if a procedure using the given args_method
- % can by called by do_call_*_closure.
-:- pred arg_info__args_method_is_ho_callable(globals, args_method, bool).
-:- mode arg_info__args_method_is_ho_callable(in, in, out) is det.
-
- % Return an args_method which can be used for procedures
- % which may be called by do_call_*_closure.
-:- pred arg_info__ho_call_args_method(globals, args_method).
-:- mode arg_info__ho_call_args_method(in, out) is det.
+:- pred make_arg_infos(list(type), list(mode), code_model, module_info,
+ list(arg_info)).
+:- mode make_arg_infos(in, in, in, in, out) is det.
% Given a list of the head variables and their argument information,
% return a list giving the input variables and their initial locations.
@@ -110,12 +95,8 @@
generate_proc_arg_info(ProcInfo0, ArgTypes, ModuleInfo, ProcInfo) :-
proc_info_argmodes(ProcInfo0, ArgModes),
- proc_info_args_method(ProcInfo0, Method),
proc_info_interface_code_model(ProcInfo0, CodeModel),
-
- make_arg_infos(Method, ArgTypes, ArgModes, CodeModel, ModuleInfo,
- ArgInfo),
-
+ make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfo),
proc_info_set_arg_info(ProcInfo0, ArgInfo, ProcInfo).
%---------------------------------------------------------------------------%
@@ -128,66 +109,28 @@
% other places scattered around the runtime and the library
% which also rely on it.
- % For the `simple' argument convention, we assume all arguments
- % go in sequentially numbered registers starting at register
- % number 1, except for semi-deterministic procs, where the
- % first register is reserved for the result and hence the arguments
- % start at register number 2. Each register is used either for
- % input or output but not both.
-
- % For the `compact' argument convention, we assume all input arguments
- % go in sequentially numbered registers starting at register
- % number 1, and all output arguments go in sequentially numbered
- % registers starting at register number 1,
- % except for semi-deterministic procs, where the
- % first register is reserved for the result and hence the output
- % arguments start at register number 2.
- % In the `compact' argument convention, we may use a single
- % register for both an input arg and an output arg.
- %
- % lambda.m ensures that all procedures which are called directly
- % from do_call_*_closure use the `compact' argument convention,
- % so that mercury_ho_call.c can place the input arguments without
- % knowing anything about the called procedure.
+ % We assume all input arguments always go in sequentially numbered
+ % registers starting at register number 1. We also assume that
+ % all output arguments go in sequentially numbered registers
+ % starting at register number 1, except for model_semi procedures,
+ % where the first register is reserved for the result and hence
+ % the output arguments start at register number 2.
-make_arg_infos(Method, ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfo) :-
+make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfo) :-
( CodeModel = model_semi ->
StartReg = 2
;
StartReg = 1
),
- (
- Method = simple,
- make_arg_infos_list(ArgModes, ArgTypes, StartReg, ModuleInfo,
- ArgInfo)
- ;
- Method = compact,
- make_arg_infos_compact_list(ArgModes, ArgTypes, 1, StartReg,
- ModuleInfo, ArgInfo)
- ).
-
-:- pred make_arg_infos_list(list(mode), list(type), int, module_info,
- list(arg_info)).
-:- mode make_arg_infos_list(in, in, in, in, out) is det.
-
-make_arg_infos_list([], [], _, _, []).
-make_arg_infos_list([Mode | Modes], [Type | Types], Reg0, ModuleInfo,
- [ArgInfo | ArgInfos]) :-
- mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
- ArgInfo = arg_info(Reg0, ArgMode),
- Reg1 is Reg0 + 1,
- make_arg_infos_list(Modes, Types, Reg1, ModuleInfo, ArgInfos).
-make_arg_infos_list([], [_|_], _, _, _) :-
- error("make_arg_infos_list: length mis-match").
-make_arg_infos_list([_|_], [], _, _, _) :-
- error("make_arg_infos_list: length mis-match").
+ make_arg_infos_list(ArgModes, ArgTypes, 1, StartReg,
+ ModuleInfo, ArgInfo).
-:- pred make_arg_infos_compact_list(list(mode), list(type), int, int,
+:- pred make_arg_infos_list(list(mode), list(type), int, int,
module_info, list(arg_info)).
-:- mode make_arg_infos_compact_list(in, in, in, in, in, out) is det.
+:- mode make_arg_infos_list(in, in, in, in, in, out) is det.
-make_arg_infos_compact_list([], [], _, _, _, []).
-make_arg_infos_compact_list([Mode | Modes], [Type | Types], InReg0, OutReg0,
+make_arg_infos_list([], [], _, _, _, []).
+make_arg_infos_list([Mode | Modes], [Type | Types], InReg0, OutReg0,
ModuleInfo, [ArgInfo | ArgInfos]) :-
mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
(
@@ -201,7 +144,7 @@
InReg1 = InReg0,
OutReg1 is OutReg0 + 1
;
- % Allocate unused regs as if they were outputs.
+ % Allocate unused args as if they were outputs.
% We must allocate them a register, and the choice
% should not matter since unused args should be rare.
ArgMode = top_unused,
@@ -210,30 +153,21 @@
OutReg1 is OutReg0 + 1
),
ArgInfo = arg_info(ArgReg, ArgMode),
- make_arg_infos_compact_list(Modes, Types, InReg1, OutReg1,
+ make_arg_infos_list(Modes, Types, InReg1, OutReg1,
ModuleInfo, ArgInfos).
-make_arg_infos_compact_list([], [_|_], _, _, _, _) :-
+make_arg_infos_list([], [_|_], _, _, _, _) :-
error("make_arg_infos_list: length mis-match").
-make_arg_infos_compact_list([_|_], [], _, _, _, _) :-
+make_arg_infos_list([_|_], [], _, _, _, _) :-
error("make_arg_infos_list: length mis-match").
%---------------------------------------------------------------------------%
-arg_info__unify_arg_info(_ArgsMethod, model_det,
+arg_info__unify_arg_info(model_det,
[arg_info(1, top_in), arg_info(2, top_in)]).
-arg_info__unify_arg_info(simple, model_semi,
- [arg_info(2, top_in), arg_info(3, top_in)]).
-arg_info__unify_arg_info(compact, model_semi,
+arg_info__unify_arg_info(model_semi,
[arg_info(1, top_in), arg_info(2, top_in)]).
-arg_info__unify_arg_info(_ArgsMethod, model_non, _) :-
+arg_info__unify_arg_info(model_non, _) :-
error("arg_info: nondet unify!").
-
-%---------------------------------------------------------------------------%
-
-arg_info__args_method_is_ho_callable(_, compact, yes).
-arg_info__args_method_is_ho_callable(_, simple, no).
-
-arg_info__ho_call_args_method(_, compact).
%---------------------------------------------------------------------------%
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.42
diff -u -b -u -r1.42 bytecode_gen.m
--- bytecode_gen.m 1999/04/22 01:04:05 1.42
+++ bytecode_gen.m 1999/05/28 08:54:21
@@ -281,10 +281,7 @@
ByteInfo, Code) :-
determinism_to_code_model(Detism, CodeModel),
bytecode_gen__get_module_info(ByteInfo, ModuleInfo),
- module_info_globals(ModuleInfo, Globals),
- arg_info__ho_call_args_method(Globals, ArgsMethod),
- make_arg_infos(ArgsMethod, ArgTypes, ArgModes, CodeModel, ModuleInfo,
- ArgInfo),
+ make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfo),
assoc_list__from_corresponding_lists(ArgVars, ArgInfo, ArgVarsInfos),
call_gen__partition_args(ArgVarsInfos, InVars, OutVars),
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.130
diff -u -b -u -r1.130 call_gen.m
--- call_gen.m 1999/04/16 06:04:12 1.130
+++ call_gen.m 1999/05/28 11:20:40
@@ -176,10 +176,7 @@
Modes, Det, GoalInfo, Code) -->
{ determinism_to_code_model(Det, CodeModel) },
code_info__get_module_info(ModuleInfo),
- { module_info_globals(ModuleInfo, Globals) },
- { arg_info__ho_call_args_method(Globals, ArgsMethod) },
- { make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
- ArgInfos) },
+ { make_arg_infos(Types, Modes, CodeModel, ModuleInfo, ArgInfos) },
{ assoc_list__from_corresponding_lists(Args, ArgInfos, ArgsInfos) },
{ call_gen__partition_args(ArgsInfos, InVars, OutVars) },
{ set__list_to_set(OutVars, OutArgs) },
@@ -276,17 +273,9 @@
call_gen__generate_class_method_call(_OuterCodeModel, TCVar, MethodNum, Args,
Types, Modes, Det, GoalInfo, Code) -->
{ determinism_to_code_model(Det, CodeModel) },
- code_info__get_globals(Globals),
code_info__get_module_info(ModuleInfo),
- { globals__get_args_method(Globals, ArgsMethod) },
- ( { ArgsMethod = compact } ->
- []
- ;
- { error("Sorry, typeclasses with simple args_method not yet implemented") }
- ),
- { make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
- ArgInfo) },
+ { make_arg_infos(Types, Modes, CodeModel, ModuleInfo, ArgInfo) },
{ assoc_list__from_corresponding_lists(Args, ArgInfo, ArgsAndArgInfo) },
{ call_gen__partition_args(ArgsAndArgInfo, InVars, OutVars) },
{ set__list_to_set(OutVars, OutArgs) },
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.23
diff -u -b -u -r1.23 check_typeclass.m
--- check_typeclass.m 1999/04/23 01:02:34 1.23
+++ check_typeclass.m 1999/05/28 08:54:21
@@ -532,15 +532,13 @@
Markers, none, PredOrFunc, ClassContext, Proofs, User,
PredInfo0),
- globals__get_args_method(Globals, ArgsMethod),
-
% Add procs with the expected modes and determinisms
AddProc = lambda([ModeAndDet::in, NewProcId::out,
OldPredInfo::in, NewPredInfo::out] is det,
(
ModeAndDet = Modes - Det,
add_new_proc(OldPredInfo, PredArity, Modes, yes(Modes), no,
- yes(Det), Context, ArgsMethod, NewPredInfo, NewProcId)
+ yes(Det), Context, yes, NewPredInfo, NewProcId)
)),
list__map_foldl(AddProc, ArgModes, InstanceProcIds,
PredInfo0, PredInfo1),
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.23
diff -u -b -u -r1.23 clause_to_proc.m
--- clause_to_proc.m 1998/10/20 15:06:40 1.23
+++ clause_to_proc.m 1999/05/28 08:54:21
@@ -38,30 +38,28 @@
% a default mode of `:- mode foo(in, in, ..., in) = out.'
% for functions that don't have an explicit mode declaration.
-:- pred maybe_add_default_modes(module_info, list(pred_id),
- pred_table, pred_table).
-:- mode maybe_add_default_modes(in, in, in, out) is det.
-
-:- pred maybe_add_default_mode(module_info, pred_info,
- pred_info, maybe(proc_id)).
-:- mode maybe_add_default_mode(in, in, out, out) is det.
+:- pred maybe_add_default_modes(list(pred_id), pred_table, pred_table).
+:- mode maybe_add_default_modes(in, in, out) is det.
+:- pred maybe_add_default_mode(pred_info, pred_info, maybe(proc_id)).
+:- mode maybe_add_default_mode(in, out, out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_goal, hlds_data, prog_data, mode_util, make_hlds, purity.
:- import_module globals.
-:- import_module int, set, map.
+:- import_module bool, int, set, map.
-maybe_add_default_modes(_, [], Preds, Preds).
-maybe_add_default_modes(ModuleInfo, [PredId | PredIds], Preds0, Preds) :-
+maybe_add_default_modes([], Preds, Preds).
+maybe_add_default_modes([PredId | PredIds], Preds0, Preds) :-
map__lookup(Preds0, PredId, PredInfo0),
- maybe_add_default_mode(ModuleInfo, PredInfo0, PredInfo, _),
+ maybe_add_default_mode(PredInfo0, PredInfo, _),
map__det_update(Preds0, PredId, PredInfo, Preds1),
- maybe_add_default_modes(ModuleInfo, PredIds, Preds1, Preds).
+ maybe_add_default_modes(PredIds, Preds1, Preds).
-maybe_add_default_mode(ModuleInfo, PredInfo0, PredInfo, MaybeProcId) :-
+maybe_add_default_mode(PredInfo0, PredInfo, MaybeProcId) :-
pred_info_procedures(PredInfo0, Procs0),
pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
(
@@ -89,11 +87,9 @@
Determinism = det,
pred_info_context(PredInfo0, Context),
MaybePredArgLives = no,
- module_info_globals(ModuleInfo, Globals),
- globals__get_args_method(Globals, ArgsMethod),
add_new_proc(PredInfo0, PredArity, PredArgModes,
yes(PredArgModes), MaybePredArgLives, yes(Determinism),
- Context, ArgsMethod, PredInfo, ProcId),
+ Context, no, PredInfo, ProcId),
MaybeProcId = yes(ProcId)
;
PredInfo = PredInfo0,
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.35
diff -u -b -u -r1.35 dnf.m
--- dnf.m 1998/12/06 23:43:06 1.35
+++ dnf.m 1999/05/28 08:54:27
@@ -399,7 +399,8 @@
% that are not part of the goal.
hlds_pred__define_new_pred(Goal0, Goal, ArgVars, _, InstMap0, PredName,
TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
- VarSet, Markers, Owner, ModuleInfo0, ModuleInfo, PredProcId),
+ VarSet, Markers, Owner, no, ModuleInfo0, ModuleInfo,
+ PredProcId),
PredProcId = proc(PredId, _).
%-----------------------------------------------------------------------------%
Index: compiler/fact_table.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/fact_table.m,v
retrieving revision 1.24
diff -u -b -u -r1.24 fact_table.m
--- fact_table.m 1999/03/18 01:31:31 1.24
+++ fact_table.m 1999/05/28 11:20:39
@@ -2445,7 +2445,6 @@
fact_table_generate_c_code(PredName, PragmaVars, ProcID, PrimaryProcID,
ProcInfo, ArgTypes, ModuleInfo, ProcCode, ExtraCode) -->
fact_table_size(FactTableSize),
- { proc_info_args_method(ProcInfo, ArgsMethod) },
{ proc_info_argmodes(ProcInfo, ArgModes) },
{ proc_info_interface_determinism(ProcInfo, Determinism) },
{ fact_table_mode_type(ArgModes, ModuleInfo, ModeType) },
@@ -2455,7 +2454,7 @@
Determinism = multidet
->
generate_multidet_code(Identifier, PragmaVars, ProcID,
- ArgTypes, ArgsMethod, ModuleInfo, FactTableSize,
+ ArgTypes, ModuleInfo, FactTableSize,
ProcCode, ExtraCode)
;
ModeType = all_out,
@@ -2483,15 +2482,15 @@
ProcID = PrimaryProcID
->
generate_primary_nondet_code(Identifier, PragmaVars,
- ProcID, ArgTypes, ArgsMethod, ModuleInfo,
- FactTableSize, ProcCode, ExtraCode)
+ ProcID, ArgTypes, ModuleInfo, FactTableSize,
+ ProcCode, ExtraCode)
;
ModeType = in_out,
Determinism = nondet,
ProcID \= PrimaryProcID
->
generate_secondary_nondet_code(Identifier, PragmaVars,
- ProcID, ArgTypes, ArgsMethod, ModuleInfo, FactTableSize,
+ ProcID, ArgTypes, ModuleInfo, FactTableSize,
ProcCode, ExtraCode)
;
% There is a determinism error in this procedure which will be
@@ -2511,10 +2510,10 @@
% XXX this should be changed to use the new model_non pragma c_code
:- pred generate_multidet_code(string, list(pragma_var), proc_id,
- list(type), args_method, module_info, int, string, string).
-:- mode generate_multidet_code(in, in, in, in, in, in, in, out, out) is det.
+ list(type), module_info, int, string, string).
+:- mode generate_multidet_code(in, in, in, in, in, in, out, out) is det.
-generate_multidet_code(PredName, PragmaVars, ProcID, ArgTypes, ArgsMethod,
+generate_multidet_code(PredName, PragmaVars, ProcID, ArgTypes,
ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
generate_nondet_proc_code(PragmaVars, PredName, ProcID, ExtraCodeLabel,
ProcCode),
@@ -2562,7 +2561,7 @@
string__append_list(["mercury__", PredName, "_fact_table_num_facts"],
NumFactsVar),
list__length(PragmaVars, Arity),
- generate_argument_vars_code(PragmaVars, ArgTypes, ArgsMethod,
+ generate_argument_vars_code(PragmaVars, ArgTypes,
ModuleInfo, ArgDeclCode, _InputCode, OutputCode, _, _, _),
generate_fact_lookup_code(PredName, PragmaVars, ArgTypes, ModuleInfo, 1,
FactTableSize, FactLookupCode),
@@ -3023,12 +3022,12 @@
% XXX this should change to use the new model_non pragma c_code when
% it has been implemented.
:- pred generate_primary_nondet_code(string, list(pragma_var), proc_id,
- list(type), args_method, module_info, int, string, string).
-:- mode generate_primary_nondet_code(in, in, in, in, in, in, in, out, out)
+ list(type), module_info, int, string, string).
+:- mode generate_primary_nondet_code(in, in, in, in, in, in, out, out)
is det.
generate_primary_nondet_code(PredName, PragmaVars, ProcID, ArgTypes,
- ArgsMethod, ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
+ ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
generate_nondet_proc_code(PragmaVars, PredName, ProcID, ExtraCodeLabel,
ProcCode),
@@ -3098,7 +3097,7 @@
",
- generate_argument_vars_code(PragmaVars, ArgTypes, ArgsMethod,
+ generate_argument_vars_code(PragmaVars, ArgTypes,
ModuleInfo, ArgDeclCode, InputCode, OutputCode, SaveRegsCode,
GetRegsCode, NumFrameVars),
generate_decl_code(PredName, ProcID, DeclCode),
@@ -3153,18 +3152,16 @@
% generate code to create argument variables and assign them to
% registers
-:- pred generate_argument_vars_code(list(pragma_var), list(type), args_method,
+:- pred generate_argument_vars_code(list(pragma_var), list(type),
module_info, string, string, string, string, string, int).
-:- mode generate_argument_vars_code(in, in, in, in, out, out, out, out, out,
+:- mode generate_argument_vars_code(in, in, in, out, out, out, out, out,
out) is det.
-generate_argument_vars_code(PragmaVars, Types, ArgsMethod, ModuleInfo,
- DeclCode, InputCode, OutputCode, SaveRegsCode, GetRegsCode,
- NumInputArgs) :-
+generate_argument_vars_code(PragmaVars, Types, ModuleInfo, DeclCode, InputCode,
+ OutputCode, SaveRegsCode, GetRegsCode, NumInputArgs) :-
list__map(lambda([X::in, Y::out] is det, X = pragma_var(_,_,Y)),
PragmaVars, Modes),
- make_arg_infos(ArgsMethod, Types, Modes, model_non, ModuleInfo,
- ArgInfos),
+ make_arg_infos(Types, Modes, model_non, ModuleInfo, ArgInfos),
generate_argument_vars_code_2(PragmaVars, ArgInfos, Types, DeclCode,
InputCode, OutputCode, SaveRegsCode, GetRegsCode, 1,
NumInputArgs).
@@ -3325,12 +3322,12 @@
% XXX this should change to use the new model_non pragma c_code when
% it has been implemented.
:- pred generate_secondary_nondet_code(string, list(pragma_var), proc_id,
- list(type), args_method, module_info, int, string, string).
-:- mode generate_secondary_nondet_code(in, in, in, in, in, in, in, out, out)
+ list(type), module_info, int, string, string).
+:- mode generate_secondary_nondet_code(in, in, in, in, in, in, out, out)
is det.
generate_secondary_nondet_code(PredName, PragmaVars, ProcID, ArgTypes,
- ArgsMethod, ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
+ ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
generate_nondet_proc_code(PragmaVars, PredName, ProcID, ExtraCodeLabel,
ProcCode),
@@ -3417,7 +3414,7 @@
",
- generate_argument_vars_code(PragmaVars, ArgTypes, ArgsMethod,
+ generate_argument_vars_code(PragmaVars, ArgTypes,
ModuleInfo, ArgDeclCode, InputCode, OutputCode, _SaveRegsCode,
_GetRegsCode, _NumFrameVars),
generate_decl_code(PredName, ProcID, DeclCode),
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_vars.m,v
retrieving revision 1.51
diff -u -b -u -r1.51 follow_vars.m
--- follow_vars.m 1998/11/20 04:07:40 1.51
+++ follow_vars.m 1999/05/28 11:20:40
@@ -173,10 +173,7 @@
IsPredOrFunc),
FollowVars) :-
determinism_to_code_model(Det, CodeModel),
- module_info_globals(ModuleInfo, Globals),
- arg_info__ho_call_args_method(Globals, ArgsMethod),
- make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
- ArgInfo),
+ make_arg_infos(Types, Modes, CodeModel, ModuleInfo, ArgInfo),
find_follow_vars_from_arginfo(ArgInfo, Args, FollowVars).
% XXX These follow-vars aren't correct since the desired positions for
@@ -190,15 +187,7 @@
Det),
FollowVars) :-
determinism_to_code_model(Det, CodeModel),
- module_info_globals(ModuleInfo, Globals),
- globals__get_args_method(Globals, ArgsMethod),
- ( ArgsMethod = compact ->
- true
- ;
- error("Sorry, typeclasses with simple args_method not yet implemented")
- ),
- make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
- ArgInfo),
+ make_arg_infos(Types, Modes, CodeModel, ModuleInfo, ArgInfo),
find_follow_vars_from_arginfo(ArgInfo, Args, FollowVars).
find_follow_vars_in_goal_2(call(A,B,C,D,E,F), ModuleInfo,
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.33
diff -u -b -u -r1.33 globals.m
--- globals.m 1998/11/05 03:52:16 1.33
+++ globals.m 1999/05/28 11:26:44
@@ -31,10 +31,6 @@
; low
; high.
-:- type args_method
- ---> simple
- ; compact.
-
:- type prolog_dialect
---> default
; nu
@@ -53,7 +49,6 @@
:- pred convert_gc_method(string::in, gc_method::out) is semidet.
:- pred convert_tags_method(string::in, tags_method::out) is semidet.
-:- pred convert_args_method(string::in, args_method::out) is semidet.
:- pred convert_prolog_dialect(string::in, prolog_dialect::out) is semidet.
:- pred convert_termination_norm(string::in, termination_norm::out) is semidet.
:- pred convert_trace_level(string::in, bool::in, trace_level::out) is semidet.
@@ -64,13 +59,12 @@
% Access predicates for the `globals' structure.
:- pred globals__init(option_table::di, gc_method::di, tags_method::di,
- args_method::di, prolog_dialect::di,
- termination_norm::di, trace_level::di, globals::uo) is det.
+ prolog_dialect::di, termination_norm::di, trace_level::di,
+ globals::uo) is det.
:- pred globals__get_options(globals::in, option_table::out) is det.
:- pred globals__get_gc_method(globals::in, gc_method::out) is det.
:- pred globals__get_tags_method(globals::in, tags_method::out) is det.
-:- pred globals__get_args_method(globals::in, args_method::out) is det.
:- pred globals__get_prolog_dialect(globals::in, prolog_dialect::out) is det.
:- pred globals__get_termination_norm(globals::in, termination_norm::out)
is det.
@@ -114,8 +108,8 @@
% io__state using io__set_globals and io__get_globals.
:- pred globals__io_init(option_table::di, gc_method::in, tags_method::in,
- args_method::in, prolog_dialect::in, termination_norm::in,
- trace_level::in, io__state::di, io__state::uo) is det.
+ prolog_dialect::in, termination_norm::in, trace_level::in,
+ io__state::di, io__state::uo) is det.
:- pred globals__io_get_gc_method(gc_method::out,
io__state::di, io__state::uo) is det.
@@ -123,9 +117,6 @@
:- pred globals__io_get_tags_method(tags_method::out,
io__state::di, io__state::uo) is det.
-:- pred globals__io_get_args_method(args_method::out,
- io__state::di, io__state::uo) is det.
-
:- pred globals__io_get_prolog_dialect(prolog_dialect::out,
io__state::di, io__state::uo) is det.
@@ -181,9 +172,6 @@
convert_tags_method("low", low).
convert_tags_method("high", high).
-convert_args_method("simple", simple).
-convert_args_method("compact", compact).
-
convert_prolog_dialect("default", default).
convert_prolog_dialect("nu", nu).
convert_prolog_dialect("NU", nu).
@@ -217,32 +205,30 @@
option_table,
gc_method,
tags_method,
- args_method,
prolog_dialect,
termination_norm,
trace_level
).
-globals__init(Options, GC_Method, TagsMethod, ArgsMethod,
+globals__init(Options, GC_Method, TagsMethod,
PrologDialect, TerminationNorm, TraceLevel,
- globals(Options, GC_Method, TagsMethod, ArgsMethod,
+ globals(Options, GC_Method, TagsMethod,
PrologDialect, TerminationNorm, TraceLevel)).
-globals__get_options(globals(Options, _, _, _, _, _, _), Options).
-globals__get_gc_method(globals(_, GC_Method, _, _, _, _, _), GC_Method).
-globals__get_tags_method(globals(_, _, TagsMethod, _, _, _, _), TagsMethod).
-globals__get_args_method(globals(_, _, _, ArgsMethod, _, _, _), ArgsMethod).
-globals__get_prolog_dialect(globals(_, _, _, _, PrologDialect, _, _),
+globals__get_options(globals(Options, _, _, _, _, _), Options).
+globals__get_gc_method(globals(_, GC_Method, _, _, _, _), GC_Method).
+globals__get_tags_method(globals(_, _, TagsMethod, _, _, _), TagsMethod).
+globals__get_prolog_dialect(globals(_, _, _, PrologDialect, _, _),
PrologDialect).
-globals__get_termination_norm(globals(_, _, _, _, _, TerminationNorm, _),
+globals__get_termination_norm(globals(_, _, _, _, TerminationNorm, _),
TerminationNorm).
-globals__get_trace_level(globals(_, _, _, _, _, _, TraceLevel), TraceLevel).
+globals__get_trace_level(globals(_, _, _, _, _, TraceLevel), TraceLevel).
-globals__set_options(globals(_, B, C, D, E, F, G), Options,
- globals(Options, B, C, D, E, F, G)).
+globals__set_options(globals(_, B, C, D, E, F), Options,
+ globals(Options, B, C, D, E, F)).
-globals__set_trace_level(globals(A, B, C, D, E, F, _), TraceLevel,
- globals(A, B, C, D, E, F, TraceLevel)).
+globals__set_trace_level(globals(A, B, C, D, E, _), TraceLevel,
+ globals(A, B, C, D, E, TraceLevel)).
globals__lookup_option(Globals, Option, OptionData) :-
globals__get_options(Globals, OptionTable),
@@ -320,15 +306,14 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-globals__io_init(Options, GC_Method, TagsMethod, ArgsMethod,
+globals__io_init(Options, GC_Method, TagsMethod,
PrologDialect, TerminationNorm, TraceLevel) -->
{ copy(GC_Method, GC_Method1) },
{ copy(TagsMethod, TagsMethod1) },
- { copy(ArgsMethod, ArgsMethod1) },
{ copy(PrologDialect, PrologDialect1) },
{ copy(TerminationNorm, TerminationNorm1) },
{ copy(TraceLevel, TraceLevel1) },
- { globals__init(Options, GC_Method1, TagsMethod1, ArgsMethod1,
+ { globals__init(Options, GC_Method1, TagsMethod1,
PrologDialect1, TerminationNorm1, TraceLevel1, Globals) },
globals__io_set_globals(Globals).
@@ -339,10 +324,6 @@
globals__io_get_tags_method(Tags_Method) -->
globals__io_get_globals(Globals),
{ globals__get_tags_method(Globals, Tags_Method) }.
-
-globals__io_get_args_method(ArgsMethod) -->
- globals__io_get_globals(Globals),
- { globals__get_args_method(Globals, ArgsMethod) }.
globals__io_get_prolog_dialect(PrologDIalect) -->
globals__io_get_globals(Globals),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.75
diff -u -b -u -r1.75 handle_options.m
--- handle_options.m 1999/04/29 02:54:41 1.75
+++ handle_options.m 1999/05/28 08:54:29
@@ -124,11 +124,6 @@
{ TagsMethod0 = string(TagsMethodStr) },
{ convert_tags_method(TagsMethodStr, TagsMethod) }
->
- { map__lookup(OptionTable, args, ArgsMethod0) },
- (
- { ArgsMethod0 = string(ArgsMethodStr) },
- { convert_args_method(ArgsMethodStr, ArgsMethod) }
- ->
{ map__lookup(OptionTable, prolog_dialect, PrologDialect0) },
(
{ PrologDialect0 = string(PrologDialectStr) },
@@ -163,9 +158,8 @@
{ DumpAlias = "" }
->
postprocess_options_2(OptionTable,
- GC_Method, TagsMethod, ArgsMethod,
- PrologDialect, TermNorm, TraceLevel,
- Error)
+ GC_Method, TagsMethod, PrologDialect,
+ TermNorm, TraceLevel, Error)
;
{ DumpAliasOption = string(DumpAlias) },
{ convert_dump_alias(DumpAlias,
@@ -174,9 +168,8 @@
{ map__set(OptionTable, dump_hlds_options,
string(DumpOptions), NewOptionTable) },
postprocess_options_2(NewOptionTable,
- GC_Method, TagsMethod, ArgsMethod,
- PrologDialect, TermNorm, TraceLevel,
- Error)
+ GC_Method, TagsMethod, PrologDialect,
+ TermNorm, TraceLevel, Error)
;
{ Error = yes("Invalid argument to option `--hlds-dump-alias'.") }
)
@@ -193,9 +186,6 @@
{ Error = yes("Invalid prolog-dialect option (must be `sicstus', `nu', or `default')") }
)
;
- { Error = yes("Invalid args option (must be `simple' or `compact')") }
- )
- ;
{ Error = yes("Invalid tags option (must be `none', `low' or `high')") }
)
;
@@ -203,14 +193,14 @@
).
:- pred postprocess_options_2(option_table, gc_method, tags_method,
- args_method, prolog_dialect, termination_norm, trace_level,
- maybe(string), io__state, io__state).
-:- mode postprocess_options_2(in, in, in, in, in, in, in, out, di, uo) is det.
+ prolog_dialect, termination_norm, trace_level, maybe(string),
+ io__state, io__state).
+:- mode postprocess_options_2(in, in, in, in, in, in, out, di, uo) is det.
-postprocess_options_2(OptionTable, GC_Method, TagsMethod, ArgsMethod,
- PrologDialect, TermNorm, TraceLevel, Error) -->
+postprocess_options_2(OptionTable, GC_Method, TagsMethod, PrologDialect,
+ TermNorm, TraceLevel, Error) -->
{ unsafe_promise_unique(OptionTable, OptionTable1) }, % XXX
- globals__io_init(OptionTable1, GC_Method, TagsMethod, ArgsMethod,
+ globals__io_init(OptionTable1, GC_Method, TagsMethod,
PrologDialect, TermNorm, TraceLevel),
% --gc conservative implies --no-reclaim-heap-*
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.218
diff -u -b -u -r1.218 hlds_out.m
--- hlds_out.m 1999/04/27 07:59:02 1.218
+++ hlds_out.m 1999/05/28 11:20:40
@@ -2397,7 +2397,7 @@
{ proc_info_get_maybe_termination_info(Proc, MaybeTermination) },
{ proc_info_typeinfo_varmap(Proc, TypeInfoMap) },
{ proc_info_typeclass_info_varmap(Proc, TypeClassInfoMap) },
- { proc_info_args_method(Proc, ArgsMethod) },
+ { proc_info_has_address_taken(Proc, HasAddressTaken) },
{ Indent1 is Indent + 1 },
hlds_out__write_indent(Indent1),
@@ -2433,9 +2433,11 @@
hlds_out__write_typeclass_info_varmap(Indent, AppendVarnums,
TypeClassInfoMap, VarSet, TVarSet),
- io__write_string("% args method: "),
- hlds_out__write_args_method(ArgsMethod),
- io__nl,
+ ( { HasAddressTaken = yes } ->
+ io__write_string("% has address taken\n")
+ ;
+ io__write_string("% does not have address taken\n")
+ ),
hlds_out__write_indent(Indent),
{ predicate_name(ModuleInfo, PredId, PredName) },
@@ -2552,14 +2554,6 @@
io__write_string("model_semi").
hlds_out__write_code_model(model_non) -->
io__write_string("model_non").
-
-:- pred hlds_out__write_args_method(args_method, io__state, io__state).
-:- mode hlds_out__write_args_method(in, di, uo) is det.
-
-hlds_out__write_args_method(simple) -->
- io__write_string("simple").
-hlds_out__write_args_method(compact) -->
- io__write_string("compact").
:- pred hlds_out__write_indent(int, io__state, io__state).
:- mode hlds_out__write_indent(in, di, uo) is det.
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.57
diff -u -b -u -r1.57 hlds_pred.m
--- hlds_pred.m 1998/12/06 23:43:21 1.57
+++ hlds_pred.m 1999/05/31 01:45:27
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1996-1998 The University of Melbourne.
+% Copyright (C) 1996-1999 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.
%-----------------------------------------------------------------------------%
@@ -14,13 +14,13 @@
:- interface.
:- import_module hlds_data, hlds_goal, hlds_module, llds, prog_data, instmap.
-:- import_module purity, rl, globals, term_util.
+:- import_module purity, rl, term_util.
:- import_module bool, list, set, map, std_util, term, varset.
:- implementation.
:- import_module code_aux, goal_util, make_hlds, prog_util.
-:- import_module mode_util, type_util, options.
+:- import_module mode_util, type_util, globals, options.
:- import_module int, string, require, assoc_list.
%-----------------------------------------------------------------------------%
@@ -350,7 +350,8 @@
% hlds_pred__define_new_pred(Goal, CallGoal, Args, ExtraArgs, InstMap,
% PredName, TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
- % VarSet, Markers, Owner, ModuleInfo0, ModuleInfo, PredProcId)
+ % VarSet, Markers, Owner, HasAddressTaken,
+ % ModuleInfo0, ModuleInfo, PredProcId)
%
% Create a new predicate for the given goal, returning a goal to
% call the created predicate. ExtraArgs is the list of extra
@@ -360,9 +361,9 @@
list(prog_var), instmap, string, tvarset, map(prog_var, type),
class_constraints, map(tvar, type_info_locn),
map(class_constraint, prog_var), prog_varset, pred_markers,
- aditi_owner, module_info, module_info, pred_proc_id).
+ aditi_owner, bool, module_info, module_info, pred_proc_id).
:- mode hlds_pred__define_new_pred(in, out, in, out, in, in, in, in, in,
- in, in, in, in, in, in, out, out) is det.
+ in, in, in, in, in, in, in, out, out) is det.
% Various predicates for accessing the information stored in the
% pred_id and pred_info data structures.
@@ -1040,7 +1041,8 @@
hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
PredName, TVarSet, VarTypes0, ClassContext, TVarMap, TCVarMap,
- VarSet0, Markers, Owner, ModuleInfo0, ModuleInfo, PredProcId) :-
+ VarSet0, Markers, Owner, HasAddressTaken,
+ ModuleInfo0, ModuleInfo, PredProcId) :-
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
@@ -1051,6 +1053,8 @@
% If typeinfo_liveness is set, all type_infos for the argument
% variables need to be passed in, not just the ones that are used.
+ % Similarly if the address of a procedure of this predicate is taken,
+ % so that we can copy the closure.
module_info_globals(ModuleInfo0, Globals),
globals__lookup_bool_option(Globals, typeinfo_liveness,
TypeInfoLiveness),
@@ -1088,11 +1092,8 @@
TermInfo = no
),
- globals__get_args_method(Globals, ArgsMethod),
-
- proc_info_create(VarSet, VarTypes, ArgVars, ArgModes,
- Detism, Goal0, Context, TVarMap, TCVarMap, ArgsMethod,
- ProcInfo0),
+ proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, Detism, Goal0,
+ Context, TVarMap, TCVarMap, HasAddressTaken, ProcInfo0),
proc_info_set_maybe_termination_info(ProcInfo0, TermInfo, ProcInfo),
pred_info_create(ModuleName, SymName, TVarSet, ExistQVars, ArgTypes,
@@ -1130,8 +1131,8 @@
:- interface.
:- pred proc_info_init(arity, list(type), list(mode), maybe(list(mode)),
- maybe(list(is_live)), maybe(determinism), prog_context,
- args_method, proc_info).
+ maybe(list(is_live)), maybe(determinism), prog_context, bool,
+ proc_info).
:- mode proc_info_init(in, in, in, in, in, in, in, in, out) is det.
:- pred proc_info_set(maybe(determinism), prog_varset, map(prog_var, type),
@@ -1139,13 +1140,13 @@
prog_context, stack_slots, determinism, bool, list(arg_info),
liveness_info, map(tvar, type_info_locn),
map(class_constraint, prog_var), maybe(arg_size_info),
- maybe(termination_info), args_method, proc_info).
+ maybe(termination_info), bool, proc_info).
:- mode proc_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
in, in, in, in, out) is det.
:- pred proc_info_create(prog_varset, map(prog_var, type), list(prog_var),
list(mode), determinism, hlds_goal, prog_context,
- map(tvar, type_info_locn), map(class_constraint, prog_var), args_method,
+ map(tvar, type_info_locn), map(class_constraint, prog_var), bool,
proc_info).
:- mode proc_info_create(in, in, in, in, in, in, in, in, in, in, out) is det.
@@ -1287,12 +1288,9 @@
:- pred proc_info_declared_argmodes(proc_info, list(mode)).
:- mode proc_info_declared_argmodes(in, out) is det.
-:- pred proc_info_args_method(proc_info, args_method).
-:- mode proc_info_args_method(in, out) is det.
+:- pred proc_info_has_address_taken(proc_info, bool).
+:- mode proc_info_has_address_taken(in, out) is det.
-:- pred proc_info_set_args_method(proc_info, args_method, proc_info).
-:- mode proc_info_set_args_method(in, in, out) is det.
-
% For a set of variables V, find all the type variables in the types
% of the variables in V, and return set of typeinfo variables for
% those type variables. (find all typeinfos for variables in V).
@@ -1370,15 +1368,13 @@
% analysis.
maybe(list(mode)),
% declared modes of arguments.
- args_method
- % The args_method to be used for
- % the procedure. Usually this will
- % be set to the value of the --args
- % option stored in the globals.
- % lambda.m will set this field to
- % `compact' for procedures it creates
- % which must be directly callable by
- % a higher_order_call goal.
+ bool
+ % Is the address of this procedure
+ % taken? We must treat such procedures
+ % differently in at least two aspects.
+ % First, we must use the compact arg
+ % passing convention, and second, we
+ % must use typeinfo liveness for them.
).
% Some parts of the procedure aren't known yet. We initialize
@@ -1389,7 +1385,7 @@
% will later provide the correct inferred determinism for it.
proc_info_init(Arity, Types, Modes, DeclaredModes, MaybeArgLives,
- MaybeDet, MContext, ArgsMethod, NewProc) :-
+ MaybeDet, MContext, HasAddressTaken, NewProc) :-
varset__init(BodyVarSet0),
make_n_fresh_vars("HeadVar__", Arity, BodyVarSet0,
HeadVars, BodyVarSet),
@@ -1407,28 +1403,28 @@
MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
ArgInfo, InitialLiveness, TVarsMap, TCVarsMap, eval_normal,
- no, no, DeclaredModes, ArgsMethod
+ no, no, DeclaredModes, HasAddressTaken
).
proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
HeadLives, Goal, Context, StackSlots, InferredDetism,
- CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap,
- ArgSizes, Termination, ArgsMethod, ProcInfo) :-
+ CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, ArgSizes,
+ Termination, HasAddressTaken, ProcInfo) :-
ProcInfo = procedure(
DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
HeadLives, Goal, Context, StackSlots, InferredDetism,
CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, eval_normal,
- ArgSizes, Termination, no, ArgsMethod).
+ ArgSizes, Termination, no, HasAddressTaken).
proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
- Context, TVarMap, TCVarsMap, ArgsMethod, ProcInfo) :-
+ Context, TVarMap, TCVarsMap, HasAddressTaken, ProcInfo) :-
map__init(StackSlots),
set__init(Liveness),
MaybeHeadLives = no,
ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
Liveness, TVarMap, TCVarsMap, eval_normal, no, no, no,
- ArgsMethod).
+ HasAddressTaken).
proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, ProcInfo) :-
ProcInfo0 = procedure(A, _, _, _, E, F, _,
@@ -1566,7 +1562,7 @@
ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
_, _, S, _).
-proc_info_args_method(ProcInfo, T) :-
+proc_info_has_address_taken(ProcInfo, T) :-
ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
_, _, _, T).
@@ -1622,15 +1618,13 @@
% % analysis.
% S maybe(list(mode))
% % declared modes of arguments.
-% T args_method
-% % The args_method to be used for
-% % the procedure. Usually this will
-% % be set to the value of the --args
-% % option stored in the globals.
-% % lambda.m will set this field to
-% % `compact' for procedures it creates
-% % which must be directly callable by
-% % a higher_order_call goal.
+% T bool
+% % Is the address of this procedure
+% % taken? We must treat such procedures
+% % differently in at least two aspects.
+% % First, we must use the compact arg
+% % passing convention, and second, we
+% % must use typeinfo liveness for them.
% ).
proc_info_set_varset(ProcInfo0, B, ProcInfo) :-
@@ -1726,12 +1720,6 @@
proc_info_set_maybe_termination_info(ProcInfo0, R, ProcInfo) :-
ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
P, Q, _, S, T),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T).
-
-proc_info_set_args_method(ProcInfo0, T, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, _),
ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
P, Q, R, S, T).
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.48
diff -u -b -u -r1.48 lambda.m
--- lambda.m 1998/12/06 23:43:27 1.48
+++ lambda.m 1999/05/28 08:54:34
@@ -337,13 +337,6 @@
module_info_pred_proc_info(ModuleInfo0, PredId0, ProcId0, _,
Call_ProcInfo),
- % check that this procedure uses an args_method which
- % is always directly higher-order callable.
- proc_info_args_method(Call_ProcInfo, Call_ArgsMethod),
- module_info_globals(ModuleInfo0, Globals),
- arg_info__args_method_is_ho_callable(Globals,
- Call_ArgsMethod, yes),
-
list__remove_suffix(CallVars, Vars, InitialVars),
% check that none of the variables that we're trying to
@@ -462,24 +455,12 @@
init_markers(LambdaMarkers)
),
- % Choose an args_method which is always directly callable
- % from do_call_*_closure even if the inputs don't preceed
- % the outputs in the declaration. mercury_ho_call.c requires
- % that procedures which are directly higher-order-called use
- % the compact args_method.
- %
- % Previously we permuted the argument variables so that
- % inputs came before outputs, but that resulted in the
- % HLDS not being type or mode correct which caused problems
- % for some transformations and for rerunning mode analysis.
- arg_info__ho_call_args_method(Globals, ArgsMethod),
-
% Now construct the proc_info and pred_info for the new
% single-mode predicate, using the information computed above
proc_info_create(VarSet, VarTypes, AllArgVars,
AllArgModes, Detism, LambdaGoal, LambdaContext,
- TVarMap, TCVarMap, ArgsMethod, ProcInfo),
+ TVarMap, TCVarMap, yes, ProcInfo),
pred_info_create(ModuleName, PredName, TVarSet, ExistQVars,
ArgTypes, true, LambdaContext, local, LambdaMarkers,
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.80
diff -u -b -u -r1.80 live_vars.m
--- live_vars.m 1998/11/20 04:08:06 1.80
+++ live_vars.m 1999/05/28 11:20:41
@@ -258,12 +258,8 @@
% by the call, plus all the variables that may be needed
% at an enclosing resumption point.
- % To figure out which variables are output, we use the arg_info;
- % but it shouldn't matter which arg convention we're using,
- % so we can just pass convention `simple' to make_arg_infos.
-
determinism_to_code_model(Det, CallModel),
- make_arg_infos(simple, Types, Modes, CallModel, ModuleInfo, ArgInfos),
+ make_arg_infos(Types, Modes, CallModel, ModuleInfo, ArgInfos),
find_output_vars_from_arg_info(ArgVars, ArgInfos, OutVars),
set__difference(Liveness, OutVars, InputLiveness),
set__union(InputLiveness, ResumeVars0, StackVars0),
@@ -297,12 +293,8 @@
% by the call, plus all the variables that may be needed
% at an enclosing resumption point.
- % To figure out which variables are output, we use the arg_info;
- % but it shouldn't matter which arg convention we're using,
- % so we can just pass convention `simple' to make_arg_infos.
-
determinism_to_code_model(Det, CallModel),
- make_arg_infos(simple, Types, Modes, CallModel, ModuleInfo, ArgInfos),
+ make_arg_infos(Types, Modes, CallModel, ModuleInfo, ArgInfos),
find_output_vars_from_arg_info(ArgVars, ArgInfos, OutVars),
set__difference(Liveness, OutVars, InputLiveness),
set__union(InputLiveness, ResumeVars0, StackVars0),
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.3
diff -u -b -u -r1.3 magic.m
--- magic.m 1999/04/28 01:18:36 1.3
+++ magic.m 1999/05/28 08:54:36
@@ -687,7 +687,7 @@
{ varset__init(TVarSet) },
{ hlds_pred__define_new_pred(Goal, CallGoal, HeadVars, ExtraArgs,
InstMap, PredName, TVarSet, VarTypes, ClassContext, TVarMap,
- TCVarMap, VarSet, Markers, Owner,
+ TCVarMap, VarSet, Markers, Owner, no,
ModuleInfo1, ModuleInfo2, LocalPredProcId) },
{ ExtraArgs = [] ->
true
@@ -1148,7 +1148,7 @@
{ map__init(TCVarMap) },
{ proc_info_create(VarSet, DoCallAditiVarTypes, DoCallAditiHeadVars,
DoCallAditiArgModes, Detism, DummyGoal, DummyContext,
- TVarMap, TCVarMap, compact, DoCallAditiProcInfo) },
+ TVarMap, TCVarMap, no, DoCallAditiProcInfo) },
{ CPredProcId = proc(_, CProcId) },
magic_util__make_pred_name(CPredInfo1, CProcId, "Do_Aditi_Call_For",
@@ -1346,9 +1346,8 @@
{ map__init(TVarMap) },
{ map__init(TCVarMap) },
- { DummyArgsMethod = compact }, % never used
{ proc_info_create(VarSet, VarTypes, AllArgs, AllArgModes, nondet,
- Goal, Context, TVarMap, TCVarMap, DummyArgsMethod, ProcInfo) },
+ Goal, Context, TVarMap, TCVarMap, no, ProcInfo) },
%
% Fill in the pred_info.
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.1
diff -u -b -u -r1.1 magic_util.m
--- magic_util.m 1998/12/06 23:43:41 1.1
+++ magic_util.m 1999/05/28 08:54:36
@@ -1080,7 +1080,7 @@
{ unqualify_name(NewName, NewPredName) },
{ hlds_pred__define_new_pred(SuppGoal, SuppCall, SuppArgs, ExtraArgs,
InstMap, NewPredName, TVarSet, VarTypes, ClassConstraints,
- TVarMap, TCVarMap, VarSet, Markers, Owner,
+ TVarMap, TCVarMap, VarSet, Markers, Owner, no,
ModuleInfo0, ModuleInfo, _) },
{ ExtraArgs = [] ->
true
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.294
diff -u -b -u -r1.294 make_hlds.m
--- make_hlds.m 1999/05/18 01:53:33 1.294
+++ make_hlds.m 1999/05/28 08:54:37
@@ -23,7 +23,7 @@
:- interface.
:- import_module prog_data, hlds_module, hlds_pred, hlds_goal, hlds_data.
-:- import_module equiv_type, module_qual, globals.
+:- import_module equiv_type, module_qual.
:- import_module io, std_util, list, bool.
@@ -43,7 +43,7 @@
:- pred add_new_proc(pred_info, arity, list(mode), maybe(list(mode)),
maybe(list(is_live)), maybe(determinism),
- prog_context, args_method, pred_info, proc_id).
+ prog_context, bool, pred_info, proc_id).
:- mode add_new_proc(in, in, in, in, in, in, in, in, out, out) is det.
:- pred clauses_info_init(int::in, clauses_info::out) is det.
@@ -58,13 +58,13 @@
:- import_module prog_io, prog_io_goal, prog_io_dcg, prog_io_util, prog_out.
:- import_module modules, module_qual, prog_util, options, hlds_out.
-:- import_module make_tags, quantification, (inst), term, varset.
+:- import_module make_tags, quantification, (inst), globals.
:- import_module code_util, unify_proc, special_pred, type_util, mode_util.
:- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
:- import_module fact_table, purity, goal_util, term_util, export, llds, rl.
:- import_module string, char, int, set, bintree, map, multi_map, require.
-:- import_module getopt, assoc_list, term_io.
+:- import_module term, varset, getopt, assoc_list, term_io.
parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, Module,
UndefTypes, UndefModes) -->
@@ -506,7 +506,7 @@
FuncName, Arity, PredIds) }
->
{ predicate_table_get_preds(PredTable0, Preds0) },
- { maybe_add_default_modes(Module0, PredIds, Preds0, Preds) },
+ { maybe_add_default_modes(PredIds, Preds0, Preds) },
{ predicate_table_set_preds(PredTable0, Preds, PredTable) },
{ module_info_set_predicate_table(Module0, PredTable, Module) }
;
@@ -2158,8 +2158,7 @@
ModuleName, Func, FuncArity, [PredId])
->
module_info_pred_info(Module0, PredId, PredInfo0),
- maybe_add_default_mode(Module0, PredInfo0,
- PredInfo, MaybeProc),
+ maybe_add_default_mode(PredInfo0, PredInfo, MaybeProc),
(
MaybeProc = no,
PredProcIds1 = PredProcIds0,
@@ -2479,9 +2478,8 @@
ArgTypes, Cond, Context, ClausesInfo0, Status, Markers,
none, predicate, ClassContext, Proofs, Owner, PredInfo0),
ArgLives = no,
- globals__get_args_method(Globals, ArgsMethod),
add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
- ArgLives, yes(Det), Context, ArgsMethod, PredInfo, _),
+ ArgLives, yes(Det), Context, no, PredInfo, _),
module_info_get_predicate_table(Module0, PredicateTable0),
predicate_table_insert(PredicateTable0, PredInfo, may_be_unqualified,
@@ -2521,12 +2519,12 @@
).
add_new_proc(PredInfo0, Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives,
- MaybeDet, Context, ArgsMethod, PredInfo, ModeId) :-
+ MaybeDet, Context, HasAddressTaken, PredInfo, ModeId) :-
pred_info_procedures(PredInfo0, Procs0),
pred_info_arg_types(PredInfo0, ArgTypes),
next_mode_id(Procs0, MaybeDet, ModeId),
proc_info_init(Arity, ArgTypes, ArgModes, MaybeDeclaredArgModes,
- MaybeArgLives, MaybeDet, Context, ArgsMethod, NewProc),
+ MaybeArgLives, MaybeDet, Context, HasAddressTaken, NewProc),
map__det_insert(Procs0, ModeId, NewProc, Procs),
pred_info_set_procedures(PredInfo0, Procs, PredInfo).
@@ -2602,9 +2600,8 @@
% add the mode declaration to the pred_info for this procedure.
{ ArgLives = no },
- globals__io_get_args_method(ArgsMethod),
{ add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives,
- MaybeDet, MContext, ArgsMethod, PredInfo, ProcId) },
+ MaybeDet, MContext, no, PredInfo, ProcId) },
{ map__det_update(Preds0, PredId, PredInfo, Preds) },
{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
{ module_info_set_predicate_table(ModuleInfo0, PredicateTable,
@@ -2775,7 +2772,7 @@
{
pred_info_clauses_info(PredInfo1, Clauses0),
pred_info_typevarset(PredInfo1, TVarSet0),
- maybe_add_default_mode(ModuleInfo0, PredInfo1, PredInfo2, _),
+ maybe_add_default_mode(PredInfo1, PredInfo2, _),
pred_info_procedures(PredInfo2, Procs),
map__keys(Procs, ModeIds)
},
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.127
diff -u -b -u -r1.127 mercury_compile.m
--- mercury_compile.m 1999/05/28 05:26:26 1.127
+++ mercury_compile.m 1999/05/31 01:16:08
@@ -2347,12 +2347,6 @@
;
UseTrailOpt = ""
},
- globals__io_get_args_method(ArgsMethod),
- { ArgsMethod = compact ->
- ArgsOpt = "-DCOMPACT_ARGS "
- ;
- ArgsOpt = ""
- },
globals__io_lookup_bool_option(type_layout, TypeLayoutOption),
{ TypeLayoutOption = no ->
TypeLayoutOpt = "-DNO_TYPE_LAYOUT "
@@ -2402,7 +2396,7 @@
PIC_Reg_Opt, TagsOpt, NumTagBitsOpt,
C_DebugOpt, LL_DebugOpt,
StackTraceOpt, RequireTracingOpt,
- UseTrailOpt, ArgsOpt, TypeLayoutOpt,
+ UseTrailOpt, TypeLayoutOpt,
InlineAllocOpt, WarningOpt, CFLAGS,
" -c ", C_File, " -o ", O_File], Command) },
invoke_system_command(Command, Succeeded),
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.28
diff -u -b -u -r1.28 modecheck_call.m
--- modecheck_call.m 1999/05/18 03:08:56 1.28
+++ modecheck_call.m 1999/05/28 08:54:39
@@ -185,7 +185,7 @@
mode_info_get_preds(ModeInfo0, Preds),
mode_info_get_module_info(ModeInfo0, ModuleInfo),
map__lookup(Preds, PredId, PredInfo0),
- maybe_add_default_mode(ModuleInfo, PredInfo0, PredInfo, _),
+ maybe_add_default_mode(PredInfo0, PredInfo, _),
pred_info_procedures(PredInfo, Procs),
( MayChangeCalledProc = may_not_change_called_proc ->
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.264
diff -u -b -u -r1.264 options.m
--- options.m 1999/05/27 05:14:33 1.264
+++ options.m 1999/05/31 02:30:58
@@ -493,7 +493,6 @@
% the `mmc' script will override the
% above default with a value determined
% at configuration time
- args - string("compact"),
sync_term_size - int(8),
% 8 is the size on linux (at the time
% of writing) - will usually be over-
@@ -844,8 +843,6 @@
long_option("bits-per-word", bits_per_word).
long_option("bytes-per-word", bytes_per_word).
long_option("conf-low-tag-bits", conf_low_tag_bits).
-long_option("args", args).
-long_option("arg-convention", args).
long_option("type-layout", type_layout).
long_option("agc-stack-layout", agc_stack_layout).
long_option("basic-stack-layout", basic_stack_layout).
@@ -1750,19 +1747,6 @@
% The --bytes-per-word option is intended for use
% by the `mmc' script; it is deliberately not documented.
-
- "--args {simple, compact}",
- "--arg-convention {simple, compact}",
- "(This option is not for general use.)",
- "\tUse the specified argument passing convention",
- "\tin the generated low-level C code. With the `simple'",
- "\tconvention, the <n>th argument is passed in or out",
- "\tusing register r<n>. With the `compact' convention,",
- "\tthe <n>th input argument is passed using register r<n>,",
- "\tand the <n>th output argument is returned using",
- "\tregister r<n>. The compact convention generally leads to",
- "\tmore efficient code. Use of the simple convention requires the",
- "\tC code to be compiled with -UCOMPACT_ARGS.",
"--no-type-layout",
"(This option is not for general use.)",
Index: compiler/pd_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_info.m,v
retrieving revision 1.4
diff -u -b -u -r1.4 pd_info.m
--- pd_info.m 1998/12/06 23:44:21 1.4
+++ pd_info.m 1999/05/28 08:54:43
@@ -745,7 +745,8 @@
% --typeinfo-liveness properly.
{ hlds_pred__define_new_pred(Goal, CallGoal, Args, _ExtraArgs, InstMap,
Name, TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
- VarSet, Markers, Owner, ModuleInfo0, ModuleInfo, PredProcId) },
+ VarSet, Markers, Owner, no,
+ ModuleInfo0, ModuleInfo, PredProcId) },
pd_info_set_module_info(ModuleInfo).
%-----------------------------------------------------------------------------%
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.5
diff -u -b -u -r1.5 post_typecheck.m
--- post_typecheck.m 1998/12/06 23:44:29 1.5
+++ post_typecheck.m 1999/05/28 08:54:44
@@ -326,7 +326,7 @@
% declarations are module qualified.
%
post_typecheck__finish_pred(ModuleInfo, PredId, PredInfo1, PredInfo) -->
- { maybe_add_default_mode(ModuleInfo, PredInfo1, PredInfo2, _) },
+ { maybe_add_default_mode(PredInfo1, PredInfo2, _) },
{ copy_clauses_to_procs(PredInfo2, PredInfo3) },
post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
PredInfo3, PredInfo).
@@ -338,7 +338,7 @@
%
post_typecheck__finish_ill_typed_pred(ModuleInfo, PredId,
PredInfo0, PredInfo) -->
- { maybe_add_default_mode(ModuleInfo, PredInfo0, PredInfo1, _) },
+ { maybe_add_default_mode(PredInfo0, PredInfo1, _) },
post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
PredInfo1, PredInfo).
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.97
diff -u -b -u -r1.97 unify_gen.m
--- unify_gen.m 1999/04/30 06:19:56 1.97
+++ unify_gen.m 1999/05/31 04:34:55
@@ -384,16 +384,6 @@
{ map__lookup(Preds, PredId, PredInfo) },
{ pred_info_procedures(PredInfo, Procs) },
{ map__lookup(Procs, ProcId, ProcInfo) },
-
- % lambda.m adds wrapper procedures for procedures which don't
- % use an args_method compatible with do_call_*_closure.
- { proc_info_args_method(ProcInfo, ArgsMethod) },
- { module_info_globals(ModuleInfo, Globals) },
- ( { arg_info__args_method_is_ho_callable(Globals, ArgsMethod, yes) } ->
- []
- ;
- { error("unify_gen__generate_construction_2: pred constant not callable") }
- ),
%
% We handle currying of a higher-order pred variable as a special case.
% We recognize
@@ -514,6 +504,7 @@
CodeAddr),
{ code_util__extract_proc_label_from_code_addr(CodeAddr,
ProcLabel) },
+ { module_info_globals(ModuleInfo, Globals) },
{ globals__lookup_bool_option(Globals, typeinfo_liveness,
TypeInfoLiveness) },
{
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.74
diff -u -b -u -r1.74 unify_proc.m
--- unify_proc.m 1999/05/27 05:14:44 1.74
+++ unify_proc.m 1999/05/28 08:55:12
@@ -267,10 +267,8 @@
map__lookup(Preds0, PredId, PredInfo0),
list__length(ArgModes, Arity),
DeclaredArgModes = no,
- module_info_globals(ModuleInfo0, Globals),
- globals__get_args_method(Globals, ArgsMethod),
add_new_proc(PredInfo0, Arity, ArgModes, DeclaredArgModes,
- ArgLives, MaybeDet, Context, ArgsMethod, PredInfo1, ProcId),
+ ArgLives, MaybeDet, Context, no, PredInfo1, ProcId),
%
% copy the clauses for the procedure from the pred_info to the
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.174
diff -u -b -u -r1.174 user_guide.texi
--- user_guide.texi 1999/05/24 04:37:21 1.174
+++ user_guide.texi 1999/05/31 02:31:19
@@ -3028,20 +3028,6 @@
is determined by the auto-configuration script.
@sp 1
- at item @code{--args @{simple, compact@}}
- at item @code{--arg-convention @{simple, compact@}}
-(This option is not intended for general use.)@*
-Use the specified argument passing convention
-in the generated low-level C code.
-With the @samp{simple} convention,
-the @var{n}th argument is passed in or out using register r at var{n}.
-With the @samp{compact} convention,
-the @var{n}th input argument is passed using register r at var{n}
-and the @var{n}th output argument is returned using register r at var{n}.
-The @samp{compact} convention, which is the default,
-generally leads to more efficient code.
-
- at sp 1
@item @code{--no-type-layout}
(This option is not intended for general use.)@*
Don't output base_type_layout structures or references to them.
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/dynamic_linking
cvs diff: Diffing extras/exceptions
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/odbc
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 library
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.53
diff -u -b -u -r1.53 array.m
--- array.m 1999/03/31 04:42:49 1.53
+++ array.m 1999/05/31 02:24:45
@@ -303,7 +303,7 @@
ENTRY(mercury____Unify___array__array_1_0));
Define_entry(mercury____Index___array__array_1_0);
- index_output = -1;
+ r1 = -1;
proceed();
Define_entry(mercury____Compare___array__array_1_0);
Index: library/benchmarking.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/benchmarking.m,v
retrieving revision 1.23
diff -u -b -u -r1.23 benchmarking.m
--- benchmarking.m 1999/05/26 04:13:53 1.23
+++ benchmarking.m 1999/05/31 02:05:25
@@ -550,29 +550,14 @@
** :- mode benchmark_det(pred(in, out) is det, in, out, in, out) is det.
**
** Polymorphism will add two extra input parameters, type_infos for T1 and T2,
-** which we don't use. With both the simple and compact argument passing
-** conventions, these will be in r1 and r2, while the closure will be in r3,
-** and the input data in r4. The repetition count will be in r6 for simple
-** and r5 for compact.
+** which we don't use. These will be in r1 and r2, while the closure will be
+** in r3, and the input data in r4. The repetition count will be in r5.
**
** The first output is a count of solutions for benchmark_nondet and the
** actual solution for benchmark_det; the second output for both is the
-** time taken in milliseconds. The outputs go into r5 and r7 for the simple
-** convention and and r1 and r2 for the compact convention.
+** time taken in milliseconds.
*/
-#ifdef COMPACT_ARGS
- #define rep_count r5
- #define count_output r1
- #define soln_output r1
- #define time_output r2
-#else
- #define rep_count r6
- #define count_output r5
- #define soln_output r5
- #define time_output r7
-#endif
-
#ifdef MR_USE_TRAIL
#define BENCHMARK_NONDET_STACK_SLOTS 7
#else
@@ -621,10 +606,10 @@
framevar(0) = r3;
framevar(1) = r4;
- if (rep_count <= 0) {
+ if (r5 <= 0) {
framevar(2) = 1;
} else {
- framevar(2) = rep_count;
+ framevar(2) = r5;
}
framevar(3) = 0;
@@ -680,8 +665,8 @@
}
/* no more iterations */
- count_output = framevar(3);
- time_output = MR_get_user_cpu_miliseconds() - framevar(4);
+ r1 = framevar(3);
+ r2 = MR_get_user_cpu_miliseconds() - framevar(4);
succeed_discard();
END_MODULE
@@ -734,10 +719,10 @@
detstackvar(1) = r3;
detstackvar(2) = r4;
- if (rep_count <= 0) {
+ if (r5 <= 0) {
detstackvar(3) = 1;
} else {
- detstackvar(3) = rep_count;
+ detstackvar(3) = r5;
}
detstackvar(4) = MR_get_user_cpu_miliseconds();
@@ -778,8 +763,8 @@
}
/* no more iterations */
- soln_output = r1; /* the closure *always* returns its output in r1 */
- time_output = MR_get_user_cpu_miliseconds() - detstackvar(4);
+ /* r1 already contains the right value */
+ r2 = MR_get_user_cpu_miliseconds() - detstackvar(4);
succip = (Word *) detstackvar(6);
decr_sp(BENCHMARK_DET_STACK_SLOTS);
proceed();
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.14
diff -u -b -u -r1.14 builtin.m
--- builtin.m 1999/05/28 07:27:59 1.14
+++ builtin.m 1999/05/31 02:05:25
@@ -899,12 +899,7 @@
copy = deep_copy(&value, (Word *) type_info, NULL, NULL);
restore_transient_registers();
-#ifdef COMPACT_ARGS
r1 = copy;
-#else
- r3 = copy;
-#endif
-
proceed();
}
END_MODULE
@@ -972,16 +967,16 @@
** the io__state contains a map(io__stream, filename).
** However, it might not be correct in general...
*/
- unify_output = (unify_input1 == unify_input2);
+ r1 = (r1 == r2);
proceed();
Define_entry(mercury____Index___builtin__c_pointer_0_0);
- index_output = -1;
+ r1 = -1;
proceed();
Define_entry(mercury____Compare___builtin__c_pointer_0_0);
- compare_output = (compare_input1 == compare_input2 ? COMPARE_EQUAL :
- compare_input1 < compare_input2 ? COMPARE_LESS :
+ r1 = (r1 == r2 ? COMPARE_EQUAL :
+ r1 < r2 ? COMPARE_LESS :
COMPARE_GREATER);
proceed();
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.24
diff -u -b -u -r1.24 private_builtin.m
--- private_builtin.m 1999/05/24 13:21:50 1.24
+++ private_builtin.m 1999/05/31 02:05:25
@@ -459,15 +459,16 @@
** The success/failure indication should go in unify_output.
*/
int comp;
+
save_transient_registers();
- comp = MR_compare_type_info(unify_input1, unify_input2);
+ comp = MR_compare_type_info(r1, r2);
restore_transient_registers();
- unify_output = (comp == COMPARE_EQUAL);
+ r1 = (comp == COMPARE_EQUAL);
proceed();
}
Define_entry(mercury____Index___private_builtin__type_info_1_0);
- index_output = -1;
+ r1 = -1;
proceed();
Define_entry(mercury____Compare___private_builtin__type_info_1_0);
@@ -479,10 +480,11 @@
** The result should go in compare_output.
*/
int comp;
+
save_transient_registers();
- comp = MR_compare_type_info(compare_input1, compare_input2);
+ comp = MR_compare_type_info(r1, r2);
restore_transient_registers();
- compare_output = comp;
+ r1 = comp;
proceed();
}
Define_entry(mercury____Unify___private_builtin__typeclass_info_1_0);
@@ -490,7 +492,7 @@
fatal_error(""attempt to unify typeclass_info"");
}
Define_entry(mercury____Index___private_builtin__typeclass_info_1_0);
- index_output = -1;
+ r1 = -1;
proceed();
Define_entry(mercury____Compare___private_builtin__typeclass_info_1_0);
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.147
diff -u -b -u -r1.147 std_util.m
--- std_util.m 1999/04/30 06:21:06 1.147
+++ std_util.m 1999/05/31 02:05:26
@@ -541,17 +541,9 @@
** the address of the respective deep copy routines).
**
** The type_info structures will be in r1 and r2, the closures will be in
-** r3 and r4, and the 'initial value' will be in r5, with both calling
-** conventions. The output should go either in r6 (for the normal parameter
-** convention) or r1 (for the compact parameter convention).
+** r3 and r4, and the 'initial value' will be in r5.
*/
-#ifdef COMPACT_ARGS
- #define builtin_aggregate_output r1
-#else
- #define builtin_aggregate_output r6
-#endif
-
#ifdef PROFILE_CALLS
#define fallthru(target, caller) { tailcall((target), (caller)); }
#else
@@ -779,7 +771,7 @@
MR_ENGINE(solutions_heap_zone)->top);
restore_transient_registers();
- builtin_aggregate_output = copied_collection;
+ r1 = copied_collection;
/* reset solutions heap to where it was before call to solutions */
MR_sol_hp = (Word *) saved_solhp_fv;
@@ -893,7 +885,7 @@
#endif
/* return the collection and discard the frame we made */
- builtin_aggregate_output = sofar_fv;
+ r1 = sofar_fv;
succeed_discard();
#undef num_framevars
@@ -905,7 +897,6 @@
END_MODULE
-#undef builtin_aggregate_output
#undef swap_heap_and_solutions_heap
/* Ensure that the initialization code for the above module gets run. */
@@ -1037,8 +1028,10 @@
% 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, "{
- Word univ_type_info = field(mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO);
+ Word univ_type_info;
int comp;
+
+ univ_type_info = field(mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO);
save_transient_registers();
comp = MR_compare_type_info(univ_type_info, TypeInfo_for_T);
restore_transient_registers();
@@ -1101,18 +1094,6 @@
Define_extern_entry(mercury____Unify___std_util__univ_0_0);
Define_extern_entry(mercury____Index___std_util__univ_0_0);
Define_extern_entry(mercury____Compare___std_util__univ_0_0);
-
-#ifndef COMPACT_ARGS
-
-Declare_label(mercury____Compare___std_util__univ_0_0_i1);
-
-MR_MAKE_PROC_LAYOUT(mercury____Compare___std_util__univ_0_0,
- MR_DETISM_DET, 1, MR_LONG_LVAL_STACKVAR(1),
- MR_PREDICATE, ""std_util"", ""compare_univ"", 3, 0);
-MR_MAKE_INTERNAL_LAYOUT(mercury____Compare___std_util__univ_0_0, 1);
-
-#endif
-
Define_extern_entry(mercury____Unify___std_util__type_info_0_0);
Define_extern_entry(mercury____Index___std_util__type_info_0_0);
Define_extern_entry(mercury____Compare___std_util__type_info_0_0);
@@ -1120,18 +1101,10 @@
BEGIN_MODULE(unify_univ_module)
init_entry(mercury____Unify___std_util__univ_0_0);
init_entry(mercury____Index___std_util__univ_0_0);
-#ifdef COMPACT_ARGS
init_entry(mercury____Compare___std_util__univ_0_0);
-#else
- init_entry_sl(mercury____Compare___std_util__univ_0_0);
- MR_INIT_PROC_LAYOUT_ADDR(mercury____Compare___std_util__univ_0_0);
- init_label_sl(mercury____Compare___std_util__univ_0_0_i1);
-#endif
-
init_entry(mercury____Unify___std_util__type_info_0_0);
init_entry(mercury____Index___std_util__type_info_0_0);
init_entry(mercury____Compare___std_util__type_info_0_0);
-
BEGIN_CODE
Define_entry(mercury____Unify___std_util__univ_0_0);
{
@@ -1146,8 +1119,8 @@
Word typeinfo1, typeinfo2;
int comp;
- univ1 = unify_input1;
- univ2 = unify_input2;
+ univ1 = r1;
+ univ2 = r2;
/* First check the type_infos compare equal */
typeinfo1 = field(mktag(0), univ1, UNIV_OFFSET_FOR_TYPEINFO);
@@ -1156,7 +1129,7 @@
comp = MR_compare_type_info(typeinfo1, typeinfo2);
restore_transient_registers();
if (comp != COMPARE_EQUAL) {
- unify_output = FALSE;
+ r1 = FALSE;
proceed();
}
@@ -1164,9 +1137,9 @@
** Then invoke the generic unification predicate on the
** unwrapped args
*/
- mercury__unify__x = field(mktag(0), univ1, UNIV_OFFSET_FOR_DATA);
- mercury__unify__y = field(mktag(0), univ2, UNIV_OFFSET_FOR_DATA);
- mercury__unify__typeinfo = typeinfo1;
+ r1 = typeinfo1;
+ r2 = field(mktag(0), univ1, UNIV_OFFSET_FOR_DATA);
+ r3 = field(mktag(0), univ2, UNIV_OFFSET_FOR_DATA);
{
Declare_entry(mercury__unify_2_0);
tailcall(ENTRY(mercury__unify_2_0),
@@ -1175,7 +1148,7 @@
}
Define_entry(mercury____Index___std_util__univ_0_0);
- index_output = -1;
+ r1 = -1;
proceed();
Define_entry(mercury____Compare___std_util__univ_0_0);
@@ -1191,8 +1164,8 @@
Word typeinfo1, typeinfo2;
int comp;
- univ1 = compare_input1;
- univ2 = compare_input2;
+ univ1 = r1;
+ univ2 = r2;
/* First compare the type_infos */
typeinfo1 = field(mktag(0), univ1, UNIV_OFFSET_FOR_TYPEINFO);
@@ -1201,7 +1174,7 @@
comp = MR_compare_type_info(typeinfo1, typeinfo2);
restore_transient_registers();
if (comp != COMPARE_EQUAL) {
- compare_output = comp;
+ r1 = comp;
proceed();
}
@@ -1210,39 +1183,15 @@
** predicate on the unwrapped args.
*/
-#ifdef COMPACT_ARGS
r1 = typeinfo1;
- r3 = field(mktag(0), univ2, UNIV_OFFSET_FOR_DATA);
r2 = field(mktag(0), univ1, UNIV_OFFSET_FOR_DATA);
+ r3 = field(mktag(0), univ2, UNIV_OFFSET_FOR_DATA);
{
Declare_entry(mercury__compare_3_0);
tailcall(ENTRY(mercury__compare_3_0),
LABEL(mercury____Compare___std_util__univ_0_0));
}
-#else
- r1 = typeinfo1;
- r4 = field(mktag(0), univ2, UNIV_OFFSET_FOR_DATA);
- r3 = field(mktag(0), univ1, UNIV_OFFSET_FOR_DATA);
- incr_sp_push_msg(1, ""mercury____Compare___std_util__univ_0_0"");
- MR_stackvar(1) = MR_succip;
- {
- Declare_entry(mercury__compare_3_0);
- call(ENTRY(mercury__compare_3_0),
- LABEL(mercury____Compare___std_util__univ_0_0_i1),
- LABEL(mercury____Compare___std_util__univ_0_0));
- }
}
-Define_label(mercury____Compare___std_util__univ_0_0_i1);
-{
- update_prof_current_proc(
- LABEL(mercury____Compare___std_util__univ_0_0));
-
- /* shuffle the return value into the right register */
- r1 = r2;
- MR_succip = MR_stackvar(1);
- proceed();
-#endif
-}
Define_entry(mercury____Unify___std_util__type_info_0_0);
{
@@ -1253,15 +1202,16 @@
** The success/failure indication should go in unify_output.
*/
int comp;
+
save_transient_registers();
- comp = MR_compare_type_info(unify_input1, unify_input2);
+ comp = MR_compare_type_info(r1, r2);
restore_transient_registers();
- unify_output = (comp == COMPARE_EQUAL);
+ r1 = (comp == COMPARE_EQUAL);
proceed();
}
Define_entry(mercury____Index___std_util__type_info_0_0);
- index_output = -1;
+ r1 = -1;
proceed();
Define_entry(mercury____Compare___std_util__type_info_0_0);
@@ -1273,10 +1223,11 @@
** The result should go in compare_output.
*/
int comp;
+
save_transient_registers();
- comp = MR_compare_type_info(unify_input1, unify_input2);
+ comp = MR_compare_type_info(r1, r2);
restore_transient_registers();
- compare_output = comp;
+ r1 = comp;
proceed();
}
cvs diff: Diffing profiler
cvs diff: Diffing runtime
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.24
diff -u -b -u -r1.24 mercury_conf_param.h
--- mercury_conf_param.h 1999/05/26 04:13:00 1.24
+++ mercury_conf_param.h 1999/05/28 09:08:43
@@ -44,7 +44,6 @@
** USE_ASM_LABELS
** CONSERVATIVE_GC
** NATIVE_GC [not yet working]
-** COMPACT_ARGS
** NO_TYPE_LAYOUT
** BOXED_FLOAT
** MR_USE_TRAIL
Index: runtime/mercury_grade.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_grade.h,v
retrieving revision 1.19
diff -u -b -u -r1.19 mercury_grade.h
--- mercury_grade.h 1999/04/30 04:25:39 1.19
+++ mercury_grade.h 1999/05/28 09:08:38
@@ -155,11 +155,7 @@
#define MR_GRADE_PART_9 MR_PASTE2(MR_GRADE_PART_8, _ubf)
#endif
-#ifdef COMPACT_ARGS
- #define MR_GRADE_PART_10 MR_GRADE_PART_9
-#else /* "sa" stands for "simple args" */
- #define MR_GRADE_PART_10 MR_PASTE2(MR_GRADE_PART_9, _sa)
-#endif
+#define MR_GRADE_PART_10 MR_GRADE_PART_9
#if defined(PIC_REG) && defined(USE_GCC_GLOBAL_REGISTERS) && defined(__i386__)
#define MR_GRADE_PART_11 MR_PASTE2(MR_GRADE_PART_10, _picreg)
@@ -286,7 +282,7 @@
#endif
/*
-** Parts 8-10 above (i.e. tag bits, compact args, and (un)boxed float)
+** Parts 8-10 above (i.e. tag bits, and (un)boxed float)
** are documented as "not for general use", and can't be set via the
** `--grade' option; we don't bother to pass them on.
*/
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.19
diff -u -b -u -r1.19 mercury_ho_call.c
--- mercury_ho_call.c 1999/04/23 05:43:26 1.19
+++ mercury_ho_call.c 1999/05/31 01:52:19
@@ -17,9 +17,6 @@
** provided by the higher-order call may be input or output, and may appear
** in any order.
**
-** The procedure whose address is contained in the closure must use the
-** `compact' argument convention.
-**
** The input arguments to do_call_*_closure are the closure in r1,
** the number of additional input arguments in r2, the number of output
** arguments to expect in r3, and the additional input arguments themselves
@@ -84,27 +81,6 @@
Define_extern_entry(mercury__compare_3_3);
Declare_label(mercury__compare_3_0_i1);
-#ifdef COMPACT_ARGS
- /*
- ** With compact args, all these methods just do some data shuffling
- ** and then a tailcall. They never have stack frames, and therefore
- ** do not participate in stack traces.
- */
-#else
- /*
- ** With simple args, some of these procedures make proper calls,
- ** and thus have stack frames.
- */
- MR_MAKE_PROC_LAYOUT(mercury__index_2_0,
- MR_DETISM_DET, 2, MR_LIVE_LVAL_STACKVAR(2),
- MR_PREDICATE, "builtin", "index", 2, 0);
- MR_MAKE_INTERNAL_LAYOUT(mercury__index_2_0, 1);
- MR_MAKE_PROC_LAYOUT(mercury__compare_3_0,
- MR_DETISM_DET, 2, MR_LIVE_LVAL_STACKVAR(2),
- MR_PREDICATE, "builtin", "compare", 3, 0);
- MR_MAKE_INTERNAL_LAYOUT(mercury__compare_3_0, 1);
-#endif
-
BEGIN_MODULE(call_module)
init_entry_ai(do_call_det_closure);
init_entry_ai(do_call_semidet_closure);
@@ -120,15 +96,8 @@
init_entry_ai(mercury__do_call_class_method);
init_entry_ai(mercury__unify_2_0);
-#ifdef COMPACT_ARGS
init_entry_ai(mercury__index_2_0);
init_entry_ai(mercury__compare_3_0);
-#else
- init_entry_sl(mercury__index_2_0);
- init_label_sl(mercury__index_2_0_i1);
- init_entry_sl(mercury__compare_3_0);
- init_label_sl(mercury__compare_3_0_i1);
-#endif
init_entry_ai(mercury__compare_3_1);
init_entry_ai(mercury__compare_3_2);
init_entry_ai(mercury__compare_3_3);
@@ -281,17 +250,8 @@
** mercury__unify_2_0 is called as `unify(TypeInfo, X, Y)'
** in the mode `unify(in, in, in) is semidet'.
**
-** With the simple parameter passing convention, the inputs are in the
-** registers r2, r3 and r4. With the compact parameter passing convention,
-** the inputs are in the registers r1, r2 and r3.
-**
-** The only output is the success/failure indication,
-** which goes in r1 with both calling conventions.
-**
** We call the type-specific unification routine as
** `UnifyPred(...ArgTypeInfos..., X, Y)' is semidet, with all arguments input.
-** Again r1 will hold the success/failure continuation; the input arguments
-** start either in r1 or r2 depending on the argument passing convention.
*/
Define_entry(mercury__unify_2_0);
@@ -305,21 +265,20 @@
Word type_ctor_info;
- x = mercury__unify__x;
- y = mercury__unify__y;
+ x = r2;
+ y = r3;
- type_ctor_info = field(0, mercury__unify__typeinfo, 0);
+ type_ctor_info = field(0, r1, 0);
if (type_ctor_info == 0) {
type_arity = 0;
- unify_pred = (Code *) field(0, mercury__unify__typeinfo,
- OFFSET_FOR_UNIFY_PRED);
+ unify_pred = (Code *) field(0, r1, OFFSET_FOR_UNIFY_PRED);
/* args_base will not be needed */
args_base = 0; /* just to supress a gcc warning */
} else {
type_arity = field(0, type_ctor_info, OFFSET_FOR_COUNT);
unify_pred = (Code *) field(0, type_ctor_info,
OFFSET_FOR_UNIFY_PRED);
- args_base = mercury__unify__typeinfo;
+ args_base = r1;
}
save_registers();
@@ -327,11 +286,10 @@
/* we call `UnifyPred(...ArgTypeInfos..., X, Y)' */
/* virtual_reg(1) will hold the success/failure indication */
for (i = 1; i <= type_arity; i++) {
- virtual_reg(i + mercury__unify__offset) =
- field(0, args_base, i);
+ virtual_reg(i) = field(0, args_base, i);
}
- virtual_reg(type_arity + mercury__unify__offset + 1) = x;
- virtual_reg(type_arity + mercury__unify__offset + 2) = y;
+ virtual_reg(type_arity + 1) = x;
+ virtual_reg(type_arity + 2) = y;
restore_registers();
@@ -342,18 +300,10 @@
** mercury__index_2_0 is called as `index(TypeInfo, X, Index)'
** in the mode `index(in, in, out) is det'.
**
-** With both parameter passing conventions, the inputs are in r1 and r2.
-** With the simple parameter passing convention, the output is in r3;
-** with the compact parameter passing convention, the output is in r1.
-**
** We call the type-specific index routine as
** `IndexPred(...ArgTypeInfos..., X, Index)' is det.
-** The ArgTypeInfo and X arguments are input, and are passed in r1, r2, ... rN
-** with both conventions. The Index argument is output; it is returned in
-** r1 with the compact convention and rN+1 with the simple convention.
-**
-** With the compact convention, we can make the call to the type-specific
-** routine a tail call, and we do so. With the simple convention, we can't.
+** The ArgTypeInfo and X arguments are input, while the Index argument
+** is output.
*/
Define_entry(mercury__index_2_0);
@@ -391,24 +341,8 @@
restore_registers();
-#ifdef COMPACT_ARGS
tailcall(index_pred, LABEL(mercury__index_2_0));
-#else
- incr_sp_push_msg(2, "mercury__index_2_0");
- MR_stackvar(2) = (Word) MR_succip;
- MR_stackvar(1) = type_arity;
- call(index_pred, LABEL(mercury__index_2_0_i1),
- LABEL(mercury__index_2_0));
}
-Define_label(mercury__index_2_0_i1);
-{
- MR_succip = (Code *) MR_stackvar(2);
- save_registers();
- r3 = virtual_reg(MR_stackvar(1) + 2);
- decr_sp_pop_msg(2);
- proceed();
-#endif
-}
/*
** mercury__compare_3_3 is called as `compare(TypeInfo, Result, X, Y)'
@@ -416,23 +350,11 @@
**
** (The additional entry points replace either or both "in"s with "ui"s.)
**
-** With the simple parameter passing convention, the inputs are in r1,
-** r3 and r4, while the output is in r2.
-**
-** With the compact parameter passing convention, the inputs are in r1,
-** r2 and r3, while the output is in r1.
-**
** We call the type-specific compare routine as
** `ComparePred(...ArgTypeInfos..., Result, X, Y)' is det.
-** The ArgTypeInfo arguments are input, and are passed in r1, r2, ... rN
-** with both conventions. The X and Y arguments are also input, but are passed
-** in different registers (rN+2 and rN+3 with the simple convention and rN+1
-** and rN+2 with the compact convention). The Index argument is output; it is
-** returned in ** r1 with the compact convention and rN+1 with the simple
-** convention.
-**
-** With the compact convention, we can make the call to the type-specific
-** routine a tail call, and we do so. With the simple convention, we can't.
+** The ArgTypeInfo arguments are input, and are passed in r1, r2, ... rN.
+** The X and Y arguments are also input, and are passed in rN+1 and rN+2.
+** The Index argument is output.
*/
Define_entry(mercury__compare_3_0);
@@ -464,21 +386,20 @@
Word type_ctor_info;
- x = mercury__compare__x;
- y = mercury__compare__y;
+ x = r2;
+ y = r3;
- type_ctor_info = field(0, mercury__compare__typeinfo, 0);
+ type_ctor_info = field(0, r1, 0);
if (type_ctor_info == 0) {
type_arity = 0;
- compare_pred = (Code *) field(0, mercury__compare__typeinfo,
- OFFSET_FOR_COMPARE_PRED);
+ compare_pred = (Code *) field(0, r1, OFFSET_FOR_COMPARE_PRED);
/* args_base will not be needed */
args_base = 0; /* just to supress a gcc warning */
} else {
type_arity = field(0, type_ctor_info, OFFSET_FOR_COUNT);
compare_pred = (Code *) field(0, type_ctor_info,
OFFSET_FOR_COMPARE_PRED);
- args_base = mercury__compare__typeinfo;
+ args_base = r1;
}
save_registers();
@@ -487,30 +408,15 @@
for (i = 1; i <= type_arity; i++) {
virtual_reg(i) = field(0, args_base, i);
}
- virtual_reg(type_arity + mercury__compare__offset + 1) = x;
- virtual_reg(type_arity + mercury__compare__offset + 2) = y;
+ virtual_reg(type_arity + 1) = x;
+ virtual_reg(type_arity + 2) = y;
restore_registers();
-#ifdef COMPACT_ARGS
tailcall(compare_pred, LABEL(mercury__compare_3_3));
-#else
- incr_sp_push_msg(2, "mercury__index_2_0");
- MR_stackvar(2) = (Word) MR_succip;
- MR_stackvar(1) = type_arity;
- call(compare_pred, LABEL(mercury__compare_3_0_i1),
- LABEL(mercury__compare_3_3));
-}
-Define_label(mercury__compare_3_0_i1);
-{
- MR_succip = (Code *) MR_stackvar(2);
- save_registers();
- r2 = virtual_reg(MR_stackvar(1) + 1);
- decr_sp_pop_msg(2);
- proceed();
-#endif
}
END_MODULE
+
void mercury_sys_init_call(void); /* suppress gcc warning */
void mercury_sys_init_call(void) {
call_module();
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.4
diff -u -b -u -r1.4 mercury_tabling.c
--- mercury_tabling.c 1999/04/22 01:04:30 1.4
+++ mercury_tabling.c 1999/05/28 09:08:41
@@ -1517,13 +1517,8 @@
*/
-#ifdef COMPACT_ARGS
r1 = (Word) &MR_cur_leader->resume_info->cur_consumer_answer_list->
answer_data;
-#else
- r2 = (Word) &MR_cur_leader->resume_info->cur_consumer_answer_list->
- answer_data;
-#endif
MR_cur_leader->resume_info->cur_consumer->remaining_answer_list_ptr =
&(MR_cur_leader->resume_info->cur_consumer_answer_list->
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.21
diff -u -b -u -r1.21 mercury_type_info.h
--- mercury_type_info.h 1999/05/07 08:09:05 1.21
+++ mercury_type_info.h 1999/05/31 02:05:05
@@ -78,50 +78,6 @@
#define COMPARE_LESS 1
#define COMPARE_GREATER 2
-#ifdef COMPACT_ARGS
-#define mercury__unify__typeinfo r1
-#define mercury__unify__x r2
-#define mercury__unify__y r3
-#define mercury__unify__offset 0
-#define mercury__compare__typeinfo r1
-#define mercury__compare__x r2
-#define mercury__compare__y r3
-#define mercury__compare__offset 0
-#define mercury__term_to_type__typeinfo r1
-#define mercury__term_to_type__term r2
-#define mercury__term_to_type__x r4
-#define mercury__term_to_type__offset 1
-#define unify_input1 r1
-#define unify_input2 r2
-#define unify_output r1
-#define compare_input1 r1
-#define compare_input2 r2
-#define compare_output r1
-#define index_input r1
-#define index_output r1
-#else
-#define mercury__unify__typeinfo r2
-#define mercury__unify__x r3
-#define mercury__unify__y r4
-#define mercury__unify__offset 1
-#define mercury__compare__typeinfo r1
-#define mercury__compare__x r3
-#define mercury__compare__y r4
-#define mercury__compare__offset 1
-#define mercury__term_to_type__typeinfo r2
-#define mercury__term_to_type__term r3
-#define mercury__term_to_type__x r4
-#define mercury__term_to_type__offset 1
-#define unify_input1 r2
-#define unify_input2 r3
-#define unify_output r1
-#define compare_input1 r2
-#define compare_input2 r3
-#define compare_output r1
-#define index_input r1
-#define index_output r2
-#endif
-
/*---------------------------------------------------------------------------*/
/*
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 scripts
Index: scripts/c2init.in
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/c2init.in,v
retrieving revision 1.23
diff -u -b -u -r1.23 c2init.in
--- c2init.in 1999/04/26 03:10:23 1.23
+++ c2init.in 1999/05/31 05:20:47
@@ -61,7 +61,6 @@
--profile-memory
--debug
--use-trail
- --args {simple, compact}
--pic-reg
See the documentation in the \"Invocation\" section
of the Mercury User's Guide.
Index: scripts/init_grade_options.sh-subr
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/init_grade_options.sh-subr,v
retrieving revision 1.6
diff -u -b -u -r1.6 init_grade_options.sh-subr
--- init_grade_options.sh-subr 1999/04/20 11:48:28 1.6
+++ init_grade_options.sh-subr 1999/05/31 05:19:23
@@ -22,7 +22,6 @@
profile_memory=false
use_trail=false
use_minimal_model=false
-args_method=compact
stack_trace=false
require_tracing=false
low_level_debug=false
Index: scripts/mgnuc.in
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/mgnuc.in,v
retrieving revision 1.63
diff -u -b -u -r1.63 mgnuc.in
--- mgnuc.in 1999/04/20 11:48:28 1.63
+++ mgnuc.in 1999/05/31 05:27:24
@@ -33,7 +33,6 @@
-g, --c-debug
--no-c-optimize
--use-trail
- --args {simple, compact}
--pic-reg
--inline-alloc
--split-c-files
@@ -284,11 +283,6 @@
*) THREAD_OPTS="" ;;
esac ;;
false) THREAD_OPTS="" ;;
-esac
-
-case $args_method in
- simple) ARG_OPTS="" ;;
- compact) ARG_OPTS="-DCOMPACT_ARGS" ;;
esac
case $pic_reg in
Index: scripts/ml.in
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/ml.in,v
retrieving revision 1.61
diff -u -b -u -r1.61 ml.in
--- ml.in 1999/05/22 02:16:47 1.61
+++ ml.in 1999/05/31 05:20:22
@@ -91,7 +91,6 @@
--debug
--low-level-debug
--use-trail
- --args {simple, compact}
--pic-reg
See the documentation in the \"Invocation\" section
of the Mercury User's Guide."
@@ -364,10 +363,6 @@
case $use_trail in
true) GRADE="$GRADE.tr" ;;
false) ;;
-esac
-case $args_method in
- simple) GRADE="$GRADE.sa" ;;
- compact) ;;
esac
case $stack_trace,$require_tracing in
true,true) GRADE="$GRADE.debug" ;;
Index: scripts/parse_grade_options.sh-subr
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/parse_grade_options.sh-subr,v
retrieving revision 1.9
diff -u -b -u -r1.9 parse_grade_options.sh-subr
--- parse_grade_options.sh-subr 1999/04/20 11:48:29 1.9
+++ parse_grade_options.sh-subr 1999/05/31 05:19:44
@@ -101,18 +101,6 @@
--no-use-minimal-model)
use_minimal_model=false ;;
- --args)
- shift
- case "$1" in
- simple|compact)
- args_method=$1;;
- *)
- echo "$0: invalid arg method \`$1'" 1>&2
- exit 1
- ;;
- esac
- ;;
-
--pic-reg)
pic_reg=true ;;
--no-pic-reg)
@@ -139,7 +127,6 @@
profile_memory=false
use_trail=false
use_minimal_model=false
- args_method=compact
stack_trace=false
require_tracing=false
low_level_debug=false
@@ -163,9 +150,6 @@
# stack_trace=true
# require_tracing=false
# ;;
- sa)
- args_method=simple
- ;;
tr) use_trail=true
;;
mm) use_minimal_model=true
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
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
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