Merge branch source:main into main

compiler/riscv/nrvadd.pas

@@ -59,11 +59,10 @@ implementation
       globtype,systems,
       cutils,verbose,globals,
       symconst,symdef,paramgr,
-      aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk,
+      aasmbase,aasmdata,aasmcpu,defutil,
       cgbase,cpuinfo,pass_1,pass_2,
-      cpupara,cgcpu,cgutils,procinfo,
-      ncon,nset,
-      ncgutil,tgobj,rgobj,rgcpu,cgobj,hlcgobj;
+      cpupara,cgutils,procinfo,
+      ncgutil,cgobj,hlcgobj;
 
 {$undef AVOID_OVERFLOW}
 {$ifopt Q+}
@@ -351,7 +350,11 @@ implementation
         op    : TAsmOp;
         cmpop,
         singleprec , inv: boolean;
+        l1, l2: TAsmLabel;
+        tmpreg1, tmpreg2: TRegister;
       begin
+        l1:=nil;
+        l2:=nil;
         pass_left_and_right;
         if (nf_swapped in flags) then
           swapleftright;
@@ -442,19 +445,39 @@ implementation
         hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
         hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
 
-        // initialize de result
+        { initialize the result and check floats for Nan}
         if not cmpop then
           begin
             location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
-            location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+            location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
           end
         else
-         begin
-           location_reset(location,LOC_REGISTER,OS_8);
-           location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-         end;
+          begin
+            tmpreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+            tmpreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+
+            if singleprec then
+              begin
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FEQ_S,tmpreg1,right.location.register,right.location.register));
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FEQ_S,tmpreg2,left.location.register,left.location.register));
+              end
+            else
+              begin
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FEQ_D,tmpreg1,right.location.register,right.location.register));
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FEQ_D,tmpreg2,left.location.register,left.location.register));
+              end;
+
+            location_reset(location,LOC_REGISTER,OS_8);
+            location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
 
-        // emit the actual operation
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_AND,location.register,tmpreg1,tmpreg2));
+
+            current_asmdata.getjumplabel(l1);
+
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_sym(A_BEQZ,location.register,l1));
+          end;
+
+        { emit the actual operation }
         if not cmpop then
           begin
             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,location.register,left.location.register,right.location.register));
@@ -465,6 +488,8 @@ implementation
             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,location.register,left.location.register,right.location.register));
             cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
 
+            cg.a_label(current_asmdata.CurrAsmList,l1);
+
             if inv then
               current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_XORI,location.register,location.register,1));
           end;

packages/fpmkunit/src/fpmkunit.pp

@@ -173,7 +173,7 @@ Type
   TCompilerMode = (cmFPC,cmTP,cmObjFPC,cmDelphi,cmMacPas,cmDelphiUnicode);
   TCompilerModes = Set of TCompilerMode;
 
-  TInstallMOde = (imInstall, imUnInstall);
+  TInstallMode = (imInstall, imUnInstall);
 
   TTargetType = (ttProgram,ttUnit,ttImplicitUnit,ttCleanOnlyUnit,ttExampleUnit,ttExampleProgram,ttFPDoc,ttSharedLibrary);
   TTargetTypes = set of TTargetType;
@@ -688,6 +688,7 @@ Type
   { TDependencies }
 
   TDependencies = Class(TConditionalStrings)
+  Private
     function GetDependency(Index : Integer): TDependency;
     procedure SetDependency(Index : Integer; const AValue: TDependency);
   Public
@@ -781,7 +782,7 @@ Type
     procedure SetXML(const AValue: string);
     // Deprecated API
     Procedure GetCleanFiles(List : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS; const aSubTarget : String); virtual; deprecated 'use TcompileTarget instead';
-    Procedure GetArchiveFiles(List : TStrings; ACPU:TCPU; AOS : TOS); virtual; virtual; deprecated 'use TcompileTarget instead';
+    Procedure GetArchiveFiles(List : TStrings; ACPU:TCPU; AOS : TOS); virtual; deprecated 'use TcompileTarget instead';
     Procedure GetInstallFiles(List : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS; const aSubTarget : String); virtual; deprecated 'use TcompileTarget instead';
     Procedure GetCleanFiles(List : TStrings; const APrefixU, APrefixB : String; const aTarget : TcompileTarget); virtual;
     Procedure GetInstallFiles(List : TStrings; const APrefixU, APrefixB : String; const aTarget : TCompileTarget); virtual;
@@ -1055,8 +1056,9 @@ Type
     procedure SaveUnitConfigToFile(Const AFileName: String;ACPU:TCPU;AOS:TOS);
     procedure EnterResolveDirsCS;
     procedure LeaveResolveDirsCS;
-    procedure ApplyNameSpaces(aEngine : TBuildEngine; aFileName : string; aTarget : TCompileTarget);
+    Function AddTargetsFromDir(const aDirectory : String; const aMask : String = '') : longint;
     // applies namespaces if map is set
