paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 12:49:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* memory optimization (3-4%) : cleanup of tai fields,

Browse Source 
cleanup of tdef and tsym fields.
  * make it work for m68k
This commit is contained in:
carl 2002-11-17 16:31:55 +00:00
parent 170f43315d
commit 64655be168
30 changed files with 453 additions and 310 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
compiler/aasmbase.pas
View File

@ -65,9 +65,7 @@ interface
{ pointer to objectdata that is the owner of this symbol }
objectdata : pointer;
{ pointer to the tai that is the owner of this symbol }
taiowner : pointer;
{ TRUE if the symbol is local for a procedure/function }
proclocal : boolean;
{ taiowner : pointer;}
{ Is the symbol in the used list }
inusedlist : boolean;
{ assembler pass label is set, used for detecting multiple labels }
@ -254,6 +252,7 @@ implementation
procedure tasmsymbol.reset;
begin
{ WriteLn(ClassName,' InstanceSize :',InstanceSize);}
{ reset section info }
section:=sec_none;
address:=0;
@ -261,9 +260,8 @@ implementation
indexnr:=-1;
pass:=255;
currbind:=AB_EXTERNAL;
proclocal:=false;
altsymbol:=nil;
taiowner:=nil;
{ taiowner:=nil;}
end;
@ -313,7 +311,6 @@ implementation
begin;
labelnr:=nr;
inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION);
proclocal:=true;
is_set:=false;
is_addr := false;
end;
@ -329,7 +326,6 @@ implementation
inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
is_set:=false;
is_addr := false;
proclocal := false;
{ write it always }
increfs;
end;
@ -888,7 +884,12 @@ implementation
end.
{
$Log$
Revision 1.11 2002-11-15 16:29:30 peter
Revision 1.12 2002-11-17 16:31:55 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.11 2002/11/15 16:29:30 peter
* made tasmsymbol.refs private (merged)
Revision 1.10 2002/11/15 01:58:45 peter

131
compiler/aasmtai.pas
View File

@ -150,6 +150,20 @@ interface
{$endif GDB}
,ait_regalloc, ait_tempalloc, ait_symbol_end];
{ ait_* types which do not have line information (and hence which are of type
tai, otherwise, they are of type tailineinfo }
{ ait_* types which do not have line information (and hence which are of type
tai, otherwise, they are of type tailineinfo }
SkipLineInfo =[ait_label,
ait_regalloc,ait_tempalloc,
{$ifdef GDB}
ait_stabn,ait_stabs,ait_stab_function_name,
{$endif GDB}
ait_cut,ait_marker,ait_align,ait_section,ait_comment,
ait_const_8bit,ait_const_16bit,ait_const_32bit,
ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit
];
type
{ cut type, required for alphanumeric ordering of the assembler filenames }
@ -159,13 +173,15 @@ interface
AsmBlockStart,AsmBlockEnd,
InlineStart,InlineEnd);
{ the short name makes typing easier }
{ Buffer type used for alignment }
tfillbuffer = array[0..63] of char;
{ abstract assembler item }
tai = class(TLinkedListItem)
{$ifndef NOOPT}
{ pointer to record with optimizer info about this tai object }
optinfo : pointer;
{$endif NOOPT}
fileinfo : tfileposinfo;
typ : taitype;
constructor Create;
constructor ppuload(t:taitype;ppufile:tcompilerppufile);virtual;
@ -175,12 +191,21 @@ interface
procedure checkredefinesym(sym:tasmsymbol);
end;
{ abstract assembler item with line information }
tailineinfo = class(tai)
fileinfo : tfileposinfo;
constructor Create;
constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
end;
taiclass = class of tai;
taiclassarray = array[taitype] of taiclass;
{ Generates an assembler string }
tai_string = class(tai)
tai_string = class(tailineinfo)
str : pchar;
{ extra len so the string can contain an \0 }
len : longint;
@ -194,7 +219,7 @@ interface
end;
{ Generates a common label }
tai_symbol = class(tai)
tai_symbol = class(tailineinfo)
is_global : boolean;
sym : tasmsymbol;
size : longint;
@ -208,7 +233,7 @@ interface
procedure derefimpl;override;
end;
tai_symbol_end = class(tai)
tai_symbol_end = class(tailineinfo)
sym : tasmsymbol;
constructor Create(_sym:tasmsymbol);
constructor Createname(const _name : string);
@ -228,7 +253,7 @@ interface
end;
{ Directly output data to final assembler file }
tai_direct = class(tai)
tai_direct = class(tailineinfo)
str : pchar;
constructor Create(_str : pchar);
destructor Destroy; override;
@ -258,7 +283,7 @@ interface
{ Generates an uninitializised data block }
tai_datablock = class(tai)
tai_datablock = class(tailineinfo)
is_global : boolean;
sym : tasmsymbol;
size : longint;
@ -280,7 +305,7 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
end;
tai_const_symbol = class(tai)
tai_const_symbol = class(tailineinfo)
sym : tasmsymbol;
offset : longint;
constructor Create(_sym:tasmsymbol);
@ -376,7 +401,7 @@ interface
{ Class template for assembler instructions
}
taicpu_abstract = class(tai)
taicpu_abstract = class(tailineinfo)
protected
procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract;
procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
@ -411,7 +436,6 @@ interface
{ alignment for operator }
tai_align_abstract = class(tai)
buf : array[0..63] of char; { buf used for fill }
aligntype : byte; { 1 = no align, 2 = word align, 4 = dword align }
fillsize : byte; { real size to fill }
fillop : byte; { value to fill with - optional }
@ -420,7 +444,7 @@ interface
constructor Create_op(b: byte; _op: byte);
constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
function getfillbuf:pchar;virtual;
function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
end;
taasmoutput = class(tlinkedlist)
@ -512,7 +536,6 @@ uses
constructor tai.Create;
begin
fileinfo:=aktfilepos;
{$ifndef NOOPT}
optinfo:=nil;
{$endif NOOPT}
@ -522,7 +545,6 @@ uses
constructor tai.ppuload(t:taitype;ppufile:tcompilerppufile);
begin
typ:=t;
ppufile.getposinfo(fileinfo);
{$ifndef NOOPT}
optinfo:=nil;
{$endif}
@ -531,7 +553,6 @@ uses
procedure tai.ppuwrite(ppufile:tcompilerppufile);
begin
ppufile.putposinfo(fileinfo);
end;
@ -542,13 +563,37 @@ uses
procedure tai.checkredefinesym(sym:tasmsymbol);
begin
if assigned(sym.taiowner) then
{ if assigned(sym.taiowner) then
begin
Message1(asmw_e_redefined_label,sym.name);
MessagePos(tai(sym.taiowner).fileinfo,asmw_e_first_defined_label);
end
else
sym.taiowner:=self;
sym.taiowner:=self;}
end;
{****************************************************************************
TAILINEINFO
****************************************************************************}
constructor tailineinfo.create;
begin
inherited create;
fileinfo:=aktfilepos;
end;
constructor tailineinfo.ppuload(t:taitype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
ppufile.getposinfo(fileinfo);
end;
procedure tailineinfo.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putposinfo(fileinfo);
end;
@ -588,7 +633,7 @@ uses
inherited Create;
typ:=ait_datablock;
sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_DATA);
checkredefinesym(sym);
{ checkredefinesym(sym);}
{ keep things aligned }
if _size<=0 then
_size:=4;
@ -602,7 +647,7 @@ uses
inherited Create;
typ:=ait_datablock;
sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
checkredefinesym(sym);
{ checkredefinesym(sym);}
{ keep things aligned }
if _size<=0 then
_size:=4;
@ -644,7 +689,7 @@ uses
inherited Create;
typ:=ait_symbol;
sym:=_sym;
checkredefinesym(sym);
{ checkredefinesym(sym);}
size:=siz;
is_global:=(sym.defbind=AB_GLOBAL);
end;
@ -654,7 +699,7 @@ uses
inherited Create;
typ:=ait_symbol;
sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_FUNCTION);
checkredefinesym(sym);
{ checkredefinesym(sym);}
size:=siz;
is_global:=false;
end;
@ -664,7 +709,7 @@ uses
inherited Create;
typ:=ait_symbol;
sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_FUNCTION);
checkredefinesym(sym);
{ checkredefinesym(sym);}
size:=siz;
is_global:=true;
end;
@ -674,7 +719,7 @@ uses
inherited Create;
typ:=ait_symbol;
sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_DATA);
checkredefinesym(sym);
{ checkredefinesym(sym);}
size:=siz;
is_global:=false;
end;
@ -684,7 +729,7 @@ uses
inherited Create;
typ:=ait_symbol;
sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
checkredefinesym(sym);
{ checkredefinesym(sym);}
size:=siz;
is_global:=true;
end;
@ -1077,7 +1122,7 @@ uses
inherited Create;
typ:=ait_label;
l:=_l;
checkredefinesym(l);
{ checkredefinesym(l);}
l.is_set:=true;
is_global:=(l.defbind=AB_GLOBAL);
end;
@ -1602,13 +1647,13 @@ uses
fillsize:=0;
fillop:=_op;
use_op:=true;
fillchar(buf,sizeof(buf),_op)
end;
function tai_align_abstract.getfillbuf:pchar;
function tai_align_abstract.calculatefillbuf(var buf : tfillbuffer):pchar;
begin
getfillbuf:=@buf;
fillchar(buf,high(buf),fillop);
calculatefillbuf:=pchar(@buf);
end;
@ -1636,17 +1681,39 @@ uses
*****************************************************************************}
function taasmoutput.getlasttaifilepos : pfileposinfo;
var
hp : tlinkedlistitem;
begin
getlasttaifilepos := nil;
if assigned(last) then
getlasttaifilepos:=@tai(last).fileinfo
else
getlasttaifilepos:=nil;
begin
{ find the last file information record }
if not (tai(last).typ in SkipLineInfo) then
getlasttaifilepos:=@tailineinfo(last).fileinfo
else
{ go through list backwards to find the first entry
with line information
}
begin
hp:=tai(last);
while assigned(hp) and (tai(hp).typ in SkipLineInfo) do
hp:=hp.Previous;
{ found entry }
if assigned(hp) then
getlasttaifilepos:=@tailineinfo(hp).fileinfo
end;
end;
end;
end.
{
$Log$
Revision 1.12 2002-11-15 16:29:30 peter
Revision 1.13 2002-11-17 16:31:55 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.12 2002/11/15 16:29:30 peter
* made tasmsymbol.refs private (merged)
Revision 1.11 2002/11/15 01:58:45 peter

47
compiler/aggas.pas
View File

@ -295,12 +295,6 @@ var
procedure TGNUAssembler.WriteTree(p:TAAsmoutput);
const
allocstr : array[boolean] of string[10]=(' released',' allocated');
nolinetai =[ait_label,
ait_regalloc,ait_tempalloc,
{$ifdef GDB}
ait_stabn,ait_stabs,ait_stab_function_name,
{$endif GDB}
ait_cut,ait_marker,ait_align,ait_section];
type
t80bitarray = array[0..9] of byte;
t64bitarray = array[0..7] of byte;
@ -308,6 +302,7 @@ var
var
ch : char;
hp : tai;
hp1 : tailineinfo;
consttyp : taitype;
s : string;
found : boolean;
@ -333,23 +328,24 @@ var
hp:=tai(p.first);
while assigned(hp) do
begin
aktfilepos:=hp.fileinfo;
if not(hp.typ in nolinetai) then
if not(hp.typ in SkipLineInfo) then
begin
hp1 := hp as tailineinfo;
aktfilepos:=hp1.fileinfo;
{$ifdef GDB}
{ write stabs }
if (cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches) then
WriteFileLineInfo(hp.fileinfo);
WriteFileLineInfo(hp1.fileinfo);
{$endif GDB}
{ no line info for inlined code }
if do_line and (inlinelevel=0) then
begin
{ load infile }
if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
begin
infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
if assigned(infile) then
begin
{ open only if needed !! }
@ -357,7 +353,7 @@ var
infile.open;
end;
{ avoid unnecessary reopens of the same file !! }
lastfileinfo.fileindex:=hp.fileinfo.fileindex;
lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
{ be sure to change line !! }
lastfileinfo.line:=-1;
end;
@ -371,20 +367,20 @@ var
if assigned(lastinfile) then
lastinfile.close;
end;
if (hp.fileinfo.line<>lastfileinfo.line) and
((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
if (hp1.fileinfo.line<>lastfileinfo.line) and
((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
begin
if (hp.fileinfo.line<>0) and
((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp.fileinfo.line)));
if (hp1.fileinfo.line<>0) and
((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp1.fileinfo.line)));
{ set it to a negative value !
to make that is has been read already !! PM }
if (infile.linebuf^[hp.fileinfo.line]>=0) then
infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
if (infile.linebuf^[hp1.fileinfo.line]>=0) then
infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
end;
end;
lastfileinfo:=hp.fileinfo;
lastfileinfo:=hp1.fileinfo;
lastinfile:=infile;
end;
end;
@ -718,7 +714,7 @@ var
FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
includecount:=0;
funcname:=nil;
WriteFileLineInfo(hp.fileinfo);
WriteFileLineInfo(aktfilepos);
{$endif GDB}
if lasTSec<>sec_none then
AsmWriteLn(ait_section2str(lasTSec));
@ -819,7 +815,12 @@ var
end.
{
$Log$
Revision 1.15 2002-11-15 01:58:45 peter
Revision 1.16 2002-11-17 16:31:55 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.15 2002/11/15 01:58:45 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

28
compiler/assemble.pas
View File

@ -191,7 +191,7 @@ Implementation
finput,
gdb,
{$endif GDB}
cpubase,aasmcpu
cpubase,cpuinfo,aasmcpu
;
var
@ -1005,12 +1005,8 @@ Implementation
(cs_gdb_lineinfo in aktglobalswitches)) then
begin
if (objectalloc.currsec<>sec_none) and
not(hp.typ in [
ait_label,
ait_regalloc,ait_tempalloc,
ait_stabn,ait_stabs,ait_section,
ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
WriteFileLineInfo(hp.fileinfo);
not(hp.typ in SkipLineInfo) then
WriteFileLineInfo(tailineinfo(hp).fileinfo);
end;
{$endif GDB}
case hp.typ of
@ -1175,6 +1171,7 @@ Implementation
function TInternalAssembler.TreePass2(hp:Tai):Tai;
var
fillbuffer : tfillbuffer;
InlineLevel,
l : longint;
{$ifdef i386}
@ -1192,12 +1189,8 @@ Implementation
(cs_gdb_lineinfo in aktglobalswitches)) then
begin
if (objectdata.currsec<>sec_none) and
not(hp.typ in [
ait_label,
ait_regalloc,ait_tempalloc,
ait_stabn,ait_stabs,ait_section,
ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
WriteFileLineInfo(hp.fileinfo);
not(hp.typ in SkipLineInfo) then
WriteFileLineInfo(tailineinfo(hp).fileinfo);
end;
{$endif GDB}
case hp.typ of
@ -1206,7 +1199,7 @@ Implementation
if objectdata.currsec=sec_bss then
objectdata.alloc(Tai_align(hp).fillsize)
else
objectdata.writebytes(Tai_align(hp).getfillbuf^,Tai_align(hp).fillsize);
objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
end;
ait_section :
begin
@ -1621,7 +1614,12 @@ Implementation
end.
{
$Log$
Revision 1.46 2002-11-15 01:58:46 peter
Revision 1.47 2002-11-17 16:31:55 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.46 2002/11/15 01:58:46 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

9
compiler/defbase.pas
View File

@ -1896,7 +1896,7 @@ implementation
else if (def_to=tdef(rec_tguid)) and
(fromtreetype=typen) and
is_interface(def_from) and
tobjectdef(def_from).isiidguidvalid then
assigned(tobjectdef(def_from).iidguid) then
begin
b:=1;
doconv:=tc_equal;
@ -2040,7 +2040,12 @@ implementation
end.
{
$Log$
Revision 1.25 2002-11-16 18:00:53 peter
Revision 1.26 2002-11-17 16:31:55 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.25 2002/11/16 18:00:53 peter
* fix merged proc-procvar check
Revision 1.24 2002/11/15 01:58:46 peter

9
compiler/gdb.pas
View File

@ -67,7 +67,7 @@ Const
end;
{ insert a cut to split into several smaller files }
tai_force_line = class(tai)
tai_force_line = class(tailineinfo)
constructor Create;
end;
@ -233,7 +233,12 @@ end.
{
$Log$
Revision 1.15 2002-08-12 15:08:39 carl
Revision 1.16 2002-11-17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.15 2002/08/12 15:08:39 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

16
compiler/i386/aasmcpu.pas
View File

@ -130,7 +130,7 @@ interface
reg : tregister;
constructor create(b:byte);
constructor create_op(b: byte; _op: byte);
function getfillbuf:pchar;override;
function calculatefillbuf(var buf : tfillbuffer):pchar;override;
end;
taicpu = class(taicpu_abstract)
@ -326,7 +326,7 @@ implementation
end;
function tai_align.getfillbuf:pchar;
function tai_align.calculatefillbuf(var buf : tfillbuffer):pchar;
const
alignarray:array[0..5] of string[8]=(
#$8D#$B4#$26#$00#$00#$00#$00,
@ -340,9 +340,10 @@ implementation
bufptr : pchar;
j : longint;
begin
inherited calculatefillbuf(buf);
if not use_op then
begin
bufptr:=@buf;
bufptr:=pchar(@buf);
while (fillsize>0) do
begin
for j:=0 to 5 do
@ -353,7 +354,7 @@ implementation
dec(fillsize,length(alignarray[j]));
end;
end;
getfillbuf:=pchar(@buf);
calculatefillbuf:=pchar(@buf);
end;
@ -1874,7 +1875,12 @@ implementation
end.
{
$Log$
Revision 1.7 2002-11-15 01:58:54 peter
Revision 1.8 2002-11-17 16:31:58 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.7 2002/11/15 01:58:54 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

41
compiler/i386/ag386int.pas
View File

@ -328,17 +328,12 @@ interface
procedure T386IntelAssembler.WriteTree(p:TAAsmoutput);
const
allocstr : array[boolean] of string[10]=(' released',' allocated');
nolinetai =[ait_label,
ait_regalloc,ait_tempalloc,
{$ifdef GDB}
ait_stabn,ait_stabs,ait_stab_function_name,
{$endif GDB}
ait_cut,ait_marker,ait_align,ait_section];
var
s,
prefix,
suffix : string;
hp : tai;
hp1 : tailineinfo;
counter,
lines,
InlineLevel : longint;
@ -360,13 +355,14 @@ interface
hp:=tai(p.first);
while assigned(hp) do
begin
if do_line and not(hp.typ in nolinetai) and
if do_line and not(hp.typ in SkipLineInfo) and
not DoNotSplitLine then
begin
hp1:=hp as tailineinfo;
{ load infile }
if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
begin
infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
if assigned(infile) then
begin
{ open only if needed !! }
@ -374,7 +370,7 @@ interface
infile.open;
end;
{ avoid unnecessary reopens of the same file !! }
lastfileinfo.fileindex:=hp.fileinfo.fileindex;
lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
{ be sure to change line !! }
lastfileinfo.line:=-1;
end;
@ -388,20 +384,20 @@ interface
if assigned(lastinfile) then
lastinfile.close;
end;
if (hp.fileinfo.line<>lastfileinfo.line) and
((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
if (hp1.fileinfo.line<>lastfileinfo.line) and
((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
begin
if (hp.fileinfo.line<>0) and
((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp.fileinfo.line)));
if (hp1.fileinfo.line<>0) and
((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp1.fileinfo.line)));
{ set it to a negative value !
to make that is has been read already !! PM }
if (infile.linebuf^[hp.fileinfo.line]>=0) then
infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
if (infile.linebuf^[hp1.fileinfo.line]>=0) then
infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
end;
end;
lastfileinfo:=hp.fileinfo;
lastfileinfo:=hp1.fileinfo;
lastinfile:=infile;
end;
DoNotSplitLine:=false;
@ -844,7 +840,12 @@ initialization
end.
{
$Log$
Revision 1.29 2002-11-15 01:58:56 peter
Revision 1.30 2002-11-17 16:31:58 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.29 2002/11/15 01:58:56 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

45
compiler/i386/ag386nsm.pas
View File

@ -348,17 +348,10 @@ interface
procedure T386NasmAssembler.WriteTree(p:taasmoutput);
const
allocstr : array[boolean] of string[10]=(' released',' allocated');
nolinetai =[ait_label,
ait_regalloc,ait_tempalloc,
{$ifdef GDB}
ait_stabn,ait_stabs,ait_stab_function_name,
{$endif GDB}
ait_cut,ait_marker,ait_align,ait_section];
var
s : string;
{prefix,
suffix : string; no need here }
hp : tai;
hp1 : tailineinfo;
counter,
lines,
i,j,l : longint;
@ -379,16 +372,17 @@ interface
hp:=tai(p.first);
while assigned(hp) do
begin
aktfilepos:=hp.fileinfo;
if not(hp.typ in nolinetai) then
if not(hp.typ in SkipLineInfo) then
begin
hp1:=hp as tailineinfo;
aktfilepos:=hp1.fileinfo;
if do_line then
begin
{ load infile }
if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
begin
infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
if assigned(infile) then
begin
{ open only if needed !! }
@ -396,7 +390,7 @@ interface
infile.open;
end;
{ avoid unnecessary reopens of the same file !! }
lastfileinfo.fileindex:=hp.fileinfo.fileindex;
lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
{ be sure to change line !! }
lastfileinfo.line:=-1;
end;
@ -410,20 +404,20 @@ interface
if assigned(lastinfile) then
lastinfile.close;
end;
if (hp.fileinfo.line<>lastfileinfo.line) and
((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
if (hp1.fileinfo.line<>lastfileinfo.line) and
((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
begin
if (hp.fileinfo.line<>0) and
((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp.fileinfo.line)));
if (hp1.fileinfo.line<>0) and
((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp1.fileinfo.line)));
{ set it to a negative value !
to make that is has been read already !! PM }
if (infile.linebuf^[hp.fileinfo.line]>=0) then
infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
if (infile.linebuf^[hp1.fileinfo.line]>=0) then
infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
end;
end;
lastfileinfo:=hp.fileinfo;
lastfileinfo:=hp1.fileinfo;
lastinfile:=infile;
end;
end;
@ -899,7 +893,12 @@ initialization
end.
{
$Log$
Revision 1.27 2002-11-15 01:58:56 peter
Revision 1.28 2002-11-17 16:31:59 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.27 2002/11/15 01:58:56 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

12
compiler/i386/daopt386.pas
View File

@ -605,7 +605,10 @@ Begin
new_one.next := foll;
prev.next := new_one;
foll.previous := new_one;
Tai(new_one).fileinfo := Tai(foll).fileinfo;
{ shgould we update line information }
if (not (Tai(new_one).typ in SkipLineInfo)) and
(not (Tai(foll).typ in SkipLineInfo)) then
Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo;
End;
End
Else asml.Concat(new_one)
@ -2591,7 +2594,12 @@ End.
{
$Log$
Revision 1.43 2002-08-18 20:06:29 peter
Revision 1.44 2002-11-17 16:31:59 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.43 2002/08/18 20:06:29 peter
* inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu

1
compiler/msg/errore.msg
View File

@ -2031,7 +2031,6 @@ option_help_pages=11025_[
**0*_Processor specific options:
3*1A<x>_output format:
3*2Aas_assemble using GNU AS
3*2Aasaout_assemble using GNU AS for aout (Go32v1)
3*2Anasmcoff_coff (Go32v2) file using Nasm
3*2Anasmelf_elf32 (Linux) file using Nasm
3*2Anasmobj_obj file using Nasm

2
compiler/msgidx.inc
View File

@ -629,7 +629,7 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 35103;
MsgTxtSize = 35052;
MsgIdxMax : array[1..20] of longint=(
17,62,189,44,43,41,98,19,35,43,

39
compiler/msgtxt.inc
View File

@ -795,59 +795,58 @@ const msgtxt : array[0..000146,1..240] of char=(
'**0*_Processor specific options:'#010+
'3*1A<x>_output format:'#010+
'3*2Aas_assemble using GNU AS'#010+
'3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#010+
'3*2Anasmcoff_coff (Go32v','2) file using Nasm'#010+
'3*2Anasmelf_elf32 (Linux) file using Nasm'#010+
'3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+
'3*2Anasmelf_elf32 (Linux) file u','sing Nasm'#010+
'3*2Anasmobj_obj file using Nasm'#010+
'3*2Amasm_obj file using Masm (Microsoft)'#010+
'3*2Atasm_obj file using Tasm (Borland)'#010+
'3*2Acoff_coff (Go32v2) using internal writer'#010+
'3*2Apecoff_pecoff (Win','32) using internal writer'#010+
'3*1R<x>_assembler reading style:'#010+
'3*2Apecoff_pecoff (Win32) using internal writer'#010+
'3*1R<x>_assembler reading',' style:'#010+
'3*2Ratt_read AT&T style assembler'#010+
'3*2Rintel_read Intel style assembler'#010+
'3*2Rdirect_copy assembler text directly to assembler file'#010+
'3*1O<x>_optimizations:'#010+
'3*2Og_generate smaller code'#010+
'3','*2OG_generate faster code (default)'#010+
'3*2Or_keep certain variables in registers'#010+
'3*2OG_generate faster code (default)'#010+
'3*2Or_keep cert','ain variables in registers'#010+
'3*2Ou_enable uncertain optimizations (see docs)'#010+
'3*2O1_level 1 optimizations (quick optimizations)'#010+
'3*2O2_level 2 optimizations (-O1 + slower optimizations)'#010+
'3*2O3_l','evel 3 optimizations (-O2 repeatedly, max 5 times)'#010+
'3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010,
'3*2Op<x>_target processor:'#010+
'3*3Op1_set target processor to 386/486'#010+
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
'3*1T<x>_Target',' operating system:'#010+
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#010+
'3*1T<x>_Target operating system:'#010+
'3*2TGO32V2_version 2 of DJ Delor','ie DOS extender'#010+
'3*2TWDOSX DOS 32 Bit Extender'#010+
'3*2TLINUX_Linux'#010+
'3*2Tnetware_Novell Netware Module (experimental)'#010+
'3*2TOS2_OS/2 2.x'#010+
'3*2TSUNOS_SunOS/Solaris'#010+
'3*2TWin32_Windows 32 Bit'#010+
'3*1W<x>_Win3','2 target options'#010+
'3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
'3*1W<x>_Win32 target options'#010+
'3*2WB<x>_Set Image base to Hexadec','imal <x> value'#010+
'3*2WC_Specify console type application'#010+
'3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
'3*2WF_Specify full-screen type application (OS/2 only)'#010+
'3*2WG_Specify graphic type a','pplication'#010+
'3*2WN_Do not generate relocation code (necessary for debugging)'#010+
'3*2WG_Specify graphic type application'#010+
'3*2WN_Do not generate relocation code (n','ecessary for debugging)'#010+
'3*2WR_Generate relocation code'#010+
'6*1A<x>_output format'#010+
'6*2Aas_Unix o-file using GNU AS'#010+
'6*2Agas_GNU Motorola assembler'#010+
'6*2Amit_MIT Syntax (old GAS)'#010+
'6*2Amot_Standard Mot','orola assembler'#010+
'6*2Amot_Standard Motorola assembler'#010+
'6*1O_optimizations:'#010+
'6*2Oa_turn on the optimizer'#010+
'6*2Oa_turn on t','he optimizer'#010+
'6*2Og_generate smaller code'#010+
'6*2OG_generate faster code (default)'#010+
'6*2Ox_optimize maximum (still BUGGY!!!)'#010+
'6*2O0_set target processor to a MC68000'#010+
'6*2O2_set target processor to a',' MC68020+ (default)'#010+
'6*1R<x>_assembler reading style:'#010+
'6*2O2_set target processor to a MC68020+ (default)'#010+
'6*1R<x>_assembler reading style',':'#010+
'6*2RMOT_read motorola style assembler'#010+
'6*1T<x>_Target operating system:'#010+
'6*2TAMIGA_Commodore Amiga'#010+
@ -855,7 +854,7 @@ const msgtxt : array[0..000146,1..240] of char=(
'6*2TMACOS_Macintosh m68k'#010+
'6*2TLINUX_Linux-68k'#010+
'6*2TPALMOS_PalmOS'#010+
'*','*1*_'#010+
'**1*_'#010+
'**1?_shows this help'#010+
'**1h_shows this help without waiting'#000
'**1h_shows this help with','out waiting'#000
);

9
compiler/ncgbas.pas
View File

@ -110,7 +110,7 @@ interface
procedure ReLabel(var p:tasmsymbol);
begin
if p.proclocal then
if p.defbind = AB_LOCAL then
begin
if not assigned(p.altsymbol) then
objectlibrary.GenerateAltSymbol(p);
@ -288,7 +288,12 @@ begin
end.
{
$Log$
Revision 1.25 2002-11-15 16:29:30 peter
Revision 1.26 2002-11-17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.25 2002/11/15 16:29:30 peter
* made tasmsymbol.refs private (merged)
Revision 1.24 2002/11/15 01:58:51 peter

9
compiler/ncgutil.pas
View File

@ -1417,7 +1417,7 @@ implementation
begin
{ Align, gprof uses 16 byte granularity }
if (cs_profile in aktmoduleswitches) then
stackalloclist.concat(Tai_align.Create_op(16,$90))
stackalloclist.concat(Tai_align.Create(16))
else
stackalloclist.concat(Tai_align.Create(aktalignment.procalign));
@ -1867,7 +1867,12 @@ implementation
end.
{
$Log$
Revision 1.59 2002-11-15 01:58:51 peter
Revision 1.60 2002-11-17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.59 2002/11/15 01:58:51 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

15
compiler/ncnv.pas
View File

@ -858,8 +858,8 @@ implementation
function ttypeconvnode.resulttype_interface_to_guid : tnode;
begin
if tobjectdef(left.resulttype.def).isiidguidvalid then
result:=cguidconstnode.create(tobjectdef(left.resulttype.def).iidguid);
if assigned(tobjectdef(left.resulttype.def).iidguid) then
result:=cguidconstnode.create(tobjectdef(left.resulttype.def).iidguid^);
end;
@ -2026,9 +2026,9 @@ implementation
{ load the GUID of the interface }
if (right.nodetype=typen) then
begin
if tobjectdef(right.resulttype.def).isiidguidvalid then
if assigned(tobjectdef(right.resulttype.def).iidguid) then
begin
hp:=cguidconstnode.create(tobjectdef(right.resulttype.def).iidguid);
hp:=cguidconstnode.create(tobjectdef(right.resulttype.def).iidguid^);
right.free;
right:=hp;
end
@ -2098,7 +2098,12 @@ begin
end.
{
$Log$
Revision 1.87 2002-10-10 16:07:57 florian
Revision 1.88 2002-11-17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.87 2002/10/10 16:07:57 florian
+ several widestring/pwidechar related stuff added
Revision 1.86 2002/10/06 16:10:23 florian

29
compiler/nobj.pas
View File

@ -859,11 +859,11 @@ implementation
objectlibrary.getdatalabel(tmplabel);
rawdata.concat(tai_align.create(const_align(pointer_size)));
rawdata.concat(Tai_label.Create(tmplabel));
rawdata.concat(Tai_const.Create_32bit(curintf.iidguid.D1));
rawdata.concat(Tai_const.Create_16bit(curintf.iidguid.D2));
rawdata.concat(Tai_const.Create_16bit(curintf.iidguid.D3));
for i:=Low(curintf.iidguid.D4) to High(curintf.iidguid.D4) do
rawdata.concat(Tai_const.Create_8bit(curintf.iidguid.D4[i]));
rawdata.concat(Tai_const.Create_32bit(curintf.iidguid^.D1));
rawdata.concat(Tai_const.Create_16bit(curintf.iidguid^.D2));
rawdata.concat(Tai_const.Create_16bit(curintf.iidguid^.D3));
for i:=Low(curintf.iidguid^.D4) to High(curintf.iidguid^.D4) do
rawdata.concat(Tai_const.Create_8bit(curintf.iidguid^.D4[i]));
dataSegment.concat(Tai_const_symbol.Create(tmplabel));
end
else
@ -1114,16 +1114,16 @@ implementation
var
i: longint;
begin
if _class.isiidguidvalid then
if assigned(_class.iidguid) then
begin
if (cs_create_smart in aktmoduleswitches) then
dataSegment.concat(Tai_cut.Create);
dataSegment.concat(Tai_symbol.Createname_global(mangledname_prefix('IID',_class.owner)+_class.objname^,0));
dataSegment.concat(Tai_const.Create_32bit(longint(_class.iidguid.D1)));
dataSegment.concat(Tai_const.Create_16bit(_class.iidguid.D2));
dataSegment.concat(Tai_const.Create_16bit(_class.iidguid.D3));
for i:=Low(_class.iidguid.D4) to High(_class.iidguid.D4) do
dataSegment.concat(Tai_const.Create_8bit(_class.iidguid.D4[i]));
dataSegment.concat(Tai_const.Create_32bit(longint(_class.iidguid^.D1)));
dataSegment.concat(Tai_const.Create_16bit(_class.iidguid^.D2));
dataSegment.concat(Tai_const.Create_16bit(_class.iidguid^.D3));
for i:=Low(_class.iidguid^.D4) to High(_class.iidguid^.D4) do
dataSegment.concat(Tai_const.Create_8bit(_class.iidguid^.D4[i]));
end;
if (cs_create_smart in aktmoduleswitches) then
dataSegment.concat(Tai_cut.Create);
@ -1333,7 +1333,12 @@ initialization
end.
{
$Log$
Revision 1.36 2002-11-15 01:58:52 peter
Revision 1.37 2002-11-17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.36 2002/11/15 01:58:52 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

15
compiler/pdecl.pas
View File

@ -129,10 +129,10 @@ implementation
begin
if is_interface(p.resulttype.def) then
begin
if tobjectdef(p.resulttype.def).isiidguidvalid then
if assigned(tobjectdef(p.resulttype.def).iidguid) then
begin
new(pg);
pg^:=tobjectdef(p.resulttype.def).iidguid;
pg^:=tobjectdef(p.resulttype.def).iidguid^;
hp:=tconstsym.create_ptr(orgname,constguid,pg);
end
else
@ -316,7 +316,9 @@ implementation
akttokenpos:=tforwarddef(hpd).forwardpos;
resolving_forward:=true;
make_ref:=false;
searchsym(tforwarddef(hpd).tosymname,srsym,srsymtable);
if not assigned(tforwarddef(hpd).tosymname) then
internalerror(20021120);
searchsym(tforwarddef(hpd).tosymname^,srsym,srsymtable);
make_ref:=true;
resolving_forward:=false;
akttokenpos:=stpos;
@ -624,7 +626,12 @@ implementation
end.
{
$Log$
Revision 1.58 2002-11-15 16:29:30 peter
Revision 1.59 2002-11-17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.58 2002/11/15 16:29:30 peter
* made tasmsymbol.refs private (merged)
Revision 1.57 2002/10/20 15:34:16 peter

21
compiler/pdecobj.pas
View File

@ -779,7 +779,14 @@ implementation
if aktclass.implementedinterfaces.searchintf(implintf)<>-1 then
Message1(sym_e_duplicate_id,implintf.name)
else
aktclass.implementedinterfaces.addintf(implintf);
begin
{ allocate and prepare the GUID only if the class
implements some interfaces.
}
if aktclass.implementedinterfaces.count = 0 then
aktclass.prepareguid;
aktclass.implementedinterfaces.addintf(implintf);
end;
end;
procedure readimplementedinterfaces;
@ -801,6 +808,7 @@ implementation
procedure readinterfaceiid;
var
p : tnode;
valid : boolean;
begin
p:=comp_expr(true);
if p.nodetype=stringconstn then
@ -808,8 +816,8 @@ implementation
stringdispose(aktclass.iidstr);
aktclass.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
p.free;
aktclass.isiidguidvalid:=string2guid(aktclass.iidstr^,aktclass.iidguid);
if (classtype=odt_interfacecom) and not aktclass.isiidguidvalid then
valid:=string2guid(aktclass.iidstr^,aktclass.iidguid^);
if (classtype=odt_interfacecom) and not assigned(aktclass.iidguid) and not valid then
Message(parser_e_improper_guid_syntax);
end
else
@ -1161,7 +1169,12 @@ implementation
end.
{
$Log$
Revision 1.55 2002-10-05 12:43:25 carl
Revision 1.56 2002-11-17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.55 2002/10/05 12:43:25 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)

12
compiler/pdecsub.pas
View File

@ -827,7 +827,6 @@ end;
procedure pd_asmname;
begin
aktprocdef.setmangledname(target_info.Cprefix+pattern);
aktprocdef.has_mangledname:=true;
if token=_CCHAR then
consume(_CCHAR)
else
@ -1036,7 +1035,6 @@ begin
consume(_NAME);
import_name:=get_stringconst;
aktprocdef.setmangledname(import_name);
aktprocdef.has_mangledname:=true;
end;
end;
end;
@ -1898,7 +1896,6 @@ const
MessagePos(aprocdef.fileinfo,parser_e_call_convention_dont_match_forward);
{ restore interface settings }
aprocdef.proccalloption:=hd.proccalloption;
aprocdef.has_mangledname:=hd.has_mangledname;
if hd.has_mangledname then
aprocdef.setmangledname(hd.mangledname);
end;
@ -1949,8 +1946,6 @@ const
begin
{ rename also asmsymbol first, because the name can already be used }
objectlibrary.renameasmsymbol(hd.mangledname,aprocdef.mangledname);
{ update the mangledname }
hd.has_mangledname:=true;
hd.setmangledname(aprocdef.mangledname);
end;
{ for compilerproc defines we need to rename and update the
@ -2059,7 +2054,12 @@ const
end.
{
$Log$
Revision 1.79 2002-11-16 14:20:50 peter
Revision 1.80 2002-11-17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.79 2002/11/16 14:20:50 peter
* fix infinite loop in pd_inline
Revision 1.78 2002/11/15 01:58:53 peter

43
compiler/powerpc/agppcmpw.pas
View File

@ -484,19 +484,12 @@ function getreferencestring(var ref : treference) : string;
procedure TPPCMPWAssembler.WriteTree(p:TAAsmoutput);
const
nolinetai =[ait_label,
ait_regalloc,ait_tempalloc,
{$ifdef GDB}
ait_stabn,ait_stabs,ait_stab_function_name,
{$endif GDB}
ait_cut,ait_marker,ait_align,ait_section];
var
s,
prefix,
suffix : string;
hp : tai;
hp1 : tailineinfo;
counter,
lines,
InlineLevel : longint;
@ -520,13 +513,14 @@ function getreferencestring(var ref : treference) : string;
hp:=tai(p.first);
while assigned(hp) do
begin
if do_line and not(hp.typ in nolinetai) and
if do_line and not(hp.typ in SkipLineInfo) and
not DoNotSplitLine then
begin
hp1 := hp as tailineinfo;
{ load infile }
if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
begin
infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
if assigned(infile) then
begin
{ open only if needed !! }
@ -534,7 +528,7 @@ function getreferencestring(var ref : treference) : string;
infile.open;
end;
{ avoid unnecessary reopens of the same file !! }
lastfileinfo.fileindex:=hp.fileinfo.fileindex;
lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
{ be sure to change line !! }
lastfileinfo.line:=-1;
end;
@ -548,20 +542,20 @@ function getreferencestring(var ref : treference) : string;
if assigned(lastinfile) then
lastinfile.close;
end;
if (hp.fileinfo.line<>lastfileinfo.line) and
((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
if (hp1.fileinfo.line<>lastfileinfo.line) and
((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
begin
if (hp.fileinfo.line<>0) and
((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp.fileinfo.line)));
if (hp1.fileinfo.line<>0) and
((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp1.fileinfo.line)));
{ set it to a negative value !
to make that is has been read already !! PM }
if (infile.linebuf^[hp.fileinfo.line]>=0) then
infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
if (infile.linebuf^[hp1.fileinfo.line]>=0) then
infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
end;
end;
lastfileinfo:=hp.fileinfo;
lastfileinfo:=hp1.fileinfo;
lastinfile:=infile;
end;
DoNotSplitLine:=false;
@ -1028,7 +1022,12 @@ initialization
end.
{
$Log$
Revision 1.14 2002-11-07 15:50:23 jonas
Revision 1.15 2002-11-17 16:31:59 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.14 2002/11/07 15:50:23 jonas
* fixed bctr(l) problems
Revision 1.13 2002/11/04 18:24:53 olle

9
compiler/psub.pas
View File

@ -623,7 +623,7 @@ implementation
{ pointer to the return value ? }
if paramanager.ret_in_param(aktprocdef.rettype.def)
{$ifdef m68k}
and not(pocall_cdecl in aktprocsym^.definition^.proccalloptions)
and not (aktprocdef.proccalloption in [pocall_cdecl])
{$endif m68k}
then
begin
@ -802,7 +802,12 @@ implementation
end.
{
$Log$
Revision 1.74 2002-11-15 01:58:53 peter
Revision 1.75 2002-11-17 16:31:57 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.74 2002/11/15 01:58:53 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

51
compiler/sparc/aasmcpu.pas
View File

@ -36,7 +36,6 @@ type
reg:tregister;
constructor create(b:byte);
constructor create_op(b:byte; _op:byte);
function getfillbuf:pchar;override;
end;
taicpu = class(taicpu_abstract)
opsize:topsize;
@ -110,35 +109,6 @@ constructor tai_align.create_op(b:byte; _op:byte);
inherited create_op(b,_op);
reg:= R_NONE;
end;
function tai_align.getfillbuf:pchar;
const
alignarray:array[0..5] of string[8]=(
#$8D#$B4#$26#$00#$00#$00#$00,
#$8D#$B6#$00#$00#$00#$00,
#$8D#$74#$26#$00,
#$8D#$76#$00,
#$89#$F6,
#$90
);
var
bufptr:pchar;
j:longint;
begin
if not use_op then
begin
bufptr:=@buf;
while (fillsize>0) do
begin
for j:=0 to 5 do
if (fillsize>=length(alignarray[j])) then
break;
move(alignarray[j][1],bufptr^,length(alignarray[j]));
inc(bufptr,length(alignarray[j]));
dec(fillsize,length(alignarray[j]));
end;
end;
getfillbuf:=pchar(@buf);
end;
{*****************************************************************************
Taicpu Constructors
*****************************************************************************}
@ -212,16 +182,16 @@ constructor taicpu.op_const_reg(op:tasmop;_op1:aword;_op2:tregister);
loadreg(1,_op2);
end;
constructor TAiCpu.op_ref_reg(Op:TAsmOp;const Ref:TReference;Reg:TRegister);
begin
begin
if not(Op in [A_JMPL,A_FLUSH,A_LDSB..A_LDDC,A_RETT,A_SWAP])
then
fail;
inherited Create(Op);
Init(S_SW);
Ops:=2;
LoadRef(0,Ref);
LoadReg(1,Reg);
end;
inherited Create(Op);
Init(S_SW);
Ops:=2;
LoadRef(0,Ref);
LoadReg(1,Reg);
end;
constructor taicpu.op_ref_ref(op:tasmop;_size:topsize;const _op1,_op2:treference);
begin
inherited create(op);
@ -1113,7 +1083,12 @@ procedure InitAsm;
end.
{
$Log$
Revision 1.12 2002-11-10 19:07:46 mazen
Revision 1.13 2002-11-17 16:32:04 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.12 2002/11/10 19:07:46 mazen
* SPARC calling mechanism almost OK (as in GCC./mppcsparc )
Revision 1.11 2002/11/06 11:31:24 mazen

88
compiler/symdef.pas
View File

@ -155,9 +155,10 @@ interface
end;
tforwarddef = class(tstoreddef)
tosymname : string;
tosymname : pstring;
forwardpos : tfileposinfo;
constructor create(const s:string;const pos : tfileposinfo);
destructor destroy;override;
function gettypename:string;override;
end;
@ -260,8 +261,7 @@ interface
writing_class_record_stab : boolean;
{$endif GDB}
objecttype : tobjectdeftype;
isiidguidvalid: boolean;
iidguid: TGUID;
iidguid: pguid;
iidstr: pstring;
lastvtableindex: longint;
{ store implemented interfaces defs and name mappings }
@ -275,6 +275,8 @@ interface
function alignment:longint;override;
function vmtmethodoffset(index:longint):longint;
function members_need_inittable : boolean;
{ this should be called when this class implements an interface }
procedure prepareguid;
function is_publishable : boolean;override;
function needs_inittable : boolean;override;
function vmt_mangledname : string;
@ -342,7 +344,6 @@ interface
end;
tarraydef = class(tstoreddef)
rangenr : longint;
lowrange,
highrange : longint;
rangetype : ttype;
@ -375,7 +376,6 @@ interface
end;
torddef = class(tstoreddef)
rangenr : longint;
low,high : TConstExprInt;
typ : tbasetype;
constructor create(t : tbasetype;v,b : TConstExprInt);
@ -411,12 +411,12 @@ interface
tabstractprocdef = class(tstoreddef)
{ saves a definition to the return type }
rettype : ttype;
para : tparalinkedlist;
proctypeoption : tproctypeoption;
proccalloption : tproccalloption;
procoptions : tprocoptions;
para : tparalinkedlist;
maxparacount,
minparacount : longint;
minparacount : byte;
symtablelevel : byte;
fpu_used : byte; { how many stack fpu must be empty }
constructor create;
@ -487,7 +487,6 @@ interface
{ browser info }
lastref,
defref,
crossref,
lastwritten : tref;
refcount : longint;
_class : tobjectdef;
@ -565,7 +564,6 @@ interface
end;
tenumdef = class(tstoreddef)
rangenr,
minval,
maxval : longint;
has_jumps : boolean;
@ -1407,7 +1405,6 @@ implementation
calcsavesize;
has_jumps:=false;
basedef:=nil;
rangenr:=0;
firstenum:=nil;
correct_owner_symtable;
end;
@ -1421,7 +1418,6 @@ implementation
basedef:=_basedef;
calcsavesize;
has_jumps:=false;
rangenr:=0;
firstenum:=basedef.firstenum;
while assigned(firstenum) and (tenumsym(firstenum).value<>minval) do
firstenum:=tenumsym(firstenum).nextenum;
@ -1622,7 +1618,6 @@ implementation
low:=v;
high:=b;
typ:=t;
rangenr:=0;
setsize;
end;
@ -1666,7 +1661,6 @@ implementation
end
else
high:=ppufile.getlongint;
rangenr:=0;
setsize;
end;
@ -1688,8 +1682,6 @@ implementation
else
savesize:=0;
end;
{ there are no entrys for range checking }
rangenr:=0;
end;
@ -2530,7 +2522,6 @@ implementation
IsConstructor:=false;
IsArrayOfConst:=false;
IsDynamicArray:=false;
rangenr:=0;
end;
@ -2547,7 +2538,6 @@ implementation
IsDynamicArray:=boolean(ppufile.getbyte);
IsVariant:=false;
IsConstructor:=false;
rangenr:=0;
end;
@ -3096,7 +3086,8 @@ implementation
proctypeoption:=tproctypeoption(ppufile.getbyte);
proccalloption:=tproccalloption(ppufile.getbyte);
ppufile.getsmallset(procoptions);
count:=ppufile.getword;
{ get the number of parameters }
count:=ppufile.getbyte;
savesize:=POINTER_SIZE;
for i:=1 to count do
begin
@ -3132,7 +3123,7 @@ implementation
ppufile.putbyte(ord(proccalloption));
ppufile.putsmallset(procoptions);
ppufile.do_interface_crc:=oldintfcrc;
ppufile.putword(maxparacount);
ppufile.putbyte(maxparacount);
hp:=TParaItem(Para.first);
while assigned(hp) do
begin
@ -3300,7 +3291,6 @@ implementation
to check same names in parast and localst }
localst.next:=parast;
defref:=nil;
crossref:=nil;
lastwritten:=nil;
refcount:=0;
if (cs_browser in aktmoduleswitches) and make_ref then
@ -4106,12 +4096,8 @@ implementation
set_parent(c);
objname:=stringdup(upper(n));
objrealname:=stringdup(n);
{ set up guid }
isiidguidvalid:=true; { default null guid }
fillchar(iidguid,sizeof(iidguid),0); { default null guid }
iidstr:=stringdup(''); { default is empty string }
if objecttype in [odt_interfacecorba,odt_interfacecom] then
prepareguid;
{ setup implemented interfaces }
if objecttype in [odt_class,odt_interfacecorba] then
implementedinterfaces:=timplementedinterfaces.create
@ -4143,8 +4129,8 @@ implementation
iidstr:=nil;
if objecttype in [odt_interfacecom,odt_interfacecorba] then
begin
isiidguidvalid:=boolean(ppufile.getbyte);
ppufile.getguid(iidguid);
new(iidguid);
ppufile.getguid(iidguid^);
iidstr:=stringdup(ppufile.getstring);
lastvtableindex:=ppufile.getlongint;
end;
@ -4194,9 +4180,12 @@ implementation
symtable.free;
stringdispose(objname);
stringdispose(objrealname);
stringdispose(iidstr);
if assigned(iidstr) then
stringdispose(iidstr);
if assigned(implementedinterfaces) then
implementedinterfaces.free;
if assigned(iidguid) then
dispose(iidguid);
inherited destroy;
end;
@ -4216,8 +4205,7 @@ implementation
ppufile.putsmallset(objectoptions);
if objecttype in [odt_interfacecom,odt_interfacecorba] then
begin
ppufile.putbyte(byte(isiidguidvalid));
ppufile.putguid(iidguid);
ppufile.putguid(iidguid^);
ppufile.putstring(iidstr^);
ppufile.putlongint(lastvtableindex);
end;
@ -4256,6 +4244,20 @@ implementation
implementedinterfaces.deref;
end;
procedure tobjectdef.prepareguid;
begin
{ set up guid }
if not assigned(iidguid) then
begin
new(iidguid);
fillchar(iidguid^,sizeof(iidguid^),0); { default null guid }
end;
{ setup iidstring }
if not assigned(iidstr) then
iidstr:=stringdup(''); { default is empty string }
end;
procedure tobjectdef.set_parent( c : tobjectdef);
begin
@ -5326,14 +5328,21 @@ implementation
inherited create;
registerdef:=oldregisterdef;
deftype:=forwarddef;
tosymname:=s;
tosymname:=stringdup(s);
forwardpos:=pos;
end;
function tforwarddef.gettypename:string;
begin
gettypename:='unresolved forward to '+tosymname;
gettypename:='unresolved forward to '+tosymname^;
end;
destructor tforwarddef.destroy;
begin
if assigned(tosymname) then
stringdispose(tosymname);
inherited destroy;
end;
@ -5438,12 +5447,6 @@ implementation
ttypesym(def.typesym).isusedinstab:=false;
def.is_def_stab_written:=not_written;
{$endif GDB}
{ reset rangenr's }
case def.deftype of
orddef : torddef(def).rangenr:=0;
enumdef : tenumdef(def).rangenr:=0;
arraydef : tarraydef(def).rangenr:=0;
end;
if assigned(def.rttitablesym) then
trttisym(def.rttitablesym).lab := nil;
if assigned(def.inittablesym) then
@ -5517,7 +5520,12 @@ implementation
end.
{
$Log$
Revision 1.104 2002-11-16 19:53:18 carl
Revision 1.105 2002-11-17 16:31:57 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.104 2002/11/16 19:53:18 carl
* avoid Range check errors
Revision 1.103 2002/11/15 16:29:09 peter

13
compiler/symsym.pas
View File

@ -114,10 +114,10 @@ interface
defs : pprocdeflist; { linked list of overloaded procdefs }
function getprocdef(nr:cardinal):Tprocdef;
public
procdef_count : cardinal;
procdef_count : byte;
is_global : boolean;
overloadchecked : boolean;
overloadcount : longint; { amount of overloaded functions in this module }
overloadcount : word; { amount of overloaded functions in this module }
property procdef[nr:cardinal]:Tprocdef read getprocdef;
constructor create(const n : string);
constructor ppuload(ppufile:tcompilerppufile);
@ -822,7 +822,7 @@ implementation
until false;
is_global:=false;
overloadchecked:=false;
overloadcount:=-1; { invalid, not used anymore }
overloadcount:=$ffff; { invalid, not used anymore }
end;
@ -2506,7 +2506,12 @@ implementation
end.
{
$Log$
Revision 1.71 2002-11-09 15:30:07 carl
Revision 1.72 2002-11-17 16:31:57 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.71 2002/11/09 15:30:07 carl
+ align RTTI tables
Revision 1.70 2002/10/13 21:33:37 peter

10
compiler/systems/t_linux.pas
View File

@ -65,7 +65,7 @@ implementation
cutils,cclasses,
verbose,systems,globtype,globals,
symconst,script,
fmodule
fmodule,dos
{$ifdef i386}
,aasmbase,aasmtai,aasmcpu,cpubase
{$endif i386}
@ -89,7 +89,6 @@ begin
if name<>'' then
begin
aktprocdef.setmangledname(name);
aktprocdef.has_mangledname:=true;
end
else
message(parser_e_empty_import_name);
@ -545,7 +544,12 @@ end.
{
$Log$
Revision 1.3 2002-11-15 01:59:02 peter
Revision 1.4 2002-11-17 16:32:04 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.3 2002/11/15 01:59:02 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

8
compiler/systems/t_macos.pas
View File

@ -62,7 +62,6 @@ begin
if name<>'' then
begin
aktprocdef.setmangledname(name);
aktprocdef.has_mangledname:=true;
end
else
message(parser_e_empty_import_name);
@ -100,7 +99,12 @@ initialization
end.
{
$Log$
Revision 1.3 2002-10-16 20:18:33 olle
Revision 1.4 2002-11-17 16:32:04 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.3 2002/10/16 20:18:33 olle
* header comment updated
Revision 1.2 2002/10/02 21:50:19 florian

8
compiler/systems/t_nwm.pas
View File

@ -140,7 +140,6 @@ begin
if name<>'' then
begin
aktprocdef.setmangledname(name);
aktprocdef.has_mangledname:=true;
end
else
message(parser_e_empty_import_name);
@ -484,7 +483,12 @@ initialization
end.
{
$Log$
Revision 1.2 2002-09-09 17:34:17 peter
Revision 1.3 2002-11-17 16:32:04 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.2 2002/09/09 17:34:17 peter
* tdicationary.replace added to replace and item in a dictionary. This
is only allowed for the same name
* varsyms are inserted in symtable before the types are parsed. This

10
compiler/utils/ppudump.pp
View File

@ -709,7 +709,7 @@ begin
end;
writeln;
end;
params:=ppufile.getword;
params:=ppufile.getbyte;
writeln(space,' Nr of parameters : ',params);
if params>0 then
begin
@ -1374,7 +1374,6 @@ begin
if tobjectdeftype(b) in [odt_interfacecom,odt_interfacecorba] then
begin
writeln(space,' GUID Valid : ',(getbyte<>0));
{ IIDGUID }
for j:=1to 16 do
getbyte;
@ -1898,7 +1897,12 @@ begin
end.
{
$Log$
Revision 1.33 2002-10-20 14:49:31 peter
Revision 1.34 2002-11-17 16:32:04 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.33 2002/10/20 14:49:31 peter
* store original source time in ppu so it can be compared instead of
comparing with the ppu time

16
compiler/x86_64/aasmcpu.pas
View File

@ -133,7 +133,7 @@ interface
reg : tregister;
constructor create(b:byte);
constructor create_op(b: byte; _op: byte);
function getfillbuf:pchar;override;
function calculatefillbuf(var buf : tfillbuffer):pchar;override;
end;
taicpu = class(taicpu_abstract)
@ -324,7 +324,7 @@ implementation
end;
function tai_align.getfillbuf:pchar;
function tai_align.calculatefillbuf(var buf : tfillbuffer):pchar;
const
alignarray:array[0..5] of string[8]=(
#$8D#$B4#$26#$00#$00#$00#$00,
@ -338,9 +338,10 @@ implementation
bufptr : pchar;
j : longint;
begin
inherited calculatefillbuf(buf);
if not use_op then
begin
bufptr:=@buf;
bufptr:=pchar(@buf);
while (fillsize>0) do
begin
for j:=0 to 5 do
@ -351,7 +352,7 @@ implementation
dec(fillsize,length(alignarray[j]));
end;
end;
getfillbuf:=pchar(@buf);
calculatefillbuf:=pchar(@buf);
end;
@ -1799,7 +1800,12 @@ implementation
end.
{
$Log$
Revision 1.3 2002-08-13 18:01:53 carl
Revision 1.4 2002-11-17 16:32:04 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.3 2002/08/13 18:01:53 carl
* rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline