* Make tglobalstat a class

compiler/fmodule.pas

@@ -225,7 +225,7 @@ interface
         waitingunits: tfpobjectlist;
 
         finishstate: pointer;
-        globalstate: pointer;
+        globalstate: tobject;
 
         namespace: pshortstring; { for JVM target: corresponds to Java package name }
 

compiler/globstat.pas

@@ -37,8 +37,8 @@ uses
 
 
 type
-  pglobalstate=^tglobalstate;
-  tglobalstate=record
+
+  tglobalstate = class
   { scanner }
     oldidtoken,
     oldtoken       : ttoken;
@@ -67,95 +67,184 @@ type
     old_debuginfo : tdebuginfo;
     old_scanner : tscannerfile;
     old_parser_file : string;
+    constructor create(savefull : boolean);
+    destructor destroy; override;
+    procedure clearscanner;
+    class procedure remove_scanner_from_states(scanner : tscannerfile); static;
+    procedure save(full : boolean);
+    procedure restore(full : boolean);
   end;
 
-procedure save_global_state(out state:tglobalstate;full:boolean);
-procedure restore_global_state(const state:tglobalstate;full:boolean);
+procedure save_global_state(state:tglobalstate;full:boolean);
+procedure restore_global_state(state:tglobalstate;full:boolean);
 
 implementation
 
 uses
   pbase,comphook;
 
-  procedure save_global_state(out state:tglobalstate;full:boolean);
+var
+  states : array of tglobalstate;
+  statecount : integer = 0;
+
+
+
+  class procedure tglobalstate.remove_scanner_from_states(scanner : tscannerfile);
+
+  var
+    i : integer;
+
+  begin
+    for I:=0 to statecount-1 do
+      if (states[i].old_scanner=scanner) then
+        states[i].clearscanner;
+  end;
+
+  procedure addstate(astate : tglobalstate);
+
+  var
+    l : integer;
+
+  begin
+    l:=length(states);
+    if l=statecount then
+      setlength(states,l+10);
+    states[statecount]:=astate;
+    inc(statecount);
+  end;
+
+  procedure removestate(astate : tglobalstate);
+
+  var
+    l : integer;
+
+  begin
+    l:=statecount-1;
+    While (l>=0) and (states[l]<>astate) do
+      dec(l);
+    if l<0 then
+      exit;
+    if l<>statecount-1 then
+      states[l]:=states[statecount-1];
+    states[statecount-1]:=Nil;
+    Dec(Statecount);
+  end;
+
+  procedure save_global_state(state:tglobalstate;full:boolean);
     begin
-      with state do
+      state.save(full);
+    end;
+
+  procedure restore_global_state(state:tglobalstate;full:boolean);
+
+  begin
+    state.restore(full);
+  end;
+
+  procedure tglobalstate.save(full: boolean);
+
+    begin
+      old_current_module:=current_module;
+
+      { save symtable state }
+      oldsymtablestack:=symtablestack;
+      oldmacrosymtablestack:=macrosymtablestack;
+      oldcurrent_procinfo:=current_procinfo;
+
+      { save scanner state }
+      oldc:=c;
+      oldpattern:=pattern;
+      oldorgpattern:=orgpattern;
+      oldtoken:=token;
+      oldidtoken:=idtoken;
+      old_block_type:=block_type;
+      oldtokenpos:=current_tokenpos;
+      old_switchesstatestack:=switchesstatestack;
+      old_switchesstatestackpos:=switchesstatestackpos;
+
+      { save cg }
+      oldparse_only:=parse_only;
+
+      { save akt... state }
+      { handle the postponed case first }
+      //flushpendingswitchesstate;
+      oldcurrent_filepos:=current_filepos;
+      old_settings:=current_settings;
+      old_verbosity:=status.verbosity;
+
+      if full then
         begin
-          old_current_module:=current_module;
-
-          { save symtable state }
-          oldsymtablestack:=symtablestack;
-          oldmacrosymtablestack:=macrosymtablestack;
-          oldcurrent_procinfo:=current_procinfo;
-
-          { save scanner state }
-          oldc:=c;
-          oldpattern:=pattern;
-          oldorgpattern:=orgpattern;
-          oldtoken:=token;
-          oldidtoken:=idtoken;
-          old_block_type:=block_type;
-          oldtokenpos:=current_tokenpos;
-          old_switchesstatestack:=switchesstatestack;
-          old_switchesstatestackpos:=switchesstatestackpos;
-
-          { save cg }
-          oldparse_only:=parse_only;
-
-          { save akt... state }
-          { handle the postponed case first }
-          //flushpendingswitchesstate;
-          oldcurrent_filepos:=current_filepos;
-          old_settings:=current_settings;
-          old_verbosity:=status.verbosity;
-
-          if full then
-            begin
-              old_asmdata:=current_asmdata;
-              old_debuginfo:=current_debuginfo;
-              old_parser_file:=parser_current_file;
-              old_scanner:=current_scanner;
-            end;
+          old_asmdata:=current_asmdata;
+          old_debuginfo:=current_debuginfo;
+          old_parser_file:=parser_current_file;
+          old_scanner:=current_scanner;
         end;
     end;
 
