Browse Source

* Subtarget support

Michaël Van Canneyt 1 year ago
parent
commit
68217c7cd0
2 changed files with 70 additions and 6 deletions
  1. 39 0
      packages/pastojs/src/pas2jscompiler.pp
  2. 31 6
      packages/pastojs/src/pas2jscompilercfg.pp

+ 39 - 0
packages/pastojs/src/pas2jscompiler.pp

@@ -116,6 +116,8 @@ const
   nRTLIdentifierChanged = 144; sRTLIdentifierChanged = 'RTL identifier %s changed from %s to %s';
   nSkipNoConstResourcestring = 145; sSkipNoConstResourcestring = 'Resource string %s is not a constant, not adding to resourcestrings file.';
   nUnknownOptimizationOption = 146; sUnknownOptimizationOption = 'unknown -Oo option %s';
+  nSubtargetConfigNotFound = 147; sSubtargetConfigNotFound = 'Subtarget %s config file not found';
+
   // Note: error numbers 201+ are used by Pas2jsFileCache
 
 //------------------------------------------------------------------------------
@@ -487,12 +489,14 @@ type
   Protected
     // These must be overridden in descendents
     function FindDefaultConfig: String; virtual; abstract;
+    function FindSubtargetConfig(const aSubTtarget : string): String; virtual; abstract;
     function GetReader(aFileName: string): TSourceLineReader; virtual; abstract;
   Public
     constructor Create(aCompiler: TPas2jsCompiler); override;
     destructor Destroy; override;
     procedure LoadDefaultConfig;
     procedure LoadConfig(Const aFileName: String);virtual;
+    procedure LoadSubTargetConfig(Const aSubTarget: String);virtual;
     property Compiler:  TPas2jsCompiler Read FCompiler;
   end;
 
@@ -607,6 +611,7 @@ type
     // params, cfg files
     FCurParam: string;
     FResourceOutputFile: String;
+    FSubTarget: String;
     procedure LoadConfig(CfgFilename: string);
     procedure ReadEnvironment;
     procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
@@ -615,6 +620,7 @@ type
     procedure ReadCodeGenerationFlags(Param: String; p: integer);
     procedure ReadSyntaxFlags(Param: String; p: integer);
     procedure ReadVerbosityFlags(Param: String; p: integer);
+    procedure SetSubTarget(AValue: String);
   protected
     // Create various other classes. Virtual so they can be overridden in descendents
     function CreateImportList : TJSSourceElements;
@@ -741,6 +747,7 @@ type
     property ShowUsedTools: boolean read GetShowUsedTools write SetShowUsedTools;
     property SkipDefaultConfig: Boolean read GetSkipDefaultConfig write SetSkipDefaultConfig;
     property TargetPlatform: TPasToJsPlatform read GetTargetPlatform write SetTargetPlatform;
+    property SubTarget : String Read FSubTarget Write SetSubTarget;
     property TargetProcessor: TPasToJsProcessor read GetTargetProcessor write SetTargetProcessor;
     property WPOAnalyzer: TPas2JSAnalyzer read FWPOAnalyzer; // Whole Program Optimization
     property WriteDebugLog: boolean read GetWriteDebugLog write SetWriteDebugLog;
@@ -1961,6 +1968,21 @@ begin
     Compiler.Log.LogMsgIgnoreFilter(nEndOfReadingConfigFile,[QuoteStr(aFilename)]);
 end;
 
+procedure TPas2JSConfigSupport.LoadSubTargetConfig(const aSubTarget: String);
+var
+  aFileName: string;
+
+begin
+  aFileName:=FindSubTargetConfig(aSubTarget);
+  if aFileName='' then
+    begin
+    Compiler.Log.Log(mtFatal,Format(sSubtargetConfigNotFound,[aSubtarget]),nSubtargetConfigNotFound);
+    Compiler.Terminate(ExitCodeFileNotFound);
+    end
+  else
+    LoadConfig(aFilename);
+end;
+
 procedure TPas2JSConfigSupport.LoadDefaultConfig;
 var
   aFileName: string;
@@ -4033,6 +4055,11 @@ begin
           else
             ReadSyntaxFlags(Param,p);
         end;
+      't': // subtarget
+        begin
+        inc(p);
+        SubTarget:=copy(Param,p,length(Param));
+        end;
       'T': // target platform
         begin
         inc(p);
@@ -4246,6 +4273,13 @@ begin
   end;
 end;
 
+procedure TPas2jsCompiler.SetSubTarget(AValue: String);
+begin
+  if FSubTarget=AValue then Exit;
+  FSubTarget:=AValue;
+  //
+end;
+
 function TPas2jsCompiler.CreateImportList: TJSSourceElements;
 begin
   Result:=TJSSourceElements.Create(0,0,'');
