View Issue Details

IDProjectCategoryView StatusLast Update
0035857FPCCompilerpublic2019-07-18 22:55
ReporterJ. Gareth MoretonAssigned To 
PrioritynormalSeverityminorReproducibilityN/A
Status newResolutionopen 
PlatformCross-platformOSMicrosoft WindowsOS Version10 Professional
Product Version3.3.1Product Buildr42445 
Target VersionFixed in Version 
Summary0035857: [Patch] Node semantic pass and supporting code
DescriptionThis patch seeks to address a couple of compilation bugs by adding an additional pass to the node system that performs semantic checks. Most importantly, some code from TGotoNode.pass_1 was moved to a new routine to help patch issue 0032913 without causing regressions.

Some additional code had to be programmed in order to fully support this feature, including the presence of a new transient flags field for TNode and it descendants. The patches were split to the best of one's ability to keep the features separate, but there is a lot of overlap in the "firstpass" procedure of "compiler/pass_1.pas".
Steps To ReproduceN/A
Additional Information- "node_flags.patch" and "node_pass_semantic_base.patch" need to be applied together for the compiler to build.
- "node_pass_semantic_specific.patch" requires the other two patches and is optional, but addresses 0032913 as well as pre-emptively minimising the chances of similar bugs from appearing (semantic checks that can raise errors are moved from "pass_1" to "pass_semantic".
- "Node Semantic Pass.pdf" is a design specification to explain the motivation behind the changes and how they were put together in much more depth.

Finally, in order to help offset the performance penalty of an additional pass, "firstpass" was refactored to replace recursive calls with a "goto" to a point near the start of the procedure. The subroutine's design make compiler-driven tail recursion difficult, wihle constructs that don't use "goto" were more difficult to follow. The performance gain is explained in the PDF.
Tagscompiler, patch, refactor
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files
  • Node Semantic Pass.pdf (160,981 bytes)
  • node_flags.patch (10,709 bytes)
    Index: compiler/hlcgobj.pas
    ===================================================================
    --- compiler/hlcgobj.pas	(revision 42445)
    +++ compiler/hlcgobj.pas	(working copy)
    @@ -4313,7 +4313,7 @@
         var
           storepos : tfileposinfo;
         begin
    -       if nf_error in p.flags then
    +       if cf_error in p.compileflags then
              exit;
            storepos:=current_filepos;
            current_filepos:=p.fileinfo;
    Index: compiler/nbas.pas
    ===================================================================
    --- compiler/nbas.pas	(revision 42445)
    +++ compiler/nbas.pas	(working copy)
    @@ -461,7 +461,7 @@
         function terrornode.pass_typecheck:tnode;
           begin
              result:=nil;
    -         include(flags,nf_error);
    +         include(compileflags,cf_error);
              codegenerror:=true;
              resultdef:=generrordef;
           end;
    Index: compiler/ncgutil.pas
    ===================================================================
    --- compiler/ncgutil.pas	(revision 42445)
    +++ compiler/ncgutil.pas	(working copy)
    @@ -237,7 +237,7 @@
             storepos : tfileposinfo;
             tmpreg : tregister;
           begin
    -         if nf_error in p.flags then
    +         if cf_error in p.compileflags then
                exit;
              storepos:=current_filepos;
              current_filepos:=p.fileinfo;
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42445)
    +++ compiler/nflw.pas	(working copy)
    @@ -1631,7 +1648,7 @@
              if (cs_opt_loopunroll in current_settings.optimizerswitches) and
                assigned(t2) and
                { statements must be error free }
    -           not(nf_error in t2.flags) then
    +           not(cf_error in t2.compileflags) then
                begin
                  typecheckpass(t2);
                  res:=t2.simplify(false);
    Index: compiler/ninl.pas
    ===================================================================
    --- compiler/ninl.pas	(revision 42445)
    +++ compiler/ninl.pas	(working copy)
    @@ -4407,7 +4407,8 @@
              inserttypeconv_internal(hpp,resultnode.resultdef);
     
              { get varstates right }
    -         node_reset_flags(hpp,[nf_pass1_done,nf_modify,nf_write]);
    +         node_reset_flags(hpp,[nf_modify,nf_write]);
    +         node_reset_compile_flags(hpp,[cf_pass1_done]);
              do_typecheckpass(hpp);
     
              addstatement(newstatement,cassignmentnode.create(resultnode,hpp));
    @@ -4414,7 +4415,7 @@
     
              { force pass 1, so copied trees get first pass'ed as well and flags like nf_write, nf_call_unique
                get set right }
    -         node_reset_flags(newstatement.statement,[nf_pass1_done]);
    +         node_reset_compile_flags(newstatement.statement,[cf_pass1_done]);
              { firstpass it }
              firstpass(tnode(newstatement.left));
     
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42445)
    +++ compiler/node.pas	(working copy)
    @@ -212,10 +212,11 @@
              nf_swapable,
              { tbinop operands are swaped    }
              nf_swapped,
    -         nf_error,
     
    -         { general }
    -         nf_pass1_done,
    +         { Reserved flags were nf_error and nf_pass1_done, moved to TNodeCompileFlag
    +           due to their nature being of little use inside a PPU file }
    +         nf_reserved1,
    +         nf_reserved2,
              { Node is written to    }
              nf_write,
              { Node is modified      }
    @@ -286,10 +287,18 @@
     
            tnodeflags = set of tnodeflag;
     
    -    const
    +       TNodeCompileFlag = (
    +         cf_error,
    +         cf_semantics_done,
    +         cf_pass1_done
    +       );
    +
    +       TNodeCompileFlags = set of TNodeCompileFlag;
    +
    +//    const
            { contains the flags which must be equal for the equality }
            { of nodes                                                }
    -       flagsequal : tnodeflags = [nf_error];
    +//       flagsequal : tnodeflags = [nf_error];
     
         type
            tnodelist = class
    @@ -327,6 +340,8 @@
              localswitches : tlocalswitches;
              verbosity     : longint;
              optinfo : poptinfo;
    +         { Node flags that are transient and not stored in the PPU }
    +         compileflags : tnodecompileflags;
              constructor create(t:tnodetype);
              { this constructor is only for creating copies of class }
              { the fields are copied by getcopy                      }
    @@ -1290,7 +1332,7 @@
                 { superclass (for compatibility), so also check the classtype (JM) }
                 (p.classtype=classtype) and
                 (p.nodetype=nodetype) and
    -            (flags*flagsequal=p.flags*flagsequal) and
    +//            (flags*flagsequal=p.flags*flagsequal) and
                 docompare(p));
           end;
     
    @@ -1335,6 +1377,7 @@
              p.location:=location;
              p.parent:=parent;
              p.flags:=flags;
    +         p.compileflags:=compileflags;
              p.resultdef:=resultdef;
              p.fileinfo:=fileinfo;
              p.localswitches:=localswitches;
    
    @@ -783,6 +812,7 @@
              verbosity:=status.verbosity;
              resultdef:=nil;
              flags:=[];
    +         compileflags:=[];
           end;
     
         constructor tnode.createforcopy;
    @@ -794,6 +824,7 @@
     
           begin
             nodetype:=t;
    +        compileflags:=[];
             { tnode fields }
             blocktype:=tblock_type(ppufile.getbyte);
             ppufile.getposinfo(fileinfo);
    Index: compiler/nutils.pas
    ===================================================================
    --- compiler/nutils.pas	(revision 42445)
    +++ compiler/nutils.pas	(working copy)
    @@ -161,6 +161,9 @@
         { excludes the flags passed in nf from the node tree passed }
         procedure node_reset_flags(p : tnode;nf : tnodeflags);
     
    +    { excludes the compile flags passed in nf from the node tree passed }
    +    procedure node_reset_compile_flags(p : tnode;cf : tnodecompileflags);
    +
         { include or exclude cs from p.localswitches }
         procedure node_change_local_switch(p : tnode;cs : tlocalswitch;enable : boolean);
     
    @@ -1503,6 +1506,19 @@
             foreachnodestatic(p,@do_node_reset_flags,@nf);
           end;
     
    +
    +    function do_node_reset_compile_flags(var n: tnode; arg: pointer): foreachnoderesult;
    +      begin
    +        result:=fen_false;
    +        n.compileflags:=n.compileflags-tnodecompileflags(arg^);
    +      end;
    +
    +
    +    procedure node_reset_compile_flags(p : tnode; cf : tnodecompileflags);
    +      begin
    +        foreachnodestatic(p,@do_node_reset_compile_flags,@cf);
    +      end;
    +
         type
            tlocalswitchchange = record
              cs : tlocalswitch;
    Index: compiler/optconstprop.pas
    ===================================================================
    --- compiler/optconstprop.pas	(revision 42445)
    +++ compiler/optconstprop.pas	(working copy)
    @@ -235,7 +235,7 @@
             if n.nodetype<>callparan then
               begin
                 if tree_modified then
    -              exclude(n.flags,nf_pass1_done);
    +              exclude(n.compileflags,cf_pass1_done);
     
                 do_firstpass(n);
               end;
    Index: compiler/optcse.pas
    ===================================================================
    --- compiler/optcse.pas	(revision 42445)
    +++ compiler/optcse.pas	(working copy)
    @@ -366,7 +366,7 @@
     
                                   { the transformed tree could result in new possibilities to fold constants
                                     so force a firstpass on the root node }
    -                              exclude(tbinarynode(n).right.flags,nf_pass1_done);
    +                              exclude(tbinarynode(n).right.compileflags,cf_pass1_done);
                                   do_firstpass(tbinarynode(n).right);
                                 end
                               else
    Index: compiler/optdeadstore.pas
    ===================================================================
    --- compiler/optdeadstore.pas	(revision 42445)
    +++ compiler/optdeadstore.pas	(working copy)
    @@ -94,7 +94,7 @@
                             tstatementnode(n).statement.free;
     
                             tstatementnode(n).statement:=cnothingnode.create;
    -                        Exclude(tstatementnode(n).flags, nf_pass1_done);
    +                        Exclude(tstatementnode(n).compileflags, cf_pass1_done);
                             do_firstpass(n);
                           end
                       end;
    Index: compiler/pass_1.pas
    ===================================================================
    --- compiler/pass_1.pas	(revision 42445)
    +++ compiler/pass_1.pas	(working copy)
    @@ -94,7 +94,7 @@
                status.verbosity:=oldverbosity;
                if codegenerror then
                 begin
    -              include(p.flags,nf_error);
    +              include(p.compileflags,cf_error);
                   { default to errortype if no type is set yet }
                   if p.resultdef=nil then
                    p.resultdef:=generrordef;
    @@ -104,7 +104,7 @@
             else
              begin
                { update the codegenerror boolean with the previous result of this node }
    -           if (nf_error in p.flags) then
    +           if (cf_error in p.compileflags) then
                  codegenerror:=true;
              end;
           end;
    @@ -206,6 +223,7 @@
                         end;
                       if codegenerror then
    -                   include(p.flags,nf_error)
    +                   include(p.compileflags,cf_error)
                       else
                        begin
     {$ifdef EXTDEBUG}
    Index: compiler/pass_2.pas
    ===================================================================
    --- compiler/pass_2.pas	(revision 42445)
    +++ compiler/pass_2.pas	(working copy)
    @@ -184,7 +184,7 @@
           begin
              if not assigned(p) then
               internalerror(200208221);
    -         if not(nf_error in p.flags) then
    +         if not(cf_error in p.compileflags) then
               begin
                 oldcodegenerror:=codegenerror;
                 oldlocalswitches:=current_settings.localswitches;
    @@ -225,7 +225,7 @@
                  end;
     {$endif EXTDEBUG}
                 if codegenerror then
    -              include(p.flags,nf_error);
    +              include(p.compileflags,cf_error);
                 codegenerror:=codegenerror or oldcodegenerror;
                 current_settings.localswitches:=oldlocalswitches;
                 current_filepos:=oldpos;
    @@ -244,7 +244,7 @@
     
              { clear errors before starting }
              codegenerror:=false;
    -         if not(nf_error in p.flags) then
    +         if not(cf_error in p.compileflags) then
                secondpass(p);
              do_secondpass:=codegenerror;
           end;
    
    node_flags.patch (10,709 bytes)
  • node_pass_semantic_base.patch (8,118 bytes)
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42445)
    +++ compiler/node.pas	(working copy)
    @@ -301,6 +310,10 @@
           private
              fppuidx : longint;
              function getppuidx:longint;
    +      protected
    +         { Static helper procedure that calls n.pass_semantic only after checking
    +           that n is not nil and the right flags are set }
    +         class procedure do_semantic_pass(const n: TNode); static; inline;
           public
              { type of this node }
              nodetype : tnodetype;
    @@ -341,6 +356,17 @@
              { toggles the flag }
              procedure toggleflag(f : tnodeflag);
     
    +         { pass_semantic will perform semantic checks on the node, returning
    +           compiler errors if necessary (pass_1 may not always be executed, but
    +           pass_semantic always is)
    +
    +           - No node transformations may happen in this stage, but information
    +             found during the checks is allowed to be stored in private fields.
    +           - When overriding, call inherited as the LAST operation (unless the
    +             node class is a direct descendant of tnode).
    +           - If an error is found, set the nf_error flag. }
    +         procedure pass_semantic; virtual;
    +
              { the 1.1 code generator may override pass_1 }
              { and it need not to implement det_* then    }
              { 1.1: pass_1 returns a value<>0 if the node has been transformed }
    @@ -425,6 +451,7 @@
     {$ifdef DEBUG_NODE_XML}
              procedure XMLPrintNodeData(var T: Text); override;
     {$endif DEBUG_NODE_XML}
    +         procedure pass_semantic; override;
           end;
     
           //pbinarynode = ^tbinarynode;
    @@ -448,6 +475,7 @@
              procedure XMLPrintNodeData(var T: Text); override;
     {$endif DEBUG_NODE_XML}
              procedure printnodelist(var t:text);
    +         procedure pass_semantic; override;
           end;
     
           //ptertiarynode = ^ttertiarynode;
    @@ -468,6 +496,7 @@
     {$ifdef DEBUG_NODE_XML}
              procedure XMLPrintNodeData(var T: Text); override;
     {$endif DEBUG_NODE_XML}
    +         procedure pass_semantic; override;
           end;
     
           tbinopnode = class(tbinarynode)
    @@ -856,6 +887,19 @@
           end;
     
     
    +    class procedure tnode.do_semantic_pass(const n: TNode);
    +      begin
    +        if Assigned(n) and (n.compileflags*[cf_error, cf_semantics_done, cf_pass1_done]=[]) then
    +          n.pass_semantic;
    +      end;
    +
    +
    +    procedure tnode.pass_semantic;
    +      begin
    +        Include(compileflags, cf_semantics_done);
    +        do_semantic_pass(successor);
    +      end;
    +
         function tnode.simplify(forinline : boolean) : tnode;
           begin
             result:=nil;
    @@ -1462,6 +1507,13 @@
           end;
     
     
    +    procedure tunarynode.pass_semantic;
    +      begin
    +        Include(compileflags, cf_semantics_done);
    +        do_semantic_pass(left);
    +        do_semantic_pass(successor);
    +      end;
    +
     {****************************************************************************
                                 TBINARYNODE
      ****************************************************************************}
    @@ -1615,6 +1667,15 @@
           end;
     
     
    +    procedure tbinarynode.pass_semantic;
    +      begin
    +        Include(compileflags, cf_semantics_done);
    +        do_semantic_pass(left);
    +        do_semantic_pass(right);
    +        do_semantic_pass(successor);
    +      end;
    +
    +
     {****************************************************************************
                                      TTERTIARYNODE
      ****************************************************************************}
    @@ -1725,6 +1786,16 @@
           end;
     
     
    +    procedure ttertiarynode.pass_semantic;
    +      begin
    +        Include(compileflags, cf_semantics_done);
    +        do_semantic_pass(left);
    +        do_semantic_pass(right);
    +        do_semantic_pass(third);
    +        do_semantic_pass(right);
    +      end;
    +
    +
     {****************************************************************************
                                 TBINOPNODE
      ****************************************************************************}
    Index: compiler/pass_1.pas
    ===================================================================
    --- compiler/pass_1.pas	(revision 42445)
    +++ compiler/pass_1.pas	(working copy)@@ -26,7 +26,7 @@
     interface
     
         uses
    -       node;
    +       node, verbose;
     
         procedure typecheckpass(var p : tnode);
         function  do_typecheckpass(var p : tnode) : boolean;
    @@ -141,15 +141,26 @@
              oldpos    : tfileposinfo;
              oldverbosity: longint;
              hp : tnode;
    +      label
    +        Reprocess;
           begin
    -         if (nf_pass1_done in p.flags) then
    -           exit;
    -         if not(nf_error in p.flags) then
    +         oldcodegenerror:=codegenerror;
    +         oldpos:=current_filepos;
    +         oldlocalswitches:=current_settings.localswitches;
    +         oldverbosity:=status.verbosity;
    +
    +Reprocess:
    +
    +         if not (cf_semantics_done in p.compileflags) then
    +//           InternalError(2019071520);
    +           p.pass_semantic;
    +
    +         if (cf_error in p.compileflags) then
                begin
    -              oldcodegenerror:=codegenerror;
    -              oldpos:=current_filepos;
    -              oldlocalswitches:=current_settings.localswitches;
    -              oldverbosity:=status.verbosity;
    +             codegenerror:=true;
    +           end
    +         else if not (cf_pass1_done in p.compileflags) then
    +           begin
                   codegenerror:=false;
                   current_filepos:=p.fileinfo;
                   current_settings.localswitches:=p.localswitches;
    @@ -172,14 +183,19 @@
                        end;
                       if codegenerror then
                        begin
    -                     include(p.flags,nf_error);
    +                     include(p.compileflags,cf_error);
                          { default to errortype if no type is set yet }
                          if p.resultdef=nil then
                           p.resultdef:=generrordef;
    -                   end;
    +                   end
    +                  else
    +                    begin
    +                      p.pass_semantic;
    +                      codegenerror:=(cf_error in p.compileflags);
    +                    end;
                       codegenerror:=codegenerror or oldcodegenerror;
                     end;
    -              if not(nf_error in p.flags) then
    +              if not(cf_error in p.compileflags) then
                     begin
                       { first pass }
                       hp:=p.pass_1;
    @@ -189,8 +205,8 @@
                          p.free;
                          { switch to new node }
                          p := hp;
    -                     { run firstpass }
    -                     firstpass(p);
    +                     { re-run semantic and firstpass on this new node }
    +                     goto Reprocess;
                        end
                       else
                         begin
    @@ -201,6 +217,7 @@
                             begin
                               p.free;
                               p := hp;
    -                          firstpass(p);
    +                          { re-run semantic and firstpass on this new node }
    +                          goto Reprocess;
                             end;
                         end;
    @@ -214,14 +231,13 @@
     {$endif EXTDEBUG}
                        end;
                     end;
    -              include(p.flags,nf_pass1_done);
    -              codegenerror:=codegenerror or oldcodegenerror;
    -              current_settings.localswitches:=oldlocalswitches;
    -              current_filepos:=oldpos;
    -              status.verbosity:=oldverbosity;
    -           end
    -         else
    -           codegenerror:=true;
    +           end;
    +
    +         include(p.compileflags,cf_pass1_done);
    +         codegenerror:=codegenerror or oldcodegenerror;
    +         current_settings.localswitches:=oldlocalswitches;
    +         current_filepos:=oldpos;
    +         status.verbosity:=oldverbosity;
           end;
    
  • node_pass_semantic_specific.patch (12,401 bytes)
    Index: compiler/ncal.pas
    ===================================================================
    --- compiler/ncal.pas	(revision 42445)
    +++ compiler/ncal.pas	(working copy)
    @@ -194,6 +194,7 @@
               }
               procedure verifyabstract(sym:TObject;arg:pointer);
               procedure insertintolist(l : tnodelist);override;
    +          procedure pass_semantic;override;
               function  pass_1 : tnode;override;
               function  pass_typecheck:tnode;override;
            {$ifdef state_tracking}
    @@ -4277,6 +4278,20 @@
           end;
     
     
    +    procedure tcallnode.pass_semantic;
    +      begin
    +        { as pass_1 and pass_semantic are never called on the methodpointer
    +          node, we must check here that it's not a helper type }
    +        if assigned(methodpointer) and
    +            (methodpointer.nodetype=typen) and
    +            is_objectpascal_helper(ttypenode(methodpointer).typedef) and
    +            not ttypenode(methodpointer).helperallowed then
    +          CGMessage(parser_e_no_category_as_types);
    +
    +        inherited pass_semantic;
    +      end;
    +
    +
         function tcallnode.pass_1 : tnode;
     
           procedure mark_unregable_parameters;
    @@ -4326,19 +4341,6 @@
              aktcallnode:=self;
     
              try
    -           { as pass_1 is never called on the methodpointer node, we must check
    -             here that it's not a helper type }
    -           if assigned(methodpointer) and
    -               (methodpointer.nodetype=typen) and
    -               is_objectpascal_helper(ttypenode(methodpointer).typedef) and
    -               not ttypenode(methodpointer).helperallowed then
    -             begin
    -               CGMessage(parser_e_no_category_as_types);
    -               { we get an internal error when trying to insert the hidden
    -                 parameters in this case }
    -               exit;
    -             end;
    -
                { can we get rid of the call? }
                if (cs_opt_remove_emtpy_proc in current_settings.optimizerswitches) and
                   not(cnf_return_value_used in callnodeflags) and
    Index: compiler/ncnv.pas
    ===================================================================
    --- compiler/ncnv.pas	(revision 42445)
    +++ compiler/ncnv.pas	(working copy)
    @@ -67,6 +67,7 @@
     {$ifdef DEBUG_NODE_XML}
               procedure XMLPrintNodeInfo(var T: Text); override;
     {$endif DEBUG_NODE_XML}
    +          procedure pass_semantic; override;
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function simplify(forinline : boolean):tnode; override;
    @@ -2390,6 +2391,15 @@
           end;
     
     
    +    procedure ttypeconvnode.pass_semantic;
    +      begin
    +        if warn_pointer_to_signed then
    +          cgmessage(type_w_pointer_to_signed);
    +
    +        inherited pass_semantic;
    +      end;
    +
    +
         function ttypeconvnode.pass_typecheck:tnode;
     
           var
    @@ -3950,8 +3960,6 @@
     
         function ttypeconvnode.pass_1 : tnode;
           begin
    -        if warn_pointer_to_signed then
    -          cgmessage(type_w_pointer_to_signed);
             result:=nil;
             firstpass(left);
             if codegenerror then
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42445)
    +++ compiler/nflw.pas	(working copy)
    @@ -73,6 +73,7 @@
               procedure XMLPrintNodeTree(var T: Text); override;
     {$endif DEBUG_NODE_XML}
               function docompare(p: tnode): boolean; override;
    +          procedure pass_semantic; override;
            end;
     
            twhilerepeatnode = class(tloopnode)
    @@ -138,9 +139,13 @@
            end;
            tcontinuenodeclass = class of tcontinuenode;
     
    +       tjumptype = (jt_Unknown, jt_Regular, jt_Long);
    +
            tgotonode = class(tnode)
            private
               labelnodeidx : longint;
    +          { Information passed from the semantic pass to pass 1 }
    +          jumptype : tjumptype;
            public
               labelsym : tlabelsym;
               labelnode : tlabelnode;
    @@ -152,6 +157,7 @@
               procedure derefimpl;override;
               procedure resolveppuidx;override;
               function dogetcopy : tnode;override;
    +          procedure pass_semantic;override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
               function docompare(p: tnode): boolean; override;
    @@ -170,6 +176,7 @@
               procedure buildderefimpl;override;
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
    +          procedure pass_semantic;override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
               function docompare(p: tnode): boolean; override;
    @@ -187,7 +194,6 @@
               constructor create(l,r,_t1 : tnode);virtual;reintroduce;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
    -          function simplify(forinline: boolean): tnode; override;
              protected
               procedure adjust_estimated_stack_size; virtual;
            end;
    @@ -1179,6 +1185,17 @@
               t2.isequal(tloopnode(p).t2);
           end;
     
    +
    +    procedure tloopnode.pass_semantic;
    +      begin
    +        Include(compileflags, cf_semantics_done);
    +        do_semantic_pass(left);
    +        do_semantic_pass(right);
    +        do_semantic_pass(t1);
    +        do_semantic_pass(t2);
    +        do_semantic_pass(successor);
    +      end;
    +
     {****************************************************************************
                                    TWHILEREPEATNODE
     *****************************************************************************}
    @@ -1996,6 +2013,7 @@
             exceptionblock:=current_exceptblock;
             labelnode:=nil;
             labelsym:=p;
    +        jumptype:=jt_Unknown;
           end;
     
     
    @@ -2036,20 +2054,10 @@
           end;
     
     
    -    function tgotonode.pass_typecheck:tnode;
    -      begin
    -        result:=nil;
    -        resultdef:=voidtype;
    -      end;
    -
    -
    -    function tgotonode.pass_1 : tnode;
    +    procedure tgotonode.pass_semantic;
           var
             p2 : tprocinfo;
           begin
    -        result:=nil;
    -        expectloc:=LOC_VOID;
    -
             { The labelnode can already be set when
               this node was copied }
             if not(assigned(labelnode)) then
    @@ -2086,31 +2094,74 @@
                             p2:=p2.parent
                           end;
     
    -                    if assigned(labelsym.jumpbuf) then
    +                    if not assigned(labelsym.jumpbuf) then
                           begin
    -                        labelsym.nonlocal:=true;
    -                        result:=ccallnode.createintern('fpc_longjmp',
    -                          ccallparanode.create(cordconstnode.create(1,sinttype,true),
    -                          ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
    -                        nil)));
    +                        CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
    +                        Include(compileflags, cf_error);
                           end
                         else
    -                      CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
    +                      jumptype:=jt_Long;
                       end
                     else
    -                  CGMessage(cg_e_interprocedural_goto_only_to_outer_scope_allowed);
    +                  begin
    +                    CGMessage(cg_e_interprocedural_goto_only_to_outer_scope_allowed);
    +                    Include(compileflags, cf_error);
    +                  end;
                   end
                 else
    -              CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
    +              begin
    +                CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
    +                Include(compileflags, cf_error);
    +              end;
               end;
     
    -        { check if we don't mess with exception blocks }
    -        if assigned(labelnode) and
    -           (exceptionblock<>labelnode.exceptionblock) then
    -          CGMessage(cg_e_goto_inout_of_exception_block);
    +        if assigned(labelnode) then
    +          begin
    +            { check if we don't mess with exception blocks }
    +            if (exceptionblock<>labelnode.exceptionblock) then
    +              begin
    +                CGMessage(cg_e_goto_inout_of_exception_block);
    +                Include(compileflags, cf_error);
    +              end
    +            else
    +              jumptype:=jt_Regular;
    +          end;
    +
    +        inherited pass_semantic;
           end;
     
     
    +    function tgotonode.pass_typecheck:tnode;
    +      begin
    +        result:=nil;
    +        resultdef:=voidtype;
    +      end;
    +
    +
    +    function tgotonode.pass_1 : tnode;
    +      var
    +        p2 : tprocinfo;
    +      begin
    +        result:=nil;
    +        expectloc:=LOC_VOID;
    +
    +        case jumptype of
    +          jt_Unknown:
    +            InternalError(2019071510);
    +          jt_Regular:
    +            { Do nothing };
    +          jt_Long:
    +            begin
    +              labelsym.nonlocal:=true;
    +              result:=ccallnode.createintern('fpc_longjmp',
    +                ccallparanode.create(cordconstnode.create(1,sinttype,true),
    +                ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
    +              nil)));
    +            end;
    +        end;
    +      end;
    +
    +
        function tgotonode.dogetcopy : tnode;
          var
            p : tgotonode;
    @@ -2117,6 +2168,7 @@
          begin
             p:=tgotonode(inherited dogetcopy);
             p.exceptionblock:=exceptionblock;
    +        p.jumptype:=jumptype;
     
             { generate labelnode if not done yet }
             if not(assigned(labelnode)) then
    @@ -2216,6 +2268,18 @@
           end;
     
     
    +    procedure tlabelnode.pass_semantic;
    +      begin
    +        if (m_non_local_goto in current_settings.modeswitches) and
    +            { the owner can be Nil for internal labels }
    +            assigned(labsym.owner) and
    +          (current_procinfo.procdef.parast.symtablelevel<>labsym.owner.symtablelevel) then
    +          CGMessage(cg_e_labels_cannot_defined_outside_declaration_scope);
    +
    +        inherited pass_semantic;
    +      end;
    +
    +
         function tlabelnode.pass_1 : tnode;
           begin
             result:=nil;
    @@ -2225,11 +2289,6 @@
     
             if assigned(left) then
               firstpass(left);
    -        if (m_non_local_goto in current_settings.modeswitches) and
    -            { the owner can be Nil for internal labels }
    -            assigned(labsym.owner) and
    -          (current_procinfo.procdef.parast.symtablelevel<>labsym.owner.symtablelevel) then
    -          CGMessage(cg_e_labels_cannot_defined_outside_declaration_scope)
           end;
     
     
    @@ -2377,29 +2436,33 @@
             result:=nil;
             expectloc:=LOC_VOID;
             firstpass(left);
    -        { on statements }
    -        if assigned(right) then
    -          firstpass(right);
    -        { else block }
    -        if assigned(t1) then
    -          firstpass(t1);
    +        if has_no_code(left) then
    +          begin
    +            { empty try -> can never raise exception -> do nothing and delete
    +              entire except block }
    +            result:=cnothingnode.create;
    +            right.Free;
    +            right:=nil;
    +            t1.Free;
    +            t1:=nil;
    +          end
    +        else
    +          begin
    +            { on statements }
    +            if assigned(right) then
    +              firstpass(right);
    +            { else block }
    +            if assigned(t1) then
    +              firstpass(t1);
     
    -        include(current_procinfo.flags,pi_do_call);
    -        include(current_procinfo.flags,pi_uses_exceptions);
    +            include(current_procinfo.flags,pi_do_call);
    +            include(current_procinfo.flags,pi_uses_exceptions);
     
    -        adjust_estimated_stack_size;
    +            adjust_estimated_stack_size;
    +          end;
           end;
     
     
    -    function ttryexceptnode.simplify(forinline: boolean): tnode;
    -      begin
    -        result:=nil;
    -        { empty try -> can never raise exception -> do nothing }
    -        if has_no_code(left) then
    -          result:=cnothingnode.create;
    -      end;
    -
    -
         procedure ttryexceptnode.adjust_estimated_stack_size;
           begin
             inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size*2);
    

