* tloadnode does not support objectsymtable,withsymtable anymore

  * withnode cleanup
  * direct with rewritten to use temprefnode

compiler/nbas.pas

@@ -327,8 +327,10 @@ implementation
 
       begin
          inherited create(blockn,l);
+    {$ifndef newra}
          if releasetemp then
            include(flags,nf_releasetemps);
+    {$endif newra}
       end;
 
     function tblocknode.det_resulttype:tnode;
@@ -803,7 +805,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.48  2003-04-27 11:21:33  peter
+  Revision 1.49  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.48  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/ncal.pas

@@ -2087,7 +2087,7 @@ type
                if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
                   assigned(symtableproc) and
                   (symtableproc.symtabletype=withsymtable) and
-                  (not twithsymtable(symtableproc).direct_with) then
+                  (tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then
                  CGmessage(cg_e_cannot_call_cons_dest_inside_with);
 
                { R.Init then R will be initialized by the constructor,
@@ -2503,7 +2503,12 @@ type
            (procdefinition.deftype=procdef) then
           writeln(t,printnodeindention,'proc = ',tprocdef(procdefinition).fullprocname(true))
         else
-          writeln(t,printnodeindention,'proc = ',symtableprocentry.name);
+          begin
+            if assigned(symtableprocentry) then
+              writeln(t,printnodeindention,'proc = ',symtableprocentry.name)
+            else
+              writeln(t,printnodeindention,'proc = <nil>');
+          end;
         printnode(t,methodpointer);
         printnode(t,right);
         printnode(t,left);
@@ -2677,7 +2682,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.149  2003-05-09 17:47:02  peter
+  Revision 1.150  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.149  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/ncgld.pas

@@ -243,29 +243,8 @@ implementation
                                    location.reference.base:=current_procinfo.framepointer;
                                    location.reference.offset:=tvarsym(symtableentry).address;
                                 end;
-                              objectsymtable:
-                                begin
-                                   if (sp_static in tvarsym(symtableentry).symoptions) then
-                                     location.reference.symbol:=objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname)
-                                   else
-                                     begin
-                                        location.reference.base:=cg.g_load_self(exprasmlist);
-                                        location.reference.offset:=tvarsym(symtableentry).address;
-                                     end;
-                                end;
-                              withsymtable:
-                                begin
-                                   if nf_islocal in tnode(twithsymtable(symtable).withnode).flags then
-                                     location.reference:=twithnode(twithsymtable(symtable).withnode).withreference
-                                   else
-                                     begin
-                                       location.reference.base:=rg.getaddressregister(exprasmlist);
-                                       cg.a_load_ref_reg(exprasmlist,OS_ADDR,
-                                          twithnode(twithsymtable(symtable).withnode).withreference,
-                                          location.reference.base);
-                                     end;
-                                   inc(location.reference.offset,tvarsym(symtableentry).address);
-                                end;
+                              else
+                                internalerror(200305102);
                            end;
                          end;
                     end;
@@ -957,7 +936,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.55  2003-04-29 07:29:14  michael
+  Revision 1.56  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.55  2003/04/29 07:29:14  michael
   + Patch from peter to fix wrong pushing of ansistring function results in open array
 
   Revision 1.54  2003/04/27 11:21:33  peter

compiler/ncgmem.pas

@@ -337,151 +337,63 @@ implementation
 *****************************************************************************}
 
     procedure tcgwithnode.pass_2;
-      var
-        tmpreg: tregister;
-        usetemp,with_expr_in_temp : boolean;
-        symtable : tsymtable;
-        i : integer;
 {$ifdef GDB}
+      const
+        withlevel : longint = 0;
+      var
         withstartlabel,withendlabel : tasmlabel;
         pp : pchar;
         mangled_length  : longint;
-
-      const
-        withlevel : longint = 0;
 {$endif GDB}
       begin
