* 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
    requires EXTDEBUG define to actually write the info
  * fixed various internal errors and crashes due recent code changes

compiler/globtype.pas

@@ -122,7 +122,7 @@ interface
          cs_gdb_dbx,cs_gdb_gsym,cs_gdb_heaptrc,cs_gdb_lineinfo,cs_checkpointer,
          { assembling }
          cs_asm_leave,cs_asm_extern,cs_asm_pipe,cs_asm_source,
-         cs_asm_regalloc,cs_asm_tempalloc,
+         cs_asm_regalloc,cs_asm_tempalloc,cs_asm_nodes,
          { linking }
          cs_link_extern,cs_link_static,cs_link_smart,cs_link_shared,cs_link_deffile,
          cs_link_strip,cs_link_staticflag,cs_link_on_target
@@ -253,7 +253,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2002-03-24 19:05:59  carl
+  Revision 1.22  2002-04-21 19:02:03  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.21  2002/03/24 19:05:59  carl
   + patch for SPARC from Mazen NEIFER
 
   Revision 1.20  2002/01/24 18:25:48  peter

compiler/i386/n386cal.pas

@@ -63,7 +63,7 @@ implementation
       cginfo,cgbase,pass_2,
       cpubase,
       nmem,nld,ncnv,
-      tainst,cga,cgobj,tgobj,n386ld,n386util,regvars,rgobj,rgcpu,cg64f32,cgcpu;
+      tainst,cga,cgobj,tgobj,n386ld,n386util,ncgutil,regvars,rgobj,rgcpu,cg64f32,cgcpu;
 
 {*****************************************************************************
                              TI386CALLPARANODE
@@ -133,6 +133,11 @@ implementation
          else if assigned(defcoll.paratype.def) and
                  (defcoll.paratype.def.deftype=formaldef) then
            begin
+              { allow passing of a constant to a const formaldef }
+              if (defcoll.paratyp=vs_const) and
+                 (left.location.loc=LOC_CONSTANT) then
+                location_force_mem(left.location);
+
               { allow @var }
               inc(pushedparasize,4);
               if (left.nodetype=addrn) and
@@ -1477,7 +1482,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.46  2002-04-21 15:34:25  carl
+  Revision 1.47  2002-04-21 19:02:07  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.46  2002/04/21 15:34:25  carl
   * changeregsize -> rg.makeregsize
 
   Revision 1.45  2002/04/15 19:44:21  peter

compiler/i386/n386cnv.pas

@@ -249,7 +249,15 @@ implementation
               end;
             LOC_REGISTER,LOC_CREGISTER :
               begin
-                cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register);
+                if left.location.size in [OS_64,OS_S64] then
+                 begin
+                   hregister:=cg.get_scratch_reg(exprasmlist);
+                   cg.a_load_reg_reg(exprasmlist,OS_32,left.location.registerlow,hregister);
+                   cg.a_op_reg_reg(exprasmlist,OP_OR,OS_32,left.location.registerhigh,hregister);
+                   cg.free_scratch_reg(exprasmlist,hregister);
+                 end
+                else
+                 cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register);
               end;
             LOC_JUMP :
               begin
@@ -364,7 +372,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2002-04-21 15:35:23  carl
+  Revision 1.37  2002-04-21 19:02:07  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.36  2002/04/21 15:35:23  carl
   * changeregsize -> rg.makeregsize
 
   Revision 1.35  2002/04/19 15:39:35  peter

compiler/i386/n386mem.pas

@@ -30,18 +30,10 @@ interface
       node,nmem,ncgmem;
 
     type
-       ti386newnode = class(tnewnode)
-          procedure pass_2;override;
-       end;
-
        ti386addrnode = class(tcgaddrnode)
           procedure pass_2;override;
        end;
 
-       ti386simplenewdisposenode = class(tsimplenewdisposenode)
-          procedure pass_2;override;
-       end;
-
        ti386derefnode = class(tcgderefnode)
           procedure pass_2;override;
        end;
@@ -64,54 +56,6 @@ implementation
       cpuinfo,cpubase,
       cgobj,cga,tgobj,rgobj,ncgutil,n386util;
 
