* self moved to hidden parameter

  * removed hdisposen,hnewn,selfn

compiler/cgbase.pas

@@ -416,6 +416,22 @@ implementation
               framepointer_offset:=procdef.parast.address_fixup;
               inc(procdef.parast.address_fixup,POINTER_SIZE);
            end;
+      end;
+
+
+    procedure tprocinfo.after_header;
+      var
+        srsym : tvarsym;
+      begin
+         { Retrieve function result offset }
+         if assigned(procdef.funcretsym) then
+           begin
+             current_procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
+                                     tvarsym(procdef.funcretsym).owner.address_fixup;
+             if tvarsym(procdef.funcretsym).owner.symtabletype=localsymtable then
+              current_procinfo.return_offset:=tg.direction*current_procinfo.return_offset;
+           end;
+         { retrieve offsets of self/vmt }
          if assigned(procdef._class) then
            begin
               if (po_containsself in procdef.procoptions) then
@@ -426,29 +442,37 @@ implementation
                { self isn't pushed in nested procedure of methods }
                if (procdef.parast.symtablelevel=normal_function_level) then
                 begin
-                  selfpointer_offset:=procdef.parast.address_fixup;
-                  inc(procdef.parast.address_fixup,POINTER_SIZE);
+                  srsym:=tvarsym(procdef.parast.search('self'));
+                  if not assigned(srsym) then
+                   internalerror(200305058);
+                  selfpointer_offset:=tvarsym(srsym).address+srsym.owner.address_fixup;
                 end;
 
               { Special parameters for de-/constructors }
               case procdef.proctypeoption of
                 potype_constructor :
                   begin
-                    vmtpointer_offset:=procdef.parast.address_fixup;
-                    inc(procdef.parast.address_fixup,POINTER_SIZE);
+                    srsym:=tvarsym(procdef.parast.search('vmt'));
+                    if not assigned(srsym) then
+                     internalerror(200305058);
+                    vmtpointer_offset:=tvarsym(srsym).address+srsym.owner.address_fixup;
                   end;
                 potype_destructor :
                   begin
                     if is_object(procdef._class) then
                      begin
-                       vmtpointer_offset:=procdef.parast.address_fixup;
-                       inc(procdef.parast.address_fixup,POINTER_SIZE);
+                       srsym:=tvarsym(procdef.parast.search('vmt'));
+                       if not assigned(srsym) then
+                        internalerror(200305058);
+                       vmtpointer_offset:=tvarsym(srsym).address+srsym.owner.address_fixup;
                      end
                     else
                      if is_class(procdef._class) then
                       begin
-                        inheritedflag_offset:=procdef.parast.address_fixup;
-                        inc(procdef.parast.address_fixup,POINTER_SIZE);
+                        srsym:=tvarsym(procdef.parast.search('vmt'));
+                        if not assigned(srsym) then
+                         internalerror(200305058);
+                        inheritedflag_offset:=tvarsym(srsym).address+srsym.owner.address_fixup;
                       end
                     else
                      internalerror(200303261);
@@ -458,19 +482,6 @@ implementation
       end;
 
 
-    procedure tprocinfo.after_header;
-      begin
-         { Retrieve function result offset }
-         if assigned(procdef.funcretsym) then
-           begin
-             current_procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
-                                     tvarsym(procdef.funcretsym).owner.address_fixup;
-             if tvarsym(procdef.funcretsym).owner.symtabletype=localsymtable then
-              current_procinfo.return_offset:=tg.direction*current_procinfo.return_offset;
-           end;
-      end;
-
-
     procedure tprocinfo.after_pass1;
       begin
       end;
@@ -630,7 +641,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.45  2003-04-27 11:21:32  peter
+  Revision 1.46  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.45  2003/04/27 11:21:32  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/cgobj.pas

@@ -1333,10 +1333,8 @@ unit cgobj;
          { call the special incr function or the generic addref }
          if incrfunc<>'' then
           begin
-            if loadref then
-              a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
-            else
-              a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+            { these functions get the pointer by value }
+            a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1));
             a_call_name(list,incrfunc);
           end
          else
@@ -1882,7 +1880,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.94  2003-05-01 12:23:46  jonas
+  Revision 1.95  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.94  2003/05/01 12:23:46  jonas
     * fix for op_reg_reg_reg in case the destination is the same as the first
       source register
 

compiler/defcmp.pas

@@ -1058,84 +1058,102 @@ implementation
 
     function compare_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean):tequaltype;
       var
-        def1,def2 : TParaItem;
+        currpara1,
+        currpara2 : TParaItem;
         eq,lowesteq : tequaltype;
-        hpd : tprocdef;
+        hpd      : tprocdef;
         convtype : tconverttype;
       begin
          compare_paras:=te_incompatible;
          { we need to parse the list from left-right so the
            not-default parameters are checked first }
          lowesteq:=high(tequaltype);
-         def1:=TParaItem(paralist1.first);
-         def2:=TParaItem(paralist2.first);
-         while (assigned(def1)) and (assigned(def2)) do
+         currpara1:=TParaItem(paralist1.first);
+         currpara2:=TParaItem(paralist2.first);
+         while (assigned(currpara1)) and (assigned(currpara2)) do
            begin
              eq:=te_incompatible;
 
              { Unique types must match exact }
-             if ((df_unique in def1.paratype.def.defoptions) or (df_unique in def2.paratype.def.defoptions)) and
-                (def1.paratype.def<>def2.paratype.def) then
+             if ((df_unique in currpara1.paratype.def.defoptions) or (df_unique in currpara2.paratype.def.defoptions)) and
+                (currpara1.paratype.def<>currpara2.paratype.def) then
                exit;
 
-             case acp of
-               cp_value_equal_const :
-                 begin
-                    if (
-                        (def1.paratyp<>def2.paratyp) and
-                        ((def1.paratyp in [vs_var,vs_out]) or
-                         (def2.paratyp in [vs_var,vs_out]))
-                       ) then
-                      exit;
-                    eq:=compare_defs(def1.paratype.def,def2.paratype.def,nothingn);
-                 end;
-               cp_all :
+             { Handle hidden parameters separately, because self is
+               defined as voidpointer for methodpointers }
+             if (currpara1.is_hidden or
+                 currpara2.is_hidden) then
+              begin
+                eq:=te_equal;
+                if not(vo_is_self in tvarsym(currpara1.parasym).varoptions) and
+                   not(vo_is_self in tvarsym(currpara2.parasym).varoptions) then
                  begin
-                    if (def1.paratyp<>def2.paratyp) then
-                      exit;
-                    eq:=compare_defs(def1.paratype.def,def2.paratype.def,nothingn);
+                   if (currpara1.paratyp<>currpara2.paratyp) then
+                    exit;
+                   eq:=compare_defs(currpara1.paratype.def,currpara2.paratype.def,nothingn);
                  end;
-               cp_procvar :
-                 begin
-                    if (def1.paratyp<>def2.paratyp) then
-                      exit;
-                    eq:=compare_defs_ext(def1.paratype.def,def2.paratype.def,nothingn,
-                                         false,true,convtype,hpd);
-                    if (eq>te_incompatible) and
-                       (eq<te_equal) and
-                       not(
-                           (convtype in [tc_equal,tc_int_2_int]) and
-                           (def1.paratype.def.size=def2.paratype.def.size)
+              end
+             else
+              begin
+                case acp of
+                  cp_value_equal_const :
+                    begin
+                       if (
+                           (currpara1.paratyp<>currpara2.paratyp) and
+                           ((currpara1.paratyp in [vs_var,vs_out]) or
+                            (currpara2.paratyp in [vs_var,vs_out]))
                           ) then
-                     begin
-                       eq:=te_incompatible;
-                     end;
+                         exit;
+                       eq:=compare_defs(currpara1.paratype.def,currpara2.paratype.def,nothingn);
+                    end;
+                  cp_all :
+                    begin
+                       if (currpara1.paratyp<>currpara2.paratyp) then
+                         exit;
+                       eq:=compare_defs(currpara1.paratype.def,currpara2.paratype.def,nothingn);
+                    end;
+                  cp_procvar :
+                    begin
+                       if (currpara1.paratyp<>currpara2.paratyp) then
+                         exit;
+                       eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                                            false,true,convtype,hpd);
+                       if (eq>te_incompatible) and
+                          (eq<te_equal) and
+                          not(
+                              (convtype in [tc_equal,tc_int_2_int]) and
+                              (currpara1.paratype.def.size=currpara2.paratype.def.size)
+                             ) then
+                        begin
+                          eq:=te_incompatible;
+                        end;
+                    end;
+                  else
+                    eq:=compare_defs(currpara1.paratype.def,currpara2.paratype.def,nothingn);
                  end;
-               else
-                 eq:=compare_defs(def1.paratype.def,def2.paratype.def,nothingn);
-              end;
+               end;
               { check type }
               if eq=te_incompatible then
                 exit;
               if eq<lowesteq then
                 lowesteq:=eq;
               { also check default value if both have it declared }
-              if assigned(def1.defaultvalue) and
-                 assigned(def2.defaultvalue) then
+              if assigned(currpara1.defaultvalue) and
+                 assigned(currpara2.defaultvalue) then
                begin
-                 if not equal_constsym(tconstsym(def1.defaultvalue),tconstsym(def2.defaultvalue)) then
+                 if not equal_constsym(tconstsym(currpara1.defaultvalue),tconstsym(currpara2.defaultvalue)) then
                    exit;
                end;
-              def1:=TParaItem(def1.next);
-              def2:=TParaItem(def2.next);
+              currpara1:=TParaItem(currpara1.next);
+              currpara2:=TParaItem(currpara2.next);
            end;
          { when both lists are empty then the parameters are equal. Also
            when one list is empty and the other has a parameter with default
            value assigned then the parameters are also equal }
-         if ((def1=nil) and (def2=nil)) or
+         if ((currpara1=nil) and (currpara2=nil)) or
             (allowdefaults and
-             ((assigned(def1) and assigned(def1.defaultvalue)) or
-              (assigned(def2) and assigned(def2.defaultvalue)))) then
+             ((assigned(currpara1) and assigned(currpara1.defaultvalue)) or
+              (assigned(currpara2) and assigned(currpara2.defaultvalue)))) then
            compare_paras:=lowesteq;
       end;
 
@@ -1193,7 +1211,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2003-04-23 20:16:04  peter
+  Revision 1.24  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.23  2003/04/23 20:16:04  peter
     + added currency support based on int64
     + is_64bit for use in cg units instead of is_64bitint
     * removed cgmessage from n386add, replace with internalerrors

compiler/fpcdefs.inc

@@ -59,7 +59,6 @@
 
 {$ifdef powerpc}
   {$define callparatemp}
-  {$define vs_hidden_self}
 {$endif powerpc}
 
 { FPU Emulator support }
@@ -74,7 +73,11 @@
 
 {
   $Log$
-  Revision 1.18  2003-04-30 09:42:42  florian
+  Revision 1.19  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.18  2003/04/30 09:42:42  florian
     + first changes to make self a hidden parameter
 
   Revision 1.17  2003/04/24 22:29:57  florian

compiler/htypechk.pas

@@ -440,8 +440,8 @@ implementation
 
              { the nil as symtable signs firstcalln that this is
                an overloaded operator }
+             inc(overloaded_operators[optoken].refs);
              ht:=ccallnode.create(nil,overloaded_operators[optoken],nil,nil);
-             inc(tcallnode(ht).symtableprocentry.refs);
              { we already know the procdef to use for equal, so it can
                skip the overload choosing in callnode.det_resulttype }
              if assigned(operpd) then
@@ -859,11 +859,6 @@ implementation
                   CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr);
                  exit;
                end;
-             selfn :
-               begin
-                 valid_for_assign:=true;
-                 exit;
-               end;
              calln :
                begin
                  { check return type }
@@ -998,7 +993,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.62  2003-04-27 11:21:32  peter
+  Revision 1.63  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.62  2003/04/27 11:21:32  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/link.pas

@@ -190,6 +190,8 @@ begin
      3. global libary dir
      4. exe path of the compiler }
   found:=FindFile(s,'.'+source_info.DirSep,foundfile);
+  if (not found) and (current_module.outputpath^<>'') then
+   found:=FindFile(s,current_module.outputpath^,foundfile);
   if (not found) then
    found:=current_module.locallibrarysearchpath.FindFile(s,foundfile);
   if (not found) then
@@ -654,7 +656,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.35  2003-04-26 09:16:07  peter
+  Revision 1.36  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.35  2003/04/26 09:16:07  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/ncal.pas

@@ -65,6 +65,8 @@ interface
 {$ifdef EXTDEBUG}
           procedure candidates_dump_info(lvl:longint;procs:pcandidate);
 {$endif EXTDEBUG}
+          function  gen_self_tree:tnode;
+          function  gen_vmt_tree:tnode;
           procedure bind_paraitem;
        public
           { the symbol containing the definition of the procedure }
@@ -89,6 +91,7 @@ interface
           { only the processor specific nodes need to override this }
           { constructor                                             }
           constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual;
+          constructor create_procvar(l,r:tnode);
           constructor createintern(const name: string; params: tnode);
           constructor createinternres(const name: string; params: tnode; const res: ttype);
           constructor createinternreturn(const name: string; params: tnode; returnnode : tnode);
@@ -112,7 +115,6 @@ interface
           function track_state_pass(exec_known:boolean):boolean;override;
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
-          procedure set_procvar(procvar:tnode);
           procedure printnodedata(var t:text);override;
        private
 {$ifdef callparatemp}
@@ -888,6 +890,20 @@ type
       end;
 
 
+    constructor tcallnode.create_procvar(l,r:tnode);
+      begin
+         inherited create(calln,l,r);
+         symtableprocentry:=nil;
+         symtableproc:=nil;
+         include(flags,nf_return_value_used);
+         methodpointer:=nil;
+         procdefinition:=nil;
+         restypeset:=false;
+         funcretnode:=nil;
+         paralength:=-1;
+      end;
+
+
      constructor tcallnode.createintern(const name: string; params: tnode);
        var
          srsym: tsym;
@@ -985,12 +1001,6 @@ type
       end;
 
 
