Арифметический стек

В качестве арифметического стека - очень хорошо подходит обычный стек с его командами push и pop.

Пример:

Фрагмент программы на Forth:

 1 2 3 4 + * swap drop

вот как это будет выглядить на ассемблере:

 push 1 ; помещаем в арифметический стек число 1
 push 2 ; помещаем в арифметический стек число 2
 push 3 ; помещаем в арифметический стек число 3
 push 4 ; помещаем в арифметический стек число 4
 pop eax ; выполнение слова "+", обычное сложение, 
 pop ebx ; т.е. снимаем со стека два числа,
 add eax, ebx ; складываем их и полученный результат
 push eax ; помещаем на вершину стека
 pop eax ; "*" - умножение, выполняется аналогично сложению, 
 pop ebx ; надо учитывать что результат
 imul ebx ; помещается в edx:eax - и результат
 push eax ; будет правилен только если он уместился целиком в регистр eax
 pop eax ; меняет местами два последних значения на стеке (слово swap)
 pop ebx
 push eax
 push ebx
 pop eax ; снимает значение с вершины стека (слово drop)

А теперь запишем все эти команды ассемблера в машинных кодах (можно для этого воспользоваться справочником Юрова) или подсмотреть в отладчике среды Delphi

 asm
 push 1
 push 2
 end;

поставить точку останова (выбрать строку и нажать F5), запустить программу на выполнение (клавиша F9), после того как выполнение остановиться на точки останова, посмотреть это всё в машинных кодах (Ctrl+Alt+C).

 68 01 00 00 00 - push 1
 68 02 00 00 00 - push 2
 68 03 00 00 00 - push 3
 68 04 00 00 00 - push 4
 5b - pop ebx
 58 - pop eax
 01 d8 - add eax, ebx
 50 - push eax
 ...

ну и все остальные команды (слова Forth) которые работают каким-либо образом с арифметическим стеком - выполняются аналогично - значения с вершины стека помещаются в какой-либо регистр (eax, ebx, edx, ...) потом над этими регистрами производятся какие-либо действия, затем результат(ы) из регистров помещаются обратно на стек (если это необходимо).

пример: Компиляция слов работающих с арифметическим стеком

