[m-rev.] diff: fix problem reported by Michael Day

Zoltan Somogyi zs at cs.mu.OZ.AU
Tue Sep 27 12:21:20 AEST 2005


compiler/jumpopt.m:
compiler/labelopt.m:
	Make the main predicates of these optimizations tail recursive in order
	to allow them to handle procedures with 50,000 instructions, such as
	the one reported by Michael Day.

Zoltan.

cvs diff: Diffing compiler
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.80
diff -u -b -r1.80 jumpopt.m
--- compiler/jumpopt.m	14 Sep 2005 01:29:08 -0000	1.80
+++ compiler/jumpopt.m	27 Sep 2005 02:16:40 -0000
@@ -123,7 +123,7 @@
                 !.Lvalmap, !.Procmap, !.Sdprocmap, !.Forkmap, !.Succmap,
                 LayoutLabels, Fulljumpopt, MayAlterRtti,
                 CheckedNondetTailCallInfo0, CheckedNondetTailCallInfo,
-                !:Instrs),
+                [], RevInstrs),
             (
                 CheckedNondetTailCallInfo = yes(_ - !:C)
             ;
@@ -136,8 +136,9 @@
             jumpopt__instr_list(!.Instrs, comment(""), !.Instrmap, !.Blockmap,
                 !.Lvalmap, !.Procmap, !.Sdprocmap, !.Forkmap, !.Succmap,
                 LayoutLabels, Fulljumpopt, MayAlterRtti,
-                CheckedNondetTailCallInfo0, _, !:Instrs)
+                CheckedNondetTailCallInfo0, _, [], RevInstrs)
         ),
+        list__reverse(RevInstrs, !:Instrs),
         opt_util__filter_out_bad_livevals(!Instrs),
         ( !.Instrs = Instrs0 ->
             Mod = no
@@ -224,11 +225,20 @@
 
 %-----------------------------------------------------------------------------%
 
-    % Optimize the given instruction list by eliminating unnecessary
-    % jumps.
+:- type new_remain
+    --->    specified(
+                new_instructions        :: list(instruction),
+                remaining_instructions  :: list(instruction)
+            )
+    ;       usual_case.
+            % The list of new instructions contains just Instr0, and
+            % the list of remaining instructions, on which to recurse,
+            % Instrs0.
+
+    % Optimize the given instruction list by eliminating unnecessary jumps.
     %
-    % We handle calls by attempting to turn them into tailcalls. If this
-    % fails, we try to short-circuit the return address.
+    % We handle calls by attempting to turn them into tailcalls. If this fails,
+    % we try to short-circuit the return address.
     %
     % We handle gotos by first trying to eliminate them. If this fails,
     % we check whether their target label begins a proceed/succeed
@@ -246,18 +256,23 @@
     % do so by negating the condition and possibly also deleting a label
     % between the if-val and the goto.
     %
+    % We build up the generated instruction list in reverse order, because
+    % building it in right order would make instr_list not tail recursive,
+    % and thus unable to handle very long instruction lists.
+    %
 :- pred jumpopt__instr_list(list(instruction)::in, instr::in, instrmap::in,
     tailmap::in, lvalmap::in, tailmap::in, tailmap::in, tailmap::in,
     tailmap::in, set(label)::in, bool::in, may_alter_rtti::in,
     maybe(pair(proc_label, counter))::in,
-    maybe(pair(proc_label, counter))::out, list(instruction)::out) is det.
+    maybe(pair(proc_label, counter))::out,
+    list(instruction)::in, list(instruction)::out) is det.
 
 jumpopt__instr_list([], _PrevInstr, _Instrmap, _Blockmap, _Lvalmap,
         _Procmap, _Sdprocmap, _Forkmap, _Succmap, _LayoutLabels,
-        _Fulljumpopt, _MayAlterRtti, !CheckedNondetTailCallInfo, []).
+        _Fulljumpopt, _MayAlterRtti, !CheckedNondetTailCallInfo, !RevInstrs).
 jumpopt__instr_list([Instr0 | Instrs0], PrevInstr, Instrmap, Blockmap,
         Lvalmap, Procmap, Sdprocmap, Forkmap, Succmap, LayoutLabels,
-        Fulljumpopt, MayAlterRtti, !CheckedNondetTailCallInfo, Instrs) :-
+        Fulljumpopt, MayAlterRtti, !CheckedNondetTailCallInfo, !RevInstrs) :-
     Instr0 = Uinstr0 - Comment0,
     % We do a switch on the instruction type to ensure that we short circuit
     % all the labels that are in Instrmap but not in LayoutLabels in *all*