-    procedure tcallnode.set_procvar(procvar:tnode);
-      begin
-        right:=procvar;
-      end;
-
-
     function tcallnode.getcopy : tnode;
       var
         n : tcallnode;
@@ -1070,7 +1080,7 @@ type
         }
         if assigned(methodpointer) and assigned(methodpointer.resulttype.def) then
             if (methodpointer.resulttype.def.deftype = classrefdef) and
-              (methodpointer.nodetype in [typen,loadvmtn]) then
+              (methodpointer.nodetype in [typen,loadvmtaddrn]) then
               begin
                 if (tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) then
                     objectdf := tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def);
@@ -1573,6 +1583,131 @@ type
       end;
 
 
+    function tcallnode.gen_self_tree:tnode;
+      var
+        selftree : tnode;
+      begin
+        selftree:=nil;
+
+        { constructors }
+        if (procdefinition.proctypeoption=potype_constructor) then
+          begin
+            if not(nf_inherited in flags) then
+              begin
+                { push 0 as self when allocation is needed }
+                if (methodpointer.resulttype.def.deftype=classrefdef) or
+                   (nf_new_call in flags) then
+                  selftree:=cpointerconstnode.create(0,voidpointertype)
+                else
+                  begin
+                    if methodpointer.nodetype=typen then
+                      selftree:=load_self
+                    else
+                      selftree:=methodpointer.getcopy;
+                  end;
+              end
+            else
+              selftree:=load_self;
+          end
+        else
+          begin
+            { Calling a static/class method from a non-static/class method,
+              then we need to load self with the VMT }
+            if (
+                (po_classmethod in procdefinition.procoptions) and
+                not(assigned(current_procdef) and
+                    (po_classmethod in current_procdef.procoptions))
+               ) or
+               (
+                (po_staticmethod in procdefinition.procoptions) and
+                 not(assigned(current_procdef) and
+                     (po_staticmethod in current_procdef.procoptions))
+               ) then
+              begin
+                if (procdefinition.deftype<>procdef) then
+                  internalerror(200305062);
+                if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
+                  begin
+                    if methodpointer.resulttype.def.deftype=classrefdef then
+                      selftree:=methodpointer.getcopy
+                    else
+                      selftree:=cloadvmtaddrnode.create(methodpointer.getcopy);
+                  end
+                else
+                  selftree:=cpointerconstnode.create(0,voidpointertype);
+              end
+            else
+              begin
+                if methodpointer.nodetype=typen then
+                  selftree:=load_self
+                else
+                  selftree:=methodpointer.getcopy;
+              end;
+          end;
+        result:=selftree;
+      end;
+
+
+    function tcallnode.gen_vmt_tree:tnode;
+      var
+        vmttree : tnode;
+      begin
+        vmttree:=nil;
+        if not(procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
+          internalerror(200305051);
+
+        { inherited call, no create/destroy }
+        if (nf_inherited in flags) then
+          vmttree:=cpointerconstnode.create(0,voidpointertype)
+        else
+          { constructor with extended syntax called from new }
+          if (nf_new_call in flags) then
+            vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resulttype))
+        else
+          { destructor with extended syntax called from dispose }
+          if (nf_dispose_call in flags) then
+            vmttree:=cloadvmtaddrnode.create(methodpointer.getcopy)
+        else
+         if (methodpointer.resulttype.def.deftype=classrefdef) then
+          begin
+            { constructor call via classreference => allocate memory }
+            if (procdefinition.proctypeoption=potype_constructor) and
+               is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
+              vmttree:=methodpointer.getcopy
+            else
+              vmttree:=cpointerconstnode.create(0,voidpointertype);
+          end
+        else
+        { class }
+         if is_class(methodpointer.resulttype.def) then
+          begin
+            { destructor: release instance, flag(vmt)=1
+              constructor: direct call, do nothing, leave vmt=0 }
+            if (procdefinition.proctypeoption=potype_destructor) then
+             begin
+               { do not release when called from member function
+                 without specifying self explicit }
+               if (nf_member_call in flags) then
+                 vmttree:=cpointerconstnode.create(0,voidpointertype)
+               else
+                 vmttree:=cpointerconstnode.create(1,voidpointertype);
+             end
+            else
+             vmttree:=cpointerconstnode.create(0,voidpointertype);
+          end
+        else
+        { object }
+         begin
+           { destructor: direct call, no dispose, vmt=0
+             constructor: initialize object, load vmt }
+           if (procdefinition.proctypeoption=potype_constructor) then
+             vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resulttype))
+           else
+             vmttree:=cpointerconstnode.create(0,voidpointertype);
+         end;
+        result:=vmttree;
+      end;
+
 
     procedure tcallnode.bind_paraitem;
       var
@@ -1636,7 +1771,21 @@ type
                     internalerror(200304082);
                   { we need the information of the next parameter }
                   hiddentree:=gen_high_tree(pt.left,is_open_string(tparaitem(currpara.previous).paratype.def));
-                end;
+                end
+              else
+               if vo_is_self in tvarsym(currpara.parasym).varoptions then
+                 begin
+{$warning todo methodpointer}
+                   if (right=nil) then
+                     hiddentree:=gen_self_tree
+                   else
+                     hiddentree:=cnothingnode.create;
+                 end
+              else
+               if vo_is_vmt in tvarsym(currpara.parasym).varoptions then
+                 begin
+                   hiddentree:=gen_vmt_tree;
+                 end;
               { add the hidden parameter }
               if not assigned(hiddentree) then
                 internalerror(200304073);
@@ -1767,13 +1916,8 @@ type
                              (symtableprocentry.procdef_count=1) then
                             begin
                               hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
-                              if (symtableprocentry.owner.symtabletype=objectsymtable) then
-                               begin
-                                 if assigned(methodpointer) then
-                                   tloadnode(hpt).set_mp(methodpointer.getcopy)
-                                 else
-                                   tloadnode(hpt).set_mp(cselfnode.create(tobjectdef(symtableprocentry.owner.defowner)));
-                               end;
+                              if assigned(methodpointer) then
+                                tloadnode(hpt).set_mp(methodpointer.getcopy);
                               resulttypepass(hpt);
                               result:=hpt;
                             end
@@ -1920,7 +2064,7 @@ type
             { direct call to inherited abstract method, then we
               can already give a error in the compiler instead
               of a runtime error }
-            if (methodpointer.nodetype=typen) and
+            if (nf_inherited in flags) and
                (po_abstractmethod in procdefinition.procoptions) then
               CGMessage(cg_e_cant_call_abstract_method);
 
@@ -1928,13 +2072,13 @@ type
             { called in a con- or destructor then a warning }
             { will be made                                  }
             { con- and destructors need a pointer to the vmt }
