* Copy() is now internal syssym that calls compilerprocs

compiler/cgobj.pas

@@ -1098,7 +1098,7 @@ unit cgobj;
         if delsource then
          reference_release(list,source);
         a_param_const(list,OS_INT,len,paramanager.getintparaloc(1));
-        a_call_name(list,'FPC_SHORTSTR_COPY');
+        a_call_name(list,'FPC_SHORTSTR_ASSIGN');
         g_maybe_loadself(list);
       end;
 
@@ -1595,7 +1595,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.59  2002-09-17 18:54:02  jonas
+  Revision 1.60  2002-10-02 18:20:52  peter
+    * Copy() is now internal syssym that calls compilerprocs
+
+  Revision 1.59  2002/09/17 18:54:02  jonas
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       register size in the register name.

compiler/compinnr.inc

@@ -58,6 +58,7 @@ const
    in_new_x             = 46;
    in_dispose_x         = 47;
    in_exit              = 48;
+   in_copy_x            = 49;
 
 { Internal constant functions }
    in_const_trunc      = 100;
@@ -105,7 +106,10 @@ const
 
 {
   $Log$
-  Revision 1.8  2002-07-16 15:34:20  florian
+  Revision 1.9  2002-10-02 18:20:52  peter
+    * Copy() is now internal syssym that calls compilerprocs
+
+  Revision 1.8  2002/07/16 15:34:20  florian
     * exit is now a syssym instead of a keyword
 
   Revision 1.7  2002/05/18 13:34:06  peter

compiler/options.pas

@@ -1358,6 +1358,7 @@ begin
 {$endif i386}
   def_symbol('INTERNSETLENGTH');
   def_symbol('INTERNLENGTH');
+  def_symbol('INTERNCOPY');
   def_symbol('INT64FUNCRESOK');
   def_symbol('HAS_ADDR_STACK_ON_STACK');
   def_symbol('NOBOUNDCHECK');
@@ -1550,7 +1551,7 @@ begin
    exclude(initmoduleswitches,cs_fp_emulation)
   else
    def_symbol('M68K_FPU_EMULATED');
-   
+
   if initoptprocessor=MC68020 then
     def_symbol('CPUM68020');
 {$endif m68k}
@@ -1680,7 +1681,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.83  2002-09-22 14:02:35  carl
+  Revision 1.84  2002-10-02 18:20:52  peter
+    * Copy() is now internal syssym that calls compilerprocs
+
+  Revision 1.83  2002/09/22 14:02:35  carl
     * stack checking cannot be called before system unit is initialized
     * MC68020 define
 

compiler/pexpr.pas

@@ -441,23 +441,14 @@ implementation
 
           in_finalize_x:
             begin
-{              consume(_LKLAMMER);
-              in_args:=true;
-              p1:=comp_expr(true);
-              if token=_COMMA then
-               begin
-                 consume(_COMMA);
-                 p2:=ccallparanode.create(comp_expr(true),nil);
-               end
-              else
-               p2:=nil;
-              p2:=ccallparanode.create(p1,p2);
-              statement_syssym:=geninlinenode(in_finalize_x,false,p2);
-              consume(_RKLAMMER);
-}
               statement_syssym:=inline_finalize;
             end;
 
+          in_copy_x:
+            begin
+              statement_syssym:=inline_copy;
+            end;
+
           in_concat_x :
             begin
               consume(_LKLAMMER);
@@ -2254,7 +2245,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.82  2002-09-30 07:00:48  florian
+  Revision 1.83  2002-10-02 18:20:52  peter
+    * Copy() is now internal syssym that calls compilerprocs
+
+  Revision 1.82  2002/09/30 07:00:48  florian
     * fixes to common code to get the alpha compiler compiled applied
 
   Revision 1.81  2002/09/16 19:06:14  peter

compiler/pinline.pas

@@ -37,6 +37,7 @@ interface
 
     function inline_setlength : tnode;
     function inline_finalize : tnode;
+    function inline_copy : tnode;
 
 
 implementation
@@ -562,10 +563,95 @@ implementation
         result:=newblock;
       end;
 
+
+    function inline_copy : tnode;
+      var
+        copynode,
+        npara,
+        paras   : tnode;
+        temp    : ttempcreatenode;
+        ppn     : tcallparanode;
+        paradef : tdef;
+        newstatement : tstatementnode;
+      begin
+        { for easy exiting if something goes wrong }
+        result := cerrornode.create;
+
+        consume(_LKLAMMER);
+        paras:=parse_paras(false,false);
+        consume(_RKLAMMER);
+        if not assigned(paras) then
+         begin
+           CGMessage(parser_e_wrong_parameter_size);
+           exit;
+         end;
+
+        { determine copy function to use based on the first argument }
+        ppn:=tcallparanode(paras);
+        while assigned(ppn.right) do
+         ppn:=tcallparanode(ppn.right);
+        paradef:=ppn.left.resulttype.def;
+        if is_ansistring(paradef) then
+          copynode:=ccallnode.createintern('fpc_ansistr_copy',paras)
+        else
+         if is_widestring(paradef) then
+           copynode:=ccallnode.createintern('fpc_widestr_copy',paras)
+        else
+         if is_char(paradef) then
+           copynode:=ccallnode.createintern('fpc_char_copy',paras)
+        else
+         if is_dynamic_array(paradef) then
+          begin
+            { Copy(dynarr) has only 1 argument }
+            if assigned(tcallparanode(paras).right) then
+             begin
+               CGMessage(parser_e_wrong_parameter_size);
+               exit;
+             end;
+
+            { create statements with call }
+            copynode:=internalstatements(newstatement);
+
+            { create temp for result, we've to use a temp because a dynarray
+              type is handled differently from a pointer so we can't
+              use createinternres() and a function }
+            temp := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,true);
+            addstatement(newstatement,temp);
+
+            { create call to fpc_dynarray_copy }
+            npara:=ccallparanode.create(caddrnode.create
+                      (crttinode.create(tstoreddef(ppn.left.resulttype.def),initrtti)),
+                   ccallparanode.create
+                      (ctypeconvnode.create_explicit(ppn.left,voidpointertype),
+                   ccallparanode.create
+                      (ctemprefnode.create(temp),nil)));
+            addstatement(newstatement,ccallnode.createintern('fpc_dynarray_copy',npara));
+
+            { return the reference to the created temp, and
+              convert the type of the temp to the dynarray type }
+            addstatement(newstatement,ctypeconvnode.create_explicit(ctemprefnode.create(temp),ppn.left.resulttype));
+
+            ppn.left:=nil;
+            paras.free;
+          end
+        else
+         begin
+           { generic fallback that will give an error if a wrong
+             type is passed }
+           copynode:=ccallnode.createintern('fpc_shortstr_copy',paras)
+         end;
+
+        result.free;
+        result:=copynode;
+      end;
+
 end.
 {
   $Log$
-  Revision 1.7  2002-09-07 12:16:03  carl
+  Revision 1.8  2002-10-02 18:20:52  peter
+    * Copy() is now internal syssym that calls compilerprocs
+
+  Revision 1.7  2002/09/07 12:16:03  carl
     * second part bug report 1996 fix, testrange in cordconstnode
       only called if option is set (also make parsing a tiny faster)
 

compiler/psystem.pas

@@ -84,6 +84,7 @@ implementation
         p.insert(tsyssym.create('Addr',in_addr_x));
         p.insert(tsyssym.create('TypeInfo',in_typeinfo_x));
         p.insert(tsyssym.create('SetLength',in_setlength_x));
+        p.insert(tsyssym.create('Copy',in_copy_x));
         p.insert(tsyssym.create('Finalize',in_finalize_x));
         p.insert(tsyssym.create('Length',in_length_x));
         p.insert(tsyssym.create('New',in_new_x));
@@ -469,7 +470,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  2002-09-27 21:13:29  carl
+  Revision 1.41  2002-10-02 18:20:53  peter
+    * Copy() is now internal syssym that calls compilerprocs
+
+  Revision 1.40  2002/09/27 21:13:29  carl
     * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
 
   Revision 1.39  2002/09/07 20:46:10  carl