Компилятор Forth для Windows (разработка на Delphi) Книги и брошюры которые нужно полистать и почитать что бы понять как работает компилятор и разобраться в исходном коде на Delphi: 1. Г. Шилдт "Теория и практика C++" Глава 10. Реализация языковых интерпретаторов на C++. Здесь можно прочитать как сделать интерпритатор для языка BASIC, что такое токен и как делается разбор выражений (это будет интересно если делать компилятор для языков BASIC, C, Pascal в Forth используется польская форма записи выражений) 2. Д. Хендрикс "Компилятор языка Си для микроЭВМ" Это не совсем компилятор - это конвертор с языка Си на язык Ассемблера, потом конечно это можно откомпилировать в коды для микропроцессора, тем более в книге есть исходный код компилятора, но сделано это не для i386. 3. В. Юров "Assembler. Специальный справочник" Здесь есть информация о структуре EXE-файла, но лучше использовать её просто для знакомства, а самое главное что здесь есть это - "команды микропроцессора Pentium III". 4. А. Ю. Бураго, В. А. Кириллин, И. В. Романовский "Форт - язык для микропроцессоров" Именно по мотивам этой брошюры сделан компилятор Forth (избранные главы смотрите в приложении) 5. Статья из журнала "Системный Администратор" 06.2004, Крис Касперски "Путь Воина - Внедрение в PE/COFF - файлы" Очень полезная статья о структуре EXE-файла. 6. Книжка о Delphi. Арифметический стек В качестве арифметического стека - очень хорошо подходит обычный стек с его командами push и pop. Пример: Фрагмент программы на Forth: 1 2 3 4 + * swap drop вот как это будет выглядить на ассемблере: Код (Text): 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 Код (Text): asm push 1 push 2 end; поставить точку останова (выбрать строку и нажать F5), запустить программу на выполнение (клавиша F9), после того как выполнение остановиться на точки останова, посмотреть это всё в машинных кодах (Ctrl+Alt+C). Код (Text): 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, ...) потом над этими регистрами производятся какие-либо действия, затем результат(ы) из регистров помещаются обратно на стек (если это необходимо). пример: Компиляция слов работающих с арифметическим стеком Код (Text): 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 – снимает значение с арифметического стека и ложит это значение на стек возвратов Код (Text): 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> - снимает значение с вершины стека возвратов и кладет его на вершину арифметического стека Код (Text): 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@ - копирует значение со стека возвратов (оставляя стек возвратов нетронутым) на вершину арифметического стека Код (Text): 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 снимут с вершины стека возвратов значения адреса и передадут туда управление). Поэтому компиляция начала определения нового слова будет выглядеть так : Код (Text): 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) : Код (Text): 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; Вот что компилируется и как если токен не известен компилятору(т.е. это не стандартное слово которые он знает, а новое слово которое определено раньше по тексту программы): Код (Text): 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. Код (Text): 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. Код (Text): 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 реальное смещение которое и высчитывает, не компилируя нового кода. Код (Text): 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. Код (Text): 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-файла. Данные и исполняемый код. исходик - http://kufal.narod.ru/src.zip
