浏览代码

* synchronised with latest changes to equivalent files in rtl/inc, in
particular the setstring changes

git-svn-id: trunk@28825 -

Jonas Maebe 10 年之前
父节点
当前提交
079b0167fc
共有 5 个文件被更改,包括 46 次插入27 次删除
  1. 1 1
      rtl/java/jsstrings.inc
  2. 26 22
      rtl/java/jsystem.inc
  3. 14 2
      rtl/java/jsystemh.inc
  4. 4 1
      rtl/java/jsystemh_types.inc
  5. 1 1
      rtl/java/justrings.inc

+ 1 - 1
rtl/java/jsstrings.inc

@@ -363,7 +363,7 @@ Function int_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; out Code
 
 
 {$define FPC_HAS_SETSTRING_SHORTSTR}
-Procedure SetString (Out S : Shortstring; Buf : PChar; Len : SizeInt);
+Procedure fpc_setstring_shortstr(Out S : Shortstring; Buf : PChar; Len : SizeInt); compilerproc;
 begin
   If Len > High(S) then
     Len := High(S);

+ 26 - 22
rtl/java/jsystem.inc

@@ -67,20 +67,6 @@ Const
                                 Local types
 ****************************************************************************}
 
-{
-  TextRec and FileRec are put in a separate file to make it available to other
-  units without putting it explicitly in systemh.
-  This way we keep TP compatibility, and the TextRec definition is available
-  for everyone who needs it.
-}
-{$ifdef FPC_HAS_FEATURE_FILEIO}
-{$i filerec.inc}
-{$endif FPC_HAS_FEATURE_FILEIO}
-
-{$ifndef CPUJVM}
-{$i textrec.inc}
-{$endif CPUJVM}
-
 {$ifdef FPC_HAS_FEATURE_EXITCODE}
   {$ifdef FPC_OBJFPC_EXTENDED_IF}
     {$if High(errorcode)<>maxExitCode}
@@ -108,7 +94,7 @@ const
 
 (*
 { For Error Handling.}
-  ErrorBase : Pointer = nil; public name 'FPC_ERRORBASE';
+  ErrorBase : Pointer = nil;public name 'FPC_ERRORBASE';
 *)
 
 {$ifndef cpujvm}
@@ -382,22 +368,22 @@ End;
 
 Function Swap (X : Longint) : Longint;{$ifdef SYSTEMINLINE}inline;{$endif}
 Begin
-  Swap:=(X and $ffff) shl 16 + (X shr 16)
+  Swap:=(X shl 16) + (X shr 16);
 End;
 
 //Function Swap (X : Cardinal) : Cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}
 //Begin
-//  Swap:=(X and $ffff) shl 16 + (X shr 16)
+//  Swap:=(X shl 16) + (X shr 16);
 //End;
 
 //Function Swap (X : QWord) : QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
 //Begin
-//  Swap:=(X and $ffffffff) shl 32 + (X shr 32);
+//  Swap:=(X shl 32) + (X shr 32);
 //End;
 
-Function swap (X : Int64) : Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Swap (X : Int64) : Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
 Begin
-  Swap:=(X and $ffffffff) shl 32 + (X shr 32);
+  Swap:=(X shl 32) + (X shr 32);
 End;
 
 {$ifdef SUPPORT_DOUBLE}
@@ -1576,6 +1562,7 @@ begin
 end;
 
 
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 procedure DoDirSeparators(var ps:RawByteString);
 var
   i : longint;
@@ -1595,7 +1582,10 @@ begin
         p[i-1]:=DirectorySeparator;
       end;
 end;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
+
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
 procedure DoDirSeparators(var ps:UnicodeString);
 var
   i : longint;
@@ -1615,6 +1605,7 @@ begin
         p[i-1]:=DirectorySeparator;
       end;
 end;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
 
 {$endif FPC_HAS_FEATURE_FILEIO}
 
@@ -1699,10 +1690,23 @@ end;
 
 {$endif FPC_HAS_FEATURE_FILEIO}
 
+(* already declared earlier in system.pp for java
+
+{ helper for targets supporting no ansistrings, it is used
+  by non-ansistring code }
+function min(v1,v2 : SizeInt) : SizeInt;
+  begin
+    if v1<v2 then
+      result:=v1
+    else
+      result:=v2;
+  end;
+*)
+
+{$ifdef FPC_HAS_FEATURE_TEXTIO}
 { Text file }
-{$ifndef CPUJVM}
 {$i text.inc}
-{$endif CPUJVM}
+{$endif FPC_HAS_FEATURE_TEXTIO}
 
 {$ifdef FPC_HAS_FEATURE_FILEIO}
 { Untyped file }

+ 14 - 2
rtl/java/jsystemh.inc

@@ -175,7 +175,12 @@ Function abs(l:longint):longint;[internproc:fpc_in_abs_long];
 {$else FPC_HAS_INTERNAL_ABS_LONG}
 Function abs(l:Longint):Longint;[internconst:fpc_in_const_abs];{$ifdef SYSTEMINLINE}inline;{$endif}
 {$endif FPC_HAS_INTERNAL_ABS_LONG}