@@ -270,10 +285,9 @@
         Uinstr0 = call(Proc, RetAddr, LiveInfos, Context, GoalPath, CallModel),
         ( RetAddr = label(RetLabel) ->
             (
-                % Look for det style tailcalls. We look for this
-                % even if the call is semidet because one of the
-                % optimizations below turns a pair of semidet epilogs
-                % into a det epilog.
+                % Look for det style tailcalls. We look for this even if
+                % the call is semidet, because one of the optimizations below
+                % turns a pair of semidet epilogs into a det epilog.
                 ( CallModel = det ; CallModel = semidet ),
                 map__search(Procmap, RetLabel, Between0),
                 PrevInstr = livevals(Livevals),
@@ -281,9 +295,9 @@
                 not set__member(RetLabel, LayoutLabels)
             ->
                 opt_util__filter_out_livevals(Between0, Between1),
-                list__append(Between1, [livevals(Livevals) - "",
-                    goto(Proc) - redirect_comment(Comment0)], NewInstrs),
-                RemainInstrs = Instrs0
+                NewInstrs = Between1 ++ [livevals(Livevals) - "",
+                    goto(Proc) - redirect_comment(Comment0)],
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
                 % Look for semidet style tailcalls.
                 CallModel = semidet,
@@ -292,9 +306,9 @@
                 MayAlterRtti = may_alter_rtti,
                 not set__member(RetLabel, LayoutLabels)
             ->
-                list__append(Between, [livevals(Livevals) - "",
-                    goto(Proc) - redirect_comment(Comment0)], NewInstrs),
-                RemainInstrs = Instrs0
+                NewInstrs = Between ++ [livevals(Livevals) - "",
+                    goto(Proc) - redirect_comment(Comment0)],
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
                 % Look for nondet style tailcalls which do not need
                 % a runtime check.
@@ -315,7 +329,7 @@
                     livevals(Livevals) - "",
                     goto(Proc) - redirect_comment(Comment0)
                 ],
-                RemainInstrs = Instrs0
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
                 % Look for nondet style tailcalls which do need
                 % a runtime check.
@@ -344,7 +358,7 @@
                     label(NewLabel) - "non tail call",
                     Instr0
                 ],
-                RemainInstrs = Instrs0,
+                NewRemain = specified(NewInstrs, Instrs0),
                 !:CheckedNondetTailCallInfo = yes(ProcLabel - Counter1)
             ;
                 % Short circuit the return label if possible.
@@ -355,21 +369,18 @@
                 jumpopt__final_dest(Instrmap, RetLabel, DestLabel,
                     RetInstr, _DestInstr),
                 ( RetLabel = DestLabel ->
-                    NewInstrs = [Instr0],
-                    RemainInstrs = Instrs0
+                    NewInstrs = [Instr0]
                 ;
                     NewInstrs = [call(Proc, label(DestLabel), LiveInfos,
                         Context, GoalPath, CallModel)
-                        - redirect_comment(Comment0)],
-                    RemainInstrs = Instrs0
-                )
+                        - redirect_comment(Comment0)]
+                ),
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
-                NewInstrs = [Instr0],
-                RemainInstrs = Instrs0
+                NewRemain = usual_case
             )
         ;
-            NewInstrs = [Instr0],
-            RemainInstrs = Instrs0
+            NewRemain = usual_case
         )
     ;
         Uinstr0 = goto(TargetAddr),