-         location_reset(location,LOC_VOID,OS_NO);
-
-         if assigned(left) then
-            begin
-               secondpass(left);
-{$ifdef i386}
-               if (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
-                  (left.location.reference.segment.number<>NR_NO) then
-                 message(parser_e_no_with_for_variable_in_other_segments);
-{$endif i386}
-
-               reference_reset(withreference);
-
-               usetemp:=false;
-               if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=current_procdef.localst) then
-                 begin
-                    { for locals use the local storage }
-                    withreference:=left.location.reference;
-                    include(flags,nf_islocal);
-                 end
-               else
-                { call can have happend with a property }
-                begin
-                  usetemp:=true;
-                  if is_class_or_interface(left.resulttype.def) then
-                    begin
-                    {$ifdef newra}
-                      tmpreg:=rg.getregisterint(exprasmlist,OS_INT);
-                    {$else}
-                      tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
-                    {$endif}
-                      cg.a_load_loc_reg(exprasmlist,left.location,tmpreg)
-                    end
-                  else
-                    begin
-                    {$ifdef newra}
-                      tmpreg:=rg.getaddressregister(exprasmlist);
-                    {$else}
-                      tmpreg := cg.get_scratch_reg_address(exprasmlist);
-                    {$endif newra}
-                      cg.a_loadaddr_ref_reg(exprasmlist,
-                        left.location.reference,tmpreg);
-                    end;
-                end;
-
-               location_release(exprasmlist,left.location);
-
-               symtable:=withsymtable;
-               for i:=1 to tablecount do
-                begin
-                  if (left.nodetype=loadn) and
-                     (tloadnode(left).symtable=current_procdef.localst) then
-                    twithsymtable(symtable).direct_with:=true;
-                  twithsymtable(symtable).withnode:=self;
-                  symtable:=symtable.next;
-                end;
-
-               { if the with expression is stored in a temp    }
-               { area we must make it persistent and shouldn't }
-               { release it (FK)                               }
-               if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) and
-                  tg.istemp(left.location.reference) then
-                 with_expr_in_temp:=tg.ChangeTempType(exprasmlist,left.location.reference,tt_persistant)
-               else
-                 with_expr_in_temp:=false;
+        location_reset(location,LOC_VOID,OS_NO);
 
-               { if usetemp is set the value must be in tmpreg }
-               if usetemp then
-                begin
-                  tg.GetTemp(exprasmlist,pointer_size,tt_persistant,withreference);
-                  { move to temp reference }
-                  cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,withreference);
-                {$ifdef newra}
-                  rg.ungetregisterint(exprasmlist,tmpreg);
-                {$else}
-                  cg.free_scratch_reg(exprasmlist,tmpreg);
-                {$endif}
 {$ifdef GDB}
-                  if (cs_debuginfo in aktmoduleswitches) then
-                    begin
-                      inc(withlevel);
-                      objectlibrary.getaddrlabel(withstartlabel);
-                      objectlibrary.getaddrlabel(withendlabel);
-                      cg.a_label(exprasmlist,withstartlabel);
-                      withdebugList.concat(Tai_stabs.Create(strpnew(
-                         '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
-                         '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
-                         tostr(N_LSYM)+',0,0,'+tostr(withreference.offset))));
-                      mangled_length:=length(current_procdef.mangledname);
-                      getmem(pp,mangled_length+50);
-                      strpcopy(pp,'192,0,0,'+withstartlabel.name);
-                      if (target_info.use_function_relative_addresses) then
-                        begin
-                          strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),current_procdef.mangledname);
-                        end;
-                      withdebugList.concat(Tai_stabn.Create(strnew(pp)));
-                    end;
+        if (cs_debuginfo in aktmoduleswitches) then
+          begin
+            { load reference }
+            if (withrefnode.nodetype=derefn) and
+               (tderefnode(withrefnode).left.nodetype=temprefn) then
+              secondpass(withrefnode);
+
+            inc(withlevel);
+            objectlibrary.getaddrlabel(withstartlabel);
+            objectlibrary.getaddrlabel(withendlabel);
+            cg.a_label(exprasmlist,withstartlabel);
+            withdebugList.concat(Tai_stabs.Create(strpnew(
+               '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
+               '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
+               tostr(N_LSYM)+',0,0,'+tostr(withrefnode.location.reference.offset))));
+            mangled_length:=length(current_procdef.mangledname);
+            getmem(pp,mangled_length+50);
+            strpcopy(pp,'192,0,0,'+withstartlabel.name);
+            if (target_info.use_function_relative_addresses) then
+              begin
+                strpcopy(strend(pp),'-');
+                strpcopy(strend(pp),current_procdef.mangledname);
+              end;
+            withdebugList.concat(Tai_stabn.Create(strnew(pp)));
+          end;
 {$endif GDB}
