unit cmdlinelazcompopt;

{$mode delphi}{$H+}

interface

// this unit depends on IDEIntf package (CompOptsIntf.pas) !

uses
  Classes, SysUtils, CompOptsIntf, cmdlinecfg, cmdlinecfgutils, cmdlinecfgparser, contnrs;

{ Either procedures depends on a certain names/keys used for the FPC options.
  This has to be caferully maintained in the configuration file.              }
procedure LazCompOptToVals(opt: TLazCompilerOptions; cfg: TCmdLineCfg; list: TList {of TCmdLineValueOpts});
procedure ValsToLazCompOpt(list: TList {of TCmdLineValueOpts}; opt: TLazCompilerOptions);

implementation

// hash all values - make their copies and "join" multi values (if available)
function AllocLookup(list: TList): TFPHashObjectList;
var
  i  : integer;
  v  : TCmdLineOptionValue;
  lv : TCmdLineOptionValue;
  d  : string;
begin
  Result:=TFPHashObjectList.Create(true);
  for i:=0 to list.Count-1 do begin
    v:=TCmdLineOptionValue(list[i]);
    if not Assigned(v) or not Assigned(v.Option) then Continue;
    lv:=TCmdLineOptionValue(Result.Find(v.Option.Name));
    if v.Option.isMultiple then begin
      if not Assigned(lv) then begin
        lv:=TCmdLineOptionValue.Create(v.Option, v.Value);
        Result.Add(v.Option.Name, lv);
      end else begin
        if (v.Option.OptType='filepath') or (v.Option.OptType='dirpath') then d:=';' else d:=' ';
        if lv.Value='' then lv.Value:=v.Value else lv.Value:=lv.Value+d+v.Value;
      end;
    end else begin
      if not Assigned(lv) then begin
        lv:=TCmdLineOptionValue.Create(v.Option, v.Value);
        Result.Add(v.Option.Name, lv);
      end else
        lv.Value:=v.Value;
    end;
  end;
end;

function LookupStr(lp: TFPHashObjectList; const Name: string; const Default: string = ''; Remove: Boolean = true): string;
var
  v: TCmdLineOptionValue;
  i: integer;
begin
  i:=lp.FindIndexOf(Name);
  if i>=0 then begin
    v:=TCmdLineOptionValue(lp.Items[i]);
    Result:=v.Value;
    if Remove then lp.Delete(i); // frees the object
  end else
    Result:=Default;
end;

function LookupBool(lp: TFPHashObjectList; const Name: string; const Default: Boolean = false; Remove: Boolean = true): Boolean;
var
  v: TCmdLineOptionValue;
  i: integer;
begin
  i:=lp.FindIndexOf(Name);
  if i>=0 then begin
    v:=TCmdLineOptionValue(lp.Items[i]);
    Result:=v.Value<>'';
    if Remove then lp.Delete(i);  // frees the object
  end else
    Result:=Default;
end;

function LookupInt(lp: TFPHashObjectList; const Name: string; const Default: Integer = 0; Remove: Boolean = true): Integer;
var
  v: TCmdLineOptionValue;
  i: integer;
begin
  i:=lp.FindIndexOf(Name);
  if i>=0 then begin
    v:=TCmdLineOptionValue(lp.Items[i]);
    Result:=StrToIntDef(v.Value,Default);
    if Remove then lp.Delete(i);   // frees the object
  end else
    Result:=Default;
end;

function StrToDbgSymbolType(const vals: string): TCompilerDbgSymbolType;
var
  v : string;
begin
  v:=AnsiLowerCase(vals);
  if v='s' then Result:=dsStabs
  else if v='w2' then Result:=dsDwarf2
  else if v='w'  then Result:=dsDwarf2Set // ???
  else if v='w3' then Result:=dsDwarf3;
end;

procedure ValsToLazCompOpt(list: TList {of TCmdLineValueOpts}; opt: TLazCompilerOptions);
var
  lookup : TFPHashObjectList;
  i      : Integer;
  l      : TList;
