fpc/compiler/fppu.pas

{
    $Id$
    Copyright (c) 1998-2000 by Florian Klaempfl

    This unit implements the first loading and searching of the modules

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************
}
unit fppu;

{$i defines.inc}

{ close ppufiles on system that are
  short on file handles like DOS system PM }
{$ifdef GO32V1}
  {$define SHORT_ON_FILE_HANDLES}
{$endif GO32V1}
{$ifdef GO32V2}
  {$define SHORT_ON_FILE_HANDLES}
{$endif GO32V2}

interface

    uses
       cutils,cclasses,
       globtype,globals,finput,fmodule,
       symbase,symppu,ppu;

    type
       tppumodule = class(tmodule)
          ppufile    : tcompilerppufile; { the PPU file }
{$ifdef Test_Double_checksum}
          crc_array  : pointer;
          crc_size   : longint;
          crc_array2 : pointer;
          crc_size2  : longint;
{$endif def Test_Double_checksum}
          constructor create(const s:string;_is_unit:boolean);
          destructor destroy;override;
          procedure reset;override;
          function  openppu:boolean;
          function  search_unit(const n : string;onlysource:boolean):boolean;
          procedure getppucrc;
          procedure writeppu;
          procedure loadppu;
       private
          procedure load_interface;
          procedure load_symtable_refs;
          procedure load_usedunits;
          procedure writeusedmacro(p:TNamedIndexItem);
          procedure writeusedmacros;
          procedure writesourcefiles;
          procedure writeusedunit;
          procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
          procedure readusedmacros;
          procedure readsourcefiles;
          procedure readloadunit;
          procedure readlinkcontainer(var p:tlinkcontainer);
       end;


    function loadunit(const s : stringid) : tmodule;


implementation

uses
{$ifdef delphi}
  dmisc,
{$else}
  dos,
{$endif}
  verbose,systems,version,
  symtable,
  scanner,
  parser;


