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

@@ -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 : RawByteString;cp : TSystemCodePage): RawByteString; [Public, alias: 'FPC_ANSISTR_TO_ANSISTR']; compilerproc;
-Function fpc_AnsiStr_To_AnsiStr (const S : AnsiString;cp : TSystemCodePage): AnsiString; 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}
 
@@ -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
@@ -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/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,8 +231,7 @@ Begin
 
   { declocked does a MT safe dec and returns true, if the counter is 0 }
   if declocked(l^) then
-    { Ref count dropped to zero ...
+    { Ref count dropped to zero remove }
-      ... remove }
     DisposeUnicodeString(S);
 end;
 
@@ -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

@@ -291,6 +291,7 @@ const
   { MultiByteToWideChar  }
   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;
@@ -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);
+    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,6 +383,7 @@ 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);
+    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.
-