@@ -379,7 +390,7 @@
                 opt_util__is_this_label_next(TargetLabel, Instrs0, _)
             ->
                 NewInstrs = [],
-                RemainInstrs = Instrs0
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
                 PrevInstr = if_val(_, label(IfTargetLabel)),
                 opt_util__is_this_label_next(IfTargetLabel, Instrs0, _)
@@ -391,27 +402,27 @@
                 % We cannot eliminate the instruction here because
                 % that would require altering the if_val instruction.
                 NewInstrs = [Instr0],
-                RemainInstrs = Instrs0
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
                 % Replace a jump to a det epilog with the epilog.
                 map__search(Procmap, TargetLabel, Between0)
             ->
                 jumpopt__adjust_livevals(PrevInstr, Between0, Between),
                 NewInstrs = Between ++ [goto(succip) - "shortcircuit"],
-                RemainInstrs = Instrs0
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
                 % Replace a jump to a semidet epilog with the epilog.
                 map__search(Sdprocmap, TargetLabel, Between0)
             ->
                 jumpopt__adjust_livevals(PrevInstr, Between0, Between),
                 NewInstrs = Between ++ [goto(succip) - "shortcircuit"],
-                RemainInstrs = Instrs0
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
                 % Replace a jump to a nondet epilog with the epilog.
                 map__search(Succmap, TargetLabel, BetweenIncl0)
             ->
                 jumpopt__adjust_livevals(PrevInstr, BetweenIncl0, NewInstrs),
-                RemainInstrs = Instrs0
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
                 % Replace a jump to a non-epilog block with the
                 % block itself. These jumps are treated separately
@@ -445,8 +456,8 @@
                 jumpopt__instr_list(AdjustedBlock, comment(""), Instrmap,
                     CrippledBlockmap, Lvalmap, Procmap, Sdprocmap, Forkmap,
                     Succmap, LayoutLabels, Fulljumpopt, MayAlterRtti,
-                    !CheckedNondetTailCallInfo, NewInstrs),
-                RemainInstrs = Instrs0
+                    !CheckedNondetTailCallInfo, [], RevNewInstrs),
+                NewRemain = specified(list__reverse(RevNewInstrs), Instrs0)
             ;
                 % Short-circuit the goto.
                 map__search(Instrmap, TargetLabel, TargetInstr)
@@ -458,16 +469,13 @@
                 opt_util__can_instr_fall_through(UdestInstr, Canfallthrough),
                 (
                     Canfallthrough = no,
-                    NewInstrs0 = [UdestInstr - Shorted],
-                    RemainInstrs = Instrs0
+                    NewInstrs0 = [UdestInstr - Shorted]
                 ;
                     Canfallthrough = yes,
                     ( TargetLabel = DestLabel ->
-                        NewInstrs0 = [Instr0],
-                        RemainInstrs = Instrs0
+                        NewInstrs0 = [Instr0]
                     ;
-                        NewInstrs0 = [goto(label(DestLabel)) - Shorted],
-                        RemainInstrs = Instrs0
+                        NewInstrs0 = [goto(label(DestLabel)) - Shorted]
                     )
                 ),
                 ( map__search(Lvalmap, DestLabel, yes(Lvalinstr)) ->
@@ -475,25 +483,24 @@
                         [Lvalinstr | NewInstrs0], NewInstrs)
                 ;
                     NewInstrs = NewInstrs0
-                )
+                ),
+                NewRemain = specified(NewInstrs, Instrs0)
             ;
-                NewInstrs = [Instr0],
-                RemainInstrs = Instrs0
+                NewRemain = usual_case
             )
         ;
-            NewInstrs = [Instr0],
-            RemainInstrs = Instrs0
+            NewRemain = usual_case
         )
     ;
         Uinstr0 = computed_goto(Index, LabelList0),
         % Short-circuit all the destination labels.
         jumpopt__short_labels(Instrmap, LabelList0, LabelList),