begin
  lookup:=AllocLookup(list);
  try
    // search paths:
    opt.IncludePath:=LookupStr(lookup, '-Fi');
    opt.Libraries:=LookupStr(lookup, '-Fl');
    opt.ObjectPath:=LookupStr(lookup, '-Fo');
    opt.OtherUnitFiles:=LookupStr(lookup, '-Fu');
    //opt.SrcPath  (not in compiler options)
    //opt.DebugPath
    opt.UnitOutputDirectory:=LookupStr(lookup, '-FU');

    // target:
    opt.TargetFilename:=LookupStr(lookup, '-o');
    //opt.TargetFilenameApplyConventions

    // parsing:
    opt.SyntaxMode:=LookupStr(lookup, '-M');
    //property AssemblerStyle: Integer read fAssemblerStyle write SetAssemblerStyle;
    opt.CStyleOperators:=LookupBool(lookup, '-Sc');
    opt.IncludeAssertionCode:=LookupBool(lookup, '-Sa');
    opt.AllowLabel:=LookupBool(lookup,'-Sg');
    opt.UseAnsiStrings:=LookupBool(lookup,'-Sh');
    opt.CPPInline:=LookupBool(lookup,'-Si');
    opt.CStyleMacros:=LookupBool(lookup,'-Sm');
    opt.InitConstructor:=LookupBool(lookup,'-Ss');

    // -St is obsolete option ... so shouldn't be available
    opt.StaticKeyword:=LookupBool(lookup,'-St');

    // code generation:
    opt.IOChecks:=LookupBool(lookup,'-Ci');
    opt.RangeChecks:=LookupBool(lookup,'-Cr');
    opt.OverflowChecks:=LookupBool(lookup,'-Co');
    opt.StackChecks:=LookupBool(lookup,'-Ct');
    opt.SmartLinkUnit:=LookupBool(lookup,'-CX');
    opt.RelocatableUnit:=LookupBool(lookup,'-WR');
    opt.EmulatedFloatOpcodes:=LookupBool(lookup,'-Ce');

    opt.HeapSize:=LookupInt(lookup, '-Ch');
    opt.StackSize:=LookupInt(lookup, '-Cs');
    opt.VerifyObjMethodCall:=LookupBool(lookup,'-CR');

    opt.SmallerCode :=LookupBool(lookup, '-Os');
    opt.TargetCPU   :=LookupStr(lookup, '-P');
    opt.TargetProcessor:=LookupStr(lookup, '-Op');
    opt.TargetOS:=LookupStr(lookup, '-T');
    opt.VariablesInRegisters:=LookupBool(lookup, '-Or');
    opt.UncertainOptimizations:=LookupBool(lookup, '-Ou');
    opt.OptimizationLevel:=StrToIntDef(LookupStr(lookup, '-O'),0);

    // linking:
    opt.GenerateDebugInfo:=LookupBool(lookup, '-g');

    opt.DebugInfoType:=StrToDbgSymbolType(LookupStr(lookup, '-g'));
    //opt.DebugInfoTypeStr: String read GetDebugInfoTypeStr;

    opt.UseLineInfoUnit:=LookupBool(lookup, '-gl');
    opt.UseHeaptrc:=LookupBool(lookup, '-gh');
    opt.UseValgrind:=LookupBool(lookup, '-gv');
    opt.GenGProfCode:=LookupBool(lookup, '-pg');
    opt.StripSymbols:=LookupBool(lookup, '-Xs');
    opt.LinkSmart:=LookupBool(lookup, '-XX');

    opt.LinkerOptions:=LookupStr(lookup, '-k');
    opt.PassLinkerOptions:=opt.LinkerOptions<>''; //todo:!

    opt.Win32GraphicApp:=LookupBool(lookup, '-WG');
    //ExecutableType: TCompilationExecutableType   read FExecutableType write SetExecutableType;
    opt.UseExternalDbgSyms:=LookupBool(lookup, '-Xg');

    // messages:
    opt.ShowErrors:=LookupBool(lookup, '-ve');
    opt.ShowWarn:=LookupBool(lookup, '-vw');
    opt.ShowNotes:=LookupBool(lookup, '-vn');
    opt.ShowHints:=LookupBool(lookup, '-vh');
    opt.ShowGenInfo:=LookupBool(lookup, '-vi');
    opt.ShowLineNum:=LookupBool(lookup, '-vl');
    opt.ShowAll:=LookupBool(lookup, '-va');
    opt.ShowAllProcsOnError:=LookupBool(lookup, '-Xs');

    opt.ShowDebugInfo:=LookupBool(lookup, '-vd');
    opt.ShowUsedFiles:=LookupBool(lookup, '-vu');
    opt.ShowTriedFiles:=LookupBool(lookup, '-vt');
    opt.ShowCompProc:=LookupBool(lookup, '-vp');
    opt.ShowCond:=LookupBool(lookup, '-vc');
    opt.ShowExecInfo:=LookupBool(lookup, '-vx');
    opt.ShowNothing:=LookupBool(lookup, '-v0');
    //opt.ShowSummary
    //opt.ShowHintsForUnusedUnitsInMainSrc
    //opt.ShowHintsForSenderNotUsed
    opt.WriteFPCLogo:=LookupBool(lookup, '-l');
    opt.StopAfterErrCount:=LookupInt(lookup, '-Se');

    // other
    opt.DontUseConfigFile:=LookupBool(lookup, '-n');
    //opt.ConfigFilePath:=LookupStr(lookup, '@');
    //opt.CustomConfigFile:=opt.ConfigFilePath<>'';


    if lookup.Count>0 then begin
      l:=TList.Create;
      try
        for i:=0 to lookup.Count-1 do l.Add(lookup.Items[i]);
        opt.CustomOptions:=CmdLineMakeOptions(l);
      finally
        l.Free; // values, will be freed with lookup
      end;
    end;
  finally
    lookup.Free;
  end;
