* widestrings aren't ref. counted anymore on windows

git-svn-id: trunk@3466 -

compiler/cgobj.pas

@@ -1484,8 +1484,13 @@ implementation
          if incrfunc<>'' then
           begin
             paramanager.allocparaloc(list,cgpara1);
-            { these functions get the pointer by value }
-            a_param_ref(list,OS_ADDR,ref,cgpara1);
+            { widestrings aren't ref. counted on all platforms so we need the address
+              to create a real copy }
+            if is_widestring(t) then
+              a_paramaddr_ref(list,ref,cgpara1)
+            else
+              { these functions get the pointer by value }
+              a_param_ref(list,OS_ADDR,ref,cgpara1);
             paramanager.freeparaloc(list,cgpara1);
             allocallcpuregisters(list);
             a_call_name(list,incrfunc);

compiler/ncgcon.pas

@@ -427,8 +427,13 @@ implementation
                                 { we use always UTF-16 coding for constants }
                                 { at least for now                          }
                                 { Consts.concat(Tai_const.Create_8bit(2)); }
-                                current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_aint(-1));
-                                current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_aint(len*cwidechartype.def.size));
+                                if tf_winlikewidestring in target_info.flags then
+                                  current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(len*cwidechartype.def.size))
+                                else
+                                  begin
+                                    current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_aint(-1));
+                                    current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_aint(len*cwidechartype.def.size));
+                                  end;
                                 current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1));
                                 for i:=0 to len-1 do
                                   current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i]));

compiler/ncginl.pas

@@ -356,9 +356,18 @@ implementation
            location_force_reg(current_asmdata.CurrAsmList,left.location,OS_ADDR,false);
            current_asmdata.getjumplabel(lengthlab);
            cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,left.location.register,lengthlab);
-           reference_reset_base(href,left.location.register,-sizeof(aint));
-           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);
+           if is_widestring(left.resulttype.def) and (tf_winlikewidestring in target_info.flags) then
+             begin
+               reference_reset_base(href,left.location.register,-sizeof(dword));
+               hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,OS_INT);
+               cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_INT,href,hregister);
+             end
+           else
+             begin
+               reference_reset_base(href,left.location.register,-sizeof(aint));
+               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.resulttype.def) then
              cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,1,hregister);
            cg.a_label(current_asmdata.CurrAsmList,lengthlab);

compiler/nld.pas

@@ -645,6 +645,7 @@ implementation
            right:=nil;
            exit;
          end;
+
         { call helpers for variant, they can contain non ref. counted types like
           vararrays which must be really copied }
         if left.resulttype.def.deftype=variantdef then
@@ -660,6 +661,18 @@ implementation
            exit;
          end;
 
+        { call helpers for windows widestrings, they aren't ref. counted }
+        if (tf_winlikewidestring in target_info.flags) and is_widestring(left.resulttype.def) then
+         begin
+           hp:=ccallparanode.create(ctypeconvnode.create_internal(right,voidpointertype),
+               ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),
+               nil));
+           result:=ccallnode.createintern('fpc_widestr_assign',hp);
+           left:=nil;
+           right:=nil;
+           exit;
+         end;
+
         { check if local proc/func is assigned to procvar }
         if right.resulttype.def.deftype=procvardef then
           test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);

compiler/nmem.pas

