Skip to content

Instantly share code, notes, and snippets.

@MisterTimur

MisterTimur/UCCATR.PAS

Last active August 29, 2015 14:22
Show Gist options
  • Save MisterTimur/f83541d56594efc7eb3d to your computer and use it in GitHub Desktop.
Save MisterTimur/f83541d56594efc7eb3d to your computer and use it in GitHub Desktop.
Download ZIP
Cross-platform compiler ATR
Raw
UCCATR.PAS
unit UCCATR;
{Абдулов Тимур Рифович 2015
Кроссплатформенный компилятор широкого спектра применения
Abdulov Timur Rifovich 2015
Cross-platform compiler wide range of applications
Emails
wsd2000@mail.ru
hostingurifa@gmail.com
Site https://sites.google.com/site/timpascallib/ccatr/source
}
{$mode objfpc}{$H+}{$asmmode INTEL}{$DEFINE Tim}
interface
uses Dialogs,Classes,SysUtils;
{ Описание констант используемых в программе } {$IFDEF Tim}
const
MaxSizeMem=65535;// Максимально допустимый размер памяти в котрой формируеться программа
Zerno=32; // Максимальный размер зерна,строки,элемента особый тип типа Variable
Toch=3; // ТОчность вычислений количество знаков после запятой должно зависить от размера зерна
MaxKolLab=5000; // Максимальное количество меток в программе использыеться в JMP метка CALL метка
MaxSizeStek=120; // Максимальная глубина стека в процессе исполнения программы
// Коды типов компилируемых элементов
Ti_Ope=10; // Оператор в идеале состояит из букв и цифер но начинаться может тока с Буквы а так же может содержать знак подчеркивания и точку
Ti_Cif=20; // Цифра сотстояит из знаков и 1 точки
Ti_Zna=30; // Знак ОДинарный двойной например = + - / , := << !=
Ti_Kav=40; // В кавычках "" просто текст в кавычках сами кавычки не читаються
{$ENDIF}
{ Структуры используемые в программе } {$IFDEF Tim}
Type TLab =Class // Описание Метки
Nam:Ansistring;// Имя метки
cod:Ansistring;// Для какой команды нужен адрес
adr:Longword; // Адрес расположения (а если локальные переменные то смещение внутри стека)
end;
Type TLabs=Class // Хранилище Адресов локальных меток
Kol:LongWord; // Количество элментов в списке
Lab:array[1..maxKolLab] of TLab; // Масив с элементами
Function RA(s:String):LongWord; // Используеться для локальных переменнх адрес генерируеться пряма во время запроса вернее это даже не адрес а смещение относительно стека
Procedure Add(s,c:String;a:LongWord);// Добавляет в списко Имя метки S код для котрого предназначена метка С Например JMP или CALL и адрес A соотвественно
Procedure Del(f:Longword); // Удаляет из спика элемент номер F Lab[f]
Function Fin(s:String):TLab; // Ищит по имени
procedure Clear; // Очищает список
constructor Create; // Конструктор
end;
Type TEl =Class // Минимальный Структура исполнительного элемента для интепретатора
Tis:Byte; // Тип Текстового Элемента
Fun:Boolean; // Если это описание функции то есть содержит структуру описвающию функцию и параметры для её выполнения
Err:AnsiString;// Ошибка
Axt:AnsiString;// В верхнем регистре
Zna:AnsiString;// Значение
Tip:Ansistring;// Тип Переменной естествено если это переменная пока не используеться
COD:Ansistring;// Машинный код для исполнения комманды пока не используеться
Rod:Tel; // Родительский элемент
Pre:Tel; // Предыдущий эллемент
Nex:Tel; // Следующий элемент
Blo:Tel; // Первый вложеный елемент
Function Lst:TEl; // Возвращает Последний элемент в вложеном списке
Function Cop(iRod,iPre:Tel):Tel; // Создает копию элемента со всеми вложеными элментами
Function add(el:Tel):Tel; // Добавляет едемент в конец списка
Function addS(el:Tel):Tel; // добавляет еллемент в начало списка
Function add(s:AnsiString;t:Byte):Tel;// Добавляет едемент в конец списка
Procedure Cle; // Очищает эелемент
Procedure Del; // Удаляет эелемент вернее не удаляет а отсоеденяет от родителя и выдергивает окуратно из списка соотвествено соеденяя предыдущий элемент тс следующим
Constructor Create; // Конструктор элемента
end;
TYpe TProg=class // Обертка для интерпретации программы
CON:Ansistring; // Консоль исполнения
GEl:Tel; // Структура с программой созданая модулем UTEl
procedure TRRun(s:Ansistring);// Запуск текста программы на выполнение
procedure TRRun(el:Tel); // Запуск елемента на выполнение
procedure TRRunS(el:Tel); // Запуск структуры на выполнение
Procedure Clear;
Constructor Create;
procedure TRCON(iel:Tel);// ПРоцедура вывода в консоль
procedure TRSCO(iel:Tel);// ПРоцедура скобка
procedure TRWHI(iel:Tel);// Оператор White
procedure TRUSL(iel:Tel);// Оператор Условия
procedure TRUMN(iel:Tel);// Операция умножения
procedure TRDEL(iel:Tel);// Операция удаления
procedure TRPLU(iel:Tel);// Операция сложения
procedure TRMIN(iel:Tel);// Операция вычитания
procedure TRRAV(iel:Tel);// Операция Равно
procedure TRBOL(iel:Tel);// Операция Больше
procedure TRMEN(iel:Tel);// Операция Меньше
procedure TRNER(iel:Tel);// Операция НЕравно
procedure TRBRA(iel:Tel);// Операция Болдьше либо равно
procedure TRMRA(iel:Tel);// Операция Меньше либо равно
procedure TRIII(iel:Tel);// Операция И
procedure TRILI(iel:Tel);// Операция Или
procedure TRPRI(iel:Tel);// Операция присваивания
end;
{$ENDIF}
{ Описание переменных используемых в программе } {$IFDEF Tim}
Var
AddSp:Byte; // Шаг стека для 16 битных систем 2 соотвественно для 32 битных 4
TrCo:Byte = 0;// Модель компиляции
MSta:LongWord;// Адрес расположения программы Виртуальный адрес начала программы не пустать с адресом в масиве MEMO адрес в масиве MEMO это MSta=Memo[0] первый адрес в виртальной модели памяти для компиляции
MEnd:LongWord;// Конец Расположения программы Виртуальный Адрес Конца программы аналогично MSta
MUka:Longword;// Используеться при компиляции программы указатель на последнию записаную комманду
TextListCommand:Ansistring;// Сюда складываютсья названия комманд из процедуры GetTextListCommand для составления отчета по машинным кодам исключительно декоративная функция
{Адреса API функций и внтреней архитектуры памяти}{$IFDEF Tim}
API__FILE,// Адрес программы внутри файла используеться при формировании исполнительного файла
API__PROG,// Адрес программы в процессе выполнения то есть значение счетчика комманд в процессоре
API__PRIN,// Адрес печати адрес процедуры для реализации комманды PRINT
API__PAUS,// Адрес паузы то биш адрес функции ожидания нажатия любой клвишы
API__STEK,// Адрес Стека ну тут думаю все понятно
API__EXIT:// Адрес Завершения программы процедура завершения программы
LongWord;
{$ENDIF}
Memo:Array[0..MaxSizeMem] of Byte;// Виртуальная модель памяти для компилируемой программы
PMemo:Pointer;// Указатель на ячейку памяти Memo[0] ну виртуальную модель памяти
AdrMas:LongWord absolute PMemo;// ОТсюда получаем адрес массива
MaxIdEl,Uk,Le:Longint;// Uk Используетсья в встроеном интепретаторе для чтения текста програмым указывает на поледнию прочитаню букву при парсинге текста программы
{Структра элемента в процессе компиляции программы} {$IFDEF Tim}
EL_RES,// резерв
EL_TIS,// тип текстового элемента
EL_FUN,// Если это функция
EL_ERR,// Код ошибки
EL_AXT,// Текст операнда в верхнем регистре
EL_ZNA,// значение операнда
EL_SAM,// Указатель на самого себя
EL_ROD,// Родительский элемент
EL_PRE,// Предыдущий эллемент если есть если нету NIL 0
EL_NEX,// Следующий эллемент ксли нету NIL 0
EL_BLO // Цепочка вложеных елементов если есть ссылка на первый элемент цепочки вложеных елементов если нету 0 NIL
:Byte;
{$ENDIF}
{Адреса меток и функций в процессе компиляции программы}{$IFDEF Tim}
SLabs:TLabs;
RLabs:TLabs;
SFuns:TLabs;
RFuns:TLabs;
GPers:TLabs;
LPers:TLabs;
{$ENDIF}
win:Array[0..MaxSizeMem] of Byte; // Модель для Windows
{ Конец блока описания переменных используемых в программе }{$ENDIF}
{ Список комманд на Ассемблере } {$IFDEF Tim}
Function Sum(a,b:AnsiString):AnsiString;
//--------------------------------------------------------
procedure PUSH_EAX;procedure PUSH_ECX;procedure PUSH_EDX;procedure PUSH_ESI;
procedure POP__EAX;procedure POP__ECX;procedure POP__EDX;procedure POP__ESI;
//--------------------------------------------------------
procedure INC__EAX;procedure INC__ECX;procedure INC__EDX;procedure INC__ESI;
procedure DEC__EAX;procedure DEC__ECX;procedure DEC__EDX;procedure DEC__ESI;
//--------------------------------------------------------
procedure XOR__EAX;procedure XOR__ECX;procedure XOR__EDX;procedure XOR__ESI;
//--------------------------------------------------------
Procedure MOV__EAX(a:LongWord);// Заполнение регистров
Procedure MOV__ECX(a:LongWord);
Procedure MOV__EDX(a:LongWord);
procedure MOV__ESI(a:LongWord);
//--------------------------------
Procedure MOV__EAX_AW(a:LongWord);// Заполнение регистров из памяти
Procedure MOV__EAX_AB(a:LongWord);
Procedure MOV__ECX_AW(a:LongWord);
Procedure MOV__ECX_AB(a:LongWord);
Procedure MOV__EDX_AW(a:LongWord);
Procedure MOV__EDX_AB(a:LongWord);
//--------------------------------
Procedure Mov_A_EAXW(a:Longword);// Сохранение регистров в память
Procedure Mov_A_EAXB(a:Longword);
Procedure MOV_A_ECXW(a:Longword);
Procedure MOV_A_ECXB(a:Longword);
Procedure Mov_A_EDXW(a:Longword);
Procedure Mov_A_EDXB(a:Longword);
//--------------------------------
Procedure Mov_AEAX_W(a:Longword);// Запись в память по адресу в регистре
Procedure Mov_AEAX_B(a:Byte);
Procedure Mov_AECX_W(a:Longword);
Procedure Mov_AECX_B(a:Byte);
Procedure Mov_AEDX_W(a:Longword);
Procedure Mov_AEDX_B(a:Byte);
//--------------------------------------------------------
procedure CMP__EAX_EDX; // Условые переходы подпрограммы
procedure JA___(a:String);
procedure JAE__(a:String);
procedure JE___(a:String);
procedure JNE__(a:String);
procedure JB___(a:String);
procedure JBE__(a:String);
Procedure JMP__(s:String);
Procedure RET__;
Procedure CAL__(s:String);
Procedure CAL__(s:LongWord);
//--------------------------------------------------------
// Арифметика
Procedure SUB__ESP(a:LongWord);// Уменьшает стек
Procedure ADD__ESP(a:LongWord);// Увеличивает стек
procedure SUB__EAX_EDX;
procedure SUB__EAX_ECX;
procedure ADD__EAX_EDX;
procedure ADD__ESI(B:LongWord);
procedure ADD__EAX_ESP;
//--------------------------------------------------------
procedure MOV__EAX_AESI;
procedure MOV__ECX_AESI;
procedure MOV__EDX_AESI;
//--------------------------------------------------------
procedure MOV_AESI_EAX;
procedure MOV_AESI_ECX;
procedure MOV_AESI_EDX;
procedure MOV_AESI_AL;
procedure MOV_AESI_CL;
procedure MOV_AESI_DL;
procedure MOV_AESI_W(a:Longword);
procedure MOV_AESI_B(a:Byte);
//--------------------------------------------------------
procedure MOV__ESP_EAX;
procedure MOV__ESI_ESP;
procedure MOV__ESI_EAX;
procedure MOV__ESI_EDX;
Procedure MOV__EDX_EAX;
procedure Mov__EAX_AEAX;
procedure Mov__EDX_AEDX;
procedure MOV_AEAX_EDX;
procedure MOV_AEAX_DL ;
procedure Mov__AL_DL;
procedure Mov__AL_Dh;
procedure Mov__AH(A:Byte);
procedure Mov__CH(A:Byte);
procedure Mov__DH(A:Byte);
procedure Mov__BL(A:Byte);
{$ENDIF}
Procedure Compiler(s,nf:Ansistring);// ПРоцедура компиляции программы
Function DelRAs(s:Ansistring):Ansistring;
implementation
{ Секция для работы с памятью } {$IFDEF Tim}
procedure InfoMes(s:Ansistring);
begin
ShowMessage(s);
end;
Function IntToHex32(i:LongWord) :String; // Преобразует число в шеснадцеричную последовательность раставляя шеснадцеричные пары в машинном порядке сперва младшии байты
var
s:String;
begin
s:=intToHex(i,8);
IntToHex32:=s[7]+s[8]+s[5]+s[6]+s[3]+s[4]+s[1]+s[2];
end;
Function IntToHex16(i:LongWord) :String; // Преобразует число в шеснадцеричную последовательность раставляя шеснадцеричные пары в машинном порядке сперва младшии байты
var
s:String;
begin
If i>=65536 Then InfoMes('IntToHex16 Число не являеться 2 батовым ');
s:=intToHex(i,4);
IntToHex16:=s[3]+s[4]+s[1]+s[2];
end;
Function IntToHex16L(i:LongWord):String; // Выделяет младший байт из 2 байтовой пары
var
s:String;
begin
If i>=65536 Then InfoMes('IntToHex16L Число не являеться 2 батовым ');
s:=intToHex(i,4);
IntToHex16L:=s[3]+s[4];
end;
Function IntToHex16H(i:LongWord):String; // Выделяет сарший байт из 2 батовой пары
var
s:String;
begin
If i>=65536 Then InfoMes('IntToHex16H Число не являеться 2 батовым');
s:=intToHex(i,4);
IntToHex16H:=s[1]+s[2];
end;
Function IntToHex8 (i:LongWord):String; // Возвращает однобатовое значение в шеснадцеричной системе считсления
var
s:String;
begin
If i>=256 Then InfoMes('IntToHex8 Число не помещаеться в 1 байт ');
s:=intToHex(i,2);
IntToHex8:=s;
end;
Function HexToInt(Str : string):LongWord; // Переводит из 16 в десятичную систему
var i, r : integer;
begin
if Length(Str)>8 then InfoMes('HexToInt Число не являеться 32 битным ');
if Length(Str)=8 then InfoMes('HexToInt Число не являеться 32 битным пустая строка ');
val('$'+Trim(Str),r, i);
if i<>0 then InfoMes(('HexToInt Не верное число str'));
HexToInt := r;
end;
Procedure WrMwm(s:String); // ЗАписывает шеснадцетиричный набор в память
var
f:Longint;
begin
f:=1;
if (length(s)<=0) or (length(s)/2<>Trunc(length(s)/2)) then InfoMes(('WrMwm Не верное шеснадцеричное значение'));
While f<=length(s) do
begin
If Muka-MSta>MaxSizeMem Then InfoMes('WrMwm Память для записи програмым переполнена ');
memo[Muka-MSta]:=HexToInt(s[f]+s[f+1]);
Muka:=Muka+1;
f:=f+2;
end;
end;
Procedure WrMwc8(i:byte); // ЗАписывает Байт в память
begin
WrMwm(IntToHex8(i));
end;
Procedure WrMw16(i:Word); // ЗАписывает Слово в память
begin
WrMwm(IntToHex16(i));
end;
Procedure WrMw16L(i:Word); // ЗАписывает Слово в память
begin
WrMwm(IntToHex16l(i));
end;
Procedure WrMw16H(i:Word); // ЗАписывает Слово в память
begin
WrMwm(IntToHex16h(i));
end;
Procedure WrMw32(i:LongWord); // ЗАписывает Двойное слово в память
begin
WrMwm(IntToHex32(i));
end;
Function TrRD(a:LongWord):LongWord; // Читает двойное слово из памяти
var
rez:LongWord;
begin
if (a-MSta>MaxSizemem) Then InfoMes(' TrRD Выход за пределы виртуальной памяти модели программы ');
a:=a-MSta+AdrMas;
asm
mov eax,a;
mov eax,[eax];
mov rez,eax;
end;
TrRd:=rez;
end;
Function TrRW(a:LongWord):Word; // Читает слово из памяти
var
rez:word;
begin
if (a-MSta>MaxSizemem) Then InfoMes(' TrRW Выход за пределы виртуальной памяти модели программы ');
a:=a-MSta+AdrMas;
asm
mov eax,a;
mov ax,[eax];
mov rez,ax;
end;
TrRw:=rez;
end;
Function TrRB(a:LongWord):Byte; // Читает байт из памяти
var
rez:byte;
begin
if (a-MSta>MaxSizemem) Then InfoMes(' TrRB Выход за пределы виртуальной памяти модели программы ');
a:=a-MSta+AdrMas;
asm
mov eax,a;
mov al,byte [eax];
mov rez,al;
end;
TrRb:=rez;
end;
procedure TrW6(a,b:Int64);// Не доработано // Записывает двойное слово в память
begin
if (a-MSta>MaxSizemem) Then InfoMes(' TrW6 Выход за пределы виртуальной памяти модели программы ');
a:=a-MSta+AdrMas;
asm
mov eax,a;
mov edx,b;
mov [eax],edx;
end;
end;
procedure TrWD(a,b:LongWord); // Записывает двойное слово в память
begin
if (a-MSta>MaxSizemem) Then InfoMes(' TrWD Выход за пределы виртуальной памяти модели программы ');
a:=a-MSta+AdrMas;
asm
mov eax,a;
mov edx,b;
mov [eax],edx;
end;
end;
procedure TrWW(a:LongWord;b:word); // Записывает слово в память
begin
if (a-MSta>MaxSizemem) Then InfoMes(' TrWW Выход за пределы виртуальной памяти модели программы ');
a:=a-MSta+AdrMas;
asm
mov eax,a;
mov dx,b;
mov [eax],dx;
end;
end;
procedure TrWB(a:LongWord;b:byte); // Записывает байт в память
begin
if (a-MSta>MaxSizemem) Then InfoMes(' TrWB Выход за пределы виртуальной памяти модели программы ');
a:=a-MSta+AdrMas;
asm
mov eax,a;
mov dl,b;
mov [eax],dl;
end;
end;
function PointerToAdr(p:pointer):Longword;// Переводит указатель в адрес
var
a:LongWord absolute p;
begin
PointerToAdr:=a;
end;
Function ReCif(A:LongWord):LongWord; // Читает Цифру по адресу из памяти В установленом режиме
var
rez:LongWord;
begin
if TrCo=80 Then rez:=TrRW(a) else // Для Z80 Spectrum
if TrCo=16 Then rez:=TrRW(a) else // ДЛя DOS
if TrCo=17 Then rez:=TrRW(a) else // для ISO
if TrCo=32 Then rez:=TrRD(a) else // Для Windows
if TrCo=33 Then rez:=TrRD(a) else // Для Колибри
if TrCo=34 Then rez:=TrRD(a) else // Для Linux
InfoMes(('ReCif Разрядность не поддерживаетья'));
ReCif:=rez;
end;
Procedure WrCif(A,Z:LongWord); // Записывает Цифру по адресу в память В установленом режиме
begin
if TrCo=80 Then TrWW(a,z) else
if TrCo=16 Then TrWW(a,z) else
if TrCo=17 Then TrWW(a,z) else
if TrCo=32 Then TrWD(a,z) else
if TrCo=33 Then TrWD(a,z) else
if TrCo=34 Then TrWD(a,z) else
InfoMes(('WrCif Разрядность не поддерживаетья'));
end;
Function RZna(s:String):LongWord; // Читает Переменную по имени из памяти В Установленом режиме
var
p:TLab;
Rez:Longword;
begin
p:=GPers.Fin(s);
if p<>nil
then rez:=ReCif(p.adr)
else begin InfoMes(('Такой переменной ещё не создано '+S));halt;end;
RZna:=rez;
end;
Procedure WZna(s:String;z:LongWord); // Записывает Переменную по имени в память В Установленом режиме
var
p:TLab;
Rez:Longword;
begin
p:=GPers.Fin(s);
if p<>nil
then WrCif(p.adr,z)
else begin InfoMes(('Такой переменной ещё не создано '+S));halt;end;
end;
Procedure WrMwc(i:LongWord); // ЗАписывает число в память при компиляции согластно режиму
begin
if TrCo=80 Then WrMwm(IntToHex16(i)) else
if TrCo=16 Then WrMwm(IntToHex16(i)) else
if TrCo=17 Then WrMwm(IntToHex16(i)) else
if TrCo=32 Then WrMwm(IntToHex32(i)) else
if TrCo=33 Then WrMwm(IntToHex32(i)) else
if TrCo=34 Then WrMwm(IntToHex32(i)) else
InfoMes(('Разрядность не поддерживаетья'));
end;
Procedure WrMwS(i:String); // ЗАписывает Текстовые символы в память при компиляции согластно режиму
var
f:Longint;
begin
for f:=1 to length(i) do
WrMwm(IntToHex8(Ord(i[f])));
WrMwc8(0);
end;
Procedure WrMwO(i:String); // ЗАписывает Текстовые символы в память при компиляции согластно режиму
var
f:Longint;
begin
for f:=1 to length(i) do
WrMwm(IntToHex8(Ord(i[f])));
end;
function Tr_Ls(a:LongWord):byte; // Читает длину строки по заданому адресу
begin
Tr_ls:=TrRB(a);
end;
function Tr_Rs(a:LongWord):String; // Читает строку по заданому адресу
var
rez:AnsiString;
f:LongWord;
l:Longint;
begin
rez:='';
if (a<MSta) or (a>MEnd) then rez:='NIL' else
begin
l:=Tr_Ls(a);
for f:=a+1 to a+l do
rez:=rez+Chr(TrRb(f));
end;
Tr_Rs:=rez;
end;
procedure Tr_Ws(a:LongWord;S:Ansistring); // Записывает строку по определенному адресу
var
f:LongWord;
begin
TrWB(a-1,1);
TrWB(a,length(s));
for f:=1 to Zerno do
TrWB(a+f,0);
for f:=1 to length(s) do
TrWB(a+f,Ord(s[f]));
end;
type TMODELFILE=array[0..MaxSizeMem] of Byte;
Function FindAdres(s:Ansistring;MF:TMODELFILE):LongWord;
var
f,f2,rez:LongWord;
begin
rez:=0;f2:=1;
for f:=0 to MaxSizeMem Do
begin
if mf[f]=ord(s[f2]) Then Inc(f2) else
begin
f2:=1;
if mf[f]=ord(s[f2]) Then Inc(f2) ;
end;
if f2>Length(s) Then
begin
REz:=f+1;
Break;
end;
end;
if REz=0 then InfoMes('UMEM FindAdres НЕ Найдена точка '+s);
FindAdres:=rez;
end;
Procedure ReadPeremensFromFile(s:Ansistring);
var
M:TMODELFILE;
MF:File Of TMODELFILE;
f:Longint;
begin
AssignFile(Mf,s);
reset(mf);
REad(Mf,M);
CloseFile(mf);
for f:=0 to MaxSizeMem do
win[f]:=m[f];
API__FILE:=FindAdres('API__PROG',m);//552
if Trco=32 Then
begin
API__STEK:=MSta+FindAdres('API__STEK',m)-API__FILE;//4262832
API__PRIN:=MSta+FindAdres('API__PRIN',m)-API__FILE;
API__EXIT:=MSta+FindAdres('API__EXIT',m)-API__FILE;
API__PAUS:=MSta+FindAdres('API__PAUS',m)-API__FILE;
API__PROG:=MSta+FindAdres('API__PROG',m)-API__FILE;//4262832
end else
if Trco=33 Then
begin
API__STEK:=MSta+FindAdres('API__STEK',m)-API__FILE;//4262832
API__PRIN:=MSta+FindAdres('API__PRIN',m)-API__FILE;
API__EXIT:=MSta+FindAdres('API__EXIT',m)-API__FILE;
API__PAUS:=MSta+FindAdres('API__PAUS',m)-API__FILE;
API__PROG:=MSta+FindAdres('API__PROG',m)-API__FILE;//4262832
end else
if Trco=34 Then
begin
API__STEK:=MSta+FindAdres('API__STEK',m)-API__FILE;//4262832
API__PRIN:=MSta+FindAdres('API__PRIN',m)-API__FILE;
API__EXIT:=MSta+FindAdres('API__EXIT',m)-API__FILE;
API__PAUS:=MSta+FindAdres('API__PAUS',m)-API__FILE;
API__PROG:=MSta+FindAdres('API__PROG',m)-API__FILE;//4262832
end else
InfoMes('UMEM ReadPeremensFromFile НЕ пропсиано как читать координаты ');
end;
{$ENDIF}
{ Процедуры для работы с метками } {$IFDEF Tim}
Procedure SetZnaPer(p:string;i:Longword);
var
Z:TLAb;
begin
Z:=GPers.Fin(p); // Если можно
if z<>nil then WrCif(Z.adr,i) else
InfoMes(('SetPer Переменная не найдена '+p));
end;
Procedure SetLocalLabels;
var
f:Longint;
NF:TLab;
begin
f:=1;
While f<=RLabs.Kol do // Смотрим что можно заполнить
begin
nf:=SLabs.Fin(RLabs.lab[f].Nam); // Если можно
if nf<>Nil then
begin // заполняем
if (RLabs.lab[f].Cod='JMP__') or
(RLabs.lab[f].Cod='JE___') or
(RLabs.lab[f].Cod='JNE__') or
(RLabs.lab[f].Cod='JA___') or
(RLabs.lab[f].Cod='JAE__') or
(RLabs.lab[f].Cod='JB___') or
(RLabs.lab[f].Cod='JBE__') then
begin
If TrCo=80 then TrWW(RLabs.Lab[f].adr,nf.adr) else
If TrCo=16 then TrWW(RLabs.Lab[f].adr,nf.adr-RLabs.lab[f].adr-2) else
If TrCo=17 then TrWW(RLabs.Lab[f].adr,nf.adr-RLabs.lab[f].adr-2) else
If TrCo=32 then TrWD(RLabs.Lab[f].adr,nf.adr-RLabs.lab[f].adr-4) else
If TrCo=33 then TrWD(RLabs.Lab[f].adr,nf.adr-RLabs.lab[f].adr-4) else
If TrCo=34 then TrWD(RLabs.Lab[f].adr,nf.adr-RLabs.lab[f].adr-4) else
If TrCo=64 then TrW6(RLabs.Lab[f].adr,nf.adr-RLabs.lab[f].adr-8) else
InfoMes(('ULABS.Sets для данной платфорсы нет комманда перехода '+RLabs.lab[f].cod));
end else
InfoMes(('ULABS.Sets Неизветная комманда перехода '+RLabs.lab[f].cod));
RLabs.del(f) //Удаляем запись
end else f:=f+1;
end;
if Rlabs.Kol<>0 Then
begin
InfoMes(('Не все адрена переходов заполнены'));
for f:=1 to RLAbs.Kol Do
InfoMes(RLAbs.Lab[f].Nam);
end;
Slabs.Clear;// Очищаем локальные метки повторно
Rlabs.Clear;// Очищаем локальные метки повторно
end;
Procedure SetFunctions;
var
f:Longint;
NF:TLab;
begin
f:=1;
While f<=RFuns.Kol do // Смотрим что можно заполнить
begin
nf:=SFuns.Fin(RFuns.lab[f].Nam); // Если можно
if nf<>Nil then
begin // заполняем
if RFuns.lab[f].Cod='CAL__' then
If TrCo=80 then TrWW(RFuns.Lab[f].adr,nf.adr) else
If TrCo=16 then TrWW(RFuns.Lab[f].adr,nf.adr-RFuns.lab[f].adr-2) else
If TrCo=17 then TrWW(RFuns.Lab[f].adr,nf.adr-RFuns.lab[f].adr-2) else
If TrCo=32 then TrWD(RFuns.Lab[f].adr,nf.adr-RFuns.lab[f].adr-4) else
If TrCo=33 then TrWD(RFuns.Lab[f].adr,nf.adr-RFuns.lab[f].adr-4) else
If TrCo=34 then TrWD(RFuns.Lab[f].adr,nf.adr-RFuns.lab[f].adr-4) else
If TrCo=64 then TrW6(RFuns.Lab[f].adr,nf.adr-RFuns.lab[f].adr-8) else
InfoMes(('UFunS.Sets Неизветная комманда перехода '+RFuns.lab[f].cod));
RFuns.del(f) //Удаляем запись
end else f:=f+1;
end;
if RFuns.Kol<>0 Then
begin
InfoMes(('Call Не все адрена переходов заполнены'));
for f:=1 to RFuns.Kol Do
InfoMes(RFuns.Lab[f].Nam);
end;
SFuns.Clear;// Очищаем локальные метки повторно
RFuns.Clear;// Очищаем локальные метки повторно
end;
//==============================================
Function TLabs.Fin(s:String):TLab;
var
f:LongWord;
rez:TLab;
begin
rez:=nil;
s:=AnsiUpperCase(s);
for f:=1 to Kol do
if s=Lab[f].nam Then rez:=Lab[f];
Fin:=Rez;
end;
Procedure TLabs.Add(s,c:String;a:LongWord);
begin
KOl:=KOl+1;
if KOl>maxKolLab Then InfoMes(('ULABS TLabs.Add Превышено количество меток '+s));
Lab[kol]:=TLab.Create;
Lab[kol].Nam:=AnsiUpperCase(s);
Lab[KOl].Adr:=a;
Lab[KOl].COD:=AnsiUpperCase(c);
end;
Procedure TLabs.Clear;
var
f:LongWord;
begin
for f:=1 to KOl do
LAb[f].Free;
kol:=0;
end;
Procedure TLabs.Del(f:Longword);
var
f2:LongWord;
begin
Lab[f].free;
for f2:=f to KOl-1 do
Lab[f2]:=Lab[f2+1];
kol:=kol-1;
end;
Function TLabs.RA(s:String):LongWord;
var
Lper:TLAb;
rez:LongWord;
begin
LPer:=Fin(s);
if Lper=nil then
begin
if TrCo=80 then rez:=kol*2+2 else
if TrCo=16 then rez:=kol*2+2 else
if TrCo=17 then rez:=kol*2+2 else
if TrCo=32 then rez:=kol*4+4 else
if TrCo=33 then rez:=kol*4+4 else
if TrCo=34 then rez:=kol*4+4 else
if TrCo=64 then rez:=kol*8+8 else
InfoMes(('TLabs.RA Стек на данной платформе не прописан '));
if REz>MaxSizeStek Then InfoMes(('Размер стека локальных переменных привышен '));
add(s,'',rez);
end else rez:=Lper.adr;
RA:=REz;
end;
constructor TLabs.Create;
begin
kol:=0;
end;
//==============================================
Procedure SePe(s:String);
begin
if GPers.FIN(s)<>NIL Then InfoMes(('Дублируються Переменные '+s));
GPers.add(s,'Peremens',Muka);
end;
Procedure ReFu(s,c:String);
begin
RFuns.add(s,c,Muka);
end;
Procedure SeFu(s:String);
begin
if SFuns.FIN(s)<>NIL Then InfoMes(('Дублируються Функции'+s));
SFuns.add(s,'Function',Muka);
end;
Procedure ReLa(s,c:String);// Запоминаем место куда нада установить адрес
begin
RLAbs.add(s,c,Muka);
end;
Procedure SeLa(s:String); // Создаем локальную метку
begin
if SLAbs.FIN(s)<>NIL Then InfoMes(('Дублируються метки'+s));
SLAbs.add(s,'LABEL',Muka);
end;
Function AdrFun(s:Ansistring):LongWord;
var
rez:TLab;
begin
s:=ansiUpperCase(s);
rez:=SFuns.Fin(s);
if Rez=Nil Then begin InfoMes(('ULABS.AdrFun Функция не обьявлена '+S));halt;end;
AdrFun:=Rez.adr;
end;
Function AdrPer(s:Ansistring):LongWord;
var
rez:TLab;
begin
s:=ansiUpperCase(s);
Rez:=GPers.Fin(s);
if Rez=Nil Then begin
InfoMes(('AdrPer Переменная не обьявлена '+S));halt;end;
AdrPer:=Rez.adr;
end;
Function AdrLab(s:Ansistring):LongWord;
var
rez:TLab;
begin
s:=ansiUpperCase(s);
Rez:=SLAbs.Fin(s);
if Rez=Nil Then begin InfoMes(('UASM.AdrLab Метка не обьявлена '+S));halt;end;
AdrLab:=Rez.adr;
end;
Procedure BeginProcedure(s:String);
begin
SFuns.add(s,'Procedure',Muka);// Записываем адрес процедуры
SUB__ESP(MaxSizeStek); // Выделяем место для локальных переменных
end;
Procedure EndProcedure;
begin
SetLocalLabels; // Растовляем переходы
LPers.clear; // Очищаем локальные переменные
ADD__ESP(MaxSizeStek);
RET__;
end;
{$ENDIF}
{ Секция описания комманд на ассемблере } {$IFDEF Tim}
Function PLATFORMA :Longint; // Платформа исполения
begin
PLATFORMA:=TrCo;
// Функция Возращающая номер платформы для котрой производиться компиляция;
end;
// Это использыеться для коментариев описания мнемоник и просто для понятности кода
Procedure WriteCros (s:AnsiString); // Записывает Название комманды
begin
// ПРоцедура описывающая мнемонику колмманды кросс ассемблера
TextListCommand:=TextListCommand+'<BR><TABLE BgColor="White"><tr><td><B>'+s+'</B></td>';
end;
Procedure EndCros;
begin
// ПРоцедура в конце формирования комманды в машинных кодах
TextListCommand:=TextListCommand+'</tr></TABLE><br>'+Chr(13)+chr(10);
end;
Procedure WriteNAME (s:AnsiString); // Записывает Название комманды
begin
// ПРоцедура описывающая мнемонику на родном для платформы ассемблеере
TextListCommand:=TextListCommand+'<td BgColor="Linen">'+s+'</td>';
end;
Procedure WriteREMM (s:AnsiString); // Записывает Коментарии
begin
// Различные комментарии
TextListCommand:=TextListCommand+'<BR>'+s+Chr(9);
end;
// ПРоцедуры для записи в масив виртуальной модели памяти программы
Procedure WriteHEXX (s:AnsiString); // Записывает последовательность байтов в HEX
begin
TextListCommand:=TextListCommand+'<td BgColor="NavajoWhite">'+s+'</td>';
WrMwm(s);
end;
Procedure WriteByte (s:Byte); // Записывает Число Byte
begin
TextListCommand:=TextListCommand+'<td BgColor="Cornsilk"> Byte</td> ';
WrMwc8(s);
end;
Procedure WriteWord (s:Word); // Записывает Число WORD
begin
TextListCommand:=TextListCommand+'<td BgColor="Ivory"> WORD </td> ';
WrMw16(s);
end;
Procedure WriteLong (s:LongWord); // Записывает Число LongWord 32 Бита
begin
TextListCommand:=TextListCommand+'<td BgColor="LemonChiffon"> DWORD </td> ';
WrMw32(s);
end;
Function WriteWorL (a:LongWord):Byte; // Записывает младший разряд 2 батового числа
begin
TextListCommand:=TextListCommand+'<td BgColor="Seashell"> LByte </td> ';
WrMw16L(a);
end;
Function WriteWorH (a:LongWord):Byte; // Записывает Страший разряд 2 батового числа
begin
TextListCommand:=TextListCommand+'<td BgColor="Honeydew"> HByte </td> ';
WrMw16H(a);
end;
// Используеться для растановки меток и адресов переменных
Function AdrPereme (s:Ansistring):LongWord;// Возвращает адрес переменной
begin
AdrPereme:=AdrPer(s);
end;
Procedure ReadLabel (a,b:Ansistring); // Записывает адрес где нада прописать адрес метки
begin
ReLa(a,b);
end;
Procedure ReadFunct (a,b:Ansistring); // Записывает адрес где нада прописать адрес метки
begin
ReFu(a,b);
end;
//------------------------------------------------------------------------------
procedure PUSH_EAX;
begin
WriteCros('PUSH_EAX');
if PLATFORMA=80 then begin WriteNAME('PUSH HL') ;WriteHexx('E5') end else
if PLATFORMA=16 then begin WriteNAME('PUSH AX') ;WriteHexx('50') end else
if PLATFORMA=17 then begin WriteNAME('PUSH AX') ;WriteHexx('50') end else
if PLATFORMA=32 then begin WriteNAME('PUSH EAX');WriteHexx('50') end else
if PLATFORMA=33 then begin WriteNAME('PUSH EAX');WriteHexx('50') end else
if PLATFORMA=34 then begin WriteNAME('PUSH EAX');WriteHexx('50') end else
InfoMes( ('Комманда PUSH_EAX для платформы не описана '));
EndCros;
end;
procedure PUSH_ECX;
begin
WriteCros('PUSH_ECX');
if PLATFORMA=80 then begin WriteNAME('PUSH BC');WriteHexx('C5') end else
if PLATFORMA=16 then Begin WriteNAME('PUSH CX');WriteHexx('51') end else
if PLATFORMA=17 then Begin WriteNAME('PUSH CX');WriteHexx('51') end else
if PLATFORMA=32 then Begin WriteNAME('PUSH ECX');WriteHexx('51') end else
if PLATFORMA=33 then Begin WriteNAME('PUSH ECX');WriteHexx('51') end else
if PLATFORMA=34 then Begin WriteNAME('PUSH ECX');WriteHexx('51') end else
InfoMes(('Комманда PUSH_ECX для платформы не описана '));
EndCros;
end;
procedure PUSH_EDX;
begin
WriteCros('PUSH_EDX');
if PLATFORMA=80 then begin WriteNAME('PUSH DE');WriteHexx('D5') end else
if PLATFORMA=16 then begin WriteNAME('PUSH DX');WriteHexx('52') end else
if PLATFORMA=17 then begin WriteNAME('PUSH DX');WriteHexx('52') end else
if PLATFORMA=32 then begin WriteNAME('PUSH EDX');WriteHexx('52') end else
if PLATFORMA=33 then begin WriteNAME('PUSH EDX');WriteHexx('52') end else
if PLATFORMA=34 then begin WriteNAME('PUSH EDX');WriteHexx('52') end else
InfoMes(('Комманда PUSH_EDX для платформы не описана '));
EndCros;
end;
procedure PUSH_ESI;
begin
WriteCros('PUSH_ESI');
if PLATFORMA=80 then begin WriteNAME('PUSH IY');WriteHexx('FDE5') end else
if PLATFORMA=16 then begin WriteNAME('PUSH SI');WriteHexx('56') end else
if PLATFORMA=17 then begin WriteNAME('PUSH SI');WriteHexx('56') end else
if PLATFORMA=32 then begin WriteNAME('PUSH ESI');WriteHexx('56') end else
if PLATFORMA=33 then begin WriteNAME('PUSH ESI');WriteHexx('56') end else
if PLATFORMA=34 then begin WriteNAME('PUSH ESI');WriteHexx('56') end else
InfoMes(('Комманда PUSH_EDX для платформы не описана '));
EndCros;
end;
procedure POP__EAX;
begin
WriteCros('POP__EAX');
if PLATFORMA=80 then begin WriteNAME('POP HL');WriteHexx('E1') end else
if PLATFORMA=16 then begin WriteNAME('POP AX');WriteHexx('58') end else
if PLATFORMA=17 then begin WriteNAME('POP AX');WriteHexx('58') end else
if PLATFORMA=32 then begin WriteNAME('POP EAX');WriteHexx('58') end else
if PLATFORMA=33 then begin WriteNAME('POP EAX');WriteHexx('58') end else
if PLATFORMA=34 then begin WriteNAME('POP EAX');WriteHexx('58') end else
InfoMes(('Комманда POP_EAX для платформы не описана '));
EndCros;
end;
procedure POP__ECX;
begin
WriteCros('POP__ECX');
if PLATFORMA=80 then begin WriteNAME('POP BC');WriteHexx('C1') end else
if PLATFORMA=16 then begin WriteNAME('POP CX');WriteHexx('59') end else
if PLATFORMA=17 then begin WriteNAME('POP CX');WriteHexx('59') end else
if PLATFORMA=32 then begin WriteNAME('POP ECX');WriteHexx('59') end else
if PLATFORMA=33 then begin WriteNAME('POP ECX');WriteHexx('59') end else
if PLATFORMA=34 then begin WriteNAME('POP ECX');WriteHexx('59') end else
InfoMes(('Комманда POP_ECX для платформы не описана '));
EndCros;
end;
procedure POP__EDX;
begin
WriteCros('POP__EDX');
if PLATFORMA=80 then begin WriteNAME('POP DE');WriteHexx('D1') end else
if PLATFORMA=16 then begin WriteNAME('POP DX');WriteHexx('5A') end else
if PLATFORMA=17 then begin WriteNAME('POP DX');WriteHexx('5A') end else
if PLATFORMA=32 then begin WriteNAME('POP EDX');WriteHexx('5A') end else
if PLATFORMA=33 then begin WriteNAME('POP EDX');WriteHexx('5A') end else
if PLATFORMA=34 then begin WriteNAME('POP EDX');WriteHexx('5A') end else
InfoMes(('Комманда POP_EDX для платформы не описана '));
EndCros;
end;
procedure POP__ESI;
begin
WriteCros('POP__ESI');
if PLATFORMA=80 then begin WriteNAME('POP IY');WriteHexx('FDE1') end else
if PLATFORMA=16 then begin WriteNAME('POP SI');WriteHexx('5E') end else
if PLATFORMA=17 then begin WriteNAME('POP SI');WriteHexx('5E') end else
if PLATFORMA=32 then begin WriteNAME('POP ESI');WriteHexx('5E') end else
if PLATFORMA=33 then begin WriteNAME('POP ESI');WriteHexx('5E') end else
if PLATFORMA=34 then begin WriteNAME('POP ESI');WriteHexx('5E') end else
InfoMes(('Комманда POP__ESI для платформы не описана '));
EndCros;
end;
//-----------------------
procedure INC__EAX;
begin
WriteCros('INC__EAX');
if PLATFORMA=80 then begin WriteNAME('INC HL');WriteHexx('23') End else // INC HL
if PLATFORMA=16 then begin WriteNAME('INC AX');WriteHexx('40') End else
if PLATFORMA=17 then begin WriteNAME('INC AX');WriteHexx('40') End else
if PLATFORMA=32 then begin WriteNAME('INC EAX');WriteHexx('40') End else
if PLATFORMA=33 then begin WriteNAME('INC EAX');WriteHexx('40') End else
if PLATFORMA=34 then begin WriteNAME('INC EAX');WriteHexx('40') End else
InfoMes(('Комманда INC__EAX для платформы не описана '));
EndCros;
end;
procedure INC__ECX;
begin
WriteCros('INC__ECX');
if PLATFORMA=80 then begin WriteNAME('INC BC');WriteHexx('03') End else
if PLATFORMA=16 then begin WriteNAME('INC CX');WriteHexx('41') End else
if PLATFORMA=17 then begin WriteNAME('INC CX');WriteHexx('41') End else
if PLATFORMA=32 then begin WriteNAME('INC ECX');WriteHexx('41') End else
if PLATFORMA=33 then begin WriteNAME('INC ECX');WriteHexx('41') End else
if PLATFORMA=34 then begin WriteNAME('INC ECX');WriteHexx('41') End else
InfoMes(('Комманда INC__ECX для платформы не описана '));
EndCros;
end;
procedure INC__EDX;
begin
WriteCros('INC__EDX');
if PLATFORMA=80 then begin WriteNAME('INC DE');WriteHexx('13') End else
if PLATFORMA=16 then begin WriteNAME('INC DX');WriteHexx('42') End else
if PLATFORMA=17 then begin WriteNAME('INC DX');WriteHexx('42') End else
if PLATFORMA=32 then begin WriteNAME('INC EDX');WriteHexx('42') End else
if PLATFORMA=33 then begin WriteNAME('INC EDX');WriteHexx('42') End else
if PLATFORMA=34 then begin WriteNAME('INC EDX');WriteHexx('42') End else
InfoMes(('Комманда INC__EDX для платформы не описана '));
EndCros;
end;
procedure INC__ESI;
begin
WriteCros('INC__ESI');
if PLATFORMA=80 then begin WriteNAME('INC IY');WriteHexx('FD23') End else
if PLATFORMA=16 then begin WriteNAME('INC SI');WriteHexx('46') End else
if PLATFORMA=17 then begin WriteNAME('INC SI');WriteHexx('46') End else
if PLATFORMA=32 then begin WriteNAME('INC ESI');WriteHexx('46') End else
if PLATFORMA=33 then begin WriteNAME('INC ESI');WriteHexx('46') End else
if PLATFORMA=34 then begin WriteNAME('INC ESI');WriteHexx('46') End else
InfoMes(('Комманда INC__EDX для платформы не описана '));
EndCros;
end;
procedure DEC__EAX;
begin
WriteCros('DEC__EAX');
if PLATFORMA=80 then Begin WriteNAME('DEC HL');WriteHexx('2B') end else // DEC HL
if PLATFORMA=16 then Begin WriteNAME('DEC AX');WriteHexx('48') end else
if PLATFORMA=17 then Begin WriteNAME('DEC AX');WriteHexx('48') end else
if PLATFORMA=32 then Begin WriteNAME('DEC EAX');WriteHexx('48') end else
if PLATFORMA=33 then Begin WriteNAME('DEC EAX');WriteHexx('48') end else
if PLATFORMA=34 then Begin WriteNAME('DEC EAX');WriteHexx('48') end else
InfoMes(('Комманда DEC__EAX для платформы не описана '));
EndCros;
end;
procedure DEC__ECX;
begin
WriteCros('DEC__ECX');
if PLATFORMA=80 then Begin WriteNAME('DEC BC');WriteHexx('0B') end else
if PLATFORMA=16 then Begin WriteNAME('DEC CX');WriteHexx('49') end else
if PLATFORMA=17 then Begin WriteNAME('DEC CX');WriteHexx('49') end else
if PLATFORMA=32 then Begin WriteNAME('DEC ECX');WriteHexx('49') end else
if PLATFORMA=33 then Begin WriteNAME('DEC ECX');WriteHexx('49') end else
if PLATFORMA=34 then Begin WriteNAME('DEC ECX');WriteHexx('49') end else
InfoMes(('Комманда DEC__ECX для платформы не описана '));
EndCros;
end;
procedure DEC__EDX;
begin
WriteCros('DEC__EDX');
if PLATFORMA=80 then Begin WriteNAME('DEC DE');WriteHexx('1B') end else
if PLATFORMA=16 then Begin WriteNAME('DEC DX');WriteHexx('4A') end else
if PLATFORMA=17 then Begin WriteNAME('DEC DX');WriteHexx('4A') end else
if PLATFORMA=32 then Begin WriteNAME('DEC EDX');WriteHexx('4A') end else
if PLATFORMA=33 then Begin WriteNAME('DEC EDX');WriteHexx('4A') end else
if PLATFORMA=34 then Begin WriteNAME('DEC EDX');WriteHexx('4A') end else
InfoMes(('Комманда DEC__EDX для платформы не описана '));
EndCros;
end;
procedure DEC__ESI;
begin
WriteCros('DEC__ESI');
if PLATFORMA=80 then Begin WriteNAME('DEC IY');WriteHexx('FD2B') end else
if PLATFORMA=16 then Begin WriteNAME('DEC SI');WriteHexx('4E') end else
if PLATFORMA=17 then Begin WriteNAME('DEC SI');WriteHexx('4E') end else
if PLATFORMA=32 then Begin WriteNAME('DEC ESI');WriteHexx('4E') end else
if PLATFORMA=33 then Begin WriteNAME('DEC ESI');WriteHexx('4E') end else
if PLATFORMA=34 then Begin WriteNAME('DEC ESI');WriteHexx('4E') end else
InfoMes(('Комманда DEC__EDX для платформы не описана '));
EndCros;
end;
//------------------------------------------------------------------------------
// Сложения Вычитания
procedure SUB__EAX_EDX;
begin
WriteCros('SUB__EAX_EDX');
if PLATFORMA=80 then begin WriteName('XOR A ; SBC HL,DE');WriteHexx('AFED52') end else
if PLATFORMA=16 then begin WriteName('SUB AX,DX');WriteHexx('29d0') end else
if PLATFORMA=17 then begin WriteName('SUB AX,DX');WriteHexx('29d0') end else
if PLATFORMA=32 then begin WriteName('SUB EAX,EDX');WriteHexx('29d0') end else
if PLATFORMA=33 then begin WriteName('SUB EAX,EDX');WriteHexx('29d0') end else
if PLATFORMA=34 then begin WriteName('SUB EAX,EDX');WriteHexx('29d0') end else
InfoMes(('Комманда SUB__EAX_EDX для платформы не описана '));
EndCros;
end;
procedure SUB__EAX_ECX;
begin
WriteCros('SUB__EAX_ECX');
if PLATFORMA=80 Then begin WriteName('SUB HL,BC') ;WriteHexx('AFED42'); end else
if PLATFORMA=16 Then begin WriteName('SUB AX,CX') ;WriteHexx('29C8'); end else
if PLATFORMA=17 Then begin WriteName('SUB AX,CX') ;WriteHexx('29C8'); end else
if PLATFORMA=32 Then begin WriteName('SUB EAX,ECX');WriteHexx('29C8'); end else
if PLATFORMA=33 Then begin WriteName('SUB EAX,ECX');WriteHexx('29C8'); end else
if PLATFORMA=34 Then begin WriteName('SUB EAX,ECX');WriteHexx('29C8'); end else
InfoMes(('Нет описания комманды SUB__EAX_ECX для данной платформы '));
EndCros;
end;
procedure ADD__EAX_EDX;
begin
WriteCros('ADD__EAX_EDX');
if PLATFORMA=80 then begin WriteName('XOR A ; ADC HL,DE');WriteHexx('AFED5A') end else
if PLATFORMA=16 then begin WriteName('ADD AX,DX');WriteHexx('01d0') end else
if PLATFORMA=17 then begin WriteName('ADD AX,DX');WriteHexx('01d0') end else
if PLATFORMA=32 then begin WriteName('ADD EAX,EDX');WriteHexx('01d0') end else
if PLATFORMA=33 then begin WriteName('ADD EAX,EDX');WriteHexx('01d0') end else
if PLATFORMA=34 then begin WriteName('ADD EAX,EDX');WriteHexx('01d0') end else
InfoMes(('Комманда ADD__EAX_EDX для платформы не описана '));
EndCros;
end;
procedure ADD__EAX_ESP;
begin
WriteCros('ADD__EAX_ESP');
if PLATFORMA=80 Then begin WriteName('ADD HL,SP') ;WriteHexx('AF39'); end else
if PLATFORMA=16 Then begin WriteName('ADD AX,SP') ;WriteHexx('01E0'); end else
if PLATFORMA=17 Then begin WriteName('ADD AX,SP') ;WriteHexx('01E0'); end else
if PLATFORMA=32 Then begin WriteName('ADD EAX,ESP');WriteHexx('01E0'); end else
if PLATFORMA=33 Then begin WriteName('ADD EAX,ESP');WriteHexx('01E0'); end else
if PLATFORMA=34 Then begin WriteName('ADD EAX,ESP');WriteHexx('01E0'); end else
InfoMes(('Нет описания комманды add__EAX_ESP для данной платформы '));
EndCros;
end;
procedure ADD__ESI_ECX;
begin
WriteCros('ADD__ESI_ECX');
if PLATFORMA=80 then begin WriteName('XOR A ; ADC IY,BC');WriteHexx('AFFD09') end else
if PLATFORMA=16 then begin WriteName('ADD SI,CX');WriteHexx('01CE') end else
if PLATFORMA=17 then begin WriteName('ADD SI,CX');WriteHexx('01CE') end else
if PLATFORMA=32 then begin WriteName('ADD ESI,ECX');WriteHexx('01CE') end else
if PLATFORMA=33 then begin WriteName('ADD ESI,ECX');WriteHexx('01CE') end else
if PLATFORMA=34 then begin WriteName('ADD ESI,ECX');WriteHexx('01CE') end else
InfoMes(('Комманда ADD__ESI_ECX для платформы не описана '));
EndCros;
end;
Procedure SUB__ESP(a:LongWord);
begin
WriteCros('SUB__ESP(CIF)');
if PLATFORMA=80 then begin
MOV_A_EAXW(AdrPereme('EAX'));
MOV_A_ECXW(AdrPereme('ECX'));
MOV__EAX(0);
ADD__EAX_ESP;
MOV__ECX(a);
SUB__EAX_ECX;
MOV__ESP_EAX;
MOV__ECX_AW(AdrPereme('ECX'));
MOV__EAX_AW(AdrPereme('EAX'));
end else
if PLATFORMA=16 Then begin WriteName('SUB SP,NN') ;WriteHexx('81ec');WriteWord(a) end else
if PLATFORMA=17 Then begin WriteName('SUB SP,NN') ;WriteHexx('81ec');WriteWord(a) end else
if PLATFORMA=32 Then begin WriteName('SUB ESP,NNNN');WriteHexx('81ec');WriteLong(a) end else
if PLATFORMA=33 Then begin WriteName('SUB ESP,NNNN');WriteHexx('81ec');WriteLong(a) end else
if PLATFORMA=34 Then begin WriteName('SUB ESP,NNNN');WriteHexx('81ec');WriteLong(a) end else
InfoMes(('Комманда SUB__ESP_B для платформы не описана '));
EndCros;
end;
Procedure ADD__ESP(a:LongWord);
begin
WriteCros('ADD__ESP(CIF)');
if PLATFORMA=80 then Begin
MOV_A_EAXW(AdrPereme('EAX'));
MOV__EAX(a);
ADD__EAX_ESP;
MOV__ESP_EAX;
MOV__EAX_AW(AdrPereme('EAX'));
end else
if PLATFORMA=16 Then begin WriteName('ADD SP,NN') ;WriteHexx('81C4');WriteWord(a) end else
if PLATFORMA=17 Then begin WriteName('ADD SP,NN') ;WriteHexx('81C4');WriteWord(a) end else
if PLATFORMA=32 Then begin WriteName('ADD SP,NNNN');WriteHexx('81C4');WriteLong(a) end else
if PLATFORMA=33 Then begin WriteName('ADD SP,NNNN');WriteHexx('81C4');WriteLong(a) end else
if PLATFORMA=34 Then begin WriteName('ADD SP,NNNN');WriteHexx('81C4');WriteLong(a) end else
InfoMes(('Комманда Add__ESP_B для платформы не описана '));
EndCros;
end;
procedure ADD__ESI(B:LongWord);
begin
WriteCros('ADD__ESI(CIF)');
if PLATFORMA=80 Then begin
MOV_A_ECXW(AdrPereme('ECX'));
MOV__ECX(b);
ADD__ESI_ECX;
MOV__ECX_AW(AdrPereme('ECX'));
end else
if PLATFORMA=16 Then begin WriteName('ADD SI,NN') ;WriteHexx('81C6');WriteWord(b) end else
if PLATFORMA=17 Then begin WriteName('ADD SI,NN') ;WriteHexx('81C6');WriteWord(b) end else
if PLATFORMA=32 Then begin WriteName('ADD ESI,NNNN');WriteHexx('81C6');WriteLong(b) end else
if PLATFORMA=33 Then begin WriteName('ADD ESI,NNNN');WriteHexx('81C6');WriteLong(b) end else
if PLATFORMA=34 Then begin WriteName('ADD ESI,NNNN');WriteHexx('81C6');WriteLong(b) end else
InfoMes(('Нет описания комманды ADD__ESI(cif) для данной платформы '));
EndCros;
end;
// SISISISISISISISIIS ----------------------------------------------------------
procedure MOV__ESP_EAX;
begin
WriteCros('MOV__ESP_EAX');
if PLATFORMA=80 Then begin WriteName('LD SP,HL') ;WriteHexx('F9'); end else
if PLATFORMA=16 Then begin WriteName('MOV SP,AX') ;WriteHexx('89C4'); end else
if PLATFORMA=17 Then begin WriteName('MOV SP,AX') ;WriteHexx('89C4'); end else
if PLATFORMA=32 Then begin WriteName('MOV ESP,EAX');WriteHexx('89C4'); end else
if PLATFORMA=33 Then begin WriteName('MOV ESP,EAX');WriteHexx('89C4'); end else
if PLATFORMA=34 Then begin WriteName('MOV ESP,EAX');WriteHexx('89C4'); end else
InfoMes(('Нет описания комманды MOV__ESP_EAX для данной платформы '));
EndCros;
end;
procedure MOV__ESI_ESP;
begin
WriteCros('MOV__ESI_ESP');
if PLATFORMA=80 Then begin
MOV_A_EAXW(AdrPereme('EAX'));
MOV__EAX(0);
ADD__EAX_ESP;
PUSH_EAX;
POP__ESI;
MOV__EAX_AW(AdrPereme('EAX'));
end else
if PLATFORMA=16 Then begin WriteName('MOV SI,SP') ;WriteHexx('89E6'); end else
if PLATFORMA=17 Then begin WriteName('MOV SI,SP') ;WriteHexx('89E6'); end else
if PLATFORMA=32 Then begin WriteName('MOV ESI,ESP');WriteHexx('89E6'); end else
if PLATFORMA=33 Then begin WriteName('MOV ESI,ESP');WriteHexx('89E6'); end else
if PLATFORMA=34 Then begin WriteName('MOV ESI,ESP');WriteHexx('89E6'); end else
InfoMes(('Нет описания комманды MOV__ESI_ESP для данной платформы '));
EndCros;
end;
procedure MOV__ESI_EAX;
begin
WriteCros('MOV__ESI_EAX');
if PLATFORMA=80 Then begin
PUSH_EAX;
POP__ESI;
end else
if PLATFORMA=16 Then begin WriteName('MOV SI,AX') ;WriteHexx('89c6'); end else
if PLATFORMA=17 Then begin WriteName('MOV SI,AX') ;WriteHexx('89c6'); end else
if PLATFORMA=32 Then begin WriteName('MOV ESI,EAX');WriteHexx('89c6'); end else
if PLATFORMA=33 Then begin WriteName('MOV ESI,EAX');WriteHexx('89c6'); end else
if PLATFORMA=34 Then begin WriteName('MOV ESI,EAX');WriteHexx('89c6'); end else
InfoMes(('Нет описания комманды MOV__ESI_EAX для данной платформы '));
EndCros;
end;
procedure MOV__ESI_ECX;
begin
WriteCros('MOV__ESI_ECX');
if PLATFORMA=80 Then begin
PUSH_ECX;
POP__ESI;
end else
if PLATFORMA=16 Then begin WriteName('MOV SI,CX');WriteHexx('89ce'); end else
if PLATFORMA=17 Then begin WriteName('MOV SI,CX');WriteHexx('89ce'); end else
if PLATFORMA=32 Then begin WriteName('MOV ESI,ECX');WriteHexx('89ce'); end else
if PLATFORMA=33 Then begin WriteName('MOV ESI,ECX');WriteHexx('89ce'); end else
if PLATFORMA=34 Then begin WriteName('MOV ESI,ECX');WriteHexx('89ce'); end else
InfoMes(('Нет описания комманды MOV__ESI_ECX для данной платформы '));
EndCros;
end;
procedure MOV__ESI_EDX;
begin
WriteCros('MOV__ESI_EDX');
if PLATFORMA=80 Then begin
PUSH_EDX;
POP__ESI;
end else
if PLATFORMA=16 Then begin WriteName('MOV SI,DX');WriteHexx('89d6'); end else
if PLATFORMA=17 Then begin WriteName('MOV SI,DX');WriteHexx('89d6'); end else
if PLATFORMA=32 Then begin WriteName('MOV ESI,EDX');WriteHexx('89d6'); end else
if PLATFORMA=33 Then begin WriteName('MOV ESI,EDX');WriteHexx('89d6'); end else
if PLATFORMA=34 Then begin WriteName('MOV ESI,EDX');WriteHexx('89d6'); end else
InfoMes(('Нет описания комманды MOV__ESI_EDX для данной платформы '));
EndCros;
end;
procedure MOV_AESI_AL;
begin
WriteCros('MOV_AESI_AL');
if PLATFORMA=80 Then begin WriteName('LD [IY],L') ;WriteHexx('FD7500'); end else
if PLATFORMA=16 Then begin WriteName('MOV [SI],AL') ;WriteHexx('8804'); end else
if PLATFORMA=17 Then begin WriteName('MOV [SI],AL') ;WriteHexx('8804'); end else
if PLATFORMA=32 Then begin WriteName('MOV [ESI],AL');WriteHexx('8806'); end else
if PLATFORMA=33 Then begin WriteName('MOV [ESI],AL');WriteHexx('8806'); end else
if PLATFORMA=34 Then begin WriteName('MOV [ESI],AL');WriteHexx('8806'); end else
InfoMes(('Нет описания комманды MOV_AESI_AL для данной платформы '));
EndCros;
end;
procedure MOV_AESI_CL;
begin
WriteCros('MOV_AESI_CL');
if PLATFORMA=80 Then begin WriteName('LD [IY],C');WriteHexx('FD7100'); end else
if PLATFORMA=16 Then begin WriteName('MOV [SI],CL');WriteHexx('880C'); end else
if PLATFORMA=17 Then begin WriteName('MOV [SI],CL');WriteHexx('880C'); end else
if PLATFORMA=32 Then begin WriteName('MOV [ESI],CL');WriteHexx('880E'); end else
if PLATFORMA=33 Then begin WriteName('MOV [ESI],CL');WriteHexx('880E'); end else
if PLATFORMA=34 Then begin WriteName('MOV [ESI],CL');WriteHexx('880E'); end else
InfoMes(('Нет описания комманды MOV_AESI_CL для данной платформы '));
EndCros;
end;
procedure MOV_AESI_DL;
begin
WriteCros('MOV_AESI_DL');
if PLATFORMA=80 Then begin WriteName('LD [IY],E');WriteHexx('FD7300'); end else
if PLATFORMA=16 Then begin WriteName('MOV [SI],DL');WriteHexx('8814'); end else
if PLATFORMA=17 Then begin WriteName('MOV [SI],DL');WriteHexx('8814'); end else
if PLATFORMA=32 Then begin WriteName('MOV [ESI],DL');WriteHexx('8816'); end else
if PLATFORMA=33 Then begin WriteName('MOV [ESI],DL');WriteHexx('8816'); end else
if PLATFORMA=34 Then begin WriteName('MOV [ESI],DL');WriteHexx('8816'); end else
InfoMes(('Нет описания комманды MOV_AESI_DL для данной платформы '));
EndCros;
end;
procedure MOV__EAX_AESI;
begin
WriteCros('MOV__EAX_AESI');
if PLATFORMA=80 Then begin
WriteName('LD L,[IY+0];INC IY;LD H,[IY+0];');
WriteHexx('FD6E00'+//LD L,(IY+s);
'FD23'+//INC IY;
'FD6600');//LD h,(IY+s)
end else
if PLATFORMA=16 Then begin WriteName('MOV AX,[SI]') ; WriteHexx('8b04'); end else
if PLATFORMA=17 Then begin WriteName('MOV AX,[SI]') ; WriteHexx('8b04'); end else
if PLATFORMA=32 Then begin WriteName('MOV EAX,[ESI]'); WriteHexx('8b06'); end else
if PLATFORMA=33 Then begin WriteName('MOV EAX,[ESI]'); WriteHexx('8b06'); end else
if PLATFORMA=34 Then begin WriteName('MOV EAX,[ESI]'); WriteHexx('8b06'); end else
InfoMes(('Нет описания комманды MOV__EAX_AESI для данной платформы '));
EndCros;
end;
procedure MOV__ECX_AESI;
begin
WriteCros('MOV__ECX_AESI');
if PLATFORMA=80 Then begin
WriteName('LD C, [IY+0];INC IY;LD B,[IY+0]');
WriteHexx('FD4E00'+// LD C, (IY+s)
'FD23'+ //INC IY
'FD4600');//LD B,(IY+s)
end else
if PLATFORMA=16 Then begin WriteName('MOV CX,[SI]') ;WriteHexx('8B0C'); end else
if PLATFORMA=17 Then begin WriteName('MOV CX,[SI]') ;WriteHexx('8B0C'); end else
if PLATFORMA=32 Then begin WriteName('MOV ECX,[ESI]');WriteHexx('8B0E'); end else
if PLATFORMA=33 Then begin WriteName('MOV ECX,[ESI]');WriteHexx('8B0E'); end else
if PLATFORMA=34 Then begin WriteName('MOV ECX,[ESI]');WriteHexx('8B0E'); end else
InfoMes(('Нет описания комманды MOV__ECX_AESI для данной платформы '));
EndCros;
end;
procedure MOV__EDX_AESI;
begin
WriteCros('MOV__EDX_AESI');
if PLATFORMA=80 Then begin
WriteName('LD E,[IY+0];INC IY;D,[IY+0];');
WriteHexx('FD5E00'+// LD e,(IY+s)
'FD23'+// INC IY
'FD5600'); // LD D,(IY+s);
end else
if PLATFORMA=16 Then begin WriteName('MOV DX,[SI]'); WriteHexx('8b14'); end else
if PLATFORMA=17 Then begin WriteName('MOV DX,[SI]'); WriteHexx('8b14'); end else
if PLATFORMA=32 Then begin WriteName('MOV EDX,[ESI]'); WriteHexx('8b16'); end else
if PLATFORMA=33 Then begin WriteName('MOV EDX,[ESI]'); WriteHexx('8b16'); end else
if PLATFORMA=34 Then begin WriteName('MOV EDX,[ESI]'); WriteHexx('8b16'); end else
InfoMes(('Нет описания комманды MOV__EDX_AESI для данной платформы '));
EndCros;
end;
procedure MOV_AESI_EAX;
begin
WriteCros('MOV_AESI_EAX');
if PLATFORMA=80 Then begin
WriteName('LD [IY+0],L;INC IY;LD [IY+0],H ');
WriteHexx('FD7500'+ //LD (IY+s),L
'FD23'+//INC IY
'FD7400') //LD (IY+s),h
end else
if PLATFORMA=16 Then begin WriteName('MOV [SI],AX') ;WriteHexx('8904'); end else
if PLATFORMA=17 Then begin WriteName('MOV [SI],AX') ;WriteHexx('8904'); end else
if PLATFORMA=32 Then begin WriteName('MOV [ESI],EAX');WriteHexx('8906'); end else
if PLATFORMA=33 Then begin WriteName('MOV [ESI],EAX');WriteHexx('8906'); end else
if PLATFORMA=34 Then begin WriteName('MOV [ESI],EAX');WriteHexx('8906'); end else
InfoMes(('Нет описания комманды MOV_AESI_EAX для данной платформы '));
EndCros;
end;
procedure MOV_AESI_ECX;
begin
WriteCros('MOV_AESI_ECX');
if PLATFORMA=80 Then begin
WriteName('LD [IY+0],C;INC IY;LD [IY+0],B');
WriteHexx('FD7100'+ //LD (IY+s),C
'FD23'+ // INC IY
'FD7000'); //LD (IY+s),B
end else
if PLATFORMA=16 Then begin WriteName('MOV [SI],CX');WriteHexx('890C'); end else
if PLATFORMA=17 Then begin WriteName('MOV [SI],CX');WriteHexx('890C'); end else
if PLATFORMA=32 Then begin WriteName('MOV [ESI],ECX');WriteHexx('890E'); end else
if PLATFORMA=33 Then begin WriteName('MOV [ESI],ECX');WriteHexx('890E'); end else
if PLATFORMA=34 Then begin WriteName('MOV [ESI],ECX');WriteHexx('890E'); end else
InfoMes(('Нет описания комманды MOV_AESI_ECX для данной платформы '));
EndCros;
end;
procedure MOV_AESI_EDX;
begin
WriteCros('MOV_AESI_EDX');
if PLATFORMA=80 Then begin
WriteName('LD [IY+0],E;INC IY;LD [IY+0],D');
WriteHexx('FD7300'+ //LD (IY+s),E
'FD23'+// INC IY
'FD7200')// LD (IY+s),D
end else
if PLATFORMA=16 Then begin WriteName('MOV [SI],DX') ;WriteHexx('8914'); end else
if PLATFORMA=17 Then begin WriteName('MOV [SI],DX') ;WriteHexx('8914'); end else
if PLATFORMA=32 Then begin WriteName('MOV [ESI],EDX');WriteHexx('8916'); end else
if PLATFORMA=33 Then begin WriteName('MOV [ESI],EDX');WriteHexx('8916'); end else
if PLATFORMA=34 Then begin WriteName('MOV [ESI],EDX');WriteHexx('8916'); end else
InfoMes(('Нет описания комманды MOV_AESI_EDX для данной платформы '));
EndCros;
end;
// условные безусловные переходы -----------------------------------------------
procedure CMP__EAX_EDX;
begin
WriteCros('CMP__EAX_EDX');
if PLATFORMA=80 then begin WriteName('XOR A;SBC HL,DE');WriteHexx('AFED52') end else
if PLATFORMA=16 then begin WriteName('CMP AX,DX') ;WriteHexx('39d0') end else
if PLATFORMA=17 then begin WriteName('CMP AX,DX') ;WriteHexx('39d0') end else
if PLATFORMA=32 then begin WriteName('CMP EAX,EDX') ;WriteHexx('39d0') end else
if PLATFORMA=33 then begin WriteName('CMP EAX,EDX') ;WriteHexx('39d0') end else
if PLATFORMA=34 then begin WriteName('CMP EAX,EDX') ;WriteHexx('39d0') end else
InfoMes(('Комманда CMP__EAX_EDX для платформы не описана '));
EndCros;
end;
procedure JA___(a:String);
begin // Если Больше
WriteCros('JA___(CIF)');
if PLATFORMA=16 then begin WriteName('JA NN') ;WriteHexx('0F87');ReadLabel(a,'JA___');WriteWord(0);end else
if PLATFORMA=17 then begin WriteName('JA NN') ;WriteHexx('0F87');ReadLabel(a,'JA___');WriteWord(0);end else
if PLATFORMA=32 then begin WriteName('JA NNNN');WriteHexx('0F87');ReadLabel(a,'JA___');WriteLong(0);end else
if PLATFORMA=33 then begin WriteName('JA NNNN');WriteHexx('0F87');ReadLabel(a,'JA___');WriteLong(0);end else
if PLATFORMA=34 then begin WriteName('JA NNNN');WriteHexx('0F87');ReadLabel(a,'JA___');WriteLong(0);end else
InfoMes(('Комманда JA___(CIF) для платформы не описана '));
EndCros;
end;
procedure JAE__(a:String);
begin // Если Больше либо равно
WriteCros('JAE__(CIF)');
if PLATFORMA=80 then begin WriteName('JP NC,NN');WriteHexx('D2') ;ReadLabel(a,'JA___');WriteWord(0);end else
if PLATFORMA=16 then begin WriteName('JAE NN');WriteHexx('0F83') ;ReadLabel(a,'JAE__');WriteWord(0);end else
if PLATFORMA=17 then begin WriteName('JAE NN');WriteHexx('0F83') ;ReadLabel(a,'JAE__');WriteWord(0);end else
if PLATFORMA=32 then begin WriteName('JAE NNNN');WriteHexx('0F83');ReadLabel(a,'JAE__');WriteLong(0);end else
if PLATFORMA=33 then begin WriteName('JAE NNNN');WriteHexx('0F83');ReadLabel(a,'JAE__');WriteLong(0);end else
if PLATFORMA=34 then begin WriteName('JAE NNNN');WriteHexx('0F83');ReadLabel(a,'JAE__');WriteLong(0);end else
InfoMes(('Комманда JAE__ для платформы не описана '));
EndCros;
end;
procedure JE___(a:String);
begin // Если равно
WriteCros('JE___(CIF)');
if PLATFORMA=80 then begin WriteName('JP Z,NN');WriteHexx('CA') ;ReadLabel(a,'JE___');WriteWord(0);end else
if PLATFORMA=16 then begin WriteName('JE NN') ;WriteHexx('0F84');ReadLabel(a,'JE___');WriteWord(0);end else
if PLATFORMA=17 then begin WriteName('JE NN') ;WriteHexx('0F84');ReadLabel(a,'JE___');WriteWord(0);end else
if PLATFORMA=32 then begin WriteName('JE NNNN');WriteHexx('0F84');ReadLabel(a,'JE___');WriteLong(0);end else
if PLATFORMA=33 then begin WriteName('JE NNNN');WriteHexx('0F84');ReadLabel(a,'JE___');WriteLong(0);end else
if PLATFORMA=34 then begin WriteName('JE NNNN');WriteHexx('0F84');ReadLabel(a,'JE___');WriteLong(0);end else
InfoMes(('Комманда JE___ для платформы не описана '));
EndCros;
end;
procedure JNE__(a:String);
begin // Если не равно
WriteCros('JNE__(CIF)');
if PLATFORMA=80 then begin WriteName('JP NZ,NN');WriteHexx('C2') ;ReadLabel(a,'JNE__');WriteWord(0);end else
if PLATFORMA=16 then begin WriteName('JNE NN') ;WriteHexx('0F85');ReadLabel(a,'JNE__');WriteWord(0);end else
if PLATFORMA=17 then begin WriteName('JNE NN') ;WriteHexx('0F85');ReadLabel(a,'JNE__');WriteWord(0);end else
if PLATFORMA=32 then begin WriteName('JNE NNNN');WriteHexx('0F85');ReadLabel(a,'JNE__');WriteLong(0);end else
if PLATFORMA=33 then begin WriteName('JNE NNNN');WriteHexx('0F85');ReadLabel(a,'JNE__');WriteLong(0);end else
if PLATFORMA=34 then begin WriteName('JNE NNNN');WriteHexx('0F85');ReadLabel(a,'JNE__');WriteLong(0);end else
InfoMes(('Комманда JNE__ для платформы не описана '));
EndCros;
end;
procedure JB___(a:String);
begin // Нсли Меньше D2
WriteCros('JB___(CIF)');
if PLATFORMA=80 then begin WriteName('JP C,NN');WriteHexx('DA') ; ReadLabel(a,'JB___');WriteWord(0);end else
if PLATFORMA=16 then begin WriteName('JB NN') ;WriteHexx('0F82'); ReadLabel(a,'JB___');WriteWord(0);end else
if PLATFORMA=17 then begin WriteName('JB NN') ;WriteHexx('0F82'); ReadLabel(a,'JB___');WriteWord(0);end else
if PLATFORMA=32 then begin WriteName('JB NNNN');WriteHexx('0F82'); ReadLabel(a,'JB___');WriteLong(0);end else
if PLATFORMA=33 then begin WriteName('JB NNNN');WriteHexx('0F82'); ReadLabel(a,'JB___');WriteLong(0);end else
if PLATFORMA=34 then begin WriteName('JB NNNN');WriteHexx('0F82'); ReadLabel(a,'JB___');WriteLong(0);end else
InfoMes(('Комманда JB___ для платформы не описана '));
EndCros;
end;
procedure JBE__(a:String);
begin // Если Меньше либо равно
WriteCros('JBE__(CIF)');
if PLATFORMA=80 then begin JB___(a);JE___(a); end else
if PLATFORMA=16 then begin WriteName('JBE NN') ;WriteHexx('0F86'); ReadLabel(a,'JBE__');WriteWord(0);end else
if PLATFORMA=17 then begin WriteName('JBE NN') ;WriteHexx('0F86'); ReadLabel(a,'JBE__');WriteWord(0);end else
if PLATFORMA=32 then begin WriteName('JBE NNNN');WriteHexx('0F86'); ReadLabel(a,'JBE__');WriteLong(0);end else
if PLATFORMA=33 then begin WriteName('JBE NNNN');WriteHexx('0F86'); ReadLabel(a,'JBE__');WriteLong(0);end else
if PLATFORMA=34 then begin WriteName('JBE NNNN');WriteHexx('0F86'); ReadLabel(a,'JBE__');WriteLong(0);end else
InfoMes(('Комманда JBE__ для платформы не описана '));
EndCros;
end;
Procedure JMP__(s:String);
begin
WriteCros('JMP__(CIF)');
if PLATFORMA=80 Then begin WriteName('JP NN') ;WriteHexx('C3');ReadLabel(s,'JMP__');WriteWord(0);end else
if PLATFORMA=16 Then begin WriteName('JMP NN') ;WriteHexx('E9');ReadLabel(s,'JMP__');WriteWord(0);end else
if PLATFORMA=17 Then begin WriteName('JMP NN') ;WriteHexx('E9');ReadLabel(s,'JMP__');WriteWord(0);end else
if PLATFORMA=32 Then begin WriteName('JMP NNNN');WriteHexx('E9');ReadLabel(s,'JMP__');WriteLong(0);end else
if PLATFORMA=33 Then begin WriteName('JMP NNNN');WriteHexx('E9');ReadLabel(s,'JMP__');WriteLong(0);end else
if PLATFORMA=34 Then begin WriteName('JMP NNNN');WriteHexx('E9');ReadLabel(s,'JMP__');WriteLong(0);end else
InfoMes(('Комманда JMP__ для платформы не описана '));
EndCros;
end;
Procedure RET__;
begin
WriteCros('RET__');
if PLATFORMA=80 Then begin WriteName('RET');WriteHexx('C9'); end else
if PLATFORMA=16 Then begin WriteName('RET');WriteHexx('C3'); end else
if PLATFORMA=17 Then begin WriteName('RET');WriteHexx('C3'); end else
if PLATFORMA=32 Then begin WriteName('RET');WriteHexx('C3'); end else
if PLATFORMA=33 Then begin WriteName('RET');WriteHexx('C3'); end else
if PLATFORMA=34 Then begin WriteName('RET');WriteHexx('C3'); end else
InfoMes(('Комманда RET__ для платформы не описана '));
EndCros;
end;
Procedure CAL__(s:String);
begin
WriteCros('CAL__(CIF)');
if PLATFORMA=80 Then begin WriteName('CALL NN') ;WriteHexx('CD');ReadFunct(s,'Cal__');WriteWord(0); end else
if PLATFORMA=16 Then begin WriteName('CALL NN') ;WriteHexx('E8');ReadFunct(s,'Cal__');WriteWord(0); end else
if PLATFORMA=17 Then begin WriteName('CALL NN') ;WriteHexx('E8');ReadFunct(s,'Cal__');WriteWord(0); end else
if PLATFORMA=32 Then begin WriteName('CALL NNNN');WriteHexx('E8');ReadFunct(s,'Cal__');WriteLong(0); end else
if PLATFORMA=33 Then begin WriteName('CALL NNNN');WriteHexx('E8');ReadFunct(s,'Cal__');WriteLong(0); end else
if PLATFORMA=34 Then begin WriteName('CALL NNNN');WriteHexx('E8');ReadFunct(s,'Cal__');WriteLong(0); end else
InfoMes(('Комманда CAL__ для платформы не описана '));
EndCros;
end;
Procedure CAL__(s:LongWord);
begin
WriteCros('CAL__(CIF)');
if PLATFORMA=80 Then begin WriteName('CALL NN') ;WriteHexx('CD');WriteWord(s); end else
if PLATFORMA=16 Then begin WriteName('CALL NN') ;WriteHexx('E8');WriteWord(s); end else
if PLATFORMA=17 Then begin WriteName('CALL NN') ;WriteHexx('E8');WriteWord(s); end else
if PLATFORMA=32 Then begin WriteName('CALL NNNN');WriteHexx('E8');WriteLong(s); end else
if PLATFORMA=33 Then begin WriteName('CALL NNNN');WriteHexx('E8');WriteLong(s); end else
if PLATFORMA=34 Then begin WriteName('CALL NNNN');WriteHexx('E8');WriteLong(s); end else
InfoMes(('Комманда CAL__ для платформы не описана '));
EndCros;
end;
// Арифметика ------------------------------------------------------------------
procedure XOR__EAX;
begin
WriteCros('XOR__EAX');
if PLATFORMA=80 then begin WriteName('LD HL,00') ;WriteHexx('210000') end else // LD HL,0
if PLATFORMA=16 then begin WriteName('XOR AX,AX') ;WriteHexx('31c0') end else
if PLATFORMA=17 then begin WriteName('XOR AX,AX') ;WriteHexx('31c0') end else
if PLATFORMA=32 then begin WriteName('XOR EAX,EAX');WriteHexx('31c0') end else
if PLATFORMA=33 then begin WriteName('XOR EAX,EAX');WriteHexx('31c0') end else
if PLATFORMA=34 then begin WriteName('XOR EAX,EAX');WriteHexx('31c0') end else
InfoMes(('Комманда XOR__EAX для платформы не описана '));
EndCros;
end;
procedure XOR__ECX;
begin
WriteCros('XOR__ECX');
if PLATFORMA=80 then begin WriteName('LD BC,00') ;WriteHexx('010000') end else
if PLATFORMA=16 then begin WriteName('XOR CX,CX') ;WriteHexx('31c9') end else
if PLATFORMA=17 then begin WriteName('XOR CX,CX') ;WriteHexx('31c9') end else
if PLATFORMA=32 then begin WriteName('XOR ECX,ECX');WriteHexx('31c9') end else
if PLATFORMA=33 then begin WriteName('XOR ECX,ECX');WriteHexx('31c9') end else
if PLATFORMA=34 then begin WriteName('XOR ECX,ECX');WriteHexx('31c9') end else
InfoMes(('Комманда XOR__ECX для платформы не описана '));
EndCros;
end;
procedure XOR__EDX;
begin
WriteCros('XOR__EDX');
if PLATFORMA=80 then begin WriteName('LD DE,00') ;WriteHexx('110000') End else
if PLATFORMA=16 then begin WriteName('XOR DX') ;WriteHexx('31d2') End else
if PLATFORMA=17 then begin WriteName('XOR DX') ;WriteHexx('31d2') End else
if PLATFORMA=32 then begin WriteName('XOR EDX,EDX');WriteHexx('31d2') End else
if PLATFORMA=33 then begin WriteName('XOR EDX,EDX');WriteHexx('31d2') End else
if PLATFORMA=34 then begin WriteName('XOR EDX,EDX');WriteHexx('31d2') End else
InfoMes(('Комманда XOR__EDX для платформы не описана '));
EndCros;
end;
procedure XOR__ESI;
begin
WriteCros('XOR__ESI');
if PLATFORMA=80 then begin WriteName('LD IY,00') ;WriteHexx('FD110000') End else
if PLATFORMA=16 then begin WriteName('XOR SI,SI') ;WriteHexx('31F6') End else
if PLATFORMA=17 then begin WriteName('XOR SI,SI') ;WriteHexx('31F6') End else
if PLATFORMA=32 then begin WriteName('XOR ESI,ESI');WriteHexx('31F6') End else
if PLATFORMA=33 then begin WriteName('XOR ESI,ESI');WriteHexx('31F6') End else
if PLATFORMA=34 then begin WriteName('XOR ESI,ESI');WriteHexx('31F6') End else
InfoMes(('Комманда XOR__ESI для платформы не описана '));
EndCros;
end;
// Загрузка значений -----------------------------------------------------------
Procedure MOV__EAX(a:LongWord);
begin
WriteCros('MOV__EAX(CIF)');
if PLATFORMA=80 then begin WriteName('LD HL,NN') ;WriteHexx('21');WriteWord(a);end else
if PLATFORMA=16 then begin WriteName('MOV AX,NN') ;WriteHexx('B8');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV AX,NN') ;WriteHexx('B8');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV EAX,NNNN');WriteHexx('B8');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV EAX,NNNN');WriteHexx('B8');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV EAX,NNNN');WriteHexx('B8');WriteLong(a);end else
InfoMes(('Комманда MOV__EAX для платформы не описана '));
EndCros;
end;
Procedure MOV__ECX(a:LongWord);
begin
WriteCros('MOV__ECX(CIF)');
if PLATFORMA=80 then begin WriteName('LD BC,NN') ;WriteHexx('01');WriteWord(a);end else
if PLATFORMA=16 then begin WriteName('MOV CX,NN') ;WriteHexx('B9');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV CX,NN') ;WriteHexx('B9');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV ECX,NNNN');WriteHexx('B9');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV ECX,NNNN');WriteHexx('B9');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV ECX,NNNN');WriteHexx('B9');WriteLong(a);end else
InfoMes(('Комманда MOV__ECX для платформы не описана '));
EndCros;
end;
Procedure MOV__EDX(a:LongWord);
begin
WriteCros('MOV__EDX(CIF)');
if PLATFORMA=80 then begin WriteName('LD DE,NN') ;WriteHexx('11');WriteWord(a);end else
if PLATFORMA=16 then begin WriteName('MOV DX,NN') ;WriteHexx('BA');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV DX,NN') ;WriteHexx('BA');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV EDX,NNNN');WriteHexx('BA');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV EDX,NNNN');WriteHexx('BA');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV EDX,NNNN');WriteHexx('BA');WriteLong(a);end else
InfoMes(('Комманда MOV__EDX(CIF) для платформы не описана '));
EndCros;
end;
procedure MOV__ESI(a:LongWord);
begin
WriteCros('MOV__ESI(CIF)');
if PLATFORMA=80 then begin WriteName('LD IY,NN') ;WriteHexx('FD21');WriteWord(a);end else
if PLATFORMA=16 then begin WriteName('MOV SI,NN') ;WriteHexx('BE') ;WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV SI,NN') ;WriteHexx('BE') ;WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV ESI,NNNN');WriteHexx('BE') ;WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV ESI,NNNN');WriteHexx('BE') ;WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV ESI,NNNN');WriteHexx('BE') ;WriteLong(a);end else
InfoMes(('Комманда MOV__ESI для платформы не описана '));
EndCros;
end;
//--------------------------------
Procedure MOV__EAX_AW(a:LongWord);
begin
WriteCros('MOV__EAX_AW(CIF)');
if PLATFORMA=80 then begin WriteName('LD HL,[NN]') ;WriteHexx('2A');WriteWord(a);end else
if PLATFORMA=16 then begin WriteName('MOV AX,[NN]') ;WriteHexx('A1');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV AX,[NN]') ;WriteHexx('A1');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV EAX,[NNNN]');WriteHexx('A1');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV EAX,[NNNN]');WriteHexx('A1');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV EAX,[NNNN]');WriteHexx('A1');WriteLong(a);end else
InfoMes(('Комманда MOV__EAX_AW для платформы не описана '));
EndCros;
end;
Procedure MOV__EAX_AB(a:LongWord);
begin
WriteCros('MOV__EAX_AB(CIF)');
if PLATFORMA=80 then begin MOV__EAX_AW(a);Mov__AH(0); end else
if PLATFORMA=16 then begin WriteName('MOV AL,[NN]') ;WriteHexx('A0');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV AL,[NN]') ;WriteHexx('A0');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV AL,[NNNN]');WriteHexx('A0');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV AL,[NNNN]');WriteHexx('A0');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV AL,[NNNN]');WriteHexx('A0');WriteLong(a);end else
InfoMes(('Комманда MOV__EAX_AB для платформы не описана '));
EndCros;
end;
Procedure MOV__ECX_AW(a:LongWord);
begin
WriteCros('MOV__ECX_AW(CIF)');
if PLATFORMA=80 then begin WriteName('LD BC,[NN]') ;WriteHexx('ED4B');WriteWord(a);end else
if PLATFORMA=16 then begin WriteName('MOV CX,[NN]') ;WriteHexx('8b0E');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV CX,[NN]') ;WriteHexx('8b0E');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV ECX,[NNNN]');WriteHexx('8B0D');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV ECX,[NNNN]');WriteHexx('8B0D');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV ECX,[NNNN]');WriteHexx('8B0D');WriteLong(a);end else
InfoMes(('Комманда MOV__ECX_AW для платформы не описана '));
EndCros;
end;
procedure MOV__ECX_AB(a:LongWord);
begin
WriteCros('MOV__ECX_AB(CIF)');
if PLATFORMA=80 then begin MOV__ECX_AW(a);MOV__CH(0);end else
if PLATFORMA=16 then begin WriteName('MOV CL,[NN]') ;WriteHexx('8A0E');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV CL,[NN]') ;WriteHexx('8A0E');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV CL,[NNNN]');WriteHexx('8A0D');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV CL,[NNNN]');WriteHexx('8A0D');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV CL,[NNNN]');WriteHexx('8A0D');WriteLong(a);end else
InfoMes(('Комманда MOV__ECX_AB для платформы не описана '));
EndCros;
end;
Procedure MOV__EDX_AW(a:LongWord);
begin
WriteCros('MOV__EDX_AW(CIF)');
if PLATFORMA=80 then begin WriteName('LD E,[NN]') ;WriteHexx('ED5B');WriteWord(a);end else
if PLATFORMA=16 then begin WriteName('MOV DX,[NN]') ;WriteHexx('8b16');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV DX,[NN]') ;WriteHexx('8b16');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV EDX,[NNNN]');WriteHexx('8b15');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV EDX,[NNNN]');WriteHexx('8b15');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV EDX,[NNNN]');WriteHexx('8b15');WriteLong(a);end else
InfoMes(('Комманда MOV__EDX_AW(CIF) для платформы не описана '));
EndCros;
end;
Procedure MOV__EDX_AB(a:LongWord);
begin
WriteCros('MOV__EDX_AB(CIF)');
if PLATFORMA=80 then begin MOV__EDX_AW(a);MOV__DH(0); end else
if PLATFORMA=16 then begin WriteName('MOV DL,[NN]') ;WriteHexx('8a16');WriteWord(a);end else
if PLATFORMA=17 then begin WriteName('MOV DL,[NN]') ;WriteHexx('8a16');WriteWord(a);end else
if PLATFORMA=32 then begin WriteName('MOV DL,[NNNN]');WriteHexx('8a15');WriteLong(a);end else
if PLATFORMA=33 then begin WriteName('MOV DL,[NNNN]');WriteHexx('8a15');WriteLong(a);end else
if PLATFORMA=34 then begin WriteName('MOV DL,[NNNN]');WriteHexx('8a15');WriteLong(a);end else
InfoMes(('Комманда MOV__EDX_AB для платформы не описана '));
EndCros;
end;
//--------------------------------
Procedure Mov_A_EAXW(a:Longword);
begin
WriteCros('Mov_A_EAXW(CIF)');
if PLATFORMA=80 Then begin WriteName('LD [NN],HL') ;WriteHexx('22');WriteWord(a) end else
if PLATFORMA=16 Then begin WriteName('MOV [NN],AX') ;WriteHexx('A3');WriteWord(a) end else
if PLATFORMA=17 Then begin WriteName('MOV [NN],AX') ;WriteHexx('A3');WriteWord(a) end else
if PLATFORMA=32 Then begin WriteName('MOV [NNNN],EAX');WriteHexx('A3');WriteLong(a) end else
if PLATFORMA=33 Then begin WriteName('MOV [NNNN],EAX');WriteHexx('A3');WriteLong(a) end else
if PLATFORMA=34 Then begin WriteName('MOV [NNNN],EAX');WriteHexx('A3');WriteLong(a) end else
InfoMes(('Нет описания комманды Mov_A_EAXW для данной платформы '));
EndCros;
end;
Procedure Mov_A_EAXB(a:LongWord);
begin
WriteCros('Mov_A_EAXB(CIF)');
if PLATFORMA=80 Then begin WriteName('LD A,L;LD [NN],A');WriteHexx('7D32');WriteWord(a) end else
if PLATFORMA=16 Then begin WriteName('MOV [NN],AL') ;WriteHexx('A2') ;WriteWord(a) end else
if PLATFORMA=17 Then begin WriteName('MOV [NN],AL') ;WriteHexx('A2') ;WriteWord(a) end else
if PLATFORMA=32 Then begin WriteName('MOV [NNNN],AL') ;WriteHexx('A2') ;WriteLong(a) end else
if PLATFORMA=33 Then begin WriteName('MOV [NNNN],AL') ;WriteHexx('A2') ;WriteLong(a) end else
if PLATFORMA=34 Then begin WriteName('MOV [NNNN],AL') ;WriteHexx('A2') ;WriteLong(a) end else
InfoMes(('Нет описания комманды Mov_A_EAXB для данной платформы '));
EndCros;
end;
Procedure MOV_A_ECXW(a:Longword);
begin
WriteCros('Mov_A_ECXW(CIF)');
if PLATFORMA=80 Then begin WriteName('LD [NN],BC') ;WriteHexx('ED43');WriteWord(a); end else
if PLATFORMA=16 Then begin WriteName('MOV [NN],CX') ;WriteHexx('890d');WriteWord(a); end else
if PLATFORMA=17 Then begin WriteName('MOV [NN],CX') ;WriteHexx('890d');WriteWord(a); end else
if PLATFORMA=32 Then begin WriteName('MOV [NNNN],ECX');WriteHexx('890d');WriteLong(a); end else
if PLATFORMA=33 Then begin WriteName('MOV [NNNN],ECX');WriteHexx('890d');WriteLong(a); end else
if PLATFORMA=34 Then begin WriteName('MOV [NNNN],ECX');WriteHexx('890d');WriteLong(a); end else
InfoMes(('Нет описания комманды MOV_A_ECXW для данной платформы '));
EndCros;
end;
Procedure Mov_A_ECXB(a:LongWord);
begin
WriteCros('Mov_A_ECXB(CIF)');
if PLATFORMA=80 Then begin WriteName('LD A,C;LD [NN],A');WriteHexx('7932');WriteWord(a); end else
if PLATFORMA=16 Then begin WriteName('MOV [NN],CL') ;WriteHexx('880E');WriteWord(a); end else
if PLATFORMA=17 Then begin WriteName('MOV [NN],CL') ;WriteHexx('880E');WriteWord(a); end else
if PLATFORMA=32 Then begin WriteName('MOV [NNNN],CL') ;WriteHexx('880D');WriteLong(a); end else
if PLATFORMA=33 Then begin WriteName('MOV [NNNN],CL') ;WriteHexx('880D');WriteLong(a); end else
if PLATFORMA=34 Then begin WriteName('MOV [NNNN],CL') ;WriteHexx('880D');WriteLong(a); end else
InfoMes(('Нет описания комманды Mov_A_ECXB для данной платформы '));
EndCros;
end;
Procedure Mov_A_EDXW(a:Longword);
begin
WriteCros('Mov_A_EDXW(CIF)');
if PLATFORMA=80 Then begin WriteName('LD [NN],DE') ;WriteHexx('ED53');WriteWord(a); end else
if PLATFORMA=16 Then begin WriteName('MOV [NN],DX') ;WriteHexx('8916');WriteWord(a); end else
if PLATFORMA=17 Then begin WriteName('MOV [NN],DX') ;WriteHexx('8916');WriteWord(a); end else
if PLATFORMA=32 Then begin WriteName('MOV [NNNN],EDX');WriteHexx('8915');WriteLong(a); end else
if PLATFORMA=33 Then begin WriteName('MOV [NNNN],EDX');WriteHexx('8915');WriteLong(a); end else
if PLATFORMA=34 Then begin WriteName('MOV [NNNN],EDX');WriteHexx('8915');WriteLong(a); end else
InfoMes(('Нет описания комманды Mov_A_EDXW для данной платформы '));
EndCros;
end;
Procedure Mov_A_EDXB(a:Longword);
begin
WriteCros('Mov_A_EDXB(CIF)');
if PLATFORMA=80 Then begin WriteName('LD A,E;LD [NN],A');WriteHexx('7B32');WriteWord(a); end else
if PLATFORMA=16 Then begin WriteName('MOV [NN],DL') ;WriteHexx('8816');WriteWord(a); end else
if PLATFORMA=17 Then begin WriteName('MOV [NN],DL') ;WriteHexx('8816');WriteWord(a); end else
if PLATFORMA=32 Then begin WriteName('MOV [NNNN],DL') ;WriteHexx('8815');WriteLong(a); end else
if PLATFORMA=33 Then begin WriteName('MOV [NNNN],DL') ;WriteHexx('8815');WriteLong(a); end else
if PLATFORMA=34 Then begin WriteName('MOV [NNNN],DL') ;WriteHexx('8815');WriteLong(a); end else
InfoMes(('Нет описания комманды Mov_A_EDXB для данной платформы '));
EndCros;
end;
//--------------------------------
Procedure Mov_AEAX_W(a:Longword);
begin
WriteCros('Mov_AEAX_W(CIF)');
if PLATFORMA=80 Then begin MOV__ESI_EAX;MOV_AESI_W(a); end else
if PLATFORMA=16 Then begin MOV__ESI_EAX;MOV_AESI_W(a); end else
if PLATFORMA=17 Then begin MOV__ESI_EAX;MOV_AESI_W(a); end else
if PLATFORMA=32 Then begin MOV__ESI_EAX;MOV_AESI_W(a); end else
if PLATFORMA=33 Then begin MOV__ESI_EAX;MOV_AESI_W(a); end else
if PLATFORMA=34 Then begin MOV__ESI_EAX;MOV_AESI_W(a); end else
InfoMes(('Нет описания комманды Mov_AEAX_W для данной платформы '));
EndCros;
end;
Procedure Mov_AEAX_B(a:Byte);
begin
WriteCros('Mov_AEAX_B(CIF)');
if PLATFORMA=80 Then begin MOV__ESI_EAX;MOV_AESI_B(a); end else
if PLATFORMA=16 Then begin MOV__ESI_EAX;MOV_AESI_B(a); end else
if PLATFORMA=17 Then begin MOV__ESI_EAX;MOV_AESI_B(a); end else
if PLATFORMA=32 Then begin MOV__ESI_EAX;MOV_AESI_B(a); end else
if PLATFORMA=33 Then begin MOV__ESI_EAX;MOV_AESI_B(a); end else
if PLATFORMA=34 Then begin MOV__ESI_EAX;MOV_AESI_B(a); end else
InfoMes(('Нет описания комманды Mov_AEAX_B для данной платформы '));
EndCros;
end;
Procedure Mov_AECX_W(a:Longword);
begin
WriteCros('Mov_AECX_W(CIF)');
if PLATFORMA=80 Then begin MOV__ESI_ECX;MOV_AESI_W(a); end else
if PLATFORMA=16 Then begin MOV__ESI_ECX;MOV_AESI_W(a); end else
if PLATFORMA=17 Then begin MOV__ESI_ECX;MOV_AESI_W(a); end else
if PLATFORMA=32 Then begin MOV__ESI_ECX;MOV_AESI_W(a); end else
if PLATFORMA=33 Then begin MOV__ESI_ECX;MOV_AESI_W(a); end else
if PLATFORMA=34 Then begin MOV__ESI_ECX;MOV_AESI_W(a); end else
InfoMes(('Нет описания комманды Mov_AECX_W для данной платформы '));
EndCros;
end;
Procedure Mov_AECX_B(a:Byte);
begin
WriteCros('Mov_AECX_B(CIF)');
if PLATFORMA=80 Then begin MOV__ESI_ECX;MOV_AESI_B(a); end else
if PLATFORMA=16 Then begin MOV__ESI_ECX;MOV_AESI_B(a); end else
if PLATFORMA=17 Then begin MOV__ESI_ECX;MOV_AESI_B(a); end else
if PLATFORMA=32 Then begin MOV__ESI_ECX;MOV_AESI_B(a); end else
if PLATFORMA=33 Then begin MOV__ESI_ECX;MOV_AESI_B(a); end else
if PLATFORMA=34 Then begin MOV__ESI_ECX;MOV_AESI_B(a); end else
InfoMes(('Нет описания комманды Mov_AECX_B для данной платформы '));
EndCros;
end;
Procedure Mov_AEDX_W(a:LongWord);
begin
WriteCros('Mov_AEDX_W(CIF)');
if PLATFORMA=80 Then begin MOV__ESI_EDX;MOV_AESI_W(a); end else
if PLATFORMA=16 Then begin MOV__ESI_EDX;MOV_AESI_W(a); end else
if PLATFORMA=17 Then begin MOV__ESI_EDX;MOV_AESI_W(a); end else
if PLATFORMA=32 Then begin MOV__ESI_EDX;MOV_AESI_W(a); end else
if PLATFORMA=33 Then begin MOV__ESI_EDX;MOV_AESI_W(a); end else
if PLATFORMA=34 Then begin MOV__ESI_EDX;MOV_AESI_W(a); end else
InfoMes(('Нет описания комманды Mov_AEDX_W для данной платформы '));
EndCros;
end;
Procedure Mov_AEDX_B(a:Byte);
begin
WriteCros('Mov_AEDX_B(CIF)');
if PLATFORMA=80 Then begin MOV__ESI_EDX;MOV_AESI_B(a); end else
if PLATFORMA=16 Then begin MOV__ESI_EDX;MOV_AESI_B(a); end else
if PLATFORMA=17 Then begin MOV__ESI_EDX;MOV_AESI_B(a); end else
if PLATFORMA=32 Then begin MOV__ESI_EDX;MOV_AESI_B(a); end else
if PLATFORMA=33 Then begin MOV__ESI_EDX;MOV_AESI_B(a); end else
if PLATFORMA=34 Then begin MOV__ESI_EDX;MOV_AESI_B(a); end else
InfoMes(('Нет описания комманды Mov_AEDX_B для данной платформы '));
EndCros;
end;
procedure MOV_AESI_W(a:LongWord);
begin
WriteCros('MOV_AESI_W(CIF)');
if PLATFORMA=80 Then begin
WriteName('LD [IY+0],N;INC IY;LD [IY+0],N');
WriteHexx('FD3600');WriteWorL(a);//LD (IY+s),n
WriteHexx('FD23'); // INC IY
WriteHexx('FD3600');WriteWorH(a);// //LD (IY+s),n
end else
if PLATFORMA=16 Then begin WriteName('MOV [SI],NN') ;WriteHexx('c704');WriteWord(a);end else
if PLATFORMA=17 Then begin WriteName('MOV [SI],NN') ;WriteHexx('c704');WriteWord(a);end else
if PLATFORMA=32 Then begin WriteName('MOV [ESI],NNNN');WriteHexx('c706');WriteLong(a);end else
if PLATFORMA=33 Then begin WriteName('MOV [ESI],NNNN');WriteHexx('c706');WriteLong(a);end else
if PLATFORMA=34 Then begin WriteName('MOV [ESI],NNNN');WriteHexx('c706');WriteLong(a);end else
InfoMes(('Нет описания комманды MOV_AESI_W для данной платформы '));
EndCros;
end;
procedure MOV_AESI_B(a:Byte);
begin
WriteCros('MOV_AESI_B(CIF)');
if PLATFORMA=80 Then begin WriteName('LD [IY],N') ;WriteHexx('FD3600');WriteByte(a)end else
if PLATFORMA=16 Then begin WriteName('MOV [SI],N') ;WriteHexx('c604') ;WriteByte(a);end else
if PLATFORMA=17 Then begin WriteName('MOV [SI],N') ;WriteHexx('c604') ;WriteByte(a);end else
if PLATFORMA=32 Then begin WriteName('MOV [ESI],N');WriteHexx('c606') ;WriteByte(a);end else
if PLATFORMA=33 Then begin WriteName('MOV [ESI],N');WriteHexx('c606') ;WriteByte(a);end else
if PLATFORMA=34 Then begin WriteName('MOV [ESI],N');WriteHexx('c606') ;WriteByte(a);end else
InfoMes(('Нет описания комманды MOV_AESI_B для данной платформы '));
EndCros;
end;
//------------------------------------------------------------------------------
Procedure MOV__EDX_EAX;
begin
WriteCros('MOV__EDX_EAX');
if PLATFORMA=80 Then begin WriteName('LD D,H;LD E,L');WriteHexx('545D'); end else
if PLATFORMA=16 Then begin WriteName('MOV DX,AX') ;WriteHexx('89c2'); end else
if PLATFORMA=17 Then begin WriteName('MOV DX,AX') ;WriteHexx('89c2'); end else
if PLATFORMA=32 Then begin WriteName('MOV EDX,EAX') ;WriteHexx('89c2'); end else
if PLATFORMA=33 Then begin WriteName('MOV EDX,EAX') ;WriteHexx('89c2'); end else
if PLATFORMA=34 Then begin WriteName('MOV EDX,EAX') ;WriteHexx('89c2'); end else
InfoMes(('Нет описания комманды MOV_EDX_EAX для данной платформы '));
EndCros;
end;
//--------------------------------
procedure Mov__EAX_AEAX;
begin
WriteCros('MOV__EAX_AEAX');
if PLATFORMA=80 Then begin MOV__ESI_EAX;MOV__EAX_AESI; end else
if PLATFORMA=16 Then begin MOV__ESI_EAX;MOV__EAX_AESI; end else
if PLATFORMA=17 Then begin MOV__ESI_EAX;MOV__EAX_AESI; end else
if PLATFORMA=32 Then begin MOV__ESI_EAX;MOV__EAX_AESI; end else
if PLATFORMA=33 Then begin MOV__ESI_EAX;MOV__EAX_AESI; end else
if PLATFORMA=34 Then begin MOV__ESI_EAX;MOV__EAX_AESI; end else
InfoMes(('Нет описания комманды Mov__EAX_AEAX для данной платформы '));
EndCros;
end;
procedure Mov__EDX_AEDX;
begin
WriteCros('MOV__EDX_AEDX');
if PLATFORMA=80 Then begin MOV__ESI_EDX;MOV__EDX_AESI; end else
if PLATFORMA=16 Then begin MOV__ESI_EDX;MOV__EDX_AESI; end else
if PLATFORMA=17 Then begin MOV__ESI_EDX;MOV__EDX_AESI; end else
if PLATFORMA=32 Then begin MOV__ESI_EDX;MOV__EDX_AESI; end else
if PLATFORMA=33 Then begin MOV__ESI_EDX;MOV__EDX_AESI; end else
if PLATFORMA=34 Then begin MOV__ESI_EDX;MOV__EDX_AESI; end else
InfoMes(('Нет описания комманды Mov__EDX_AEDX для данной платформы '));
EndCros;
end;
//--------------------------------
procedure MOV_AEAX_EDX ;
begin
WriteCros('MOV_AEAX_EDX');
if PLATFORMA=80 Then begin MOV__ESI_EAX;MOV_AESI_EDX; end else
if PLATFORMA=16 Then begin MOV__ESI_EAX;MOV_AESI_EDX; end else
if PLATFORMA=17 Then begin MOV__ESI_EAX;MOV_AESI_EDX; end else
if PLATFORMA=32 Then begin MOV__ESI_EAX;MOV_AESI_EDX; end else
if PLATFORMA=33 Then begin MOV__ESI_EAX;MOV_AESI_EDX; end else
if PLATFORMA=34 Then begin MOV__ESI_EAX;MOV_AESI_EDX; end else
InfoMes(('Нет описания комманды MOV_AEAX_EDX для данной платформы '));
EndCros;
end;
procedure MOV_AEAX_DL ;
begin
WriteCros('MOV_AEAX_DL');
if PLATFORMA=80 Then begin MOV__ESI_EAX;MOV_AESI_DL; end else
if PLATFORMA=16 Then begin MOV__ESI_EAX;MOV_AESI_DL; end else
if PLATFORMA=17 Then begin MOV__ESI_EAX;MOV_AESI_DL; end else
if PLATFORMA=32 Then begin MOV__ESI_EAX;MOV_AESI_DL; end else
if PLATFORMA=33 Then begin MOV__ESI_EAX;MOV_AESI_DL; end else
if PLATFORMA=34 Then begin MOV__ESI_EAX;MOV_AESI_DL; end else
InfoMes(('Нет описания комманды MOV_AEAX_DL для данной платформы '));
EndCros;
end;
//--------------------------------
procedure Mov__AH(A:Byte);
begin
WriteCros('Mov__AH(CIF)');
if PLATFORMA=80 Then begin WriteName('LD H,N') ;WriteHexx('26');WriteByte(a); end else
if PLATFORMA=16 Then begin WriteName('MOV AH,N');WriteHexx('B4');WriteByte(a); end else
if PLATFORMA=17 Then begin WriteName('MOV AH,N');WriteHexx('B4');WriteByte(a); end else
if PLATFORMA=32 Then begin WriteName('MOV AH,N');WriteHexx('B4');WriteByte(a); end else
if PLATFORMA=33 Then begin WriteName('MOV AH,N');WriteHexx('B4');WriteByte(a); end else
if PLATFORMA=34 Then begin WriteName('MOV AH,N');WriteHexx('B4');WriteByte(a); end else
InfoMes(('Нет описания комманды Mov_AH для данной платформы '));
EndCros;
end;
procedure Mov__CH(A:Byte);
begin
WriteCros('Mov__CH(CIF)');
if PLATFORMA=80 Then begin WriteName('LD B,N') ;WriteHexx('06');WriteByte(a); end else
if PLATFORMA=16 Then begin WriteName('MOV CH,N');WriteHexx('B5');WriteByte(a); end else
if PLATFORMA=17 Then begin WriteName('MOV CH,N');WriteHexx('B5');WriteByte(a); end else
if PLATFORMA=32 Then begin WriteName('MOV CH,N');WriteHexx('B5');WriteByte(a); end else
if PLATFORMA=33 Then begin WriteName('MOV CH,N');WriteHexx('B5');WriteByte(a); end else
if PLATFORMA=34 Then begin WriteName('MOV CH,N');WriteHexx('B5');WriteByte(a); end else
InfoMes(('Нет описания комманды Mov_CH для данной платформы '));
EndCros;
end;
procedure Mov__DH(A:Byte);
begin
WriteCros('Mov__DH(CIF)');
if PLATFORMA=80 Then begin WriteName('LD D,N') ;WriteHexx('16');WriteByte(a); end else
if PLATFORMA=16 Then begin WriteName('MOV DH,N');WriteHexx('B6');WriteByte(a); end else
if PLATFORMA=17 Then begin WriteName('MOV DH,N');WriteHexx('B6');WriteByte(a); end else
if PLATFORMA=32 Then begin WriteName('MOV DH,N');WriteHexx('B6');WriteByte(a); end else
if PLATFORMA=33 Then begin WriteName('MOV DH,N');WriteHexx('B6');WriteByte(a); end else
if PLATFORMA=34 Then begin WriteName('MOV DH,N');WriteHexx('B6');WriteByte(a); end else
InfoMes(('Нет описания комманды Mov_DH для данной платформы '));
EndCros;
end;
procedure Mov__BL(A:Byte);
begin
WriteCros('Mov__BL(CIF)');
if PLATFORMA=16 Then begin WriteName('MOV BL,N');WriteHexx('B311');WriteByte(a); end else
if PLATFORMA=17 Then begin WriteName('MOV BL,N');WriteHexx('B311');WriteByte(a); end else
if PLATFORMA=32 Then begin WriteName('MOV BL,N');WriteHexx('B311');WriteByte(a); end else
if PLATFORMA=33 Then begin WriteName('MOV BL,N');WriteHexx('B311');WriteByte(a); end else
if PLATFORMA=34 Then begin WriteName('MOV BL,N');WriteHexx('B311');WriteByte(a); end else
InfoMes(('Нет описания комманды Mov_BL для данной платформы '));
EndCros;
end;
procedure Mov__AL_DL;
begin
WriteCros('MOV__AL_DL');
if PLATFORMA=80 Then begin WriteName('LD L,E') ;WriteHexx('6B'); end else
if PLATFORMA=16 Then begin WriteName('MOV AL,DL');WriteHexx('88d0'); end else
if PLATFORMA=17 Then begin WriteName('MOV AL,DL');WriteHexx('88d0'); end else
if PLATFORMA=32 Then begin WriteName('MOV AL,DL');WriteHexx('88d0'); end else
if PLATFORMA=33 Then begin WriteName('MOV AL,DL');WriteHexx('88d0'); end else
if PLATFORMA=34 Then begin WriteName('MOV AL,DL');WriteHexx('88d0'); end else
InfoMes(('Нет описания комманды Mov__AL_DL для данной платформы '));
EndCros;
end;
procedure Mov__AL_DH;
begin
WriteCros('MOV__AL_DH');
if PLATFORMA=80 Then begin WriteName('LD L,D') ;WriteHexx('6A'); end else
if PLATFORMA=16 Then begin WriteName('MOV AL,DH');WriteHexx('88f0'); end else
if PLATFORMA=17 Then begin WriteName('MOV AL,DH');WriteHexx('88f0'); end else
if PLATFORMA=32 Then begin WriteName('MOV AL,DH');WriteHexx('88f0'); end else
if PLATFORMA=33 Then begin WriteName('MOV AL,DH');WriteHexx('88f0'); end else
if PLATFORMA=34 Then begin WriteName('MOV AL,DH');WriteHexx('88f0'); end else
InfoMes(('Нет описания комманды Mov__AL_Dh для данной платформы '));
EndCros;
end;
procedure INT__(i:LongWord);
begin
if TrCo=16 Then begin WrMwm('CD');WrMwc8(i); end else
if TrCo=17 Then begin WrMwm('CD');WrMwc8(i); end else
if TrCo=32 Then begin WrMwm('CD');WrMwc8(i); end else
InfoMes(('Комманда INT__ для платформы не описана '));
end;
Procedure GetTextListCommand;// ПРосто выводит красивую табличку со всеми поддреживаемыми коммандами
var
MR:Array[1..3] of LongWord;// Список поддреживаемых режимов
f:Byte;// Эта переменная нужна для перебора списка платформ в цикле
begin
TextListCommand:='';
MR[1]:=16;// INTEL 16
MR[2]:=32;// INTEL 32
MR[3]:=80;// ZILOG Z80A
for f:=1 to 3 do
begin
trCo:=mR[f];
if f=1 then TextListCommand:=TextListCommand+'<HR> <center> 16 битный режим INTEL </center><br><br>';
if f=2 then TextListCommand:=TextListCommand+'<HR> <center> 32 битный режим INTEL </center><br><br>';
if f=3 then TextListCommand:=TextListCommand+'<HR> <center> ZILOG Z80A </center><br><br>';
//--------------------------------------------------------
TextListCommand:=TextListCommand+'<HR> <center>Процедуры для работы со стеком </center><br><br>';
PUSH_EAX;PUSH_ECX;PUSH_EDX;PUSH_ESI;
POP__EAX;POP__ECX;POP__EDX;POP__ESI;
TextListCommand:=TextListCommand+'<HR> <center> Инскримент Дискримент </center><br><br>';
INC__EAX;INC__ECX;INC__EDX;INC__ESI;
DEC__EAX;DEC__ECX;DEC__EDX;DEC__ESI;
TextListCommand:=TextListCommand+'<HR> <center> Обнуление регистров </center><br><br>';
XOR__EAX;XOR__ECX;XOR__EDX;XOR__ESI;
TextListCommand:=TextListCommand+'<HR> <center> Заполнение регистров </center><br><br>';
MOV__EAX(0);MOV__ECX(0);MOV__EDX(0);MOV__ESI(0);
TextListCommand:=TextListCommand+'<HR> <center> Заполнение регистров из памяти </center><br><br>';
MOV__EAX_AW(0);MOV__EAX_AB(0);
MOV__ECX_AW(0);MOV__ECX_AB(0);
MOV__EDX_AW(0);MOV__EDX_AB(0);
TextListCommand:=TextListCommand+'<HR> <center> Сохранение знаяения регистров В память </center><br><br>';
Mov_A_EAXW(0);Mov_A_EAXB(0);
MOV_A_ECXW(0);MOV_A_ECXB(0);
Mov_A_EDXW(0);Mov_A_EDXB(0);
TextListCommand:=TextListCommand+'<HR> <center> Запись в память по адресу в регистре </center><br><br>';
Mov_AEAX_W(0);Mov_AEAX_B(0);
Mov_AECX_W(0);Mov_AECX_B(0);
Mov_AEDX_W(0);Mov_AEDX_B(0);
TextListCommand:=TextListCommand+'<HR> <center> Условые переходы подпрограммы </center><br><br>';
CMP__EAX_EDX;
JA___('АДРЕС');
JAE__('АДРЕС');
JE___('АДРЕС');
JNE__('АДРЕС');
JB___('АДРЕС');
JBE__('АДРЕС');
JMP__('АДРЕС');
RET__;
CAL__('АДРЕС');
CAL__(0);
TextListCommand:=TextListCommand+'<HR> <center> Арифметика </center><br><br>';
SUB__ESP(0);// Уменьшает стек
ADD__ESP(0);// Увеличивает стек
SUB__EAX_EDX;
SUB__EAX_ECX;
ADD__EAX_EDX;
ADD__ESI(0);
ADD__EAX_ESP;
TextListCommand:=TextListCommand+'<HR> <center> Различные перемещения между регистрами </center><br><br>';
// Различные перемещения между регистрами
MOV__EAX_AESI;
MOV__ECX_AESI;
MOV__EDX_AESI;
//--------------------------------------------------------
MOV_AESI_EAX;
MOV_AESI_ECX;
MOV_AESI_EDX;
MOV_AESI_AL;
MOV_AESI_CL;
MOV_AESI_DL;
MOV_AESI_W(0);
MOV_AESI_B(0);
//--------------------------------------------------------
MOV__ESP_EAX;
MOV__ESI_ESP;
MOV__ESI_EAX;
MOV__ESI_EDX;
MOV__EDX_EAX;
Mov__EAX_AEAX;
Mov__EDX_AEDX;
MOV_AEAX_EDX;
MOV_AEAX_DL ;
Mov__AL_DL;
Mov__AL_Dh;
Mov__AH(0);
Mov__CH(0);
Mov__DH(0);
end;
end;
{$ENDIF}
{ Кроплатформенные комманды } {$IFDEF Tim}
function ATRA(a:String):String;
var
rez:String;
begin
if a[1]='@'
then rez:='@'+IntToStr(LPERS.RA(a))
else Rez:=IntToStr(AdrPer(a));
ATRA:=Rez;
end;
//------------------------------------------------------------------------------
procedure O_LOA__EAX(a:string);// Оригинальная загрука регистра Original
begin
if a[1]='@' then
begin
MOV__ESI_ESP;
ADD__ESI(LPERS.RA(a)+ADDSP);//ADDSP:=2;ADDSP:=4;
MOV__EAX_AESI;
end else MOV__EAX_AW(AdrPer(a));// загружает адрес обычной переменной
end;
procedure O_LOA__EDX(a:string);
begin
if a[1]='@' then
begin
MOV__ESI_ESP;
ADD__ESI(LPERS.RA(a)+ADDSP);
MOV__EDX_AESI;
end else MOV__EDX_AW(AdrPer(a));
end;
procedure O_LOA__ECX(a:string);
begin
if a[1]='@' then
begin
MOV__ESI_ESP;
ADD__ESI(LPERS.RA(a)+ADDSP);
MOV__ECX_AESI;
end else MOV__ECX_AW(AdrPer(a));
end;
procedure O_SAV__EAX(a:string);
begin
if a[1]='@' then
begin
MOV__ESI_ESP;
ADD__ESI(LPERS.RA(a)+ADDSP);
MOV_AESI_EAX;
end else MOV_A_EAXW(AdrPer(a));
end;
procedure O_SAV__EDX(a:string);
begin
if a[1]='@' then
begin
MOV__ESI_ESP;
ADD__ESI(LPERS.RA(a)+ADDSP);
MOV_AESI_EDX;
end else MOV_A_EDXW(AdrPer(a));
end;
procedure O_SAV__ECX(a:string);
begin
if a[1]='@' then
begin
MOV__ESI_ESP;
ADD__ESI(LPERS.RA(a)+ADDSP);
MOV_AESI_ECX;
end else MOV_A_ECXW(AdrPer(a));
end;
//------------------------------------------------------------------------------
procedure LOA__EAX(a:string);
var
m:String;
begin
M:='PR'+IntToStr(MUka);
if SFuns.Fin('LOA__EAX'+ATRA(a))=nil then
begin JMP__(m);SeFu('LOA__EAX'+ATRA(a));O_LOA__EAX(a);Ret__;end;
SeLa(m);Cal__('LOA__EAX'+ATRA(a));
end;
procedure LOA__EAX(a:LongWord);// загружает В ригистр EAX число
begin
MOV__EAX(a);
end;
procedure LOA__EDX(a:string);
var
m:String;
begin
M:='PR'+IntToStr(MUka);
if SFuns.Fin('LOA__EDX'+ATRA(a))=nil then
begin JMP__(m);SeFu('LOA__EDX'+ATRA(a));O_LOA__EDX(a);Ret__;end;
SeLa(m); Cal__('LOA__EDX'+ATRA(a));
end;
procedure LOA__EDX(a:LongWord);// загружает в регистр EDX число
begin
MOV__EDX(a);
end;
procedure LOA__ECX(a:string);
var
m:String;
begin
M:='PR'+IntToStr(MUka);
if SFuns.Fin('LOA__ECX'+ATRA(a))=nil then
begin JMP__(m);SeFu('LOA__ECX'+ATRA(a));O_LOA__ECX(A);Ret__;end;
SeLa(m);Cal__('LOA__ECX'+ATRA(a));
end;
procedure LOA__ECX(a:LongWord);// загружает в регистр ECX число
begin
MOV__ECX(a);
end;
procedure SAV__EAX(a:string);
var
m:String;
begin
M:='PR'+IntToStr(MUka);
if SFuns.Fin('SAV__EAX'+ATRA(a))=nil then
begin JMP__(m);SeFu('SAV__EAX'+ATRA(a));O_SAV__EAX(a);Ret__;end;
SeLa(m); Cal__('SAV__EAX'+ATRA(a));
end;
procedure SAV__EDX(a:string);
var
m:String;
begin
M:='PR'+IntToStr(MUka);
if SFuns.Fin('SAV__EDX'+ATRA(a))=nil then
begin JMP__(m);SeFu('SAV__EDX'+ATRA(a));O_SAV__EDX(a);Ret__;end;
SeLa(m); Cal__('SAV__EDX'+ATRA(a));
end;
procedure SAV__ECX(a:string);
var
m:String;
begin
M:='PR'+IntToStr(MUka);
if SFuns.Fin('SAV__ECX'+ATRA(a))=nil then
begin JMP__(m);SeFu('SAV__ECX'+ATRA(a));O_SAV__ECX(a);Ret__;end;
SeLa(m); Cal__('SAV__ECX'+ATRA(a));
end;
//------------------------------------------------------------------------------
Procedure REA_W(a,b:String);
var
m:String;
begin
if SFuns.Fin('REA_W'+ATRA(a)+'_'+ATRA(b))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('REA_W'+ATRA(a)+'_'+ATRA(b));
Pop__EDX;
//------------
LOA__EAX(b);
MOV__EAX_AEAX;
SAV__EAX(A);
//------------
Push_EDX;
Ret__;
SeLa(m); Cal__('REA_W'+ATRA(a)+'_'+ATRA(b));
end else Cal__('REA_W'+ATRA(a)+'_'+ATRA(b));
end;
Procedure REA_B(a,b:String);
var
m:String;
begin
if SFuns.Fin('REA_B'+ATRA(a)+'_'+ATRA(b))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('REA_B'+ATRA(a)+'_'+ATRA(b));
Pop__ECX;
//------------
LOA__EDX(b);
MOV__EDX_AEDX;
XOR__EAX;
MOV__AL_DL;
SAV__EAX(A);
//-------------
Push_ECX;
Ret__;
SeLa(m); Cal__('REA_B'+ATRA(a)+'_'+ATRA(b));
end else Cal__('REA_B'+ATRA(a)+'_'+ATRA(b));
end;
Procedure WRI_W(a,b:String);
var
m:String;
begin
if SFuns.Fin('WRI_W'+ATRA(a)+'_'+ATRA(b))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('WRI_W'+ATRA(a)+'_'+ATRA(b));
Pop__ECX;
//------------
LOA__EAX(a);
LOA__EDX(b);
MOV_AEAX_EDX;
//-------------
Push_ECX;
Ret__;
SeLa(m); Cal__('WRI_W'+ATRA(a)+'_'+ATRA(b));
end else Cal__('WRI_W'+ATRA(a)+'_'+ATRA(b));
end;
Procedure WRI_B(a,b:String);
var
m:String;
begin
if SFuns.Fin('WRI_B'+ATRA(a)+'_'+ATRA(b))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('WRI_B'+ATRA(a)+'_'+ATRA(b));
Pop__ECX;
//------------
LOA__EAX(a);
LOA__EDX(b);
MOV_AEAX_DL;
//-------------
Push_ECX;
Ret__;
SeLa(m); Cal__('WRI_B'+ATRA(a)+'_'+ATRA(b));
end else Cal__('WRI_B'+ATRA(a)+'_'+ATRA(b));
end;
Procedure WRI_W(a:String;b:LongWord);
begin
LOA__EAX(a);
MOV_AEAX_W(b);
end;
Procedure WRI_B(a:String;b:Byte);
begin
LOA__EAX(a);
MOV_AEAX_B(b);
end;
//------------------------------------------------------------------------------
Procedure PRI__(a,b:String);
begin
LOA__EAX(B);
SAV__EAX(a);
end;
Procedure PRI__(a:String;B:Longword);
begin
MOV__EAX(b);
SAV__EAX(a);
end;
// Арифметика ------------------------------------------------------------------
procedure INC__(a:String);
var
m:String;
begin
if SFuns.Fin('INC__'+ATRA(a))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('INC__'+ATRA(a));
Pop__ECX;
//------------
LOA__EAX(a);
INC__EAX;
SAV__EAX(a);
//-------------
Push_ECX;
Ret__;
SeLa(m); Cal__('INC__'+ATRA(a));
end else Cal__('INC__'+ATRA(a));
end;
procedure INC_W(a:String);
begin
LOA__EAX(a);
if TrCo=80 then begin MOV__EDX(2);ADD__EAX_EDX;end else
if TrCo=16 then begin MOV__EDX(2);ADD__EAX_EDX;end else
if TrCo=17 then begin MOV__EDX(2);ADD__EAX_EDX;end else
if TrCo=32 then begin MOV__EDX(4);ADD__EAX_EDX;end else
if TrCo=33 then begin MOV__EDX(4);ADD__EAX_EDX;end else
if TrCo=34 then begin MOV__EDX(4);ADD__EAX_EDX;end else
if TrCo=64 then begin MOV__EDX(8);ADD__EAX_EDX;end else
InfoMes(('Для данной платформы не описано INC_W'));
SAV__EAX(a);
end;
procedure DEC__(a:String);
var
m:String;
begin
if SFuns.Fin('DEC__'+ATRA(a))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('DEC__'+ATRA(a));
Pop__ECX;
//------------
LOA__EAX(a);
DEC__EAX;
SAV__EAX(a);
//-------------
Push_ECX;
Ret__;
SeLa(m); Cal__('DEC__'+ATRA(a));
end else Cal__('DEC__'+ATRA(a));
end;
procedure ADD__(a,b:String);
var
m:String;
begin
if SFuns.Fin('ADD__'+ATRA(a)+'_'+ATRA(b))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('ADD__'+ATRA(a)+'_'+ATRA(b));
Pop__ECX;
//------------ }
LOA__EAX(a);
LOA__EDX(b);
ADD__EAX_EDX;
SAV__EAX(a);
//-------------
Push_ECX;
Ret__;
SeLa(m); Cal__('ADD__'+ATRA(a)+'_'+ATRA(b));
end else Cal__('ADD__'+ATRA(a)+'_'+ATRA(b));
end;
procedure ADD__(a:String;b:LongWord);
var
m:String;
begin
if SFuns.Fin('ADD__'+ATRA(a)+'_L'+IntToStr(b))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('ADD__'+ATRA(a)+'_L'+IntToStr(b));
Pop__ECX;
//------------
LOA__EAX(a);
MOV__EDX(b);
ADD__EAX_EDX;
SAV__EAX(a);
//-------------
Push_ECX;
Ret__;
SeLa(m); Cal__('ADD__'+ATRA(a)+'_L'+IntToStr(b));
end else Cal__('ADD__'+ATRA(a)+'_L'+IntToStr(b));
end;
procedure SUB__(a,b:String);
var
m:String;
begin
if SFuns.Fin('SUB__'+ATRA(a)+'_'+ATRA(b))=nil then
begin
M:='PR'+IntToStr(MUka);
JMP__(m);
SeFu('SUB__'+ATRA(a)+'_'+ATRA(b));
Pop__ECX;
//------------
LOA__EAX(a);
LOA__EDX(b);
SUB__EAX_EDX;
SAV__EAX(a);
//-------------
Push_ECX;
Ret__;
SeLa(m); Cal__('SUB__'+ATRA(a)+'_'+ATRA(b));
end else Cal__('SUB__'+ATRA(a)+'_'+ATRA(b));
end;
procedure SUB__(a:String;b:LongWord);
begin
LOA__EAX(a);
MOV__EDX(b);
SUB__EAX_EDX;
SAV__EAX(a);
end;
// Условные переходы вызов подпрограмм -----------------------------------------
procedure BOL__(a,b,c:String);
begin
LOA__EAX(a);
LOA__EDX(b);
If TrCo=80 Then begin INC__EDX;CMP__EAX_EDX;JAE__(c);end else
If TrCo=16 Then begin CMP__EAX_EDX;JA___(c);end else
If TrCo=17 Then begin CMP__EAX_EDX;JA___(c);end else
If TrCo=32 Then begin CMP__EAX_EDX;JA___(c);end else
If TrCo=33 Then begin CMP__EAX_EDX;JA___(c);end else
If TrCo=34 Then begin CMP__EAX_EDX;JA___(c);end else
InfoMes(('Коммангда BOL__ ДЛя платформы не описана '));
end;
procedure BOL__(a:String;b:LongWord;c:String);
begin
LOA__EAX(a);
MOV__EDX(b);
If TrCo=80 Then begin INC__EDX;CMP__EAX_EDX;JAE__(c);end else
If TrCo=16 Then begin CMP__EAX_EDX;JA___(c);end else
If TrCo=17 Then begin CMP__EAX_EDX;JA___(c);end else
If TrCo=32 Then begin CMP__EAX_EDX;JA___(c);end else
If TrCo=33 Then begin CMP__EAX_EDX;JA___(c);end else
If TrCo=34 Then begin CMP__EAX_EDX;JA___(c);end else
InfoMes(('Коммангда BOL__ ДЛя платформы не описана '));
end;
procedure BRA__(a,b,c:String);
begin
LOA__EAX(a);
LOA__EDX(b);
CMP__EAX_EDX;
JAE__(c);
end;
procedure BRA__(a:String;b:LongWord;c:String);
begin
LOA__EAX(a);
MOV__EDX(b);
CMP__EAX_EDX;
JAE__(c);
end;
procedure RAV__(a,b,c:String);
begin
LOA__EAX(a);
LOA__EDX(b);
CMP__EAX_EDX;
JE___(c);
end;
procedure RAV__(a:String;b:LongWord;c:String);
begin
LOA__EAX(a);
MOV__EDX(b);
CMP__EAX_EDX;
JE___(c);
end;
procedure NRA__(a,b,c:String);
begin
LOA__EAX(a);
LOA__EDX(b);
CMP__EAX_EDX;
JNE__(c);
end;
procedure NRA__(a:String;b:LongWord;c:String);
begin
LOA__EAX(a);
MOV__EDX(b);
CMP__EAX_EDX;
JNE__(c);
end;
procedure MEN__(a,b,c:String);
begin
LOA__EAX(a);
LOA__EDX(b);
If TrCo=80 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=16 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=17 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=32 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=33 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=34 then begin CMP__EAX_EDX;JB___(c);end else
InfoMes(('Коммангда MEN__ ДЛя платформы не описана '));
end;
procedure MEN__(a:String;b:LongWord;c:String);
begin
LOA__EAX(a);
MOV__EDX(b);
If TrCo=80 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=16 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=17 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=32 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=33 then begin CMP__EAX_EDX;JB___(c);end else
If TrCo=34 then begin CMP__EAX_EDX;JB___(c);end else
InfoMes(('Коммангда MEN__ ДЛя платформы не описана '));
end;
procedure MRA__(a,b,c:String);
begin
LOA__EAX(a);
LOA__EDX(b);
If TrCo=80 then begin CMP__EAX_EDX;JB___(c);JE___(c);end else
If TrCo=16 then begin CMP__EAX_EDX;JBE__(c);end else
If TrCo=17 then begin CMP__EAX_EDX;JBE__(c);end else
If TrCo=32 then begin CMP__EAX_EDX;JBE__(c);end else
If TrCo=33 then begin CMP__EAX_EDX;JBE__(c);end else
If TrCo=34 then begin CMP__EAX_EDX;JBE__(c);end else
InfoMes(('Коммангда MRA__ ДЛя платформы не описана '));
end;
procedure MRA__(a:String;b:LongWord;c:String);
begin
LOA__EAX(a);
MOV__EDX(b);
If TrCo=80 then begin CMP__EAX_EDX;JB___(c);JE___(c);end else
If TrCo=16 then begin CMP__EAX_EDX;JBE__(c);end else
If TrCo=17 then begin CMP__EAX_EDX;JBE__(c);end else
If TrCo=32 then begin CMP__EAX_EDX;JBE__(c);end else
If TrCo=33 then begin CMP__EAX_EDX;JBE__(c);end else
If TrCo=34 then begin CMP__EAX_EDX;JBE__(c);end else
InfoMes(('Коммангда MRA__ ДЛя платформы не описана '));
end;
{$ENDIF}
{ Секция для работы с Строками } {$IFDEF Tim}
Function DelRAs(s:Ansistring):Ansistring;
var
f,f2:Longint;
rez:Ansistring;
begin
f:=Length(s);
if f=0 Then InfoMes('Имя файла указано не верно пустоая строка DelRA.UStr');
While (s[f]<>'.') and (f>0) do dec(f);
Dec(f);
for f2:=1 to f do
REz:=rez+s[f2];
DelRAs:=REz;
end;
Function TexToInt(s:String):Longword;
begin
TexToInt:=HexToInt(IntToHex8(Ord(s[1]))+IntToHex8(Ord(s[2])));
end;
Function KolSlov(s:Ansistring;r:char):Longint;
var
f,rez:Longint;
begin
if length(s)=0 then rez:=0 else rez:=1;
for f:=1 to Length(s) do
if s[f]=r Then REz:=rez+1;
KolSlov:=rez;
end;
Function SlovoN(s:Ansistring;r:char;n:Longint):Ansistring;
var
f,ns,ls:Longint;
rez:Ansistring;
begin
ns:=1;
rez:='';
ls:=length(s);
f:=1;
while (NS<=N)and(f<=ls) do
begin
if s[f]=r then ns:=ns+1 else
if ns=n then rez:=rez+s[f];
f:=f+1;
end;
SlovoN:=rez;
end;
function est(s1,s2:ansistring):boolean;
var
rez:boolean;
f:longint;
begin
rez:=false;
for f:=1 to kolslov(s1,',') do
if slovoN(s1,',',f)=s2 then
begin
rez:=true;
break;
end;
est:=rez;
end;
Function Dopolnit(s:Ansistring;c:Char;k:byte):Ansistring;
var
f:Longint;
rez:Ansistring;
begin
rez:=s;
for f:=length(s) to k do
rez:=c+rez;
Dopolnit:=rez;
end;
Function StrToCifra(s:String):REal;
var
f:Longint;
begin
for f:=1 to length(s) do
if s[f]='.' Then s[f]:=',';
StrToCifra:=StrToFloat(s);
end;
function ReadCif(var UK,LE:Longint;S:Ansistring):Ansistring;// Читает цифру из строки если не удаеться возвращает пустую строку
var
rez:Ansistring;
kt:Byte;
begin
kt:=0;
rez:='';
if (UK<=LE) and((s[UK]>='0') and (s[UK]<='9')) Then
while (UK<=LE) and (((s[UK]>='0') and (s[UK]<='9'))or(s[UK]='.'))and (kt<2) do
begin
if s[UK]='.' then kt:=kt+1;
if kt<=1 then
begin
rez:=rez+s[UK];
UK:=UK+1;
end;
end;
ReadCif:=rez;
end;
Function EtoCif(uk,Le:Longint;s:Ansistring):Boolean;// Проверяет цифра ли это в строке
var
rez:Boolean;
begin
if ReadCif(uk,le,s)<>'' Then Rez:=true else rez:=false;
EtoCif:=rez;
end;
Function CifraFloat(s:Ansistring):Real;// Преобразует строку в цифру в случае если это цифра
var
uk,le:Longint;
REz:Real;
begin
rez:=0;uk:=1;le:=length(s);
If EtoCif(uk,le,s) then rez:=StrToCifra(REadCif(uk,le,s));
CifraFloat:=rez;
end;
function ReadKav(var UK,LE:Longint;S:Ansistring):Ansistring;//Читает строку в кавычках ' из строки если не удаеться возвращает пустую строку
var
rez:Ansistring;
begin
rez:='';
if (UK<=LE) and ((s[UK]=chr(39)) or (s[UK]='"')) Then
begin
UK:=UK+1;
while (UK<=LE)and (s[UK]<>chr(39)) and (s[UK]<>'"') do
begin
rez:=rez+s[UK];
UK:=UK+1;
end;
UK:=UK+1;
end;
ReadKav:=rez;
end;
Function EtoKav(uk,Le:Longint;s:Ansistring):Boolean;// ПРоверяет идет ли следующим в строке строка в кавычках '
var
rez:Boolean;
begin
if s[uk]=chr(39) Then Rez:=true else rez:=false;
EtoKav:=rez;
end;
function ReadRem(var UK,LE:Longint;S:Ansistring):Ansistring;// Читает коментарий мз строки в случае не удачи возвращает пустую строку
var
rez:Ansistring;
begin
rez:='';
if (UK<LE) and (s[uk]+s[uk+1]='/*') then
begin
UK:=UK+2;
While (UK<LE) and (s[uk]+s[uk+1]<>'*/') do
begin
rez:=rez+s[uk];
uk:=uk+1;
end;
uk:=uk+2;
end else
if (UK<LE) and (s[uk]+s[uk+1]='//') then
begin
UK:=UK+2;
While (UK<=LE) and (s[uk]<>Chr(13)) do
begin
rez:=rez+s[uk];
uk:=uk+1;
end;
uk:=uk+1;
end;
ReadRem:=rez;
end;
Function EtoRem(uk,Le:Longint;s:Ansistring):Boolean;// проверяет идет ли далее в строке коментарий
var
rez:Boolean;
begin
rez:=false;
if (uk<le) then
if (s[uk]+s[uk+1]='/*') or (s[uk]+s[uk+1]='//') Then Rez:=true;
EtoRem:=rez;
end;
function ReadZn2(var UK,LE:Longint;S:Ansistring):Ansistring;// Читает Двойной знак из строки в случае неудачи возвращает пустую строку
var
rez,r:Ansistring;
NP:Longint;
begin
r:=':=<=>=<>!=>><<';
rez:='';
NP:=1;
If UK+1<=LE Then
While (rez='') and (Length(r)>=NP) do
if (s[UK]=r[np]) and (s[UK+1]=r[np+1]) then
begin
rez:=s[UK]+s[uk+1];
UK:=UK+2;
end else Np:=Np+2;
ReadZn2:=rez;
end;
Function EtoZn2(uk,Le:Longint;s:Ansistring):Boolean;// Определяет идет ли далее Двойной знак
var
rez:Boolean;
begin
if ReadZn2(uk,le,s)<>'' Then Rez:=true else rez:=false;
EtoZn2:=rez;
end;
function ReadZn1(var UK,LE:Longint;S:Ansistring):Ansistring;// Читает одинарный знак из строки в случае неудачи возвращает пустую строку
var
rez,r:Ansistring;
NP:Longint;
begin
R:='+-/\*()[]><=:{}';
rez:='';
NP:=1;
If UK<=LE Then
While (rez='') and (Length(r)>=NP) do
if (s[UK]=r[np]) then
begin
rez:=s[UK];
UK:=UK+1;
end else Np:=Np+1;
ReadZn1:=rez;
end;
Function EtoZn1(uk,Le:Longint;s:Ansistring):Boolean;// Определяет идет ли далее одинарный знак
var
rez:Boolean;
begin
if ReadZn1(uk,le,s)<>'' Then Rez:=true else rez:=false;
EtoZn1:=rez;
end;
Function Predel(C:Char;R:Ansistring):Boolean;// Проверки Вхождления Символа в определенные пределы
var
rez:Boolean;
Np:Longint;
begin
NP:=1;rez:=False;
While (NP<Length(R)) and (rez=False) do
if (C>=R[NP]) AnD (C<=R[NP+1])
Then rez:=true
else NP:=NP+2;
Predel:=rez;
end;
function Readope(var UK,LE:Longint;S:Ansistring):Ansistring;// Читает оператор из строки
var
rez:Ansistring;
begin
rez:='';
if (UK<LE) and (predel(s[UK],'аяАЯazAZёЁ')) Then
while (UK<LE) and (predel(s[uk],'аяАЯёёЁЁazAZ__09')) do
begin
rez:=rez+s[uk];
Uk:=Uk+1;
end;
Readope:=rez;
end;
Function EtoOpe(uk,Le:Longint;s:Ansistring):Boolean;// ПРоверяет идет ли следующим в строке оператор в случае неудачи возвращает пустуюстроку
var
rez:Boolean;
begin
if Readope(uk,le,s)<>'' Then Rez:=true else rez:=false;
EtoOpe:=rez;
end;
//==============================================================================
//==============================================================================
//==============================================================================
procedure Del__Sim(s,c:String); // Удаляет в строке символ
begin
Loa__EAX(s);
Loa__EDX(c);
CAL__('DELSimvol');
end;
Procedure Cre__Str(a:String); // Создает новую строку
begin
cal__('GetString');
SAV__EAX(a);
end;
procedure Add__Sim(s,c:String); // ПРисоеденяет к строке символ
begin
LOA__EAX(s);
LOA__EDX(c);
CAL__('AsiString');
end;
procedure Add__Sim(s:String;c:Byte); // ПРисоеденяет к строке символ
begin
LOA__EAX(s);
LOA__EDX(c);
CAL__('AsiString');
end;
procedure Del__Sim(s:String;C:Byte); // Удаляет в строке символ
begin
Loa__EAX(s);
Loa__EDX(c);
CAL__('DELSimvol');
end;
Procedure Cop__Str(a,b:String); // Копирует строку
begin
Loa__EAX(a);
Loa__EDX(b);
CAL__('CopString');
end;
Procedure Fre__Str(a:String); // Освобождает строку
begin
Loa__EAX(a);
cal__('FreString');
end;
Procedure DelSimvol;// EAX:Строка EDX Символ Возвращает новую обработаную строку Удаляет указаный символ из строки
begin
BeginProcedure('DelSimvol');
Sav__EAX('@STR'); // Сторка из котрой удаляем символ
Sav__EDX('@DSI'); // Удаляемый сивол
Cre__Str('@REZ'); // Строка результат
REA_B('@LEN','@STR');// Читаем длинну строки
Pri__('@UKA','@STR');// Создаем указатель для считтывания строки
INC__('@UKA');
SeLa('CIK'); RAV__('@LEN',0,'ECIK');
REA_B('@SIM','@UKA');
rav__('@SIM','@DSI','NEX');
ADD__SIM('@REZ','@SIM');
SeLa('NEX'); DEC__('@LEN');INC__('@UKA');
JMP__('CIK');
SeLa('ECIK');
Cop__Str('@STR','@Rez');
Fre__Str('@REz');
EndProcedure;
end;
procedure Pos__Sim(r,s,c:String); // Ищит в строке символ и возвращает позицию если есть
begin
Loa__EAX(s);
Loa__EDX(c);
CAL__('PosSimvol');
SAV__EAX(r);
end;
procedure POs__Sim(r,s:String;c:Byte); // Ищит в строке символ и возвращает позицию если есть
begin
Loa__EAX(s);
Loa__EDX(c);
CAL__('PosSimvol');
SAV__EAX(r);
end;
Procedure PosSimvol;// EAX:Строка EDX Символ Возвращает новую обработаную строку Удаляет указаный символ из строки
begin
BeginProcedure('POSSimvol');
Sav__EAX('@STR'); // Сторка В котрой ищим смвол
Sav__EDX('@DSI'); // Искомый символ
REA_B('@LEN','@STR');// Читаем длинну строки
Pri__('@UKA','@STR');// Создаем указатель для считтывания строки
Pri__('@END','@STR');
ADD__('@END','@LEN');
INC__('@UKA');
RAV__('@LEN',0,'NET');
SeLa('CIK'); BOL__('@UKA','@END','NET');
REA_B('@SIM','@UKA');
rav__('@SIM','@DSI','EST');
INC__('@UKA');
JMP__('CIK');
SeLa('EST');
PRI__('@REZ','@UKA');
SUB__('@REZ','@STR');
JMP__('VIHOD');
SeLa('NET'); PRI__('@REZ',0);
SeLa('VIHOD'); LOA__EAX('@REZ');
EndProcedure;
end;
Procedure Sim__NOM(c,s,n:String); // Возвращает символ из строки
Begin
PRI__('@SIMNOMUK',S);
ADD__('@SIMNOMUK',N);
REA_B(C,'@SIMNOMUK');
end;
Procedure Sim__SET(s,n,c:String); // Возвращает символ из строки
begin
PRI__('@SIMNOMUK',S);
ADD__('@SIMNOMUK',N);
Wri_B('@SIMNOMUK',C);
end;
Procedure Sim__SET(s,n:String;C:Byte); // Возвращает символ из строки
begin
PRI__('@SIMNOMUK',S);
ADD__('@SIMNOMUK',N);
Wri_B('@SIMNOMUK',C);
end;
Procedure Tip__Str(t,s:String); // Определяет тип строки если цифра то 1
Begin
LOA__EAX(s);
cal__('TipString');
SAV__EAX(t);
end;
Procedure LEn__Str(L,S:String); // Oпределяет Длину строки
Begin
REA_B(l,s);
end;
procedure Add__SSI(s,c:String); // Добавляет символ в начало строки
Begin
Loa__EAX(s);
Loa__EDX(C);
Cal__('ASSString');
end;
procedure Add__SSI(s:String;C:byte); // Добавляет символ в начало строки
Begin
Loa__EAX(s);
Loa__EDX(C);
Cal__('ASSString');
end;
Procedure Rav__Str(a,b,c:String); // eax: строка 1 edx:строка 2 возврвщает
begin
Loa__EAX(a);
Loa__EDX(b);
CAL__('RavString');
SAV__EAX('@QWE_RAV');
RAV__('@QWE_RAV',1,C);
end;
Procedure Bol__Str(a,b,c:String); // eax: строка 1 edx:строка 2 возврвщает
begin
Loa__EAX(a);
Loa__EDX(b);
CAL__('BolString');
SAV__EAX('@QWE_BOL');
RAV__('@QWE_BOL',1,C);
end;
Procedure Men__Str(a,b,c:String); // eax: строка 1 edx:строка 2 возврвщает
begin
Loa__EAX(a);
Loa__EDX(b);
CAL__('MenString');
SAV__EAX('@QWE_Men');
RAV__('@QWE_Men',1,C);
end;
Procedure NRa__Str(a,b,c:String); // eax: строка 1 edx:строка 2 возврвщает
begin
Loa__EAX(a);
Loa__EDX(b);
CAL__('RavString');
SAV__EAX('@QWE_RAV');
RAV__('@QWE_RAV',0,C);
end;
Procedure Kol__Str(s,r,k:String); // Определяет количество Слов в строке
begin
LOA__EAX(s);
LOA__EDX(r);
CAL__('KolString');
SAV__EAX(k);
end;
Procedure Slo__Str(s,n,r,rez:String); // Выделяет слово номер N из строки s с разделителм R
begin
LOA__EAX(s);
LOA__EDX(n);
LOA__ECX(r);
CAL__('SloString');
SAV__EAX(rez);
end;
Procedure Vho__Str(Slo,spi,r,c:String);// ПРоверяет вхождение слова
begin
LOA__EAX(SLO);
LOA__EDX(SPI);
LOA__ECX(R);
CAL__('VhoString');
SAV__EAX('@QWE_NOM');
NRA__('@QWE_NOM',0,c);
end;
Procedure NVh__Str(Slo,spi,r,c:String);// ПРоверяет вхождение слова если не входит переход
begin
LOA__EAX(SLO);
LOA__EDX(SPI);
LOA__ECX(R);
CAL__('VhoString');
SAV__EAX('@QWE_NOM');
Rav__('@QWE_NOM',0,c);
end;
Procedure Add__Str(a,b:String); // Сложение строк
begin
LOA__EAX(A);
LOA__EDX(B);
CAl__('SumString');
end;
procedure TipString; // ПРоцедура Определяет тип строки если цифра то 1
begin
BeginProcedure('TipString');
SAV__EAX('@STR');
Len__Str('@L','@STR');
PRI__('@KTO',0);
PRI__('@F',1);
RAV__('@L',0,'STROKA');
Sim__Nom('@SIM','@STR','@F');
NRA__('@SIM',Ord('-'),'NEX');
INC__('@F');
SeLa('NEX');
SeLa('CIK'); BOL__('@F','@L','CIFRA');
Sim__Nom('@SIM','@STR','@F');
NRA__('@SIM',Ord('.'),'CIF');
INC__('@KTO');// увеличиваем количсетво точек
BOL__('@KTO',1,'STROKA');
INC__('@F');
JMP__('CIK');
SeLa('CIF');
BOL__('@SIM',Ord('9'),'STROKA');
MEN__('@SIM',Ord('0'),'STROKA');
INC__('@F');
JMP__('CIK');
SeLa('STROKA');Pri__('@REZ',0);
JMP__('VIHOD');
SeLa('Cifra'); Pri__('@REZ',1);
SeLa('VIHOD'); Loa__EAX('@REZ');
EndProcedure;
end;
procedure GetString; // ПРоцедура создает Новую строку в памяти
begin
BeginProcedure('GetString');
// Ищим свободное зерно
Pri__('@Fin','TrMe');
SeLa('Cikl'); REa_b('@Del','@Fin');
RAV__('@Del',0,'Nex');
Add__('@FIN',Zerno);
JMP__('CIKL');
SeLa('NEX'); // Создаем строку
SeLa('CrSt'); Wri_B('@Fin',1);INC__('@Fin'); // записываем что этот участок памяти вделен под строку
PRI__('@REZ','@Fin'); // Записываем адрес строки
Wri_B('@Fin',0); // Обнуляем длину строки
SeLa('VIHOD');Loa__EAX('@REZ'); // возвращаем результат
EndProcedure;
end;
procedure CrSt(N,Z:String);
begin
if TrCo=80 Then
begin
SePe('S_'+n);WrMwc8(Length(z));WrMwS(z);WrMwc8(0);
SePe(n);WrMw16(adrPer('S_'+n));
end else
if TrCo=16 Then
begin
SePe('S_'+n);WrMwc8(Length(z));WrMwS(z);WrMwc8(0);
SePe(n);WrMw16(adrPer('S_'+n));
end else
if TrCo=32 Then
begin
SePe('S_'+n);WrMwc8(Length(z));WrMwS(z);WrMwc8(0);
SePe(n);WrMw32(adrPer('S_'+n));
end else
if TrCo=33 Then
begin
SePe('S_'+n);WrMwc8(Length(z));WrMwS(z);WrMwc8(0);
SePe(n);WrMw32(adrPer('S_'+n));
end else
if TrCo=34 Then
begin
SePe('S_'+n);WrMwc8(Length(z));WrMwS(z);WrMwc8(0);
SePe(n);WrMw32(adrPer('S_'+n));
end else
if TrCo=17 Then
begin
SePe('S_'+n);WrMwc8(Length(z));WrMwS(z);WrMwc8(0);
SePe(n);WrMw16(adrPer('S_'+n));
end else
InfoMes('CrSt Не прописано создание переменной строки для данной платформы ');
end;
procedure OtSt(Z:String);
var
m:Ansistring;
begin
m:='OTL__'+IntToStr(MuKa);
JMP__(m);
WrMwO(z+chr(144)+chr(144)+chr(144)+chr(144)+chr(144)+chr(144)+chr(144)+chr(144));
SeLa(m)
end;
procedure CopString; // ПРоцедура Копирует строку EAX<<EDX
begin
BeginProcedure('CopString');
SAV__EAX('@ST1');
SAV__EDX('@ST2');
REA_B('@LEN','@ST2');
WRI_B('@ST1','@LEN');
SeLa('Cikl'); MRA__('@LEN',0,'VIHOD');
INC__('@ST2');
INC__('@ST1');
DEC__('@LEN');
REA_B('@SIM','@ST2');
WRI_B('@ST1','@SIM');
JMP__('Cikl');
SeLa('VIHOD');
EndProcedure;
end;
Procedure SumString; // Сложеие строк
Begin
BeginProcedure('SumString');
SAV__EAX('@ST1');
SAV__EDX('@ST2');
Pri__('@UK1','@ST1');
Pri__('@UK2','@ST2');
REA_B('@LEN1','@UK1');
REA_B('@LEN2','@UK2');
Pri__('@LEN3','@LEN1');
ADD__('@LEN3','@LEN2');
WRI_B('@UK1','@LEN3');
ADD__('@UK1','@LEN1');
INC__('@UK1');
INC__('@UK2');
SeLa('@Cikl'); rav__('@LEN2',0,'VIHOD');
REA_B('@SIM','@UK2');
WRI_B('@UK1','@SIM');
inc__('@UK1');
inc__('@UK2');
Dec__('@LEN2');
JMP__('@CIKL');
SeLa('VIHOD');
EndProcedure;
end;
Procedure RavString; // eax: строка 1 edx:строка 2 возврвщает
begin
BeginProcedure('RavString');
SAV__EAX('@ST1');
SAV__EDX('@ST2');
REA_B('@LEN1','@ST1');
REA_B('@LEN2','@ST2');
NRA__('@LEN1','@LEN2','NERAV');
SeLa('Cikl'); MRA__('@LEN1',0,'RAVNO');
INC__('@ST1');
INC__('@ST2');
DEC__('@LEN1');
REA_B('@SIM1','@ST1');
REA_B('@SIM2','@St2');
NRA__('@SIM1','@SIM2','NERAV');
JMP__('Cikl');
SeLa('RAVNO');LOA__EAX(1);JMP__('VIHOD');
SeLa('NERAV');LOA__EAX(0);
SeLa('VIHOD');
EndProcedure;
end;
Procedure MenString; // eax: строка 1 edx:строка 2 возврвщает
begin
BeginProcedure('MenString');
SAV__EAX('@ST1');
SAV__EDX('@ST2');
Len__STR('@LEN','@ST1');
Pri__('@U1','@ST1');Inc__('@U1');
Pri__('@U2','@ST2');Inc__('@U2');
SeLa('Cik'); RAV__('@LEN',0,'RAVNO');
Rea_B('@SIM1','@U1');
Rea_B('@SIM2','@U2');
BOL__('@SIM1','@SIM2','BOLHE');
MEN__('@SIM1','@SIM2','MENHE');
DEC__('@LEN');
INC__('@u1');
INC__('@u2');
JMP__('Cik');
SeLa('BOLHE');
SeLa('RAVNO');PRI__('@REZ',0);
JMP__('VIHOD');
SeLa('MENHE');PRI__('@REZ',1);
SeLa('VIHOD');LOA__EAX('@REZ');
EndProcedure;
end;
Procedure BolString; // eax: строка 1 edx:строка 2 возврвщает
begin
BeginProcedure('BolString');
SAV__EAX('@ST1');
SAV__EDX('@ST2');
Len__STR('@LEN','@ST1');
Pri__('@U1','@ST1');Inc__('@U1');
Pri__('@U2','@ST2');Inc__('@U2');
SeLa('Cik'); RAV__('@LEN',0,'RAVNO');
Rea_B('@SIM1','@U1');
Rea_B('@SIM2','@U2');
BOL__('@SIM1','@SIM2','BOLHE');
MEN__('@SIM1','@SIM2','MENHE');
DEC__('@LEN');
INC__('@u1');
INC__('@u2');
JMP__('Cik');
SeLa('Menhe');
SeLa('RAVNO');PRI__('@REZ',0);
JMP__('VIHOD');
SeLa('Bolhe');PRI__('@REZ',1);
SeLa('VIHOD');LOA__EAX('@REZ');
EndProcedure;
end;
Procedure AsiString; // Присоеденяет к строке символ EDX
begin
BeginProcedure('AsiString');
SAV__EAX('@STR');
SAV__EDX('@SIM');
Rea_B('@LEN','@STR');INC__('@LEN');
Wri_B('@STR','@LEN');
ADD__('@LEN','@STR');
Wri_B('@LEN','@SIM');
SeLa('VIHOD');
endProcedure;
end;
procedure ASSString; // Добавление символа в начало строки
begin
BeginProcedure('ASSString');
SAV__EAX('@STR');
SAV__EDX('@Sim');
Cre__Str('@Rez');
REA_B('@LEN','@STR');
PRI__('@UKA','@STR');
INC__('@UKA');
Add__SIM('@REz','@SIM');
SeLa('Cikl'); MRA__('@LEN',0,'ecik1');
REA_B('@SIM','@UKA');
Add__Sim('@REZ','@SIM');
DEC__('@LEN');
INC__('@UKA');
JMP__('Cikl');
sElA('Ecik1');
Cop__Str('@Str','@Rez');
Fre__Str('@REz');
SeLa('VIHOD');
EndProcedure;
end;
Procedure KolString; // Определяет количество слов с разделителем EDX;
begin
BeginProcedure('KolString');
SAV__EAX('@STR');
SAV__EDX('@RAZ');
Pri__('@REZ',0);
REa_B('@LEN','@STR');
RAV__('@LEN',0,'VIHOD');
ADD__('@LEN','@STR');
Pri__('@REZ',1);
Pri__('@UK','@STR');Inc__('@UK');
SeLa('CIKL'); BOL__('@UK','@LEN','VIHOD');
REA_B('@SIM','@UK');
NRA__('@SIM','@RAZ','NEX1');
INC__('@REZ');
SeLa('NEX1');
INC__('@UK');
JMP__('CIKL');
SeLa('VIHOD');Loa__EAX('@REZ');
EndProcedure;
end;
Procedure SloString; // Возвращет слово с заданым номер EDX и Разделителем ECX
begin
BeginProcedure('SloString');
SAV__EAX('@SL');
SAV__EDX('@NS');
SAV__ECX('@RA');
PRI__('@RS',1); // читаемое слово
PRI__('@UK','@SL'); // указатель на символ
REA_B('@LE','@SL'); // Длина строки
ADD__('@LE','@SL');
INC__('@UK');
Cre__Str('@RE'); // Результат
SeLa('CIKL'); BOL__('@UK','@LE','VIHOD');
REA_B('@SIM','@UK');
NRA__('@SIM','@RA','NEX1');
INC__('@RS');
jmp__('nex2');
SeLa('NEX1'); NRA__('@RS','@NS','NEX2');
ADD__SIM('@RE','@SIM');
SeLa('NEX2'); Inc__('@UK');
JMP__('CIKL');
SeLa('VIHOD');LOA__EAX('@Re');
EndProcedure;
end;
Procedure VhoString; // ПРоверяет Наличие строки EAX В строке EDX с разделителем ECX
begin
BeginProcedure('VhoString');
SAV__EAX('@EAX');
SAV__EDX('@EDX');
SAV__ECX('@ECX');
PRI__('@AXT','@EAX');
Kol__Str('@EDX','@ECX','@KOL');// Определяем количество слов
PRI__('@NS',1); // Устанавливаем номер слова 1
SeLa('CIKL'); BOL__('@NS','@KOL','NET');
Slo__Str('@EDX','@NS','@ECX','@SLO'); // Выделяем слово
Rav__STR('@AXT','@SLO','EST'); // если есть такое слово выход
Fre__STR('@SLO');
inc__('@NS');
JMP__('CIKL');
SeLa('EST'); Fre__STR('@SLO');
LOA__EAX('@NS');
JMP__('VIHOD');
SeLa('NET'); LOA__EAX(0);
SeLa('VIHOD');
EndProcedure;
end;
procedure FreString; // Освободает строку
Begin
BeginProcedure('FreString');
SAV__EAX('@ADR');// тип элемента
DEC__('@ADR');
WRI_B('@ADR',0);
EndProcedure;
end;
Procedure ReadCif; // EAX=UK EDX=SL
Begin
BeginProcedure('ReadCif');
SAV__EAX('@UK');
SAV__EDX('@SL');
PRI__('@KTO',0); // Количество точек равно 0
WRI_B('@SL',0); // Обнуляем длину слова
SeLa('CIKL');
Rea_B('@SIM','@UK'); // читаем символ
RAV__('@SIM',0,'VIHOD'); // если строка кончилася нулевой символ
RAV__('@SIM',Ord('.'),'ATOCH');// Если точка анализируем наличие точек
MEN__('@SIM',Ord('0'),'VIHOD');// если строка кончилася нулевой символ
BOL__('@SIM',ord('9'),'VIHOD');// если строка кончилася нулевой символ
//-----------------------------
JMP__('EATOCH');
SeLa('ATOCH'); RAV__('@KTO',1,'VIHOD'); // Если точка уже есть то выход
INC__('@KTO'); // Если точки нету указываем что точку прочитали в этой цифре
SeLa('EATOCH'); //-----------------------------
REA_B('@LSL','@SL'); // читаем длину слова
INC__('@LSL'); // Увеличиваем длину слова
WRI_B('@SL','@LSL'); // Записываем длину слова
INC__('@UK'); // Увеличиваем указтель на символ в программе
PRI__('@USL','@SL');
ADD__('@USL','@LSL');
WRI_B('@USL','@SIM'); // Записываем символ
JMP__('CIKL');
SeLa('VIHOD'); LOA__EAX('@UK');
Endprocedure;
end;
Procedure ReadOpe; // EAX=UK EDX=SL
Begin
BeginProcedure('ReadOpe');
SAV__EAX('@UK');
SAV__EDX('@SL');
WRI_B('@SL',0); // Обнуляем длину слова
SeLa('CIKL');
Rea_B('@SIM','@UK'); // читаем символ
RAV__('@SIM',0,'VIHOD'); // если строка кончилася нулевой символ
MEN__('@SIM',Ord('A'),'VIHOD');// если строка кончилася нулевой символ
BOL__('@SIM',ord('Z'),'VIHOD');// если строка кончилася нулевой символ
REA_B('@LSL','@SL'); // читаем длину слова
INC__('@LSL'); // Увеличиваем длину слова
WRI_B('@SL','@LSL'); // Записываем длину слова
INC__('@UK'); // Увеличиваем указтель на символ в программе
PRI__('@USL','@SL');
ADD__('@USL','@LSL');
WRI_B('@USL','@SIM'); // Записываем символ
JMP__('CIKL');
SeLa('VIHOD'); LOA__EAX('@UK');
Endprocedure;
end;
Procedure ReadZn1; // EAX=UK EDX=SL
Begin
BeginProcedure('ReadZn1');
SAV__EAX('@UK');
SAV__EDX('@SL');
WRI_B('@SL',0); // Обнуляем длину слова
SeLa('CIKL');
Rea_B('@SIM','@UK'); // читаем символ
RAV__('@SIM',0,'VIHOD'); // если строка кончилася нулевой символ
Rav__('@SIM',Ord('+'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('-'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('*'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('/'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('('),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord(')'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('{'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('}'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('<'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('>'),'ZNAK');// если строка кончилася нулевой символ
Rav__('@SIM',Ord('='),'ZNAK');// если строка кончилася нулевой символ
JMP__('VIHOD');
SeLa('ZNAK'); WRI_B('@SL',1); // ставим длину слова 1
INC__('@SL'); // Увеличиваем указатель в слове
WRI_B('@SL','@SIM'); // Записываем символ
INC__('@UK'); // Увеличиваем указатель
SeLa('VIHOD'); LOA__EAX('@UK');
Endprocedure;
end;
Procedure ReadZn2; // EAX=UK EDX=SL
Begin
BeginProcedure('ReadZn2');
SAV__EAX('@UK');
SAV__EDX('@SL');
WRI_B('@SL',0); // Обнуляем длину слова
Rea_W('@SIM1','@UK'); // читаем символ
Pri__('@VUK','@UK');
Rea_B('@SIM1','@VUK'); // читаем символ
INC__('@VUK');
Rea_B('@SIM2','@VUK'); // читаем символ
NRA__('@SIM1',ORD(':'),'NEX1');
NRA__('@SIM2',ORD('='),'NEX1');
JMP__('ZNAK');
SeLa('NEX1');
JMP__('VIHOD');
SeLa('ZNAk'); ADD__SIM('@SL','@SIM1');
ADD__SIM('@SL','@SIM2');
inc__('@UK');inc__('@UK');
SeLa('VIHOD');
LOA__EAX('@UK');
Endprocedure;
end;
Procedure ReadKav; // EAX=UK EDX=SL
Begin
BeginProcedure('ReadKav');
SAV__EAX('@UK');
SAV__EDX('@SL');
WRI_B('@SL',0); // Обнуляем длину слова
Rea_B('@SIM','@UK'); // читаем символ
RAV__('@SIM',0,'VIHOD'); // если строка кончилася нулевой символ
NRA__('@SIM',Ord('"'),'VIHOD'); // если строка кончилася нулевой символ
REA_B('@LSL','@SL'); // читаем длину слова
INC__('@LSL'); // Увеличиваем длину слова
WRI_B('@SL','@LSL'); // Записываем длину слова
INC__('@UK'); // Увеличиваем указтель на символ в программе
SeLa('CIKL'); //----------------------------
RAV__('@SIM',0,'VIHOD'); // если строка кончилася нулевой символ
NRA__('@SIM',Ord('"'),'VIHOD2');// если строка кончилася нулевой символ
REA_B('@LSL','@SL'); // читаем длину слова
INC__('@LSL'); // Увеличиваем длину слова
WRI_B('@SL','@LSL'); // Записываем длину слова
INC__('@UK'); // Увеличиваем указтель на символ в программе
PRI__('@USL','@SL');
ADD__('@USL','@LSL');
WRI_B('@USL','@SIM'); // Записываем символ
JMP__('CIKL');
SeLa('VIHOD2'); INC__('@UK');
SeLa('VIHOD'); LOA__EAX('@UK');
Endprocedure;
end;
{$ENDIF}
{ Секция BIOS } {$IFDEF Tim}
Procedure ConstructorElement;// Конструктор структуры элемента
var
z:Byte;
begin
if TrCo=80 then begin z:=2;ADDSP:=2;end else
if TrCo=16 then begin z:=2;ADDSP:=2;end else
if TrCo=17 then begin z:=2;ADDSP:=2;end else
if TrCo=32 then begin z:=4;ADDSP:=4;end else
if TrCo=33 then begin z:=4;ADDSP:=4;end else
if TrCo=34 then begin z:=4;ADDSP:=4;end else
InfoMes('ConstructorElement Не описано создание елемента ');
EL_RES:=0;// резерв
EL_TIS:=1;// тип текстового элемента
EL_FUN:=2;// Если это функция
EL_ERR:=3;// Код ошибки
EL_AXT:=4;// Текст операнда в верхнем регистре
EL_ZNA:=4+(z*1);// значение операнда
EL_SAM:=4+(z*2);// Указатель на самого себя
EL_ROD:=4+(z*3);// Родительский элемент
EL_PRE:=4+(z*4);// Предыдущий эллемент если есть если нету NIL 0
EL_NEX:=4+(z*5);// Следующий эллемент ксли нету NIL 0
EL_BLO:=4+(z*6);// Цепочка вложеных елементов если есть ссылка на первый элемент цепочки вложеных елементов если нету 0 NIL
end;
procedure BIOS_Z80;
//-----------------------------------------------------------
procedure BIOS_PRINT_STR_EAX; // Подпрограммы выводв строки EAX адрес строки
begin
BeginProcedure('BIOS_PRINT_STR_EAX');
SAV__EAX('@SLO' );//Запоминаем адрес слова
WrMwm('D9' );//EXX;
WrMwm('216227' );//LD HL,2762;// НЕобходимо для правельной работы БИОС ZX Spectrum
WrMwm('d9' );//EXX;
WrMwm('3E02' );//LD A,2;
MOV__ESI(HexToInt('5C3A'));//LD IY,5C3A
cal__(HexToInt('1601' ));//CALL $1601 Установка потока
Len__Str('@LEN','@SLO' );
Loa__ECX('@LEN');
Loa__EDX('@SLO');
INC__EDX;
MOV__ESI(HexToInt('5C3A'));// ld IY,5C3A // НЕобходимо для правельного функционирования БИОСА
Cal__(HexToInt('203C')); // вывод строки в поток
EndProcedure;
end;
procedure BIOS_PRINT_CIF_EAX; // Подпрограммы выводв строки EAX адрес строки
begin
BeginProcedure('BIOS_PRINT_CIF_EAX');
SAV__EAX('@CIF');
LOA__ECX('@CIF');
WrMwm('D9');//EXX;
WrMwm('216227');//LD HL,2762;
WrMwm('d9');//EXX;
WrMwm('3E02');//LD A,2;
MOV__ESI(HexToInt('5C3A')); // ld IY,5C3A
CAL__(HexToInt('2D2B'));
WrMwm('D9');//EXX;
WrMwm('216227');//LD HL,2762;
WrMwm('d9');//EXX;
WrMwm('3E02');//LD A,2;
MOV__ESI(HexToInt('5C3A')); // ld IY,5C3A
cal__(HexToInt('1601'));// Установка потока
CAL__(HexToInt('2DE3'));
EndProcedure;
end;
procedure BIOS_PAUSE;
var
m:Ansistring;
begin
BeginProcedure('BIOS_PAUSE');
m:=IntToStr(Muka);
LOA__EAX(0);
MOV_A_EAXB(23560);
SeLa('PCIK'+m); MOV__EAX(0);
MOV__EAX_AB(23560);
SAV__EAX('@KEY');
RAV__('@KEY',0,'PCIK'+m);
EndProcedure;
end;
procedure BIOS_EXIT ;
begin
BeginProcedure('BIOS_EXIT');
ADD__ESP(MaxSizeStek);
WrMwm('D9');//EXX;
WrMwm('216227');//LD HL,2762;
WrMwm('d9');//EXX;
WrMwm('3E02');//LD A,2;
MOV__ESI(HexToInt('5C3A')); // ld IY,5C3A
Ret__;
EndProcedure;
end;
begin
ConstructorElement;
MSta:=HexToInt('6000');//Указываем стартовый адрес программы
Muka:=MSta ;// Перепроверить
MEnd:=MSta+MaxSizeMem ;// Максимально доступная точка памяти в программе
Cal__('MAIN');
CAl__('BIOS_EXIT');
// Различные данные для программы
SePe('TrMe');WrMwc(0);// Указатель на кучю
SePe('EAX') ;WrMwc(0);// место для временого хранения регистра
SePe('ECX') ;WrMwc(0);// место для временого хранения регистра
SePe('EDX') ;WrMwc(0);// место для временого хранения регистра
SePe('ESI') ;WrMwc(0);// место для временого хранения регистра
// Загрузка базовых процедур и функций
BIOS_PRINT_STR_EAX;
BIOS_PRINT_CIF_EAX;
BIOS_PAUSE;
BIOS_EXIT ;
end;//-----------------------------------------------------------
procedure BIOS_DOS;
//-----------------------------------------------------------
procedure BIOS_PRINT_STR_EAX; // Подпрограммы выводв строки EAX адрес строки
begin
BeginProcedure('BIOS_PRINT_STR_EAX');
SAV__EAX('@SLO');
REA_B('@LSL','@SLO');// Читаем длину слова
INC__('@SLO');
PRI__('@ESL','@SLO');
ADD__('@ESL','@LSL');
WRI_B('@ESL',ord('$'));
MOV__AH(9);
LOA__EDX('@SLO');
INT__(HexToInt('21'));
EndProcedure;
end;
procedure BIOS_PRINT_CIF_EAX; // Подпрограммы выводв строки EAX адрес строки
begin
BeginProcedure('BIOS_PRINT_CIF_EAX');
EndProcedure;
end;
procedure BIOS_PAUSE;
begin
BeginProcedure('BIOS_PAUSE');
PUSH_EAX;
MOV__AH(8);
INT__(HexToInt('21'));
POP__EAX;
EndProcedure;
end;
procedure BIOS_EXIT;
begin
BeginProcedure('BIOS_EXIT');
PUSH_EAX;
MOV__AH(8);
INT__(HexToInt('21'));
POP__EAX;
EndProcedure;
end;
begin
ConstructorElement;
MSta:=HexToInt('0100');//Указываем стартовый адрес программы
Muka:=MSta ;// Перепроверить
MEnd:=MSta+MaxSizeMem ;// Максимально доступная точка памяти в программе
Cal__('MAIN');
Cal__('BIOS_EXIT');
// Различные данные для программы
SePe('TrMe');WrMwc(0);// Указатель на кучю
SePe('EAX') ;WrMwc(0);// место для временого хранения регистра
SePe('ECX') ;WrMwc(0);// место для временого хранения регистра
SePe('EDX') ;WrMwc(0);// место для временого хранения регистра
SePe('ESI') ;WrMwc(0);// место для временого хранения регистра
BIOS_PRINT_STR_EAX;
BIOS_PRINT_CIF_EAX;
BIOS_PAUSE;
BIOS_EXIT ;
end;//-----------------------------------------------------------
Procedure PRINT_STR(s:Ansistring);
begin
LOA__EAX(s);
CAL__('BIOS_PRINT_STR_EAX');
end;
Procedure PRINT_CIF(s:Ansistring);// EAX Число которое нада преобразовать EDX адрес строки с результатом
begin
LOA__EAX(s);
CAL__('BIOS_PRINT_CIF_EAX');
end;
Procedure Pau__;
begin
CAL__('BIOS_PAUSE');
end;
procedure LOAD_BIOS;
begin
// Загрузка биос API системы
If TRCo=80 Then BIOS_Z80 else
If TRCo=16 Then BIOS_DOS else
InfoMes(('BIOS не прописан для платформы '));
end;
{$ENDIF}
{ Секция для математических операций } {$IFDEF Tim}
function UmnEdi(a,b:LongWord):LongWord;
begin
UmnEdi:=(a*b)mod 10;
end;
function UmnDes(a,b:LongWord):LongWord;
begin
UmnDes:=(a*b)div 10;
end;
Function PosSim(s:String;c:Char):LongWord;
var
f:LongWord;
Rez:LongWord;
begin
Rez:=0;
f:=1;
while (f<=length(s)) do
begin
if s[f]=C then Rez:=f;
inc(f);
end;
PosSim:=rez;
end;
Function DelSim(s:AnsiString;C:Char):AnsiString;
var
f:LongWord;
rez:AnsiString;
begin
for f:=1 to length(s) do
if s[f]<>C then rez:=rez+s[f];
DelSim:=rez;
end;
Function Add_Do(b:LongWord;s:AnsiString;c:Char):AnsiString;
var
f:Longint;
begin
for f:=1 to b do
s:=c+s;
add_Do:=s;
end;
Function add_Po(b:LongWord;s:AnsiString;c:Char):AnsiString;
var
f:Longint;
begin
for f:=1 to b do
s:=s+c;
add_Po:=s;
end;
Function Nor(a:AnsiString):AnsiString;
var
f,l,s,e:Longword;
Rez:AnsiString;
begin
rez:='';
l:=length(a);
f:=1;while (f<=L) and (a[f]='0') do inc(f);s:=f;
f:=l;while (f>0) and (a[f]='0') do dec(f);e:=f;
if PosSim(a,'.')=0 then e:=L;
f:=s;while (f<=e) do begin rez:=rez+a[f];inc(f); end;
if rez='' then rez:='0';
if rez[length(rez)]='.' then delete(rez,length(rez),1);
if rez='' then rez:='0';
if rez[1]='.' then rez:='0'+rez;
nor:=rez;
end;
Function Zna(a,b:Ansistring):byte;
var
z1,z2:byte;
begin
z1:=0;
z2:=0;
if (length(a)>0) and (a[1]='-') Then z1:=1;
if (length(b)>0) and (b[1]='-') Then z2:=2;
Zna:=z1+z2;
end;
Function Cor(var a,b:AnsiString):LongWord;
var
f:LongWord;
l1,l2,m,t1,t2,p:LongWord;
begin
a:=DelSim(a,'-');
b:=DelSim(b,'-');
l1:=length(a);
l2:=length(b);
t1:=PosSim(a,'.');
t2:=PosSim(b,'.');
//--------------------------------------------------------------
if t1=0 then t1:=l1+1;
if t2=0 then t2:=l2+1;
//--------------------------------------------------------------
if t1<>t2 then
if t1>t2
Then b:=Add_Do(t1-t2,b,'0')
else a:=Add_Do(t2-t1,a,'0');
//--------------------------------------------------------------
if l1<t1 then a:=a+'.';
if l2<t2 then b:=b+'.';
l1:=length(a);
l2:=length(b);
if l1<>l2 then
if l1>l2
Then b:=Add_Po(l1-l2,b,'0')
else a:=Add_Po(l2-l1,a,'0');
f:=PosSim(a,'.');
cor:=length(a)-f;
end;
Function Rav1(a,b:AnsiString):Boolean;
var
f:LongWord;
rez:Boolean;
begin
cor(a,b);
f:=1;
rez:=true;
while f<=length(a) do
if a[f]<>b[f] then begin rez:=false;break;end else inc(f);
rav1:=rez;
end;
Function Bol1(a,b:AnsiString):Boolean;
var
f:LongWord;
rez:Boolean;
begin
cor(a,b);
f:=1;
rez:=false;
while f<=length(a) do
if a[f]=b[f] then inc(f) else
if a[f]>b[f]
then begin rez:=true;break;end
else begin rez:=false;break;end;
Bol1:=rez;
end;
Function Men1(a,b:AnsiString):Boolean;
var
f:LongWord;
rez:Boolean;
begin
cor(a,b);
f:=1;
rez:=false;
while f<=length(a) do
if a[f]=b[f] then inc(f) else
if a[f]<b[f]
then begin rez:=true;break;end
else begin rez:=false;break;end;
men1:=rez;
end;
Function Sum1(a,b:AnsiString):AnsiString;
var
f,l,p1,a1,b1,c1,t:LongWord;
rez,rez2:AnsiString;
begin
t:=cor(a,b);
a:=delSim(a,'.');
b:=delSim(b,'.');
l:=Length(a);
f:=l;
p1:=0;
While f>0 do
begin
a1:=ord(a[f])-ord('0');
b1:=ord(b[f])-ord('0');
c1:=a1+b1+p1;
p1:=0;
While c1>9 do
begin
c1:=c1-10;
P1:=p1+1;
end;
rez:=chr(c1+ord('0'))+rez;
dec(f);
end;
if p1<>0 then
rez:=chr(p1+ord('0'))+rez;
for f:=1 to length(rez) do
if f=length(rez)-t then rez2:=rez2+rez[f]+'.' else rez2:=rez2+rez[f];
Sum1:=Nor(rez2);
end;
Function Min1(a,b:AnsiString):AnsiString;
var
f,a1,b1,r,z1,z2,t:LongWord;
rez,rez2,ob:AnsiString;
begin
t:=cor(a,b);
a:=delSim(a,'.');
b:=delSim(b,'.');
if Men1(a,b) then begin ob:=a;a:=b;b:=ob;end;
f:=Length(a);
while f>0 do
begin
a1:=ord(a[f])-ord('0');
b1:=ord(b[f])-ord('0');
if a1<b1 then
begin
r:=f-1;
while a[r]='0' do r:=r-1;
a[r]:=Chr(ord(a[r])-1);
r:=r+1;
while r<f do begin a[r]:='9';inc(r);end;
a1:=a1+10;
end;
if a1>b1 then
begin
rez:=chr((a1-b1)+ord('0'))+rez;
end else
if a1=b1 then
begin
rez:='0'+rez;
end;
f:=f-1;
end;
for f:=1 to length(rez) do
if f=length(rez)-t then rez2:=rez2+rez[f]+'.' else rez2:=rez2+rez[f];
min1:=nor(rez2);
end;
Function Umn1(a,b:AnsiString):AnsiString;
var
f,f1,f2,a1,b1,o,r,t:LongWord;
rez,rez2,sss:AnsiString;
begin
t:=cor(a,b);
a:=delSim(a,'.');
b:=delSim(b,'.');
o:=0;
r:=0;
rez:='0';
f1:=length(a);
while f1>0 do
begin
f2:=length(a);
sss:='';
sss:=Add_Po(length(a)-f1,sss,'0');
r:=0;
while f2>0 do
begin
a1:=ord(a[f2])-ord('0');
b1:=ord(b[f1])-ord('0');
o:=UmnEdi(a1,b1);
o:=o+r;
sss:=chr((o)+ord('0'))+sss;
r:=UmnDes(a1,b1);
f2:=f2-1;
end;
sss:=chr((r)+ord('0'))+sss;
rez:=sum1(sss,rez);
f1:=f1-1;
end;
if Length(rez)<t+t+1 then
rez:=Add_do(t+t+1,rez,'0');
for f:=1 to length(rez) do
if f=length(rez)-(t+t)
then rez2:=rez2+rez[f]+'.'
else rez2:=rez2+rez[f];
Umn1:=Nor(rez2);
end;
Function Del1(a,b:AnsiString;toch:LongWord):AnsiString;
var
f,t,u,c:LongWord;
r,pre,rez,rez2:AnsiString;
begin
t:=cor(a,b);
a:=delSim(a,'.');
b:=delSim(b,'.');
a:=nor(a);a:=add_Po(toch,a,'0');
b:=nor(b);
r:='';
u:=length(b);
for f:=1 to u do
r:=r+a[f];
while u<=length(a) do
begin
if Bol1(r,b) or Rav1(r,b) then
begin
pre:='0';
c:=0;
while men1(sum(pre,b),r) or rav1(sum(pre,b),r) do
begin
pre:=sum1(pre,b);
c:=c+1;
end;
r:=min1(r,pre);
rez:=rez+chr(c+ord('0'));
end else rez:=rez+'0';
u:=u+1; if u<=length(a) then r:=r+a[u];
end;
if Length(rez)<toch+1 then rez:=Add_do(toch+1,rez,'0');
for f:=1 to length(rez) do
if f=length(rez)-(toch) then rez2:=rez2+rez[f]+'.' else rez2:=rez2+rez[f];
del1:=nor(rez2);
end;
Function Rav(a,b:AnsiString):Boolean;
var
z:Byte;
begin
z:=Zna(a,b);
if z=1 then rav:=false else
if z=2 then rav:=false else rav:=rav1(a,b);
end;
Function Bol(a,b:AnsiString):Boolean;
var
z:Byte;
begin
z:=Zna(a,b);
if z=1 then Bol:=false else
if z=2 then Bol:=True else Bol:=Bol1(a,b);
end;
Function Men(a,b:AnsiString):Boolean;
var
z:Byte;
begin
z:=Zna(a,b);
if z=1 then Men:=true else
if z=2 then Men:=False else Men:=Men1(a,b);
end;
Function Sum(a,b:AnsiString):AnsiString;
var
z:Longword;
begin
z:=zna(a,b);
if rav1(a,b) then
begin
if z=3 then sum:='-'+sum1(a,b) else
if z=1 then sum:='0' else
if z=2 then sum:='0' else
if z=0 then sum:=sum1(a,b);
end else
if Bol1(a,b) then
begin
if z=3 then sum:='-'+Sum1(a,b) else
if z=1 then sum:='-'+Min1(a,b) else
if z=2 then sum:=min1(a,b) else
if z=0 then sum:=sum1(a,b);
end else
if Men1(a,b) then
begin
if z=3 then sum:='-'+sum1(a,b) else
if z=1 then sum:=min1(a,b) else
if z=2 then sum:='-'+min1(a,b) else
if z=0 then sum:=sum1(a,b);
end;
{
(-5+(-5))=-10
(-5+( 5))=0
( 5+(-5))=0
( 5+( 5))=10
----------------
(-10+(-5))=-15
(-10+( 5))=-5
( 10+(-5))=5
( 10+( 5))=15
----------------
(-5+(-10))=-15
(-5+( 10))=5
( 5+(-10))=-5
( 5+( 10))=15
}
end;
Function Min(a,b:AnsiString):AnsiString;
var
z:Longword;
begin
z:=zna(a,b);
if rav1(a,b) then
begin
if z=3 then min:='0' else
if z=1 then min:='-'+sum1(a,b) else
if z=2 then min:=sum1(a,b) else
if z=0 then min:='0';
end else
if Bol1(a,b) then
begin
if z=3 then min:='-'+min1(a,b) else
if z=1 then min:='-'+sum1(a,b) else
if z=2 then min:=sum1(a,b) else
if z=0 then min:=min1(a,b);
end else
if men1(a,b) then
begin
if z=3 then min:=min1(a,b) else
if z=1 then min:='-'+sum1(a,b) else
if z=2 then min:=sum1(a,b) else
if z=0 then min:='-'+min1(a,b);
end;
{
(-5-(-5))=0
(-5-( 5))=-10
( 5-(-5))=10
( 5-( 5))=0
--------------------
(-10-(-5))=-5
(-10-( 5))=-15
( 10-(-5))=15
( 10-( 5))=5
--------------------
(-5-(-10))=5
(-5-( 10))=-15
( 5-(-10))=15
( 5-( 10))=-5
}
end;
Function Umn(a,b:AnsiString):AnsiString;
var
z:Longword;
begin
z:=zna(a,b);
if rav1('0',a) then umn:='0' else
if rav1('0',b) then umn:='0' else
if z=3 then Umn:=Umn1(a,b) else
if z=1 then Umn:='-'+Umn1(a,b) else
if z=2 then Umn:='-'+Umn1(a,b) else
if z=0 then Umn:=Umn1(a,b);
end;
Function del(a,b:AnsiString;toch:LongWord):AnsiString;
var
z:Longword;
begin
z:=zna(a,b);
if rav1('0',a) then Del:='Бесконечность' else
if rav1('0',b) then Del:='0' else
if z=3 then Del:=Del1(a,b,Toch) else
if z=1 then Del:='-'+Del1(a,b,Toch) else
if z=2 then Del:='-'+Del1(a,b,Toch) else
if z=0 then Del:=Del1(a,b,Toch);
end;
//==============================================================================
//==============================================================================
//==============================================================================
Procedure UMN__EDI(R,A,B:String);
begin
LOA__EAX(a);
LOA__EDX(b);
Cal__('UmnDesEdi');
SAV__EDX(r);
end;
Procedure UMN__DES(R,A,B:String);
begin
LOA__EAX(a);
LOA__EDX(b);
Cal__('UmnDesEdi');
SAV__EAX(r);
end;
Procedure Add__Poo(st:String;ch:LongWord;kol:String);
begin
Loa__EAX(st);
Loa__EDX(ch);
Loa__ECX(kol);
Cal__('addPosle');
end;
procedure Add__Doo(st,ch:String;kol:LongWord);
begin
Loa__EAX(st);
Loa__EDX(ch);
Loa__ECX(kol);
Cal__('addDoooo');
end;
procedure Add__Doo(st:String;ch:LongWord;kol:String);
begin
Loa__EAX(st);
Loa__EDX(ch);
Loa__ECX(kol);
Cal__('addDoooo');
end;
procedure Add__Doo(st,ch,kol:String);
begin
Loa__EAX(st);
Loa__EDX(ch);
Loa__ECX(kol);
Cal__('addDoooo');
end;
procedure Nor__CHI(a:string);
begin
LOA__EAX(a);
Cal__('NorChislo');
end;
procedure Cor__CHI(t,a,b:String);
begin
LOA__EAX(a);
LOA__EDX(b);
Cal__('CorChisel');
SAv__EAX(t);
end;
procedure Zna__CHI(z,a,b:String);
begin
LOA__EAX(a);
LOA__EDX(b);
Cal__('ZnaChisel');
SAV__EAX(z);
end;
Procedure RAV1_CHI(a,b,r:String);
begin
Cre__Str('@RAV1_CHI_A');
Cre__Str('@RAV1_CHI_B');
Cop__STR('@RAV1_CHI_A',A);
Cop__STR('@RAV1_CHI_B',B);
LOA__EAX('@RAV1_CHI_A');
LOA__EDX('@RAV1_CHI_B');
CAL__('RAV1Chisel');
SAV__EAX('@RAV1_CHI_C');
Fre__Str('@RAV1_CHI_A');
Fre__Str('@RAV1_CHI_B');
RAV__('@RAV1_CHI_C',1,R);
end;
Procedure BOL1_CHI(a,b,r:String);
begin
Cre__Str('@BOL1_CHI_A');
Cre__Str('@BOL1_CHI_B');
Cop__STR('@BOL1_CHI_A',A);
Cop__STR('@BOL1_CHI_B',B);
LOA__EAX('@BOL1_CHI_A');
LOA__EDX('@BOL1_CHI_B');
CAL__('Bol1Chisel');
SAV__EAX('@BOL1_CHI_C');
Fre__Str('@BOL1_CHI_A');
Fre__Str('@BOL1_CHI_B');
RAV__('@BOL1_CHI_C',1,R);
end;
Procedure MEN1_CHI(a,b,r:String);
begin
Cre__Str('@MEN1_CHI_A');
Cre__Str('@MEN1_CHI_B');
Cop__STR('@MEN1_CHI_A',A);
Cop__STR('@MEN1_CHI_B',B);
LOA__EAX('@MEN1_CHI_A');
LOA__EDX('@MEN1_CHI_B');
CAL__('MEN1Chisel');
SAV__EAX('@MEN1_CHI_C');
Fre__Str('@MEN1_CHI_A');
Fre__Str('@MEN1_CHI_B');
RAV__('@MEN1_CHI_C',1,R);
end;
Procedure Sum1_Chi(a,b:String); // Складывает строки с числа EAX:EDX без знака
begin
Cre__Str('@Sum1_Chi_B');
Cop__Str('@Sum1_Chi_B',b);
LOA__EAX(a);
LOA__EDX('@Sum1_Chi_B');
Cal__('Sum1Chisel');
Fre__Str('@Sum1_Chi_B');
end;
Procedure Min1_Chi(a,b:String); // Вычитает строки с числа EAX:EDX без знака
begin
Cre__Str('@Min1_Chi_B');
Cop__Str('@Min1_Chi_B',b);
LOA__EAX(a);
LOA__EDX('@Min1_Chi_B');
Cal__('Min1Chisel');
Fre__Str('@Min1_Chi_B');
end;
Procedure Umn1_Chi(a,b:String); // Умножает строки с числа EAX:EDX без знака
begin
Cre__Str('@Umn1_Chi_B');
Cop__Str('@Umn1_Chi_B',b);
LOA__EAX(a);
LOA__EDX('@Umn1_Chi_B');
Cal__('Umn1Chisel');
Fre__Str('@UMN1_Chi_B');
end;
Procedure Del1_Chi(a,b:String); // Делит строки с числа EAX:EDX без знака
begin
Cre__Str('@Del1_Chi_B');
Cop__Str('@Del1_Chi_B',b);
LOA__EAX(a);
LOA__EDX('@Del1_Chi_B');
LOA__ECX(Toch);// ТОчность результата;
Cal__('Del1Chisel');
Fre__Str('@Del1_Chi_B');
end;
Procedure RAV__CHI(a,b,r:String); // ПРоверяет на равенство строки числа полное
begin
LOA__EAX(a);
LOA__EDX(b);
CAL__('RavChisel');
SAV__EAX('@RAV__CHI');
RAV__('@RAV__CHI',1,r);
end;
Procedure Bol__CHI(a,b,r:String); // ПРоверяет на Больше если первое Число больше строки числа полное
begin
LOA__EAX(a);
LOA__EDX(b);
CAL__('BolChisel');
SAV__EAX('@Bol__CHI');
RAV__('@Bol__CHI',1,r);
end;
Procedure Men__CHI(a,b,r:String); // ПРоверяет на Больше если первое Число Меньше строки числа полное
begin
LOA__EAX(a);
LOA__EDX(b);
CAL__('MenChisel');
SAV__EAX('@Men__CHI_C');
RAV__('@Men__CHI_C',1,r);
end;
Procedure Sum__Chi(a,b:String); // Складывает строки с числа EAX:EDX Полное
begin
LOA__EAX(a);
LOA__EDX(b);
Cal__('SumChisel');
end;
Procedure Min__Chi(a,b:String); // Вычитает строки с числа EAX:EDX Полное
begin
LOA__EAX(a);
LOA__EDX(b);
Cal__('MinChisel');
end;
Procedure Umn__Chi(a,b:String); // Умножение строки с числа EAX:EDX Полное
begin
LOA__EAX(a);
LOA__EDX(b);
Cal__('UmnChisel');
end;
Procedure Del__Chi(a,b:String); // Деление строки с числа EAX:EDX Полное
begin
LOA__EAX(a);
LOA__EDX(b);
Cal__('DelChisel');
end;
Procedure UmnDesEdi; // Умножает и возвращает Возращает десятки EAX:и единицы EDX
begin
BeginProcedure('UmnDesEdi');
SAV__EAX('@A');
SAV__EDX('@B');
Pri__('@F','@A');
Pri__('@EDI',0);
Pri__('@DES',0);
Pri__('@SSS',0);
SeLa('Cik'); Rav__('@F',0,'Ecik');
ADD__('@SSS','@B');
MEN__('@SSS',10,'NEX');
INC__('@DES');
SUB__('@SSS',10);
SeLA('NEX'); PRI__('@EDI','@SSS');
DEC__('@F');
Jmp__('CIK');
SeLa('Ecik');
LOA__EAX('@DES');
LOA__EDX('@EDI');
EndProcedure;
end;
procedure addPosle; // Добавляет в коцес строки EAX символ EDX в Количсетве ECX символов
begin
BeginProcedure('addPosle');
SAV__EAX('@STR');
SAV__EDX('@SIM');
SAV__ECX('@KOL');
PRI__('@F',1);
SeLa('CIK'); BOL__('@F','@KOL','ECIK');
Add__Sim('@STR','@SIM');
INC__('@F');
JMP__('CIK');
SeLa('ECIK');
EndProcedure;
{BeginProcedure('addPosle');
SAV__EAX('@STR');
SAV__EDX('@SIM');
SAV__ECX('@KOL');
SeLa('CIK'); RAV__('@KOL',0,'ECIK');
ADD__Sim('@STR','@SIM');
DEC__('@KOL');
JMP__('CIK');
SeLa('ECIK');
EndProcedure; }
end;
procedure addDoooo; // Добавляет в Начало строки EAX символ EDX в количсетве символов ECX
begin
BeginProcedure('addDoooo');
SAV__EAX('@STR');
SAV__EDX('@SIM');
SAV__ECX('@KOL');
PRI__('@F',1);
SeLa('CIK'); Bol__('@F','@KOL','ECIK');
ADD__SSI('@STR','@SIM');
INC__('@F');
JMP__('CIK');
SeLa('ECIK');
EndProcedure;
end;
procedure NorChislo; // Нормализация числа EAX возвращает нормализованое число
begin
BeginProcedure('NorChislo');
SAv__EAX('@CHI');
Cre__Str('@REZ'); // Создаем строку для записи результата
// Получаем адрес начальньного символа
//------------------------------------------------------------
PRI__('@STA','@CHI');// получаем Указатель на строку с числом
PRI__('@END','@CHI');// получаем Указатель на строку с числом
Len__STR('@LEN','@CHI');
ADD__('@END','@LEN');// Получаем конец строки 0 1 2 3 4
INC__('@STA');
SeLa('CIK1'); REA_B('@SIM','@STA');
BOL__('@STA','@END','ECIK1');// Если указатель больше последнего символа выход
NRA__('@SIM',ord('0'),'ECIK1');// Если символ не нуль с него считать и выход
INC__('@STA');
JMP__('CIK1');
SeLa('ECIK1');// ПОлучаем адрес конечного символа цифры в строке
//------------------------------------------------------------
SeLa('CIK2'); BOL__('@STA','@END','ECIK2');// Если конец строки оказался меньше начала строки выход
REA_B('@SIM','@END');
NRA__('@SIM',ord('0'),'ECIK2');
DEC__('@END');
JMP__('CIK2');
SeLa('ECIK2');//------------------------------------------------------------
//if not Est_Sim(a,'.') then e:=L;
POs__SIM('@R','@CHI',Ord('.'));
NRA__('@R',0,'E');
PRI__('@END','@CHI');
ADD__('@END','@LEN');
SeLa('E'); //------------------------------------------------------------
//f:=s;while (f<=e) do begin rez:=rez+a[f];inc(f); end;
// Читаем число
PRI__('@F','@STA');
SeLa('CIK3'); BOL__('@F','@END','ECIK3');
Rea_B('@SIM','@F');
Add__SIM('@REZ','@SIM');
INC__('@F');
JMP__('CIK3');
SeLa('ECIK3');//------------------------------------------------------------
//if rez[length(rez)]='.' then delete(rez,length(rez),1);
//Если последний знак точка удаляем
Len__Str('@LLL','@REZ');
RAV__('@LLL',0,'NEX4');
ADD__('@LLL','@REZ');
REA_B('@SiM','@LLL');
NRA__('@SIM',ord('.'),'NEX2');
Len__Str('@LLL','@REZ');
DEC__('@LLL');
WRI_B('@REZ','@LLL');
SeLA('NEX2'); //------------------------------------------------------------
//if rez[1]='.' then rez:='0'+rez;
// Если первый знак точка добавляем нуль в начало
PRI__('@UKA','@REZ');
INC__('@UKA');
Rea_B('@SIM','@UKA');
NRa__('@SIM',Ord('.'),'NEX4');
Add__SSI('@REZ',Ord('0'));
SeLa('NEX4'); // Если длина строки нулевая ставим нуль
//------------------------------------------------------------
//if rez='' then rez:='0';
Len__str('@LEN','@REZ');
Nra__('@LEN',0,'NEX1');
add__Sim('@REz',Ord('0'));
SeLa('NEX1');
Cop__Str('@CHI','@REZ');
EndProcedure; Fre__Str('@REZ');
end;
Procedure ZnaChisel; // EAX: число1 EDX: число2 Возвращает код комбинации знаков 0++ 1-+ 2+- 3--
begin
BeginProcedure('ZnaChisel');
SAv__Eax('@CHI1');
SAv__Edx('@CHI2');
REA_B('@LEN1','@CHI1');
REA_B('@LEN2','@CHI2');
Pri__('@REZ',0);
RAV__('@LEN1',0,'NEX1');
REA_B('@SIM','@CHI1');
NRA__('@SIM',ord('-'),'NEX1');
ADD__('@REZ',1);
SeLA('NEX1');
RAV__('@LEN2',0,'NEX2');
REA_B('@SIM','@CHI2');
NRA__('@SIM',ord('-'),'NEX2');
ADD__('@REZ',2);
SeLA('NEX2');
LOA__EAX('@REZ');
endProcedure;
end;
Procedure CorChisel; // EAX: число1 EDX: число2 ПРоизводит корекцию чисел
begin
BeginProcedure('CorChisel');
Sav__Eax('@CHI1');
Sav__EDx('@CHI2');
Del__Sim('@CHI1',Ord('-'));
Del__Sim('@CHI2',Ord('-'));
Len__Str('@L1','@CHI1');
Len__Str('@L2','@CHI2');
POS__Sim('@T1','@CHI1',Ord('.'));
POS__Sim('@T2','@CHI2',Ord('.'));
//--------------------------------------------------------------
// Вычисляем кооординаты точек если их нету то координа длина строки плюс 1
NRA__('@T1',0,'NEX1');
Pri__('@T1','@L1');
Inc__('@T1');
SeLA('NEX1'); //---------------------
NRA__('@T2',0,'NEX2');
Pri__('@T2','@L2');
Inc__('@T2');
SeLA('NEX2');
//--------------------------------------------------------------
// Добавляем нули в начале строк //
RAV__('@T1','@T2','VAREN');// Если тока в числах в одной и тойже позиии пропускаем
BOL__('@T1','@T2','VARME');// Если в первом числе точка дальше
// Если точка во втором числе ближе чем в первом
PRI__('@TT2','@T2');
SUB__('@TT2','@T1');
Add__DOO('@CHI1',Ord('0'),'@TT2');
JMP__('VAREN');
SeLa('VARME');// Если точка во втором числе больше чем в первом
PRI__('@TT2','@T1');
SUB__('@TT2','@T2');
Add__DOO('@CHI2',Ord('0'),'@TT2');
SeLa('VAREN');
//--------------------------------------------------------------
// Добавляем точку если её нету в числе перед выравниванием
MRA__('@t1','@l1','TO1');
add__Sim('@Chi1',Ord('.'));
SeLa('TO1');
MRA__('@t2','@l2','TO3');
add__Sim('@Chi2',Ord('.'));
SeLa('TO3');
//--------------------------------------------------------------
Len__Str('@L1','@CHI1');// Определяем длины строк заного
Len__Str('@L2','@CHI2');
//--------------------------------------------------------------
RAV__('@L1','@L2','ARAV');
BOL__('@L1','@L2','ABOL');
Pri__('@LLL','@L2');
SUB__('@LLL','@L1');
Add__Poo('@CHI1',Ord('0'),'@LLL');
JMP__('ARAV');
SeLa('ABOL');
Pri__('@LLL','@L1');
SUB__('@LLL','@L2');
Add__Poo('@CHI2',Ord('0'),'@LLL');
SeLa('ARAV');
// Определяем сколько знаков после запятой
POs__Sim('@F','@CHI1',ord('.'));
Len__Str('@LEN','@CHI1');
SUB__('@LEN','@F');
LOA__EAX('@LEN');
endProcedure;
end;
procedure Rav1Chisel;// ПРоверяет равенство строк с числами EAX:EDX Возвращает EAX без знака
begin
BeginProcedure('Rav1Chisel');
SAV__EAX('@CHI1');
SAV__EDX('@CHI2');
Cor__Chi('@T','@CHI1','@CHI2');
Len__STR('@LEN','@CHI1');
Pri__('@U1','@CHI1');Inc__('@U1');
Pri__('@U2','@CHI2');Inc__('@U2');
SeLa('Cik'); RAV__('@LEN',0,'RAVNO');
Rea_B('@SIM1','@U1');
Rea_B('@SIM2','@U2');
NRA__('@SIM1','@SIM2','NERAV');
DEC__('@LEN');
INC__('@u1');
INC__('@u2');
JMP__('Cik');
SeLA('ECIK');
SeLa('NERAV');PRI__('@REZ',0);
JMP__('VIHOD');
SeLa('RAVNO');PRI__('@REZ',1);
SeLa('VIHOD');LOA__EAX('@REZ');
EndProcedure;
end;
procedure BOL1Chisel;// ПРоверяет Больше ли первая строка с числами EAX:EDX Возвращает EAX без знака
begin
BeginProcedure('Bol1Chisel');
SAV__EAX('@CHI1');
SAV__EDX('@CHI2');
Cor__Chi('@T','@CHI1','@CHI2');
Len__STR('@LEN','@CHI1');
Pri__('@U1','@CHI1');inc__('@U1');
Pri__('@U2','@CHI2');inc__('@U2');
SeLa('Cik'); RAV__('@LEN',0,'RAVNO');
Rea_B('@SIM1','@U1');
Rea_B('@SIM2','@U2');
Men__('@SIM1','@SIM2','MENHE');
Bol__('@SIM1','@SIM2','BOLHE');
DEC__('@LEN');
INC__('@u1');
INC__('@u2');
JMP__('Cik');
SeLA('ECIK');
SeLa('BOLHE');PRI__('@REZ',1);
JMP__('VIHOD');
SeLa('RAVNO');
SeLa('MENHE');PRI__('@REZ',0);
SeLA('VIHOD');LOA__EAX('@REZ');
EndProcedure;
end;
procedure MEN1Chisel;// ПРоверяет Меньше ли первая строка с числами EAX:EDX Возвращает EAX без знака
begin
BeginProcedure('Men1Chisel');
SAV__EAX('@CHI1');
SAV__EDX('@CHI2');
Cor__Chi('@T','@CHI1','@CHI2');
Len__STR('@LEN','@CHI1');
Pri__('@U1','@CHI1');INC__('@U1');
Pri__('@U2','@CHI2');INC__('@U2');
SeLa('Cik'); RAV__('@LEN',0,'RAVNO');
Rea_B('@SIM1','@U1');
Rea_B('@SIM2','@U2');
Men__('@SIM1','@SIM2','MENHE');
Bol__('@SIM1','@SIM2','BOLHE');
DEC__('@LEN');
INC__('@u1');
INC__('@u2');
JMP__('Cik');
SeLA('ECIK');
SeLa('MENHE');PRI__('@REZ',1);
JMP__('VIHOD');
SeLa('RAVNO');
SeLa('BOLHE');PRI__('@REZ',0);
SeLa('VIHOD');LOA__EAX('@REZ');
EndProcedure;
end;
Procedure Sum1Chisel;// Складывает строки с числа EAX:EDX без знака
begin
BeginProcedure('Sum1Chisel');
SAV__EAX('@CHI1');
SAV__EDX('@CHI2');
Cor__Chi('@T','@CHI1','@CHI2');
Del__Sim('@CHI1',ord('.'));
Del__Sim('@CHI2',ord('.'));
Cre__Str('@REZ');
Cre__Str('@REZ2');
Len__Str('@L','@CHI1');
Pri__('@U1','@CHI1');ADD__('@U1','@L');
Pri__('@U2','@CHI2');ADD__('@U2','@L');
Pri__('@F','@L');
Pri__('@P1',0);
//------------------------------------------------------------------------------
SeLa('Cik'); rav__('@F',0,'ECIK');
// Переводим числа из текста в Цифры
REA_B('@A1','@U1');
REA_B('@B1','@U2');
SUB__('@A1',ord('0'));
SUB__('@B1',ord('0'));
// Складываем числа
Pri__('@C1','@P1');
ADD__('@C1','@A1');
ADD__('@C1','@B1');
Pri__('@P1',0);// ОБнуляем остаток
// Считаем и вычитаем Десятки -----
SeLa('Cik2'); MRA__('@C1',9,'ECIK2');
SUB__('@C1',10);
INC__('@P1');
Jmp__('Cik2');
SeLa('ECik2');
//----------------------------------
// Записываем получившиеся число
Pri__('@RSIM','@c1');
ADD__('@RSIM',ord('0'));
Add__SSI('@REZ','@RSIM');
DEC__('@F');
DEC__('@U1');
DEC__('@U2');
JMP__('CIK');
SeLa('ECik'); //--------------------------------------
// Записываем остаток от сложений
// if p1<>0 then rez:=chr(p1+ord('0'))+rez;
Cre__Str('@REZ2');
RAV__('@P1',0,'@NEX1');
Pri__('@RSIM','@P1');
ADD__('@RSIM',ord('0'));
Add__SSI('@REZ','@RSIM');
SeLa('@NEX1');//--------------------------------------
// Расчитываем length(rez)-t
Len__Str('@LR','@REZ');//
Pri__('@LRT','@LR');
SUB__('@LRT','@T');
Pri__('@F',1);
//--------------------------------------
// for f:=1 to length(rez) do
SeLa('CIK3'); BOL__('@F','@LR','ECIK3');
SIM__NOM('@SIM','@REZ','@F');
// if f=length(rez)-t then
NRA__('@LRT','@F','ELSE');
Add__Sim('@REZ2','@SIM');
Add__Sim('@REZ2',ord('.'));
JMP__('EIFF');
SeLa('ELSE'); // ELSE
Add__Sim('@REZ2','@SIM');
SeLa('EIFF');
INC__('@F');
JMP__('CIK3');
SeLa('ECIK3');//--------------------------------------
Nor__CHI('@REZ2');
Cop__Str('@CHI1','@REZ2');
Fre__Str('@REZ');
Fre__Str('@REZ2');
EndProcedure;
end;
Procedure Min1Chisel;// Вычитает строки с числа EAX:EDX без знака
begin
BeginProcedure('Min1Chisel');
SAV__EAX('@CHI1');
SAV__EDX('@CHI2');
Cre__Str('@REz');
Cre__Str('@REz2');
COR__CHI('@T','@CHI1','@CHI2');
Del__Sim('@CHI1',Ord('.'));
Del__Sim('@CHI2',Ord('.'));
//if Men1(a,b) then begin ob:=a;a:=b;b:=ob;end;
BOL1_Chi('@CHI1','@CHI2','NEX0');
RAV1_Chi('@CHI1','@CHI2','NEX0');
Cre__Str('@OB');//--
Cop__Str('@OB','@Chi1');
Cop__Str('@CHI1','@CHI2');
Cop__Str('@CHI2','@OB');
Fre__Str('@OB');//--
//------------------------------------
SeLa('NEX0');
Len__Str('@F','@CHI1');
//while f>0 do
SeLa('Cik'); Rav__('@F',0,'ECIK');
Sim__Nom('@A1','@CHI1','@F');SUB__('@A1',Ord('0'));
Sim__Nom('@B1','@CHI2','@F');SUB__('@B1',Ord('0'));
//if a1<b1 then ---------------------
BRA__('@A1','@B1','NEX1');
//r:=f-1;
PRI__('@R','@F');Dec__('@R');
//while a[r]='0' do r:=r-1;
Sim__Nom('@S','@CHI1','@R');
SeLa('CIK2'); nra__('@s',ord('0'),'ECIK2');
DEC__('@R');
Sim__Nom('@S','@CHI1','@R');
JMP__('CIK2');
SeLa('ECIK2');//------------------------------------
DEC__('@S');//Chr(ord(a[r])-1)
Sim__Set('@CHI1','@R','@S');//a[r]:=
Inc__('@R');//r:=r+1;
//------------------------------------
// while r<f do begin a[r]:='9';inc(r);end;
SeLa('CIK3'); BRA__('@r','@f','ECIK3');
Sim__Set('@CHI1','@r',Ord('9'));
Inc__('@r');
Jmp__('CIK3');
SeLa('ECIK3');
ADD__('@A1',10);
//.....................................
SelA('NEX1'); //------------------ BIG IFFFF
// if a1>b1 THEN rez:=chr((a1-b1)+ord('0'))+rez;
RAV__('@A1','@B1','NEX2');
PRI__('@SSS','@A1');
SUB__('@SSS','@B1');
ADD__('@SSS',Ord('0'));
Add__SSi('@rez','@SSS');
Jmp__('NEX3');
SeLa('NEX2'); NRA__('@A1','@B1','NEX3');// ELSE
Add__SSi('@rez',ord('0'));
SeLa('NEX3');
DEC__('@F');
JMP__('CIK');
SeLa('ECIK');//==========================================
// Расчитываем length(rez)-t
Len__Str('@LR','@REZ');//
Pri__('@LRT','@LR');
SUB__('@LRT','@T');
Pri__('@F',1);
//--------------------------------------
// for f:=1 to length(rez) do
SeLa('CIK4'); BOL__('@F','@LR','ECIK4');
SIM__NOM('@SIM','@REZ','@F');
// if f=length(rez)-t then
NRA__('@LRT','@F','ELSE');
Add__Sim('@REZ2','@SIM');
Add__Sim('@REZ2',ord('.'));
JMP__('EIFF');
SeLa('ELSE'); // ELSE
Add__Sim('@REZ2','@SIM');
SeLa('EIFF');
INC__('@F');
JMP__('CIK4');
SeLa('ECIK4');//--------------------------------------
NOR__Chi('@REZ2');
Cop__Str('@CHI1','@REZ2');
Fre__Str('@REZ');
Fre__Str('@REZ2');
EndProcedure;
end;
Procedure Umn1Chisel;// Умножает строки с числа EAX:EDX без знака
begin
BeginProcedure('Umn1Chisel');
SAV__EAX('@A');
SAV__EDX('@B');
COR__CHI('@T','@A','@B');
Del__Sim('@A',ord('.'));
Del__Sim('@B',ord('.'));
Cre__Str('@REz');
Cre__Str('@REz2');
Cre__Str('@SSS');
Add__Sim('@REZ',ORD('0'));
Pri__('@O',0);
Pri__('@R',0);
Len__Str('@F1','@A');
//=====================================================
// while f1>0 do
SeLa('CIK'); MRA__('@F1',0,'ECIK');
Len__Str('@F2','@A');
//sss:=Add_Po(length(a)-f1,sss,'0');
WRI_B('@SSS',0);
Len__Str('@LA','@A');
SUB__('@LA','@F1');
ADD__POO('@SSS',Ord('0'),'@LA');
PRI__('@R',0);
//....................
SeLa('CIK2'); RAV__('@F2',0,'ECIK2');//while f2>0 do
Sim__NOM('@A1','@A','@F2');SUB__('@A1',Ord('0'));
Sim__NOM('@B1','@B','@F1');SUB__('@B1',Ord('0'));
UMN__EDI('@O','@A1','@B1');
ADD__('@O','@R');
PRI__('@O2','@O');
ADD__('@O2',ord('0'));
Add__SSI('@SSS','@O2');
UMN__DES('@R','@A1','@B1');
DEC__('@F2');
JMP__('CIK2');
SeLa('ECIK2');//....................
// sss:=chr((r)+ord('0'))+sss;
PRI__('@O2','@R');
ADD__('@O2',ord('0'));
Add__SSI('@SSS','@O2');
// rez:=sum1(sss,rez);
Sum1_CHI('@REZ','@SSS');
// f1:=f1-1;
DEC__('@F1');
JMP__('CIK');
SeLa('ECIK'); //------------------------
//=====================================================
Len__STR('@L','@REZ');
// t+t+1
Pri__('@T2','@T');
ADD__('@T2','@T2');
INC__('@T2');
//if Length(rez)<t+t+1 then
BRa__('@L2','@T2','NEX1');
Add__DOO('@REZ',Ord('0'),'@T2');
SeLa('Nex1');
Pri__('@F',1);
Len__Str('@L','@REZ');
PRI__('@ZZZ','@L');
SUB__('@ZZZ','@T');
SUB__('@ZZZ','@T');
SeLa('CIK3'); Bol__('@F','@L','ECIK3');
NRA__('@F','@ZZZ','NEX2');
Sim__Nom('@SIM','@REZ','@F');
ADD__Sim('@REZ2','@SIM');
ADD__Sim('@REZ2',Ord('.'));
JMP__('END2');
SeLa('NEX2'); Sim__Nom('@SIM','@REZ','@F');
ADD__Sim('@REZ2','@SIM');
SeLa('END2'); INC__('@F');
JMP__('CIK3');
SeLa('ECIK3');
Nor__Chi('@REZ2');
Cop__Str('@A','@REZ2');
Fre__Str('@SSS');
Fre__Str('@REZ');
Fre__Str('@REZ2');
EndProcedure;
end;
Procedure Del1Chisel;// Делит строки с числа EAX:EDX без знака
begin
BeginProcedure('Del1Chisel');
SAV__EAX('@A');
SAV__EDX('@B');
SAV__ECX('@TOCH');
COR__CHI('@T','@A','@B');
Del__Sim('@A',Ord('.'));
Del__Sim('@B',Ord('.'));
Nor__CHI('@A');ADD__Poo('@A',Ord('0'),'@TOCH');
Nor__CHI('@B');
//----------------------------
Cre__Str('@R'); // Накаплеваемое значение СТРОКА
Cre__STr('@PPRE');// Предпологаемое значение СТРОКА
Cre__STr('@PRE'); // Предпологаемое значение СТРОКА
Cre__STr('@REZ'); // Результат СТРОКА
Cre__STr('@REZ2');// Результат СТРОКА
Len__Str('@U','@B');
Pri__('@F',1);
//----------------------------
SeLA('Cik'); BOL__('@F','@U','ECIK');
Sim__Nom('@SIM','@A','@F');
Add__Sim('@R','@SIM');
INC__('@F');
JMP__('CIK');
SeLa('ECik'); //----------------------------
//==============================================================================
//while u<=length(a) do
SeLA('Cik2'); Len__Str('@LENA','@A');
BOL__('@U','@LENA','ECIK2');
//if Bol1(r,b) or Rav1(r,b) then
MEN1_CHI('@R','@B','NEX1');
//THEN -------------------------
//pre:='0';
Wri_B('@Pre',0);Add__Sim('@PRE',ord('0'));
Pri__('@C',0);// c:=0;
SeLa('CIK3'); // while men1(sum(pre,b),r) or rav1(sum(pre,b),r) do
// ppre:='0';ppre:=Sum('pre',b)
Wri_b('@Ppre',0);Add__Sim('@PPRE',Ord('0'));
sum1_Chi('@Ppre','@Pre');
sum1_Chi('@Ppre','@B');
BOL1_CHI('@PPRE','@R','ECIK3');
Sum1_Chi('@PRE','@B');
INC__('@C');
JMP__('CIK3');//----------------
SeLa('ECIK3');
Min1_CHI('@R','@PRE');//r:=min1(r,pre);
Pri__('@C2',ord('0'));
ADD__('@C2','@C');
Add__SIM('@REZ','@C2');
JMP__('NEXE');
SeLa('NEX1'); //ELSE -------------------------
Add__Sim('@REZ',Ord('0'));
SeLa('NEXE'); //ENDIF -------------------------
INC__('@U');//u:=u+1;
// if u<=length(a) then r:=r+a[u];
Len__Str('@ZZZ','@a');
BOL__('@U','@ZZZ','NNN');
Sim__Nom('@Sim','@A','@u');
Add__Sim('@R','@SIM');
SeLa('NNN');
JMP__('CIK2');
SeLA('ECik2');
//==============================================================================
Len__Str('@LEN','@REZ');
Pri__('@TTT','@TOCH');
INC__('@TTT');
BRA__('@LEN','@TTT','NEX2');
ADD__DOO('@REZ',Ord('0'),'@TTT');
SeLa('NEX2');
Len__Str('@LEN','@REZ');
Pri__('@F',1);
Pri__('@RT','@LEN');
SUB__('@RT','@TOCH');
SeLa('CIK4'); BOL__('@F','@LEN','ECIK4');
NRA__('@F','@RT','NEX4');
Sim__Nom('@SIM','@REZ','@F');
Add__Sim('@REZ2','@SIM');
Add__Sim('@REZ2',Ord('.'));
JMP__('ENEX4');
SeLa('NEX4'); Sim__Nom('@SIM','@REZ','@F');
Add__Sim('@REZ2','@SIM');
SeLa('ENEX4');INC__('@F');
JMP__('CIK4');
SeLa('ECIK4');
Nor__Chi('@REZ2');
Cop__Str('@A','@REZ2');
Fre__Str('@R'); // Накаплеваемое значение СТРОКА
Fre__STr('@PPRE');// Предпологаемое значение СТРОКА
Fre__STr('@PRE'); // Предпологаемое значение СТРОКА
Fre__STr('@REZ'); // Результат СТРОКА
Fre__STr('@REZ2');// Результат СТРОКА
EndProcedure;
end;
procedure RavChisel; // ПРоверяет равенство строк с числами EAX:EDX Возвращает EAX
Begin
BeginProcedure('RavChisel');
SAV__EAX('@CHI1');
SAV__EDX('@CHI2');
Zna__Chi('@R','@CHI1','@CHI2');
//-------------------------------
Nra__('@R',1,'NEX1');
JMP__('NERAVNO');
//-------------------------------
SeLa('NEX1'); Nra__('@R',2,'NEX2');
JMP__('NERAVNO');
//-------------------------------
SeLa('NEX2'); RAV1_CHI('@CHI1','@CHI2','RAVNO');
SeLa('NERAVNO');PRI__('@REZ',0);
JMP__('VIHOD');
SeLa('RAVNO'); PRI__('@REZ',1);
SeLa('VIHOD'); LOA__EAX('@REZ');
EndProcedure;
end;
procedure BolChisel; // ПРоверяет Больше ли строка с числами EAX:EDX Возвращает EAX
Begin
BeginProcedure('BolChisel');
SAV__EAX('@CHI1');
SAV__EDX('@CHI2');
Zna__Chi('@R','@CHI1','@CHI2');
//-------------------------------
Nra__('@R',1,'NEX1');
JMP__('MENHE');
//-------------------------------
SeLa('NEX1'); Nra__('@R',2,'NEX2');
JMP__('BOLHE');
//-------------------------------
SeLa('NEX2'); Bol1_CHI('@CHI1','@CHI2','BOLHE');
SeLa('MENHE');PRI__('@REZ',0);
JMP__('VIHOD');
SeLa('BOLHE');PRI__('@REZ',1);
SeLa('VIHOD');LOA__EAX('@REZ');
EndProcedure;
end;
procedure MenChisel; // ПРоверяет Ментше ли строка с числами EAX:EDX Возвращает EAX
Begin
BeginProcedure('MenChisel');
SAV__EAX('@CHI1');
SAV__EDX('@CHI2');
Zna__Chi('@R','@CHI1','@CHI2');
//-------------------------------
Nra__('@R',1,'NEX1');
JMP__('MENHE');
//-------------------------------
SeLa('NEX1'); Nra__('@R',2,'NEX2');
JMP__('BOLHE');
//-------------------------------
SeLa('NEX2'); Men1_CHI('@CHI1','@CHI2','MENHE');
SeLa('BOLHE');PRI__('@REZ',0);
JMP__('VIHOD');
SeLa('MENHE');PRI__('@REZ',1);
SeLa('VIHOD');LOA__EAX('@REZ');
EndProcedure;
end;
Procedure SumChisel; // Складывает строки с числа EAX:EDX Полное
begin
BeginProcedure('SumChisel');
SAV__EAX('@A');
SAV__EDX('@B');
Zna__Chi('@Z','@A','@B');
BOL1_CHI('@A','@B','BOL');
MEN1_CHI('@A','@B','MEN');
SeLa('RAV'); //------------------------
RAV__('@Z',1,'RAV1');
RAV__('@Z',2,'RAV2');
RAV__('@Z',0,'RAV0');
SeLa('RAV3');
Sum1_CHI('@a','@b');
ADD__SSI('@a',Ord('-'));
JMP__('VIH');
SeLa('RAV1');
Wri_b('@a',0);
ADD__Sim('@a',Ord('0'));
JMP__('VIH');
SeLa('RAV2');
Wri_b('@a',0);
ADD__Sim('@a',Ord('0'));
JMP__('VIH');
SeLa('RAV0');
Sum1_CHI('@a','@b');
JMP__('VIH');
SeLa('BOL'); //------------------------
RAV__('@Z',1,'BOL1');
RAV__('@Z',2,'BOL2');
RAV__('@Z',0,'BOL0');
SeLa('BOL3');
Sum1_CHI('@a','@b');
ADD__SSI('@a',Ord('-'));
JMP__('VIH');
SeLa('BOL1');
Min1_CHI('@a','@b');
ADD__SSI('@a',ord('-'));
JMP__('VIH');
SeLa('BOL2');
Min1_CHI('@a','@b');
JMP__('VIH');
SeLa('BOL0');
Sum1_CHI('@a','@b');
JMP__('VIH');
SeLa('MEN'); //------------------------
RAV__('@Z',1,'MEN1');
RAV__('@Z',2,'MEN2');
RAV__('@Z',0,'MEN0');
SeLa('MEN3');
Sum1_CHI('@a','@b');
ADD__SSI('@a',Ord('-'));
JMP__('VIH');
SeLa('MEN1');
Min1_CHI('@a','@b');
JMP__('VIH');
SeLa('MEN2');
Min1_CHI('@a','@b');
ADD__SSI('@a',Ord('-'));
JMP__('VIH');
SeLa('MEN0');
Sum1_CHI('@a','@b');
SeLa('VIH');
EndProcedure;
end;
Procedure MinChisel; // Вычитает строки с числа EAX:EDX Полное
begin
BeginProcedure('MinChisel');
SAV__EAX('@A');
SAV__EDX('@B');
Zna__Chi('@Z','@A','@B');
BOL1_CHI('@A','@B','BOL');
MEN1_CHI('@A','@B','MEN');
SeLa('RAV'); //------------------------
RAV__('@Z',1,'RAV1');
RAV__('@Z',2,'RAV2');
RAV__('@Z',0,'RAV0');
SeLa('RAV3');
Wri_B('@A',0);
ADD__Sim('@a',Ord('0'));
JMP__('VIH');
SeLa('RAV1');
Sum1_CHI('@a','@b');
ADD__SSI('@a',ord('-'));
JMP__('VIH');
SeLa('RAV2');
Sum1_CHI('@a','@b');
JMP__('VIH');
SeLa('RAV0');
Wri_B('@A',ord('0'));
ADD__Sim('@a',Ord('0'));
JMP__('VIH');
SeLa('BOL'); //------------------------
RAV__('@Z',1,'BOL1');
RAV__('@Z',2,'BOL2');
RAV__('@Z',0,'BOL0');
SeLa('BOL3');
Min1_CHI('@a','@b');
ADD__SSi('@a',ord('-'));
JMP__('VIH');
SeLa('BOL1');
Sum1_CHI('@a','@b');
ADD__SSI('@a',ord('-'));
JMP__('VIH');
SeLa('BOL2');
Sum1_CHI('@a','@b');
JMP__('VIH');
SeLa('BOL0');
Min1_CHI('@a','@b');
JMP__('VIH');
SeLa('MEN'); //------------------------
RAV__('@Z',1,'MEN1');
RAV__('@Z',2,'MEN2');
RAV__('@Z',0,'MEN0');
SeLa('MEN3');
Min1_CHI('@a','@b');
JMP__('VIH');
SeLa('MEN1');
Sum1_CHI('@a','@b');
ADD__SSI('@a',ord('-'));
JMP__('VIH');
SeLa('MEN2');
Sum1_CHI('@a','@b');
JMP__('VIH');
SeLa('MEN0');
Min1_CHI('@a','@b');
ADD__SSI('@a',ord('-'));
SeLa('VIH');
EndProcedure;
end;
Procedure UmnChisel; // Умножение строки с числа EAX:EDX Полное
begin
BeginProcedure('UmnChisel');
SAV__EAX('@A');
SAV__EDX('@B');
Zna__Chi('@Z','@A','@B');
NRA__('@Z',3,'NEX3');
UMN1_CHI('@A','@B');
JMP__('VIH');
SeLa('NEX3');
NRA__('@Z',1,'NEX4');
UMN1_CHI('@A','@B');
Add__SSI('@A',Ord('-'));
JMP__('VIH');
SeLa('NEX4');
NRA__('@Z',2,'NEX5');
UMN1_CHI('@A','@B');
Add__SSI('@A',ord('-'));
JMP__('VIH');
SeLa('NEX5');
UMN1_CHI('@A','@B');
SeLa('VIH');
EndProcedure;
end;
Procedure DelChisel; // Деление строки с числа EAX:EDX Полное
begin
BeginProcedure('DelChisel');
SAV__EAX('@A');
SAV__EDX('@B');
Zna__Chi('@Z','@A','@B');
NRA__('@Z',3,'NEX3');
DEL1_CHI('@A','@B');
JMP__('VIH');
SeLa('NEX3');
NRA__('@Z',1,'NEX4');
DEL1_CHI('@A','@B');
Add__SSI('@A',Ord('-'));
JMP__('VIH');
SeLa('NEX4');
NRA__('@Z',2,'NEX5');
DEL1_CHI('@A','@B');
Add__SIM('@A',Ord('-'));
JMP__('VIH');
SeLa('NEX5');
DEL1_CHI('@A','@B');
SeLa('VIH');
EndProcedure;
end;
{$ENDIF}
{ Секция Описания элементов програмым } {$IFDEF Tim}
Procedure InitMem; // Инициализация памяти
Begin
BeginProcedure('InitMem');
Pri__('@f1','TrMe');
Inc__('TrMe');
Pri__('@f2',API__STEK-1000);
SeLa('Cikl'); RAV__('@f1','@f2','VIHOD');
Wri_b('@f1',0);
inc__('@f1');
Jmp__('Cikl');
SeLa('VIHOD');
EndProcedure;
end;
Procedure TEl.Del;
var
pr,ne:Tel;
begin
pr:=pre;
ne:=nex;
if pr<>nil then pr.nex:=ne;
if ne<>nil then ne.pre:=pr;
if rod.blo=self then rod.blo:=ne;
end;
function TEl.Lst:TEl;
var
rez:tel;
begin
rez:=nil;
if blo<>nil then
begin
rez:=blo;
while rez.nex<>nil do rez:=rez.nex;
end;
Lst:=rez;
end;
Constructor TEl.Create;// Создает элемент
begin
Rod:=nil; // Предок
Pre:=nil; // предыдущий эллемент
Nex:=nil; // Следующий элемент
blo:=nil;
MaxIdEl:=MaxIdEl+1;
end;
Function TEl.add(el:Tel):Tel;// Добавляет едемент в конец списка
var
pr,ne:Tel;
begin
pr:=el.Pre;
ne:=el.Nex;
if el.Pre<>nil then el.pre.nex:=ne;
if el.Nex<>nil then el.nex.pre:=pr;
If(el.Rod<>nil)and (el.rod.blo=el) then
if(el.nex<>nil)
then el.rod.blo:=el.nex
else el.rod.blo:=nil;
el.pre:=lst;
if lst<>nil then lst.nex:=el else blo:=el;
el.Rod:=Self;
el.nex:=nil;
end;
Function TEl.addS(el:Tel):Tel;// Добавляет едемент в Начало списка
var
pr,ne:Tel;
begin
pr:=el.Pre;
ne:=el.Nex;
if el.Pre<>nil then el.pre.nex:=ne;
if el.Nex<>nil then el.nex.pre:=pr;
If(el.Rod<>nil)and (el.rod.blo=el) then
if(el.nex<>nil)
then el.rod.blo:=el.nex
else el.rod.blo:=nil;
el.Rod:=Self;
el.pre:=nil;
el.nex:=lst;
if blo<>nil then
begin
el.blo.pre:=el;
el.nex:=blo;
end;
blo:=el;
end;
Function TEl.add(s:AnsiString;t:Byte):Tel;// Создает и Добавляет едемент в конец списка
var
rez:Tel;
begin
rez:=Tel.create;
rez.axt:=AnsiUpperCase(s);
rez.zna:=s;
rez.Tis:=t;
add(rez);
add:=rez;
end;
Function TEl.Cop(iRod,iPre:Tel):Tel;// Копирует элемент
var
rez:Tel;
f:Longint;
pr,ne:Tel;
begin
rez:=Tel.create;
rez.Axt:=Axt;
rez.Zna:=Zna;
rez.Tis:=Tis;
rez.Fun:=Fun;
rez.Rod:=iRod;
rez.Pre:=iPre;
rez.Nex:=Nil;
rez.Blo:=Nil;
//================================
if blo<>nil then
begin
rez.blo:=blo.cop(rez,nil);
ne:=blo.nex;// следующий
pr:=rez.blo;
while ne<>nil do
begin
pr.nex:=ne.cop(rez,pr);
pr.Nex.Pre:=pr;
ne:=ne.nex;
pr:=pr.nex;
end;
end;
Cop:=Rez;
end;
Procedure Tel.Cle;// Очищает элемент
var
l,l2:Tel;
begin
l2:=blo;
while l2<>nil do
begin
l:=l2;
l.Cle;
l2:=l.nex;
l.free;
end;
end;
Procedure CompileSc(s1,s2:Ansistring;El:Tel);// Чтение скобок
var
f:Longint;
NK,PE,NE:Tel;
begin
f:=1;
NK:=El;// куда добавлять
PE:=El.Blo;// ПОслдений эллемент
While pe<>nil do
begin
ne:=pe.nex;
if el<>nk then
if pe.Axt<>s2 then NK.add(PE);
if PE.Axt=s1 then NK:=PE;// Куда добавлять
if PE.Axt=s2 then begin NK:=NK.Rod;
pe.del;end;// Вернуться на уровень вверх
pe:=ne;
end;
end;
Procedure Compileti(el:Tel);// Умножение деление
var
l:TEl;
begin
l:=el.blo;
while l<>nil do
begin
if l.blo<>nil then Compileti(l);
if l.Axt=':' then
begin
el.tip:=el.nex.axt;
l:=l.nex.nex;
el.del;
el.nex.del;
end else l:=l.nex;
end;
end;
Procedure CompileMa(s:ansistring;el:Tel);// Умножение деление
var
l:TEl;
begin
l:=el.blo;
while l<>nil do
begin
if l.blo<>nil then CompileMa(s,l);
if est(s,l.Axt) then
begin
if l.pre<>nil then CompileMa(s,l.pre);
if l.nex<>nil then CompileMa(s,l.nex);
l.add(l.pre);
l.add(l.nex);
end;
l:=l.nex;
end;
end;
Procedure Podgotovk(el:Tel);// Удаление ненужных символов замена begin end на {}
var
l:TEl;
begin
l:=el.blo;
while l<>nil do
begin
if l<>nil then Podgotovk(l);
if (l.axt ='BEGIN') then l.axt:='{';
if (l.axt ='END') then l.axt:='}';
l:=l.Nex;
end;
end;
Procedure CompilePa(el:Tel);// Вложение параметров функций
var
l:Tel;
begin
l:=el.blo;
while l<>nil do
begin
if (l.Tis=Ti_Ope) and (l.nex<>nil) then
if (l.nex.axt='(') then l.add(l.nex) else
if (l.blo=nil) then l.add('(',Ti_Zna);
if (l.blo<>nil) then CompilePa(l);
l:=l.nex;
end;
end;
Procedure CompileBL(el:Tel);// Вложение Блоков {}
var
l:tel;
begin
l:=el.blo;
while l<>nil do
begin
if(l.Tis=Ti_Ope)and (l.nex<>nil) then
if (l.nex.AXT='{') then
begin
l.fun:=true;
l.add(l.nex);
end else l.add('{',Ti_Zna);
if l.blo<>nil then CompileBL(l);
l:=l.nex;
end;
end;
Procedure ProgCompile(El:Tel);// ПРеоразует сроку в набор елементов
begin
Podgotovk(el); // преобразование begin end в { }
CompileSc('(',')',el); // Вложение Cкобок
CompileSc('{','}',el); // Вложение Блоков
CompilePa(el); // вложение параметров
CompileTi(el); // вложение Типов
CompileBL(el); // вложение Блоков в операторы
Compilema('*,/',el); // Умножение деление
Compilema('+,-',el); // Сложение вычитание
Compilema('>,<,=,>=,<=,!=',el); // Больше меньше
Compilema(':=',el); // ПРисваивание
end;
Function ProgRead(Var UK,LE:Longint;S:Ansistring):Tel;// Разбивает строку на токены
var
rez:Tel;
begin
Rez:=Tel.create;
while UK<=LE do
If EtoOpe(UK,LE,S) Then rez.add(ReadOpe(UK,LE,S),Ti_Ope) else
If EtoCif(UK,LE,S) Then rez.add(ReadCif(UK,LE,s),Ti_Cif) else
If EtoKav(UK,LE,S) Then rez.add(ReadKav(UK,LE,s),Ti_Kav) else
If EtoRem(UK,LE,S) Then ReadRem(UK,LE,s) else
If EtoZn2(UK,LE,S) Then rez.add(ReadZn2(UK,LE,s),Ti_Zna) else
If EtoZn1(UK,LE,S) Then rez.add(ReadZn1(UK,LE,s),Ti_Zna) else
Uk:=Uk+1;
ProgRead:=Rez;
end;
//==============================================================================
//==============================================================================
//==============================================================================
Procedure ELE__(a,b:String;c:Longword);
begin
PRI__('@QWE__ELE',c);//PE:=El.Blo; ПОслдений эллемент
ADD__('@QWE__ELE',b);
REA_W(a,'@QWE__ELE');
end;
Procedure ELE_B(a,b:String;c:Longword);
begin
PRI__('@QWE__ELE',c);//PE:=El.Blo; ПОслдений эллемент
ADD__('@QWE__ELE',b);
REA_B(a,'@QWE__ELE');
end;
Procedure Cre__Ele(a:String); // Создает Новый елемент
begin
cal__('GetElement');
SAV__EAX(a);
end;
Procedure Fre__Ele(a:String); // Удаляет елемент и все вложеные элементы
begin
Loa__EAX(a);
cal__('FreElement');
end;
Procedure Add__Ele(a,b:String); // Добавляет элемент в список
begin
LOA__EAX(a);
LOA__EDX(b);
CAL__('AddElement');
end;
procedure Del__Ele(a:String); // Удаляет из списка отсоеденяет элемент
begin
LOA__EAX(a);
CAL__('DelElement'); //pe.del;
end;
Procedure Sad__Ele(a,b:String;c:Byte); // Создает и добюавлет элемент
begin
Loa__EAX(a);
Loa__EDX(b);
PRI__('@QWE_TIP',c);
LOA__ECX('@QWE_TIP');
CAL__('SAdElement');
end;
Procedure Lst__Ele(a,b:String); // Ищит послеждий элемент
begin
LOA__EAX(b);
CAL__('LstElement');
SAV__EAX(a);
end;
Procedure Cop__ELE(iEl,iRod,iPre,rez:String);// создает копию элемента
begin
LOA__EAX(iEl);
LOA__EDX(iRod);
LOA__ECX(iPre);
CAL__('CopElement');
SAV__EAX(rez);
end;
Procedure FreElement;// освоббождает элемент
begin
BeginProcedure('FreElement');
SAV__EAX('@iEl');// тип элемента
ELE__('@AXT','@iEl',EL_AXT);
RAV__('@AXT',0,'Fre_Ele_NEX1');
Fre__Str('@AXT');
SeLa('Fre_Ele_NEX1');
ELE__('@ZNA','@iEl',EL_ZNA);
RAV__('@ZNA',0,'Fre_Ele_NEX2');
Fre__Str('@ZNA');
SeLa('Fre_Ele_NEX2');
ELE__('@BLO','@iEl',EL_BLO);
RAV__('@BLO',0,'Fre_Ele_NEX3');
LOA__EAX('@BLO');
CAL__('FreElement');
SeLa('Fre_Ele_NEX3');
ELE__('@NEX','@iEl',EL_NEX);
RAV__('@NEX',0,'Fre_Ele_NEX4');
LOA__EAX('@NEX');
CAL__('FreElement');
SeLa('Fre_Ele_NEX4');
DEC__('@iEl');
WRI_B('@iEl',0);
EndProcedure;
end;
procedure GetElement;// ПРоцедура создает Новый элемент в памяти
begin
BeginProcedure('GetElement');
// Ищим свободное зерно
Pri__('@Fin','TrMe');
SeLa('Cikl'); REa_b('@Del','@Fin');
RAV__('@Del',0,'Nex');
Add__('@FIN',Zerno);
JMP__('CIKL');
SeLa('NEX'); Wri_B('@Fin',2);INC__('@Fin'); // записываем что этот участок памяти вделен под Елемент
PRI__('@REZ','@Fin'); // Записываем адрес Елемента
Wri_B('@Fin',1);INC__('@Fin'); // Записываем RES;
Wri_B('@Fin',0);INC__('@Fin'); // Записываем TIS;
Wri_B('@Fin',0);INC__('@Fin'); // Записываем FUN;
Wri_B('@Fin',0);INC__('@Fin'); // Записываем ERR;
Cre__Str('@AXT');Wri_W('@Fin','@AXT');INC_W('@Fin');// Записываем AXT;
Cre__Str('@ZNA');Wri_W('@Fin','@ZNA');INC_W('@Fin');// Записываем ZNA;
Wri_W('@Fin','@REZ');INC_W('@Fin');// Записываем SAM;
Wri_W('@Fin',0);INC_W('@Fin'); // Записываем ROD;
Wri_W('@Fin',0);INC_W('@Fin'); // Записываем PRE;
Wri_W('@Fin',0);INC_W('@Fin'); // Записываем NEX;
Wri_W('@Fin',0);INC_W('@Fin'); // Записываем BLO;
SeLa('VIHOD');Loa__EAX('@REZ'); // возвращаем результат
EndProcedure;
end;
Procedure LstElement;// Eax Eax Последний элемент
begin
BeginProcedure('LstElement');
SAV__EAX('@EL');
PRI__('@EAX',0);
ADD__('@EL',EL_BLO);
REA_W('@BLO','@El');
RAV__('@BLO',0,'VIHOD');
PRI__('@EAX','@BLO');
PRI__('@LLL','@BLO');
SeLa('CIKL'); ADD__('@LLL',EL_NEX);
REA_W('@LLL','@LLL');
RAV__('@LLL',0,'VIHOD');
PRI__('@EAX','@LLL');
JMP__('CIKL');
SeLa('VIHOD'); LOA__EAX('@EAX');
EndProcedure;
end;
Procedure AddElement;// EAX:Родитель EDX:Добавляемый элемент
begin
BeginProcedure('AddElement');
SAV__EAX('@ROD');
SAV__EDX('@EL');
LOA__EAX('@EL');
CAL__('DelElement');
// Устанавливаем родителя
PRI__('@AROD',EL_ROD);
ADD__('@AROD','@EL');
WRI_W('@AROD','@ROD');
Lst__ELE('@LLL','@ROD');
RAV__('@LLL',0,'BLO');
// ПРисоеденяем к последнему элементу
PRI__('@APRE',EL_PRE);
ADD__('@APRE','@EL');
WRI_W('@APRE','@LLL');
PRI__('@ANEX',EL_NEX);
ADD__('@ANEX','@LLL');
WRI_W('@ANEX','@El');
JMP__('VIHOD');
SeLa('BLO'); // Добавляем вложеный элемент
PRI__('@ABLO',EL_BLO);
ADD__('@ABLO','@ROD');
WRI_W('@ABLO','@EL');
SeLa('VIHOD');
EndProcedure;
end;
Procedure SadElement;// EAX:Родитель EDX:SLOVO EСX: Тип Элемента
begin
BeginProcedure('SAdElement');
SAV__EAX('@ROD');
SAV__EDX('@SLO');
SAV__ECX('@TIP');
Cre__Ele('@EL');
// Записываем тип элемента
PRI__('@ATIS',el_TIS);
ADD__('@ATIS','@EL');
WRI_B('@ATIS','@TIP');
// Записываем AXT элемента
ELE__('@AXT','@El',EL_AXT);
Cop__Str('@AXT','@SLO');
// Записываем ZNA элемента
ELE__('@ZNA','@El',EL_ZNA);
Cop__Str('@ZNA','@SLO');
LOA__EAX('@ROD');
LOA__EDX('@EL');
CAL__('AddElement');
SeLa('VIHOD'); LOA__EAX('@EL');
EndProcedure;
end;
procedure DelElement;// EAX удаляемый елемент
begin
BeginProcedure('DelElement');
SAV__EAX('@EL');
// Адрес Следующего элемента
PRI__('@ANEX',EL_NEX);
ADD__('@ANEX','@EL');
REA_W('@NEX','@ANEX');
WRI_W('@ANEX',0);
// Адрес Предыдущего элемента
PRI__('@APRE',EL_PRE);
ADD__('@APRE','@EL');
REA_W('@PRE','@APRE');
WRI_W('@APRE',0);
// Адрес родителя
PRI__('@AROD',EL_ROD);
ADD__('@AROD','@EL');
REA_W('@ROD','@AROD');
WRI_W('@AROD',0);
// Установка в предыдущем элементе следующего
RAV__('@PRE',0,'NEX1');
PRI__('@ZPRE',EL_NEX);
ADD__('@ZPRE','@PRE');
WRI_W('@ZPRE','@NEX');
SeLa('NEX1'); // Установка в Следующем элементе предыдущего
RAV__('@NEX',0,'NEX2');
PRI__('@ZNEX',EL_PRE);
ADD__('@ZNEX','@NEX');
WRI_W('@ZNEX','@PRE');
SeLa('NEX2'); // Сброс родителя
RAV__('@ROD',0,'VIHOD');
PRI__('@ABLO',EL_BLO);
ADD__('@ABLO','@ROD');
REA_W('@BLO','@ABLO');
NRA__('@BLO','@EL','VIHOD');
WRI_W('@ABLO','@NEX');
SeLa('VIHOD');
EndProcedure;
end;
procedure CopElement;// Создает копию элемента со всеми вложеными элементами их тоже копирует
begin
BeginProcedure('CopElement');
SAV__EAX('@EL');
SAV__EDX('@iRod');
SAV__ECX('@iPre');
Cre__ELE('@REZ');
//===========================
ELE__('@AXT1','@REZ',EL_AXT);
ELE__('@AXT2','@EL',EL_AXT);
Cop__Str('@AXT1','@AXT2');
//===========================
ELE__('@ZNA1','@REZ',EL_ZNA);
ELE__('@ZNA2','@EL',EL_ZNA);
Cop__Str('@ZNA1','@ZNA2');
//===========================
ELE_B('@TIS2','@el',EL_TIS);
PRI__('@ATIS','@rez');
ADD__('@ATIS',EL_TIS);
WRI_B('@ATIS','@TIS2');
//===========================
ELE_B('@FUN2','@el',EL_FUN);
PRI__('@AFUN','@rez');
ADD__('@AFUN',EL_FUN);
WRI_B('@AFUN','@FUN2');
//===========================
PRI__('@AROD','@rez');
ADD__('@AROD',EL_ROD);
WRI_W('@AROD','@iROD');
//===========================
PRI__('@APRE','@rez');
ADD__('@APRE',EL_PRE);
WRI_W('@APRE','@iPre');
//===========================
PRI__('@ANEX','@rez');
ADD__('@ANEX',EL_Nex);
WRI_W('@ANEX',0);
//===========================
PRI__('@ABLO','@rez');
ADD__('@ABLO',EL_BLO);
WRI_W('@ABLO',0);
// if blo<>nil then begin ==================================
ELE__('@BLO','@el',EL_BLO);
RAV__('@BLO',0,'VIHOD');
// rez.blo:=blo.cop(rez,nil);
LOA__EAX('@Blo');
LOA__EDX('@REZ');
LOA__ECX(0);
CAL__('CopElement');
SAV__EAX('@Blo');
PRI__('@ABLO',EL_BLO);
ADD__('@ABLO','@REZ');
WRI_W('@ABLO','@Blo');
PRI__('@PR','@Blo'); //pr:=rez.blo;
//--------------------------
//ne:=blo.nex;// следующий
ELE__('@BLO','@el',EL_BLO);
ELE__('@NE','@BLO',EL_NEX);
//while ne<>nil do
SeLa('CIK1'); Rav__('@NE',0,'VIHOD');
//pr.nex:=ne.cop(rez,pr);
LOA__EAX('@NE');
LOA__EDX('@REZ');
LOA__ECX('@PR');
CAL__('CopElement');
SAV__EAX('@NEX');
PRI__('@ANEX','@PR');
ADD__('@ANEX',El_NEX);
WRI_W('@ANEX','@NEX');
// .........
//pr.Nex.Pre:=pr;
PRI__('@APRE','@NEX');
ADD__('@APRE',el_PRE);
WRi_W('@APRE','@PR');
ELE__('@NE','@NE',EL_NEX);
ELE__('@PR','@PR',EL_NEX);
JMP__('CIK1');
SeLa('ECIK1');
// END Cop:=Rez;=============================================
SeLa('VIHOD'); LOA__EAX('@REZ');
EndProcedure;
{ Function TEl.Cop(iRod,iPre:Tel):Tel;
var
rez:Tel;
f:Longint;
pr,ne:Tel;
begin
rez:=Tel.create;
rez.Axt:=Axt;
rez.Zna:=Zna;
rez.Tis:=Tis;
rez.Fun:=Fun;
rez.Rod:=iRod;
rez.Pre:=iPre;
rez.Nex:=Nil;
rez.Blo:=Nil;
//================================
if blo<>nil then
begin
rez.blo:=blo.cop(rez,nil);
pr:=rez.blo;
ne:=blo.nex;// следующий
while ne<>nil do
begin
pr.nex:=ne.cop(rez,pr);
pr.Nex.Pre:=pr;
ne:=ne.nex;
pr:=pr.nex;
end;
end;
Cop:=Rez;
end;
}
end;
{$ENDIF}
{ Секция для Интерпретации програмым } {$IFDEF Tim}
Constructor TProg.Create;
begin
GEl:=Nil;
end;
Procedure TProg.Clear;
begin
if Gel<>Nil Then
begin
Gel.cle;
Gel.Free;
Gel:=Nil;
end;
end;
// Ищит функцию iNam:Ansistring; поиск наружу и в параметрах
function FindFuncN(iEl:TEl;n:ansistring):Tel;
var
l,REz:Tel;
begin
rez:=Nil;
if (iEl.fun)and (iEl.Axt=n) then rez:=iEl;
l:=iEl;
while (l<>nil) and (rez=nil) do
begin
if (l.Tis=Ti_Ope) and
(l.fun) and
(l.Axt=n) Then rez:=l;
l:=l.pre;
end;
if (rez=nil) and (iEl.rod<>nil) and (iEl.rod.fun) Then
begin
l:=iEl.rod.blo.blo;
while (REZ=NIL) AND (l<>nil) do
begin
if l.Axt=n then rez:=l;
l:=l.nex;
end;
end;
if (rez=nil) and (iEl.Rod<>Nil) Then rez:=FindFuncN(iEl.Rod,n);
FindFuncN:=rez;
end;
Procedure TProg.TRRunS(el:Tel);// исполняет структуру
var
l:TEl;
begin
l:=el.blo;
While l<>nil do
begin
if Not l.fun then TrRun(l);
l:=l.nex;
end;
end;
Procedure TProg.TRRun(el:Tel); // выполняет кон команду
var
l1,l2:TEl;
Fun,ru:Tel;
begin
if (el.Axt='PRINT') Then TRCON(el) else
if (el.Axt='WHILE') Then TRWHI(el) else
if (el.Axt='IF' ) Then TRUSL(el) else
if (el.Axt='||' ) Then TRILI(el) else
if (el.Axt='&&' ) Then TRIII(el) else
if (el.Axt='*' ) Then TRUMN(el) else
if (el.Axt='/' ) Then TRDEL(el) else
if (el.Axt='+' ) Then TRPLU(el) else
if (el.Axt='-' ) Then TRMIN(el) else
if (el.Axt='=' ) Then TRRAV(el) else
if (el.Axt='>' ) Then TRBOL(el) else
if (el.Axt='<' ) Then TRMEN(el) else
if (el.Axt='<>' ) Then TRNER(el) else
if (el.Axt='!=' ) Then TRNER(el) else
if (el.Axt='>=' ) Then TRBRA(el) else
if (el.Axt='<=' ) Then TRMRA(el) else
if (el.Axt=':=' ) Then TRPRI(el) else
if (el.Axt='(' ) Then TrSCO(el) else
if (el.Axt='{' ) Then TrRuns(el) else
if (el.Tis=Ti_Ope) Then
begin
fun:=FindFuncN(el,el.Axt);
if fun<>nil then
begin
ru:=fun.cop(el.Rod,El.Pre);
if el.blo<>nil then
TrRuns(El.blo);//Вычисляем параметры
if (ru.blo<>nil) and (ru.blo.blo<>nil) and
(el.blo<>nil) and (el.blo.blo<>nil) then
begin
l1:=ru.blo.blo;
l2:=el.blo.blo;
while (l1<>nil) and (l2<>nil) do
begin
l1.Zna:=l2.Zna;
l1:=l1.nex;
l2:=l2.nex;
end;
end;
// Если есть исполнительный блок
if (Ru.blo<>nil) and (Ru.blo.nex<>nil) then TrRuns(Ru.blo.nex);
el.Zna:=Ru.zna;
Ru.Cle;
ru.Free;
end else
el.Err:='Не обнаржена переменная'+el.Axt;
end
else
el.Err:='Неопределено';
end;
Procedure TProg.TrRun(s:Ansistring);
var
el:Tel;
uk,le:Longint;
begin
Uk:=1;le:=Length(s);
el:=ProgRead(uk,le,s);// Разбивает скрипт на составные части
ProgCompile(el); // Формирует исполнительнгую структуру
TRRunS(el); // Выполнение скрипта
Gel:=el;
end;
Procedure TProg.TRSCO(iel:Tel);
var
l:TEl;
rez:Ansistring;
begin
rez:='';
l:=Iel.Blo;
while l<>nil do
begin
trRun(l);
rez:=rez+l.zna;
l:=l.nex;
end;
iel.zna:=rez;
end;
Procedure TProg.TRCON(iel:Tel);
var
l:Tel;
begin
l:=iel.Blo;
while l<>nil do
begin
TrRun(l);
Con:=Con+l.zna;
L:=l.nex;
end;
Con:=Con+chr(13)+chr(10);
end;
Procedure TProg.TRWHI(iel:Tel);
begin
if iel.blo=nil
Then iel.Err:='(Не Верная конструкция ПОКА)'
else
begin
TrRun(iel.blo);
WHile iel.blo.zna='1' do
begin
if iel.blo.nex=nil
then iel.Err:='(Не Верная конструкция ПОКА)'
else TrRun(iel.blo.nex);
TrRun(iel.blo);
end;
end
end;
Procedure TProg.TRUSL(iel:Tel);
begin
TrRun(iel.Blo);
if iel.blo=nil then iel.err:='Не вероое условие' else
if iel.Blo.zna='1' then TrRun(iel.Blo.nex) else
if iel.nex.nex<>nil then TrRun(iel.Blo.nex.nex);
end;
Procedure TProg.TRUMN(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if Not EtoCif(1,length(iel.blo.zna),iel.blo.zna)
then iel.blo.Err:='(Не верное значение)' else
if Not EtoCif(1,length(iel.blo.nex.zna),iel.blo.nex.zna)
then iel.blo.nex.Err:='(Не верное значение)' else
iel.zna:=FloatToStr(StrToFloat(iel.blo.zna)*StrToFloat(iel.blo.nex.zna))
end;
end;
Procedure TProg.TRDEL(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if Not EtoCif(1,length(iel.Blo.zna),iel.Blo.zna) then iel.Blo.Err:='(Не верное значение)' else
if Not EtoCif(1,length(iel.blo.nex.zna),iel.Blo.nex.zna)then iel.Blo.Nex.Err:='(Не верное значение)'else
if StrToFloat(iel.blo.nex.zna)=0 Then iel.blo.nex.Err:='(Деление на ноль)' else
iel.Zna:=FloatToStr(StrToCifra(iel.Blo.zna)/StrToCifra(iel.Blo.nex.zna))
end;
end;
Procedure TProg.TRPLU(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if EtoCif(1,length(iel.Blo.zna),iel.Blo.zna) and EtoCif(1,length(iel.Blo.nex.zna),iel.Blo.nex.zna)
Then
Begin
iel.zna:=FloatToStr(StrToFloat(iel.Blo.zna)+StrToFloat(iel.Blo.nex.zna))
end
Else
begin
iel.zna:=iel.Blo.zna+iel.Blo.nex.zna
end;
end;
end;
Procedure TProg.TRMIN(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if Not EtoCif(1,length(iel.blo.zna),iel.blo.zna) then iel.blo.Err:='(Не верное значение)' else
if Not EtoCif(1,length(iel.blo.nex.zna),iel.blo.nex.zna) then iel.blo.nex.Err:='(Не верное значение)' else
iel.zna:=FloatToStr(StrToFloat(iel.blo.zna)-StrToFloat(iel.blo.nex.zna))
end;
end;
Procedure TProg.TRRAV(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if iel.Blo.zna=iel.Blo.nex.zna
Then iel.Zna:='1'
else iel.Zna:='0'
end;
end;
Procedure TProg.TRBOL(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if EtoCif(1,Length(iel.Blo.zna),iel.Blo.zna) and EtoCif(1,Length(iel.Blo.nex.zna),iel.Blo.nex.zna) then
begin
if CifraFloat(iel.Blo.zna)>CifraFloat(iel.Blo.nex.zna)
Then iel.Zna:='1'
else iel.Zna:='0'
end else
if iel.Blo.zna>iel.Blo.nex.zna
Then iel.Zna:='1'
else iel.Zna:='0'
end;
end;
Procedure TProg.TRMEN(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if EtoCif(1,Length(iel.blo.zna),iel.blo.zna) and
EtoCif(1,Length(iel.blo.nex.zna),iel.blo.nex.zna) then
begin
if CifraFloat(iel.blo.zna)<CifraFloat(iel.blo.nex.zna)
Then iel.Zna:='1'
else iel.Zna:='0'
end else
if iel.blo.zna<iel.blo.nex.zna
Then iel.Zna:='1'
else iel.Zna:='0'
end;
end;
Procedure TProg.TRNER(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if EtoCif(1,Length(iel.Blo.zna),iel.blo.zna) and
EtoCif(1,Length(iel.blo.nex.zna),iel.blo.nex.zna) then
begin
if CifraFloat(iel.blo.zna)<>CifraFloat(iel.blo.nex.zna)
Then iel.Zna:='1'
else iel.Zna:='0'
end else
if iel.Blo.zna<>iel.blo.nex.zna
Then iel.Zna:='1'
else iel.Zna:='0'
end;
end;
Procedure TProg.TRBRA(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.Blo);
TrRun(iel.Blo.nex);
if EtoCif(1,Length(iel.blo.zna),iel.blo.zna) and
EtoCif(1,Length(iel.Blo.nex.zna),iel.Blo.nex.zna) then
begin
if CifraFloat(iel.blo.zna)>=CifraFloat(iel.blo.nex.zna)
Then iel.Zna:='1'
else iel.Zna:='0'
end else
if iel.Blo.zna>=iel.Blo.nex.zna
Then iel.Zna:='1'
else iel.Zna:='0'
end;
end;
Procedure TProg.TRMRA(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.Blo);
TrRun(iel.Blo.nex);
if EtoCif(1,Length(iel.Blo.zna),iel.blo.zna) and
EtoCif(1,Length(iel.blo.nex.zna),iel.blo.nex.zna) then
begin
if CifraFloat(iel.Blo.zna)<=CifraFloat(iel.Blo.nex.zna)
Then iel.Zna:='1'
else iel.Zna:='0'
end else
if iel.Blo.zna<=iel.Blo.nex.zna
Then iel.Zna:='1'
else iel.Zna:='0'
end ;
end;
Procedure TProg.TRIII(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.Blo);
TrRun(iel.Blo.nex);
if (iel.Blo.zna='1') and (iel.Blo.nex.zna='1')
Then iel.Zna:='1'
else iel.Zna:='0'
end;
end;
Procedure TProg.TRILI(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.Blo);
TrRun(iel.Blo.nex);
if (iel.Blo.zna='1') or (iel.Blo.nex.zna='1')
Then iel.Zna:='1'
else iel.Zna:='0'
end;
end;
Procedure TProg.TRPRI(iel:Tel);
var
Fun:Tel;
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.Blo.nex);
Fun:=FindFuncN(iEl,iel.Blo.axt);
if Fun<>Nil Then Fun.Zna:=iel.Blo.nex.Zna;
end;
end;
procedure FindFuncN; // Ищит функцию или переменную
begin
BeginProcedure('FindFuncN');
SAv__EAX('@iEL');
SAv__EDX('@n');
PRI__('@REZ',0);
//------------------------- Если нашли функцию
ELE_B('@FUN','@iEl',EL_FUN);
ELE__('@AXT','@iEl',EL_AXT);
NRA__('@FUN',1,'NEX1'); // if (iEl.fun)
NRA__STR('@AXT','@n','NEX1');// and (iEl.Axt=n)
Pri__('@REZ','@iEl'); // then rez:=iEl; ВЫХОД
JMP__('VIHOD'); // Выход Выход Выход Выход
//-------------------------
//-------------------------
//-------------------------
SeLa('NEX1'); PRI__('@l','@iEl'); // l:=iEl;
SeLa('CIK1'); RAV__('@L',0,'ECIK1'); //
NRA__('@REZ',0,'ECIK1'); // while (l<>nil) and (rez=nil) do
ELE_B('@TIS','@l',EL_TIS); // l.TIS
ELE_B('@FUN','@l',EL_FUN); // l.FUN
ELE__('@AXT','@l',EL_AXT); // l.AXT
Nra__('@TIS',TI_OPE,'Cik1Nex1'); // (l.Tis=Ti_TOpe)
Nra__('@FUN',1,'Cik1Nex1'); // (l.fun)
Nra__STR('@AXT','@N','Cik1Nex1'); // (l.Axt=n)
PRI__('@REZ','@l'); // rez:=l;
JMP__('VIHOD'); // ВЫХОД
SeLa('Cik1Nex1');ELE__('@L','@L',EL_PRE); // l:=l.pre;
JMP__('CIK1');
SeLa('ECIK1');
//-------------------------
//if (iEl.rod<>nil) and (iEl.rod.fun) Then
ELE__('@ROD','@iEl',EL_ROD);
RAV__('@ROD',0,'NEX2');
ELE_B('@FUN','@ROD',El_FUN);
NRA__('@FUN',1,'NEX2');
//-------------------------- l:=iEl.rod.blo.blo;
ELE__('@ROD','@iEl',EL_Rod);
ELE__('@BLO','@ROD',EL_BLO);
RAV__('@BLO',0,'NEX2');
ELE__('@BLO','@BLO',EL_BLO);
RAV__('@BLO',0,'NEX2');
PRI__('@L','@BLO'); // Блок с параметрами функции
//---------------------------
//while (l<>nil) do
SeLa('CIK2'); RAV__('@l',0,'ECIK2');
ELE__('@AXT','@L',EL_AXT);
NRa__STR('@AXT','@N','CIK2NEX1');// if l.Axt=n then
Pri__('@REz','@L'); // rez:=l;
JMP__('VIHOD'); // ВЫХОД
SeLa('Cik2Nex1');ELE__('@L','@L',EL_NEX); // l:=l.nex
JMP__('CIK2');
SeLa('ECIK2');
SeLa('NEX2'); //===========================
// if (iEl.Rod<>Nil) Then rez:=FindFuncN(iEl.Rod,n);
ELE__('@ROD','@iEl',EL_ROD);
RAV__('@ROD',0,'VIHOD');
Loa__EAX('@ROD');
LOa__EDX('@n');
Cal__('FindFuncN');
SAV__EAX('@REZ');
SeLa('VIHOD'); LOA__EAX('@REZ');
EndProcedure;
{ function FindFuncN(iEl:TEl;n:ansistring):Tel;
var
l,REz:Tel;
begin
rez:=Nil;
if (iEl.fun)and (iEl.Axt=n) then rez:=iEl;
l:=iEl;
while (l<>nil) and (rez=nil) do
begin
if (l.Tis=Ti_TOpe) and
(l.fun) and
(l.Axt=n) Then rez:=l;
l:=l.pre;
end;
if (rez=nil) and (iEl.rod<>nil) and (iEl.rod.fun) Then
begin
l:=iEl.rod.blo.blo;
while (REZ=NIL) AND (l<>nil) do
begin
if l.Axt=n then rez:=l;
l:=l.nex;
end;
end;
if (rez=nil) and (iEl.Rod<>Nil) Then rez:=FindFuncN(iEl.Rod,n);
FindFuncN:=rez;
end;
}
end;
Procedure CopPAr; // Копирует параметры функции
begin
BeginProcedure('CopPar');
SAv__Eax('@RU');
SAv__EDx('@EL');
//if (ru.blo<>nil) and (ru.blo.blo<>nil)
ELE__('@BLO','@RU',EL_BLO);
RAV__('@BLO',0,'VIHOD');
ELE__('@BLO','@BLO',EL_BLO);
RAV__('@BLO',0,'VIHOD');
Pri__('@l1','@BLO');//l1:=ru.blo.blo;
//if (el.blo<>nil) and (el.blo.blo<>nil) then
ELE__('@BLO','@EL',EL_BLO);
RAV__('@BLO',0,'VIHOD');
ELE__('@BLO','@BLO',EL_BLO);
RAV__('@BLO',0,'VIHOD');
Pri__('@l2','@BLO');//l2:=El.blo.blo;
//===========================================
seLa('CIK1'); RAV__('@l1',0,'VIHOD');
RAV__('@l2',0,'VIHOD');
ELE__('@ZNA1','@l1',EL_ZNA);
ELE__('@ZNA2','@l2',EL_ZNA);
Cop__Str('@Zna1','@Zna2');
ELE__('@l1','@l1',EL_NEX);
ELE__('@l2','@l2',EL_NEX);
JMP__('CIK1');
SeLa('VIHOD');
EndProcedure;
{
if (ru.blo<>nil) and (ru.blo.blo<>nil) and
(el.blo<>nil) and (el.blo.blo<>nil) then
begin
l1:=ru.blo.blo;
l2:=el.blo.blo;
while (l1<>nil) and (l2<>nil) do
begin
l1.Zna:=l2.Zna;
l1:=l1.nex;
l2:=l2.nex;
end;
end;
}
end;
procedure TrRun; // Запускает элемент на выполнение
begin
BeginProcedure('TrRun');
SAv__EAX('@iEL');
ELE__('@AXT','@iEL',EL_AXT);
ELE_B('@TIS','@iEL',EL_TIS);
Pri__('@ZAP',ord(','));
NRA__Str('@AXT','COM_PRINT','NEX1');// Вывод в консоль
LOA__EAX('@iEL');CAL__('TrCoN');JMP__('VIHOD');
SeLa('NEX1');
NRA__Str('@AXT','COM_PRI','NEX2');// ПРисвоение
LOA__EAX('@iEL');CAL__('TrPri');JMP__('VIHOD');
SeLa('NEX2');
NRA__Str('@AXT','COM_Sco','NEX3');// Скобка
LOA__EAX('@iEL');CAL__('TrSco');JMP__('VIHOD');
SeLa('NEX3');
NRA__Str('@AXT','COM_Blo','NEX4');// Выполнение блока
LOA__EAX('@iEL');CAL__('TrRuns');JMP__('VIHOD');
SeLa('NEX4');
NVh__Str('@AXT','COM_ZNA','@ZAp','NEX5');// Мат операции
LOA__EAX('@iEL');CAL__('TrZna');JMP__('VIHOD');
SeLa('NEX5'); NRA__('@TIS',Ti_Ope,'VIHOD');
//-----------------------------------------------
// fun:=FindFuncN(el.Rod,el.Axt);
ELE__('@ROD','@iEL',EL_ROD);
ELE__('@AXT','@iEL',EL_AXT);
LOA__EAX('@iEl');
LOA__EDX('@AXT');
CAl__('FindFuncN');SAV__EAX('@FUN');
RAV__('@FUN',0,'VIHOD');
//----------------------------------------------
//ru:=fun.cop(el.Rod,El.Pre);
ELE__('@PRE','@iEL',EL_PRE);
Cop__ELE('@FUN','@ROD','@PRE','@RU');
//if el.blo<>nil then TrRuns(El.blo);//Вычисляем параметры
ELE__('@BLO','@iEL',EL_BLO);
RAV__('@BLO',0,'NNEX1');
LOA__EAX('@BLO');
CAL__('TrRuns');
SeLa('NNEX1');//----------------------------------------------
//CopPar(ru,iel)
LOA__EAX('@RU');
LOA__EDX('@iEL');
cal__('CopPar');
//----------------------------------------------
//if (Ru.blo<>nil) and (Ru.blo.nex<>nil) then TrRuns(Ru.blo.nex);
ELE__('@BLO','@RU',EL_BLO);
RAV__('@BLO',0,'NNEX2');
ELE__('@NEX','@BLO',EL_NEX);
RAV__('@NEX',0,'NNEX2');
LOA__EAX('@NEX');
CAL__('TrRuns');
SeLa('NNEX2');//==============================================
//el.Zna:=Ru.zna;
ELE__('@ZNA1','@iEL',EL_ZNA);
ELE__('@AXT1','@iEL',EL_AXT);
ELE__('@ZNA2','@RU',EL_ZNA);
Cop__Str('@ZNA1','@ZNA2');
// Отсоеденяем
PRI__('@APRE',EL_PRE);
ADD__('@APRE','@RU');
WRI_W('@APRE',0);
PRI__('@ANEX',EL_NEX);
ADD__('@ANEX','@RU');
WRI_W('@ANEX',0);
Fre__Ele('@RU');
JMP__('VIHOD');
SeLa('PEREM');
SeLa('VIHOD');
EndProcedure;
{ Procedure TProg.TRRun(el:Tel); // выполняет кон команду
var
l1,l2:TEl;
Fun,ru:Tel;
begin
if (el.Axt='PRINT') Then TRCON(el) else
if (el.Axt='WHILE') Then TRWHI(el) else
if (el.Axt='IF' ) Then TRUSL(el) else
if (el.Axt='||' ) Then TRILI(el) else
if (el.Axt='&&' ) Then TRIII(el) else
if (el.Axt='*' ) Then TRUMN(el) else
if (el.Axt='/' ) Then TRDEL(el) else
if (el.Axt='+' ) Then TRPLU(el) else
if (el.Axt='-' ) Then TRMIN(el) else
if (el.Axt='=' ) Then TRRAV(el) else
if (el.Axt='>' ) Then TRBOL(el) else
if (el.Axt='<' ) Then TRMEN(el) else
if (el.Axt='<>' ) Then TRNER(el) else
if (el.Axt='!=' ) Then TRNER(el) else
if (el.Axt='>=' ) Then TRBRA(el) else
if (el.Axt='<=' ) Then TRMRA(el) else
if (el.Axt=':=' ) Then TRPRI(el) else
if (el.Axt='(' ) Then TrSCO(el) else
if (el.Axt='{' ) Then TrRuns(el) else
if (el.Tis=Ti_TOpe) Then
begin
fun:=FindFuncN(el.Rod,el.Axt);
if fun<>nil then
begin
ru:=fun.cop(el.Rod,El.Pre);
if el.blo<>nil then TrRuns(El.blo);//Вычисляем параметры
CopPar(ru,el)
// Если есть исполнительный блок
if (Ru.blo<>nil) and (Ru.blo.nex<>nil) then TrRuns(Ru.blo.nex);
el.Zna:=Ru.zna;
Ru.Cle;
ru.Free;
end else
el.Err:='Не обнаржена переменная'+el.Axt;
end
else
el.Err:='Неопределено';
end;
}
}
end;
procedure TrRunS; // Запускает На выполнение все элементы в блоке BLO
begin
BeginProcedure('TrRunS');
SAv__EAX('@iEL');
ELE__('@l','@iEl',EL_BLO); // l:=el.blo;
SeLa('Cikl'); RAV__('@L',0,'VIHOD'); // While l<>nil do
ELE__('@AXT','@L',EL_AXT);
ELE_B('@Fun','@L',El_FUN); // L.Fun
RAV__('@FUN',1,'CIK1NEX1');// if Not l.fun then
Loa__EAX('@L');
Cal__('TrRun'); // TrRun(l);
SeLa('CIK1Nex1');
ELE__('@L','@L',EL_NEX); // l:=l.nex;
JMP__('Cikl');
SeLa('VIHOD');
EndProcedure;
{Procedure TProg.TRRunS(el:Tel);// исполняет структуру
var
l:TEl;
begin
l:=el.blo;
While l<>nil do
begin
if Not l.fun then TrRun(l);
l:=l.nex;
end;
end;}
end;
procedure TRCON; // ПРоцедура вывода в консоль
begin
BeginProcedure('TRCON');
SAv__EAX('@iEL');
ELE__('@BLO','@iEl',EL_BLO);
LOA__EAX('@BLO');
CAL__('TrRun');
ELE__('@ZNA','@BLO',EL_ZNA);
Print_Str('@ZNA');
SeLa('VIHOD');
EndProcedure;
{ Procedure TProg.TRCON(iel:Tel);
var
l:Tel;
begin
l:=iel.Blo;
while l<>nil do
begin
TrRun(l);
Con:=Con+l.zna;
L:=l.nex;
end;
Con:=Con+chr(13)+chr(10);
end;
}
end;
procedure TRSCO; // ПРоцедура скобка
begin
BeginProcedure('TRSCO');
SAv__EAX('@iEL');
ELE__('@l','@iEl',El_Blo);
ELE__('@ZNA','@iEl',El_Zna);
Wri_B('@ZNA',0);// Обнуляем результат
SeLa('Cikl'); RAv__('@l',0,'VIHOD');
LOA__EAX('@l');
CAL__('TrRun');
ELE__('@ZNA2','@L',EL_ZNA);
Add__STR('@ZNA','@ZNA2');
ELE__('@L','@L',EL_NEX);
JMP__('CIKL');
SeLa('VIHOD');
EndProcedure;
{ Procedure TProg.TRSCO(iel:Tel);
var
l:TEl;
rez:Ansistring;
begin
rez:='';
l:=Iel.Blo;
while l<>nil do
begin
trRun(l);
rez:=rez+l.zna;
l:=l.nex;
end;
iel.zna:=rez;
end;
}
end;
procedure TRZNA; // Операция сложения
begin
BeginProcedure('TRZNA');
SAv__EAX('@iEL');
//--------------------------
ELE__('@BLO','@iEl',EL_Blo);
RAV__('@BLO',0,'ERROR');
ELE__('@NEX','@BLO',EL_NEX);
RAV__('@NEX',0,'ERROR');
//--------------------------
LOA__EAX('@BLO');Cal__('TrRun');
LOA__EAX('@NEX');Cal__('TrRun');
//--------------------------
ELE__('@AXT','@iEl',El_AXT);
ELE__('@ZNA0','@iEl',El_ZNA);
ELE__('@ZNA1','@BLO',El_ZNA);
ELE__('@ZNA2','@NEX',El_ZNA);
Tip__Str('@TIP1','@ZNA1');
Tip__Str('@TIP2','@ZNA2');
Pri__('@TIP',0);
NRA__('@TIP1',1,'NEX');
NRA__('@TIP2',1,'NEX');
Pri__('@TIP',1);
SeLa('NEX');
//==============================================================================
// СЛОЖЕНИЕ
SeLa('CIF0'); NRa__Str('@AXT','COM_SUM','CIF1');
NRA__('@TIP',1,'STR0');
Cop__Str('@ZNA0','@ZNA1');
Sum__Chi('@ZNA0','@ZNA2');
Jmp__('VIHOD');
SeLa('STR0');
ADD__STr('@ZNA0','@ZNA1');
ADD__STr('@ZNA0','@ZNA2');
Jmp__('VIHOD');
// Вычитание
SeLa('CIF1'); NRa__Str('@AXT','COM_MIN','CIF2');
NRA__('@TIP',1,'STR1');
Cop__Str('@ZNA0','@ZNA1');
Min__Chi('@ZNA0','@ZNA2');
Jmp__('VIHOD');
SeLa('STR1'); Jmp__('ERROR');
// Умножение
SeLa('CIF2'); NRa__Str('@AXT','COM_UMN','CIF3');
NRA__('@TIP',1,'STR2');
Cop__Str('@ZNA0','@ZNA1');
UMN__Chi('@ZNA0','@ZNA2');
Jmp__('VIHOD');
SeLa('STR2'); Jmp__('ERROR');
// Деление
SeLa('CIF3'); NRa__Str('@AXT','COM_DEL','CIF4');
NRA__('@TIP',1,'STR3');
Cop__Str('@ZNA0','@ZNA1');
DEL__Chi('@ZNA0','@ZNA2');
Jmp__('VIHOD');
SeLa('STR3'); Jmp__('ERROR');
// Меньше
SeLa('CIF4'); NRa__Str('@AXT','COM_MEN','CIF5');
NRA__('@TIP',1,'STR4');
MEN__Chi('@ZNA1','@ZNA2','CMEN4');
Wri_B('@ZNA0',0);ADD__SIM('@ZNA0',ord('1'));
Jmp__('VIHOD');
SeLa('CMEN4'); Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('0'));
Jmp__('VIHOD');
SeLa('STR4'); MEN__STR('@ZNA1','@ZNA2','SMEN4');
Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('1'));
Jmp__('VIHOD');
SeLa('SMEN4'); Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('0'));
Jmp__('VIHOD');
// БОЛЬШЕ
SeLa('CIF5'); NRa__Str('@AXT','COM_BOL','CIF6');
NRA__('@TIP',1,'STR5');
Bol__Chi('@ZNA1','@ZNA2','CMEN5');
Wri_B('@ZNA0',0);ADD__SIM('@ZNA0',ord('1'));
Jmp__('VIHOD');
SeLa('CMEN5'); Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('0'));
Jmp__('VIHOD');
SeLa('STR5'); Bol__STR('@ZNA1','@ZNA2','SMEN5');
Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('1'));
Jmp__('VIHOD');
SeLa('SMEN5'); Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('0'));
Jmp__('VIHOD');
// Равно
SeLa('CIF6'); NRa__Str('@AXT','COM_RAV','CIF7');
NRA__('@TIP',1,'STR5');
RAV__Chi('@ZNA1','@ZNA2','CMEN6');
Wri_B('@ZNA0',0);ADD__SIM('@ZNA0',ord('1'));
Jmp__('VIHOD');
SeLa('CMEN6'); Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('0'));
Jmp__('VIHOD');
SeLa('STR6'); RAV__STR('@ZNA1','@ZNA2','SMEN6');
Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('1'));
Jmp__('VIHOD');
SeLa('SMEN6'); Wri_B('@ZNA0',0);
ADD__SIM('@ZNA0',ord('0'));
Jmp__('VIHOD');
SeLa('Cif7'); Jmp__('ERROR');
//==============================================================================
Jmp__('VIHOD');
SeLa('ERROR');
PRI__('@AERR',EL_ERR);
ADD__('@AERR','@iEl');
//Wri_B('@AERR',1);// Ошибка
SeLa('VIHOD');
EndProcedure;
{ Procedure TProg.TRPLU(iel:Tel);
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.blo);
TrRun(iel.blo.nex);
if EtoCif(1,length(iel.Blo.zna),iel.Blo.zna) and EtoCif(1,length(iel.Blo.nex.zna),iel.Blo.nex.zna)
Then
Begin
iel.zna:=FloatToStr(StrToFloat(iel.Blo.zna)+StrToFloat(iel.Blo.nex.zna))
end
Else
begin
iel.zna:=iel.Blo.zna+iel.Blo.nex.zna
end;
end;
end;
}
end;
procedure TRPRI; // Операция присваивания
begin
BeginProcedure('TRPRI');
SAv__EAX('@iEL');
//--------------------------
ELE__('@BLO','@iEl',EL_Blo);//if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
RAV__('@BLO',0,'ERROR');
ELE__('@NEX','@BLO',EL_NEX);//if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
RAV__('@NEX',0,'ERROR');
//--------------------------
LOA__EAX('@NEX');
CAL__('TrRun');
ELE__('@ROD','@iEl',El_ROD);
ELE__('@BLO','@iEl',El_BLO);
ELE__('@NEX','@BLO',El_NEX);
ELE__('@AXT','@BLO',El_AXT);
//LOA__EAX('@ROD');
LOA__EAX('@iEl');//*******************
LOA__EDX('@AXT');
CAL__('FindFuncN');
SAV__EAX('@FUN');
RAV__('@FUN',0,'VIHOD');
ELE__('@ZNA1','@FUN',EL_ZNA);
ELE__('@ZNA2','@NEX',EL_ZNA);
COP__STR('@ZNA1','@ZNa2');
Jmp__('VIHOD');
SeLa('ERROR');
PRI__('@AERR',EL_ERR);
ADD__('@AERR','@iEl');
//Wri_B('@AERR',1);// Ошибка
SeLa('VIHOD');
EndProcedure;
{ Procedure TProg.TRPRI(iel:Tel);
var
Fun:Tel;
begin
if iel.blo=nil Then iel.Err:='(Не хватает значений)' else
if iel.blo.nex=nil Then iel.Err:='(Не хватает значений)' else
begin
TrRun(iel.Blo.nex);
Fun:=FindFuncN(iEl.rod,iel.Blo.axt);
if Fun<>Nil Then Fun.Zna:=iel.Blo.nex.Zna;
end;
end;
}
end;
{$ENDIF}
{ Парсер } {$IFDEF Tim}
Procedure Compilema; // Вкладывает знаковые операции тпа A+B A:=B
begin
BeginProcedure('Compilema');
SAv__EAX('@EL');
SAv__EDX('@S');
Pri__('@ZAP',ord(','));
ELE__('@L','@EL',EL_BLO); // l:=el.blo;
SeLa('CIKL'); RAV__('@L',0,'VIHOD'); // while l<>nil do
ELE__('@BLO','@L',EL_BLO); // l.blo
RAV__('@BLO',0,'NEX1'); // if l.blo<>nil then
LOA__EAX('@l');
LOA__EDX('@S');
CAL__('Compilema');
SeLa('NEX1'); ELE__('@AXT','@L',EL_AXT); // l.Axt
NVh__Str('@AXT','@S','@ZAP','NEX2');//if est(s,l.Axt) then
ELE__('@PRE','@L',EL_PRE);
ADD__ELE('@L','@PRE');
ELE__('@NEX','@L',EL_NEX);
ADD__ELE('@L','@NEX');
SeLa('NEX2'); ELE__('@NEX','@L',EL_NEX);
PRI__('@L','@NEX');
JMP__('CIKL');
SeLa('VIHOD'); LOA__EAX('@EL');
EndProcedure;
{ Procedure CompileMa(s:ansistring;el:Tel);// Умножение деление
var
l:TEl;
begin
l:=el.blo;
while l<>nil do
begin
if l.blo<>nil then CompileMa(s,l);
if est(s,l.Axt) then
begin
if l.pre<>nil then CompileMa(s,l.pre);
if l.nex<>nil then CompileMa(s,l.nex);
l.add(l.pre);
l.add(l.nex);
end;
l:=l.nex;
end;
end;
}
end;
Procedure CompilePa; // Вкладываает параметры типа SUMMA (Параметры)
begin
BeginProcedure('CompilePa');
SAv__EAX('@EL');
SAv__EDX('@SC1');
ELE__('@L','@EL',EL_BLO); //l:=el.blo;
SeLa('CIKL'); RAV__('@L',0,'VIHOD'); // while l<>nil do
ELE_B('@TIS','@L',EL_TIS); // L.TIS
ELE__('@NEX','@L',EL_NEX); // L.NEX
NRA__('@TIS',Ti_Ope,'NEX1'); // if (l.Tis=Ti_TOpe) 1
RAV__('@NEX',0,'NEX1'); // and (l.nex<>nil) then 2
ELE__('@NAX','@NEX',EL_AXT); // L.NEX.AXT
NRA__Str('@NAX','@SC1','NEX1'); // if (l.nex.axt='(') then 3
//00000000000000000000000000000000
NRA__('@sc1','SS_BL1','NNN'); // l.fun:=1; если вкладываем блоки
PRI__('@AFUN',El_FUN); // Указываем что это функция
ADD__('@AFUN','@L');
WRI_B('@AFUN',1); // ПРоверяем наличие параметров если нету сперва их добавляем
//00000000000000000000000000000000
SeLa('NNN'); Add__ELE('@L','@NEX'); // l.add(l.nex)
SeLa('NEX1'); ELE__('@BLO','@L',EL_BLO); //l.Blo
RAV__('@BLO',0,'NEX3'); //if (l.blo<>nil) then
LOA__EAX('@L'); //CompilePa(l);
LOA__EDX('@sc1');
CAL__('CompilePa');
SeLa('NEX3'); ELE__('@L','@L',EL_NEX); // L.NEX
JMP__('CIKL');
SeLa('VIHOD'); LOA__EAX('@EL');
EndProcedure;
{
// Вложение параметров функций
Procedure CompilePa(el:Tel);
var
l:Tel;
begin
l:=el.blo;
while l<>nil do
begin
if (l.Tis=Ti_TOpe) and (l.nex<>nil) then
if (l.nex.axt='(') then l.add(l.nex) else
if (l.blo=nil) then l.add('(',Ti_TZna);
if (l.blo<>nil) then CompilePa(l);
l:=l.nex;
end;
end;
}
end;
Procedure CompileSc; // Вкладывает внутрб скобок слова
Begin
BeginProcedure('CompileSc');
SAv__EAX('@EL');
SAv__EDX('@sc1');
SAv__ECX('@sc2');
PRI__('@NK','@EL'); // NK:=El; Куда добавлять
ELE__('@PE','@EL',EL_BLO); // PE:=El.Blo; ПОслдений эллемент
SeLa('CIKL'); RAV__('@PE',0,'VIHOD');
ELE__('@NE','@PE',EL_NEX); // ne:=pe.nex;
ELE__('@AXT','@PE',EL_AXT); // pe.Axt
//------------------------
RAV__('@EL','@NK','NEX1'); // if el<>nk and pe.Axt<>s2 then
Rav__Str('@AXT','@SC2','NEX1'); //
Add__Ele('@NK','@PE'); // NK.add(PE);
SeLa('NEX1'); //------------------------
Nra__Str('@AXT','@SC1','NEX2'); // if PE.Axt=s1 then
PRI__('@NK','@PE'); // NK:=PE; Куда добавлять
SeLa('NEX2'); //------------------------
Nra__Str('@AXT','@SC2','NEX3'); // if PE.Axt=s2 then
ELE__('@ROD','@NK',EL_ROD); // NK.Rod;
PRI__('@NK','@ROD'); // NK:=NK.Rod;
Del__Ele('@PE'); // pe.del;
SeLa('NEX3'); //------------------------
Pri__('@PE','@NE');
JMP__('CIKL');
SeLa('VIHOD'); Loa__EAX('@EL');
EndProcedure;
{ // Чтение скобок
Procedure CompileSc(s1,s2:Ansistring;El:Tel);
var
f:Longint;
NK,PE,NE:Tel;
begin
f:=1;
NK:=El;// куда добавлять
PE:=El.Blo;// ПОслдений эллемент
While pe<>nil do
begin
ne:=pe.nex;
if el<>nk then if pe.Axt<>s2 then NK.add(PE);
if PE.Axt=s1 then NK:=PE;// Куда добавлять
if PE.Axt=s2 then begin NK:=NK.Rod;pe.del;end;// Вернуться на уровень вверх
pe:=ne;
end;
end;
}
end;
Procedure PArsing; // EAX:Указатель на тект программы EDX:Указатель на елеменнт
begin
BeginProcedure('PArsing');
SAV__EAX('@UK');
Cre__Str('@SL');
Cre__Ele('@EL');
SeLa('CIKL');
REA_B('@SIM','@UK');
RAV__('@SIM',0,'VIHOD');
//-----------------
Loa__EAX('@UK');Loa__EDX('@SL');CAL__('ReadCif');SAV__EAX('@NUK');PRI__('@TIP',TI_Cif);NRA__('@NUK','@UK','NEX1');
Loa__EAX('@UK');Loa__EDX('@SL');CAL__('ReadOpe');SAV__EAX('@NUK');PRI__('@TIP',TI_Ope);NRA__('@NUK','@UK','NEX1');
Loa__EAX('@UK');Loa__EDX('@SL');CAL__('ReadZn1');SAV__EAX('@NUK');PRI__('@TIP',TI_Zna);NRA__('@NUK','@UK','NEX1');
Loa__EAX('@UK');Loa__EDX('@SL');CAL__('ReadZn2');SAV__EAX('@NUK');PRI__('@TIP',TI_Zna);NRA__('@NUK','@UK','NEX1');
Loa__EAX('@UK');Loa__EDX('@SL');CAL__('ReadKav');SAV__EAX('@NUK');PRI__('@TIP',TI_Kav);NRA__('@NUK','@UK','NEX1');
INC__('@UK');
JMP__('CIKL');
SeLa('NEX1'); PRI__('@UK','@NUK');
LOA__EAX('@EL');
LOA__EDX('@SL');
LOA__ECX('@TIP');
Cal__('SADElement');
JMP__('Cikl');
SeLa('VIHOD'); Fre__Str('@SL');
LOA__EAX('@EL');
EndProcedure;
end;
{$ENDIF}
{ ОТладочная секция } {$IFDEF Tim}
procedure PrintElement(a:String);
begin
{
PrintStr('ln');
PrintStr('ln');
PrintCif(a);
PrintStr('ln');
Pri__('@OtEl',a);add__('@OtEl',El_Res);REA_B('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
Pri__('@OtEl',a);add__('@OtEl',El_Tis);REA_B('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
Pri__('@OtEl',a);add__('@OtEl',El_Fun);REA_B('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
Pri__('@OtEl',a);add__('@OtEl',El_Err);REA_B('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
PrintStr('ln');
Pri__('@OtEl',a);add__('@OtEl',El_AXT);REA_W('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
Pri__('@OtEl',a);add__('@OtEl',El_ZNA);REA_W('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
PrintStr('ln');
Pri__('@OtEl',a);add__('@OtEl',El_SAM);REA_W('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
Pri__('@OtEl',a);add__('@OtEl',El_ROD);REA_W('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
Pri__('@OtEl',a);add__('@OtEl',El_PRE);REA_W('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
Pri__('@OtEl',a);add__('@OtEl',El_NEX);REA_W('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
Pri__('@OtEl',a);add__('@OtEl',El_BLO);REA_W('@OtEl','@OtEl');PrintCif('@OtEl');PrintStr('Raz');
PrintStr('ln');pau__;
}
end;
Procedure Ots__(s:String);
begin
Cre__Str('@BUF');
Loa__EAX(s);
Loa__EDX('@BUF');
Cal__('OtstUp');
Print_Str('@BUF');
Fre__Str('@BUF');
end;
Procedure OtstUp;
begin
BeginProcedure('OtstUp');
SAV__EAX('@b');
SAV__EDX('@BUF');
WRI_B('@BUF','@B');
PRI__('@USL','@BUF');
PRI__('@LEN',1);Inc__('@USL');
SeLa('CIKL'); BOL__('@LEN','@b','VIHOD');
WRI_B('@USL',ord('*'));
INC__('@USL');
INC__('@LEN');
JMP__('CIKL');
SeLa('VIHOD');
EndProcedure;
end;
Procedure PrintElements;// Печатает содержимое елемента EAX: с отступом EDX
Begin
BeginProcedure('PriElements');
Sav__EAX('@EL');
Sav__EDX('@OT');
ELE__('@AXT','@EL',EL_AXT);
//PrintStr('@AXT');PrintStr('ln');
ELE__('@LLL','@EL',EL_BLO);
SeLa('CIKL'); Rav__('@LLL',0,'VIHOD');
ELE__('@AXT','@LLL',EL_AXT);
ELE__('@ZNA','@LLL',EL_ZNA);
ELE_B('@FFF','@LLL',EL_FUN);
ots__('@OT');
PRINT_CIF('@FFF');Print_Str('raz');Print_Str('@AXT');Print_Str('raz');Print_Str('@ZNA');Print_Str('Ln');
ELE__('@N','@LLL',EL_BLO);
RAV__('@N',0,'NEX1');
PRI__('@OT2',1);
ADD__('@OT2','@OT');
LOA__EAX('@LLL');
LOA__EDX('@OT2');
CAL__('PriElements');
SeLa('NEX1');
ELE__('@LLL','@LLL',EL_NEX);
JMP__('CIKL');
SeLa('VIHOD');
EndProcedure;
end;
{Для отладки
//----------------------------------
ELE__('@AXT','@Ru',EL_AXT);
PrintStr('COP');PrintStr('@AXT');PrintStr('ln');pau__;//+++++==
LOA__EAX('@Ru');
LOA__EDX(1);// ОТступ
Cal__('PriElements');
//---------------------------------
}
{$ENDIF}
{ Секция компиляции программы } {$IFDEF Tim}
procedure Vars(s:Ansistring);
begin
// Текст программы на исполнение
SePe('PROG');WrMwS(s);
SePe('C1') ;WrMwc(0);// указатель на кучю
SePe('C2') ;WrMwc(0);// указатель на кучю
CrSt('SS_SC1','(');
CrSt('SS_SC2',')');
CrSt('SS_BL1','{');
CrSt('SS_BL2','}');
CrSt('SS_SUM','+,-');
CrSt('SS_UMN','*,/');
CrSt('SS_LOG','>,<,=,>=,<=,!=');
CrSt('SS_PRI',':=');
CrSt('COM_PRINT','PRINT');
CrSt('COM_ZNA','+,-,*,/,>,<,=,>=,<=,!=');
CrSt('COM_PRI',':=');
CrSt('COM_SCO','(');
CrSt('COM_BLO','{');
CrSt('COM_SUM','+');
CrSt('COM_MIN','-');
CrSt('COM_UMN','*');
CrSt('COM_DEL','/');
CrSt('COM_BOL','>');
CrSt('COM_MEN','<');
CrSt('COM_RAV','=');
CrSt('SS_EST','EST');
CrSt('SS_NET','NET');
CrSt('TR_CON','TR_CON ');
CrSt('TR_SCO','TR_SCO ');
CrSt('TR_PRI','TR_PRI ');
CrSt('TR_PLU','TR_PLU ');
CrSt('cop',' cop ');
CrSt('Start2','-Start Program Ok.-');
CrSt('InitMem','-Init Mem Ok.-');
CrSt('END','-END Program Ok.-');
CrSt('RAZ','-');
If TrCo=80 Then CrSt('LN',chr(13)) else
If TrCo=16 Then CrSt('LN',chr(13)+chr(10)) else
If TrCo=17 Then CrSt('LN',chr(13)+chr(10)) else
If TrCo=32 Then CrSt('LN',chr(13)+chr(10)) else
If TrCo=33 Then CrSt('LN',chr(13)) else
If TrCo=34 Then CrSt('LN',chr(13)+chr(10)) else
InfoMes(('LN Не прописан для платформы'));
CrSt('CHI1','1');
CrSt('CHI2','2');
CrSt('MENHE','MENHE');
CrSt('RAVNO','RAVNO');
CrSt('BOLHE','BOLHE');
CrSt('PRIVET',
chr(HexToInt('16'))+
chr(HexToInt('0B'))+ // Строка
chr(HexToInt('0A'))+ // Столбец
chr(HexToInt('11'))+ //
chr(HexToInt('01'))+ // Цвет фона
chr(HexToInt('10'))+
chr(HexToInt('06'))+ // Цвет чернил
'ZX SPECTRUM');
CrSt('NIL','-NIL-');
CrSt('PUS','-PUS-');
CrSt('Start','-Start Ok.-');
end;
procedure Prog(S:Ansistring);
begin
BeginProcedure('Main');
Jmp__('START');
Vars(s);
SeLa('START');
Print_Str('Start');print_Str('ln');
//-------- ПАРСЕР -----------------------
LOA__EAX(adrPer('PROG'));CAL__('Parsing');
LOA__EDX('SS_SC1');LOA__ECX('SS_SC2');Cal__('CompileSc');
LOA__EDX('SS_BL1');LOA__ECX('SS_BL2');Cal__('CompileSc');
LOA__EDX('SS_SC1');Cal__('CompilePa');
LOA__EDX('SS_BL1');Cal__('CompilePa');
LOA__EDX('SS_UMN');Cal__('CompileMa');
LOA__EDX('SS_SUM');Cal__('CompileMa');
LOA__EDX('SS_LOG');Cal__('CompileMa');
LOA__EDX('SS_PRI');Cal__('CompileMa');
CAL__('TrRuns');
Print_Str('ln');
Print_Str('END');
Pau__;
EndProcedure;
end;
procedure MemoSaveToFile(nf:Ansistring);
var
f:Longint;
Fb:File of Byte;
begin
assignfile(fb,nf);
rewrite(fb);
For f:= MSta To MUka-1 do
write(fb,TrRb(f));
Closefile(fb);
end;
Procedure Compiler(s,nf:Ansistring);
begin
// Список локальных меток
SLabs.clear;
RLabs.clear;
// Список процедур и функций
SFuns.clear;
RFuns.clear;
// Список переменных
GPers.clear;
// Список ЛОкальных переменных
LPers.clear;
LOAD_BIOS;// Загрузка базовой системы ввода вывода формирование структуры элемента
PROG(s) ;// Формирование непосредственно програмы
InitMem ;
TipString; // ПРоцедура Определяет тип строки если цифра то 1
RavString;
BolString;
MenString;
CopString;
VhoString;
AsiString;
KolString;
SloString;
SumString;
GetString;
FreString; // Освободает строку
ASSString; // Добавление символа в начало строки
DelSimvol;
POsSimvol;// EAX:Строка EDX Символ Возвращает новую обработаную строку Удаляет указаный символ из строки
ReadCif;
ReadOpe;
ReadZn1;
ReadZn2;
ReadKav;
GetElement;
FreElement;
LstElement;
AddElement;
SadElement;
DelElement;
CopElement;
PrintElements;
Parsing;
FindFuncN;
CopPAr;
TrRun;
TrRunS;
TRCON;// ПРоцедура вывода в консоль
TRSCO;// ПРоцедура скобка
TRZNA;// Операция сложения
TRPRI;// Операция присваивания
Compilema;
CompilePa;
CompileSc;
OtstUp;
UmnDesEdi; // Умножает и возвращает Возращает десятки EAX:и единицы EDX
ZnaChisel; // EAX: число1 EDX: число2 Возвращает код комбинации знаков 0++ 1-+ 2+- 3--
addPosle; // Добавляет в коцес строки EAX EDX Количсетво символов ECX
addDoooo; // Добавляет в Начало строки EAX EDX Количсетво символов ECX
NorChislo; // Нормализация числа EAX возвращает нормализованое число
CorChisel; // EAX: число1 EDX: число2 ПРоизводит корекцию чисел
Rav1Chisel;// ПРоверяет равенство строк с числами без знака EAX:EDX Возвращает EAX без знака
BOL1Chisel;// ПРоверяет Больше ли первая строка с числами EAX:EDX Возвращает EAX без знака
MEN1Chisel;// ПРоверяет Меньше ли первая строка с числами EAX:EDX Возвращает EAX без знака
RavChisel; // ПРоверяет равенство строк с числами EAX:EDX Возвращает EAX
BolChisel; // ПРоверяет Больше ли строка с числами EAX:EDX Возвращает EAX
MenChisel; // ПРоверяет менше ли строка с числами EAX:EDX Возвращает EAX
Sum1Chisel;// Складывает строки с числа EAX:EDX без знака
Min1Chisel;// Вычитает строки с числа EAX:EDX без знака
Umn1Chisel;// Умножает строки с числа EAX:EDX без знака
Del1Chisel;// Делит строки с числа EAX:EDX без знака
SumChisel; // Складывает строки с числа EAX:EDX Полное
MinChisel; // Вычитает строки с числа EAX:EDX Полное
UmnChisel; // Умножение строки с числа EAX:EDX Полное
DelChisel; // Деление строки с числа EAX:EDX Полное
SetZnaPer('TrMe',MUka);// Количество используемой памяти
SetFunctions;
MemoSaveToFile(nf);
end;
{$ENDIF}
begin
{ Инициализация модуля } {$IFDEF Tim}
pmemo:=Addr(Memo);
// Список локальных меток
SLabs:=Tlabs.Create;
RLabs:=TLAbs.Create;
// Список процедур и функций
SFuns:=TLAbs.Create;
RFuns:=TLAbs.Create;
// Список переменных
GPers:=TLAbs.Create;
// Список ЛОкальных переменных
LPers:=TLAbs.Create;
{$ENDIF}
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment