Browse Source

Merged revisions 6855,6905,6915,6932,6959,7015 via svnmerge from
svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r6855 | jonas | 2007-03-14 20:45:07 +0100 (Wed, 14 Mar 2007) | 7 lines

* changed fpc_big_chararray and fpc_big_widechararray from
array[0..1023] into array[0..0], because they're used as
dummy return types for the Xstring_to_chararray helpers,
and if a smaller array is actually passed as result then
having a larger array declared will cause -gt to
overwrite other data

........
r6905 | jonas | 2007-03-17 23:00:18 +0100 (Sat, 17 Mar 2007) | 2 lines

* test the (previously) working parts of this test

........
r6915 | jonas | 2007-03-18 13:20:01 +0100 (Sun, 18 Mar 2007) | 9 lines

* changed *string_to_*chararray helpers from functions into procedures
because on win64 the location of a function result can depend on its
size (so some chararrays had to be returned in registers and others
by reference, which means it's impossible to have a generic function
declaration which works in all cases) (mantis #8533)
* pad constant string assignments to chararrays with #0 up to the
length of the chararray for 2.0.x compatibility (fixes
tests/test/tarray3)

........
r6932 | jonas | 2007-03-19 14:45:16 +0100 (Mon, 19 Mar 2007) | 2 lines

* fixed typos (MacOS -> Mac OS)

........
r6959 | jonas | 2007-03-23 01:21:46 +0100 (Fri, 23 Mar 2007) | 2 lines

* fixed SSE2 substraction when both operands are on the 80x87 fpu stack

........
r7015 | jonas | 2007-03-28 15:42:18 +0200 (Wed, 28 Mar 2007) | 3 lines

* made less complex for sparc so it compiles there too without running
out of registers

........

git-svn-id: branches/fixes_2_2@7117 -

Jonas Maebe 18 years ago
parent
commit
0a1fd3ec07

+ 1 - 0
.gitattributes

@@ -6190,6 +6190,7 @@ tests/tbs/tb0530.pp svneol=native#text/plain
 tests/tbs/tb0531.pp svneol=native#text/plain
 tests/tbs/tb0531.pp svneol=native#text/plain
 tests/tbs/tb0533.pp svneol=native#text/plain
 tests/tbs/tb0533.pp svneol=native#text/plain
 tests/tbs/tb0534.pp svneol=native#text/plain
 tests/tbs/tb0534.pp svneol=native#text/plain
+tests/tbs/tb0535.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

+ 5 - 5
compiler/msg/errore.msg

@@ -2600,9 +2600,9 @@ S*2Aas_assemble using GNU AS
 A*2Tlinux_Linux
 A*2Tlinux_Linux
 A*2Twince_Windows CE
 A*2Twince_Windows CE
 P*2Tamiga_AmigaOS on PowerPC
 P*2Tamiga_AmigaOS on PowerPC
-P*2Tdarwin_Darwin and MacOS X on PowerPC
+P*2Tdarwin_Darwin and Mac OS X on PowerPC
 P*2Tlinux_Linux on PowerPC
 P*2Tlinux_Linux on PowerPC
-P*2Tmacos_MacOS (classic) on PowerPC
+P*2Tmacos_Mac OS (classic) on PowerPC
 P*2Tmorphos_MorphOS
 P*2Tmorphos_MorphOS
 S*2Tlinux_Linux
 S*2Tlinux_Linux
 **1u<x>_undefines the symbol <x>
 **1u<x>_undefines the symbol <x>
@@ -2630,9 +2630,9 @@ S*2Tlinux_Linux
 3*2WG_Specify graphic type application
 3*2WG_Specify graphic type application
 3*2WN_Do not generate relocation code (necessary for debugging)
 3*2WN_Do not generate relocation code (necessary for debugging)
 3*2WR_Generate relocation code
 3*2WR_Generate relocation code
-P*2WC_Specify console type application (MacOS only)
-P*2WG_Specify graphic type application (MacOS only)
-P*2WT_Specify tool type application (MPW tool, MacOS only)
+P*2WC_Specify console type application (Mac OS only)
+P*2WG_Specify graphic type application (Mac OS only)
+P*2WT_Specify tool type application (MPW tool, Mac OS only)
 **1X_executable options:
 **1X_executable options:
 **2Xc_pass --shared to the linker (Unix only)
 **2Xc_pass --shared to the linker (Unix only)
 **2Xd_don't use standard library search path (needed for cross compile)
 **2Xd_don't use standard library search path (needed for cross compile)

+ 1 - 1
compiler/msgidx.inc

@@ -721,7 +721,7 @@ const
   option_info=11024;
   option_info=11024;
   option_help_pages=11025;
   option_help_pages=11025;
 
 
-  MsgTxtSize = 42987;
+  MsgTxtSize = 42992;
 
 
   MsgIdxMax : array[1..20] of longint=(
   MsgIdxMax : array[1..20] of longint=(
     24,82,234,79,63,49,107,22,135,60,
     24,82,234,79,63,49,107,22,135,60,

+ 15 - 15
compiler/msgtxt.inc

@@ -989,57 +989,57 @@ const msgtxt : array[0..000179,1..240] of char=(
   'A*2Tlinux_Linux'#010+
   'A*2Tlinux_Linux'#010+
   'A*2Twince_Windows CE'#010+
   'A*2Twince_Windows CE'#010+
   'P*2Tamiga_AmigaOS on PowerPC'#010+
   'P*2Tamiga_AmigaOS on PowerPC'#010+
-  'P*2Tdarwin_Darwin and MacOS X on PowerPC'#010+
+  'P*2Tdarwin_Darwin and Mac OS X on PowerPC'#010+
   'P*2Tlinux_Linux on PowerPC'#010+
   'P*2Tlinux_Linux on PowerPC'#010+
-  'P*2Tmacos_MacOS (classic) on PowerPC'#010+
-  'P*','2Tmorphos_MorphOS'#010+
+  'P*2Tmacos_Mac OS (classic) on PowerPC'#010,
+  'P*2Tmorphos_MorphOS'#010+
   'S*2Tlinux_Linux'#010+
   'S*2Tlinux_Linux'#010+
   '**1u<x>_undefines the symbol <x>'#010+
   '**1u<x>_undefines the symbol <x>'#010+
   '**1U_unit options:'#010+
   '**1U_unit options:'#010+
   '**2Un_don'#039't check the unit name'#010+
   '**2Un_don'#039't check the unit name'#010+
   '**2Ur_generate release unit files'#010+
   '**2Ur_generate release unit files'#010+
   '**2Us_compile a system unit'#010+
   '**2Us_compile a system unit'#010+
-  '**1v<x>_Be verbose. <x> is a combination of the following le','tters:'#010+
+  '**1v<x>_Be verbose. <x> is a combination of the following ','letters:'#010+
   '**2*_e : Show errors (default)       0 : Show nothing (except errors)'#010+
   '**2*_e : Show errors (default)       0 : Show nothing (except errors)'#010+
   '**2*_w : Show warnings               u : Show unit info'#010+
   '**2*_w : Show warnings               u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
-  '**2*_h : Show hints                  c : Sho','w conditionals'#010+
+  '**2*_h : Show hints                  c : S','how conditionals'#010+
   '**2*_i : Show general info           d : Show debug info'#010+
   '**2*_i : Show general info           d : Show debug info'#010+
   '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
   '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
   '**2*_a : Show everything             x : Executable info (Win32 only)'#010+
   '**2*_a : Show everything             x : Executable info (Win32 only)'#010+
-  '**2*_b : Write file names me','ssages with full path'#010+
+  '**2*_b : Write file names ','messages with full path'#010+
   '**2*_v : write fpcdebug.txt with     p : Write tree.log with parse tre'+
   '**2*_v : write fpcdebug.txt with     p : Write tree.log with parse tre'+
   'e'#010+
   'e'#010+
   '**2*_    lots of debugging info'#010+
   '**2*_    lots of debugging info'#010+
   '3*1W<x>_Win32-like target options'#010+
   '3*1W<x>_Win32-like target options'#010+
   '3*2WB_Create a relocatable image'#010+
   '3*2WB_Create a relocatable image'#010+
-  '3*2WB<x>_Set Image base to Hexadecimal <x> valu','e'#010+
+  '3*2WB<x>_Set Image base to Hexadecimal <x> va','lue'#010+
   '3*2WC_Specify console type application'#010+
   '3*2WC_Specify console type application'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
   '3*2WF_Specify full-screen type application (OS/2 only)'#010+
   '3*2WF_Specify full-screen type application (OS/2 only)'#010+
   '3*2WG_Specify graphic type application'#010+
   '3*2WG_Specify graphic type application'#010+
-  '3*2WN_Do not generate relocation code (necessary for ','debugging)'#010+
+  '3*2WN_Do not generate relocation code (necessary fo','r debugging)'#010+
   '3*2WR_Generate relocation code'#010+
   '3*2WR_Generate relocation code'#010+
-  'P*2WC_Specify console type application (MacOS only)'#010+
-  'P*2WG_Specify graphic type application (MacOS only)'#010+
-  'P*2WT_Specify tool type application (MPW tool, MacOS only)'#010+
+  'P*2WC_Specify console type application (Mac OS only)'#010+
+  'P*2WG_Specify graphic type application (Mac OS only)'#010+
+  'P*2WT_Specify tool type application (MPW tool, Mac OS only)'#010+
   '**1X_executable options:'#010+
   '**1X_executable options:'#010+
-  '**2Xc_pass',' --shared to the linker (Unix only)'#010+
+  '**2Xc','_pass --shared to the linker (Unix only)'#010+
   '**2Xd_don'#039't use standard library search path (needed for cross com'+
   '**2Xd_don'#039't use standard library search path (needed for cross com'+
   'pile)'#010+
   'pile)'#010+
   '**2Xe_use external linker'#010+
   '**2Xe_use external linker'#010+
   '**2XD_try to link units dynamic          (defines FPC_LINK_DYNAMIC)'#010+
   '**2XD_try to link units dynamic          (defines FPC_LINK_DYNAMIC)'#010+
   '**2Xi_use internal linker'#010+
   '**2Xi_use internal linker'#010+
-  '**2Xm_genera','te link map'#010+
+  '**2Xm_g','enerate link map'#010+
   '**2XM<x>_set the name of the '#039'main'#039' program routine (default i'+
   '**2XM<x>_set the name of the '#039'main'#039' program routine (default i'+
   's '#039'main'#039')'#010+
   's '#039'main'#039')'#010+
   '**2XP<x>_prepend the binutils names with the prefix <x>'#010+
   '**2XP<x>_prepend the binutils names with the prefix <x>'#010+
   '**2Xr<x>_set library search path to <x> (needed for cross compile)'#010+
   '**2Xr<x>_set library search path to <x> (needed for cross compile)'#010+
-  '**2Xs_strip all symbols from exec','utable'#010+
+  '**2Xs_strip all symbols from',' executable'#010+
   '**2XS_try to link units static (default) (defines FPC_LINK_STATIC)'#010+
   '**2XS_try to link units static (default) (defines FPC_LINK_STATIC)'#010+
   '**2Xt_link with static libraries (-static is passed to linker)'#010+
   '**2Xt_link with static libraries (-static is passed to linker)'#010+
   '**2XX_try to link units smart            (defines FPC_LINK_SMART)'#010+
   '**2XX_try to link units smart            (defines FPC_LINK_SMART)'#010+
   '**1*_'#010+
   '**1*_'#010+
   '**1?_shows this help'#010+
   '**1?_shows this help'#010+
-  '**1h_shows',' this help without waiting'#000
+  '**1h_','shows this help without waiting'#000
 );
 );

+ 25 - 5
compiler/ncnv.pas

@@ -778,6 +778,10 @@ implementation
 
 
     function ttypeconvnode.typecheck_string_to_chararray : tnode;
     function ttypeconvnode.typecheck_string_to_chararray : tnode;
       var
       var
+        newblock : tblocknode;
+        newstat  : tstatementnode;
+        restemp  : ttempcreatenode;
+        pchtemp  : pchar;
         arrsize  : aint;
         arrsize  : aint;
         chartype : string[8];
         chartype : string[8];
       begin
       begin
@@ -795,7 +799,18 @@ implementation
                constant directly. This is handled in ncgcnv }
                constant directly. This is handled in ncgcnv }
              if (arrsize>=tstringconstnode(left).len) and
              if (arrsize>=tstringconstnode(left).len) and
                 is_char(tarraydef(resultdef).elementdef) then
                 is_char(tarraydef(resultdef).elementdef) then
-               exit;
+               begin
+                 { pad the constant string with #0 to the array len }
+                 { (2.0.x compatible)                               }
+                 if (arrsize>tstringconstnode(left).len) then
+                   begin
+                     pchtemp:=concatansistrings(tstringconstnode(left).value_str,pchar(StringOfChar(#0,arrsize-tstringconstnode(left).len)),tstringconstnode(left).len,arrsize-tstringconstnode(left).len);
+                     left.free;
+                     left:=cstringconstnode.createpchar(pchtemp,arrsize);
+                     typecheckpass(left);
+                   end;
+                 exit;
+               end;
              { Convert to wide/short/ansistring and call default helper }
              { Convert to wide/short/ansistring and call default helper }
              if is_widechar(tarraydef(resultdef).elementdef) then
              if is_widechar(tarraydef(resultdef).elementdef) then
                inserttypeconv(left,cwidestringtype)
                inserttypeconv(left,cwidestringtype)
@@ -811,11 +826,16 @@ implementation
           chartype:='widechar'
           chartype:='widechar'
         else
         else
           chartype:='char';
           chartype:='char';
-        result := ccallnode.createinternres(
-          'fpc_'+tstringdef(left.resultdef).stringtypname+
+        newblock:=internalstatements(newstat);
+        restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+        addstatement(newstat,restemp);
+        addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
           '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
           '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
-          cordconstnode.create(arrsize,s32inttype,true),nil)),resultdef);
-        left := nil;
+          ctemprefnode.create(restemp),nil))));
+        addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
+        addstatement(newstat,ctemprefnode.create(restemp));
+        result:=newblock;
+        left:=nil;
       end;
       end;
 
 
 
 

