瀏覽代碼

* fixed @methodpointer

peter 23 年之前
父節點
當前提交
624e5bd699
共有 3 個文件被更改,包括 52 次插入29 次删除
  1. 8 5
      compiler/cgobj.pas
  2. 20 15
      compiler/i386/n386ld.pas
  3. 24 9
      compiler/nld.pas

+ 8 - 5
compiler/cgobj.pas

@@ -200,7 +200,7 @@ unit cgobj;
           procedure a_load_const_loc(list : taasmoutput;a : aword;const loc : tlocation);
           procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);virtual; abstract;
           procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; abstract;
-          procedure a_load_reg_loc(list : taasmoutput;reg : tregister;const loc: tlocation);
+          procedure a_load_reg_loc(list : taasmoutput;size : tcgsize;reg : tregister;const loc: tlocation);
           procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual; abstract;
           procedure a_load_loc_reg(list : taasmoutput;const loc: tlocation; reg : tregister);
           procedure a_load_loc_ref(list : taasmoutput;const loc: tlocation; const ref : treference);
@@ -1226,13 +1226,13 @@ unit cgobj;
       end;
 
 
-    procedure tcg.a_load_reg_loc(list : taasmoutput;reg : tregister;const loc: tlocation);
+    procedure tcg.a_load_reg_loc(list : taasmoutput;size : tcgsize;reg : tregister;const loc: tlocation);
       begin
         case loc.loc of
           LOC_REFERENCE,LOC_CREFERENCE:
-            a_load_reg_ref(list,loc.size,reg,loc.reference);
+            a_load_reg_ref(list,size,reg,loc.reference);
           LOC_REGISTER,LOC_CREGISTER:
-            a_load_reg_reg(list,loc.size,reg,loc.register);
+            a_load_reg_reg(list,size,reg,loc.register);
           else
             internalerror(200203271);
         end;
@@ -1645,7 +1645,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.16  2002-04-21 15:25:30  carl
+  Revision 1.17  2002-04-22 16:30:05  peter
+    * fixed @methodpointer
+
+  Revision 1.16  2002/04/21 15:25:30  carl
   + a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
   + changeregsize -> rg.makeregsize
 

+ 20 - 15
compiler/i386/n386ld.pas

@@ -291,13 +291,13 @@ implementation
                       begin
                          location_reset(location,LOC_CREFERENCE,OS_64);
                          tg.gettempofsizereference(exprasmlist,8,location.reference);
+
+                         { called as type.method, then we only need to return
+                           the address of the function, not the self pointer }
                          if left.nodetype=typen then
                           begin
-                            if left.resulttype.def.deftype<>objectdef then
-                             internalerror(200103261);
-                            hregister:=rg.getexplicitregisterint(exprasmlist,R_EDI);
-                            emit_sym_ofs_reg(A_MOV,S_L,
-                              newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0,R_EDI);
+                            { there is no instance, we return 0 }
+                            cg.a_load_const_ref(exprasmlist,OS_ADDR,0,location.reference);
                           end
                          else
                           begin
@@ -325,15 +325,16 @@ implementation
                                       emit_ref_reg(A_LEA,S_L,left.location.reference,R_EDI);
                                  end;
                                else internalerror(26019);
+
                             end;
                             location_release(exprasmlist,left.location);
                             location_freetemp(exprasmlist,left.location);
-                          end;
 
-                         { store the class instance address }
-                         href:=location.reference;
-                         inc(href.offset,4);
-                         emit_reg_ref(A_MOV,S_L,hregister,href);
+                            { store the class instance address }
+                            href:=location.reference;
+                            inc(href.offset,4);
+                            emit_reg_ref(A_MOV,S_L,hregister,href);
+                          end;
 
                          { virtual method ? }
                          if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then
@@ -349,14 +350,15 @@ implementation
                                                    tprocdef(resulttype.def).extnumber));
                               emit_ref_reg(A_MOV,S_L,href,R_EDI);
                               { ... and store it }
-                              emit_reg_ref(A_MOV,S_L,R_EDI,location.reference);
+                              cg.a_load_reg_loc(exprasmlist,OS_ADDR,R_EDI,location);
                               rg.ungetregisterint(exprasmlist,R_EDI);
                            end
                          else
                            begin
+                              reference_reset_symbol(href,newasmsymbol(tprocdef(resulttype.def).mangledname),0);
+                              cg.a_loadaddr_ref_reg(exprasmlist,href,R_EDI);
+                              cg.a_load_reg_loc(exprasmlist,OS_ADDR,R_EDI,location);
                               rg.ungetregisterint(exprasmlist,R_EDI);
-                              s:=newasmsymbol(tprocdef(resulttype.def).mangledname);
-                              emit_sym_ofs_ref(A_MOV,S_L,s,0,location.reference);
                            end;
                       end
                     else
@@ -645,7 +647,7 @@ implementation
                    tcg64f32(cg).a_load64_reg_loc(exprasmlist,
                        right.location.registerlow,right.location.registerhigh,left.location)
                   else
-                   cg.a_load_reg_loc(exprasmlist,right.location.register,left.location);
+                   cg.a_load_reg_loc(exprasmlist,right.location.size,right.location.register,left.location);
                 end;
               LOC_FPUREGISTER,LOC_CFPUREGISTER :
                 begin
@@ -777,7 +779,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.37  2002-04-21 15:36:13  carl
+  Revision 1.38  2002-04-22 16:30:06  peter
+    * fixed @methodpointer
+
+  Revision 1.37  2002/04/21 15:36:13  carl
   * changeregsize -> rg.makeregsize
 
   Revision 1.36  2002/04/19 15:39:35  peter

+ 24 - 9
compiler/nld.pas

@@ -261,15 +261,27 @@ implementation
                     end
                    else
                     resulttype.setdef(procdeflist);
-                   { if the owner of the procsym is a object,  }
-                   { left must be set, if left isn't set       }
-                   { it can be only self                       }
-                   { this code is only used in TP procvar mode }
-                   if (m_tp_procvar in aktmodeswitches) and
-                      not(assigned(left)) and
-                      (tprocsym(symtableentry).owner.symtabletype=objectsymtable) then
+
+                   if (m_tp_procvar in aktmodeswitches) then
                     begin
-                      left:=cselfnode.create(tobjectdef(symtableentry.owner.defowner));
+                      if assigned(left) then
+                       begin
+                         if left.nodetype=typen then
+                          begin
+                            { we need to return only a voidpointer,
+                              so no need to keep the typen }
+                            left.free;
+                            left:=nil;
+                          end;
+                       end
+                      else
+                       begin
+                         { if the owner of the procsym is a object,  }
+                         { left must be set, if left isn't set       }
+                         { it can be only self                       }
+                         if (tprocsym(symtableentry).owner.symtabletype=objectsymtable) then
+                           left:=cselfnode.create(tobjectdef(symtableentry.owner.defowner));
+                       end;
                     end;
 
                    { process methodpointer }
@@ -913,7 +925,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.35  2002-04-21 19:02:04  peter
+  Revision 1.36  2002-04-22 16:30:06  peter
+    * fixed @methodpointer
+
+  Revision 1.35  2002/04/21 19:02:04  peter
     * removed newn and disposen nodes, the code is now directly
       inlined from pexpr
     * -an option that will write the secondpass nodes to the .s file, this