AmigActive 2/AACD 2.iso/AACD/Programming/fpc/compiler/files.pas

Pascal/Delphi Source File | 1998-09-24 | 26.6 KB | 894 lines

{
    $Id: files.pas,v 1.1.1.1 1998/03/25 11:18:12 root Exp $
    Copyright (c) 1996-98 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;

  interface

    uses
       cobjects,globals;

    const
{$ifdef FPC}
       maxunits = 1024;
{$else}
       maxunits = 128;
{$endif}

    type
       pextfile = ^textfile;

       { this isn't a text file, this is t-ext-file }
       { which means a extended file                }
       { this files can be handled by a file        }
       { manager                                    }
       textfile = object(tbufferedfile)
          path,name,ext : pstring;
          { this is because there is a name conflict }
          { with the older next from tinputstack     }
          _next : pextfile;
          { 65000 input files for a unit should be enough !! }
          ref_index : word;

          { p must be the complete path (with ending \ (or / for unix ...) }
          constructor init(const p,n,e : string);
          destructor done;virtual;
       end;

       pinputfile = ^tinputfile;

       tinputfile = object(textfile)
          filenotatend : boolean;
          line_no : longint;
          { second counter for unimportant tokens }
          line_count : longint;
          { next input file in the stack of input files }
          next : pinputfile;
          { to handle the browser refs }
          ref_count : longint;

          constructor init(const p,n,e : string);
          { writes the file name and line number to t }
          procedure write_file_line(var t : text);
          function get_file_line : string;
       end;

       pfilemanager = ^tfilemanager;

       tfilemanager = object
          files : pextfile;
          last_ref_index : word;
          constructor init;
          destructor done;
          procedure close_all;
          procedure register_file(f : pextfile);
       end;

       pimported_procedure = ^timported_procedure;

       timported_procedure = object(tlinkedlist_item)
          ordnr : word;
          name,func : pstring;
          { should be plabel, but this gaves problems with circular units }
          lab : pointer;
          constructor init(const n,s : string;o : word);
          destructor done;virtual;
       end;

       pimportlist = ^timportlist;

       timportlist = object(tlinkedlist_item)
          dllname : pstring;
          imported_procedures : plinkedlist;
          constructor init(const n : string);
          destructor done;virtual;
       end;

    type
       pmodule = ^tmodule;
       pused_unit = ^tused_unit;

       tused_unit = object(tlinkedlist_item)
          u : pmodule;
          in_uses, in_interface, is_stab_written : boolean;
          unitid : word;
          constructor init(_u : pmodule;f : byte);
          destructor done;virtual;
       end;

       tunitmap = array[0..maxunits-1] of pointer;
       punitmap = ^tunitmap;

       tmodule = object(tlinkedlist_item)

          { the PPU file }
          ppufile : pextfile;
          { used for global switches - in_main section after uses clause }
          { then TRUE else false.                                        }
          in_main : boolean;
          { mapping of all used units }
          map : punitmap;
          { local unit counter }
          unitcount : word;
          { this is a pointer because symtable uses this unit }
          { it should be psymtable                            }
          symtable : pointer;

          { PPU version, handle different versions }
          ppuversion : longint;

          { check sum written to the file }
          crc : longint;

          { flags }
          flags : byte;

          {Set if the module imports from DLL's.}
          uses_imports:boolean;

          imports : plinkedlist;

          { how to write this file }
          output_format : tof;

          { for interpenetrated units }
          in_implementation,
          compiled,
          do_assemble,
          do_compile,              { true, if it's needed to compile the sources }
          sources_avail : boolean; { true, if all sources are reachable }

          { only used, if the module is compiled by this compiler call }
          sourcefiles : tfilemanager;
          linklibfiles,
          linkofiles  : tstringcontainer;
          used_units  : tlinkedlist;
          current_inputfile : pinputfile;

          unitname,               { name of the (unit) module }
          objfilename,            { fullname of the objectfile }
          asmfilename,            { fullname of the assemblerfile }
          ppufilename,            { fullname of the ppufile }
          mainsource   : pstring; { name of the main sourcefile }

          constructor init(const s:string;is_unit:boolean);
          { this is to be called only when compiling again }
          destructor special_done;virtual;

          function load_ppu(const unit_path,n,ext : string):boolean;
          procedure search_unit(const n : string);
       end;

    const
       main_module : pmodule = nil;
       current_module : pmodule = nil;

    var
       loaded_units : tlinkedlist;

    type
       tunitheader = array[0..19] of char;

    const
                                   {                compiler version }
                                   {             format      |       }
                                   { signature    |          |       }
                                   {  |           |          |       }
                                   { /-------\   /-------\  /----\   }
       unitheader : tunitheader  = ('P','P','U','0','1','3',#0,#99,
                                     #0,#0,#0,#0,#0,#0,#255,#255,
                                   { |   | \---------/ \-------/    }
                                   { |   |    |             |        }
                                   { |   |    check sum     |        }
                                   { |   \--flags        unused      }
                                   { target system                   }
                                    #0,#0,#0,#0);
                                   {\---------/                      }
                                   {  |                              }
                                   {  start of machine language      }

    const
       ibloadunit = 1;
       iborddef = 2;
       ibpointerdef = 3;
       ibtypesym = 4;
       ibarraydef = 5;
       ibprocdef = 6;
       ibprocsym = 7;
       iblinkofile = 8;
       ibstringdef = 9;
       ibvarsym = 10;
       ibconstsym = 11;
       ibinitunit = 12;
       ibaufzaehlsym = 13;
       ibtypedconstsym = 14;
       ibrecorddef = 15;
       ibfiledef = 16;
       ibformaldef = 17;
       ibobjectdef = 18;
       ibenumdef = 19;
       ibsetdef = 20;
       ibprocvardef = 21;
       ibsourcefile = 22;
       ibdbxcount = 23;
       ibfloatdef = 24;
       ibref = 25;
       ibextsymref = 26;
       ibextdefref = 27;
       ibabsolutesym = 28;
       ibclassrefdef = 29;
       ibpropertysym = 30;
       iblibraries = 31;
       iblongstringdef = 32;
       ibansistringdef = 33;
       ibend = 255;

       { unit flags }
       uf_init = 1;
       uf_uses_dbx = 2;
       uf_uses_browser = 4;
       uf_in_library = 8;
       uf_shared_library = 16;
       uf_big_endian = 32;

  implementation

  uses
    dos,verbose,systems;


{****************************************************************************
                                  TFILE
 ****************************************************************************}

    constructor textfile.init(const p,n,e : string);

      begin
{$ifdef FPC}
         inherited init(p+n+e,65536);
{$else}
         inherited init(p+n+e,10000);
{$endif}
         path:=stringdup(p);
         name:=stringdup(n);
         ext:=stringdup(e);
      end;

    destructor textfile.done;

      begin
         inherited done;
      end;

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

    constructor tinputfile.init(const p,n,e : string);

      begin
         inherited init(p,n,e);
         filenotatend:=true;
         line_no:=1;
         line_count:=0;
         next:=nil;
      end;

    procedure tinputfile.write_file_line(var t : text);

      begin
         write(t,get_file_line);
      end;

    function tinputfile.get_file_line : string;

      begin
{$ifdef USE_RHIDE}
        get_file_line:=lowercase(name^+ext^)+':'+tostr(line_no)+':'
{$else  USE_RHIDE}
        get_file_line:=name^+ext^+'('+tostr(line_no)+')'
{$endif USE_RHIDE}
      end;

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

    constructor tfilemanager.init;

      begin
         files:=nil;
         last_ref_index:=0;
      end;

    destructor tfilemanager.done;

      var
         hp : pextfile;

      begin
         hp:=files;
         while assigned(hp) do
           begin
              files:=files^._next;
              dispose(hp,done);
              hp:=files;
           end;
      end;

    procedure tfilemanager.close_all;

      begin
      end;

    procedure tfilemanager.register_file(f : pextfile);

      begin
         inc(last_ref_index);
         f^._next:=files;
         f^.ref_index:=last_ref_index;
         files:=f;
      end;

{****************************************************************************
                           Imports stuff
 ****************************************************************************}


    constructor timported_procedure.init(const n,s : string;o : word);

      begin
         inherited init;
         func:=stringdup(n);
         name:=stringdup(s);
         ordnr:=o;
         lab:=nil;
      end;

    destructor timported_procedure.done;

      begin
         stringdispose(name);
         inherited done;
      end;

    constructor timportlist.init(const n : string);

      begin
         inherited init;
         dllname:=stringdup(n);
         imported_procedures:=new(plinkedlist,init);
      end;

    destructor timportlist.done;

      begin
         dispose(imported_procedures,done);
         stringdispose(dllname);
      end;

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

{$I-}

    function tmodule.load_ppu(const unit_path,n,ext : string):boolean;
    var
         header  : tunitheader;
         count   : longint;
         temp,hs : string;
         b       : byte;
         code    : word;
         objfiletime,
         ppufiletime,
         asmfiletime,
         source_time : longint;
{$ifdef UseBrowser}
         hp : pextfile;
         _d : dirstr;
         _n : namestr;
         _e : extstr;
{$endif UseBrowser}

    begin
      load_ppu:=false;

      Message1(unit_u_ppu_loading,ppufilename^);
      ppufile:=new(pextfile,init(unit_path,n,ext));
      ppufile^.reset;
      ppufile^.flush;

      {Get ppufile time}
      ppufiletime:=getnamedfiletime(ppufilename^);
      Message1(unit_d_ppu_time,filetimestring(ppufiletime));

      { load the header }
      ppufile^.read_data(header,sizeof(header),count);
      if count<>sizeof(header) then
       begin
         ppufile^.done;
         Message(unit_d_ppu_file_too_short);
         exit;
       end;

      { check for a valid PPU file }
      if (header[0]<>'P') or (header[1]<>'P') or (header[2]<>'U') then
       begin
         ppufile^.done;
         Message(unit_d_ppu_invalid_header);
         exit;
       end;

      { load ppu version }
      val(header[3]+header[4]+header[5],ppuversion,code);
      if ppuversion<>13 then
       begin
         ppufile^.done;
         Message1(unit_d_ppu_invalid_version,tostr(ppuversion));
         exit;
       end;

      flags:=byte(header[9]);
      Message1(unit_d_ppu_flags,tostr(flags));

      crc:=plongint(@header[10])^;
      Message1(unit_d_ppu_crc,tostr(crc));

    { search source files there is at least one source file }
      do_compile:=false;
      sources_avail:=true;
      ppufile^.read_data(b,1,count);
      while b<>ibend do
       begin
         ppufile^.read_data(hs[0],1,count);
         ppufile^.read_data(hs[1],ord(hs[0]),count);
         if (flags and uf_in_library)<>0 then
          begin
            sources_avail:=false;
            temp:=' library';
          end
         else
          begin
            { check the date of the source files }
            Source_Time:=GetNamedFileTime(unit_path+hs);
            if Source_Time=-1 then
             begin
               sources_avail:=false;
               temp:=' not found';
             end
            else
             begin
               temp:=' time '+filetimestring(source_time);
               if (source_time>ppufiletime) then
                begin
                  do_compile:=true;
                  temp:=temp+' *'
                end;
             end;
          end;
         Message1(unit_t_ppu_source,unit_path+hs+temp);
{$ifdef UseBrowser}
         fsplit(unit_path+hs,_d,_n,_e);
         new(hp,init(_d,_n,_e));
         { the indexing should match what is done in writeasunit }
         sourcefiles.register_file(hp);
{$endif UseBrowser}
         ppufile^.read_data(b,1,count);
       end;
    { main source is always the last }
      stringdispose(mainsource);
      mainsource:=stringdup(ppufile^.path^+hs);

    { check the object and assembler file if not a library }
      if (flags and uf_in_library)=0 then
       begin
       { the objectfile should be newer than the ppu file }
         objfiletime:=getnamedfiletime(objfilename^);
         if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
          begin
          { check if assembler file is older than ppu file }
            asmfileTime:=GetNamedFileTime(asmfilename^);
            if (asmfiletime<0) or (ppufiletime>asmfiletime) then
             begin
               Message(unit_d_obj_and_asm_are_older_than_ppu);
               do_compile:=true;
             end
            else
             begin
               Message(unit_d_obj_is_older_than_asm);
               do_assemble:=true;
             end;
          end;
       end;
      load_ppu:=true;
    end;

    procedure tmodule.search_unit(const n : string);
      var
         ext       : string[8];
         singlepathstring,
         Path,
         filename  : string;
         found     : boolean;
         start,pos : longint;

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

         Procedure SetFileNames;
         begin
           stringdispose(mainsource);
           stringdispose(objfilename);
           stringdispose(asmfilename);
           stringdispose(ppufilename);
           mainsource:=stringdup(SinglePathString+FileName+ext);
           objfilename:=stringdup(SinglePathString+FileName+target_info.objext);
           asmfilename:=stringdup(SinglePathString+FileName+target_info.asmext);
           ppufilename:=stringdup(SinglePathString+FileName+target_info.unitext);
         end;


       begin
         start:=1;
         filename:=FixFileName(n);
         path:=UnitSearchPath;
         Found:=false;
         repeat
         {Create current path to check}
           pos:=system.pos(';',path);
           if pos=0 then
            pos:=length(path)+1;
           singlepathstring:=FixPath(copy(path,start,pos-start));
           delete(path,start,pos-start+1);
         { Check for PPL file }
           if not (cs_link_static in aktswitches) then
            begin
              Found:=UnitExists(target_info.libext);
              if Found then
               Begin
                 SetFileNames;
                 Found:=Load_PPU(singlepathstring,filename,target_info.libext);
               End;

             end;
         { Check for PPU file }
           if not (cs_link_dynamic in aktswitches) and not Found then
            begin
              Found:=UnitExists(target_info.unitext);
              if Found then
               Begin
                 SetFileNames;
                 Found:=Load_PPU(singlepathstring,filename,target_info.unitext);
               End;

            end;
         { Check for Sources }
           if not Found then
            begin
              ppufile:=nil;
              do_compile:=true;
            {Check for .pp file}
              Found:=UnitExists(target_info.sourceext);
              if Found then
               Ext:=target_info.sourceext
              else
               begin
               {Check for .pas}
                 Found:=UnitExists(target_info.pasext);
                 if Found then
                  Ext:=target_info.pasext;
               end;
              if Found then
               begin
                 sources_avail:=true;
               {Load Filenames when found}
                 SetFilenames;
               end
              else
               begin
                 sources_avail:=false;
                 stringdispose(mainsource);
               end;
            end;
         until Found or (path='');
      end;

    constructor tmodule.init(const s:string;is_unit:boolean);
      var
        p:dirstr;
        n:namestr;
        e:extstr;
      begin
         FSplit(s,p,n,e);
         n:=Upper(n);
         unitname:=stringdup(n);
         objfilename:=nil;
         asmfilename:=nil;
         ppufilename:=nil;
         mainsource:=stringdup(s);
         used_units.init;
         sourcefiles.init;
         linkofiles.init;
         linklibfiles.init;
         ppufile:=nil;
         current_inputfile:=nil;
         map:=nil;
         symtable:=nil;
         flags:=0;
         unitcount:=1;
         do_assemble:=false;
         do_compile:=false;
         sources_avail:=true;
         compiled:=false;
         in_implementation:=false;
         in_main:=false;
         uses_imports:=false;
         imports:=new(plinkedlist,init);
         output_format:=commandline_output_format;
       { search the PPU file if it is an unit }
         if is_unit then
          search_unit(unitname^);
      end;

    destructor tmodule.special_done;

      begin
         if assigned(map) then dispose(map);
         { cannot remove that because it is linked
         in the global chain of used_objects
         used_units.done; }
         sourcefiles.done;
         linkofiles.done;
         linklibfiles.done;
         if assigned(ppufile) then
          dispose(ppufile,done);
         if assigned(imports) then
           dispose(imports,done);
         inherited done;
      end;

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


    constructor tused_unit.init(_u : pmodule;f : byte);

      begin
         u:=_u;
         in_interface:=false;
         in_uses:=false;
         is_stab_written:=false;
         unitid:=f;
      end;

    destructor tused_unit.done;

      begin
         inherited done;
      end;
{$I+}

end.
{
  $Log: files.pas,v $
  Revision 1.1.1.1  1998/03/25 11:18:12  root
  * Restored version

  Revision 1.37  1998/03/13 22:45:58  florian
    * small bug fixes applied

  Revision 1.36  1998/03/11 22:22:52  florian
    * Fixed circular unit uses, when the units are not in the current dir (from Peter)
    * -i shows correct info, not <lf> anymore (from Peter)
    * linking with shared libs works again (from Peter)

  Revision 1.35  1998/03/10 16:27:38  pierre
    * better line info in stabs debug
    * symtabletype and lexlevel separated into two fields of tsymtable
    + ifdef MAKELIB for direct library output, not complete
    + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
      working
    + ifdef TESTFUNCRET for setting func result in underfunction, not
      working

  Revision 1.34  1998/03/10 01:17:18  peter
    * all files have the same header
    * messages are fully implemented, EXTDEBUG uses Comment()
    + AG... files for the Assembler generation

  Revision 1.33  1998/03/04 17:33:44  michael
  + Changed ifdef FPK to ifdef FPC

  Revision 1.32  1998/03/04 01:35:03  peter
    * messages for unit-handling and assembler/linker
    * the compiler compiles without -dGDB, but doesn't work yet
    + -vh for Hint

  Revision 1.31  1998/02/28 14:43:47  florian
    * final implemenation of win32 imports
    * extended tai_align to allow 8 and 16 byte aligns

  Revision 1.30  1998/02/28 09:30:57  florian
    + writing of win32 import section added

  Revision 1.29  1998/02/28 00:20:23  florian
    * more changes to get import libs for Win32 working

  Revision 1.28  1998/02/26 11:57:06  daniel
  * New assembler optimizations commented out, because of bugs.
  * Use of dir-/name- and extstr.

  Revision 1.27  1998/02/24 14:20:51  peter
    + tstringcontainer.empty
    * ld -T option restored for linux
    * libraries are placed before the objectfiles in a .PPU file
    * removed 'uses link' from files.pas

  Revision 1.26  1998/02/24 10:29:13  peter
    * -a works again

  Revision 1.25  1998/02/24 00:19:09  peter
    * makefile works again (btw. linux does like any char after a \ )
    * removed circular unit with assemble and files
    * fixed a sigsegv in pexpr
    * pmodule init unit/program is the almost the same, merged them

  Revision 1.24  1998/02/22 23:03:17  peter
    * renamed msource->mainsource and name->unitname
    * optimized filename handling, filename is not seperate anymore with
      path+name+ext, this saves stackspace and a lot of fsplit()'s
    * recompiling of some units in libraries fixed
    * shared libraries are working again
    + $LINKLIB <lib> to support automatic linking to libraries
    + libraries are saved/read from the ppufile, also allows more libraries
      per ppufile

  Revision 1.23  1998/02/17 21:20:48  peter
    + Script unit
    + __EXIT is called again to exit a program
    - target_info.link/assembler calls
    * linking works again for dos
    * optimized a few filehandling functions
    * fixed stabs generation for procedures

  Revision 1.22  1998/02/16 12:51:30  michael
  + Implemented linker object

  Revision 1.21  1998/02/13 10:34:58  daniel
  * Made Motorola version compilable.
  * Fixed optimizer

  Revision 1.20  1998/02/12 11:50:04  daniel
  Yes! Finally! After three retries, my patch!

  Changes:

  Complete rewrite of psub.pas.
  Added support for DLL's.
  Compiler requires less memory.
  Platform units for each platform.

  Revision 1.19  1998/02/06 23:08:33  florian
    + endian to targetinfo and sourceinfo added
    + endian independed writing of ppu file (reading missed), a PPU file
      is written with the target endian

  Revision 1.18  1998/02/02 13:13:27  pierre
    * line_count transfered to tinputfile, to avoid crosscounting

  Revision 1.17  1998/01/30 17:31:20  pierre
    * bug of cyclic symtablestack fixed

  Revision 1.16  1998/01/26 18:51:18  peter
    * ForceSlash() changed to FixPath() which also removes a trailing './'

  Revision 1.15  1998/01/23 17:12:11  pierre
    * added some improvements for as and ld :
      - doserror and dosexitcode treated separately
      - PATH searched if doserror=2
    + start of long and ansi string (far from complete)
      in conditionnal UseLongString and UseAnsiString
    * options.pas cleaned (some variables shifted to globals)gl

  Revision 1.14  1998/01/22 08:57:54  peter
    + added target_info.pasext and target_info.libext

  Revision 1.13  1998/01/21 00:11:35  peter
    * files in a ppl will now not recompile
    * better info about source files of a ppu, a * after the time will
      indicate that the file is changed

  Revision 1.12  1998/01/20 13:16:29  michael
  + Added flag for static/shared libs.

  Revision 1.11  1998/01/17 01:57:32  michael
  + Start of shared library support. First working version.

  Revision 1.10  1998/01/16 12:52:09  michael
  + Path treatment and file searching should now be more or less in their
    definite form:
    - Using now modified AddPathToList everywhere.
    - File Searching mechanism is uniform for all files.
    - Include path is working now !!
    All fixes by Peter Vreman. Tested with remake3 target.

  Revision 1.9  1998/01/16 00:00:54  michael
  + Better and more modular searching and loading of units.
    - searching in tmodule.search_unit.
    - initial Loading in tmpodule.load_ppu.
    - tmodule.init now calls search_unit.
  * Case sensitivity problem of unix hopefully solved now forever.
    (All from Peter Vreman, checked with remake3)

  Revision 1.8  1998/01/15 13:07:46  michael
  + added library treating stuff

  Revision 1.7  1998/01/15 12:01:19  michael
  * Linux prints now that actual name of the file being loaded.

  Revision 1.6  1998/01/13 23:39:26  michael
  * changed mechanism to look for unit file.
  + added iblibraries constant to implement shared libraries.

  Revision 1.5  1998/01/13 23:05:51  florian
    + unit format 013 (change of options size, see symtable.pas log)

  Revision 1.4  1998/01/13 17:13:06  michael
  * File time handling and file searching is now done in an OS-independent way,
    using the new file treating functions in globals.pas.

  Revision 1.3  1998/01/07 00:16:49  michael
  Restored released version (plus fixes) as current

  Revision 1.2  1997/11/28 18:14:31  pierre
   working version with several bug fixes

  Revision 1.1.1.1  1997/11/27 08:32:56  michael
  FPC Compiler CVS start


  Pre-CVS log:

  CEC  Carl-Eric Codere
  FK   Florian Klaempfl
  +    feature added
  -    removed
  *    bug fixed or changed

  History (started with version 0.9.0):
       2th december 1996:
         + unit started  (FK)
      22th december 1996:
         + tinputfile added  (FK)
      7th september 1997:
         + moved main_module and current_module to const section
           line ~319 and ~416: in_main initialized - added in_main
           field to tmodule object  (CEC)

}