+ 2 - 0
compiler/options.pas

@@ -1956,6 +1956,8 @@ begin
   def_system_macro('FPC_HAS_VALGRINDBOOL');
   def_system_macro('FPC_HAS_VALGRINDBOOL');
   def_system_macro('FPC_HAS_STR_CURRENCY');
   def_system_macro('FPC_HAS_STR_CURRENCY');
   def_system_macro('FPC_REAL2REAL_FIXED');
   def_system_macro('FPC_REAL2REAL_FIXED');
+  def_system_macro('FPC_STRTOCHARARRAYPROC');
+
 {$if defined(x86) or defined(arm)}
 {$if defined(x86) or defined(arm)}
   def_system_macro('INTERNAL_BACKTRACE');
   def_system_macro('INTERNAL_BACKTRACE');
 {$endif}
 {$endif}

+ 30 - 16
compiler/x86/nx86add.pas

@@ -35,7 +35,7 @@ unit nx86add;
       protected
       protected
         function  getresflags(unsigned : boolean) : tresflags;
         function  getresflags(unsigned : boolean) : tresflags;
         procedure left_must_be_reg(opsize:TCGSize;noswap:boolean);
         procedure left_must_be_reg(opsize:TCGSize;noswap:boolean);
-        procedure left_and_right_must_be_fpureg;
+        procedure check_left_and_right_fpureg(force_fpureg: boolean);
         procedure emit_op_right_left(op:TAsmOp;opsize:TCgSize);
         procedure emit_op_right_left(op:TAsmOp;opsize:TCgSize);
         procedure emit_generic_code(op:TAsmOp;opsize:TCgSize;unsigned,extra_not,mboverflow:boolean);
         procedure emit_generic_code(op:TAsmOp;opsize:TCgSize;unsigned,extra_not,mboverflow:boolean);
 
 