-            if (methodpointer.nodetype=typen) and
+            if (nf_inherited in flags) and
                (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
                is_object(methodpointer.resulttype.def) and
                not(current_procdef.proctypeoption in [potype_constructor,potype_destructor]) then
              CGMessage(cg_w_member_cd_call_from_method);
 
-            if not(methodpointer.nodetype in [typen,hnewn]) then
+            if methodpointer.nodetype<>typen then
              begin
                hpt:=methodpointer;
                while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
@@ -1968,12 +2112,39 @@ type
                   (tloadnode(hpt).symtableentry.typ=varsym) then
                  tvarsym(tloadnode(hpt).symtableentry).varstate:=vs_used;
              end;
+          end
+         else
+          begin
+            { When this is method the methodpointer must be available }
+            if procdefinition.owner.symtabletype=objectsymtable then
+              internalerror(200305061);
           end;
 
          { bind paraitems to the callparanodes and insert hidden parameters }
          aktcallprocdef:=procdefinition;
          bind_paraitem;
 
+         { methodpointer is only needed for virtual calls, and
+           it should then be loaded with the VMT }
+         if (po_virtualmethod in procdefinition.procoptions) and
+            not(assigned(methodpointer) and
+                (methodpointer.nodetype=typen)) then
+          begin
+            if not assigned(methodpointer) then
+              internalerror(200305063);
+            if (methodpointer.resulttype.def.deftype<>classrefdef) then
+             begin
+               methodpointer:=cloadvmtaddrnode.create(methodpointer);
+               resulttypepass(methodpointer);
+             end;
+          end
+         else
+          begin
+            { not needed anymore }
+            methodpointer.free;
+            methodpointer:=nil;
+          end;
+
          { insert type conversions for parameters }
          if assigned(left) then
            tcallparanode(left).insert_typeconv(true);
@@ -2214,29 +2385,18 @@ type
          if (methodpointer<>nil) then
            begin
               if methodpointer.nodetype<>typen then
-                firstpass(methodpointer);
+               begin
+                 firstpass(methodpointer);
+                 registersfpu:=max(methodpointer.registersfpu,registersfpu);
+                 registers32:=max(methodpointer.registers32,registers32);
+{$ifdef SUPPORT_MMX }
+                 registersmmx:=max(methodpointer.registersmmx,registersmmx);
+{$endif SUPPORT_MMX}
+               end;
 
               { if we are calling the constructor }
-              if procdefinition.proctypeoption in [potype_constructor] then
+              if procdefinition.proctypeoption=potype_constructor then
                 verifyabstractcalls;
-
-              case methodpointer.nodetype of
-                { but only, if this is not a supporting node }
-                typen: ;
-                { we need one register for new return value PM }
-                hnewn : if registers32=0 then
-                          registers32:=1;
-                else
-                  begin
-                     { this is not a good reason to accept it in FPC if we produce
-                       wrong code for it !!! (PM) }
-                     registersfpu:=max(methodpointer.registersfpu,registersfpu);
-                     registers32:=max(methodpointer.registers32,registers32);
-{$ifdef SUPPORT_MMX }
-                     registersmmx:=max(methodpointer.registersmmx,registersmmx);
-{$endif SUPPORT_MMX}
-                  end;
-              end;
            end;
 
          if inlined then
@@ -2517,7 +2677,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.148  2003-05-05 14:53:16  peter
+  Revision 1.149  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.148  2003/05/05 14:53:16  peter
     * vs_hidden replaced by is_hidden boolean
 
   Revision 1.147  2003/04/27 11:21:33  peter

compiler/ncgcal.pas

@@ -40,10 +40,7 @@ interface
        end;
 
        tcgcallnode = class(tcallnode)
-       private
-          function  push_self_and_vmt(needvmtreg:boolean):tregister;
        protected
-//          funcretref : treference;
           refcountedtemp : treference;
           procedure handle_return_value(inlined:boolean);
           {# This routine is used to push the current frame pointer
@@ -148,6 +145,45 @@ implementation
              else
                push_value_para(exprasmlist,left,calloption,para_offset,para_alignment,paraitem.paraloc);
            end
+         { hidden parameters }
+         else if paraitem.is_hidden then
+           begin
+             { don't push a node that already generated a pointer type
+               by address for implicit hidden parameters }
+             if (vo_is_funcret in tvarsym(paraitem.parasym).varoptions) or
+                (not(left.resulttype.def.deftype in [pointerdef,classrefdef]) and
+                 paramanager.push_addr_param(paraitem.paratype.def,calloption)) then
+               begin
+                  if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+                    internalerror(200305071);
+
+                  inc(pushedparasize,POINTER_SIZE);
+                  if calloption=pocall_inline then
+                    begin
+                    {$ifdef newra}
+                       tmpreg:=rg.getaddressregister(exprasmlist);
+                    {$else}
+                       tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                    {$endif}
+                       cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
+                       reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
+                       cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                    {$ifdef newra}
+                       rg.ungetregisterint(exprasmlist,tmpreg);
+                    {$else}
+                       cg.free_scratch_reg(exprasmlist,tmpreg);
+                    {$endif}
+                    end
+                  else
+                    cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
+                  location_release(exprasmlist,left.location);
+               end
+             else
+               begin
+                  push_value_para(exprasmlist,left,calloption,
+                    para_offset,para_alignment,paraitem.paraloc);
+               end;
+           end
          { filter array of const c styled args }
          else if is_array_of_const(left.resulttype.def) and (nf_cargs in left.flags) then
            begin
@@ -210,7 +246,7 @@ implementation
                  { passing self to a var parameter is allowed in
                    TP and delphi }
                  if not((left.location.loc=LOC_CREFERENCE) and
-                        (left.nodetype=selfn)) then
+                        is_self_node(left)) then
                   internalerror(200106041);
                end;
               if (paraitem.paratyp=vs_out) and
@@ -241,16 +277,13 @@ implementation
            end
          else
            begin
-              { open array must always push the address, this is needed to
-                also push addr of small open arrays and with cdecl functions (PFV) }
-              if (
-                  assigned(paraitem.paratype.def) and
-                  (is_open_array(paraitem.paratype.def) or
-                   is_array_of_const(paraitem.paratype.def))
-                 ) or
-                 (
-                  paramanager.push_addr_param(resulttype.def,calloption)
-                 ) then
+              { don't push a node that already generated a pointer type
+                by address for implicit hidden parameters }
+              if (not(
+                      paraitem.is_hidden and
+                      (left.resulttype.def.deftype in [pointerdef,classrefdef])
+                     ) and
+                  paramanager.push_addr_param(paraitem.paratype.def,calloption)) then
                 begin
                    if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
                     begin
@@ -341,328 +374,6 @@ implementation
       end;
 
 
-    function tcgcallnode.push_self_and_vmt(needvmtreg:boolean):tregister;
-      var
-         href : treference;
-         vmtloc,selfloc : tlocation;
-         self_is_vmt,
-         vmtrefaddr,
-         selfrefaddr : boolean;
-
-         procedure selfloc_to_register;
-         var
-           hregister : tregister;
-         begin
-           case selfloc.loc of
-             LOC_REGISTER :
-               hregister:=selfloc.register;
-             LOC_CREFERENCE,
-             LOC_REFERENCE :
-               begin
-                 hregister:=rg.getaddressregister(exprasmlist);
-                 if selfrefaddr then
-                   begin
-                     cg.a_loadaddr_ref_reg(exprasmlist,selfloc.reference,hregister);
-                     selfrefaddr:=false;
-                   end
-                 else
-                   cg.a_load_ref_reg(exprasmlist,OS_ADDR,selfloc.reference,hregister);
-                 reference_release(exprasmlist,selfloc.reference);
-               end;
-             else
-               internalerror(200303269);
-           end;
-           location_reset(selfloc,LOC_REGISTER,OS_ADDR);
-           selfloc.register:=hregister;
-         end;
-
-      begin
-        result.enum:=R_INTREGISTER;
-        result.number:=NR_NO;
-        location_reset(vmtloc,LOC_CONSTANT,OS_ADDR);
-        location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
-        vmtrefaddr:=false;
-        selfrefaddr:=false;
-        self_is_vmt:=false;
-
-        { generate fake methodpointer node for withsymtable }
-        if (symtableproc.symtabletype=withsymtable) then
-         begin
-           methodpointer:=cnothingnode.create;
-           methodpointer.resulttype:=twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
-         end;
-
-        if assigned(methodpointer) then
-          begin
-            case methodpointer.nodetype of
-              typen:
-                begin
-                   if (sp_static in symtableprocentry.symoptions) then
-                     begin
-                        self_is_vmt:=true;
-                        if (oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
-                          begin
-                            location_reset(vmtloc,LOC_REFERENCE,OS_NO);
-                            reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
-                            vmtrefaddr:=true;
-                          end;
-                     end
-                   else
-                     begin
-                       { normal member call, load self. Not for classes
-                         when we call the constructor }
-                       if not(
-                              is_class(methodpointer.resulttype.def) and
-                              (procdefinition.proctypeoption=potype_constructor) and
-                              (current_procdef.proctypeoption<>potype_constructor)
-                             ) then
-                        begin
-                          location_reset(selfloc,LOC_REGISTER,OS_ADDR);
-                          selfloc.register:=cg.g_load_self(exprasmlist);
-                        end;
-                     end;
-
-                   if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
-                    begin
-                      if is_object(methodpointer.resulttype.def) then
-                       begin
-                         { reset self when calling constructor from destructor }
-                         if (procdefinition.proctypeoption=potype_constructor) and
-                            assigned(current_procdef) and
-                            (current_procdef.proctypeoption=potype_destructor) then
-                          begin
-                            location_release(exprasmlist,selfloc);
-                            location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
-                          end;
-                       end;
-                    end;
-                end;
-              hnewn:
-                begin
-                   { constructor with extended syntax called from new }
-                   { vmt }
-                   location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
-                   reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
-                   vmtrefaddr:=true;
-                end;
-              hdisposen:
-                begin
-                   { destructor with extended syntax called from dispose }
-                   { hdisposen always deliver LOC_REFERENCE }
-                   secondpass(methodpointer);
-                   { vmt }
-                   location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
-                   reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
-                   vmtrefaddr:=true;
-                   { self, load in register first when it requires a virtual call }
-                   location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
-                   selfloc.reference:=methodpointer.location.reference;
-                   selfrefaddr:=true;
-                end;
-              else
-                begin
-                   { call to an instance member }
-                   if (symtableproc.symtabletype<>withsymtable) then
-                     begin
-                        secondpass(methodpointer);
-                        case methodpointer.location.loc of
-                           LOC_CREGISTER,
-                           LOC_REGISTER:
-                             begin
-                               location_reset(selfloc,LOC_REGISTER,OS_ADDR);
-                               selfloc.register:=methodpointer.location.register;
-                             end;
-                           LOC_CREFERENCE,
-                           LOC_REFERENCE :
-                             begin
-                               location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
-                               selfloc.reference:=methodpointer.location.reference;
-                               if (methodpointer.resulttype.def.deftype<>classrefdef) and
-                                  not(is_class_or_interface(methodpointer.resulttype.def)) then
-                                 selfrefaddr:=true;
-                             end;
-                           else
-                             internalerror(200303212);
-                        end;
-                     end
-                   else
-                     begin
-                       location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
-                       selfloc.reference:=twithnode(twithsymtable(symtableproc).withnode).withreference;
-                       if (nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags) and
-                          (twithsymtable(symtableproc).direct_with) and
-                          not(is_class_or_interface(twithnode(twithsymtable(symtableproc).withnode).left.resulttype.def)) then
-                         selfrefaddr:=true;
-                     end;
-
-                   if (po_staticmethod in procdefinition.procoptions) or
-                      (po_classmethod in procdefinition.procoptions) then
-                     begin
-                       self_is_vmt:=true;
-                       { classref are already loaded with VMT }
-                       if (methodpointer.resulttype.def.deftype=classrefdef) then
-                        location_copy(vmtloc,selfloc)
-                       else
-                        begin
-                          if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
-                            begin
-                              { load VMT from passed self }
-                              selfloc_to_register;
-                              cg.g_maybe_testself(exprasmlist,selfloc.register);
-                              location_copy(vmtloc,selfloc);
-                              reference_reset_base(href,vmtloc.register,tprocdef(procdefinition)._class.vmt_offset);
-                              cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,vmtloc.register);
-                            end;
-                        end;
-                       { reset self }
-                       location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
-                     end;
-
-                   if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
-                    begin
-                      { constructor call via classreference => allocate memory }
-                      if (methodpointer.resulttype.def.deftype=classrefdef) then
-                        begin
-                          if (procdefinition.proctypeoption=potype_constructor) and
-                             is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
-                           begin
-                             self_is_vmt:=true;
-                             { vmt load from provided methodpointer that
-                               was already loaded in selfloc }
-                             location_copy(vmtloc,selfloc);
-                             { reset self }
-                             location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
-                           end;
-                       end
-                      else
-                      { class }
-                       if is_class(methodpointer.resulttype.def) then
-                        begin
-                          { destructor: release instance, flag(vmt)=1
-                            constructor: direct call, do nothing, leave vmt=0 }
-                          if (procdefinition.proctypeoption=potype_destructor) then
-                           begin
-                             { flag 1 for destructor: remove data }
-                             location_reset(vmtloc,LOC_CONSTANT,OS_ADDR);
-                             vmtloc.value:=1;
-                           end;
-                        end
-                      else
-                      { object }
-                       begin
-                         { destructor: direct call, no dispose, vmt=0
-                           constructor: initialize object, load vmt }
-                         if (procdefinition.proctypeoption=potype_constructor) then
-                          begin
-                            { vmt }
-                            location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
-                            reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(
-                               tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
-                            vmtrefaddr:=true;
-                          end;
-                       end;
-                    end;
-                end;
-            end;
-          end
-        else
-          { No methodpointer }
-          begin
-             if (po_staticmethod in procdefinition.procoptions) or
-                (po_classmethod in procdefinition.procoptions) then
-              begin
-                self_is_vmt:=true;
-                { Load VMT from self? }
-                if (
-                    (po_classmethod in procdefinition.procoptions) and
-                    not(assigned(current_procdef) and
-                        (po_classmethod in current_procdef.procoptions))
-                   ) or
-                   (
-                    (po_staticmethod in procdefinition.procoptions) and
-                     not(assigned(current_procdef) and
-                         (po_staticmethod in current_procdef.procoptions))
-                   ) then
-                  begin
-                    if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
-                     begin
-                       { load vmt from self passed to the current method }
-                       location_reset(vmtloc,LOC_REGISTER,OS_ADDR);
-                       vmtloc.register:=cg.g_load_self(exprasmlist);
-                       cg.g_maybe_testself(exprasmlist,vmtloc.register);
-                       reference_reset_base(href,vmtloc.register,tprocdef(procdefinition)._class.vmt_offset);
-                       cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,vmtloc.register);
-                     end;
-                  end
-                 else
-                  begin
-                    { self is already VMT }
-                    location_reset(vmtloc,LOC_REGISTER,OS_ADDR);
-                    vmtloc.register:=cg.g_load_self(exprasmlist);
-                  end;
-               end
-             else
-               begin
-                  { member call, load self }
-                  location_reset(selfloc,LOC_REGISTER,OS_ADDR);
-                  selfloc.register:=cg.g_load_self(exprasmlist);
-               end;
-          end;
-
-        { Do we need to push the VMT as self for
-          class methods and static methods? }
-        if self_is_vmt then
-          begin
-            location_release(exprasmlist,selfloc);
-            location_copy(selfloc,vmtloc);
-            selfrefaddr:=vmtrefaddr;
-          end;
-
-        { when we need the vmt in a register then we already
-          load self in a register so it can generate optimized code }
-        if needvmtreg then
-          selfloc_to_register;
-
-        { constructor/destructor need vmt }
-        if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
-         begin
-           if vmtrefaddr then
-             cg.a_paramaddr_ref(exprasmlist,vmtloc.reference,paramanager.getintparaloc(2))
-           else
-             cg.a_param_loc(exprasmlist,vmtloc,paramanager.getintparaloc(2));
-         end;
-        if not self_is_vmt then
-          location_release(exprasmlist,vmtloc);
-
-        { push self }
-        if selfrefaddr then
-          cg.a_paramaddr_ref(exprasmlist,selfloc.reference,paramanager.getintparaloc(1))
-        else
-          cg.a_param_loc(exprasmlist,selfloc,paramanager.getintparaloc(1));
-
-        if needvmtreg then
-          begin
-            { self should already be loaded in a register }
-            if selfloc.register.number=NR_NO then
-              internalerror(2003032611);
-
-            { load vmt from self, this is already done
-              for static/class methods }
-            if not self_is_vmt then
-             begin
-               cg.g_maybe_testself(exprasmlist,selfloc.register);
-               { this is one point where we need vmt_offset (PM) }
-               reference_reset_base(href,selfloc.register,tprocdef(procdefinition)._class.vmt_offset);
-               cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,selfloc.register);
-             end;
-
-            result:=selfloc.register;
-          end
-        else
-          location_release(exprasmlist,selfloc);
-     end;
-
-
     procedure tcgcallnode.push_framepointer;
       var
         href : treference;
@@ -866,7 +577,6 @@ implementation
          href : treference;
          hp : tnode;
          pp : tcallparanode;
-         virtual_vmt_call,
          inlined : boolean;
          inlinecode : tprocinlinenode;
          store_parast_fixup,
@@ -875,8 +585,8 @@ implementation
          pop_size : longint;
          returnref,
          pararef : treference;
-         accreg,
-         vmtreg : tregister;
+         vmtreg,
+         accreg : tregister;
          oldaktcallnode : tcallnode;
       begin
          iolabel:=nil;
@@ -1022,18 +732,6 @@ implementation
          if inlined or
             (right=nil) then
            begin
-              { Virtual function call through VMT? }
-              vmtreg.enum:=R_INTREGISTER;
-              vmtreg.number:=NR_NO;
-              virtual_vmt_call:=(po_virtualmethod in procdefinition.procoptions) and
-                                not(assigned(methodpointer) and
-                                    (methodpointer.nodetype=typen));
-
-              { push self/vmt for methods }
-              if assigned(symtableproc) and
-                 (symtableproc.symtabletype in [withsymtable,objectsymtable]) then
-                vmtreg:=push_self_and_vmt(virtual_vmt_call);
-
               { push base pointer ?}
               { never when inlining, since if necessary, the base pointer }
               { can/will be gottten from the current procedure's symtable }
@@ -1047,8 +745,13 @@ implementation
               rg.saveintregvars(exprasmlist,regs_to_push_int);
               rg.saveotherregvars(exprasmlist,regs_to_push_other);
 
-              if virtual_vmt_call then
+              if (po_virtualmethod in procdefinition.procoptions) and
+                 assigned(methodpointer) then
                 begin
+                   secondpass(methodpointer);
+                   location_force_reg(exprasmlist,methodpointer.location,OS_ADDR,false);
+                   vmtreg:=methodpointer.location.register;
+
                    { virtual methods require an index }
                    if tprocdef(procdefinition).extnumber=-1 then
                      internalerror(200304021);
@@ -1067,7 +770,7 @@ implementation
                    cg.a_call_ref(exprasmlist,href);
 
                    { release self }
-                   rg.ungetregisterint(exprasmlist,vmtreg);
+                   rg.ungetaddressregister(exprasmlist,vmtreg);
                 end
               else
                 begin
@@ -1133,6 +836,11 @@ implementation
           begin
             { the old pop_size was already included in pushedparasize }
             pop_size:=pushedparasize;
+            { for Cdecl functions we don't need to pop the funcret when it
+              was pushed by para }
+            if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
+               paramanager.ret_in_param(procdefinition.rettype.def,procdefinition.proccalloption) then
+              dec(pop_size,POINTER_SIZE);
           end;
 
          { Remove parameters/alignment from the stack }
@@ -1437,7 +1145,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2003-05-05 14:53:16  peter
+  Revision 1.59  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.58  2003/05/05 14:53:16  peter
     * vs_hidden replaced by is_hidden boolean
 
   Revision 1.57  2003/04/30 20:53:32  florian

compiler/ncginl.pas

@@ -57,7 +57,7 @@ implementation
       symconst,symdef,defutil,symsym,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_1,pass_2,
-      cpubase,paramgr,
+      cpuinfo,cpubase,paramgr,
       nbas,ncon,ncal,ncnv,nld,
       tgobj,ncgutil,cgobj,rgobj,rgcpu
 {$ifndef cpu64bit}
@@ -420,7 +420,7 @@ implementation
                   addvalue,tcallparanode(left).left.location)
               else
                cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber],
-                  addvalue,tcallparanode(left).left.location);
+                  aword(addvalue),tcallparanode(left).left.location);
             end
            else
              begin
@@ -682,7 +682,11 @@ end.
 
 {
   $Log$
-  Revision 1.29  2003-05-01 12:27:08  jonas
+  Revision 1.30  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.29  2003/05/01 12:27:08  jonas
     * fixed include/exclude for normalsets
 
   Revision 1.28  2003/04/27 11:21:33  peter

compiler/ncgmem.pas

@@ -34,15 +34,7 @@ interface
       node,nmem;
 
     type
-       tcgloadvmtnode = class(tloadvmtnode)
-          procedure pass_2;override;
-       end;
-
-       tcghnewnode = class(thnewnode)
-          procedure pass_2;override;
-       end;
-
-       tcghdisposenode = class(thdisposenode)
+       tcgloadvmtaddrnode = class(tloadvmtaddrnode)
           procedure pass_2;override;
        end;
 
@@ -62,10 +54,6 @@ interface
           procedure pass_2;override;
        end;
 
-       tcgselfnode = class(tselfnode)
-          procedure pass_2;override;
-       end;
-
        tcgwithnode = class(twithnode)
           procedure pass_2;override;
        end;
@@ -113,67 +101,68 @@ implementation
                             TCGLOADNODE
 *****************************************************************************}
 
