Browse Source

* remove do_compile, clearer flow when loading ppu/pas files

Michaël Van Canneyt 1 year ago
parent
commit
a888a141a2
2 changed files with 98 additions and 73 deletions
  1. 21 11
      compiler/fmodule.pas
  2. 77 62
      compiler/fppu.pas

+ 21 - 11
compiler/fmodule.pas

@@ -113,7 +113,6 @@ interface
       public
         is_reset,                 { has reset been called ? }
         do_reload,                { force reloading of the unit }
-        do_compile,               { need to compile the sources }
         sources_avail,            { if all sources are reachable }
         interface_compiled,       { if the interface section has been parsed/compiled/loaded }
         is_dbginfo_written,
@@ -647,7 +646,6 @@ implementation
         globalmacrosymtable:=nil;
         localmacrosymtable:=nil;
         do_reload:=false;
-        do_compile:=false;
         sources_avail:=true;
         mainfilepos.line:=0;
         mainfilepos.column:=0;
@@ -794,6 +792,7 @@ implementation
       var
         i   : longint;
         current_debuginfo_reset : boolean;
+        m : tmodule;
       begin
         is_reset:=true;
         if assigned(scanner) then
@@ -906,7 +905,17 @@ implementation
         pendingspecializations:=tfphashobjectlist.create(false);
         if assigned(waitingforunit) and
           (waitingforunit.count<>0) then
-          internalerror(2016070501);
+           begin
+           Write(Self.modulename^, ' is reset while still waiting for units: ');
+           for I:=0 to waitingforunit.Count-1 do
+             begin
+             M:=tmodule(waitingforunit.Items[i]);
+             write(m.modulename^,' (state:',M.state,') ');
+
+             end;
+           Writeln;
+           internalerror(2016070501);
+           end;
         waitingforunit.free;
         waitingforunit:=tfpobjectlist.create(false);
         linkunitofiles.Free;
@@ -926,7 +935,6 @@ implementation
         stringdispose(mainname);
         FImportLibraryList.Free;
         FImportLibraryList:=TFPHashObjectList.Create;
-        do_compile:=false;
         do_reload:=false;
         interface_compiled:=false;
         in_interface:=true;
@@ -1002,6 +1010,8 @@ implementation
     procedure tmodule.flagdependent(callermodule:tmodule);
       var
         pm : tdependent_unit;
+        m : tmodule;
+
       begin
         { flag all units that depend on this unit for reloading }
         pm:=tdependent_unit(current_module.dependent_units.first);
@@ -1010,16 +1020,16 @@ implementation
            { We do not have to reload the unit that wants to load
              this unit, unless this unit is already compiled during
              the loading }
-           if (pm.u=callermodule) and
-              (pm.u.state<ms_compiled) then
-             Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
+           m:=pm.u;
+           if (m=callermodule) and (m.state<ms_compiled) then
+             Message1(unit_u_no_reload_is_caller,m.modulename^)
            else
-            if (pm.u.state=ms_compile) and (pm.u.compilecount>1) then
-              Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
+            if (m.state=ms_compile) {and (pm.u.compilecount>1)} then
+              Message1(unit_u_no_reload_in_second_compile,m.modulename^)
            else
             begin
-              pm.u.do_reload:=true;
-              Message1(unit_u_flag_for_reload,pm.u.modulename^);
+              m.do_reload:=true;
+              Message1(unit_u_flag_for_reload,m.modulename^);
             end;
            pm:=tdependent_unit(pm.next);
          end;

+ 77 - 62
compiler/fppu.pas

@@ -44,6 +44,8 @@ interface
 
     type
        { tppumodule }
+       TAvailableUnitFile = (auPPU,auSrc);
+       TAvailableUnitFiles = set of TAvailableUnitFile;
 
        tppumodule = class(tmodule)
           ppufile    : tcompilerppufile; { the PPU file }