{****************************************************************************
                                TPPUMODULE
 ****************************************************************************}

    constructor tppumodule.create(const s:string;_is_unit:boolean);
      begin
        inherited create(s,_is_unit);
        ppufile:=nil;
      { search the PPU file if it is an unit }
        if is_unit then
         begin
           { use the realmodulename so we can also find a case sensitive
             source filename }
           search_unit(realmodulename^,false);
           { it the sources_available is changed then we know that
             the sources aren't available }
           if not sources_avail then
            sources_checked:=true;
         end;
      end;


    destructor tppumodule.Destroy;
      begin
        if assigned(ppufile) then
         ppufile.free;
        ppufile:=nil;
        inherited Destroy;
      end;


    procedure tppumodule.reset;
      begin
        if assigned(ppufile) then
         begin
           ppufile.free;
           ppufile:=nil;
         end;
        inherited reset;
      end;


    function tppumodule.openppu:boolean;
      var
        ppufiletime : longint;
      begin
        openppu:=false;
        Message1(unit_t_ppu_loading,ppufilename^);
      { Get ppufile time (also check if the file exists) }
        ppufiletime:=getnamedfiletime(ppufilename^);
        if ppufiletime=-1 then
         exit;
      { Open the ppufile }
        Message1(unit_u_ppu_name,ppufilename^);
        ppufile:=tcompilerppufile.create(ppufilename^);
        if not ppufile.openfile then
         begin
           ppufile.free;
           ppufile:=nil;
           Message(unit_u_ppu_file_too_short);
           exit;
         end;
      { check for a valid PPU file }
        if not ppufile.CheckPPUId then
         begin
           ppufile.free;
           ppufile:=nil;
           Message(unit_u_ppu_invalid_header);
           exit;
         end;
      { check for allowed PPU versions }
        if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
         begin
           ppufile.free;
           ppufile:=nil;
           Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion));
           exit;
         end;
      { check the target processor }
        if ttargetcpu(ppufile.header.cpu)<>target_cpu then
         begin
           ppufile.free;
           ppufile:=nil;
           Message(unit_u_ppu_invalid_processor);
           exit;
         end;
      { check target }
        if ttarget(ppufile.header.target)<>target_info.target then
         begin
           ppufile.free;
           ppufile:=nil;
           Message(unit_u_ppu_invalid_target);
           exit;
         end;
      { Load values to be access easier }
        flags:=ppufile.header.flags;
        crc:=ppufile.header.checksum;
        interface_crc:=ppufile.header.interface_checksum;
      { Show Debug info }
        Message1(unit_u_ppu_time,filetimestring(ppufiletime));
        Message1(unit_u_ppu_flags,tostr(flags));
        Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
        Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
        do_compile:=false;
        openppu:=true;
      end;


    function tppumodule.search_unit(const n : string;onlysource:boolean):boolean;
      var
         singlepathstring,
         filename : string;

         Function UnitExists(const ext:string;var foundfile:string):boolean;
         begin
           Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
           UnitExists:=FindFile(FileName+ext,Singlepathstring,foundfile);
         end;

         Function PPUSearchPath(const s:string):boolean;
         var
           found : boolean;
           hs    : string;
         begin
           Found:=false;
           singlepathstring:=FixPath(s,false);
         { Check for PPU file }
           Found:=UnitExists(target_info.unitext,hs);
           if Found then
            Begin
              SetFileName(hs,false);
              Found:=OpenPPU;
            End;
           PPUSearchPath:=Found;
         end;

         Function SourceSearchPath(const s:string):boolean;
         var
           found   : boolean;
           hs      : string;
         begin
           Found:=false;
           singlepathstring:=FixPath(s,false);
         { Check for Sources }
           ppufile:=nil;
           do_compile:=true;
           recompile_reason:=rr_noppu;
         {Check for .pp file}
           Found:=UnitExists(target_info.sourceext,hs);
           if not Found then
            begin
              { Check for .pas }
              Found:=UnitExists(target_info.pasext,hs);
            end;
           stringdispose(mainsource);
           if Found then
            begin
              sources_avail:=true;
              { Load Filenames when found }
              mainsource:=StringDup(hs);
              SetFileName(hs,false);
            end
           else
            sources_avail:=false;
           SourceSearchPath:=Found;
         end;

         Function SearchPath(const s:string):boolean;
         var
           found : boolean;
         begin
           { First check for a ppu, then for the source }
           found:=false;
           if not onlysource then
            found:=PPUSearchPath(s);
           if not found then
            found:=SourceSearchPath(s);
           SearchPath:=found;
         end;

         Function SearchPathList(list:TSearchPathList):boolean;
         var
           hp : TStringListItem;
           found : boolean;
         begin
           found:=false;
           hp:=TStringListItem(list.First);
           while assigned(hp) do
            begin
              found:=SearchPath(hp.Str);
              if found then
               break;
              hp:=TStringListItem(hp.next);
            end;
           SearchPathList:=found;
         end;

       var
         fnd : boolean;
       begin
         filename:=FixFileName(n);
         { try to find unit
            1. look for ppu in cwd
            2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
            3. look for source in cwd
            4. local unit pathlist
            5. global unit pathlist }
         fnd:=false;
         if not onlysource then
          begin
            fnd:=PPUSearchPath('.');
            if (not fnd) and (current_module.outputpath^<>'') then
             fnd:=PPUSearchPath(current_module.outputpath^);
           end;
         if (not fnd) then
          fnd:=SourceSearchPath('.');
         if (not fnd) then
          fnd:=SearchPathList(current_module.LocalUnitSearchPath);
         if (not fnd) then
          fnd:=SearchPathList(UnitSearchPath);

         { try to find a file with the first 8 chars of the modulename, like
           dos }
         if (not fnd) and (length(filename)>8) then
          begin
            filename:=copy(filename,1,8);
            fnd:=SearchPath('.');
            if (not fnd) then
             fnd:=SearchPathList(current_module.LocalUnitSearchPath);
            if not fnd then
             fnd:=SearchPathList(UnitSearchPath);
          end;
         search_unit:=fnd;
      end;