-    procedure tcgloadvmtnode.pass_2;
+    procedure tcgloadvmtaddrnode.pass_2;
       var
        href : treference;
 
       begin
          location_reset(location,LOC_REGISTER,OS_ADDR);
-         location.register:=rg.getaddressregister(exprasmlist);
-         { on 80386, LEA is the same as mov imm32 }
-         reference_reset_symbol(href,
-           objectlibrary.newasmsymboldata(tobjectdef(tclassrefdef(resulttype.def).pointertype.def).vmt_mangledname),0);
-         cg.a_loadaddr_ref_reg(exprasmlist,href,location.register);
-      end;
-
-
-{*****************************************************************************
-                            TCGHNEWNODE
-*****************************************************************************}
-
-    procedure tcghnewnode.pass_2;
-      begin
-         location_reset(location,LOC_VOID,OS_NO);
-         { completely resolved in first pass now }
-      end;
-
-
-{*****************************************************************************
-                         TCGHDISPOSENODE
-*****************************************************************************}
-
-    procedure tcghdisposenode.pass_2;
-      begin
-         location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
-
-         secondpass(left);
-         if codegenerror then
-           exit;
-
-         case left.location.loc of
-            LOC_REGISTER:
-              begin
-                if not rg.isaddressregister(left.location.register) then
-                  begin
-                    location_release(exprasmlist,left.location);
-                    location.reference.base := rg.getaddressregister(exprasmlist);
-                    cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,
-                      location.reference.base);
-                  end
-                else
-                  location.reference.base := left.location.register;
-              end;
-            LOC_CREGISTER,
-            LOC_CREFERENCE,
-            LOC_REFERENCE:
-              begin
-                 location_release(exprasmlist,left.location);
-                 location.reference.base:=rg.getaddressregister(exprasmlist);
-                 cg.a_load_loc_reg(exprasmlist,left.location,location.reference.base);
-              end;
+         if (left.nodetype<>typen) then
+          begin
+            { left contains self, load vmt from self }
+            secondpass(left);
+            if is_object(left.resulttype.def) then
+             begin
+               case left.location.loc of
+                  LOC_CREFERENCE,
+                  LOC_REFERENCE:
+                    begin
+                       location_release(exprasmlist,left.location);
+                       reference_reset_base(href,rg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
+                       cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,href.base);
+                    end;
+                  else
+                    internalerror(200305056);
+               end;
+             end
             else
-              internalerror(2002032217);
-         end;
+             begin
+               case left.location.loc of
+                  LOC_REGISTER:
+                    begin
+                      if not rg.isaddressregister(left.location.register) then
+                        begin
+                          location_release(exprasmlist,left.location);
+                          reference_reset_base(href,rg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
+                          cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,href.base);
+                        end
+                      else
+                        reference_reset_base(href,left.location.register,tobjectdef(left.resulttype.def).vmt_offset);
+                    end;
+                  LOC_CREGISTER,
+                  LOC_CREFERENCE,
+                  LOC_REFERENCE:
+                    begin
+                       location_release(exprasmlist,left.location);
+                       reference_reset_base(href,rg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
+                       cg.a_load_loc_reg(exprasmlist,left.location,href.base);
+                    end;
+                  else
+                    internalerror(200305057);
+               end;
+             end;
+            reference_release(exprasmlist,href);
+            location.register:=rg.getaddressregister(exprasmlist);
+            cg.g_maybe_testself(exprasmlist,href.base);
+            cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,location.register);
+          end
+         else
+          begin
+            reference_reset_symbol(href,
+              objectlibrary.newasmsymboldata(tobjectdef(tclassrefdef(resulttype.def).pointertype.def).vmt_mangledname),0);
+            location.register:=rg.getaddressregister(exprasmlist);
+            cg.a_loadaddr_ref_reg(exprasmlist,href,location.register);
+          end;
       end;
 
 
@@ -342,26 +331,6 @@ implementation
          location.size:=def_cgsize(resulttype.def);
       end;
 
-{*****************************************************************************
-                            TCGSELFNODE
-*****************************************************************************}
-
-    procedure tcgselfnode.pass_2;
-      begin
-         if (resulttype.def.deftype=classrefdef) or
-            (is_class(resulttype.def) or
-             (po_staticmethod in current_procdef.procoptions)) then
-          begin
-            location_reset(location,LOC_REGISTER,OS_ADDR);
-            location.register:=cg.g_load_self(exprasmlist);
-          end
-         else
-           begin
-             location_reset(location,LOC_CREFERENCE,OS_ADDR);
-             location.reference.base:=cg.g_load_self(exprasmlist);
-           end;
-      end;
-
 
 {*****************************************************************************
                             TCGWITHNODE
@@ -933,20 +902,21 @@ implementation
 
 
 begin
-   cloadvmtnode:=tcgloadvmtnode;
-   chnewnode:=tcghnewnode;
-   chdisposenode:=tcghdisposenode;
+   cloadvmtaddrnode:=tcgloadvmtaddrnode;
    caddrnode:=tcgaddrnode;
    cdoubleaddrnode:=tcgdoubleaddrnode;
    cderefnode:=tcgderefnode;
    csubscriptnode:=tcgsubscriptnode;
-   cselfnode:=tcgselfnode;
    cwithnode:=tcgwithnode;
    cvecnode:=tcgvecnode;
 end.
 {
   $Log$
-  Revision 1.50  2003-05-07 09:16:23  mazen
+  Revision 1.51  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.50  2003/05/07 09:16:23  mazen
   - non used units removed from uses clause
 
   Revision 1.49  2003/04/27 11:21:33  peter

compiler/ncgutil.pas

@@ -1722,7 +1722,8 @@ implementation
                        if assigned(pd) then
                          begin
                             objectlibrary.getlabel(nodestroycall);
-                            reference_reset_base(href,current_procinfo.framepointer,current_procinfo.selfpointer_offset);
+                            { check VMT pointer if this is an inherited constructor }
+                            reference_reset_base(href,current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
                             cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
                             r:=cg.g_load_self(list);
                             if is_class(current_procdef._class) then
@@ -2006,7 +2007,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.95  2003-04-29 07:28:52  michael
+  Revision 1.96  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.95  2003/04/29 07:28:52  michael
   + Patch from peter to fix wrong pushing of ansistring function results in open array
 
   Revision 1.94  2003/04/28 21:17:38  peter

compiler/ncnv.pas

@@ -1127,6 +1127,7 @@ implementation
           te_convert_operator :
             begin
               include(current_procinfo.flags,pi_do_call);
+              inc(overloaded_operators[_assignment].refs);
               hp:=ccallnode.create(ccallparanode.create(left,nil),
                                    overloaded_operators[_assignment],nil,nil);
               { tell explicitly which def we must use !! (PM) }
@@ -1177,7 +1178,7 @@ implementation
                            if assigned(tcallnode(left).methodpointer) then
                              tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy)
                            else
-                             tloadnode(hp).set_mp(cselfnode.create(tobjectdef(tcallnode(left).symtableprocentry.owner.defowner)));
+                             tloadnode(hp).set_mp(load_self);
                          end;
                         resulttypepass(hp);
                       end;
@@ -1214,7 +1215,7 @@ implementation
                          begin
                            { we can translate the typeconvnode to 'as' when
                              typecasting to a class or interface }
-                           hp:=casnode.create(left,cloadvmtnode.create(ctypenode.create(resulttype)));
+                           hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype)));
                            left:=nil;
                            result:=hp;
                            exit;
@@ -1277,8 +1278,7 @@ implementation
                  (left.resulttype.def.deftype=procvardef) and
                  (not is_void(tprocvardef(left.resulttype.def).rettype.def)) then
                begin
-                 hp:=ccallnode.create(nil,nil,nil,nil);
-                 tcallnode(hp).set_procvar(left);
+                 hp:=ccallnode.create_procvar(nil,left);
                  resulttypepass(hp);
                  left:=hp;
                end;
@@ -2091,7 +2091,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.109  2003-04-27 11:21:33  peter
+  Revision 1.110  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.109  2003/04/27 11:21:33  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/ninl.pas

@@ -483,8 +483,7 @@ implementation
                 { support writeln(procvar) }
                 if (para.left.resulttype.def.deftype=procvardef) then
                   begin
-                    p1:=ccallnode.create(nil,nil,nil,nil);
-                    tcallnode(p1).set_procvar(para.left);
+                    p1:=ccallnode.create_procvar(nil,para.left);
                     resulttypepass(p1);
                     para.left:=p1;
                   end;
@@ -576,8 +575,7 @@ implementation
                 { support writeln(procvar) }
                 if (para.left.resulttype.def.deftype=procvardef) then
                   begin
-                    p1:=ccallnode.create(nil,nil,nil,nil);
-                    tcallnode(p1).set_procvar(para.left);
+                    p1:=ccallnode.create_procvar(nil,para.left);
                     resulttypepass(p1);
                     para.left:=p1;
                   end;
@@ -2351,7 +2349,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.109  2003-04-27 11:21:33  peter
+  Revision 1.110  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.109  2003/04/27 11:21:33  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/nld.pas

@@ -128,6 +128,8 @@ interface
 
     procedure load_procvar_from_calln(var p1:tnode);
     function load_high_value(vs:tvarsym):tnode;
+    function load_self:tnode;
+    function is_self_node(p:tnode):boolean;
 
 
 implementation
@@ -199,6 +201,28 @@ implementation
       end;
 
 
+    function load_self:tnode;
+      var
+        srsym : tsym;
+        srsymtable : tsymtable;
+      begin
+        result:=nil;
+        searchsym('self',srsym,srsymtable);
+        if assigned(srsym) then
+          result:=cloadnode.create(srsym,srsymtable)
+        else
+          CGMessage(cg_e_illegal_expression);
+      end;
+
+
+    function is_self_node(p:tnode):boolean;
+      begin
+        is_self_node:=(p.nodetype=loadn) and
+                      (tloadnode(p).symtableentry.typ=varsym) and
+                      (vo_is_self in tvarsym(tloadnode(p).symtableentry).varoptions);
+      end;
+
+
 {*****************************************************************************
                              TLOADNODE
 *****************************************************************************}
@@ -320,7 +344,23 @@ implementation
                 if nf_absolute in flags then
                   tvarsym(symtableentry).varstate:=vs_used
                 else
