{*******************************************************}
{                                                       }
{       Whymake - Why compile and link driver.          }
{       Written by Y [07-04-00] or later                }
{                                                       }
{       Copyright (c) 2000 CROWELL, Inc.                }
{       All Rights Reserved.                            }
{                                                       }
{*******************************************************}

uses DOS; {$V-,M 32786,0,0}

var
  BiosTimer: LongInt absolute $0040: $006C;

const
  cWhySwitches: String = '';
  cWhyQuietSwitch = '/q';
  cTasmSwitches: String = '/m5 /q';
  cTasmQuietSwitch = '/t';

var {options}
  opCompileOnly, opNoLink, opQuietMode, opVerboseMode: Boolean;

function Up(S: String):String;
var
  i: Integer;
begin
  for i := 1 to Length(S) do
    if (S[i] >= 'a') and (S[i] <= 'z') then
      S[i] := Char(Byte(S[i]) + Byte('A') - Byte('a'));
  Up := S;
end; {Up}

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}

function RunProgram(ProgramName: String; CommandLine: String): Boolean;
var
  S: String;
begin
  S := FSearch(ProgramName, GetEnv('PATH'));
  if (S = '') then
  begin
    Writeln('WHYMAKE: Program not found: ' + ProgramName);
    RunProgram := False;
  end
  else
  begin
    Exec(S, CommandLine);
    if (DosError <> 0) then
    begin
      Writeln;
      Writeln('WHYMAKE: Error executing ' + ProgramName);
      RunProgram := False;
    end
    else if (DosExitCode <> 0) then
    begin
      Writeln;
      Writeln('WHYMAKE: Error reported from ' + ProgramName);
      RunProgram := False;
    end
    else
      RunProgram := True;
  end;
end; {RunProgram}

function Link(ExeName, ObjFiles: String): Boolean;
const
  WlinkFile = 'whymak32.lnk';
var
  Temp: Boolean;
  F: Text;
begin
  Assign(F, WlinkFile);
  SetFAttr(F, 0);
  Rewrite(F);
  if (IOResult = 0) then
  begin
    Writeln(F, '# Wlink responce file, generated by WHYMAKE');
    Writeln(F, '# Warning! Stack must be AT LEAST 131072 bytes');
    Writeln(F, '# (64K for rstack and the rest for astack)');
    Writeln(F);
    if not opVerboseMode then
      Writeln(F, 'option  quiet');
    Writeln(F, 'option  stack=131072');
    {Writeln(F, 'option  stub=pmodew.exe');}
    Writeln(F, 'option  stub=st4gw.exe');
    Writeln(F, 'debug   watcom all');
    Writeln(F, 'library pmc, mylib');
    Writeln(F, 'file    w0d32f, system, ' + ObjFiles);
    Writeln(F, 'name    ' + ExeName);
    Writeln(F, 'format  os2 le');
    Close(F);
    if (IOResult <> 0) then;

    Temp := RunProgram('WLINK.EXE', '@' + WlinkFile);

    if Temp then {success}
      Erase(F);
  end
  else
    Writeln('WHYMAKE: cannot write WLINK responce file ' + WlinkFile);

  Link := Temp;
end; {Link}

function Make(FileNames: String): Boolean;
var
  CleanFileName, Dir, Ext: String;
  Temp: Boolean;
  ObjNames, FileName, ExeName, NextFileNames: String;
