Browse Source

Merge remote-tracking branch 'origin/main' into wasm_js_promise_integration

Nikolay Nikolov 2 years ago
parent
commit
8ac46ed38c

+ 5 - 0
compiler/globals.pas

@@ -256,6 +256,9 @@ interface
        outputfilename    : string;
        outputprefix      : pshortstring;
        outputsuffix      : pshortstring;
+       { selected subtarget }
+       subtarget         : string;
+
        { specified with -FE or -FU }
        outputexedir      : TPathStr;
        outputunitdir     : TPathStr;
@@ -1002,6 +1005,8 @@ implementation
          if (tf_use_8_3 in Source_Info.Flags) or
             (tf_use_8_3 in Target_Info.Flags) then
            Replace(s,'$FPCTARGET',target_os_string)
+         else if subtarget<>'' then
+           Replace(s,'$FPCTARGET',target_full_string+'-'+lower(subtarget))
          else
            Replace(s,'$FPCTARGET',target_full_string);
          Replace(s,'$FPCSUBARCH',lower(cputypestr[init_settings.cputype]));

+ 16 - 0
compiler/msg/errore.msg

@@ -30,6 +30,7 @@
 #   exec_     calls to assembler, external linker, binder
 #   link_     internal linker
 #   package_  package handling
+#   sym_      symbol handling 
 #
 # <type> the type of the message it should normally used for
 #   f_   fatal error
@@ -2439,6 +2440,10 @@ sym_e_type_must_be_rec_or_object=05098_E_Record or object type expected
 sym_e_symbol_no_capture=05099_E_Symbol "$1" can not be captured
 % The specified symbol can not be captured to be used in a function reference.
 % For example \var{var} or \var{out} parameters can not be captured in that way.
+sym_f_systemunitnotloaded=05100_F_System unit not loaded.
+% The compiler used a function that requires the system unit to be loaded,
+% but it was not yet loaded. This is an internal compiler error and must be reported.
+%
 % \end{description}
 #
 # Codegenerator
@@ -3637,6 +3642,12 @@ option_unsupported_fpu=11063_F_The selected FPU type "$1" is not supported by th
 % Not all instruction sets support all FPU types. For example on ARM, Thumb(-1) supports no FPU/VFP instruction set
 option_too_many_exception_modes=11064_E_Only one WebAssembly exception support mode can be specified.
 % Only one WebAssembly exception support mode (NOEXCEPTIONS, JSEXCEPTIONS, BFEXCEPTIONS or NATIVEEXCEPTIONS) can be specified.
+option_subtarget_is_already_set=11065_W_Subtarget is already set to: $1
+% Displayed if more than one \var{-t} option is specified.
+option_subtarget_config_not_found=11066_E_Subtarget $1 specified but no corresponding config file $2 found.
+% Displayed if more than one \var{-t} option is specified.
+option_x_ignored=11067_N_Ignoring compiler executable suffix $1.
+% Displayed if more than one \var{-t} option is specified.
 %\end{description}
 # EndOfTeX
 
@@ -4321,6 +4332,10 @@ Z*2Tzxspectrum_ZX Spectrum
 W*2Tembedded_Embedded
 W*2Twasi_The WebAssembly System Interface (WASI)
 # end of targets section
+**1t<x>_Target architecture
+**2*_ * Defines FPC_SUBTARGET_<x> 
+**2*_ * Defines FPC_SUBTARGET as <arg>
+**2*_ * Additionally reads config file fpc-<subtarget>.cfg
 **1u<x>_Undefines the symbol <x>
 **1U_Unit options:
 **2Un_Do not check where the unit name matches the file name
@@ -4424,6 +4439,7 @@ P*2WT_Specify MPW tool type application (Classic Mac OS)
 6*3WQqhdr_Set metadata to QDOS File Header style (default)
 6*3WQxtcc_Set metadata to XTcc style
 **2WX_Enable executable stack (Linux)
+**1x<suff>_Set suffix for compiler executable (fpc command only).
 **1X_Executable options:
 **2X9_Generate linkerscript for GNU Binutils ld older than version 2.19.1 (Linux)
 **2Xa_Generate code which allows to use more than 2 GB static data on 64 bit targets (Linux)

+ 7 - 3
compiler/msgidx.inc

@@ -691,6 +691,7 @@ const
   sym_e_generic_type_param_decl=05097;
   sym_e_type_must_be_rec_or_object=05098;
   sym_e_symbol_no_capture=05099;
+  sym_f_systemunitnotloaded=05100;
   cg_e_parasize_too_big=06009;
   cg_e_file_must_call_by_reference=06012;
   cg_e_cant_use_far_pointer_there=06013;
@@ -1108,6 +1109,9 @@ const
   option_valgrind_heaptrc_mismatch=11062;
   option_unsupported_fpu=11063;
   option_too_many_exception_modes=11064;
+  option_subtarget_is_already_set=11065;
+  option_subtarget_config_not_found=11066;
+  option_x_ignored=11067;
   wpo_cant_find_file=12000;
   wpo_begin_processing=12001;
   wpo_end_processing=12002;
@@ -1161,9 +1165,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 90964;
+  MsgTxtSize = 91385;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,109,369,133,100,63,148,38,223,71,
-    65,20,30,1,1,1,1,1,1,1
+    28,109,369,133,101,63,148,38,223,71,
+    68,20,30,1,1,1,1,1,1,1
   );

File diff suppressed because it is too large
+ 363 - 356
compiler/msgtxt.inc


+ 52 - 3
compiler/options.pas

