Browse Source

--- Merging r29469 into '.':
U rtl/inc/system.fpd
--- Merging r29470 into '.':
G rtl/inc/system.fpd
--- Merging r29475 into '.':
U compiler/msg/errore.msg
U compiler/msgtxt.inc
--- Merging r29477 into '.':
U rtl/dragonfly/x86_64/cprt0.as
--- Merging r29478 into '.':
U packages/openssl/src/openssl.pas
--- Merging r29491 into '.':
U installer/install.dat
--- Merging r29492 into '.':
U rtl/os2/sysos.inc
U rtl/os2/sysucode.inc
--- Merging r29494 into '.':
U utils/fpmake.pp

# revisions: 29469,29470,29475,29477,29478,29491,29492,29494

git-svn-id: branches/fixes_3_0@29505 -

marco 10 years ago
parent
commit
00092321e3

+ 1 - 1
compiler/msg/errore.msg

@@ -3760,7 +3760,7 @@ V*2Tembedded_Embedded
 **2*_a : Show everything             x : Show info about invoked tools
 **2*_a : Show everything             x : Show info about invoked tools
 **2*_b : Write file names messages   p : Write tree.log with parse tree
 **2*_b : Write file names messages   p : Write tree.log with parse tree
 **2*_    with full path              v : Write fpcdebug.txt with
 **2*_    with full path              v : Write fpcdebug.txt with
-**2*_                                    lots of debugging info
+**2*_z : Write output to stderr          lots of debugging info
 **2*_m<x>,<y> : Do not show messages numbered <x> and <y>
 **2*_m<x>,<y> : Do not show messages numbered <x> and <y>
 F*1V<x>_Append '-<x>' to the used compiler binary name (e.g. for version)
 F*1V<x>_Append '-<x>' to the used compiler binary name (e.g. for version)
 **1W<x>_Target-specific options (targets)
 **1W<x>_Target-specific options (targets)

+ 1 - 1
compiler/msgtxt.inc