@@ -757,7 +757,7 @@ implementation
 
          if (nf_callunique in flags) and
             (is_ansistring(left.resulttype.def) or
-             is_widestring(left.resulttype.def)) then
+             (is_widestring(left.resulttype.def) and not(tf_winlikewidestring in target_info.flags))) then
            begin
              left := ctypeconvnode.create_internal(ccallnode.createintern('fpc_'+tstringdef(left.resulttype.def).stringtypname+'_unique',
                ccallparanode.create(
@@ -767,7 +767,9 @@ implementation
              { double resulttype passes somwhere else may cause this to be }
              { reset though :/                                             }
              exclude(flags,nf_callunique);
-           end;
+           end
+         else if is_widestring(left.resulttype.def) and (tf_winlikewidestring in target_info.flags) then
+           exclude(flags,nf_callunique);
 
          { the register calculation is easy if a const index is used }
          if right.nodetype=ordconstn then

compiler/ptconst.pas

@@ -600,8 +600,13 @@ implementation
                             current_asmdata.getdatalabel(ll);
                             datalist.concat(Tai_const.Create_sym(ll));
                             current_asmdata.asmlists[al_const].concat(tai_align.create(const_align(sizeof(aint))));
-                            current_asmdata.asmlists[al_const].concat(Tai_const.Create_aint(-1));
-                            current_asmdata.asmlists[al_const].concat(Tai_const.Create_aint(strlength*cwidechartype.def.size));
+                            if tf_winlikewidestring in target_info.flags then
+                              current_asmdata.asmlists[al_const].concat(Tai_const.Create_32bit(strlength*cwidechartype.def.size))
+                            else
+                              begin
+                                current_asmdata.asmlists[al_const].concat(Tai_const.Create_aint(-1));
+                                current_asmdata.asmlists[al_const].concat(Tai_const.Create_aint(strlength*cwidechartype.def.size));
+                              end;
                             current_asmdata.asmlists[al_const].concat(Tai_label.Create(ll));
                             for i:=0 to strlength-1 do
                               current_asmdata.asmlists[al_const].concat(Tai_const.Create_16bit(pcompilerwidestring(strval)^.data[i]));

rtl/inc/compproc.inc

@@ -129,13 +129,13 @@ Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt); compilerproc;
 {$ifdef EXTRAANSISHORT}
 Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; compilerproc;
 {$endif EXTRAANSISHORT}
-{ pointer argument because otherwise when calling this, we get }
-{ an endless loop since a 'var s: ansistring' must be made     }
-{ unique as well                                               }
+{ pointer argument because otherwise when calling this, we get
+  an endless loop since a 'var s: ansistring' must be made
+  unique as well                                               }
 Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
 
 Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc;
-Procedure fpc_WideStr_Incr_Ref (S : Pointer); compilerproc;
+Procedure fpc_WideStr_Incr_Ref (Var S : Pointer); compilerproc;
 function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring; compilerproc;
 Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerproc;
 Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
@@ -157,7 +157,9 @@ Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
 Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
 Procedure fpc_WideStr_CheckRange(len,index : SizeInt); compilerproc;
 Procedure fpc_WideStr_SetLength (Var S : WideString; l : SizeInt); compilerproc;
+{$ifndef FPC_WINLIKEWIDESTRING}
 function fpc_widestr_Unique(Var S : Pointer): Pointer; compilerproc;
+{$endif FPC_WINLIKEWIDESTRING}
 
 Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
 Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;

rtl/inc/wstrings.inc

@@ -35,8 +35,12 @@
 Type
   PWideRec = ^TWideRec;
   TWideRec = Packed Record
-    Ref,
-    Len   : SizeInt;
+{$ifdef FPC_WINLIKEWIDESTRING}
+    Len   : DWord;
+{$else FPC_WINLIKEWIDESTRING}
+    Ref : SizeInt;
+    Len : SizeInt;
+{$endif FPC_WINLIKEWIDESTRING}
     First : WideChar;
   end;
 
@@ -55,17 +59,15 @@ procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt)
 var
   i : SizeInt;
 begin
-  //writeln('in widetoansimove');
   setlength(dest,len);
   for i:=1 to len do
-   begin
-     if word(source^)<256 then
-      dest[i]:=char(word(source^))
-     else
-      dest[i]:='?';
-     //inc(dest);
-     inc(source);
-   end;
+    begin
+      if word(source^)<256 then
+        dest[i]:=char(word(source^))
+      else
+        dest[i]:='?';
+      inc(source);
+    end;
 end;
 
 
@@ -73,19 +75,15 @@ procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
 var
   i : SizeInt;
 begin
-  //writeln('in ansitowidemove');
   setlength(dest,len);
   for i:=1 to len do
-   begin
-//     if byte(source^)<128 then
+    begin
       dest[i]:=widechar(byte(source^));
-//     else
-//      dest^:=' ';
-     //inc(dest);
-     inc(source);
-   end;
+      inc(source);
+    end;
 end;
 
+
 Procedure GetWideStringManager (Var Manager : TWideStringManager);
 begin
   manager:=widestringmanager;
@@ -98,6 +96,7 @@ begin
   widestringmanager:=New;
 end;
 
+
 Procedure SetWideStringManager (Const New : TWideStringManager);
 begin
   widestringmanager:=New;
@@ -135,8 +134,7 @@ begin
     Begin
       With PWideRec(S-WideFirstOff)^ do
        begin
-         Write   ('(Maxlen: ',maxlen);
-         Write   (' Len:',len);
+         Write   ('(Len:',len);
          Writeln (' Ref: ',ref,')');
        end;
     end;
@@ -154,19 +152,20 @@ Var
 begin
 {$ifdef MSWINDOWS}
   if winwidestringalloc then
-    P:=SysAllocStringLen(nil,Len*sizeof(WideChar)+WideRecLen)
+    P:=SysAllocStringLen(nil,Len)
   else
 {$endif MSWINDOWS}
-    GetMem(P,Len*sizeof(WideChar)+WideRecLen);
-  If P<>Nil then
     begin
-     PWideRec(P)^.Len:=0;         { Initial length }
-     PWideRec(P)^.Ref:=1;         { Set reference count }
-     PWideRec(P)^.First:=#0;      { Terminating #0 }
-     inc(p,WideFirstOff);         { Points to string now }
-    end
-  else
-    WideStringError;
+      GetMem(P,Len*sizeof(WideChar)+WideRecLen);
+      If P<>Nil then
+        begin
+         PWideRec(P)^.Len:=Len*2;     { Initial length }
+         PWideRec(P)^.First:=#0;      { Terminating #0 }
+         inc(p,WideFirstOff);         { Points to string now }
+        end
+      else
+        WideStringError;
+    end;
   NewWideString:=P;
 end;
 
@@ -200,28 +199,43 @@ Var
   l : pSizeInt;
 Begin
   { Zero string }
-  If S=Nil then exit;
+  if S=Nil then
+    exit;
+{$ifndef FPC_WINLIKEWIDESTRING}
   { check for constant strings ...}
-  l:=@PWIDEREC(S-WideFirstOff)^.Ref;
-  If l^<0 then exit;
+  l:=@PWideRec(S-WideFirstOff)^.Ref;
+  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 }
-    DisposeWideString (S);        { Remove...}
+  if declocked(l^) then
+    { Ref count dropped to zero ...
+      ... remove }
+{$endif FPC_WINLIKEWIDESTRING}
+    DisposeWideString(S);
 end;
 
 { alias for internal use }
 Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_DECR_REF'];
 