@@ -212,25 +212,31 @@ unit nx86add;
        end;
        end;
 
 
 
 
-    procedure tx86addnode.left_and_right_must_be_fpureg;
+    procedure tx86addnode.check_left_and_right_fpureg(force_fpureg: boolean);
       begin
       begin
         if (right.location.loc<>LOC_FPUREGISTER) then
         if (right.location.loc<>LOC_FPUREGISTER) then
          begin
          begin
-           location_force_fpureg(current_asmdata.CurrAsmList,right.location,false);
-           if (left.location.loc<>LOC_FPUREGISTER) then
-             location_force_fpureg(current_asmdata.CurrAsmList,left.location,false)
-           else
-             { left was on the stack => swap }
-             toggleflag(nf_swapped);
+           if (force_fpureg) then
+             begin
+               location_force_fpureg(current_asmdata.CurrAsmList,right.location,false);
+                if (left.location.loc<>LOC_FPUREGISTER) then
+                  location_force_fpureg(current_asmdata.CurrAsmList,left.location,false)
+                else
+                  { left was on the stack => swap }
+                  toggleflag(nf_swapped);
+             end
          end
          end
         { the nominator in st0 }
         { the nominator in st0 }
         else if (left.location.loc<>LOC_FPUREGISTER) then
         else if (left.location.loc<>LOC_FPUREGISTER) then