-        RemainInstrs = Instrs0,
         ( LabelList = LabelList0 ->
-            NewInstrs = [Instr0]
+            NewRemain = usual_case
         ;
             Shorted = Comment0 ++ " (some shortcircuits)",
-            NewInstrs = [computed_goto(Index, LabelList) - Shorted]
+            NewInstrs = [computed_goto(Index, LabelList) - Shorted],
+            NewRemain = specified(NewInstrs, Instrs0)
         )
     ;
         Uinstr0 = if_val(Cond, TargetAddr),
@@ -544,7 +551,8 @@
                 % the recursive call. We can't go into an infinite
                 % loop because each application of the transformation
                 % strictly reduces the size of the code.
-                RemainInstrs = [NewInstr | AfterGoto]
+                RemainInstrs = [NewInstr | AfterGoto],
+                NewRemain = specified(NewInstrs, RemainInstrs)
             ;
                 % Attempt to transform code such as
                 %
@@ -580,7 +588,8 @@
                 NewInstrs = [NewIfInstr],
                 NewGotoComment = Comment0 ++ " (switched)",
                 NewGotoInstr = goto(label(TargetLabel)) - NewGotoComment,
-                RemainInstrs = [NewGotoInstr | AfterGoto]
+                RemainInstrs = [NewGotoInstr | AfterGoto],
+                NewRemain = specified(NewInstrs, RemainInstrs)
             ;
                 map__search(Instrmap, TargetLabel, TargetInstr)
             ->
@@ -627,52 +636,48 @@
                             "shortcircuit bool computation"
                     ),
                     Proceed = goto(succip) - "shortcircuit",
-                    list__append([NewAssign | Between], [Proceed], NewInstrs),
-                    RemainInstrs = Instrs0
+                    NewInstrs = [NewAssign | Between] ++ [Proceed],
+                    NewRemain = specified(NewInstrs, Instrs0)
                 ;
                     % Try to short-circuit the destination.
                     TargetLabel \= DestLabel
                 ->
                     Shorted = "shortcircuited jump: " ++ Comment0,
                     NewInstrs = [if_val(Cond, label(DestLabel)) - Shorted],
-                    RemainInstrs = Instrs0
+                    NewRemain = specified(NewInstrs, Instrs0)
                 ;
-                    NewInstrs = [Instr0],
-                    RemainInstrs = Instrs0
+                    NewRemain = usual_case
                 )
             ;
-                NewInstrs = [Instr0],
-                RemainInstrs = Instrs0
+                NewRemain = usual_case
             )
         ;
-            NewInstrs = [Instr0],
-            RemainInstrs = Instrs0
+            NewRemain = usual_case
         )
     ;
         Uinstr0 = assign(Lval, Rval0),
         % Any labels mentioned in Rval0 should be short-circuited.
         jumpopt__short_labels_rval(Instrmap, Rval0, Rval),
-        RemainInstrs = Instrs0,
         ( Rval = Rval0 ->
-            NewInstrs = [Instr0]
+            NewRemain = usual_case
         ;
             Shorted = Comment0 ++ " (some shortcircuits)",
-            NewInstrs = [assign(Lval, Rval) - Shorted]
+            NewInstrs = [assign(Lval, Rval) - Shorted],
+            NewRemain = specified(NewInstrs, Instrs0)
         )
     ;
         Uinstr0 = mkframe(FrameInfo, Redoip),
         ( Redoip = yes(label(Label0)) ->
             jumpopt__short_label(Instrmap, Label0, Label),
-            RemainInstrs = Instrs0,
             ( Label = Label0 ->
-                NewInstrs = [Instr0]
+                NewRemain = usual_case
             ;
                 Shorted = Comment0 ++ " (some shortcircuits)",
-                NewInstrs = [mkframe(FrameInfo, yes(label(Label))) - Shorted]
+                NewInstrs = [mkframe(FrameInfo, yes(label(Label))) - Shorted],
+                NewRemain = specified(NewInstrs, Instrs0)
             )
         ;
-            NewInstrs = [Instr0],
-            RemainInstrs = Instrs0
+            NewRemain = usual_case
         )
     ;
 		Uinstr0 = pragma_c(Decls, Components0, MayCallMercury,
@@ -724,30 +729,26 @@
 %           ),
             (
                 !.Redirect = no,
-                Instr = Instr0
+                NewRemain = usual_case
             ;
                 !.Redirect = yes,
                 Comment = Comment0 ++ " (some redirects)",
                 Uinstr = pragma_c(Decls, Components, MayCallMercury,
                     MaybeFixNoLayout, MaybeFixLayout, MaybeFixOnlyLayout,
                     MaybeNoFix, StackSlotRef, MaybeDup),
-                Instr = Uinstr - Comment
+                Instr = Uinstr - Comment,
+                NewRemain = specified([Instr], Instrs0)
+            )
             )