-Procedure fpc_WideStr_Incr_Ref (S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_REF']; compilerproc;
-Begin
-  If S=Nil then
-    exit;
-  { Let's be paranoid : Constant string ??}
-  If PWideRec(S-WideFirstOff)^.Ref<0 then exit;
-  inclocked(PWideRec(S-WideFirstOff)^.Ref);
-end;
+Procedure fpc_WideStr_Incr_Ref(Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_REF']; compilerproc;
+{$ifdef FPC_WINLIKEWIDESTRING}
+  var
+    p : pointer;
+{$endif FPC_WINLIKEWIDESTRING}
+  Begin
+    If S=Nil then
+      exit;
+{$ifdef FPC_WINLIKEWIDESTRING}
+    p:=s;
+    fpc_WideStr_SetLength(WideString(s),length(WideString(p)));
+    move(p^,s^,length(WideString(p))*sizeof(widechar));
+{$else FPC_WINLIKEWIDESTRING}
+    { Let's be paranoid : Constant string ??}
+    If PWideRec(S-WideFirstOff)^.Ref<0 then exit;
+      inclocked(PWideRec(S-WideFirstOff)^.Ref);
+{$endif FPC_WINLIKEWIDESTRING}
+  end;
 
 { alias for internal use }
 Procedure fpc_WideStr_Incr_Ref (S : Pointer);[external name 'FPC_WIDESTR_INCR_REF'];
@@ -244,7 +258,6 @@ begin
      widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
      fpc_WideStr_To_ShortStr:=temp;
    end;
-
 end;
 
 
@@ -256,12 +269,11 @@ Var
   Size : SizeInt;
 begin
   Size:=Length(S2);
-  //Setlength (fpc_ShortStr_To_WideStr,Size);
   if Size>0 then
     begin
-			widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),fpc_ShortStr_To_WideStr,Size);
+      widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),fpc_ShortStr_To_WideStr,Size);
       { Terminating Zero }
