paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 10:19:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ targetcpu

Browse Source 
* cleaner pmodules for newppu
This commit is contained in:
peter 1998-06-16 08:56:17 +00:00
parent 3710abda98
commit c2d5abdfed
15 changed files with 916 additions and 542 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/aopt386.pas
View File

@ -548,7 +548,7 @@ End;
imul 6, reg1 to
lea (reg1,reg1,2), reg1
add reg1, reg1}
If (aktoptprocessor <= i486)
If (aktoptprocessor <= int486)
Then
Begin
TmpRef^.Index := TRegister(Pai386(p)^.op2);
@ -618,7 +618,7 @@ End;
imul 10, reg1 to
lea (reg1,reg1,4), reg1
add reg1, reg1}
If (aktoptprocessor <= i486) Then
If (aktoptprocessor <= int486) Then
Begin
If (Pai386(p)^.op3t = Top_Reg)
Then
@ -653,7 +653,7 @@ End;
imul 12, reg1 to
lea (reg1,reg1,2), reg1
lea (,reg1,4), reg1}
If (aktoptprocessor <= i486)
If (aktoptprocessor <= int486)
Then
Begin
TmpRef^.Index := TRegister(Pai386(p)^.op2);
@ -1631,7 +1631,11 @@ end;
End.
{
$Log$
Revision 1.14 1998-05-30 14:31:02 peter
Revision 1.15 1998-06-16 08:56:17 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.14 1998/05/30 14:31:02 peter
+ $ASMMODE
Revision 1.13 1998/05/24 18:42:37 jonas

8
compiler/cg386set.pas
View File

@ -715,7 +715,7 @@ implementation
else
max_linear_list:=2;
{ a jump table crashes the pipeline! }
if aktoptprocessor=i486 then
if aktoptprocessor=int486 then
inc(max_linear_list,3);
if aktoptprocessor=pentium then
inc(max_linear_list,6);
@ -765,7 +765,11 @@ implementation
end.
{
$Log$
Revision 1.1 1998-06-05 17:44:13 peter
Revision 1.2 1998-06-16 08:56:18 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.1 1998/06/05 17:44:13 peter
* splitted cgi386
}

228
compiler/files.pas
View File

@ -122,6 +122,7 @@ unit files;
{ used in firstpass for faster settings }
current_index : word;
path, { path where the module is find/created }
modulename, { name of the module in uppercase }
objfilename, { fullname of the objectfile }
asmfilename, { fullname of the assemblerfile }
@ -132,9 +133,9 @@ unit files;
constructor init(const s:string;_is_unit:boolean);
destructor special_done;virtual; { this is to be called only when compiling again }
procedure setfilename(const path,name:string);
procedure setfilename(const _path,name:string);
{$ifdef NEWPPU}
function openppu(const unit_path:string):boolean;
function openppu:boolean;
{$else}
function load_ppu(const unit_path,n,ext:string):boolean;
{$endif}
@ -143,12 +144,22 @@ unit files;
pused_unit = ^tused_unit;
tused_unit = object(tlinkedlist_item)
u : pmodule;
unitid : word;
{$ifdef NEWPPU}
name : pstring;
checksum : longint;
loaded : boolean;
{$endif NEWPPU}
in_uses,
in_interface,
is_stab_written : boolean;
unitid : word;
u : pmodule;
{$ifdef NEWPPU}
constructor init(_u : pmodule;intface:boolean);
constructor init_to_load(const n:string;c:longint;intface:boolean);
{$else NEWPPU}
constructor init(_u : pmodule;f : byte);
{$endif NEWPPU}
destructor done;virtual;
end;
@ -225,6 +236,9 @@ unit files;
var
main_module : pmodule;
current_module : pmodule;
{$ifdef NEWPPU}
current_ppu : pppufile;
{$endif}
global_unit_count : word;
loaded_units : tlinkedlist;
@ -349,7 +363,7 @@ unit files;
TMODULE
****************************************************************************}
procedure tmodule.setfilename(const path,name:string);
procedure tmodule.setfilename(const _path,name:string);
var
s : string;
begin
@ -357,7 +371,9 @@ unit files;
stringdispose(asmfilename);
stringdispose(ppufilename);
stringdispose(libfilename);
s:=FixFileName(FixPath(path)+name);
stringdispose(path);
path:=stringdup(FixPath(_path));
s:=FixFileName(FixPath(_path)+name);
objfilename:=stringdup(s+target_info.objext);
asmfilename:=stringdup(s+target_info.asmext);
ppufilename:=stringdup(s+target_info.unitext);
@ -366,29 +382,18 @@ unit files;
{$ifdef NEWPPU}
function tmodule.openppu(const unit_path:string):boolean;
function tmodule.openppu:boolean;
var
temp,hs : string;
b : byte;
incfile_found : boolean;
objfiletime,
ppufiletime,
asmfiletime,
source_time : longint;
{$ifdef UseBrowser}
hp : pextfile;
_d : dirstr;
_n : namestr;
_e : extstr;
{$endif UseBrowser}
asmfiletime : longint;
begin
openppu:=false;
{ Get ppufile time (also check if the file exists) }
ppufiletime:=getnamedfiletime(ppufilename^);
if ppufiletime=-1 then
exit;
{ Open the ppufile }
Message1(unit_u_ppu_loading,ppufilename^);
ppufile:=new(pppufile,init(ppufilename^));
if not ppufile^.open then
@ -411,6 +416,21 @@ unit files;
Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
exit;
end;
{ check the target processor }
if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
begin
dispose(ppufile,done);
Comment(V_Debug,'unit is compiled for an other processor');
exit;
end;
{ check target }
if ttarget(ppufile^.header.target)<>target_info.target then
begin
dispose(ppufile,done);
Comment(V_Debug,'unit is compiled for an other target');
exit;
end;
{!!!!!!!!!!!!!!!!!!! }
{ Load values to be access easier }
flags:=ppufile^.header.flags;
crc:=ppufile^.header.checksum;
@ -418,83 +438,9 @@ unit files;
Message1(unit_d_ppu_time,filetimestring(ppufiletime));
Message1(unit_d_ppu_flags,tostr(flags));
Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
{ Unitname }
b:=ppufile^.readentry;
if b=ibmodulename then
begin
stringdispose(modulename);
modulename:=stringdup(ppufile^.getstring);
b:=ppufile^.readentry;
end;
{ search source files there is at least one source file }
{ check the object and assembler file to see if we need only to
assemble, only if it's not in a library }
do_compile:=false;
sources_avail:=true;
if b=ibsourcefiles then
begin
while not ppufile^.endofentry do
begin
hs:=ppufile^.getstring;
temp:='';
if (flags and uf_in_library)<>0 then
begin
sources_avail:=false;
temp:=' library';
end
else if pos('Macro ',hs)=1 then
begin
{ we don't want to find this file }
{ but there is a problem with file indexing !! }
temp:='';
end
else
begin
{ check the date of the source files }
Source_Time:=GetNamedFileTime(unit_path+hs);
if Source_Time=-1 then
begin
{ search for include files in the includepathlist }
if b<>ibend then
begin
temp:=search(hs,includesearchpath,incfile_found);
if incfile_found then
begin
hs:=temp+hs;
Source_Time:=GetNamedFileTime(hs);
end;
end;
end
else
hs:=unit_path+hs;
if Source_Time=-1 then
begin
sources_avail:=false;
temp:=' not found';
end
else
begin
temp:=' time '+filetimestring(source_time);
if (source_time>ppufiletime) then
begin
do_compile:=true;
temp:=temp+' *'
end;
end;
end;
Message1(unit_t_ppu_source,hs+temp);
{$ifdef UseBrowser}
fsplit(hs,_d,_n,_e);
new(hp,init(_d,_n,_e));
{ the indexing should match what is done in writeasunit }
sourcefiles.register_file(hp);
{$endif UseBrowser}
end;
end;
{ main source is always the last }
stringdispose(mainsource);
mainsource:=stringdup(hs);
{ check the object and assembler file if not a library }
if (flags and uf_in_library)=0 then
begin
if (flags and uf_smartlink)<>0 then
@ -532,7 +478,7 @@ unit files;
var
ext : string[8];
singlepathstring,
Path,
unitPath,
filename : string;
found : boolean;
start,i : longint;
@ -546,15 +492,15 @@ unit files;
begin
start:=1;
filename:=FixFileName(n);
path:=UnitSearchPath;
unitpath:=UnitSearchPath;
Found:=false;
repeat
{ Create current path to check }
i:=pos(';',path);
i:=pos(';',unitpath);
if i=0 then
i:=length(path)+1;
singlepathstring:=FixPath(copy(path,start,i-start));
delete(path,start,i-start+1);
i:=length(unitpath)+1;
singlepathstring:=FixPath(copy(unitpath,start,i-start));
delete(unitpath,start,i-start+1);
{ Check for PPL file }
if not (cs_link_static in aktswitches) then
begin
@ -562,7 +508,7 @@ unit files;
if Found then
Begin
SetFileName(SinglePathString,FileName);
Found:=OpenPPU(singlepathstring);
Found:=OpenPPU;
End;
end;
{ Check for PPU file }
@ -572,7 +518,7 @@ unit files;
if Found then
Begin
SetFileName(SinglePathString,FileName);
Found:=OpenPPU(singlepathstring);
Found:=OpenPPU;
End;
end;
{ Check for Sources }
@ -602,7 +548,7 @@ unit files;
else
sources_avail:=false;
end;
until Found or (path='');
until Found or (unitpath='');
search_unit:=Found;
end;
@ -779,7 +725,7 @@ unit files;
var
ext : string[8];
singlepathstring,
Path,
UnitPath,
filename : string;
found : boolean;
start,i : longint;
@ -793,15 +739,15 @@ unit files;
begin
start:=1;
filename:=FixFileName(n);
path:=UnitSearchPath;
unitpath:=UnitSearchPath;
Found:=false;
repeat
{Create current path to check}
i:=pos(';',path);
i:=pos(';',unitpath);
if i=0 then
i:=length(path)+1;
singlepathstring:=FixPath(copy(path,start,i-start));
delete(path,start,i-start+1);
i:=length(unitpath)+1;
singlepathstring:=FixPath(copy(unitpath,start,i-start));
delete(unitpath,start,i-start+1);
{ Check for PPL file }
if not (cs_link_static in aktswitches) then
begin
@ -849,7 +795,7 @@ unit files;
else
sources_avail:=false;
end;
until Found or (path='');
until Found or (unitpath='');
search_unit:=Found;
end;
@ -874,6 +820,7 @@ unit files;
asmfilename:=nil;
libfilename:=nil;
ppufilename:=nil;
path:=nil;
setfilename(p,n);
used_units.init;
sourcefiles.init;
@ -932,26 +879,65 @@ unit files;
TUSED_UNIT
****************************************************************************}
{$ifdef NEWPPU}
constructor tused_unit.init(_u : pmodule;f : byte);
constructor tused_unit.init(_u : pmodule;intface:boolean);
begin
u:=_u;
in_interface:=false;
in_uses:=false;
is_stab_written:=false;
unitid:=f;
u:=_u;
in_interface:=intface;
in_uses:=false;
is_stab_written:=false;
loaded:=true;
name:=stringdup(_u^.modulename^);
checksum:=_u^.crc;
unitid:=0;
end;
constructor tused_unit.init_to_load(const n:string;c:longint;intface:boolean);
begin
u:=nil;
in_interface:=intface;
in_uses:=false;
is_stab_written:=false;
loaded:=false;
name:=stringdup(n);
checksum:=c;
unitid:=0;
end;
destructor tused_unit.done;
begin
inherited done;
stringdispose(name);
inherited done;
end;
{$else NEWPPU}
constructor tused_unit.init(_u : pmodule;f : byte);
begin
u:=_u;
in_interface:=false;
in_uses:=false;
is_stab_written:=false;
unitid:=f;
end;
destructor tused_unit.done;
begin
inherited done;
end;
{$endif NEWPPU}
end.
{
$Log$
Revision 1.23 1998-06-15 14:44:36 daniel
Revision 1.24 1998-06-16 08:56:20 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.23 1998/06/15 14:44:36 daniel
* BP updates.

10
compiler/opts386.pas
View File

@ -60,8 +60,8 @@ begin
'x' : initswitches:=initswitches+[cs_optimize,cs_maxoptimieren];
'z' : initswitches:=initswitches+[cs_optimize,cs_uncertainopts];
'2' : initoptprocessor:=pentium2;
'3' : initoptprocessor:=systems.i386;
'4' : initoptprocessor:=i486;
'3' : initoptprocessor:=int386;
'4' : initoptprocessor:=int486;
'5' : initoptprocessor:=pentium;
'6' : initoptprocessor:=pentiumpro;
'7' : initoptprocessor:=cx6x86;
@ -89,7 +89,11 @@ end;
end.
{
$Log$
Revision 1.7 1998-05-30 14:31:05 peter
Revision 1.8 1998-06-16 08:56:22 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.7 1998/05/30 14:31:05 peter
+ $ASMMODE
Revision 1.6 1998/05/28 17:26:48 peter

41
compiler/parser.pas
View File

@ -75,8 +75,6 @@ unit parser;
procedure compile(const filename:string;compile_system:boolean);
var
hp : pmodule;
{ some variables to save the compiler state }
oldtoken : ttoken;
oldtokenpos : tfileposinfo;
@ -85,6 +83,7 @@ unit parser;
oldpreprocstack : ppreprocstack;
oldorgpattern,oldprocprefix : string;
old_block_type : tblock_type;
oldcurrlinepos,
oldlastlinepos,
oldinputbuffer,
oldinputpointer : pchar;
@ -200,6 +199,7 @@ unit parser;
oldinputbuffer:=inputbuffer;
oldinputpointer:=inputpointer;
oldcurrlinepos:=currlinepos;
oldlastlinepos:=lastlinepos;
olds_point:=s_point;
oldc:=c;
@ -273,35 +273,7 @@ unit parser;
{$endif UseBrowser}
end;
{ if the current file isn't a system unit }
{ the the system unit will be loaded }
if not(cs_compilesystem in aktswitches) then
begin
{ should be done in unit system (changing the field system_unit)
FK
}
hp:=loadunit(upper(target_info.system_unit),true,true);
systemunit:=hp^.symtable;
make_ref:=false;
readconstdefs;
{ we could try to overload caret by default }
symtablestack:=systemunit;
{ if POWER is defined in the RTL then use it for starstar overloading }
getsym('POWER',false);
if assigned(srsym) and (srsym^.typ=procsym) and
(overloaded_operators[STARSTAR]=nil) then
begin
overloaded_operators[STARSTAR]:=
new(pprocsym,init(overloaded_names[STARSTAR]));
overloaded_operators[STARSTAR]^.definition:=pprocsym(srsym)^.definition;
end;
make_ref:=true;
end
else
begin
createconstdefs;
systemunit:=nil;
end;
loadsystemunit;
registerdef:=true;
make_ref:=true;
@ -418,6 +390,7 @@ done:
inputbuffer:=oldinputbuffer;
inputpointer:=oldinputpointer;
lastlinepos:=oldlastlinepos;
currlinepos:=oldcurrlinepos;
s_point:=olds_point;
c:=oldc;
comment_level:=oldcomment_level;
@ -470,7 +443,11 @@ done:
end.
{
$Log$
Revision 1.25 1998-06-15 15:38:07 pierre
Revision 1.26 1998-06-16 08:56:23 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.25 1998/06/15 15:38:07 pierre
* small bug in systems.pas corrected
+ operators in different units better hanlded

11
compiler/pass_1.pas
View File

@ -5018,7 +5018,11 @@ unit pass_1;
end.
{
$Log$
Revision 1.32 1998-06-14 18:23:57 peter
Revision 1.33 1998-06-16 08:56:24 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.32 1998/06/14 18:23:57 peter
* fixed xor bug (from mailinglist)
Revision 1.31 1998/06/13 00:10:09 peter
@ -5048,9 +5052,8 @@ end.
to a procedure
Revision 1.26 1998/06/04 09:55:39 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
* demangled name of procsym reworked to become independant
of the mangling scheme
Revision 1.25 1998/06/03 22:48:57 peter
+ wordbool,longbool

374
compiler/pmodules.pas
View File

@ -30,7 +30,7 @@ unit pmodules;
files;
procedure addlinkerfiles(hp:pmodule);
function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;
procedure loadsystemunit;
procedure proc_unit;
procedure proc_program(islibrary : boolean);
@ -141,103 +141,234 @@ unit pmodules;
end;
{$ifdef NEWPPU}
function loadunit(const s : string;compile_system:boolean) : pmodule;forward;
procedure load_usedunits(compile_system:boolean);
var
pu : pused_unit;
loaded_unit : pmodule;
nextmapentry : longint;
begin
{ init the map }
new(current_module^.map);
nextmapentry:=1;
{ load the used units from interface }
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);
pu^.u:=loaded_unit;
pu^.loaded:=true;
if current_module^.compiled then
exit;
if loaded_unit^.crc<>pu^.checksum then
begin
current_module^.do_compile:=true;
exit;
end;
{ setup the map entry for deref }
current_module^.map^[nextmapentry]:=loaded_unit^.symtable;
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^.symtable:=new(punitsymtable,loadasunit);
{ if this is the system unit insert the intern symbols }
if compile_system then
begin
make_ref:=false;
insertinternsyms(psymtable(current_module^.symtable));
make_ref:=true;
end;
{ 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;
if loaded_unit^.crc<>pu^.checksum then
begin
current_module^.do_compile:=true;
exit;
end;
{ setup the map entry for deref }
{ current_module^.map^[nextmapentry]:=loaded_unit^.symtable;
inc(nextmapentry);
if nextmapentry>maxunits then
Message(unit_f_too_much_units); }
end;
pu:=pused_unit(pu^.next);
end;
{ 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;
var
st : punitsymtable;
old_current_ppu : pppufile;
old_current_module,hp,nextmodule : pmodule;
hs : pstring;
begin
old_current_module:=current_module;
old_current_ppu:=current_ppu;
{ 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;
{ the unit is not in the symtable stack }
if (not assigned(st)) then
{ ((not current_module^.in_implementation) and (hp^.in_implementation)) then }
begin
{ load the unit, it's not loaded yet }
if not assigned(hp) then
begin
{ generates a new unit info record }
current_module:=new(pmodule,init(s,true));
current_ppu:=current_module^.ppufile;
{ now we can register the unit }
loaded_units.insert(current_module);
{ 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 needn't the ppufile }
if assigned(current_module^.ppufile) then
begin
dispose(current_module^.ppufile,done);
current_module^.ppufile:=nil;
end;
if not(current_module^.sources_avail) then
Message1(unit_f_cant_compile_unit,current_module^.modulename^)
else
begin
if assigned(old_current_module^.current_inputfile) then
old_current_module^.current_inputfile^.tempclose;
compile(current_module^.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 (current_module^.do_assemble) then
OnlyAsm(current_module^.asmfilename^);
{ add the files for the linker }
addlinkerfiles(current_module);
end;
{ register the unit _once_ }
usedunits.concat(new(pused_unit,init(current_module,true)));
end
else
{ we have to compile the unit again, but it is already inserted !!}
{ we may have problem with the lost symtable !! }
begin
current_module:=hp;
{ we must preserve the unit chain }
nextmodule:=pmodule(current_module^.next);
{ we have to cleanup a little }
current_module^.special_done;
new(hs);
hs^:=current_module^.mainsource^;
current_module^.init(hs^,true);
dispose(hs);
{ we must preserve the unit chain }
current_module^.next:=nextmodule;
if assigned(current_module^.ppufile) then
begin
current_ppu:=current_module^.ppufile;
load_interface;
load_usedunits(compile_system)
end
else
begin
{$ifdef UseBrowser}
{ here we need to remove the names ! }
current_module^.sourcefiles.done;
current_module^.sourcefiles.init;
{$endif UseBrowser}
if assigned(old_current_module^.current_inputfile) then
old_current_module^.current_inputfile^.tempclose;
Message1(parser_d_compiling_second_time,current_module^.mainsource^);
compile(current_module^.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;
hp:=current_module;
end;
{ set the old module }
current_ppu:=old_current_ppu;
current_module:=old_current_module;
loadunit:=hp;
end;
{$else NEWPPU}
{*****************************************************************************
Old PPU
*****************************************************************************}
function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;forward;
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 }
if compile_system then
begin
make_ref:=false;
insertinternsyms(psymtable(hp^.symtable));
make_ref:=true;
end;
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
@ -283,7 +414,7 @@ unit pmodules;
hp^.ppufile^.read_data(b,1,count);
end;
{ ok, now load the unit }
hp^.symtable:=new(punitsymtable,load(hp));
hp^.symtable:=new(punitsymtable,load(hp^.modulename^));
{ if this is the system unit insert the intern }
{ symbols }
make_ref:=false;
@ -334,7 +465,6 @@ unit pmodules;
hp^.ppufile^.read_data(b,1,count);
end;
hp^.ppufile^.close;
{$endif}
dispose(hp^.map);
hp^.map:=nil;
end;
@ -410,11 +540,7 @@ unit pmodules;
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);
@ -460,7 +586,7 @@ unit pmodules;
{ here we need to remove the names ! }
hp^.sourcefiles.done;
hp^.sourcefiles.init;
{$endif not UseBrowser}
{$endif UseBrowser}
if assigned(old_current_module^.current_inputfile) then
old_current_module^.current_inputfile^.tempclose;
Message1(parser_d_compiling_second_time,hp^.mainsource^);
@ -480,6 +606,47 @@ unit pmodules;
loadunit:=hp;
end;
{$endif NEWPPU}
procedure loadsystemunit;
var
hp : pmodule;
begin
{ if the current file isn't a system unit the the system unit
will be loaded }
if not(cs_compilesystem in aktswitches) then
begin
{$ifdef NEWPPU}
hp:=loadunit(upper(target_info.system_unit),true);
systemunit:=hp^.symtable;
{ add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true)));
{$else NEWPPU}
hp:=loadunit(upper(target_info.system_unit),true,true);
systemunit:=hp^.symtable;
{ add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,0)));
{$endif NEWPPU}
{ read default constant definitions }
make_ref:=false;
readconstdefs;
{ we could try to overload caret by default }
symtablestack:=systemunit;
{ if POWER is defined in the RTL then use it for starstar overloading }
getsym('POWER',false);
if assigned(srsym) and (srsym^.typ=procsym) and
(overloaded_operators[STARSTAR]=nil) then
overloaded_operators[STARSTAR]:=pprocsym(srsym);
make_ref:=true;
end
else
begin
createconstdefs;
systemunit:=nil;
end;
end;
procedure loadunits;
var
@ -497,7 +664,14 @@ unit pmodules;
repeat
s:=pattern;
consume(ID);
{$ifdef NEWPPU}
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;
{$else NEWPPU}
hp2:=loadunit(s,false,true);
{$endif NEWPPU}
if current_module^.compiled then
exit;
refsymtable^.insert(new(punitsym,init(s,hp2^.symtable)));
@ -512,10 +686,11 @@ unit pmodules;
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;
{ now insert the units in the symtablestack }
hp:=pused_unit(current_module^.used_units.first);
while assigned(hp) do
begin
{$IfDef GDB}
@ -700,7 +875,6 @@ unit pmodules;
consume(_IMPLEMENTATION);
parse_only:=false;
refsymtable^.number_defs;
{$ifdef GDB}
{ add all used definitions even for implementation}
@ -733,6 +907,10 @@ unit pmodules;
{ to reinsert it after loading the implementation units }
symtablestack:=unitst^.next;
{ number the definitions, so a deref from other units works }
numberunits;
refsymtable^.number_defs;
{ Read the implementation units }
parse_implementation_uses(unitst);
@ -968,7 +1146,11 @@ unit pmodules;
end.
{
$Log$
Revision 1.28 1998-06-13 00:10:10 peter
Revision 1.29 1998-06-16 08:56:25 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.28 1998/06/13 00:10:10 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)

17
compiler/ppu.pas
View File

@ -82,12 +82,10 @@ const
ibsetdef = 50;
ibprocvardef = 51;
ibfloatdef = 52;
ibextsymref = 53;
ibextdefref = 54;
ibclassrefdef = 55;
iblongstringdef = 56;
ibansistringdef = 57;
ibwidestringdef = 58;
ibclassrefdef = 53;
iblongstringdef = 54;
ibansistringdef = 55;
ibwidestringdef = 56;
{ unit flags }
uf_init = $1;
@ -106,6 +104,7 @@ type
id : array[1..3] of char; { = 'PPU' }
ver : array[1..3] of char;
compiler : word;
cpu : word;
target : word;
flags : longint;
size : longint; { size of the ppufile without header }
@ -750,7 +749,11 @@ end;
end.
{
$Log$
Revision 1.5 1998-06-13 00:10:12 peter
Revision 1.6 1998-06-16 08:56:26 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.5 1998/06/13 00:10:12 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)

10
compiler/rai386.pas
View File

@ -1347,8 +1347,8 @@ var
{ this makes cpu.pp uncompilable, but i think this code should be }
{ inserted in the system unit anyways. }
if (instruc >= lastop_in_table) and
((cs_compilesystem in aktswitches) or (aktoptprocessor > systems.i386)) then
if (instruc >= lastop_in_table) then
{ ((cs_compilesystem in aktswitches) or (aktoptprocessor > systems.i386)) then }
begin
Message(assem_w_opcode_not_in_table);
fits:=true;
@ -3376,7 +3376,11 @@ Begin
end.
{
$Log$
Revision 1.10 1998-06-12 10:32:33 pierre
Revision 1.11 1998-06-16 08:56:28 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.10 1998/06/12 10:32:33 pierre
* column problem hopefully solved
+ C vars declaration changed

8
compiler/ratti386.pas
View File

@ -1539,7 +1539,7 @@ const
{ the att version only if the processor > i386 or we are compiling }
{ the system unit then this will be allowed... }
if (instruc >= lastop_in_table) and
((cs_compilesystem in aktswitches) or (aktoptprocessor >systems.i386)) then
((cs_compilesystem in aktswitches) or (aktoptprocessor>int386)) then
begin
Message1(assem_w_opcode_not_in_table,att_op2str[instruc]);
fits:=true;
@ -3691,7 +3691,11 @@ end.
{
$Log$
Revision 1.12 1998-06-12 10:32:35 pierre
Revision 1.13 1998-06-16 08:56:29 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.12 1998/06/12 10:32:35 pierre
* column problem hopefully solved
+ C vars declaration changed

16
compiler/scanner.pas
View File

@ -147,6 +147,7 @@ unit scanner;
orgpattern,
pattern : string;
macrobuffer : pmacrobuffer;
currlinepos,
lastlinepos,
lasttokenpos,
inputbuffer,
@ -336,7 +337,7 @@ unit scanner;
end;
inputbuffer[readsize]:=#0;
inputpointer:=inputbuffer;
lastlinepos:=inputpointer;
currlinepos:=inputpointer;
{ Set EOF when main source and at endoffile }
if eof(current_module^.current_inputfile^.f) then
begin
@ -354,8 +355,9 @@ unit scanner;
status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
inputbuffer:=current_module^.current_inputfile^.buf;
inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos;
lastlinepos:=inputpointer;
currlinepos:=inputpointer;
end;
lastlinepos:=currlinepos;
{ load next char }
c:=inputpointer^;
inc(longint(inputpointer));
@ -387,7 +389,7 @@ unit scanner;
inc(current_module^.current_inputfile^.true_line);
status.currentline:=current_module^.current_inputfile^.true_line;
inc(status.compiledlines);
lastlinepos:=inputpointer;
currlinepos:=inputpointer;
end;
@ -709,6 +711,7 @@ unit scanner;
until false;
{ Save current token position }
lastlinepos:=currlinepos;
lasttokenpos:=inputpointer;
tokenpos.line:=current_module^.current_inputfile^.true_line;
tokenpos.column:=get_file_col;
@ -1173,6 +1176,7 @@ unit scanner;
comment_level:=0;
lasttokenpos:=inputpointer;
lastlinepos:=inputpointer;
currlinepos:=inputpointer;
s_point:=false;
block_type:=bt_general;
end;
@ -1263,7 +1267,11 @@ unit scanner;
end.
{
$Log$
Revision 1.25 1998-06-13 00:10:15 peter
Revision 1.26 1998-06-16 08:56:30 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.25 1998/06/13 00:10:15 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)

46
compiler/symdef.inc
View File

@ -406,10 +406,10 @@
writelong(len);
{$ifdef NEWPPU}
case string_typ of
shortstring : ppufile^.writeentry(ibstringdef);
longstring : ppufile^.writeentry(iblongstringdef);
ansistring : ppufile^.writeentry(ibansistringdef);
widestring : ppufile^.writeentry(ibwidestringdef);
shortstring : current_ppu^.writeentry(ibstringdef);
longstring : current_ppu^.writeentry(iblongstringdef);
ansistring : current_ppu^.writeentry(ibansistringdef);
widestring : current_ppu^.writeentry(ibwidestringdef);
end;
{$endif}
end;
@ -535,7 +535,7 @@
tdef.write;
writelong(max);
{$ifdef NEWPPU}
ppufile^.writeentry(ibenumdef);
current_ppu^.writeentry(ibenumdef);
{$endif}
end;
@ -699,7 +699,7 @@
writelong(low);
writelong(high);
{$ifdef NEWPPU}
ppufile^.writeentry(iborddef);
current_ppu^.writeentry(iborddef);
{$endif}
end;
@ -772,7 +772,7 @@
tdef.write;
writebyte(byte(typ));
{$ifdef NEWPPU}
ppufile^.writeentry(ibfloatdef);
current_ppu^.writeentry(ibfloatdef);
{$endif}
end;
@ -892,7 +892,7 @@
if filetype=ft_typed then
writedefref(typed_as);
{$ifdef NEWPPU}
ppufile^.writeentry(ibfiledef);
current_ppu^.writeentry(ibfiledef);
{$endif}
end;
@ -1013,7 +1013,7 @@
tdef.write;
writedefref(definition);
{$ifdef NEWPPU}
ppufile^.writeentry(ibpointerdef);
current_ppu^.writeentry(ibpointerdef);
{$endif}
end;
@ -1099,7 +1099,7 @@
tdef.write;
writedefref(definition);
{$ifdef NEWPPU}
ppufile^.writeentry(ibclassrefdef);
current_ppu^.writeentry(ibclassrefdef);
{$endif}
end;
@ -1177,7 +1177,7 @@
if settype=varset then
writelong(savesize);
{$ifdef NEWPPU}
ppufile^.writeentry(ibsetdef);
current_ppu^.writeentry(ibsetdef);
{$endif}
end;
@ -1240,7 +1240,7 @@
{$endif}
tdef.write;
{$ifdef NEWPPU}
ppufile^.writeentry(ibformaldef);
current_ppu^.writeentry(ibformaldef);
{$endif}
end;
@ -1327,7 +1327,7 @@
writelong(lowrange);
writelong(highrange);
{$ifdef NEWPPU}
ppufile^.writeentry(ibarraydef);
current_ppu^.writeentry(ibarraydef);
{$endif}
end;
@ -1483,7 +1483,7 @@
tdef.write;
writelong(savesize);
{$ifdef NEWPPU}
ppufile^.writeentry(ibrecorddef);
current_ppu^.writeentry(ibrecorddef);
{$endif}
self.symtable^.writeasstruct;
read_member:=oldread_member;
@ -1862,8 +1862,6 @@
lastwritten:=nil;
defref:=nil;
refcount:=0;
if (current_module^.flags and uf_has_browser)<>0 then
load_references;
{$endif UseBrowser}
end;
@ -1875,7 +1873,7 @@
var
pos : tfileposinfo;
begin
while (not ppufile^.endofentry) do
while (not current_ppu^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
@ -1904,7 +1902,7 @@
writeposinfo(ref^.posinfo);
ref:=ref^.nextref;
end;
ppufile^.writeentry(ibdefref);
current_ppu^.writeentry(ibdefref);
lastwritten:=lastref;
end;
@ -2051,7 +2049,7 @@
}
end;
{$ifdef NEWPPU}
ppufile^.writeentry(ibprocdef);
current_ppu^.writeentry(ibprocdef);
{$endif}
end;
@ -2219,7 +2217,7 @@
{$endif StoreFPULevel}
inherited write;
{$ifdef NEWPPU}
ppufile^.writeentry(ibprocvardef);
current_ppu^.writeentry(ibprocvardef);
{$endif}
end;
@ -2471,7 +2469,7 @@
writedefref(childof);
writelong(options);
{$ifdef NEWPPU}
ppufile^.writeentry(ibobjectdef);
current_ppu^.writeentry(ibobjectdef);
{$endif}
if (options and (oo_hasprivate or oo_hasprotected))<>0 then
object_options:=true;
@ -2646,7 +2644,11 @@
{
$Log$
Revision 1.13 1998-06-15 15:38:09 pierre
Revision 1.14 1998-06-16 08:56:31 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.13 1998/06/15 15:38:09 pierre
* small bug in systems.pas corrected
+ operators in different units better hanlded

629
compiler/symppu.inc
View File

@ -31,45 +31,46 @@
{$ENDIF}
{$ENDIF}
{$ifdef NEWPPU}
{*****************************************************************************
PPU Writing
*****************************************************************************}
{$ifdef NEWPPU}
procedure writebyte(b:byte);
begin
ppufile^.putbyte(b);
current_ppu^.putbyte(b);
end;
procedure writeword(w:word);
begin
ppufile^.putword(w);
current_ppu^.putword(w);
end;
procedure writelong(l:longint);
begin
ppufile^.putlongint(l);
current_ppu^.putlongint(l);
end;
procedure writedouble(d:double);
begin
ppufile^.putdata(d,sizeof(double));
current_ppu^.putdata(d,sizeof(double));
end;
procedure writestring(const s:string);
begin
ppufile^.putstring(s);
current_ppu^.putstring(s);
end;
procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
begin
ppufile^.putdata(s,32);
current_ppu^.putdata(s,32);
end;
@ -83,11 +84,11 @@
while not p.empty do
begin
s:=p.get;
ppufile^.putstring(s);
current_ppu^.putstring(s);
if hold then
hcontainer.insert(s);
end;
ppufile^.writeentry(id);
current_ppu^.writeentry(id);
if hold then
p:=hcontainer;
end;
@ -95,23 +96,23 @@
procedure writeposinfo(const p:tfileposinfo);
begin
writeword(p.fileindex);
writelong(p.line);
writeword(p.column);
current_ppu^.putword(p.fileindex);
current_ppu^.putlongint(p.line);
current_ppu^.putword(p.column);
end;
procedure writedefref(p : pdef);
begin
if p=nil then
ppufile^.putlongint($ffffffff)
current_ppu^.putlongint($ffffffff)
else
begin
if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
ppufile^.putword($ffff)
current_ppu^.putword($ffff)
else
ppufile^.putword(p^.owner^.unitid);
ppufile^.putword(p^.indexnb);
current_ppu^.putword(p^.owner^.unitid);
current_ppu^.putword(p^.indexnb);
end;
end;
@ -119,18 +120,56 @@
procedure writesymref(p : psym);
begin
if p=nil then
writelong($ffffffff)
current_ppu^.putlongint($ffffffff)
else
begin
if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
writeword($ffff)
current_ppu^.putword($ffff)
else
writeword(p^.owner^.unitid);
writeword(p^.indexnb);
current_ppu^.putword(p^.owner^.unitid);
current_ppu^.putword(p^.indexnb);
end;
end;
procedure writesourcefiles;
var
hp2 : pextfile;
index : longint;
begin
{ second write the used source files }
hp2:=current_module^.sourcefiles.files;
index:=current_module^.sourcefiles.last_ref_index;
while assigned(hp2) do
begin
{ only name and extension }
current_ppu^.putstring(hp2^.name^+hp2^.ext^);
{ index in that order }
hp2^.ref_index:=index;
dec(index);
hp2:=hp2^._next;
end;
current_ppu^.writeentry(ibsourcefiles);
end;
procedure writeusedunit;
var
hp : pused_unit;
begin
numberunits;
hp:=pused_unit(current_module^.used_units.first);
while assigned(hp) do
begin
current_ppu^.putstring(hp^.name^);
current_ppu^.putlongint(hp^.checksum);
current_ppu^.putbyte(byte(hp^.in_interface));
hp:=pused_unit(hp^.next);
end;
current_ppu^.writeentry(ibloadunit_int);
end;
procedure writeunitas(const s : string;unittable : punitsymtable);
begin
Message1(unit_u_ppu_write,s);
@ -155,33 +194,357 @@
end;
{ open ppufile }
ppufile:=new(pppufile,init(s));
ppufile^.change_endian:=source_os.endian<>target_os.endian;
if not ppufile^.create then
current_ppu:=new(pppufile,init(s));
current_ppu^.change_endian:=source_os.endian<>target_os.endian;
if not current_ppu^.create then
Message(unit_f_ppu_cannot_write);
{ write symbols and definitions }
unittable^.writeasunit;
{ flush to be sure }
ppufile^.flush;
current_ppu^.flush;
{ create and write header }
ppufile^.header.size:=ppufile^.size;
ppufile^.header.checksum:=ppufile^.crc;
ppufile^.header.compiler:=wordversion;
ppufile^.header.target:=word(target_info.target);
ppufile^.header.flags:=current_module^.flags;
ppufile^.writeheader;
current_ppu^.header.size:=current_ppu^.size;
current_ppu^.header.checksum:=current_ppu^.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;
current_ppu^.writeheader;
{ save crc in current_module also }
current_module^.crc:=ppufile^.crc;
current_module^.crc:=current_ppu^.crc;
{ close }
ppufile^.close;
dispose(ppufile,done);
current_ppu^.close;
dispose(current_ppu,done);
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 readdouble : double;
var
d : double;
begin
current_ppu^.getdata(d,sizeof(double));
if current_ppu^.error then
Message(unit_f_ppu_read_error);
readdouble:=d;
end;
function readstring : string;
begin
readstring:=current_ppu^.getstring;
if current_ppu^.error then
Message(unit_f_ppu_read_error);
end;
procedure readset(var s); {You cannot pass an array [0..31] of byte.}
begin
current_ppu^.getdata(s,32);
if current_ppu^.error then
Message(unit_f_ppu_read_error);
end;
procedure readcontainer(var p:tstringcontainer);
begin
while not current_ppu^.endofentry do
p.insert(current_ppu^.getstring);
end;
procedure readposinfo(var p:tfileposinfo);
begin
p.fileindex:=current_ppu^.getword;
p.line:=current_ppu^.getlongint;
p.column:=current_ppu^.getword;
end;
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;
{$ifdef UseBrowser}
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 readsourcefiles;
var
temp,hs : string;
incfile_found : boolean;
ppufiletime,
source_time : longint;
{$ifdef UseBrowser}
hp : pextfile;
_d,_n,_e : string;
{$endif UseBrowser}
begin
ppufiletime:=getnamedfiletime(current_module^.ppufilename^);
current_module^.sources_avail:=true;
while not current_ppu^.endofentry do
begin
hs:=current_ppu^.getstring;
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);
if Source_Time=-1 then
begin
{ search for include files in the includepathlist }
temp:=search(hs,includesearchpath,incfile_found);
if incfile_found then
begin
hs:=temp+hs;
Source_Time:=GetNamedFileTime(hs);
end;
end
else
hs:=current_module^.path^+hs;
if Source_Time=-1 then
begin
current_module^.sources_avail:=false;
temp:=' not found';
end
else
begin
temp:=' time '+filetimestring(source_time);
if (source_time>ppufiletime) then
begin
current_module^.do_compile:=true;
temp:=temp+' *'
end;
end;
end;
Message1(unit_t_ppu_source,hs+temp);
{$ifdef UseBrowser}
fsplit(hs,_d,_n,_e);
new(hp,init(_d,_n,_e));
{ the indexing should match what is done in writeasunit }
current_module^.sourcefiles.register_file(hp);
{$endif UseBrowser}
end;
{ main source is always the last }
stringdispose(current_module^.mainsource);
current_module^.mainsource:=stringdup(hs);
{ check if we want to rebuild every unit, only if the sources are
available }
if do_build and current_module^.sources_avail then
current_module^.do_compile:=true;
end;
procedure readloadunit;
var
hs : string;
checksum : longint;
in_interface : boolean;
begin
while not current_ppu^.endofentry do
begin
hs:=current_ppu^.getstring;
checksum:=current_ppu^.getlongint;
in_interface:=(current_ppu^.getbyte<>0);
current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,in_interface)));
end;
end;
procedure load_interface;
var
b : byte;
begin
{ read interface part }
repeat
b:=current_ppu^.readentry;
case b of
{ ibinitunit : usedunits^.insert(readstring); }
ibmodulename : begin
stringdispose(current_module^.modulename);
current_module^.modulename:=stringdup(current_ppu^.getstring);
end;
ibsourcefiles : readsourcefiles;
ibloadunit_int : readloadunit;
iblinksharedlibs : readcontainer(current_module^.LinkSharedLibs);
iblinkstaticlibs : readcontainer(current_module^.LinkStaticLibs);
iblinkofiles : readcontainer(current_module^.LinkOFiles);
ibendinterface : break;
else
Message1(unit_f_ppu_invalid_entry,tostr(b));
end;
until false;
end;
{$else NEWPPU}
{*****************************************************************************
Old PPU
*****************************************************************************}
function readbyte : byte;
var
count : longint;
b : byte;
begin
current_module^.ppufile^.read_data(b,sizeof(byte),count);
readbyte:=b;
if count<>1 then
Message(unit_f_ppu_read_error);
end;
function readword : word;
var
count : longint;
w : word;
begin
current_module^.ppufile^.read_data(w,sizeof(word),count);
readword:=w;
if count<>sizeof(word) then
Message(unit_f_ppu_read_error);
end;
function readlong : longint;
var
count,l : longint;
begin
current_module^.ppufile^.read_data(l,sizeof(longint),count);
readlong:=l;
if count<>sizeof(longint) then
Message(unit_f_ppu_read_error);
end;
function readdouble : double;
var
count : longint;
d : double;
begin
current_module^.ppufile^.read_data(d,sizeof(double),count);
readdouble:=d;
if count<>sizeof(double) then
Message(unit_f_ppu_read_error);
end;
function readstring : string;
var
s : string;
count : longint;
begin
s[0]:=char(readbyte);
current_module^.ppufile^.read_data(s[1],ord(s[0]),count);
if count<>ord(s[0]) then
Message(unit_f_ppu_read_error);
readstring:=s;
end;
{***SETCONST}
procedure readset(var s); {You cannot pass an array [0..31] of byte.}
var count:longint;
begin
current_module^.ppufile^.read_data(s,32,count);
if count<>32 then
Message(unit_f_ppu_read_error);
end;
{***}
procedure readposinfo(var p:tfileposinfo);
begin
p.fileindex:=readword;
p.line:=readlong;
p.column:=readword;
end;
function readdefref : pdef;
var
hd : pdef;
begin
longint(hd):=readword;
longint(hd):=longint(hd) or (longint(readword) shl 16);
readdefref:=hd;
end;
{$ifdef UseBrowser}
function readsymref : psym;
var
hd : psym;
begin
longint(hd):=readword;
longint(hd):=longint(hd) or (longint(readword) shl 16);
readsymref:=hd;
end;
{$endif UseBrowser}
procedure writebyte(b:byte);
begin
ppufile.write_data(b,1);
@ -328,205 +691,17 @@
ppufile.done;
end;
{$endif NEWPPU}
{*****************************************************************************
PPU Reading
*****************************************************************************}
{$ifdef NEWPPU}
function readbyte:byte;
begin
readbyte:=ppufile^.getbyte;
if ppufile^.error then
Message(unit_f_ppu_read_error);
end;
function readword:word;
begin
readword:=ppufile^.getword;
if ppufile^.error then
Message(unit_f_ppu_read_error);
end;
function readlong:longint;
begin
readlong:=ppufile^.getlongint;
if ppufile^.error then
Message(unit_f_ppu_read_error);
end;
function readdouble : double;
var
d : double;
begin
ppufile^.getdata(d,sizeof(double));
if ppufile^.error then
Message(unit_f_ppu_read_error);
readdouble:=d;
end;
function readstring : string;
begin
readstring:=ppufile^.getstring;
if ppufile^.error then
Message(unit_f_ppu_read_error);
end;
procedure readset(var s); {You cannot pass an array [0..31] of byte.}
begin
ppufile^.getdata(s,32);
if ppufile^.error then
Message(unit_f_ppu_read_error);
end;
procedure readcontainer(var p:tstringcontainer);
begin
while not current_module^.ppufile^.endofentry do
p.insert(current_module^.ppufile^.getstring);
end;
procedure readposinfo(var p:tfileposinfo);
begin
p.fileindex:=readword;
p.line:=readlong;
p.column:=readword;
end;
function readdefref : pdef;
var
hd : pdef;
begin
longint(hd):=readword;
longint(hd):=longint(hd) or (longint(readword) shl 16);
readdefref:=hd;
end;
{$ifdef UseBrowser}
function readsymref : psym;
var
hd : psym;
begin
longint(hd):=readword;
longint(hd):=longint(hd) or (longint(readword) shl 16);
readsymref:=hd;
end;
{$endif}
{$else NEWPPU}
function readbyte : byte;
var
count : longint;
b : byte;
begin
current_module^.ppufile^.read_data(b,sizeof(byte),count);
readbyte:=b;
if count<>1 then
Message(unit_f_ppu_read_error);
end;
function readword : word;
var
count : longint;
w : word;
begin
current_module^.ppufile^.read_data(w,sizeof(word),count);
readword:=w;
if count<>sizeof(word) then
Message(unit_f_ppu_read_error);
end;
function readlong : longint;
var
count,l : longint;
begin
current_module^.ppufile^.read_data(l,sizeof(longint),count);
readlong:=l;
if count<>sizeof(longint) then
Message(unit_f_ppu_read_error);
end;
function readdouble : double;
var
count : longint;
d : double;
begin
current_module^.ppufile^.read_data(d,sizeof(double),count);
readdouble:=d;
if count<>sizeof(double) then
Message(unit_f_ppu_read_error);
end;
function readstring : string;
var
s : string;
count : longint;
begin
s[0]:=char(readbyte);
current_module^.ppufile^.read_data(s[1],ord(s[0]),count);
if count<>ord(s[0]) then
Message(unit_f_ppu_read_error);
readstring:=s;
end;
{***SETCONST}
procedure readset(var s); {You cannot pass an array [0..31] of byte.}
var count:longint;
begin
current_module^.ppufile^.read_data(s,32,count);
if count<>32 then
Message(unit_f_ppu_read_error);
end;
{***}
procedure readposinfo(var p:tfileposinfo);
begin
p.fileindex:=readword;
p.line:=readlong;
p.column:=readword;
end;
function readdefref : pdef;
var
hd : pdef;
begin
longint(hd):=readword;
longint(hd):=longint(hd) or (longint(readword) shl 16);
readdefref:=hd;
end;
{$ifdef UseBrowser}
function readsymref : psym;
var
hd : psym;
begin
longint(hd):=readword;
longint(hd):=longint(hd) or (longint(readword) shl 16);
readsymref:=hd;
end;
{$endif UseBrowser}
{$endif NEWPPU}
{
$Log$
Revision 1.3 1998-06-13 00:10:17 peter
Revision 1.4 1998-06-16 08:56:32 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.3 1998/06/13 00:10:17 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)

28
compiler/symsym.inc
View File

@ -82,7 +82,7 @@
var
pos : tfileposinfo;
begin
while (not ppufile^.endofentry) do
while (not current_ppu^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
@ -113,7 +113,7 @@
ref:=ref^.nextref;
end;
lastwritten:=lastref;
ppufile^.writeentry(ibsymref);
current_ppu^.writeentry(ibsymref);
{ when it's a procsym then write also the refs to the definition
due the overloading }
if typ=procsym then
@ -515,7 +515,7 @@
tsym.write;
writedefref(pdef(definition));
{$ifdef NEWPPU}
ppufile^.writeentry(ibprocsym);
current_ppu^.writeentry(ibprocsym);
{$endif}
end;
@ -673,7 +673,7 @@
writedefref(readaccessdef);
writedefref(writeaccessdef);
{$ifdef NEWPPU}
ppufile^.writeentry(ibpropertysym);
current_ppu^.writeentry(ibpropertysym);
{$endif}
end;
@ -756,7 +756,7 @@
toaddr : writelong(address);
end;
{$ifdef NEWPPU}
ppufile^.writeentry(ibabsolutesym);
current_ppu^.writeentry(ibabsolutesym);
{$endif}
end;
@ -900,9 +900,9 @@
end;
{$ifdef NEWPPU}
if (var_options and vo_is_C_var)<>0 then
ppufile^.writeentry(ibvarsym_C)
current_ppu^.writeentry(ibvarsym_C)
else
ppufile^.writeentry(ibvarsym);
current_ppu^.writeentry(ibvarsym);
{$endif}
end;
@ -1239,7 +1239,7 @@
writedefref(definition);
writestring(prefix^);
{$ifdef NEWPPU}
ppufile^.writeentry(ibtypedconstsym);
current_ppu^.writeentry(ibtypedconstsym);
{$endif}
end;
@ -1387,7 +1387,7 @@
else internalerror(13);
end;
{$ifdef NEWPPU}
ppufile^.writeentry(ibconstsym);
current_ppu^.writeentry(ibconstsym);
{$endif}
end;
@ -1497,7 +1497,7 @@
writedefref(definition);
writelong(value);
{$ifdef NEWPPU}
ppufile^.writeentry(ibenumsym);
current_ppu^.writeentry(ibenumsym);
{$endif}
end;
@ -1573,7 +1573,7 @@
tsym.write;
writedefref(definition);
{$ifdef NEWPPU}
ppufile^.writeentry(ibtypesym);
current_ppu^.writeentry(ibtypesym);
{$endif}
end;
@ -1680,7 +1680,11 @@
{
$Log$
Revision 1.13 1998-06-15 15:38:10 pierre
Revision 1.14 1998-06-16 08:56:34 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.13 1998/06/15 15:38:10 pierre
* small bug in systems.pas corrected
+ operators in different units better hanlded

20
compiler/systems.pas
View File

@ -28,9 +28,11 @@ unit systems;
type
tendian = (endian_little,en_big_endian);
ttargetcpu = (i386,m68k,alpha);
tprocessors = (
{$ifdef i386}
i386,i486,pentium,pentiumpro,cx6x86,pentium2,amdk6
int386,int486,pentium,pentiumpro,cx6x86,pentium2,amdk6
{$endif}
{$ifdef m68k}
MC68000,MC68020
@ -44,7 +46,7 @@ unit systems;
{$endif}
{$ifdef m68k}
M68K_MOT
{$endif}
{$endif}
);
@ -164,6 +166,14 @@ unit systems;
idtxt : string[8];
end;
const
{$ifdef i386}
target_cpu = i386;
{$endif i386}
{$ifdef m68k}
target_cpu = m68k;
{$endif m68k}
var
target_info : ttargetinfo;
target_os : tosinfo;
@ -844,7 +854,11 @@ begin
end.
{
$Log$
Revision 1.20 1998-06-15 15:38:14 pierre
Revision 1.21 1998-06-16 08:56:36 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.20 1998/06/15 15:38:14 pierre
* small bug in systems.pas corrected
+ operators in different units better hanlded