12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064 |
- {
- $Id$
- 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
- {$ifdef NEWPPU}
- ,ppu
- {$endif}
- ;
- const
- {$ifdef FPC}
- maxunits = 1024;
- extbufsize = 65535;
- {$else}
- maxunits = 128;
- extbufsize = 2000;
- {$endif}
- type
- { 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 }
- pextfile = ^textfile;
- textfile = object(tbufferedfile)
- path,name,ext : pstring;
- _next : pextfile; { else conflicts with tinputstack }
- ref_index : word; { 65000 input files for a unit should be enough !! }
- { 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; { position to give out }
- true_line : longint; { real line counter }
- column : longint;
- next : pinputfile; { next input file in the stack of input files }
- ref_count : longint; { to handle the browser refs }
- constructor init(const p,n,e : string);
- procedure write_file_line(var t : text); { writes the file name and line number to t }
- 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);
- function get_file(w : word) : pextfile;
- end;
- type
- tunitmap = array[0..maxunits-1] of pointer;
- punitmap = ^tunitmap;
- pmodule = ^tmodule;
- tmodule = object(tlinkedlist_item)
- {$ifdef NEWPPU}
- ppufile : pppufile; { the PPU file }
- {$else}
- ppufile : pextfile; { the PPU file }
- {$endif}
- crc,
- flags : longint; { the PPU flags }
- compiled, { unit is already compiled }
- do_assemble, { only assemble the object, don't recompile }
- do_compile, { need to compile the sources }
- sources_avail, { if all sources are reachable }
- is_unit,
- in_implementation, { processing the implementation part? }
- in_main : boolean; { global, after uses else false }
- map : punitmap; { mapping of all used units }
- unitcount : word; { local unit counter }
- unit_index : word; { global counter for browser }
- symtable : pointer; { pointer to the psymtable of this unit }
- uses_imports : boolean; { Set if the module imports from DLL's.}
- imports : plinkedlist;
- sourcefiles : tfilemanager;
- linksharedlibs,
- linkstaticlibs,
- linkofiles : tstringcontainer;
- used_units : tlinkedlist;
- current_inputfile : pinputfile;
- { used in firstpass for faster settings }
- current_index : word;
- modulename, { name of the module in uppercase }
- objfilename, { fullname of the objectfile }
- asmfilename, { fullname of the assemblerfile }
- ppufilename, { fullname of the ppufile }
- libfilename, { fullname of the libraryfile }
- mainsource : pstring; { name of the main sourcefile }
- constructor init(const s:string;_is_unit:boolean);
- destructor special_done;virtual; { this is to be called only when compiling again }
- procedure setfilename(const path,name:string);
- {$ifdef NEWPPU}
- function openppu(const unit_path:string):boolean;
- {$else}
- function load_ppu(const unit_path,n,ext:string):boolean;
- {$endif}
- function search_unit(const n : string):boolean;
- end;
- 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;
- {$ifndef NEWPPU}
- type
- tunitheader = array[0..19] of char;
- const
- { compiler version }
- { format | }
- { signature | | }
- { | | | }
- { /-------\ /-------\ /----\ }
- unitheader : tunitheader = ('P','P','U','0','1','4',#0,#99,
- #0,#0,#0,#0,#0,#0,#255,#255,
- { | | \---------/ \-------/ }
- { | | | | }
- { | | check sum | }
- { | \--flags unused }
- { target system }
- #0,#0,#0,#0);
- {\---------/ }
- { | }
- { start of machine language }
- ibloadunit = 1;
- iborddef = 2;
- ibpointerdef = 3;
- ibtypesym = 4;
- ibarraydef = 5;
- ibprocdef = 6;
- ibprocsym = 7;
- iblinkofile = 8;
- ibstringdef = 9;
- ibvarsym = 10;
- ibconstsym = 11;
- ibinitunit = 12;
- ibenumsym = 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;
- ibsharedlibs = 31;
- iblongstringdef = 32;
- ibansistringdef = 33;
- ibunitname = 34;
- ibwidestringdef = 35;
- ibstaticlibs = 36;
- ibvarsym_C = 37;
- ibend = 255;
- { unit flags }
- uf_init = $1;
- uf_has_dbx = $2;
- uf_has_browser = $4;
- uf_in_library = $8;
- uf_shared_library = $10;
- uf_big_endian = $20;
- uf_smartlink = $40;
- {$endif}
- var
- main_module : pmodule;
- current_module : pmodule;
- global_unit_count : word;
- loaded_units : tlinkedlist;
- implementation
- uses
- dos,verbose,systems;
- {****************************************************************************
- TFILE
- ****************************************************************************}
- constructor textfile.init(const p,n,e : string);
- begin
- inherited init(p+n+e,extbufsize);
- 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;
- true_line:=1;
- column:=1;
- 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
- if Use_Rhide then
- get_file_line:=lower(bstoslash(path^)+name^+ext^)+':'+tostr(line_no)+':'
- else
- get_file_line:=name^+ext^+'('+tostr(line_no)+')'
- 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;
- last_ref_index:=0;
- end;
- procedure tfilemanager.close_all;
- var
- hp : pextfile;
- begin
- hp:=files;
- while assigned(hp) do
- begin
- hp^.close;
- hp:=hp^._next;
- end;
- end;
- procedure tfilemanager.register_file(f : pextfile);
- begin
- inc(last_ref_index);
- f^._next:=files;
- f^.ref_index:=last_ref_index;
- files:=f;
- end;
- function tfilemanager.get_file(w : word) : pextfile;
- var
- ff : pextfile;
- begin
- ff:=files;
- while assigned(ff) and (ff^.ref_index<>w) do
- ff:=ff^._next;
- get_file:=ff;
- end;
- {****************************************************************************
- TMODULE
- ****************************************************************************}
- procedure tmodule.setfilename(const path,name:string);
- var
- s : string;
- begin
- stringdispose(objfilename);
- stringdispose(asmfilename);
- stringdispose(ppufilename);
- stringdispose(libfilename);
- s:=FixFileName(FixPath(path)+name);
- objfilename:=stringdup(s+target_info.objext);
- asmfilename:=stringdup(s+target_info.asmext);
- ppufilename:=stringdup(s+target_info.unitext);
- libfilename:=stringdup(s+target_os.staticlibext);
- end;
- {$ifdef NEWPPU}
- function tmodule.openppu(const unit_path:string):boolean;
- var
- temp,hs : string;
- b : byte;
- incfile_found : boolean;
- objfiletime,
- ppufiletime,
- asmfiletime,
- source_time : longint;
- {$ifdef UseBrowser}
- hp : pextfile;
- _d : dirstr;
- _n : namestr;
- _e : extstr;
- {$endif UseBrowser}
- begin
- openppu:=false;
- { Get ppufile time (also check if the file exists) }
- ppufiletime:=getnamedfiletime(ppufilename^);
- if ppufiletime=-1 then
- exit;
- Message1(unit_u_ppu_loading,ppufilename^);
- ppufile:=new(pppufile,init(ppufilename^));
- if not ppufile^.open then
- begin
- dispose(ppufile,done);
- Message(unit_d_ppu_file_too_short);
- exit;
- end;
- { check for a valid PPU file }
- if not ppufile^.CheckPPUId then
- begin
- dispose(ppufile,done);
- Message(unit_d_ppu_invalid_header);
- exit;
- end;
- { check for allowed PPU versions }
- if not (ppufile^.GetPPUVersion in [15]) then
- begin
- dispose(ppufile,done);
- Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
- exit;
- end;
- { Load values to be access easier }
- flags:=ppufile^.header.flags;
- crc:=ppufile^.header.checksum;
- { Show Debug info }
- Message1(unit_d_ppu_time,filetimestring(ppufiletime));
- Message1(unit_d_ppu_flags,tostr(flags));
- Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
- { Unitname }
- b:=ppufile^.readentry;
- if b=ibmodulename then
- begin
- stringdispose(modulename);
- modulename:=stringdup(ppufile^.getstring);
- b:=ppufile^.readentry;
- end;
- { search source files there is at least one source file }
- do_compile:=false;
- sources_avail:=true;
- if b=ibsourcefiles then
- begin
- while not ppufile^.endofentry do
- begin
- hs:=ppufile^.getstring;
- temp:='';
- if (flags and uf_in_library)<>0 then
- begin
- sources_avail:=false;
- temp:=' library';
- end
- else if pos('Macro ',hs)=1 then
- begin
- { we don't want to find this file }
- { but there is a problem with file indexing !! }
- temp:='';
- end
- else
- begin
- { check the date of the source files }
- Source_Time:=GetNamedFileTime(unit_path+hs);
- if Source_Time=-1 then
- begin
- { search for include files in the includepathlist }
- if b<>ibend then
- begin
- temp:=search(hs,includesearchpath,incfile_found);
- if incfile_found then
- begin
- hs:=temp+hs;
- Source_Time:=GetNamedFileTime(hs);
- end;
- end;
- end
- else
- hs:=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,hs+temp);
- {$ifdef UseBrowser}
- fsplit(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}
- end;
- end;
- { main source is always the last }
- stringdispose(mainsource);
- mainsource:=stringdup(hs);
- { check the object and assembler file if not a library }
- if (flags and uf_in_library)=0 then
- begin
- if (flags and uf_smartlink)<>0 then
- begin
- objfiletime:=getnamedfiletime(libfilename^);
- if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
- do_compile:=true;
- end
- else
- 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;
- end;
- openppu:=true;
- end;
- function tmodule.search_unit(const n : string):boolean;
- var
- ext : string[8];
- singlepathstring,
- Path,
- filename : string;
- found : boolean;
- start,i : longint;
- Function UnitExists(const ext:string):boolean;
- begin
- Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
- UnitExists:=FileExists(Singlepathstring+FileName+ext);
- end;
- begin
- start:=1;
- filename:=FixFileName(n);
- path:=UnitSearchPath;
- Found:=false;
- repeat
- { Create current path to check }
- i:=pos(';',path);
- if i=0 then
- i:=length(path)+1;
- singlepathstring:=FixPath(copy(path,start,i-start));
- delete(path,start,i-start+1);
- { Check for PPL file }
- if not (cs_link_static in aktswitches) then
- begin
- Found:=UnitExists(target_info.unitlibext);
- if Found then
- Begin
- SetFileName(SinglePathString,FileName);
- Found:=OpenPPU(singlepathstring);
- 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
- SetFileName(SinglePathString,FileName);
- Found:=OpenPPU(singlepathstring);
- End;
- end;
- { Check for Sources }
- if not Found then
- begin
- ppufile:=nil;
- do_compile:=true;
- {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);
- end
- else
- sources_avail:=false;
- end;
- until Found or (path='');
- search_unit:=Found;
- end;
- {$else NEWPPU}
- function tmodule.load_ppu(const unit_path,n,ext : string):boolean;
- var
- header : tunitheader;
- count : longint;
- temp,hs : string;
- b : byte;
- incfile_found : boolean;
- code : word;
- ppuversion,
- objfiletime,
- ppufiletime,
- asmfiletime,
- source_time : longint;
- {$ifdef UseBrowser}
- hp : pextfile;
- _d : dirstr;
- _n : namestr;
- _e : extstr;
- {$endif UseBrowser}
- begin
- load_ppu:=false;
- { Get ppufile time (also check if the file exists) }
- ppufiletime:=getnamedfiletime(ppufilename^);
- if ppufiletime=-1 then
- exit;
- Message1(unit_u_ppu_loading,ppufilename^);
- ppufile:=new(pextfile,init(unit_path,n,ext));
- ppufile^.reset;
- ppufile^.flush;
- { 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 not(ppuversion in [13..14]) then
- begin
- ppufile^.done;
- Message1(unit_d_ppu_invalid_version,tostr(ppuversion));
- exit;
- end;
- flags:=byte(header[9]);
- crc:=plongint(@header[10])^;
- {Get ppufile time}
- ppufiletime:=getnamedfiletime(ppufilename^);
- {Show Debug info}
- Message1(unit_d_ppu_time,filetimestring(ppufiletime));
- Message1(unit_d_ppu_flags,tostr(flags));
- Message1(unit_d_ppu_crc,tostr(crc));
- { read name if its there }
- ppufile^.read_data(b,1,count);
- if b=ibunitname then
- begin
- ppufile^.read_data(hs[0],1,count);
- ppufile^.read_data(hs[1],ord(hs[0]),count);
- stringdispose(modulename);
- modulename:=stringdup(hs);
- ppufile^.read_data(b,1,count);
- end;
- { search source files there is at least one source file }
- do_compile:=false;
- sources_avail:=true;
- while b<>ibend do
- begin
- ppufile^.read_data(hs[0],1,count);
- ppufile^.read_data(hs[1],ord(hs[0]),count);
- ppufile^.read_data(b,1,count);
- temp:='';
- 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
- { search for include files in the includepathlist }
- if b<>ibend then
- begin
- temp:=search(hs,includesearchpath,incfile_found);
- if incfile_found then
- begin
- hs:=temp+hs;
- Source_Time:=GetNamedFileTime(hs);
- end;
- end;
- end
- else
- hs:=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,hs+temp);
- {$ifdef UseBrowser}
- fsplit(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}
- end;
- { main source is always the last }
- stringdispose(mainsource);
- mainsource:=stringdup(hs);
- { check the object and assembler file if not a library }
- if (flags and uf_smartlink)<>0 then
- begin
- objfiletime:=getnamedfiletime(libfilename^);
- if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
- do_compile:=true;
- end
- else
- begin
- 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;
- end;
- load_ppu:=true;
- end;
- function tmodule.search_unit(const n : string):boolean;
- var
- ext : string[8];
- singlepathstring,
- Path,
- filename : string;
- found : boolean;
- start,i : longint;
- Function UnitExists(const ext:string):boolean;
- begin
- Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
- UnitExists:=FileExists(Singlepathstring+FileName+ext);
- end;
- begin
- start:=1;
- filename:=FixFileName(n);
- path:=UnitSearchPath;
- Found:=false;
- repeat
- {Create current path to check}
- i:=pos(';',path);
- if i=0 then
- i:=length(path)+1;
- singlepathstring:=FixPath(copy(path,start,i-start));
- delete(path,start,i-start+1);
- { Check for PPL file }
- if not (cs_link_static in aktswitches) then
- begin
- Found:=UnitExists(target_info.unitlibext);
- if Found then
- Begin
- SetFileName(SinglePathString,FileName);
- Found:=Load_PPU(singlepathstring,filename,target_info.unitlibext);
- 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
- SetFileName(SinglePathString,FileName);
- 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_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);
- end
- else
- sources_avail:=false;
- end;
- until Found or (path='');
- search_unit:=Found;
- end;
- {$endif NEWPPU}
- 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
- modulename:=stringdup(Upper(n))
- else
- modulename:=stringdup('PROGRAM');
- mainsource:=stringdup(s);
- objfilename:=nil;
- asmfilename:=nil;
- libfilename:=nil;
- ppufilename:=nil;
- setfilename(p,n);
- used_units.init;
- sourcefiles.init;
- linkofiles.init;
- linkstaticlibs.init;
- linksharedlibs.init;
- ppufile:=nil;
- current_inputfile:=nil;
- map:=nil;
- symtable:=nil;
- flags:=0;
- crc:=0;
- unitcount:=1;
- inc(global_unit_count);
- unit_index:=global_unit_count;
- do_assemble:=false;
- do_compile:=false;
- sources_avail:=true;
- compiled:=false;
- in_implementation:=false;
- in_main:=false;
- is_unit:=_is_unit;
- uses_imports:=false;
- imports:=new(plinkedlist,init);
- { set smartlink flag }
- if (cs_smartlink in aktswitches) then
- flags:=flags or uf_smartlink;
- { search the PPU file if it is an unit }
- if is_unit then
- begin
- if (not search_unit(modulename^)) and (length(modulename^)>8) then
- search_unit(copy(modulename^,1,8));
- end;
- 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;
- linkstaticlibs.done;
- linksharedlibs.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;
- end.
- {
- $Log$
- Revision 1.22 1998-06-14 18:25:41 peter
- * small fix with crc in newppu
- Revision 1.21 1998/06/13 00:10:05 peter
- * working browser and newppu
- * some small fixes against crashes which occured in bp7 (but not in
- fpc?!)
- Revision 1.20 1998/06/12 14:50:48 peter
- * removed the tree dependency to types.pas
- * long_fil.pas support (not fully tested yet)
- Revision 1.19 1998/06/12 10:32:26 pierre
- * column problem hopefully solved
- + C vars declaration changed
- Revision 1.18 1998/06/11 13:58:07 peter
- * small fix to let newppu compile
- Revision 1.17 1998/06/09 16:01:40 pierre
- + added procedure directive parsing for procvars
- (accepted are popstack cdecl and pascal)
- + added C vars with the following syntax
- var C calias 'true_c_name';(can be followed by external)
- reason is that you must add the Cprefix
- which is target dependent
- Revision 1.16 1998/06/04 10:42:19 pierre
- * small bug fix in load_ppu or openppu
- Revision 1.15 1998/05/28 14:37:53 peter
- * default programname is PROGRAM (like TP7) to avoid dup id's
- Revision 1.14 1998/05/27 19:45:02 peter
- * symtable.pas splitted into includefiles
- * symtable adapted for $ifdef NEWPPU
- Revision 1.13 1998/05/23 01:21:05 peter
- + aktasmmode, aktoptprocessor, aktoutputformat
- + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
- + $LIBNAME to set the library name where the unit will be put in
- * splitted cgi386 a bit (codeseg to large for bp7)
- * nasm, tasm works again. nasm moved to ag386nsm.pas
- Revision 1.12 1998/05/20 09:42:33 pierre
- + UseTokenInfo now default
- * unit in interface uses and implementation uses gives error now
- * only one error for unknown symbol (uses lastsymknown boolean)
- the problem came from the label code !
- + first inlined procedures and function work
- (warning there might be allowed cases were the result is still wrong !!)
- * UseBrower updated gives a global list of all position of all used symbols
- with switch -gb
- Revision 1.11 1998/05/12 10:46:59 peter
- * moved printstatus to verb_def
- + V_Normal which is between V_Error and V_Warning and doesn't have a
- prefix like error: warning: and is included in V_Default
- * fixed some messages
- * first time parameter scan is only for -v and -T
- - removed old style messages
- Revision 1.10 1998/05/11 13:07:53 peter
- + $ifdef NEWPPU for the new ppuformat
- + $define GDB not longer required
- * removed all warnings and stripped some log comments
- * no findfirst/findnext anymore to remove smartlink *.o files
- Revision 1.9 1998/05/06 15:04:20 pierre
- + when trying to find source files of a ppufile
- check the includepathlist for included files
- the main file must still be in the same directory
- Revision 1.8 1998/05/04 17:54:25 peter
- + smartlinking works (only case jumptable left todo)
- * redesign of systems.pas to support assemblers and linkers
- + Unitname is now also in the PPU-file, increased version to 14
- Revision 1.7 1998/05/01 16:38:44 florian
- * handling of private and protected fixed
- + change_keywords_to_tp implemented to remove
- keywords which aren't supported by tp
- * break and continue are now symbols of the system unit
- + widestring, longstring and ansistring type released
- Revision 1.6 1998/05/01 07:43:53 florian
- + basics for rtti implemented
- + switch $m (generate rtti for published sections)
- Revision 1.5 1998/04/30 15:59:40 pierre
- * GDB works again better :
- correct type info in one pass
- + UseTokenInfo for better source position
- * fixed one remaining bug in scanner for line counts
- * several little fixes
- Revision 1.4 1998/04/29 10:33:52 pierre
- + added some code for ansistring (not complete nor working yet)
- * corrected operator overloading
- * corrected nasm output
- + started inline procedures
- + added starstarn : use ** for exponentiation (^ gave problems)
- + started UseTokenInfo cond to get accurate positions
- Revision 1.3 1998/04/27 23:10:28 peter
- + new scanner
- * $makelib -> if smartlink
- * small filename fixes pmodule.setfilename
- * moved import from files.pas -> import.pas
- Revision 1.2 1998/04/21 10:16:47 peter
- * patches from strasbourg
- * objects is not used anymore in the fpc compiled version
- }
|