@@ -90,8 +92,8 @@ interface
           function  openppu(ppufiletime:longint):boolean;
           procedure prepare_second_load(from_module: tmodule);
           procedure recompile_from_sources(from_module: tmodule);
-          function  search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean;
-          function  search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean;
+          function  search_unit_files(loaded_from : tmodule; onlysource:boolean):TAvailableUnitFiles;
+          function  search_unit(loaded_from : tmodule; onlysource,shortname:boolean):TAvailableUnitFiles;
           function  loadfrompackage:boolean;
           procedure load_interface;
           procedure load_implementation;
@@ -438,28 +440,24 @@ var
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
         Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
         Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
-        do_compile:=false;
         openppu:=true;
       end;
 
 
-    function tppumodule.search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean;
+    function tppumodule.search_unit_files(loaded_from : tmodule; onlysource:boolean):TAvailableUnitFiles;
       var
-        found : boolean;
+        found : TAvailableUnitFiles;
       begin
-        found:=false;
-        if search_unit(loaded_from,onlysource,false) then
-          found:=true;
-        if (not found) and
+        found:=search_unit(loaded_from,onlysource,false);
+        if (found=[]) and
            (ft83 in AllowedFilenameTransFormations) and
-           (length(modulename^)>8) and
-           search_unit(loaded_from,onlysource,true) then
-          found:=true;
+           (length(modulename^)>8) then
+           found:=search_unit(loaded_from,onlysource,true);
         search_unit_files:=found;
       end;
 
 
-    function tppumodule.search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean;
+    function tppumodule.search_unit(loaded_from : tmodule; onlysource,shortname:boolean):TAvailableUnitFiles;
       var
          singlepathstring,
          filename : TCmdStr;
@@ -512,7 +510,6 @@ var
            singlepathstring:=FixPath(s,false);
          { Check for Sources }
            ppufile:=nil;
-           do_compile:=true;
            recompile_reason:=rr_noppu;
          {Check for .pp file}
            Found:=UnitExists(sourceext,hs,prefix);
@@ -549,30 +546,32 @@ var
            SourceSearchPath:=Found;
          end;
 
-         Function SearchPath(const s,prefix:TCmdStr):boolean;
+         Function SearchPath(const s,prefix:TCmdStr):TAvailableUnitFiles;
          var
-           found : boolean;
+           found : TAvailableUnitFiles;
          begin
            { First check for a ppu, then for the source }
-           found:=false;
+           found:=[];
            if not onlysource then
-            found:=PPUSearchPath(s,prefix);
-           if not found then
-            found:=SourceSearchPath(s,prefix);
+             if PPUSearchPath(s,prefix) then
+               Include(found,auPPU);
+           if found=[] then
+             if SourceSearchPath(s,prefix) then
+              Include(found,auSrc);
            SearchPath:=found;
          end;
 
-         Function SearchPathList(list:TSearchPathList;const prefix:TCmdStr):boolean;
+         Function SearchPathList(list:TSearchPathList;const prefix:TCmdStr):TAvailableUnitFiles;
          var
            hp : TCmdStrListItem;
-           found : boolean;
+           found : TAvailableUnitFiles;
          begin
-           found:=false;
+           found:=[];
            hp:=TCmdStrListItem(list.First);
            while assigned(hp) do
             begin
               found:=SearchPath(hp.Str,prefix);
-              if found then
+              if found<>[] then
                break;
               hp:=TCmdStrListItem(hp.next);
             end;
@@ -588,34 +587,38 @@ var
             result:=PPUSearchPath(main_module.Path,prefix);
          end;
 
-         function SearchSourcePaths(const prefix:TCmdStr):boolean;
+         function SearchSourcePaths(const prefix:TCmdStr):TAvailableUnitFiles;
          begin