@@ -56,6 +56,7 @@ Type
     paratarget        : tsystem;
     paratargetasm     : tasm;
     paratargetdbg     : tdbg;
+    parasubtarget    : string;
     LinkTypeSetExplicitly : boolean;
     LinkerSetExplicitly : boolean;
     Constructor Create;
@@ -123,8 +124,10 @@ const
 
 var
   option     : toption;
+  read_subfile,         { read subtarget config file, set when a cfgfile is found }
   read_configfile,        { read config file, set when a cfgfile is found }
   disable_configfile : boolean;
+  subcfg,
   fpcdir,
   ppccfg,
   param_file    : string;   { file to compile specified on the commandline }
@@ -1507,7 +1510,7 @@ begin
      not(
          (opt[1]='-') and
          (
-          ((length(opt)>1) and (opt[2] in ['i','d','v','T','u','n','X','l','U'])) or
+          ((length(opt)>1) and (opt[2] in ['i','d','v','T','t','u','n','x','X','l','U'])) or
           ((length(opt)>3) and (opt[2]='F') and (opt[3]='e')) or
           ((length(opt)>2) and (opt[2]='C') and (opt[3] in ['a','b','f','p'])) or
           ((length(opt)>3) and (opt[2]='W') and (opt[3] in ['m','p']))
@@ -2782,6 +2785,22 @@ begin
                 if More<>upper(target_info.shortname) then
                  Message1(option_target_is_already_set,target_info.shortname);
              end;
+           't' :
+             begin
+               more:=Upper(More);
+               if (more='') then
+                 Message1(option_missing_arg,'-t')
+               else
+                 begin
+                 if (self.parasubtarget<>'') and (More<>upper(self.parasubtarget)) then
+                    Message1(option_subtarget_is_already_set,self.parasubtarget)
+                 else
+                    begin
+                    self.parasubtarget:=more;
+                    end;
+                 end;
+
+             end;
 
            'u' :
              if is_identifier(more) then
@@ -3177,7 +3196,8 @@ begin
                   inc(j);
                 end;
              end;
-
+           'x' :
+             message1(option_x_ignored,more);
            'X' :
              begin
                j:=1;
@@ -3768,6 +3788,7 @@ procedure toption.writequickinfo;
 var
   s : string;
   i : longint;
+  emptyOK : Boolean;
 
   procedure addinfo(const hs:string);
   begin
@@ -3778,6 +3799,7 @@ var
   end;
 
 begin
+  emptyOK:=False;
   s:='';
   i:=0;
   while (i<length(quickinfo)) do
@@ -3804,6 +3826,11 @@ begin
              addinfo(lower(target_info.shortname));
            'P' :
              AddInfo(target_cpu_string);
+           'T' :
+             begin
+             addinfo(lower(self.parasubtarget));
+             emptyOK:=True;
+             end
            else
              IllegalPara('-i'+QuickInfo);
           end;
@@ -3820,7 +3847,7 @@ begin
         IllegalPara('-i'+QuickInfo);
     end;
   end;
-  if s<>'' then
+  if (s<>'') or EmptyOK then
    begin
      writeln(s);
      stopoptions(0);
@@ -4155,6 +4182,8 @@ begin
    end;
 end;
 
+
+
 procedure read_arguments(cmd:TCmdStr);
 
   procedure def_cpu_macros;
@@ -4580,6 +4609,16 @@ begin
 
   { don't remove this, it's also for fpdoc necessary (FK) }
   def_system_macro('FPC_HAS_FEATURE_SUPPORT');
+  if (Option.parasubtarget<>'') then
+    begin
+    def_system_macro('FPC_SUBTARGET_'+Option.parasubtarget);
+    if cs_support_macro in init_settings.moduleswitches then
+      set_system_macro('FPC_SUBTARGET',Option.parasubtarget)
+    else
+      set_system_compvar('FPC_SUBTARGET',Option.parasubtarget);
+    // So it can be used in macro substitution.
+    globals.subtarget:=Option.parasubtarget;
+    end;
 
   { make cpu makros available when reading the config files the second time }
   def_cpu_macros;
@@ -4649,6 +4688,14 @@ begin
     read_configfile:=check_configfile(ppccfg,ppccfg)
   else
     read_configfile := false;
+  if (option.parasubtarget<>'') then
+    begin
+    subcfg:='fpc-'+lower(option.parasubtarget)+'.cfg';
+    read_subfile:=check_configfile(subcfg,subcfg);
+    // Warn if we didn't find an architecture-specific file
+    if not read_subfile then
+      message2(option_subtarget_config_not_found,option.parasubtarget,subcfg);
+    end;
 
 { Read commandline and configfile }
   param_file:='';
@@ -4656,6 +4703,8 @@ begin
   { read configfile }
   if read_configfile then
     option.interpret_file(ppccfg);
+  if read_subfile then
+    option.interpret_file(subcfg);
 
   { read parameters again to override config file }
   if cmd<>'' then

+ 11 - 1
compiler/symtable.pas

@@ -3071,11 +3071,17 @@ implementation
           end;
       end;
 
+    procedure check_systemunit_loaded; inline;
+    begin
+      if systemunit=nil then
+       Message(sym_f_systemunitnotloaded);
+    end;
 
     procedure write_system_parameter_lists(const name:string);
       var
         srsym:tprocsym;
       begin
+        check_systemunit_loaded;
         srsym:=tprocsym(systemunit.find(name));
         if not assigned(srsym) or not (srsym.typ=procsym) then
           internalerror(2016060302);
@@ -3617,8 +3623,9 @@ implementation
       var
         pmod : tmodule;
       begin
-        pmod:=tmodule(pm);
         result:=false;
+        if not assigned(pm) then exit;
+        pmod:=tmodule(pm);
         if assigned(pmod.globalsymtable) then
           begin
             srsym:=tsym(pmod.globalsymtable.Find(s));
@@ -4218,6 +4225,7 @@ implementation
       var
         sym : tsym;
       begin
+        check_systemunit_loaded;
         sym:=tsym(systemunit.Find(s));
         if not assigned(sym) or
            (sym.typ<>typesym) then
@@ -4230,6 +4238,7 @@ implementation
       var
         sym : tsym;
       begin
+        check_systemunit_loaded;
         sym:=tsym(systemunit.Find(s));
         if not assigned(sym) then
           result:=nil
@@ -4267,6 +4276,7 @@ implementation
       var
         srsym: tsym;
       begin
+        check_systemunit_loaded;
         srsym:=tsym(systemunit.find(s));
         if not assigned(srsym) and
            (cs_compilesystem in current_settings.moduleswitches) then

+ 199 - 53
compiler/utils/fpc.pp

@@ -126,7 +126,7 @@ Const
     {$endif sparc}
     {$ifdef sparc64}
          ppcbin:='ppcsparc64';
-          processorname:='sparc64';
+         processorname:='sparc64';
     {$endif sparc64}
     {$ifdef x86_64}
          ppcbin:='ppcx64';
@@ -183,6 +183,8 @@ Const
     end;
 
   var
+    warn : Boolean;
+    ShowErrno : Boolean;
     extrapath : ansistring;
 
   function findexe(var ppcbin:string): boolean;
@@ -261,18 +263,146 @@ Const
           writeln(processorname);
           halt(0);
         end;
-   end;
+      end;
 
+Function FindConfigFile(const aFile : string) : String;
+// Adapted from check_configfile(fn:string; var foundfn:string):boolean;
+{
+  Order to read configuration file :
+  Unix:
+   1 - current dir
+   2 - ~/.fpc.cfg
+   3 - configpath
+   4 - /etc
+  Windows:
+   1 - current dir
+   2 - home dir of user or all users
+   3 - config path
+   4 - next to binary
+  Other:
+   1 - current dir
+   3 - config path
+   4 - next to binary
+}
+
+var
+  {$ifdef unix}hs,{$endif} aSearchPath,exepath,configpath : string;
+
+  Procedure AddToPath(aDir : String);
+
+  begin
+    if aDir='' then exit;
+    if (aSearchPath<>'') then
+      aSearchPath:=aSearchPath+PathSeparator;
+    aSearchPath:=aSearchPath+IncludeTrailingPathDelimiter(SetDirSeparators(aDir));
+  end;
+
+begin
+  if FileExists(aFile) then
+    Exit(aFile);
+  ExePath:=SetDirSeparators(ExtractFilePath(paramstr(0)));
+  aSearchPath:='';
+  { retrieve configpath }
+  configpath:=SetDirSeparators(GetEnvironmentVariable('PPC_CONFIG_PATH'));
+{$ifdef Unix}
+  hs:=SetDirSeparators(GetEnvironmentVariable('HOME'));
+  if (hs<>'') then
+    begin
+    Result:=IncludeTrailingPathDelimiter(hs)+'.'+aFile;
+    if FileExists(Result) then
+      exit;
+    end;
+  if configpath='' then
+    configpath:=ExpandFileName(ExePath+'../etc/');
+{$endif}
+  AddToPath(ConfigPath);
+{$ifdef WINDOWS}
+  AddToPath(GetEnvironmentVariable('USERPROFILE'));
+  AddToPath(GetEnvironmentVariable('ALLUSERSPROFILE'));
+{$endif WINDOWS}
+{$ifdef Unix}
+  AddToPath('/etc/');
+{$else}
+  AddToPath(exepath);
+{$endif}
+  Result:=FileSearch(aFile,aSearchPath);
+end;
+
+Procedure CheckWarn(aOpt : String);
+
+Var
+  Len,I : integer;
+
+begin
+  Len:=Length(aOpt);
+  For I:=1 to Len do
+    begin
+    if (aOpt[i]='w') then
+      Warn:=(I=Len) or (aOpt[i+1]<>'-');
+    if (aOpt[i]='q') then
+      ShowErrNo:=(I=Len) or (aOpt[i+1]<>'-');
+    end;
+end;
+
+procedure SetExeSuffix(var ExeSuffix : string; aValue : string);
+
+begin
+  if ExeSuffix='' then
+    exesuffix :=aValue
+  else if Warn then
+    begin
+    Write('Warning: ');
+    if ShowErrNo then
+      Write('(99999) ');
+    Writeln('Compiler version already set to: ',ExeSuffix);
+    end;
+end;
+
+Procedure ProcessConfigFile(aFileName : String; var ExeSuffix : String);
+
+  Function Stripline(aLine : String) : string;
+
+  Var
+    P : integer;
+
+  begin
+    if (aLine<>'') and (aLine[1]=';') then exit;
+    Pos('#',aLine); // no ifdef or include.
+    if P=0 then
+      P:=Length(aLine)+1;
+    Result:=Copy(aLine,1,P-1);
+  end;
+
+Var
+  aFile : Text;
+  aLine : String;
+
+begin
+  Assign(aFile,aFileName);
+  {$push}{$I-}
+  filemode:=0;
+  Reset(aFile);
+  {$pop}
+  if ioresult<>0 then
+    Error('Cannot open config file: '+aFileName);
+  While not EOF(aFile) do
+    begin
+    ReadLn(aFile,aLine);
+    aLine:=StripLine(aLine);
+    if aLine='' then
+      continue;
+    if Copy(aLine,1,2)='-V' then
+      SetExeSuffix(ExeSuffix,Copy(aLine,3,Length(aLine)-2));
+    end;
+  {$i+}
+  Close(aFile);
+end;
 
   var
-     s              : ansistring;
-     cpusuffix,
-     SourceCPU,
-     ppcbin,
-     versionStr,
-     TargetCPU   : string;
-     ppccommandline : array of ansistring;
-     ppccommandlinelen : longint;
+     s,CfgFile: ansistring;
+     CPUSuffix, ExeSuffix, SourceCPU, ppcbin, TargetName, TargetCPU: string;
+     PPCCommandLine: array of ansistring;
+     PPCCommandLineLen: longint;
      i : longint;
      errorvalue     : Longint;
 
@@ -283,54 +413,70 @@ Const
        Inc(PPCCommandLineLen);
      end;
 
+begin
+  ppccommandline := [];
+  setlength(ppccommandline, paramcount);
+  ppccommandlinelen := 0;
+  cpusuffix := '';        // if not empty, signals attempt at cross
+  // compiler.
+  extrapath := '';
+  initplatform(ppcbin, SourceCPU);
+  exesuffix := '';                      { Default is just the name }
+  if ParamCount = 0 then
   begin
-     ppccommandline:=[];
-     setlength(ppccommandline,paramcount);
-     ppccommandlinelen:=0;
-     cpusuffix     :='';        // if not empty, signals attempt at cross
-                                // compiler.
-     extrapath     :='';
-     versionstr:='';                      { Default is just the name }
-     initplatform(ppcbin,SourceCPU);
-     if ParamCount = 0 then
-       begin
-         SetLength (PPCCommandLine, 1);
-         AddToCommandLine('-?F' + ParamStr (0));
-       end
-     else
-      for i:=1 to paramcount do
-       begin
-          s:=paramstr(i);
-          if pos('-V',s)=1 then
-              versionstr:=copy(s,3,length(s)-2)
+    SetLength(PPCCommandLine, 1);
+    AddToCommandLine('-?F'+ParamStr(0));
+  end
+  else
+    for i := 1 to paramcount do
+    begin
+      s := ParamStr(i);
+      if pos('-t', s) = 1 then
+      begin
+        targetname := copy(s, 3, length(s)-2);
+        AddToCommandLine(S);
+      end
+      else if pos('-V', s) = 1 then
+        SetExeSuffix(ExeSuffix,copy(s, 3, length(s)-2))
+      else
+      begin
+        if pos('-P', s) = 1 then
+           begin
+             TargetCPU:=copy(s,3,length(s)-2);
+             CheckSpecialProcessors(TargetCPU,SourceCPU,ppcbin,cpusuffix,exesuffix);
+             if TargetCPU <> SourceCPU then
+               begin
+                 cpusuffix:=processortosuffix(TargetCPU);
+                 ppcbin:='ppc'+crosssuffix+cpusuffix;
+               end;
+           end
+        else if pos('-Xp',s)=1 then
+          extrapath:=copy(s,4,length(s)-3)
+        else
+        begin
+          if pos('-h', s) = 1 then
+            AddToCommandLine('-hF'+ParamStr(0))
+          else if pos('-?', s) = 1 then
+            AddToCommandLine('-?F'+ParamStr(0))
           else
             begin
-              if pos('-P',s)=1 then
-                 begin
-                   TargetCPU:=copy(s,3,length(s)-2);
-                   CheckSpecialProcessors(TargetCPU,SourceCPU,ppcbin,cpusuffix,versionstr);
-                   if TargetCPU <> SourceCPU then
-                     begin
-                       cpusuffix:=processortosuffix(TargetCPU);
-                       ppcbin:='ppc'+crosssuffix+cpusuffix;
-                     end;
-                 end
-              else if pos('-Xp',s)=1 then
-                extrapath:=copy(s,4,length(s)-3)
-              else
-                begin
-                  if pos('-h',s)=1 then
-                    AddToCommandLine('-hF'+ParamStr(0))
-                  else if pos('-?',s)=1 then
-                    AddToCommandLine('-?F'+ParamStr(0))
-                  else
-                    AddToCommandLine(S);
-                end;
+            AddToCommandLine(S);
+            if pos('-v', s) = 1 then
+              CheckWarn(Copy(S,3,length(S)-2));
             end;
+        end;
+      end;
+    end;
+     if (TargetName<>'') then
+       begin
+       S:='fpc-'+TargetName+'.cfg';
+       CfgFile:=FindConfigFile(s);
+       if CfgFile='' then
+         Error('Cannot find subtarget config file: '+s);
+       ProcessConfigFile(CfgFile,ExeSuffix);
        end;
-     SetLength(ppccommandline,ppccommandlinelen);
-
-     ppcbin:=findcompiler(ppcbin,cpusuffix,versionstr);
+     SetLength(ppccommandline, ppccommandlinelen);
+     ppcbin := findcompiler(ppcbin, cpusuffix, exesuffix);
 
      { call ppcXXX }
      try

+ 1 - 0
packages/fcl-image/src/fpreadjpeg.pas

@@ -65,6 +65,7 @@ type
     procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
     function  InternalCheck(Str: TStream): boolean; override;
     class function InternalSize(Str:TStream): TPoint; override;
+    property CompressInfo : jpeg_decompress_struct Read Finfo Write FInfo;
   public
     constructor Create; override;
     destructor Destroy; override;

+ 15 - 12
packages/fcl-image/src/fpwritejpeg.pas

@@ -38,7 +38,9 @@ type
     FQuality: TFPJPEGCompressionQuality;
     FProgressMgr: TFPJPEGProgressManager;
   protected
+    procedure InitWriting; virtual;
     procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override;
+    property CompressInfo : jpeg_compress_struct Read FInfo Write FInfo;
   public
     constructor Create; override;
     destructor Destroy; override;
@@ -95,23 +97,24 @@ end;
 
 { TFPWriterJPEG }
 
+
+procedure TFPWriterJPEG.InitWriting;
+begin
+  FError := jpeg_std_error;
+  FInfo := Default(jpeg_compress_struct);
+  jpeg_create_compress(@FInfo);
+  FInfo.err := jerror.jpeg_std_error(FError);
+  FInfo.progress := @FProgressMgr.pub;
+  FProgressMgr.pub.progress_monitor := @ProgressCallback;
+  FProgressMgr.instance := Self;
+
+end;
+
 procedure TFPWriterJPEG.InternalWrite(Str: TStream; Img: TFPCustomImage);
 var
   MemStream: TMemoryStream;
   Continue: Boolean;
 
-  procedure InitWriting;
-  begin
-    FillChar(FInfo, sizeof(FInfo), 0);
-    FError := jpeg_std_error;
-    FInfo.err := jerror.jpeg_std_error(FError);
-
-    jpeg_create_compress(@FInfo);
-    FProgressMgr.pub.progress_monitor := @ProgressCallback;
-    FProgressMgr.instance := Self;
-    FInfo.progress := @FProgressMgr.pub;
-  end;
-
   procedure SetDestination;
   begin
     if Str is TMemoryStream then

File diff suppressed because it is too large
+ 412 - 110
packages/fpmkunit/src/fpmkunit.pp


+ 1 - 1
packages/gdbint/fpmake.pp

@@ -93,7 +93,7 @@ begin
       Installer.BuildEngine.Log(vlCommand,'GDB-lib found, compiling and running gdbver to obtain GDB-version');
       Installer.BuildEngine.Compile(P,GdbVerTarget);
       Cmd:=Installer.BuildEngine.AddPathPrefix(p,
-            p.GetBinOutputDir(Defaults.CPU, Defaults.OS))+
+            p.GetBinOutputDir(Defaults.CompileTarget ))+
             PathDelim+
             AddProgramExtension('gdbver',Defaults.BuildOS);
       Opts:=TStringList.Create;

+ 1 - 1
packages/ide/fpmake.pp

@@ -310,7 +310,7 @@ begin
         if CompilerTarget<>Defaults.CPU then
           begin
             T.SetExeName(AddProgramExtension(CPUToString(CompilerTarget)+'-fp',Defaults.BuildOS));
-            P.SetUnitsOutputDir(P.GetUnitsOutputDir(Defaults.BuildCPU,Defaults.BuildOS)+CPUToString(CompilerTarget));
+            P.SetUnitsOutputDir(P.GetUnitsOutputDir(Defaults.BuildTarget)+CPUToString(CompilerTarget));
             P.Options.Add('-dCROSSGDB');
           end;
 

+ 186 - 0
packages/rtl-objpas/src/inc/system.uitypes.pp

@@ -201,6 +201,186 @@ Type
 
       TColors = TColorRec;
 
+
+  TAlphaColors = record
+    const
+      Null                 = TAlphaColor(0);
+      Alpha                = TAlphaColor($ff000000);
+      Black                = Alpha;
+      Blue                 = TAlphaColor($ff0000ff);
+      Green                = TAlphaColor($ff008000);
+      Lime                 = TAlphaColor($ff00ff00);
+      Red                  = TAlphaColor($ffff0000);
+      White                = TAlphaColor($ffffffff);
+      AliceBlue            = TAlphaColor($ffF0F8FF);
+      AntiqueWhite         = TAlphaColor($ffFAEBD7);
+      Aqua                 = TAlphaColor($ff00FFFF);
+      AquaMarine           = TAlphaColor($ff7FFFD4);
+      Azure                = TAlphaColor($ffF0FFFF);
+      Beige                = TAlphaColor($ffF5F5DC);
+      Bisque               = TAlphaColor($ffFFE4C4);
+      BlanchedAlmond       = TAlphaColor($ffFFEBCD);
+      BlueViolet           = TAlphaColor($ff8A2BE2);
+      Brown                = TAlphaColor($ffA52A2A);
+      BurlyWood            = TAlphaColor($ffDEB887);
+      CadetBlue            = TAlphaColor($ff5F9EA0);
+      Chartreuse           = TAlphaColor($ff7FFF00);
+      Chocolate            = TAlphaColor($ffD2691E);
+      Coral                = TAlphaColor($ffFF7F50);
+      CornflowerBlue       = TAlphaColor($ff6495ED);
+      CornSilk             = TAlphaColor($ffFFF8DC);
+      Crimson              = TAlphaColor($ffDC143C);
+      Cyan                 = TAlphaColor($ff00FFFF);
+      DarkBlue             = TAlphaColor($ff00008B);
+      DarkCyan             = TAlphaColor($ff008B8B);
+      DarkGoldenRod        = TAlphaColor($ffB8860B);
+      DarkGray             = TAlphaColor($ffA9A9A9);
+      DarkGreen            = TAlphaColor($ff006400);
+      DarkGrey             = TAlphaColor($ffA9A9A9);
+      DarkKhaki            = TAlphaColor($ffBDB76B);
+      DarkMagenta          = TAlphaColor($ff8B008B);
+      DarkOliveGreen       = TAlphaColor($ff556B2F);
+      DarkOrange           = TAlphaColor($ffFF8C00);
+      DarkOrchid           = TAlphaColor($ff9932CC);
+      DarkRed              = TAlphaColor($ff8B0000);
+      DarkSalmon           = TAlphaColor($ffE9967A);
+      DarkSeaGreen         = TAlphaColor($ff8FBC8F);
+      DarkSlateBlue        = TAlphaColor($ff483D8B);
+      DarkSlateGray        = TAlphaColor($ff2F4F4F);
+      DarkSlateGrey        = TAlphaColor($ff2F4F4F);
+      DarkTurquoise        = TAlphaColor($ff00CED1);
+      DarkViolet           = TAlphaColor($ff9400D3);
+      DeepPink             = TAlphaColor($ffFF1493);
+      DeepSkyBlue          = TAlphaColor($ff00BFFF);
+      DimGray              = TAlphaColor($ff696969);
+      DimGrey              = TAlphaColor($ff696969);
+      DodgerBlue           = TAlphaColor($ff1E90FF);
+      Firebrick            = TAlphaColor($ffB22222);
+      FloralWhite          = TAlphaColor($ffFFFAF0);
+      ForestGreen          = TAlphaColor($ff228B22);
+      Fuchsia              = TAlphaColor($ffFF00FF);
+      Gainsboro            = TAlphaColor($ffDCDCDC);
+      GhostWhite           = TAlphaColor($ffF8F8FF);
+      Gold                 = TAlphaColor($ffFFD700);
+      GoldenRod            = TAlphaColor($ffDAA520);
+      Gray                 = TAlphaColor($ff808080);
+      GreenYellow          = TAlphaColor($ffADFF2F);
+      Grey                 = TAlphaColor($ff808080);
+      HoneyDew             = TAlphaColor($ffF0FFF0);
+      HotPink              = TAlphaColor($ffFF69B4);
+      IndianRed            = TAlphaColor($ffCD5C5C);
+      Indigo               = TAlphaColor($ff4B0082);
+      Ivory                = TAlphaColor($ffFFFFF0);
+      Khaki                = TAlphaColor($ffF0E68C);
+      Lavender             = TAlphaColor($ffE6E6FA);
+      LavenderBlush        = TAlphaColor($ffFFF0F5);
+      LawnGreen            = TAlphaColor($ff7CFC00);
+      LemonChiffon         = TAlphaColor($ffFFFACD);
+      LightBlue            = TAlphaColor($ffADD8E6);
+      LightCoral           = TAlphaColor($ffF08080);
+      LightCyan            = TAlphaColor($ffE0FFFF);
+      LightGoldenRodYellow = TAlphaColor($ffFAFAD2);
+      LightGray            = TAlphaColor($ffD3D3D3);
+      LightGreen           = TAlphaColor($ff90EE90);
+      LightGrey            = TAlphaColor($ffD3D3D3);
+      LightPink            = TAlphaColor($ffFFB6C1);
+      LightSalmon          = TAlphaColor($ffFFA07A);
+      LightSeaGreen        = TAlphaColor($ff20B2AA);
+      LightSkyBlue         = TAlphaColor($ff87CEFA);
+      LightSlateGray       = TAlphaColor($ff778899);
+      LightSlateGrey       = TAlphaColor($ff778899);
+      LightSteelBlue       = TAlphaColor($ffB0C4DE);
+      LightYellow          = TAlphaColor($ffFFFFE0);
+      LtGray               = TAlphaColor($ffC0C0C0);
+      MedGray              = TAlphaColor($ffA0A0A0);
+      DkGray               = TAlphaColor($ff808080);
+      MoneyGreen           = TAlphaColor($ffC0DCC0);
+      LegacySkyBlue        = TAlphaColor($ffF0CAA6);
+      Cream                = TAlphaColor($ffF0FBFF);
+      LimeGreen            = TAlphaColor($ff32CD32);
+      Linen                = TAlphaColor($ffFAF0E6);
+      Magenta              = TAlphaColor($ffFF00FF);
+      Maroon               = TAlphaColor($ff800000);
+      MediumAquaMarine     = TAlphaColor($ff66CDAA);
+      MediumBlue           = TAlphaColor($ff0000CD);
+      MediumOrchid         = TAlphaColor($ffBA55D3);
+      MediumPurple         = TAlphaColor($ff9370DB);
+      MediumSeaGreen       = TAlphaColor($ff3CB371);
+      MediumSlateBlue      = TAlphaColor($ff7B68EE);
+      MediumSpringGreen    = TAlphaColor($ff00FA9A);
+      MediumTurquoise      = TAlphaColor($ff48D1CC);
+      MediumVioletRed      = TAlphaColor($ffC71585);
+      MidnightBlue         = TAlphaColor($ff191970);
+      MintCream            = TAlphaColor($ffF5FFFA);
+      MistyRose            = TAlphaColor($ffFFE4E1);
+      Moccasin             = TAlphaColor($ffFFE4B5);
+      NavajoWhite          = TAlphaColor($ffFFDEAD);
+      Navy                 = TAlphaColor($ff000080);
+      OldLace              = TAlphaColor($ffFDF5E6);
+      Olive                = TAlphaColor($ff808000);
+      OliveDrab            = TAlphaColor($ff6B8E23);
+      Orange               = TAlphaColor($ffFFA500);
+      OrangeRed            = TAlphaColor($ffFF4500);
+      Orchid               = TAlphaColor($ffDA70D6);
+      PaleGoldenRod        = TAlphaColor($ffEEE8AA);
+      PaleGreen            = TAlphaColor($ff98FB98);
+      PaleTurquoise        = TAlphaColor($ffAFEEEE);
+      PaleVioletRed        = TAlphaColor($ffDB7093);
+      PapayaWhip           = TAlphaColor($ffFFEFD5);
+      PeachPuff            = TAlphaColor($ffFFDAB9);
+      Peru                 = TAlphaColor($ffCD853F);
+      Pink                 = TAlphaColor($ffFFC0CB);
+      Plum                 = TAlphaColor($ffDDA0DD);
+      PowderBlue           = TAlphaColor($ffB0E0E6);
+      Purple               = TAlphaColor($ff800080);
+      RosyBrown            = TAlphaColor($ffBC8F8F);
+      RoyalBlue            = TAlphaColor($ff4169E1);
+      SaddleBrown          = TAlphaColor($ff8B4513);
+      Salmon               = TAlphaColor($ffFA8072);
+      SandyBrown           = TAlphaColor($ffF4A460);
+      SeaGreen             = TAlphaColor($ff2E8B57);
+      SeaShell             = TAlphaColor($ffFFF5EE);
+      Sienna               = TAlphaColor($ffA0522D);
+      Silver               = TAlphaColor($ffC0C0C0);
+      SkyBlue              = TAlphaColor($ff87CEEB);
+      SlateBlue            = TAlphaColor($ff6A5ACD);
+      SlateGray            = TAlphaColor($ff708090);
+      SlateGrey            = TAlphaColor($ff708090);
+      Snow                 = TAlphaColor($ffFFFAFA);
+      SpringGreen          = TAlphaColor($ff00FF7F);
+      SteelBlue            = TAlphaColor($ff4682B4);
+      Tan                  = TAlphaColor($ffD2B48C);
+      Teal                 = TAlphaColor($ff008080);
+      Thistle              = TAlphaColor($ffD8BFD8);
+      Tomato               = TAlphaColor($ffFF6347);
+      Turquoise            = TAlphaColor($ff40E0D0);
+      Violet               = TAlphaColor($ffEE82EE);
+      Wheat                = TAlphaColor($ffF5DEB3);
+      WhiteSmoke           = TAlphaColor($ffF5F5F5);
+      Yellow               = TAlphaColor($ffFFFF00);
+      YellowGreen          = TAlphaColor($ff9ACD32);
+  public
+    constructor Create(const Color: TAlphaColor);
+    class var ColorToRGB: function (Color: TAlphaColor): Longint;
+    case Cardinal of
+          0:
+            (Color: TAlphaColor);
+          2:
+            (HiWord, LoWord: Word);
+          3:
+    {$IFDEF BIGENDIAN}
+            (A, R, G, B: Byte);
+    {$ELSE}
+            (B, G, R, A: Byte);
+    {$ENDIF}
+  end;
+  TAlphaColorRec = TAlphaColors;
+
+  TAlphaColorF = record
+    R, G, B, A: Single;
+  end;
+
+
 // copied from Lazutils version
 ///////////////////////////////
 
@@ -332,4 +512,10 @@ begin
   result:=AColor.Color;
 end;
 
+constructor TAlphaColors.Create(const Color: TAlphaColor);
+begin
+  Self := TAlphaColors(Color);
+end;
+
+
 end.

File diff suppressed because it is too large
+ 205 - 172
utils/fpcm/fpcmake.inc


+ 33 - 4
utils/fpcm/fpcmake.ini

@@ -20,6 +20,9 @@ OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
 
+lc = $(subst A,a,$(subst B,b,$(subst C,c,$(subst D,d,$(subst E,e,$(subst F,f,$(subst G,g,$(subst H,h,$(subst I,i,$(subst J,j,$(subst K,k,$(subst L,l,$(subst M,m,$(subst N,n,$(subst O,o,$(subst P,p,$(subst Q,q,$(subst R,r,$(subst S,s,$(subst T,t,$(subst U,u,$(subst V,v,$(subst W,w,$(subst X,x,$(subst Y,y,$(subst Z,z,$1))))))))))))))))))))))))))
+
+
 [osdetect]
 #####################################################################
 # Autodetect source OS (Linux or Dos or Windows NT or OS/2 or other)
@@ -249,8 +252,26 @@ endif
 ifndef OS_TARGET
 OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
 endif
-FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+
+CPU_OS_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+ifdef SUB_TARGET
+L_SUB_TARGET=$(call lc,$(SUB_TARGET))
+FULL_TARGET:=$(CPU_TARGET)-$(OS_TARGET)-$(L_SUB_TARGET)
+else
+FULL_TARGET:=$(CPU_TARGET)-$(OS_TARGET)
+endif
+
+#
+# not sure if we'll need this, but defining it for the moment.
+# Reason for defining it: this could redefine a "cross-compile".
+#
+CPU_OS_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifdef SUB_SOURCE
+L_SUB_SOURCE=$(call lc,$(SUB_SOURCE))
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)-$(L_SUB_SOURCE)
+else
 FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+endif
 
 ifeq ($(CPU_TARGET),armeb)
 ARCH=arm
@@ -268,6 +289,11 @@ ifeq ($(FULL_TARGET),aarch64-embedded)
 # override FPCOPT+=-Cp$(SUBARCH)
 endif
 
+ifdef SUB_TARGET 
+override FPCOPT+=-t$(SUB_TARGET)
+endif
+
+
 ifeq ($(FULL_TARGET),arm-embedded)
 ifeq ($(SUBARCH),)
 # we don't add a default here, people should explicitly add the SUBARCH
@@ -328,14 +354,17 @@ SOURCESUFFIX=$(FULL_SOURCE)
 endif
 
 # Cross compile flag
-ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+#
+# We may need to switch to FULL_TARGET/FULL_TARGET
+#
+ifneq ($(CPU_OS_TARGET),$(CPU_OS_SOURCE))
 CROSSCOMPILE=1
 endif
 
 # Check if the Makefile supports this target, but not
 # when the make target is to rebuild the makefile
 ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
-ifeq ($(filter $(FULL_TARGET),$(MAKEFILETARGETS)),)
+ifeq ($(filter $(CPU_OS_TARGET),$(MAKEFILETARGETS)),)
 $(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
 endif
 endif
@@ -361,7 +390,7 @@ BUILDNATIVE=1
 export BUILDNATIVE
 endif
 
-export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE SUB_TARGET SUB_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE CPU_OS_TARGET CPU_OS_SOURCE
 
 [fpmakefpcdetect]
 #####################################################################

+ 58 - 0
utils/fpcm/fpcmake.lpi

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="fpcmake"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="fpcmake.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="fpcmmain.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="fpcmdic.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="fpcmpkg.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="fpcmwr.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="fpcmake"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+</CONFIG>

+ 1 - 1
utils/fpcm/fpcmake.pp

@@ -21,7 +21,7 @@ program fpcmake;
     uses
       getopts,
       sysutils,
-      fpcmmain,fpcmwr,fpcmpkg;
+      fpcmmain,fpcmwr,fpcmpkg, fpcmdic;
 
     type
       { Verbosity Level }

+ 7 - 1
utils/fpcm/fpcmmain.pp

@@ -209,8 +209,11 @@ interface
 
       TFPCMakeVerbose = (FPCMakeError, FPCMakeInfo, FPCMakeDebug);
 
+      { TFPCMake }
+
       TFPCMake = class
       private
+        FKnownArchitectures: TStrings;
         FStream         : TStream;
         FFileName       : string;
         FCommentChars   : TSysCharSet;
@@ -270,6 +273,7 @@ interface
         property CommentChars:TSysCharSet read FCommentChars write FCommentChars;
         property EmptyLines:Boolean read FEmptyLines write FEmptyLines;
         property IncludeTargets:TTargetSet read FIncludeTargets write FIncludeTargets;
+        Property KnownArchitectures : TStrings Read FKnownArchitectures;
       end;
 
     function posidx(const substr,s : string;idx:integer):integer;
@@ -649,6 +653,7 @@ implementation
         for c:=low(tcpu) to high(tcpu) do
          for t:=low(tos) to high(tos) do
           FRequireList[c,t]:=TStringList.Create;
+        FKnownArchitectures:=TStringList.Create;
         FVariables:=TKeyValue.Create;
         FCommentChars:=[';','#'];
         FEmptyLines:=false;
@@ -672,6 +677,7 @@ implementation
         for c:=low(tcpu) to high(tcpu) do
          for t:=low(tos) to high(tos) do
           FRequireList[c,t].Free;
+        FKnownArchitectures.Free;
         FVariables.Free;
       end;
 
@@ -1104,7 +1110,7 @@ implementation
       end;
 
 
-    function TFPCMake.GetTargetRequires(c:TCpu;t:Tos):TStringList;
+        function TFPCMake.GetTargetRequires(c: TCpu; t: TOS): TStringList;
       var
         ReqSec  : TFPCMakeSection;
         ReqList : TStringList;

+ 3 - 3
utils/fpcm/fpcmwr.pp

@@ -290,7 +290,7 @@ implementation
                 s:=FInput.GetTargetVariable(c,t,IniVar,false);
                 if s<>'' then
                   begin
-                    FOutput.Add('ifeq ($(FULL_TARGET),'+CPUStr[c]+'-'+OSStr[t]+')');
+                    FOutput.Add('ifeq ($(CPU_OS_TARGET),'+CPUStr[c]+'-'+OSStr[t]+')');
                     FOutput.Add('override '+FixVariable(IniVar)+'+='+s);
                     FOutput.Add('endif');
                   end;
@@ -347,7 +347,7 @@ implementation
                 s:=FInput.GetTargetVariable(c,t,IniVar,false);
                 if s<>'' then
                   begin
-                    FOutput.Add('ifeq ($(FULL_TARGET),'+CpuStr[c]+'-'+OSStr[t]+')');
+                    FOutput.Add('ifeq ($(CPU_OS_TARGET),'+CpuStr[c]+'-'+OSStr[t]+')');
                     AddTokens(s);
                     FOutput.Add('endif');
                   end;
@@ -608,7 +608,7 @@ implementation
                 FInput.Verbose(FPCMakeInfo,CpuStr[c]+'-'+OSStr[t]+' requires: '+sl.CommaText);
                 if sl.count>0 then
                  begin
-                   FOutput.Add('ifeq ($(FULL_TARGET),'+CPUStr[c]+'-'+OSStr[t]+')');
+                   FOutput.Add('ifeq ($(CPU_OS_TARGET),'+CPUStr[c]+'-'+OSStr[t]+')');
                    for i:=0 to sl.count-1 do
                     begin
                       FOutput.Add(prefix+VarName(sl[i])+'=1');

Some files were not shown because too many files changed in this diff