Browse Source

* remove a lot of code to support typen in loadn-procsym

peter 22 years ago
parent
commit
a0fbe08d83
3 changed files with 92 additions and 132 deletions
  1. 73 98
      compiler/ncgld.pas
  2. 13 32
      compiler/nld.pas
  3. 6 2
      compiler/pexpr.pas

+ 73 - 98
compiler/ncgld.pas

@@ -68,7 +68,6 @@ implementation
       var
       var
         intreg,
         intreg,
         hregister : tregister;
         hregister : tregister;
-        freereg   : boolean;
         symtabletype : tsymtabletype;
         symtabletype : tsymtabletype;
         i : longint;
         i : longint;
         href : treference;
         href : treference;
@@ -290,107 +289,80 @@ implementation
                begin
                begin
                   if assigned(left) then
                   if assigned(left) then
                     begin
                     begin
-                       {
-                         THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK
-                         ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS
-                         CONSISTS OF TWO OS_ADDR, so you cannot set it
-                         to OS_64 - how to solve?? Carl
-                       }
-                       if (sizeof(aword) = 4) then
-                          location_reset(location,LOC_CREFERENCE,OS_64)
-                       else
-                          internalerror(20020520);
-                       tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference);
-                       freereg:=false;
+                      {
+                        THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK
+                        ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS
+                        CONSISTS OF TWO OS_ADDR, so you cannot set it
+                        to OS_64 - how to solve?? Carl
+                      }
+                      if (sizeof(aword) = 4) then
+                         location_reset(location,LOC_CREFERENCE,OS_64)
+                      else
+                         internalerror(20020520);
+                      tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference);
+                      secondpass(left);
+
+                      { load class instance address }
+                      case left.location.loc of
+                         LOC_CREGISTER,
+                         LOC_REGISTER:
+                           begin
+                              hregister:=left.location.register;
+                              if is_object(left.resulttype.def) then
+                                CGMessage(cg_e_illegal_expression);
+                           end;
+                         LOC_CREFERENCE,
+                         LOC_REFERENCE:
+                           begin
+                              hregister:=rg.getaddressregister(exprasmlist);
+                              if is_class_or_interface(left.resulttype.def) then
+                                cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister)
+                              else
+                                cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister);
+                              location_release(exprasmlist,left.location);
+                              location_freetemp(exprasmlist,left.location);
+                           end;
+                         else
+                           internalerror(26019);
+                      end;
 
 
-                       { called as type.method, then we only need to return
-                         the address of the function, not the self pointer }
-                       if left.nodetype=typen then
+                      { store the class instance address }
+                      href:=location.reference;
+                      inc(href.offset,POINTER_SIZE);
+                      cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
+
+                      { virtual method ? }
+                      if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then
                         begin
                         begin
-                          { there is no instance, we return 0 }
-                          href:=location.reference;
-                          inc(href.offset,POINTER_SIZE);
-                          cg.a_load_const_ref(exprasmlist,OS_ADDR,0,href);
+                          { load vmt pointer }
+                          reference_reset_base(href,hregister,0);
+                          reference_release(exprasmlist,href);
+                          hregister:=rg.getaddressregister(exprasmlist);
+                          cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+
+
+                          reference_reset_base(href,hregister,tprocdef(resulttype.def)._class.vmtmethodoffset(
+                                           tprocdef(resulttype.def).extnumber));
+                          reference_release(exprasmlist,href);
+
+                          { load method address }
+                          hregister:=rg.getaddressregister(exprasmlist);
+                          cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+                          { ... and store it }
+                          cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
+                          rg.ungetaddressregister(exprasmlist,hregister);
                         end
                         end
-                       else
+                      else
                         begin
                         begin