-                  resulttype:=tvarsym(symtableentry).vartype;
+                  begin
+                    { fix self type which is declared as voidpointer in the
+                      definition }
+                    if vo_is_self in tvarsym(symtableentry).varoptions then
+                      begin
+                        if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
+                           (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
+                          begin
+                            resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
+                            resulttype.setdef(tclassrefdef.create(resulttype));
+                          end
+                        else
+                          resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
+                      end
+                    else
+                      resulttype:=tvarsym(symtableentry).vartype;
+                  end;
               end;
             typedconstsym :
                 if not(nf_absolute in flags) then
@@ -861,7 +901,7 @@ implementation
         hp        : tarrayconstructornode;
         dovariant : boolean;
         htype     : ttype;
-        orgflags  : tnodeflagset;
+        orgflags  : tnodeflags;
       begin
         dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
         result:=nil;
@@ -1127,7 +1167,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.90  2003-04-27 11:21:33  peter
+  Revision 1.91  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.90  2003/04/27 11:21:33  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/nmat.pas

@@ -530,8 +530,9 @@ implementation
               minusdef:=nil;
               if assigned(overloaded_operators[_minus]) then
                 minusdef:=overloaded_operators[_minus].search_procdef_unary_operator(left.resulttype.def);
-              if minusdef<>nil then
+              if assigned(minusdef) then
                 begin
+                  inc(overloaded_operators[_minus].refs);
                   t:=ccallnode.create(ccallparanode.create(left,nil),
                                       overloaded_operators[_minus],nil,nil);
                   left:=nil;
@@ -705,6 +706,7 @@ implementation
                 notdef:=overloaded_operators[_op_not].search_procdef_unary_operator(left.resulttype.def);
               if notdef<>nil then
                 begin
+                  inc(overloaded_operators[_op_not].refs);
                   t:=ccallnode.create(ccallparanode.create(left,nil),
                                       overloaded_operators[_op_not],nil,nil);
                   left:=nil;
@@ -793,7 +795,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2003-04-25 20:59:33  peter
+  Revision 1.48  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.47  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/nmem.pas

@@ -32,30 +32,12 @@ interface
        cpubase;
 
     type
-       tloadvmtnode = class(tunarynode)
+       tloadvmtaddrnode = class(tunarynode)
           constructor create(l : tnode);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        end;
-       tloadvmtnodeclass = class of tloadvmtnode;
-
-       thnewnode = class(tnode)
-          objtype : ttype;
-          constructor create(t:ttype);virtual;
-          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefimpl;override;
-          function pass_1 : tnode;override;
-          function det_resulttype:tnode;override;
-       end;
-       thnewnodeclass = class of thnewnode;
-
-       thdisposenode = class(tunarynode)
-          constructor create(l : tnode);virtual;
-          function pass_1 : tnode;override;
-          function det_resulttype:tnode;override;
-       end;
-       thdisposenodeclass = class of thdisposenode;
+       tloadvmtaddrnodeclass = class of tloadvmtaddrnode;
 
        taddrnode = class(tunarynode)
           getprocvardef : tprocvardef;
@@ -107,17 +89,6 @@ interface
        end;
        tvecnodeclass = class of tvecnode;
 
-       tselfnode = class(tnode)
-          classdef : tdef; { objectdef or classrefdef }
-          constructor create(_class : tdef);virtual;
-          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefimpl;override;
-          function pass_1 : tnode;override;
-          function det_resulttype:tnode;override;
-       end;
-       tselfnodeclass = class of tselfnode;
-
        twithnode = class(tbinarynode)
           withsymtable  : twithsymtable;
           tablecount    : longint;
@@ -134,15 +105,12 @@ interface
        twithnodeclass = class of twithnode;
 
     var
-       cloadvmtnode : tloadvmtnodeclass;
-       chnewnode : thnewnodeclass;
-       chdisposenode : thdisposenodeclass;
+       cloadvmtaddrnode : tloadvmtaddrnodeclass;
        caddrnode : taddrnodeclass;
        cdoubleaddrnode : tdoubleaddrnodeclass;
        cderefnode : tderefnodeclass;
        csubscriptnode : tsubscriptnodeclass;
        cvecnode : tvecnodeclass;
-       cselfnode : tselfnodeclass;
        cwithnode : twithnodeclass;
 
 implementation
@@ -156,118 +124,40 @@ implementation
       ;
 
 {*****************************************************************************
-                            TLOADVMTNODE
+                            TLOADVMTADDRNODE
 *****************************************************************************}
 
-    constructor tloadvmtnode.create(l : tnode);
+    constructor tloadvmtaddrnode.create(l : tnode);
       begin
-         inherited create(loadvmtn,l);
+         inherited create(loadvmtaddrn,l);
       end;
 
-    function tloadvmtnode.det_resulttype:tnode;
+
+    function tloadvmtaddrnode.det_resulttype:tnode;
       begin
         result:=nil;
         resulttypepass(left);
         if codegenerror then
          exit;
 
-        resulttype.setdef(tclassrefdef.create(left.resulttype));
-      end;
-
-    function tloadvmtnode.pass_1 : tnode;
-      begin
-         result:=nil;
-         registers32:=1;
-         expectloc:=LOC_REGISTER;
-      end;
-
-{*****************************************************************************
-                             THNEWNODE
-*****************************************************************************}
-
-    constructor thnewnode.create(t:ttype);
-      begin
-         inherited create(hnewn);
-         objtype:=t;
-      end;
-
-
-    constructor thnewnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        ppufile.gettype(objtype);
-      end;
-
-
-    procedure thnewnode.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.puttype(objtype);
-      end;
-
-
-    procedure thnewnode.derefimpl;
-      begin
-        inherited derefimpl;
-        objtype.resolve;
-      end;
-
-
-    function thnewnode.det_resulttype:tnode;
-      begin
-        result:=nil;
-        if objtype.def.deftype<>objectdef then
+        if left.resulttype.def.deftype<>objectdef then
           Message(parser_e_pointer_to_class_expected);
-        resulttype:=objtype;
-      end;
-
-
-    function thnewnode.pass_1 : tnode;
-      begin
-         result:=nil;
-         expectloc:=LOC_VOID;
-      end;
-
 
-{*****************************************************************************
-                            THDISPOSENODE
-*****************************************************************************}
-
-    constructor thdisposenode.create(l : tnode);
-      begin
-         inherited create(hdisposen,l);
-      end;
-
-
-    function thdisposenode.det_resulttype:tnode;
-      begin
-        result:=nil;
-        resulttypepass(left);
-        if codegenerror then
-         exit;
-        if (left.resulttype.def.deftype<>pointerdef) then
-          CGMessage1(type_e_pointer_type_expected,left.resulttype.def.typename);
-        resulttype:=tpointerdef(left.resulttype.def).pointertype;
+        resulttype.setdef(tclassrefdef.create(left.resulttype));
       end;
 
 
-    function thdisposenode.pass_1 : tnode;
+    function tloadvmtaddrnode.pass_1 : tnode;
       begin
          result:=nil;
-         firstpass(left);
-         if codegenerror then
-           exit;
-
-         registers32:=left.registers32;
-         registersfpu:=left.registersfpu;
-{$ifdef SUPPORT_MMX}
-         registersmmx:=left.registersmmx;
-{$endif SUPPORT_MMX}
+         expectloc:=LOC_REGISTER;
+         if left.nodetype<>typen then
+           begin
+             firstpass(left);
+             registers32:=left.registers32;
+           end;
          if registers32<1 then
            registers32:=1;
-         if left.expectloc=LOC_CREGISTER then
-           inc(registers32);
-         expectloc:=LOC_REFERENCE;
       end;
 
 
@@ -873,56 +763,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                               TSELFNODE
-*****************************************************************************}
-
-    constructor tselfnode.create(_class : tdef);
-
-      begin
-         inherited create(selfn);
-         classdef:=_class;
-      end;
-
-    constructor tselfnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        classdef:=tdef(ppufile.getderef);
-      end;
-
-
-    procedure tselfnode.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putderef(classdef);
-      end;
-
-
-    procedure tselfnode.derefimpl;
-      begin
-        inherited derefimpl;
-        resolvedef(pointer(classdef));
-      end;
-
-
-    function tselfnode.det_resulttype:tnode;
-      begin
-        result:=nil;
-        resulttype.setdef(classdef);
-      end;
-
-    function tselfnode.pass_1 : tnode;
-      begin
-         result:=nil;
-         if (resulttype.def.deftype=classrefdef) or
-            is_class(resulttype.def) or
-            (po_staticmethod in current_procdef.procoptions) then
-           expectloc:=LOC_REGISTER
-         else
-           expectloc:=LOC_CREFERENCE;
-      end;
-
-
 {*****************************************************************************
                                TWITHNODE
 *****************************************************************************}
@@ -1047,20 +887,21 @@ implementation
       end;
 
 begin
-  cloadvmtnode := tloadvmtnode;
-  chnewnode := thnewnode;
-  chdisposenode := thdisposenode;
+  cloadvmtaddrnode := tloadvmtaddrnode;
   caddrnode := taddrnode;
   cdoubleaddrnode := tdoubleaddrnode;
   cderefnode := tderefnode;
   csubscriptnode := tsubscriptnode;
   cvecnode := tvecnode;
-  cselfnode := tselfnode;
   cwithnode := twithnode;
 end.
 {
   $Log$
-  Revision 1.52  2003-05-05 14:53:16  peter
+  Revision 1.53  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.52  2003/05/05 14:53:16  peter
     * vs_hidden replaced by is_hidden boolean
 
   Revision 1.51  2003/04/27 11:21:33  peter

compiler/node.pas

@@ -81,15 +81,12 @@ interface
           vecn,             {Represents array indexing}
           pointerconstn,    {Represents a pointer constant}
           stringconstn,     {Represents a string constant}
-          selfn,            {Represents the self parameter}
           notn,             {Represents the not operator}
           inlinen,          {Internal procedures (i.e. writeln)}
           niln,             {Represents the nil pointer}
           errorn,           {This part of the tree could not be
                              parsed because of a compiler error}
           typen,            {A type name. Used for i.e. typeof(obj)}
-          hnewn,            {The new operation, constructor call}
-          hdisposen,        {The dispose operation with destructor call}
           setelementn,      {A set element(s) (i.e. [a,b] and also [a..b])}
           setconstn,        {A set constant (i.e. [1,2])}
           blockn,           {A block of statements}
@@ -121,7 +118,7 @@ interface
           tempdeleten,      { for temps in the result/firstpass }
           addoptn,          { added for optimizations where we cannot suppress }
           nothingn,         {NOP, Do nothing}
-          loadvmtn,         {Load the address of the VMT of a class/object}
+          loadvmtaddrn,         {Load the address of the VMT of a class/object}
           guidconstn,       {A GUID COM Interface constant }
           rttin             {Rtti information so they can be accessed in result/firstpass}
        );
@@ -165,14 +162,11 @@ interface
           'vecn',
           'pointerconstn',
           'stringconstn',
-          'selfn',
           'notn',
           'inlinen',
           'niln',
           'errorn',
           'typen',
-          'hnewn',
-          'hdisposen',
           'setelementn',
           'setconstn',
           'blockn',
@@ -204,13 +198,13 @@ interface
           'tempdeleten',
           'addoptn',
           'nothingn',
-          'loadvmtn',
+          'loadvmtaddrn',
           'guidconstn',
           'rttin');
 
     type
        { all boolean field of ttree are now collected in flags }
-       tnodeflags = (
+       tnodeflag = (
          nf_swapable,    { tbinop operands can be swaped }
          nf_swaped,      { tbinop operands are swaped    }
          nf_error,
@@ -223,7 +217,11 @@ interface
 
          { flags used by tcallnode }
          nf_return_value_used,
+         nf_inherited,
          nf_anon_inherited,
+         nf_new_call,
+         nf_dispose_call,
+         nf_member_call, { called with implicit methodpointer tree }
 
          { flags used by tcallparanode }
          nf_varargs_para,  { belongs this para to varargs }
@@ -265,12 +263,12 @@ interface
          nf_releasetemps
        );
 
-       tnodeflagset = set of tnodeflags;
+       tnodeflags = set of tnodeflag;
 
     const
        { contains the flags which must be equal for the equality }
        { of nodes                                                }
-       flagsequal : tnodeflagset = [nf_error];
+       flagsequal : tnodeflags = [nf_error];
 
     type
        tnodelist = class
@@ -291,7 +289,7 @@ interface
           { this field is set by concattolist  }
           parent : tnode;
           { there are some properties about the node stored }
-          flags : tnodeflagset;
+          flags : tnodeflags;
           { the number of registers needed to evalute the node }
           registers32,registersfpu : longint;  { must be longint !!!! }
 {$ifdef SUPPORT_MMX}
@@ -314,7 +312,7 @@ interface
           procedure derefimpl;virtual;
 
           { toggles the flag }
-          procedure toggleflag(f : tnodeflags);
+          procedure toggleflag(f : tnodeflag);
 
           { the 1.1 code generator may override pass_1 }
           { and it need not to implement det_* then    }
@@ -584,7 +582,7 @@ implementation
       end;
 
 
-    procedure tnode.toggleflag(f : tnodeflags);
+    procedure tnode.toggleflag(f : tnodeflag);
       begin
          if f in flags then
            exclude(flags,f)
@@ -630,7 +628,7 @@ implementation
           write(t,' ,resulttype = <nil>');
         writeln(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
                   ', loc = ',tcgloc2str[location.loc],
-                  ', inttgobj:  = ',registers32,
+                  ', intregs = ',registers32,
                   ', fpuregs = ',registersfpu);
       end;
 
@@ -990,7 +988,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  2003-04-25 20:59:33  peter
+  Revision 1.59  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.58  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/pass_2.pas

@@ -107,14 +107,11 @@ implementation
              'vecn',        {vecn}
              'pointerconst',{pointerconstn}
              'stringconst', {stringconstn}
-             'selfn',       {selfn}
              'not',         {notn}
              'inline',      {inlinen}
              'niln',        {niln}
              'error',       {errorn}
              'nothing-typen',     {typen}
-             'hnewn',       {hnewn}
-             'hdisposen',   {hdisposen}
              'setelement',  {setelementn}
              'setconst',    {setconstn}
              'blockn',      {blockn}
@@ -306,7 +303,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.49  2003-04-27 11:21:33  peter
+  Revision 1.50  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.49  2003/04/27 11:21:33  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/pdecobj.pas

@@ -230,7 +230,9 @@ implementation
            oldregisterdef:=registerdef;
            registerdef:=false;
            readprocdef:=tprocvardef.create(normal_function_level);
+           include(readprocdef.procoptions,po_methodpointer);
            writeprocdef:=tprocvardef.create(normal_function_level);
+           include(writeprocdef.procoptions,po_methodpointer);
            registerdef:=oldregisterdef;
 
            if token<>_ID then
@@ -278,8 +280,7 @@ implementation
                     varspez:=vs_value;
                   sc.reset;
                   repeat
-                    readvs:=tvarsym.create(orgpattern,generrortype);
-                    readvs.varspez:=varspez;
+                    readvs:=tvarsym.create(orgpattern,varspez,generrortype);
                     readprocdef.parast.insert(readvs);
                     sc.insert(readvs);
                     consume(_ID);
@@ -307,7 +308,7 @@ implementation
                    begin
                      readprocdef.concatpara(nil,tt,readvs,nil,false);
                      { also update the writeprocdef }
-                     hvs:=tvarsym.create(readvs.realname,generrortype);
+                     hvs:=tvarsym.create(readvs.realname,vs_value,generrortype);
                      writeprocdef.parast.insert(hvs);
                      writeprocdef.concatpara(nil,tt,hvs,nil,false);
                      readvs:=tvarsym(readvs.listnext);
@@ -344,10 +345,10 @@ implementation
                      p.indextype.setdef(pt.resulttype.def);
                      include(p.propoptions,ppo_indexed);
                      { concat a longint to the para templates }
-                     hvs:=tvarsym.create('$index',p.indextype);
+                     hvs:=tvarsym.create('$index',vs_value,p.indextype);
                      readprocdef.parast.insert(hvs);
                      readprocdef.concatpara(nil,p.indextype,hvs,nil,false);
-                     hvs:=tvarsym.create('$index',p.indextype);
+                     hvs:=tvarsym.create('$index',vs_value,p.indextype);
                      writeprocdef.parast.insert(hvs);
                      writeprocdef.concatpara(nil,p.indextype,hvs,nil,false);
                      pt.free;
@@ -422,7 +423,7 @@ implementation
                        { write is a procedure with an extra value parameter
                          of the of the property }
                        writeprocdef.rettype:=voidtype;
-                       hvs:=tvarsym.create('$value',p.proptype);
+                       hvs:=tvarsym.create('$value',vs_value,p.proptype);
                        writeprocdef.parast.insert(hvs);
                        writeprocdef.concatpara(nil,p.proptype,hvs,nil,false);
                        { Insert hidden parameters }
@@ -557,7 +558,7 @@ implementation
            if (cs_constructor_name in aktglobalswitches) and
               (pd.procsym.name<>'DONE') then
              Message(parser_e_destructorname_must_be_done);
-           if not(pd.Para.empty) and
+           if not(pd.maxparacount=0) and
               (m_fpc in aktmodeswitches) then
              Message(parser_e_no_paras_for_destructor);
            consume(_SEMICOLON);
@@ -1145,7 +1146,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.64  2003-05-05 14:53:16  peter
+  Revision 1.65  2003-05-09 17:47:02  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.64  2003/05/05 14:53:16  peter
     * vs_hidden replaced by is_hidden boolean
 
   Revision 1.63  2003/04/27 11:21:33  peter

compiler/pdecsub.pas

@@ -109,66 +109,94 @@ implementation
             akttokenpos:=tprocdef(pd).fileinfo;
 
            { Generate result variable accessing function result }
-           vs:=tvarsym.create('$result',pd.rettype);
+           vs:=tvarsym.create('$result',vs_var,pd.rettype);
            include(vs.varoptions,vo_is_funcret);
+           pd.parast.insert(vs);
+           pd.insertpara(vs.vartype,vs,nil,true);
            { Store the this symbol as funcretsym for procedures }
            if pd.deftype=procdef then
             tprocdef(pd).funcretsym:=vs;
 
-           { Handle like a var parameter }
-           vs.varspez:=vs_var;
-           pd.parast.insert(vs);
-           { Also insert a hidden parameter as first }
-           pd.insertpara(vs.vartype,vs,nil,true);
-
            akttokenpos:=storepos;
          end;
       end;
 
+
     procedure insert_self_and_vmt_para(pd:tabstractprocdef);
       var
         storepos : tfileposinfo;
         vs       : tvarsym;
         tt       : ttype;
+        vsp      : tvarspez;
       begin
         if (pd.deftype=procvardef) and
-          pd.is_methodpointer then
+           pd.is_methodpointer then
           begin
-             internalerror(200304301);
+            if not(po_containsself in pd.procoptions) then
+             begin
+               { Generate self variable }
+               tt:=voidpointertype;
+               vs:=tvarsym.create('$self',vs_value,tt);
+               include(vs.varoptions,vo_is_self);
+               { Insert as hidden parameter }
+               pd.parast.insert(vs);
+               pd.insertpara(vs.vartype,vs,nil,true);
+             end;
           end
         else
           begin
-             if (pd is tprocdef) and
-               assigned(tprocdef(pd)._class) then
+             if (pd.deftype=procdef) and
+                assigned(tprocdef(pd)._class) and
+                (pd.parast.symtablelevel=normal_function_level) then
               begin
                 storepos:=akttokenpos;
-                if pd.deftype=procdef then
-                 akttokenpos:=tprocdef(pd).fileinfo;
-
-                { Generate result variable accessing function result }
-                tt.setdef(tprocdef(pd)._class);
-                { for unknwon reasons this doesn't work:
-                tt.setdef(tprocdef(pd)._class.typedef);
-                }
-                vs:=tvarsym.create('$self',tt);
-                include(vs.varoptions,vo_is_funcret);
-                { Store the this symbol as funcretsym for procedures }
-                if pd.deftype=procdef then
-                 tprocdef(pd).funcretsym:=vs;
-
-                { Handle self of objects like a var parameter }
-                if is_object(tprocdef(pd)._class) then
-                  vs.varspez:=vs_var;
-
-                pd.parast.insert(vs);
-                { Also insert a hidden parameter as first }
-                pd.insertpara(vs.vartype,vs,nil,true);
+                akttokenpos:=tprocdef(pd).fileinfo;
+
+                { Generate VMT variable for constructor/destructor }
+                if pd.proctypeoption in [potype_constructor,potype_destructor] then
+                 begin
+                   { can't use classrefdef as type because inheriting
+                     will then always file because of a type mismatch }
+                   tt:=voidpointertype;
+                   vs:=tvarsym.create('$vmt',vs_value,tt);
+                   include(vs.varoptions,vo_is_vmt);
+                   { Insert as hidden parameter }
+                   pd.parast.insert(vs);
+                   pd.insertpara(vs.vartype,vs,nil,true);
+                 end;
+
+                { Generate self variable, for classes we need
+                  to use the generic voidpointer to be compatible with
+                  methodpointers.
+                  Only needed when there is no explicit self para }
+                if not(po_containsself in pd.procoptions) then
+                 begin
+                   vsp:=vs_value;
+                   if (po_staticmethod in pd.procoptions) or
+                      (po_classmethod in pd.procoptions) then
+                     begin
+                       tt.setdef(tprocdef(pd)._class);
+                       tt.setdef(tclassrefdef.create(tt));
+                     end
+                   else
+                     begin
+                       if is_object(tprocdef(pd)._class) then
+                         vsp:=vs_var;
+                       tt.setdef(tprocdef(pd)._class);
+                     end;
+                   vs:=tvarsym.create('$self',vsp,tt);
+                   include(vs.varoptions,vo_is_self);
+                   { Insert as hidden parameter }
+                   pd.parast.insert(vs);
+                   pd.insertpara(vs.vartype,vs,nil,true);
+                 end;
 
                 akttokenpos:=storepos;
               end;
           end;
       end;
 
+
     procedure insert_funcret_local(pd:tprocdef);
       var
         storepos : tfileposinfo;
@@ -187,7 +215,7 @@ implementation
              when it is returning in a register }
            if not paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
             begin
