* fixed some crashes

  * fixed varargs and register calling probs

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
 

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
 

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

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

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

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

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

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

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