-          location_force_fpureg(current_asmdata.CurrAsmList,left.location,false)
+          begin
+            if (force_fpureg) then
+              location_force_fpureg(current_asmdata.CurrAsmList,left.location,false)
+          end
         else
         else
-         begin
-           { fpu operands are always in the wrong order on the stack }
-           toggleflag(nf_swapped);
-         end;
+          begin
+            { fpu operands are always in the wrong order on the stack }
+            toggleflag(nf_swapped);
+          end;
       end;
       end;
 
 
 
 
@@ -700,8 +706,16 @@ unit nx86add;
         op : topcg;
         op : topcg;
       begin
       begin
         pass_left_right;
         pass_left_right;
+        check_left_and_right_fpureg(false);
+
         if (nf_swapped in flags) then
         if (nf_swapped in flags) then
-          swapleftright;
+          { can't use swapleftright if both are on the fpu stack, since then }
+          { both are "R_ST" -> nothing would change -> manually switch       }
+          if (left.location.loc = LOC_FPUREGISTER) and
+             (right.location.loc = LOC_FPUREGISTER) then
+            emit_none(A_FXCH,S_NO)
+          else
+            swapleftright;
 
 
         case nodetype of
         case nodetype of
           addn :
           addn :
@@ -885,7 +899,7 @@ unit nx86add;
             internalerror(2003042214);
             internalerror(2003042214);
         end;
         end;
 
 
-        left_and_right_must_be_fpureg;
+        check_left_and_right_fpureg(true);
 
 
         { if we swaped the tree nodes, then use the reverse operator }
         { if we swaped the tree nodes, then use the reverse operator }
         if nf_swapped in flags then
         if nf_swapped in flags then
@@ -915,7 +929,7 @@ unit nx86add;
           end;
           end;
 
 
         pass_left_right;
         pass_left_right;
-        left_and_right_must_be_fpureg;
+        check_left_and_right_fpureg(true);
 
 
 {$ifndef x86_64}
 {$ifndef x86_64}
         if current_settings.cputype<cpu_Pentium2 then
         if current_settings.cputype<cpu_Pentium2 then

+ 26 - 0
rtl/inc/astrings.inc

@@ -409,6 +409,7 @@ begin
   Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
   Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
 end;
 end;
 
 
+{$ifndef FPC_STRTOCHARARRAYPROC}
 
 
 { note: inside the compiler, the resulttype is modified to be the length }
 { note: inside the compiler, the resulttype is modified to be the length }
 { of the actual chararray to which we convert (JM)                       }
 { of the actual chararray to which we convert (JM)                       }
@@ -419,13 +420,38 @@ begin
   len := length(src);
   len := length(src);
   if len > arraysize then
   if len > arraysize then
     len := arraysize;
     len := arraysize;
+{$r-}
   { make sure we don't try to access element 1 of the ansistring if it's nil }
   { make sure we don't try to access element 1 of the ansistring if it's nil }
   if len > 0 then
   if len > 0 then
     move(src[1],fpc_ansistr_to_chararray[0],len);
     move(src[1],fpc_ansistr_to_chararray[0],len);
+  { fpc_big_chararray is defined as array[0..0], see compproc.inc why }
   fillchar(fpc_ansistr_to_chararray[len],arraysize-len,0);
   fillchar(fpc_ansistr_to_chararray[len],arraysize-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
 end;
 end;
 
 
+{$else ndef FPC_STRTOCHARARRAYPROC}
 
 
+procedure  fpc_ansistr_to_chararray(out res: array of char; const src: ansistring); compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],res[0],len);
+  { fpc_big_chararray is defined as array[0..0], see compproc.inc why }
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
 
 
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE'];  compilerproc;
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE'];  compilerproc;
 {
 {

+ 27 - 7
rtl/inc/compproc.inc

@@ -23,10 +23,15 @@
 
 
 { some dummy types necessary to have generic resulttypes for certain compilerprocs }
 { some dummy types necessary to have generic resulttypes for certain compilerprocs }
 type
 type
-  { normally the array shall be maxlongint big, but that will confuse
-    the debugger }
-  fpc_big_chararray = array[0..1023] of char;
-  fpc_big_widechararray = array[0..1023] of widechar;
+  { normally the array should be maxlongint big, but that will confuse
+    the debugger. The compiler will set the correct size of the array
+    internally. It's now set to 0..0 because when compiling with -gt,
+    the entire array will be trashed, so it must not be defined larger
+    than the minimal size (otherwise we can trash other memory) }
+{$ifndef FPC_STRTOCHARARRAYPROC}
+  fpc_big_chararray = array[0..0] of char;
+  fpc_big_widechararray = array[0..0] of widechar;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
   fpc_small_set = longint;
   fpc_small_set = longint;
   fpc_normal_set = array[0..7] of longint;
   fpc_normal_set = array[0..7] of longint;
 
 
@@ -54,7 +59,11 @@ function fpc_pchar_length(p:pchar):longint; compilerproc;
 function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
 function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
 
 
 function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring; compilerproc;
 function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring; compilerproc;
+{$ifndef FPC_STRTOCHARARRAYPROC}
 function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
 function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
 
 
 Function  fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
 Function  fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
 function  fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc;
 function  fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc;
@@ -170,7 +179,11 @@ Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerp
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
 Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
 Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
 Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
+{$ifndef FPC_STRTOCHARARRAYPROC}
 function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
 function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_ansistr_to_chararray(out res: array of char; const src: ansistring)compilerproc;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
 Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
 Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
 Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
 Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
@@ -204,13 +217,20 @@ Procedure fpc_WideStr_Concat_multi (Var DestS : Widestring;const sarr:array of W
 Function fpc_Char_To_WideStr(const c : WideChar): WideString; compilerproc;
 Function fpc_Char_To_WideStr(const c : WideChar): WideString; compilerproc;
 Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
 Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
 Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
 Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
+{$ifndef FPC_STRTOCHARARRAYPROC}
 function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray; compilerproc;
 function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray; compilerproc;
-Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
 Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
 Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
-Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
 Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
-Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
 Function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray; compilerproc;
 Function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
+procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
+procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
+procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
+Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
 Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerproc;
 Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerproc;
 Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
 Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;

+ 27 - 0
rtl/inc/generic.inc

@@ -760,6 +760,8 @@ end;
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
 
 
+{$ifndef FPC_STRTOCHARARRAYPROC}
+
 { inside the compiler, the resulttype is modified to that of the actual }
 { inside the compiler, the resulttype is modified to that of the actual }
 { chararray we're converting to (JM)                                    }
 { 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;
 function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray;[public,alias: 'FPC_SHORTSTR_TO_CHARARRAY']; compilerproc;
@@ -769,12 +771,37 @@ begin
   len := length(src);
   len := length(src);
   if len > arraysize then
   if len > arraysize then
     len := arraysize;
     len := arraysize;
+{$r-}
   { make sure we don't access char 1 if length is 0 (JM) }
   { make sure we don't access char 1 if length is 0 (JM) }
   if len > 0 then
   if len > 0 then
     move(src[1],fpc_shortstr_to_chararray[0],len);
     move(src[1],fpc_shortstr_to_chararray[0],len);
   fillchar(fpc_shortstr_to_chararray[len],arraysize-len,0);
   fillchar(fpc_shortstr_to_chararray[len],arraysize-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
 end;
 end;
 
 
+{$else ndef FPC_STRTOCHARARRAYPROC}
+
+procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
+var
+  len: longint;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't access char 1 if length is 0 (JM) }
+  if len > 0 then
+    move(src[1],res[0],len);
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+
 {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
 {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
 {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}

+ 102 - 0
rtl/inc/wstrings.inc

@@ -662,6 +662,8 @@ begin
   PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1])+i*sizeof(WideChar))^:=#0;
   PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1])+i*sizeof(WideChar))^:=#0;
 end;
 end;
 
 
+{$ifndef FPC_STRTOCHARARRAYPROC}
+
 { inside the compiler, the resulttype is modified to that of the actual }
 { inside the compiler, the resulttype is modified to that of the actual }
 { chararray we're converting to (JM)                                    }
 { chararray we're converting to (JM)                                    }
 function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
 function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
@@ -676,8 +678,12 @@ begin
   len := length(temp);
   len := length(temp);
   if len > arraysize then
   if len > arraysize then
     len := arraysize;
     len := arraysize;
+{$r-}
   move(temp[1],fpc_widestr_to_chararray[0],len);
   move(temp[1],fpc_widestr_to_chararray[0],len);
   fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
   fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
 end;
 end;
 
 
 
 
@@ -690,10 +696,14 @@ begin
   len := length(src);
   len := length(src);
   if len > arraysize then
   if len > arraysize then
     len := arraysize;
     len := arraysize;
+{$r-}
   { make sure we don't try to access element 1 of the ansistring if it's nil }
   { make sure we don't try to access element 1 of the ansistring if it's nil }
   if len > 0 then
   if len > 0 then
     move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
     move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
   fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
   fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
 end;
 end;
 
 
 
 
@@ -712,8 +722,12 @@ begin
   if len > arraysize then
   if len > arraysize then
     len := arraysize;
     len := arraysize;
 
 
+{$r-}
   move(temp[1],fpc_ansistr_to_widechararray[0],len*sizeof(widechar));
   move(temp[1],fpc_ansistr_to_widechararray[0],len*sizeof(widechar));
   fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
   fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
 end;
 end;
 
 
 function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; compilerproc;
 function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; compilerproc;
@@ -728,10 +742,98 @@ begin
   len := length(temp);
   len := length(temp);
   if len > arraysize then
   if len > arraysize then
     len := arraysize;
     len := arraysize;
+{$r-}
   move(temp[1],fpc_shortstr_to_widechararray[0],len*sizeof(widechar));
   move(temp[1],fpc_shortstr_to_widechararray[0],len*sizeof(widechar));
   fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
   fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$else ndef FPC_STRTOCHARARRAYPROC}
+
+procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
+var
+  len: SizeInt;
+  temp: ansistring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  move(temp[1],res[0],len);
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],res[0],len*SizeOf(WideChar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
+var
+  len: SizeInt;
+  temp: widestring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+
+{$r-}
+  move(temp[1],res[0],len*sizeof(widechar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
 end;
 end;
 
 
+procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
+var
+  len: longint;
+  temp : widestring;
+begin
+  len := length(src);
+  { make sure we don't access char 1 if length is 0 (JM) }
+  if len > 0 then
+    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  move(temp[1],res[0],len*sizeof(widechar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
 {
 {
   Compares 2 WideStrings;
   Compares 2 WideStrings;

+ 13 - 0
tests/tbs/tb0535.pp

@@ -0,0 +1,13 @@
+program bug;
+
+var l,h:longint;
+    r:single;
+
+begin
+  l:=-2;
+  h:=1;
+  r:=0;
+  r:=r+(single(h)-single(l))-1;
+  if trunc(r) <> 2 then
+    halt(1);
+end.

+ 16 - 4
tests/test/tarray3.pp

@@ -1,5 +1,4 @@
-{ %KNOWNRUNERROR=1 Known array of char problems }
-
+{$j+}
 {$P+}
 {$P+}
 
 
 type
 type
@@ -62,7 +61,8 @@ const
       Error('string length too big in calling var arg');
       Error('string length too big in calling var arg');
   end;
   end;
 
 
-{$P-}
+{ is global switch, can't turn off here }
+{P-}
   procedure testvarconv2(var st : string4);
   procedure testvarconv2(var st : string4);
   begin
   begin
     Writeln('st=',st);
     Writeln('st=',st);
@@ -95,8 +95,10 @@ begin
   Writeln('Testing if "',car4_1,'" is equal to "',cst4_1,'"');
   Writeln('Testing if "',car4_1,'" is equal to "',cst4_1,'"');
   if car4_1<>cst4_1 then
   if car4_1<>cst4_1 then
     error('Comparison of array of char and string don''t work');
     error('Comparison of array of char and string don''t work');
+{$ifdef test_known_problems}
   if string4(car6_2)<>'efgh' then
   if string4(car6_2)<>'efgh' then
     error('typcasting to shorter strings leads to problems');
     error('typcasting to shorter strings leads to problems');
+{$endif}
   ar4_2:='Test';
   ar4_2:='Test';
   ar4_1:=cst6_2;
   ar4_1:=cst6_2;
   if ar4_2<>'Test' then
   if ar4_2<>'Test' then
@@ -109,7 +111,7 @@ begin
   if ar6_1='AB'#0't'#0'T' then
   if ar6_1='AB'#0't'#0'T' then
     Error('assigning strings to array of char does not zero end of array if string is shorter');
     Error('assigning strings to array of char does not zero end of array if string is shorter');
   if ar6_1='AB'#0#0#0#0 then
   if ar6_1='AB'#0#0#0#0 then
-    writeln('assigning shorter strings to array of char does zero  fo tserarray')
+    writeln('assigning shorter strings to array of char does zero rest of array')
   else
   else
     error('assigning "AB" to ar6_1 gives '+ar6_1);
     error('assigning "AB" to ar6_1 gives '+ar6_1);
 {$endif}
 {$endif}
@@ -132,24 +134,34 @@ begin
   testvalueconv(pc);
   testvalueconv(pc);
 {$endif def FPC this is not allowed in BP !}
 {$endif def FPC this is not allowed in BP !}
   testconstconv('AB');
   testconstconv('AB');
+{$ifdef test_known_problems}
   testconstconv('ABCDEFG');
   testconstconv('ABCDEFG');
+{$endif}
   testconstconv(st4_1);
   testconstconv(st4_1);
+{$ifdef test_known_problems}
   testconstconv(cst6_2);
   testconstconv(cst6_2);
+{$endif}
 {$ifdef FPC this is not allowed in BP !}
 {$ifdef FPC this is not allowed in BP !}
+{$ifdef test_known_problems}
   testconstconv(pc);
   testconstconv(pc);
+{$endif}
 {$endif def FPC this is not allowed in BP !}
 {$endif def FPC this is not allowed in BP !}
   testvarconv(st4_2);
   testvarconv(st4_2);
   testvarconv(cst4_1);
   testvarconv(cst4_1);
 {$ifdef FPC this is not allowed in BP !}
 {$ifdef FPC this is not allowed in BP !}
+{$ifdef test_known_problems}
   testvarconv(st6_1);
   testvarconv(st6_1);
   testvarconv(cst8_1);
   testvarconv(cst8_1);
+{$endif}
 {$endif def FPC this is not allowed in BP !}
 {$endif def FPC this is not allowed in BP !}
   { testvarconv(pc); this one fails at compilation }
   { testvarconv(pc); this one fails at compilation }
   testvarconv2(st4_2);
   testvarconv2(st4_2);
   testvarconv2(cst4_1);
   testvarconv2(cst4_1);
 {$ifdef FPC this is not allowed in BP !}
 {$ifdef FPC this is not allowed in BP !}
+{$ifdef test_known_problems}
   testvarconv2(st6_1);
   testvarconv2(st6_1);
   testvarconv2(cst8_1);
   testvarconv2(cst8_1);
+{$endif}
 {$endif def FPC this is not allowed in BP !}
 {$endif def FPC this is not allowed in BP !}
   if has_errors then
   if has_errors then
     begin
     begin

+ 2 - 2
tests/webtbs/tw2242.pp

@@ -10922,7 +10922,7 @@ s += chr(85);
 s += chr(86);
 s += chr(86);
 s += chr(87);
 s += chr(87);
 s += chr(88);
 s += chr(88);
-{$ifndef cpuarm}
+{$if not defined(cpuarm) and not defined(cpusparc)}
 s += chr(89);
 s += chr(89);
 s += chr(90);
 s += chr(90);
 s += chr(65);
 s += chr(65);
@@ -13076,6 +13076,6 @@ s += chr(80);
 s += chr(81);
 s += chr(81);
 s += chr(82);
 s += chr(82);
 s += chr(83);
 s += chr(83);
-{$endif cpuarm}
+{$endif cpuarm or cpusparc}
 writeln(s)
 writeln(s)
 END.
 END.