-              vs:=tvarsym.create('$result',pd.rettype);
+              vs:=tvarsym.create('$result',vs_value,pd.rettype);
               include(vs.varoptions,vo_is_funcret);
               pd.localst.insert(vs);
               pd.localst.insertvardata(vs);
@@ -232,8 +260,7 @@ implementation
             begin
               if assigned(currpara.parasym) then
                begin
-                 hvs:=tvarsym.create('$high'+tvarsym(currpara.parasym).name,s32bittype);
-                 hvs.varspez:=vs_const;
+                 hvs:=tvarsym.create('$high'+tvarsym(currpara.parasym).name,vs_const,s32bittype);
                  include(hvs.varoptions,vo_is_high_value);
                  tvarsym(currpara.parasym).owner.insert(hvs);
                  tvarsym(currpara.parasym).highvarsym:=hvs;
@@ -313,6 +340,7 @@ implementation
     procedure check_self_para(pd:tabstractprocdef);
       var
         hpara : tparaitem;
+        vs : tvarsym;
       begin
         hpara:=pd.selfpara;
         if assigned(hpara) and
@@ -331,6 +359,10 @@ implementation
               if compare_defs(hpara.paratype.def,tprocdef(pd)._class,nothingn)=te_incompatible then
                 CGMessage2(type_e_incompatible_types,hpara.paratype.def.typename,tprocdef(pd)._class.typename);
             end;
+           { add an alias for $self which is for internal use }
+           vs:=tabsolutesym.create_ref('$self',hpara.paratype,tstoredsym(hpara.parasym));
+           include(vs.varoptions,vo_is_self);
+           pd.parast.insert(vs);
          end;
       end;
 
@@ -389,7 +421,7 @@ implementation
           { read identifiers and insert with error type }
           sc.reset;
           repeat
-            vs:=tvarsym.create(orgpattern,generrortype);
+            vs:=tvarsym.create(orgpattern,varspez,generrortype);
             currparast.insert(vs);
             if assigned(vs.owner) then
              sc.insert(vs)
@@ -484,7 +516,6 @@ implementation
            begin
              { update varsym }
              vs.vartype:=tt;
-             vs.varspez:=varspez;
              { For proc vars we only need the definitions }
              if not is_procvar then
               begin
@@ -501,8 +532,9 @@ implementation
         until not try_to_consume(_SEMICOLON);
         { remove parasymtable from stack }
         sc.free;
-        { check for a self parameter, only for normal procedures. For
-          procvars we need to wait until the 'of object' is parsed }
+        { check for a self parameter which is needed to allow message
+          directive, only for normal procedures. For procvars we need
+          to wait until the 'of object' is parsed }
         if not is_procvar then
           check_self_para(pd);
         { reset object options }
@@ -1775,9 +1807,7 @@ const
         { insert hidden high parameters }
         insert_hidden_para(pd);
         { insert hidden self parameter }
-{$ifdef vs_hidden_self}
         insert_self_and_vmt_para(pd);
-{$endif vs_hidden_self}
         { insert funcret parameter if required }
         insert_funcret_para(pd);
 
@@ -2170,7 +2200,11 @@ const
 end.
 {
   $Log$
-  Revision 1.121  2003-05-05 14:53:16  peter
+  Revision 1.122  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.121  2003/05/05 14:53:16  peter
     * vs_hidden replaced by is_hidden boolean
 
   Revision 1.120  2003/04/30 09:42:42  florian

compiler/pdecvar.pas

@@ -87,7 +87,7 @@ implementation
                 if (symtablestack.symtabletype=objectsymtable) and
                    (sp_static in current_object_option) then
                   begin
-                     vs2:=tvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,tt);
+                     vs2:=tvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,vs_value,tt);
                      symtablestack.defowner.owner.insert(vs2);
                      symtablestack.defowner.owner.insertvardata(vs2);
                   end
@@ -151,7 +151,7 @@ implementation
              sorg:=orgpattern;
              sc.reset;
              repeat
-               vs:=tvarsym.create(orgpattern,generrortype);
+               vs:=tvarsym.create(orgpattern,vs_value,generrortype);
                symtablestack.insert(vs);
                if assigned(vs.owner) then
                 sc.insert(vs)
@@ -507,7 +507,7 @@ implementation
                   symtablestack:=symtablestack.next;
                   read_type(casetype,'');
                   symtablestack:=oldsymtablestack;
-                  vs:=tvarsym.create(sorg,casetype);
+                  vs:=tvarsym.create(sorg,vs_value,casetype);
                   symtablestack.insert(vs);
                   symtablestack.insertvardata(vs);
                 end;
@@ -560,7 +560,7 @@ implementation
               symtablestack.dataalignment:=maxalignment;
               uniontype.def:=uniondef;
               uniontype.sym:=nil;
-              UnionSym:=tvarsym.create('case',uniontype);
+              UnionSym:=tvarsym.create('$case',vs_value,uniontype);
               symtablestack:=symtablestack.next;
               { we do NOT call symtablestack.insert
                on purpose PM }
@@ -602,7 +602,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.46  2003-04-25 20:59:33  peter
+  Revision 1.47  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.46  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/pexpr.pas

@@ -46,7 +46,7 @@ interface
     function parse_paras(__colon,in_prop_paras : boolean) : tnode;
 
     { the ID token has to be consumed before calling this function }
-    procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean);
+    procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callnflags:tnodeflags);
 
 {$ifdef int64funcresok}
     function get_intconst:TConstExprInt;
@@ -239,8 +239,7 @@ implementation
                      (p.resulttype.def.deftype=procvardef) and
                      (tprocvardef(p.resulttype.def).minparacount=0) then
                     begin
-                       p1:=ccallnode.create(nil,nil,nil,nil);
-                       tcallnode(p1).set_procvar(p);
+                       p1:=ccallnode.create_procvar(nil,p);
                        resulttypepass(p1);
                        p:=p1;
                     end;
@@ -315,13 +314,11 @@ implementation
               consume(_RKLAMMER);
               if p1.nodetype=typen then
                 ttypenode(p1).allowed:=true;
-              if (p1.resulttype.def.deftype = objectdef) or
-                 ((p1.resulttype.def.deftype = classrefdef) and
-                  (p1.nodetype in [selfn,loadvmtn])) then
+              if (p1.resulttype.def.deftype = objectdef) then
                statement_syssym:=geninlinenode(in_typeof_x,false,p1)
               else
                begin
-                 Message(type_e_mismatch);
+                 Message(parser_e_class_id_expected);
                  p1.destroy;
                  statement_syssym:=cerrornode.create;
                end;
@@ -634,19 +631,49 @@ implementation
       end;
 
 
+    function maybe_load_methodpointer(st:tsymtable;var p1:tnode):boolean;
+      begin
+        maybe_load_methodpointer:=false;
+        if not assigned(p1) then
+         begin
+           case st.symtabletype of
+             withsymtable :
+               begin
+                 if (st.defowner.deftype=objectdef) then
+                  begin
+                    p1:=tnode(twithsymtable(st).withrefnode).getcopy;
+                    maybe_load_methodpointer:=true;
+                  end;
+               end;
+             objectsymtable :
+               begin
+                 p1:=load_self;
+                 maybe_load_methodpointer:=true;
+               end;
+           end;
+         end;
+      end;
+
+
     { reads the parameter for a subroutine call }
     procedure do_proc_call(sym:tsym;st:tsymtable;getaddr:boolean;var again : boolean;var p1:tnode);
       var
+         membercall,
          prevafterassn : boolean;
-         hs,hs1 : tvarsym;
+         vs : tvarsym;
          para,p2 : tnode;
-         hst : tsymtable;
+         currpara : tparaitem;
          aprocdef : tprocdef;
       begin
          prevafterassn:=afterassignment;
          afterassignment:=false;
+         membercall:=false;
          aprocdef:=nil;
 
+         { when it is a call to a member we need to load the
+           methodpointer first }
+         membercall:=maybe_load_methodpointer(st,p1);
+
          { When we are expecting a procvar we also need
            to get the address in some cases }
          if assigned(getprocvardef) then
@@ -666,34 +693,50 @@ implementation
               end;
           end;
 