+{$ifdef FPC_HAS_INTERNAL_ABS_INT64}
+{$define FPC_SYSTEM_HAS_ABS_INT64}
+Function abs(l:Int64):Int64;[internproc:fpc_in_abs_long];
+{$else FPC_HAS_INTERNAL_ABS_INT64}
 Function abs(l:Int64):Int64;[internconst:fpc_in_const_abs];{$ifdef SYSTEMINLINE}inline;{$endif}
+{$endif FPC_HAS_INTERNAL_ABS_INT64}
 Function sqr(l:Longint):Longint;[internconst:fpc_in_const_sqr];{$ifdef SYSTEMINLINE}inline;{$endif}
 Function sqr(l:Int64):Int64;[internconst:fpc_in_const_sqr];{$ifdef SYSTEMINLINE}inline;{$endif}
 Function sqr(l:QWord):QWord;[internconst:fpc_in_const_sqr]; external;
@@ -451,10 +456,16 @@ Function  Pos(const substr:shortstring;const s:shortstring):SizeInt;
 Function  Pos(C:Char;const s:shortstring):SizeInt;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Function  Pos(const Substr : ShortString; const Source : RawByteString) : SizeInt;
+
+{$ifdef FPC_HAS_CPSTRING}
+Procedure fpc_setstring_ansistr_pansichar(out S : RawByteString; Buf : PAnsiChar; Len : SizeInt; cp: TSystemCodePage); rtlproc; compilerproc;
+Procedure fpc_setstring_ansistr_pwidechar(out S : RawByteString; Buf : PWideChar; Len : SizeInt; cp: TSystemCodePage); rtlproc; compilerproc;
+{$else}
 Procedure SetString(out S : AnsiString; Buf : PAnsiChar; Len : SizeInt);
 Procedure SetString(out S : AnsiString; Buf : PWideChar; Len : SizeInt);
+{$endif}
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
-Procedure SetString (out S : Shortstring; Buf : PChar; Len : SizeInt);
+Procedure {$ifdef FPC_HAS_CPSTRING}fpc_setstring_shortstr{$else}SetString{$endif}(out S : Shortstring; Buf : PChar; Len : SizeInt); {$ifdef FPC_HAS_CPSTRING} compilerproc; {$endif FPC_HAS_CPSTRING}
 function  ShortCompareText(const S1, S2: shortstring): SizeInt;
 Function  upCase(const s:shortstring):shortstring;
 Function  lowerCase(const s:shortstring):shortstring; overload;
@@ -471,6 +482,7 @@ Function  binStr(Val:qword;cnt:byte):shortstring; {$ifdef cpujvm}external;{$endi
 {$ifdef CPUI8086}
 Function  hexStr(Val:NearPointer):shortstring;
 Function  hexStr(Val:FarPointer):shortstring;
+Function  hexStr(Val:HugePointer):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
 {$else CPUI8086}
 Function  hexStr(Val:Pointer):shortstring;
 {$endif CPUI8086}
@@ -758,7 +770,7 @@ Function  ParamStr(l:Longint):string;
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 
 {$ifndef JVM}
-Procedure Dump_Stack(var f : text;bp:pointer;addr : pointer = nil);
+Procedure Dump_Stack(var f : text;fp:pointer;addr : codepointer = nil);
 {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
 procedure DumpExceptionBackTrace(var f:text);
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}

+ 4 - 1
rtl/java/jsystemh_types.inc

@@ -507,7 +507,8 @@ Type
   { the size of textrec/filerec is hardcoded in the 2.6 compiler binary }
   {$define FPC_ANSI_TEXTFILEREC}
 {$endif}
-  TFileTextRecChar    = {$ifdef FPC_ANSI_TEXTFILEREC}AnsiChar{$else}UnicodeChar{$endif};
+
+  TFileTextRecChar    = {$if defined(FPC_ANSI_TEXTFILEREC) or not(defined(FPC_HAS_FEATURE_WIDESTRINGS))}AnsiChar{$else}UnicodeChar{$endif};
   PFileTextRecChar    = ^TFileTextRecChar;
 
   TTextLineBreakStyle = (tlbsLF,tlbsCRLF,tlbsCR);
@@ -703,6 +704,8 @@ Var
   { Stack checking }
   StackBottom : Pointer;
   StackLength : SizeUInt;
+
+function StackTop: Pointer;
 *)
 
 { Numbers for routines that have compiler magic }

+ 1 - 1
rtl/java/justrings.inc

@@ -760,7 +760,7 @@ end;
 
 
 {$define FPC_HAS_SETSTRING_UNICODESTR_PUNICODECHAR}
-Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
+Procedure fpc_setstring_unicodestr_pwidechar(Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt); compilerproc;
 begin
   if assigned(buf) and (Len>0) then
     s:=JLString.Create(TJCharArray(Buf),0,Len)