mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-27 07:53:43 +02:00
847 lines
26 KiB
PHP
847 lines
26 KiB
PHP
{
|
|
$Id$
|
|
Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
|
|
|
|
Implementation of the reading of PPU Files for the symtable
|
|
|
|
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.
|
|
****************************************************************************
|
|
}
|
|
|
|
const
|
|
{$ifdef FPC}
|
|
ppubufsize=32768;
|
|
{$ELSE}
|
|
{$IFDEF USEOVERLAY}
|
|
ppubufsize=512;
|
|
{$ELSE}
|
|
ppubufsize=4096;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{ define ORDERSOURCES}
|
|
|
|
{*****************************************************************************
|
|
PPU Writing
|
|
*****************************************************************************}
|
|
|
|
procedure writebyte(b:byte);
|
|
begin
|
|
current_ppu^.putbyte(b);
|
|
end;
|
|
|
|
|
|
procedure writeword(w:word);
|
|
begin
|
|
current_ppu^.putword(w);
|
|
end;
|
|
|
|
|
|
procedure writelong(l:longint);
|
|
begin
|
|
current_ppu^.putlongint(l);
|
|
end;
|
|
|
|
|
|
procedure writereal(d:bestreal);
|
|
begin
|
|
current_ppu^.putreal(d);
|
|
end;
|
|
|
|
|
|
procedure writestring(const s:string);
|
|
begin
|
|
current_ppu^.putstring(s);
|
|
end;
|
|
|
|
|
|
procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
|
|
begin
|
|
current_ppu^.putdata(s,sizeof(tnormalset));
|
|
end;
|
|
|
|
|
|
procedure writesmallset(var s);
|
|
begin
|
|
current_ppu^.putdata(s,4);
|
|
end;
|
|
|
|
|
|
{ posinfo is not relevant for changes in PPU }
|
|
procedure writeposinfo(const p:tfileposinfo);
|
|
var
|
|
oldcrc : boolean;
|
|
begin
|
|
oldcrc:=current_ppu^.do_crc;
|
|
current_ppu^.do_crc:=false;
|
|
current_ppu^.putword(p.fileindex);
|
|
current_ppu^.putlongint(p.line);
|
|
current_ppu^.putword(p.column);
|
|
current_ppu^.do_crc:=oldcrc;
|
|
end;
|
|
|
|
|
|
procedure writederef(p : psymtableentry);
|
|
begin
|
|
if p=nil then
|
|
current_ppu^.putbyte(ord(derefnil))
|
|
else
|
|
begin
|
|
{ Static symtable ? }
|
|
if p^.owner^.symtabletype=staticsymtable then
|
|
begin
|
|
current_ppu^.putbyte(ord(derefaktstaticindex));
|
|
current_ppu^.putword(p^.indexnr);
|
|
end
|
|
{ Local record/object symtable ? }
|
|
else if (p^.owner=aktrecordsymtable) then
|
|
begin
|
|
current_ppu^.putbyte(ord(derefaktrecordindex));
|
|
current_ppu^.putword(p^.indexnr);
|
|
end
|
|
{ Local local/para symtable ? }
|
|
else if (p^.owner=aktlocalsymtable) then
|
|
begin
|
|
current_ppu^.putbyte(ord(derefaktlocal));
|
|
current_ppu^.putword(p^.indexnr);
|
|
end
|
|
else
|
|
begin
|
|
current_ppu^.putbyte(ord(derefindex));
|
|
current_ppu^.putword(p^.indexnr);
|
|
{ Current unit symtable ? }
|
|
repeat
|
|
if not assigned(p) then
|
|
internalerror(556655);
|
|
case p^.owner^.symtabletype of
|
|
{ when writing the pseudo PPU file
|
|
to get CRC values the globalsymtable is not yet
|
|
a unitsymtable PM }
|
|
globalsymtable,
|
|
unitsymtable :
|
|
begin
|
|
current_ppu^.putbyte(ord(derefunit));
|
|
current_ppu^.putword(p^.owner^.unitid);
|
|
break;
|
|
end;
|
|
staticsymtable :
|
|
begin
|
|
current_ppu^.putbyte(ord(derefaktstaticindex));
|
|
current_ppu^.putword(p^.indexnr);
|
|
break;
|
|
end;
|
|
localsymtable :
|
|
begin
|
|
p:=p^.owner^.defowner;
|
|
current_ppu^.putbyte(ord(dereflocal));
|
|
current_ppu^.putword(p^.indexnr);
|
|
end;
|
|
parasymtable :
|
|
begin
|
|
p:=p^.owner^.defowner;
|
|
current_ppu^.putbyte(ord(derefpara));
|
|
current_ppu^.putword(p^.indexnr);
|
|
end;
|
|
objectsymtable,
|
|
recordsymtable :
|
|
begin
|
|
p:=p^.owner^.defowner;
|
|
current_ppu^.putbyte(ord(derefrecord));
|
|
current_ppu^.putword(p^.indexnr);
|
|
end;
|
|
else
|
|
internalerror(556656);
|
|
end;
|
|
until false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure writedefref(p : pdef);
|
|
begin
|
|
writederef(p);
|
|
end;
|
|
|
|
procedure writesymref(p : psym);
|
|
begin
|
|
writederef(p);
|
|
end;
|
|
|
|
|
|
procedure writesourcefiles;
|
|
var
|
|
hp : pinputfile;
|
|
{$ifdef ORDERSOURCES}
|
|
i,j : longint;
|
|
{$endif ORDERSOURCES}
|
|
begin
|
|
{ second write the used source files }
|
|
current_ppu^.do_crc:=false;
|
|
hp:=current_module^.sourcefiles^.files;
|
|
{$ifdef ORDERSOURCES}
|
|
{ write source files directly in good order }
|
|
j:=0;
|
|
while assigned(hp) do
|
|
begin
|
|
inc(j);
|
|
hp:=hp^.ref_next;
|
|
end;
|
|
while j>0 do
|
|
begin
|
|
hp:=current_module^.sourcefiles^.files;
|
|
for i:=1 to j-1 do
|
|
hp:=hp^.ref_next;
|
|
current_ppu^.putstring(hp^.name^);
|
|
dec(j);
|
|
end;
|
|
{$else not ORDERSOURCES}
|
|
while assigned(hp) do
|
|
begin
|
|
{ only name and extension }
|
|
current_ppu^.putstring(hp^.name^);
|
|
hp:=hp^.ref_next;
|
|
end;
|
|
{$endif ORDERSOURCES}
|
|
current_ppu^.writeentry(ibsourcefiles);
|
|
current_ppu^.do_crc:=true;
|
|
end;
|
|
|
|
procedure writeusedmacros;
|
|
var
|
|
hp : pmacrosym;
|
|
i : longint;
|
|
begin
|
|
{ second write the used source files }
|
|
current_ppu^.do_crc:=false;
|
|
for i:=1 to macros^.symindex^.count do
|
|
begin
|
|
hp:=pmacrosym(macros^.symindex^.search(i));
|
|
{ only used or init defined macros are stored }
|
|
if hp^.is_used or hp^.defined_at_startup then
|
|
begin
|
|
current_ppu^.putstring(hp^.name);
|
|
current_ppu^.putbyte(byte(hp^.defined_at_startup));
|
|
current_ppu^.putbyte(byte(hp^.is_used));
|
|
end;
|
|
end;
|
|
current_ppu^.writeentry(ibusedmacros);
|
|
current_ppu^.do_crc:=true;
|
|
end;
|
|
|
|
|
|
procedure writeusedunit;
|
|
var
|
|
hp : pused_unit;
|
|
begin
|
|
numberunits;
|
|
hp:=pused_unit(current_module^.used_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
{ implementation units should not change
|
|
the CRC PM }
|
|
current_ppu^.do_crc:=hp^.in_interface;
|
|
current_ppu^.putstring(hp^.name^);
|
|
{ the checksum should not affect the crc of this unit ! (PFV) }
|
|
current_ppu^.do_crc:=false;
|
|
current_ppu^.putlongint(hp^.checksum);
|
|
current_ppu^.putlongint(hp^.interface_checksum);
|
|
current_ppu^.putbyte(byte(hp^.in_interface));
|
|
current_ppu^.do_crc:=true;
|
|
hp:=pused_unit(hp^.next);
|
|
end;
|
|
current_ppu^.do_interface_crc:=true;
|
|
current_ppu^.writeentry(ibloadunit);
|
|
end;
|
|
|
|
|
|
procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
|
|
var
|
|
hcontainer : tlinkcontainer;
|
|
s : string;
|
|
mask : longint;
|
|
begin
|
|
hcontainer.init;
|
|
while not p.empty do
|
|
begin
|
|
s:=p.get(mask);
|
|
if strippath then
|
|
current_ppu^.putstring(SplitFileName(s))
|
|
else
|
|
current_ppu^.putstring(s);
|
|
current_ppu^.putlongint(mask);
|
|
hcontainer.insert(s,mask);
|
|
end;
|
|
current_ppu^.writeentry(id);
|
|
p:=hcontainer;
|
|
end;
|
|
|
|
|
|
procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
|
|
begin
|
|
Message1(unit_u_ppu_write,s);
|
|
|
|
{ create unit flags }
|
|
with Current_Module^ do
|
|
begin
|
|
{$ifdef GDB}
|
|
if cs_gdb_dbx in aktglobalswitches then
|
|
flags:=flags or uf_has_dbx;
|
|
{$endif GDB}
|
|
if target_os.endian=endian_big then
|
|
flags:=flags or uf_big_endian;
|
|
if cs_browser in aktmoduleswitches then
|
|
flags:=flags or uf_has_browser;
|
|
if cs_local_browser in aktmoduleswitches then
|
|
flags:=flags or uf_local_browser;
|
|
end;
|
|
|
|
{$ifdef Test_Double_checksum_write}
|
|
If only_crc then
|
|
Assign(CRCFile,s+'.INT')
|
|
else
|
|
Assign(CRCFile,s+'.IMP');
|
|
Rewrite(CRCFile);
|
|
{$endif def Test_Double_checksum_write}
|
|
{ open ppufile }
|
|
current_ppu:=new(pppufile,init(s));
|
|
current_ppu^.crc_only:=only_crc;
|
|
if not current_ppu^.create then
|
|
Message(unit_f_ppu_cannot_write);
|
|
|
|
{$ifdef Test_Double_checksum}
|
|
if only_crc then
|
|
begin
|
|
new(current_ppu^.crc_test);
|
|
new(current_ppu^.crc_test2);
|
|
end
|
|
else
|
|
begin
|
|
current_ppu^.crc_test:=Current_Module^.crc_array;
|
|
current_ppu^.crc_index:=Current_Module^.crc_size;
|
|
current_ppu^.crc_test2:=Current_Module^.crc_array2;
|
|
current_ppu^.crc_index2:=Current_Module^.crc_size2;
|
|
end;
|
|
{$endif def Test_Double_checksum}
|
|
|
|
current_ppu^.change_endian:=source_os.endian<>target_os.endian;
|
|
{ write symbols and definitions }
|
|
unittable^.writeasunit;
|
|
|
|
{ flush to be sure }
|
|
current_ppu^.flush;
|
|
{ create and write header }
|
|
current_ppu^.header.size:=current_ppu^.size;
|
|
current_ppu^.header.checksum:=current_ppu^.crc;
|
|
current_ppu^.header.interface_checksum:=current_ppu^.interface_crc;
|
|
current_ppu^.header.compiler:=wordversion;
|
|
current_ppu^.header.cpu:=word(target_cpu);
|
|
current_ppu^.header.target:=word(target_info.target);
|
|
current_ppu^.header.flags:=current_module^.flags;
|
|
If not only_crc then
|
|
current_ppu^.writeheader;
|
|
{ save crc in current_module also }
|
|
current_module^.crc:=current_ppu^.crc;
|
|
current_module^.interface_crc:=current_ppu^.interface_crc;
|
|
if only_crc then
|
|
begin
|
|
{$ifdef Test_Double_checksum}
|
|
Current_Module^.crc_array:=current_ppu^.crc_test;
|
|
current_ppu^.crc_test:=nil;
|
|
Current_Module^.crc_size:=current_ppu^.crc_index2;
|
|
Current_Module^.crc_array2:=current_ppu^.crc_test2;
|
|
current_ppu^.crc_test2:=nil;
|
|
Current_Module^.crc_size2:=current_ppu^.crc_index2;
|
|
{$endif def Test_Double_checksum}
|
|
closecurrentppu;
|
|
end;
|
|
{$ifdef Test_Double_checksum_write}
|
|
close(CRCFile);
|
|
{$endif Test_Double_checksum_write}
|
|
end;
|
|
|
|
|
|
procedure closecurrentppu;
|
|
begin
|
|
{$ifdef Test_Double_checksum}
|
|
if assigned(current_ppu^.crc_test) then
|
|
dispose(current_ppu^.crc_test);
|
|
if assigned(current_ppu^.crc_test2) then
|
|
dispose(current_ppu^.crc_test2);
|
|
{$endif Test_Double_checksum}
|
|
{ close }
|
|
current_ppu^.close;
|
|
dispose(current_ppu,done);
|
|
current_ppu:=nil;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
PPU Reading
|
|
*****************************************************************************}
|
|
|
|
function readbyte:byte;
|
|
begin
|
|
readbyte:=current_ppu^.getbyte;
|
|
if current_ppu^.error then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
|
|
function readword:word;
|
|
begin
|
|
readword:=current_ppu^.getword;
|
|
if current_ppu^.error then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
|
|
function readlong:longint;
|
|
begin
|
|
readlong:=current_ppu^.getlongint;
|
|
if current_ppu^.error then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
|
|
function readreal : bestreal;
|
|
begin
|
|
readreal:=current_ppu^.getreal;
|
|
if current_ppu^.error then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
|
|
function readstring : string;
|
|
begin
|
|
readstring:=current_ppu^.getstring;
|
|
if current_ppu^.error then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
|
|
procedure readnormalset(var s); {You cannot pass an array [0..31] of byte.}
|
|
begin
|
|
current_ppu^.getdata(s,sizeof(tnormalset));
|
|
if current_ppu^.error then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
|
|
procedure readsmallset(var s);
|
|
begin
|
|
current_ppu^.getdata(s,4);
|
|
if current_ppu^.error then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
|
|
procedure readposinfo(var p:tfileposinfo);
|
|
begin
|
|
p.fileindex:=current_ppu^.getword;
|
|
p.line:=current_ppu^.getlongint;
|
|
p.column:=current_ppu^.getword;
|
|
end;
|
|
|
|
|
|
{$ifndef OLDDEREF}
|
|
function readderef : pderef;
|
|
var
|
|
hp,p : pderef;
|
|
b : tdereftype;
|
|
begin
|
|
p:=nil;
|
|
repeat
|
|
hp:=p;
|
|
b:=tdereftype(current_ppu^.getbyte);
|
|
case b of
|
|
derefnil :
|
|
break;
|
|
derefunit,
|
|
derefaktrecordindex,
|
|
derefaktlocal,
|
|
derefaktstaticindex :
|
|
begin
|
|
new(p,init(b,current_ppu^.getword));
|
|
p^.next:=hp;
|
|
break;
|
|
end;
|
|
derefindex,
|
|
dereflocal,
|
|
derefpara,
|
|
derefrecord :
|
|
begin
|
|
new(p,init(b,current_ppu^.getword));
|
|
p^.next:=hp;
|
|
end;
|
|
end;
|
|
until false;
|
|
readderef:=p;
|
|
end;
|
|
|
|
function readdefref : pdef;
|
|
begin
|
|
readdefref:=pdef(readderef);
|
|
end;
|
|
|
|
function readsymref : psym;
|
|
begin
|
|
readsymref:=psym(readderef);
|
|
end;
|
|
{$else}
|
|
function readdefref : pdef;
|
|
var
|
|
hd : pdef;
|
|
begin
|
|
longint(hd):=current_ppu^.getword;
|
|
longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
|
|
readdefref:=hd;
|
|
end;
|
|
|
|
|
|
function readsymref : psym;
|
|
var
|
|
hd : psym;
|
|
begin
|
|
longint(hd):=current_ppu^.getword;
|
|
longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
|
|
readsymref:=hd;
|
|
end;
|
|
{$endif}
|
|
|
|
|
|
procedure readusedmacros;
|
|
var
|
|
hs : string;
|
|
mac : pmacrosym;
|
|
was_defined_at_startup,
|
|
was_used : boolean;
|
|
begin
|
|
while not current_ppu^.endofentry do
|
|
begin
|
|
hs:=current_ppu^.getstring;
|
|
was_defined_at_startup:=boolean(current_ppu^.getbyte);
|
|
was_used:=boolean(current_ppu^.getbyte);
|
|
mac:=pmacrosym(macros^.search(hs));
|
|
if assigned(mac) then
|
|
begin
|
|
{$ifndef EXTDEBUG}
|
|
{ if we don't have the sources why tell }
|
|
if current_module^.sources_avail then
|
|
{$endif ndef EXTDEBUG}
|
|
if not was_defined_at_startup and was_used and
|
|
mac^.defined_at_startup then
|
|
Comment(V_Hint,'Conditional '+hs+' was not set at startup '+
|
|
'in last compilation of '+current_module^.mainsource^);
|
|
end
|
|
else { not assigned }
|
|
if was_defined_at_startup and was_used then
|
|
Comment(V_Hint,'Conditional '+hs+' was set at startup '+
|
|
'in last compilation of '+current_module^.mainsource^);
|
|
end;
|
|
end;
|
|
|
|
procedure readsourcefiles;
|
|
var
|
|
temp,hs : string;
|
|
{$ifdef ORDERSOURCES}
|
|
main_dir : string;
|
|
{$endif ORDERSOURCES}
|
|
incfile_found,
|
|
main_found,
|
|
is_main : boolean;
|
|
ppufiletime,
|
|
source_time : longint;
|
|
hp : pinputfile;
|
|
begin
|
|
ppufiletime:=getnamedfiletime(current_module^.ppufilename^);
|
|
current_module^.sources_avail:=true;
|
|
{$ifdef ORDERSOURCES}
|
|
is_main:=true;
|
|
main_dir:='';
|
|
{$endif ORDERSOURCES}
|
|
while not current_ppu^.endofentry do
|
|
begin
|
|
hs:=current_ppu^.getstring;
|
|
{$ifndef ORDERSOURCES}
|
|
is_main:=current_ppu^.endofentry;
|
|
{$endif ORDERSOURCES}
|
|
temp:='';
|
|
if (current_module^.flags and uf_in_library)<>0 then
|
|
begin
|
|
current_module^.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(current_module^.path^+hs);
|
|
incfile_found:=false;
|
|
if Source_Time<>-1 then
|
|
hs:=current_module^.path^+hs
|
|
{$ifdef ORDERSOURCES}
|
|
else if not(is_main) then
|
|
begin
|
|
Source_Time:=GetNamedFileTime(main_dir+hs);
|
|
if Source_Time<>-1 then
|
|
hs:=main_dir+hs;
|
|
end
|
|
{$endif def ORDERSOURCES}
|
|
;
|
|
if (Source_Time=-1) then
|
|
begin
|
|
if is_main then
|
|
temp:=unitsearchpath.FindFile(hs,main_found)
|
|
else
|
|
temp:=includesearchpath.FindFile(hs,incfile_found);
|
|
{$ifdef ORDERSOURCES}
|
|
if is_main then
|
|
begin
|
|
stringdispose(current_module^.mainsource);
|
|
current_module^.mainsource:=stringdup(hs);
|
|
if main_found then
|
|
main_dir:=temp;
|
|
end;
|
|
{$endif ORDERSOURCES}
|
|
if incfile_found or main_found then
|
|
begin
|
|
hs:=temp+hs;
|
|
Source_Time:=GetNamedFileTime(hs);
|
|
end
|
|
end;
|
|
if Source_Time=-1 then
|
|
begin
|
|
current_module^.sources_avail:=false;
|
|
temp:=' not found';
|
|
end
|
|
else
|
|
begin
|
|
{ time newer? But only allow if the file is not searched
|
|
in the include path (PFV), else you've problems with
|
|
units which use the same includefile names }
|
|
if incfile_found then
|
|
temp:=' found'
|
|
else
|
|
begin
|
|
temp:=' time '+filetimestring(source_time);
|
|
if (source_time>ppufiletime) then
|
|
begin
|
|
current_module^.do_compile:=true;
|
|
current_module^.recompile_reason:=rr_sourcenewer;
|
|
temp:=temp+' *'
|
|
end;
|
|
end;
|
|
end;
|
|
new(hp,init(hs));
|
|
{ the indexing is wrong here PM }
|
|
current_module^.sourcefiles^.register_file(hp);
|
|
end;
|
|
Message1(unit_u_ppu_source,hs+temp);
|
|
{$ifdef ORDERSOURCES}
|
|
is_main:=false;
|
|
{$endif ORDERSOURCES}
|
|
end;
|
|
{$ifndef ORDERSOURCES}
|
|
{ main source is always the last }
|
|
stringdispose(current_module^.mainsource);
|
|
current_module^.mainsource:=stringdup(hs);
|
|
|
|
{ the indexing is corrected here PM }
|
|
current_module^.sourcefiles^.inverse_register_indexes;
|
|
{$endif ORDERSOURCES}
|
|
{ check if we want to rebuild every unit, only if the sources are
|
|
available }
|
|
if do_build and current_module^.sources_avail then
|
|
begin
|
|
current_module^.do_compile:=true;
|
|
current_module^.recompile_reason:=rr_build;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure readloadunit;
|
|
var
|
|
hs : string;
|
|
intfchecksum,
|
|
checksum : longint;
|
|
in_interface : boolean;
|
|
begin
|
|
while not current_ppu^.endofentry do
|
|
begin
|
|
hs:=current_ppu^.getstring;
|
|
checksum:=current_ppu^.getlongint;
|
|
intfchecksum:=current_ppu^.getlongint;
|
|
in_interface:=(current_ppu^.getbyte<>0);
|
|
current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,intfchecksum,in_interface)));
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure readlinkcontainer(var p:tlinkcontainer);
|
|
var
|
|
s : string;
|
|
m : longint;
|
|
begin
|
|
while not current_ppu^.endofentry do
|
|
begin
|
|
s:=current_ppu^.getstring;
|
|
m:=current_ppu^.getlongint;
|
|
p.insert(s,m);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure load_interface;
|
|
var
|
|
b : byte;
|
|
newmodulename : pstring;
|
|
begin
|
|
{ read interface part }
|
|
repeat
|
|
b:=current_ppu^.readentry;
|
|
case b of
|
|
ibmodulename :
|
|
begin
|
|
newmodulename:=stringdup(current_ppu^.getstring);
|
|
if newmodulename^<>current_module^.modulename^ then
|
|
Message2(unit_f_unit_name_error,current_module^.modulename^,newmodulename^);
|
|
stringdispose(current_module^.modulename);
|
|
current_module^.modulename:=newmodulename;
|
|
end;
|
|
ibsourcefiles :
|
|
readsourcefiles;
|
|
ibusedmacros :
|
|
readusedmacros;
|
|
ibloadunit :
|
|
readloadunit;
|
|
iblinkunitofiles :
|
|
readlinkcontainer(current_module^.LinkUnitOFiles);
|
|
iblinkunitstaticlibs :
|
|
readlinkcontainer(current_module^.LinkUnitStaticLibs);
|
|
iblinkunitsharedlibs :
|
|
readlinkcontainer(current_module^.LinkUnitSharedLibs);
|
|
iblinkotherofiles :
|
|
readlinkcontainer(current_module^.LinkotherOFiles);
|
|
iblinkotherstaticlibs :
|
|
readlinkcontainer(current_module^.LinkotherStaticLibs);
|
|
iblinkothersharedlibs :
|
|
readlinkcontainer(current_module^.LinkotherSharedLibs);
|
|
ibendinterface :
|
|
break;
|
|
else
|
|
Message1(unit_f_ppu_invalid_entry,tostr(b));
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.56 1999-11-21 01:42:37 pierre
|
|
* Nextoverloading ordering fix
|
|
|
|
Revision 1.55 1999/11/17 17:05:04 pierre
|
|
* Notes/hints changes
|
|
|
|
Revision 1.54 1999/11/12 11:03:50 peter
|
|
* searchpaths changed to stringqueue object
|
|
|
|
Revision 1.53 1999/11/06 14:34:27 peter
|
|
* truncated log to 20 revs
|
|
|
|
Revision 1.52 1999/11/05 17:18:03 pierre
|
|
* local browsing works at first level
|
|
ie for function defined in interface or implementation
|
|
not yet for functions inside other functions
|
|
|
|
Revision 1.51 1999/09/16 13:27:08 pierre
|
|
+ error if PPU modulename is different from what is searched
|
|
(8+3 limitations!)
|
|
+ cond ORDERSOURCES to allow recompilation of FP
|
|
if symppu.inc is changed (need PPUversion change!)
|
|
|
|
Revision 1.50 1999/09/12 15:45:11 florian
|
|
* tnamedindexobject._name should be never accessed direct! Use the
|
|
function name instead
|
|
|
|
Revision 1.49 1999/09/03 10:54:22 pierre
|
|
* message about conditionals changed to Hint
|
|
|
|
Revision 1.48 1999/08/31 15:47:56 pierre
|
|
+ startup conditionals stored in PPU file for debug info
|
|
|
|
Revision 1.47 1999/08/27 10:54:45 pierre
|
|
* some code adapted to CRC_only computation
|
|
+ main file is search in unitspathlist
|
|
and triggers do_compile flag
|
|
* some changes to get identical CRC vaules after
|
|
interface and after implementation
|
|
|
|
Revision 1.46 1999/08/13 21:33:12 peter
|
|
* support for array constructors extended and more error checking
|
|
|
|
Revision 1.45 1999/08/03 22:03:17 peter
|
|
* moved bitmask constants to sets
|
|
* some other type/const renamings
|
|
|
|
Revision 1.44 1999/07/14 21:19:12 florian
|
|
+ implemented a better error message if a PPU file isn't found as suggested
|
|
by Lee John
|
|
|
|
Revision 1.43 1999/07/03 00:30:00 peter
|
|
* new link writing to the ppu, one .ppu is needed for all link types,
|
|
static (.o) is now always created also when smartlinking is used
|
|
|
|
Revision 1.42 1999/06/22 16:24:47 pierre
|
|
* local browser stuff corrected
|
|
|
|
Revision 1.41 1999/05/14 17:52:28 peter
|
|
* new deref code
|
|
|
|
Revision 1.40 1999/05/13 21:59:44 peter
|
|
* removed oldppu code
|
|
* warning if objpas is loaded from uses
|
|
* first things for new deref writing
|
|
|
|
Revision 1.39 1999/05/04 21:45:06 florian
|
|
* changes to compile it with Delphi 4.0
|
|
|
|
Revision 1.38 1999/04/26 13:31:51 peter
|
|
* release storenumber,double_checksum
|
|
|
|
Revision 1.37 1999/04/21 09:43:53 peter
|
|
* storenumber works
|
|
* fixed some typos in double_checksum
|
|
+ incompatible types type1 and type2 message (with storenumber)
|
|
|
|
Revision 1.36 1999/04/14 09:15:01 peter
|
|
* first things to store the symbol/def number in the ppu
|
|
|
|
Revision 1.35 1999/04/07 15:39:35 pierre
|
|
+ double_checksum code added
|
|
|
|
Revision 1.34 1999/03/02 13:49:19 peter
|
|
* renamed loadunit_int -> loadunit
|
|
|
|
Revision 1.33 1999/02/23 18:29:25 pierre
|
|
* win32 compilation error fix
|
|
+ some work for local browser (not cl=omplete yet)
|
|
|
|
}
|