-                end;
 
-               { right can be optimize out !!! }
-               if assigned(right) then
-                 secondpass(right);
+        if assigned(left) then
+          secondpass(left);
 
-               if usetemp then
-                 begin
-                   tg.UnGetTemp(exprasmlist,withreference);
 {$ifdef GDB}
-                   if (cs_debuginfo in aktmoduleswitches) then
-                     begin
-                       cg.a_label(exprasmlist,withendlabel);
-                       strpcopy(pp,'224,0,0,'+withendlabel.name);
-                      if (target_info.use_function_relative_addresses) then
-                        begin
-                          strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),current_procdef.mangledname);
-                        end;
-                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
-                       freemem(pp,mangled_length+50);
-                       dec(withlevel);
-                     end;
+        if (cs_debuginfo in aktmoduleswitches) then
+          begin
+            cg.a_label(exprasmlist,withendlabel);
+            strpcopy(pp,'224,0,0,'+withendlabel.name);
+           if (target_info.use_function_relative_addresses) then
+             begin
+               strpcopy(strend(pp),'-');
+               strpcopy(strend(pp),current_procdef.mangledname);
+             end;
+            withdebugList.concat(Tai_stabn.Create(strnew(pp)));
+            freemem(pp,mangled_length+50);
+            dec(withlevel);
+          end;
 {$endif GDB}
-                 end;
-
-               if with_expr_in_temp then
-                 tg.UnGetTemp(exprasmlist,left.location.reference);
-
-               reference_reset(withreference);
-            end;
        end;
 
 
@@ -912,7 +824,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2003-05-09 17:47:02  peter
+  Revision 1.52  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.51  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/ncgutil.pas

@@ -1731,6 +1731,11 @@ implementation
                             { 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);
+{                            srsym:=pd.parast.searchsym('self');
+                            if not assigned(srsym) then
+                              internalerror(200305101);
+                            reference_reset_base(href,current_procinfo.framepointer,tvarsym(srsym).adjusted_address);
+                            cg.a_load_ref_reg( }
                             r:=cg.g_load_self(list);
                             if is_class(current_procdef._class) then
                              begin
@@ -2013,7 +2018,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.97  2003-05-10 13:20:23  jonas
+  Revision 1.98  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.97  2003/05/10 13:20:23  jonas
     * moved storing of register parameters to memory even earlier in the
       entry code to fix problems with constructors
 

compiler/nld.pas

@@ -237,6 +237,7 @@ implementation
          procdef:=nil;
       end;
 
+
     constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : tsymtable);
       begin
          inherited create(loadn,nil);
@@ -252,9 +253,6 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         symtableentry:=tsym(ppufile.getderef);
-{$ifdef fpc}
-{$warning FIXME: No withsymtable support}
-{$endif}
         symtable:=nil;
         procdef:=tprocdef(ppufile.getderef);
       end;
@@ -299,21 +297,8 @@ implementation
 
 
     function tloadnode.det_resulttype:tnode;