-        ),
-        NewInstrs = [Instr],
-        RemainInstrs = Instrs0
     ;
         Uinstr0 = c_code(_, _),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = comment(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = livevals(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = block(_, _, _),
         % These are supposed to be introduced only after jumpopt is run
@@ -755,68 +756,52 @@
         error("jumpopt__instr_list: block")
     ;
         Uinstr0 = label(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = save_maxfr(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = restore_maxfr(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = incr_sp(_, _),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = decr_sp(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = decr_sp_and_return(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = store_ticket(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = reset_ticket(_, _),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = discard_ticket,
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = prune_ticket,
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = prune_tickets_to(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = mark_ticket_stack(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = mark_hp(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = free_heap(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = incr_hp(_, _, _, _, _),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = restore_hp(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = fork(Child0, Parent0, NumSlots),
         short_label(Instrmap, Child0, Child),
@@ -825,44 +810,62 @@
             Child = Child0,
             Parent = Parent0
         ->
-            Instr = Instr0
+            NewRemain = usual_case
         ;
             Uinstr = fork(Child, Parent, NumSlots),
             Comment = Comment0 ++ " (redirect)",
-            Instr = Uinstr - Comment
-        ),
-        NewInstrs = [Instr],
-        RemainInstrs = Instrs0
+            Instr = Uinstr - Comment,
+            NewRemain = specified([Instr], Instrs0)
+        )
     ;
         Uinstr0 = init_sync_term(_, _),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ;
         Uinstr0 = join_and_continue(SyncTerm, Label0),
         short_label(Instrmap, Label0, Label),
         ( Label = Label0 ->
-            Instr = Instr0
+            NewRemain = usual_case
         ;
             Uinstr = join_and_continue(SyncTerm, Label),
             Comment = Comment0 ++ " (redirect)",
-            Instr = Uinstr - Comment
-        ),
-        NewInstrs = [Instr],
-        RemainInstrs = Instrs0
+            Instr = Uinstr - Comment,
+            NewRemain = specified([Instr], Instrs0)
+        )
     ;
         Uinstr0 = join_and_terminate(_),
-        NewInstrs = [Instr0],
-        RemainInstrs = Instrs0
+        NewRemain = usual_case
     ),
-    ( ( Uinstr0 = comment(_) ; NewInstrs = [] ) ->
+    (
+        NewRemain = usual_case,
+        ReplacementInstrsEmpty = no,
+        RecurseInstrs = Instrs0,
+        !:RevInstrs = [Instr0 | !.RevInstrs]
+    ;
+        NewRemain = specified(ReplacementInstrs, RecurseInstrs),
+        % ReplacementInstrs are in the right order, but they will be reversed
+        % by our caller. We therefore reverse them here, which allows that
+        % final reverse to put them in the right order.
+        !:RevInstrs = list__reverse(ReplacementInstrs) ++ !.RevInstrs,
+        (
+            ReplacementInstrs = [],
+            ReplacementInstrsEmpty = yes
+        ;
+            ReplacementInstrs = [_ | _],
+            ReplacementInstrsEmpty = no
+        )
+    ),
+    (
+        ( Uinstr0 = comment(_)
+        ; ReplacementInstrsEmpty = yes
+        )
+    ->
         NewPrevInstr = PrevInstr
     ;
         NewPrevInstr = Uinstr0
     ),
-    jumpopt__instr_list(RemainInstrs, NewPrevInstr, Instrmap, Blockmap,
+    jumpopt__instr_list(RecurseInstrs, NewPrevInstr, Instrmap, Blockmap,
         Lvalmap, Procmap, Sdprocmap, Forkmap, Succmap, LayoutLabels,
-        Fulljumpopt, MayAlterRtti, !CheckedNondetTailCallInfo, Instrs9),
-    list__append(NewInstrs, Instrs9, Instrs).
+        Fulljumpopt, MayAlterRtti, !CheckedNondetTailCallInfo, !RevInstrs).
 
 :- func block_may_be_duplicated(list(instruction)) = bool.
 
Index: compiler/labelopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/labelopt.m,v
retrieving revision 1.25
diff -u -b -r1.25 labelopt.m
--- compiler/labelopt.m	16 Jun 2005 05:19:56 -0000	1.25
+++ compiler/labelopt.m	27 Sep 2005 02:18:33 -0000
@@ -34,8 +34,8 @@
     % The input set is the list of labels referred to from outside
     % the given list of instructions.
     %
-:- pred labelopt__build_useset(list(instruction)::in, set(label)::in,
-    set(label)::out) is det.
+:- pred build_useset(list(instruction)::in, set(label)::in, set(label)::out)
+    is det.
 
 %-----------------------------------------------------------------------------%
 
@@ -46,9 +46,12 @@
 :- import_module std_util.
 
 labelopt_main(Final, LayoutLabelSet, Instrs0, Instrs, Mod) :-
-    labelopt__build_useset(Instrs0, LayoutLabelSet, Useset),
-    labelopt__instr_list(Instrs0, yes, Useset, Instrs1, Mod),
-    ( Final = yes, Mod = yes ->
+    build_useset(Instrs0, LayoutLabelSet, Useset),
+    instr_list(Instrs0, Instrs1, Useset, Mod),
+    (
+        Final = yes,
+        Mod = yes
+    ->
         labelopt_main(Final, LayoutLabelSet, Instrs1, Instrs, _)
     ;
         Instrs = Instrs1
@@ -56,12 +59,12 @@
 
 %-----------------------------------------------------------------------------%
 
-labelopt__build_useset([], Useset, Useset).
-labelopt__build_useset([Instr | Instructions], Useset0, Useset) :-
+build_useset([], !Useset).
+build_useset([Instr | Instructions], !Useset) :-
     Instr = Uinstr - _Comment,
     opt_util__instr_labels(Uinstr, Labels, _CodeAddresses),
-    set__insert_list(Useset0, Labels, Useset1),
-    labelopt__build_useset(Instructions, Useset1, Useset).
+    set__insert_list(!.Useset, Labels, !:Useset),
+    build_useset(Instructions, !Useset).
 
 %-----------------------------------------------------------------------------%
 
@@ -71,12 +74,25 @@
     % If not, we delete it. We delete the following code as well if
     % the label was preceded by code that cannot fall through.
     %
-:- pred labelopt__instr_list(list(instruction)::in, bool::in, set(label)::in,
-    list(instruction)::out, bool::out) is det.
+    % We build up the generated instruction list in reverse order in
+    % instr_list_2, because building it in right order here would make
+    % instr_list not tail recursive, and thus unable to handle very long
+    % instruction lists.
+    %
+:- pred instr_list(list(instruction)::in, list(instruction)::out,
+    set(label)::in, bool::out) is det.
+
+instr_list(Instrs0, Instrs, Useset, Mod) :-
+    Fallthrough = yes,
+    instr_list_2(Instrs0, [], RevInstrs, no, Mod, Fallthrough, Useset),
+    list__reverse(RevInstrs, Instrs).
+
+:- pred instr_list_2(list(instruction)::in,
+    list(instruction)::in, list(instruction)::out,
+    bool::in, bool::out, bool::in, set(label)::in) is det.
 
-labelopt__instr_list([], _Fallthrough, _Useset, [], no).
-labelopt__instr_list([Instr0 | MoreInstrs0],
-        Fallthrough, Useset, MoreInstrs, Mod) :-
+instr_list_2([], !RevInstrs, !Mod, _Fallthrough, _Useset).
+instr_list_2([Instr0 | Instrs0], !RevInstrs, !Mod, !.Fallthrough, Useset) :-
     Instr0 = Uinstr0 - _Comment,
     ( Uinstr0 = label(Label) ->
         (
@@ -89,59 +105,48 @@
                 set__member(Label, Useset)
             )
         ->
-            ReplInstrs = [Instr0],
-            Fallthrough1 = yes,
-            Mod0 = no
+            !:RevInstrs = [Instr0 | !.RevInstrs],
+            !:Fallthrough = yes
         ;
-            labelopt__eliminate(Instr0, yes(Fallthrough), ReplInstrs, Mod0),
-            Fallthrough1 = Fallthrough
+            eliminate(Instr0, yes(!.Fallthrough), !RevInstrs, !Mod)
         )
     ;
         (
-            Fallthrough = yes,
-            ReplInstrs = [Instr0],
-            Mod0 = no
+            !.Fallthrough = yes,
+            !:RevInstrs = [Instr0 | !.RevInstrs]
         ;
-            Fallthrough = no,
-            labelopt__eliminate(Instr0, no, ReplInstrs, Mod0)
+            !.Fallthrough = no,
+            eliminate(Instr0, no, !RevInstrs, !Mod)
         ),
         opt_util__can_instr_fall_through(Uinstr0, Canfallthrough),
         (
-            Canfallthrough = yes,
-            Fallthrough1 = Fallthrough
+            Canfallthrough = yes
         ;
             Canfallthrough = no,
-            Fallthrough1 = no
+            !:Fallthrough = no
         )
     ),
-    labelopt__instr_list(MoreInstrs0, Fallthrough1, Useset, MoreInstrs1, Mod1),
-    list__append(ReplInstrs, MoreInstrs1, MoreInstrs),
-    ( Mod0 = no, Mod1 = no ->
-        Mod = no
-    ;
-        Mod = yes
-    ).
+    instr_list_2(Instrs0, !RevInstrs, !Mod, !.Fallthrough, Useset).
 
     % Instead of removing eliminated instructions from the instruction list,
     % we can replace them by placeholder comments. The original comment
     % field on the instruction is often enough to deduce what the
     % eliminated instruction was.
     %
-:- pred labelopt__eliminate(instruction::in, maybe(bool)::in,
-    list(instruction)::out, bool::out) is det.
+:- pred eliminate(instruction::in, maybe(bool)::in,
+    list(instruction)::in, list(instruction)::out,
+    bool::in, bool::out) is det.
 
-labelopt__eliminate(Uinstr0 - Comment0, Label, Instr, Mod) :-
+eliminate(Uinstr0 - Comment0, Label, !RevInstrs, !Mod) :-
     labelopt_eliminate_total(Total),
     (
         Total = yes,
-        Instr = [],
-        Mod = yes
+        % We have deleted Uinstr0 by not adding it to !RevInstrs.
+        !:Mod = yes
     ;
         Total = no,
         ( Uinstr0 = comment(_) ->
-            Comment = Comment0,
-            Uinstr = Uinstr0,
-            Mod = no
+            Uinstr = Uinstr0
         ;
             (
                 Label = yes(Follow),
@@ -156,10 +161,9 @@
                 Label = no,
                 Uinstr = comment("eliminated instruction")
             ),
-            Comment = Comment0,
-            Mod = yes
+            !:Mod = yes
         ),
-        Instr = [Uinstr - Comment]
+        !:RevInstrs = [Uinstr - Comment0 | !.RevInstrs]
     ).
 
 :- pred labelopt_eliminate_total(bool::out) is det.
cvs diff: Diffing compiler/notes
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list