freepascal.compiler/compiler/files.pas

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

    This unit implements an extended file management and the first loading
    and searching of the modules (ppufiles)

    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 files;

{$ifdef TP}
  {$V+}
{$endif}

{$ifdef TP}
  {$define SHORTASMPREFIX}
{$endif}
{$ifdef go32v1}
  {$define SHORTASMPREFIX}
{$endif}
{$ifdef go32v2}
  {$define SHORTASMPREFIX}
{$endif}
{$ifdef OS2}
  { Allthough OS/2 supports long filenames I play it safe and
    use 8.3 filenames, because this allows the compiler to run
    on a FAT partition. (DM) }
  {$define SHORTASMPREFIX}
{$endif}


  interface

    uses
       globtype,cobjects,globals,ppu
       {$IFDEF NEWST},objects{$ENDIF};

    const
{$ifdef FPC}
       maxunits = 1024;
       InputFileBufSize=32*1024;
       linebufincrease=512;
{$else}
       maxunits = 128;
       InputFileBufSize=1024;
       linebufincrease=64;
{$endif}

    type
       trecompile_reason = (rr_unknown,rr_noppu,rr_sourcenewer,
         rr_build,rr_libolder,rr_objolder,rr_asmolder,rr_crcchanged);
{$ifdef FPC}
       tlongintarr = array[0..1000000] of longint;
{$else}
       tlongintarr = array[0..16000] of longint;
{$endif}
       plongintarr = ^tlongintarr;

       pinputfile = ^tinputfile;
       tinputfile = object
         path,name : pstring;       { path and filename }
         next      : pinputfile;    { next file for reading }

         is_macro,
         endoffile,                 { still bytes left to read }
         closed       : boolean;    { is the file closed }

         buf          : pchar;      { buffer }
         bufstart,                  { buffer start position in the file }
         bufsize,                   { amount of bytes in the buffer }
         maxbufsize   : longint;    { size in memory for the buffer }

         saveinputpointer : pchar;  { save fields for scanner variables }
         savelastlinepos,
         saveline_no      : longint;

         linebuf    : plongintarr;  { line buffer to retrieve lines }
         maxlinebuf : longint;

         ref_count  : longint;      { to handle the browser refs }
         ref_index  : longint;
         ref_next   : pinputfile;

         constructor init(const fn:string);
         destructor done;
         procedure setpos(l:longint);
         procedure seekbuf(fpos:longint);
         procedure readbuf;
         function  open:boolean;
         procedure close;
         procedure tempclose;
         function  tempopen:boolean;
         procedure setmacro(p:pchar;len:longint);
         procedure setline(line,linepos:longint);
         function  getlinestr(l:longint):string;
       {$ifdef FPC}protected{$else}public{$endif}
         function fileopen(const filename: string): boolean; virtual;
         function fileseek(pos: longint): boolean; virtual;
         function fileread(var databuf; maxsize: longint): longint; virtual;
         function fileeof: boolean; virtual;
         function fileclose: boolean; virtual;
       end;

       pdosinputfile = ^tdosinputfile;
       tdosinputfile = object(tinputfile)
       {$ifdef FPC}protected{$else}public{$endif}
         function fileopen(const filename: string): boolean; virtual;
         function fileseek(pos: longint): boolean; virtual;
         function fileread(var databuf; maxsize: longint): longint; virtual;
         function fileeof: boolean; virtual;
         function fileclose: boolean; virtual;
       private
         f            : file;       { current file handle }
       end;

       pfilemanager = ^tfilemanager;
       tfilemanager = object
          files : pinputfile;
          last_ref_index : longint;
          cacheindex : longint;
          cacheinputfile : pinputfile;
          constructor init;
          destructor done;
          procedure register_file(f : pinputfile);
          procedure inverse_register_indexes;
          function  get_file(l:longint) : pinputfile;
          function  get_file_name(l :longint):string;
          function  get_file_path(l :longint):string;
       end;

    {$IFDEF NEWST}
       Plinkitem=^Tlinkitem;
       Tlinkitem=object(Tobject)
          data     : pstring;
          needlink : longint;
          constructor init(const s:string;m:longint);
          destructor  done;virtual;
       end;
    {$ELSE}
       plinkcontaineritem=^tlinkcontaineritem;
       tlinkcontaineritem=object(tcontaineritem)
          data     : pstring;
          needlink : longint;
          constructor init(const s:string;m:longint);
          destructor  done;virtual;
       end;

       plinkcontainer=^tlinkcontainer;
       tlinkcontainer=object(tcontainer)
          constructor Init;
          procedure insert(const s : string;m:longint);
          function get(var m:longint) : string;
          function getusemask(mask:longint) : string;
          function find(const s:string):boolean;
       end;
    {$ENDIF NEWST}

