mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 13:39:39 +01:00 
			
		
		
		
	afterwards. This is needed to support uses xxx in yyy correctly * unit dependency check fixed
		
			
				
	
	
		
			758 lines
		
	
	
		
			21 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			758 lines
		
	
	
		
			21 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    $Id$
 | 
						|
    Copyright (c) 1998-2002 by Florian Klaempfl
 | 
						|
 | 
						|
    This unit implements an extended file management
 | 
						|
 | 
						|
    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 finput;
 | 
						|
 | 
						|
{$i fpcdefs.inc}
 | 
						|
 | 
						|
interface
 | 
						|
 | 
						|
    uses
 | 
						|
      cutils,cclasses;
 | 
						|
 | 
						|
    const
 | 
						|
       InputFileBufSize=32*1024;
 | 
						|
       linebufincrease=512;
 | 
						|
 | 
						|
    type
 | 
						|
       tlongintarr = array[0..1000000] of longint;
 | 
						|
       plongintarr = ^tlongintarr;
 | 
						|
 | 
						|
       tinputfile = class
 | 
						|
         path,name : pstring;       { path and filename }
 | 
						|
         next      : tinputfile;    { 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_index  : longint;      { to handle the browser refs }
 | 
						|
         ref_next   : tinputfile;
 | 
						|
 | 
						|
         constructor create(const fn:string);
 | 
						|
         destructor  destroy;override;
 | 
						|
         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;
 | 
						|
         function  getfiletime:longint;
 | 
						|
       protected
 | 
						|
         filetime  : longint;
 | 
						|
         function fileopen(const filename: string): boolean; virtual; abstract;
 | 
						|
         function fileseek(pos: longint): boolean; virtual; abstract;
 | 
						|
         function fileread(var databuf; maxsize: longint): longint; virtual; abstract;
 | 
						|
         function fileeof: boolean; virtual; abstract;
 | 
						|
         function fileclose: boolean; virtual; abstract;
 | 
						|
         procedure filegettime; virtual; abstract;
 | 
						|
       end;
 | 
						|
 | 
						|
       tdosinputfile = class(tinputfile)
 | 
						|
       protected
 | 
						|
         function fileopen(const filename: string): boolean; override;
 | 
						|
         function fileseek(pos: longint): boolean; override;
 | 
						|
         function fileread(var databuf; maxsize: longint): longint; override;
 | 
						|
         function fileeof: boolean; override;
 | 
						|
         function fileclose: boolean; override;
 | 
						|
         procedure filegettime; override;
 | 
						|
       private
 | 
						|
         f            : file;       { current file handle }
 | 
						|
       end;
 | 
						|
 | 
						|
       tinputfilemanager = class
 | 
						|
          files : tinputfile;
 | 
						|
          last_ref_index : longint;
 | 
						|
          cacheindex : longint;
 | 
						|
          cacheinputfile : tinputfile;
 | 
						|
          constructor create;
 | 
						|
          destructor destroy;override;
 | 
						|
          procedure register_file(f : tinputfile);
 | 
						|
          procedure inverse_register_indexes;
 | 
						|
          function  get_file(l:longint) : tinputfile;
 | 
						|
          function  get_file_name(l :longint):string;
 | 
						|
          function  get_file_path(l :longint):string;
 | 
						|
       end;
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                                TModuleBase
 | 
						|
 ****************************************************************************}
 | 
						|
 | 
						|
     type
 | 
						|
        tmodulestate = (ms_unknown,
 | 
						|
          ms_registered,
 | 
						|
          ms_load,ms_compile,
 | 
						|
          ms_second_load,ms_second_compile,
 | 
						|
          ms_compiled
 | 
						|
        );
 | 
						|
     const
 | 
						|
        ModuleStateStr : array[TModuleState] of string[20] = (
 | 
						|
          'Unknown',
 | 
						|
          'Registered',
 | 
						|
          'Load','Compile',
 | 
						|
          'Second_Load','Second_Compile',
 | 
						|
          'Compiled'
 | 
						|
        );
 | 
						|
 | 
						|
     type
 | 
						|
        tmodulebase = class(TLinkedListItem)
 | 
						|
          { index }
 | 
						|
          unit_index    : longint;  { global counter for browser }
 | 
						|
          { status }
 | 
						|
          state         : tmodulestate;
 | 
						|
          { sources }
 | 
						|
          sourcefiles   : tinputfilemanager;
 | 
						|
          { paths and filenames }
 | 
						|
          path,                     { path where the module is find/created }
 | 
						|
          outputpath,               { path where the .s / .o / exe are created }
 | 
						|
          modulename,               { name of the module in uppercase }
 | 
						|
          realmodulename,           { name of the module in the orignal case }
 | 
						|
          objfilename,              { fullname of the objectfile }
 | 
						|
          newfilename,              { fullname of the assemblerfile }
 | 
						|
          ppufilename,              { fullname of the ppufile }
 | 
						|
          staticlibfilename,        { fullname of the static libraryfile }
 | 
						|
          sharedlibfilename,        { fullname of the shared libraryfile }
 | 
						|
          mapfilename,              { fullname of the mapfile }
 | 
						|
          exefilename,              { fullname of the exefile }
 | 
						|
          mainsource   : pstring;   { name of the main sourcefile }
 | 
						|
          constructor create(const s:string);
 | 
						|
          destructor destroy;override;
 | 
						|
          procedure setfilename(const fn:string;allowoutput:boolean);
 | 
						|
          function get_asmfilename : string;
 | 
						|
       end;
 | 
						|
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
uses
 | 
						|
{$ifdef Delphi}
 | 
						|
  dmisc,
 | 
						|
{$else Delphi}
 | 
						|
  dos,
 | 
						|
{$endif Delphi}
 | 
						|
{$ifdef heaptrc}
 | 
						|
  fmodule,
 | 
						|
  ppheap,
 | 
						|
{$endif heaptrc}
 | 
						|
  globals,systems
 | 
						|
  ;
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                                  TINPUTFILE
 | 
						|
 ****************************************************************************}
 | 
						|
 | 
						|
    constructor tinputfile.create(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;
 | 
						|
        filetime:=-1;
 | 
						|
      { 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_index:=0;
 | 
						|
      { line buffer }
 | 
						|
        linebuf:=nil;
 | 
						|
        maxlinebuf:=0;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    destructor tinputfile.destroy;
 | 
						|
      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
 | 
						|
            begin
 | 
						|
              Freemem(buf,maxbufsize);
 | 
						|
              buf:=nil;
 | 
						|
            end;
 | 
						|
           closed:=true;
 | 
						|
           exit;
 | 
						|
         end;
 | 
						|
        if not closed then
 | 
						|
         begin
 | 
						|
           fileclose;
 | 
						|
           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
 | 
						|
           fileclose;
 | 
						|
           if assigned(buf) then
 | 
						|
            begin
 | 
						|
              Freemem(buf,maxbufsize);
 | 
						|
              buf:=nil;
 | 
						|
            end;
 | 
						|
           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);
 | 
						|
           getlinestr[0]:=chr(i);
 | 
						|
         end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    function tinputfile.getfiletime:longint;
 | 
						|
      begin
 | 
						|
        if filetime=-1 then
 | 
						|
         filegettime;
 | 
						|
        getfiletime:=filetime;
 | 
						|
      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,Pos);
 | 
						|
        {$I+}
 | 
						|
        fileseek:=(ioresult=0);
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    function tdosinputfile.fileread(var databuf; maxsize: longint): longint;
 | 
						|
      var
 | 
						|
        w : longint;
 | 
						|
      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;
 | 
						|
 | 
						|
 | 
						|
    procedure tdosinputfile.filegettime;
 | 
						|
      begin
 | 
						|
        filetime:=getnamedfiletime(path^+name^);
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                                Tinputfilemanager
 | 
						|
 ****************************************************************************}
 | 
						|
 | 
						|
    constructor tinputfilemanager.create;
 | 
						|
      begin
 | 
						|
         files:=nil;
 | 
						|
         last_ref_index:=0;
 | 
						|
         cacheindex:=0;
 | 
						|
         cacheinputfile:=nil;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    destructor tinputfilemanager.destroy;
 | 
						|
      var
 | 
						|
         hp : tinputfile;
 | 
						|
      begin
 | 
						|
         hp:=files;
 | 
						|
         while assigned(hp) do
 | 
						|
          begin
 | 
						|
            files:=files.ref_next;
 | 
						|
            hp.free;
 | 
						|
            hp:=files;
 | 
						|
          end;
 | 
						|
         last_ref_index:=0;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure tinputfilemanager.register_file(f : tinputfile);
 | 
						|
      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 heaptrc}
 | 
						|
         ppheap_register_file(f.name^,current_module.unit_index*100000+f.ref_index);
 | 
						|
{$endif heaptrc}
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
   { this procedure is necessary after loading the
 | 
						|
     sources files from a PPU file  PM }
 | 
						|
   procedure tinputfilemanager.inverse_register_indexes;
 | 
						|
     var
 | 
						|
        f : tinputfile;
 | 
						|
     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 tinputfilemanager.get_file(l :longint) : tinputfile;
 | 
						|
     var
 | 
						|
        ff : tinputfile;
 | 
						|
     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 tinputfilemanager.get_file_name(l :longint):string;
 | 
						|
     var
 | 
						|
       hp : tinputfile;
 | 
						|
     begin
 | 
						|
       hp:=get_file(l);
 | 
						|
       if assigned(hp) then
 | 
						|
        get_file_name:=hp.name^
 | 
						|
       else
 | 
						|
        get_file_name:='';
 | 
						|
     end;
 | 
						|
 | 
						|
 | 
						|
   function tinputfilemanager.get_file_path(l :longint):string;
 | 
						|
     var
 | 
						|
       hp : tinputfile;
 | 
						|
     begin
 | 
						|
       hp:=get_file(l);
 | 
						|
       if assigned(hp) then
 | 
						|
        get_file_path:=hp.path^
 | 
						|
       else
 | 
						|
        get_file_path:='';
 | 
						|
     end;
 | 
						|
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                                TModuleBase
 | 
						|
 ****************************************************************************}
 | 
						|
 | 
						|
    procedure tmodulebase.setfilename(const fn:string;allowoutput:boolean);
 | 
						|
      var
 | 
						|
        p : dirstr;
 | 
						|
        n : NameStr;
 | 
						|
        e : ExtStr;
 | 
						|
      begin
 | 
						|
         stringdispose(objfilename);
 | 
						|
         stringdispose(newfilename);
 | 
						|
         stringdispose(ppufilename);
 | 
						|
         stringdispose(staticlibfilename);
 | 
						|
         stringdispose(sharedlibfilename);
 | 
						|
         stringdispose(mapfilename);
 | 
						|
         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);
 | 
						|
         newfilename := stringdup(n);
 | 
						|
         objfilename:=stringdup(p+n+target_info.objext);
 | 
						|
         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_info.staticlibprefix+n+target_info.staticlibext);
 | 
						|
         if target_info.system in [system_i386_WIN32,system_i386_wdosx] then
 | 
						|
           sharedlibfilename:=stringdup(p+n+target_info.sharedlibext)
 | 
						|
         else
 | 
						|
           sharedlibfilename:=stringdup(p+target_info.sharedlibprefix+n+target_info.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);
 | 
						|
         mapfilename:=stringdup(p+n+'.map');
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    constructor tmodulebase.create(const s:string);
 | 
						|
      begin
 | 
						|
        modulename:=stringdup(Upper(s));
 | 
						|
        realmodulename:=stringdup(s);
 | 
						|
        mainsource:=nil;
 | 
						|
        ppufilename:=nil;
 | 
						|
        objfilename:=nil;
 | 
						|
        newfilename:=nil;
 | 
						|
        staticlibfilename:=nil;
 | 
						|
        sharedlibfilename:=nil;
 | 
						|
        exefilename:=nil;
 | 
						|
        mapfilename:=nil;
 | 
						|
        outputpath:=nil;
 | 
						|
        path:=nil;
 | 
						|
        { status }
 | 
						|
        state:=ms_registered;
 | 
						|
        { unit index }
 | 
						|
        inc(global_unit_count);
 | 
						|
        unit_index:=global_unit_count;
 | 
						|
        { sources }
 | 
						|
        sourcefiles:=TInputFileManager.Create;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    function tmodulebase.get_asmfilename : string;
 | 
						|
     begin
 | 
						|
         get_asmfilename:=outputpath^+newfilename^+target_info.asmext;
 | 
						|
     end;
 | 
						|
 | 
						|
    destructor tmodulebase.destroy;
 | 
						|
      begin
 | 
						|
        if assigned(sourcefiles) then
 | 
						|
         sourcefiles.free;
 | 
						|
        sourcefiles:=nil;
 | 
						|
        stringdispose(objfilename);
 | 
						|
        stringdispose(newfilename);
 | 
						|
        stringdispose(ppufilename);
 | 
						|
        stringdispose(staticlibfilename);
 | 
						|
        stringdispose(sharedlibfilename);
 | 
						|
        stringdispose(exefilename);
 | 
						|
        stringdispose(mapfilename);
 | 
						|
        stringdispose(outputpath);
 | 
						|
        stringdispose(path);
 | 
						|
        stringdispose(modulename);
 | 
						|
        stringdispose(realmodulename);
 | 
						|
        stringdispose(mainsource);
 | 
						|
        inherited destroy;
 | 
						|
      end;
 | 
						|
 | 
						|
