* var:=new(pointer_type) support added

compiler/cg386mem.pas

@@ -75,11 +75,45 @@ implementation
 *****************************************************************************}
 
     procedure secondnewn(var p : ptree);
+      var
+         pushed : tpushed;
+         r : preference;
       begin
-         secondpass(p^.left);
+         if assigned(p^.left) then
+           begin
+              secondpass(p^.left);
+              p^.location.register:=p^.left^.location.register;
+           end
+         else
+           begin
+              pushusedregisters(pushed,$ff);
+
+              { code copied from simplenewdispose PM }
+              { determines the size of the mem block }
+              push_int(ppointerdef(p^.resulttype)^.definition^.size);
+
+              gettempofsizereference(target_os.size_of_pointer,p^.location.reference);
+              emitpushreferenceaddr(exprasmlist,p^.location.reference);
+              
+              emitcall('FPC_GETMEM',true);
+              if ppointerdef(p^.resulttype)^.definition^.needs_inittable then
+                begin
+                   new(r);
+                   reset_reference(r^);
+                   r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
+                   emitpushreferenceaddr(exprasmlist,r^);
+                   { push pointer adress }
+                   emitpushreferenceaddr(exprasmlist,p^.location.reference);
+                   stringdispose(r^.symbol);
+                   dispose(r);
+                   emitcall('FPC_INITIALIZE',true);
+                end;
+              popusedregisters(pushed);
+              { may be load ESI }
+              maybe_loadesi;
+           end;
          if codegenerror then
            exit;
-         p^.location.register:=p^.left^.location.register;
       end;
 
 
@@ -157,6 +191,8 @@ implementation
                         LOC_REFERENCE:
                           emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                      end;
+                     stringdispose(r^.symbol);
+                     dispose(r);
                      emitcall('FPC_FINALIZE',true);
                   end;
                 emitcall('FPC_FREEMEM',true);
@@ -177,6 +213,8 @@ implementation
                         LOC_REFERENCE:
                           emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                      end;
+                     stringdispose(r^.symbol);
+                     dispose(r);
                      emitcall('FPC_INITIALIZE',true);
                   end;
              end;
@@ -702,7 +740,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  1998-11-20 15:35:55  florian
+  Revision 1.20  1998-11-25 19:12:54  pierre
+    * var:=new(pointer_type) support added
+
+  Revision 1.19  1998/11/20 15:35:55  florian
     * problems with rtti fixed, hope it works
 
   Revision 1.18  1998/11/17 00:36:40  peter

compiler/cg68kmem.pas

@@ -77,11 +77,46 @@ implementation
 *****************************************************************************}
 
     procedure secondnewn(var p : ptree);
+      var
+         pushed : tpushed;
+         r : preference;
       begin
-         secondpass(p^.left);
+         if assigned(p^.left) then
+           begin
+              secondpass(p^.left);
+              p^.location.register:=p^.left^.location.register;
+           end
+         else
+           begin
+              pushusedregisters(pushed,$ff);
+
+              { code copied from simplenewdispose PM }
+              { determines the size of the mem block }
+              push_int(ppointerdef(p^.resulttype)^.definition^.size);
+
+              gettempofsizereference(target_os.size_of_pointer,p^.location.reference);
+              emitpushreferenceaddr(exprasmlist,p^.location.reference);
+              
+              emitcall('FPC_GETMEM',true);
+{!!!!!!!}
+(*              if ppointerdef(p^.resulttype)^.definition^.needs_inittable then
+                begin
+                   new(r);
+                   reset_reference(r^);
+                   r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
+                   emitpushreferenceaddr(exprasmlist,r^);
+                   { push pointer adress }
+                   emitpushreferenceaddr(exprasmlist,p^.location.reference);
+                   stringdispose(r^.symbol);
+                   dispose(r);
+                   emitcall('FPC_INITIALIZE',true);
+                end; *)
+              popusedregisters(pushed);
+              { may be load ESI }
+              maybe_loada5;
+           end;
          if codegenerror then
            exit;
-         p^.location.register:=p^.left^.location.register;
       end;
 
 
@@ -689,7 +724,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  1998-10-14 11:28:21  florian
+  Revision 1.9  1998-11-25 19:12:55  pierre
+    * var:=new(pointer_type) support added
+
+  Revision 1.8  1998/10/14 11:28:21  florian
     * emitpushreferenceaddress gets now the asmlist as parameter
     * m68k version compiles with -duseansistrings
 

compiler/pexpr.pas

@@ -1420,10 +1420,14 @@ unit pexpr;
                   pd:=p1^.typenodetype;
                  pd2:=pd;
 
-                 if (pd^.deftype<>pointerdef) or
-                    (ppointerdef(pd)^.definition^.deftype<>objectdef) then
+                 if (pd^.deftype<>pointerdef) then
+                   Message(type_e_pointer_type_expected)
+                 else if (ppointerdef(pd)^.definition^.deftype<>objectdef) then
                   begin
-                    Message(parser_e_pointer_to_class_expected);
+                    p1:=gensinglenode(newn,nil);
+                    p1^.resulttype:=pd2;
+                    consume(RKLAMMER);
+                    (*Message(parser_e_pointer_to_class_expected);
                     { if an error occurs, read til the end of
                       the new statement }
                     p1:=genzeronode(errorn);
@@ -1437,7 +1441,7 @@ unit pexpr;
                        consume(token);
                        if l=0 then
                         break;
-                     end;
+                     end;*)
                   end
                  else
                   begin
@@ -1904,7 +1908,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.74  1998-11-13 10:18:11  peter
+  Revision 1.75  1998-11-25 19:12:51  pierre
+    * var:=new(pointer_type) support added
+
+  Revision 1.74  1998/11/13 10:18:11  peter
     + nil constants
 
   Revision 1.73  1998/11/05 12:02:52  peter

compiler/tcmem.pas

@@ -81,18 +81,25 @@ implementation
     procedure firstnew(var p : ptree);
       begin
          { Standardeinleitung }
-         firstpass(p^.left);
+         if assigned(p^.left) then
+           firstpass(p^.left);
 
          if codegenerror then
            exit;
-         p^.registers32:=p^.left^.registers32;
-         p^.registersfpu:=p^.left^.registersfpu;
+         if assigned(p^.left) then
+           begin
+              p^.registers32:=p^.left^.registers32;
+              p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
-         p^.registersmmx:=p^.left^.registersmmx;
+              p^.registersmmx:=p^.left^.registersmmx;
 {$endif SUPPORT_MMX}
+           end;
          { result type is already set }
          procinfo.flags:=procinfo.flags or pi_do_call;
-         p^.location.loc:=LOC_REGISTER;
+         if assigned(p^.left) then
+           p^.location.loc:=LOC_REGISTER
+         else
+           p^.location.loc:=LOC_REFERENCE;
       end;
 
 
@@ -500,7 +507,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  1998-09-26 15:03:05  florian
+  Revision 1.4  1998-11-25 19:12:53  pierre
+    * var:=new(pointer_type) support added
+
+  Revision 1.3  1998/09/26 15:03:05  florian
     * small problems with DOM and excpetions fixed (code generation
       of raise was wrong and self was sometimes destroyed :()