{$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-}
{$IFDEF VER70}
{$P-,Q-,T-}
{$ENDIF}
unit
  ACmdLine;

interface
  uses
    tpString,
    AVars;

const
  { Options flags }
  ofOutputListing    = $0001;
  ofCrossRefInLst    = $0002;
  ofExpandedListing  = $0004;
  ofSymbolTableInLst = $0008;

  ofXrefOutput       = $0010;
  ofSmartLink        = $0020;
  ofCaseAll          = $0040;
  ofCaseGlobal       = $0080;

  ofSupressMsg       = $0100;
  ofWarningLev1      = $0200;
  ofWarningLev2      = $0400;
  ofDisplayErrLine   = $0800;

  ofOutputInline     = $1000;

  DefaultOptions : Word = ofSymbolTableInLst + ofDisplayErrLine +
                          ofWarningLev1 + ofWarningLev2;

procedure Abort(MSG:String; ExitCode: Byte);
  {--  Stop program with given message and exit code}

procedure ProcessCmdLine;
  {--  Parse command line, set options and file names }

procedure OpenFiles;
  {--  Open / create all neccesary files }

procedure CloseFiles;
  {--  Close all opened / created files }


implementation

procedure Abort(MSG:String; ExitCode: Byte);
  {--  Stop program with given message and exit code}
begin
  write(^M^J,MSG);
  halt(ExitCode);
end; { Abort }

procedure Help;
  {--  Show brief help screen }
begin
  writeln;
  writeln(ProcTitle+'  '+Copyright);
  writeln('Syntax:  A [options] source [,binary] [,listing] [,xref] [options]');
  writeln('/c            Generate cross-reference in listing');
  writeln('/dSYM[=VAL]   Define symbol SYM = 0, or = value VAL');
  writeln('/h,/?         Display this help screen');
  writeln('/iPATH        Search PATH for include files');
  writeln('/l,/la        Generate listing: l=normal listing, la=expanded listing');
  writeln('/ml,/mx,/mu   Case sensitivity on symbols: ml=all, mx=globals, mu=none');
  writeln('/n            Suppress symbol tables in listing');
  writeln('/oi           Output listing in Turbo Pascal "INLINE" format');
  writeln('/q            Suppress BIN records not needed for linking');
  writeln('/t            Suppress messages if successful assembly');
  writeln('/w0,/w1,/w2   Set warning level: w0=none, w1=w2=warnings on');
  writeln('/z            Display source line with error message');
  Halt(exHelpShown);
end; { Help }

procedure DefineSymbol(Sym: String);
  {--   }
begin

end; {  }

procedure SetPath(Path: String);
  {--   }
begin

end; {  }

procedure ProcessOptions(Opt : String);
  {-- Analyses an option(s), changes the flags in word DefaultOptions }
  procedure InvalidOption(S: String);
  begin
    Writeln(UnknownOption+S);
    Abort(Usage,exError+exUnknownOption);
  end;
var
  S    : String;
  SL   : byte absolute S;
  NDel : Integer;
begin
  S := Copy(Opt,2,255); { skip "/" or "-" characters }
  if SL = 0 then
    Help;
  while SL > 0 do begin
    case S[1] of
      'C' : begin
        DefaultOptions := DefaultOptions OR ofCrossRefInLst;
        NDel := 1;
      end;
      'D' : begin
        DefineSymbol(Copy(S,2,255));
        exit;
      end;
      'H','?' : Help;
      'I' :  begin
        SetPath(Copy(S,2,255));
        exit;
      end;
      'L' : begin
        if S[2] = 'A' then begin
          DefaultOptions := DefaultOptions OR ofOutputListing OR ofExpandedListing;
          NDel := 2;
        end else begin
          DefaultOptions := DefaultOptions OR ofOutputListing;
          NDel := 1;
        end;
      end;
      'M' : begin
        case S[2] of
          'L' : DefaultOptions := DefaultOptions OR ofCaseAll;
          'X' : DefaultOptions := DefaultOptions OR ofCaseGlobal;
          'U' : ; { default on }
          else InvalidOption(Copy(S,1,2));
        end; { case }
        NDel := 2;
      end;
      'N' : begin
        DefaultOptions := DefaultOptions AND NOT(ofSymbolTableInLst);
        NDel := 1;
      end;
      'O' : if S[2] = 'I' then
        begin
          DefaultOptions := DefaultOptions OR ofOutputInline;
          NDel := 2;
        end else
          InvalidOption(Copy(S,1,2));
      'Q' : begin
        DefaultOptions := DefaultOptions OR ofSmartLink;
        NDel := 1;
      end;
      'T' : begin
        DefaultOptions := DefaultOptions OR ofSupressMsg;
        NDel := 1;
      end;
      'W' : case S[2] of
             '0' : DefaultOptions := DefaultOptions AND NOT(ofWarningLev1 OR ofWarningLev2);
             '1' : DefaultOptions := DefaultOptions OR ofWarningLev1;
             '2' : DefaultOptions := DefaultOptions OR ofWarningLev1 OR ofWarningLev2;
             else InvalidOption(Copy(S,1,2));
        NDel := 2;
      end; { case }
      'Z' : begin
        DefaultOptions := DefaultOptions OR ofDisplayErrLine;
        NDel := 1;
      end;
    end; { case }
    Delete(S,1,NDel); { delete parsed char(s) }
  end;