end.
 | 
						|
{
 | 
						|
  $Log$
 | 
						|
  Revision 1.21  2002-12-29 14:57:50  peter
 | 
						|
    * unit loading changed to first register units and load them
 | 
						|
      afterwards. This is needed to support uses xxx in yyy correctly
 | 
						|
    * unit dependency check fixed
 | 
						|
 | 
						|
  Revision 1.20  2002/11/15 01:58:46  peter
 | 
						|
    * merged changes from 1.0.7 up to 04-11
 | 
						|
      - -V option for generating bug report tracing
 | 
						|
      - more tracing for option parsing
 | 
						|
      - errors for cdecl and high()
 | 
						|
      - win32 import stabs
 | 
						|
      - win32 records<=8 are returned in eax:edx (turned off by default)
 | 
						|
      - heaptrc update
 | 
						|
      - more info for temp management in .s file with EXTDEBUG
 | 
						|
 | 
						|
  Revision 1.19  2002/10/20 14:49:31  peter
 | 
						|
    * store original source time in ppu so it can be compared instead of
 | 
						|
      comparing with the ppu time
 | 
						|
 | 
						|
  Revision 1.18  2002/08/11 13:24:11  peter
 | 
						|
    * saving of asmsymbols in ppu supported
 | 
						|
    * asmsymbollist global is removed and moved into a new class
 | 
						|
      tasmlibrarydata that will hold the info of a .a file which
 | 
						|
      corresponds with a single module. Added librarydata to tmodule
 | 
						|
      to keep the library info stored for the module. In the future the
 | 
						|
      objectfiles will also be stored to the tasmlibrarydata class
 | 
						|
    * all getlabel/newasmsymbol and friends are moved to the new class
 | 
						|
 | 
						|
  Revision 1.17  2002/07/26 21:15:37  florian
 | 
						|
    * rewrote the system handling
 | 
						|
 | 
						|
  Revision 1.16  2002/07/01 18:46:22  peter
 | 
						|
    * internal linker
 | 
						|
    * reorganized aasm layer
 | 
						|
 | 
						|
  Revision 1.15  2002/05/18 13:34:07  peter
 | 
						|
    * readded missing revisions
 | 
						|
 | 
						|
  Revision 1.14  2002/05/16 19:46:36  carl
 | 
						|
  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
 | 
						|
  + try to fix temp allocation (still in ifdef)
 | 
						|
  + generic constructor calls
 | 
						|
  + start of tassembler / tmodulebase class cleanup
 | 
						|
 | 
						|
  Revision 1.13  2002/05/14 19:34:41  peter
 | 
						|
    * removed old logs and updated copyright year
 | 
						|
 | 
						|
  Revision 1.12  2002/04/04 18:34:00  carl
 | 
						|
  + added wdosx support (patch from Pavel)
 | 
						|
 | 
						|
}
 |