mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 13:09:35 +02:00
5ad339b3d8
(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
1124 lines
40 KiB
ObjectPascal
1124 lines
40 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998 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;
|
|
|
|
{define TEST_IMPL does not work well }
|
|
|
|
interface
|
|
|
|
uses
|
|
files;
|
|
|
|
procedure addlinkerfiles(hp:pmodule);
|
|
function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;
|
|
procedure proc_unit;
|
|
procedure proc_program(islibrary : boolean);
|
|
|
|
implementation
|
|
|
|
uses
|
|
cobjects,verbose,systems,globals,
|
|
symtable,aasm,hcodegen,
|
|
link,assemble,import
|
|
{$ifdef i386}
|
|
,i386
|
|
{$endif}
|
|
{$ifdef m68k}
|
|
,m68k
|
|
{$endif}
|
|
,scanner,pbase,psystem,pdecl,psub,parser;
|
|
|
|
|
|
procedure addlinkerfiles(hp:pmodule);
|
|
begin
|
|
with hp^ do
|
|
begin
|
|
while not linkofiles.empty do
|
|
Linker.AddObject(linkofiles.Get);
|
|
while not linksharedlibs.empty do
|
|
Linker.AddSharedLibrary(linksharedlibs.Get);
|
|
while not linkstaticlibs.empty do
|
|
Linker.AddStaticLibrary(linkstaticlibs.Get);
|
|
end;
|
|
end;
|
|
|
|
procedure insertsegment;
|
|
|
|
procedure fixseg(p:paasmoutput;sec:tsection);
|
|
begin
|
|
p^.insert(new(pai_section,init(sec)));
|
|
if (cs_smartlink in aktswitches) 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_smartlink in aktswitches))
|
|
{$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 '+version_string+' for '+target_string+' - '+target_info.short_name)));
|
|
end;
|
|
{ Insert start and end of sections }
|
|
fixseg(codesegment,sec_code);
|
|
fixseg(datasegment,sec_data);
|
|
fixseg(bsssegment,sec_bss);
|
|
fixseg(consts,sec_data);
|
|
end;
|
|
|
|
procedure insertheap;
|
|
begin
|
|
if (cs_smartlink in aktswitches) 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_OS2 : ;
|
|
{$endif i386}
|
|
{$ifdef m68k}
|
|
target_Mac68K : bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
|
|
{$endif m68k}
|
|
else
|
|
bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
|
|
end;
|
|
datasegment^.concat(new(pai_symbol,init_global('HEAPSIZE')));
|
|
datasegment^.concat(new(pai_const,init_32bit(heapsize)));
|
|
end;
|
|
|
|
|
|
procedure inserttargetspecific;
|
|
var
|
|
i : longint;
|
|
begin
|
|
{$ifdef i386}
|
|
case target_info.target of
|
|
target_GO32V2 : begin
|
|
{ stacksize can be specified }
|
|
datasegment^.concat(new(pai_symbol,init_global('__stklen')));
|
|
datasegment^.concat(new(pai_const,init_32bit(stacksize)));
|
|
end;
|
|
target_WIN32 : begin
|
|
{ Generate an external entry to be sure that _mainCRTStarup will be
|
|
linked, can't use concat_external because those aren't written for
|
|
asw (PFV) }
|
|
datasegment^.concat(new(pai_const,init_symbol('_mainCRTStartup')));
|
|
{ generate the last entry for the imports directory, is done
|
|
in the ld script }
|
|
{ if not(assigned(importssection)) then
|
|
importssection:=new(paasmoutput,init);
|
|
importssection^.concat(new(pai_section,init_idata(3)));
|
|
for i:=1 to 5 do
|
|
importssection^.concat(new(pai_const,init_32bit(0))); }
|
|
end;
|
|
end;
|
|
{$endif i386}
|
|
end;
|
|
|
|
|
|
|
|
procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean);
|
|
var
|
|
loaded_unit : pmodule;
|
|
b : byte;
|
|
checksum,
|
|
{$ifndef NEWPPU}
|
|
count,
|
|
{$endif NEWPPU}
|
|
nextmapentry : longint;
|
|
hs : string;
|
|
begin
|
|
{ init the map }
|
|
new(hp^.map);
|
|
nextmapentry:=1;
|
|
|
|
{$ifdef NEWPPU}
|
|
{ load the used units from interface }
|
|
b:=hp^.ppufile^.readentry;
|
|
if b=ibloadunit_int then
|
|
begin
|
|
while not hp^.ppufile^.endofentry do
|
|
begin
|
|
hs:=hp^.ppufile^.getstring;
|
|
checksum:=hp^.ppufile^.getlongint;
|
|
loaded_unit:=loadunit(hs,false,false);
|
|
if hp^.compiled then
|
|
exit;
|
|
{ if the crc of a used unit is the same as written to the
|
|
PPU file, we needn't to recompile the current unit }
|
|
if (loaded_unit^.crc<>checksum) then
|
|
begin
|
|
{ we have to compile the current unit remove stuff which isn't
|
|
needed }
|
|
{ forget the map }
|
|
dispose(hp^.map);
|
|
hp^.map:=nil;
|
|
{ remove the ppufile }
|
|
dispose(hp^.ppufile,done);
|
|
hp^.ppufile:=nil;
|
|
{ recompile or give an fatal error }
|
|
if not(hp^.sources_avail) then
|
|
Message1(unit_f_cant_compile_unit,hp^.modulename^)
|
|
else
|
|
begin
|
|
if assigned(oldhp^.current_inputfile) then
|
|
oldhp^.current_inputfile^.tempclose;
|
|
compile(hp^.mainsource^,compile_system);
|
|
if (not oldhp^.compiled) and assigned(oldhp^.current_inputfile) then
|
|
oldhp^.current_inputfile^.tempreopen;
|
|
end;
|
|
exit;
|
|
end;
|
|
{ setup the map entry for deref }
|
|
hp^.map^[nextmapentry]:=loaded_unit^.symtable;
|
|
inc(nextmapentry);
|
|
if nextmapentry>maxunits then
|
|
Message(unit_f_too_much_units);
|
|
end;
|
|
{ ok, now load the unit }
|
|
hp^.symtable:=new(punitsymtable,load(hp));
|
|
{ if this is the system unit insert the intern symbols }
|
|
make_ref:=false;
|
|
if compile_system then
|
|
insertinternsyms(psymtable(hp^.symtable));
|
|
make_ref:=true;
|
|
end;
|
|
{ now only read the implementation part }
|
|
hp^.in_implementation:=true;
|
|
{ load the used units from implementation }
|
|
b:=hp^.ppufile^.readentry;
|
|
if b=ibloadunit_imp then
|
|
begin
|
|
while not hp^.ppufile^.endofentry do
|
|
begin
|
|
hs:=hp^.ppufile^.getstring;
|
|
checksum:=hp^.ppufile^.getlongint;
|
|
loaded_unit:=loadunit(hs,false,false);
|
|
if hp^.compiled then
|
|
exit;
|
|
end;
|
|
end;
|
|
{$ifdef NEWPPU}
|
|
{ The next entry should be an ibendimplementation }
|
|
b:=hp^.ppufile^.readentry;
|
|
if b <> ibendimplementation then
|
|
Message1(unit_f_ppu_invalid_entry,tostr(b));
|
|
{ The next entry should be an ibend }
|
|
b:=hp^.ppufile^.readentry;
|
|
if b <> ibend then
|
|
Message1(unit_f_ppu_invalid_entry,tostr(b));
|
|
{$endif}
|
|
hp^.ppufile^.close;
|
|
{! dispose(hp^.ppufile,done);}
|
|
{$else}
|
|
{ load the used units from interface }
|
|
hp^.ppufile^.read_data(b,1,count);
|
|
while (b=ibloadunit) do
|
|
begin
|
|
{ read unit name }
|
|
hp^.ppufile^.read_data(hs[0],1,count);
|
|
hp^.ppufile^.read_data(hs[1],byte(hs[0]),count);
|
|
hp^.ppufile^.read_data(checksum,4,count);
|
|
loaded_unit:=loadunit(hs,false,false);
|
|
if hp^.compiled then
|
|
exit;
|
|
{ if the crc of a used unit is the same as }
|
|
{ written to the PPU file, we needn't to }
|
|
{ recompile the current unit }
|
|
if (loaded_unit^.crc<>checksum) then
|
|
begin
|
|
{ we have to compile the current unit }
|
|
{ remove stuff which isn't needed }
|
|
{ forget the map }
|
|
dispose(hp^.map);
|
|
hp^.map:=nil;
|
|
hp^.ppufile^.close;
|
|
dispose(hp^.ppufile,done);
|
|
hp^.ppufile:=nil;
|
|
if not(hp^.sources_avail) then
|
|
Message1(unit_f_cant_compile_unit,hp^.modulename^)
|
|
else
|
|
begin
|
|
if assigned(oldhp^.current_inputfile) then
|
|
oldhp^.current_inputfile^.tempclose;
|
|
compile(hp^.mainsource^,compile_system);
|
|
if (not oldhp^.compiled) and assigned(oldhp^.current_inputfile) then
|
|
oldhp^.current_inputfile^.tempreopen;
|
|
end;
|
|
exit;
|
|
end;
|
|
{ setup the map entry for deref }
|
|
hp^.map^[nextmapentry]:=loaded_unit^.symtable;
|
|
inc(nextmapentry);
|
|
if nextmapentry>maxunits then
|
|
Message(unit_f_too_much_units);
|
|
{ read until ibend }
|
|
hp^.ppufile^.read_data(b,1,count);
|
|
end;
|
|
{ ok, now load the unit }
|
|
hp^.symtable:=new(punitsymtable,load(hp));
|
|
{ if this is the system unit insert the intern }
|
|
{ symbols }
|
|
make_ref:=false;
|
|
if compile_system then
|
|
insertinternsyms(psymtable(hp^.symtable));
|
|
make_ref:=true;
|
|
{ now only read the implementation part }
|
|
hp^.in_implementation:=true;
|
|
{ load the used units from implementation }
|
|
hp^.ppufile^.read_data(b,1,count);
|
|
while (b<>ibend) and (b=ibloadunit) do
|
|
begin
|
|
{ read unit name }
|
|
hp^.ppufile^.read_data(hs[0],1,count);
|
|
hp^.ppufile^.read_data(hs[1],byte(hs[0]),count);
|
|
hp^.ppufile^.read_data(checksum,4,count);
|
|
loaded_unit:=loadunit(hs,false,false);
|
|
if hp^.compiled then exit;
|
|
{ if the crc of a used unit is the same as }
|
|
{ written to the PPU file, we needn't to }
|
|
{ recompile the current unit }
|
|
{ but for the implementation part }
|
|
{ the written crc is false, because }
|
|
{ not defined when writing the ppufile !! }
|
|
{$ifdef TEST_IMPL}
|
|
if (checksum<>0) and (loaded_unit^.crc<>checksum) then
|
|
begin
|
|
{ we have to compile the current unit }
|
|
{ remove stuff which isn't needed }
|
|
{ forget the map }
|
|
dispose(hp^.map);
|
|
hp^.map:=nil;
|
|
hp^.ppufile^.close;
|
|
dispose(hp^.ppufile,done);
|
|
hp^.ppufile:=nil;
|
|
if not(hp^.sources_avail) then
|
|
Message1(unit_f_cant_compile_unit,hp^.modulename^)
|
|
else
|
|
begin
|
|
oldhp^.current_inputfile^.tempclose;
|
|
compile(hp^.mainsource^,compile_system);
|
|
oldhp^.current_inputfile^.tempclose;
|
|
end;
|
|
exit;
|
|
end;
|
|
{$endif TEST_IMPL}
|
|
{ read until ibend }
|
|
hp^.ppufile^.read_data(b,1,count);
|
|
end;
|
|
hp^.ppufile^.close;
|
|
{$endif}
|
|
dispose(hp^.map);
|
|
hp^.map:=nil;
|
|
end;
|
|
|
|
|
|
function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;
|
|
var
|
|
st : punitsymtable;
|
|
old_current_module,hp,nextmodule : pmodule;
|
|
pu : pused_unit;
|
|
hs : pstring;
|
|
begin
|
|
old_current_module:=current_module;
|
|
{ be sure not to mix lines from different files }
|
|
{ update_line; }
|
|
{ unit not found }
|
|
st:=nil;
|
|
{ search all loaded units }
|
|
hp:=pmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if hp^.modulename^=s then
|
|
begin
|
|
{ the unit is already registered }
|
|
{ and this means that the unit }
|
|
{ is already compiled }
|
|
{ else there is a cyclic unit use }
|
|
if assigned(hp^.symtable) then
|
|
st:=punitsymtable(hp^.symtable)
|
|
else
|
|
begin
|
|
{ recompile the unit ? }
|
|
if (not current_module^.in_implementation) and (hp^.in_implementation) then
|
|
Message(unit_f_circular_unit_reference);
|
|
end;
|
|
break;
|
|
end;
|
|
{ the next unit }
|
|
hp:=pmodule(hp^.next);
|
|
end;
|
|
{ no error and the unit isn't loaded }
|
|
if not(assigned(hp)) and (st=nil) then
|
|
begin
|
|
{ generates a new unit info record }
|
|
hp:=new(pmodule,init(s,true));
|
|
{ now we can register the unit }
|
|
loaded_units.insert(hp);
|
|
current_module:=hp;
|
|
{ force build ? }
|
|
if (hp^.do_compile) or (hp^.sources_avail and do_build) then
|
|
begin
|
|
{ we needn't the ppufile }
|
|
if assigned(hp^.ppufile) then
|
|
begin
|
|
dispose(hp^.ppufile,done);
|
|
hp^.ppufile:=nil;
|
|
end;
|
|
if not(hp^.sources_avail) then
|
|
Message1(unit_f_cant_compile_unit,hp^.modulename^)
|
|
else
|
|
begin
|
|
if assigned(old_current_module^.current_inputfile) then
|
|
old_current_module^.current_inputfile^.tempclose;
|
|
compile(hp^.mainsource^,compile_system);
|
|
if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then
|
|
old_current_module^.current_inputfile^.tempreopen;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ only reassemble ? }
|
|
if (hp^.do_assemble) then
|
|
OnlyAsm(hp^.asmfilename^);
|
|
{ we should know there the PPU file else it's an error and
|
|
we can't load the unit }
|
|
{$ifdef NEWPPU}
|
|
{ if hp^.ppufile^.name^<>'' then}
|
|
{$else}
|
|
if hp^.ppufile^.name^<>'' then
|
|
{$endif}
|
|
load_ppu(old_current_module,hp,compile_system);
|
|
{ add the files for the linker }
|
|
addlinkerfiles(hp);
|
|
end;
|
|
{ register the unit _once_ }
|
|
usedunits.concat(new(pused_unit,init(hp,0)));
|
|
{ the unit is written, so we can set the symtable type }
|
|
{ to unitsymtable, else we get some dupid errors }
|
|
{ this is not the right place because of the }
|
|
{ ready label }
|
|
{ psymtable(hp^.symtable)^.symtabletype:=unitsymtable; }
|
|
{ placed at this end of proc_unit }
|
|
psymtable(hp^.symtable)^.unitid:=0;
|
|
{ reset the unitnumbers for the other units }
|
|
pu:=pused_unit(old_current_module^.used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
psymtable(pu^.u^.symtable)^.unitid:=pu^.unitid;
|
|
pu:=pused_unit(pu^.next);
|
|
end;
|
|
end
|
|
else
|
|
if assigned(hp) and (st=nil) then
|
|
begin
|
|
{ we have to compile the unit again, but it is already inserted !!}
|
|
{ we may have problem with the lost symtable !! }
|
|
current_module:=hp;
|
|
{ we must preserve the unit chain }
|
|
nextmodule:=pmodule(hp^.next);
|
|
{ we have to cleanup a little }
|
|
hp^.special_done;
|
|
new(hs);
|
|
hs^:=hp^.mainsource^;
|
|
hp^.init(hs^,true);
|
|
dispose(hs);
|
|
{ we must preserve the unit chain }
|
|
hp^.next:=nextmodule;
|
|
if assigned(hp^.ppufile) then
|
|
load_ppu(old_current_module,hp,compile_system)
|
|
else
|
|
begin
|
|
{$ifdef UseBrowser}
|
|
{ here we need to remove the names ! }
|
|
hp^.sourcefiles.done;
|
|
hp^.sourcefiles.init;
|
|
{$endif not UseBrowser}
|
|
if assigned(old_current_module^.current_inputfile) then
|
|
old_current_module^.current_inputfile^.tempclose;
|
|
Message1(parser_d_compiling_second_time,hp^.mainsource^);
|
|
compile(hp^.mainsource^,compile_system);
|
|
if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then
|
|
old_current_module^.current_inputfile^.tempreopen;
|
|
end;
|
|
current_module^.compiled:=true;
|
|
end;
|
|
{ set the old module }
|
|
current_module:=old_current_module;
|
|
{ the current module uses the unit hp }
|
|
current_module^.used_units.concat(new(pused_unit,init(hp,0)));
|
|
pused_unit(current_module^.used_units.last)^.in_uses:=in_uses;
|
|
if in_uses and not current_module^.in_implementation then
|
|
pused_unit(current_module^.used_units.last)^.in_interface:=true;
|
|
loadunit:=hp;
|
|
end;
|
|
|
|
|
|
procedure loadunits;
|
|
var
|
|
s : stringid;
|
|
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);
|
|
hp2:=loadunit(s,false,true);
|
|
if current_module^.compiled then
|
|
exit;
|
|
refsymtable^.insert(new(punitsym,init(s,hp2^.symtable)));
|
|
|
|
if token=COMMA then
|
|
begin
|
|
pattern:='';
|
|
consume(COMMA);
|
|
end
|
|
else
|
|
break;
|
|
until false;
|
|
consume(SEMICOLON);
|
|
|
|
{ now insert the units in the symtablestack }
|
|
hp:=pused_unit(current_module^.used_units.first);
|
|
{ set the symtable to systemunit so it gets reorderd correctly }
|
|
symtablestack:=systemunit;
|
|
while assigned(hp) do
|
|
begin
|
|
{$IfDef GDB}
|
|
if (cs_debuginfo in aktswitches) and
|
|
not hp^.is_stab_written then
|
|
begin
|
|
punitsymtable(hp^.u^.symtable)^.concattypestabto(debuglist);
|
|
hp^.is_stab_written:=true;
|
|
hp^.unitid:=psymtable(hp^.u^.symtable)^.unitid;
|
|
end;
|
|
{$EndIf GDB}
|
|
if hp^.in_uses then
|
|
begin
|
|
hp3:=symtablestack;
|
|
while assigned(hp3) do
|
|
begin
|
|
{ insert units only once ! }
|
|
if hp^.u^.symtable=hp3 then
|
|
break;
|
|
hp3:=hp3^.next;
|
|
{ unit isn't inserted }
|
|
if hp3=nil then
|
|
begin
|
|
psymtable(hp^.u^.symtable)^.next:=symtablestack;
|
|
symtablestack:=psymtable(hp^.u^.symtable);
|
|
{$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 parse_implementation_uses(symt:Psymtable);
|
|
|
|
var
|
|
old_module_in_implementation : boolean;
|
|
begin
|
|
if token=_USES then
|
|
begin
|
|
old_module_in_implementation:=module_in_implementation;
|
|
module_in_implementation:=true;
|
|
current_module^.in_implementation:=true;
|
|
symt^.symtabletype:=unitsymtable;
|
|
loadunits;
|
|
symt^.symtabletype:=globalsymtable;
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
module_in_implementation:=old_module_in_implementation;
|
|
end;
|
|
end;
|
|
|
|
procedure proc_unit;
|
|
|
|
var
|
|
{ unitname : stringid; }
|
|
names:Tstringcontainer;
|
|
p : psymtable;
|
|
unitst : punitsymtable;
|
|
pu : pused_unit;
|
|
s1,s2 : ^string; {Saves stack space}
|
|
begin
|
|
consume(_UNIT);
|
|
|
|
if token=ID then
|
|
begin
|
|
{ create filenames and unit name }
|
|
current_module^.SetFileName(current_module^.current_inputfile^.path^,current_module^.current_inputfile^.name^);
|
|
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(current_module^.current_inputfile^.name^);
|
|
if (cs_compilesystem in aktswitches) then
|
|
begin
|
|
if (cs_check_unit_name in aktswitches) and
|
|
((length(current_module^.modulename^)>8) or
|
|
(current_module^.modulename^<>s1^) or
|
|
(current_module^.modulename^<>s2^)) then
|
|
Message1(unit_e_illegal_unit_name,s1^);
|
|
end
|
|
else
|
|
if (current_module^.modulename^=s1^) then
|
|
Message(unit_w_switch_us_missed);
|
|
dispose(s2);
|
|
dispose(s1);
|
|
|
|
{ Add Object File }
|
|
if (cs_smartlink in aktswitches) then
|
|
current_module^.linkstaticlibs.insert(current_module^.libfilename^)
|
|
else
|
|
current_module^.linkofiles.insert(current_module^.objfilename^);
|
|
end;
|
|
|
|
consume(ID);
|
|
consume(SEMICOLON);
|
|
consume(_INTERFACE);
|
|
|
|
{ this should be placed after uses !!}
|
|
{$ifndef UseNiceNames}
|
|
procprefix:='_'+current_module^.modulename^+'$$';
|
|
{$else UseNiceNames}
|
|
procprefix:='_'+tostr(length(current_module^.unitname^))+lowercase(current_module^.unitname^)+'_';
|
|
{$endif UseNiceNames}
|
|
|
|
parse_only:=true;
|
|
|
|
{ generate now the global symboltable }
|
|
p:=new(punitsymtable,init(globalsymtable,current_module^.modulename^));
|
|
refsymtable:=p;
|
|
unitst:=punitsymtable(p);
|
|
|
|
{ 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)));
|
|
{ set the symbol table for the current unit }
|
|
{ this must be set later for interdependency }
|
|
{ current_module^.symtable:=psymtable(p); }
|
|
|
|
{ a unit compiled at command line must be inside the loaded_unit list }
|
|
if (compile_level=1) then
|
|
begin
|
|
loaded_units.insert(current_module);
|
|
if cs_unit_to_lib in initswitches then
|
|
begin
|
|
current_module^.flags:=current_module^.flags or uf_in_library;
|
|
if cs_shared_lib in initswitches then
|
|
current_module^.flags:=current_module^.flags or uf_shared_library;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ insert qualifier for the system unit (allows system.writeln) }
|
|
if not(cs_compilesystem in aktswitches) then
|
|
begin
|
|
{ insert the system unit }
|
|
{ it is allways the first }
|
|
systemunit^.next:=nil;
|
|
symtablestack:=systemunit;
|
|
refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
|
|
|
|
if token=_USES then
|
|
begin
|
|
unitst^.symtabletype:=unitsymtable;
|
|
loadunits;
|
|
{ has it been compiled at a higher level ?}
|
|
if current_module^.compiled then
|
|
exit;
|
|
unitst^.symtabletype:=globalsymtable;
|
|
end;
|
|
|
|
{ ... but insert the symbol table later }
|
|
p^.next:=symtablestack;
|
|
symtablestack:=p;
|
|
end
|
|
else
|
|
{ while compiling a system unit, some types are directly inserted }
|
|
begin
|
|
p^.next:=symtablestack;
|
|
symtablestack:=p;
|
|
insert_intern_types(p);
|
|
end;
|
|
|
|
{ displaced for inter-dependency considerations }
|
|
current_module^.symtable:=psymtable(p);
|
|
|
|
constsymtable:=symtablestack;
|
|
{ ... parse the declarations }
|
|
read_interface_declarations;
|
|
consume(_IMPLEMENTATION);
|
|
|
|
parse_only:=false;
|
|
refsymtable^.number_defs;
|
|
|
|
{$ifdef GDB}
|
|
{ add all used definitions even for implementation}
|
|
if (cs_debuginfo in aktswitches) then
|
|
begin
|
|
{ all types }
|
|
punitsymtable(refsymtable)^.concattypestabto(debuglist);
|
|
{ and all local symbols}
|
|
refsymtable^.concatstabto(debuglist);
|
|
end;
|
|
{$endif GDB}
|
|
{ for interdependent units
|
|
the crc is included in the ppufile
|
|
but it is not known when writing the first ppufile
|
|
so I tried to add a fake writing of the ppu
|
|
just to get the CRC
|
|
but the result is different for the real CRC
|
|
it calculates after, I don't know why
|
|
|
|
Answer:
|
|
-------
|
|
When reading the interface part, the compiler assumes
|
|
that all registers are modified by a procedure
|
|
usedinproc:=$ff !
|
|
If the definition is read, the compiler determines
|
|
the used registers and write the correct value
|
|
to usedinproc
|
|
|
|
only_calculate_crc:=true;
|
|
writeunitas(current_module^.current_inputfile^.path^+current_module^.current_inputfile^.name^+
|
|
+'.PPS',punitsymtable(symtablestack));
|
|
only_calculate_crc:=false;
|
|
}
|
|
{ generates static symbol table }
|
|
p:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
|
|
{ must be done only after _USES !! (PM)
|
|
refsymtable:=p;}
|
|
|
|
{Generate a procsym.}
|
|
aktprocsym:=new(Pprocsym,init(current_module^.modulename^+'_init'));
|
|
aktprocsym^.definition:=new(Pprocdef,init);
|
|
aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit;
|
|
aktprocsym^.definition^.setmangledname(current_module^.modulename^+'_init');
|
|
|
|
{The generated procsym has a local symtable. Discard it and turn
|
|
it into the static one.}
|
|
dispose(aktprocsym^.definition^.localst,done);
|
|
aktprocsym^.definition^.localst:=p;
|
|
|
|
|
|
{ testing !!!!!!!!! }
|
|
{ we set the interface part as a unitsymtable }
|
|
{ for the case we need to compile another unit }
|
|
|
|
{ remove the globalsymtable from the symtable stack }
|
|
{ to reinsert it after loading the implementation units }
|
|
symtablestack:=unitst^.next;
|
|
|
|
parse_implementation_uses(unitst);
|
|
{ now we can change refsymtable }
|
|
refsymtable:=p;
|
|
|
|
{ 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}
|
|
|
|
{ set some informations }
|
|
procinfo.retdef:=voiddef;
|
|
procinfo._class:=nil;
|
|
procinfo.call_offset:=8;
|
|
{ for temporary values }
|
|
procinfo.framepointer:=frame_pointer;
|
|
{ clear flags }
|
|
procinfo.flags:=0;
|
|
|
|
{Reset the codegenerator.}
|
|
codegen_newprocedure;
|
|
|
|
names.init;
|
|
names.insert(current_module^.modulename^+'_init');
|
|
names.insert('INIT$$'+current_module^.modulename^);
|
|
compile_proc_body(names,true,false);
|
|
names.done;
|
|
|
|
codegen_doneprocedure;
|
|
|
|
consume(POINT);
|
|
|
|
|
|
{ size of the static data }
|
|
datasize:=symtablestack^.datasize;
|
|
|
|
{ unsed static symbols ? }
|
|
symtablestack^.allsymbolsused;
|
|
|
|
{$ifdef GDB}
|
|
{ add all used definitions even for implementation}
|
|
if (cs_debuginfo in aktswitches) then
|
|
begin
|
|
{ all types }
|
|
punitsymtable(symtablestack)^.concattypestabto(debuglist);
|
|
{ and all local symbols}
|
|
symtablestack^.concatstabto(debuglist);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
current_module^.in_implementation:=false;
|
|
{ deletes all symtables generated in the implementation part }
|
|
while symtablestack^.symtabletype<>globalsymtable do
|
|
dellexlevel;
|
|
|
|
{ tests, if all forwards are resolved }
|
|
symtablestack^.check_forwards;
|
|
symtablestack^.symtabletype:=unitsymtable;
|
|
punitsymtable(symtablestack)^.is_stab_written:=false;
|
|
|
|
{Write out the unit if the compile was succesfull.}
|
|
if status.errorcount=0 then
|
|
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack));
|
|
|
|
pu:=pused_unit(usedunits.first);
|
|
while assigned(pu) do
|
|
begin
|
|
punitsymtable(pu^.u^.symtable)^.is_stab_written:=false;
|
|
pu:=pused_unit(pu^.next);
|
|
end;
|
|
inc(datasize,symtablestack^.datasize);
|
|
|
|
{ generate imports }
|
|
if current_module^.uses_imports then
|
|
importlib^.generatelib;
|
|
|
|
{ finish asmlist by adding segment starts }
|
|
insertsegment;
|
|
end;
|
|
|
|
|
|
|
|
procedure proc_program(islibrary : boolean);
|
|
|
|
var
|
|
st : psymtable;
|
|
names : Tstringcontainer;
|
|
begin
|
|
{ Trying to compile the system unit... }
|
|
{ if no unit defined... then issue a }
|
|
{ fatal error (avoids pointer problems)}
|
|
{ when referencing the non-existant }
|
|
{ system unit. }
|
|
|
|
{ System Unit should be compiled using proc_unit !! (PFV) }
|
|
{ if (cs_compilesystem in aktswitches) then
|
|
Begin
|
|
if token<>_UNIT then
|
|
Message1(scan_f_syn_expected,'UNIT');
|
|
consume(_UNIT);
|
|
end;}
|
|
|
|
parse_only:=false;
|
|
if islibrary then
|
|
begin
|
|
consume(_LIBRARY);
|
|
stringdispose(current_module^.modulename);
|
|
current_module^.modulename:=stringdup(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);
|
|
consume(ID);
|
|
if token=LKLAMMER then
|
|
begin
|
|
consume(LKLAMMER);
|
|
idlist;
|
|
consume(RKLAMMER);
|
|
end;
|
|
consume(SEMICOLON);
|
|
end;
|
|
|
|
{ insert after the unit symbol tables the static symbol table }
|
|
{ of the program }
|
|
st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
|
|
|
|
{Generate a procsym.}
|
|
aktprocsym:=new(Pprocsym,init('main'));
|
|
aktprocsym^.definition:=new(Pprocdef,init);
|
|
aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poproginit;
|
|
aktprocsym^.definition^.setmangledname(target_os.Cprefix+'main');
|
|
{The localst is a local symtable. Change it into the static
|
|
symtable.}
|
|
dispose(aktprocsym^.definition^.localst,done);
|
|
aktprocsym^.definition^.localst:=st;
|
|
|
|
refsymtable:=st;
|
|
|
|
{ necessary for browser }
|
|
loaded_units.insert(current_module);
|
|
|
|
{Insert the symbols of the system unit into the stack of symbol
|
|
tables.}
|
|
symtablestack:=systemunit;
|
|
systemunit^.next:=nil;
|
|
refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
|
|
|
|
{Load the units used by the program we compile.}
|
|
if token=_USES then
|
|
loadunits;
|
|
|
|
{Insert the name of the main program into the symbol table.}
|
|
if current_module^.modulename^<>'' then
|
|
st^.insert(new(pprogramsym,init(current_module^.modulename^)));
|
|
|
|
{ ...is also constsymtable, this is the symtable where }
|
|
{ the elements of enumeration types are inserted }
|
|
constsymtable:=st;
|
|
|
|
{ set some informations about the main program }
|
|
with procinfo do
|
|
begin
|
|
retdef:=voiddef;
|
|
_class:=nil;
|
|
call_offset:=8;
|
|
framepointer:=frame_pointer;
|
|
flags:=0;
|
|
end;
|
|
|
|
procprefix:='';
|
|
in_except_block:=false;
|
|
|
|
codegen_newprocedure;
|
|
|
|
{The program intialization needs an alias, so it can be called
|
|
from the bootstrap code.}
|
|
names.init;
|
|
names.insert('program_init');
|
|
names.insert('PASCALMAIN');
|
|
names.insert(target_os.cprefix+'main');
|
|
compile_proc_body(names,true,false);
|
|
names.done;
|
|
|
|
codegen_doneprocedure;
|
|
|
|
consume(POINT);
|
|
|
|
if (cs_smartlink in aktswitches) then
|
|
current_module^.linkstaticlibs.insert(current_module^.libfilename^)
|
|
else
|
|
current_module^.linkofiles.insert(current_module^.objfilename^);
|
|
|
|
{ insert heap }
|
|
insertheap;
|
|
|
|
{ generate imports }
|
|
if current_module^.uses_imports then
|
|
importlib^.generatelib;
|
|
|
|
inserttargetspecific;
|
|
|
|
datasize:=symtablestack^.datasize;
|
|
|
|
{ finish asmlist by adding segment starts }
|
|
insertsegment;
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.26 1998-06-09 16:01:47 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.25 1998/06/08 22:59:49 peter
|
|
* smartlinking works for win32
|
|
* some defines to exclude some compiler parts
|
|
|
|
Revision 1.24 1998/06/08 13:13:44 pierre
|
|
+ temporary variables now in temp_gen.pas unit
|
|
because it is processor independent
|
|
* mppc68k.bat modified to undefine i386 and support_mmx
|
|
(which are defaults for i386)
|
|
|
|
Revision 1.23 1998/06/05 17:47:29 peter
|
|
* some better uses clauses
|
|
|
|
Revision 1.22 1998/06/05 14:37:34 pierre
|
|
* fixes for inline for operators
|
|
* inline procedure more correctly restricted
|
|
|
|
Revision 1.21 1998/06/04 23:51:53 peter
|
|
* m68k compiles
|
|
+ .def file creation moved to gendef.pas so it could also be used
|
|
for win32
|
|
|
|
Revision 1.20 1998/06/04 09:55:42 pierre
|
|
* demangled name of procsym reworked to become independant of the mangling scheme
|
|
|
|
Revision 1.19 1998/06/03 23:40:38 peter
|
|
+ unlimited file support, release tempclose
|
|
|
|
Revision 1.18 1998/06/03 22:49:00 peter
|
|
+ wordbool,longbool
|
|
* rename bis,von -> high,low
|
|
* moved some systemunit loading/creating to psystem.pas
|
|
|
|
Revision 1.17 1998/05/28 14:40:25 peter
|
|
* fixes for newppu, remake3 works now with it
|
|
|
|
Revision 1.16 1998/05/27 19:45:06 peter
|
|
* symtable.pas splitted into includefiles
|
|
* symtable adapted for $ifdef NEWPPU
|
|
|
|
Revision 1.15 1998/05/23 01:21:22 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.14 1998/05/20 09:42:35 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.13 1998/05/12 10:47:00 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.12 1998/05/11 13:07:56 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.11 1998/05/06 18:36:53 peter
|
|
* tai_section extended with code,data,bss sections and enumerated type
|
|
* ident 'compiled by FPC' moved to pmodules
|
|
* small fix for smartlink
|
|
|
|
Revision 1.10 1998/05/04 17:54:28 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.9 1998/05/01 16:38:45 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.8 1998/04/30 15:59:41 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.7 1998/04/29 10:33:59 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.6 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.5 1998/04/14 23:27:03 florian
|
|
+ exclude/include with constant second parameter added
|
|
|
|
Revision 1.4 1998/04/10 14:41:43 peter
|
|
* removed some Hints
|
|
* small speed optimization for AsmLn
|
|
|
|
Revision 1.3 1998/04/03 09:51:00 daniel
|
|
* Fixed heap allocation for OS/2.
|
|
}
|