{*******************************************************}
{                                                       }
{       WHY not a compiler? by Y [05-04-00]             }
{       Project file                                    }
{                                                       }
{       Copyright (c) 1999-2000 CROWELL, Inc.           }
{       All Rights Reserved.                            }
{                                                       }
{*******************************************************}

program CBuildMe;

{$I CDEFINES.PAS}
{$IFDEF TPC} {$N+,V-,M 32768,120000,120000} {$ENDIF}

uses Dos, Objects, CSyntax, CConstants;

var
  OldExitProc: Pointer;
  {options}
  opQuietMode: Boolean;

procedure About;
begin
  Writeln(
  'WHY not a compiler?  Version ' + Version + ' by Y [05-04-99]'#13#10 +
  'Copyright (c) 1999-2000 CROWELL, Inc. All Rights Reserved.'#13#10);
end; {About}

procedure Help;
var
  Dir, FileName, Ext: String;
begin
  FSplit(ParamStr(0), Dir, FileName, Ext);
  Writeln(
    'Syntax: ', FileName + Ext, ' [<switches>] <source.why> [<switches>]'#13#10 +
    '/q = operate quetly'
  );
end; {Help}

{$F+}
procedure NewExitProc;
begin
  {lists}
  Dispose(GlobalVariables, Done);
  Dispose(LocalVariables, Done);
  {compiler stuff}
  Dispose(Publics, Done);
  Dispose(CodeGen, Done);
  Dispose(Tokens, Done);
  ExitProc := OldExitProc;
end; {NewExitProc}
{$F-}

procedure Run(FileName: String);
var
  ModuleName, AsmFileName, IncFileName, Dir, Name, Ext: String;
begin
  {prepare source file name}
  if Pos('.', FileName) = 0 then
    FileName := FileName + '.WHY';

  {prepare destination file name}
  FSplit(FileName, Dir, Name, Ext);
  ModuleName := Name + Ext;
  AsmFileName := Dir + Name + '.ASM';
  IncFileName := Dir + Name + '.INC';

  {go}
  if not opQuietMode then
    Writeln('Compiling file: ', FileName, '...');

  New(Tokens, Init(FileName));
  New(CodeGen, Init(AsmFileName));
  New(Publics, Init(IncFileName));
  New(LocalVariables, Init(1024, 16));
  New(GlobalVariables, Init(1024, 16));

  {assign new exit procedure}
  OldExitProc := ExitProc;
  ExitProc := @NewExitProc;

  {go ahead!}
  CompileProgram(ModuleName);
  if not opQuietMode then
    Writeln(Tokens^.InStream.CurrentLine,
      ' line(s) compiled successfully, no syntax errors detected.'#13#10);
end; {Run}

function ExtractNextFileName(var FileNames: String): String;
var
  Temp: String;
  i, FileNamesLength: Integer;
begin
  Temp := '';

  {skip leading spaces}
  i := 1;
  FileNamesLength := Length(FileNames);
  while (i <= FileNamesLength) and (FileNames[i] = ' ') do
    Inc(i);
  if (i > 1) then
    Delete(FileNames, 1, i - 1);

  {extract file name}
  if (FileNames <> '') then
  begin
    i := Pos(' ', FileNames);
    if (i <> 0) then
      Temp := Copy(FileNames, 1, i - 1)
    else
    begin
      Temp := FileNames;
      i := Length(FileNames);
    end;
    Delete(FileNames, 1, i);
  end;

  ExtractNextFileName := Temp;
end; {ExtractNextFileName}

procedure ExtractSwitches(var ParamString: String);
var
  Temp: Integer;
begin
  opQuietMode := False;

  Temp := Pos('/q', ParamString);
  if (Temp = 0) then
    Temp := Pos('/Q', ParamString);

  if (Temp <> 0) then
  begin
    opQuietMode := True;
    Delete(ParamString, Temp, 2);
  end;

  Temp := Pos('/?', ParamString);
  if (Temp <> 0) then
    ParamString := '';
end; {ExtractSwitches}

var
  ParamString: String;
begin
  ParamString := String(Ptr(PrefixSeg, $80)^);
  ExtractSwitches(ParamString);

  if not opQuietMode then
    About;

  ParamString := ExtractNextFileName(ParamString);

  if (ParamString <> '') then
    Run(ParamString)
  else
  begin
    if opQuietMode then
      About;

    Help;

    Halt(256-1);
  end;
end {CBuildMe}.