+ nested exit support

git-svn-id: trunk@23309 -

.gitattributes

@@ -11099,7 +11099,8 @@ tests/test/tmaclocalprocparam4e.pp svneol=native#text/plain
 tests/test/tmaclocalprocparam4f.pp svneol=native#text/plain
 tests/test/tmaclocalprocparam4g.pp svneol=native#text/plain
 tests/test/tmaclocalprocparam4h.pp svneol=native#text/plain
-tests/test/tmacnonlocalexit.pp svneol=native#text/plain
+tests/test/tmacnonlocalexit1.pp svneol=native#text/plain
+tests/test/tmacnonlocalexit2.pp svneol=native#text/pascal
 tests/test/tmacnonlocalgoto.pp svneol=native#text/plain
 tests/test/tmacpas1.pp svneol=native#text/plain
 tests/test/tmacpas2.pp svneol=native#text/plain

compiler/globtype.pas

@@ -564,7 +564,9 @@ interface
          { subroutine contains interprocedural gotos }
          pi_has_global_goto,
          { subroutine contains inherited call }
-         pi_has_inherited
+         pi_has_inherited,
+         { subroutine has nested exit }
+         pi_has_nested_exit
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/msg/errore.msg

@@ -1075,8 +1075,8 @@ parser_e_invalid_qualifier=03205_E_Illegal qualifier
 parser_e_upper_lower_than_lower=03206_E_High range limit < low range limit
 % You are declaring a subrange, and the high limit is less than the low limit of
 % the range.
-parser_e_macpas_exit_wrong_param=03207_E_Exit's parameter must be the name of the procedure it is used in
-% Non local exit is not allowed. This error occurs only in mode MacPas.
+parser_e_macpas_exit_wrong_param=03207_E_Exit's parameter must be the name of the procedure it is used in or of a surrounding procedure
+% The parameter of a exit call in macpas mode must be either the name of the current subroutine or of a surrounding one
 parser_e_illegal_assignment_to_count_var=03208_E_Illegal assignment to for-loop variable "$1"
 % The type of a \var{for} loop variable must be an ordinal type.
 % Loop variables cannot be reals or strings. You also cannot assign values to

compiler/msgidx.inc

@@ -963,7 +963,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 68063;
+  MsgTxtSize = 68093;
 
   MsgIdxMax : array[1..20] of longint=(
     26,93,328,120,87,56,126,26,202,63,

compiler/nflw.pas

@@ -1718,8 +1718,10 @@ implementation
               { generated by the optimizer? }
                not(assigned(labelsym.owner))) then
               labelnode:=tlabelnode(labelsym.code)