@@ -4576,6 +4610,8 @@ begin
   AddDefine('FPC_WIDESTRING_EQUAL_UNICODESTRING');
   AddDefine('STR_CONCAT_PROCS');
   AddDefine('UNICODE');
+  if SubTarget<>'' then
+    AddDefine('FPC_SUBTARGET',SubTarget);
 
   FHasShownLogo:=false;
   FHasShownEncoding:=false;
@@ -4611,6 +4647,8 @@ begin
     // read default config
     if Assigned(ConfigSupport) and not SkipDefaultConfig then
       ConfigSupport.LoadDefaultConfig;
+    if Assigned(ConfigSupport) and (SubTarget<>'') then
+      ConfigSupport.LoadSubTargetConfig(SubTarget);
 
     // read env PAS2JS_OPTS
     ReadEnvironment;
@@ -4873,6 +4911,7 @@ begin
   w('  -SI<x>  : Set interface style to <x>');
   w('    -SIcom  : COM, reference counted interface (default)');
   w('    -SIcorba: CORBA interface');
+  w('  -T<x>  : Set subtarget (searches for pas2js-<subtarget>.cfg');
   w('  -T<x>  : Set target platform');
   w('    -Tbrowser: default');
   w('    -Tnodejs : add pas.run(), includes -Jc');

+ 31 - 6
packages/pastojs/src/pas2jscompilercfg.pp

@@ -39,9 +39,15 @@ uses
 {$ENDIF FPC_DOTTEDUNITS}
 
 Type
+  
+  { TPas2JSFileConfigSupport }
+
   TPas2JSFileConfigSupport = Class(TPas2JSConfigSupport)
+    function FindConfig(const aBaseName : string): String;
     function FindDefaultConfig: String; override;
     function GetReader(aFileName: string): TSourceLineReader; override;
+  protected
+    function FindSubtargetConfig(const aSubTarget: string): String; override;
   end;
 
 implementation
@@ -56,7 +62,26 @@ begin
   Result:=CacheFile.CreateLineReader(true);
 end;
 
-Function TPas2JSFileConfigSupport.FindDefaultConfig : String;
+function TPas2JSFileConfigSupport.FindSubtargetConfig(const aSubTarget: string): String;
+
+var
+  FN,Ext : String;
+
+begin
+  FN:=ChangeFileExt(DefaultConfigFile,'');
+  Ext:=ExtractFileExt(DefaultConfigFile);
+  FN:=FN+'-'+LowerCase(aSubtarget)+Ext;
+  Result:=FindConfig(FN);
+end;
+
+function TPas2JSFileConfigSupport.FindDefaultConfig: String;
+
+begin
+  Result:=FindConfig(DefaultConfigFile);
+end;
+
+function TPas2JSFileConfigSupport.FindConfig(const aBaseName : string): String;
+
 var
   Tried: TStringList;
 
@@ -70,7 +95,7 @@ var
     if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then
       Compiler.Log.LogMsgIgnoreFilter(nConfigFileSearch,[aFilename]);
     if not Compiler.FS.FileExists(aFilename) then exit;
-    FindDefaultConfig:=aFilename;
+    FindConfig:=aFilename;
     Result:=true;
   end;
 
@@ -85,7 +110,7 @@ begin
     aFilename:=ChompPathDelim(GetEnvironmentVariablePJ('HOME'));
     if aFilename<>'' then
       begin
-      aFilename:=aFilename+PathDelim{$IFDEF UNIX}+'.'{$ENDIF}+DefaultConfigFile;
+      aFilename:=aFilename+PathDelim{$IFDEF UNIX}+'.'{$ENDIF}+aBaseName;
       if TryConfig(aFileName) then
         exit;
       end;
@@ -96,7 +121,7 @@ begin
       aFilename:=ExtractFilePath(Compiler.CompilerExe);
       if aFilename<>'' then
       begin
-        aFilename:=IncludeTrailingPathDelimiter(aFilename)+DefaultConfigFile;
+        aFilename:=IncludeTrailingPathDelimiter(aFilename)+aBaseName;
         if TryConfig(aFilename) then
           exit;
       end;
@@ -105,7 +130,7 @@ begin
       if (aFilename<>'') and (aFilename<>Compiler.CompilerExe) then
       begin
         aFilename:=ExtractFilePath(aFilename);
-        aFilename:=IncludeTrailingPathDelimiter(aFilename)+DefaultConfigFile;
+        aFilename:=IncludeTrailingPathDelimiter(aFilename)+aBaseName;
         if TryConfig(aFilename) then
           exit;
       end;
@@ -113,7 +138,7 @@ begin
 
     // finally try global directory
     {$IFDEF Unix}
-    if TryConfig('/etc/'+DefaultConfigFile) then
+    if TryConfig('/etc/'+aBaseName) then
       exit;
     {$ENDIF}