end;

procedure AddBoolValue(cfg: TCmdLineCfg; const Key: string; AVal: Boolean; list: TList; var Other: string);
var
  o  : TCmdLineCfgOption;
begin
  if not AVal then Exit;
  o:=cfg.FindOption(Key);
  if Assigned(o) then
    list.Add(TCmdLineOptionValue.Create(o, '1'));
end;

procedure AddStrValue(cfg: TCmdLineCfg; const Key, AVal: string; list: TList; var Other: string);
var
  o  : TCmdLineCfgOption;
begin
  if AVal='' then Exit;
  o:=cfg.FindOption(Key);
  if Assigned(o) then
    list.Add(TCmdLineOptionValue.Create(o, AVal));
end;

procedure AddIntValue(cfg: TCmdLineCfg; const Key: string; AVal: Integer; list: TList; var Other: string);
var
  o  : TCmdLineCfgOption;
begin
  if AVal<=0 then Exit;
  o:=cfg.FindOption(Key);
  if Assigned(o) then
    list.Add(TCmdLineOptionValue.Create(o, IntToStr(AVal)));
end;

procedure AddMultiStrValue(cfg: TCmdLineCfg; const Key, AVal, Delim: string; list: TList; var Other: string);
var
  o  : TCmdLineCfgOption;
  ch : Char;
begin
  if AVal='' then Exit;
  o:=cfg.FindOption(Key);
  if Assigned(o) then begin
    if length(DElim)>0 then ch:=Delim[1] else ch:=#0;
    CmdLineAllocMultiValues(o, AVal, ch, list);
  end;
end;


procedure LazCompOptToVals(opt: TLazCompilerOptions; cfg: TCmdLineCfg; list: TList {of TCmdLineValueOpts});
var
  other : string;