Relationships

child of 0032913 feedbackFlorian nested try blocks with exit gives Error: Internal error 

Activities

J. Gareth Moreton

2019-07-18 05:55

developer  

Node Semantic Pass.pdf (160,981 bytes)

Sven Barth

2019-07-18 12:01

manager   ~0117302

I've not yet looked at the patches in absolute detail (especially regarding functionality), but some things I noticed:
- it seems you missed some changes when adding "compilerflags" in node_flags.patch (some of these are still in node_pass_semantic_base.patch); please test with that patch alone and see what I mean ;)
- you have too many spaces in various code parts between symbols and operators (especially in node_pass_semantic_base.patch and node_pass_semantic_specific.patch)
- the entries of the "tjumptype" enum should be "jt_unknown", etc.

J. Gareth Moreton

2019-07-18 14:06

developer   ~0117304

Last edited: 2019-07-18 14:06

View 2 revisions

I'll take a look at the patches. I did have trouble isolating all of the flag changes because there are different modifications in "firstpass" that almost overlap to the point that two separate patches would fail to merge. I did try to explain that while I attempted to keep the changes separate, it proved impossible and so the two patches rely on each other. Otherwise you just have to manually correct the forgotten entries when you merge the patch alone.

J. Gareth Moreton

2019-07-18 21:28

