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

* fixed some crashes

Browse Source 
* fixed varargs and register calling probs
This commit is contained in:
peter 2003-12-01 18:44:15 +00:00
parent 1b0d0ca3c4
commit 9aba5c8c7a
9 changed files with 107 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
compiler/i386/cpupara.pas
View File

@ -290,7 +290,7 @@ unit cpupara;
paraloc.reference.index:=NR_STACK_POINTER_REG;
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
varalign:=size_2_align(l);
paraloc.reference.offset:=parasize+target_info.first_parm_offset;
paraloc.reference.offset:=parasize;
varalign:=used_align(varalign,paraalign,paraalign);
parasize:=align(parasize+l,varalign);
hp.paraloc[callerside]:=paraloc;
@ -451,21 +451,19 @@ unit cpupara;
end;
{ Register parameters are assigned from left-to-right, adapt offset
for calleeside to be reversed }
if (side=calleeside) then
hp:=tparaitem(p.para.first);
while assigned(hp) do
begin
hp:=tparaitem(p.para.first);
while assigned(hp) do
if (hp.paraloc[side].loc=LOC_REFERENCE) then
begin
if (hp.paraloc[side].loc=LOC_REFERENCE) then
begin
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
varalign:=used_align(size_2_align(l),paraalign,paraalign);
l:=align(l,varalign);
hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l+
target_info.first_parm_offset;
end;
hp:=tparaitem(hp.next);
end;
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
varalign:=used_align(size_2_align(l),paraalign,paraalign);
l:=align(l,varalign);
hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l;
if side=calleeside then
inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset);
end;
hp:=tparaitem(hp.next);
end;
{ We need to return the size allocated }
result:=parasize;
@ -500,7 +498,11 @@ begin
end.
{
$Log$
Revision 1.45 2003-11-28 17:24:22 peter
Revision 1.46 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.45 2003/11/28 17:24:22 peter
* reversed offset calculation for caller side so it works
correctly for interfaces

14
compiler/ncal.pas
View File

@ -2282,10 +2282,12 @@ type
tvarsym(tloadnode(hpt).symtableentry).varstate:=vs_used;
end;
{ if we are calling the constructor, ignore inherited
calls }
{ if we are calling the constructor check for abstract
methods. Ignore inherited and member calls, because the
class is then already created }
if (procdefinition.proctypeoption=potype_constructor) and
not(nf_inherited in flags) then
not(nf_inherited in flags) and
not(nf_member_call in flags) then
verifyabstractcalls;
end
else
@ -2694,7 +2696,11 @@ begin
end.
{
$Log$
Revision 1.209 2003-11-28 17:24:22 peter
Revision 1.210 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.209 2003/11/28 17:24:22 peter
* reversed offset calculation for caller side so it works
correctly for interfaces

8
compiler/ncgld.pas
View File

@ -272,6 +272,8 @@ implementation
end;
procsym:
begin
if not assigned(procdef) then
internalerror(200312011);
if assigned(left) then
begin
{
@ -890,7 +892,11 @@ begin
end.
{
$Log$
Revision 1.99 2003-11-23 17:39:33 peter
Revision 1.100 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.99 2003/11/23 17:39:33 peter
* removed obsolete nf_cargs flag
Revision 1.98 2003/10/29 19:48:50 peter

11
compiler/nflw.pas
View File

@ -1382,8 +1382,7 @@ implementation
destructor tonnode.destroy;
begin
{ copied nodes don't need to release the symtable }
if assigned(exceptsymtable) and
not(nf_copy in flags) then
if assigned(exceptsymtable) then
exceptsymtable.free;
inherited destroy;
end;
@ -1402,7 +1401,7 @@ implementation
n : tonnode;
begin
n:=tonnode(inherited getcopy);
n.exceptsymtable:=exceptsymtable;
n.exceptsymtable:=exceptsymtable.getcopy;
n.excepttype:=excepttype;
result:=n;
end;
@ -1472,7 +1471,11 @@ begin
end.
{
$Log$
Revision 1.88 2003-11-23 17:39:16 peter
Revision 1.89 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.88 2003/11/23 17:39:16 peter
* don't release exceptsymtable for copied nodes
Revision 1.87 2003/11/12 15:48:27 peter

13
compiler/nld.pas
View File

@ -361,6 +361,7 @@ implementation
n:=tloadnode(inherited getcopy);
n.symtable:=symtable;
n.symtableentry:=symtableentry;
n.procdef:=procdef;
result:=n;
end;
@ -510,6 +511,7 @@ implementation
docompare :=
inherited docompare(p) and
(symtableentry = tloadnode(p).symtableentry) and
(procdef = tloadnode(p).procdef) and
(symtable = tloadnode(p).symtable);
end;
@ -517,7 +519,10 @@ implementation
procedure Tloadnode.printnodedata(var t:text);
begin
inherited printnodedata(t);
writeln(t,printnodeindention,'symbol = ',symtableentry.name);
write(t,printnodeindention,'symbol = ',symtableentry.name);
if symtableentry.typ=procsym then
write(t,printnodeindention,'procdef = ',procdef.mangledname);
writeln(t,'');
end;
@ -1241,7 +1246,11 @@ begin
end.
{
$Log$
Revision 1.118 2003-11-26 14:25:26 michael
Revision 1.119 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.118 2003/11/26 14:25:26 michael
+ Applied patch from peter to support ansistrings in array constructors
Revision 1.117 2003/11/23 17:39:33 peter

8
compiler/nmem.pas
View File

@ -661,6 +661,8 @@ implementation
result:=nil;
resulttypepass(left);
resulttypepass(right);
set_varstate(left,vs_used,true);
set_varstate(right,vs_used,true);
if codegenerror then
exit;
@ -957,7 +959,11 @@ begin
end.
{
$Log$
Revision 1.73 2003-11-29 14:33:13 peter
Revision 1.74 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.73 2003/11/29 14:33:13 peter
* typed address only used for @ and addr() that are parsed
Revision 1.72 2003/11/10 22:02:52 peter

9
compiler/node.pas
View File

@ -198,7 +198,6 @@ interface
nf_swapable, { tbinop operands can be swaped }
nf_swaped, { tbinop operands are swaped }
nf_error,
nf_copy,
{ general }
nf_write, { Node is written to }
@ -767,8 +766,6 @@ implementation
{$ifdef extdebug}
p.firstpasscount:=firstpasscount;
{$endif extdebug}
{ mark node as being a copy }
include(p.flags,nf_copy);
{ p.list:=list; }
getcopy:=p;
end;
@ -1090,7 +1087,11 @@ implementation
end.
{
$Log$
Revision 1.77 2003-11-29 14:33:13 peter
Revision 1.78 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.77 2003/11/29 14:33:13 peter
* typed address only used for @ and addr() that are parsed
Revision 1.76 2003/11/23 17:38:48 peter

28
compiler/symbase.pas
View File

@ -107,8 +107,11 @@ interface
unitid : word;
{ level of symtable, used for nested procedures }
symtablelevel : byte;
refcount : integer;
constructor Create(const s:string);
destructor destroy;override;
procedure freeinstance;override;
function getcopy:tsymtable;
procedure clear;virtual;
function rename(const olds,news : stringid):tsymentry;
procedure foreach(proc2call : tnamedindexcallback;arg:pointer);
@ -171,11 +174,15 @@ implementation
symsearch:=tdictionary.create;
symsearch.noclear:=true;
unitid:=0;
refcount:=1;
end;
destructor tsymtable.destroy;
begin
{ freeinstance decreases refcount }
if refcount>1 then
exit;
stringdispose(name);
stringdispose(realname);
symindex.destroy;
@ -189,6 +196,21 @@ implementation
end;
procedure tsymtable.freeinstance;
begin
dec(refcount);
if refcount=0 then
inherited freeinstance;
end;
function tsymtable.getcopy:tsymtable;
begin
inc(refcount);
result:=self;
end;
{$ifdef EXTDEBUG}
procedure tsymtable.dumpsym(p : TNamedIndexItem;arg:pointer);
begin
@ -311,7 +333,11 @@ implementation
end.
{
$Log$
Revision 1.15 2003-09-23 17:56:06 peter
Revision 1.16 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.15 2003/09/23 17:56:06 peter
* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure

18
compiler/symsym.pas
View File

@ -242,6 +242,7 @@ interface
ref : tsymlist;
constructor create(const n : string;const tt : ttype);
constructor create_ref(const n : string;const tt : ttype;_ref:tsymlist);
destructor destroy;override;
constructor ppuload(ppufile:tcompilerppufile);
procedure buildderef;override;
procedure deref;override;
@ -1499,6 +1500,7 @@ implementation
begin
inherited create(n,vs_value,tt);
typ:=absolutesym;
ref:=nil;
end;
@ -1509,7 +1511,15 @@ implementation
ref:=_ref;
end;
destructor tabsolutesym.destroy;
begin
if assigned(ref) then
ref.free;
inherited destroy;
end;
constructor tabsolutesym.ppuload(ppufile:tcompilerppufile);
begin
{ Note: This needs to load everything of tvarsym.write }
@ -2689,7 +2699,11 @@ implementation
end.
{
$Log$
Revision 1.136 2003-11-29 18:16:39 jonas
Revision 1.137 2003-12-01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs
Revision 1.136 2003/11/29 18:16:39 jonas
* don't internalerror when emitting debuginfo for LOC_FPUREGISTER
Revision 1.135 2003/11/23 17:05:16 peter