mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-01 01:33:41 +02:00
1774 lines
62 KiB
ObjectPascal
1774 lines
62 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2000 by Florian Klaempfl
|
|
|
|
Handles the parsing and loading 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 pmodules;
|
|
{ close old_current_ppu on system that are
|
|
short on file handles like DOS system PM }
|
|
{$ifdef GO32V1}
|
|
{$define SHORT_ON_FILE_HANDLES}
|
|
{$endif GO32V1}
|
|
{$ifdef GO32V2}
|
|
{$define SHORT_ON_FILE_HANDLES}
|
|
{$endif GO32V2}
|
|
|
|
{$define New_GDB}
|
|
|
|
interface
|
|
|
|
procedure proc_unit;
|
|
procedure proc_program(islibrary : boolean);
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,version,systems,tokens,
|
|
cobjects,comphook,compiler,
|
|
globals,verbose,files,
|
|
symconst,symtable,aasm,
|
|
{$ifdef newcg}
|
|
cgbase,
|
|
{$else newcg}
|
|
hcodegen,
|
|
{$endif newcg}
|
|
link,assemble,import,export,gendef,ppu,comprsrc,
|
|
cresstr,cpubase,cpuasm,
|
|
{$ifdef GDB}
|
|
gdb,
|
|
{$endif GDB}
|
|
scanner,pbase,psystem,pdecl,psub,parser;
|
|
|
|
procedure create_objectfile;
|
|
begin
|
|
{ create the .s file and assemble it }
|
|
GenerateAsm(false);
|
|
|
|
{ Also create a smartlinked version ? }
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
begin
|
|
{ regenerate the importssection for win32 }
|
|
if assigned(importssection) and
|
|
(target_info.target=target_i386_win32) then
|
|
begin
|
|
importssection^.clear;
|
|
importlib^.generatesmartlib;
|
|
end;
|
|
|
|
GenerateAsm(true);
|
|
if target_asm.needar then
|
|
Linker^.MakeStaticLibrary;
|
|
end;
|
|
|
|
{ resource files }
|
|
CompileResourceFiles;
|
|
end;
|
|
|
|
|
|
procedure insertobjectfile;
|
|
{ Insert the used object file for this unit in the used list for this unit }
|
|
begin
|
|
current_module^.linkunitofiles.insert(current_module^.objfilename^,link_static);
|
|
current_module^.flags:=current_module^.flags or uf_static_linked;
|
|
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
begin
|
|
current_module^.linkunitstaticlibs.insert(current_module^.staticlibfilename^,link_smart);
|
|
current_module^.flags:=current_module^.flags or uf_smart_linked;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure insertsegment;
|
|
|
|
procedure fixseg(p:paasmoutput;sec:tsection);
|
|
begin
|
|
p^.insert(new(pai_section,init(sec)));
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
p^.insert(new(pai_cut,init));
|
|
p^.concat(new(pai_section,init(sec_none)));
|
|
end;
|
|
|
|
begin
|
|
{ Insert Ident of the compiler }
|
|
if (not (cs_create_smart in aktmoduleswitches))
|
|
{$ifndef EXTDEBUG}
|
|
and (not current_module^.is_unit)
|
|
{$endif}
|
|
then
|
|
begin
|
|
datasegment^.insert(new(pai_align,init(4)));
|
|
datasegment^.insert(new(pai_string,init('FPC '+full_version_string+
|
|
' ['+date_string+'] for '+target_cpu_string+' - '+target_info.short_name)));
|
|
end;
|
|
{ finish codesegment }
|
|
codesegment^.concat(new(pai_align,init(16)));
|
|
{ Insert start and end of sections }
|
|
fixseg(codesegment,sec_code);
|
|
fixseg(datasegment,sec_data);
|
|
fixseg(bsssegment,sec_bss);
|
|
{ we should use .rdata section for these two no ? }
|
|
{ .rdata is a read only data section (PM) }
|
|
fixseg(rttilist,sec_data);
|
|
fixseg(consts,sec_data);
|
|
if assigned(resourcestringlist) then
|
|
fixseg(resourcestringlist,sec_data);
|
|
{$ifdef GDB}
|
|
if assigned(debuglist) then
|
|
begin
|
|
debuglist^.insert(new(pai_symbol,initname('gcc2_compiled',0)));
|
|
fixseg(debuglist,sec_code);
|
|
end;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
|
|
Procedure InsertResourceTablesTable;
|
|
var
|
|
hp : pused_unit;
|
|
ResourceStringTables : taasmoutput;
|
|
count : longint;
|
|
begin
|
|
ResourceStringTables.init;
|
|
count:=0;
|
|
hp:=pused_unit(usedunits.first);
|
|
while assigned(hp) do
|
|
begin
|
|
If (hp^.u^.flags and uf_has_resources)=uf_has_resources then
|
|
begin
|
|
ResourceStringTables.concat(new(pai_const_symbol,initname(hp^.u^.modulename^+'_RESOURCESTRINGLIST')));
|
|
inc(count);
|
|
end;
|
|
hp:=Pused_unit(hp^.next);
|
|
end;
|
|
{ Add program resources, if any }
|
|
If ResourceStringList<>Nil then
|
|
begin
|
|
ResourceStringTables.concat(new(pai_const_symbol,initname(Current_Module^.modulename^+'_RESOURCESTRINGLIST')));
|
|
Inc(Count);
|
|
end;
|
|
{ TableCount }
|
|
{ doesn't work because of bug in the compiler !! (JM)
|
|
With ResourceStringTables do}
|
|
begin
|
|
ResourceStringTables.insert(new(pai_const,init_32bit(count)));
|
|
ResourceStringTables.insert(new(pai_symbol,initname_global('FPC_RESOURCESTRINGTABLES',0)));
|
|
ResourceStringTables.concat(new(pai_symbol_end,initname('FPC_RESOURCESTRINGTABLES')));
|
|
end;
|
|
{ insert in data segment }
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
datasegment^.concat(new(pai_cut,init));
|
|
datasegment^.concatlist(@ResourceStringTables);
|
|
ResourceStringTables.done;
|
|
end;
|
|
|
|
|
|
procedure InsertInitFinalTable;
|
|
var
|
|
hp : pused_unit;
|
|
unitinits : taasmoutput;
|
|
count : longint;
|
|
begin
|
|
unitinits.init;
|
|
count:=0;
|
|
hp:=pused_unit(usedunits.first);
|
|
while assigned(hp) do
|
|
begin
|
|
{ call the unit init code and make it external }
|
|
if (hp^.u^.flags and (uf_init or uf_finalize))<>0 then
|
|
begin
|
|
if (hp^.u^.flags and uf_init)<>0 then
|
|
begin
|
|
unitinits.concat(new(pai_const_symbol,initname('INIT$$'+hp^.u^.modulename^)));
|
|
end
|
|
else
|
|
unitinits.concat(new(pai_const,init_32bit(0)));
|
|
if (hp^.u^.flags and uf_finalize)<>0 then
|
|
begin
|
|
unitinits.concat(new(pai_const_symbol,initname('FINALIZE$$'+hp^.u^.modulename^)));
|
|
end
|
|
else
|
|
unitinits.concat(new(pai_const,init_32bit(0)));
|
|
inc(count);
|
|
end;
|
|
hp:=Pused_unit(hp^.next);
|
|
end;
|
|
if current_module^.islibrary then
|
|
if (current_module^.flags and uf_finalize)<>0 then
|
|
begin
|
|
{ INIT code is done by PASCALMAIN calling }
|
|
unitinits.concat(new(pai_const,init_32bit(0)));
|
|
unitinits.concat(new(pai_const_symbol,initname('FINALIZE$$'+current_module^.modulename^)));
|
|
inc(count);
|
|
end;
|
|
{ TableCount,InitCount }
|
|
unitinits.insert(new(pai_const,init_32bit(0)));
|
|
unitinits.insert(new(pai_const,init_32bit(count)));
|
|
unitinits.insert(new(pai_symbol,initname_global('INITFINAL',0)));
|
|
unitinits.concat(new(pai_symbol_end,initname('INITFINAL')));
|
|
{ insert in data segment }
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
datasegment^.concat(new(pai_cut,init));
|
|
datasegment^.concatlist(@unitinits);
|
|
unitinits.done;
|
|
end;
|
|
|
|
|
|
procedure insertheap;
|
|
begin
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
begin
|
|
bsssegment^.concat(new(pai_cut,init));
|
|
datasegment^.concat(new(pai_cut,init));
|
|
end;
|
|
{ On the Macintosh Classic M68k Architecture
|
|
The Heap variable is simply a POINTER to the
|
|
real HEAP. The HEAP must be set up by the RTL
|
|
and must store the pointer in this value.
|
|
On OS/2 the heap is also intialized by the RTL. We do
|
|
not output a pointer }
|
|
case target_info.target of
|
|
{$ifdef i386}
|
|
target_i386_OS2:
|
|
;
|
|
{$endif i386}
|
|
{$ifdef alpha}
|
|
target_alpha_linux:
|
|
;
|
|
{$endif alpha}
|
|
{$ifdef powerpc}
|
|
target_powerpc_linux:
|
|
;
|
|
{$endif powerpc}
|
|
{$ifdef m68k}
|
|
target_m68k_Mac:
|
|
bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
|
|
target_m68k_PalmOS:
|
|
;
|
|
{$endif m68k}
|
|
else
|
|
bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
|
|
end;
|
|
{$ifdef m68k}
|
|
if target_info.target<>target_m68k_PalmOS then
|
|
begin
|
|
datasegment^.concat(new(pai_symbol,initname_global('HEAP_SIZE',0)));
|
|
datasegment^.concat(new(pai_const,init_32bit(heapsize)));
|
|
end;
|
|
{$else m68k}
|
|
datasegment^.concat(new(pai_symbol,initname_global('HEAPSIZE',4)));
|
|
datasegment^.concat(new(pai_const,init_32bit(heapsize)));
|
|
{$endif m68k}
|
|
end;
|
|
|
|
|
|
procedure inserttargetspecific;
|
|
begin
|
|
case target_info.target of
|
|
{$ifdef alpha}
|
|
target_alpha_linux:
|
|
;
|
|
{$endif alpha}
|
|
{$ifdef powerpc}
|
|
target_powerpc_linux:
|
|
;
|
|
{$endif powerpc}
|
|
{$ifdef i386}
|
|
target_i386_GO32V2 :
|
|
begin
|
|
{ stacksize can be specified }
|
|
datasegment^.concat(new(pai_symbol,initname_global('__stklen',4)));
|
|
datasegment^.concat(new(pai_const,init_32bit(stacksize)));
|
|
end;
|
|
{$endif i386}
|
|
{$ifdef m68k}
|
|
target_m68k_Atari :
|
|
begin
|
|
{ stacksize can be specified }
|
|
datasegment^.concat(new(pai_symbol,initname_global('__stklen',4)));
|
|
datasegment^.concat(new(pai_const,init_32bit(stacksize)));
|
|
end;
|
|
{$endif m68k}
|
|
end;
|
|
end;
|
|
|
|
|
|
function loadunit(const s : string;compile_system:boolean) : pmodule;forward;
|
|
|
|
|
|
procedure load_usedunits(compile_system:boolean);
|
|
var
|
|
pu : pused_unit;
|
|
loaded_unit : pmodule;
|
|
load_refs : boolean;
|
|
nextmapentry : longint;
|
|
begin
|
|
load_refs:=true;
|
|
{ init the map }
|
|
new(current_module^.map);
|
|
fillchar(current_module^.map^,sizeof(tunitmap),#0);
|
|
{$ifdef NEWMAP}
|
|
current_module^.map^[0]:=current_module;
|
|
{$endif NEWMAP}
|
|
nextmapentry:=1;
|
|
{ load the used units from interface }
|
|
current_module^.in_implementation:=false;
|
|
pu:=pused_unit(current_module^.used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if (not pu^.loaded) and (pu^.in_interface) then
|
|
begin
|
|
loaded_unit:=loadunit(pu^.name^,false);
|
|
if current_module^.compiled then
|
|
exit;
|
|
{ register unit in used units }
|
|
pu^.u:=loaded_unit;
|
|
pu^.loaded:=true;
|
|
{ doubles are not important for that list PM }
|
|
pu^.u^.dependent_units.concat(new(pdependent_unit,init(current_module)));
|
|
{ need to recompile the current unit ? }
|
|
if loaded_unit^.crc<>pu^.checksum then
|
|
begin
|
|
Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^);
|
|
current_module^.recompile_reason:=rr_crcchanged;
|
|
current_module^.do_compile:=true;
|
|
dispose(current_module^.map);
|
|
current_module^.map:=nil;
|
|
exit;
|
|
end;
|
|
{ setup the map entry for deref }
|
|
{$ifndef NEWMAP}
|
|
current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
|
|
{$else NEWMAP}
|
|
current_module^.map^[nextmapentry]:=loaded_unit;
|
|
{$endif NEWMAP}
|
|
inc(nextmapentry);
|
|
if nextmapentry>maxunits then
|
|
Message(unit_f_too_much_units);
|
|
end;
|
|
pu:=pused_unit(pu^.next);
|
|
end;
|
|
{ ok, now load the unit }
|
|
current_module^.globalsymtable:=new(punitsymtable,loadasunit);
|
|
{ now only read the implementation part }
|
|
current_module^.in_implementation:=true;
|
|
{ load the used units from implementation }
|
|
pu:=pused_unit(current_module^.used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if (not pu^.loaded) and (not pu^.in_interface) then
|
|
begin
|
|
loaded_unit:=loadunit(pu^.name^,false);
|
|
if current_module^.compiled then
|
|
exit;
|
|
{ register unit in used units }
|
|
pu^.u:=loaded_unit;
|
|
pu^.loaded:=true;
|
|
{ need to recompile the current unit ? }
|
|
if (loaded_unit^.interface_crc<>pu^.interface_checksum) {and
|
|
not(current_module^.in_second_compile) } then
|
|
begin
|
|
Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^+' {impl}');
|
|
current_module^.recompile_reason:=rr_crcchanged;
|
|
current_module^.do_compile:=true;
|
|
dispose(current_module^.map);
|
|
current_module^.map:=nil;
|
|
exit;
|
|
end;
|
|
{ setup the map entry for deref }
|
|
{$ifndef NEWMAP}
|
|
current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
|
|
{$else NEWMAP}
|
|
current_module^.map^[nextmapentry]:=loaded_unit;
|
|
{$endif NEWMAP}
|
|
inc(nextmapentry);
|
|
if nextmapentry>maxunits then
|
|
Message(unit_f_too_much_units);
|
|
end;
|
|
pu:=pused_unit(pu^.next);
|
|
end;
|
|
{ load browser info if stored }
|
|
if ((current_module^.flags and uf_has_browser)<>0) and load_refs then
|
|
punitsymtable(current_module^.globalsymtable)^.load_symtable_refs;
|
|
{ remove the map, it's not needed anymore }
|
|
dispose(current_module^.map);
|
|
current_module^.map:=nil;
|
|
end;
|
|
|
|
|
|
function loadunit(const s : string;compile_system:boolean) : pmodule;
|
|
const
|
|
ImplIntf : array[boolean] of string[15]=('interface','implementation');
|
|
var
|
|
st : punitsymtable;
|
|
second_time : boolean;
|
|
old_current_ppu : pppufile;
|
|
old_current_module,hp,hp2 : pmodule;
|
|
name : string;{ necessary because current_module^.mainsource^ is reset in compile !! }
|
|
scanner : pscannerfile;
|
|
|
|
procedure loadppufile;
|
|
begin
|
|
{ load interface section }
|
|
if not current_module^.do_compile then
|
|
load_interface;
|
|
{ only load units when we don't recompile }
|
|
if not current_module^.do_compile then
|
|
load_usedunits(compile_system);
|
|
{ recompile if set }
|
|
if current_module^.do_compile then
|
|
begin
|
|
{ we don't need the ppufile anymore }
|
|
if assigned(current_module^.ppufile) then
|
|
begin
|
|
dispose(current_module^.ppufile,done);
|
|
current_module^.ppufile:=nil;
|
|
current_ppu:=nil;
|
|
end;
|
|
{ recompile the unit or give a fatal error if sources not available }
|
|
if not(current_module^.sources_avail) then
|
|
if (not current_module^.search_unit(current_module^.modulename^,true))
|
|
and (length(current_module^.modulename^)>8) then
|
|
current_module^.search_unit(copy(current_module^.modulename^,1,8),true);
|
|
if not(current_module^.sources_avail) then
|
|
begin
|
|
if current_module^.recompile_reason=rr_noppu then
|
|
Message1(unit_f_cant_find_ppu,current_module^.modulename^)
|
|
else
|
|
Message1(unit_f_cant_compile_unit,current_module^.modulename^);
|
|
end
|
|
else
|
|
begin
|
|
if current_module^.in_compile then
|
|
begin
|
|
current_module^.in_second_compile:=true;
|
|
Message1(parser_d_compiling_second_time,current_module^.modulename^);
|
|
end;
|
|
current_scanner^.tempcloseinputfile;
|
|
name:=current_module^.mainsource^;
|
|
if assigned(scanner) then
|
|
scanner^.invalid:=true;
|
|
compile(name,compile_system);
|
|
current_module^.in_second_compile:=false;
|
|
if (not current_scanner^.invalid) then
|
|
current_scanner^.tempopeninputfile;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ only reassemble ? }
|
|
if (current_module^.do_assemble) then
|
|
OnlyAsm;
|
|
end;
|
|
if assigned(current_module^.ppufile) then
|
|
begin
|
|
dispose(current_module^.ppufile,done);
|
|
current_module^.ppufile:=nil;
|
|
current_ppu:=nil;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
dummy : pmodule;
|
|
|
|
begin
|
|
old_current_module:=current_module;
|
|
old_current_ppu:=current_ppu;
|
|
{ Info }
|
|
Message3(unit_u_load_unit,current_module^.modulename^,ImplIntf[current_module^.in_implementation],s);
|
|
{ unit not found }
|
|
st:=nil;
|
|
dummy:=nil;
|
|
{ search all loaded units }
|
|
hp:=pmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if hp^.modulename^=s then
|
|
begin
|
|
{ forced to reload ? }
|
|
if hp^.do_reload then
|
|
begin
|
|
hp^.do_reload:=false;
|
|
break;
|
|
end;
|
|
{ the unit is already registered }
|
|
{ and this means that the unit }
|
|
{ is already compiled }
|
|
{ else there is a cyclic unit use }
|
|
if assigned(hp^.globalsymtable) then
|
|
st:=punitsymtable(hp^.globalsymtable)
|
|
else
|
|
begin
|
|
{ both units in interface ? }
|
|
if (not current_module^.in_implementation) and (not hp^.in_implementation) then
|
|
begin
|
|
{ check for a cycle }
|
|
hp2:=current_module^.loaded_from;
|
|
while assigned(hp2) and (hp2<>hp) do
|
|
begin
|
|
if hp2^.in_implementation then
|
|
hp2:=nil
|
|
else
|
|
hp2:=hp2^.loaded_from;
|
|
end;
|
|
if assigned(hp2) then
|
|
Message2(unit_f_circular_unit_reference,current_module^.modulename^,hp^.modulename^);
|
|
end;
|
|
end;
|
|
break;
|
|
end
|
|
else if copy(hp^.modulename^,1,8)=s then
|
|
dummy:=hp;
|
|
{ the next unit }
|
|
hp:=pmodule(hp^.next);
|
|
end;
|
|
if assigned(dummy) and not assigned(hp) then
|
|
Message2(unit_w_unit_name_error,s,dummy^.modulename^);
|
|
{ the unit is not in the symtable stack }
|
|
if (not assigned(st)) then
|
|
begin
|
|
if assigned(hp) then
|
|
begin
|
|
{ remove the old unit }
|
|
loaded_units.remove(hp);
|
|
scanner:=hp^.scanner;
|
|
hp^.reset;
|
|
hp^.scanner:=scanner;
|
|
{ try to reopen ppu }
|
|
hp^.search_unit(s,false);
|
|
{ try to load the unit a second time first }
|
|
current_module:=hp;
|
|
current_module^.in_second_load:=true;
|
|
Message1(unit_u_second_load_unit,current_module^.modulename^);
|
|
second_time:=true;
|
|
end
|
|
else
|
|
{ generates a new unit info record }
|
|
begin
|
|
current_module:=new(pmodule,init(s,true));
|
|
scanner:=nil;
|
|
second_time:=false;
|
|
end;
|
|
current_ppu:=current_module^.ppufile;
|
|
{ close old_current_ppu on system that are
|
|
short on file handles like DOS PM }
|
|
{$ifdef SHORT_ON_FILE_HANDLES}
|
|
if assigned(old_current_ppu) then
|
|
old_current_ppu^.tempclose;
|
|
{$endif SHORT_ON_FILE_HANDLES}
|
|
{ now we can register the unit }
|
|
current_module^.loaded_from:=old_current_module;
|
|
loaded_units.insert(current_module);
|
|
{ now realy load the ppu }
|
|
loadppufile;
|
|
{ set compiled flag }
|
|
current_module^.compiled:=true;
|
|
{ load return pointer }
|
|
hp:=current_module;
|
|
{ for a second_time recompile reload all dependent units,
|
|
for a first time compile register the unit _once_ }
|
|
if second_time then
|
|
begin
|
|
{ now reload all dependent units }
|
|
hp2:=pmodule(loaded_units.first);
|
|
while assigned(hp2) do
|
|
begin
|
|
if hp2^.do_reload then
|
|
dummy:=loadunit(hp2^.modulename^,false);
|
|
hp2:=pmodule(hp2^.next);
|
|
end;
|
|
end
|
|
else
|
|
usedunits.concat(new(pused_unit,init(current_module,true)));
|
|
end;
|
|
{ set the old module }
|
|
{$ifdef SHORT_ON_FILE_HANDLES}
|
|
if assigned(old_current_ppu) then
|
|
old_current_ppu^.tempopen;
|
|
{$endif SHORT_ON_FILE_HANDLES}
|
|
current_ppu:=old_current_ppu;
|
|
current_module:=old_current_module;
|
|
loadunit:=hp;
|
|
end;
|
|
|
|
|
|
procedure loaddefaultunits;
|
|
var
|
|
hp : pmodule;
|
|
begin
|
|
{ are we compiling the system unit? }
|
|
if (cs_compilesystem in aktmoduleswitches) then
|
|
begin
|
|
{ create system defines }
|
|
createconstdefs;
|
|
{ we don't need to reset anything, it's already done in parser.pas }
|
|
exit;
|
|
end;
|
|
{ insert the system unit, it is allways the first }
|
|
hp:=loadunit(upper(target_info.system_unit),true);
|
|
systemunit:=hp^.globalsymtable;
|
|
{ it's always the first unit }
|
|
systemunit^.next:=nil;
|
|
symtablestack:=systemunit;
|
|
{ add to the used units }
|
|
current_module^.used_units.concat(new(pused_unit,init(hp,true)));
|
|
refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
|
|
{ read default constant definitions }
|
|
make_ref:=false;
|
|
readconstdefs;
|
|
{ if POWER is defined in the RTL then use it for starstar overloading }
|
|
getsym('POWER',false);
|
|
make_ref:=true;
|
|
if assigned(srsym) and (srsym^.typ=procsym) and (overloaded_operators[_STARSTAR]=nil) then
|
|
overloaded_operators[_STARSTAR]:=pprocsym(srsym);
|
|
{ Objpas unit? }
|
|
if m_objpas in aktmodeswitches then
|
|
begin
|
|
hp:=loadunit('OBJPAS',false);
|
|
psymtable(hp^.globalsymtable)^.next:=symtablestack;
|
|
symtablestack:=hp^.globalsymtable;
|
|
{ add to the used units }
|
|
current_module^.used_units.concat(new(pused_unit,init(hp,true)));
|
|
refsymtable^.insert(new(punitsym,init('OBJPAS',hp^.globalsymtable)));
|
|
end;
|
|
{ Profile unit? Needed for go32v2 only }
|
|
if (cs_profile in aktmoduleswitches) and (target_info.target=target_i386_go32v2) then
|
|
begin
|
|
hp:=loadunit('PROFILE',false);
|
|
psymtable(hp^.globalsymtable)^.next:=symtablestack;
|
|
symtablestack:=hp^.globalsymtable;
|
|
{ add to the used units }
|
|
current_module^.used_units.concat(new(pused_unit,init(hp,true)));
|
|
refsymtable^.insert(new(punitsym,init('PROFILE',hp^.globalsymtable)));
|
|
end;
|
|
{ Heaptrc unit? (not needed for units), this is here to be sure that it is really
|
|
loaded as first unit }
|
|
if (cs_gdb_heaptrc in aktglobalswitches) and not(current_module^.is_unit)then
|
|
begin
|
|
hp:=loadunit('HEAPTRC',false);
|
|
psymtable(hp^.globalsymtable)^.next:=symtablestack;
|
|
symtablestack:=hp^.globalsymtable;
|
|
{ add to the used units }
|
|
current_module^.used_units.concat(new(pused_unit,init(hp,true)));
|
|
refsymtable^.insert(new(punitsym,init('HEAPTRC',hp^.globalsymtable)));
|
|
end;
|
|
{ save default symtablestack }
|
|
defaultsymtablestack:=symtablestack;
|
|
end;
|
|
|
|
|
|
procedure loadunits;
|
|
var
|
|
s : stringid;
|
|
pu,
|
|
hp : pused_unit;
|
|
hp2 : pmodule;
|
|
hp3 : psymtable;
|
|
oldprocsym:Pprocsym;
|
|
begin
|
|
oldprocsym:=aktprocsym;
|
|
consume(_USES);
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
repeat
|
|
s:=pattern;
|
|
consume(_ID);
|
|
{ Give a warning if objpas is loaded }
|
|
if s='OBJPAS' then
|
|
Message(parser_w_no_objpas_use_mode);
|
|
{ check if the unit is already used }
|
|
pu:=pused_unit(current_module^.used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if (pu^.name^=s) then
|
|
break;
|
|
pu:=pused_unit(pu^.next);
|
|
end;
|
|
{ avoid uses of itself }
|
|
if not assigned(pu) and (s<>current_module^.modulename^) then
|
|
begin
|
|
{ load the unit }
|
|
hp2:=loadunit(s,false);
|
|
{ the current module uses the unit hp2 }
|
|
current_module^.used_units.concat(new(pused_unit,init(hp2,not current_module^.in_implementation)));
|
|
pused_unit(current_module^.used_units.last)^.in_uses:=true;
|
|
if current_module^.compiled then
|
|
exit;
|
|
refsymtable^.insert(new(punitsym,init(s,hp2^.globalsymtable)));
|
|
end
|
|
else
|
|
Message1(sym_e_duplicate_id,s);
|
|
if token=_COMMA then
|
|
begin
|
|
pattern:='';
|
|
consume(_COMMA);
|
|
end
|
|
else
|
|
break;
|
|
until false;
|
|
consume(_SEMICOLON);
|
|
|
|
{ set the symtable to systemunit so it gets reorderd correctly }
|
|
symtablestack:=defaultsymtablestack;
|
|
|
|
{ now insert the units in the symtablestack }
|
|
hp:=pused_unit(current_module^.used_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
{$IfDef GDB}
|
|
if (cs_debuginfo in aktmoduleswitches) and
|
|
(cs_gdb_dbx in aktglobalswitches) and
|
|
not hp^.is_stab_written then
|
|
begin
|
|
punitsymtable(hp^.u^.globalsymtable)^.concattypestabto(debuglist);
|
|
hp^.is_stab_written:=true;
|
|
hp^.unitid:=psymtable(hp^.u^.globalsymtable)^.unitid;
|
|
end;
|
|
{$EndIf GDB}
|
|
if hp^.in_uses then
|
|
begin
|
|
hp3:=symtablestack;
|
|
while assigned(hp3) do
|
|
begin
|
|
{ insert units only once ! }
|
|
if hp^.u^.globalsymtable=hp3 then
|
|
break;
|
|
hp3:=hp3^.next;
|
|
{ unit isn't inserted }
|
|
if hp3=nil then
|
|
begin
|
|
psymtable(hp^.u^.globalsymtable)^.next:=symtablestack;
|
|
symtablestack:=psymtable(hp^.u^.globalsymtable);
|
|
{$ifdef CHAINPROCSYMS}
|
|
symtablestack^.chainprocsyms;
|
|
{$endif CHAINPROCSYMS}
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
end;
|
|
end;
|
|
end;
|
|
hp:=pused_unit(hp^.next);
|
|
end;
|
|
aktprocsym:=oldprocsym;
|
|
end;
|
|
|
|
|
|
procedure write_gdb_info;
|
|
{$IfDef GDB}
|
|
var
|
|
hp : pused_unit;
|
|
begin
|
|
if not (cs_debuginfo in aktmoduleswitches) then
|
|
exit;
|
|
if (cs_gdb_dbx in aktglobalswitches) then
|
|
begin
|
|
debuglist^.concat(new(pai_asm_comment,init(strpnew('EINCL of global '+
|
|
punitsymtable(current_module^.globalsymtable)^.name^+' has index '+
|
|
tostr(punitsymtable(current_module^.globalsymtable)^.unitid)))));
|
|
debuglist^.concat(new(pai_stabs,init(strpnew('"'+
|
|
punitsymtable(current_module^.globalsymtable)^.name^+'",'+
|
|
tostr(N_EINCL)+',0,0,0'))));
|
|
punitsymtable(current_module^.globalsymtable)^.dbx_count_ok:=true;
|
|
dbx_counter:=punitsymtable(current_module^.globalsymtable)^.prev_dbx_counter;
|
|
do_count_dbx:=false;
|
|
end;
|
|
|
|
{ now insert the units in the symtablestack }
|
|
hp:=pused_unit(current_module^.used_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if (cs_debuginfo in aktmoduleswitches) and
|
|
not hp^.is_stab_written then
|
|
begin
|
|
punitsymtable(hp^.u^.globalsymtable)^.concattypestabto(debuglist);
|
|
hp^.is_stab_written:=true;
|
|
hp^.unitid:=psymtable(hp^.u^.globalsymtable)^.unitid;
|
|
end;
|
|
hp:=pused_unit(hp^.next);
|
|
end;
|
|
if current_module^.in_implementation then
|
|
begin
|
|
if assigned(current_module^.localsymtable) then
|
|
begin
|
|
{ all types }
|
|
punitsymtable(current_module^.localsymtable)^.concattypestabto(debuglist);
|
|
{ and all local symbols}
|
|
punitsymtable(current_module^.localsymtable)^.concatstabto(debuglist);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if assigned(current_module^.globalsymtable) then
|
|
begin
|
|
{ all types }
|
|
punitsymtable(current_module^.globalsymtable)^.concattypestabto(debuglist);
|
|
{ and all local symbols}
|
|
punitsymtable(current_module^.globalsymtable)^.concatstabto(debuglist);
|
|
end;
|
|
end;
|
|
end;
|
|
{$Else GDB}
|
|
begin
|
|
end;
|
|
{$EndIf GDB}
|
|
|
|
|
|
procedure parse_implementation_uses(symt:Psymtable);
|
|
begin
|
|
if token=_USES then
|
|
begin
|
|
symt^.symtabletype:=unitsymtable;
|
|
loadunits;
|
|
symt^.symtabletype:=globalsymtable;
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure setupglobalswitches;
|
|
|
|
procedure def_symbol(const s:string);
|
|
var
|
|
mac : pmacrosym;
|
|
begin
|
|
mac:=new(pmacrosym,init(s));
|
|
mac^.defined:=true;
|
|
Message1(parser_m_macro_defined,mac^.name);
|
|
macros^.insert(mac);
|
|
end;
|
|
|
|
begin
|
|
{ can't have local browser when no global browser }
|
|
if (cs_local_browser in aktmoduleswitches) and
|
|
not(cs_browser in aktmoduleswitches) then
|
|
aktmoduleswitches:=aktmoduleswitches-[cs_local_browser];
|
|
|
|
{ define a symbol in delphi,objfpc,tp,gpc mode }
|
|
if (m_delphi in aktmodeswitches) then
|
|
def_symbol('FPC_DELPHI')
|
|
else
|
|
if (m_tp in aktmodeswitches) then
|
|
def_symbol('FPC_TP')
|
|
else
|
|
if (m_objfpc in aktmodeswitches) then
|
|
def_symbol('FPC_OBJFPC')
|
|
else
|
|
if (m_gpc in aktmodeswitches) then
|
|
def_symbol('FPC_GPC');
|
|
|
|
{ turn ansistrings on by default ? }
|
|
if (m_default_ansistring in aktmodeswitches) then
|
|
aktlocalswitches:=aktlocalswitches+[cs_ansistrings];
|
|
end;
|
|
|
|
|
|
procedure gen_main_procsym(const name:string;options:tproctypeoption;st:psymtable);
|
|
var
|
|
stt : psymtable;
|
|
begin
|
|
{Generate a procsym for main}
|
|
make_ref:=false;
|
|
aktprocsym:=new(Pprocsym,init(name));
|
|
{ main are allways used }
|
|
inc(aktprocsym^.refs);
|
|
{Try to insert in in static symtable ! }
|
|
stt:=symtablestack;
|
|
symtablestack:=st;
|
|
aktprocsym^.definition:=new(Pprocdef,init);
|
|
symtablestack:=stt;
|
|
aktprocsym^.definition^.proctypeoption:=options;
|
|
aktprocsym^.definition^.setmangledname(target_os.cprefix+name);
|
|
aktprocsym^.definition^.forwarddef:=false;
|
|
make_ref:=true;
|
|
{ The localst is a local symtable. Change it into the static
|
|
symtable }
|
|
dispose(aktprocsym^.definition^.localst,done);
|
|
aktprocsym^.definition^.localst:=st;
|
|
{ and insert the procsym in symtable }
|
|
st^.insert(aktprocsym);
|
|
{ set some informations about the main program }
|
|
with procinfo^ do
|
|
begin
|
|
returntype.setdef(voiddef);
|
|
_class:=nil;
|
|
para_offset:=8;
|
|
framepointer:=frame_pointer;
|
|
flags:=0;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure proc_unit;
|
|
|
|
function is_assembler_generated:boolean;
|
|
begin
|
|
is_assembler_generated:=(Errorcount=0) and
|
|
not(
|
|
codesegment^.empty and
|
|
datasegment^.empty and
|
|
bsssegment^.empty and
|
|
((importssection=nil) or importssection^.empty) and
|
|
((resourcesection=nil) or resourcesection^.empty) and
|
|
((resourcestringlist=nil) or resourcestringlist^.empty)
|
|
);
|
|
end;
|
|
|
|
var
|
|
{$ifdef fixLeaksOnError}
|
|
names : Pstringcontainer;
|
|
{$else fixLeaksOnError}
|
|
names : Tstringcontainer;
|
|
{$endif fixLeaksOnError}
|
|
st : psymtable;
|
|
unitst : punitsymtable;
|
|
{$ifdef GDB}
|
|
pu : pused_unit;
|
|
{$endif GDB}
|
|
{$ifndef Dont_use_double_checksum}
|
|
store_crc,store_interface_crc : longint;
|
|
{$endif}
|
|
s1,s2 : ^string; {Saves stack space}
|
|
begin
|
|
consume(_UNIT);
|
|
if Compile_Level=1 then
|
|
IsExe:=false;
|
|
|
|
if token=_ID then
|
|
begin
|
|
{ create filenames and unit name }
|
|
current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^,true);
|
|
stringdispose(current_module^.modulename);
|
|
current_module^.modulename:=stringdup(upper(pattern));
|
|
{ check for system unit }
|
|
new(s1);
|
|
new(s2);
|
|
s1^:=upper(target_info.system_unit);
|
|
s2^:=upper(SplitName(current_scanner^.inputfile^.name^));
|
|
if (cs_compilesystem in aktmoduleswitches) then
|
|
begin
|
|
if ((length(current_module^.modulename^)>8) or
|
|
(current_module^.modulename^<>s1^) or
|
|
(current_module^.modulename^<>s2^)) then
|
|
Message1(unit_e_illegal_unit_name,current_module^.modulename^);
|
|
end
|
|
else
|
|
begin
|
|
if (cs_check_unit_name in aktglobalswitches) and
|
|
not((current_module^.modulename^=s2^) or
|
|
((length(current_module^.modulename^)>8) and
|
|
(copy(current_module^.modulename^,1,8)=s2^))) then
|
|
Message1(unit_e_illegal_unit_name,current_module^.modulename^);
|
|
if (current_module^.modulename^=s1^) then
|
|
Message(unit_w_switch_us_missed);
|
|
end;
|
|
dispose(s2);
|
|
dispose(s1);
|
|
end;
|
|
|
|
consume(_ID);
|
|
consume(_SEMICOLON);
|
|
consume(_INTERFACE);
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module^.in_global:=false;
|
|
|
|
{ handle the global switches }
|
|
setupglobalswitches;
|
|
|
|
Message1(unit_u_start_parse_interface,current_module^.modulename^);
|
|
|
|
{ update status }
|
|
status.currentmodule:=current_module^.modulename^;
|
|
|
|
{ maybe turn off m_objpas if we are compiling objpas }
|
|
if (current_module^.modulename^='OBJPAS') then
|
|
aktmodeswitches:=aktmodeswitches-[m_objpas];
|
|
|
|
{ this should be placed after uses !!}
|
|
{$ifndef UseNiceNames}
|
|
procprefix:='_'+current_module^.modulename^+'$$';
|
|
{$else UseNiceNames}
|
|
procprefix:='_'+tostr(length(current_module^.modulename^))+lowercase(current_module^.modulename^)+'_';
|
|
{$endif UseNiceNames}
|
|
|
|
parse_only:=true;
|
|
|
|
{ generate now the global symboltable }
|
|
st:=new(punitsymtable,init(globalsymtable,current_module^.modulename^));
|
|
refsymtable:=st;
|
|
unitst:=punitsymtable(st);
|
|
{ define first as local to overcome dependency conflicts }
|
|
current_module^.localsymtable:=st;
|
|
|
|
{ the unit name must be usable as a unit specifier }
|
|
{ inside the unit itself (PM) }
|
|
{ this also forbids to have another symbol }
|
|
{ with the same name as the unit }
|
|
refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst)));
|
|
|
|
{ a unit compiled at command line must be inside the loaded_unit list }
|
|
if (compile_level=1) then
|
|
loaded_units.insert(current_module);
|
|
|
|
{ load default units, like the system unit }
|
|
loaddefaultunits;
|
|
|
|
{ reset }
|
|
make_ref:=true;
|
|
lexlevel:=0;
|
|
|
|
{ insert qualifier for the system unit (allows system.writeln) }
|
|
if not(cs_compilesystem in aktmoduleswitches) then
|
|
begin
|
|
if token=_USES then
|
|
begin
|
|
unitst^.symtabletype:=unitsymtable;
|
|
loadunits;
|
|
{ has it been compiled at a higher level ?}
|
|
if current_module^.compiled then
|
|
begin
|
|
{ this unit symtable is obsolete }
|
|
{ dispose(unitst,done);
|
|
disposed as localsymtable !! }
|
|
exit;
|
|
end;
|
|
unitst^.symtabletype:=globalsymtable;
|
|
end;
|
|
{ ... but insert the symbol table later }
|
|
st^.next:=symtablestack;
|
|
symtablestack:=st;
|
|
end
|
|
else
|
|
{ while compiling a system unit, some types are directly inserted }
|
|
begin
|
|
st^.next:=symtablestack;
|
|
symtablestack:=st;
|
|
insert_intern_types(st);
|
|
end;
|
|
|
|
{ now we know the place to insert the constants }
|
|
constsymtable:=symtablestack;
|
|
|
|
{ move the global symtab from the temporary local to global }
|
|
current_module^.globalsymtable:=current_module^.localsymtable;
|
|
current_module^.localsymtable:=nil;
|
|
|
|
reset_global_defs;
|
|
|
|
{ number all units, so we know if a unit is used by this unit or
|
|
needs to be added implicitly }
|
|
numberunits;
|
|
|
|
{ ... parse the declarations }
|
|
Message1(parser_u_parsing_interface,current_module^.modulename^);
|
|
read_interface_declarations;
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
exit;
|
|
end;
|
|
|
|
{$ifdef New_GDB}
|
|
write_gdb_info;
|
|
{$endIf Def New_GDB}
|
|
|
|
{$ifndef Dont_use_double_checksum}
|
|
if not(cs_compilesystem in aktmoduleswitches) then
|
|
if (Errorcount=0) then
|
|
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true);
|
|
{$endif Test_Double_checksum}
|
|
|
|
{ Parse the implementation section }
|
|
consume(_IMPLEMENTATION);
|
|
current_module^.in_implementation:=true;
|
|
Message1(unit_u_start_parse_implementation,current_module^.modulename^);
|
|
|
|
parse_only:=false;
|
|
|
|
{ generates static symbol table }
|
|
st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
|
|
current_module^.localsymtable:=st;
|
|
|
|
{ remove the globalsymtable from the symtable stack }
|
|
{ to reinsert it after loading the implementation units }
|
|
symtablestack:=unitst^.next;
|
|
|
|
{ we don't want implementation units symbols in unitsymtable !! PM }
|
|
refsymtable:=st;
|
|
|
|
{ Read the implementation units }
|
|
parse_implementation_uses(unitst);
|
|
|
|
if current_module^.compiled then
|
|
begin
|
|
exit;
|
|
end;
|
|
|
|
{ reset ranges/stabs in exported definitions }
|
|
reset_global_defs;
|
|
|
|
{ All units are read, now give them a number }
|
|
numberunits;
|
|
|
|
{ now we can change refsymtable }
|
|
refsymtable:=st;
|
|
|
|
{ but reinsert the global symtable as lasts }
|
|
unitst^.next:=symtablestack;
|
|
symtablestack:=unitst;
|
|
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
constsymtable:=symtablestack;
|
|
|
|
{$ifdef Splitheap}
|
|
if testsplit then
|
|
begin
|
|
Split_Heap;
|
|
allow_special:=true;
|
|
Switch_to_temp_heap;
|
|
end;
|
|
{ it will report all crossings }
|
|
allow_special:=false;
|
|
{$endif Splitheap}
|
|
|
|
Message1(parser_u_parsing_implementation,current_module^.modulename^);
|
|
|
|
{ Compile the unit }
|
|
codegen_newprocedure;
|
|
gen_main_procsym(current_module^.modulename^+'_init',potype_unitinit,st);
|
|
{$ifdef fixLeaksOnError}
|
|
new(names,init);
|
|
strContStack.push(names);
|
|
names^.insert('INIT$$'+current_module^.modulename^);
|
|
names^.insert(target_os.cprefix+current_module^.modulename^+'_init');
|
|
compile_proc_body(names^,true,false);
|
|
if names <> PstringContainer(strContStack.pop) then
|
|
writeln('Problem with strContStack in pmodules (1)');
|
|
dispose(names,done);
|
|
{$else fixLeaksOnError}
|
|
names.init;
|
|
names.insert('INIT$$'+current_module^.modulename^);
|
|
names.insert(target_os.cprefix+current_module^.modulename^+'_init');
|
|
compile_proc_body(names,true,false);
|
|
names.done;
|
|
{$endif fixLeaksOnError}
|
|
codegen_doneprocedure;
|
|
|
|
{ avoid self recursive destructor call !! PM }
|
|
aktprocsym^.definition^.localst:=nil;
|
|
|
|
{ finalize? }
|
|
if token=_FINALIZATION then
|
|
begin
|
|
{ set module options }
|
|
current_module^.flags:=current_module^.flags or uf_finalize;
|
|
|
|
{ Compile the finalize }
|
|
codegen_newprocedure;
|
|
gen_main_procsym(current_module^.modulename^+'_finalize',potype_unitfinalize,st);
|
|
{$ifdef fixLeaksOnError}
|
|
new(names,init);
|
|
strContStack.push(names);
|
|
names^.insert('FINALIZE$$'+current_module^.modulename^);
|
|
names^.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
|
|
compile_proc_body(names^,true,false);
|
|
if names <> PstringContainer(strContStack.pop) then
|
|
writeln('Problem with strContStack in pmodules (2)');
|
|
dispose(names,done);
|
|
{$else fixLeaksOnError}
|
|
names.init;
|
|
names.insert('FINALIZE$$'+current_module^.modulename^);
|
|
names.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
|
|
compile_proc_body(names,true,false);
|
|
names.done;
|
|
{$endif fixLeaksOnError}
|
|
codegen_doneprocedure;
|
|
end;
|
|
|
|
{ the last char should always be a point }
|
|
consume(_POINT);
|
|
|
|
If ResourceStringList<>Nil then
|
|
begin
|
|
insertresourcestrings;
|
|
current_module^.flags:=current_module^.flags or uf_has_resources;
|
|
WriteResourceFile(Current_module^.ModuleName^);
|
|
end;
|
|
|
|
{ avoid self recursive destructor call !! PM }
|
|
aktprocsym^.definition^.localst:=nil;
|
|
{ absence does not matter here !! }
|
|
aktprocsym^.definition^.forwarddef:=false;
|
|
{ test static symtable }
|
|
if (Errorcount=0) then
|
|
begin
|
|
st^.allsymbolsused;
|
|
st^.allprivatesused;
|
|
end;
|
|
|
|
{ size of the static data }
|
|
datasize:=st^.datasize;
|
|
|
|
{$ifdef GDB}
|
|
{ add all used definitions even for implementation}
|
|
if (cs_debuginfo in aktmoduleswitches) then
|
|
begin
|
|
{$IfnDef New_GDB}
|
|
if assigned(current_module^.globalsymtable) then
|
|
begin
|
|
{ all types }
|
|
punitsymtable(current_module^.globalsymtable)^.concattypestabto(debuglist);
|
|
{ and all local symbols}
|
|
punitsymtable(current_module^.globalsymtable)^.concatstabto(debuglist);
|
|
end;
|
|
{ all local types }
|
|
punitsymtable(st)^.concattypestabto(debuglist);
|
|
{ and all local symbols}
|
|
st^.concatstabto(debuglist);
|
|
{$else New_GDB}
|
|
write_gdb_info;
|
|
{$endIf Def New_GDB}
|
|
end;
|
|
{$endif GDB}
|
|
|
|
reset_global_defs;
|
|
|
|
{ tests, if all (interface) forwards are resolved }
|
|
if (Errorcount=0) then
|
|
begin
|
|
symtablestack^.check_forwards;
|
|
symtablestack^.allprivatesused;
|
|
end;
|
|
|
|
{ now we have a correct unit, change the symtable type }
|
|
current_module^.in_implementation:=false;
|
|
symtablestack^.symtabletype:=unitsymtable;
|
|
{$ifdef GDB}
|
|
punitsymtable(symtablestack)^.is_stab_written:=false;
|
|
{$endif GDB}
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
exit;
|
|
end;
|
|
|
|
{ generate imports }
|
|
if current_module^.uses_imports then
|
|
importlib^.generatelib;
|
|
|
|
{ insert own objectfile, or say that it's in a library
|
|
(no check for an .o when loading) }
|
|
if is_assembler_generated then
|
|
insertobjectfile
|
|
else
|
|
current_module^.flags:=current_module^.flags or uf_no_link;
|
|
|
|
if cs_local_browser in aktmoduleswitches then
|
|
current_module^.localsymtable:=refsymtable;
|
|
{ Write out the ppufile }
|
|
{$ifndef Dont_use_double_checksum}
|
|
store_interface_crc:=current_module^.interface_crc;
|
|
store_crc:=current_module^.crc;
|
|
{$endif Test_Double_checksum}
|
|
if (Errorcount=0) then
|
|
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false);
|
|
|
|
{$ifndef Dont_use_double_checksum}
|
|
if not(cs_compilesystem in aktmoduleswitches) then
|
|
if store_interface_crc<>current_module^.interface_crc then
|
|
Do_comment(V_Warning,current_module^.ppufilename^+' Interface CRC changed '+
|
|
tostr(store_crc)+'<>'+tostr(current_module^.interface_crc));
|
|
{$ifdef EXTDEBUG}
|
|
if not(cs_compilesystem in aktmoduleswitches) then
|
|
if (store_crc<>current_module^.crc) and simplify_ppu then
|
|
Do_comment(V_Warning,current_module^.ppufilename^+' implementation CRC changed '+
|
|
tostr(store_crc)+'<>'+tostr(current_module^.interface_crc));
|
|
{$endif EXTDEBUG}
|
|
{$endif ndef Dont_use_Double_checksum}
|
|
{ must be done only after local symtable ref stores !! }
|
|
closecurrentppu;
|
|
{$ifdef GDB}
|
|
pu:=pused_unit(usedunits.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if assigned(pu^.u^.globalsymtable) then
|
|
punitsymtable(pu^.u^.globalsymtable)^.is_stab_written:=false;
|
|
pu:=pused_unit(pu^.next);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
{ remove static symtable (=refsymtable) here to save some mem }
|
|
if not (cs_local_browser in aktmoduleswitches) then
|
|
begin
|
|
dispose(st,done);
|
|
current_module^.localsymtable:=nil;
|
|
end;
|
|
|
|
if is_assembler_generated then
|
|
begin
|
|
{ finish asmlist by adding segment starts }
|
|
insertsegment;
|
|
{ assemble }
|
|
create_objectfile;
|
|
end;
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure proc_program(islibrary : boolean);
|
|
var
|
|
st : psymtable;
|
|
hp : pmodule;
|
|
{$ifdef fixLeaksOnError}
|
|
names : Pstringcontainer;
|
|
{$else fixLeaksOnError}
|
|
names : Tstringcontainer;
|
|
{$endif fixLeaksOnError}
|
|
begin
|
|
DLLsource:=islibrary;
|
|
IsExe:=true;
|
|
parse_only:=false;
|
|
{ relocation works only without stabs under win32 !! PM }
|
|
{ internal assembler uses rva for stabs info
|
|
so it should work with relocated DLLs }
|
|
if RelocSection and
|
|
(target_info.target=target_i386_win32) and
|
|
(target_info.assem<>as_i386_pecoff) then
|
|
begin
|
|
aktglobalswitches:=aktglobalswitches+[cs_link_strip];
|
|
{ Warning stabs info does not work with reloc section !! }
|
|
if cs_debuginfo in aktmoduleswitches then
|
|
begin
|
|
Message1(parser_w_parser_reloc_no_debug,current_module^.mainsource^);
|
|
Message(parser_w_parser_win32_debug_needs_WN);
|
|
aktmoduleswitches:=aktmoduleswitches-[cs_debuginfo];
|
|
end;
|
|
end;
|
|
if islibrary then
|
|
begin
|
|
consume(_LIBRARY);
|
|
stringdispose(current_module^.modulename);
|
|
current_module^.modulename:=stringdup(pattern);
|
|
current_module^.islibrary:=true;
|
|
exportlib^.preparelib(pattern);
|
|
consume(_ID);
|
|
consume(_SEMICOLON);
|
|
end
|
|
else
|
|
{ is there an program head ? }
|
|
if token=_PROGRAM then
|
|
begin
|
|
consume(_PROGRAM);
|
|
stringdispose(current_module^.modulename);
|
|
current_module^.modulename:=stringdup(pattern);
|
|
if (target_info.target=target_i386_WIN32) then
|
|
exportlib^.preparelib(pattern);
|
|
consume(_ID);
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
idlist;
|
|
consume(_RKLAMMER);
|
|
end;
|
|
consume(_SEMICOLON);
|
|
end
|
|
else if (target_info.target=target_i386_WIN32) then
|
|
exportlib^.preparelib(current_module^.modulename^);
|
|
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module^.in_global:=false;
|
|
{ get correct output names }
|
|
current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^,true);
|
|
|
|
{ setup things using the global switches }
|
|
setupglobalswitches;
|
|
|
|
{ set implementation flag }
|
|
current_module^.in_implementation:=true;
|
|
|
|
{ insert after the unit symbol tables the static symbol table }
|
|
{ of the program }
|
|
st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
|
|
current_module^.localsymtable:=st;
|
|
symtablestack:=st;
|
|
refsymtable:=st;
|
|
|
|
{ necessary for browser }
|
|
loaded_units.insert(current_module);
|
|
|
|
{ load standard units (system,objpas,profile unit) }
|
|
loaddefaultunits;
|
|
|
|
{ reset }
|
|
lexlevel:=0;
|
|
|
|
{Load the units used by the program we compile.}
|
|
if token=_USES then
|
|
loadunits;
|
|
|
|
{ reset ranges/stabs in exported definitions }
|
|
reset_global_defs;
|
|
|
|
{ All units are read, now give them a number }
|
|
numberunits;
|
|
|
|
{Insert the name of the main program into the symbol table.}
|
|
if current_module^.modulename^<>'' then
|
|
{st^.insert(new(pprogramsym,init(current_module^.modulename^)));}
|
|
st^.insert(new(punitsym,init(current_module^.modulename^,punitsymtable(st))));
|
|
|
|
{ ...is also constsymtable, this is the symtable where }
|
|
{ the elements of enumeration types are inserted }
|
|
constsymtable:=st;
|
|
|
|
Message1(parser_u_parsing_implementation,current_module^.mainsource^);
|
|
|
|
{ reset }
|
|
procprefix:='';
|
|
|
|
{The program intialization needs an alias, so it can be called
|
|
from the bootstrap code.}
|
|
codegen_newprocedure;
|
|
gen_main_procsym('main',potype_proginit,st);
|
|
{$ifdef fixLeaksOnError}
|
|
new(names,init);
|
|
strContStack.push(names);
|
|
names^.insert('program_init');
|
|
names^.insert('PASCALMAIN');
|
|
names^.insert(target_os.cprefix+'main');
|
|
{$ifdef m68k}
|
|
if target_info.target=target_m68k_PalmOS then
|
|
names^.insert('PilotMain');
|
|
{$endif m68k}
|
|
compile_proc_body(names^,true,false);
|
|
if names <> PstringContainer(strContStack.pop) then
|
|
writeln('Problem with strContStack in pmodules (1)');
|
|
dispose(names,done);
|
|
{$else fixLeaksOnError}
|
|
names.init;
|
|
names.insert('program_init');
|
|
names.insert('PASCALMAIN');
|
|
names.insert(target_os.cprefix+'main');
|
|
{$ifdef m68k}
|
|
if target_info.target=target_m68k_PalmOS then
|
|
names.insert('PilotMain');
|
|
{$endif m68k}
|
|
compile_proc_body(names,true,false);
|
|
names.done;
|
|
{$endif fixLeaksOnError}
|
|
|
|
{ avoid self recursive destructor call !! PM }
|
|
aktprocsym^.definition^.localst:=nil;
|
|
|
|
{ consider these symbols as global ones }
|
|
{ for browser }
|
|
current_module^.globalsymtable:=current_module^.localsymtable;
|
|
current_module^.localsymtable:=nil;
|
|
|
|
If ResourceStringList<>Nil then
|
|
begin
|
|
insertresourcestrings;
|
|
WriteResourceFile(Current_module^.ModuleName^);
|
|
end;
|
|
|
|
codegen_doneprocedure;
|
|
|
|
{ finalize? }
|
|
if token=_FINALIZATION then
|
|
begin
|
|
{ set module options }
|
|
current_module^.flags:=current_module^.flags or uf_finalize;
|
|
|
|
{ Compile the finalize }
|
|
codegen_newprocedure;
|
|
gen_main_procsym(current_module^.modulename^+'_finalize',potype_unitfinalize,st);
|
|
{$ifdef fixLeaksOnError}
|
|
new(names,init);
|
|
strContStack.push(names);
|
|
names^.insert('FINALIZE$$'+current_module^.modulename^);
|
|
names^.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
|
|
compile_proc_body(names^,true,false);
|
|
if names <> PstringContainer(strContStack.pop) then
|
|
writeln('Problem with strContStack in pmodules (1)');
|
|
dispose(names,done);
|
|
{$else fixLeaksOnError}
|
|
names.init;
|
|
names.insert('FINALIZE$$'+current_module^.modulename^);
|
|
names.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
|
|
compile_proc_body(names,true,false);
|
|
names.done;
|
|
{$endif fixLeaksOnError}
|
|
codegen_doneprocedure;
|
|
end;
|
|
|
|
{ consume the last point }
|
|
consume(_POINT);
|
|
|
|
{$ifdef New_GDB}
|
|
write_gdb_info;
|
|
{$endIf Def New_GDB}
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
exit;
|
|
end;
|
|
|
|
{ test static symtable }
|
|
if (Errorcount=0) then
|
|
begin
|
|
st^.allsymbolsused;
|
|
st^.allprivatesused;
|
|
end;
|
|
|
|
{ generate imports }
|
|
if current_module^.uses_imports then
|
|
importlib^.generatelib;
|
|
|
|
if islibrary or
|
|
(target_info.target=target_i386_WIN32) then
|
|
exportlib^.generatelib;
|
|
|
|
|
|
{ insert heap }
|
|
insertResourceTablesTable;
|
|
insertinitfinaltable;
|
|
insertheap;
|
|
inserttargetspecific;
|
|
|
|
datasize:=symtablestack^.datasize;
|
|
|
|
{ finish asmlist by adding segment starts }
|
|
insertsegment;
|
|
|
|
{ insert own objectfile }
|
|
insertobjectfile;
|
|
|
|
{ assemble and link }
|
|
create_objectfile;
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
exit;
|
|
end;
|
|
|
|
{ create the executable when we are at level 1 }
|
|
if (compile_level=1) then
|
|
begin
|
|
{ insert all .o files from all loaded units }
|
|
hp:=pmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
Linker^.AddModuleFiles(hp);
|
|
hp:=pmodule(hp^.next);
|
|
end;
|
|
{ write .def file }
|
|
if (cs_link_deffile in aktglobalswitches) then
|
|
deffile.writefile;
|
|
{ finally we can create a executable }
|
|
if (not current_module^.is_unit) then
|
|
begin
|
|
if DLLSource then
|
|
Linker^.MakeSharedLibrary
|
|
else
|
|
Linker^.MakeExecutable;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.183 2000-01-16 22:17:12 peter
|
|
* renamed call_offset to para_offset
|
|
|
|
Revision 1.182 2000/01/16 14:15:33 jonas
|
|
* changed "with object_type" construct because of bug in the
|
|
compiler
|
|
|
|
Revision 1.181 2000/01/12 10:30:15 peter
|
|
* align codesegment at the end after main proc
|
|
|
|
Revision 1.180 2000/01/11 17:16:05 jonas
|
|
* removed a lot of memory leaks when an error is encountered (caused by
|
|
procinfo and pstringcontainers). There are still plenty left though :)
|
|
|
|
Revision 1.179 2000/01/11 09:52:07 peter
|
|
* fixed placing of .sl directories
|
|
* use -b again for base-file selection
|
|
* fixed group writing for linux with smartlinking
|
|
|
|
Revision 1.178 2000/01/07 01:14:29 peter
|
|
* updated copyright to 2000
|
|
|
|
Revision 1.177 1999/12/20 22:29:26 pierre
|
|
* relocation with debug info in rva (only with internal compiler)
|
|
|
|
Revision 1.176 1999/12/10 10:02:53 peter
|
|
* only check relocsection for win32
|
|
|
|
Revision 1.175 1999/11/30 10:40:44 peter
|
|
+ ttype, tsymlist
|
|
|
|
Revision 1.174 1999/11/29 16:24:52 pierre
|
|
* bug in previous commit corrected
|
|
|
|
Revision 1.173 1999/11/29 15:18:27 pierre
|
|
+ allow exports in win32 executables
|
|
|
|
Revision 1.172 1999/11/24 11:41:05 pierre
|
|
* defaultsymtablestack is now restored after parser.compile
|
|
|
|
Revision 1.171 1999/11/22 22:21:46 pierre
|
|
* Compute correct Exe Filenam
|
|
|
|
Revision 1.170 1999/11/22 00:23:09 pierre
|
|
* also complain about unused functions in program
|
|
|
|
Revision 1.169 1999/11/20 01:19:10 pierre
|
|
* DLL index used for win32 target with DEF file
|
|
+ DLL initialization/finalization support
|
|
|
|
Revision 1.168 1999/11/18 23:35:40 pierre
|
|
* avoid double warnings
|
|
|
|
Revision 1.167 1999/11/18 15:34:47 pierre
|
|
* Notes/Hints for local syms changed to
|
|
Set_varstate function
|
|
|
|
Revision 1.166 1999/11/17 17:05:02 pierre
|
|
* Notes/hints changes
|
|
|
|
Revision 1.165 1999/11/15 15:03:47 pierre
|
|
* Pavel's changes for reloc section in executable
|
|
+ warning that -g needs -WN under win32
|
|
|
|
Revision 1.164 1999/11/09 23:46:00 pierre
|
|
* power search for ** operator not in browser
|
|
* DBX support work, still does not work !
|
|
|
|
Revision 1.163 1999/11/09 13:00:37 peter
|
|
* define FPC_DELPHI,FPC_OBJFPC,FPC_TP,FPC_GPC
|
|
* initial support for ansistring default with modes
|
|
|
|
Revision 1.162 1999/11/06 14:34:22 peter
|
|
* truncated log to 20 revs
|
|
|
|
Revision 1.161 1999/11/02 15:06:57 peter
|
|
* import library fixes for win32
|
|
* alignment works again
|
|
|
|
Revision 1.160 1999/10/21 14:29:37 peter
|
|
* redesigned linker object
|
|
+ library support for linux (only procedures can be exported)
|
|
|
|
Revision 1.159 1999/10/12 21:20:45 florian
|
|
* new codegenerator compiles again
|
|
|
|
Revision 1.158 1999/10/03 19:44:42 peter
|
|
* removed objpasunit reference, tvarrec is now searched in systemunit
|
|
where it already was located
|
|
|
|
Revision 1.157 1999/09/27 23:44:54 peter
|
|
* procinfo is now a pointer
|
|
* support for result setting in sub procedure
|
|
|
|
Revision 1.156 1999/09/20 16:39:00 peter
|
|
* cs_create_smart instead of cs_smartlink
|
|
* -CX is create smartlink
|
|
* -CD is create dynamic, but does nothing atm.
|
|
|
|
Revision 1.155 1999/09/16 23:05:54 florian
|
|
* m68k compiler is again compilable (only gas writer, no assembler reader)
|
|
|
|
Revision 1.154 1999/09/16 14:18:12 pierre
|
|
+ warning if truncate unit name found
|
|
|
|
Revision 1.153 1999/09/13 22:56:17 peter
|
|
* fixed crashes under plain dos
|
|
|
|
Revision 1.152 1999/09/01 22:18:42 peter
|
|
* moved parsing interface/implementation to -vu
|
|
|
|
Revision 1.151 1999/08/31 15:51:10 pierre
|
|
* in_second_compile cleaned up, in_compile and in_second_load added
|
|
|
|
Revision 1.150 1999/08/30 16:21:40 pierre
|
|
* tempclosing of ppufiles under dos was wrong
|
|
|
|
Revision 1.149 1999/08/28 15:34:19 florian
|
|
* bug 519 fixed
|
|
|
|
Revision 1.148 1999/08/27 14:53:00 pierre
|
|
* double checksum problem solved
|
|
|
|
Revision 1.147 1999/08/27 10:57:56 pierre
|
|
+ define SHORT_ON_FILE_HANDLES for DOS targets
|
|
causes tempclose of ppufiles
|
|
+ double_checksum code released
|
|
(you can try with -dDONT_USE_DOUBLE_CHECKSUM to see the difference)
|
|
this allow second compilation of compiler without any
|
|
unit recompilation !!!!
|
|
|
|
Revision 1.146 1999/08/26 21:16:21 peter
|
|
* write date of the compiler into the executable
|
|
|
|
Revision 1.145 1999/08/26 20:24:44 michael
|
|
+ Hopefuly last fixes for resourcestrings
|
|
|
|
Revision 1.144 1999/08/24 22:38:53 michael
|
|
* more resourcestring changes
|
|
|
|
Revision 1.143 1999/08/24 12:01:34 michael
|
|
+ changes for resourcestrings
|
|
|
|
Revision 1.142 1999/08/16 15:35:27 pierre
|
|
* fix for DLL relocation problems
|
|
* external bss vars had wrong stabs for pecoff
|
|
+ -WB11000000 to specify default image base, allows to
|
|
load several DLLs with debugging info included
|
|
(relocatable DLL are stripped because the relocation
|
|
of the .Stab section is misplaced by ldw)
|
|
|
|
}
|