[m-dev.] For Review: Bytecode compiler

[Levi Cameron]

Changed from last posted diff
 log message for code_gen.m, removed bytecode stub
 check for main/2 (was used only for debugging)
 added comments describing which procs don't have bytecode stub generated
 goal_have_foreign to goal_list_has_foreign
 adr -> addr

--------------------------------------------

Estimated hours taken: 4

Changed code generator to output bytecode stubs if needed

bytecode/code_gen.m:
        Changed code generator to replace normal procedure code with
	bytecode call stub if procedure contains no foreign code

bytecode/hlds_util.m:
        Added predicates to determine if a goal tree contains
        any foreign code.

bytecode/llds_out.m:
        Added a #include to modules generating bytecode

Levi
l.cameron2 at ugrad.unimelb.edu.au
Index: code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.92
diff -u -r1.92 code_gen.m
--- code_gen.m	2001/01/18 01:18:40	1.92
+++ code_gen.m	2001/01/31 01:48:03
@@ -348,11 +348,33 @@
 		ContainsReconstruction = does_not_contain_reconstruction
 	),
 
-		% Construct a c_procedure structure with all the information.
 	code_info__get_label_counter(LabelCounter, CodeInfo, _),
-	Proc = c_procedure(Name, Arity, proc(PredId, ProcId), Instructions,
-		ProcLabel, LabelCounter, ContainsReconstruction).
 
+	globals__lookup_bool_option(Globals, generate_bytecode, GenBytecode),
+	(
+		% XXX: There is a mass of calls above that the bytecode
+		% doesn't need; work out which is and isn't needed and put
+		% inside the else case below
+		GenBytecode = yes,
+		% We don't generate bytecode for __Unify__, __Compare__ etc
+		% Since we will assume this code is already correct
+		\+ code_util__compiler_generated(PredInfo),
+		% Don't generate bytecode for procs with foreign code
+		goal_has_foreign(Goal) = no
+	->
+		EmptyLabelCounter = counter__init(0),
+		code_gen__bytecode_stub(ModuleInfo, PredId, ProcId,
+			BytecodeInstructions),
+		Proc = c_procedure(Name, Arity, proc(PredId, ProcId),
+			BytecodeInstructions, ProcLabel, EmptyLabelCounter,
+			ContainsReconstruction)
+	;	
+		Proc = c_procedure(Name, Arity, proc(PredId, ProcId),
+			Instructions, ProcLabel, LabelCounter,
+			ContainsReconstruction)
+	).
+
 :- pred maybe_add_tabling_pointer_var(module_info::in,
 	pred_id::in, proc_id::in, proc_info::in, proc_label::in,
 	global_data::in, global_data::out) is det.
@@ -1211,5 +1233,69 @@
 		Instrn = Instrn0
 	),
 	code_gen__add_saved_succip(Instrns0, StackLoc, Instrns).