while u1.token_type <> u1.FINISH do
 begin
 u1.GetToken1;
 :
 if u1.token_type = u1.NUM then
 begin
 tmp:=$68; fs.Write(tmp, 1);
 tmp:=StrToInt(u1.token) ; fs.Write(tmp, 4); {push NUM}
 continue;
 end;
 if u1.token = drop then
 begin
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 continue;
 end;
 if u1.token = dup then
 begin
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = swap then
 begin
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 tmp:=$53; fs.Write(tmp, 1); {push ebx}
 continue;
 end;
 if u1.token = - then
 begin
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$29; fs.Write(tmp, 1);
 tmp:=$d8; fs.Write(tmp, 1); {sub eax, ebx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = + then
 begin
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$01; fs.Write(tmp, 1);
 tmp:=$d8; fs.Write(tmp, 1); {add eax, ebx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = * then
 begin
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$f7; fs.Write(tmp, 1);
 tmp:=$eb; fs.Write(tmp, 1); {imul ebx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = negate then
 begin
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$f7; fs.Write(tmp, 1);
 tmp:=$d8; fs.Write(tmp, 1); {neg eax}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = / then
 begin
 tmp:=$31; fs.Write(tmp, 1);
 tmp:=$d2; fs.Write(tmp, 1); {xor edx, edx}
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$f7; fs.Write(tmp, 1);
 tmp:=$fb; fs.Write(tmp, 1); {idiv ebx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = mod then
 begin
 tmp:=$31; fs.Write(tmp, 1);
 tmp:=$d2; fs.Write(tmp, 1); {xor edx, edx}
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$f7; fs.Write(tmp, 1);
 tmp:=$fb; fs.Write(tmp, 1); {idiv ebx}
 tmp:=$52; fs.Write(tmp, 1); {push edx}
 continue;
 end;
 if u1.token = /mod then
 begin
 tmp:=$31; fs.Write(tmp, 1);
 tmp:=$d2; fs.Write(tmp, 1); {xor edx, edx}
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$f7; fs.Write(tmp, 1);
 tmp:=$fb; fs.Write(tmp, 1); {idiv ebx}
 tmp:=$52; fs.Write(tmp, 1); {push edx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = 1+ then
 begin
 tmp:=$ff; fs.Write(tmp, 1);
 tmp:=$04; fs.Write(tmp, 1);
 tmp:=$24; fs.Write(tmp, 1); {inc [esp]}
 continue;
 end;
 if u1.token = 1- then
 begin
 tmp:=$ff; fs.Write(tmp, 1);
 tmp:=$0c; fs.Write(tmp, 1);
 tmp:=$24; fs.Write(tmp, 1); {dec [esp]}
 continue;
 end;
 if u1.token = and then
 begin
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$23; fs.Write(tmp, 1);
 tmp:=$c3; fs.Write(tmp, 1); {and eax, ebx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = or then
 begin
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$0b; fs.Write(tmp, 1);
 tmp:=$c3; fs.Write(tmp, 1); {or eax, ebx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = not then
 begin
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$f7; fs.Write(tmp, 1);
 tmp:=$d0; fs.Write(tmp, 1); {not eax}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 if u1.token = xor then
 begin
 tmp:=$5b; fs.Write(tmp, 1); {pop ebx}
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$33; fs.Write(tmp, 1);
 tmp:=$c3; fs.Write(tmp, 1); {xor eax, ebx}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;
 :
 end;

Стек возвратов

Адрес вершины стека возвратов храниться в регистре EBP. Сам стек возвратов находится в самом конце памяти выделяемой для загрузки exe-файла, это последняя секция (.kf) неинициализированных данных (размер этой секции на размер exe-файла не влияет, поэтому размер стека возвратов можно изменять - изменяя размер секции .kf .

Слова языка Forth которые работают со стеком возвратов :

>r - снимает значение с арифметического стека и ложит это значение на стек возвратов

if u1.token = >r then
 begin
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$83; fs.Write(tmp, 1);
 tmp:=$ed; fs.Write(tmp, 1);
 tmp:=$04; fs.Write(tmp, 1); {sub ebp,4}
 tmp:=$89; fs.Write(tmp, 1);
 tmp:=$45; fs.Write(tmp, 1);
 tmp:=$00; fs.Write(tmp, 1); {mov [ebp],eax}
 continue;
 end;

r> - снимает значение с вершины стека возвратов и кладет его на вершину арифметического стека

if u1.token = r> then
 begin
 tmp:=$8b; fs.Write(tmp, 1);
 tmp:=$45; fs.Write(tmp, 1);
 tmp:=$00; fs.Write(tmp, 1); {mov eax,[ebp]}
 tmp:=$83; fs.Write(tmp, 1);
 tmp:=$c5; fs.Write(tmp, 1);
 tmp:=$04; fs.Write(tmp, 1); {add ebp, 4}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;

и r@ - копирует значение со стека возвратов (оставляя стек возвратов нетронутым) на вершину арифметического стека

if u1.token = r@ then
 begin
 tmp:=$8b; fs.Write(tmp, 1);
 tmp:=$45; fs.Write(tmp, 1);
 tmp:=$00; fs.Write(tmp, 1); {mov eax,[ebp]}
 tmp:=$50; fs.Write(tmp, 1); {push eax}
 continue;
 end;

Описание новых слов

В Forth для описания слова используется следующий синтаксис :

 
 : <имя нового слова> (<слово>) ;

например так :

 
 : сто 100 ;
 : view_here here . ;

слово "сто" - если оно встретится в тексте программы при выполнении положит на вершину арифметического стека число 100, а второе слово выведет на экран текущее значение вершины кодофайла ( here - кладёт на вершину стека это значение, а слово "." (точка) - снимает значение с вершины стека и выводит это значение на экран ).

При выполнении новых слов используется стек возвратов - перед выполнением слова в этот стек помещается адрес - по которому будет сделан переход после выполнения слова (т.е. слово ; (точка с запятой) или exit снимут с вершины стека возвратов значения адреса и передадут туда управление). Поэтому компиляция начала определения нового слова будет выглядеть так :

if u1.token = : then
 begin
 u1.GetToken1;
 u2.Add(u1.token, fs.Position - _fCode + _BaseOfCode ,0);
 begin
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$83; fs.Write(tmp, 1);
 tmp:=$ed; fs.Write(tmp, 1);
 tmp:=$04; fs.Write(tmp, 1); {sub ebp,4}
 tmp:=$89; fs.Write(tmp, 1);
 tmp:=$45; fs.Write(tmp, 1);
 tmp:=$00; fs.Write(tmp, 1); {mov [ebp],eax}
 end;
 continue;
 end;

здесь модуль u1 с его функцией Add используется для запоминания начала адреса в памяти определяемого слова.

А это окончание определения нового слова (или слово exit) :

 if (u1.token = ;) or (u1.token = exit) then
 begin
 tmp:=$8b; fs.Write(tmp, 1);
 tmp:=$45; fs.Write(tmp, 1);
 tmp:=$00; fs.Write(tmp, 1); {mov eax,[ebp]}
 tmp:=$83; fs.Write(tmp, 1);
 tmp:=$c5; fs.Write(tmp, 1);
 tmp:=$04; fs.Write(tmp, 1); {add ebp, 4}
 tmp:=$ff; fs.Write(tmp, 1);
 tmp:=$e0; fs.Write(tmp, 1); {jmp eax}
 continue;
 end;

Вот что компилируется и как если токен не известен компилятору(т.е. это не стандартное слово которые он знает, а новое слово которое определено раньше по тексту программы):

 if u2.Find(u1.token, _adr, _size) then
 begin
 if _size = 0 then
 begin
 tmp:=$e8; fs.Write(tmp, 1);
 tmp:=dword((_adr - _BaseOfCode) -
 (fs.Position - _fCode + 4)) ;
 fs.Write(tmp, 4); {call смещ32}
 end;
 continue;
 end;

здесь модуль u1 с его функцией Find используется для поиска начала адреса в памяти ранее определенного слова по имени.

Управляющие конструкции

В Forth слова управляющих конструкций т.к. if, then, else, begin и др. - имеют признак немедленного исполнения и активно используют арифметический стек, т.к. в компиляторе во время компиляции EXE-файла, арифметического стека не существует - для его эмуляции используется модуль u3 с функциями procedure PUSH(i:integer) и function POP:integer.

if u1.token = if then
 begin
 tmp:=$58; fs.Write(tmp, 1); {pop eax}
 tmp:=$0b; fs.Write(tmp, 1);
 tmp:=$c0; fs.Write(tmp, 1); {or eax, eax}
 tmp:=$0f; fs.Write(tmp, 1);
 tmp:=$84; fs.Write(tmp, 1);
 u3.PUSH(fs.Position);
 u3.PUSH(2);
 tmp:=$0; fs.Write(tmp, 4); {jz metka32}
 continue;
 end;

Слово if компилируется с командой условного перехода (jz), адрес (на самом деле это не реальный адрес, а fs.Position, но этого достаточно) по которому находится смещение этой команды (по началу это 0) - запоминаем с помощью PUSH.

 if u1.token = then then
 begin
 if u3.POP = 2 then
 begin
 tmp := u3.POP;
 pdword(dword(fs.Memory) + tmp)^ := fs.Position - tmp - 4;
 end;
 continue;
 end;

Слово then устанавливает по тому адресу который был запомнен словом if реальное смещение которое и высчитывает, не компилируя нового кода.

 if u1.token = else then
 begin
 if u3.POP = 2 then
 begin
 tmp:=$e9; fs.Write(tmp, 1);
 tmp:=$0; fs.Write(tmp, 4); {jmp смещ32}
 tmp := u3.POP;
 pdword(dword(fs.Memory) + tmp)^ := fs.Position - tmp - 4;
 u3.PUSH(fs.Position - 4);
 u3.PUSH(2);
 end;
 continue;
 end;

Пример:

Слово abs - берет с арифметического стека число и кладёт туда модуль этого числа

: abs dup 0 < if negate then ;

Создание EXE-файла. Заголовок.

Особенности и тонкости структуры исполняемого файла хорошо описаны у Криса Касперски, образ файла создаем в памяти - пригодится для этого класс - TMemoryStream, в последующим туда же будет происходить и компиляция. Для заголовка exe-файла понадобятся структуры модуля Windows :

TImageDosHeader, TImageNtHeader и структура TImageSection.
procedure CompileForth(prg : pchar; fn_exe : string);
var
 fs : TMemoryStream;
 headDos : TImageDosHeader;
 inh : TImageNtHeaders;
 ish : TImageSectionHeader;
 //
...
fs := TMemoryStream.Create;
 fs.SetSize(_fData + _fszData);
 FillChar((fs.Memory)^, fs.Size, #$90);
 FillChar(headDos, sizeof(headDos),#0);
 headDos.e_magic := IMAGE_DOS_SIGNATURE; {MZ}
 headDos.e_cblp := 64+15+strlen(stroka); {кол-во байт в последней странице файла}
 headDos.e_cp := 1; {одна страница - длина файла}
 headDos.e_crlc := 0; {кол-во эл-тов в таблице размещения}
 headDos.e_cparhdr := 4; {длина заголовка в параграфах}
 headDos.e_maxalloc := $ffff;
 headDos.e_sp := $b8;
 headDos.e_ip := 0;
 headDos.e_cs := 0;
 headDos.e_lfarlc := $40; {это PE-файл}
 headDos._lfanew := 256;
 fs.Position := 0;
 fs.WriteBuffer(headDos, sizeof(headDos));
 //------------заглушка--------------------
 fs.WriteBuffer(zaglushka, sizeof(zaglushka));
 fs.WriteBuffer(stroka, strlen(stroka));
 //------------PE-заголовок----------------
 fs.Position := 256;
 FillChar(inh, sizeof(inh), #0);
 inh.Signature := IMAGE_NT_SIGNATURE; {PE/0/0}
 inh.FileHeader.Machine := IMAGE_FILE_MACHINE_I386;
 inh.FileHeader.NumberOfSections := 3; {кол-во секций}
 inh.FileHeader.TimeDateStamp := _DateExe;
 inh.FileHeader.SizeOfOptionalHeader := 224; {размер дополнительного заголовка}
 inh.FileHeader.Characteristics := $818f;
 inh.OptionalHeader.Magic := $010b;
 inh.OptionalHeader.MajorLinkerVersion := 4;
 inh.OptionalHeader.MinorLinkerVersion := 2;
 inh.OptionalHeader.SizeOfCode := code_size;
 inh.OptionalHeader.SizeOfInitializedData := data_size;
 inh.OptionalHeader.SizeOfUninitializedData := 0;
 inh.OptionalHeader.AddressOfEntryPoint := $1000; {точка входа}
 inh.OptionalHeader.BaseOfCode := _BaseOfCode;
 inh.OptionalHeader.BaseOfData := _BaseOfData;
 inh.OptionalHeader.ImageBase := _ImageBase;
 inh.OptionalHeader.SectionAlignment := $1000;
 inh.OptionalHeader.FileAlignment := $200;
 inh.OptionalHeader.MajorOperatingSystemVersion := 1;
 inh.OptionalHeader.MinorOperatingSystemVersion := 0;
 inh.OptionalHeader.MajorImageVersion := 0;
 inh.OptionalHeader.MinorImageVersion := 0;
 inh.OptionalHeader.MajorSubsystemVersion := 3;
 inh.OptionalHeader.MinorSubsystemVersion := 10;
 inh.OptionalHeader.SizeOfImage := size_of_image;
 inh.OptionalHeader.SizeOfHeaders := size_of_head;
 inh.OptionalHeader.CheckSum := 0;
 inh.OptionalHeader.Subsystem := _Subsystem;
 inh.OptionalHeader.SizeOfStackReserve := 0;
 inh.OptionalHeader.SizeOfStackCommit := 0;
 inh.OptionalHeader.SizeOfHeapReserve := 0;
 inh.OptionalHeader.SizeOfHeapCommit := 0;
 inh.OptionalHeader.NumberOfRvaAndSizes := 16;
 //----------------------------------------
 szi := Import_1(pointer(dword(fs.Memory) + _fData) , _BaseOfData,
 [5,2],
 [kernel32.dll, ExitProcess, GetStdHandle, GetProcAddress,
 LoadLibraryA, WriteConsoleA, user32.dll, MessageBoxA,
 wsprintfA]);
 //----------------------------------------
 inh.OptionalHeader.DataDirectory[1].VirtualAddress := _BaseOfData; {import}
 inh.OptionalHeader.DataDirectory[1].Size := szi;
 fs.WriteBuffer(inh, sizeof(inh));
...

Заголовок Dos-части - стандартен, вывод строки и завершение работы программы.

Import_1 - эта функция подготавливает таблицу импорта, функций ExitProcess, GetStdHandle, GetProcAddress, LoadLibraryA, WriteConsoleA, MessageBoxA, wsprintfA - вполне достаточно, таблица импорта находится в секции данных.

Используется 3-и секции - для кода (.code), для данных(.data) и неинициализированных данных (.kf) - кодофайл.

...
//------------секции----------------------
 FillChar(ish, sizeof(ish), #0);
 strcopy(pchar(@(ish.Name)), .code);
 ish.VirtualAddress := _BaseOfCode;
 ish.Misc.VirtualSize := $3000;
 ish.SizeOfRawData := _fszCode;
 ish.PointerToRawData := _fCode;
 ish.Characteristics := IMAGE_SCN_CNT_CODE or
	IMAGE_SCN_MEM_EXECUTE or IMAGE_SCN_MEM_READ or IMAGE_SCN_MEM_WRITE;
 fs.WriteBuffer(ish, sizeof(ish));
 FillChar(ish, sizeof(ish), #0);
 strcopy(pchar(@(ish.Name)), .data);
 ish.VirtualAddress := _BaseOfData;
 ish.Misc.VirtualSize := $1000;
 ish.SizeOfRawData := _fszData;
 ish.PointerToRawData := _fData;
 ish.Characteristics := IMAGE_SCN_CNT_INITIALIZED_DATA or
	IMAGE_SCN_MEM_READ or IMAGE_SCN_MEM_WRITE;
 fs.WriteBuffer(ish, sizeof(ish));
 FillChar(ish, sizeof(ish), #0);
 strcopy(pchar(@(ish.Name)), .kf);
 ish.VirtualAddress := _BaseOfData + $1000;
 ish.Misc.VirtualSize := $1000;
 ish.SizeOfRawData := 0;
 ish.PointerToRawData := 0;
 ish.Characteristics := IMAGE_SCN_CNT_UNINITIALIZED_DATA or
	IMAGE_SCN_MEM_READ or IMAGE_SCN_MEM_WRITE;
 fs.WriteBuffer(ish, sizeof(ish));
...

Создание EXE-файла. Данные и исполняемый код. [ZIP; ~237 Кб]