📄 unit1.pas
字号:
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));
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -