merge r13488 from cpstrnew branch by florian except ncgcon.pas which has a difficult merge conflict (code moved to another unit which is not at the branch during the revision):

* first batch of patches to make tcpstr1.pp work

git-svn-id: trunk@19085 -

compiler/ncginl.pas

@@ -363,7 +363,7 @@ implementation
                hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,OS_INT);
                cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,href,hregister);
              end;
-           if is_widestring(left.resultdef) or is_unicodestring(left.resultdef) then
+           if is_widestring(left.resultdef) then
              cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,1,hregister);
            cg.a_label(current_asmdata.CurrAsmList,lengthlab);
            location_reset(location,LOC_REGISTER,def_cgsize(resultdef));

rtl/inc/astrings.inc

@@ -73,7 +73,7 @@ begin
      PAnsiRec(P)^.CodePage:=DefaultSystemCodePage;
      PAnsiRec(P)^.ElementSize:=SizeOf(AnsiChar);
      PAnsiRec(P)^.First:=#0;      { Terminating #0 }
-     inc(p,AnsiFirstOff);             { Points to string now }
+     inc(p,AnsiFirstOff);         { Points to string now }
    end;
   NewAnsiString:=P;
 end;
@@ -103,10 +103,12 @@ Var
   l : pSizeInt;
 Begin
   { Zero string }
-  If S=Nil then exit;
+  If S=Nil then 
+    exit;
   { check for constant strings ...}
   l:=@PAnsiRec(S-AnsiFirstOff)^.Ref;
-  If l^<0 then exit;
+  If l^<0 then 
+    exit;
   { declocked does a MT safe dec and returns true, if the counter is 0 }
   If declocked(l^) then
     { Ref count dropped to zero }
@@ -308,12 +310,9 @@ begin
     end;
   fpc_AnsiStr_Decr_Ref(destcopy);
 end;
-
-
 {$endif STR_CONCAT_PROCS}
 
 
-
 {$ifdef EXTRAANSISHORT}
 Procedure AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString);
 {
@@ -335,8 +334,7 @@ begin
 end;
 {$endif EXTRAANSISHORT}
 
-
-Function fpc_AnsiStr_To_AnsiStr (const S : AnsiString;cp : TSystemCodePage): AnsiString; compilerproc;
+Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; [Public, alias: 'FPC_ANSISTR_TO_ANSISTR']; compilerproc;
 {
   Converts an AnsiString to an AnsiString taking code pages into care
 }
@@ -351,6 +349,7 @@ begin
     widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(temp)),result,cp,Size);
 end;
 
+Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; [external name 'FPC_ANSISTR_TO_ANSISTR'];
 
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 
@@ -358,7 +357,7 @@ end;
 { procedure fpc_AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);     }
 { which is what the old helper was, so we don't need an extra implementation }
 { of the old helper (JM)                                                     }
-function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring;[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR'];  compilerproc;
+function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring; [Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; compilerproc;
 {
   Converts a AnsiString to a ShortString;
 }
@@ -440,7 +439,6 @@ begin
 end;
 
 
-
 Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
 var
   i  : SizeInt;
@@ -598,6 +596,8 @@ begin
        begin
          GetMem(Pointer(S),AnsiRecLen+L);
          PAnsiRec(S)^.Ref:=1;
+         PAnsiRec(S)^.CodePage:=DefaultSystemCodePage;
+         PAnsiRec(S)^.ElementSize:=1;
          inc(Pointer(S),AnsiFirstOff);
        end
       else if PAnsiRec(Pointer(S)-AnsiFirstOff)^.Ref=1 then
@@ -617,14 +617,14 @@ begin
 
           { also move terminating null }
           lens:=succ(length(s));
-          if l < lens then
-            movelen := l
+          if l<lens then
+            movelen:=l
           else
-            movelen := lens;
+            movelen:=lens;
           Move(Pointer(S)^,Temp^,movelen);
           { ref count dropped to zero in the mean time? }
-          If (PAnsiRec(Pointer(S)-AnsiFirstOff)^.Ref > 0) and
-             declocked(PAnsiRec(Pointer(S)-AnsiFirstOff)^.Ref) then
+          If (PAnsiRec(Pointer(S)-AnsiFirstOff)^.Ref>0) and
+            declocked(PAnsiRec(Pointer(S)-AnsiFirstOff)^.Ref) then
             freemem(PAnsiRec(Pointer(s)-AnsiFirstOff));
           Pointer(S):=Temp;
        end;
@@ -636,7 +636,7 @@ begin
     begin
       { Length=0 }
       if Pointer(S)<>nil then
-       fpc_ansistr_decr_ref (Pointer(S));
+        fpc_ansistr_decr_ref (Pointer(S));
       Pointer(S):=Nil;
     end;
 end;
@@ -1144,3 +1144,18 @@ function StringRefCount(const S: RawByteString): SizeInt; overload;
       Result:=SizeOf(AnsiChar);
   end;
 
+
+procedure SetCodePage(var s : RawByteString; CodePage : TSystemCodePage; Convert : Boolean = True);
+  begin
+    if (S='') or (StringCodePage(S)=CodePage) then
+      exit
+    else if Convert then
+      begin
+        s:=fpc_AnsiStr_To_AnsiStr(s,CodePage);
+      end
+    else
+      begin
+        UniqueString(s);
+        PAnsiRec(pointer(s)-AnsiFirstOff)^.CodePage:=CodePage;
+      end;
+  end;

rtl/inc/compproc.inc

@@ -266,7 +266,7 @@ function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): s
 {$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : Ansistring); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
-Function fpc_AnsiStr_To_AnsiStr (const S : AnsiString;cp : TSystemCodePage): AnsiString; compilerproc;
+Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; compilerproc;
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 

rtl/inc/systemh.inc

@@ -345,7 +345,7 @@ Type
 
 {$ifndef FPUNONE}
   PDate               = ^TDateTime;
-  PDateTime	      = ^TDateTime;
+  PDateTime           = ^TDateTime;
 {$endif}
   PError              = ^TError;
   PVariant            = ^Variant;

rtl/inc/ustrings.inc

@@ -185,7 +185,7 @@ begin
   GetMem(P,Len*sizeof(UnicodeChar)+UnicodeRecLen);
   If P<>Nil then
     begin
-      PUnicodeRec(P)^.Len:=Len*2;     { Initial length }
+      PUnicodeRec(P)^.Len:=Len;       { Initial length }
       PUnicodeRec(P)^.Ref:=1;         { Initial Refcount }
       PUnicodeRec(P)^.CodePage:=DefaultUnicodeCodePage;
       PUnicodeRec(P)^.ElementSize:=SizeOf(UnicodeChar);
@@ -231,9 +231,8 @@ Begin
 
   { declocked does a MT safe dec and returns true, if the counter is 0 }
   if declocked(l^) then
-    { Ref count dropped to zero ...
-      ... remove }
-  DisposeUnicodeString(S);
+    { Ref count dropped to zero remove }
+    DisposeUnicodeString(S);
 end;
 
 { alias for internal use }
@@ -676,7 +675,6 @@ begin
 end;
 
 
-
 Function fpc_Char_To_UnicodeStr(const c : Char): UnicodeString; compilerproc;
 {
   Converts a Char to a UnicodeString;
@@ -1377,7 +1375,7 @@ begin
         end;
       { Force nil termination in case it gets shorter }
       PWord(Pointer(S)+l*sizeof(UnicodeChar))^:=0;
-      PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Len:=l*sizeof(UnicodeChar);
+      PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Len:=l;
     end
   else
     begin

rtl/inc/wstrings.inc

@@ -1359,7 +1359,6 @@ function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: SizeInt): SizeI
   end;
 
 
-
 function UTF8ToUnicode(Dest: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
   const
     UNICODE_INVALID=63;

rtl/win/syswin.inc

@@ -289,9 +289,10 @@ function GetProcessID: SizeUInt;
  ******************************************************************************}
 const
   { MultiByteToWideChar  }
-     MB_PRECOMPOSED = 1;
-     CP_ACP = 0;
-     WC_NO_BEST_FIT_CHARS = $400;
+  MB_PRECOMPOSED = 1;
+  CP_ACP = 0;
+  CP_UTF16 = 1200;
+  WC_NO_BEST_FIT_CHARS = $400;
 
 function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
     stdcall; external 'kernel32' name 'MultiByteToWideChar';
@@ -308,10 +309,14 @@ procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;cp : TSy
   begin
     // retrieve length including trailing #0
     // not anymore, because this must also be usable for single characters
-    destlen:=WideCharToMultiByte(cp, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
+    destlen:=WideCharToMultiByte(cp, 0, source, len, nil, 0, nil, nil);
     // this will null-terminate
     setlength(dest, destlen);
-    WideCharToMultiByte(cp, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
+    if destlen>0 then
+      begin
+        WideCharToMultiByte(cp, 0, source, len, @dest[1], destlen, nil, nil);
+        PAnsiRec(pointer(dest)-AnsiFirstOff)^.CodePage:=cp;
+      end;
   end;
 
 procedure Win32Ansi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:UnicodeString;len:SizeInt);
@@ -323,7 +328,11 @@ procedure Win32Ansi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:Unico
     destlen:=MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, nil, 0);
     // this will null-terminate
     setlength(dest, destlen);
-    MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, @dest[1], destlen);
+    if destlen>0 then
+      begin
+        MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, @dest[1], destlen);
+        PUnicodeRec(pointer(dest)-UnicodeFirstOff)^.CodePage:=CP_UTF16;
+      end;
   end;
 
 
