paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-01 22:09:28 +01:00
Code Issues Packages Projects Releases Wiki Activity

* symtable.pas splitted into includefiles

Browse Source 
* symtable adapted for $ifdef NEWPPU
This commit is contained in:
peter 1998-05-27 19:45:02 +00:00
parent fd402226d0
commit 7b28ebd6ef
8 changed files with 4669 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/files.pas
View File

@ -411,10 +411,10 @@ unit files;
Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
{ Unitname }
b:=ppufile^.readentry;
if b=ibunitname then
if b=ibmodulename then
begin
stringdispose(unitname);
unitname:=stringdup(ppufile^.getstring);
stringdispose(modulename);
modulename:=stringdup(ppufile^.getstring);
b:=ppufile^.readentry;
end;
@ -487,7 +487,7 @@ unit files;
begin
if (flags and uf_smartlink)<>0 then
begin
objfiletime:=getnamedfiletime(arfilename^);
objfiletime:=getnamedfiletime(libfilename^);
if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
do_compile:=true;
end
@ -927,7 +927,11 @@ unit files;
end.
{
$Log$
Revision 1.13 1998-05-23 01:21:05 peter
Revision 1.14 1998-05-27 19:45:02 peter
* symtable.pas splitted into includefiles
* symtable adapted for $ifdef NEWPPU
Revision 1.13 1998/05/23 01:21:05 peter
+ aktasmmode, aktoptprocessor, aktoutputformat
+ smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+ $LIBNAME to set the library name where the unit will be put in

11
compiler/parser.pas
View File

@ -297,8 +297,9 @@ unit parser;
{ init code generator for a new module }
codegen_newmodule;
{$ifdef GDB}
reset_gdb_info;
{$endif GDB}
{ global switches are read, so further changes aren't allowed }
current_module^.in_main:=true;
@ -429,7 +430,9 @@ done:
if dispose_asm_lists then
codegen_donemodule;
{$ifdef GDB}
reset_gdb_info;
{$endif GDB}
{ restore symtable state }
{$ifdef UseBrowser}
if (compile_level>1) then
@ -508,7 +511,11 @@ done:
end.
{
$Log$
Revision 1.18 1998-05-23 01:21:15 peter
Revision 1.19 1998-05-27 19:45:04 peter
* symtable.pas splitted into includefiles
* symtable adapted for $ifdef NEWPPU
Revision 1.18 1998/05/23 01:21:15 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

12
compiler/pexpr.pas
View File

@ -1448,7 +1448,7 @@ unit pexpr;
do_firstpass(p1);
case p1^.treetype of
ordconstn : begin
if p1^.resulttype=s32bitdef then
if porddef(p1^.resulttype)=s32bitdef then
p1^.resulttype:=u8bitdef;
if pd=nil then
pd:=p1^.resulttype;
@ -1460,7 +1460,7 @@ unit pexpr;
consume(POINTPOINT);
p3:=comp_expr(true);
do_firstpass(p3);
if p3^.resulttype=s32bitdef then
if porddef(p3^.resulttype)=s32bitdef then
p3^.resulttype:=u8bitdef;
if not(is_equal(pd,p3^.resulttype)) then
Message(parser_e_typeconflict_in_set)
@ -1485,7 +1485,7 @@ unit pexpr;
end;
else
begin
if p1^.resulttype=s32bitdef then
if porddef(p1^.resulttype)=s32bitdef then
p1^.resulttype:=u8bitdef;
if pd=nil then
pd:=p1^.resulttype;
@ -1745,7 +1745,11 @@ unit pexpr;
end.
{
$Log$
Revision 1.20 1998-05-26 07:53:59 pierre
Revision 1.21 1998-05-27 19:45:05 peter
* symtable.pas splitted into includefiles
* symtable adapted for $ifdef NEWPPU
Revision 1.20 1998/05/26 07:53:59 pierre
* bug fix for empty sets (nil pd was dereferenced )
Revision 1.19 1998/05/25 17:11:43 pierre

10
compiler/pmodules.pas
View File

@ -308,7 +308,7 @@ unit pmodules;
hp^.ppufile:=nil;
{ recompile or give an fatal error }
if not(hp^.sources_avail) then
Message1(unit_f_cant_compile_unit,hp^.unitname^)
Message1(unit_f_cant_compile_unit,hp^.modulename^)
else
begin
{$ifdef TEST_TEMPCLOSE}
@ -330,7 +330,7 @@ unit pmodules;
Message(unit_f_too_much_units);
end;
{ ok, now load the unit }
hp^.symtable:=new(punitsymtable,load(hp^.unitname^));
hp^.symtable:=new(punitsymtable,load(hp^.modulename^));
{ if this is the system unit insert the intern symbols }
make_ref:=false;
if compile_system then
@ -1110,7 +1110,11 @@ unit pmodules;
end.
{
$Log$
Revision 1.15 1998-05-23 01:21:22 peter
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

37
compiler/ppu.pas
View File

@ -33,7 +33,7 @@ const
{$endif}
{ppu entries}
ibunitname = 1;
ibmodulename = 1;
ibsourcefile = 2;
ibloadunit_int = 3;
ibloadunit_imp = 4;
@ -43,6 +43,9 @@ const
ibstaticlibs = 8;
ibdbxcount = 9;
ibref = 10;
ibenddefs = 250;
ibendsyms = 251;
ibendheader = 252;
ibentry = 254;
ibend = 255;
{syms}
@ -107,8 +110,8 @@ type
pppufile=^tppufile;
tppufile=object
f : file;
error,
writing : boolean;
mode : byte; {0 - Closed, 1 - Reading, 2 - Writing}
error : boolean;
fname : string;
fsize : longint;
@ -235,7 +238,7 @@ constructor tppufile.init(fn:string);
begin
fname:=fn;
change_endian:=false;
writing:=false;
Mode:=0;
NewHeader;
getmem(buf,ppubufsize);
end;
@ -250,7 +253,7 @@ end;
procedure tppufile.flush;
begin
if writing then
if Mode=2 then
writebuf;
end;
@ -259,11 +262,15 @@ procedure tppufile.close;
var
i : word;
begin
Flush;
{$I-}
system.close(f);
{$I+}
i:=ioresult;
if Mode<>0 then
begin
Flush;
{$I-}
system.close(f);
{$I+}
i:=ioresult;
Mode:=0;
end;
end;
@ -346,7 +353,7 @@ begin
{reset buffer}
bufstart:=i;
bufsize:=0;
writing:=false;
Mode:=1;
open:=true;
end;
@ -508,6 +515,7 @@ begin
{$I+}
if ioresult<>0 then
exit;
Mode:=2;
{write header for sure}
blockwrite(f,header,sizeof(tppuheader));
bufsize:=ppubufsize;
@ -515,7 +523,6 @@ begin
crc:=$ffffffff;
do_crc:=true;
size:=0;
writing:=true;
create:=true;
end;
@ -644,7 +651,11 @@ end;
end.
{
$Log$
Revision 1.1 1998-05-12 10:56:07 peter
Revision 1.2 1998-05-27 19:45:08 peter
* symtable.pas splitted into includefiles
* symtable adapted for $ifdef NEWPPU
Revision 1.1 1998/05/12 10:56:07 peter
+ the ppufile object unit
}

2376
compiler/symdef.inc Normal file
View File

File diff suppressed because it is too large Load Diff

541
compiler/symppu.inc Normal file
View File

@ -0,0 +1,541 @@
{
$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}
{*****************************************************************************
PPU Writing
*****************************************************************************}
{$ifdef NEWPPU}
procedure writebyte(b:byte);
begin
ppufile.putbyte(b);
end;
procedure writeword(w:word);
begin
ppufile.putword(w);
end;
procedure writelong(l:longint);
begin
ppufile.putlongint(l);
end;
procedure writedouble(d:double);
begin
ppufile.putdata(d,sizeof(double));
end;
procedure writestring(const s:string);
begin
ppufile.putstring(s);
end;
procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
begin
ppufile.putdata(s,32);
end;
procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean);
var
hcontainer : tstringcontainer;
s : string;
begin
if hold then
hcontainer.init;
while not p.empty do
begin
s:=p.get;
ppufile.putstring(s);
if hold then
hcontainer.insert(s);
end;
ppufile.writeentry(id);
if hold then
p:=hcontainer;
end;
procedure writeposinfo(const p:tfileposinfo);
begin
writeword(p.fileindex);
writelong(p.line);
writeword(p.column);
end;
procedure writedefref(p : pdef);
begin
if p=nil then
ppufile.putlongint($ffffffff)
else
begin
if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
ppufile.putword($ffff)
else
ppufile.putword(p^.owner^.unitid);
ppufile.putword(p^.number);
end;
end;
{$ifdef UseBrowser}
procedure writesymref(p : psym);
begin
if p=nil then
writelong($ffffffff)
else
begin
if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
writeword($ffff)
else
writeword(p^.owner^.unitid);
writeword(p^.indexnb);
end;
end;
{$endif UseBrowser}
procedure writeunitas(const s : string;unit_symtable : punitsymtable);
{$ifdef UseBrowser}
var
pus : punitsymtable;
{$endif UseBrowser}
begin
Message1(unit_u_ppu_write,s);
{ create unit flags }
with Current_Module^ do
begin
if cs_smartlink in aktswitches then
begin
flags:=flags or uf_smartlink;
if SplitName(ppufilename^)<>SplitName(libfilename^) then
flags:=flags or uf_in_library;
end;
if use_dbx then
flags:=flags or uf_uses_dbx;
if target_os.endian=en_big_endian then
flags:=flags or uf_big_endian;
{$ifdef UseBrowser}
if use_browser then
flags:=flags or uf_uses_browser;
{$endif UseBrowser}
end;
ppufile.init(s);
ppufile.change_endian:=source_os.endian<>target_os.endian;
if not ppufile.create then
Message(unit_f_ppu_cannot_write);
unit_symtable^.writeasunit;
{$ifdef UseBrowser}
{ write all new references to old unit elements }
pus:=punitsymtable(unit_symtable^.next);
if use_browser then
while assigned(pus) do
begin
if pus^.symtabletype = unitsymtable then
pus^.write_external_references;
pus:=punitsymtable(pus^.next);
end;
{$endif UseBrowser}
ppufile.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;
{ save crc in current_module also }
current_module^.crc:=ppufile.crc;
{ close }
ppufile.close;
ppufile.done;
end;
{$else NEWPPU}
procedure writebyte(b:byte);
begin
ppufile.write_data(b,1);
end;
procedure writeword(w:word);
begin
ppufile.write_data(w,2);
end;
procedure writelong(l:longint);
begin
ppufile.write_data(l,4);
end;
procedure writedouble(d:double);
begin
ppufile.write_data(d,sizeof(double));
end;
procedure writestring(s : string);
begin
ppufile.write_data(s,length(s)+1);
end;
procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
begin
ppufile.write_data(s,32);
end;
procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean);
var
hcontainer : tstringcontainer;
s : string;
begin
if hold then
hcontainer.init;
while not p.empty do
begin
writebyte(id);
s:=p.get;
writestring(s);
if hold then
hcontainer.insert(s);
end;
if hold then
p:=hcontainer;
end;
procedure writeposinfo(const p:tfileposinfo);
begin
writeword(p.fileindex);
writelong(p.line);
writeword(p.column);
end;
procedure writedefref(p : pdef);
begin
if p=nil then
writelong($ffffffff)
else
begin
if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
writeword($ffff)
else
writeword(p^.owner^.unitid);
writeword(p^.number);
end;
end;
{$ifdef UseBrowser}
procedure writesymref(p : psym);
begin
if p=nil then
writelong($ffffffff)
else
begin
if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
writeword($ffff)
else
writeword(p^.owner^.unitid);
writeword(p^.indexnb);
end;
end;
{$endif UseBrowser}
procedure writeunitas(const s : string;unit_symtable : punitsymtable);
{$ifdef UseBrowser}
var
pus : punitsymtable;
{$endif UseBrowser}
begin
Message1(unit_u_ppu_write,s);
{ create unit flags }
with Current_Module^ do
begin
if cs_smartlink in aktswitches then
begin
flags:=flags or uf_smartlink;
if SplitName(ppufilename^)<>SplitName(libfilename^) then
flags:=flags or uf_in_library;
end;
if use_dbx then
flags:=flags or uf_uses_dbx;
if target_os.endian=en_big_endian then
flags:=flags or uf_big_endian;
{$ifdef UseBrowser}
if use_browser then
flags:=flags or uf_uses_browser;
{$endif UseBrowser}
end;
{ open en init ppufile }
ppufile.init(s,ppubufsize);
ppufile.change_endian:=source_os.endian<>target_os.endian;
ppufile.rewrite;
if ioresult<>0 then
Message(unit_f_ppu_cannot_write);
{ create and write header }
unitheader[8]:=char(byte(target_info.target));
unitheader[9]:=char(current_module^.flags);
ppufile.write_data(unitheader,sizeof(unitheader));
ppufile.clear_crc;
ppufile.do_crc:=true;
unit_symtable^.writeasunit;
ppufile.flush;
ppufile.do_crc:=false;
{$ifdef UseBrowser}
{ write all new references to old unit elements }
pus:=punitsymtable(unit_symtable^.next);
if use_browser then
while assigned(pus) do
begin
if pus^.symtabletype = unitsymtable then
pus^.write_external_references;
pus:=punitsymtable(pus^.next);
end;
{$endif UseBrowser}
{ writes the checksum }
ppufile.seek(10);
current_module^.crc:=ppufile.getcrc;
ppufile.write_data(current_module^.crc,4);
ppufile.flush;
ppufile.done;
end;
{$endif NEWPPU}
{*****************************************************************************
PPU Reading
*****************************************************************************}
{$ifdef NEWPPU}
function readbyte:byte;
begin
readbyte:=current_module^.ppufile^.getbyte;
if current_module^.ppufile^.error then
Message(unit_f_ppu_read_error);
end;
function readword:word;
begin
readword:=current_module^.ppufile^.getword;
if current_module^.ppufile^.error then
Message(unit_f_ppu_read_error);
end;
function readlong:longint;
begin
readlong:=current_module^.ppufile^.getlongint;
if current_module^.ppufile^.error then
Message(unit_f_ppu_read_error);
end;
function readdouble : double;
var
d : double;
begin
current_module^.ppufile^.getdata(d,sizeof(double));
if current_module^.ppufile^.error then
Message(unit_f_ppu_read_error);
readdouble:=d;
end;
function readstring : string;
begin
readstring:=current_module^.ppufile^.getstring;
if current_module^.ppufile^.error then
Message(unit_f_ppu_read_error);
end;
procedure readset(var s); {You cannot pass an array [0..31] of byte.}
begin
current_module^.ppufile^.getdata(s,32);
if current_module^.ppufile^.error then
Message(unit_f_ppu_read_error);
end;
procedure readcontainer(var p:tstringcontainer);
begin
p.init;
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.1 1998-05-27 19:45:09 peter
* symtable.pas splitted into includefiles
* symtable adapted for $ifdef NEWPPU
}

1695
compiler/symsym.inc Normal file
View File

File diff suppressed because it is too large Load Diff