-           result:=SourceSearchPath('.',prefix);
-           if (not result) and Assigned(main_module) and (main_module.Path<>'') then
-             result:=SourceSearchPath(main_module.Path,prefix);
-           if (not result) and Assigned(loaded_from) then
+           result:=[];
+           if SourceSearchPath('.',prefix) then
+              include(Result,auSrc);
+           if (result=[]) and Assigned(main_module) and (main_module.Path<>'') then
+             if SourceSearchPath(main_module.Path,prefix) then
+              include(Result,auSrc);
+           if (result=[]) and Assigned(loaded_from) then
              result:=SearchPathList(loaded_from.LocalUnitSearchPath,prefix);
-           if not result then
+           if (result=[]) then
              result:=SearchPathList(UnitSearchPath,prefix);
          end;
 
-         function SearchNamespaceList(const prefixes:TCmdStrList):boolean;
+         function SearchNamespaceList(const prefixes:TCmdStrList): TAvailableUnitFiles;
          var
            nsitem : TCmdStrListItem;
-           res : Boolean;
+           res : TAvailableUnitFiles;
          begin
-           res:=false;
+           res:=[];
            nsitem:=TCmdStrListItem(prefixes.first);
            while assigned(nsitem) do
              begin
                if not onlysource then
                  begin
-                   res:=SearchPPUPaths(nsitem.str);
-                   if res then
+                   if SearchPPUPaths(nsitem.str) then
+                     Include(res,auPPU);
+                   if res<>[] then
                      break;
                  end;
                res:=SearchSourcePaths(nsitem.str);
-               if res then
+               if res<>[] then
                  break;
                nsitem:=TCmdStrListItem(nsitem.next);
              end;
@@ -626,9 +629,10 @@ var
 
 
        var
-         fnd : boolean;
+         fnd : TAvailableUnitFiles;
          hs : TPathStr;
        begin
+         fnd:=[];
          if shortname then
           filename:=FixFileName(Copy(realmodulename^,1,8))
          else
@@ -644,46 +648,49 @@ var
             8. global unit pathlist
             9. for each default namespace:
                   repeat 1 - 3 and 5 - 8 with namespace as prefix }
-         fnd:=false;
          if not onlysource then
-            fnd:=SearchPPUPaths('');
-         if (not fnd) and (sourcefn<>'') then
+           if SearchPPUPaths('') then
+             include(fnd,auPPU);
+         if (fnd=[]) and (sourcefn<>'') then
           begin
             { the full filename is specified so we can't use here the
               searchpath (PFV) }
             if CheckVerbosity(V_Tried) then
               Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,sourceext));
-            fnd:=FindFile(ChangeFileExt(sourcefn,sourceext),'',true,hs);
-            if not fnd then
+            if FindFile(ChangeFileExt(sourcefn,sourceext),'',true,hs) then
+              include(fnd,auSrc);
+            if (fnd=[]) then
              begin
                if CheckVerbosity(V_Tried) then
                  Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pasext));
-               fnd:=FindFile(ChangeFileExt(sourcefn,pasext),'',true,hs);
+               if FindFile(ChangeFileExt(sourcefn,pasext),'',true,hs) then
+                 include(fnd,auSrc);
              end;
-            if not fnd and
+            if (fnd=[]) and
                ((m_mac in current_settings.modeswitches) or
                 (tf_p_ext_support in target_info.flags)) then
              begin
                if CheckVerbosity(V_Tried) then
                  Message1(unit_t_unitsearch,ChangeFileExt(sourcefn,pext));
-               fnd:=FindFile(ChangeFileExt(sourcefn,pext),'',true,hs);
+               if FindFile(ChangeFileExt(sourcefn,pext),'',true,hs) then
+                include(fnd,auSrc)
              end;
-            if fnd then
+            if [auSrc]=fnd then
              begin
                sources_avail:=true;
-               do_compile:=true;
+               state:=ms_compile;
                recompile_reason:=rr_noppu;
                mainsource:=hs;
                SetFileName(hs,false);
              end;
           end;
