* fixed some crashes

* 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

View File

@ -290,7 +290,7 @@ unit cpupara;
paraloc.reference.index:=NR_STACK_POINTER_REG; paraloc.reference.index:=NR_STACK_POINTER_REG;
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
varalign:=size_2_align(l); varalign:=size_2_align(l);
paraloc.reference.offset:=parasize+target_info.first_parm_offset; paraloc.reference.offset:=parasize;
varalign:=used_align(varalign,paraalign,paraalign); varalign:=used_align(varalign,paraalign,paraalign);
parasize:=align(parasize+l,varalign); parasize:=align(parasize+l,varalign);
hp.paraloc[callerside]:=paraloc; hp.paraloc[callerside]:=paraloc;
@ -451,21 +451,19 @@ unit cpupara;
end; end;
{ Register parameters are assigned from left-to-right, adapt offset { Register parameters are assigned from left-to-right, adapt offset
for calleeside to be reversed } for calleeside to be reversed }
if (side=calleeside) then hp:=tparaitem(p.para.first);
while assigned(hp) do
begin begin
hp:=tparaitem(p.para.first); if (hp.paraloc[side].loc=LOC_REFERENCE) then
while assigned(hp) do
begin begin
if (hp.paraloc[side].loc=LOC_REFERENCE) then l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
begin varalign:=used_align(size_2_align(l),paraalign,paraalign);
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); l:=align(l,varalign);
varalign:=used_align(size_2_align(l),paraalign,paraalign); hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l;
l:=align(l,varalign); if side=calleeside then
hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l+ inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset);
target_info.first_parm_offset; end;
end; hp:=tparaitem(hp.next);
hp:=tparaitem(hp.next);
end;
end; end;
{ We need to return the size allocated } { We need to return the size allocated }
result:=parasize; result:=parasize;
@ -500,7 +498,11 @@ begin
end. end.
{ {
$Log$ $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 * reversed offset calculation for caller side so it works
correctly for interfaces correctly for interfaces

View File

@ -2282,10 +2282,12 @@ type
tvarsym(tloadnode(hpt).symtableentry).varstate:=vs_used; tvarsym(tloadnode(hpt).symtableentry).varstate:=vs_used;
end; end;
{ if we are calling the constructor, ignore inherited { if we are calling the constructor check for abstract
calls } methods. Ignore inherited and member calls, because the
class is then already created }
if (procdefinition.proctypeoption=potype_constructor) and 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; verifyabstractcalls;
end end
else else
@ -2694,7 +2696,11 @@ begin
end. end.
{ {
$Log$ $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 * reversed offset calculation for caller side so it works
correctly for interfaces correctly for interfaces

View File

@ -272,6 +272,8 @@ implementation
end; end;
procsym: procsym:
begin begin
if not assigned(procdef) then
internalerror(200312011);
if assigned(left) then if assigned(left) then
begin begin
{ {
@ -890,7 +892,11 @@ begin
end. end.
{ {
$Log$ $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 * removed obsolete nf_cargs flag
Revision 1.98 2003/10/29 19:48:50 peter Revision 1.98 2003/10/29 19:48:50 peter

View File

@ -1382,8 +1382,7 @@ implementation
destructor tonnode.destroy; destructor tonnode.destroy;
begin begin
{ copied nodes don't need to release the symtable } { copied nodes don't need to release the symtable }
if assigned(exceptsymtable) and if assigned(exceptsymtable) then
not(nf_copy in flags) then
exceptsymtable.free; exceptsymtable.free;
inherited destroy; inherited destroy;
end; end;
@ -1402,7 +1401,7 @@ implementation
n : tonnode; n : tonnode;
begin begin
n:=tonnode(inherited getcopy); n:=tonnode(inherited getcopy);
n.exceptsymtable:=exceptsymtable; n.exceptsymtable:=exceptsymtable.getcopy;
n.excepttype:=excepttype; n.excepttype:=excepttype;
result:=n; result:=n;
end; end;
@ -1472,7 +1471,11 @@ begin
end. end.
{ {
$Log$ $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 * don't release exceptsymtable for copied nodes
Revision 1.87 2003/11/12 15:48:27 peter Revision 1.87 2003/11/12 15:48:27 peter

View File

@ -361,6 +361,7 @@ implementation
n:=tloadnode(inherited getcopy); n:=tloadnode(inherited getcopy);
n.symtable:=symtable; n.symtable:=symtable;
n.symtableentry:=symtableentry; n.symtableentry:=symtableentry;
n.procdef:=procdef;
result:=n; result:=n;
end; end;
@ -510,6 +511,7 @@ implementation
docompare := docompare :=
inherited docompare(p) and inherited docompare(p) and
(symtableentry = tloadnode(p).symtableentry) and (symtableentry = tloadnode(p).symtableentry) and
(procdef = tloadnode(p).procdef) and
(symtable = tloadnode(p).symtable); (symtable = tloadnode(p).symtable);
end; end;
@ -517,7 +519,10 @@ implementation
procedure Tloadnode.printnodedata(var t:text); procedure Tloadnode.printnodedata(var t:text);
begin begin
inherited printnodedata(t); 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; end;
@ -1241,7 +1246,11 @@ begin
end. end.
{ {
$Log$ $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 + Applied patch from peter to support ansistrings in array constructors
Revision 1.117 2003/11/23 17:39:33 peter Revision 1.117 2003/11/23 17:39:33 peter

View File

@ -661,6 +661,8 @@ implementation
result:=nil; result:=nil;
resulttypepass(left); resulttypepass(left);
resulttypepass(right); resulttypepass(right);
set_varstate(left,vs_used,true);
set_varstate(right,vs_used,true);
if codegenerror then if codegenerror then
exit; exit;
@ -957,7 +959,11 @@ begin
end. end.
{ {
$Log$ $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 * typed address only used for @ and addr() that are parsed
Revision 1.72 2003/11/10 22:02:52 peter Revision 1.72 2003/11/10 22:02:52 peter

View File

@ -198,7 +198,6 @@ interface
nf_swapable, { tbinop operands can be swaped } nf_swapable, { tbinop operands can be swaped }
nf_swaped, { tbinop operands are swaped } nf_swaped, { tbinop operands are swaped }
nf_error, nf_error,
nf_copy,
{ general } { general }
nf_write, { Node is written to } nf_write, { Node is written to }
@ -767,8 +766,6 @@ implementation
{$ifdef extdebug} {$ifdef extdebug}
p.firstpasscount:=firstpasscount; p.firstpasscount:=firstpasscount;
{$endif extdebug} {$endif extdebug}
{ mark node as being a copy }
include(p.flags,nf_copy);
{ p.list:=list; } { p.list:=list; }
getcopy:=p; getcopy:=p;
end; end;
@ -1090,7 +1087,11 @@ implementation
end. end.
{ {
$Log$ $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 * typed address only used for @ and addr() that are parsed
Revision 1.76 2003/11/23 17:38:48 peter Revision 1.76 2003/11/23 17:38:48 peter

View File

@ -107,8 +107,11 @@ interface
unitid : word; unitid : word;
{ level of symtable, used for nested procedures } { level of symtable, used for nested procedures }
symtablelevel : byte; symtablelevel : byte;
refcount : integer;
constructor Create(const s:string); constructor Create(const s:string);
destructor destroy;override; destructor destroy;override;
procedure freeinstance;override;
function getcopy:tsymtable;
procedure clear;virtual; procedure clear;virtual;
function rename(const olds,news : stringid):tsymentry; function rename(const olds,news : stringid):tsymentry;
procedure foreach(proc2call : tnamedindexcallback;arg:pointer); procedure foreach(proc2call : tnamedindexcallback;arg:pointer);
@ -171,11 +174,15 @@ implementation
symsearch:=tdictionary.create; symsearch:=tdictionary.create;
symsearch.noclear:=true; symsearch.noclear:=true;
unitid:=0; unitid:=0;
refcount:=1;
end; end;
destructor tsymtable.destroy; destructor tsymtable.destroy;
begin begin
{ freeinstance decreases refcount }
if refcount>1 then
exit;
stringdispose(name); stringdispose(name);
stringdispose(realname); stringdispose(realname);
symindex.destroy; symindex.destroy;
@ -189,6 +196,21 @@ implementation
end; 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} {$ifdef EXTDEBUG}
procedure tsymtable.dumpsym(p : TNamedIndexItem;arg:pointer); procedure tsymtable.dumpsym(p : TNamedIndexItem;arg:pointer);
begin begin
@ -311,7 +333,11 @@ implementation
end. end.
{ {
$Log$ $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 * locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when * tvarsym.localloc contains the location of para/local when
generating code for the current procedure generating code for the current procedure

View File

@ -242,6 +242,7 @@ interface
ref : tsymlist; ref : tsymlist;
constructor create(const n : string;const tt : ttype); constructor create(const n : string;const tt : ttype);
constructor create_ref(const n : string;const tt : ttype;_ref:tsymlist); constructor create_ref(const n : string;const tt : ttype;_ref:tsymlist);
destructor destroy;override;
constructor ppuload(ppufile:tcompilerppufile); constructor ppuload(ppufile:tcompilerppufile);
procedure buildderef;override; procedure buildderef;override;
procedure deref;override; procedure deref;override;
@ -1499,6 +1500,7 @@ implementation
begin begin
inherited create(n,vs_value,tt); inherited create(n,vs_value,tt);
typ:=absolutesym; typ:=absolutesym;
ref:=nil;
end; end;
@ -1509,7 +1511,15 @@ implementation
ref:=_ref; ref:=_ref;
end; end;
destructor tabsolutesym.destroy;
begin
if assigned(ref) then
ref.free;
inherited destroy;
end;
constructor tabsolutesym.ppuload(ppufile:tcompilerppufile); constructor tabsolutesym.ppuload(ppufile:tcompilerppufile);
begin begin
{ Note: This needs to load everything of tvarsym.write } { Note: This needs to load everything of tvarsym.write }
@ -2689,7 +2699,11 @@ implementation
end. end.
{ {
$Log$ $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 * don't internalerror when emitting debuginfo for LOC_FPUREGISTER
Revision 1.135 2003/11/23 17:05:16 peter Revision 1.135 2003/11/23 17:05:16 peter