begin
  other := '';
  AddMultiStrValue(cfg, '-Fi', opt.IncludePath, ';', list, Other);
  AddMultiStrValue(cfg, '-Fl', opt.Libraries, ';', list, Other);
  AddMultiStrValue(cfg, '-Fo', opt.ObjectPath, ';', list, Other);
  AddMultiStrValue(cfg, '-Fu', opt.OtherUnitFiles, ';', list, Other);
  // opt.SrcPath   (not in compiler options) ?? -sources for Lazarus itself?

  //opt.DebugPath
  AddStrValue(cfg, '-FU', opt.UnitOutputDirectory, list, other);

  // target:
  AddStrValue(cfg, '-o', opt.TargetFilename, list, other);

  // parsing:
  AddStrValue(cfg, '-M', opt.UnitOutputDirectory, list, other);

  //property AssemblerStyle: Integer read fAssemblerStyle write SetAssemblerStyle;
  AddBoolValue(cfg, '-Sc', opt.CStyleOperators, list, other);

  AddBoolValue(cfg, '-Sa', opt.IncludeAssertionCode, list, other);
  AddBoolValue(cfg, '-Sg', opt.AllowLabel, list, other);
  AddBoolValue(cfg, '-Sh', opt.UseAnsiStrings, list, other);
  AddBoolValue(cfg, '-Si', opt.CPPInline, list, other);
  AddBoolValue(cfg, '-Sm', opt.CStyleMacros, list, other);
  AddBoolValue(cfg, '-Ss', opt.InitConstructor, list, other);

  // -St is obsolete option ... so shouldn't be available
  AddBoolValue(cfg, '-St', opt.StaticKeyword, list, other);

  // code generation:
  AddBoolValue(cfg, '-Ci', opt.IOChecks, list, other);
  AddBoolValue(cfg, '-Cr', opt.RangeChecks, list, other);
  AddBoolValue(cfg, '-Co', opt.OverflowChecks, list, other);
  AddBoolValue(cfg, '-Ct', opt.StackChecks, list, other);
  AddBoolValue(cfg, '-CX', opt.SmartLinkUnit, list, other);
  AddBoolValue(cfg, '-WR', opt.RelocatableUnit, list, other);
  AddBoolValue(cfg, '-Ce', opt.EmulatedFloatOpcodes, list, other);

  AddIntValue(cfg, '-Ch', opt.HeapSize, list, other);
  AddIntValue(cfg, '-Cs', opt.StackSize, list, other);
  AddBoolValue(cfg, '-CR', opt.VerifyObjMethodCall, list, other);

  AddBoolValue(cfg, '-CR', opt.SmallerCode, list, other);
  AddStrValue(cfg, '-P', opt.TargetCPU, list, other);
  AddStrValue(cfg, '-Op', opt.TargetProcessor, list, other);
  AddStrValue(cfg, '-T', opt.TargetOS, list, other);
  AddBoolValue(cfg, '-Or', opt.VariablesInRegisters, list, other);
  AddBoolValue(cfg, '-Ou', opt.UncertainOptimizations, list, other);
  AddStrValue(cfg,  '-O',  IntToStr(opt.OptimizationLevel), list, other);

  // linking:
  AddBoolValue(cfg, '-g', opt.GenerateDebugInfo, list, other);

  //todo: EPIC TODO
  //AddStrValue(cfg, '-g', opt.DebugInfoType, list, other);
  //opt.DebugInfoTypeStr: String read GetDebugInfoTypeStr;

  AddBoolValue(cfg, '-gl', opt.UseLineInfoUnit, list, other);
  AddBoolValue(cfg, '-gh', opt.UseHeaptrc, list, other);
  AddBoolValue(cfg, '-gv', opt.UseValgrind, list, other);
  AddBoolValue(cfg, '-pg', opt.GenGProfCode, list, other);
  AddBoolValue(cfg, '-Xs', opt.StripSymbols, list, other);
  AddBoolValue(cfg, '-XX', opt.LinkSmart, list, other);

  AddMultiStrValue(cfg, '-k', opt.LinkerOptions, ' ', list, other);
  {opt.LinkerOptions:=LookupStr(lookup, '-k');
  opt.PassLinkerOptions:=opt.LinkerOptions<>''; //todo:!}

  AddBoolValue(cfg, '-WG', opt.Win32GraphicApp, list, other);
  //ExecutableType: TCompilationExecutableType   read FExecutableType write SetExecutableType;
  AddBoolValue(cfg, '-Xg', opt.UseExternalDbgSyms, list, other);

  // messages:
  AddBoolValue(cfg, '-ve', opt.ShowErrors, list, other);
  AddBoolValue(cfg, '-vw', opt.ShowWarn, list, other);
  AddBoolValue(cfg, '-vn', opt.ShowNotes, list, other);
  AddBoolValue(cfg, '-vh', opt.ShowHints, list, other);
  AddBoolValue(cfg, '-vi', opt.ShowGenInfo, list, other);
  AddBoolValue(cfg, '-vl', opt.ShowLineNum, list, other);
  AddBoolValue(cfg, '-va', opt.ShowAll, list, other);
  AddBoolValue(cfg, '-Xs', opt.ShowAllProcsOnError, list, other);

  AddBoolValue(cfg, '-vd', opt.ShowDebugInfo, list, other);
  AddBoolValue(cfg, '-vu', opt.ShowUsedFiles, list, other);
  AddBoolValue(cfg, '-vt', opt.ShowTriedFiles, list, other);
  AddBoolValue(cfg, '-vp', opt.ShowCompProc, list, other);
  AddBoolValue(cfg, '-vc', opt.ShowCond, list, other);
  AddBoolValue(cfg, '-vx', opt.ShowExecInfo, list, other);
  AddBoolValue(cfg, '-v0', opt.ShowNothing, list, other);
  //opt.ShowSummary
  //opt.ShowHintsForUnusedUnitsInMainSrc
  //opt.ShowHintsForSenderNotUsed
  AddBoolValue(cfg, '-l' , opt.WriteFPCLogo, list, other);
  AddIntValue(cfg, '-Se', opt.StopAfterErrCount, list, other);

  // other
  AddBoolValue(cfg, '-n', opt.DontUseConfigFile, list, other);
  CmdLineMatchArgsToOpts(cfg, opt.CustomOptions, list);
end;

end.