+
+%---------------------------------------------------------------------------%
+
+:- pred code_gen__bytecode_stub(module_info::in, pred_id::in, proc_id::in,
+	list(instruction)::out) is det.
+
+code_gen__bytecode_stub(ModuleInfo, PredId, ProcId, BytecodeInstructions) :-
+	
+%	module_info_name(ModuleInfo, ModuleSymName),
+	module_info_pred_info(ModuleInfo, PredId, PredInfo),
+	pred_info_module(PredInfo, ModuleSymName),
+
+	prog_out__sym_name_to_string(ModuleSymName, "__", ModuleName),
+	
+	code_util__make_local_entry_label(ModuleInfo, PredId,
+		ProcId, no, Entry),
+
+	pred_info_name(PredInfo, PredName),
+	proc_id_to_int(ProcId, ProcNum),
+	string__int_to_string(ProcNum, ProcStr),
+	pred_info_arity(PredInfo, Arity),
+	int_to_string(Arity, ArityStr),
+	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
+
+	CallStructName = "bytecode_call__" ++
+		(PredOrFunc = function -> "fn__" ; "") ++
+		ModuleName ++ "__" ++ PredName ++ "_" ++ ArityStr ++ "_" ++
+		ProcStr,
+
+	append_list([
+		"\t\tstatic MB_Call ", CallStructName, " = {\n",
+		"\t\t\t(MB_Word)NULL,\n",
+		"\t\t\t""", ModuleName, """,\n",
+		"\t\t\t""", PredName, """,\n",
+		"\t\t\t", ProcStr, ",\n",
+		"\t\t\t", ArityStr, ",\n",
+		"\t\t\t", (PredOrFunc = function -> "TRUE" ; "FALSE"), "\n",
+		"\t\t};\n"
+		], CallStruct),
+
+	append_list([
+		"\t\tMB_Native_Addr return_addr;\n",
+		"\t\tMR_save_registers();\n",
+		"\t\treturn_addr = MB_bytecode_call_entry(",
+			"&",CallStructName,");\n",
+		"\t\tMR_restore_registers();\n",
+		"\t\tMR_GOTO(return_addr);\n"
+		], BytecodeCall),
+
+		
+	BytecodeInstructions = [
+		label(Entry) - "Procedure entry point",
+
+		pragma_c(
+		[],
+		[
+		pragma_c_raw_code("\t{\n"),
+		pragma_c_raw_code(CallStruct),
+		pragma_c_raw_code(BytecodeCall),
+		pragma_c_raw_code("\t}\n")
+		],
+		may_call_mercury, no, no, no, no
+		) - "Entry stub"
+	].
 
 %---------------------------------------------------------------------------%
Index: hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.83
diff -u -r1.83 hlds_goal.m
--- hlds_goal.m	2001/01/16 15:44:21	1.83
+++ hlds_goal.m	2001/01/31 01:44:52
@@ -800,6 +800,12 @@
 :- pred negate_goal(hlds_goal, hlds_goal_info, hlds_goal).
 :- mode negate_goal(in, in, out) is det.
 
+	% Return yes if goal(s) contain any foreign code
+:- func goal_has_foreign(hlds_goal) = bool.
+:- mode goal_has_foreign(in) = out is det.
+:- func goal_list_has_foreign(list(hlds_goal)) = bool.
+:- mode goal_list_has_foreign(in) = out is det.
+
 	% A goal is atomic iff it doesn't contain any sub-goals
 	% (except possibly goals inside lambda expressions --
 	% but lambda expressions will get transformed into separate
@@ -1470,6 +1476,71 @@
 	all_negated(NegatedConj, Goals1),
 	all_negated(NegatedGoals, Goals2),
 	list__append(Goals1, Goals2, Goals).
+
+%-----------------------------------------------------------------------------%
+% Returns yes if a goal (or subgoal contained within) contains any foreign
+% code
+goal_has_foreign(Goal) = HasForeign :-
+	Goal = GoalExpr - _,
+	(
+		GoalExpr = conj(Goals),
+		HasForeign = goal_list_has_foreign(Goals)
+	;
+		GoalExpr = call(_, _, _, _, _, _),
+		HasForeign = no
+	;
+		GoalExpr = generic_call(_, _, _, _),
+		HasForeign = no
+	;
+		GoalExpr = switch(_, _, _, _),
+		HasForeign = no
+	;
+		GoalExpr = unify(_, _, _, _, _),
+		HasForeign = no
+	;
+		GoalExpr = disj(Goals, _),
+		HasForeign = goal_list_has_foreign(Goals)
+	;
+		GoalExpr = not(Goal2),
+		HasForeign = goal_has_foreign(Goal2)
+	;
+		GoalExpr = some(_, _, Goal2),
+		HasForeign = goal_has_foreign(Goal2)
+	;
+		GoalExpr = if_then_else(_, Goal2, Goal3, Goal4, _),
+		HasForeign =
+		(	goal_has_foreign(Goal2) = yes 
+		->	yes
+		;	goal_has_foreign(Goal3) = yes
+		->	yes
+		;	goal_has_foreign(Goal4) = yes
+		->	yes
+		;	no
+		)
+	;
+		GoalExpr = pragma_foreign_code(_, _, _, _, _, _, _),
+		HasForeign = yes
+	;
+		GoalExpr = par_conj(Goals, _),
+		HasForeign = goal_list_has_foreign(Goals)
+	;
+		GoalExpr = bi_implication(Goal2, Goal3),
+		HasForeign =
+		(	goal_has_foreign(Goal2) = yes
+		->	yes
+		;	goal_has_foreign(Goal3) = yes
+		->	yes
+		;	no
+		)
+	).
+
+goal_list_has_foreign([]) = no.
+goal_list_has_foreign([X | Xs]) =
+	(	goal_has_foreign(X) = yes
+	->	yes
+	;	goal_list_has_foreign(Xs)
+	).
+
 
 %-----------------------------------------------------------------------------%
 
Index: llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.171
diff -u -r1.171 llds_out.m
--- llds_out.m	2001/01/20 15:42:43	1.171
+++ llds_out.m	2001/01/30 07:18:13
@@ -418,6 +418,11 @@
 		io__write_string("#include ""mercury_trace_base.h""\n")
 	;
 		io__write_string("#include ""mercury_imp.h""\n")
+	),
+	globals__io_lookup_bool_option(generate_bytecode, GenBytecode),
+	(	{ GenBytecode = yes },
+		io__write_string("#include ""mb_interface.h""\n")
+	;	{ GenBytecode = no }
 	).
 
 output_c_file_intro_and_grade(SourceFileName, Version) -->
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------