[m-rev.] for review: wrap main in exception handler

[Peter Ross]

Hi,

For Tyson to review.


===================================================================


Estimated hours taken: 2
Branches: main

mlds_to_il.m:
    Wrap an exception handler around main.  This avoids those annoying
    pop up windows, and hence allows people to use windows machines via
    ssh.

tree.m:
    Add the higher order function map.

Index: mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.48
diff -u -r1.48 mlds_to_il.m
--- mlds_to_il.m	13 Jul 2001 11:45:36 -0000	1.48
+++ mlds_to_il.m	13 Jul 2001 13:42:29 -0000
@@ -870,21 +870,6 @@
 		)
 	),
 
-		% If this is main, add the entrypoint, set a flag, and
-		% call the initialization instructions in the cctor of
-		% this module.
-	(
-		{ Name = function(PredLabel, _ProcId, MaybeSeqNum, _PredId) },
-		{ PredLabel = pred(predicate, no, "main", 2, model_det, no) },
-		{ MaybeSeqNum = no }
-	->
-		{ EntryPoint = [entrypoint] },
-		il_info_add_init_instructions(runtime_initialization_instrs),
-		^ has_main := yes
-	;
-		{ EntryPoint = [] }
-	),
-
 		% Need to insert a ret for functions returning
 		% void (MLDS doesn't).
 	{ Returns = [] ->
@@ -896,16 +881,91 @@
 		% Retrieve the locals, put them in the enclosing
 		% scope.
 	il_info_get_locals_list(Locals),
-	{ InstrsTree = tree__list([
+	{ InstrsTree2 = tree__list([
 		context_node(Context),
 		node(CtorInstrs),
 		context_node(Context),
 		instr_node(start_block(scope(Locals), BlockId)),
 		InstrsTree1, 
 		MaybeRet,
 		instr_node(end_block(scope(Locals), BlockId))
 		])
 	},
+
+		% If this is main, add the entrypoint, set a flag,
+		% wrap the code in an exception handler and call the
+		% initialization instructions in the cctor of this
+		% module.
+	(
+		{ Name = function(PredLabel, _ProcId, MaybeSeqNum, _PredId) },
+		{ PredLabel = pred(predicate, no, "main", 2, model_det, no) },
+		{ MaybeSeqNum = no }
+	->
+		{ EntryPoint = [entrypoint] },
+		il_info_add_init_instructions(runtime_initialization_instrs),
+		^ has_main := yes,
+
+		il_info_get_next_block_id(TryBlockId),
+		il_info_make_next_label(DoneLabel),
+
+			% Replace all the returns with leave
+			% instructions as a side effect this means that
+			% we can no longer have any tail calls so
+			% replace them with nops.
+		{ RenameRets = (func(I) = 
+			(if (I = ret) then
+				leave(label_target(DoneLabel))
+			else if (I = tailcall) then
+				nop
+			else
+				I
+			)
+		)},
+		{ RenameNode = (func(N) = list__map(RenameRets, N)) },
+
+		{ ExceptionClassName = structured_name("mscorlib",
+				["System", "Exception"]) },
+
+		{ ConsoleWriteName = class_member_name(structured_name(
+				"mscorlib", ["System", "Console"]),
+				id("Write")) },
+		{ WriteString = methoddef(call_conv(no, default),
+					void, ConsoleWriteName,
+					[il_string_type]) },
+		{ WriteObject = methoddef(call_conv(no, default),
+					void, ConsoleWriteName,
+					[il_generic_type]) },
+
+			% Wrap an exception handler around the main
+			% code.  This allows us to debug programs
+			% remotely without a window popping up asking
+			% how you wish to debug.  Pressing the cancel
+			% button on this window is a bit difficult
+			% remotely.
+		{ InstrsTree = tree__list([
+				instr_node(start_block(try, TryBlockId)),
+				tree__map(RenameNode, InstrsTree2),
+				instr_node(leave(label_target(DoneLabel))),
+				instr_node(end_block(try, TryBlockId)),
+
+				instr_node(start_block(
+						catch(ExceptionClassName),
+						TryBlockId)),
+				instr_node(ldstr("\nException Caught: \n")),
+				instr_node(call(WriteString)),
+				instr_node(call(WriteObject)),
+				instr_node(leave(label_target(DoneLabel))),
+				instr_node(end_block(catch(ExceptionClassName),
+						TryBlockId)),
+
+				instr_node(label(DoneLabel)),
+				instr_node(ret)
+			]) }
+	;
+		{ EntryPoint = [] },
+		{ InstrsTree = InstrsTree2 }
+	),
 
 		% Generate the entire method contents.
 	DebugIlAsm =^ debug_il_asm,
Index: tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/tree.m,v
retrieving revision 1.13
diff -u -r1.13 tree.m
--- tree.m	27 Jul 2000 04:42:06 -0000	1.13
+++ tree.m	13 Jul 2001 13:42:29 -0000
@@ -37,6 +37,8 @@
 :- pred tree__tree_of_lists_is_empty(tree(list(T))).
 :- mode tree__tree_of_lists_is_empty(in) is semidet.
 
+:- func tree__map(func(T) = U, tree(T)) = tree(U).
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -73,5 +75,12 @@
 tree__tree_of_lists_is_empty(tree(L, R)) :-
 	tree__tree_of_lists_is_empty(L),
 	tree__tree_of_lists_is_empty(R).
+
+%-----------------------------------------------------------------------------%
+
+tree__map(_F, empty) = empty.
+tree__map(F, node(T)) = node(F(T)).
+tree__map(F, tree(L, R)) = tree(tree__map(F, L), tree__map(F, R)).
+
 
 %-----------------------------------------------------------------------------%

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------