{**********************************
    PPU Reading/Writing Helpers
***********************************}

    procedure tppumodule.writeusedmacro(p:TNamedIndexItem);
      begin
        if tmacro(p).is_used or tmacro(p).defined_at_startup then
          begin
            ppufile.putstring(p.name);
            ppufile.putbyte(byte(tmacro(p).defined_at_startup));
            ppufile.putbyte(byte(tmacro(p).is_used));
          end;
      end;


    procedure tppumodule.writeusedmacros;
      begin
        ppufile.do_crc:=false;
        current_scanner.macros.foreach({$ifdef FPCPROCVAR}@{$endif}writeusedmacro);
        ppufile.writeentry(ibusedmacros);
        ppufile.do_crc:=true;
      end;


    procedure tppumodule.writesourcefiles;
      var
        hp  : tinputfile;
        i,j : longint;
      begin
      { second write the used source files }
        ppufile.do_crc:=false;
        hp:=sourcefiles.files;
      { write source files directly in good order }
        j:=0;
        while assigned(hp) do
          begin
            inc(j);
            hp:=hp.ref_next;
          end;
        while j>0 do
          begin
            hp:=sourcefiles.files;
            for i:=1 to j-1 do
              hp:=hp.ref_next;
            ppufile.putstring(hp.name^);
            dec(j);
         end;
        ppufile.writeentry(ibsourcefiles);
        ppufile.do_crc:=true;
      end;


    procedure tppumodule.writeusedunit;
      var
        hp : tused_unit;
      begin
        { renumber the units for derefence writing }
        numberunits;
        { write a reference for each used unit }
        hp:=tused_unit(used_units.first);
        while assigned(hp) do
         begin
           { implementation units should not change
             the CRC PM }
           ppufile.do_crc:=hp.in_interface;
           ppufile.putstring(hp.name^);
           { the checksum should not affect the crc of this unit ! (PFV) }
           ppufile.do_crc:=false;
           ppufile.putlongint(longint(hp.checksum));
           ppufile.putlongint(longint(hp.interface_checksum));
           ppufile.putbyte(byte(hp.in_interface));
           ppufile.do_crc:=true;
           hp:=tused_unit(hp.next);
         end;
        ppufile.do_interface_crc:=true;
        ppufile.writeentry(ibloadunit);
      end;


    procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
      var
        hcontainer : tlinkcontainer;
        s : string;
        mask : cardinal;
      begin
        hcontainer:=TLinkContainer.Create;
        while not p.empty do
         begin
           s:=p.get(mask);
           if strippath then
            ppufile.putstring(SplitFileName(s))
           else
            ppufile.putstring(s);
           ppufile.putlongint(mask);
           hcontainer.add(s,mask);
         end;
        ppufile.writeentry(id);
        p.Free;
        p:=hcontainer;
      end;


    procedure tppumodule.readusedmacros;
      var
        hs : string;
        mac : tmacro;
        was_defined_at_startup,
        was_used : boolean;
      begin
        while not ppufile.endofentry do
         begin
           hs:=ppufile.getstring;
           was_defined_at_startup:=boolean(ppufile.getbyte);
           was_used:=boolean(ppufile.getbyte);
           mac:=tmacro(current_scanner.macros.search(hs));
           if assigned(mac) then
             begin
{$ifndef EXTDEBUG}
           { if we don't have the sources why tell }
              if sources_avail then
{$endif ndef EXTDEBUG}
               if (not was_defined_at_startup) and
                  was_used and
                  mac.defined_at_startup then
                Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
             end
           else { not assigned }
             if was_defined_at_startup and
                was_used then
              Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
         end;
      end;


    procedure tppumodule.readsourcefiles;
      var
        temp,hs       : string;
        temp_dir      : string;
        main_dir      : string;
        incfile_found,
        main_found,
        is_main       : boolean;
        ppufiletime,
        source_time   : longint;
        hp            : tinputfile;
      begin
        ppufiletime:=getnamedfiletime(ppufilename^);
        sources_avail:=true;
        is_main:=true;
        main_dir:='';
        while not ppufile.endofentry do
         begin
           hs:=ppufile.getstring;
           temp_dir:='';
           if (flags and uf_in_library)<>0 then
            begin
              sources_avail:=false;
              temp:=' library';
            end
           else if pos('Macro ',hs)=1 then
            begin
              { we don't want to find this file }
              { but there is a problem with file indexing !! }
              temp:='';
            end
           else
            begin
              { check the date of the source files }
              Source_Time:=GetNamedFileTime(path^+hs);
              incfile_found:=false;
              main_found:=false;
              if Source_Time<>-1 then
                hs:=path^+hs
              else
               if not(is_main) then
                begin
                  Source_Time:=GetNamedFileTime(main_dir+hs);
                  if Source_Time<>-1 then
                    hs:=main_dir+hs;
                end;
              if (Source_Time=-1) then
                begin
                  if is_main then
                    main_found:=unitsearchpath.FindFile(hs,temp_dir)
                  else
                    incfile_found:=includesearchpath.FindFile(hs,temp_dir);
                  if incfile_found or main_found then
                   begin
                     Source_Time:=GetNamedFileTime(temp_dir);
                     if Source_Time<>-1 then
                      hs:=temp_dir;
                   end;
                end;
              if Source_Time=-1 then
               begin
                 sources_avail:=false;
                 temp:=' not found';
               end
              else
               begin
                 if main_found then
                   main_dir:=temp_dir;
                 { time newer? But only allow if the file is not searched
                   in the include path (PFV), else you've problems with
                   units which use the same includefile names }
                 if incfile_found then
                  temp:=' found'
                 else
                  begin
                    temp:=' time '+filetimestring(source_time);
                    if (source_time>ppufiletime) then
                     begin
                       do_compile:=true;
                       recompile_reason:=rr_sourcenewer;
                       temp:=temp+' *'
                     end;
                  end;
               end;
              hp:=tinputfile.create(hs);
              { the indexing is wrong here PM }
              sourcefiles.register_file(hp);
            end;
           if is_main then
             begin
               stringdispose(mainsource);
               mainsource:=stringdup(hs);
             end;
           Message1(unit_u_ppu_source,hs+temp);
           is_main:=false;
         end;
      { check if we want to rebuild every unit, only if the sources are
        available }
        if do_build and sources_avail then
          begin
             do_compile:=true;
             recompile_reason:=rr_build;
          end;
      end;


    procedure tppumodule.readloadunit;
      var
        hs : string;
        intfchecksum,
        checksum : cardinal;
        in_interface : boolean;
      begin
        while not ppufile.endofentry do
         begin
           hs:=ppufile.getstring;
           checksum:=cardinal(ppufile.getlongint);
           intfchecksum:=cardinal(ppufile.getlongint);
           in_interface:=(ppufile.getbyte<>0);
           used_units.concat(tused_unit.create_to_load(hs,checksum,intfchecksum,in_interface));
         end;
      end;


    procedure tppumodule.readlinkcontainer(var p:tlinkcontainer);
      var
        s : string;
        m : longint;
      begin
        while not ppufile.endofentry do
         begin
           s:=ppufile.getstring;
           m:=ppufile.getlongint;
           p.add(s,m);
         end;
      end;


    procedure tppumodule.load_interface;
      var
        b : byte;
        newmodulename : string;
      begin
       { read interface part }
         repeat
           b:=ppufile.readentry;
           case b of
             ibmodulename :
               begin
                 newmodulename:=ppufile.getstring;
                 if upper(newmodulename)<>modulename^ then
                   Message2(unit_f_unit_name_error,realmodulename^,newmodulename);
                 stringdispose(modulename);
                 stringdispose(realmodulename);
                 modulename:=stringdup(upper(newmodulename));
                 realmodulename:=stringdup(newmodulename);
               end;
             ibsourcefiles :
               readsourcefiles;
             ibusedmacros :
               readusedmacros;
             ibloadunit :
               readloadunit;
             iblinkunitofiles :
               readlinkcontainer(LinkUnitOFiles);
             iblinkunitstaticlibs :
               readlinkcontainer(LinkUnitStaticLibs);
             iblinkunitsharedlibs :
               readlinkcontainer(LinkUnitSharedLibs);
             iblinkotherofiles :
               readlinkcontainer(LinkotherOFiles);
             iblinkotherstaticlibs :
               readlinkcontainer(LinkotherStaticLibs);
             iblinkothersharedlibs :
               readlinkcontainer(LinkotherSharedLibs);
             ibendinterface :
               break;
           else
             Message1(unit_f_ppu_invalid_entry,tostr(b));
           end;
         until false;
      end;


    procedure tppumodule.load_symtable_refs;
      var
         b : byte;
         unitindex : word;
      begin
        { load local symtable first }
        if ((flags and uf_local_browser)<>0) then
          begin
             localsymtable:=tstaticsymtable.create(modulename^);
             tstaticsymtable(localsymtable).load(ppufile);
          end;

        { load browser }
        if (current_module.flags and uf_has_browser)<>0 then
          begin
            tstoredsymtable(globalsymtable).load_browser(ppufile);
            unitindex:=1;
            while assigned(map^[unitindex]) do
             begin
               { each unit wrote one browser entry }
               tstoredsymtable(globalsymtable).load_browser(ppufile);
               inc(unitindex);
             end;
            b:=ppufile.readentry;
            if b<>ibendbrowser then
             Message1(unit_f_ppu_invalid_entry,tostr(b));
          end;
        if ((current_module.flags and uf_local_browser)<>0) then
          tstaticsymtable(current_module.localsymtable).load_browser(ppufile);
      end;


    procedure tppumodule.writeppu;
      var
        pu : tused_unit;
      begin
         Message1(unit_u_ppu_write,realmodulename^);

         { create unit flags }
{$ifdef GDB}
         if cs_gdb_dbx in aktglobalswitches then
          flags:=flags or uf_has_dbx;
{$endif GDB}
         if cs_browser in aktmoduleswitches then
          flags:=flags or uf_has_browser;
         if cs_local_browser in aktmoduleswitches then
          flags:=flags or uf_local_browser;

{$ifdef Test_Double_checksum_write}
         Assign(CRCFile,s+'.IMP');
         Rewrite(CRCFile);
{$endif def Test_Double_checksum_write}

         { create new ppufile }
         ppufile:=tcompilerppufile.create(ppufilename^);
         if not ppufile.createfile then
          Message(unit_f_ppu_cannot_write);

         { first the unitname }
         ppufile.putstring(realmodulename^);
         ppufile.writeentry(ibmodulename);

         writesourcefiles;
         writeusedmacros;
         writeusedunit;

         { write the objectfiles and libraries that come for this unit,
           preserve the containers becuase they are still needed to load
           the link.res. All doesn't depend on the crc! It doesn't matter
           if a unit is in a .o or .a file }
         ppufile.do_crc:=false;
         writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
         writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
         writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
         writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
         writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
         writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
         ppufile.do_crc:=true;

         ppufile.writeentry(ibendinterface);

         { write the symtable entries }
         tstoredsymtable(globalsymtable).write(ppufile);

         { everything after this doesn't affect the crc }
         ppufile.do_crc:=false;
         ppufile.writeentry(ibendimplementation);

         { write static symtable
           needed for local debugging of unit functions }
         if ((flags and uf_local_browser)<>0) and
            assigned(localsymtable) then
           tstoredsymtable(localsymtable).write(ppufile);

         { write all browser section }
         if (flags and uf_has_browser)<>0 then
          begin
            tstoredsymtable(globalsymtable).write_browser(ppufile);
            pu:=tused_unit(used_units.first);
            while assigned(pu) do
             begin
               tstoredsymtable(pu.u.globalsymtable).write_browser(ppufile);
               pu:=tused_unit(pu.next);
             end;
            ppufile.writeentry(ibendbrowser);
          end;
         if ((flags and uf_local_browser)<>0) and
            assigned(localsymtable) then
           tstaticsymtable(localsymtable).write_browser(ppufile);

         { the last entry ibend is written automaticly }

         { flush to be sure }
         ppufile.flush;
         { create and write header }
         ppufile.header.size:=ppufile.size;
         ppufile.header.checksum:=ppufile.crc;
         ppufile.header.interface_checksum:=ppufile.interface_crc;
         ppufile.header.compiler:=wordversion;
         ppufile.header.cpu:=word(target_cpu);
         ppufile.header.target:=word(target_info.target);
         ppufile.header.flags:=flags;
         ppufile.writeheader;

         { save crc in current module also }
         crc:=ppufile.crc;
         interface_crc:=ppufile.interface_crc;

{$ifdef Test_Double_checksum_write}
         close(CRCFile);
{$endif Test_Double_checksum_write}

         ppufile.closefile;
         ppufile.free;
         ppufile:=nil;
      end;


    procedure tppumodule.getppucrc;
      begin
{$ifdef Test_Double_checksum_write}
         Assign(CRCFile,s+'.INT')
         Rewrite(CRCFile);
{$endif def Test_Double_checksum_write}

         { create new ppufile }
         ppufile:=tcompilerppufile.create(ppufilename^);
         ppufile.crc_only:=true;
         if not ppufile.createfile then
           Message(unit_f_ppu_cannot_write);

         { first the unitname }
         ppufile.putstring(realmodulename^);
         ppufile.writeentry(ibmodulename);

         { the interface units affect the crc }
         writeusedunit;

         ppufile.writeentry(ibendinterface);

         { write the symtable entries }
         tstoredsymtable(globalsymtable).write(ppufile);

         { save crc  }
         crc:=ppufile.crc;
         interface_crc:=ppufile.interface_crc;

{$ifdef Test_Double_checksum}
         crc_array:=ppufile.crc_test;
         ppufile.crc_test:=nil;
         crc_size:=ppufile.crc_index2;
         crc_array2:=ppufile.crc_test2;
         ppufile.crc_test2:=nil;
         crc_size2:=ppufile.crc_index2;
{$endif Test_Double_checksum}

{$ifdef Test_Double_checksum_write}
         close(CRCFile);
{$endif Test_Double_checksum_write}

         ppufile.closefile;
         ppufile.free;
         ppufile:=nil;
      end;


    procedure tppumodule.load_usedunits;
      var
        pu           : tused_unit;
        loaded_unit  : tmodule;
        load_refs    : boolean;
        nextmapentry : longint;
        b            : byte;
      begin
        load_refs:=true;
        { init the map }
        new(map);
        fillchar(map^,sizeof(tunitmap),#0);
{$ifdef NEWMAP}
        map^[0]:=current_module;
{$endif NEWMAP}
        nextmapentry:=1;
        { load the used units from interface }
        in_implementation:=false;
        pu:=tused_unit(used_units.first);
        while assigned(pu) do
         begin
           if (not pu.loaded) and (pu.in_interface) then
            begin
              loaded_unit:=loadunit(pu.name^);
              if compiled then
               exit;
              { register unit in used units }
              pu.u:=loaded_unit;
              pu.loaded:=true;
              { doubles are not important for that list PM }
              pu.u.dependent_units.concat(tdependent_unit.create(self));
              { need to recompile the current unit ? }
              if loaded_unit.crc<>pu.checksum then
               begin
                 Message2(unit_u_recompile_crc_change,modulename^,pu.name^);
                 recompile_reason:=rr_crcchanged;
                 do_compile:=true;
                 dispose(map);
                 map:=nil;
                 exit;
               end;
            { setup the map entry for deref }
{$ifndef NEWMAP}
              map^[nextmapentry]:=loaded_unit.globalsymtable;
{$else NEWMAP}
              map^[nextmapentry]:=loaded_unit;
{$endif NEWMAP}
              inc(nextmapentry);
              if nextmapentry>maxunits then
               Message(unit_f_too_much_units);
            end;
           pu:=tused_unit(pu.next);
         end;
        { ok, now load the interface of this unit }
        current_module:=self;
        SetCompileModule(current_module);
        globalsymtable:=tglobalsymtable.create(modulename^);
        tstoredsymtable(globalsymtable).load(ppufile);
        { now only read the implementation uses }
        in_implementation:=true;
        pu:=tused_unit(used_units.first);
        while assigned(pu) do
         begin
           if (not pu.loaded) and (not pu.in_interface) then
            begin
              loaded_unit:=loadunit(pu.name^);
              if compiled then
               exit;
            { register unit in used units }
              pu.u:=loaded_unit;
              pu.loaded:=true;
            { need to recompile the current unit ? }
              if (loaded_unit.interface_crc<>pu.interface_checksum) {and
                 not(current_module.in_second_compile) } then
                begin
                  Message2(unit_u_recompile_crc_change,modulename^,pu.name^+' {impl}');
                  recompile_reason:=rr_crcchanged;
                  do_compile:=true;
                  dispose(map);
                  map:=nil;
                  exit;
                end;
            { setup the map entry for deref }
{$ifndef NEWMAP}
              map^[nextmapentry]:=loaded_unit.globalsymtable;
{$else NEWMAP}
              map^[nextmapentry]:=loaded_unit;
{$endif NEWMAP}
              inc(nextmapentry);
              if nextmapentry>maxunits then
               Message(unit_f_too_much_units);
            end;
           pu:=tused_unit(pu.next);
         end;
        { read the implementation part }
        b:=ppufile.readentry;
        if b<>ibendimplementation then
          Message1(unit_f_ppu_invalid_entry,tostr(b));
        { load browser info if stored }
        if ((flags and uf_has_browser)<>0) and load_refs then
         begin
           current_module:=self;
           load_symtable_refs;
         end;
        { remove the map, it's not needed anymore }
        dispose(map);
        map:=nil;
      end;


    procedure tppumodule.loadppu;
      var
        name : string;
      begin
        { load interface section }
          if not do_compile then
           load_interface;
        { only load units when we don't recompile }
          if not do_compile then
           load_usedunits;
        { recompile if set }
          if do_compile then
           begin
           { we don't need the ppufile anymore }
             if assigned(ppufile) then
              begin
                ppufile.free;
                ppufile:=nil;
              end;
           { recompile the unit or give a fatal error if sources not available }
             if not(sources_avail) and
                not(sources_checked) then
               if (not search_unit(modulename^,true))
                  and (length(modulename^)>8) then
                 search_unit(copy(modulename^,1,8),true);
             if not(sources_avail) then
               begin
                  if recompile_reason=rr_noppu then
                    Message1(unit_f_cant_find_ppu,modulename^)
                  else
                    Message1(unit_f_cant_compile_unit,modulename^);
               end
             else
              begin
                if in_compile then
                  begin
                    in_second_compile:=true;
                    Message1(parser_d_compiling_second_time,modulename^);
                  end;
                current_scanner.tempcloseinputfile;
                name:=mainsource^;
                if assigned(scanner) then
                  tscannerfile(scanner).invalid:=true;
                { compile this module }
                current_module:=self;
                compile(name);
                in_second_compile:=false;
                if (not current_scanner.invalid) then
                  current_scanner.tempopeninputfile;
              end;
           end;
         if assigned(ppufile) then
           begin
              ppufile.closefile;
              ppufile.free;
              ppufile:=nil;
           end;
        end;


{*****************************************************************************
                                  LoadUnit
*****************************************************************************}

    function loadunit(const s : stringid) : tmodule;
      const
        ImplIntf : array[boolean] of string[15]=('interface','implementation');
      var
        st : tglobalsymtable;
        second_time : boolean;
        old_current_module,hp2 : tmodule;
        hp : tppumodule;
        scanner : tscannerfile;
        dummy : tmodule;
        ups   : stringid;
      begin
         old_current_module:=current_module;
         { Info }
         Message3(unit_u_load_unit,current_module.modulename^,ImplIntf[current_module.in_implementation],s);
         ups:=upper(s);
         { unit not found }
         st:=nil;
         dummy:=nil;
         { search all loaded units }
         hp:=tppumodule(loaded_units.first);
         while assigned(hp) do
           begin
              if hp.modulename^=ups then
                begin
                   { forced to reload ? }
                   if hp.do_reload then
                    begin
                      hp.do_reload:=false;
                      break;
                    end;
                   { the unit is already registered   }
                   { and this means that the unit     }
                   { is already compiled              }
                   { else there is a cyclic unit use  }
                   if assigned(hp.globalsymtable) then
                     st:=tglobalsymtable(hp.globalsymtable)
                   else
                    begin
                    { both units in interface ? }
                      if (not current_module.in_implementation) and
                         (not hp.in_implementation) then
                       begin
                       { check for a cycle }
                         hp2:=current_module.loaded_from;
                         while assigned(hp2) and (hp2<>hp) do
                          begin
                            if hp2.in_implementation then
                             hp2:=nil
                            else
                             hp2:=hp2.loaded_from;
                          end;
                         if assigned(hp2) then
                          Message2(unit_f_circular_unit_reference,current_module.modulename^,hp.modulename^);
                       end;
                    end;
                   break;
                end
              else if copy(hp.modulename^,1,8)=ups then
                dummy:=hp;
              { the next unit }
              hp:=tppumodule(hp.next);
           end;
         if assigned(dummy) and not assigned(hp) then
           Message2(unit_w_unit_name_error,s,dummy.modulename^);
       { the unit is not in the loaded units, we must load it first }
         if (not assigned(st)) then
          begin
            if assigned(hp) then
             begin
               { remove the old unit, but save the scanner }
               loaded_units.remove(hp);
               scanner:=tscannerfile(hp.scanner);
               hp.reset;
               hp.scanner:=scanner;
               { try to reopen ppu }
               hp.search_unit(s,false);
               { try to load the unit a second time first }
               current_module:=hp;
               current_module.in_second_load:=true;
               Message1(unit_u_second_load_unit,current_module.modulename^);
               second_time:=true;
             end
            else
          { generates a new unit info record }
             begin
                current_module:=tppumodule.create(s,true);
                scanner:=nil;
                second_time:=false;
             end;
            { close old_current_ppu on system that are
              short on file handles like DOS PM }
{$ifdef SHORT_ON_FILE_HANDLES}
            if old_current_module.is_unit and
               assigned(tppumodule(old_current_module).ppufile) then
              tppumodule(old_current_module).ppufile.tempclose;
{$endif SHORT_ON_FILE_HANDLES}
          { now we can register the unit }
            current_module.loaded_from:=old_current_module;
            loaded_units.insert(current_module);
          { now realy load the ppu }
            tppumodule(current_module).loadppu;
          { set compiled flag }
            current_module.compiled:=true;
          { load return pointer }
            hp:=tppumodule(current_module);
          { for a second_time recompile reload all dependent units,
            for a first time compile register the unit _once_ }
            if second_time then
             begin
               { now reload all dependent units }
               hp2:=tmodule(loaded_units.first);
               while assigned(hp2) do
                begin
                  if hp2.do_reload then
                   dummy:=loadunit(hp2.modulename^);
                  hp2:=tmodule(hp2.next);
                end;
             end
            else
             usedunits.concat(tused_unit.create(current_module,true));
          end;
         { set the old module }
{$ifdef SHORT_ON_FILE_HANDLES}
         if old_current_module.is_unit and
            assigned(tppumodule(old_current_module).ppufile) then
           tppumodule(old_current_module).ppufile.tempopen;
{$endif SHORT_ON_FILE_HANDLES}
         { we are back }
         current_module:=old_current_module;
         SetCompileModule(current_module);
         loadunit:=hp;
      end;



end.
{
  $Log$
  Revision 1.4  2001-05-09 14:11:10  jonas
    * range check error fixes from Peter

  Revision 1.3  2001/05/08 21:06:30  florian
    * some more support for widechars commited especially
      regarding type casting and constants

  Revision 1.2  2001/05/07 11:53:21  jonas
    * fix from Peter for short_on_file_handles code

  Revision 1.1  2001/05/06 14:49:17  peter
    * ppu object to class rewrite
    * move ppu read and write stuff to fppu
}