-      var
-        p1 : tnode;
       begin
          result:=nil;
-         { optimize simple with loadings }
-         if (symtable.symtabletype=withsymtable) and
-            (twithsymtable(symtable).direct_with) and
-            (symtableentry.typ=varsym) then
-           begin
-              p1:=tnode(twithsymtable(symtable).withrefnode).getcopy;
-              p1:=csubscriptnode.create(tvarsym(symtableentry),p1);
-              left:=nil;
-              result:=p1;
-              exit;
-           end;
          { handle first absolute as it will replace the symtableentry }
          if symtableentry.typ=absolutesym then
            begin
@@ -342,25 +327,23 @@ implementation
               begin
                 { if it's refered by absolute then it's used }
                 if nf_absolute in flags then
-                  tvarsym(symtableentry).varstate:=vs_used
-                else
+                  tvarsym(symtableentry).varstate:=vs_used;
+
+                { fix self type which is declared as voidpointer in the
+                  definition }
+                if vo_is_self in tvarsym(symtableentry).varoptions then
                   begin
-                    { fix self type which is declared as voidpointer in the
-                      definition }
-                    if vo_is_self in tvarsym(symtableentry).varoptions then
+                    if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
+                       (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) 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);
+                        resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
+                        resulttype.setdef(tclassrefdef.create(resulttype));
                       end
                     else
-                      resulttype:=tvarsym(symtableentry).vartype;
-                  end;
+                      resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
+                  end
+                else
+                  resulttype:=tvarsym(symtableentry).vartype;
               end;
             typedconstsym :
                 if not(nf_absolute in flags) then
@@ -439,8 +422,6 @@ implementation
                     { call by value open arrays are also indirect addressed }
                     is_open_array(tvarsym(symtableentry).vartype.def) then
                   registers32:=1;
-                if symtable.symtabletype in [withsymtable,objectsymtable] then
-                  inc(registers32);
 
                 if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
                   registers32:=1;
@@ -1167,7 +1148,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.91  2003-05-09 17:47:02  peter
+  Revision 1.92  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.91  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/nmem.pas

@@ -89,11 +89,11 @@ interface
        end;
        tvecnodeclass = class of tvecnode;
 
-       twithnode = class(tbinarynode)
+       twithnode = class(tunarynode)
           withsymtable  : twithsymtable;
           tablecount    : longint;
-          withreference : treference;
-          constructor create(symtable : twithsymtable;l,r : tnode;count : longint);virtual;
+          withrefnode   : tnode;
+          constructor create(l:tnode;symtable:twithsymtable;count:longint;r:tnode);
           destructor destroy;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -767,13 +767,12 @@ implementation
                                TWITHNODE
 *****************************************************************************}
 
-    constructor twithnode.create(symtable : twithsymtable;l,r : tnode;count : longint);
-
+    constructor twithnode.create(l:tnode;symtable:twithsymtable;count:longint;r:tnode);
       begin
-         inherited create(withn,l,r);
+         inherited create(withn,l);
+         withrefnode:=r;
          withsymtable:=symtable;
          tablecount:=count;
-         FillChar(withreference,sizeof(withreference),0);
          set_file_line(l);
       end;
 
@@ -821,69 +820,58 @@ implementation
          p:=twithnode(inherited getcopy);
          p.withsymtable:=withsymtable;
          p.tablecount:=tablecount;
-         p.withreference:=withreference;
+         if assigned(p.withrefnode) then
+           p.withrefnode:=withrefnode.getcopy
+         else
+           p.withrefnode:=nil;
          result:=p;
       end;
 
+
     function twithnode.det_resulttype:tnode;
-      var
-         symtable : tsymtable;
-         i : longint;
       begin
