Merged revisions 9296-9297,9307-9308,9310,9322,9337,9340,9343-9344,9359,9373-9375,9387,9396,9399,9401-9402,9410 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r9296 | peter | 2007-11-19 23:22:25 +0100 (Mon, 19 Nov 2007) | 3 lines
  
    * typecast to tenumreg before updating usedregs to prevent varset usage, patch from Sergei Gorelkin
........
  r9297 | peter | 2007-11-19 23:24:52 +0100 (Mon, 19 Nov 2007) | 3 lines
  
    * optimize fixpath, findfile to not require temp ansistrings
    * check for verbosity for V_Tried level messages, patches from Sergei Gorelkin
........
  r9410 | jonas | 2007-12-07 16:52:12 +0100 (Fri, 07 Dec 2007) | 5 lines
  
    * move conversions of winlinke widestring, variant and records/arrays-
      with-init-info assignments into helper calls from
      tassignmentnode.pass_typecheck to pass_1 so they can be optimised
      in more cases (patch from Sergei Gorelkin)
........

git-svn-id: branches/fixes_2_2@9845 -

compiler/cfileutils.pas

@@ -109,12 +109,12 @@ interface
     Function  FileExists (const F : TCmdStr;allowcache:boolean) : Boolean;
     function  FileExistsNonCase(const path,fn:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
     Function  RemoveDir(d:TCmdStr):boolean;
-    Function  FixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
+    Function  FixPath(const s:TCmdStr;allowdot:boolean):TCmdStr;
     function  FixFileName(const s:TCmdStr):TCmdStr;
     function  TargetFixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
     function  TargetFixFileName(const s:TCmdStr):TCmdStr;
     procedure SplitBinCmd(const s:TCmdStr;var bstr: TCmdStr;var cstr:TCmdStr);
-    function  FindFile(const f : TCmdStr;path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
+    function  FindFile(const f : TCmdStr; const path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
 {    function  FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean;}
     function  FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
     function  GetShortName(const n:TCmdStr):TCmdStr;
@@ -481,7 +481,7 @@ implementation
         else
 {$endif usedircache}
           Result:=SysUtils.FileExists(F);
-        if assigned(do_comment) then
+        if do_checkverbosity(V_Tried) then
          begin
            if Result then
              do_comment(V_Tried,'Searching file '+F+'... found')
@@ -608,27 +608,37 @@ implementation
       end;
 
 
-    Function FixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
+    Function FixPath(const s:TCmdStr;allowdot:boolean):TCmdStr;
       var
-        i : longint;
+        i, L : longint;
+        P: PChar;
       begin
+        Result := s;
+        L := Length(Result);
+        if L=0 then
+          exit;
         { Fix separator }
-        for i:=1 to length(s) do
-         if s[i] in ['/','\'] then
-          s[i]:=source_info.DirSep;
+        P := @Result[1];
+        for i:=0 to L-1 do
+          begin
+            if p^ in ['/','\'] then
+              p^:=source_info.DirSep;
+            inc(p);
+          end;
         { Fix ending / }
-        if (length(s)>0) and (s[length(s)]<>source_info.DirSep) and
-           (s[length(s)]<>DriveSeparator) then
-         s:=s+source_info.DirSep;
+        if (L>0) and (Result[L]<>source_info.DirSep) and
+           (Result[L]<>DriveSeparator) then
+          Result:=Result+source_info.DirSep;  { !still results in temp AnsiString }
         { Remove ./ }
-        if (not allowdot) and (s='.'+source_info.DirSep) then
-         s:='';
+        if (not allowdot) and ((Length(Result)=2) and (Result[1]='.') and (Result[2] = source_info.DirSep)) then
+          begin
+            Result:='';
+            Exit;
+          end;
         { return }
-        if (tf_files_case_aware in source_info.flags) or
-           (tf_files_case_sensitive in source_info.flags) then
-         FixPath:=s
-        else
-         FixPath:=Lower(s);
+        if not ((tf_files_case_aware in source_info.flags) or
+           (tf_files_case_sensitive in source_info.flags)) then
+          Result := lower(Result);
       end;
 
   {Actually the version in macutils.pp could be used,
@@ -901,7 +911,7 @@ implementation
 
        procedure WarnNonExistingPath(const path : TCmdStr);
        begin
-         if assigned(do_comment) then
+         if do_checkverbosity(V_Tried) then
            do_comment(V_Tried,'Path "'+path+'" not found');
        end;
 
@@ -1090,26 +1100,22 @@ implementation
      end;
 
 
-   function FindFile(const f : TCmdStr;path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
-      Var
-        singlepathstring : TCmdStr;
-        i : longint;
+   function FindFile(const f : TCmdStr; const path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
+     Var
+       StartPos, EndPos, L: LongInt;
      begin
-       if PathSeparator <> ';' then
-        for i:=1 to length(path) do
-         if path[i]=PathSeparator then
-          path[i]:=';';
-       FindFile:=false;
+       Result:=False;
+       StartPos := 1;
+       L := Length(Path);
        repeat
-          i:=pos(';',path);
-          if i=0 then
-           i:=Succ (Length (Path));
-          singlepathstring:=FixPath(copy(path,1,i-1),false);
-          delete(path,1,i);
-          result:=FileExistsNonCase(singlepathstring,f,allowcache,FoundFile);
-          if result then
-            exit;
-       until path='';
+         EndPos := StartPos;
+         while (EndPos <= L) and ((Path[EndPos] <> PathSeparator) and (Path[EndPos] <> ';')) do
+           Inc(EndPos);
+         Result := FileExistsNonCase(FixPath(Copy(Path, StartPos, EndPos-StartPos), False), f, allowcache, FoundFile);
+         if Result then
+           Exit;
+         StartPos := EndPos + 1;
+       until StartPos > L;
        FoundFile:=f;
      end;
 

compiler/cmsgs.pas

@@ -383,7 +383,7 @@ begin
   if hp=nil then
     Get:='msg nr '+tostr(nr)
   else
-    Get:=MsgReplace(strpas(hp),args);
+    Get:=MsgReplace(system.strpas(hp),args);
 end;
 
 end.

compiler/comphook.pas

@@ -123,6 +123,7 @@ var
 Function  def_status:boolean;
 Function  def_comment(Level:Longint;const s:ansistring):boolean;
 function  def_internalerror(i:longint):boolean;
+function  def_CheckVerbosity(v:longint):boolean;
 procedure def_initsymbolinfo;
 procedure def_donesymbolinfo;
 procedure def_extractsymbolinfo;
@@ -134,6 +135,7 @@ type
   tstatusfunction        = function:boolean;
   tcommentfunction       = function(Level:Longint;const s:ansistring):boolean;
   tinternalerrorfunction = function(i:longint):boolean;
+  tcheckverbosityfunction = function(i:longint):boolean;
 
   tinitsymbolinfoproc = procedure;
   tdonesymbolinfoproc = procedure;
@@ -145,6 +147,7 @@ const
   do_status        : tstatusfunction  = @def_status;
   do_comment       : tcommentfunction = @def_comment;
   do_internalerror : tinternalerrorfunction = @def_internalerror;
+  do_checkverbosity : tcheckverbosityfunction = @def_checkverbosity;
 
   do_initsymbolinfo : tinitsymbolinfoproc = @def_initsymbolinfo;
   do_donesymbolinfo : tdonesymbolinfoproc = @def_donesymbolinfo;
@@ -368,6 +371,12 @@ begin
   def_internalerror:=true;
 end;
 
+function def_CheckVerbosity(v:longint):boolean;
+begin
+  result:=status.use_bugreport or
+          ((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask));
+end;
+
 procedure def_initsymbolinfo;
 begin
 end;

compiler/fppu.pas

@@ -265,7 +265,8 @@ uses
 
          Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean;
          begin
-           Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
+           if CheckVerbosity(V_Tried) then
+             Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
            UnitExists:=FindFile(FileName+ext,Singlepathstring,true,foundfile);
          end;
 
@@ -382,16 +383,19 @@ uses
           begin
             { the full filename is specified so we can't use here the
               searchpath (PFV) }
-            Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,sourceext));
+            if CheckVerbosity(V_Tried) then
+              Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,sourceext));
             fnd:=FindFile(ChangeFileExt(sourcefn^,sourceext),'',true,hs);
             if not fnd then
              begin
-               Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pasext));
+               if CheckVerbosity(V_Tried) then
+                 Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pasext));
                fnd:=FindFile(ChangeFileExt(sourcefn^,pasext),'',true,hs);
              end;
             if not fnd and ((m_mac in current_settings.modeswitches) or (tf_p_ext_support in target_info.flags)) then
              begin