end; { ProcessOptions }

procedure ProcessName(Opt : String);
  {-- Analyses a name(s), sets the corresponding name(s) }
begin
  if InFileName = '' then begin
    InFileName := DefaultExtension(Opt, InFileExt);
  end else
    if OutFileName = '' then begin
      if Opt <> '' then
        OutFileName := DefaultExtension(Opt,OutFileExt)
      else
        OutFileName := ForceExtension(InFileName,OutFileExt);
    end else
      if LstFileName = '' then begin
        if Opt <> '' then
          LstFileName := DefaultExtension(Opt,LstFileExt)
        else
          LstFileName := ForceExtension(InFileName,LstFileExt);
      end else
        if XrefFileName = '' then begin
          if Opt <> '' then
            XrefFileName := DefaultExtension(Opt,XrefFileExt)
          else
            XrefFileName := ForceExtension(InFileName,XrefFileExt);
        end else
          Abort(TooManyParameters+Opt,exTooManyParameters+exError);
end; { ProcessName }

procedure ProcessCmdLine;
  {--  Parse command line, set options and file names }
var
  S  : String;
  SL : Byte absolute S;
  B  : Byte;
  I  : Word;
  Opt : String;
  C  : Byte;
begin
  { all file names := '' }
  InFileName   := '';
  LstFileName  := '';
  XrefFileName := '';
  OutFileName  := '';

  S := '';
  for I := 1 to ParamCount do
    S := S + ' ' + StUpcase(ParamStr(I));
  S := Trim(S);
  if S = '' then
    Help;

  B := WordCount(S, CmdDelim);
  for C:= 1 to B do begin
    Opt := Trim(ExtractWord(C, S, CmdDelim));
    if (Opt[1] = '/') or (Opt[1] = '-') then
      ProcessOptions(Opt)
    else
      ProcessName(Opt);
  end;

  if InFileName = '' then
    Help;

  if OutFileName = '' then
    OutFileName := ForceExtension(InFileName,OutFileExt);

  if (DefaultOptions AND ofOutputListing) <> 0 then
    if LstFileName = '' then
      LstFileName := ForceExtension(InFileName,LstFileExt);

  if (DefaultOptions AND ofXrefOutput) <> 0 then
    if XrefFileName = '' then
      XrefFileName := ForceExtension(InFileName,XrefFileExt);

end; { ProcessCmdLine }

procedure OpenFiles;
  {--  Open / create all neccesary files }
begin
  { Input file - assembler source }
  assign(InFile,InFileName);
  reset(InFile);
  if IOResult <> 0 then
    Abort('File not found: '+InFileName,exError+exFileNotFound);

  { binary output file }
  assign(OutFile,OutFileName);
  rewrite(OutFile,1);
  if IOResult <> 0 then
    Abort('File create error: '+OutFileName,exError+exFileCreateError);

  if LstFileName <> '' then begin
    DefaultOptions := DefaultOptions or ofOutputListing;
    assign(LstFile,LstFileName);
    rewrite(LstFile);
    if IOResult <> 0 then
      Abort('File create error: '+LstFileName,exError+exFileCreateError);
  end;

  if XrefFileName <> '' then begin
    DefaultOptions := DefaultOptions or ofXrefOutput;
    assign(XrefFile,XrefFileName);
    rewrite(XrefFile);
    if IOResult <> 0 then
      Abort('File create error: '+XrefFileName,exError+exFileCreateError);
  end;
end; { OpenFiles }

procedure CloseFiles;
  {--  Close all opened / created files }
begin
  Close(InFile);
  if IOResult <> 0 then {do nothing};

  Close(OutFile);
  if IOResult <> 0 then {};

  Close(LstFile);
  if IOResult <> 0 then {};

  Close(XrefFile);
  if IOResult <> 0 then {};
end; { CloseFiles }

end.