developer   ~0117310

Fixed some of the issues that Sven brought up. "node_flags" still requires "node_pass_semantic_base" to compile, but it's easier to make "node_flags" compile by itself now.

node_flags.patch (10,709 bytes)
Index: compiler/hlcgobj.pas
===================================================================
--- compiler/hlcgobj.pas	(revision 42445)
+++ compiler/hlcgobj.pas	(working copy)
@@ -4313,7 +4313,7 @@
     var
       storepos : tfileposinfo;
     begin
-       if nf_error in p.flags then
+       if cf_error in p.compileflags then
          exit;
        storepos:=current_filepos;
        current_filepos:=p.fileinfo;
Index: compiler/nbas.pas
===================================================================
--- compiler/nbas.pas	(revision 42445)
+++ compiler/nbas.pas	(working copy)
@@ -461,7 +461,7 @@
     function terrornode.pass_typecheck:tnode;
       begin
          result:=nil;
-         include(flags,nf_error);
+         include(compileflags,cf_error);
          codegenerror:=true;
          resultdef:=generrordef;
       end;
Index: compiler/ncgutil.pas
===================================================================
--- compiler/ncgutil.pas	(revision 42445)
+++ compiler/ncgutil.pas	(working copy)
@@ -237,7 +237,7 @@
         storepos : tfileposinfo;
         tmpreg : tregister;
       begin
