diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas index 2b23b84d46..fd0091125a 100644 --- a/compiler/i386/cpupara.pas +++ b/compiler/i386/cpupara.pas @@ -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 diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 27e700f46e..de6da0941f 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -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 diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index acb5410df0..f7898e40e2 100644 --- a/compiler/ncgld.pas +++ b/compiler/ncgld.pas @@ -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 diff --git a/compiler/nflw.pas b/compiler/nflw.pas index 8320944f45..df3bb64224 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -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 diff --git a/compiler/nld.pas b/compiler/nld.pas index 24c424f34b..942d45f7f7 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -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 diff --git a/compiler/nmem.pas b/compiler/nmem.pas index d64a9445f7..42d6f7c958 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -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 diff --git a/compiler/node.pas b/compiler/node.pas index e969414c0e..d034212b50 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -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 diff --git a/compiler/symbase.pas b/compiler/symbase.pas index 0099462fe1..f556d9944d 100644 --- a/compiler/symbase.pas +++ b/compiler/symbase.pas @@ -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 diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 1c9703c325..c840824056 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -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