* procedure of object and addrn fixes

compiler/cg386cal.pas

@@ -490,10 +490,10 @@ implementation
                                         end;
 
                                     if not(is_con_or_destructor and
-                                      pobjectdef(p^.methodpointer^.resulttype)^.isclass and
-                                        assigned(aktprocsym) and
-                                        ((aktprocsym^.definition^.options and
-                                        (poconstructor or podestructor))<>0)) then
+                                           pobjectdef(p^.methodpointer^.resulttype)^.isclass and
+                                           assigned(aktprocsym) and
+                                           ((aktprocsym^.definition^.options and (poconstructor or podestructor))<>0)
+                                          ) then
                                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
                                     { if an inherited con- or destructor should be  }
                                     { called in a con- or destructor then a warning }
@@ -808,7 +808,7 @@ implementation
                    { which is a class member                     }
                    { else ESI is overwritten !                   }
                    if (p^.right^.location.reference.base=R_ESI) or
-                     (p^.right^.location.reference.index=R_ESI) then
+                      (p^.right^.location.reference.index=R_ESI) then
                      begin
                         del_reference(p^.right^.location.reference);
                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
@@ -823,6 +823,7 @@ implementation
                      newreference(p^.right^.location.reference),R_ESI)));
                    { push self pointer }
                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+
                    dec(p^.right^.location.reference.offset,4);
 
                    if hregister=R_NO then
@@ -1187,7 +1188,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.80  1999-05-17 23:51:37  peter
+  Revision 1.81  1999-05-18 09:52:17  peter
+    * procedure of object and addrn fixes
+
+  Revision 1.80  1999/05/17 23:51:37  peter
     * with temp vars now use a reference with a persistant temp instead
       of setting datasize
 

compiler/pexpr.pas

@@ -544,7 +544,8 @@ unit pexpr;
       begin
          if ((procvar^.options and pomethodpointer)<>0) then
            begin
-              if (t^.methodpointer^.resulttype^.deftype=objectdef) and
+              if assigned(t^.methodpointer) and
+                 (t^.methodpointer^.resulttype^.deftype=objectdef) and
                  (pobjectdef(t^.methodpointer^.resulttype)^.isclass) and
                  (proc_to_procvar_equal(procvar,pprocsym(t^.symtableentry)^.definition)) then
                 begin
@@ -1371,7 +1372,7 @@ unit pexpr;
                                 classh:=classh^.childof;
                               end;
                              consume(ID);
-                             do_member_read(false,sym,p1,pd,again);
+                             do_member_read(getaddr,sym,p1,pd,again);
                            end;
 
                          objectdef:
@@ -1390,8 +1391,9 @@ unit pexpr;
                               end;
                              allow_only_static:=store_static;
                              consume(ID);
-                             do_member_read(false,sym,p1,pd,again);
+                             do_member_read(getaddr,sym,p1,pd,again);
                            end;
+
                          pointerdef:
                            begin
                              Message(cg_e_invalid_qualifier);
@@ -1988,7 +1990,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.106  1999-05-16 17:06:31  peter
+  Revision 1.107  1999-05-18 09:52:18  peter
+    * procedure of object and addrn fixes
+
+  Revision 1.106  1999/05/16 17:06:31  peter
     * remove firstcallparan which looks obsolete
 
   Revision 1.105  1999/05/12 22:36:09  florian

compiler/tcmem.pas

@@ -180,13 +180,29 @@ implementation
          make_not_regable(p^.left);
          if not(assigned(p^.resulttype)) then
            begin
+              { proc/procvar 2 procvar ? }
               if p^.left^.treetype=calln then
                 begin
                      { it could also be a procvar, not only pprocsym ! }
                      if p^.left^.symtableprocentry^.typ=varsym then
                         hp:=genloadnode(pvarsym(p^.left^.symtableprocentry),p^.left^.symtableproc)
                      else
-                        hp:=genloadcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc);
+                        begin
+                          if assigned(p^.left^.methodpointer) and
+                             (p^.left^.methodpointer^.resulttype^.deftype=objectdef) and
+                             (pobjectdef(p^.left^.methodpointer^.resulttype)^.isclass) then
+                           begin
+                             hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
+                               getcopy(p^.left^.methodpointer));
+                             disposetree(p);
+                             firstpass(hp);
+                             p:=hp;
+                             exit;
+                           end
+                          else
+                           hp:=genloadcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc);
+                        end;
+
                    { result is a procedure variable }
                    { No, to be TP compatible, you must return a pointer to
                      the procedure that is stored in the procvar.}