-         if nf_error in p.flags then
+         if cf_error in p.compileflags then
            exit;
          storepos:=current_filepos;
          current_filepos:=p.fileinfo;
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42445)
+++ compiler/nflw.pas	(working copy)
@@ -1631,7 +1648,7 @@
          if (cs_opt_loopunroll in current_settings.optimizerswitches) and
            assigned(t2) and
            { statements must be error free }
-           not(nf_error in t2.flags) then
+           not(cf_error in t2.compileflags) then
            begin
              typecheckpass(t2);
              res:=t2.simplify(false);
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 42445)
+++ compiler/ninl.pas	(working copy)
@@ -4407,7 +4407,8 @@
          inserttypeconv_internal(hpp,resultnode.resultdef);
 
          { get varstates right }
-         node_reset_flags(hpp,[nf_pass1_done,nf_modify,nf_write]);
+         node_reset_flags(hpp,[nf_modify,nf_write]);
+         node_reset_compile_flags(hpp,[cf_pass1_done]);
          do_typecheckpass(hpp);
 
          addstatement(newstatement,cassignmentnode.create(resultnode,hpp));
@@ -4414,7 +4415,7 @@
 
          { force pass 1, so copied trees get first pass'ed as well and flags like nf_write, nf_call_unique
            get set right }