-         result:=nil;
-         resulttype:=voidtype;
-         if assigned(left) and assigned(right) then
-          begin
-            resulttypepass(left);
-            unset_varstate(left);
-            set_varstate(left,true);
-            if codegenerror then
-             exit;
-
-            symtable:=withsymtable;
-            for i:=1 to tablecount do
-             begin
-               if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=current_procdef.localst) then
-                twithsymtable(symtable).direct_with:=true;
-               twithsymtable(symtable).withnode:=self;
-               symtable:=symtable.next;
-             end;
-
-            resulttypepass(right);
-            if codegenerror then
-             exit;
-          end;
+        result:=nil;
         resulttype:=voidtype;
+
+        resulttypepass(withrefnode);
+        unset_varstate(withrefnode);
+        set_varstate(withrefnode,true);
+        if codegenerror then
+         exit;
+
+        if (withrefnode.nodetype=vecn) and
+           (nf_memseg in withrefnode.flags) then
+          CGMessage(parser_e_no_with_for_variable_in_other_segments);
+
+        if assigned(left) then
+          resulttypepass(left);
       end;
 
 
     function twithnode.pass_1 : tnode;
       begin
-         result:=nil;
-         expectloc:=LOC_VOID;
-         if assigned(left) and assigned(right) then
-            begin
-               firstpass(left);
-               firstpass(right);
-               if codegenerror then
-                 exit;
+        result:=nil;
+        expectloc:=LOC_VOID;
 
-               left_right_max;
-            end
-         else
-           begin
-              { optimization }
-              result:=nil;
-           end;
+        if assigned(left) then
+         begin
+           firstpass(left);
+           registers32:=left.registers32;
+           registersfpu:=left.registersfpu;
+{$ifdef SUPPORT_MMX}
+           registersmmx:=left.registersmmx;
+{$endif SUPPORT_MMX}
+         end;
       end;
 
+
     function twithnode.docompare(p: tnode): boolean;
       begin
         docompare :=
           inherited docompare(p) and
           (withsymtable = twithnode(p).withsymtable) and
-          (tablecount = twithnode(p).tablecount);
+          (tablecount = twithnode(p).tablecount) and
+          (withrefnode.isequal(twithnode(p).withrefnode));
       end;
 
 begin
@@ -897,7 +885,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2003-05-09 17:47:02  peter
+  Revision 1.54  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.53  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/pexpr.pas

@@ -809,9 +809,17 @@ implementation
                sl_load :
                  begin
                    { p1 can already contain the loadnode of
-                     the class variable. Then we need to use a
-                     subscriptn. If no tree is found (with block), then
-                     generate a loadn }
+                     the class variable. When there is no tree yet we
+                     may need to load it for with or objects }
+                   if not assigned(p1) then
+                    begin
+                      case st.symtabletype of
+                        withsymtable :
+                          p1:=tnode(twithsymtable(st).withrefnode).getcopy;
+                        objectsymtable :
+                          p1:=load_self;
+                      end;
+                    end;
                    if assigned(p1) then
                     p1:=csubscriptnode.create(plist^.sym,p1)
                    else
@@ -1101,7 +1109,16 @@ implementation
                        searchsym(static_name,srsym,srsymtable);
                        check_hints(srsym);
                      end;
-                    p1:=cloadnode.create(srsym,srsymtable);
+
+                    case srsymtable.symtabletype of
+                      objectsymtable :
+                        p1:=csubscriptnode.create(srsym,load_self);
+                      withsymtable :
+                        p1:=csubscriptnode.create(srsym,tnode(twithsymtable(srsymtable).withrefnode).getcopy);
+                      else
+                        p1:=cloadnode.create(srsym,srsymtable);
+                    end;
+
                     if tvarsym(srsym).varstate=vs_declared then
                      begin
                        include(p1.flags,nf_first_use);
@@ -2322,7 +2339,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.115  2003-05-09 17:47:03  peter
+  Revision 1.116  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.115  2003/05/09 17:47:03  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/pstatmnt.pas