-			PWideChar(Pointer(fpc_ShortStr_To_WideStr)+Size*sizeof(WideChar))^:=#0;
+      PWideChar(Pointer(fpc_ShortStr_To_WideStr)+Size*sizeof(WideChar))^:=#0;
     end;
 end;
 
@@ -276,13 +288,8 @@ begin
   if s2='' then
     exit;
   Size:=Length(WideString(S2));
-//  Setlength (fpc_WideStr_To_AnsiStr,Size);
   if Size>0 then
-   begin
-     widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),fpc_WideStr_To_AnsiStr,Size);
-     { Terminating Zero }
-//     PChar(Pointer(fpc_WideStr_To_AnsiStr)+Size)^:=#0;
-   end;
+    widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),fpc_WideStr_To_AnsiStr,Size);
 end;
 
 
@@ -296,7 +303,6 @@ begin
    if s2='' then
      exit;
    Size:=Length(S2);
-  // Setlength (result,Size);
    if Size>0 then
     begin
       widestringmanager.Ansi2WideMoveProc(PChar(S2),result,Size);
@@ -313,13 +319,8 @@ begin
   if p=nil then
    exit;
   Size := IndexWord(p^, -1, 0);
- // Setlength (result,Size);
   if Size>0 then
-   begin
-     widestringmanager.Wide2AnsiMoveProc(P,result,Size);
-     { Terminating Zero }
-   //  PChar(Pointer(result)+Size)^:=#0;
-   end;
+    widestringmanager.Wide2AnsiMoveProc(P,result,Size);
 end;
 
 
@@ -330,7 +331,7 @@ begin
   if p=nil then
    exit;
   Size := IndexWord(p^, -1, 0);
-  Setlength (result,Size);
+  Setlength(result,Size);
   if Size>0 then
    begin
       Move(p^,PWideChar(Pointer(result))^,Size*sizeof(WideChar));
@@ -351,14 +352,8 @@ begin
      exit;
    end;
   Size := IndexWord(p^, $7fffffff, 0);
-//  Setlength (result,Size+1);
   if Size>0 then
-   begin
-//     If Size>255 then
-//      Size:=255;
-     widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
-//     byte(result[0]):=byte(Size);
-   end;
+    widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
   result := temp
 end;
 
@@ -370,15 +365,23 @@ Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_
   Assigns S2 to S1 (S1:=S2), taking in account reference counts.
 }
 begin
+{$ifndef FPC_WINLIKEWIDESTRING}
   If S2<>nil then
     If PWideRec(S2-WideFirstOff)^.Ref>0 then
-      Inc(PWideRec(S2-WideFirstOff)^.ref);
+      inclocked(PWideRec(S2-WideFirstOff)^.ref);
+{$endif FPC_WINLIKEWIDESTRING}
   { Decrease the reference count on the old S1 }
   fpc_widestr_decr_ref (S1);
   { And finally, have S1 pointing to S2 (or its copy) }
+{$ifdef FPC_WINLIKEWIDESTRING}
+  fpc_WideStr_SetLength(WideString(s1),length(WideString(s2)));
+  move(s2^,s1^,length(WideString(s1))*sizeof(widechar));
+{$else FPC_WINLIKEWIDESTRING}
   S1:=S2;
+{$endif FPC_WINLIKEWIDESTRING}
 end;
 
+
 { alias for internal use }
 Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_WIDESTR_ASSIGN'];
 
@@ -443,7 +446,7 @@ begin
   if c = #0 then
     { result is automatically set to '' }
     exit;
