+ noreturn directive

git-svn-id: trunk@26003 -

.gitattributes

@@ -11504,6 +11504,7 @@ tests/test/tnoext4.pp svneol=native#text/plain
 tests/test/tnonlocalgoto1.pp svneol=native#text/pascal
 tests/test/tnonlocalgoto2.pp svneol=native#text/pascal
 tests/test/tnonlocalgoto3.pp svneol=native#text/pascal
+tests/test/tnoreturn1.pp svneol=native#text/pascal
 tests/test/tnostackframe.pp svneol=native#text/pascal
 tests/test/tnostackframe2.pp svneol=native#text/pascal
 tests/test/tnostackframe3.pp svneol=native#text/pascal

compiler/ncal.pas

@@ -3209,6 +3209,10 @@ implementation
          if po_varargs in procdefinition.procoptions then
            include(callnodeflags,cnf_uses_varargs);
 
+         { set the appropriate node flag if the call never returns }
+         if po_noreturn in procdefinition.procoptions then
+           include(callnodeflags,cnf_call_never_returns);
+
          { Change loading of array of const to varargs }
          if assigned(left) and
             is_array_of_const(tparavarsym(procdefinition.paras[procdefinition.paras.count-1]).vardef) and

compiler/pdecsub.pas

@@ -2037,7 +2037,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=43;
+  num_proc_directives=44;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -2258,6 +2258,15 @@ const
       mutexclpocall : [pocall_internproc];
       mutexclpotype : [];
       mutexclpo     : []
+    ),(
+      idtok:_NORETURN;
+      pd_flags : [pd_implemen,pd_interface,pd_body,pd_notobjintf];
+      handler  : nil;
+      pocall   : pocall_none;
+      pooption : [po_noreturn];
+      mutexclpocall : [];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_interrupt,po_virtualmethod,po_iocheck]
     ),(
       idtok:_NOSTACKFRAME;
       pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf];

compiler/symconst.pas

@@ -352,7 +352,9 @@ type
       with a higher visibility on the JVM target }
     po_auto_raised_visibility,
     { procedure is far (x86 only) }
-    po_far
+    po_far,
+    { the procedure never returns, this information is usefull for dfa }
+    po_noreturn
   );
   tprocoptions=set of tprocoption;
 

compiler/tokens.pas

@@ -224,6 +224,7 @@ type
     _MULTIPLY,
     _MWPASCAL,
     _NEGATIVE,
+    _NORETURN,
     _NOTEQUAL,
     _OPERATOR,
     _OPTIONAL,
@@ -540,6 +541,7 @@ const
       (str:'MULTIPLY'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'MWPASCAL'      ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'NEGATIVE'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
+      (str:'NORETURN'      ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'NOTEQUAL'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'OPERATOR'      ;special:false;keyword:[m_fpc];op:NOTOKEN),
       (str:'OPTIONAL'      ;special:false;keyword:[m_none];op:NOTOKEN), { optional methods in an Objective-C protocol }

compiler/utils/ppuutils/ppudump.pp

@@ -1189,7 +1189,7 @@ const
          str:' subroutine contains a nested subroutine which calls the exit of the current one '),
          (mask:pi_has_stack_allocs;
          str:' allocates memory on stack, so stack may be unbalanced on exit ')
-         
+
   );
 var
   procinfooptions : tprocinfoflags;
@@ -1730,7 +1730,8 @@ const
      (mask:po_ignore_for_overload_resolution;str: 'Ignored for overload resolution'),
      (mask:po_rtlproc;         str: 'RTL procedure'),
      (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler'),
-     (mask:po_far;             str: 'Far')
+     (mask:po_far;             str: 'Far'),
+     (mask:po_noreturn;             str: 'No return')
   );
 var
   proctypeoption  : tproctypeoption;

tests/test/tnoreturn1.pp

@@ -0,0 +1,16 @@
+{ %OPT=-Sew -vw -Oodfa}
+
+procedure do_halt;noreturn;
+  begin
+    halt(0);
+  end;
+
+function f : longint;
+  begin
+    do_halt;
+  end;
+
+begin
+  f;
+end.
+