-         node_reset_flags(newstatement.statement,[nf_pass1_done]);
+         node_reset_compile_flags(newstatement.statement,[cf_pass1_done]);
          { firstpass it }
          firstpass(tnode(newstatement.left));
 
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42445)
+++ compiler/node.pas	(working copy)
@@ -212,10 +212,11 @@
          nf_swapable,
          { tbinop operands are swaped    }
          nf_swapped,
-         nf_error,
 
-         { general }
-         nf_pass1_done,
+         { Reserved flags were nf_error and nf_pass1_done, moved to TNodeCompileFlag
+           due to their nature being of little use inside a PPU file }
+         nf_reserved1,
+         nf_reserved2,
          { Node is written to    }
          nf_write,
          { Node is modified      }
@@ -286,10 +287,18 @@
 
        tnodeflags = set of tnodeflag;
 
-    const
+       TNodeCompileFlag = (
+         cf_error,
+         cf_semantics_done,
+         cf_pass1_done
+       );
+
+       TNodeCompileFlags = set of TNodeCompileFlag;
+
+//    const
        { contains the flags which must be equal for the equality }
        { of nodes                                                }
-       flagsequal : tnodeflags = [nf_error];
+//       flagsequal : tnodeflags = [nf_error];
 
     type
        tnodelist = class
@@ -327,6 +340,8 @@
          localswitches : tlocalswitches;
          verbosity     : longint;
          optinfo : poptinfo;
+         { Node flags that are transient and not stored in the PPU }
+         compileflags : tnodecompileflags;
          constructor create(t:tnodetype);
          { this constructor is only for creating copies of class }
          { the fields are copied by getcopy                      }
@@ -1290,7 +1332,7 @@
             { superclass (for compatibility), so also check the classtype (JM) }
             (p.classtype=classtype) and
             (p.nodetype=nodetype) and
-            (flags*flagsequal=p.flags*flagsequal) and
+//            (flags*flagsequal=p.flags*flagsequal) and
             docompare(p));
       end;
 
@@ -1335,6 +1377,7 @@
          p.location:=location;
          p.parent:=parent;
          p.flags:=flags;
+         p.compileflags:=compileflags;
          p.resultdef:=resultdef;
          p.fileinfo:=fileinfo;
          p.localswitches:=localswitches;

@@ -783,6 +812,7 @@
          verbosity:=status.verbosity;
          resultdef:=nil;
          flags:=[];
+         compileflags:=[];
       end;
 
     constructor tnode.createforcopy;
@@ -794,6 +824,7 @@
 
       begin
         nodetype:=t;
+        compileflags:=[];
         { tnode fields }
         blocktype:=tblock_type(ppufile.getbyte);
         ppufile.getposinfo(fileinfo);
Index: compiler/nutils.pas
===================================================================
--- compiler/nutils.pas	(revision 42445)
+++ compiler/nutils.pas	(working copy)
@@ -161,6 +161,9 @@
     { excludes the flags passed in nf from the node tree passed }
     procedure node_reset_flags(p : tnode;nf : tnodeflags);
 
+    { excludes the compile flags passed in nf from the node tree passed }
+    procedure node_reset_compile_flags(p : tnode;cf : tnodecompileflags);
+
     { include or exclude cs from p.localswitches }
     procedure node_change_local_switch(p : tnode;cs : tlocalswitch;enable : boolean);
 
@@ -1503,6 +1506,19 @@
         foreachnodestatic(p,@do_node_reset_flags,@nf);
       end;
 