-  Setlength (fpc_Char_To_WideStr,1);
+  Setlength(fpc_Char_To_WideStr,1);
   fpc_Char_To_WideStr[1]:=c;
   { Terminating Zero }
   PWideChar(Pointer(fpc_Char_To_WideStr)+sizeof(WideChar))^:=#0;
@@ -458,7 +461,6 @@ begin
     { result is automatically set to '' }
     exit;
   l:=IndexChar(p^,-1,#0);
-  //SetLength(fpc_PChar_To_WideStr,L);
   widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
 end;
 
@@ -560,6 +562,7 @@ begin
   fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
 end;
 
+
 { inside the compiler, the resulttype is modified to that of the actual }
 { widechararray we're converting to (JM)                                }
 function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray;[public,alias: 'FPC_WIDESTR_TO_WIDECHARARRAY']; compilerproc;
@@ -575,6 +578,7 @@ begin
   fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
 end;
 
+
 { inside the compiler, the resulttype is modified to that of the actual }
 { chararray we're converting to (JM)                                    }
 function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray;[public,alias: 'FPC_ANSISTR_TO_WIDECHARARRAY']; compilerproc;
@@ -650,7 +654,7 @@ begin
     HandleErrorFrame(201,get_frame);
 end;
 
-Procedure fpc_WideStr_SetLength (Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; compilerproc;
+Procedure fpc_WideStr_SetLength(Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; compilerproc;
 {
   Sets The length of string S to L.
   Makes sure S is unique, and contains enough room.
@@ -669,17 +673,21 @@ begin
       { windows doesn't support reallocing widestrings, this code
         is anyways subject to be removed because widestrings shouldn't be
         ref. counted anymore (FK) }
-      else if
+      else
+{$ifndef FPC_WINLIKEWIDESTRING}
+        if
 {$ifdef MSWINDOWS}
               not winwidestringalloc and
 {$endif MSWINDOWS}
               (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
+{$endif FPC_WINLIKEWIDESTRING}
         begin
           Dec(Pointer(S),WideFirstOff);
           if L*sizeof(WideChar)+WideRecLen>MemSize(Pointer(S)) then
               reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
           Inc(Pointer(S), WideFirstOff);
         end
+{$ifndef FPC_WINLIKEWIDESTRING}
       else
         begin
           { Reallocation is needed... }
@@ -694,7 +702,9 @@ begin
             end;
           fpc_widestr_decr_ref(Pointer(S));
           Pointer(S):=Temp;
-       end;
+        end
+{$endif FPC_WINLIKEWIDESTRING}
+        ;
       { Force nil termination in case it gets shorter }
       PWord(Pointer(S)+l*sizeof(WideChar))^:=0;
       PWideRec(Pointer(S)-FirstOff)^.Len:=l*sizeof(WideChar);
@@ -703,14 +713,11 @@ begin
     begin
       { Length=0 }
       if Pointer(S)<>nil then
-       fpc_widestr_decr_ref (Pointer(S));
+        fpc_widestr_decr_ref (Pointer(S));
       Pointer(S):=Nil;
     end;
 end;
 
-
-
-
 {*****************************************************************************
                      Public functions, In interface.
 *****************************************************************************}
@@ -753,9 +760,11 @@ procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
   end;
 
 
-
-
 Function fpc_widestr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_WIDESTR_UNIQUE']; compilerproc;
+{$ifdef FPC_WINLIKEWIDESTRING}
+  begin
+  end;
+{$else FPC_WINLIKEWIDESTRING}
 {
   Make sure reference count of S is 1,
   using copy-on-write semantics.
@@ -778,6 +787,7 @@ begin
      pointer(result):=SNew;
    end;
 end;
+{$endif FPC_WINLIKEWIDESTRING}
 
 
 Function Fpc_WideStr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc;
@@ -1406,5 +1416,3 @@ procedure initwidestringmanager;
     widestringmanager.CompareTextWideStringProc:=@CompareTextWideString;
     widestringmanager.CharLengthPCharProc:=@CharLengthPChar;
   end;
-
-