begin
  Temp := True;
  ObjNames := '';
  NextFileNames := '';

  FileName := ExtractNextFileName(FileNames);
  FSplit(FileName, Dir, CleanFileName, Ext);
  ExeName := Dir + CleanFileName;

  if not opVerboseMode then
  begin
    cWhySwitches := cWhySwitches + cWhyQuietSwitch;
    cTasmSwitches := cTasmSwitches + cTasmQuietSwitch;
  end;

  {compile with WHY.EXE}
  while (Temp and (FileName <> '')) do
  begin
    FSplit(FileName, Dir, CleanFileName, Ext);
    if (Ext = '') then
      Ext := '.WHY';

    if (Up(Ext) = '.WHY') then
      if not RunProgram('WHY.EXE', Dir + CleanFileName + '.why ' + cWhySwitches) then
        Temp := False
      else
        Ext := '.ASM';

    NextFileNames := NextFileNames + ' ' + Dir + CleanFileName + Ext;
    FileName := ExtractNextFileName(FileNames);
  end;

  FileNames := NextFileNames;
  FileName := ExtractNextFileName(FileNames);

  {assemble with TASM.EXE}
  if not opCompileOnly then
    while (Temp and (FileName <> '')) do
    begin
      FSplit(FileName, Dir, CleanFileName, Ext);

      if Temp and (Up(Ext) = '.ASM') then
      begin
        if not RunProgram('TASM.EXE', ' ' + cTasmSwitches + ' ' + Dir + CleanFileName + '.asm') then
          Temp := False
        else
          Ext := '.OBJ';

        if Temp and (Up(Ext) = '.OBJ') then
          if (ObjNames = '') then
            {TASM does not put .obj files to the target directory}
            ObjNames := {Dir + }CleanFileName
          else
            ObjNames := ObjNames + ', ' + {Dir + }CleanFileName
        else
          if Temp then
            Writeln('WHYMAKE: warning: don''t know how to make ' + Dir + CleanFileName + Ext);
      end
      else if Temp and (Up(Ext) = '.OBJ') then
        if (ObjNames = '') then
          ObjNames := Dir + CleanFileName
        else
          ObjNames := ObjNames + ', ' + Dir + CleanFileName
      else
        if Temp then
          Writeln('WHYMAKE: warning: don''t know how to make ' + Dir + CleanFileName + Ext);

      FileName := ExtractNextFileName(FileNames);
    end;

  {link with WLINK.EXE}
  if (not opNoLink) and Temp and (ObjNames <> '') then
    Temp := Link(ExeName, ObjNames);

  Make := Temp;
end;

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

  Temp := Pos('/c', ParamString);
  if (Temp = 0) then
    Temp := Pos('/C', ParamString);

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

  Temp := Pos('/a', ParamString);
  if (Temp = 0) then
    Temp := Pos('/A', ParamString);

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

  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('/v', ParamString);
  if (Temp = 0) then
    Temp := Pos('/V', ParamString);

  if (Temp <> 0) then
  begin
    opQuietMode := False;
    opVerboseMode := True;
    Delete(ParamString, Temp, 2);
  end;
end; {ExtractSwitches}

procedure About;
begin
  Writeln('WHYMAKE  Version 0.02 alpha'#13#10 +
    'Why not compile and link driver? Written by Y [08-05-00].'#13#10 +
    'Copyright (c) 2000 CROWELL, Inc. All Rights Reserved.'#10);
  Flush(Output);
end; {About}

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

  if not opQuietMode then
    About;

  if (ParamStr(1) = '') or (Pos('?', ParamString) <> 0) then
  begin
    if opQuietMode then
      About;
    Writeln(
      'WHYMAKE: no source names given.'#13#10#13#10 +
      'Syntax: WHYMAK32.EXE { <switch> } <file.ext> { <file.ext> }'#13#10 +
      '/c = compile only (do not assemble and link)'#13#10,
      '/a = compile and assemble (do not link)'#13#10 +
      '/q = operate quietly'#13#10 +
      '/v = don''t supress Why/TASM/WLINK messages'
    );
  end
  else
  begin
    TimeStamp := BiosTimer;
    MakeResult := Make(ParamString);
    TimeStamp := BiosTimer - TimeStamp;

    if opVerboseMode and (not opNoLink) then
      Writeln;

    if (not MakeResult) then
      Writeln('WHYMAKE: cannot make specified file(s)');

    if not opQuietMode then
      Writeln('WHYMAKE: time elapsed: ', TimeStamp / 18.2 * 1000: 0: 1, ' ms.');
  end;
end {whymak32.pas}.