Browse Source

* Added field to identify blocknodes that wrap entire subroutines

J. Gareth "Curious Kit" Moreton 1 year ago
parent
commit
5605566e42
1 changed files with 51 additions and 0 deletions
  1. 51 0
      compiler/nbas.pas

+ 51 - 0
compiler/nbas.pas

@@ -112,15 +112,27 @@ interface
        end;
        end;
        tstatementnodeclass = class of tstatementnode;
        tstatementnodeclass = class of tstatementnode;
 
 
+       TBlockNodeFlag = (
+         bnf_strippable { Block node can be removed via simplify etc. }
+       );
+
+       TBlockNodeFlags = set of TBlockNodeFlag;
+
        tblocknode = class(tunarynode)
        tblocknode = class(tunarynode)
+          blocknodeflags : TBlockNodeFlags;
           constructor create(l : tnode);virtual;
           constructor create(l : tnode);virtual;
           destructor destroy; override;
           destructor destroy; override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
           function simplify(forinline : boolean) : tnode; override;
           function simplify(forinline : boolean) : tnode; override;
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck:tnode;override;
 {$ifdef state_tracking}
 {$ifdef state_tracking}
           function track_state_pass(exec_known:boolean):boolean;override;
           function track_state_pass(exec_known:boolean):boolean;override;
 {$endif state_tracking}
 {$endif state_tracking}
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_XML}
           property statements : tnode read left write left;
           property statements : tnode read left write left;
        end;
        end;
        tblocknodeclass = class of tblocknode;
        tblocknodeclass = class of tblocknode;
@@ -686,6 +698,7 @@ implementation
 
 
       begin
       begin
          inherited create(blockn,l);
          inherited create(blockn,l);
+         blocknodeflags:=[];
       end;
       end;
 
 
     destructor tblocknode.destroy;
     destructor tblocknode.destroy;
@@ -706,6 +719,20 @@ implementation
       end;
       end;
 
 
 
 
+    constructor tblocknode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.getset(tppuset1(blocknodeflags));
+      end;
+
+
+    procedure tblocknode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(blocknodeflags));
+      end;
+
+
     function NodesEqual(var n: tnode; arg: pointer): foreachnoderesult;
     function NodesEqual(var n: tnode; arg: pointer): foreachnoderesult;
       begin
       begin
         if n.IsEqual(tnode(arg)) then
         if n.IsEqual(tnode(arg)) then
@@ -863,6 +890,30 @@ implementation
             end;
             end;
       end;
       end;
 {$endif state_tracking}
 {$endif state_tracking}
+{$ifdef DEBUG_NODE_XML}
+    procedure TBlockNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i_bnf: TBlockNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+
+        First := True;
+        for i_bnf in blocknodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' blocknodeflags="', i_bnf);
+                First := False;
+              end
+            else
+              Write(T, ',', i_bnf)
+          end;
+
+        if not First then
+          write(T,'"');
+      end;
+{$endif DEBUG_NODE_XML}
 
 
 {*****************************************************************************
 {*****************************************************************************
                              TASMNODE
                              TASMNODE