{
Этот исходный текст является частью Продвинутого векторного транслятора.
Следующие файлы используются этим исходным текстом:
mainwindow.lfm
На них так же распространяются те же права, как и на этот исходный текст.
Copyright © 2017 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или
изменять её на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она может быть полезна,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit MainWindow;
{$MODE DELPHI,EXTENDEDSYNTAX ON}
interface
uses
Windows,
Classes, SysUtils, Forms, Graphics, Dialogs, Controls, StdCtrls, ExtCtrls,
Menus, InterfaceBase, LCLIntf, LMessages,
Lang, IOStream, FileIO, SettingFiles,
TranIntf, TranType, BuildLex, BuildNms, BuildFTr,
GenX86, Gen16bit, Gen32bit, Gen64bit, AsmGens;
{$ASMMODE INTEL,CALLING REGISTER,INLINE ON,GOTO ON}
{$H+,I-,J-,M-,Q-,R-,T-}
const
LM_COMPILE_BEGIN = LM_USER + 1;
LM_COMPILE_END = LM_USER + 2;
LM_COMPILE_ERROR = LM_USER + 3;
type
GenerationInfo = interface;
TMainForm = class;
GenerationInfo_Array1d = packed array of GenerationInfo;
GenerationInfo = interface(_Interface) ['{A2619CC7-DF2E-4BFD-8017-0CF91E443ADA}']
function getExecutableName(): String;
function getGeneratorClass(): TextGenerator_Class;
property executableName: String read getExecutableName;
property generatorClass: TextGenerator_Class read getGeneratorClass;
end;
TMainForm = class(TForm, _Interface, Runnable)
targetProcessor: TGroupBox;
targetProcessorBitsLabel: TLabel;
targetProcessorBits: TComboBox;
targetProcessorInstructionSetLabel: TLabel;
targetProcessorInstructionSet: TComboBox;
source: TGroupBox;
sourceFileList: TListBox;
sourceAdd: TButton;
sourceExpell: TButton;
sourceMoveUp: TButton;
sourceMoveDown: TButton;
platform: TGroupBox;
platformExecutableTypeLabel: TLabel;
platformExecutableType: TComboBox;
platformExitInstructionLabel: TLabel;
platformExitInstruction: TComboBox;
platformHeapSizeLabel: TLabel;
platformHeapSize: TEdit;
platformStackSizeLabel: TLabel;
platformStackSize: TEdit;
destination: TGroupBox;
destinationFileName: TEdit;
destinationSelect: TButton;
fasm: TGroupBox;
fasmAlsoBuild: TCheckBox;
fasmExePathLabel: TLabel;
fasmExePath: TEdit;
fasmExePathSearch: TButton;
fasmDestinationLabel: TLabel;
fasmDestination: TEdit;
fasmDestinationSelect: TButton;
buttonsPanel: TPanel;
loadProject: TButton;
saveProject: TButton;
buildProject: TButton;
aboutAVT: TButton;
closeAVT: TButton;
sourceAddDialog: TOpenDialog;
destinationSelectDialog: TSaveDialog;
fasmExePathSearchDialog: TOpenDialog;
fasmDestinationSelectDialog: TSaveDialog;
loadProjectDialog: TOpenDialog;
saveProjectDialog: TSaveDialog;
procedure formDropFiles(sender: TObject; const fileNames: array of String);
procedure targetProcessorBitsChange(sender: TObject);
procedure sourceFileListSelectionChange(sender: TObject; user: boolean);
procedure sourceAddClick(sender: TObject);
procedure sourceExpellClick(sender: TObject);
procedure sourceMoveUpClick(sender: TObject);
procedure sourceMoveDownClick(sender: TObject);
procedure platformExecutableTypeChange(sender: TObject);
procedure destinationSelectClick(sender: TObject);
procedure fasmAlsoBuildClick(sender: TObject);
procedure fasmExePathSearchClick(sender: TObject);
procedure fasmDestinationSelectClick(sender: TObject);
procedure loadProjectClick(sender: TObject);
procedure saveProjectClick(sender: TObject);
procedure buildProjectClick(sender: TObject);
procedure aboutAVTClick(sender: TObject);
procedure closeAVTClick(sender: TObject);
private
translatorUseFasm: boolean;
translatorBits: int;
translatorInstructionSet: int;
translatorHeapSize: int;
translatorStackSize: int;
translatorExitInstruction: int;
translatorExecutableType: TextGenerator_Class;
translatorSources: String_Array1d;
translatorDestination: String;
translatorFasmPath: String;
translatorExecutable: String;
procedure runFasm();
private
errorLine: int;
errorChar: int;
errorInfo: String;
errorSource: String;
private
openedDialog: TForm;
generators16bit: GenerationInfo_Array1d;
generators32bit: GenerationInfo_Array1d;
generators64bit: GenerationInfo_Array1d;
generatorsCurrent: GenerationInfo_Array1d;
procedure sourceButtonsSetEnabledState();
procedure saveProjectToStream(stream: Output);
procedure loadProjectFromStream(stream: Input);
protected
procedure wmCompileBegin(var msg: TLMessage); message LM_COMPILE_BEGIN;
procedure wmCompileEnd(var msg: TLMessage); message LM_COMPILE_END;
procedure wmCompileError(var msg: TLMessage); message LM_COMPILE_ERROR;
protected
function loadSourceFromStream(stream: Input): UnicodeString; virtual;
public
constructor create(theOwner: TComponent); override;
procedure afterConstruction(); override;
procedure run(); virtual;
function openDialog(dialog: TForm): int; virtual; overload;
function openDialog(const caption, text: String; dialogType: TMsgDlgType;
buttons: TMsgDlgButtons): int; virtual; overload;
private
const SECTION_PROCESSOR = 'processor';
const SECTION_SOURCES = 'sources';
const SECTION_PLATFORM = 'platform';
const SECTION_DESTINATION = 'destination';
const SECTION_FASM = 'fasm';
const IDENT_BITS = 'bits';
const IDENT_INSTRUCTION_SET = 'instruction set';
const IDENT_FILE = 'file ';
const IDENT_EXE_TYPE_INDEX = 'exe type index';
const IDENT_EXIT_INSTRUCTION = 'exit instruction';
const IDENT_HEAP_SIZE = 'heap size';
const IDENT_STACK_SIZE = 'stack size';
const IDENT_FILE_NAME = 'file name';
const IDENT_USE = 'use';
const IDENT_PATH = 'path';
const VALUE_SSE3 = 'SSE3';
const VALUE_SSSE3 = 'SSSE3';
const VALUE_SSE4_1 = 'SSE4.1';
const VALUE_AVX_512 = 'AVX-512';
const VALUE_RET = 'ret';
const VALUE_RETF = 'retf';
const VALUE_CALL = 'call';
class var INSTANCE: TMainForm;
public
class procedure createInstance();
end;
resourcestring
msgError = 'Ошибка';
msgWait = 'Подождите…';
msgCompile = 'Компилировать';
msgSource = 'Исходный код: ';
msgLine = 'Строка: ';
msgChar = 'Символ: ';
msgErrorLoadingSource = 'Ошибка возникла при загрузке исходного кода.'#13#10 +
'Проверьте выбранный путь и имя файла.'#13#10 +
'Файл исходного кода, возбудивший ошибку: ';
msgErrorSavingDestination = 'Ошибка возникла при сохранении целевого файла исходного кода ' +
'на языке flat assembler.'#13#10'Проверьте выбранный путь и имя файла.';
msgErrorLoadingProject = 'Ошибка возникла при загрузке проекта. '#13#10 +
'Проверьте выбранный путь и имя файла.';
msgErrorSavingProject = 'Ошибка возникла при сохранении проекта. '#13#10 +
'Проверьте выбранный путь и имя файла.';
msgBinaryFile = 'Двоичный файл';
msg16bitDOS_COM = 'DOS: COM-программа';
msg32bitGNULinux_ELF = 'GNU/Linux: ELF-программа';
msg32bitWindows_GUI = 'Windows: графическая программа';
msg32bitWindows_Console = 'Windows: консольная программа';
msg32bitKolibriOS_MENUET01 = 'KolibriOS: MENUET01-программа';
msg64bitGNULinux_ELF64 = 'GNU/Linux: ELF64-программа';
msg64bitWindows_GUI = 'Windows: графическая программа';
msg64bitWindows_Console = 'Windows: консольная программа';
msgOpenDialogFormIsNull = 'openDialog: dialog = nil.';
msgOpenDialogAlreadyOpened = 'openDialog: у этой формы уже открыто диалоговое окно.';
msgOpenDialogDisabled = 'openDialog: эта форма недоступна.';
msgOpenDialogFormAlreadyOpened = 'openDialog: запрашиваемое диалоговое окно уже открыто.';
msgOpenDialogFormDisabled = 'openDialog: запрашиваемое диалоговое окно недоступно.';
msgOpenDialogFormMDIChild = 'openDialog: запрашиваемое окно не может быть диалоговым.';
msgAbout = 'О программе';
msgAboutContent = 'Продвинутый векторный транслятор'#13#10 +
'Версия: 0.3.2 бета'#13#10#13#10 +
'Страница программы в Интернете:'#13#10 +
'https://malik-elaborarer.ru/avt_ru/'#13#10#13#10 +
'Copyright © 2017 Малик Разработчик'#13#10#13#10 +
'Лицензия GPL/LGPL.'#13#10 +
'Обратитесь к исходному коду за подробностями.';
implementation
{$R *.LFM}
type
CodeGenerationInfo = class(RefCountInterfacedObject, GenerationInfo)
public
constructor create(const executableName: String; generatorClass: TextGenerator_Class);
function getExecutableName(): String; virtual;
function getGeneratorClass(): TextGenerator_Class; virtual;
strict private
executableName: String;
generatorClass: TextGenerator_Class;
end;
{ TMainForm }
procedure TMainForm.formDropFiles(sender: TObject; const fileNames: array of String);
var
i: int;
lim: int;
begin
with sourceFileList.items do begin
beginUpdate();
try
lim := length(fileNames) - 1;
for i := 0 to lim do begin
add(fileNames[i]);
end;
finally
endUpdate();
end;
end;
sourceButtonsSetEnabledState();
end;
procedure TMainForm.targetProcessorBitsChange(sender: TObject);
var
i: int;
lim: int;
generators: GenerationInfo_Array1d;
begin
generators := nil;
case targetProcessorBits.itemIndex of
0: generators := generators16bit;
1: generators := generators32bit;
2: generators := generators64bit;
end;
generatorsCurrent := generators;
with platformExecutableType, items do begin
beginUpdate();
try
clear();
lim := length(generators) - 1;
for i := 0 to lim do begin
add(generators[i].executableName);
end;
finally
endUpdate();
end;
itemIndex := 0;
platformExecutableTypeChange(platformExecutableType);
end;
end;
procedure TMainForm.sourceFileListSelectionChange(sender: TObject; user: boolean);
begin
sourceButtonsSetEnabledState();
end;
procedure TMainForm.sourceAddClick(sender: TObject);
var
i: int;
lim: int;
fileNames: TStrings;
begin
with sourceAddDialog do begin
if not execute() then begin
exit;
end;
fileNames := files;
end;
with sourceFileList.items do begin
beginUpdate();
try
lim := fileNames.count - 1;
for i := 0 to lim do begin
add(fileNames.strings[i]);
end;
finally
endUpdate();
end;
end;
sourceButtonsSetEnabledState();
end;
procedure TMainForm.sourceExpellClick(sender: TObject);
var
i: int;
begin
with sourceFileList, items do begin
beginUpdate();
try
for i := count - 1 downto 0 do begin
if selected[i] then begin
delete(i);
end;
end;
finally
endUpdate();
end;
end;
sourceButtonsSetEnabledState();
end;
procedure TMainForm.sourceMoveUpClick(sender: TObject);
var
currIsSelected: boolean;
prevNonSelectedIndex: int;
i: int;
len: int;
begin
with sourceFileList, items do begin
beginUpdate();
try
len := count;
prevNonSelectedIndex := 0;
for i := 0 to len do begin
if i < len then begin
currIsSelected := selected[i];
end else begin
currIsSelected := false;
end;
if currIsSelected = false then begin
if i <> prevNonSelectedIndex then begin
move(prevNonSelectedIndex, i - 1);
end;
prevNonSelectedIndex := i;
end;
end;
finally
endUpdate();
end;
end;
sourceButtonsSetEnabledState();
end;
procedure TMainForm.sourceMoveDownClick(sender: TObject);
var
currIsSelected: boolean;
prevNonSelectedIndex: int;
i: int;
lim: int;
begin
with sourceFileList, items do begin
beginUpdate();
try
lim := count - 1;
prevNonSelectedIndex := lim;
for i := lim downto -1 do begin
if i >= 0 then begin
currIsSelected := selected[i];
end else begin
currIsSelected := false;
end;
if currIsSelected = false then begin
if i <> prevNonSelectedIndex then begin
move(prevNonSelectedIndex, i + 1);
end;
prevNonSelectedIndex := i;
end;
end;
finally
endUpdate();
end;
end;
sourceButtonsSetEnabledState();
end;
procedure TMainForm.platformExecutableTypeChange(sender: TObject);
var
generatorClass: TextGenerator_Class;
begin
generatorClass := generatorsCurrent[platformExecutableType.itemIndex].generatorClass;
if generatorClass.isNeedHeapSize() then begin
platformHeapSizeLabel.enabled := true;
with platformHeapSize do begin
enabled := true;
color := clWindow;
end;
end else begin
platformHeapSizeLabel.enabled := false;
with platformHeapSize do begin
enabled := false;
color := clBtnFace;
end;
end;
if generatorClass.isNeedStackSize() then begin
platformStackSizeLabel.enabled := true;
with platformStackSize do begin
enabled := true;
color := clWindow;
end;
end else begin
platformStackSizeLabel.enabled := false;
with platformStackSize do begin
enabled := false;
color := clBtnFace;
end;
end;
if generatorClass.isNeedExitMethod() then begin
platformExitInstructionLabel.enabled := true;
with platformExitInstruction do begin
enabled := true;
color := clWindow;
end;
end else begin
platformExitInstructionLabel.enabled := false;
with platformExitInstruction do begin
enabled := false;
color := clBtnFace;
end;
end;
end;
procedure TMainForm.destinationSelectClick(sender: TObject);
begin
with destinationSelectDialog do begin
fileName := destinationFileName.text;
if execute() then begin
destinationFileName.text := fileName;
end;
end;
end;
procedure TMainForm.fasmAlsoBuildClick(sender: TObject);
begin
if fasmAlsoBuild.checked then begin
fasmExePathLabel.enabled := true;
with fasmExePath do begin
enabled := true;
color := clWindow;
end;
fasmExePathSearch.enabled := true;
fasmDestinationLabel.enabled := true;
with fasmDestination do begin
enabled := true;
color := clWindow;
end;
fasmDestinationSelect.enabled := true;
end else begin
fasmExePathLabel.enabled := false;
with fasmExePath do begin
enabled := false;
color := clBtnFace;
end;
fasmExePathSearch.enabled := false;
fasmDestinationLabel.enabled := false;
with fasmDestination do begin
enabled := false;
color := clBtnFace;
end;
fasmDestinationSelect.enabled := false;
end;
end;
procedure TMainForm.fasmExePathSearchClick(sender: TObject);
begin
with fasmExePathSearchDialog do begin
fileName := fasmExePath.text;
if execute() then begin
fasmExePath.text := fileName;
end;
end;
end;
procedure TMainForm.fasmDestinationSelectClick(sender: TObject);
begin
with fasmDestinationSelectDialog do begin
fileName := fasmDestination.text;
if execute() then begin
fasmDestination.text := fileName;
end;
end;
end;
procedure TMainForm.loadProjectClick(sender: TObject);
var
fileAsStream: Input;
fileAsObject: FileInputStream;
projectFileName: String;
begin
with loadProjectDialog do begin
if execute() = false then begin
exit;
end;
projectFileName := fileName;
end;
fileAsObject := FileInputStream.create(stringToUTF16(projectFileName));
if fileAsObject.hasOpenError() then begin
fileAsObject.free();
openDialog(msgError, msgErrorLoadingProject, mtError, [mbClose]);
exit;
end;
fileAsStream := fileAsObject;
try
loadProjectFromStream(fileAsStream);
finally
fileAsStream.close();
end;
end;
procedure TMainForm.saveProjectClick(sender: TObject);
var
fileAsStream: Output;
fileAsObject: FileOutputStream;
projectFileName: String;
begin
with saveProjectDialog do begin
if execute() = false then begin
exit;
end;
projectFileName := fileName;
end;
fileAsObject := FileOutputStream.create(stringToUTF16(projectFileName), false);
if fileAsObject.hasOpenError() then begin
fileAsObject.free();
openDialog(msgError, msgErrorSavingProject, mtError, [mbClose]);
exit;
end;
fileAsStream := fileAsObject;
try
saveProjectToStream(fileAsStream);
finally
fileAsStream.close();
end;
end;
procedure TMainForm.buildProjectClick(sender: TObject);
var
i: int;
lim: int;
sources: String_Array1d;
begin
translatorUseFasm := fasmAlsoBuild.checked;
case targetProcessorBits.itemIndex of
0: translatorBits := RegistersX86.MODE_16_BIT;
1: translatorBits := RegistersX86.MODE_32_BIT;
2: translatorBits := RegistersX86.MODE_64_BIT;
end;
case targetProcessorInstructionSet.itemIndex of
0: translatorInstructionSet := TranslatorNamespacesBuilder.EXTENSION_SSE3;
1: translatorInstructionSet := TranslatorNamespacesBuilder.EXTENSION_SSSE3;
2: translatorInstructionSet := TranslatorNamespacesBuilder.EXTENSION_SSE4_1;
end;
translatorHeapSize := stringParseInt(platformHeapSize.text, 10, -1);
translatorStackSize := stringParseInt(platformStackSize.text, 10, -1);
case platformExitInstruction.itemIndex of
0: translatorExitInstruction := TextGenerator.EXIT_RET;
1: translatorExitInstruction := TextGenerator.EXIT_RETF;
2: translatorExitInstruction := TextGenerator.EXIT_CALL;
end;
translatorExecutableType := generatorsCurrent[platformExecutableType.itemIndex].generatorClass;
with sourceFileList.items do begin
lim := count - 1;
sources := String_Array1d_create(lim + 1);
for i := 0 to lim do begin
sources[i] := strings[i];
end;
end;
translatorSources := sources;
translatorDestination := destinationFileName.text;
translatorFasmPath := fasmExePath.text;
translatorExecutable := fasmDestination.text;
with Thread.create(self) do begin
freeOnTerminate := true;
start();
end;
sendMessage(handle, LM_COMPILE_BEGIN, 0, 0);
end;
procedure TMainForm.aboutAVTClick(sender: TObject);
begin
openDialog(msgAbout, msgAboutContent, mtInformation, [mbClose]);
end;
procedure TMainForm.closeAVTClick(sender: TObject);
begin
close();
end;
procedure TMainForm.runFasm();
var
fasmStartupInfo: Windows.StartupInfoW;
fasmProcessInfo: Windows.Process_Information;
fasmArguments: UnicodeString;
begin
initialize(fasmStartupInfo);
initialize(fasmProcessInfo);
fasmArguments := '"' + stringToUTF16(translatorFasmPath) + '" "' +
stringToUTF16(translatorDestination) + '" "' +
stringToUTF16(translatorExecutable) + '"'#$0000;
fillChar(fasmStartupInfo, sizeof(Windows.StartupInfoW), 0);
fasmStartupInfo.cb := sizeof(Windows.StartupInfoW);
fasmStartupInfo.wShowWindow := 1;
if Windows.createProcessW(nil, PWideChar(fasmArguments), nil, nil,
false, $20, nil, nil, fasmStartupInfo, fasmProcessInfo) then begin
Windows.closeHandle(fasmProcessInfo.hProcess);
Windows.closeHandle(fasmProcessInfo.hThread);
end;
end;
procedure TMainForm.sourceButtonsSetEnabledState();
var
hasEnabled: boolean;
hasSelected: boolean;
begin
with sourceFileList do begin
hasSelected := selCount > 0;
with sourceExpell do begin
if (hasSelected = false) and focused() then begin
sourceFileList.setFocus();
end;
enabled := hasSelected;
end;
hasEnabled := hasSelected and (selected[0] = false);
with sourceMoveUp do begin
if (hasEnabled = false) and focused() then begin
sourceFileList.setFocus();
end;
enabled := hasEnabled;
end;
hasEnabled := hasSelected and (selected[count - 1] = false);
with sourceMoveDown do begin
if (hasEnabled = false) and focused() then begin
sourceFileList.setFocus();
end;
enabled := hasEnabled;
end;
end;
end;
procedure TMainForm.saveProjectToStream(stream: Output);
var
i: int;
lim: int;
settings: AbstractInitializationFile;
valueStr: String;
begin
settings := NormalInitializationFile.create();
try
valueStr := copy(targetProcessorBits.text, 1, 2);
settings.writeString(SECTION_PROCESSOR, IDENT_BITS, valueStr);
case targetProcessorInstructionSet.itemIndex of
0: valueStr := VALUE_SSE3;
1: valueStr := VALUE_SSSE3;
2: valueStr := VALUE_SSE4_1;
3: valueStr := VALUE_AVX_512;
end;
settings.writeString(SECTION_PROCESSOR, IDENT_INSTRUCTION_SET, valueStr);
with sourceFileList.items do begin
lim := count - 1;
for i := 0 to lim do begin
settings.writeString(SECTION_SOURCES, IDENT_FILE + intToString(i + 1),
strings[i]);
end;
end;
settings.writeInt(SECTION_PLATFORM, IDENT_EXE_TYPE_INDEX,
platformExecutableType.itemIndex);
case platformExitInstruction.itemIndex of
0: valueStr := VALUE_RET;
1: valueStr := VALUE_RETF;
2: valueStr := VALUE_CALL;
end;
settings.writeString(SECTION_PLATFORM, IDENT_EXIT_INSTRUCTION, valueStr);
settings.writeString(SECTION_PLATFORM, IDENT_HEAP_SIZE, platformHeapSize.text);
settings.writeString(SECTION_PLATFORM, IDENT_STACK_SIZE, platformStackSize.text);
settings.writeString(SECTION_DESTINATION, IDENT_FILE_NAME, destinationFileName.text);
settings.writeBoolean(SECTION_FASM, IDENT_USE, fasmAlsoBuild.checked);
settings.writeString(SECTION_FASM, IDENT_PATH, fasmExePath.text);
settings.writeString(SECTION_FASM, IDENT_FILE_NAME, fasmDestination.text);
settings.saveToStream(stream);
finally
settings.free();
end;
end;
procedure TMainForm.loadProjectFromStream(stream: Input);
var
i: int;
valueInt: int;
settings: AbstractInitializationFile;
ident: String;
valueStr: String;
begin
settings := NormalInitializationFile.create();
try
settings.loadFromStream(stream);
case settings.readInt(SECTION_PROCESSOR, IDENT_BITS, 64) of
16: targetProcessorBits.itemIndex := 0;
32: targetProcessorBits.itemIndex := 1;
else
targetProcessorBits.itemIndex := 2;
end;
targetProcessorBitsChange(targetProcessorBits);
valueStr := stringToUpperCase(settings.readString(SECTION_PROCESSOR, IDENT_INSTRUCTION_SET,
VALUE_SSE3));
if valueStr = VALUE_SSE3 then begin
targetProcessorInstructionSet.itemIndex := 0;
end else
if valueStr = VALUE_SSSE3 then begin
targetProcessorInstructionSet.itemIndex := 1;
end else
if valueStr = VALUE_SSE4_1 then begin
targetProcessorInstructionSet.itemIndex := 2;
end;
with sourceFileList.items do begin
beginUpdate();
try
clear();
i := 1;
repeat
ident := IDENT_FILE + intToString(i);
inc(i);
if not settings.isIdentExists(SECTION_SOURCES, ident) then begin
break;
end;
valueStr := settings.readString(SECTION_SOURCES, ident, '');
if length(valueStr) > 0 then begin
add(valueStr);
end;
until false;
finally
endUpdate();
end;
end;
sourceButtonsSetEnabledState();
valueInt := settings.readInt(SECTION_PLATFORM, IDENT_EXE_TYPE_INDEX, 0);
with platformExecutableType, items do begin
if (valueInt >= 0) and (valueInt < count) then begin
itemIndex := valueInt;
end;
end;
platformExecutableTypeChange(platformExecutableType);
valueStr := stringToLowerCase(settings.readString(SECTION_PLATFORM, IDENT_EXIT_INSTRUCTION,
VALUE_RET));
if valueStr = VALUE_RET then begin
platformExitInstruction.itemIndex := 0;
end else
if valueStr = VALUE_RETF then begin
platformExitInstruction.itemIndex := 1;
end else
if valueStr = VALUE_CALL then begin
platformExitInstruction.itemIndex := 2;
end;
valueInt := settings.readInt(SECTION_PLATFORM, IDENT_HEAP_SIZE, -1);
if valueInt >= 0 then begin
platformHeapSize.text := intToString(valueInt);
end else begin
platformHeapSize.text := '';
end;
valueInt := settings.readInt(SECTION_PLATFORM, IDENT_STACK_SIZE, -1);
if valueInt >= 0 then begin
platformStackSize.text := intToString(valueInt);
end else begin
platformStackSize.text := '';
end;
destinationFileName.text := settings.readString(SECTION_DESTINATION, IDENT_FILE_NAME, '');
fasmAlsoBuild.checked := settings.readBoolean(SECTION_FASM, IDENT_USE, false);
fasmExePath.text := settings.readString(SECTION_FASM, IDENT_PATH, '');
fasmDestination.text := settings.readString(SECTION_FASM, IDENT_FILE_NAME, '');
fasmAlsoBuildClick(fasmAlsoBuild);
finally
settings.free();
end;
end;
procedure TMainForm.wmCompileBegin(var msg: TLMessage);
begin
saveProject.setFocus();
with buildProject do begin
caption := msgWait;
enabled := false;
end;
end;
procedure TMainForm.wmCompileEnd(var msg: TLMessage);
begin
with buildProject do begin
caption := msgCompile;
enabled := true;
end;
end;
procedure TMainForm.wmCompileError(var msg: TLMessage);
begin
with buildProject do begin
caption := msgCompile;
enabled := true;
end;
if length(errorSource) > 0 then begin
openDialog(msgError, errorInfo +
LINE_ENDING + msgSource + errorSource +
LINE_ENDING + msgLine + intToString(errorLine) +
LINE_ENDING + msgChar + intToString(errorChar),
mtError, [mbClose]);
exit;
end;
openDialog(msgError, errorInfo, mtError, [mbClose]);
end;
function TMainForm.loadSourceFromStream(stream: Input): UnicodeString;
var
size: int;
content: byte_Array1d;
begin
size := int(stream.available());
content := byte_Array1d_create(size);
stream.read(content, 0, size);
result := stringToUTF16(String_create(content, 0, size));
end;
constructor TMainForm.create(theOwner: TComponent);
var
binaryFile: GenerationInfo;
begin
inherited create(theOwner);
binaryFile := CodeGenerationInfo.create(msgBinaryFile, TextGenerator);
self.generators16bit := GenerationInfo_Array1d(Interface_Array1d_create([
binaryFile,
CodeGenerationInfo.create(msg16bitDOS_COM,
TextGenerator_16bit_DOS_COM) as GenerationInfo
]));
self.generators32bit := GenerationInfo_Array1d(Interface_Array1d_create([
binaryFile,
CodeGenerationInfo.create(msg32bitGNULinux_ELF,
TextGenerator_32bit_GNULinux_ELF) as GenerationInfo,
CodeGenerationInfo.create(msg32bitWindows_GUI,
TextGenerator_32bit_Windows_GraphicApp) as GenerationInfo,
CodeGenerationInfo.create(msg32bitWindows_Console,
TextGenerator_32bit_Windows_ConsoleApp) as GenerationInfo,
CodeGenerationInfo.create(msg32bitKolibriOS_MENUET01,
TextGenerator_32bit_KolibriOS_MENUET01) as GenerationInfo
]));
self.generators64bit := GenerationInfo_Array1d(Interface_Array1d_create([
CodeGenerationInfo.create(msgBinaryFile,
TextGenerator64) as GenerationInfo,
CodeGenerationInfo.create(msg64bitGNULinux_ELF64,
TextGenerator_64bit_GNULinux_ELF) as GenerationInfo,
CodeGenerationInfo.create(msg64bitWindows_GUI,
TextGenerator_64bit_Windows_GraphicApp) as GenerationInfo,
CodeGenerationInfo.create(msg64bitWindows_Console,
TextGenerator_64bit_Windows_ConsoleApp) as GenerationInfo
]));
self.generatorsCurrent := self.generators64bit;
end;
procedure TMainForm.afterConstruction();
var
fileAsStream: Input;
fileAsObject: FileInputStream;
arguments: UnicodeString_Array1d;
begin
inherited afterConstruction();
arguments := stringParseCommandLine();
if length(arguments) <= 1 then begin
targetProcessorBitsChange(targetProcessorBits);
exit;
end;
fileAsObject := FileInputStream.create(arguments[1]);
if fileAsObject.hasOpenError() then begin
fileAsObject.free();
targetProcessorBitsChange(targetProcessorBits);
exit;
end;
fileAsStream := fileAsObject;
try
loadProjectFromStream(fileAsStream);
finally
fileAsStream.close();
end;
end;
procedure TMainForm.run();
var
i: int;
lim: int;
ext: int;
bits: int;
valueInt: int;
lexemes: Lexer;
generator: TextGenerator;
programme: BuilderOfTrees;
translator: BuilderOfTargetCode;
destAsObject: FileOutputStream;
destAsStream: Output;
sourceAsObject: FileInputStream;
sourceAsStream: Input;
sources: String_Array1d;
source: String;
begin
bits := translatorBits;
ext := translatorInstructionSet;
programme := TranslatorTreeBuilder.create(bits, ext);
try
try
sources := translatorSources;
lim := length(sources) - 1;
for i := 0 to lim do begin
source := sources[i];
sourceAsObject := FileInputStream.create(stringToUTF16(source));
if sourceAsObject.hasOpenError() then begin
sourceAsObject.free();
raise IOException.create(msgErrorLoadingSource + source);
end;
sourceAsStream := sourceAsObject;
try
lexemes := TranslatorLexer.create(stringToUTF16(source));
lexemes.split(false, loadSourceFromStream(sourceAsStream));
finally
sourceAsStream.close();
sourceAsStream := nil;
end;
programme.addLexer(lexemes);
end;
programme.buildNamespaces();
generator := translatorExecutableType.create();
try
valueInt := translatorHeapSize;
if generator.isNeedHeapSize() and (valueInt >= 0) then begin
generator.heapSize := valueInt;
end;
valueInt := translatorStackSize;
if generator.isNeedStackSize() and (valueInt >= 0) then begin
generator.stackSize := valueInt;
end;
if generator.isNeedExitMethod() then begin
generator.exitMethod := translatorExitInstruction;
end;
case bits of
TranslatorType.SIZE_16_BIT:
translator := TranslatorBuilderOf16bitCode.create(generator, false);
TranslatorType.SIZE_32_BIT:
translator := TranslatorBuilderOf32bitCode.create(generator, false);
else
translator := TranslatorBuilderOf64bitCode.create(ext,
generator as TextGenerator64, false);
end;
try
destAsObject := FileOutputStream.create(
stringToUTF16(translatorDestination), false);
if destAsObject.hasOpenError() then begin
destAsObject.free();
raise IOException.create(msgErrorSavingDestination);
end;
destAsStream := destAsObject;
try
translator.buildTargetCode(programme, destAsStream);
finally
destAsStream.close();
destAsStream := nil;
end;
finally
translator := nil;
end;
finally
generator.free();
end;
finally
programme.clear();
programme := nil;
end;
except
on e: TranIntf.CompileError do begin
errorInfo := e.message;
errorSource := stringToUTF8(e.sourceName);
errorLine := e.sourceLine;
errorChar := e.sourceChar;
sendMessage(handle, LM_COMPILE_ERROR, 0, 0);
exit;
end;
on e: SysUtils.Exception do begin
errorInfo := e.message;
errorSource := '';
errorLine := 0;
errorChar := 0;
sendMessage(handle, LM_COMPILE_ERROR, 0, 0);
exit;
end;
end;
sendMessage(handle, LM_COMPILE_END, 0, 0);
if translatorUseFasm and (length(translatorFasmPath) > 0) and
(length(translatorExecutable) > 0) then begin
runFasm();
end;
end;
function TMainForm.openDialog(dialog: TForm): int;
var
capture: int;
begin
if dialog = nil then begin
raise NullPointerException.create(msgOpenDialogFormIsNull);
end;
if openedDialog <> nil then begin
raise EInvalidOperation.create(msgOpenDialogAlreadyOpened);
end;
if self.enabled = false then begin
raise EInvalidOperation.create(msgOpenDialogDisabled);
end;
if dialog.visible = true then begin
raise EInvalidOperation.create(msgOpenDialogFormAlreadyOpened);
end;
if dialog.enabled = false then begin
raise EInvalidOperation.create(msgOpenDialogFormDisabled);
end;
if dialog.formStyle = TFormStyle.fsMDIChild then begin
raise EInvalidOperation.create(msgOpenDialogFormMDIChild);
end;
dragManager.dragStop(false);
if activePopupMenu <> nil then begin
activePopupMenu.close();
end;
capture := getCapture();
if capture <> 0 then begin
sendMessage(capture, LM_CANCELMODE, 0, 0);
end;
releaseCapture();
result := 0;
openedDialog := dialog;
try
dialog.position := poDesigned;
dialog.left := Math.max(0, Math.min(left + ((self.width - dialog.width) div 2),
screen.desktopWidth - dialog.width));
dialog.top := Math.max(0, Math.min(top + ((self.height - dialog.height) div 2),
screen.desktopHeight - dialog.height));
dialog.modalResult := 0;
dialog.show();
dialog.bringToFront();
self.enabled := false;
try
repeat
try
widgetSet.appProcessMessages();
except
if application.captureExceptions then begin
application.handleException(self);
end else begin
raise;
end;
end;
if application.terminated then begin
dialog.modalResult := 0;
break;
end;
if dialog.modalResult <> 0 then begin
dialog.hide();
break;
end;
if dialog.visible = false then begin
break;
end;
application.idle(true);
until false;
result := dialog.modalResult;
if result = 0 then begin
result := mrClose;
end;
finally
self.enabled := true;
self.show();
end;
finally
openedDialog := nil;
end;
end;
function TMainForm.openDialog(const caption, text: String; dialogType: TMsgDlgType;
buttons: TMsgDlgButtons): int;
var
dialog: TForm;
begin
dialog := createMessageDialog(text, dialogType, buttons);
try
dialog.caption := caption;
result := openDialog(dialog);
finally
dialog.free();
end;
end;
class procedure TMainForm.createInstance();
begin
application.createForm(self, INSTANCE);
end;
{ CodeGenerationInfo }
constructor CodeGenerationInfo.create(const executableName: String;
generatorClass: TextGenerator_Class);
begin
inherited create();
self.executableName := executableName;
self.generatorClass := generatorClass;
end;
function CodeGenerationInfo.getExecutableName(): String;
begin
result := executableName;
end;
function CodeGenerationInfo.getGeneratorClass(): TextGenerator_Class;
begin
result := generatorClass;
end;
end.