+    procedure ApplyNameSpaces(aEngine : TBuildEngine; aFileName : string; aTarget : TCompileTarget);
     procedure ApplyNameSpaces(aEngine : TBuildEngine; aTarget : TCompileTarget);
     Function SubTargetAllowed(Const aSubTarget : String) : Boolean;
     Property Version : String Read GetVersion Write SetVersion;
@@ -1238,7 +1240,7 @@ Type
   Public
     Constructor Create;
     Destructor Destroy; override;
-    Procedure InitDefaults;
+    Procedure InitDefaults; virtual;
     Function HaveOptions: Boolean;
     Procedure AddOption(const aValue : string);
     function IsBuildDifferentFromTarget: boolean;
@@ -1536,6 +1538,7 @@ Type
     Destructor destroy; override;
     Function AddPackage(Const AName : String) : TPackage;
     Function AddPackageVariant(AName: string; AIsInheritable: boolean; AutoAddToPackage: Boolean = false): TPackageVariants;
+    Function AddPackageFromDir(Const AName : String; const aDirectory : String; const aMask : string = '') : TPackage;
     Function Run : Boolean;
     Property FPMakeOptionsString: string read FFPMakeOptionsString;
     Property BuildEngine : TBuildEngine Read FBuildEngine;
@@ -1560,15 +1563,21 @@ Type
   { TValueItem }
 
   TValueItem = Class(TObject)
+  Private
     FValue : String;
+  Public  
     Constructor Create(AValue : String);
+    Property Value : String Read FValue;
   end;
 
   { TFunctionItem }
 
   TFunctionItem = Class(TObject)
+  Private
     FFunc : TReplaceFunction;
-    Constructor Create(AFunc : TReplaceFunction);
+  public  
+    Constructor Create(AFunc : TReplaceFunction); 
+    Property Func : TReplaceFunction Read FFunc;
   end;
 
 {$ifndef NO_THREADING}
@@ -2070,6 +2079,7 @@ ResourceString
   sHelpPackageVariant4= ' +[variantname]*=[variant1],<variant2>,...';
   sHelpPackageVariant5= 'To add specific options for one package-variant:';
   sHelpPackageVariant6= ' --options_[variantname]_[variant1]=Value';
+  SSwitchingToBuildUnitCompilation = 'Switching to buildunit compilation of package %s';
 
 
 Const
@@ -5138,6 +5148,50 @@ begin
 {$endif}
 end;
 
+function TPackage.AddTargetsFromDir(const aDirectory: String; const aMask: String): longint;
+var
+  lMasks : Array of string;
+  lMask : string;
+  lDir,lFile : string;
+  lInfo : TSearchRec;
+begin
+  if aDirectory='' then
+    lDir:='./'
+  else
+    lDir:=IncludeTrailingPathDelimiter(aDirectory);
+  if not DirectoryExists(lDir) then
+    Exit(-1);
+  if aMask='' then
+    lMasks:=['*.pp','*.pas','*.lpr']
+  else
+    lMasks:=aMask.Split([';']);
+  Result:=0;
+  for lMask in lMasks do
+    begin
+    if FindFirst(lDir+lMask,0,lInfo)=0 then
+      try
+        repeat
+          lFile:=ldir+lInfo.Name;
+          if SameFileName(ExtractFileExt(lInfo.Name),'.lpr') then
+            Targets.AddProgram(lFile)
+          else
+            // Todo: add some detection for program/unit
+            Targets.AddUnit(lFile);
+          Installer.Log(vlInfo,Format('Adding unit %s to targets of %s',[lFile,Name]));
+          Inc(Result);
+        until FindNext(lInfo)<>0;
+      finally
+        FindClose(lInfo)
+      end;
+    end;
+  if Result>0 then
+    begin
+    Installer.Log(vlInfo, Format(SSwitchingToBuildUnitCompilation, [Name]));
+    Defaults.BuildMode:=bmBuildUnit;
+    FSupportBuildModes:=[bmBuildUnit];
+    end;
+end;
+
 procedure TPackage.ChangePaths(Aliases : TStrings; aTarget : TCompileTarget);
 
 var
@@ -6086,6 +6140,15 @@ begin
   FPackageVariants.Add(result);
 end;
 
+function TCustomInstaller.AddPackageFromDir(const AName: String; const aDirectory: String; const aMask: string): TPackage;
+begin
+  Result:=AddPackage(aName);
+  if Result.AddTargetsFromDir(aDirectory,aMask)<=0 then
+    Result.Free
+  else
+    Result.Dependencies.Clear;
+end;
+
 procedure TCustomInstaller.AnalyzeOptions;
 
   Function CheckOption(Index : Integer;const Short,Long : String; AddToOptionString: boolean = false): Boolean;