@@ -389,6 +389,12 @@ implementation
          withsymtable,symtab : tsymtable;
          obj : tobjectdef;
          hp : tnode;
+         newblock : tblocknode;
+         newstatement : tstatementnode;
+         loadp : ttempcreatenode;
+         refp : tnode;
+         htype : ttype;
+         hasimplicitderef : boolean;
       begin
          p:=comp_expr(true);
          do_resulttypepass(p);
@@ -397,26 +403,73 @@ implementation
          if (not codegenerror) and
             (p.resulttype.def.deftype in [objectdef,recorddef]) then
           begin
+            newblock:=nil;
+            { ignore nodes that don't add instructions in the tree }
+            hp:=p;
+            while { equal type conversions }
+                  (
+                   (hp.nodetype=typeconvn) and
+                   (ttypeconvnode(hp).convtype=tc_equal)
+                  ) or
+                  { constant array index }
+                  (
+                   (hp.nodetype=vecn) and
+                   (tvecnode(hp).right.nodetype=ordconstn)
+                  ) do
+              hp:=tunarynode(hp).left;
+            if (hp.nodetype=loadn) and
+               (
+                (tloadnode(hp).symtable=current_procdef.localst) or
+                (tloadnode(hp).symtable=current_procdef.parast) or
+                (tloadnode(hp).symtable.symtabletype in [staticsymtable,globalsymtable])
+               ) then
+             begin
+               { simple load, we can reference direct }
+               loadp:=nil;
+               refp:=p;
+             end
+            else
+             begin
+               { complex load, load in temp first }
+               newblock:=internalstatements(newstatement,false);
+               { classes and interfaces have implicit dereferencing }
+               hasimplicitderef:=is_class_or_interface(p.resulttype.def);
+               if hasimplicitderef then
+                 htype:=p.resulttype
+               else
+                 htype.setdef(tpointerdef.create(p.resulttype));
+               loadp:=ctempcreatenode.create(htype,POINTER_SIZE,true);
+               resulttypepass(loadp);
+               if hasimplicitderef then
+                begin
+                  hp:=p;
+                  refp:=ctemprefnode.create(loadp);
+                end
+               else
+                begin
+                  hp:=caddrnode.create(p);
+                  refp:=cderefnode.create(ctemprefnode.create(loadp));
+                end;
+               addstatement(newstatement,loadp);
+               addstatement(newstatement,cassignmentnode.create(
+                   ctemprefnode.create(loadp),
+                   hp));
+               resulttypepass(refp);
+             end;
+
             case p.resulttype.def.deftype of
               objectdef :
                 begin
                    obj:=tobjectdef(p.resulttype.def);
-                   symtab:=twithsymtable.Create(obj,obj.symtable.symsearch);
-                   withsymtable:=symtab;
-                   if (p.nodetype=loadn) and
-                      (tloadnode(p).symtable=current_procdef.localst) then
-                     twithsymtable(symtab).direct_with:=true;
-                   twithsymtable(symtab).withrefnode:=p;
+                   withsymtable:=twithsymtable.Create(obj,obj.symtable.symsearch,refp);
+                   { include also all parent symtables }
                    levelcount:=1;
                    obj:=obj.childof;
+                   symtab:=withsymtable;
                    while assigned(obj) do
                     begin
-                      symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch);
+                      symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch,refp);
                       symtab:=symtab.next;
-                      if (p.nodetype=loadn) and
-                         (tloadnode(p).symtable=current_procdef.localst) then
-                        twithsymtable(symtab).direct_with:=true;
-                      twithsymtable(symtab).withrefnode:=p;
                       obj:=obj.childof;
                       inc(levelcount);
                     end;
@@ -427,39 +480,40 @@ implementation
                 begin
                    symtab:=trecorddef(p.resulttype.def).symtable;
                    levelcount:=1;