{$ifndef NEWMAP}
       tunitmap = array[0..maxunits-1] of pointer;
       punitmap = ^tunitmap;

       pmodule = ^tmodule;

{$else NEWMAP}
       pmodule = ^tmodule;

       tunitmap = array[0..maxunits-1] of pmodule;
       punitmap = ^tunitmap;
{$endif NEWMAP}

       tmodule = object(tlinkedlist_item)
          ppufile       : pppufile; { the PPU file }
          crc,
          interface_crc,
          flags         : longint;  { the PPU flags }

          compiled,                 { unit is already compiled }
          do_reload,                { force reloading of the unit }
          do_assemble,              { only assemble the object, don't recompile }
          do_compile,               { need to compile the sources }
          sources_avail,            { if all sources are reachable }
          sources_checked,          { if there is already done a check for the sources }
          is_unit,
          in_compile,               { is it being compiled ?? }
          in_second_compile,        { is this unit being compiled for the 2nd time? }
          in_second_load,           { is this unit PPU loaded a 2nd time? }
          in_implementation,        { processing the implementation part? }
          in_global     : boolean;  { allow global settings }
          recompile_reason : trecompile_reason;  { the reason why the unit should be recompiled }

          islibrary     : boolean;  { if it is a library (win32 dll) }
          map           : punitmap; { mapping of all used units }
          unitcount     : word;     { local unit counter }
          unit_index    : word;     { global counter for browser }
          globalsymtable,           { pointer to the local/static symtable of this unit }
          localsymtable : pointer;  { pointer to the psymtable of this unit }
          scanner       : pointer;  { scanner object used }
          loaded_from   : pmodule;
          uses_imports  : boolean;  { Set if the module imports from DLL's.}
          imports       : plinkedlist;
          _exports      : plinkedlist;

          sourcefiles   : pfilemanager;
          resourcefiles : tstringcontainer;

       {$IFDEF NEWST}
          linkunitofiles,
          linkunitstaticlibs,
          linkunitsharedlibs,
          linkotherofiles,           { objects,libs loaded from the source }
          linkothersharedlibs,       { using $L or $LINKLIB or import lib (for linux) }
          linkotherstaticlibs  : Tcollection;
       {$ELSE}
          linkunitofiles,
          linkunitstaticlibs,
          linkunitsharedlibs,
          linkotherofiles,           { objects,libs loaded from the source }
          linkothersharedlibs,       { using $L or $LINKLIB or import lib (for linux) }
          linkotherstaticlibs  : tlinkcontainer;
       {$ENDIF NEWST}

          used_units           : tlinkedlist;
          dependent_units      : tlinkedlist;

          localunitsearchpath,           { local searchpaths }
          localobjectsearchpath,
          localincludesearchpath,
          locallibrarysearchpath : TSearchPathList;

          path,                     { path where the module is find/created }
          outputpath,               { path where the .s / .o / exe are created }
          modulename,               { name of the module in uppercase }
          objfilename,              { fullname of the objectfile }
          asmfilename,              { fullname of the assemblerfile }
          ppufilename,              { fullname of the ppufile }
          staticlibfilename,        { fullname of the static libraryfile }
          sharedlibfilename,        { fullname of the shared libraryfile }
          exefilename,              { fullname of the exefile }
          asmprefix,                { prefix for the smartlink asmfiles }
          mainsource    : pstring;  { name of the main sourcefile }
{$ifdef Test_Double_checksum}
          crc_array : pointer;
          crc_size : longint;
          crc_array2 : pointer;
          crc_size2 : longint;
{$endif def Test_Double_checksum}
          constructor init(const s:string;_is_unit:boolean);
          destructor done;virtual;
          procedure reset;
          procedure setfilename(const fn:string;allowoutput:boolean);
          function  openppu:boolean;
          function  search_unit(const n : string;onlysource:boolean):boolean;
       end;

       pused_unit = ^tused_unit;
       tused_unit = object(tlinkedlist_item)
          unitid          : word;
          name            : pstring;
          checksum,
          interface_checksum : longint;
          loaded          : boolean;
          in_uses,
          in_interface,
          is_stab_written : boolean;
          u               : pmodule;
          constructor init(_u : pmodule;intface:boolean);
          constructor init_to_load(const n:string;c,intfc:longint;intface:boolean);
          destructor done;virtual;
       end;

       pdependent_unit = ^tdependent_unit;
       tdependent_unit = object(tlinkedlist_item)
          u : pmodule;
          constructor init(_u : pmodule);
       end;

    var
       main_module       : pmodule;     { Main module of the program }
       current_module    : pmodule;     { Current module which is compiled or loaded }
       compiled_module   : pmodule;     { Current module which is compiled }
       current_ppu       : pppufile;    { Current ppufile which is read }
       global_unit_count : word;
       usedunits         : tlinkedlist; { Used units for this program }
       loaded_units      : tlinkedlist; { All loaded units }
       SmartLinkOFiles   : TStringContainer; { List of .o files which are generated,
                                               used to delete them after linking }

  function get_source_file(moduleindex,fileindex : word) : pinputfile;


implementation

uses
{$ifdef Delphi}
   dmisc,
{$else Delphi}
   dos,
{$endif Delphi}
  verbose,systems,
  symtable,scanner{$IFDEF NEWST},symtablt{$ENDIF};

{****************************************************************************
                                  TINPUTFILE
 ****************************************************************************}

    constructor tinputfile.init(const fn:string);
      var
        p:dirstr;
        n:namestr;
        e:extstr;
      begin
        FSplit(fn,p,n,e);
        name:=stringdup(n+e);
        path:=stringdup(p);
        next:=nil;
      { file info }
        is_macro:=false;
        endoffile:=false;
        closed:=true;
        buf:=nil;
        bufstart:=0;
        bufsize:=0;
        maxbufsize:=InputFileBufSize;
      { save fields }
        saveinputpointer:=nil;
        saveline_no:=0;
        savelastlinepos:=0;
      { indexing refs }
        ref_next:=nil;
        ref_count:=0;
        ref_index:=0;
      { line buffer }
        linebuf:=nil;
        maxlinebuf:=0;
      end;


    destructor tinputfile.done;
      begin
        if not closed then
         close;
        stringdispose(path);
        stringdispose(name);
      { free memory }
        if assigned(linebuf) then
         freemem(linebuf,maxlinebuf shl 2);
      end;


    procedure tinputfile.setpos(l:longint);
      begin
        bufstart:=l;
      end;


    procedure tinputfile.seekbuf(fpos:longint);
      begin
        if closed then
         exit;
        fileseek(fpos);
        bufstart:=fpos;
        bufsize:=0;
      end;


    procedure tinputfile.readbuf;
      begin
        if is_macro then
         endoffile:=true;
        if closed then
         exit;
        inc(bufstart,bufsize);
        bufsize:=fileread(buf^,maxbufsize-1);
        buf[bufsize]:=#0;
        endoffile:=fileeof;
      end;


    function tinputfile.open:boolean;
      begin
        open:=false;
        if not closed then
         Close;
        if not fileopen(path^+name^) then
         exit;
      { file }
        endoffile:=false;
        closed:=false;
        Getmem(buf,MaxBufsize);
        bufstart:=0;
        bufsize:=0;
        open:=true;
      end;


    procedure tinputfile.close;
      begin
        if is_macro then
         begin
           if assigned(buf) then
             Freemem(buf,maxbufsize);
           buf:=nil;
           {is_macro:=false;
           still needed for dispose in scanner PM }
           closed:=true;
           exit;
         end;
        if not closed then
         begin
           if fileclose then;
           closed:=true;
         end;
        if assigned(buf) then
          begin
             Freemem(buf,maxbufsize);
             buf:=nil;
          end;
        bufstart:=0;
      end;


    procedure tinputfile.tempclose;
      begin
        if is_macro then
         exit;
        if not closed then
         begin
           if fileclose then;
           Freemem(buf,maxbufsize);
           buf:=nil;
           closed:=true;
         end;
      end;

    function tinputfile.tempopen:boolean;
      begin
        tempopen:=false;
        if is_macro then
         begin
           { seek buffer postion to bufstart }
           if bufstart>0 then
            begin
              move(buf[bufstart],buf[0],bufsize-bufstart+1);
              bufstart:=0;
            end;
           tempopen:=true;
           exit;
         end;
        if not closed then
         exit;
        if not fileopen(path^+name^) then
         exit;
        closed:=false;
      { get new mem }
        Getmem(buf,maxbufsize);
      { restore state }
        fileseek(BufStart);
        bufsize:=0;
        readbuf;
        tempopen:=true;
      end;


    procedure tinputfile.setmacro(p:pchar;len:longint);
      begin
      { create new buffer }
        getmem(buf,len+1);
        move(p^,buf^,len);
        buf[len]:=#0;
      { reset }
        bufstart:=0;
        bufsize:=len;
        maxbufsize:=len+1;
        is_macro:=true;
        endoffile:=true;
        closed:=true;
      end;


    procedure tinputfile.setline(line,linepos:longint);
      var
        oldlinebuf  : plongintarr;
      begin
        if line<1 then
         exit;
        while (line>=maxlinebuf) do
         begin
           oldlinebuf:=linebuf;
         { create new linebuf and move old info }
           getmem(linebuf,(maxlinebuf+linebufincrease) shl 2);
           if assigned(oldlinebuf) then
            begin
              move(oldlinebuf^,linebuf^,maxlinebuf shl 2);
              freemem(oldlinebuf,maxlinebuf shl 2);
            end;
           fillchar(linebuf^[maxlinebuf],linebufincrease shl 2,0);
           inc(maxlinebuf,linebufincrease);
         end;
        linebuf^[line]:=linepos;
      end;


    function tinputfile.getlinestr(l:longint):string;
      var
        c    : char;
        i,
        fpos : longint;
        p    : pchar;
      begin
        getlinestr:='';
        if l<maxlinebuf then
         begin
           fpos:=linebuf^[l];
           { fpos is set negativ if the line was already written }
           { but we still know the correct value                 }
           if fpos<0 then
             fpos:=-fpos+1;
           if closed then
            open;
         { in current buf ? }
           if (fpos<bufstart) or (fpos>bufstart+bufsize) then
            begin
              seekbuf(fpos);
              readbuf;
            end;
         { the begin is in the buf now simply read until #13,#10 }
           i:=0;
           p:=@buf[fpos-bufstart];
           repeat
             c:=p^;
             if c=#0 then
              begin
                if endoffile then
                 break;
                readbuf;
                p:=buf;
                c:=p^;
              end;
             if c in [#10,#13] then
              break;
             inc(i);
             getlinestr[i]:=c;
             inc(longint(p));
           until (i=255);
           {$ifndef TP}
             {$ifopt H+}
               setlength(getlinestr,i);
             {$else}
               getlinestr[0]:=chr(i);
             {$endif}
           {$else}
             getlinestr[0]:=chr(i);
           {$endif}
         end;
      end;


    function tinputfile.fileopen(const filename: string): boolean;
      begin
        abstract;
        fileopen:=false;
      end;


    function tinputfile.fileseek(pos: longint): boolean;
      begin
        abstract;
        fileseek:=false;
      end;


    function tinputfile.fileread(var databuf; maxsize: longint): longint;
      begin
        abstract;
        fileread:=0;
      end;


    function tinputfile.fileeof: boolean;
      begin
        abstract;
        fileeof:=false;
      end;


    function tinputfile.fileclose: boolean;
      begin
        abstract;
        fileclose:=false;
      end;


{****************************************************************************
                                TDOSINPUTFILE
 ****************************************************************************}

    function tdosinputfile.fileopen(const filename: string): boolean;
      var
        ofm : byte;
      begin
        ofm:=filemode;
        filemode:=0;
        Assign(f,filename);
        {$I-}
         reset(f,1);
        {$I+}
        filemode:=ofm;
        fileopen:=(ioresult=0);
      end;


    function tdosinputfile.fileseek(pos: longint): boolean;
      begin
        {$I-}
         seek(f,BufStart);
        {$I+}
        fileseek:=(ioresult=0);
      end;


    function tdosinputfile.fileread(var databuf; maxsize: longint): longint;
      var w: {$ifdef TP}word{$else}longint{$endif};
      begin
        blockread(f,databuf,maxsize,w);
        fileread:=w;
      end;


    function tdosinputfile.fileeof: boolean;
      begin
        fileeof:=eof(f);
      end;


    function tdosinputfile.fileclose: boolean;
      begin
        {$I-}
         system.close(f);
        {$I+}
        fileclose:=(ioresult=0);
      end;


{****************************************************************************
                                TFILEMANAGER
 ****************************************************************************}

    constructor tfilemanager.init;
      begin
         files:=nil;
         last_ref_index:=0;
         cacheindex:=0;
         cacheinputfile:=nil;
      end;


    destructor tfilemanager.done;
      var
         hp : pinputfile;
      begin
         hp:=files;
         while assigned(hp) do
          begin
            files:=files^.ref_next;
            dispose(hp,done);
            hp:=files;
          end;
         last_ref_index:=0;
      end;


    procedure tfilemanager.register_file(f : pinputfile);
      begin
         { don't register macro's }
         if f^.is_macro then
          exit;
         inc(last_ref_index);
         f^.ref_next:=files;
         f^.ref_index:=last_ref_index;
         files:=f;
         { update cache }
         cacheindex:=last_ref_index;
         cacheinputfile:=f;
{$ifdef FPC}
  {$ifdef heaptrc}
         writeln(stderr,f^.name^,' index ',current_module^.unit_index*100000+f^.ref_index);
  {$endif heaptrc}
{$endif FPC}
      end;


   { this procedure is necessary after loading the
     sources files from a PPU file  PM }
   procedure tfilemanager.inverse_register_indexes;
     var
        f : pinputfile;
     begin
        f:=files;
        while assigned(f) do
          begin
             f^.ref_index:=last_ref_index-f^.ref_index+1;
             f:=f^.ref_next;
          end;
        { reset cache }
        cacheindex:=0;
        cacheinputfile:=nil;
     end;



   function tfilemanager.get_file(l :longint) : pinputfile;
     var
        ff : pinputfile;
     begin
       { check cache }
       if (l=cacheindex) and assigned(cacheinputfile) then
        begin
          get_file:=cacheinputfile;
          exit;
        end;
       ff:=files;
       while assigned(ff) and (ff^.ref_index<>l) do
         ff:=ff^.ref_next;
       get_file:=ff;
     end;


   function tfilemanager.get_file_name(l :longint):string;
     var
       hp : pinputfile;
     begin
       hp:=get_file(l);
       if assigned(hp) then
        get_file_name:=hp^.name^
       else
        get_file_name:='';
     end;


   function tfilemanager.get_file_path(l :longint):string;
     var
       hp : pinputfile;
     begin
       hp:=get_file(l);
       if assigned(hp) then
        get_file_path:=hp^.path^
       else
        get_file_path:='';
     end;


    function get_source_file(moduleindex,fileindex : word) : pinputfile;
      var
         hp : pmodule;
         f : pinputfile;
      begin
         hp:=pmodule(loaded_units.first);
         while assigned(hp) and (hp^.unit_index<>moduleindex) do
           hp:=pmodule(hp^.next);
         get_source_file:=nil;
         if not assigned(hp) then
           exit;
         f:=pinputfile(hp^.sourcefiles^.files);
         while assigned(f) do
           begin
              if f^.ref_index=fileindex then
                begin
                   get_source_file:=f;
                   exit;
                end;
              f:=pinputfile(f^.ref_next);
           end;
      end;


{****************************************************************************
                             TLinkContainerItem
 ****************************************************************************}

{$IFDEF NEWST}
constructor TLinkItem.Init(const s:string;m:longint);
begin
  inherited Init;
  data:=stringdup(s);
  needlink:=m;
end;


destructor TLinkItem.Done;
begin
  stringdispose(data);
end;
{$ELSE}
constructor TLinkContainerItem.Init(const s:string;m:longint);
begin
  inherited Init;
  data:=stringdup(s);
  needlink:=m;
end;


destructor TLinkContainerItem.Done;
begin
  stringdispose(data);
end;
{$ENDIF NEWST}


{****************************************************************************
                           TLinkContainer
 ****************************************************************************}

 {$IFNDEF NEWST}
    constructor TLinkContainer.Init;
      begin
        inherited init;
      end;


    procedure TLinkContainer.insert(const s : string;m:longint);
      var
        newnode : plinkcontaineritem;
      begin
         {if find(s) then
          exit; }
         new(newnode,init(s,m));
         inherited insert(newnode);
      end;


    function TLinkContainer.get(var m:longint) : string;
      var
        p : plinkcontaineritem;
      begin
        p:=plinkcontaineritem(inherited get);
        if p=nil then
         begin
           get:='';
           m:=0;
           exit;
         end;
        get:=p^.data^;
        m:=p^.needlink;
        dispose(p,done);
      end;


    function TLinkContainer.getusemask(mask:longint) : string;
      var
         p : plinkcontaineritem;
         found : boolean;
      begin
        found:=false;
        repeat
          p:=plinkcontaineritem(inherited get);
          if p=nil then
           begin
             getusemask:='';
             exit;
           end;
          getusemask:=p^.data^;
          found:=(p^.needlink and mask)<>0;
          dispose(p,done);
        until found;
      end;


    function TLinkContainer.find(const s:string):boolean;
      var
        newnode : plinkcontaineritem;
      begin
        find:=false;
        newnode:=plinkcontaineritem(root);
        while assigned(newnode) do
         begin
           if newnode^.data^=s then
            begin
              find:=true;
              exit;
            end;
           newnode:=plinkcontaineritem(newnode^.next);
         end;
      end;
    {$ENDIF NEWST}



{****************************************************************************
                                  TMODULE
 ****************************************************************************}

    procedure tmodule.setfilename(const fn:string;allowoutput:boolean);
      var
        p : dirstr;
        n : NameStr;
        e : ExtStr;
      begin
         stringdispose(objfilename);
         stringdispose(asmfilename);
         stringdispose(ppufilename);
         stringdispose(staticlibfilename);
         stringdispose(sharedlibfilename);
         stringdispose(exefilename);
         stringdispose(outputpath);
         stringdispose(path);
         { Create names }
         fsplit(fn,p,n,e);
         n:=FixFileName(n);
         { set path }
         path:=stringdup(FixPath(p,false));
         { obj,asm,ppu names }
         p:=path^;
         if AllowOutput then
          begin
            if (OutputUnitDir<>'') then
             p:=OutputUnitDir
            else
             if (OutputExeDir<>'') then
              p:=OutputExeDir;
          end;
         outputpath:=stringdup(p);
         objfilename:=stringdup(p+n+target_info.objext);
         asmfilename:=stringdup(p+n+target_info.asmext);
         ppufilename:=stringdup(p+n+target_info.unitext);
         { lib and exe could be loaded with a file specified with -o }
         if AllowOutput and (OutputFile<>'') and (compile_level=1) then
          n:=OutputFile;
         staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
         if target_info.target=target_i386_WIN32 then
           sharedlibfilename:=stringdup(p+n+target_os.sharedlibext)
         else
           sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
         { output dir of exe can be specified separatly }
         if AllowOutput and (OutputExeDir<>'') then
          p:=OutputExeDir
         else
          p:=path^;
         exefilename:=stringdup(p+n+target_info.exeext);
      end;


    function tmodule.openppu:boolean;
      var
        objfiletime,
        ppufiletime,
        asmfiletime : 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:=new(pppufile,init(ppufilename^));
        ppufile^.change_endian:=source_os.endian<>target_os.endian;
        if not ppufile^.open then
         begin
           dispose(ppufile,done);
           Message(unit_u_ppu_file_too_short);
           exit;
         end;
      { check for a valid PPU file }
        if not ppufile^.CheckPPUId then
         begin
           dispose(ppufile,done);
           Message(unit_u_ppu_invalid_header);
           exit;
         end;
      { check for allowed PPU versions }
        if not (ppufile^.GetPPUVersion = CurrentPPUVersion) then
         begin
           dispose(ppufile,done);
           Message1(unit_u_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
           exit;
         end;
      { check the target processor }
        if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
         begin
           dispose(ppufile,done);
           Message(unit_u_ppu_invalid_processor);
           exit;
         end;
      { check target }
        if ttarget(ppufile^.header.target)<>target_info.target then
         begin
           dispose(ppufile,done);
           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,tostr(ppufile^.header.checksum));
        Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)');
      { check the object and assembler file to see if we need only to
        assemble, only if it's not in a library }
        do_compile:=false;
        if (flags and uf_in_library)=0 then
         begin
           if (flags and uf_smart_linked)<>0 then
            begin
              objfiletime:=getnamedfiletime(staticlibfilename^);
              Message2(unit_u_check_time,staticlibfilename^,filetimestring(objfiletime));
              if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
                begin
                  recompile_reason:=rr_libolder;
                  Message(unit_u_recompile_staticlib_is_older);
                  do_compile:=true;
                  exit;
                end;
            end;
           if (flags and uf_static_linked)<>0 then
            begin
              { the objectfile should be newer than the ppu file }
              objfiletime:=getnamedfiletime(objfilename^);
              Message2(unit_u_check_time,objfilename^,filetimestring(objfiletime));
              if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
               begin
                 { check if assembler file is older than ppu file }
                 asmfileTime:=GetNamedFileTime(asmfilename^);
                 Message2(unit_u_check_time,asmfilename^,filetimestring(asmfiletime));
                 if (asmfiletime<0) or (ppufiletime>asmfiletime) then
                  begin
                    Message(unit_u_recompile_obj_and_asm_older);
                    recompile_reason:=rr_objolder;
                    do_compile:=true;
                    exit;
                  end
                 else
                  begin
                    Message(unit_u_recompile_obj_older_than_asm);
                    if not(cs_asm_extern in aktglobalswitches) then
                     begin
                       do_compile:=true;
                       recompile_reason:=rr_asmolder;
                       exit;
                     end;
                  end;
               end;
            end;
         end;
        openppu:=true;
      end;


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

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

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

         Function SourceSearchPath(const s:string):boolean;
         var
           found   : boolean;
           ext     : string[8];
         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_os.sourceext);
           if Found then
            Ext:=target_os.sourceext
           else
            begin
            {Check for .pas}
              Found:=UnitExists(target_os.pasext);
              if Found then
               Ext:=target_os.pasext;
            end;
           stringdispose(mainsource);
           if Found then
            begin
              sources_avail:=true;
            {Load Filenames when found}
              mainsource:=StringDup(SinglePathString+FileName+Ext);
              SetFileName(SinglePathString+FileName,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 : PStringQueueItem;
           found : boolean;
         begin
           found:=false;
           hp:=list.First;
           while assigned(hp) do
            begin
              found:=SearchPath(hp^.data^);
              if found then
               break;
              hp:=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;



    procedure tmodule.reset;
      var
         pm : pdependent_unit;
      begin
        if assigned(scanner) then
          pscannerfile(scanner)^.invalid:=true;
        if assigned(globalsymtable) then
          begin
            dispose(punitsymtable(globalsymtable),done);
            globalsymtable:=nil;
          end;
        if assigned(localsymtable) then
          begin
            dispose(punitsymtable(localsymtable),done);
            localsymtable:=nil;
          end;
        if assigned(map) then
         begin
           dispose(map);
           map:=nil;
         end;
        if assigned(ppufile) then
         begin
           dispose(ppufile,done);
           ppufile:=nil;
         end;
        sourcefiles^.done;
        sourcefiles^.init;
        imports^.done;
        imports^.init;
        _exports^.done;
        _exports^.init;
        used_units.done;
        used_units.init;
        { all units that depend on this one must be recompiled ! }
        pm:=pdependent_unit(dependent_units.first);
        while assigned(pm) do
          begin
            if pm^.u^.in_second_compile then
             Comment(v_debug,'No reload already in second compile: '+pm^.u^.modulename^)
            else
             begin
               pm^.u^.do_reload:=true;
               Comment(v_debug,'Reloading '+pm^.u^.modulename^+' needed because '+modulename^+' is reloaded');
             end;
            pm:=pdependent_unit(pm^.next);
          end;
        dependent_units.done;
        dependent_units.init;
        resourcefiles.done;
        resourcefiles.init;
        linkunitofiles.done;
        linkunitofiles.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkunitstaticlibs.done;
        linkunitstaticlibs.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkunitsharedlibs.done;
        linkunitsharedlibs.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkotherofiles.done;
        linkotherofiles.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkotherstaticlibs.done;
        linkotherstaticlibs.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkothersharedlibs.done;
        linkothersharedlibs.init{$IFDEF NEWST}(8,4){$ENDIF};
        uses_imports:=false;
        do_assemble:=false;
        do_compile:=false;
        { sources_avail:=true;
        should not be changed PM }
        compiled:=false;
        in_implementation:=false;
        in_global:=true;
        {loaded_from:=nil;
        should not be changed PFV }
        flags:=0;
        crc:=0;
        interface_crc:=0;
        unitcount:=1;
        recompile_reason:=rr_unknown;
      end;


    constructor tmodule.init(const s:string;_is_unit:boolean);
      var
        p : dirstr;
        n : namestr;
        e : extstr;
      begin
        FSplit(s,p,n,e);
      { Programs have the name program to don't conflict with dup id's }
        if _is_unit then
{$ifdef UNITALIASES}
          modulename:=stringdup(GetUnitAlias(Upper(n)))
{$else}
          modulename:=stringdup(Upper(n))
{$endif}
        else
          modulename:=stringdup('PROGRAM');
        mainsource:=stringdup(s);
        ppufilename:=nil;
        objfilename:=nil;
        asmfilename:=nil;
        staticlibfilename:=nil;
        sharedlibfilename:=nil;
        exefilename:=nil;
        { Dos has the famous 8.3 limit :( }
{$ifdef SHORTASMPREFIX}
        asmprefix:=stringdup(FixFileName('as'));
{$else}
        asmprefix:=stringdup(FixFileName(n));
{$endif}
        outputpath:=nil;
        path:=nil;
        setfilename(p+n,true);
        localunitsearchpath.init;
        localobjectsearchpath.init;
        localincludesearchpath.init;
        locallibrarysearchpath.init;
        used_units.init;
        dependent_units.init;
        new(sourcefiles,init);
        resourcefiles.init;
        linkunitofiles.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkunitstaticlibs.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkunitsharedlibs.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkotherofiles.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkotherstaticlibs.init{$IFDEF NEWST}(8,4){$ENDIF};
        linkothersharedlibs.init{$IFDEF NEWST}(8,4){$ENDIF};
        ppufile:=nil;
        scanner:=nil;
        map:=nil;
        globalsymtable:=nil;
        localsymtable:=nil;
        loaded_from:=nil;
        flags:=0;
        crc:=0;
        interface_crc:=0;
        do_reload:=false;
        unitcount:=1;
        inc(global_unit_count);
        unit_index:=global_unit_count;
        do_assemble:=false;
        do_compile:=false;
        sources_avail:=true;
        sources_checked:=false;
        compiled:=false;
        recompile_reason:=rr_unknown;
        in_second_load:=false;
        in_compile:=false;
        in_second_compile:=false;
        in_implementation:=false;
        in_global:=true;
        is_unit:=_is_unit;
        islibrary:=false;
        uses_imports:=false;
        imports:=new(plinkedlist,init);
        _exports:=new(plinkedlist,init);
      { search the PPU file if it is an unit }
        if is_unit then
         begin
           search_unit(modulename^,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 tmodule.done;
{$ifdef MEMDEBUG}
      var
        d : tmemdebug;
{$endif}
      begin
        if assigned(map) then
         dispose(map);
        if assigned(ppufile) then
         dispose(ppufile,done);
        ppufile:=nil;
        if assigned(imports) then
         dispose(imports,done);
        imports:=nil;
        if assigned(_exports) then
         dispose(_exports,done);
        _exports:=nil;
        if assigned(scanner) then
          pscannerfile(scanner)^.invalid:=true;
        if assigned(sourcefiles) then
         dispose(sourcefiles,done);
        sourcefiles:=nil;
        used_units.done;
        dependent_units.done;
        resourcefiles.done;
        linkunitofiles.done;
        linkunitstaticlibs.done;
        linkunitsharedlibs.done;
        linkotherofiles.done;
        linkotherstaticlibs.done;
        linkothersharedlibs.done;
        stringdispose(objfilename);
        stringdispose(asmfilename);
        stringdispose(ppufilename);
        stringdispose(staticlibfilename);
        stringdispose(sharedlibfilename);
        stringdispose(exefilename);
        stringdispose(outputpath);
        stringdispose(path);
        stringdispose(modulename);
        stringdispose(mainsource);
        stringdispose(asmprefix);
        localunitsearchpath.done;
        localobjectsearchpath.done;
        localincludesearchpath.done;
        locallibrarysearchpath.done;
{$ifdef MEMDEBUG}
        d.init('symtable');
{$endif}
        if assigned(globalsymtable) then
          dispose(punitsymtable(globalsymtable),done);
        globalsymtable:=nil;
        if assigned(localsymtable) then
          dispose(punitsymtable(localsymtable),done);
        localsymtable:=nil;
{$ifdef MEMDEBUG}
        d.done;
{$endif}
        inherited done;
      end;


{****************************************************************************
                              TUSED_UNIT
 ****************************************************************************}

    constructor tused_unit.init(_u : pmodule;intface:boolean);
      begin
        u:=_u;
        in_interface:=intface;
        in_uses:=false;
        is_stab_written:=false;
        loaded:=true;
        name:=stringdup(_u^.modulename^);
        checksum:=_u^.crc;
        interface_checksum:=_u^.interface_crc;
        unitid:=0;
      end;


    constructor tused_unit.init_to_load(const n:string;c,intfc:longint;intface:boolean);
      begin
        u:=nil;
        in_interface:=intface;
        in_uses:=false;
        is_stab_written:=false;
        loaded:=false;
        name:=stringdup(n);
        checksum:=c;
        interface_checksum:=intfc;
        unitid:=0;
      end;


    destructor tused_unit.done;
      begin
        stringdispose(name);
        inherited done;
      end;


{****************************************************************************
                            TDENPENDENT_UNIT
 ****************************************************************************}

    constructor tdependent_unit.init(_u : pmodule);
      begin
         u:=_u;
      end;

end.
{
  $Log$
  Revision 1.3  2000-08-12 15:30:44  peter
    * IDE patch for stream reading (merged)

  Revision 1.2  2000/07/13 11:32:41  michael
  + removed logs

}