-            else if (m_non_local_goto in current_settings.modeswitches) and
-              assigned(labelsym.owner) then
+            else if ((m_non_local_goto in current_settings.modeswitches) and
+              assigned(labelsym.owner)) or
+              { nested exits don't need the non local goto switch }
+              (labelsym.realname='$nestedexit') then
               begin
                 if current_procinfo.procdef.parast.symtablelevel>labelsym.owner.symtablelevel then
                   begin

compiler/pexpr.pas

@@ -226,6 +226,7 @@ implementation
          hdef  : tdef;
          temp  : ttempcreatenode;
          newstatement : tstatementnode;
+         procinfo : tprocinfo;
        begin
          { Properties are not allowed, because the write can
            be different from the read }
@@ -269,6 +270,7 @@ implementation
         err,
         prev_in_args : boolean;
         def : tdef;
+        exit_procinfo: tprocinfo;
       begin
         prev_in_args:=in_args;
         case l of
@@ -298,6 +300,7 @@ implementation
 
           in_exit :
             begin
+              statement_syssym:=nil;
               if try_to_consume(_LKLAMMER) then
                 begin
                   if not (m_mac in current_settings.modeswitches) then
@@ -321,8 +324,40 @@ implementation
                     end
                   else
                     begin
-                      if not (current_procinfo.procdef.procsym.name = pattern) then
-                        Message(parser_e_macpas_exit_wrong_param);
+                      { non local exit ? }
+                      if current_procinfo.procdef.procsym.name<>pattern then
+                        begin
+                          exit_procinfo:=current_procinfo.parent;
+                          while assigned(exit_procinfo) do
+                            begin
+                              if exit_procinfo.procdef.procsym.name=pattern then
+                                break;
+                              exit_procinfo:=exit_procinfo.parent;
+                            end;
+                          if assigned(exit_procinfo) then
+                            begin
+                              if not(assigned(exit_procinfo.nestedexitlabel)) then
+                                begin
+                                  include(exit_procinfo.flags,pi_has_nested_exit);
+                                  exclude(exit_procinfo.procdef.procoptions,po_inline);
+
+                                  exit_procinfo.nestedexitlabel:=tlabelsym.create('$nestedexit');
+
+                                  { the compiler is responsible to define this label }
+                                  exit_procinfo.nestedexitlabel.defined:=true;
+                                  exit_procinfo.nestedexitlabel.used:=true;
+
+                                  exit_procinfo.nestedexitlabel.jumpbuf:=tlocalvarsym.create('LABEL$_'+exit_procinfo.nestedexitlabel.name,vs_value,rec_jmp_buf,[]);
+                                  exit_procinfo.procdef.localst.insert(exit_procinfo.nestedexitlabel);
+                                  exit_procinfo.procdef.localst.insert(exit_procinfo.nestedexitlabel.jumpbuf);
+                                end;
+
+                              statement_syssym:=cgotonode.create(exit_procinfo.nestedexitlabel);
+                              tgotonode(statement_syssym).labelsym:=exit_procinfo.nestedexitlabel;
+                            end
+                          else
+                            Message(parser_e_macpas_exit_wrong_param);
+                        end;
                       consume(_ID);
                       consume(_RKLAMMER);
                       p1:=nil;
@@ -330,7 +365,8 @@ implementation
                 end
               else
                 p1:=nil;
-              statement_syssym:=cexitnode.create(p1);
+              if not assigned(statement_syssym) then
+                statement_syssym:=cexitnode.create(p1);
             end;
 
           in_break :
@@ -732,6 +768,7 @@ implementation
                   statement_syssym:=cerrornode.create;
                 end;
             end;
+
           in_length_x:
             begin
               consume(_LKLAMMER);

compiler/procinfo.pas

@@ -112,6 +112,9 @@ unit procinfo;
           { label to leave the sub routine }
           CurrExitLabel : tasmlabel;
 
+          { label for nested exits }
+          nestedexitlabel : tlabelsym;
+
           { The code for the routine itself, excluding entry and
             exit code. This is a linked list of tai classes.
           }

compiler/pstatmnt.pas

@@ -1249,11 +1249,15 @@ implementation
              if p.nodetype in [vecn,derefn,typeconvn,subscriptn,loadn] then
                maybe_call_procvar(p,false);
 
-             { blockn support because a read/write is changed into a blocknode }
-             { with a separate statement for each read/write operation (JM)    }
-             { the same is true for val() if the third parameter is not 32 bit }
+             { blockn support because a read/write is changed into a blocknode
+               with a separate statement for each read/write operation (JM)
+               the same is true for val() if the third parameter is not 32 bit
+
+               goto nodes are created by the compiler for non local exit statements, so
+               include them as well
+             }
              if not(p.nodetype in [nothingn,errorn,calln,ifn,assignn,breakn,inlinen,
-                                   continuen,labeln,blockn,exitn]) or
+                                   continuen,labeln,blockn,exitn,goton]) or
                 ((p.nodetype=inlinen) and
                  not is_void(p.resultdef)) or
                 ((p.nodetype=calln) and

compiler/psub.pas

@@ -144,6 +144,12 @@ implementation
             Message(parser_h_inlining_disabled);
             exit;
           end;
+        if pi_has_nested_exit in current_procinfo.flags then
+          begin
+            Message1(parser_h_not_supported_for_inline,'nested exit');
+            Message(parser_h_inlining_disabled);
+            exit;
+          end;
         { the compiler cannot handle inherited in inlined subroutines because
           it tries to search for self in the symtable, however, the symtable
           is not available }
@@ -861,6 +867,8 @@ implementation
             maybe_add_constructor_wrapper(code,
               cs_implicit_exceptions in current_settings.moduleswitches);
             addstatement(newstatement,code);
+            if assigned(nestedexitlabel) then
+              addstatement(newstatement,clabelnode.create(cnothingnode.create,nestedexitlabel));
             addstatement(newstatement,exitlabel_asmnode);
             addstatement(newstatement,bodyexitcode);
             if not is_constructor then

compiler/utils/ppudump.pp

@@ -1062,7 +1062,9 @@ const
          (mask:pi_has_global_goto;
          str:' subroutine contains interprocedural goto '),
          (mask:pi_has_inherited;
-         str:' subroutine contains inherited call ')
+         str:' subroutine contains inherited call '),
+         (mask:pi_has_nested_exit;
+         str:' subroutine contains a nested subroutine which calls the exit of the current one ')
   );
 var
   procinfooptions : tprocinfoflags;

tests/test/tmacnonlocalexit2.pp

@@ -0,0 +1,41 @@
+{ %fail }
+program tmacnonlocalexit2;
+{$MODE MACPAS}
+
+	var
+		failed: Boolean;
+
+	procedure Global;
+
+                procedure AnotherLocal;
+                  begin
+                  end;
+
+
+		procedure Local;
+		begin
+			Exit(AnotherLocal);
+			failed := true;
+		end;
+
+	begin
+		Local;
+		failed := true;
+	end;
+
+
+begin
+	failed := false;
+
+	Global;
+
+	if failed then
+		writeln('Failed')
+	else
+		writeln('Succeded');
+
+  {$IFC NOT UNDEFINED FPC}
+	if failed then
+		Halt(1);
+  {$ENDC}
+end.