* some fixes in compilerprocs for chararray to string conversions

  * conversion from string to chararray is now also done via compilerprocs

compiler/i386/n386cnv.pas

@@ -265,19 +265,10 @@ implementation
 
     procedure ti386typeconvnode.second_string_to_chararray;
       var
-         pushedregs: tpushed;
-         //l1 : tasmlabel;
-         //hr : preference;
-         arrsize, strtype: longint;
-         regstopush: byte;
+        arrsize: longint;
       begin
          with tarraydef(resulttype.def) do
-          begin
-            if highrange<lowrange then
-             internalerror(75432653);
-            arrsize := highrange-lowrange+1;
-          end;
-
+           arrsize := highrange-lowrange+1;
          if (left.nodetype = stringconstn) and
             { left.length+1 since there's always a terminating #0 character (JM) }
             (tstringconstnode(left).len+1 >= arrsize) and
@@ -285,67 +276,10 @@ implementation
            begin
              inc(location.reference.offset);
              exit;
-           end;
-         clear_location(location);
-         location.loc := LOC_REFERENCE;
-         gettempofsizereference(arrsize,location.reference);
-
-         regstopush := $ff;
-         remove_non_regvars_from_loc(left.location,regstopush);
-         pushusedregisters(pushedregs,regstopush);
-
-         emit_push_lea_loc(location,false);
-
-         case tstringdef(left.resulttype.def).string_typ of
-           st_shortstring :
-             begin
-               { 0 means shortstring }
-               strtype := 0;
-               del_reference(left.location.reference);
-               emit_push_lea_loc(left.location,true);
-               ungetiftemp(left.location.reference);
-             end;
-           st_ansistring :
-             begin
-               { 1 means ansistring }
-               strtype := 1;
-               case left.location.loc of
-                  LOC_CREGISTER,LOC_REGISTER:
-                    begin
-                      ungetregister(left.location.register);
-                      emit_push_loc(left.location);
-                    end;
-                  LOC_MEM,LOC_REFERENCE:
-                    begin
-                      del_reference(left.location.reference);
-                      emit_push_loc(left.location);
-                      ungetiftemp(left.location.reference);
-                    end;
-               end;
-             end;
-           st_longstring:
-             begin
-               {!!!!!!!}
-               { 2 means longstring, but still needs support in FPC_STR_TO_CHARARRAY,
-                 which is in i386.inc and/or generic.inc (JM) }
-               strtype := 2;
-
-               internalerror(8888);
-             end;
-           st_widestring:
-             begin
-               {!!!!!!!}
-               { 3 means widestring, but still needs support in FPC_STR_TO_CHARARRAY,
-                 which is in i386.inc and/or generic.inc (JM) }
-               strtype := 3;
-               internalerror(8888);
-             end;
-         end;
-         push_int(arrsize);
-         push_int(strtype);
-         saveregvars(regstopush);
-         emitcall('FPC_STR_TO_CHARARRAY');
-         popusedregisters(pushedregs);
+           end
+         else
+           { should be handled already in resulttype pass (JM) }
+           internalerror(200108292);
       end;
 
 
@@ -1066,7 +1000,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.21  2001-08-28 13:24:47  jonas
+  Revision 1.22  2001-08-29 19:49:03  jonas
+    * some fixes in compilerprocs for chararray to string conversions
+    * conversion from string to chararray is now also done via compilerprocs
+
+  Revision 1.21  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
       compilerproc implementations (using {$ifdef hascompilerproc} is not

compiler/ncnv.pas

@@ -43,6 +43,7 @@ interface
        private
           function resulttype_cord_to_pointer : tnode;
           function resulttype_chararray_to_string : tnode;
+          function resulttype_string_to_chararray : tnode;
           function resulttype_string_to_string : tnode;
           function resulttype_char_to_string : tnode;
           function resulttype_int_to_real : tnode;
@@ -57,7 +58,6 @@ interface
           function first_int_to_int : tnode;virtual;
           function first_cstring_to_pchar : tnode;virtual;
           function first_string_to_chararray : tnode;virtual;
-          function first_string_to_string : tnode;virtual;
           function first_char_to_string : tnode;virtual;
           function first_nothing : tnode;virtual;
           function first_array_to_pointer : tnode;virtual;
@@ -430,6 +430,32 @@ implementation
         resulttypepass(result);
       end;
     
+    function ttypeconvnode.resulttype_string_to_chararray : tnode;
+      var
+        arrsize: longint;
+      begin
+         with tarraydef(resulttype.def) do
+          begin
+            if highrange<lowrange then
+             internalerror(75432653);
+            arrsize := highrange-lowrange+1;
+          end;
+         if (left.nodetype = stringconstn) and
+            { left.length+1 since there's always a terminating #0 character (JM) }
+            (tstringconstnode(left).len+1 >= arrsize) and
+            (tstringdef(left.resulttype.def).string_typ=st_shortstring) then
+           begin
+             { handled separately }
+             result := nil;
+             exit;
+           end;
+        result := ccallnode.createinternres(
+          'fpc_'+lower(tstringdef(left.resulttype.def).stringtypname)+
+          '_to_chararray',ccallparanode.create(left,ccallparanode.create(
+          cordconstnode.create(arrsize,s32bittype),nil)),resulttype);
+        left := nil;
+        resulttypepass(result);
+      end;
     
     function ttypeconvnode.resulttype_string_to_string : tnode;
       var
@@ -653,7 +679,7 @@ implementation
           { cchar_2_pchar } @ttypeconvnode.resulttype_cchar_to_pchar,
           { cstring_2_pchar } @ttypeconvnode.resulttype_cstring_to_pchar,
           { ansistring_2_pchar } nil,
-          { string_2_chararray } nil,
+          { string_2_chararray } @ttypeconvnode.resulttype_string_to_chararray,
           { chararray_2_string } @ttypeconvnode.resulttype_chararray_to_string,
           { array_2_pointer } nil,
           { pointer_2_array } nil,
@@ -1068,23 +1094,6 @@ implementation
       end;
 
 
-    function ttypeconvnode.first_string_to_string : tnode;
-      begin
-         first_string_to_string:=nil;
-         if tstringdef(resulttype.def).string_typ<>
-            tstringdef(left.resulttype.def).string_typ then
-           begin
-             procinfo^.flags:=procinfo^.flags or pi_do_call;
-           end;
-         { for simplicity lets first keep all ansistrings
-           as LOC_MEM, could also become LOC_REGISTER }
-         if tstringdef(resulttype.def).string_typ in [st_ansistring,st_widestring] then
-           { we may use ansistrings so no fast exit here }
-           procinfo^.no_fast_exit:=true;
-         location.loc:=LOC_MEM;
-      end;
-
-
     function ttypeconvnode.first_char_to_string : tnode;
       begin
          first_char_to_string:=nil;
@@ -1262,14 +1271,14 @@ implementation
          firstconvert : array[tconverttype] of pointer = (
            @ttypeconvnode.first_nothing, {equal}
            @ttypeconvnode.first_nothing, {not_possible}
-           @ttypeconvnode.first_string_to_string,
+           nil, { removed in resulttype_string_to_string }
            @ttypeconvnode.first_char_to_string,
-           @ttypeconvnode.first_nothing, { removed in resulttype_chararray_to_string }
+           nil, { removed in resulttype_chararray_to_string }
            @ttypeconvnode.first_cchar_to_pchar,
            @ttypeconvnode.first_cstring_to_pchar,
            @ttypeconvnode.first_ansistring_to_pchar,
            @ttypeconvnode.first_string_to_chararray,
-           @ttypeconvnode.first_nothing, { removed in resulttype_chararray_to_string }
+           nil, { removed in resulttype_chararray_to_string }
            @ttypeconvnode.first_array_to_pointer,
            @ttypeconvnode.first_pointer_to_array,
            @ttypeconvnode.first_int_to_int,
@@ -1477,7 +1486,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  2001-08-29 12:18:07  jonas
+  Revision 1.35  2001-08-29 19:49:03  jonas
+    * some fixes in compilerprocs for chararray to string conversions
+    * conversion from string to chararray is now also done via compilerprocs
+
+  Revision 1.34  2001/08/29 12:18:07  jonas
     + new createinternres() constructor for tcallnode to support setting a
       custom resulttype
     * compilerproc typeconversions now set the resulttype from the type

rtl/i386/i386.inc

@@ -888,6 +888,11 @@ begin
         cld
         movl    arr,%esi
         movl    arr+4,%ecx
+{$ifdef hascompilerproc}
+        { previous implementations passed length(arr), with compilerproc }
+        { we only have high(arr), so add one (JM)                        }
+        incl    %ecx
+{$endif hascompilerproc}
         orl     %esi,%esi
         jnz     .LStrCharArrayNotNil
         movl    $0,%ecx
@@ -1139,7 +1144,11 @@ procedure inclocked(var l : longint);assembler;
 
 {
   $Log$
-  Revision 1.15  2001-08-28 13:24:47  jonas
+  Revision 1.16  2001-08-29 19:49:04  jonas
+    * some fixes in compilerprocs for chararray to string conversions
+    * conversion from string to chararray is now also done via compilerprocs
+
+  Revision 1.15  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
       compilerproc implementations (using {$ifdef hascompilerproc} is not

rtl/inc/astrings.inc

@@ -314,6 +314,8 @@ begin
     { result is automatically set to '' }
     exit;
   i:=IndexChar(arr,high(arr)+1,#0);
+  if i = -1 then
+    i := high(arr)+1;
   SetLength(fpc_CharArray_To_AnsiStr,i);
   Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
 end;
@@ -321,13 +323,46 @@ end;
 { old style helper }
 {$ifndef hascompilerproc}
 { the declaration below is the same as                                              }
-{ Procedure fpc_CharArray_To_AnsiStr(var a : ansistring; p: pointer; len: longint); }
 { which is what the old helper was (we need the parameter as "array of char" type   }
 { so we can pass it to the new style helper (JM)                                    }
-Procedure fpc_CharArray_To_AnsiStr(var a : ansistring; const arr: array of char);[Public,Alias : 'FPC_CHARARRAY_TO_ANSISTR'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+Procedure fpc_CharArray_To_AnsiStr(var a : ansistring; p: pointer; len: longint);[Public,Alias : 'FPC_CHARARRAY_TO_ANSISTR'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+  src: pchar;
+  i: longint;
+begin
+  src := pchar(p);
+  if src[0]=#0 Then
+    { result is automatically set to '' }
+    begin
+      pointer(a) := nil;
+      exit;
+    end;
+  i:=IndexChar(src^,len,#0);
+  if i = -1 then
+    i := len;
+  pointer(a) := NewAnsiString(i);
+  Move (src^,a[1],i);
+end;
+{$endif not hascompilerproc}
+
+
+{$ifdef hascompilerproc}
+
+{ note: inside the compiler, the resulttype is modified to be the length }
+{ of the actual chararray to which we convert (JM)                       }
+function fpc_ansistr_to_chararray(arraysize: longint; const src: ansistring): fpc_big_chararray; [public, alias: 'FPC_ANSISTR_TO_CHARARRAY']; compilerproc;
+var
+  len: longint;
 begin
-  pointer(a) := pointer(fpc_CharArray_To_AnsiStr(arr));
+  len := length(src);
+  if len > arraysize then
+    len := arraysize;
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],fpc_ansistr_to_chararray[0],len);
+  fillchar(fpc_ansistr_to_chararray[len],arraysize-len,0);
 end;
+
 {$endif hascompilerproc}
 
 
@@ -759,7 +794,11 @@ end;
 
 {
   $Log$
-  Revision 1.19  2001-08-28 13:24:47  jonas
+  Revision 1.20  2001-08-29 19:49:04  jonas
+    * some fixes in compilerprocs for chararray to string conversions
+    * conversion from string to chararray is now also done via compilerprocs
+
+  Revision 1.19  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
       compilerproc implementations (using {$ifdef hascompilerproc} is not

rtl/inc/compproc.inc

@@ -24,6 +24,9 @@
 
 {$ifdef hascompilerproc}
 
+type
+  fpc_big_chararray = array[0..maxlongint] of char;
+
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:StrLenInt); compilerproc;
 function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
 procedure fpc_shortstr_concat(const s1,s2:shortstring); compilerproc;
@@ -31,7 +34,8 @@ function fpc_shortstr_compare(const dstr,sstr:shortstring) : longint; compilerpr
 function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
 
 function fpc_chararray_to_shortstr(const arr: array of char):shortstring; compilerproc;
-procedure fpc_str_to_chararray(strtyp, arraysize: longint; src,dest: pchar);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;
@@ -61,6 +65,7 @@ Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerp
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
 Function fpc_CharArray_To_AnsiStr(const arr: array of char): ansistring; compilerproc;
+function fpc_ansistr_to_chararray(arraysize: longint; const src: ansistring): fpc_big_chararray; compilerproc;
 Function fpc_AnsiStr_Compare(S1,S2 : Pointer): Longint; compilerproc;
 Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
 Procedure fpc_AnsiStr_CheckRange(len,index : longint); compilerproc;
@@ -81,6 +86,7 @@ Procedure fpc_WideStr_Concat (S1,S2 : Pointer;var S3 : Pointer); compilerproc;
 Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc;
 Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
 Function fpc_CharArray_To_WideStr(const arr: array of char): WideString; compilerproc;
+function fpc_widestr_to_chararray(arraysize: longint; const src: WideString): fpc_big_chararray; compilerproc;
 Function fpc_WideStr_Compare(S1,S2 : Pointer): Longint; compilerproc;
 Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
 Procedure fpc_WideStr_CheckRange(len,index : longint); compilerproc;
@@ -231,7 +237,11 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
 
 {
   $Log$
-  Revision 1.5  2001-08-28 13:24:47  jonas
+  Revision 1.6  2001-08-29 19:49:04  jonas
+    * some fixes in compilerprocs for chararray to string conversions
+    * conversion from string to chararray is now also done via compilerprocs
+
+  Revision 1.5  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
       compilerproc implementations (using {$ifdef hascompilerproc} is not

rtl/inc/generic.inc

@@ -614,21 +614,50 @@ function strpas(p:pchar):shortstring; [external name 'FPC_PCHAR_TO_SHORTSTR'];
 
 {$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
 
-function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$ifdef hascompilerproc}
+function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR'];
 var
- s: shortstring;
-begin
+  l: longint;
+{$else hascompilerproc}
+function fpc_chararray_to_shortstr(const arr: array of char):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
+{$endif hascompilerproc}
+begin
+{$ifdef hascompilerproc}
+  l := high(arr)+1;
+{$endif hascompilerproc}
   if l>=256 then
     l:=255
   else if l<0 then
     l:=0;
-  move(p^,s[1],l);
-  s[0]:=chr(l);
-  strchararray := s;
+  move(arr[0],fpc_chararray_to_shortstr[1],l);
+  fpc_chararray_to_shortstr[0]:=chr(l);
 end;
 
 {$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
 
+{$ifdef hascompilerproc}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM)                                    }
+function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray;[public,alias: 'FPC_SHORTSTR_TO_CHARARRAY']; compilerproc;
+var
+  len: longint;
+begin
+  len := length(src);
+  if len > arraysize then
+    len := arraysize;
+  { make sure we don't access char 1 if length is 0 (JM) }
+  if len > 0 then
+    move(src[1],fpc_shortstr_to_chararray[0],len);
+  fillchar(fpc_shortstr_to_chararray[len],arraysize-len,0);
+end;
+
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
+
+{$else hascompilerproc}
+
 {$ifopt r+}
 {$define rangeon}
 {$r-}
@@ -664,6 +693,7 @@ begin
     move(src^,dest^,len);
   fillchar(dest[len],arraysize-len,0);
 end;
+
 {$endif FPC_SYSTEM_HAS_FPC_STR_TO_CHARARRAY}
 
 {$ifdef rangeon}
@@ -671,6 +701,8 @@ end;
 {undef rangeon}
 {$endif rangeon}
 
+{$endif hascompilerproc}
+
 {$ifndef FPC_SYSTEM_HAS_STRLEN}
 
 function strlen(p:pchar):longint;
@@ -857,7 +889,11 @@ end;
 
 {
   $Log$
-  Revision 1.18  2001-08-28 13:24:47  jonas
+  Revision 1.19  2001-08-29 19:49:04  jonas
+    * some fixes in compilerprocs for chararray to string conversions
+    * conversion from string to chararray is now also done via compilerprocs
+
+  Revision 1.18  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
       compilerproc implementations (using {$ifdef hascompilerproc} is not

rtl/inc/wstrings.inc

@@ -402,19 +402,47 @@ begin
     { result is automatically set to '' }
     exit;
   i:=IndexChar(arr,high(arr)+1,#0);
+  if i = -1 then
+    i := high(arr)+1;
   SetLength(fpc_CharArray_To_WideStr,i);
   Ansi2WideMoveProc (pchar(@arr),PWideChar(Pointer(fpc_CharArray_To_WideStr)),i);
 end;
 
 { old style helper }
 {$ifndef hascompilerproc}
-{ the declaration below is the same as                                              }
-{ Procedure fpc_CharArray_To_WideStr(var a : WideString; p: pointer; len: longint); }
-{ which is what the old helper was (we need the parameter as "array of char" type   }
-{ so we can pass it to the new style helper (JM)                                    }
-Procedure fpc_CharArray_To_WideStr(var a : WideString; const arr: array of char);[Public,Alias : 'FPC_CHARARRAY_TO_WIDESTR'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+Procedure fpc_CharArray_To_WideStr(var a : WideString; p: pointer; len: longint); [Public,Alias : 'FPC_CHARARRAY_TO_WIDESTR'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+  src: pchar;
+  i: longint;
+begin
+  src := pchar(p);
+  if src[0]=#0 Then
+    begin
+      pointer(a) := nil;
+      exit;
+    end;
+  i:=IndexChar(src^,len,#0);
+  if i = -1 then
+    i := len;
+  pointer(a) := NewWideString(i);
+  Ansi2WideMoveProc (src,PWideChar(Pointer(@a[1])),i);
+end;
+{$endif not hascompilerproc}
+
+{$ifdef hascompilerproc}
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM)                                    }
+function fpc_widestr_to_chararray(arraysize: longint; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
+var
+  len: longint;
 begin
-  pointer(a) := pointer(fpc_CharArray_To_WideStr(arr));
+  len := length(src);
+  if len > arraysize then
+    len := arraysize;
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    wide2ansimoveproc(pwidechar(@src[1]),pchar(@fpc_widestr_to_chararray[0]),len);
+  fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
 end;
 {$endif hascompilerproc}
 
@@ -812,7 +840,11 @@ end;
 
 {
   $Log$
-  Revision 1.13  2001-08-28 13:24:47  jonas
+  Revision 1.14  2001-08-29 19:49:04  jonas
+    * some fixes in compilerprocs for chararray to string conversions
+    * conversion from string to chararray is now also done via compilerprocs
+
+  Revision 1.13  2001/08/28 13:24:47  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
       compilerproc implementations (using {$ifdef hascompilerproc} is not