-         if not fnd then
+         if fnd=[] then
            begin
              fnd:=SearchSourcePaths('');
              // current_namespacelist is set to the current module's namespacelist.
-             if not fnd and assigned(current_namespacelist) and (current_namespacelist.count>0) then
+             if (fnd=[]) and assigned(current_namespacelist) and (current_namespacelist.count>0) then
                fnd:=SearchNameSpaceList(current_namespacelist);
-             if not fnd and (namespacelist.count>0) then
+             if (fnd=[]) and (namespacelist.count>0) then
                fnd:=SearchNameSpaceList(namespacelist);
            end;
          search_unit:=fnd;
@@ -1256,7 +1263,7 @@ var
                       if (orgfiletime<>-1) and
                          (source_time<>orgfiletime) then
                         begin
-                          do_compile:=true;
+                          state:=ms_compile;
                           recompile_reason:=rr_sourcenewer;
                           Message2(unit_u_source_modified,hs,ppufilename,@queuecomment);
                           temp:=temp+' *';
@@ -1292,7 +1299,7 @@ var
         available }
         if do_build and sources_avail then
           begin
-             do_compile:=true;
+             state:=ms_compile;
              recompile_reason:=rr_build;
           end;
       end;
@@ -1572,7 +1579,7 @@ var
              Message1(unit_f_ppu_invalid_entry,tostr(b));
            end;
            { we can already stop when we know that we must recompile }
-           if do_compile then
+           if state=ms_compile then
              exit;
          until false;
       end;
@@ -1969,7 +1976,7 @@ var
                    Comment(V_Normal,'  implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
 {$endif DEBUG_UNIT_CRC_CHANGES}
                  recompile_reason:=rr_crcchanged;
-                 do_compile:=true;
+                 state:=ms_compile;
                  exit;
                end;
             end;
@@ -2022,7 +2029,7 @@ var
                     Comment(V_Normal,'  indcrc change (2): '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^);
 {$endif DEBUG_UNIT_CRC_CHANGES}
                   recompile_reason:=rr_crcchanged;
-                  do_compile:=true;
+                  state:=ms_compile;
                   exit;
                 end;
             end;
@@ -2192,7 +2199,6 @@ var
             begin
               Message1(unit_u_second_compile_unit,modulename^);
               state:=ms_compile;
-              do_compile:=true;
             end
           else
             state:=ms_load;
@@ -2202,15 +2208,18 @@ var
 
       begin
         Message1(unit_u_loading_unit,modulename^);
-        search_unit_files(from_module,false);
-        if not do_compile then
+        if auPPU in search_unit_files(from_module,false) then
+          state:=ms_load
+        else
+          state:=ms_compile;
+        if not (state=ms_compile) then
          begin
            load_interface;
            setdefgeneration;
-           if not do_compile then
+           if not (state=ms_compile) then
             begin
               load_usedunits;
-              if not do_compile then
+              if not (state=ms_compile) then
                 Message1(unit_u_finished_loading_unit,modulename^);
             end;
          end;
@@ -2296,6 +2305,7 @@ var
         second_time        : boolean;
 
       begin
+
         Result:=false;
         Message3(unit_u_load_unit,from_module.modulename^,
                  ImplIntf[from_module.in_interface],
@@ -2327,6 +2337,11 @@ var
         { loading the unit for a second time? }
         if state=ms_registered then
           state:=ms_load
+        else if (state in [ms_compile, ms_compiling_waitintf]) then
+          begin
+          { no use continuing if we must be compiled }
+          exit(false)
+          end
         else
           begin
             second_time:=true;
@@ -2343,11 +2358,11 @@ var
 
         { try to opening ppu, skip this when we already
           know that we need to compile the unit }
-        if not do_compile then
+        if not (state=ms_compile) then
           try_load_ppufile(from_module);
 
         { Do we need to recompile the unit }
-        if do_compile then
+        if (state=ms_compile) then
           recompile_from_sources(from_module)
         else
           state:=ms_compiled;