+  procedure tglobalstate.restore(full: boolean);
 
-  procedure restore_global_state(const state:tglobalstate;full:boolean);
     begin
-      with state do
+      { restore scanner }
+      c:=oldc;
+      pattern:=oldpattern;
+      orgpattern:=oldorgpattern;
+      token:=oldtoken;
+      idtoken:=oldidtoken;
+      current_tokenpos:=oldtokenpos;
+      block_type:=old_block_type;
+      switchesstatestack:=old_switchesstatestack;
+      switchesstatestackpos:=old_switchesstatestackpos;
+
+      { restore cg }
+      parse_only:=oldparse_only;
+
+      { restore symtable state }
+      symtablestack:=oldsymtablestack;
+      macrosymtablestack:=oldmacrosymtablestack;
+      current_procinfo:=oldcurrent_procinfo;
+      current_filepos:=oldcurrent_filepos;
+      current_settings:=old_settings;
+      status.verbosity:=old_verbosity;
+
+      if full then
         begin
-          { restore scanner }
-          c:=oldc;
-          pattern:=oldpattern;
-          orgpattern:=oldorgpattern;
-          token:=oldtoken;
-          idtoken:=oldidtoken;
-          current_tokenpos:=oldtokenpos;
-          block_type:=old_block_type;
-          switchesstatestack:=old_switchesstatestack;
-          switchesstatestackpos:=old_switchesstatestackpos;
-
-          { restore cg }
-          parse_only:=oldparse_only;
-
-          { restore symtable state }
-          symtablestack:=oldsymtablestack;
-          macrosymtablestack:=oldmacrosymtablestack;
-          current_procinfo:=oldcurrent_procinfo;
-          current_filepos:=oldcurrent_filepos;
-          current_settings:=old_settings;
-          status.verbosity:=old_verbosity;
-
-          if full then
-            begin
-              current_module:=old_current_module; {!}
-              current_asmdata:=old_asmdata;
-              current_debuginfo:=old_debuginfo;
-              set_current_scanner(old_scanner);
-              parser_current_file:=old_parser_file;
-            end;
+          set_current_module(old_current_module);
+          // These can be different
+          current_asmdata:=old_asmdata;
+          current_debuginfo:=old_debuginfo;
         end;
     end;
 
+    constructor tglobalstate.create(savefull: boolean);
+
+    begin
+      addstate(self);
+      save(savefull);
+    end;
+
+  destructor tglobalstate.destroy;
+
+    begin
+      removestate(self);
+      inherited destroy;
+    end;
+
+  procedure tglobalstate.clearscanner;
+
+  begin
+    old_scanner:=nil;
+    oldidtoken:=NOTOKEN;
+    oldtoken:=NOTOKEN;
+    oldtokenpos:=Default(tfileposinfo);
+    oldc:=#0;
+    oldpattern:='';
+    oldorgpattern:='';
+    old_block_type:=bt_none;
+  end;
+
+initialization
+  onfreescanner:[email protected]_scanner_from_states;
+finalization
+  onfreescanner:=Nil;
 end.
 

compiler/parser.pas

@@ -336,7 +336,7 @@ implementation
     procedure compile_module(module : tmodule);
 
       var
-         olddata : pglobalstate;
+         olddata : tglobalstate;
          hp,hp2 : tmodule;
          finished : boolean;
          sc : tscannerfile;
@@ -352,10 +352,9 @@ implementation
          { Uses heap memory instead of placing everything on the
            stack. This is needed because compile() can be called
            recursively }
-         new(olddata);
          { handle the postponed case first }
          flushpendingswitchesstate;
-         save_global_state(olddata^,false);
+         olddata:=tglobalstate.create(false);
 
        { reset parser, a previous fatal error could have left these variables in an unreliable state, this is
          important for the IDE }
@@ -478,7 +477,7 @@ implementation
               { Write Browser Collections }
               do_extractsymbolinfo;
 