+
+    function do_node_reset_compile_flags(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        result:=fen_false;
+        n.compileflags:=n.compileflags-tnodecompileflags(arg^);
+      end;
+
+
+    procedure node_reset_compile_flags(p : tnode; cf : tnodecompileflags);
+      begin
+        foreachnodestatic(p,@do_node_reset_compile_flags,@cf);
+      end;
+
     type
        tlocalswitchchange = record
          cs : tlocalswitch;
Index: compiler/optconstprop.pas
===================================================================
--- compiler/optconstprop.pas	(revision 42445)
+++ compiler/optconstprop.pas	(working copy)
@@ -235,7 +235,7 @@
         if n.nodetype<>callparan then
           begin
             if tree_modified then
-              exclude(n.flags,nf_pass1_done);
+              exclude(n.compileflags,cf_pass1_done);
 
             do_firstpass(n);
           end;
Index: compiler/optcse.pas
===================================================================
--- compiler/optcse.pas	(revision 42445)
+++ compiler/optcse.pas	(working copy)
@@ -366,7 +366,7 @@
 
                               { the transformed tree could result in new possibilities to fold constants
                                 so force a firstpass on the root node }
-                              exclude(tbinarynode(n).right.flags,nf_pass1_done);
+                              exclude(tbinarynode(n).right.compileflags,cf_pass1_done);
                               do_firstpass(tbinarynode(n).right);
                             end
                           else
Index: compiler/optdeadstore.pas
===================================================================
--- compiler/optdeadstore.pas	(revision 42445)
+++ compiler/optdeadstore.pas	(working copy)
@@ -94,7 +94,7 @@
                         tstatementnode(n).statement.free;
 
                         tstatementnode(n).statement:=cnothingnode.create;
-                        Exclude(tstatementnode(n).flags, nf_pass1_done);
+                        Exclude(tstatementnode(n).compileflags, cf_pass1_done);
                         do_firstpass(n);
                       end
                   end;
Index: compiler/pass_1.pas
===================================================================
--- compiler/pass_1.pas	(revision 42445)
+++ compiler/pass_1.pas	(working copy)
@@ -94,7 +94,7 @@
            status.verbosity:=oldverbosity;
            if codegenerror then
             begin
-              include(p.flags,nf_error);
+              include(p.compileflags,cf_error);
               { default to errortype if no type is set yet }
               if p.resultdef=nil then
                p.resultdef:=generrordef;
@@ -104,7 +104,7 @@
         else
          begin
            { update the codegenerror boolean with the previous result of this node }
-           if (nf_error in p.flags) then
+           if (cf_error in p.compileflags) then
              codegenerror:=true;
          end;
       end;
@@ -206,6 +223,7 @@
                     end;
                   if codegenerror then
-                   include(p.flags,nf_error)
+                   include(p.compileflags,cf_error)
                   else
                    begin
 {$ifdef EXTDEBUG}
Index: compiler/pass_2.pas
===================================================================
--- compiler/pass_2.pas	(revision 42445)
+++ compiler/pass_2.pas	(working copy)
@@ -184,7 +184,7 @@
       begin
          if not assigned(p) then
           internalerror(200208221);
-         if not(nf_error in p.flags) then
+         if not(cf_error in p.compileflags) then
           begin
             oldcodegenerror:=codegenerror;
             oldlocalswitches:=current_settings.localswitches;
@@ -225,7 +225,7 @@
              end;
 {$endif EXTDEBUG}
             if codegenerror then
-              include(p.flags,nf_error);
+              include(p.compileflags,cf_error);
             codegenerror:=codegenerror or oldcodegenerror;
             current_settings.localswitches:=oldlocalswitches;
             current_filepos:=oldpos;
@@ -244,7 +244,7 @@
 
          { clear errors before starting }
          codegenerror:=false;
-         if not(nf_error in p.flags) then
+         if not(cf_error in p.compileflags) then
            secondpass(p);
          do_secondpass:=codegenerror;
       end;
node_flags.patch (10,709 bytes)

J. Gareth Moreton

2019-07-18 22:55

developer   ~0117313

Fixed the spacing conventions between operators.

node_pass_semantic_base.patch (8,118 bytes)
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42445)
+++ compiler/node.pas	(working copy)
@@ -301,6 +310,10 @@
       private
          fppuidx : longint;
          function getppuidx:longint;
+      protected
+         { Static helper procedure that calls n.pass_semantic only after checking
+           that n is not nil and the right flags are set }
+         class procedure do_semantic_pass(const n: TNode); static; inline;
       public
          { type of this node }
          nodetype : tnodetype;
@@ -341,6 +356,17 @@
          { toggles the flag }
          procedure toggleflag(f : tnodeflag);
 
+         { pass_semantic will perform semantic checks on the node, returning
+           compiler errors if necessary (pass_1 may not always be executed, but
+           pass_semantic always is)
+
+           - No node transformations may happen in this stage, but information
+             found during the checks is allowed to be stored in private fields.
+           - When overriding, call inherited as the LAST operation (unless the
+             node class is a direct descendant of tnode).
+           - If an error is found, set the nf_error flag. }
+         procedure pass_semantic; virtual;
+
          { the 1.1 code generator may override pass_1 }
          { and it need not to implement det_* then    }
          { 1.1: pass_1 returns a value<>0 if the node has been transformed }
@@ -425,6 +451,7 @@
 {$ifdef DEBUG_NODE_XML}
          procedure XMLPrintNodeData(var T: Text); override;
 {$endif DEBUG_NODE_XML}
+         procedure pass_semantic; override;
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -448,6 +475,7 @@
          procedure XMLPrintNodeData(var T: Text); override;
 {$endif DEBUG_NODE_XML}
          procedure printnodelist(var t:text);
+         procedure pass_semantic; override;
       end;
 
       //ptertiarynode = ^ttertiarynode;
@@ -468,6 +496,7 @@
 {$ifdef DEBUG_NODE_XML}
          procedure XMLPrintNodeData(var T: Text); override;
 {$endif DEBUG_NODE_XML}
+         procedure pass_semantic; override;
       end;
 
       tbinopnode = class(tbinarynode)
@@ -856,6 +887,19 @@
       end;
 
 
+    class procedure tnode.do_semantic_pass(const n: TNode);
+      begin
+        if Assigned(n) and (n.compileflags*[cf_error, cf_semantics_done, cf_pass1_done]=[]) then
+          n.pass_semantic;
+      end;
+
+
+    procedure tnode.pass_semantic;
+      begin
+        Include(compileflags, cf_semantics_done);
+        do_semantic_pass(successor);
+      end;
+
     function tnode.simplify(forinline : boolean) : tnode;
       begin
         result:=nil;
@@ -1462,6 +1507,13 @@
       end;
 
 
+    procedure tunarynode.pass_semantic;
+      begin
+        Include(compileflags, cf_semantics_done);
+        do_semantic_pass(left);
+        do_semantic_pass(successor);
+      end;
+
 {****************************************************************************
                             TBINARYNODE
  ****************************************************************************}
@@ -1615,6 +1667,15 @@
       end;
 
 
+    procedure tbinarynode.pass_semantic;
+      begin
+        Include(compileflags, cf_semantics_done);
+        do_semantic_pass(left);
+        do_semantic_pass(right);
+        do_semantic_pass(successor);
+      end;
+
+
 {****************************************************************************
                                  TTERTIARYNODE
  ****************************************************************************}
@@ -1725,6 +1786,16 @@
       end;
 
 
+    procedure ttertiarynode.pass_semantic;
+      begin
+        Include(compileflags, cf_semantics_done);
+        do_semantic_pass(left);
+        do_semantic_pass(right);
+        do_semantic_pass(third);
+        do_semantic_pass(right);
+      end;
+
+
 {****************************************************************************
                             TBINOPNODE
  ****************************************************************************}
Index: compiler/pass_1.pas
===================================================================
--- compiler/pass_1.pas	(revision 42445)
+++ compiler/pass_1.pas	(working copy)@@ -26,7 +26,7 @@
 interface
 
     uses
-       node;
+       node, verbose;
 
     procedure typecheckpass(var p : tnode);
     function  do_typecheckpass(var p : tnode) : boolean;
@@ -141,15 +141,26 @@
          oldpos    : tfileposinfo;
          oldverbosity: longint;
          hp : tnode;
+      label
+        Reprocess;
       begin