-                          secondpass(left);
-
-                          { load class instance address }
-                          case left.location.loc of
-                             LOC_CREGISTER,
-                             LOC_REGISTER:
-                               begin
-                                  hregister:=left.location.register;
-                                  if is_object(left.resulttype.def) then
-                                    CGMessage(cg_e_illegal_expression);
-                               end;
-                             LOC_CREFERENCE,
-                             LOC_REFERENCE:
-                               begin
-                                  hregister:=rg.getaddressregister(exprasmlist);
-                                  if is_class_or_interface(left.resulttype.def) then
-                                    cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister)
-                                  else
-                                    cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister);
-                                  location_release(exprasmlist,left.location);
-                                  location_freetemp(exprasmlist,left.location);
-                               end;
-                             else
-                               internalerror(26019);
-                          end;
-
-                          { store the class instance address }
-                          href:=location.reference;
-                          inc(href.offset,POINTER_SIZE);
-                          cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
-                          { hregister will be reused when loading a virtual method }
-                          freereg:=true;
+                          { we don't use the hregister }
+                          rg.ungetregister(exprasmlist,hregister);
+                          { load address of the function }
+                          reference_reset_symbol(href,objectlibrary.newasmsymbol(tprocdef(resulttype.def).mangledname),0);
+                          hregister:=cg.get_scratch_reg_address(exprasmlist);
+                          cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
+                          cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
+                          cg.free_scratch_reg(exprasmlist,hregister);
                         end;
                         end;
-
-                       { virtual method ? }
-                       if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then
-                         begin
-                            if not freereg then
-                              begin
-                                if left.nodetype <> typen then
-                                  internalerror(200205161);
-                                reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),
-                                  tprocdef(resulttype.def)._class.vmtmethodoffset(tprocdef(resulttype.def).extnumber));
-                              end
-                            else
-                              begin
-                                { load vmt pointer }
-                                reference_reset_base(href,hregister,0);
-                                reference_release(exprasmlist,href);
-                                hregister:=rg.getaddressregister(exprasmlist);
-                                cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
-
-
-                                reference_reset_base(href,hregister,tprocdef(resulttype.def)._class.vmtmethodoffset(
-                                                 tprocdef(resulttype.def).extnumber));
-                                reference_release(exprasmlist,href);
-                              end;
-
-                            { load method address }
-                            hregister:=rg.getaddressregister(exprasmlist);
-                            cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
-                            { ... and store it }
-                            cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
-                            rg.ungetaddressregister(exprasmlist,hregister);
-                         end
-                       else
-                         begin
-                            { we don't use the hregister }
-                            if freereg then
-                             rg.ungetregister(exprasmlist,hregister);
-                            { load address of the function }
-                            reference_reset_symbol(href,objectlibrary.newasmsymbol(tprocdef(resulttype.def).mangledname),0);
-                            hregister:=cg.get_scratch_reg_address(exprasmlist);
-                            cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
-                            cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
-                            cg.free_scratch_reg(exprasmlist,hregister);
-                         end;
                     end
                     end
                   else
                   else
                     begin
                     begin
@@ -987,7 +959,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.42  2002-12-20 18:13:46  peter
+  Revision 1.43  2003-01-05 22:44:14  peter
+    * remove a lot of code to support typen in loadn-procsym
+
+  Revision 1.42  2002/12/20 18:13:46  peter
     * fixes for fpu values in arrayconstructor
     * fixes for fpu values in arrayconstructor
 
 
   Revision 1.41  2002/11/27 20:04:39  peter
   Revision 1.41  2002/11/27 20:04:39  peter

+ 13 - 32
compiler/nld.pas

@@ -178,7 +178,11 @@ implementation
             begin
             begin
               p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry,
               p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry,
                  tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc);
                  tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc);
-              if assigned(tcallnode(p1).methodpointer) then
+              { when the methodpointer is typen we've something like:
+                tobject.create. Then only the address is needed of the
+                method without a self pointer }
+              if assigned(tcallnode(p1).methodpointer) and
+                 (tcallnode(p1).methodpointer.nodetype<>typen) then
                begin
                begin
                  tloadnode(p2).set_mp(tcallnode(p1).methodpointer);
                  tloadnode(p2).set_mp(tcallnode(p1).methodpointer);
                  tcallnode(p1).methodpointer:=nil;
                  tcallnode(p1).methodpointer:=nil;
@@ -268,6 +272,9 @@ implementation
 
 
     procedure tloadnode.set_mp(p:tnode);
     procedure tloadnode.set_mp(p:tnode);
       begin
       begin
+        { typen nodes should not be set }
+        if p.nodetype=typen then
+          internalerror(200301042);
         left:=p;
         left:=p;
       end;
       end;
 
 
@@ -376,38 +383,9 @@ implementation
                    else
                    else
                     resulttype.setdef(procdef);
                     resulttype.setdef(procdef);
 
 
-                   if (m_tp_procvar in aktmodeswitches) then
-                    begin
-                      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 }
                    { process methodpointer }
                    if assigned(left) then
                    if assigned(left) then
-                    begin
-                      resulttypepass(left);
-
-                      { turn on the allowed flag, the secondpass
-                        will handle the typen itself }
-                      if left.nodetype=typen then
-                       ttypenode(left).allowed:=true;
-                    end;
+                     resulttypepass(left);
                 end;
                 end;
            else
            else
              internalerror(200104141);
              internalerror(200104141);
@@ -1272,7 +1250,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.78  2003-01-03 12:15:56  daniel
+  Revision 1.79  2003-01-05 22:44:14  peter
+    * remove a lot of code to support typen in loadn-procsym
+
+  Revision 1.78  2003/01/03 12:15:56  daniel
     * Removed ifdefs around notifications
     * Removed ifdefs around notifications
       ifdefs around for loop optimizations remain
       ifdefs around for loop optimizations remain
 
 

+ 6 - 2
compiler/pexpr.pas

@@ -709,7 +709,8 @@ implementation
               else
               else
                 aprocdef:=nil;
                 aprocdef:=nil;
               p2:=cloadnode.create_procvar(sym,aprocdef,st);
               p2:=cloadnode.create_procvar(sym,aprocdef,st);
-              if assigned(p1) then
+              if assigned(p1) and
+                 (p1.nodetype<>typen) then
                 tloadnode(p2).set_mp(p1);
                 tloadnode(p2).set_mp(p1);
               p1:=p2;
               p1:=p2;
 
 
@@ -2303,7 +2304,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.96  2002-12-11 22:40:36  peter
+  Revision 1.97  2003-01-05 22:44:14  peter
+    * remove a lot of code to support typen in loadn-procsym
+
+  Revision 1.96  2002/12/11 22:40:36  peter
     * assigned(procvar) fix for delphi mode, fixes tb0430
     * assigned(procvar) fix for delphi mode, fixes tb0430
 
 
   Revision 1.95  2002/11/30 11:12:48  carl
   Revision 1.95  2002/11/30 11:12:48  carl