@@ -1612,7 +1612,7 @@ const msgtxt : array[0..000310,1..240] of char=(
   '**2*_b : Write file names messages   p : Write tree','.log with parse t'+
   '**2*_b : Write file names messages   p : Write tree','.log with parse t'+
   'ree'#010+
   'ree'#010+
   '**2*_    with full path              v : Write fpcdebug.txt with'#010+
   '**2*_    with full path              v : Write fpcdebug.txt with'#010+
-  '**2*_                                    lots of debugging info'#010+
+  '**2*_z : Write output to stderr          lots of debugging info'#010+
   '**2*_m<x>,<y> : Do not show messages numbered <x> and <y>'#010+
   '**2*_m<x>,<y> : Do not show messages numbered <x> and <y>'#010+
   'F*1V<x>_Append '#039'-<x>'#039' to the use','d compiler binary name (e.g.'+
   'F*1V<x>_Append '#039'-<x>'#039' to the use','d compiler binary name (e.g.'+
   ' for version)'#010+
   ' for version)'#010+

+ 115 - 25
installer/install.dat

@@ -846,6 +846,22 @@ defaultcfg=
 # Parsing switches
 # Parsing switches
 # ----------------
 # ----------------
 
 
+# Pascal language mode
+#      -Mfpc      free pascal dialect (default)
+#      -Mobjfpc   switch some Delphi 2 extensions on
+#      -Mdelphi   tries to be Delphi compatible
+#      -Mtp       tries to be TP/BP 7.0 compatible
+#      -Mgpc      tries to be gpc compatible
+#      -Mmacpas   tries to be compatible to the macintosh pascal dialects
+#
+# Turn on Object Pascal extensions by default
+#-Mobjfpc
+
+# Assembler reader mode
+#      -Rdefault  use default assembler
+#      -Ratt      read AT&T style assembler
+#      -Rintel    read Intel style assembler
+#
 # All assembler blocks are intel styled by default
 # All assembler blocks are intel styled by default
 #-Rintel
 #-Rintel
 
 
@@ -856,19 +872,29 @@ defaultcfg=
 #-Rdirect
 #-Rdirect
 
 
 # Semantic checking
 # Semantic checking
-#  -S2        switch some Delphi 2 extensions on
-#  -Sc        supports operators like C (*=,+=,/= and -=)
-#  -Sd        tries to be Delphi compatible
-#  -Se<x>     compiler stops after the <x> errors (default is 1)
-#  -Sg        allow LABEL and GOTO
-#  -Sh        Use ansistrings
-#  -Si        support C++ styled INLINE
-#  -Sm        support macros like C (global)
-#  -So        tries to be TP/BP 7.0 compatible
-#  -Sp        tries to be gpc compatible
-#  -Ss        constructor name must be init (destructor must be done)
-#  -St        allow static keyword in objects
-# Allow goto, inline, C-operators
+#      -S2        same as -Mobjfpc
+#      -Sa        include assertion code.
+#      -Sc        supports operators like C (*=,+=,/= and -=)
+#      -Sd        same as -Mdelphi
+#      -Se<x>     error options. <x> is a combination of the following:
+#         <n> : compiler stops after <n> errors (default is 1)
+#         w   : compiler stops also after warnings
+#         n   : compiler stops also after notes
+#         h   : compiler stops also after hints
+#      -Sg        allow LABEL and GOTO
+#      -Sh        Use ansistrings
+#      -Si        support C++ styled INLINE
+#      -Sk        load fpcylix unit
+#      -SI<x>     set interface style to <x>
+#         -SIcom    COM compatible interface (default)
+#         -SIcorba  CORBA compatible interface
+#      -Sm        support macros like C (global)
+#      -So        same as -Mtp
+#      -Sp        same as -Mgpc
+#      -Ss        constructor name must be init (destructor must be done)
+#      -Sx        enable exception keywords (default in Delphi/ObjFPC modes)
+#
+# Allow goto, inline, C-operators, C-vars
 -Sgic
 -Sgic
 
 
 # ---------------
 # ---------------
@@ -890,9 +916,21 @@ defaultcfg=
 #-Ct
 #-Ct
 
 
 # Optimizer switches
 # Optimizer switches
-# -O1        level 1 optimizations (quick and debugger friendly)
-# -O2        level 2 optimizations (-O1 + quick optimizations)
-# -O3        level 3 optimizations (-O2 + slow optimizations)
+# -Os        generate smaller code
+# -Oa=N      set alignment to N
+# -O1        level 1 optimizations (quick optimizations, debuggable)
+# -O2        level 2 optimizations (-O1 + optimizations which make debugging more difficult)
+# -O3        level 3 optimizations (-O2 + optimizations which also may make the program slower rather than faster)
+# -Oo<x>     switch on optimalization x. See fpc -i for possible values
+# -OoNO<x>   switch off optimalization x. See fpc -i for possible values
+# -Op<x>     set target cpu for optimizing, see fpc -i for possible values
+
+#ifdef darwin
+#ifdef cpui386
+-Cppentiumm
+-Oppentiumm
+#endif
+#endif
 
 
 
 
 # -----------------------
 # -----------------------
@@ -909,6 +947,8 @@ defaultcfg=
 #-Fr%basepath%/msg/errord.msg
 #-Fr%basepath%/msg/errord.msg
 #-Fr%basepath%/msg/errorr.msg
 #-Fr%basepath%/msg/errorr.msg
 
 
+# search path for unicode binary files
+-FM%basepath%/unicode/
 # path to the gcclib
 # path to the gcclib
 #-Fl%basepath%/lib
 #-Fl%basepath%/lib
 
 
@@ -926,12 +966,42 @@ defaultcfg=
 -Fu%basepath%/units/%fpctargetmacro%/*
 -Fu%basepath%/units/%fpctargetmacro%/*
 -Fu%basepath%/units/%fpctargetmacro%/rtl
 -Fu%basepath%/units/%fpctargetmacro%/rtl
 
 
+#ifdef cpui8086
+-Fu%basepath%/units/%fpctargetmacro%/$fpcsubarch-$fpcmemorymodel
+-Fu%basepath%/units/%fpctargetmacro%/$fpcsubarch-$fpcmemorymodel/*
+-Fu%basepath%/units/%fpctargetmacro%/$fpcsubarch-$fpcmemorymodel/rtl
+#endif
+
 # searchpath for libraries
 # searchpath for libraries
 #-Fl%basepath%/lib
 #-Fl%basepath%/lib
 #-Fl/lib;/usr/lib
 #-Fl/lib;/usr/lib
 
 
 # searchpath for tools
 # searchpath for tools
 -FD%basepath%/bin/%fpctargetmacro%
 -FD%basepath%/bin/%fpctargetmacro%
+# never need cross-prefix when targeting the JVM
+# (no native compiler, always cross-compiling)
+#ifdef cpujvm
+#undef NEEDCROSSBINUTILS
+#endif
+
+# for android cross-prefix is set by compiler
+#ifdef android
+#undef NEEDCROSSBINUTILS
+#endif
+
+# never need cross-prefix when targeting the i8086
+# (no native compiler, always cross-compiling)
+#ifdef cpui8086
+#undef NEEDCROSSBINUTILS
+#endif
+
+# binutils prefix for cross compiling
+#IFDEF FPC_CROSSCOMPILING
+#IFDEF NEEDCROSSBINUTILS
+  -XP$FPCTARGET-
+#ENDIF
+#ENDIF
+
 
 
 # -------------
 # -------------
 # Linking
 # Linking
@@ -939,6 +1009,15 @@ defaultcfg=
 
 
 # generate always debugging information for GDB (slows down the compiling
 # generate always debugging information for GDB (slows down the compiling
 # process)
 # process)
+#      -gc        generate checks for pointers
+#      -gd        use dbx
+#      -gg        use gsym
+#      -gh        use heap trace unit (for memory leak debugging)
+#      -gl        use line info unit to show more info for backtraces
+#      -gv        generates programs tracable with valgrind
+#      -gw        generate dwarf debugging info
+#
+# Enable debuginfo and use the line info unit by default
 #-gl
 #-gl
 
 
 # always pass an option to the linker
 # always pass an option to the linker
@@ -947,6 +1026,13 @@ defaultcfg=
 # Always strip debuginfo from the executable
 # Always strip debuginfo from the executable
 -Xs
 -Xs
 
 
+# Always use smartlinking on i8086, because the system unit exceeds the 64kb
+# code limit
+#ifdef cpui8086
+-CX
+-XX
+#endif
+
 
 
 # -------------
 # -------------
 # Miscellaneous
 # Miscellaneous
@@ -956,15 +1042,19 @@ defaultcfg=
 -l
 -l
 
 
 # Verbosity
 # Verbosity
-# e : Show errors (default)       d : Show debug info
-# w : Show warnings               u : Show used files
-# n : Show notes                  t : Show tried files
-# h : Show hints                  m : Show defined macros
-# i : Show general info           p : Show compiled procedures
-# l : Show linenumbers            c : Show conditionals
-# a : Show everything             0 : Show nothing (except errors)
-
-# Display Info, Warnings, Notes and Hints
+#      e : Show errors (default)       d : Show debug info
+#      w : Show warnings               u : Show unit info
+#      n : Show notes                  t : Show tried/used files
+#      h : Show hints                  s : Show time stamps
+#      i : Show general info           q : Show message numbers
+#      l : Show linenumbers            c : Show conditionals
+#      a : Show everything             0 : Show nothing (except errors)
+#      b : Write file names messages   r : Rhide/GCC compatibility mode
+#          with full path              x : Executable info (Win32 only)
+#      v : write fpcdebug.txt with     p : Write tree.log with parse tree
+#          lots of debugging info
+#
+# Display Info, Warnings and Notes
 -viwn
 -viwn
 # If you don't want so much verbosity use
 # If you don't want so much verbosity use
 #-vw
 #-vw

+ 16 - 5
packages/openssl/src/openssl.pas

@@ -92,11 +92,15 @@ var
   {$ELSE}
   {$ELSE}
    {$IFDEF OS2}
    {$IFDEF OS2}
     {$IFDEF OS2GCC}
     {$IFDEF OS2GCC}
-  DLLSSLName: string = 'kssl.dll';
-  DLLUtilName: string = 'kcrypto.dll';
+  DLLSSLName: string = 'kssl10.dll';
+  DLLUtilName: string = 'kcrypt10.dll';
+  DLLSSLName2: string = 'kssl.dll';
+  DLLUtilName2: string = 'kcrypto.dll';
     {$ELSE OS2GCC}
     {$ELSE OS2GCC}
-  DLLSSLName: string = 'ssl.dll';
-  DLLUtilName: string = 'crypto.dll';
+  DLLSSLName: string = 'emssl10.dll';
+  DLLUtilName: string = 'emcrpt10.dll';
+  DLLSSLName2: string = 'ssl.dll';
+  DLLUtilName2: string = 'crypto.dll';
     {$ENDIF OS2GCC}
     {$ENDIF OS2GCC}
    {$ELSE OS2}
    {$ELSE OS2}
   DLLSSLName: string = 'libssl';
   DLLSSLName: string = 'libssl';
@@ -3430,7 +3434,14 @@ begin
   {$IFDEF MSWINDOWS}
   {$IFDEF MSWINDOWS}
   if (SSLLibHandle = 0) then
   if (SSLLibHandle = 0) then
     SSLLibHandle := LoadLib(DLLSSLName2);
     SSLLibHandle := LoadLib(DLLSSLName2);
-  {$ENDIF}
+  {$ELSE MSWINDOWS}
+   {$IFDEF OS2}
+  if (SSLUtilHandle = 0) then
+    SSLUtilHandle := LoadLib(DLLUtilName2);
+  if (SSLLibHandle = 0) then
+    SSLLibHandle := LoadLib(DLLSSLName2);
+   {$ENDIF OS2}
+  {$ENDIF MSWINDOWS}
   Result:=(SSLLibHandle<>0) and (SSLUtilHandle<>0);
   Result:=(SSLLibHandle<>0) and (SSLUtilHandle<>0);
 end;
 end;
 
 

+ 16 - 0
rtl/dragonfly/x86_64/cprt0.as

@@ -120,6 +120,22 @@ _start:
 	call	exit
 	call	exit
 .LFE5:
 .LFE5:
 	.size	_start, .-_start
 	.size	_start, .-_start
+.weak __error
+.type	__error, @function
+__error:
+.LFB9:
+	
+	pushq	%rbp
+	movq	%rsp, %rbp
+	movq	%fs:0, %rdx
+	movq	errno@gottpoff(%rip), %rax
+	addq	%rdx, %rax
+	popq	%rbp
+	ret
+	
+.LFE9:
+	.size	__error, .-__error
+
 .bss
 .bss
         .type   __stkptr,@object
         .type   __stkptr,@object
         .size   __stkptr,8
         .size   __stkptr,8

+ 2 - 0
rtl/inc/system.fpd

@@ -19,6 +19,8 @@ Type
    Char    = #0..#255;
    Char    = #0..#255;
    Longint = -2147483648..2147483647;
    Longint = -2147483648..2147483647;
    Longword= 0..4294967295;
    Longword= 0..4294967295;
+   Int64   = =-9223372036854775808.. 9223372036854775807;
+   QWord   = 0..18446744073709551615;
    Shortint= -128 .. 127;
    Shortint= -128 .. 127;
    Smallint= -32768 .. 32767;
    Smallint= -32768 .. 32767;
    Word    = 0 .. 65535;
    Word    = 0 .. 65535;

+ 0 - 2
rtl/os2/sysos.inc

@@ -446,8 +446,6 @@ function DosQueryDBCSEnv (Size: cardinal; var Country: TCountryCode;
                                                   Buf: PChar): cardinal; cdecl;
                                                   Buf: PChar): cardinal; cdecl;
 external 'NLS' index 6;
 external 'NLS' index 6;
 
 
-{
 function DosQueryCollate (Size: cardinal; var Country: TCountryCode;
 function DosQueryCollate (Size: cardinal; var Country: TCountryCode;
                      Buf: PByteArray; var TableLen: cardinal): cardinal; cdecl;
                      Buf: PByteArray; var TableLen: cardinal): cardinal; cdecl;
 external 'NLS' index 8;
 external 'NLS' index 8;
-}

+ 192 - 224
rtl/os2/sysucode.inc

@@ -174,6 +174,7 @@ type
 
 
 var
 var
   DBCSLeadRanges: array [0..11] of char;
   DBCSLeadRanges: array [0..11] of char;
+  CollationSequence: array [char] of char;
 
 
 
 
 const
 const
@@ -234,6 +235,7 @@ const
     #250, #251, #252, #253, #254, #255);
     #250, #251, #252, #253, #254, #255);
   NoIso88591Support: boolean = false;
   NoIso88591Support: boolean = false;
 
 
+
 threadvar
 threadvar
 (* Temporary allocations may be performed in parallel in different threads *)
 (* Temporary allocations may be performed in parallel in different threads *)
   TempCpRec: TCpRec;
   TempCpRec: TCpRec;
@@ -473,11 +475,16 @@ begin
     Inc (DBCSLeadRangesEnd, 2);
     Inc (DBCSLeadRangesEnd, 2);
 end;
 end;
 
 
-procedure InitDummyLowercase;
+
+procedure InitDummyAnsiSupport;
 var
 var
   C: char;
   C: char;
   AllChars: array [char] of char;
   AllChars: array [char] of char;
+  RetSize: cardinal;
 begin
 begin
+  if DosQueryCollate (SizeOf (CollationSequence), EmptyCC, @CollationSequence,
+                                                             RetSize) <> 0 then
+   Move (LowerChars, CollationSequence, SizeOf (CollationSequence));
   Move (LowerChars, AllChars, SizeOf (AllChars));
   Move (LowerChars, AllChars, SizeOf (AllChars));
   if DosMapCase (SizeOf (AllChars), IsoCC, @AllChars [#0]) <> 0 then
   if DosMapCase (SizeOf (AllChars), IsoCC, @AllChars [#0]) <> 0 then
 (* Codepage 819 may not be supported in all old OS/2 versions. *)
 (* Codepage 819 may not be supported in all old OS/2 versions. *)
@@ -503,13 +510,17 @@ begin
 end;
 end;
 
 
 
 
-procedure ReInitDummyLowercase;
+procedure ReInitDummyAnsiSupport;
 var
 var
   C: char;
   C: char;
   AllChars: array [char] of char;
   AllChars: array [char] of char;
+  RetSize: cardinal;
 begin
 begin
   for C := Low (char) to High (char) do
   for C := Low (char) to High (char) do
    AllChars [C] := C;
    AllChars [C] := C;
+  if DosQueryCollate (SizeOf (CollationSequence), EmptyCC, @CollationSequence,
+                                                             RetSize) <> 0 then
+   Move (AllChars, CollationSequence, SizeOf (CollationSequence));
   DosMapCase (SizeOf (AllChars), EmptyCC, @AllChars [#0]);
   DosMapCase (SizeOf (AllChars), EmptyCC, @AllChars [#0]);
   for C := Low (char) to High (char) do
   for C := Low (char) to High (char) do
    if AllChars [C] <> C then
    if AllChars [C] <> C then
@@ -742,7 +753,7 @@ begin
   if RCI <> 0 then
   if RCI <> 0 then
    OSErrorWatch (cardinal (RCI));
    OSErrorWatch (cardinal (RCI));
   if not (UniAPI) then
   if not (UniAPI) then
-   ReInitDummyLowercase;
+   ReInitDummyAnsiSupport;
   InInitDefaultCP := -1;
   InInitDefaultCP := -1;
 end;
 end;
 
 
@@ -1278,77 +1289,195 @@ begin
    end;
    end;
 end;
 end;
 
 
-      
-{
-      CompareStrAnsiStringProc:=@CompareStrAnsiString;
-      CompareTextAnsiStringProc:=@AnsiCompareText;
-      StrCompAnsiStringProc:=@StrCompAnsi;
-      StrICompAnsiStringProc:=@AnsiStrIComp;
-      StrLCompAnsiStringProc:=@AnsiStrLComp;
-      StrLICompAnsiStringProc:=@AnsiStrLIComp;
-      StrLowerAnsiStringProc:=@AnsiStrLower;
-      StrUpperAnsiStringProc:=@AnsiStrUpper;
-}
 
 
-(*
-CWSTRING:
-
-procedure EnsureAnsiLen(var S: AnsiString; const len: SizeInt); inline;
+function OS2CompareStrAnsiString (const S1, S2: AnsiString): PtrInt;
+var
+  I, MaxLen: PtrUInt;
 begin
 begin
-  if (len>length(s)) then
-    if (length(s) < 10*256) then
-      setlength(s,length(s)+10)
+  if UniAPI then
+   Result := OS2CompareUnicodeString (S1, S2) (* implicit conversions *)
+  else
+(* Older OS/2 versions without Unicode support do not provide direct means *)
+(* for case sensitive and codepage and language-aware string comparison.   *)
+(* We have to resort to manual comparison of the original strings together *)
+(* with strings translated using the case insensitive collation sequence.  *)
+   begin
+    if Length (S1) = 0 then
+     begin
+      if Length (S2) = 0 then
+       Result := 0
+      else
+       Result := -1;
+      Exit;
+     end
+    else
+     if Length (S2) = 0 then
+      begin
+       Result := 1;
+       Exit;
+      end;
+    I := 1;
+    MaxLen := Length (S1);
+    if Length (S2) < MaxLen then
+     MaxLen := Length (S2);
+    repeat
+     if CollationSequence [S1 [I]] = CollationSequence [S2 [I]] then
+      begin
+       if S1 [I] < S2 [I] then
+        begin
+         Result := -1;
+         Exit;
+        end
+       else if S1 [I] > S2 [I] then
+        begin
+         Result := 1;
+         Exit;
+        end;
+      end
+     else
+      begin
+       if CollationSequence [S1 [I]] < CollationSequence [S2 [I]] then
+        Result := -1
+       else
+        Result := 1;
+       Exit;
+      end;
+     Inc (I);
+    until (I > MaxLen);
+    if Length (S2) > MaxLen then
+     Result := -1
+    else if Length (S1) > MaxLen then
+     Result := 1
     else
     else
-      setlength(s,length(s)+length(s) shr 8);
+     Result := 0;
+   end;
 end;
 end;
 
 
 
 
-procedure ConcatCharToAnsiStr(const c: char; var S: AnsiString; var index: SizeInt);
+function OS2StrCompAnsiString (S1, S2: PChar): PtrInt;
+var
+  HSA1, HSA2: AnsiString;
+  HSU1, HSU2: UnicodeString;
 begin
 begin
-  EnsureAnsiLen(s,index);
-  pchar(@s[index])^:=c;
-  inc(index);
+(* Do not call OS2CompareUnicodeString to skip scanning for #0. *)
+  HSA1 := AnsiString (S1);
+  HSA2 := AnsiString (S2);
+  if UniApi then
+   begin
+    HSU1 := HSA1; (* implicit conversion *)
+    HSU2 := HSA2; (* implicit conversion *)
+    Result := Sys_UniStrColl (DefLocObj, PWideChar (HSU1), PWideChar (HSU2));
+    if Result < -1 then
+     Result := -1
+    else if Result > 1 then
+     Result := 1;
+   end
+  else
+   Result := OS2CompareStrAnsiString (HSA1, HSA2);
 end;
 end;
 
 
 
 
-{ concatenates an utf-32 char to a widestring. S *must* be unique when entering. }
-{$ifndef beos}
-procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt; var mbstate: mbstate_t);
-{$else not beos}
-procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt);
-{$endif beos}
+function OS2CompareTextAnsiString (const S1, S2: AnsiString): PtrInt;
 var
 var
-  p     : pchar;
-  mblen : size_t;
+  HSA1, HSA2: AnsiString;
+  I: PtrUInt;
 begin
 begin
-  { we know that s is unique -> avoid uniquestring calls}
-  p:=@s[index];
-  if (nc<=127) then
-    ConcatCharToAnsiStr(char(nc),s,index)
+  if UniAPI then
+   Result := OS2CompareTextUnicodeString (S1, S2) (* implicit conversions *)
   else
   else
-    begin
-      EnsureAnsiLen(s,index+MB_CUR_MAX);
-{$ifndef beos}
-      mblen:=wcrtomb(p,wchar_t(nc),@mbstate);
-{$else not beos}
-      mblen:=wctomb(p,wchar_t(nc));
-{$endif not beos}
-      if (mblen<>size_t(-1)) then
-        inc(index,mblen)
-      else
-        begin
-          { invalid wide char }
-          p^:='?';
-          inc(index);
-        end;
-    end;
+   begin
+(* Let's use collation strings here as a fallback *)
+    SetLength (HSA1, Length (S1));
+    if Length (HSA1) > 0 then
+(* Using assembler would be much faster, but never mind... *)
+     for I := 1 to Length (HSA1) do
+      HSA1 [I] := CollationSequence [S1 [I]];
+{$WARNING Results of using collation sequence with DBCS not known/tested!}
+    SetLength (HSA2, Length (S2));
+    if Length (HSA2) > 0 then
+     for I := 1 to Length (HSA2) do
+      HSA2 [I] := CollationSequence [S2 [I]];
+    if HSA1 = HSA2 then
+     Result := 0
+    else if HSA1 < HSA2 then
+     Result := -1
+    else
+     Result := 1;
+   end;
 end;
 end;
 
 
 
 
+function OS2StrICompAnsiString (S1, S2: PChar): PtrInt;
+begin
+  Result := OS2CompareTextAnsiString (AnsiString (S1), AnsiString (S2));
+end;
 
 
 
 
-function utf16toutf32(const S: WideString; const index: SizeInt; out len: longint): UCS4Char; external name 'FPC_UTF16TOUTF32';
+function OS2StrLCompAnsiString (S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+var
+  A, B: AnsiString;
+begin
+  if (MaxLen = 0) then
+   Exit (0);
+  SetLength (A, MaxLen);
+  Move (S1^, A [1], MaxLen);
+  SetLength (B, MaxLen);
+  Move (S2^, B [1], MaxLen);
+  Result := OS2CompareStrAnsiString (A, B);
+end;
+
+
+function OS2StrLICompAnsiString (S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+var
+  A, B: AnsiString;
+begin
+  if (MaxLen = 0) then
+   Exit (0);
+  SetLength (A, MaxLen);
+  Move (S1^, A [1], MaxLen);
+  SetLength (B, MaxLen);
+  Move (S2^, B [1], MaxLen);
+  Result := OS2CompareTextAnsiString (A, B);
+end;
+
+
+procedure FPC_RangeError; [external name 'FPC_RANGEERROR'];
+
+
+procedure Ansi2PChar (const S: AnsiString; const OrgP: PChar; out P: Pchar);
+var
+  NewLen: SizeUInt;
+begin
+  NewLen := Length (S);
+  if NewLen > StrLen (OrgP) then
+   FPC_RangeError;
+  P := OrgP;
+  if (NewLen > 0) then
+   Move (S [1], P [0], NewLen);
+  P [NewLen] := #0;
+end;
+
+
+function OS2StrUpperAnsiString (Str: PChar): PChar;
+var
+  Temp: AnsiString;
+begin
+  Temp := OS2UpperAnsiString (Str);
+  Ansi2PChar (Temp, Str, Result);
+end;
+
 
 
+function OS2StrLowerAnsiString (Str: PChar): PChar;
+var
+  Temp: AnsiString;
+begin
+  Temp := OS2LowerAnsiString (Str);
+  Ansi2PChar (Temp, Str, Result);
+end;
+
+
+(*
+CWSTRING:
 { return value: number of code points in the string. Whenever an invalid
 { return value: number of code points in the string. Whenever an invalid
   code point is encountered, all characters part of this invalid code point
   code point is encountered, all characters part of this invalid code point
   are considered to form one "character" and the next character is
   are considered to form one "character" and the next character is
@@ -1399,164 +1528,6 @@ function CodePointLength(const Str: PChar; maxlookahead: ptrint): PtrInt;
       result:=-1;
       result:=-1;
 {$endif beos}
 {$endif beos}
   end;
   end;
-
-
-function StrCompAnsiIntern(s1,s2 : PChar; len1, len2: PtrInt; canmodifys1, canmodifys2: boolean): PtrInt;
-  var
-    a,b: pchar;
-    i: PtrInt;
-  begin
-    if not(canmodifys1) then
-      getmem(a,len1+1)
-    else
-      a:=s1;
-    for i:=0 to len1-1 do
-      if s1[i]<>#0 then
-        a[i]:=s1[i]
-      else
-        a[i]:=#32;
-    a[len1]:=#0;
-
-    if not(canmodifys2) then
-      getmem(b,len2+1)
-    else
-      b:=s2;
-    for i:=0 to len2-1 do
-      if s2[i]<>#0 then
-        b[i]:=s2[i]
-      else
-        b[i]:=#32;
-    b[len2]:=#0;
-    result:=strcoll(a,b);
-    if not(canmodifys1) then
-      freemem(a);
-    if not(canmodifys2) then
-      freemem(b);
-  end;
-
-
-function CompareStrAnsiString(const s1, s2: ansistring): PtrInt;
-  begin
-    result:=StrCompAnsiIntern(pchar(s1),pchar(s2),length(s1),length(s2),false,false);
-  end;
-
-
-function StrCompAnsi(s1,s2 : PChar): PtrInt;
-  begin
-    result:=strcoll(s1,s2);
-  end;
-
-
-function AnsiCompareText(const S1, S2: ansistring): PtrInt;
-  var
-    a, b: AnsiString;
-  begin
-    a:=UpperAnsistring(s1);
-    b:=UpperAnsistring(s2);
-    result:=StrCompAnsiIntern(pchar(a),pchar(b),length(a),length(b),true,true);
-  end;
-
-
-function AnsiStrIComp(S1, S2: PChar): PtrInt;
-  begin
-    result:=AnsiCompareText(ansistring(s1),ansistring(s2));
-  end;
-
-
-function AnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-  var
-    a, b: pchar;
-begin
-  if (maxlen=0) then
-    exit(0);
-  if (s1[maxlen]<>#0) then
-    begin
-      getmem(a,maxlen+1);
-      move(s1^,a^,maxlen);
-      a[maxlen]:=#0;
-    end
-  else
-    a:=s1;
-  if (s2[maxlen]<>#0) then
-    begin
-      getmem(b,maxlen+1);
-      move(s2^,b^,maxlen);
-      b[maxlen]:=#0;
-    end
-  else
-    b:=s2;
-  result:=StrCompAnsiIntern(a,b,maxlen,maxlen,a<>s1,b<>s2);
-  if (a<>s1) then
-    freemem(a);
-  if (b<>s2) then
-    freemem(b);
-end;
-
-
-function AnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-  var
-    a, b: ansistring;
-begin
-  if (maxlen=0) then
-    exit(0);
-  setlength(a,maxlen);
-  move(s1^,a[1],maxlen);
-  setlength(b,maxlen);
-  move(s2^,b[1],maxlen);
-  result:=AnsiCompareText(a,b);
-end;
-
-
-procedure ansi2pchar(const s: ansistring; const orgp: pchar; out p: pchar);
-var
-  newlen: sizeint;
-begin
-  newlen:=length(s);
-  if newlen>strlen(orgp) then
-    fpc_rangeerror;
-  p:=orgp;
-  if (newlen>0) then
-    move(s[1],p[0],newlen);
-  p[newlen]:=#0;
-end;
-
-
-function AnsiStrLower(Str: PChar): PChar;
-var
-  temp: ansistring;
-begin
-  temp:=loweransistring(str);
-  ansi2pchar(temp,str,result);
-end;
-
-
-function AnsiStrUpper(Str: PChar): PChar;
-var
-  temp: ansistring;
-begin
-  temp:=upperansistring(str);
-  ansi2pchar(temp,str,result);
-end;
-
-{$ifdef FPC_HAS_CPSTRING}
-{$i textrec.inc}
-procedure SetStdIOCodePage(var T: Text); inline;
-begin
-  case TextRec(T).Mode of
-    fmInput:TextRec(T).CodePage:=GetStandardCodePage(scpConsoleInput);
-    fmOutput:TextRec(T).CodePage:=GetStandardCodePage(scpConsoleOutput);
-  end;
-end;
-
-procedure SetStdIOCodePages; inline;
-begin
-  SetStdIOCodePage(Input);
-  SetStdIOCodePage(Output);
-  SetStdIOCodePage(ErrOutput);
-  SetStdIOCodePage(StdOut);
-  SetStdIOCodePage(StdErr);
-end;
-{$endif FPC_HAS_CPSTRING}
 *)
 *)
 
 
 procedure InitOS2WideStringManager; inline;
 procedure InitOS2WideStringManager; inline;
@@ -1646,7 +1617,7 @@ begin
     Sys_UniStrColl := @DummyUniStrColl;
     Sys_UniStrColl := @DummyUniStrColl;
     Sys_UniCreateLocaleObject := @DummyUniCreateLocaleObject;
     Sys_UniCreateLocaleObject := @DummyUniCreateLocaleObject;
     Sys_UniFreeLocaleObject := @DummyUniFreeLocaleObject;
     Sys_UniFreeLocaleObject := @DummyUniFreeLocaleObject;
-    InitDummyLowercase;
+    InitDummyAnsiSupport;
    end;
    end;
 
 
     { Widestring }
     { Widestring }
@@ -1672,15 +1643,12 @@ begin
 *)
 *)
   WideStringManager.UpperAnsiStringProc := @OS2UpperAnsiString;
   WideStringManager.UpperAnsiStringProc := @OS2UpperAnsiString;
   WideStringManager.LowerAnsiStringProc := @OS2LowerAnsiString;
   WideStringManager.LowerAnsiStringProc := @OS2LowerAnsiString;
-(*
   WideStringManager.CompareStrAnsiStringProc := @OS2CompareStrAnsiString;
   WideStringManager.CompareStrAnsiStringProc := @OS2CompareStrAnsiString;
-  WideStringManager.CompareTextAnsiStringProc := @OS2AnsiCompareTextAnsiString;
-
-      StrCompAnsiStringProc:=@StrCompAnsi;
-      StrICompAnsiStringProc:=@AnsiStrIComp;
-      StrLCompAnsiStringProc:=@AnsiStrLComp;
-      StrLICompAnsiStringProc:=@AnsiStrLIComp;
-      StrLowerAnsiStringProc:=@AnsiStrLower;
-      StrUpperAnsiStringProc:=@AnsiStrUpper;
-*)
+  WideStringManager.CompareTextAnsiStringProc := @OS2CompareTextAnsiString;
+  WideStringManager.StrCompAnsiStringProc := @OS2StrCompAnsiString;
+  WideStringManager.StrICompAnsiStringProc := @OS2StrICompAnsiString;
+  WideStringManager.StrLCompAnsiStringProc := @OS2StrLCompAnsiString;
+  WideStringManager.StrLICompAnsiStringProc := @OS2StrLICompAnsiString;
+  WideStringManager.StrLowerAnsiStringProc := @OS2StrLowerAnsiString;
+  WideStringManager.StrUpperAnsiStringProc := @OS2StrUpperAnsiString;
 end;
 end;

+ 2 - 1
utils/fpmake.pp

@@ -65,7 +65,8 @@ begin
     P.Dependencies.Add('paszlib');
     P.Dependencies.Add('paszlib');
     P.Dependencies.Add('hash');
     P.Dependencies.Add('hash');
     P.Dependencies.Add('univint',[darwin,iphonesim]);
     P.Dependencies.Add('univint',[darwin,iphonesim]);
-
+    P.Dependencies.Add('rtl-extra');
+	
     P.Version:='3.0.1';
     P.Version:='3.0.1';
 
 
     T:=P.Targets.AddProgram('ptop.pp');
     T:=P.Targets.AddProgram('ptop.pp');