-         if (nf_pass1_done in p.flags) then
-           exit;
-         if not(nf_error in p.flags) then
+         oldcodegenerror:=codegenerror;
+         oldpos:=current_filepos;
+         oldlocalswitches:=current_settings.localswitches;
+         oldverbosity:=status.verbosity;
+
+Reprocess:
+
+         if not (cf_semantics_done in p.compileflags) then
+//           InternalError(2019071520);
+           p.pass_semantic;
+
+         if (cf_error in p.compileflags) then
            begin
-              oldcodegenerror:=codegenerror;
-              oldpos:=current_filepos;
-              oldlocalswitches:=current_settings.localswitches;
-              oldverbosity:=status.verbosity;
+             codegenerror:=true;
+           end
+         else if not (cf_pass1_done in p.compileflags) then
+           begin
               codegenerror:=false;
               current_filepos:=p.fileinfo;
               current_settings.localswitches:=p.localswitches;
@@ -172,14 +183,19 @@
                    end;
                   if codegenerror then
                    begin
-                     include(p.flags,nf_error);
+                     include(p.compileflags,cf_error);
                      { default to errortype if no type is set yet }
                      if p.resultdef=nil then
                       p.resultdef:=generrordef;
-                   end;
+                   end
+                  else
+                    begin
+                      p.pass_semantic;
+                      codegenerror:=(cf_error in p.compileflags);
+                    end;
                   codegenerror:=codegenerror or oldcodegenerror;
                 end;
-              if not(nf_error in p.flags) then
+              if not(cf_error in p.compileflags) then
                 begin
                   { first pass }
                   hp:=p.pass_1;
@@ -189,8 +205,8 @@
                      p.free;
                      { switch to new node }
                      p := hp;
-                     { run firstpass }
-                     firstpass(p);
+                     { re-run semantic and firstpass on this new node }
+                     goto Reprocess;
                    end
                   else
                     begin
@@ -201,6 +217,7 @@
                         begin
                           p.free;
                           p := hp;
-                          firstpass(p);
+                          { re-run semantic and firstpass on this new node }
+                          goto Reprocess;
                         end;
                     end;
@@ -214,14 +231,13 @@
 {$endif EXTDEBUG}
                    end;
                 end;
-              include(p.flags,nf_pass1_done);
-              codegenerror:=codegenerror or oldcodegenerror;
-              current_settings.localswitches:=oldlocalswitches;
-              current_filepos:=oldpos;
-              status.verbosity:=oldverbosity;
-           end
-         else
-           codegenerror:=true;
+           end;
+
+         include(p.compileflags,cf_pass1_done);
+         codegenerror:=codegenerror or oldcodegenerror;
+         current_settings.localswitches:=oldlocalswitches;
+         current_filepos:=oldpos;
+         status.verbosity:=oldverbosity;
       end;
node_pass_semantic_specific.patch (12,401 bytes)
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 42445)
+++ compiler/ncal.pas	(working copy)
@@ -194,6 +194,7 @@
           }
           procedure verifyabstract(sym:TObject;arg:pointer);
           procedure insertintolist(l : tnodelist);override;
+          procedure pass_semantic;override;
           function  pass_1 : tnode;override;
           function  pass_typecheck:tnode;override;
        {$ifdef state_tracking}
@@ -4277,6 +4278,20 @@
       end;
 
 
+    procedure tcallnode.pass_semantic;
+      begin
+        { as pass_1 and pass_semantic are never called on the methodpointer
+          node, we must check here that it's not a helper type }
+        if assigned(methodpointer) and
+            (methodpointer.nodetype=typen) and
+            is_objectpascal_helper(ttypenode(methodpointer).typedef) and
+            not ttypenode(methodpointer).helperallowed then
+          CGMessage(parser_e_no_category_as_types);
+
+        inherited pass_semantic;
+      end;
+
+
     function tcallnode.pass_1 : tnode;
 
       procedure mark_unregable_parameters;
@@ -4326,19 +4341,6 @@
          aktcallnode:=self;
 
          try
-           { as pass_1 is never called on the methodpointer node, we must check
-             here that it's not a helper type }
-           if assigned(methodpointer) and
-               (methodpointer.nodetype=typen) and
-               is_objectpascal_helper(ttypenode(methodpointer).typedef) and
-               not ttypenode(methodpointer).helperallowed then
-             begin
-               CGMessage(parser_e_no_category_as_types);
-               { we get an internal error when trying to insert the hidden
-                 parameters in this case }
-               exit;
-             end;
-
            { can we get rid of the call? }
            if (cs_opt_remove_emtpy_proc in current_settings.optimizerswitches) and
               not(cnf_return_value_used in callnodeflags) and
Index: compiler/ncnv.pas
===================================================================
--- compiler/ncnv.pas	(revision 42445)
+++ compiler/ncnv.pas	(working copy)
@@ -67,6 +67,7 @@
 {$ifdef DEBUG_NODE_XML}
           procedure XMLPrintNodeInfo(var T: Text); override;
 {$endif DEBUG_NODE_XML}
+          procedure pass_semantic; override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -2390,6 +2391,15 @@
       end;
 
 
+    procedure ttypeconvnode.pass_semantic;
+      begin
+        if warn_pointer_to_signed then
+          cgmessage(type_w_pointer_to_signed);
+
+        inherited pass_semantic;
+      end;
+
+
     function ttypeconvnode.pass_typecheck:tnode;
 
       var
@@ -3950,8 +3960,6 @@
 
     function ttypeconvnode.pass_1 : tnode;
       begin
-        if warn_pointer_to_signed then
-          cgmessage(type_w_pointer_to_signed);
         result:=nil;
         firstpass(left);
         if codegenerror then
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42445)
+++ compiler/nflw.pas	(working copy)
@@ -73,6 +73,7 @@
           procedure XMLPrintNodeTree(var T: Text); override;
 {$endif DEBUG_NODE_XML}
           function docompare(p: tnode): boolean; override;
+          procedure pass_semantic; override;
        end;
 
        twhilerepeatnode = class(tloopnode)
@@ -138,9 +139,13 @@
        end;
        tcontinuenodeclass = class of tcontinuenode;
 
+       tjumptype = (jt_Unknown, jt_Regular, jt_Long);
+
        tgotonode = class(tnode)
        private
           labelnodeidx : longint;
+          { Information passed from the semantic pass to pass 1 }
+          jumptype : tjumptype;
        public
           labelsym : tlabelsym;
           labelnode : tlabelnode;
@@ -152,6 +157,7 @@
           procedure derefimpl;override;
           procedure resolveppuidx;override;
           function dogetcopy : tnode;override;
+          procedure pass_semantic;override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -170,6 +176,7 @@
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
+          procedure pass_semantic;override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -187,7 +194,6 @@
           constructor create(l,r,_t1 : tnode);virtual;reintroduce;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
-          function simplify(forinline: boolean): tnode; override;
          protected
           procedure adjust_estimated_stack_size; virtual;
        end;
@@ -1179,6 +1185,17 @@
           t2.isequal(tloopnode(p).t2);
       end;
 
+
+    procedure tloopnode.pass_semantic;
+      begin
+        Include(compileflags, cf_semantics_done);
+        do_semantic_pass(left);
+        do_semantic_pass(right);
+        do_semantic_pass(t1);
+        do_semantic_pass(t2);
+        do_semantic_pass(successor);
+      end;
+
 {****************************************************************************
                                TWHILEREPEATNODE
 *****************************************************************************}
@@ -1996,6 +2013,7 @@
         exceptionblock:=current_exceptblock;
         labelnode:=nil;
         labelsym:=p;
+        jumptype:=jt_Unknown;
       end;
 
 
@@ -2036,20 +2054,10 @@
       end;
 
 
-    function tgotonode.pass_typecheck:tnode;
-      begin
-        result:=nil;
-        resultdef:=voidtype;
-      end;
-
-
-    function tgotonode.pass_1 : tnode;
+    procedure tgotonode.pass_semantic;
       var
         p2 : tprocinfo;
       begin
-        result:=nil;
-        expectloc:=LOC_VOID;
-
         { The labelnode can already be set when
           this node was copied }
         if not(assigned(labelnode)) then
@@ -2086,31 +2094,74 @@
                         p2:=p2.parent
                       end;
 
-                    if assigned(labelsym.jumpbuf) then
+                    if not assigned(labelsym.jumpbuf) then
                       begin
-                        labelsym.nonlocal:=true;
-                        result:=ccallnode.createintern('fpc_longjmp',
-                          ccallparanode.create(cordconstnode.create(1,sinttype,true),
-                          ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
-                        nil)));
+                        CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
+                        Include(compileflags, cf_error);
                       end
                     else