-         { want we only determine the address of }
-         { a subroutine ?                       }
-         if not(getaddr) then
+         { only need to get the address of the procedure? }
+         if getaddr then
+           begin
+             { Retrieve info which procvar to call. For tp_procvar the
+               aprocdef is already loaded above so we can reuse it }
+             if not assigned(aprocdef) and
+                assigned(getprocvardef) then
+               aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
+
+             { generate a methodcallnode or proccallnode }
+             { we shouldn't convert things like @tcollection.load }
+             p2:=cloadnode.create_procvar(sym,aprocdef,st);
+             if assigned(p1) then
+              begin
+                if (p1.nodetype<>typen) then
+                  tloadnode(p2).set_mp(p1)
+                else
+                  p1.free;
+              end;
+             p1:=p2;
+
+             { no postfix operators }
+             again:=false;
+           end
+         else
            begin
              para:=nil;
              if anon_inherited then
               begin
-                hst:=symtablestack;
-                while assigned(hst) and (hst.symtabletype<>parasymtable) do
-                 hst:=hst.next;
-                if assigned(hst) then
+                if not assigned(current_procdef) then
+                  internalerror(200305054);
+                currpara:=tparaitem(current_procdef.para.first);
+                while assigned(currpara) do
                  begin
-                   hs:=tvarsym(hst.symindex.first);
-                   while assigned(hs) do
+                   if not currpara.is_hidden then
                     begin
-                      if hs.typ<>varsym then
-                       internalerror(54382953);
+                      vs:=tvarsym(currpara.parasym);
                       { if there is a localcopy then use that }
-                      if assigned(hs.localvarsym) then
-                       hs1:=hs.localvarsym
-                      else
-                       hs1:=hs;
-                      para:=ccallparanode.create(cloadnode.create(hs1,hs1.owner),para);
-                      hs:=tvarsym(hs.indexnext);
+                      if assigned(vs.localvarsym) then
+                        vs:=vs.localvarsym;
+                      para:=ccallparanode.create(cloadnode.create(vs,vs.owner),para);
                     end;
-                 end
-                else
-                 internalerror(54382954);
+                   currpara:=tparaitem(currpara.next);
+                 end;
               end
              else
               begin
@@ -704,47 +747,11 @@ implementation
                  end;
               end;
              p1:=ccallnode.create(para,tprocsym(sym),st,p1);
-           end
-        else
-           begin
-              { address operator @: }
-              if not assigned(p1) then
-               begin
-                 case st.symtabletype of
-                   withsymtable :
-                     begin
-                       if (st.defowner.deftype=objectdef) then
-                         p1:=tnode(twithsymtable(st).withrefnode).getcopy;
-                     end;
-                   objectsymtable :
-                     begin
-                       { we must provide a method pointer, if it isn't given, }
-                       { it is self                                           }
-                       p1:=cselfnode.create(tobjectdef(st.defowner));
-                     end;
-                 end;
-               end;
-
-               { Retrieve info which procvar to call. For tp_procvar the
-                 aprocdef is already loaded above so we can reuse it }
-              if not assigned(aprocdef) and
-                 assigned(getprocvardef) then
-                aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
-
-              { generate a methodcallnode or proccallnode }
-              { we shouldn't convert things like @tcollection.load }
-              p2:=cloadnode.create_procvar(sym,aprocdef,st);
-              if assigned(p1) then
-               begin
-                 if (p1.nodetype<>typen) then
-                   tloadnode(p2).set_mp(p1)
-                 else
-                   p1.free;
-               end;
-              p1:=p2;
-
-              { no postfix operators }
-              again:=false;
+             { indicate if this call was generated by a member and
+               no explicit self is used, this is needed to determine
+               how to handle a destructor call (PFV) }
+             if membercall then
+               include(p1.flags,nf_member_call);
            end;
          afterassignment:=prevafterassn;
       end;
@@ -825,6 +832,7 @@ implementation
       var
          paras : tnode;
          p2    : tnode;
+         membercall : boolean;
       begin
          paras:=nil;
          { property parameters? read them only if the property really }
@@ -855,8 +863,11 @@ implementation
                      procsym :
                        begin
                          { generate the method call }
+                         membercall:=maybe_load_methodpointer(st,p1);
                          p1:=ccallnode.create(paras,
                                               tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1);
+                         if membercall then
+                           include(tcallnode(p1).flags,nf_member_call);
                          paras:=nil;
                          consume(_ASSIGNMENT);
                          { read the expression }
@@ -905,7 +916,10 @@ implementation
                      procsym :
                        begin
                           { generate the method call }
+                          membercall:=maybe_load_methodpointer(st,p1);
                           p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1);
+                          if membercall then
+                            include(tcallnode(p1).flags,nf_member_call);
                           paras:=nil;
                           include(p1.flags,nf_isproperty);
                        end
@@ -930,7 +944,7 @@ implementation
 
 
     { the ID token has to be consumed before calling this function }
-    procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean);
+    procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callnflags:tnodeflags);
 
       var
          static_name : string;
@@ -967,6 +981,9 @@ implementation
                       do_proc_call(sym,sym.owner,
                                    (getaddr and not(token in [_CARET,_POINT])),
                                    again,p1);
+                      { add provided flags }
+                      if (p1.nodetype=calln) then
+                        p1.flags:=p1.flags+callnflags;
                       { we need to know which procedure is called }
                       do_resulttypepass(p1);
                       { now we know the real method e.g. we can check for a class method }
@@ -1135,7 +1152,7 @@ implementation
                                  srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
                                  check_hints(srsym);
                                  consume(_ID);
-                                 do_member_read(false,srsym,p1,again);
+                                 do_member_read(false,srsym,p1,again,[]);
                                end
                               else
                                begin
@@ -1159,7 +1176,7 @@ implementation
                               else
                                begin
                                  consume(_ID);
-                                 do_member_read(getaddr,srsym,p1,again);
+                                 do_member_read(getaddr,srsym,p1,again,[]);
                                end;
                             end;
                          end
@@ -1183,7 +1200,7 @@ implementation
                                 else
                                  begin
                                    consume(_ID);
-                                   do_member_read(getaddr,srsym,p1,again);
+                                   do_member_read(getaddr,srsym,p1,again,[]);
                                  end;
                               end
                              else
@@ -1193,7 +1210,7 @@ implementation
                                   the type. For all other blocks we return
                                   a loadvmt node }
                                 if (block_type<>bt_type) then
-                                 p1:=cloadvmtnode.create(p1);
+                                 p1:=cloadvmtaddrnode.create(p1);
                               end;
                            end
                           else
@@ -1579,7 +1596,7 @@ implementation
                              else
                               begin
                                 consume(_ID);
-                                do_member_read(getaddr,hsym,p1,again);
+                                do_member_read(getaddr,hsym,p1,again,[]);
                               end;
                            end;
 
@@ -1602,7 +1619,7 @@ implementation
                               else
                                 begin
                                    consume(_ID);
-                                   do_member_read(getaddr,hsym,p1,again);
+                                   do_member_read(getaddr,hsym,p1,again,[]);
                                 end;
                            end;
 
@@ -1635,25 +1652,24 @@ implementation
                            again:=false
                          else
                            if (token=_LKLAMMER) or
-                              ((tprocvardef(p1.resulttype.def).para.empty) and
+                              ((tprocvardef(p1.resulttype.def).maxparacount=0) and
                                (not((token in [_ASSIGNMENT,_UNEQUAL,_EQUAL]))) and
                                (not afterassignment) and
                                (not in_args)) then
                              begin
-                                { do this in a strange way  }
-                                { it's not a clean solution }
-                                p2:=p1;
-                                p1:=ccallnode.create(nil,nil,nil,nil);
-                                tcallnode(p1).set_procvar(p2);
                                 if try_to_consume(_LKLAMMER) then
                                   begin
-                                     tcallnode(p1).left:=parse_paras(false,false);
+                                     p2:=parse_paras(false,false);
                                      consume(_RKLAMMER);
-                                  end;
+                                  end
+                                else
+                                  p2:=nil;
+                                p1:=ccallnode.create_procvar(p2,p1);
                                 { proc():= is never possible }
                                 if token=_ASSIGNMENT then
                                  begin
                                    Message(cg_e_illegal_expression);
+                                   p1.free;
                                    p1:=cerrornode.create;
                                    again:=false;
                                  end;
@@ -1738,14 +1754,7 @@ implementation
                 end
                else
                 begin
-                  if (po_classmethod in current_procdef.procoptions) then
-                   begin
-                     { self in class methods is a class reference type }
-                     htype.setdef(current_procdef._class);
-                     p1:=cselfnode.create(tclassrefdef.create(htype));
-                   end
-                  else
-                   p1:=cselfnode.create(current_procdef._class);
+                  p1:=load_self;
                   postfixoperators(p1,again);
                 end;
              end;
@@ -1784,15 +1793,14 @@ implementation
                   if assigned(sym) then
                    begin
                      check_hints(sym);
+                     { load the procdef from the inherited class and
+                       not from self }
                      if sym.typ=procsym then
                       begin
                         htype.setdef(classh);
                         p1:=ctypenode.create(htype);
                       end;
-                     do_member_read(false,sym,p1,again);
-                     { Add flag to indicate that inherited is used }
-                     if p1.nodetype=calln then
-                       include(p1.flags,nf_anon_inherited);
+                     do_member_read(false,sym,p1,again,[nf_inherited,nf_anon_inherited]);
                    end
                   else
                    begin
@@ -2314,7 +2322,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.114  2003-05-01 07:59:42  florian
+  Revision 1.115  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.114  2003/05/01 07:59:42  florian
     * introduced defaultordconsttype to decribe the default size of ordinal constants
       on 64 bit CPUs it's equal to cs64bitdef while on 32 bit CPUs it's equal to s32bitdef
     + added defines CPU32 and CPU64 for 32 bit and 64 bit CPUs

compiler/pinline.pas

@@ -74,6 +74,7 @@ implementation
         destructorname : stringid;
         sym      : tsym;
         classh   : tobjectdef;
+        callflag : tnodeflag;
         destructorpos,
         storepos : tfileposinfo;
       begin
@@ -140,20 +141,25 @@ implementation
               end
             else
               begin
+                p2:=cderefnode.create(p.getcopy);
+                do_resulttypepass(p2);
                 if is_new then
-                 p2:=chnewnode.create(tpointerdef(p.resulttype.def).pointertype)
+                  callflag:=nf_new_call
                 else
-                 p2:=chdisposenode.create(p);
-                do_resulttypepass(p2);
+                  callflag:=nf_dispose_call;
                 if is_new then
-                  do_member_read(false,sym,p2,again)
+                  do_member_read(false,sym,p2,again,[callflag])
                 else
                   begin
                     if not(m_fpc in aktmodeswitches) then
-                      do_member_read(false,sym,p2,again)
+                      do_member_read(false,sym,p2,again,[callflag])
                     else
                       begin
                         p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2);
+                        if is_new then
+                          include(p2.flags,nf_new_call)
+                        else
+                          include(p2.flags,nf_dispose_call);
                         { support dispose(p,done()); }
                         if try_to_consume(_LKLAMMER) then
                           begin
@@ -168,7 +174,6 @@ implementation
                   end;
 
                 { we need the real called method }
-                { rg.cleartempgen;}
                 do_resulttypepass(p2);
 
                 if p2.nodetype<>calln then
@@ -221,7 +226,7 @@ implementation
 
                   { create statements with call to getmem+initialize or
                     finalize+freemem }
-                  new_dispose_statement:=internalstatements(newstatement);
+                  new_dispose_statement:=internalstatements(newstatement,true);
 
                   if is_new then
                    begin
@@ -292,22 +297,31 @@ implementation
         if p1.nodetype<>typen then
          begin
            Message(type_e_type_id_expected);
+           consume_all_until(_RKLAMMER);
+           consume(_RKLAMMER);
            p1.destroy;
-           p1:=cerrornode.create;
-           do_resulttypepass(p1);
+           new_function:=cerrornode.create;
+           exit;
          end;
 
         if (p1.resulttype.def.deftype<>pointerdef) then
-          Message1(type_e_pointer_type_expected,p1.resulttype.def.typename)
-        else
-         if token=_RKLAMMER then
+         begin
+           Message1(type_e_pointer_type_expected,p1.resulttype.def.typename);
+           consume_all_until(_RKLAMMER);
+           consume(_RKLAMMER);
+           p1.destroy;
+           new_function:=cerrornode.create;
+           exit;
+         end;
+
+        if try_to_consume(_RKLAMMER) then
           begin
             if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=objectdef) and
                (oo_has_vmt in tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def).objectoptions)  then
               Message(parser_w_use_extended_syntax_for_objects);
 
             { create statements with call to getmem+initialize }
-            newblock:=internalstatements(newstatement);
+            newblock:=internalstatements(newstatement,true);
 
             { create temp for result }
             temp := ctempcreatenode.create(p1.resulttype,p1.resulttype.def.size,true);
@@ -339,40 +353,45 @@ implementation
 
             p1.destroy;
             p1:=newblock;
-            consume(_RKLAMMER);
           end
         else
           begin
-            p2:=chnewnode.create(tpointerdef(p1.resulttype.def).pointertype);
-            do_resulttypepass(p2);
             consume(_COMMA);
-            afterassignment:=false;
-            { determines the current object defintion }
-            classh:=tobjectdef(p2.resulttype.def);
-            if classh.deftype=objectdef then
+            if tpointerdef(p1.resulttype.def).pointertype.def.deftype<>objectdef then
              begin
-               { check for an abstract class }
-               if (oo_has_abstract in classh.objectoptions) then
-                Message(sym_e_no_instance_of_abstract_object);
-               { search the constructor also in the symbol tables of
-                 the parents }
-               sym:=searchsym_in_class(classh,pattern);
-               consume(_ID);
-               do_member_read(false,sym,p2,again);
-               { we need to know which procedure is called }
-               do_resulttypepass(p2);
-               if (p2.nodetype<>calln) or
-                  (assigned(tcallnode(p2).procdefinition) and
-                   (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor)) then
-                Message(parser_e_expr_have_to_be_constructor_call);
-             end
-            else
-             Message(parser_e_pointer_to_class_expected);
+               Message(parser_e_pointer_to_class_expected);
+               consume_all_until(_RKLAMMER);
+               consume(_RKLAMMER);
+               p1.destroy;
+               new_function:=cerrornode.create;
+               exit;
+             end;
+            classh:=tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def);
+            { check for an abstract class }
+            if (oo_has_abstract in classh.objectoptions) then
+              Message(sym_e_no_instance_of_abstract_object);
+            { use the objectdef for loading the VMT }
+            p2:=p1;
+            p1:=ctypenode.create(tpointerdef(p1.resulttype.def).pointertype);
+            do_resulttypepass(p1);
+            { search the constructor also in the symbol tables of
+              the parents }
+            afterassignment:=false;
+            sym:=searchsym_in_class(classh,pattern);
+            consume(_ID);
+            do_member_read(false,sym,p1,again,[nf_new_call]);
+            { we need to know which procedure is called }
+            do_resulttypepass(p1);
+            if not(
+                   (p1.nodetype=calln) and
+                   assigned(tcallnode(p1).procdefinition) and
+                   (tcallnode(p1).procdefinition.proctypeoption=potype_constructor)
+                  ) then
+              Message(parser_e_expr_have_to_be_constructor_call);
             { constructors return boolean, update resulttype to return
               the pointer to the object }
-            p2.resulttype:=p1.resulttype;
-            p1.destroy;
-            p1:=p2;
+            p1.resulttype:=p2.resulttype;
+            p2.free;
             consume(_RKLAMMER);
           end;
         new_function:=p1;
@@ -465,7 +484,7 @@ implementation
          begin
             { create statements with call initialize the arguments and
               call fpc_dynarr_setlength }