@@ -354,10 +363,14 @@ procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;cp : TSystemCo
   begin
     // retrieve length including trailing #0
     // not anymore, because this must also be usable for single characters
-    destlen:=WideCharToMultiByte(cp, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
+    destlen:=WideCharToMultiByte(cp, 0, source, len, nil, 0, nil, nil);
     // this will null-terminate
     setlength(dest, destlen);
-    WideCharToMultiByte(cp, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
+    if destlen>0 then
+      begin
+        WideCharToMultiByte(cp, 0, source, len, @dest[1], destlen, nil, nil);
+        PAnsiRec(pointer(dest)-AnsiFirstOff)^.CodePage:=cp;
+      end;
   end;
 
 
@@ -370,7 +383,8 @@ procedure Win32Ansi2WideMove(source:pchar;cp : TSystemCodePage;var dest:widestri
     destlen:=MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, nil, 0);
     // this will null-terminate
     setlength(dest, destlen);
-    MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, @dest[1], destlen);
+    if destlen>0 then
+      MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, @dest[1], destlen);
   end;
 
 
@@ -407,6 +421,8 @@ var
   WStrInitTablesTable: TWStrInitTablesTable; external name 'FPC_WIDEINITTABLES';
 {$endif}
 
+function GetACP:UINT; external 'kernel32' name 'GetACP';
+
 { there is a similiar procedure in sysutils which inits the fields which
   are only relevant for the sysutils units }
 procedure InitWin32Widestrings;
@@ -442,5 +458,7 @@ procedure InitWin32Widestrings;
     widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper;
     widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
 {$endif VER2_2}
+    DefaultSystemCodePage:=GetACP;
+    DefaultUnicodeCodePage:=CP_UTF16;
   end;
 

rtl/win32/system.pp

@@ -948,4 +948,3 @@ begin
   InitWin32Widestrings;
   DispCallByIDProc:=@DoDispCallByIDError;
 end.
-