unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Inifiles, Fmxutils, Menus, ExtCtrls;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    btnPreProcess: TButton;
    btnPostProcess: TButton;
    lblCpath: TLabel;
    lblApath: TLabel;
    btnCompile: TButton;
    btnAssemble: TButton;
    lblProject: TLabel;
    btnEdit: TButton;
    btnViewl51: TButton;
    btnViewa51: TButton;
    btnLink: TButton;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Bevel1: TBevel;
    Help1: TMenuItem;
    About1: TMenuItem;
    procedure btnPreProcessClick(Sender: TObject);
    procedure WriteItOut(var S:String);
    procedure ProcessStrings;
    procedure ProcessInclude;
    procedure ProcessIla;
    procedure ProcessLabel(S:String);
    function GetStartAddr(S:String) : longint;
    procedure btnPostProcessClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lblProjectDblClick(Sender: TObject);
    procedure btnEditClick(Sender: TObject);
    procedure btnCompileClick(Sender: TObject);
    procedure btnViewl51Click(Sender: TObject);
    procedure btnViewa51Click(Sender: TObject);
    procedure btnAssembleClick(Sender: TObject);
    procedure lblCpathDblClick(Sender: TObject);
    procedure lblApathDblClick(Sender: TObject);
    procedure btnLinkClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);

  private

    { Private declarations }
  public
    Hitlist : TStringList;
    appIni : TIniFile;
    { Public declarations }
  end;

var
  Form1: TForm1;
  InF, OuP, OuA, OuI, InA, InS : TextFile ;
  StringsCount : integer;
  firstAddr, theAddr : longint;
  StrProcessed, HasAssembler : boolean;
  compilerpath,asm51path,projpath : string;

implementation

uses Unit2, Unit3;

{$R *.DFM}

Function TForm1.GetStartAddr(S:String) : longint;
var
  i : integer;
  theAddr : longint;
  wS : String;

begin
  theAddr := 0;
  StringsCount := 0;
  wS := UpperCase(s);
  if Pos('START AT $',wS) = 0 then
  begin
    Listbox1.items.add(S);
    Listbox1.items.add('Error - No Start address found for strings');
  end
  else
  begin
    i := Pos('$',S);
    theAddr := StrToInt(Copy(S,i,5));
  end;
  result := theAddr;
end;

procedure TForm1.ProcessInclude;
var
  S : String;
begin
  while not eof(InS) do {next do strings include}
  begin
    readln(InS,S);
    writeln(OuA,S);
  end;

  writeln(OuA,chr(9) + 'END' + chr(9)); {write final 'END' to assembler file}
end;

procedure TForm1.ProcessIla;
var
  S : String;
begin
  if HasAssembler then {process inline assembler include}
  begin
    while not eof(OuI) do {.ila include}
    begin
      readln(OuI,S);
      writeln(OuA,S);
    end;
  end;
end;


procedure TForm1.ProcessLabel(S:String);
{compare the label at the start of the string with the procnames
in hitlist. If found, zap the asm code lines by reading them off the
input file InA}
var
i : integer;
lab,gash : string;
begin;
  i := Pos(':',s);
  lab := uppercase(copy(s,1,i-1));
  if HitList.IndexOf(lab) <> -1 then {found one to remove}
  begin
    repeat
      readln(InA,gash);
    until ((Pos('RET',gash) <> 0) and (gash[1] <> ';')) or (eof(InA));
    if eof(InA) then
     listbox1.Items.add('Unexpected EOF, Assembler external procedure ' + lab)
    else
     listbox1.Items.add('Assembler procedure ' + lab + ' processed')
  end
  else writeln(OuA,S);

end;

procedure TForm1.ProcessStrings;
var
i : integer;
S, varname, theString : string;
firsttime : boolean;