-{*****************************************************************************
-                            TI386NEWNODE
-*****************************************************************************}
-
-    procedure ti386newnode.pass_2;
-      var
-         pushed : tpushedsaved;
-         regstopush: tregisterset;
-         href : treference;
-      begin
-         if assigned(left) then
-           begin
-              secondpass(left);
-              location_copy(location,left.location);
-           end
-         else
-           begin
-              location_reset(location,LOC_REFERENCE,OS_ADDR);
-
-              regstopush := all_registers;
-              remove_non_regvars_from_loc(location,regstopush);
-              rg.saveusedregisters(exprasmlist,pushed,regstopush);
-
-              tg.gettempofsizereference(exprasmlist,pointer_size,location.reference);
-
-              { determines the size of the mem block }
-              push_int(tpointerdef(resulttype.def).pointertype.def.size);
-              emit_push_lea_loc(location,false);
-              rg.saveregvars(exprasmlist,all_registers);
-              emitcall('FPC_GETMEM');
-
-              if tpointerdef(resulttype.def).pointertype.def.needs_inittable then
-                begin
-                   reference_reset_symbol(href,tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
-                   emitpushreferenceaddr(href);
-
-                   { push pointer we just allocated, we need to initialize the
-                     data located at that pointer not the pointer self (PFV) }
-                   cg.a_param_loc(exprasmlist,location,1);
-                   emitcall('FPC_INITIALIZE');
-                end;
-              rg.restoreusedregisters(exprasmlist,pushed);
-              { may be load ESI }
-              maybe_loadself;
-           end;
-      end;
-
-
 {*****************************************************************************
                              TI386ADDRNODE
 *****************************************************************************}
@@ -125,86 +69,6 @@ implementation
           location.segment:=left.location.reference.segment;
       end;
 
-{*****************************************************************************
-                         TI386SIMPLENEWDISPOSENODE
-*****************************************************************************}
-
-    procedure ti386simplenewdisposenode.pass_2;
-
-      var
-         regstopush: tregisterset;
-         pushed : tpushedsaved;
-         href : treference;
-         lefttemp: treference;
-         left_needs_initfinal: boolean;
-
-         procedure saveleft;
-         begin
-           tg.gettempofsizereference(exprasmlist,pointer_size,lefttemp);
-           cg.a_load_loc_ref(exprasmlist,left.location,lefttemp);
-           location_release(exprasmlist,left.location);
-         end;
-
-      begin
-         secondpass(left);
-         if codegenerror then
-           exit;
-
-         left_needs_initfinal:=tpointerdef(left.resulttype.def).pointertype.def.needs_inittable;
-
-         regstopush := all_registers;
-         remove_non_regvars_from_loc(left.location,regstopush);
-         rg.saveusedregisters(exprasmlist,pushed,regstopush);
-         rg.saveregvars(exprasmlist,all_registers);
-
-         { call the mem handling procedures }
-         case nodetype of
-           simpledisposen:
-             begin
-                if left_needs_initfinal then
-                  begin
-                     reference_reset_symbol(href,tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
-                     emitpushreferenceaddr(href);
-                     { push pointer adress }
-                     cg.a_param_loc(exprasmlist,left.location,1);
-                     { save left and free its registers }
-                     saveleft;
-                     emitcall('FPC_FINALIZE');
-                     { push left again as parameter for freemem }
-                     emit_push_mem(lefttemp);
-                     tg.ungetiftemp(exprasmlist,lefttemp);
-                  end
-                else
-                  begin
-                    cg.a_param_loc(exprasmlist,left.location,1);
-                    location_release(exprasmlist,left.location);
-                  end;
-                emitcall('FPC_FREEMEM');
-             end;
-           simplenewn:
-             begin
-                { determines the size of the mem block }
-                push_int(tpointerdef(left.resulttype.def).pointertype.def.size);
-                emit_push_lea_loc(left.location,true);
-                { save left and free its registers }
-                if left_needs_initfinal then
-                  saveleft;
-                emitcall('FPC_GETMEM');
-                if left_needs_initfinal then
-                  begin
-                     reference_reset_symbol(href,tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
-                     emitpushreferenceaddr(href);
-                     emit_push_mem(lefttemp);
-                     tg.ungetiftemp(exprasmlist,lefttemp);
-                     emitcall('FPC_INITIALIZE');
-                  end;
-             end;
-         end;
-         rg.restoreusedregisters(exprasmlist,pushed);
-         { may be load ESI }
-         maybe_loadself;
-      end;
-
 
 {*****************************************************************************
                            TI386DEREFNODE
@@ -219,11 +83,11 @@ implementation
          if not tpointerdef(left.resulttype.def).is_far and
             (cs_gdb_heaptrc in aktglobalswitches) and
             (cs_checkpointer in aktglobalswitches) then
-              begin
-                 emit_reg(
-                   A_PUSH,S_L,location.reference.base);
-                 emitcall('FPC_CHECKPOINTER');
-              end;
+          begin
+             emit_reg(
+               A_PUSH,S_L,location.reference.base);
+             emitcall('FPC_CHECKPOINTER');
+          end;
       end;
 
 
@@ -655,15 +519,20 @@ implementation
 
 
 begin
-   cnewnode:=ti386newnode;
-   csimplenewdisposenode:=ti386simplenewdisposenode;
    caddrnode:=ti386addrnode;
    cderefnode:=ti386derefnode;
    cvecnode:=ti386vecnode;
 end.
 {
   $Log$
-  Revision 1.27  2002-04-20 21:37:07  carl
+  Revision 1.28  2002-04-21 19:02:07  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.27  2002/04/20 21:37:07  carl
   + generic FPC_CHECKPOINTER
   + first parameter offset in stack now portable
   * rename some constants

compiler/i386/n386set.pas

@@ -899,7 +899,13 @@ implementation
          opsize:=bytes2Sxx[left.resulttype.def.size];
          { copy the case expression to a register }
          location_force_reg(left.location,def_cgsize(left.resulttype.def),false);
-         hregister:=left.location.register;
+         if opsize=S_Q then
+          begin
+            hregister:=left.location.registerlow;
+            hregister2:=left.location.registerhigh;
+          end
+         else
+          hregister:=left.location.register;
          if isjump then
           begin
             truelabel:=otl;
@@ -1030,7 +1036,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2002-04-21 15:37:26  carl
+  Revision 1.25  2002-04-21 19:02:07  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.24  2002/04/21 15:37:26  carl
   * changeregsize -> rg.makeregsize
 
   Revision 1.23  2002/04/19 15:39:35  peter

compiler/nbas.pas

@@ -81,7 +81,6 @@ interface
          { refs and deletenode can hook to this copy once they get copied too    }
          hookoncopy : ptempinfo;
          ref        : treference;
-         size       : longint;
          restype    : ttype;
          valid      : boolean;
        end;
@@ -91,6 +90,7 @@ interface
        ttempcreatenode = class(tnode)
           size: longint;
           tempinfo: ptempinfo;
+          persistent: boolean;
           { * persistent temps are used in manually written code where the temp }
           { be usable among different statements and where you can manually say }
           { when the temp has to be freed (using a ttempdeletenode)             }
@@ -103,8 +103,6 @@ interface
           function pass_1 : tnode; override;
           function det_resulttype: tnode; override;
           function docompare(p: tnode): boolean; override;
-         protected
-          persistent: boolean;
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -123,6 +121,9 @@ interface
         { a node which removes a temp }
         ttempdeletenode = class(tnode)
           constructor create(const temp: ttempcreatenode);
+          { this will convert the persistant temp to a normal temp
+            for returning to the other nodes }
+          constructor create_normal_temp(const temp: ttempcreatenode);
           function getcopy: tnode; override;
           function pass_1: tnode; override;
           function det_resulttype: tnode; override;
@@ -130,6 +131,7 @@ interface
           destructor destroy; override;
          protected
           tempinfo: ptempinfo;
+          release_to_normal : boolean;
         end;
        ttempdeletenodeclass = class of ttempdeletenode;
 
@@ -143,6 +145,12 @@ interface
        ctemprefnode : ttemprefnodeclass;
        ctempdeletenode : ttempdeletenodeclass;
 
+       { Create a blocknode and statement node for multiple statements
+         generated internally by the parser }
+       function  internalstatements(var laststatement:tstatementnode):tblocknode;
+       procedure addstatement(var laststatement:tstatementnode;n:tnode);
+
+
 implementation
 
     uses
@@ -153,6 +161,28 @@ implementation
       ncal,nflw,rgobj,cgbase
       ;
 
+
+{*****************************************************************************
+                                     Helpers
+*****************************************************************************}
+
+    function internalstatements(var laststatement:tstatementnode):tblocknode;
+      begin
+        { create dummy initial statement }
+        laststatement := cstatementnode.create(nil,cnothingnode.create);
+        internalstatements := cblocknode.create(laststatement);
+      end;
+
+
+    procedure addstatement(var laststatement:tstatementnode;n:tnode);
+      begin
+        if assigned(laststatement.left) then
+         internalerror(200204201);
+        laststatement.left:=cstatementnode.create(nil,n);
+        laststatement:=tstatementnode(laststatement.left);
+      end;
+
+
 {*****************************************************************************
                              TFIRSTNOTHING
 *****************************************************************************}
@@ -239,6 +269,7 @@ implementation
          firstpass(right);
          if codegenerror then
            exit;
+         location.loc:=right.location.loc;
          registers32:=right.registers32;
          registersfpu:=right.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -306,6 +337,11 @@ implementation
                           (tcallnode(hp.right).procdefinition.proctypeoption=potype_constructor)) and
                       not(is_void(hp.right.resulttype.def)) then
                      CGMessage(cg_e_illegal_expression);
+                   { the resulttype of the block is the last type that is
+                     returned. Normally this is a voidtype. But when the
+                     compiler inserts a block of multiple statements then the
+                     last entry can return a value }
+                   resulttype:=hp.right.resulttype;
                 end;
               hp:=tstatementnode(hp.left);
            end;
@@ -389,6 +425,7 @@ implementation
               if hp.registersmmx>registersmmx then
                 registersmmx:=hp.registersmmx;
 {$endif}
+              location.loc:=hp.location.loc;
               inc(count);
               hp:=tstatementnode(hp.left);
            end;
@@ -456,7 +493,6 @@ implementation
         new(tempinfo);
         fillchar(tempinfo^,sizeof(tempinfo^),0);
         tempinfo^.restype := _restype;
-        tempinfo^.size := _size;
         persistent := _persistent;
       end;
 
@@ -470,7 +506,6 @@ implementation
         new(n.tempinfo);
         fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
         n.tempinfo^.restype := tempinfo^.restype;
-        n.tempinfo^.size:=size;
 
         { signal the temprefs that the temp they point to has been copied, }
         { so that if the refs get copied as well, they can hook themselves }
@@ -562,6 +597,16 @@ implementation
       begin
         inherited create(temprefn);
         tempinfo := temp.tempinfo;
+        release_to_normal := false;
+        if not temp.persistent then
+          internalerror(200204211);
+      end;
+
+    constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
+      begin
+        inherited create(temprefn);
+        tempinfo := temp.tempinfo;
+        release_to_normal := true;
       end;
 
     function ttempdeletenode.getcopy: tnode;
@@ -620,7 +665,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2002-04-04 19:05:57  peter
+  Revision 1.21  2002-04-21 19:02:03  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.20  2002/04/04 19:05:57  peter
     * removed unused units
     * use tlocation.size in cg.a_*loc*() routines
 

compiler/ncgbas.pas

@@ -94,6 +94,8 @@ interface
              begin
                rg.cleartempgen;
                secondpass(tstatementnode(hp).right);
+               { Compiler inserted blocks can return values }
+               location_copy(location,tstatementnode(hp).right.location);
              end;
             hp:=tstatementnode(hp).left;
           end;
@@ -223,7 +225,11 @@ interface
       begin
         { do second pass on left node }
         if assigned(left) then
-         secondpass(left);
+         begin
+           secondpass(left);
+           { Compiler inserted blocks can return values }
+           location_copy(location,left.location);
+         end;
       end;
 
 {*****************************************************************************
@@ -255,7 +261,7 @@ interface
         if not tempinfo^.valid then
           internalerror(200108231);
         { set the temp's location }
-        location_reset(location,LOC_REFERENCE,int_cgsize(tempinfo^.size));
+        location_reset(location,LOC_REFERENCE,def_cgsize(tempinfo^.restype.def));
         location.reference := tempinfo^.ref;
       end;
 
@@ -265,7 +271,10 @@ interface
 
     procedure tcgtempdeletenode.pass_2;
       begin
-        tg.ungetpersistanttempreference(exprasmlist,tempinfo^.ref);
+        if release_to_normal then
+          tg.persistanttemptonormal(tempinfo^.ref.offset)
+        else
+          tg.ungetpersistanttempreference(exprasmlist,tempinfo^.ref);
       end;
 
 
@@ -280,7 +289,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2002-04-04 19:05:57  peter
+  Revision 1.13  2002-04-21 19:02:03  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.12  2002/04/04 19:05:57  peter
     * removed unused units
     * use tlocation.size in cg.a_*loc*() routines
 

compiler/ncgcnv.pas

@@ -390,8 +390,15 @@ interface
       begin
         { we reuse the old value }
         location_copy(location,left.location);
+
+        { Floats should never be returned as LOC_CONSTANT, do the
+          moving to memory before the new size is set }
+        if (resulttype.def.deftype=floatdef) and
+           (location.loc=LOC_CONSTANT) then
+         location_force_mem(location);
+
         { but use the new size, but we don't know the size of all arrays }
-        location.size:=def_cgsize(resulttype.def)
+        location.size:=def_cgsize(resulttype.def);
       end;
 
 
@@ -434,7 +441,14 @@ end.
 
 {
   $Log$
-  Revision 1.10  2002-04-19 15:39:34  peter
+  Revision 1.11  2002-04-21 19:02:03  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.10  2002/04/19 15:39:34  peter
     * removed some more routines from cga
     * moved location_force_reg/mem to ncgutil
     * moved arrayconstructnode secondpass to ncgld

compiler/ncgutil.pas

@@ -298,6 +298,7 @@ implementation
           LOC_FPUREGISTER,
           LOC_CFPUREGISTER :
             begin
+              tg.gettempofsizereference(exprasmlist,TCGSize2Size[l.size],r);
               cg.a_loadfpu_reg_ref(exprasmlist,l.size,l.register,r);
               location_reset(l,LOC_REFERENCE,l.size);
               l.reference:=r;
@@ -382,7 +383,14 @@ end.
 
 {
   $Log$
-  Revision 1.9  2002-04-21 15:24:38  carl
+  Revision 1.10  2002-04-21 19:02:03  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.9  2002/04/21 15:24:38  carl
   + a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
   + changeregsize -> rg.makeregsize
 

compiler/ncnv.pas

@@ -1485,8 +1485,12 @@ implementation
         if convtype=tc_equal then
          begin
            { remove typeconv node if left is a const. For other nodes we can't
-             remove it because the secondpass can still depend on the old type (PFV) }
-           if is_constnode(left) then
+             remove it because the secondpass can still depend on the old type (PFV)
+             Conversions to float should also be left in the tree, because a float
+             is not possible in LOC_CONSTANT. The second_nothing routine will take
+             care of the conversion to LOC_REFERENCE }
+           if is_constnode(left) and
+              (resulttype.def.deftype<>floatdef) then
             begin
               left.resulttype:=resulttype;
               result:=left;
@@ -1701,7 +1705,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2002-04-06 18:10:42  jonas
+  Revision 1.52  2002-04-21 19:02:03  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.51  2002/04/06 18:10:42  jonas
     * several powerpc-related additions and fixes
 
   Revision 1.50  2002/04/04 19:05:58  peter

compiler/nld.pas

@@ -275,14 +275,12 @@ implementation
                    { process methodpointer }
                    if assigned(left) then
                     begin
-                      { if only typenode then remove }
+                      resulttypepass(left);
+
+                      { turn on the allowed flag, the secondpass
+                        will handle the typen itself }
                       if left.nodetype=typen then
-                       begin
-                         left.free;
-                         left:=nil;
-                       end
-                      else
-                       resulttypepass(left);
+                       ttypenode(left).allowed:=true;
                     end;
                 end;
            else
@@ -915,7 +913,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  2002-04-02 17:11:29  peter
+  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.34  2002/04/02 17:11:29  peter
     * tlocation,treference update
     * LOC_CONSTANT added for better constant handling
     * secondadd splitted in multiple routines

compiler/nmem.pas

@@ -40,19 +40,13 @@ interface
        tloadvmtnodeclass = class of tloadvmtnode;
 
        thnewnode = class(tnode)
-          constructor create;virtual;
+          objtype : ttype;
+          constructor create(t:ttype);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        end;
        thnewnodeclass = class of thnewnode;
 
-       tnewnode = class(tunarynode)
-          constructor create(l : tnode);virtual;
-          function pass_1 : tnode;override;
-          function det_resulttype:tnode;override;
-       end;
-       tnewnodeclass = class of tnewnode;
-
        thdisposenode = class(tunarynode)
           constructor create(l : tnode);virtual;
           function pass_1 : tnode;override;
@@ -60,13 +54,6 @@ interface
        end;
        thdisposenodeclass = class of thdisposenode;
 
-       tsimplenewdisposenode = class(tunarynode)
-          constructor create(n : tnodetype;l : tnode);
-          function pass_1 : tnode;override;
-          function det_resulttype:tnode;override;
-       end;
-       tsimplenewdisposenodeclass = class of tsimplenewdisposenode;
-
        taddrnode = class(tunarynode)
           getprocvardef : tprocvardef;
           constructor create(l : tnode);virtual;
@@ -130,9 +117,7 @@ interface
     var
        cloadvmtnode : tloadvmtnodeclass;
        chnewnode : thnewnodeclass;
-       cnewnode : tnewnodeclass;
        chdisposenode : thdisposenodeclass;
-       csimplenewdisposenode : tsimplenewdisposenodeclass;
        caddrnode : taddrnodeclass;
        cdoubleaddrnode : tdoubleaddrnodeclass;
        cderefnode : tderefnodeclass;
@@ -147,6 +132,7 @@ implementation
       globtype,systems,
       cutils,verbose,globals,
       symconst,symbase,types,
+      nbas,
       htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase
       ;
 
@@ -180,16 +166,19 @@ implementation
                              THNEWNODE
 *****************************************************************************}
 
-    constructor thnewnode.create;
+    constructor thnewnode.create(t:ttype);
       begin
          inherited create(hnewn);
+         objtype:=t;
       end;
 
 
     function thnewnode.det_resulttype:tnode;
       begin
         result:=nil;
-        resulttype:=voidtype;
+        if objtype.def.deftype<>objectdef then
+          Message(parser_e_pointer_to_class_expected);
+        resulttype:=objtype;
       end;
 
 
@@ -199,100 +188,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                              TNEWNODE
-*****************************************************************************}
-
-    constructor tnewnode.create(l : tnode);
-      begin
-         inherited create(newn,l);
-      end;
-
-
-    function tnewnode.det_resulttype:tnode;
-      begin
-        result:=nil;
-        if assigned(left) then
-         resulttypepass(left);
-        resulttype:=voidtype;
-      end;
-
-
-    function tnewnode.pass_1 : tnode;
-{$ifdef NEW_COMPILERPROC}
-      var
-        temp          : ttempcreatenode;
-        newstatement  : tstatementnode;
-        newblock      : tblocknode;
-{$endif NEW_COMPILERPROC}
-      begin
-         result:=nil;
-{$ifdef NEW_COMPILERPROC}
-         { create the blocknode which will hold the generated statements + }
-         { an initial dummy statement                                      }
-         newstatement := cstatementnode.create(nil,cnothingnode.create);
-         newblock := cblocknode.create(newstatement);
-
-         { create temp for result }
-         temp := ctempcreatenode.create(resulttype,
-                                        resulttype.size,true);
-         newstatement.left := cstatementnode.create(nil,temp);
-
-         { create parameter }
-         sizepara := ccallparanode.create(cordconstnode.create
-             (tpointerdef(resulttype.def).pointertype.def.size,s32bittype),nil);
-
-         { create the call and assign the result to dest  }
-         { the assignment will take care of rangechecking }
-         newstatement.left := cstatementnode.create(nil,cassignmentnode.create(
-           ctemprefnode.create(tempcode),
-           ccallnode.createintern('fpc_getmem',sizepara)));
-         newstatement := tstatementnode(newstatement.left);
-
-         if tpointerdef(resulttype.def).pointertype.def.needs_inittable then
-          begin
-            para := ccallparanode.create(cloadnode.create
-                       (tpointerdef(resulttype.def).pointertype.def.size,s32bittype),
-                    ccallparanode.create(cordconstnode.create
-                       (tpointerdef(resulttype.def).pointertype.def.size,s32bittype),nil));
-            newstatement.left := cstatementnode.create(nil,cassignmentnode.create(
-            ctemprefnode.create(tempcode),
-            ccallnode.createintern('fpc_initialize',sizepara)));
-            newstatement := tstatementnode(newstatement.left);
-            new(r);
-            reset_reference(r^);
-            r^.symbol:=tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_rtti_label(initrtti);
-            emitpushreferenceaddr(r^);
-            dispose(r);
-            { push pointer we just allocated, we need to initialize the
-              data located at that pointer not the pointer self (PFV) }
-            emit_push_loc(location);
-            emitcall('FPC_INITIALIZE');
-          end;
-
-         { and return it }
-         result := newblock;
-{$endif NEW_COMPILERPROC}
-
-         if assigned(left) then
-          begin
-            firstpass(left);
-            if codegenerror then
-             exit;
-
-            registers32:=left.registers32;
-            registersfpu:=left.registersfpu;
-{$ifdef SUPPORT_MMX}
-            registersmmx:=left.registersmmx;
-{$endif SUPPORT_MMX}
-            location.loc:=LOC_REGISTER
-          end
-         else
-          location.loc:=LOC_REFERENCE;
-         procinfo^.flags:=procinfo^.flags or pi_do_call;
-      end;
-
-
 {*****************************************************************************
                             THDISPOSENODE
 *****************************************************************************}
@@ -309,6 +204,8 @@ implementation
         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;
       end;
 
@@ -337,48 +234,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                        TSIMPLENEWDISPOSENODE
-*****************************************************************************}
-
-    constructor tsimplenewdisposenode.create(n : tnodetype;l : tnode);
-
-      begin
-         inherited create(n,l);
-      end;
-
-
-    function tsimplenewdisposenode.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:=voidtype;
-      end;
-
-
-    function tsimplenewdisposenode.pass_1 : tnode;
-      begin
-         result:=nil;
-         { this cannot be in a register !! }
-         make_not_regable(left);
-
-         firstpass(left);
-         if codegenerror then
-          exit;
-
-         registers32:=left.registers32;
-         registersfpu:=left.registersfpu;
-{$ifdef SUPPORT_MMX}
-         registersmmx:=left.registersmmx;
-{$endif SUPPORT_MMX}
-         procinfo^.flags:=procinfo^.flags or pi_do_call;
-      end;
-
-
 {*****************************************************************************
                              TADDRNODE
 *****************************************************************************}
@@ -1027,9 +882,7 @@ implementation
 begin
   cloadvmtnode := tloadvmtnode;
   chnewnode := thnewnode;
-  cnewnode := tnewnode;
   chdisposenode := thdisposenode;
-  csimplenewdisposenode := tsimplenewdisposenode;
   caddrnode := taddrnode;
   cdoubleaddrnode := tdoubleaddrnode;
   cderefnode := tderefnode;
@@ -1040,7 +893,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.28  2002-04-20 21:32:23  carl
+  Revision 1.29  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.28  2002/04/20 21:32:23  carl
   + generic FPC_CHECKPOINTER
   + first parameter offset in stack now portable
   * rename some constants

compiler/node.pas

@@ -86,8 +86,6 @@ interface
           typen,           {A type name. Used for i.e. typeof(obj).}
           hnewn,           {The new operation, constructor call.}
           hdisposen,       {The dispose operation with destructor call.}
-          newn,     {The new operation, constructor call.}
-          simpledisposen,  {The dispose operation.}
           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.}
@@ -104,10 +102,8 @@ interface
           casen,           {A case statement.}
           labeln,         {A label.}
           goton,           {A goto statement.}
-          simplenewn,      {The new operation.}
           tryexceptn,      {A try except block.}
           raisen,         {A raise statement.}
-          switchesn,       {??? Currently unused...}
           tryfinallyn,     {A try finally statement.}
           onn,       { for an on statement in exception code }
           isn,       {Represents the is operator.}
@@ -175,8 +171,6 @@ interface
           'typen',
           'hnewn',
           'hdisposen',
-          'newn',
-          'simpledisposen',
           'setelementn',
           'setconstn',
           'blockn',
@@ -193,10 +187,8 @@ interface
           'casen',
           'labeln',
           'goton',
-          'simplenewn',
           'tryexceptn',
           'raisen',
-          'switchesn',
           'tryfinallyn',
           'onn',
           'isn',
@@ -814,7 +806,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2002-04-06 18:13:01  jonas
+  Revision 1.24  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.23  2002/04/06 18:13:01  jonas
     * several powerpc-related additions and fixes
 
   Revision 1.22  2002/03/31 20:26:35  jonas

compiler/options.pas

@@ -382,6 +382,7 @@ begin
                         'l' : include(initglobalswitches,cs_asm_source);
                         'r' : include(initglobalswitches,cs_asm_regalloc);
                         't' : include(initglobalswitches,cs_asm_tempalloc);
+                        'n' : include(initglobalswitches,cs_asm_nodes);
                         '-' : initglobalswitches:=initglobalswitches -
                                 [cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc];
                        else
@@ -1345,6 +1346,7 @@ begin
   def_symbol('HAS_ADDR_STACK_ON_STACK');
   def_symbol('NOBOUNDCHECK');
   def_symbol('HASCOMPILERPROC');
+  def_symbol('VALUEGETMEM');
   def_symbol('VALUEFREEMEM');
 
   { some stuff for TP compatibility }
@@ -1379,7 +1381,7 @@ begin
    else
         internalerror(1295969);
   end;
-      
+
 
 { get default messagefile }
 {$ifdef Delphi}
@@ -1656,7 +1658,14 @@ finalization
 end.
 {
   $Log$
-  Revision 1.68  2002-04-20 21:32:24  carl
+  Revision 1.69  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.68  2002/04/20 21:32:24  carl
   + generic FPC_CHECKPOINTER
   + first parameter offset in stack now portable
   * rename some constants

compiler/pass_2.pas

@@ -47,7 +47,7 @@ procedure secondpass(var p : tnode);
 implementation
 
    uses
-{$ifdef logsecondpass}
+{$ifdef EXTDEBUG}
      cutils,
 {$endif}
      globtype,systems,verbose,
@@ -59,7 +59,7 @@ implementation
                               SecondPass
 *****************************************************************************}
 
-{$ifdef logsecondpass}
+{$ifdef EXTDEBUG}
      procedure logsecond(ht:tnodetype; entry: boolean);
        const
          secondnames: array[tnodetype] of string[13] =
@@ -92,9 +92,8 @@ implementation
              'ordconst',    {ordconstn}
              'typeconv',    {typeconvn}
              'calln',       {calln}
-             'nothing-callp',     {callparan}
+             'noth-callpar',     {callparan}
              'realconst',   {realconstn}
-             'fixconst',    {fixconstn}
              'unaryminus',  {unaryminusn}
              'asm',         {asmn}
              'vecn',        {vecn}
@@ -109,8 +108,6 @@ implementation
              'nothing-typen',     {typen}
              'hnewn',       {hnewn}
              'hdisposen',   {hdisposen}
-             'newn',        {newn}
-             'simplenewDISP', {simpledisposen}
              'setelement',  {setelementn}
              'setconst',    {setconstn}
              'blockn',      {blockn}
@@ -127,22 +124,25 @@ implementation
              'case',        {casen}
              'label',       {labeln}
              'goto',        {goton}
-             'simpleNEWdisp', {simplenewn}
              'tryexcept',   {tryexceptn}
              'raise',       {raisen}
-             'nothing-swtch',     {switchesn}
              'tryfinally',  {tryfinallyn}
              'on',    {onn}
              'is',    {isn}
              'as',    {asn}
              'error-caret',       {caretn}
              'fail',        {failn}
-             'add-startstar',  {starstarn}
+             'add-starstar',  {starstarn}
              'procinline',  {procinlinen}
              'arrayconstruc', {arrayconstructn}
              'noth-arrcnstr',     {arrayconstructrangen}
+             'tempn',
+             'temprefn',
+             'addoptn',
              'nothing-nothg',     {nothingn}
-             'loadvmt'      {loadvmtn}
+             'loadvmt',      {loadvmtn}
+             'guidconstn',
+             'rttin'
              );
       var
         p: pchar;
@@ -153,7 +153,7 @@ implementation
           p := strpnew('second'+secondnames[ht]+' (exit)');
         exprasmlist.concat(tai_asm_comment.create(p));
       end;
-{$endif logsecondpass}
+{$endif EXTDEBUG}
 
      procedure secondpass(var p : tnode);
       var
@@ -184,15 +184,13 @@ implementation
 {$ifdef EXTDEBUG}
             oldloc:=p.location.loc;
             p.location.loc:=LOC_INVALID;
+            if (cs_asm_nodes in aktglobalswitches) then
+              logsecond(p.nodetype,true);
 {$endif EXTDEBUG}
-{$ifdef logsecondpass}
-            logsecond(p.nodetype,true);
-{$endif logsecondpass}
             p.pass_2;
-{$ifdef logsecondpass}
-            logsecond(p.nodetype,false);
-{$endif logsecondpass}
 {$ifdef EXTDEBUG}
+            if (cs_asm_nodes in aktglobalswitches) then
+              logsecond(p.nodetype,false);
             if (not codegenerror) and
                (oldloc<>LOC_INVALID) and
                (p.location.loc=LOC_INVALID) then
@@ -256,48 +254,51 @@ implementation
          { only do secondpass if there are no errors }
          if ErrorCount=0 then
            begin
+{$ifdef OMITSTACKFRAME}
              if (cs_regalloc in aktglobalswitches) and
                 ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
                begin
-                                   { can we omit the stack frame ? }
-                                   { conditions:
-                                     1. procedure (not main block)
-                                     2. no constructor or destructor
-                                     3. no call to other procedures
-                                     4. no interrupt handler
-                                   }
-                                   {!!!!!! this doesn work yet, because of problems with
-                                      with linux and windows
-                                   }
-                                   (*
-                                   if assigned(aktprocsym) then
-                                     begin
-                                       if not(assigned(procinfo^._class)) and
-                                          not(aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) and
-                                          not(po_interrupt in aktprocdef.procoptions) and
-                                          ((procinfo^.flags and pi_do_call)=0) and
-                                          (lexlevel>=normal_function_level) then
-                                         begin
-                                          { use ESP as frame pointer }
-                                           procinfo^.framepointer:=STACK_POINTER_REG;
-                                           use_esp_stackframe:=true;
-
-                                          { calc parameter distance new }
-                                           dec(procinfo^.framepointer_offset,4);
-                                           dec(procinfo^.selfpointer_offset,4);
-
-                                          { is this correct ???}
-                                          { retoffset can be negativ for results in eax !! }
-                                          { the value should be decreased only if positive }
-                                           if procinfo^.retoffset>=0 then
-                                             dec(procinfo^.retoffset,4);
-
-                                           dec(procinfo^.para_offset,4);
-                                           aktprocdef.parast.address_fixup:=procinfo^.para_offset;
-                                         end;
-                                     end;
-                                    *)
-                                  end;
+                 { can we omit the stack frame ? }
+                 { conditions:
+                   1. procedure (not main block)
+                   2. no constructor or destructor
+                   3. no call to other procedures
+                   4. no interrupt handler
+                 }
+                 {!!!!!! this doesn work yet, because of problems with
+                    with linux and windows
+                 }
+                 (*
+                 if assigned(aktprocsym) then
+                   begin
+                     if not(assigned(procinfo^._class)) and
+                        not(aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) and
+                        not(po_interrupt in aktprocdef.procoptions) and
+                        ((procinfo^.flags and pi_do_call)=0) and
+                        (lexlevel>=normal_function_level) then
+                       begin
+                        { use ESP as frame pointer }
+                         procinfo^.framepointer:=STACK_POINTER_REG;
+                         use_esp_stackframe:=true;
+
+                        { calc parameter distance new }
+                         dec(procinfo^.framepointer_offset,4);
+                         dec(procinfo^.selfpointer_offset,4);
+
+                        { is this correct ???}
+                        { retoffset can be negativ for results in eax !! }
+                        { the value should be decreased only if positive }
+                         if procinfo^.retoffset>=0 then
+                           dec(procinfo^.retoffset,4);
+
+                         dec(procinfo^.para_offset,4);
+                         aktprocdef.parast.address_fixup:=procinfo^.para_offset;
+                       end;
+                   end;
+                  *)
+                end;
+{$endif OMITSTACKFRAME}
+
               { process register variable stuff (JM) }
               assign_regvars(p);
               load_regvars(procinfo^.aktentrycode,p);
@@ -320,7 +321,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  2002-04-20 21:32:24  carl
+  Revision 1.26  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.25  2002/04/20 21:32:24  carl
   + generic FPC_CHECKPOINTER
   + first parameter offset in stack now portable
   * rename some constants

compiler/pdecobj.pas

@@ -794,6 +794,7 @@ implementation
           p:=comp_expr(true);
           if p.nodetype=stringconstn then
             begin
+              stringdispose(aktclass.iidstr);
               aktclass.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
               p.free;
               aktclass.isiidguidvalid:=string2guid(aktclass.iidstr^,aktclass.iidguid);
@@ -1110,7 +1111,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  2002-04-19 15:46:02  peter
+  Revision 1.41  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.40  2002/04/19 15:46:02  peter
     * mangledname rewrite, tprocdef.mangledname is now created dynamicly
       in most cases and not written to the ppu
     * add mangeledname_prefix() routine to generate the prefix of

compiler/pdecsub.pas

@@ -329,7 +329,6 @@ implementation
         orgsp,sp:stringid;
         paramoffset:longint;
         sym:tsym;
-        doinsert : boolean;
         st : tsymtable;
         srsymtable : tsymtable;
         pdl     : pprocdeflist;
@@ -478,7 +477,6 @@ implementation
              end;
          end;
 
-        doinsert:=true;
         if assigned(aktprocsym) then
          begin
            { Check if overloaded is a procsym }
@@ -498,8 +496,9 @@ implementation
                   Message1(parser_e_overloaded_no_procedure,aktprocsym.realname)
                  else
                   DuplicateSym(aktprocsym);
-                 { don't reinsert as that will generated another error }
-                 doinsert:=false;
+                 { rename the name to an unique name to avoid an
+                   error when inserting the symbol in the symtable }
+                 orgsp:=orgsp+'$'+tostr(aktfilepos.line);
                end;
               { generate a new aktprocsym }
               aktprocsym:=nil;
@@ -537,8 +536,7 @@ implementation
              end
             else
              aktprocsym:=tprocsym.create(orgsp);
-            if doinsert then
-             symtablestack.insert(aktprocsym);
+            symtablestack.insert(aktprocsym);
          end;
 
         st:=symtablestack;
@@ -1908,23 +1906,31 @@ const
 
         { insert otsym only in the right symtable }
         if ((procinfo^.flags and pi_operator)<>0) and
-           assigned(otsym) and
-           not parse_only then
-          begin
-            if ret_in_param(aprocdef.rettype.def) then
-              begin
-                aprocdef.parast.insert(otsym);
-                { this increases the data size }
-                { correct this to get the right ret $value }
-                dec(aprocdef.parast.datasize,
-                    align(otsym.getpushsize,aktprocdef.parast.dataalignment));
-                { this allows to read the funcretoffset }
-                otsym.address:=-4;
-                otsym.varspez:=vs_var;
-              end
-            else
-              aprocdef.localst.insert(otsym);
-          end;
+           assigned(otsym) then
+         begin
+           if not parse_only then
+            begin
+              if ret_in_param(aprocdef.rettype.def) then
+               begin
+                 aprocdef.parast.insert(otsym);
+                 { this increases the data size }
+                 { correct this to get the right ret $value }
+                 dec(aprocdef.parast.datasize,
+                     align(otsym.getpushsize,aktprocdef.parast.dataalignment));
+                 { this allows to read the funcretoffset }
+                 otsym.address:=-4;
+                 otsym.varspez:=vs_var;
+               end
+              else
+               aprocdef.localst.insert(otsym);
+            end
+           else
+            begin
+              { this is not required anymore }
+              otsym.free;
+              otsym:=nil;
+            end;
+         end;
 
         proc_add_definition:=forwardfound;
       end;
@@ -1932,7 +1938,14 @@ const
 end.
 {
   $Log$
-  Revision 1.52  2002-04-20 21:32:24  carl
+  Revision 1.53  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.52  2002/04/20 21:32:24  carl
   + generic FPC_CHECKPOINTER
   + first parameter offset in stack now portable
   * rename some constants

compiler/pexpr.pas

@@ -220,6 +220,9 @@ implementation
 
     function new_dispose_statement(is_new:boolean) : tnode;
       var
+        newstatement : tstatementnode;
+        temp         : ttempcreatenode;
+        para         : tcallparanode;
         p,p2     : tnode;
         again    : boolean; { dummy for do_proc_call }
         destructorname : stringid;
@@ -293,11 +296,10 @@ implementation
             else
               begin
                 if is_new then
-                 p2:=chnewnode.create
+                 p2:=chnewnode.create(tpointerdef(p.resulttype.def).pointertype)
                 else
                  p2:=chdisposenode.create(p);
                 do_resulttypepass(p2);
-                p2.resulttype:=tpointerdef(p.resulttype.def).pointertype;
                 if is_new then
                   do_member_read(false,sym,p2,again)
                 else
@@ -329,8 +331,6 @@ implementation
                     begin
                       if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
                         Message(parser_e_expr_have_to_be_constructor_call);
-                      p2:=cnewnode.create(p2);
-                      do_resulttypepass(p2);
                       p2.resulttype:=p.resulttype;
                       p2:=cassignmentnode.create(p,p2);
                     end
@@ -365,10 +365,57 @@ implementation
                        Message(parser_e_no_new_dispose_on_void_pointers);
                     end;
 
+                  { create statements with call to getmem+initialize or
+                    finalize+freemem }
+                  new_dispose_statement:=internalstatements(newstatement);
+
                   if is_new then
-                    new_dispose_statement:=csimplenewdisposenode.create(simplenewn,p)
+                   begin
+                     { create temp for result }
+                     temp := ctempcreatenode.create(p.resulttype,p.resulttype.def.size,true);
+                     addstatement(newstatement,temp);
+
+                     { create call to fpc_getmem }
+                     para := ccallparanode.create(cordconstnode.create
+                         (tpointerdef(p.resulttype.def).pointertype.def.size,s32bittype),nil);
+                     addstatement(newstatement,cassignmentnode.create(
+                         ctemprefnode.create(temp),
+                         ccallnode.createintern('fpc_getmem',para)));
+
+                     { create call to fpc_initialize }
+                     if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
+                      begin
+                        para := ccallparanode.create(caddrnode.create(crttinode.create(
+                                   tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
+                                ccallparanode.create(ctemprefnode.create
+                                   (temp),nil));
+                        addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
+                      end;
+
+                     { copy the temp to the destination }
+                     addstatement(newstatement,cassignmentnode.create(
+                         p,
+                         ctemprefnode.create(temp)));
+
+                     { release temp }
+                     addstatement(newstatement,ctempdeletenode.create(temp));
+                   end
                   else
-                    new_dispose_statement:=csimplenewdisposenode.create(simpledisposen,p);
+                   begin
+                     { create call to fpc_finalize }
+                     if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
+                      begin
+                        { we need to use a copy of p here }
+                        para := ccallparanode.create(caddrnode.create(crttinode.create
+                                   (tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
+                                ccallparanode.create(p.getcopy,nil));
+                        addstatement(newstatement,ccallnode.createintern('fpc_finalize',para));
+                      end;
+
+                     { create call to fpc_freemem }
+                     para := ccallparanode.create(p,nil);
+                     addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));
+                   end;
                end;
           end;
         consume(_RKLAMMER);
@@ -377,6 +424,10 @@ implementation
 
     function new_function : tnode;
       var
+        newstatement : tstatementnode;
+        newblock     : tblocknode;
+        temp         : ttempcreatenode;
+        para         : tcallparanode;
         p1,p2  : tnode;
         classh : tobjectdef;
         sym    : tsym;
@@ -399,26 +450,52 @@ implementation
           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);
-            p2:=cnewnode.create(nil);
-            do_resulttypepass(p2);
-            p2.resulttype:=p1.resulttype;
+              Message(parser_w_use_extended_syntax_for_objects);
+
+            { create statements with call to getmem+initialize }
+            newblock:=internalstatements(newstatement);
+
+            { create temp for result }
+            temp := ctempcreatenode.create(p1.resulttype,p1.resulttype.def.size,true);
+            addstatement(newstatement,temp);
+
+            { create call to fpc_getmem }
+            para := ccallparanode.create(cordconstnode.create
+                (tpointerdef(p1.resulttype.def).pointertype.def.size,s32bittype),nil);
+            addstatement(newstatement,cassignmentnode.create(
+                ctemprefnode.create(temp),
+                ccallnode.createintern('fpc_getmem',para)));
+
+            { create call to fpc_initialize }
+            if tpointerdef(p1.resulttype.def).pointertype.def.needs_inittable then
+             begin
+               para := ccallparanode.create(caddrnode.create(crttinode.create
+                          (tstoreddef(tpointerdef(p1.resulttype.def).pointertype.def),initrtti)),
+                       ccallparanode.create(ctemprefnode.create
+                          (temp),nil));
+               addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
+             end;
+
+            { the last statement should return the value as
+              location and type, this is done be referencing the
+              temp and converting it first from a persistent temp to
+              normal temp }
+            addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+            addstatement(newstatement,ctemprefnode.create(temp));
+
             p1.destroy;
-            p1:=p2;
+            p1:=newblock;
             consume(_RKLAMMER);
           end
         else
           begin
-            p2:=chnewnode.create;
+            p2:=chnewnode.create(tpointerdef(p1.resulttype.def).pointertype);
             do_resulttypepass(p2);
-            p2.resulttype:=tpointerdef(p1.resulttype.def).pointertype;
             consume(_COMMA);
             afterassignment:=false;
             { determines the current object defintion }
             classh:=tobjectdef(p2.resulttype.def);
-            if classh.deftype<>objectdef then
-             Message(parser_e_pointer_to_class_expected)
-            else
+            if classh.deftype=objectdef then
              begin
                { check for an abstract class }
                if (oo_has_abstract in classh.objectoptions) then
@@ -434,9 +511,11 @@ implementation
                   (assigned(tcallnode(p2).procdefinition) and
                    (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor)) then
                 Message(parser_e_expr_have_to_be_constructor_call);
-             end;
-            p2:=cnewnode.create(p2);
-            do_resulttypepass(p2);
+             end
+            else
+             Message(parser_e_pointer_to_class_expected);
+            { constructors return boolean, update resulttype to return
+              the pointer to the object }
             p2.resulttype:=p1.resulttype;
             p1.destroy;
             p1:=p2;
@@ -2458,7 +2537,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.62  2002-04-16 16:11:17  peter
+  Revision 1.63  2002-04-21 19:02:05  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.62  2002/04/16 16:11:17  peter
     * using inherited; without a parent having the same function
       will do nothing like delphi
 

compiler/pstatmnt.pas

@@ -991,8 +991,8 @@ implementation
              { blockn support because a read/write is changed into a blocknode }
              { with a separate statement for each read/write operation (JM)    }
              { the same is true for val() if the third parameter is not 32 bit }
-             if not(p.nodetype in [nothingn,calln,assignn,breakn,inlinen,continuen,labeln,blockn,
-                                   simplenewn,simpledisposen]) then
+             if not(p.nodetype in [nothingn,calln,assignn,breakn,inlinen,
+                                   continuen,labeln,blockn]) then
                Message(cg_e_illegal_expression);
 
              { specify that we don't use the value returned by the call }
@@ -1071,7 +1071,7 @@ implementation
       {# Optimize the assembler block by removing all references
          which are via the frame pointer by replacing them with
          references via the stack pointer.
-         
+
          This is only available to certain cpu targets where
          the frame pointer saving must be done explicitly.
       }
@@ -1178,8 +1178,8 @@ implementation
            following conditions are met:
            - if the are no local variables
            - no reference to the result variable (refcount<=1)
-           - result is not stored as parameter 
-           - target processor has optional frame pointer save 
+           - result is not stored as parameter
+           - target processor has optional frame pointer save
              (vm, i386, vm only currently)
          }
          if (po_assembler in aktprocdef.procoptions) and
@@ -1213,7 +1213,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2002-04-20 21:32:24  carl
+  Revision 1.54  2002-04-21 19:02:05  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.53  2002/04/20 21:32:24  carl
   + generic FPC_CHECKPOINTER
   + first parameter offset in stack now portable
   * rename some constants

compiler/symdef.pas

@@ -745,6 +745,8 @@ implementation
         prefix : string;
       begin
         prefix:='';
+        if not assigned(st) then
+         internalerror(200204212);
         { sub procedures }
         while (st.symtabletype=localsymtable) do
          begin
@@ -5468,7 +5470,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.72  2002-04-20 21:32:25  carl
+  Revision 1.73  2002-04-21 19:02:05  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
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.72  2002/04/20 21:32:25  carl
   + generic FPC_CHECKPOINTER
   + first parameter offset in stack now portable
   * rename some constants