-               Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pext));
+               if CheckVerbosity(V_Tried) then
+                 Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pext));
                fnd:=FindFile(ChangeFileExt(sourcefn^,pext),'',true,hs);
              end;
             if fnd then

compiler/i386/daopt386.pas

@@ -65,8 +65,9 @@ const
 {********************************* Types *********************************}
 
 type
-  TRegArray = Array[RS_EAX..RS_ESP] of tsuperregister;
-  TRegSet = Set of RS_EAX..RS_ESP;
+  TRegEnum = RS_EAX..RS_ESP;
+  TRegArray = Array[TRegEnum] of tsuperregister;
+  TRegSet = Set of TRegEnum;
   toptreginfo = Record
                 NewRegsEncountered, OldRegsEncountered: TRegSet;
                 RegsLoadedForRef: TRegSet;
@@ -337,9 +338,9 @@ begin
       begin
         case tai_regalloc(p).ratype of
           ra_alloc :
-            UsedRegs := UsedRegs + [tai_regalloc(p).reg];
+            Include(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
           ra_dealloc :
-            UsedRegs := UsedRegs - [tai_regalloc(p).reg];
+            Exclude(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
         end;
         p := tai(p.next);
       end;
@@ -1151,9 +1152,9 @@ begin
           begin
             case tai_regalloc(p).ratype of
               ra_alloc :
-                UsedRegs := UsedRegs + [getsupreg(tai_regalloc(p).reg)];
+                Include(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
               ra_dealloc :
-                UsedRegs := UsedRegs - [getsupreg(tai_regalloc(p).reg)];
+                Exclude(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
             end;
           end;
         p := tai(p.next);

compiler/nld.pas

@@ -592,48 +592,6 @@ implementation
                right:=nil;
                exit;
              end;
-         end
-        { call helpers for variant, they can contain non ref. counted types like
-          vararrays which must be really copied }
-        else if left.resultdef.typ=variantdef then
-         begin
-           hp:=ccallparanode.create(ctypeconvnode.create_internal(
-                 caddrnode.create_internal(right),voidpointertype),
-               ccallparanode.create(ctypeconvnode.create_internal(
-                 caddrnode.create_internal(left),voidpointertype),
-               nil));
-           result:=ccallnode.createintern('fpc_variant_copy',hp);
-           left:=nil;
-           right:=nil;
-           exit;
-         end
-        { call helpers for composite types containing automated types }
-        else if (left.resultdef.needs_inittable) and
-            (left.resultdef.typ in [arraydef,objectdef,recorddef]) and
-            not is_dynamic_array(left.resultdef) then
-         begin
-           hp:=ccallparanode.create(caddrnode.create_internal(
-                  crttinode.create(tstoreddef(left.resultdef),initrtti)),
-               ccallparanode.create(ctypeconvnode.create_internal(
-                 caddrnode.create_internal(left),voidpointertype),
-               ccallparanode.create(ctypeconvnode.create_internal(
-                 caddrnode.create_internal(right),voidpointertype),
-               nil)));
-           result:=ccallnode.createintern('fpc_copy_proc',hp);
-           left:=nil;
-           right:=nil;
-           exit;
-         end
-        { call helpers for windows widestrings, they aren't ref. counted }
-        else if (tf_winlikewidestring in target_info.flags) and is_widestring(left.resultdef) 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 }
@@ -751,7 +709,69 @@ implementation
                  exit;
                end;
             end;
-           end;
+           end
+        { call helpers for composite types containing automated types }
+        else if (left.resultdef.needs_inittable) and
+            (left.resultdef.typ in [arraydef,objectdef,recorddef]) and
+            not is_interfacecom(left.resultdef) and
+            not is_dynamic_array(left.resultdef) then
+         begin
+           hp:=ccallparanode.create(caddrnode.create_internal(
+                  crttinode.create(tstoreddef(left.resultdef),initrtti)),
+               ccallparanode.create(ctypeconvnode.create_internal(
+                 caddrnode.create_internal(left),voidpointertype),
+               ccallparanode.create(ctypeconvnode.create_internal(
+                 caddrnode.create_internal(right),voidpointertype),
+               nil)));
+           result:=ccallnode.createintern('fpc_copy_proc',hp);
+           firstpass(result);
+           left:=nil;
+           right:=nil;
+           exit;
+         end
+        { call helpers for variant, they can contain non ref. counted types like
+          vararrays which must be really copied }
+        else if left.resultdef.typ=variantdef then
+         begin
+           hp:=ccallparanode.create(ctypeconvnode.create_internal(
+                 caddrnode.create_internal(right),voidpointertype),
+               ccallparanode.create(ctypeconvnode.create_internal(
+                 caddrnode.create_internal(left),voidpointertype),
+               nil));
+           result:=ccallnode.createintern('fpc_variant_copy',hp);
+           firstpass(result);
+           left:=nil;
+           right:=nil;
+           exit;
+         end
+        { call helpers for windows widestrings, they aren't ref. counted }
+        else if (tf_winlikewidestring in target_info.flags) and is_widestring(left.resultdef) then
+         begin
+           { The first argument of fpc_widestr_assign is a var parameter. Properties cannot   }
+           { be passed to var or out parameters, because in that case setters/getters are not }
+           { used. Further, if we would allow it in case there are no getters or setters, you }
+           { would need source changes in case these are introduced later on, thus defeating  }
+           { part of the transparency advantages of properties. In this particular case,      }
+           { however:                                                                         }
+           {   a) if there is a setter, this code will not be used since then the assignment  }
+           {      will be converted to a procedure call                                       }
+           {   b) the getter is irrelevant, because fpc_widestr_assign must always decrease   }
+           {      the refcount of the field to which we are writing                           }
+           {   c) source code changes are not required if a setter is added/removed, because  }
+           {      this transformation is handled at compile time                              }
+           {  -> we can remove the nf_isproperty flag (if any) from left, so that in case it  }
+           {     is a property which refers to a field without a setter call, we will not get }
+           {     an error about trying to pass a property as a var parameter                  }
+           exclude(left.flags,nf_isproperty);
+           hp:=ccallparanode.create(ctypeconvnode.create_internal(right,voidpointertype),
+               ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),
+               nil));
+           result:=ccallnode.createintern('fpc_widestr_assign',hp);
+           firstpass(result);
+           left:=nil;
+           right:=nil;
+           exit;
+         end;
 
          registersint:=left.registersint+right.registersint;
          registersfpu:=max(left.registersfpu,right.registersfpu);

compiler/verbose.pas

@@ -179,8 +179,7 @@ implementation
 
     function CheckVerbosity(v:longint):boolean;
       begin
-        CheckVerbosity:=status.use_bugreport or
-                        ((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask));
+        result:=do_checkverbosity(v);
       end;