begin
  StrProcessed := True;
  FirstTime := True;
  readln(InF,S);
  S := Trim(S);
  while S <> '' do
  begin
    if FirstTime then
    begin
      theAddr := GetStartAddr(S);
      firstAddr := theAddr;
      readln(InF,S);
      FirstTime := false;
      writeln(OuP,'   {Stringlist generated on ' + datetostr(date) + ' at ' + timetostr(time) + '}');
      writeln(OuA,';');
      writeln(OuA,'; Stringlist generated on ' + datetostr(date) + ' at ' + timetostr(time));
      writeln(OuA,chr(9),'CSEG at ',intTohex(theAddr,4),'H');
      writeln(OuA,chr(9),'ORG ',intTohex(theAddr,4),'H');
    end;

    i := Pos(':=',S);
    varname := copy(s,1,i-1);
    varname := trim(varname);
    i := Pos('''',S);
    theString := Copy(S,i+1,length(S)-i - 2);
    Listbox1.items.add('Processing string at $' + intTohex(theAddr,4));
    write(OuP, '   ',varname,' at $',intTohex(theAddr,4),' : string;');
    writeln(OuP,' {',theString,'}');
    writeln(OuA,chr(9),'DB ',length(theString));
    writeln(OuA,chr(9),'DB ''',theString,  '''');
    theAddr := theAddr + length(theString) + 1;
    StringsCount := StringsCount + 1;
    readln(InF,S);
    S := Trim(S);
  end;
  Listbox1.items.add('Finished processing ' + IntToStr(StringsCount) + ' string(s)');
  Listbox1.items.add('Strings Start Address = $' + intTohex(firstAddr,4) + ', Last Address = $' + intTohex(theAddr,4));
  Listbox1.items.add('Total string space = $' + InttoHex(theAddr - firstAddr,4) + '  (' + IntToStr(theAddr - firstAddr) + ' bytes)');
end;

procedure Convert_Char(var s:String);
var
 sch,numstr : string;
 i,st : integer;
 allDone, gotOne : boolean;

begin
  allDone := false;
  while allDone = false do
    begin
    gotOne := false;
    for i := 14 to 127 do
    begin
      sch := '''' + chr(i) + '''';
      st := Pos(sch,s);
      if st <> 0 then
      begin
        numstr:= IntToHex(ord(i),2);
        insert('$' + numstr + ' {', s, st);
        st := Pos(sch,s) + 3;
        insert('}',s,st);
        st := Pos(sch,s);
        s[st] := chr(96); //replace ' with open quote.
        s[st+2] := chr(180);//and aclose quote
        gotOne := true;
      end;
    end;
    if gotOne then allDone := false else allDone := true;
    //allDone := true;
  end;
end;

procedure TForm1.WriteItOut(var s:String);
var
 i,j : integer;
 wS, wS1 : String;
 procname, fpath, fname,OutName : String;
begin
  wS := UpperCase(s);

  if Pos('{*EXTERNAL}',wS) <> 0 then
  {This line has the name of a procedure which is implemented
   elsewhere in existing asm code.
   So, add the name of the procedure to a hitlist. This list will
   be used later to strip out the code planted in the .a51 file
   by Pascal51 compiler}
  begin
    i := Pos('PROCEDURE',wS);
    i := i + 10;
    j := Pos(';',wS);
    procname := trim(procname);
    procname := copy(ws,i,j-i);
    HitList.add(procname);
    Listbox1.items.add('External procedure ' + procname + ' processed.');
  end
  else if Pos('{*ASSEMBLER}',wS) <> 0 then
  {This line has the name of a procedure which is implemented
   inline in the P80 code.
   So, copy the lines between the 'begin' and 'end;' to the
   .ila (In Line Assembler) file. This file must be included
   in the final assembly}
  begin
    if not HasAssembler then {1st time in only}
    begin
      fPath := ExtractFilePath(ProjPath);
      fName := ExtractFileName(ProjPath);
      fName := Copy(fName,1,length(fName)-3); {remove file extension - 3 chars only}
      OutName := fPath + fName + 'ila';
      AssignFile(OuI, OutName);   { File selected in dialog box }
      Rewrite(OuI);
      writeln(OuI,';');  {write to inline assembler source file}
      writeln(OuI,'; Inline assembler generated on ' + datetostr(date) + ' at ' + timetostr(time));