-            newblock:=internalstatements(newstatement);
+            newblock:=internalstatements(newstatement,true);
 
             { get temp for array of lengths }
             temp := ctempcreatenode.create(s32bittype,counter*s32bittype.def.size,true);
@@ -627,7 +646,7 @@ implementation
              end;
 
             { create statements with call }
-            copynode:=internalstatements(newstatement);
+            copynode:=internalstatements(newstatement,true);
 
             if (counter=3) then
              begin
@@ -680,7 +699,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  2002-11-26 22:59:09  peter
+  Revision 1.13  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.12  2002/04/25 20:15:40  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.11  2002/11/26 22:59:09  peter
     * fix Copy(array,x,y)
 
   Revision 1.10  2002/11/25 17:43:22  peter

compiler/pstatmnt.pas

@@ -597,11 +597,11 @@ implementation
                                   is_class(ttypesym(srsym).restype.def) then
                                  begin
                                     ot:=ttypesym(srsym).restype;
-                                    sym:=tvarsym.create(objrealname,ot);
+                                    sym:=tvarsym.create(objrealname,vs_value,ot);
                                  end
                                else
                                  begin
-                                    sym:=tvarsym.create(objrealname,generrortype);
+                                    sym:=tvarsym.create(objrealname,vs_value,generrortype);
                                     if (srsym.typ=typesym) then
                                       Message1(type_e_class_type_expected,ttypesym(srsym).restype.def.typename)
                                     else
@@ -1131,7 +1131,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.95  2003-04-30 22:15:59  florian
+  Revision 1.96  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.95  2003/04/30 22:15:59  florian
     * some 64 bit adaptions in ncgadd
     * x86-64 now uses ncgadd
     * tparamanager.ret_in_acc doesn't return true anymore for a void-def

compiler/psub.pas

@@ -542,9 +542,8 @@ implementation
            if copy(name,1,3)='val' then
             begin
               pd:=tprocdef(owner.defowner);
-              vs:=tvarsym.create(Copy(name,4,255),vartype);
+              vs:=tvarsym.create(Copy(name,4,255),varspez,vartype);
               vs.fileinfo:=fileinfo;
-              vs.varspez:=varspez;
               if not assigned(pd.localst) then
                 pd.insert_localst;
               pd.localst.insert(vs);
@@ -843,7 +842,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.107  2003-04-27 11:21:34  peter
+  Revision 1.108  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.107  2003/04/27 11:21:34  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/psystem.pas

@@ -198,12 +198,12 @@ implementation
         vmtsymtable:=trecordsymtable.create;
         vmttype.setdef(trecorddef.create(vmtsymtable));
         pvmttype.setdef(tpointerdef.create(vmttype));
-        vmtsymtable.insert(tvarsym.create('$parent',pvmttype));
-        vmtsymtable.insert(tvarsym.create('$length',s32bittype));
-        vmtsymtable.insert(tvarsym.create('$mlength',s32bittype));
+        vmtsymtable.insert(tvarsym.create('$parent',vs_value,pvmttype));
+        vmtsymtable.insert(tvarsym.create('$length',vs_value,s32bittype));
+        vmtsymtable.insert(tvarsym.create('$mlength',vs_value,s32bittype));
         vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
         tarraydef(vmtarraytype.def).setelementtype(voidpointertype);
-        vmtsymtable.insert(tvarsym.create('$__pfn',vmtarraytype));
+        vmtsymtable.insert(tvarsym.create('$__pfn',vs_value,vmtarraytype));
         addtype('$__vtbl_ptr_type',vmttype);
         addtype('$pvmt',pvmttype);
         vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
@@ -389,14 +389,11 @@ implementation
         nodeclass[vecn]:=cvecnode;
         nodeclass[pointerconstn]:=cpointerconstnode;
         nodeclass[stringconstn]:=cstringconstnode;
-        nodeclass[selfn]:=cselfnode;
         nodeclass[notn]:=cnotnode;
         nodeclass[inlinen]:=cinlinenode;
         nodeclass[niln]:=cnilnode;
         nodeclass[errorn]:=cerrornode;
         nodeclass[typen]:=ctypenode;
-        nodeclass[hnewn]:=chnewnode;
-        nodeclass[hdisposen]:=chdisposenode;
         nodeclass[setelementn]:=csetelementnode;
         nodeclass[setconstn]:=csetconstnode;
         nodeclass[blockn]:=cblocknode;
@@ -428,7 +425,7 @@ implementation
         nodeclass[tempdeleten]:=ctempdeletenode;
         nodeclass[addoptn]:=caddnode;
         nodeclass[nothingn]:=cnothingnode;
-        nodeclass[loadvmtn]:=cloadvmtnode;
+        nodeclass[loadvmtaddrn]:=cloadvmtaddrnode;
         nodeclass[guidconstn]:=cguidconstnode;
         nodeclass[rttin]:=crttinode;
       end;
@@ -491,7 +488,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.48  2003-05-01 07:59:42  florian
+  Revision 1.49  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.48  2003/05/01 07:59:42  florian
     * introduced defaultordconsttype to decribe the default size of ordinal constants
       on 64 bit CPUs it's equal to cs64bitdef while on 32 bit CPUs it's equal to s32bitdef
     + added defines CPU32 and CPU64 for 32 bit and 64 bit CPUs

compiler/ptconst.pas

@@ -237,7 +237,7 @@ implementation
            begin
               p:=comp_expr(true);
               case p.nodetype of
-                 loadvmtn:
+                 loadvmtaddrn:
                    begin
                       if not(tobjectdef(tclassrefdef(p.resulttype.def).pointertype.def).is_related(
                         tobjectdef(tclassrefdef(t.def).pointertype.def))) then
@@ -1004,7 +1004,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.68  2003-04-30 20:53:32  florian
+  Revision 1.69  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.68  2003/04/30 20:53:32  florian
     * error when address of an abstract method is taken
     * fixed some x86-64 problems
     * merged some more x86-64 and i386 code

compiler/ptype.pas

@@ -455,6 +455,7 @@ implementation
       var
         p  : tnode;
         pd : tabstractprocdef;
+        is_func,
         enumdupmsg : boolean;
       begin
          tt.reset;
@@ -593,33 +594,25 @@ implementation
               begin
                 tt.setdef(object_dec(name,nil));
               end;
-            _PROCEDURE:
-              begin
-                consume(_PROCEDURE);
-                tt.setdef(tprocvardef.create(normal_function_level));
-                if token=_LKLAMMER then
-                  parse_parameter_dec(tprocvardef(tt.def));
-                if token=_OF then
-                  begin
-                    consume(_OF);
-                    consume(_OBJECT);
-                    include(tprocvardef(tt.def).procoptions,po_methodpointer);
-                    check_self_para(tprocvardef(tt.def));
-                  end;
-              end;
+            _PROCEDURE,
             _FUNCTION:
               begin
-                consume(_FUNCTION);
+                is_func:=(token=_FUNCTION);
+                consume(token);
                 pd:=tprocvardef.create(normal_function_level);
                 if token=_LKLAMMER then
                   parse_parameter_dec(pd);
-                consume(_COLON);
-                single_type(pd.rettype,hs,false);
+                if is_func then
+                 begin
+                   consume(_COLON);
+                   single_type(pd.rettype,hs,false);
+                 end;
                 if token=_OF then
                   begin
                     consume(_OF);
                     consume(_OBJECT);
                     include(pd.procoptions,po_methodpointer);
+                    check_self_para(pd);
                   end;
                 { Add implicit hidden parameters and function result }
                 calc_parast(pd);
@@ -635,7 +628,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2003-04-27 11:21:34  peter
+  Revision 1.54  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.53  2003/04/27 11:21:34  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/symconst.pas

@@ -248,6 +248,8 @@ type
     vo_is_exported,
     vo_is_high_value,
     vo_is_funcret,
+    vo_is_self,
+    vo_is_vmt,
     vo_is_result  { special result variable }
   );
   tvaroptions=set of tvaroption;
@@ -350,7 +352,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2003-05-05 14:53:16  peter
+  Revision 1.54  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.53  2003/05/05 14:53:16  peter
     * vs_hidden replaced by is_hidden boolean
 
   Revision 1.52  2003/04/27 11:21:34  peter

compiler/symdef.pas

@@ -3334,13 +3334,16 @@ implementation
                end;
                if assigned(hp.paratype.def.typesym) then
                  begin
-                   s:=s+' ';
+                   if s<>'(' then
+                    s:=s+' ';
                    hs:=hp.paratype.def.typesym.realname;
                    if hs[1]<>'$' then
                      s:=s+hp.paratype.def.typesym.realname
                    else
                      s:=s+hp.paratype.def.gettypename;
-                 end;
+                 end
+               else
+                 s:=s+hp.paratype.def.gettypename;
                { default value }
                if assigned(hp.defaultvalue) then
                 begin
@@ -3643,6 +3646,9 @@ implementation
       var
         s : string;
       begin
+{$ifdef EXTDEBUG}
+        showhidden:=true;
+{$endif EXTDEBUG}
         s:='';
         if assigned(_class) then
          begin
@@ -3660,8 +3666,7 @@ implementation
 
     function tprocdef.is_methodpointer:boolean;
       begin
-        result:=assigned(owner) and
-                (owner.symtabletype=objectsymtable);
+        result:=assigned(_class);
       end;
 
 
@@ -4287,7 +4292,13 @@ implementation
     function tprocvardef.gettypename : string;
       var
         s: string;
+        showhidden : boolean;
       begin
+{$ifdef EXTDEBUG}
+         showhidden:=true;
+{$else EXTDEBUG}
+         showhidden:=false;
+{$endif EXTDEBUG}
          s:='<';
          if po_classmethod in procoptions then
            s := s+'class method type of'
@@ -4298,9 +4309,9 @@ implementation
              s := s+'procedure variable type of';
          if assigned(rettype.def) and
             (rettype.def<>voidtype.def) then
-           s:=s+' function'+typename_paras(false)+':'+rettype.def.gettypename
+           s:=s+' function'+typename_paras(showhidden)+':'+rettype.def.gettypename
          else
-           s:=s+' procedure'+typename_paras(false);
+           s:=s+' procedure'+typename_paras(showhidden);
          if po_methodpointer in procoptions then
            s := s+' of object';
          gettypename := s+';'+ProcCallOptionStr[proccalloption]+'>';
@@ -5751,7 +5762,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.140  2003-05-05 14:53:16  peter
+  Revision 1.141  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.140  2003/05/05 14:53:16  peter
     * vs_hidden replaced by is_hidden boolean
 
   Revision 1.139  2003/05/01 07:59:43  florian

compiler/symsym.pas

@@ -184,9 +184,9 @@ interface
           varstate      : tvarstate;
           paraitem      : tparaitem;
           notifications : Tlinkedlist;
-          constructor create(const n : string;const tt : ttype);
-          constructor create_dll(const n : string;const tt : ttype);
-          constructor create_C(const n,mangled : string;const tt : ttype);
+          constructor create(const n : string;vsp:tvarspez;const tt : ttype);
+          constructor create_dll(const n : string;vsp:tvarspez;const tt : ttype);
+          constructor create_C(const n,mangled : string;vsp:tvarspez;const tt : ttype);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -981,7 +981,8 @@ implementation
         p:=pdlistfirst;
         while p<>nil do
          begin
-           if p^.def.para.empty and is_boolean(p^.def.rettype.def) then
+           if (p^.def.maxparacount=0) and
+              is_boolean(p^.def.rettype.def) then
             begin
               search_procdef_nopara_boolret:=p^.def;
               break;
@@ -1455,14 +1456,14 @@ implementation
 
     constructor tabsolutesym.create(const n : string;const tt : ttype);
       begin
-        inherited create(n,tt);
+        inherited create(n,vs_value,tt);
         typ:=absolutesym;
       end;
 
 
     constructor tabsolutesym.create_ref(const n : string;const tt : ttype;sym:tstoredsym);
       begin
-        inherited create(n,tt);
+        inherited create(n,vs_value,tt);
         typ:=absolutesym;
         ref:=sym;
       end;
@@ -1577,13 +1578,13 @@ implementation
                                   TVARSYM
 ****************************************************************************}
 
-    constructor tvarsym.create(const n : string;const tt : ttype);
+    constructor tvarsym.create(const n : string;vsp:tvarspez;const tt : ttype);
       begin
          inherited create(n);
          typ:=varsym;
          vartype:=tt;
          _mangledname:=nil;
-         varspez:=vs_value;
+         varspez:=vsp;
          address:=0;
          localvarsym:=nil;
          highvarsym:=nil;
@@ -1605,16 +1606,16 @@ implementation
       end;
 
 
-    constructor tvarsym.create_dll(const n : string;const tt : ttype);
+    constructor tvarsym.create_dll(const n : string;vsp:tvarspez;const tt : ttype);
       begin
-         tvarsym(self).create(n,tt);
+         tvarsym(self).create(n,vsp,tt);
          include(varoptions,vo_is_dll_var);
       end;
 
 
-    constructor tvarsym.create_C(const n,mangled : string;const tt : ttype);
+    constructor tvarsym.create_C(const n,mangled : string;vsp:tvarspez;const tt : ttype);
       begin
-         tvarsym(self).create(n,tt);
+         tvarsym(self).create(n,vsp,tt);
          stringdispose(_mangledname);
          _mangledname:=stringdup(mangled);
       end;
@@ -2557,7 +2558,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.101  2003-05-05 14:53:16  peter
+  Revision 1.102  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.101  2003/05/05 14:53:16  peter
     * vs_hidden replaced by is_hidden boolean
 
   Revision 1.100  2003/04/27 11:21:34  peter

compiler/utils/ppudump.pp

@@ -784,6 +784,7 @@ begin
      readsymref;
      write  (space,'     Symbol : ');
      readsymref;
+     writeln(space,'  Is Hidden : ',(ppufile.getbyte<>0));
      write  (space,'   Location : ');
      writeln('<not yet implemented>');
      paraloclen:=ppufile.getbyte;
@@ -1937,7 +1938,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.41  2003-04-27 07:29:52  peter
+  Revision 1.42  2003-05-09 17:47:03  peter
+    * self moved to hidden parameter
+    * removed hdisposen,hnewn,selfn
+
+  Revision 1.41  2003/04/27 07:29:52  peter
     * aktprocdef cleanup, aktprocdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed