* Copy() changed to internal function calling compilerprocs

  * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
    new copy functions

rtl/i386/i386.inc

@@ -732,7 +732,7 @@ end;
                                  String
 ****************************************************************************}
 
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 
 function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
 begin
@@ -768,7 +768,11 @@ begin
   end ['ESI','EDI','EAX','ECX'];
 end;
 
+{$ifdef interncopy}
+procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
+{$else}
 procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
+{$endif}
 begin
   asm
         pushl   %eax
@@ -1170,7 +1174,12 @@ procedure inclocked(var l : longint);assembler;
 
 {
   $Log$
-  Revision 1.30  2002-09-07 21:33:35  carl
+  Revision 1.31  2002-10-02 18:21:51  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.30  2002/09/07 21:33:35  carl
     - removed unused defines
 
   Revision 1.29  2002/09/07 16:01:19  peter

rtl/inc/astrings.inc

@@ -519,7 +519,11 @@ begin
 end;
 
 
+{$ifdef interncopy}
+Function Fpc_Ansistr_Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;compilerproc;
+{$else}
 Function Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
+{$endif}
 var
   ResultAddress : Pointer;
 begin
@@ -544,7 +548,11 @@ begin
         PByte(ResultAddress+Size)^:=0;
       end;
    end;
+{$ifdef interncopy}
+  Pointer(fpc_ansistr_Copy):=ResultAddress;
+{$else}
   Pointer(Copy):=ResultAddress;
+{$endif}
 end;
 
 
@@ -782,7 +790,12 @@ end;
 
 {
   $Log$
-  Revision 1.28  2002-09-14 11:20:50  carl
+  Revision 1.29  2002-10-02 18:21:51  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.28  2002/09/14 11:20:50  carl
     * Delphi compatibility fix (with string routines)
 
   Revision 1.27  2002/09/07 21:10:47  carl

rtl/inc/compproc.inc

@@ -47,16 +47,18 @@ function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
 function fpc_chararray_to_shortstr(const arr: array of char):shortstring; compilerproc;
 function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
 
-
-function fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc;
-function fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
+Function  fpc_shortstr_Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;compilerproc;
+Function  fpc_ansistr_Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;compilerproc;
+Function  fpc_widestr_Copy (Const S : WideString; Index,Size : Longint) : WideString;compilerproc;
+function  fpc_char_copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;compilerproc;
+procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer);compilerproc;
+
+function  fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc;
+function  fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
 procedure fpc_dynarray_clear(var p : pointer;ti : pointer); compilerproc;
 procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer); compilerproc;
 procedure fpc_dynarray_incr_ref(p : pointer); compilerproc;
-procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
-  dimcount : dword;dims : pdynarrayindex); compilerproc;
-function fpc_dynarray_copy(var p : pointer;ti : pointer;
-  dimcount : dword;dims : pdynarrayindex) : pointer; compilerproc;
+procedure fpc_dynarray_setlength(var p : pointer;pti : pointer; dimcount : dword;dims : pdynarrayindex); compilerproc;
 
 procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring); compilerproc;
 procedure fpc_ShortStr_Longint(v : longint;len : longint;var s : shortstring); compilerproc;
@@ -263,7 +265,12 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
 
 {
   $Log$
-  Revision 1.23  2002-09-27 21:10:40  carl
+  Revision 1.24  2002-10-02 18:21:51  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.23  2002/09/27 21:10:40  carl
     * fix 2GB limit problem
 
   Revision 1.22  2002/09/07 21:12:04  carl

rtl/inc/dynarr.inc

@@ -248,20 +248,32 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
   end;
 
 
-function fpc_dynarray_copy(var p : pointer;ti : pointer;
-  dimcount : dword;dims : pdynarrayindex) : pointer;[Public,Alias:'FPC_DYNARRAY_COPY']; {$ifdef hascompilerproc} compilerproc; {$endif}
-
+procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer);{$ifdef hascompilerproc} compilerproc; {$endif}
+  var
+    size : longint;
   begin
-     { note: ti is of type pdynarrayinfo, but it can't be declared       }
-     { that way because this procedure is also declared in the interface }
-     { (as compilerproc) and the pdynarraytypeinfo isn't available there }
-     {!!!!!!!!!!}
+     pdest:=nil;
+     if psrc=nil then
+       exit;
+
+     { skip kind and name }
+     inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen));
+
+     { create new array }
+     size:=pdynarraytypeinfo(ti)^.elesize*(pdynarray(psrc)^.high+1)+sizeof(tdynarray);
+     getmem(pdest,size);
+     move(psrc^,pdest^,size);
   end;
 
 
 {
   $Log$
-  Revision 1.18  2002-09-07 15:07:45  peter
+  Revision 1.19  2002-10-02 18:21:51  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.18  2002/09/07 15:07:45  peter
     * old logs removed and tabs fixed
 
   Revision 1.17  2002/04/26 15:19:05  peter

rtl/inc/generic.inc

@@ -422,7 +422,7 @@ begin
      end
    else
      ppointer(_self+vmt_pos)^:=nil;
-   _self := nil;  
+   _self := nil;
 end;
 {$endif FPC_SYSTEM_HAS_FPC_HELP_FAIL}
 
@@ -506,7 +506,7 @@ end;
                                  String
 ****************************************************************************}
 
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 
 function fpc_shortstr_to_shortstr(len:longint;const sstr:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
 var
@@ -530,7 +530,11 @@ begin
     move(sstr[0],result[0],len+1);
 end;
 
+{$ifdef interncopy}
+procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; {$ifdef HAS_COMPILER_PROC} compilerproc; {$endif}
+{$else}
 procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY']; {$ifdef HAS_COMPILER_PROC} compilerproc; {$endif}
+{$endif}
 var
   slen : byte;
 type
@@ -557,7 +561,7 @@ begin
  }
 end;
 