-                   withsymtable:=twithsymtable.create(trecorddef(p.resulttype.def),symtab.symsearch);
-                   if (p.nodetype=loadn) and
-                      (tloadnode(p).symtable=current_procdef.localst) then
-                   twithsymtable(withsymtable).direct_with:=true;
-                   twithsymtable(withsymtable).withrefnode:=p;
+                   withsymtable:=twithsymtable.create(trecorddef(p.resulttype.def),symtab.symsearch,refp);
                    withsymtable.next:=symtablestack;
                    symtablestack:=withsymtable;
                 end;
             end;
-            if token=_COMMA then
-             begin
-               consume(_COMMA);
-               right:=_with_statement{$ifdef FPCPROCVAR}(){$endif};
-             end
+            if try_to_consume(_COMMA) then
+              right:=_with_statement{$ifdef FPCPROCVAR}(){$endif}
             else
+              begin
+                consume(_DO);
+                if token<>_SEMICOLON then
+                  right:=statement
+                else
+                  right:=cerrornode.create;
+              end;
+            { remove symtables from the stack }
+            for i:=1 to levelcount do
+              symtablestack:=symtablestack.next;
+            p:=cwithnode.create(right,twithsymtable(withsymtable),levelcount,refp);
+            { Finalize complex withnode with destroy of temp }
+            if assigned(newblock) then
              begin
-               consume(_DO);
-               if token<>_SEMICOLON then
-                right:=statement
-               else
-                right:=cerrornode.create;
+               addstatement(newstatement,p);
+               addstatement(newstatement,ctempdeletenode.create(loadp));
+               p:=newblock;
              end;
-            for i:=1 to levelcount do
-             symtablestack:=symtablestack.next;
-            _with_statement:=cwithnode.create(twithsymtable(withsymtable),p,right,levelcount);
+            _with_statement:=p;
           end
          else
           begin
             Message(parser_e_false_with_expr);
             { try to recover from error }
-            if token=_COMMA then
+            if try_to_consume(_COMMA) then
              begin
-               consume(_COMMA);
                hp:=_with_statement{$ifdef FPCPROCVAR}(){$endif};
                if (hp=nil) then; { remove warning about unused }
              end
@@ -1131,7 +1185,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.96  2003-05-09 17:47:03  peter
+  Revision 1.97  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.96  2003/05/09 17:47:03  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/symtable.pas

@@ -179,15 +179,8 @@ interface
        end;
 
        twithsymtable = class(tsymtable)
-          direct_with : boolean;
-          { in fact it is a tnode }
-          withnode : pointer;
-          { tnode to load of direct with var }
-          { already usable before firstwith
-            needed for firstpass of function parameters PM }
-          withrefnode : pointer;
-          use_count : longint;
-          constructor create(aowner:tdef;asymsearch:TDictionary);
+          withrefnode : pointer; { tnode }
+          constructor create(aowner:tdef;asymsearch:TDictionary;refnode:pointer{tnode});
           destructor  destroy;override;
           procedure clear;override;
         end;
@@ -1874,14 +1867,11 @@ implementation
                               TWITHSYMTABLE
 ****************************************************************************}
 
-    constructor twithsymtable.create(aowner:tdef;asymsearch:TDictionary);
+    constructor twithsymtable.create(aowner:tdef;asymsearch:TDictionary;refnode:pointer{tnode});
       begin
          inherited create('');
          symtabletype:=withsymtable;
-         direct_with:=false;
-         withnode:=nil;
-         withrefnode:=nil;
-         use_count:=1;
+         withrefnode:=refnode;
          { we don't need the symsearch }
          symsearch.free;
          { set the defaults }
@@ -2428,7 +2418,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.97  2003-04-27 11:21:34  peter
+  Revision 1.98  2003-05-11 14:45:12  peter
+    * tloadnode does not support objectsymtable,withsymtable anymore
+    * withnode cleanup
+    * direct with rewritten to use temprefnode
+
+  Revision 1.97  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