-                      CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
+                      jumptype:=jt_Long;
                   end
                 else
-                  CGMessage(cg_e_interprocedural_goto_only_to_outer_scope_allowed);
+                  begin
+                    CGMessage(cg_e_interprocedural_goto_only_to_outer_scope_allowed);
+                    Include(compileflags, cf_error);
+                  end;
               end
             else
-              CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
+              begin
+                CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
+                Include(compileflags, cf_error);
+              end;
           end;
 
-        { check if we don't mess with exception blocks }
-        if assigned(labelnode) and
-           (exceptionblock<>labelnode.exceptionblock) then
-          CGMessage(cg_e_goto_inout_of_exception_block);
+        if assigned(labelnode) then
+          begin
+            { check if we don't mess with exception blocks }
+            if (exceptionblock<>labelnode.exceptionblock) then
+              begin
+                CGMessage(cg_e_goto_inout_of_exception_block);
+                Include(compileflags, cf_error);
+              end
+            else
+              jumptype:=jt_Regular;
+          end;
+
+        inherited pass_semantic;
       end;
 
 
+    function tgotonode.pass_typecheck:tnode;
+      begin
+        result:=nil;
+        resultdef:=voidtype;
+      end;
+
+
+    function tgotonode.pass_1 : tnode;
+      var
+        p2 : tprocinfo;
+      begin
+        result:=nil;
+        expectloc:=LOC_VOID;
+
+        case jumptype of
+          jt_Unknown:
+            InternalError(2019071510);
+          jt_Regular:
+            { Do nothing };
+          jt_Long:
+            begin
+              labelsym.nonlocal:=true;
+              result:=ccallnode.createintern('fpc_longjmp',
+                ccallparanode.create(cordconstnode.create(1,sinttype,true),
+                ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
+              nil)));
+            end;
+        end;
+      end;
+
+
    function tgotonode.dogetcopy : tnode;
      var
        p : tgotonode;
@@ -2117,6 +2168,7 @@
      begin
         p:=tgotonode(inherited dogetcopy);
         p.exceptionblock:=exceptionblock;
+        p.jumptype:=jumptype;
 
         { generate labelnode if not done yet }
         if not(assigned(labelnode)) then
@@ -2216,6 +2268,18 @@
       end;
 
 
+    procedure tlabelnode.pass_semantic;
+      begin
+        if (m_non_local_goto in current_settings.modeswitches) and
+            { the owner can be Nil for internal labels }
+            assigned(labsym.owner) and
+          (current_procinfo.procdef.parast.symtablelevel<>labsym.owner.symtablelevel) then
+          CGMessage(cg_e_labels_cannot_defined_outside_declaration_scope);
+
+        inherited pass_semantic;
+      end;
+
+
     function tlabelnode.pass_1 : tnode;
       begin
         result:=nil;
@@ -2225,11 +2289,6 @@
 
         if assigned(left) then
           firstpass(left);
-        if (m_non_local_goto in current_settings.modeswitches) and
-            { the owner can be Nil for internal labels }
-            assigned(labsym.owner) and
-          (current_procinfo.procdef.parast.symtablelevel<>labsym.owner.symtablelevel) then
-          CGMessage(cg_e_labels_cannot_defined_outside_declaration_scope)
       end;
 
 
@@ -2377,29 +2436,33 @@
         result:=nil;
         expectloc:=LOC_VOID;
         firstpass(left);
-        { on statements }
-        if assigned(right) then
-          firstpass(right);
-        { else block }
-        if assigned(t1) then
-          firstpass(t1);
+        if has_no_code(left) then
+          begin
+            { empty try -> can never raise exception -> do nothing and delete
+              entire except block }
+            result:=cnothingnode.create;
+            right.Free;
+            right:=nil;
+            t1.Free;
+            t1:=nil;
+          end
+        else
+          begin
+            { on statements }
+            if assigned(right) then
+              firstpass(right);
+            { else block }
+            if assigned(t1) then
+              firstpass(t1);
 
-        include(current_procinfo.flags,pi_do_call);
-        include(current_procinfo.flags,pi_uses_exceptions);
+            include(current_procinfo.flags,pi_do_call);
+            include(current_procinfo.flags,pi_uses_exceptions);
 
-        adjust_estimated_stack_size;
+            adjust_estimated_stack_size;
+          end;
       end;
 
 
-    function ttryexceptnode.simplify(forinline: boolean): tnode;
-      begin
-        result:=nil;
-        { empty try -> can never raise exception -> do nothing }
-        if has_no_code(left) then
-          result:=cnothingnode.create;
-      end;
-
-
     procedure ttryexceptnode.adjust_estimated_stack_size;
       begin
         inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size*2);

Issue History

Date Modified Username Field Change
2019-07-18 05:54 J. Gareth Moreton New Issue
2019-07-18 05:54 J. Gareth Moreton File Added: node_flags.patch
2019-07-18 05:54 J. Gareth Moreton File Added: node_pass_semantic_base.patch
2019-07-18 05:54 J. Gareth Moreton File Added: node_pass_semantic_specific.patch
2019-07-18 05:55 J. Gareth Moreton Relationship added child of 0032913
2019-07-18 05:55 J. Gareth Moreton File Added: Node Semantic Pass.pdf
2019-07-18 07:41 J. Gareth Moreton Tag Attached: patch
2019-07-18 07:41 J. Gareth Moreton Tag Attached: refactor
2019-07-18 07:41 J. Gareth Moreton Tag Attached: compiler
2019-07-18 12:01 Sven Barth Note Added: 0117302
2019-07-18 14:06 J. Gareth Moreton Note Added: 0117304
2019-07-18 14:06 J. Gareth Moreton Note View State: 0117304: private
2019-07-18 14:06 J. Gareth Moreton Note Edited: 0117304 View Revisions
2019-07-18 14:06 J. Gareth Moreton Note View State: 0117304: public
2019-07-18 21:26 J. Gareth Moreton File Deleted: node_flags.patch
2019-07-18 21:26 J. Gareth Moreton File Deleted: node_pass_semantic_specific.patch
2019-07-18 21:28 J. Gareth Moreton File Deleted: node_pass_semantic_base.patch
2019-07-18 21:28 J. Gareth Moreton File Added: node_pass_semantic_base.patch
2019-07-18 21:28 J. Gareth Moreton File Added: node_pass_semantic_specific.patch
2019-07-18 21:28 J. Gareth Moreton File Added: node_flags.patch
2019-07-18 21:28 J. Gareth Moreton Note Added: 0117310
2019-07-18 22:55 J. Gareth Moreton File Deleted: node_pass_semantic_base.patch
2019-07-18 22:55 J. Gareth Moreton File Deleted: node_pass_semantic_specific.patch
2019-07-18 22:55 J. Gareth Moreton File Added: node_pass_semantic_base.patch
2019-07-18 22:55 J. Gareth Moreton File Added: node_pass_semantic_specific.patch
2019-07-18 22:55 J. Gareth Moreton Note Added: 0117313