-{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
+{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
 
@@ -920,7 +924,12 @@ end;
 {$endif ndef FPC_SYSTEM_HAS_INT_STR_LONGWORD}
 {
   $Log$
-  Revision 1.37  2002-09-27 21:10:40  carl
+  Revision 1.38  2002-10-02 18:21:51  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.37  2002/09/27 21:10:40  carl
     * fix 2GB limit problem
 
   Revision 1.36  2002/09/13 19:13:06  carl

rtl/inc/sstrings.inc

@@ -27,7 +27,11 @@ begin
   s[0]:=chr(len);
 end;
 
+{$ifdef interncopy}
+function fpc_shortstr_copy(const s : shortstring;index : StrLenInt;count : StrLenInt): shortstring;compilerproc;
+{$else}
 function copy(const s : shortstring;index : StrLenInt;count : StrLenInt): shortstring;
+{$endif}
 begin
   if count<0 then
    count:=0;
@@ -40,8 +44,13 @@ begin
   else
    if count>length(s)-index then
     count:=length(s)-index;
+{$ifdef interncopy}
+  fpc_shortstr_Copy[0]:=chr(Count);
+  Move(s[Index+1],fpc_shortstr_Copy[1],Count);
+{$else}
   Copy[0]:=chr(Count);
   Move(s[Index+1],Copy[1],Count);
+{$endif}
 end;
 
 
@@ -150,6 +159,15 @@ begin
 end;
 
 
+{$ifdef interncopy}
+function fpc_char_copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;compilerproc;
+begin
+  if (index=1) and (Count>0) then
+   fpc_char_Copy:=c
+  else
+   fpc_char_Copy:='';
+end;
+{$else}
 function copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
 begin
   if (index=1) and (Count>0) then
@@ -157,6 +175,7 @@ begin
   else
    Copy:='';
 end;
+{$endif}
 
 
 function pos(const substr : shortstring;c:char): StrLenInt;
@@ -659,7 +678,12 @@ end;
 
 {
   $Log$
-  Revision 1.23  2002-09-14 11:20:50  carl
+  Revision 1.24  2002-10-02 18:21:51  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.23  2002/09/14 11:20:50  carl
     * Delphi compatibility fix (with string routines)
 
   Revision 1.22  2002/09/07 21:19:00  carl

rtl/inc/systemh.inc

@@ -118,7 +118,7 @@ Type
   ValSInt = Longint;
   ValUInt = Cardinal;
   ValReal = Double;
-  
+
   { map comp to int64, but this doesn't mean to compile the comp support in! }
   Comp = Int64;
 {$endif powerpc}
@@ -351,7 +351,9 @@ function strlen(p:pchar):longint;
 {$ifndef INTERNSETLENGTH}
 Procedure SetLength (Var S:ShortString;len:StrLenInt);
 {$endif INTERNSETLENGTH}
+{$ifndef InternCopy}
 Function  Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;
+{$endif interncopy}
 Procedure Delete(Var s:shortstring;index:StrLenInt;count:StrLenInt);
 Procedure Insert(const source:shortstring;Var s:shortstring;index:StrLenInt);
 Procedure Insert(source:Char;Var s:shortstring;index:StrLenInt);
@@ -376,7 +378,9 @@ Function  binStr(Val:int64;cnt:byte):shortstring;
 Function  Chr(b:byte):Char;
 Function  upCase(c:Char):Char;
 Function  lowerCase(c:Char):Char; overload;
+{$ifndef InternCopy}
 function  copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
+{$endif interncopy}
 function  pos(const substr : shortstring;c:char): StrLenInt;
 {$ifndef INTERNLENGTH}
 function  length(c:char):byte;
@@ -394,7 +398,9 @@ Procedure UniqueString (Var S : AnsiString);
 {$ifndef INTERNLENGTH}
 Function  Length (Const S : AnsiString) : Longint;
 {$endif INTERNLENGTH}
+{$ifndef InternCopy}
 Function  Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
+{$endif interncopy}
 Function  Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint;
 Function  Pos (c : Char; Const s : AnsiString) : Longint;
 Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
@@ -416,7 +422,9 @@ Procedure UniqueString (Var S : WideString);
 {$ifndef INTERNLENGTH}
 Function  Length (Const S : WideString) : Longint;
 {$endif INTERNLENGTH}
+{$ifndef InternCopy}
 Function  Copy (Const S : WideString; Index,Size : Longint) : WideString;
+{$endif interncopy}
 Function  Pos (Const Substr : WideString; Const Source : WideString) : Longint;
 Function  Pos (c : Char; Const s : WideString) : Longint;
 Function  Pos (c : WideChar; Const s : WideString) : Longint;
@@ -596,7 +604,12 @@ const
 
 {
   $Log$
-  Revision 1.56  2002-09-28 21:18:02  florian
+  Revision 1.57  2002-10-02 18:21:51  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.56  2002/09/28 21:18:02  florian
     * map comp to int64 for the powerpc
 
   Revision 1.55  2002/09/26 21:50:37  florian

rtl/inc/wstrings.inc

@@ -619,7 +619,11 @@ begin
 end;
 
 
+{$ifdef interncopy}
+Function Fpc_WideStr_Copy (Const S : WideString; Index,Size : Longint) : WideString;compilerproc;
+{$else}
 Function Copy (Const S : WideString; Index,Size : Longint) : WideString;
+{$endif}
 var
   ResultAddress : Pointer;
 begin
@@ -644,7 +648,11 @@ begin
         PWideChar(ResultAddress+Size*sizeof(WideChar))^:=#0;
       end;
    end;
+{$ifdef interncopy}
+  Pointer(fpc_widestr_Copy):=ResultAddress;
+{$else}
   Pointer(Copy):=ResultAddress;
+{$endif}
 end;
 
 
@@ -880,7 +888,12 @@ end;
 
 {
   $Log$
-  Revision 1.22  2002-09-26 21:50:38  florian
+  Revision 1.23  2002-10-02 18:21:52  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.22  2002/09/26 21:50:38  florian
     + some WideString<->AnsiString conversion functions added
 
   Revision 1.21  2002/09/14 11:20:50  carl

rtl/powerpc/powerpc.inc

@@ -723,8 +723,12 @@ LShortStrCopyDone:
 end ['R0','R3','R4','R5','R10','CR0','CTR'];
 
 
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+{$ifdef interncopy}
+procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
+{$else}
 procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
+{$endif}
 assembler;
 { input: r3: len, r4: sstr, r5: dstr }
 asm
@@ -960,7 +964,12 @@ end ['R3','R10'];
 
 {
   $Log$
-  Revision 1.20  2002-09-10 21:30:34  jonas
+  Revision 1.21  2002-10-02 18:21:52  peter
+    * Copy() changed to internal function calling compilerprocs
+    * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
+      new copy functions
+
+  Revision 1.20  2002/09/10 21:30:34  jonas
     * disabled powerpc-specific fpc_shortstr_concat for now, it was
       completely wrong