-            restore_global_state(olddata^,false);
+            olddata.restore(false);
 
             { Restore all locally modified warning messages }
             RestoreLocalVerbosity(current_settings.pmessage);
@@ -523,12 +522,12 @@ implementation
              file which will result in pointing to the wrong position in the
              file. In the normal case current_scanner and current_module.scanner
              would be Nil, thus nothing bad would happen }
-           if olddata^.old_current_module<>current_module then
-             set_current_module(olddata^.old_current_module);
+           if olddata.old_current_module<>current_module then
+             set_current_module(olddata.old_current_module);
 
            FreeLocalVerbosity(current_settings.pmessage);
 
-           dispose(olddata);
+           FreeAndNil(olddata);
          end;
     end;
 

compiler/pmodules.pas

@@ -295,7 +295,7 @@ implementation
 
     procedure loadsystemunit(curr : tmodule);
       var
-        state: pglobalstate;
+        state: tglobalstate;
 
       begin
         { we are going to rebuild the symtablestack, clear it first }
@@ -326,11 +326,10 @@ implementation
 
         { load_intern_types resets the scanner... }
         current_scanner.tempcloseinputfile;
-        new(state);
-        save_global_state(state^,true);
+        state:=tglobalstate.create(true);
         load_intern_types;
-        restore_global_state(state^,true);
-        dispose(state);
+        state.restore(true);
+        FreeAndNil(state);
         current_scanner.tempopeninputfile;
 
         { Set the owner of errorsym and errortype to symtable to
@@ -572,33 +571,31 @@ implementation
         until false;
       end;
 
-
     procedure loadunits(curr: tmodule; preservest:tsymtable);
 
       var
          s,sorg  : ansistring;
          pu,pu2  : tused_unit;
          hp2     : tmodule;
-         state: pglobalstate;
+         state: tglobalstate;
 
          procedure restorestate;
 
          begin
-           restore_global_state(state^,true);
+           state.restore(true);
            if assigned(current_scanner) and (current_module.scanner=current_scanner) then
               begin
               if assigned(current_scanner.inputfile) then
                 current_scanner.tempopeninputfile;
               end;
 
-           dispose(state);
+           state.free;
          end;
 
       begin
         parseusesclause(curr);
         current_scanner.tempcloseinputfile;
-        new(state);
-        save_global_state(state^,true);
+        state:=tglobalstate.create(true);
          { Load the units }
          pu:=tused_unit(curr.used_units.first);
          while assigned(pu) do
@@ -949,7 +946,7 @@ type
         finalize_procinfo : tcgprocinfo;
         i,j : integer;
         finishstate:pfinishstate;
-        globalstate:pglobalstate;
+        globalstate:tglobalstate;
 
       begin
         result:=true;
@@ -1014,9 +1011,7 @@ type
           begin
             { save the current state, so the parsing can continue where we left
               of here }
-            New(globalstate);
-            save_global_state(globalstate^,true);
-            curr.globalstate:=globalstate;
+            globalstate:=tglobalstate.create(true);
           end;
       end;
 
@@ -1086,7 +1081,6 @@ type
 
         { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
         maybe_load_got;
-
         if not curr.interface_only then
           begin
             consume(_IMPLEMENTATION);
@@ -1259,10 +1253,12 @@ type
 
          { consume the semicolon after maps have been updated else conditional compiling expressions
            might cause internal errors, see tw8611 }
+
          if consume_semicolon_after_uses then
            consume(_SEMICOLON);
 
          result:=parse_unit_interface_declarations(curr);
+
       end;
 
     procedure finish_unit(module:tmodule;immediate:boolean);
@@ -1285,8 +1281,8 @@ type
 
       procedure module_is_done(curr: tmodule);inline;
         begin
-          dispose(pglobalstate(curr.globalstate));
-          curr.globalstate:=nil;
+
+          FreeAndNil(curr.globalstate);
           dispose(pfinishstate(curr.finishstate));
           curr.finishstate:=nil;
         end;
@@ -1316,7 +1312,7 @@ type
              save_global_state(globalstate,true);
              if not assigned(module.globalstate) then
                internalerror(2012091802);
-             restore_global_state(pglobalstate(module.globalstate)^,true);
+             tglobalstate(module.globalstate).restore(true);
            end;
 
          { curr is now module }
@@ -1604,6 +1600,8 @@ type
         Message1(unit_u_finished_compiling,module.modulename^);
 
         module_is_done(module);
+        module.end_of_parsing;
+
         if not immediate then
           restore_global_state(globalstate,true);