@@ -553,7 +569,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  1999-05-17 23:51:46  peter
+  Revision 1.16  1999-05-18 09:52:21  peter
+    * procedure of object and addrn fixes
+
+  Revision 1.15  1999/05/17 23:51:46  peter
     * with temp vars now use a reference with a persistant temp instead
       of setting datasize
 

compiler/tree.pas

@@ -249,6 +249,7 @@ unit tree;
     function genlabelnode(t : ttreetyp;nr : plabel) : ptree;
     function genloadnode(v : pvarsym;st : psymtable) : ptree;
     function genloadcallnode(v: pprocsym;st: psymtable): ptree;
+    function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
     function gensinglenode(t : ttreetyp;l : ptree) : ptree;
     function gensubscriptnode(varsym : pvarsym;l : ptree) : ptree;
     function genordinalconstnode(v : longint;def : pdef) : ptree;
@@ -965,6 +966,30 @@ unit tree;
          genloadcallnode:=p;
       end;
 
+    function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
+      var
+         p : ptree;
+
+      begin
+         p:=getnode;
+         p^.registers32:=0;
+{         p^.registers16:=0;
+         p^.registers8:=0; }
+         p^.registersfpu:=0;
+{$ifdef SUPPORT_MMX}
+         p^.registersmmx:=0;
+{$endif SUPPORT_MMX}
+         p^.treetype:=loadn;
+         p^.left:=nil;
+         p^.resulttype:=v^.definition;
+         p^.symtableentry:=v;
+         p^.symtable:=st;
+         p^.is_first := False;
+         p^.disposetyp:=dt_left;
+         p^.left:=mp;
+         genloadmethodcallnode:=p;
+      end;
+
 
     function gentypedconstloadnode(sym : ptypedconstsym;st : psymtable) : ptree;
 
@@ -1708,7 +1733,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.80  1999-05-17 23:51:48  peter
+  Revision 1.81  1999-05-18 09:52:22  peter
+    * procedure of object and addrn fixes
+
+  Revision 1.80  1999/05/17 23:51:48  peter
     * with temp vars now use a reference with a persistant temp instead
       of setting datasize
 

compiler/types.pas

@@ -486,7 +486,7 @@ implementation
             (pstringdef(p)^.string_typ in [st_ansistring,st_widestring]) then
            ungettempoftype:=false;
       end;
-      
+
     function mmx_type(p : pdef) : tmmxtype;
       begin
          mmx_type:=mmxno;
@@ -611,6 +611,9 @@ implementation
 
 
     function is_equal(def1,def2 : pdef) : boolean;
+      const
+         procvarmask = not(poassembler or pomethodpointer or povirtualmethod or pooverridingmethod or
+                           pocontainsself or pomsgstr or pomsgint);
       var
          b : boolean;
          hd : pdef;
@@ -711,12 +714,8 @@ implementation
                 { poassembler isn't important for compatibility }
                 { if a method is assigned to a methodpointer    }
                 { is checked before                             }
-                b:=((pprocvardef(def1)^.options and not(poassembler or pomethodpointer or
-                      povirtualmethod or pooverridingmethod))=
-                    (pprocvardef(def2)^.options and not(poassembler or pomethodpointer or
-                      povirtualmethod or pooverridingmethod))
-                   ) and
-                  is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef);
+                b:=((pprocvardef(def1)^.options and procvarmask)=(pprocvardef(def2)^.options and procvarmask)) and
+                   is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef);
                 { now evalute the parameters }
                 if b then
                   begin
@@ -794,7 +793,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  1999-04-19 09:29:51  pierre
+  Revision 1.59  1999-05-18 09:52:24  peter
+    * procedure of object and addrn fixes
+
+  Revision 1.58  1999/04/19 09:29:51  pierre
     + ungettempoftype(pdef) boolean function
       returns true (can call ungetiftemp )
       unless the temp should be "unget" with temptoremove