Автор |
Сообщение |
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
ну и получающийся asm файл Код: format PE console
include 'include\win32a.inc' include 'include\macro\struct.inc'
section '.import' import data readable writeable
library kernel,'KERNEL32.DLL'
import kernel,\ LoadLibrary, 'LoadLibrary',\ GetProcAddress, 'GetProcAddress',\ ExitProcess, 'ExitProcess',\ GetStdHandle, 'GetStdHandle',\ WriteFile, 'WriteFile',\ ReadFile, 'ReadFile'
; типы данных
struct cell body dd ? ; ends
struct addr body dd ? ; ends
struct token call db 0xE8 ref dd ? ends
struct scnt body db ? ends
struct ref body dd ? ends
; ------------------------------------------------------------------------------ ; объявление констант
ADDR = sizeof.addr ; размер адресной ссылки CELL = sizeof.cell ; размер ячейки данных REF = sizeof.ref ; размер ссылки TOKEN = sizeof.token ; размер токена SCNT = sizeof.scnt ; размер счетчика длины
dStack equ 0x1000 ; размер стека данных rStack equ 0x1000 ; размер стека возвратов
NamesSpace = 0x10000 CodeSpace = 0x10000
; вычисляем сколько места надо выделять под стеки stack (dStack+rStack)*2, dStack+rStack
; ------------------------------------------------------------------------------
latest = 0
; описатель форт-строк macro fstr [string] { common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
macro slit [str] { local labxx call _box addr labxx fstr str align labxx: }
; формат заголовка имени (подробнее см. _sHeader) macro def string,cfa,flg { dd latest latest=$-CELL addr cfa db flg common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
allot equ rb
macro align { repeat (($+CELL-1)and -CELL)-$ nop end repeat }
macro trialign { repeat (($+CELL-1)and -CELL)-$+3 nop end repeat }
section '.fvm' code executable readable writeable ; первое определение align _NOOP: ; ( --> ) RET
; удалить элемент под вершиной стека align _NIP: ; ( a b --> b ) LEA EBP, [EBP+CELL] RET
; удалить значение с вершины стека данных align _DROP: ; ( n --> ) MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; удалить d с вершины стека данных align _DDROP: ; ( d --> ) MOV EAX, [EBP+CELL] LEA EBP, [EBP+CELL*2] RET
; дублировать значение n на вершине стека данных align _DUP: ; ( n --> n n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX RET
; дублировать значение d на вершине стека данных align _DDUP: ; ( d --> d d ) MOV EDX, [EBP] MOV [EBP-CELL], EAX MOV [EBP-CELL*2], EDX LEA EBP, [EBP-CELL*2] RET
; обменять значения двух ячеек на вершине стека данных align _SWAP: ; ( a b --> b a ) MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX RET
; положить на вершину стека данных копию значения второго элемента align _OVER: ; ( a b --> a b a ) MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX RET
; Прокрутить три верхних элемента стека. align _ROT: ; ( a b c --> b c a ) MOV EDX, [EBP] MOV [EBP], EAX MOV EAX, [EBP+CELL] MOV dword [EBP+CELL], EDX RET
; извлечь значение с указанного адреса align _Fetch: ; ( addr --> n ) MOV EAX, [EAX] RET
; сохранить значение n по указанному адресу align _Store: ; ( n addr --> ) MOV EDX, [EBP] MOV dword [EAX], EDX MOV EAX, [EBP+CELL] LEA EBP, [EBP+8] RET
; извлечь значение байта b по указанному адресу addr align _BFetch: ; ( addr --> b ) MOVZX EAX, byte [EAX] RET
; сохранить значение байта b по указанному адресу addr align _BStore: ; ( b addr --> ) MOV EDX, [EBP] MOV byte [EAX], DL MOV EAX, [EBP+CELL] LEA EBP, [EBP+8] RET
; сложить два числа на вершине стека данных, результат оставить на вершине align _Plus: ; ( n1 n2 --> n ) ADD EAX, [EBP] LEA EBP, [EBP+CELL] RET
; сложить два числа на вершине стека данных, результат оставить на вершине align _Minus: ; ( n1 n2 --> n ) MOV EDX, [EBP] SUB EDX, EAX MOV EAX, EDX LEA EBP, [EBP+CELL] RET
; знаковое деление чисел одинарной длины align _Slash: ; ( na nb --> n ) MOV ECX, EAX MOV EAX, [EBP] CDQ IDIV ECX LEA EBP, [EBP+CELL] RET
; логическое или над двумя операндами на вершине стека даных align _OR: ; ( na nb --> n ) OR EAX, [EBP] LEA EBP, [EBP+CELL] RET
; поделить беззнаковое число двойной точности ; на беззнаковое число одинарной точности ; результат - частное и остаток от деления align _UMSlashMOD: ; ( ud u1 --> div mod ) MOV ECX, EAX MOV EDX, [EBP] MOV EAX, [EBP+CELL] DIV ECX LEA EBP, [EBP+CELL] MOV dword [EBP], EDX RET
; Преобразовать число n в двойное число d с тем же числовым значением. align _SToD: ; ( n --> d ) CDQ LEA EBP, [EBP-CELL] MOV [EBP], EAX MOV EAX, EDX RET
; найти абсолютное значение числа align _ABS: ; ( n --> u ) MOV EDX, EAX SAR EDX, 31 ADD EAX, EDX XOR EAX, EDX RET
; оставить минимальное n из двух чисел na, nb на вершине стека данных align _MIN: ; ( na nb --> n ) CMP EAX, [EBP] JL _2st MOV EAX, [EBP] _2st: LEA EBP, [EBP+CELL] RET
; увеличить значение, хранящееся по addr на n, ; результат сохранить по addr и оставить на вершине стека данных align _PlusStoreFetch: ; ( n addr --> x+n ) MOV EDX, [EAX] ADD EDX, [EBP] MOV dword [EAX], EDX MOV EAX, EDX LEA EBP, [EBP+CELL] RET
; переместить указатель вершины стека данных на указанный адрес ; в TOS остается значение align _SPStore: ; ( addr --> ) MOV EBP, EAX RET
; вернуть адрес вершины стека данных align _SPFetch: ; ( --> addr ) MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX RET
; переместить указатель вершины стека возвратов на указанный адрес align _RPStore: ; ( addr --> ) POP EDX MOV ESP, EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JMP EDX
; вернуть адрес вершины стека возвратов align _RPFetch: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, ESP RET
; перенести значение с вершины стека данных на вершину стека возвратов align _ToR: ; ( addr --> r: addr ) POP EDX PUSH EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JMP EDX RET
; перенести значение с вершины стека возвратов на вершину стека данных align _RTo: ; ( r: addr --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EDX POP EAX JMP EDX RET
; выложить на вершину стека данных значение, ; скомпилированное в коде за вызовом (LIT) align _lParLITrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+CELL] MOV EAX, [EAX] JMP EDX
; выложить на вершину стека данных значение, ; скомпилированное в коде за вызовом (LIT) align _lParDLITrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+CELL] MOV EAX, [EAX] JMP EDX
; вернуть адрес слова, вызов которого скомпилирован в коде вслед за (') align _lParTickrPar: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+TOKEN] MOV EAX, [EAX+1] JMP EDX
; вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину # align _lParSLITrPar: ; ( --> asc # ) LEA EBP, [EBP-8] MOV dword [EBP+CELL], EAX POP EBX LEA EDX, [EBX+CELL] MOV dword [EBP], EDX MOV EAX, [EBX] LEA EDX, [EBX+EAX+TOKEN] JMP EDX
; положить на вершину стека адрес переменной align _lParCREATErPar: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX RET
; положить на вершину стека значение align _lParCONSTANTrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX MOV EAX, [EAX] RET
; проверка числа на 0 align _0Equal: ; ( n --> flag ) SUB EAX, 1 SBB EAX, EAX RET
; сравнить числа na и nb align _To: ; ( na nb --> flag ) CMP EAX, [EBP] SETGE AL AND EAX, 1 DEC EAX LEA EBP, [EBP+CELL] RET
align _UTo: ; ( ua ub --> flag ) CMP EAX, [EBP] SBB EAX, EAX LEA EBP, [EBP+CELL] RET
; сравнить числа na и nb align _Less: ; ( na nb --> flag ) CMP EAX, [EBP] SETLE AL AND EAX, 1 DEC EAX LEA EBP, [EBP+CELL] RET
; выйти из текущего определения align _EXIT: ; ( --> ) LEA ESP, [ESP+CELL] RET
; безусловное ветвление align _BRANCH: ; ( --> ) POP EDX JMP dword [EDX]
; условное ветвление align _QuestionBRANCH: ; ( n --> n ) OR EAX, EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JZ _BRANCH POP EDX LEA EDX, [EDX+CELL] JMP EDX
; условное ветвление align _NQuestionBRANCH: ; ( n --> n ) OR EAX, EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JNZ _BRANCH POP EDX LEA EDX, [EDX+CELL] JMP EDX
; размер буферов TIB и PAD в байтах trialign _TIBSize: CALL _lParCONSTANTrPar dd 0x100
; ( --> # ) trialign _PADSize: CALL _lParCONSTANTrPar dd 0x100
; ( --> #) ; terminal input buffer trialign _TIB: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
; указатель на первый неразобранный символ во входном буфере trialign _ToIN: CALL _lParCREATErPar dd 0
; указатель на последний введенный символ trialign _SizeTIB: CALL _lParCREATErPar dd 0
; Дно стека данных trialign _S0: CALL _lParCREATErPar dd 0
; ( --> addr ) ; Дно стека возвратов trialign _R0: CALL _lParCREATErPar dd 0
; ( --> addr ) ; размеры стеков trialign _DataStackSize: CALL _lParCONSTANTrPar dd 0x1000
trialign _ReturnStackSize: CALL _lParCONSTANTrPar dd 0x1000
; Хранит адрес первой свободной ячейки памяти в пространстве кода и данных trialign _DP: CALL _lParCREATErPar dd 0
; ( --> addr ) ; Хранит адрес первой свободной ячейки памяти в пространстве имен trialign _HDP: CALL _lParCREATErPar dd 0
; ( --> addr ) ; стандартные потоки В\В trialign _STDIN: CALL _lParCREATErPar dd 0
; входной trialign _STDOUT: CALL _lParCREATErPar dd 0
; выходной trialign _STDERR: CALL _lParCREATErPar dd 0
; выходной для ошибок ; флаг необходимости извещения о повторном использовании уже существующего имени определения trialign _WARNING: CALL _lParCREATErPar dd 0
; текущее состоянии системы (интерпретация\компиляция) trialign _STATE: CALL _lParCREATErPar dd 0
; переключение состояния системы align _lStap: ; ( --> ) CALL _lParLITrPar dd 0x0 CALL _STATE CALL _Store RET
align _rStap: ; ( --> ) CALL _lParLITrPar dd 0xFFFFFFFF CALL _STATE CALL _Store RET
trialign _CELL: CALL _lParCONSTANTrPar dd 0x4
; размер ячейки, байт trialign _ADDR: CALL _lParCONSTANTrPar dd 0x4
; размер адресной ссылки, байт ; преобразовать значение количетсва ячеек в количество минимально адресуемых единиц (байт) align _CELLS: ; ( u --> # ) SAR EAX, 2 RET
; вернуть адрес первой свободной ячейки памят в пространстве кода и данных align _HERE: ; ( --> addr ) CALL _DP MOV EAX, [EAX] RET
; вернуть адрес первой свободной ячейки памят в пространстве имен align _HHERE: ; ( haddr --> addr ) CALL _HDP MOV EAX, [EAX] RET
; добавить в конец файла fid содержимое строки Asc # align _WRITEMinusFILE: ; ( asc # fid --> # ) CALL _ToR CALL _ToR CALL _ToR CALL _lParLITrPar dd 0x0 MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _RTo CALL _RTo MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX CALL _RTo LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [WriteFile] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; читать в буфер asc строку длиной не более # символов содержимое файла fid align _READMinusFILE: ; ( asc # fid --> # ) CALL _ToR CALL _ToR CALL _ToR CALL _lParLITrPar dd 0x0 MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _RTo CALL _RTo MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX CALL _RTo LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [ReadFile] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; вывести в текущий STDOUT поток указанную строку align _TYPE: ; ( asc # --> ) CALL _STDOUT MOV EAX, [EAX] CALL _WRITEMinusFILE MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; вывести символ в текущий поток В\В align _EMIT: ; ( char --> ) MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX CALL _lParLITrPar dd 0x1 CALL _TYPE MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; текущая система счисления trialign _BASE: CALL _lParCREATErPar dd 0
; переключения системы счисления align _DECIMAL: ; ( --> ) CALL _lParLITrPar dd 0xA CALL _BASE CALL _Store RET
align _HEX: ; ( --> ) CALL _lParLITrPar dd 0x10 CALL _BASE CALL _Store RET
; буфер для форматного преобразования чисел и строк trialign _PAD: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
; буфер обычно заполняется с конца, поэтому необходим адрес конца буфера PadTop: ; указатель на последний символ в PAD trialign _HLD: CALL _lParCREATErPar dd 0
; начать форматное преобразование строки align _LessSize: ; ( --> )
CALL _lParLITrPar dd PadTop CALL _HLD CALL _Store RET
; задать текущую систему счисления и начать форматное преобразование строки align _lBrSize: ; ( base --> ) CALL _BASE CALL _Store CALL _LessSize RET
; завершить форматное преобразование строки, вернуть адрес asc и длину # полученной строки align _SizerBr: ; ( --> asc # ) CALL _HLD MOV EAX, [EAX] CALL _PAD CALL _PADSize CALL _Plus MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX CALL _Minus RET
; то же, что и #}, только предварительно удаляет число двойной длины с вершины стека данных align _SizeTo: ; ( d --> asc # ) LEA EBP, [EBP+CELL] MOV EAX, [EBP] LEA EBP, [EBP+CELL] CALL _SizerBr RET
; добавляет символ char в позицию HLD, сам HLD уменьшает на размер одного символа align _HOLD: ; ( char --> ) CALL _lParLITrPar dd 0xFFFFFFFF CALL _HLD CALL _PlusStoreFetch CALL _BStore RET
; -1 HLD @ + PAD UMAX DUP HLD ! B! ; преобразовать число в символ ; число не должно превышать значение находящееся в BASE align _ToDIGIT: ; ( u --> char ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _lParLITrPar dd 0x9 CALL _To CALL _QuestionBRANCH dd lab_0001 CALL _lParLITrPar dd 0x7 CALL _Plus lab_0001: CALL _lParLITrPar dd 0x30 CALL _Plus RET
; добавить в буфер PAD остаток от деления двойного числа на содержимое BASE align _Size: ; ( ud1 --> ud2 ) CALL _lParLITrPar dd 0x0 CALL _BASE MOV EAX, [EAX] MOV ECX, EAX MOV EDX, [EBP] MOV EAX, [EBP+CELL] DIV ECX LEA EBP, [EBP+CELL] MOV dword [EBP], EDX CALL _ToR CALL _BASE MOV EAX, [EAX] MOV ECX, EAX MOV EDX, [EBP] MOV EAX, [EBP+CELL] DIV ECX LEA EBP, [EBP+CELL] MOV dword [EBP], EDX CALL _RTo MOV EDX, [EBP] MOV [EBP], EAX MOV EAX, [EBP+CELL] MOV dword [EBP+CELL], EDX CALL _ToDIGIT CALL _HOLD RET
; Если n отрицательно, добавить в PAD символ '-' align _SIGN: ; ( n --> ) CALL _lParLITrPar dd 0x0 CALL _Less CALL _QuestionBRANCH dd lab_0002 CALL _lParLITrPar dd 0x2D CALL _HOLD lab_0002: RET
; преобразовать число двойной длинны в строку align _SizeS: ; ( ud --> 0 0 ) lab_0003: ; метка для перехода назад CALL _Size MOV EDX, [EBP] MOV [EBP-CELL], EAX MOV [EBP-CELL*2], EDX LEA EBP, [EBP-CELL*2] OR EAX, [EBP] LEA EBP, [EBP+CELL] CALL _QuestionBRANCH dd lab_0004 JMP lab_0003 ; переход назад lab_0004: RET
; константы значения спецсимволов trialign _Bl_: CALL _lParCONSTANTrPar dd 0x20
trialign _Cr_: CALL _lParCONSTANTrPar dd 0xA
trialign _Lf_: CALL _lParCONSTANTrPar dd 0xD
; преобразовать число одинарной длинны в строку ; в десятичной системе независимо от значения BASE align _lParPeroidrPar: ; ( n --> asc # ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _ToR MOV EDX, EAX SAR EDX, 31 ADD EAX, EDX XOR EAX, EDX CDQ LEA EBP, [EBP-CELL] MOV [EBP], EAX MOV EAX, EDX CALL _LessSize CALL _SizeS CALL _RTo CALL _SIGN CALL _SizeTo RET
; вывести число в текущей системе счисления в выходной поток align _Peroid: ; ( n --> ) CALL _lParPeroidrPar CALL _TYPE RET
; перевод строки align _CR: ; ( --> ) CALL _lParSLITrPar dd 0x2 db 0xD,0xA,0x00 CALL _TYPE RET
; текущая глубина стека данных align _DEPTH: ; ( --> n ) MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX CALL _S0 MOV EAX, [EAX] MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX CALL _Minus CALL _CELL MOV ECX, EAX MOV EAX, [EBP] CDQ IDIV ECX LEA EBP, [EBP+CELL] RET
; приглашение align _PROMPT: ; ( --> ) CALL _DEPTH CALL _Peroid CALL _STATE MOV EAX, [EAX] CALL _QuestionBRANCH dd lab_0005 CALL _lParSLITrPar dd 0x1 db 0x5D,0x00 CALL _BRANCH dd lab_0006 lab_0005: CALL _lParSLITrPar dd 0x1 db 0x5B,0x00 lab_0006: CALL _TYPE RET
; получить очередную строку из STDIN в буфер TIB align _QUERY: ; ( --> ) CALL _TIB CALL _TIBSize CALL _STDIN MOV EAX, [EAX] CALL _READMinusFILE CALL _SizeTIB CALL _Store CALL _lParLITrPar dd 0x0 CALL _ToIN CALL _Store RET
; -- парсер -------------------------------------------------------------------- ; является ли символ char пробельным align _nQuestionsep: ; ( char --> flag ) CALL _Bl_ CALL _To RET
; адрес первого неразобранного символа align _CharAddr: ; ( --> addr ) CALL _TIB CALL _ToIN MOV EAX, [EAX] CALL _Plus RET
; прочесть символ из текущего значения >IN align _PeekChar: ; ( --> char ) CALL _CharAddr MOVZX EAX, byte [EAX] RET
; пропустить один символ во входном потоке align _SkipChar: ; ( --> ) CALL _ToIN MOV EAX, [EAX] CALL _lParLITrPar dd 0x1 CALL _Plus CALL _SizeTIB MOV EAX, [EAX] CALL _MIN CALL _ToIN CALL _Store RET
; вернуть TRUE если весь текст уже разобран align _QuestionCOMPLETE: ; ( --> flag ) CALL _SizeTIB MOV EAX, [EAX] CALL _ToIN MOV EAX, [EAX] CALL _Less RET
; взять очередной символ из входного потока ; flag = TRUE если входной поток исчерпан align _NextChar: ; ( --> char flag ) CALL _PeekChar CALL _QuestionCOMPLETE CALL _SkipChar RET
; пропустить все символы разделители до первого значащего символа, ; либо до конца разбираемой строки align _MissSeparators: ; ( --> ) INT3 lab_0007: ; метка для перехода назад CALL _NextChar CALL _NQuestionBRANCH dd lab_0008 CALL _nQuestionsep CALL _NQuestionBRANCH dd lab_0009 JMP lab_0007 ; переход назад lab_0009: CALL _EXIT lab_0008: MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; пропустить текст вплодь до разделителя align _MissLexeme: ; ( --> ) INT3 lab_000A: ; метка для перехода назад CALL _NextChar CALL _NQuestionBRANCH dd lab_000B CALL _nQuestionsep CALL _QuestionBRANCH dd lab_000C JMP lab_000A ; переход назад lab_000C: CALL _EXIT lab_000B: MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; выделить из буфера блок символов вплоть до разделителя align _PassLexeme: ; ( --> asc # ) CALL _CharAddr CALL _MissLexeme CALL _CharAddr MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX CALL _Minus RET
; Получить адрес и длину очередной лексемы align _NextWord: ; ( --> asc # ) CALL _MissSeparators CALL _PassLexeme RET
trialign _WORDLISTS: CALL _lParCONSTANTrPar dd 0x10
; количество словарей в системе ; текущий словарь ( в который ведется добавление имен) trialign _CURRENT: CALL _lParCREATErPar dd 0
; стек словарей для поиска trialign _CONTEXT: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
CNSP: ; вершина списка словарей ; сделать верхний текущий словарь контекстным align _DEFINITIONS: ; ( --> ) CALL _CONTEXT MOV EAX, [EAX] CALL _CURRENT CALL _Store RET
; !!! написать нормально ; идентификатор словаря FORTH align _FORTHMinusWORDLIST: ; ( --> wid ) CALL _lParLITrPar dd 0x1 RET
; !!! написать нормально ; инициализация контекста align _ONLY: ; ( --> ) CALL _FORTHMinusWORDLIST CALL _CONTEXT CALL _Store RET
; !!! написать нормально ; выполнить действие над очередной лексемой align _EVALMinusTOKEN: ; ( asc # --> ) CALL _CR CALL _TYPE RET
; интерпретировать входной поток ; : INTERPRET ( --> ) BEGIN NextWord DUP WHILE EVAL-TOKEN REPEAT DDROP ; align _INTERPRET: ; ( --> ) CALL _TIB CALL _SizeTIB MOV EAX, [EAX] CALL _TYPE CALL _CR RET
; проверка протекания стека данных align _QuestionSTACK: ; ( --> ) MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX CALL _S0 MOV EAX, [EAX] CMP EAX, [EBP] SBB EAX, EAX LEA EBP, [EBP+CELL] CALL _QuestionBRANCH dd lab_000D CALL _lParSLITrPar dd 0x1A db 0x88,0xE1,0xE7,0xA5,0xE0,0xAF,0xA0,0xAD,0xA8,0xA5,0x20 db 0xE1,0xE2,0xA5,0xAA,0xA0,0x20,0xA4,0xA0,0xAD,0xAD,0xEB,0xE5,0x21,0xD,0xA,0x00 CALL _TYPE CALL _S0 MOV EAX, [EAX] CALL _SPStore lab_000D: RET
; основной цикл системы align _QUIT: ; ( --> ) CALL _lStap CALL _DECIMAL CALL _CR lab_000E: ; метка для перехода назад CALL _PROMPT CALL _QUERY CALL _INTERPRET CALL _QuestionSTACK JMP lab_000E ; переход назад RET
; инициализация системы после ошибки align _ABORT: ; ( --> ) CALL _S0 MOV EAX, [EAX] CALL _SPStore CALL _R0 MOV EAX, [EAX] CALL _RPStore CALL _ONLY CALL _DEFINITIONS CALL _QUIT RET
; инициализация идентификаторов потоков В/В align _INITMinusIO: ; ( --> ) CALL _lParLITrPar dd 0xFFFFFFF6 LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [GetStdHandle] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] CALL _STDIN CALL _Store CALL _lParLITrPar dd 0xFFFFFFF5 LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [GetStdHandle] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] CALL _STDOUT CALL _Store CALL _lParLITrPar dd 0xFFFFFFF4 LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [GetStdHandle] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] CALL _STDERR CALL _Store RET
; приветствие после запуска системы align _TITLE: ; ( --> ) CALL _lParSLITrPar dd 0xA db 0xD,0xA,0x48,0x65,0x6C,0x6C,0x6F,0x21,0xD,0xA,0x00 CALL _TYPE RET
; сделать вектором! align _MAIN: ; ( --> ) CALL _TITLE RET
; холодный запуск системы align _COLD: ; ( --> ) LEA EBP, [EBP-256] ; для начала раздвигаются указатели стеков CALL _RPFetch LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _R0 CALL _Store ; стек возвратов под стеком данных используется для хранения ; только внутренних вызовов, т.к. АПИ очень сильно жрет стек CALL _ReturnStackSize CALL _Minus CALL _S0 CALL _Store CALL _INITMinusIO CALL _DECIMAL CALL _MAIN CALL _ABORT RET
; последнее определение системы trialign _FENCE: CALL _lParCREATErPar ; ( --> )
entry _COLD ; точка входа
section '.names' data readable writeable ; makevoc FORTH
; Имя, Метка, Флаг immediate def 'FENCE', _FENCE, 1 def 'COLD', _COLD, 1 def 'MAIN', _MAIN, 1 def 'TITLE', _TITLE, 1 def 'INIT-IO', _INITMinusIO, 1 def 'ABORT', _ABORT, 1 def 'QUIT', _QUIT, 1 def '?STACK', _QuestionSTACK, 1 def 'INTERPRET', _INTERPRET, 1 def 'EVAL-TOKEN', _EVALMinusTOKEN, 1 def 'ONLY', _ONLY, 1 def 'FORTH-WORDLIST', _FORTHMinusWORDLIST, 1 def 'DEFINITIONS', _DEFINITIONS, 1 def 'CONTEXT', _CONTEXT, 1 def 'CURRENT', _CURRENT, 1 def 'WORDLISTS', _WORDLISTS, 1 def 'NextWord', _NextWord, 1 def 'PassLexeme', _PassLexeme, 1 def 'MissLexeme', _MissLexeme, 1 def 'MissSeparators', _MissSeparators, 1 def 'NextChar', _NextChar, 1 def '?COMPLETE', _QuestionCOMPLETE, 1 def 'SkipChar', _SkipChar, 1 def 'PeekChar', _PeekChar, 1 def 'CharAddr', _CharAddr, 1 def 'n?sep', _nQuestionsep, 1 def 'QUERY', _QUERY, 1 def 'PROMPT', _PROMPT, 1 def 'DEPTH', _DEPTH, 1 def 'CR', _CR, 1 def '.', _Peroid, 1 def '(.)', _lParPeroidrPar, 1 def 'Lf_', _Lf_, 1 def 'Cr_', _Cr_, 1 def 'Bl_', _Bl_, 1 def '#S', _SizeS, 1 def 'SIGN', _SIGN, 1 def '#', _Size, 1 def '>DIGIT', _ToDIGIT, 1 def 'HOLD', _HOLD, 1 def '#>', _SizeTo, 1 def '#}', _SizerBr, 1 def '{#', _lBrSize, 1 def '<#', _LessSize, 1 def 'HLD', _HLD, 1 def 'PAD', _PAD, 1 def 'HEX', _HEX, 1 def 'DECIMAL', _DECIMAL, 1 def 'BASE', _BASE, 1 def 'EMIT', _EMIT, 1 def 'TYPE', _TYPE, 1 def 'READ-FILE', _READMinusFILE, 1 def 'WRITE-FILE', _WRITEMinusFILE, 1 def 'HHERE', _HHERE, 1 def 'HERE', _HERE, 1 def 'CELLS', _CELLS, 1 def 'ADDR', _ADDR, 1 def 'CELL', _CELL, 1 def ']', _rStap, 1 def '[', _lStap, -1 def 'STATE', _STATE, 1 def 'WARNING', _WARNING, 1 def 'STDERR', _STDERR, 1 def 'STDOUT', _STDOUT, 1 def 'STDIN', _STDIN, 1 def 'HDP', _HDP, 1 def 'DP', _DP, 1 def 'ReturnStack#', _ReturnStackSize, 1 def 'DataStack#', _DataStackSize, 1 def 'R0', _R0, 1 def 'S0', _S0, 1 def '#TIB', _SizeTIB, 1 def '>IN', _ToIN, 1 def 'TIB', _TIB, 1 def 'PAD#', _PADSize, 1 def 'TIB#', _TIBSize, 1 def 'N?BRANCH', _NQuestionBRANCH, 1 def '?BRANCH', _QuestionBRANCH, 1 def 'BRANCH', _BRANCH, 1 def 'EXIT', _EXIT, 1 def '<', _Less, 1 def 'U>', _UTo, 1 def '>', _To, 1 def '0=', _0Equal, 1 def '(CONSTANT)', _lParCONSTANTrPar, 1 def '(CREATE)', _lParCREATErPar, 1 def '(SLIT)', _lParSLITrPar, 1 def '(`)', _lParTickrPar, 1 def '(DLIT)', _lParDLITrPar, 1 def '(LIT)', _lParLITrPar, 1 def 'R>', _RTo, 1 def '>R', _ToR, 1 def 'RP@', _RPFetch, 1 def 'RP!', _RPStore, 1 def 'SP@', _SPFetch, 1 def 'SP!', _SPStore, 1 def '+!@', _PlusStoreFetch, 1 def 'MIN', _MIN, 1 def 'ABS', _ABS, 1 def 'S>D', _SToD, 1 def 'UM/MOD', _UMSlashMOD, 1 def 'OR', _OR, 1 def '/', _Slash, 1 def '-', _Minus, 1 def '+', _Plus, 1 def 'B!', _BStore, 1 def 'B@', _BFetch, 1 def '!', _Store, 1 def '@', _Fetch, 1 def 'ROT', _ROT, 1 def 'OVER', _OVER, 1 def 'SWAP', _SWAP, 1 def 'DDUP', _DDUP, 1 def 'DUP', _DUP, 1 def 'DDROP', _DDROP, 1 def 'DROP', _DROP, 1 def 'NIP', _NIP, 1 def 'NOOP', _NOOP, 1 LATEST: ; чтобы получить хвост цепочки имен NSADDR: allot NamesSpace-($-$$) ;
section '.edata' export data readable export 'FORTH',\ _FENCE,'FENCE',\ _COLD,'COLD',\ _MAIN,'MAIN',\ _TITLE,'TITLE',\ _INITMinusIO,'INIT-IO',\ _ABORT,'ABORT',\ _QUIT,'QUIT',\ _QuestionSTACK,'?STACK',\ _INTERPRET,'INTERPRET',\ _EVALMinusTOKEN,'EVAL-TOKEN',\ _ONLY,'ONLY',\ _FORTHMinusWORDLIST,'FORTH-WORDLIST',\ _DEFINITIONS,'DEFINITIONS',\ _CONTEXT,'CONTEXT',\ _CURRENT,'CURRENT',\ _WORDLISTS,'WORDLISTS',\ _NextWord,'NextWord',\ _PassLexeme,'PassLexeme',\ _MissLexeme,'MissLexeme',\ _MissSeparators,'MissSeparators',\ _NextChar,'NextChar',\ _QuestionCOMPLETE,'?COMPLETE',\ _SkipChar,'SkipChar',\ _PeekChar,'PeekChar',\ _CharAddr,'CharAddr',\ _nQuestionsep,'n?sep',\ _QUERY,'QUERY',\ _PROMPT,'PROMPT',\ _DEPTH,'DEPTH',\ _CR,'CR',\ _Peroid,'.',\ _lParPeroidrPar,'(.)',\ _Lf_,'Lf_',\ _Cr_,'Cr_',\ _Bl_,'Bl_',\ _SizeS,'#S',\ _SIGN,'SIGN',\ _Size,'#',\ _ToDIGIT,'>DIGIT',\ _HOLD,'HOLD',\ _SizeTo,'#>',\ _SizerBr,'#}',\ _lBrSize,'{#',\ _LessSize,'<#',\ _HLD,'HLD',\ _PAD,'PAD',\ _HEX,'HEX',\ _DECIMAL,'DECIMAL',\ _BASE,'BASE',\ _EMIT,'EMIT',\ _TYPE,'TYPE',\ _READMinusFILE,'READ-FILE',\ _WRITEMinusFILE,'WRITE-FILE',\ _HHERE,'HHERE',\ _HERE,'HERE',\ _CELLS,'CELLS',\ _ADDR,'ADDR',\ _CELL,'CELL',\ _rStap,']',\ _lStap,'[',\ _STATE,'STATE',\ _WARNING,'WARNING',\ _STDERR,'STDERR',\ _STDOUT,'STDOUT',\ _STDIN,'STDIN',\ _HDP,'HDP',\ _DP,'DP',\ _ReturnStackSize,'ReturnStack#',\ _DataStackSize,'DataStack#',\ _R0,'R0',\ _S0,'S0',\ _SizeTIB,'#TIB',\ _ToIN,'>IN',\ _TIB,'TIB',\ _PADSize,'PAD#',\ _TIBSize,'TIB#',\ _NQuestionBRANCH,'N?BRANCH',\ _QuestionBRANCH,'?BRANCH',\ _BRANCH,'BRANCH',\ _EXIT,'EXIT',\ _Less,'<',\ _UTo,'U>',\ _To,'>',\ _0Equal,'0=',\ _lParCONSTANTrPar,'(CONSTANT)',\ _lParCREATErPar,'(CREATE)',\ _lParSLITrPar,'(SLIT)',\ _lParTickrPar,'(`)',\ _lParDLITrPar,'(DLIT)',\ _lParLITrPar,'(LIT)',\ _RTo,'R>',\ _ToR,'>R',\ _RPFetch,'RP@',\ _RPStore,'RP!',\ _SPFetch,'SP@',\ _SPStore,'SP!',\ _PlusStoreFetch,'+!@',\ _MIN,'MIN',\ _ABS,'ABS',\ _SToD,'S>D',\ _UMSlashMOD,'UM/MOD',\ _OR,'OR',\ _Slash,'/',\ _Minus,'-',\ _Plus,'+',\ _BStore,'B!',\ _BFetch,'B@',\ _Store,'!',\ _Fetch,'@',\ _ROT,'ROT',\ _OVER,'OVER',\ _SWAP,'SWAP',\ _DDUP,'DDUP',\ _DUP,'DUP',\ _DDROP,'DDROP',\ _DROP,'DROP',\ _NIP,'NIP',\ _NOOP,'NOOP'
Пока что просто ожидает ввода строки, затем выводит ее на экран, собственно, для иллюстрации работы транслятора достаточно 8)
ну и получающийся asm файл [code]format PE console
include 'include\win32a.inc' include 'include\macro\struct.inc'
section '.import' import data readable writeable
library kernel,'KERNEL32.DLL'
import kernel,\ LoadLibrary, 'LoadLibrary',\ GetProcAddress, 'GetProcAddress',\ ExitProcess, 'ExitProcess',\ GetStdHandle, 'GetStdHandle',\ WriteFile, 'WriteFile',\ ReadFile, 'ReadFile'
; типы данных
struct cell body dd ? ; ends
struct addr body dd ? ; ends
struct token call db 0xE8 ref dd ? ends
struct scnt body db ? ends
struct ref body dd ? ends
; ------------------------------------------------------------------------------ ; объявление констант
ADDR = sizeof.addr ; размер адресной ссылки CELL = sizeof.cell ; размер ячейки данных REF = sizeof.ref ; размер ссылки TOKEN = sizeof.token ; размер токена SCNT = sizeof.scnt ; размер счетчика длины
dStack equ 0x1000 ; размер стека данных rStack equ 0x1000 ; размер стека возвратов
NamesSpace = 0x10000 CodeSpace = 0x10000
; вычисляем сколько места надо выделять под стеки stack (dStack+rStack)*2, dStack+rStack
; ------------------------------------------------------------------------------
latest = 0
; описатель форт-строк macro fstr [string] { common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
macro slit [str] { local labxx call _box addr labxx fstr str align labxx: }
; формат заголовка имени (подробнее см. _sHeader) macro def string,cfa,flg { dd latest latest=$-CELL addr cfa db flg common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
allot equ rb
macro align { repeat (($+CELL-1)and -CELL)-$ nop end repeat }
macro trialign { repeat (($+CELL-1)and -CELL)-$+3 nop end repeat }
section '.fvm' code executable readable writeable ; первое определение align _NOOP: ; ( --> ) RET
; удалить элемент под вершиной стека align _NIP: ; ( a b --> b ) LEA EBP, [EBP+CELL] RET
; удалить значение с вершины стека данных align _DROP: ; ( n --> ) MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; удалить d с вершины стека данных align _DDROP: ; ( d --> ) MOV EAX, [EBP+CELL] LEA EBP, [EBP+CELL*2] RET
; дублировать значение n на вершине стека данных align _DUP: ; ( n --> n n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX RET
; дублировать значение d на вершине стека данных align _DDUP: ; ( d --> d d ) MOV EDX, [EBP] MOV [EBP-CELL], EAX MOV [EBP-CELL*2], EDX LEA EBP, [EBP-CELL*2] RET
; обменять значения двух ячеек на вершине стека данных align _SWAP: ; ( a b --> b a ) MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX RET
; положить на вершину стека данных копию значения второго элемента align _OVER: ; ( a b --> a b a ) MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX RET
; Прокрутить три верхних элемента стека. align _ROT: ; ( a b c --> b c a ) MOV EDX, [EBP] MOV [EBP], EAX MOV EAX, [EBP+CELL] MOV dword [EBP+CELL], EDX RET
; извлечь значение с указанного адреса align _Fetch: ; ( addr --> n ) MOV EAX, [EAX] RET
; сохранить значение n по указанному адресу align _Store: ; ( n addr --> ) MOV EDX, [EBP] MOV dword [EAX], EDX MOV EAX, [EBP+CELL] LEA EBP, [EBP+8] RET
; извлечь значение байта b по указанному адресу addr align _BFetch: ; ( addr --> b ) MOVZX EAX, byte [EAX] RET
; сохранить значение байта b по указанному адресу addr align _BStore: ; ( b addr --> ) MOV EDX, [EBP] MOV byte [EAX], DL MOV EAX, [EBP+CELL] LEA EBP, [EBP+8] RET
; сложить два числа на вершине стека данных, результат оставить на вершине align _Plus: ; ( n1 n2 --> n ) ADD EAX, [EBP] LEA EBP, [EBP+CELL] RET
; сложить два числа на вершине стека данных, результат оставить на вершине align _Minus: ; ( n1 n2 --> n ) MOV EDX, [EBP] SUB EDX, EAX MOV EAX, EDX LEA EBP, [EBP+CELL] RET
; знаковое деление чисел одинарной длины align _Slash: ; ( na nb --> n ) MOV ECX, EAX MOV EAX, [EBP] CDQ IDIV ECX LEA EBP, [EBP+CELL] RET
; логическое или над двумя операндами на вершине стека даных align _OR: ; ( na nb --> n ) OR EAX, [EBP] LEA EBP, [EBP+CELL] RET
; поделить беззнаковое число двойной точности ; на беззнаковое число одинарной точности ; результат - частное и остаток от деления align _UMSlashMOD: ; ( ud u1 --> div mod ) MOV ECX, EAX MOV EDX, [EBP] MOV EAX, [EBP+CELL] DIV ECX LEA EBP, [EBP+CELL] MOV dword [EBP], EDX RET
; Преобразовать число n в двойное число d с тем же числовым значением. align _SToD: ; ( n --> d ) CDQ LEA EBP, [EBP-CELL] MOV [EBP], EAX MOV EAX, EDX RET
; найти абсолютное значение числа align _ABS: ; ( n --> u ) MOV EDX, EAX SAR EDX, 31 ADD EAX, EDX XOR EAX, EDX RET
; оставить минимальное n из двух чисел na, nb на вершине стека данных align _MIN: ; ( na nb --> n ) CMP EAX, [EBP] JL _2st MOV EAX, [EBP] _2st: LEA EBP, [EBP+CELL] RET
; увеличить значение, хранящееся по addr на n, ; результат сохранить по addr и оставить на вершине стека данных align _PlusStoreFetch: ; ( n addr --> x+n ) MOV EDX, [EAX] ADD EDX, [EBP] MOV dword [EAX], EDX MOV EAX, EDX LEA EBP, [EBP+CELL] RET
; переместить указатель вершины стека данных на указанный адрес ; в TOS остается значение align _SPStore: ; ( addr --> ) MOV EBP, EAX RET
; вернуть адрес вершины стека данных align _SPFetch: ; ( --> addr ) MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX RET
; переместить указатель вершины стека возвратов на указанный адрес align _RPStore: ; ( addr --> ) POP EDX MOV ESP, EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JMP EDX
; вернуть адрес вершины стека возвратов align _RPFetch: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, ESP RET
; перенести значение с вершины стека данных на вершину стека возвратов align _ToR: ; ( addr --> r: addr ) POP EDX PUSH EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JMP EDX RET
; перенести значение с вершины стека возвратов на вершину стека данных align _RTo: ; ( r: addr --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EDX POP EAX JMP EDX RET
; выложить на вершину стека данных значение, ; скомпилированное в коде за вызовом (LIT) align _lParLITrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+CELL] MOV EAX, [EAX] JMP EDX
; выложить на вершину стека данных значение, ; скомпилированное в коде за вызовом (LIT) align _lParDLITrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+CELL] MOV EAX, [EAX] JMP EDX
; вернуть адрес слова, вызов которого скомпилирован в коде вслед за (') align _lParTickrPar: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+TOKEN] MOV EAX, [EAX+1] JMP EDX
; вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину # align _lParSLITrPar: ; ( --> asc # ) LEA EBP, [EBP-8] MOV dword [EBP+CELL], EAX POP EBX LEA EDX, [EBX+CELL] MOV dword [EBP], EDX MOV EAX, [EBX] LEA EDX, [EBX+EAX+TOKEN] JMP EDX
; положить на вершину стека адрес переменной align _lParCREATErPar: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX RET
; положить на вершину стека значение align _lParCONSTANTrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX MOV EAX, [EAX] RET
; проверка числа на 0 align _0Equal: ; ( n --> flag ) SUB EAX, 1 SBB EAX, EAX RET
; сравнить числа na и nb align _To: ; ( na nb --> flag ) CMP EAX, [EBP] SETGE AL AND EAX, 1 DEC EAX LEA EBP, [EBP+CELL] RET
align _UTo: ; ( ua ub --> flag ) CMP EAX, [EBP] SBB EAX, EAX LEA EBP, [EBP+CELL] RET
; сравнить числа na и nb align _Less: ; ( na nb --> flag ) CMP EAX, [EBP] SETLE AL AND EAX, 1 DEC EAX LEA EBP, [EBP+CELL] RET
; выйти из текущего определения align _EXIT: ; ( --> ) LEA ESP, [ESP+CELL] RET
; безусловное ветвление align _BRANCH: ; ( --> ) POP EDX JMP dword [EDX]
; условное ветвление align _QuestionBRANCH: ; ( n --> n ) OR EAX, EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JZ _BRANCH POP EDX LEA EDX, [EDX+CELL] JMP EDX
; условное ветвление align _NQuestionBRANCH: ; ( n --> n ) OR EAX, EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JNZ _BRANCH POP EDX LEA EDX, [EDX+CELL] JMP EDX
; размер буферов TIB и PAD в байтах trialign _TIBSize: CALL _lParCONSTANTrPar dd 0x100
; ( --> # ) trialign _PADSize: CALL _lParCONSTANTrPar dd 0x100
; ( --> #) ; terminal input buffer trialign _TIB: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
; указатель на первый неразобранный символ во входном буфере trialign _ToIN: CALL _lParCREATErPar dd 0
; указатель на последний введенный символ trialign _SizeTIB: CALL _lParCREATErPar dd 0
; Дно стека данных trialign _S0: CALL _lParCREATErPar dd 0
; ( --> addr ) ; Дно стека возвратов trialign _R0: CALL _lParCREATErPar dd 0
; ( --> addr ) ; размеры стеков trialign _DataStackSize: CALL _lParCONSTANTrPar dd 0x1000
trialign _ReturnStackSize: CALL _lParCONSTANTrPar dd 0x1000
; Хранит адрес первой свободной ячейки памяти в пространстве кода и данных trialign _DP: CALL _lParCREATErPar dd 0
; ( --> addr ) ; Хранит адрес первой свободной ячейки памяти в пространстве имен trialign _HDP: CALL _lParCREATErPar dd 0
; ( --> addr ) ; стандартные потоки В\В trialign _STDIN: CALL _lParCREATErPar dd 0
; входной trialign _STDOUT: CALL _lParCREATErPar dd 0
; выходной trialign _STDERR: CALL _lParCREATErPar dd 0
; выходной для ошибок ; флаг необходимости извещения о повторном использовании уже существующего имени определения trialign _WARNING: CALL _lParCREATErPar dd 0
; текущее состоянии системы (интерпретация\компиляция) trialign _STATE: CALL _lParCREATErPar dd 0
; переключение состояния системы align _lStap: ; ( --> ) CALL _lParLITrPar dd 0x0 CALL _STATE CALL _Store RET
align _rStap: ; ( --> ) CALL _lParLITrPar dd 0xFFFFFFFF CALL _STATE CALL _Store RET
trialign _CELL: CALL _lParCONSTANTrPar dd 0x4
; размер ячейки, байт trialign _ADDR: CALL _lParCONSTANTrPar dd 0x4
; размер адресной ссылки, байт ; преобразовать значение количетсва ячеек в количество минимально адресуемых единиц (байт) align _CELLS: ; ( u --> # ) SAR EAX, 2 RET
; вернуть адрес первой свободной ячейки памят в пространстве кода и данных align _HERE: ; ( --> addr ) CALL _DP MOV EAX, [EAX] RET
; вернуть адрес первой свободной ячейки памят в пространстве имен align _HHERE: ; ( haddr --> addr ) CALL _HDP MOV EAX, [EAX] RET
; добавить в конец файла fid содержимое строки Asc # align _WRITEMinusFILE: ; ( asc # fid --> # ) CALL _ToR CALL _ToR CALL _ToR CALL _lParLITrPar dd 0x0 MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _RTo CALL _RTo MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX CALL _RTo LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [WriteFile] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; читать в буфер asc строку длиной не более # символов содержимое файла fid align _READMinusFILE: ; ( asc # fid --> # ) CALL _ToR CALL _ToR CALL _ToR CALL _lParLITrPar dd 0x0 MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _RTo CALL _RTo MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX CALL _RTo LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [ReadFile] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; вывести в текущий STDOUT поток указанную строку align _TYPE: ; ( asc # --> ) CALL _STDOUT MOV EAX, [EAX] CALL _WRITEMinusFILE MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; вывести символ в текущий поток В\В align _EMIT: ; ( char --> ) MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX CALL _lParLITrPar dd 0x1 CALL _TYPE MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; текущая система счисления trialign _BASE: CALL _lParCREATErPar dd 0
; переключения системы счисления align _DECIMAL: ; ( --> ) CALL _lParLITrPar dd 0xA CALL _BASE CALL _Store RET
align _HEX: ; ( --> ) CALL _lParLITrPar dd 0x10 CALL _BASE CALL _Store RET
; буфер для форматного преобразования чисел и строк trialign _PAD: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
; буфер обычно заполняется с конца, поэтому необходим адрес конца буфера PadTop: ; указатель на последний символ в PAD trialign _HLD: CALL _lParCREATErPar dd 0
; начать форматное преобразование строки align _LessSize: ; ( --> )
CALL _lParLITrPar dd PadTop CALL _HLD CALL _Store RET
; задать текущую систему счисления и начать форматное преобразование строки align _lBrSize: ; ( base --> ) CALL _BASE CALL _Store CALL _LessSize RET
; завершить форматное преобразование строки, вернуть адрес asc и длину # полученной строки align _SizerBr: ; ( --> asc # ) CALL _HLD MOV EAX, [EAX] CALL _PAD CALL _PADSize CALL _Plus MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX CALL _Minus RET
; то же, что и #}, только предварительно удаляет число двойной длины с вершины стека данных align _SizeTo: ; ( d --> asc # ) LEA EBP, [EBP+CELL] MOV EAX, [EBP] LEA EBP, [EBP+CELL] CALL _SizerBr RET
; добавляет символ char в позицию HLD, сам HLD уменьшает на размер одного символа align _HOLD: ; ( char --> ) CALL _lParLITrPar dd 0xFFFFFFFF CALL _HLD CALL _PlusStoreFetch CALL _BStore RET
; -1 HLD @ + PAD UMAX DUP HLD ! B! ; преобразовать число в символ ; число не должно превышать значение находящееся в BASE align _ToDIGIT: ; ( u --> char ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _lParLITrPar dd 0x9 CALL _To CALL _QuestionBRANCH dd lab_0001 CALL _lParLITrPar dd 0x7 CALL _Plus lab_0001: CALL _lParLITrPar dd 0x30 CALL _Plus RET
; добавить в буфер PAD остаток от деления двойного числа на содержимое BASE align _Size: ; ( ud1 --> ud2 ) CALL _lParLITrPar dd 0x0 CALL _BASE MOV EAX, [EAX] MOV ECX, EAX MOV EDX, [EBP] MOV EAX, [EBP+CELL] DIV ECX LEA EBP, [EBP+CELL] MOV dword [EBP], EDX CALL _ToR CALL _BASE MOV EAX, [EAX] MOV ECX, EAX MOV EDX, [EBP] MOV EAX, [EBP+CELL] DIV ECX LEA EBP, [EBP+CELL] MOV dword [EBP], EDX CALL _RTo MOV EDX, [EBP] MOV [EBP], EAX MOV EAX, [EBP+CELL] MOV dword [EBP+CELL], EDX CALL _ToDIGIT CALL _HOLD RET
; Если n отрицательно, добавить в PAD символ '-' align _SIGN: ; ( n --> ) CALL _lParLITrPar dd 0x0 CALL _Less CALL _QuestionBRANCH dd lab_0002 CALL _lParLITrPar dd 0x2D CALL _HOLD lab_0002: RET
; преобразовать число двойной длинны в строку align _SizeS: ; ( ud --> 0 0 ) lab_0003: ; метка для перехода назад CALL _Size MOV EDX, [EBP] MOV [EBP-CELL], EAX MOV [EBP-CELL*2], EDX LEA EBP, [EBP-CELL*2] OR EAX, [EBP] LEA EBP, [EBP+CELL] CALL _QuestionBRANCH dd lab_0004 JMP lab_0003 ; переход назад lab_0004: RET
; константы значения спецсимволов trialign _Bl_: CALL _lParCONSTANTrPar dd 0x20
trialign _Cr_: CALL _lParCONSTANTrPar dd 0xA
trialign _Lf_: CALL _lParCONSTANTrPar dd 0xD
; преобразовать число одинарной длинны в строку ; в десятичной системе независимо от значения BASE align _lParPeroidrPar: ; ( n --> asc # ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _ToR MOV EDX, EAX SAR EDX, 31 ADD EAX, EDX XOR EAX, EDX CDQ LEA EBP, [EBP-CELL] MOV [EBP], EAX MOV EAX, EDX CALL _LessSize CALL _SizeS CALL _RTo CALL _SIGN CALL _SizeTo RET
; вывести число в текущей системе счисления в выходной поток align _Peroid: ; ( n --> ) CALL _lParPeroidrPar CALL _TYPE RET
; перевод строки align _CR: ; ( --> ) CALL _lParSLITrPar dd 0x2 db 0xD,0xA,0x00 CALL _TYPE RET
; текущая глубина стека данных align _DEPTH: ; ( --> n ) MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX CALL _S0 MOV EAX, [EAX] MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX CALL _Minus CALL _CELL MOV ECX, EAX MOV EAX, [EBP] CDQ IDIV ECX LEA EBP, [EBP+CELL] RET
; приглашение align _PROMPT: ; ( --> ) CALL _DEPTH CALL _Peroid CALL _STATE MOV EAX, [EAX] CALL _QuestionBRANCH dd lab_0005 CALL _lParSLITrPar dd 0x1 db 0x5D,0x00 CALL _BRANCH dd lab_0006 lab_0005: CALL _lParSLITrPar dd 0x1 db 0x5B,0x00 lab_0006: CALL _TYPE RET
; получить очередную строку из STDIN в буфер TIB align _QUERY: ; ( --> ) CALL _TIB CALL _TIBSize CALL _STDIN MOV EAX, [EAX] CALL _READMinusFILE CALL _SizeTIB CALL _Store CALL _lParLITrPar dd 0x0 CALL _ToIN CALL _Store RET
; -- парсер -------------------------------------------------------------------- ; является ли символ char пробельным align _nQuestionsep: ; ( char --> flag ) CALL _Bl_ CALL _To RET
; адрес первого неразобранного символа align _CharAddr: ; ( --> addr ) CALL _TIB CALL _ToIN MOV EAX, [EAX] CALL _Plus RET
; прочесть символ из текущего значения >IN align _PeekChar: ; ( --> char ) CALL _CharAddr MOVZX EAX, byte [EAX] RET
; пропустить один символ во входном потоке align _SkipChar: ; ( --> ) CALL _ToIN MOV EAX, [EAX] CALL _lParLITrPar dd 0x1 CALL _Plus CALL _SizeTIB MOV EAX, [EAX] CALL _MIN CALL _ToIN CALL _Store RET
; вернуть TRUE если весь текст уже разобран align _QuestionCOMPLETE: ; ( --> flag ) CALL _SizeTIB MOV EAX, [EAX] CALL _ToIN MOV EAX, [EAX] CALL _Less RET
; взять очередной символ из входного потока ; flag = TRUE если входной поток исчерпан align _NextChar: ; ( --> char flag ) CALL _PeekChar CALL _QuestionCOMPLETE CALL _SkipChar RET
; пропустить все символы разделители до первого значащего символа, ; либо до конца разбираемой строки align _MissSeparators: ; ( --> ) INT3 lab_0007: ; метка для перехода назад CALL _NextChar CALL _NQuestionBRANCH dd lab_0008 CALL _nQuestionsep CALL _NQuestionBRANCH dd lab_0009 JMP lab_0007 ; переход назад lab_0009: CALL _EXIT lab_0008: MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; пропустить текст вплодь до разделителя align _MissLexeme: ; ( --> ) INT3 lab_000A: ; метка для перехода назад CALL _NextChar CALL _NQuestionBRANCH dd lab_000B CALL _nQuestionsep CALL _QuestionBRANCH dd lab_000C JMP lab_000A ; переход назад lab_000C: CALL _EXIT lab_000B: MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; выделить из буфера блок символов вплоть до разделителя align _PassLexeme: ; ( --> asc # ) CALL _CharAddr CALL _MissLexeme CALL _CharAddr MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX CALL _Minus RET
; Получить адрес и длину очередной лексемы align _NextWord: ; ( --> asc # ) CALL _MissSeparators CALL _PassLexeme RET
trialign _WORDLISTS: CALL _lParCONSTANTrPar dd 0x10
; количество словарей в системе ; текущий словарь ( в который ведется добавление имен) trialign _CURRENT: CALL _lParCREATErPar dd 0
; стек словарей для поиска trialign _CONTEXT: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
CNSP: ; вершина списка словарей ; сделать верхний текущий словарь контекстным align _DEFINITIONS: ; ( --> ) CALL _CONTEXT MOV EAX, [EAX] CALL _CURRENT CALL _Store RET
; !!! написать нормально ; идентификатор словаря FORTH align _FORTHMinusWORDLIST: ; ( --> wid ) CALL _lParLITrPar dd 0x1 RET
; !!! написать нормально ; инициализация контекста align _ONLY: ; ( --> ) CALL _FORTHMinusWORDLIST CALL _CONTEXT CALL _Store RET
; !!! написать нормально ; выполнить действие над очередной лексемой align _EVALMinusTOKEN: ; ( asc # --> ) CALL _CR CALL _TYPE RET
; интерпретировать входной поток ; : INTERPRET ( --> ) BEGIN NextWord DUP WHILE EVAL-TOKEN REPEAT DDROP ; align _INTERPRET: ; ( --> ) CALL _TIB CALL _SizeTIB MOV EAX, [EAX] CALL _TYPE CALL _CR RET
; проверка протекания стека данных align _QuestionSTACK: ; ( --> ) MOV EDX, EAX MOV EAX, EBP LEA EBP, [EBP-CELL] MOV dword [EBP], EDX CALL _S0 MOV EAX, [EAX] CMP EAX, [EBP] SBB EAX, EAX LEA EBP, [EBP+CELL] CALL _QuestionBRANCH dd lab_000D CALL _lParSLITrPar dd 0x1A db 0x88,0xE1,0xE7,0xA5,0xE0,0xAF,0xA0,0xAD,0xA8,0xA5,0x20 db 0xE1,0xE2,0xA5,0xAA,0xA0,0x20,0xA4,0xA0,0xAD,0xAD,0xEB,0xE5,0x21,0xD,0xA,0x00 CALL _TYPE CALL _S0 MOV EAX, [EAX] CALL _SPStore lab_000D: RET
; основной цикл системы align _QUIT: ; ( --> ) CALL _lStap CALL _DECIMAL CALL _CR lab_000E: ; метка для перехода назад CALL _PROMPT CALL _QUERY CALL _INTERPRET CALL _QuestionSTACK JMP lab_000E ; переход назад RET
; инициализация системы после ошибки align _ABORT: ; ( --> ) CALL _S0 MOV EAX, [EAX] CALL _SPStore CALL _R0 MOV EAX, [EAX] CALL _RPStore CALL _ONLY CALL _DEFINITIONS CALL _QUIT RET
; инициализация идентификаторов потоков В/В align _INITMinusIO: ; ( --> ) CALL _lParLITrPar dd 0xFFFFFFF6 LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [GetStdHandle] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] CALL _STDIN CALL _Store CALL _lParLITrPar dd 0xFFFFFFF5 LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [GetStdHandle] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] CALL _STDOUT CALL _Store CALL _lParLITrPar dd 0xFFFFFFF4 LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, dword [GetStdHandle] MOV dword [fs:0x14], ESP MOV ESP, EBP CALL EAX MOV EBP, ESP MOV ESP, dword [fs:0x14] LEA EBP, [EBP+CELL] CALL _STDERR CALL _Store RET
; приветствие после запуска системы align _TITLE: ; ( --> ) CALL _lParSLITrPar dd 0xA db 0xD,0xA,0x48,0x65,0x6C,0x6C,0x6F,0x21,0xD,0xA,0x00 CALL _TYPE RET
; сделать вектором! align _MAIN: ; ( --> ) CALL _TITLE RET
; холодный запуск системы align _COLD: ; ( --> ) LEA EBP, [EBP-256] ; для начала раздвигаются указатели стеков CALL _RPFetch LEA EBP, [EBP-CELL] MOV dword [EBP], EAX CALL _R0 CALL _Store ; стек возвратов под стеком данных используется для хранения ; только внутренних вызовов, т.к. АПИ очень сильно жрет стек CALL _ReturnStackSize CALL _Minus CALL _S0 CALL _Store CALL _INITMinusIO CALL _DECIMAL CALL _MAIN CALL _ABORT RET
; последнее определение системы trialign _FENCE: CALL _lParCREATErPar ; ( --> )
entry _COLD ; точка входа
section '.names' data readable writeable ; makevoc FORTH
; Имя, Метка, Флаг immediate def 'FENCE', _FENCE, 1 def 'COLD', _COLD, 1 def 'MAIN', _MAIN, 1 def 'TITLE', _TITLE, 1 def 'INIT-IO', _INITMinusIO, 1 def 'ABORT', _ABORT, 1 def 'QUIT', _QUIT, 1 def '?STACK', _QuestionSTACK, 1 def 'INTERPRET', _INTERPRET, 1 def 'EVAL-TOKEN', _EVALMinusTOKEN, 1 def 'ONLY', _ONLY, 1 def 'FORTH-WORDLIST', _FORTHMinusWORDLIST, 1 def 'DEFINITIONS', _DEFINITIONS, 1 def 'CONTEXT', _CONTEXT, 1 def 'CURRENT', _CURRENT, 1 def 'WORDLISTS', _WORDLISTS, 1 def 'NextWord', _NextWord, 1 def 'PassLexeme', _PassLexeme, 1 def 'MissLexeme', _MissLexeme, 1 def 'MissSeparators', _MissSeparators, 1 def 'NextChar', _NextChar, 1 def '?COMPLETE', _QuestionCOMPLETE, 1 def 'SkipChar', _SkipChar, 1 def 'PeekChar', _PeekChar, 1 def 'CharAddr', _CharAddr, 1 def 'n?sep', _nQuestionsep, 1 def 'QUERY', _QUERY, 1 def 'PROMPT', _PROMPT, 1 def 'DEPTH', _DEPTH, 1 def 'CR', _CR, 1 def '.', _Peroid, 1 def '(.)', _lParPeroidrPar, 1 def 'Lf_', _Lf_, 1 def 'Cr_', _Cr_, 1 def 'Bl_', _Bl_, 1 def '#S', _SizeS, 1 def 'SIGN', _SIGN, 1 def '#', _Size, 1 def '>DIGIT', _ToDIGIT, 1 def 'HOLD', _HOLD, 1 def '#>', _SizeTo, 1 def '#}', _SizerBr, 1 def '{#', _lBrSize, 1 def '<#', _LessSize, 1 def 'HLD', _HLD, 1 def 'PAD', _PAD, 1 def 'HEX', _HEX, 1 def 'DECIMAL', _DECIMAL, 1 def 'BASE', _BASE, 1 def 'EMIT', _EMIT, 1 def 'TYPE', _TYPE, 1 def 'READ-FILE', _READMinusFILE, 1 def 'WRITE-FILE', _WRITEMinusFILE, 1 def 'HHERE', _HHERE, 1 def 'HERE', _HERE, 1 def 'CELLS', _CELLS, 1 def 'ADDR', _ADDR, 1 def 'CELL', _CELL, 1 def ']', _rStap, 1 def '[', _lStap, -1 def 'STATE', _STATE, 1 def 'WARNING', _WARNING, 1 def 'STDERR', _STDERR, 1 def 'STDOUT', _STDOUT, 1 def 'STDIN', _STDIN, 1 def 'HDP', _HDP, 1 def 'DP', _DP, 1 def 'ReturnStack#', _ReturnStackSize, 1 def 'DataStack#', _DataStackSize, 1 def 'R0', _R0, 1 def 'S0', _S0, 1 def '#TIB', _SizeTIB, 1 def '>IN', _ToIN, 1 def 'TIB', _TIB, 1 def 'PAD#', _PADSize, 1 def 'TIB#', _TIBSize, 1 def 'N?BRANCH', _NQuestionBRANCH, 1 def '?BRANCH', _QuestionBRANCH, 1 def 'BRANCH', _BRANCH, 1 def 'EXIT', _EXIT, 1 def '<', _Less, 1 def 'U>', _UTo, 1 def '>', _To, 1 def '0=', _0Equal, 1 def '(CONSTANT)', _lParCONSTANTrPar, 1 def '(CREATE)', _lParCREATErPar, 1 def '(SLIT)', _lParSLITrPar, 1 def '(`)', _lParTickrPar, 1 def '(DLIT)', _lParDLITrPar, 1 def '(LIT)', _lParLITrPar, 1 def 'R>', _RTo, 1 def '>R', _ToR, 1 def 'RP@', _RPFetch, 1 def 'RP!', _RPStore, 1 def 'SP@', _SPFetch, 1 def 'SP!', _SPStore, 1 def '+!@', _PlusStoreFetch, 1 def 'MIN', _MIN, 1 def 'ABS', _ABS, 1 def 'S>D', _SToD, 1 def 'UM/MOD', _UMSlashMOD, 1 def 'OR', _OR, 1 def '/', _Slash, 1 def '-', _Minus, 1 def '+', _Plus, 1 def 'B!', _BStore, 1 def 'B@', _BFetch, 1 def '!', _Store, 1 def '@', _Fetch, 1 def 'ROT', _ROT, 1 def 'OVER', _OVER, 1 def 'SWAP', _SWAP, 1 def 'DDUP', _DDUP, 1 def 'DUP', _DUP, 1 def 'DDROP', _DDROP, 1 def 'DROP', _DROP, 1 def 'NIP', _NIP, 1 def 'NOOP', _NOOP, 1 LATEST: ; чтобы получить хвост цепочки имен NSADDR: allot NamesSpace-($-$$) ;
section '.edata' export data readable export 'FORTH',\ _FENCE,'FENCE',\ _COLD,'COLD',\ _MAIN,'MAIN',\ _TITLE,'TITLE',\ _INITMinusIO,'INIT-IO',\ _ABORT,'ABORT',\ _QUIT,'QUIT',\ _QuestionSTACK,'?STACK',\ _INTERPRET,'INTERPRET',\ _EVALMinusTOKEN,'EVAL-TOKEN',\ _ONLY,'ONLY',\ _FORTHMinusWORDLIST,'FORTH-WORDLIST',\ _DEFINITIONS,'DEFINITIONS',\ _CONTEXT,'CONTEXT',\ _CURRENT,'CURRENT',\ _WORDLISTS,'WORDLISTS',\ _NextWord,'NextWord',\ _PassLexeme,'PassLexeme',\ _MissLexeme,'MissLexeme',\ _MissSeparators,'MissSeparators',\ _NextChar,'NextChar',\ _QuestionCOMPLETE,'?COMPLETE',\ _SkipChar,'SkipChar',\ _PeekChar,'PeekChar',\ _CharAddr,'CharAddr',\ _nQuestionsep,'n?sep',\ _QUERY,'QUERY',\ _PROMPT,'PROMPT',\ _DEPTH,'DEPTH',\ _CR,'CR',\ _Peroid,'.',\ _lParPeroidrPar,'(.)',\ _Lf_,'Lf_',\ _Cr_,'Cr_',\ _Bl_,'Bl_',\ _SizeS,'#S',\ _SIGN,'SIGN',\ _Size,'#',\ _ToDIGIT,'>DIGIT',\ _HOLD,'HOLD',\ _SizeTo,'#>',\ _SizerBr,'#}',\ _lBrSize,'{#',\ _LessSize,'<#',\ _HLD,'HLD',\ _PAD,'PAD',\ _HEX,'HEX',\ _DECIMAL,'DECIMAL',\ _BASE,'BASE',\ _EMIT,'EMIT',\ _TYPE,'TYPE',\ _READMinusFILE,'READ-FILE',\ _WRITEMinusFILE,'WRITE-FILE',\ _HHERE,'HHERE',\ _HERE,'HERE',\ _CELLS,'CELLS',\ _ADDR,'ADDR',\ _CELL,'CELL',\ _rStap,']',\ _lStap,'[',\ _STATE,'STATE',\ _WARNING,'WARNING',\ _STDERR,'STDERR',\ _STDOUT,'STDOUT',\ _STDIN,'STDIN',\ _HDP,'HDP',\ _DP,'DP',\ _ReturnStackSize,'ReturnStack#',\ _DataStackSize,'DataStack#',\ _R0,'R0',\ _S0,'S0',\ _SizeTIB,'#TIB',\ _ToIN,'>IN',\ _TIB,'TIB',\ _PADSize,'PAD#',\ _TIBSize,'TIB#',\ _NQuestionBRANCH,'N?BRANCH',\ _QuestionBRANCH,'?BRANCH',\ _BRANCH,'BRANCH',\ _EXIT,'EXIT',\ _Less,'<',\ _UTo,'U>',\ _To,'>',\ _0Equal,'0=',\ _lParCONSTANTrPar,'(CONSTANT)',\ _lParCREATErPar,'(CREATE)',\ _lParSLITrPar,'(SLIT)',\ _lParTickrPar,'(`)',\ _lParDLITrPar,'(DLIT)',\ _lParLITrPar,'(LIT)',\ _RTo,'R>',\ _ToR,'>R',\ _RPFetch,'RP@',\ _RPStore,'RP!',\ _SPFetch,'SP@',\ _SPStore,'SP!',\ _PlusStoreFetch,'+!@',\ _MIN,'MIN',\ _ABS,'ABS',\ _SToD,'S>D',\ _UMSlashMOD,'UM/MOD',\ _OR,'OR',\ _Slash,'/',\ _Minus,'-',\ _Plus,'+',\ _BStore,'B!',\ _BFetch,'B@',\ _Store,'!',\ _Fetch,'@',\ _ROT,'ROT',\ _OVER,'OVER',\ _SWAP,'SWAP',\ _DDUP,'DDUP',\ _DUP,'DUP',\ _DDROP,'DDROP',\ _DROP,'DROP',\ _NIP,'NIP',\ _NOOP,'NOOP' [/code]
Пока что просто ожидает ввода строки, затем выводит ее на экран, собственно, для иллюстрации работы транслятора достаточно 8)
|
|
|
|
Добавлено: Вт янв 20, 2015 20:00 |
|
|
|
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
\ пример транслируемого текста TRANSLATE: zzz
\ первое определение : NOOP ( --> ) ;
\ удалить элемент под вершиной стека : NIP ( a b --> b ) NIP ;
\ удалить значение с вершины стека данных : DROP ( n --> ) DROP ;
\ удалить d с вершины стека данных : DDROP ( d --> ) DDROP ;
\ дублировать значение n на вершине стека данных : DUP ( n --> n n ) DUP ;
\ дублировать значение d на вершине стека данных : DDUP ( d --> d d ) DDUP ;
\ обменять значения двух ячеек на вершине стека данных : SWAP ( a b --> b a ) SWAP ;
\ положить на вершину стека данных копию значения второго элемента : OVER ( a b --> a b a ) OVER ;
\ Прокрутить три верхних элемента стека. : ROT ( a b c --> b c a ) ROT ;
\ извлечь значение с указанного адреса : @ ( addr --> n ) @ ;
\ сохранить значение n по указанному адресу : ! ( n addr --> ) STORE SKP ;
\ извлечь значение байта b по указанному адресу addr : B@ ( addr --> b ) B@ ;
\ сохранить значение байта b по указанному адресу addr : B! ( b addr --> ) STOREB SKP ;
\ сложить два числа на вершине стека данных, результат оставить на вершине : + ( n1 n2 --> n ) PLUS NIP ;
\ сложить два числа на вершине стека данных, результат оставить на вершине : - ( n1 n2 --> n ) MINUS NIP ;
\ знаковое деление чисел одинарной длины : / ( na nb --> n ) / ;
\ логическое или над двумя операндами на вершине стека даных : OR ( na nb --> n ) OR ;
\ поделить беззнаковое число двойной точности \ на беззнаковое число одинарной точности \ результат - частное и остаток от деления : UM/MOD ( ud u1 --> div mod ) UM/MOD ;
\ Преобразовать число n в двойное число d с тем же числовым значением. : S>D ( n --> d ) S>D ;
\ найти абсолютное значение числа : ABS ( n --> u ) ABS ;
\ оставить минимальное n из двух чисел na, nb на вершине стека данных : MIN ( na nb --> n ) MIN_ ;
\ увеличить значение, хранящееся по addr на n, \ результат сохранить по addr и оставить на вершине стека данных : +!@ ( n addr --> x+n ) PSFA NIP ;
\ переместить указатель вершины стека данных на указанный адрес \ в TOS остается значение : SP! ( addr --> ) TOSP ;
\ вернуть адрес вершины стека данных : SP@ ( --> addr ) SP@ ;
\ переместить указатель вершины стека возвратов на указанный адрес : RP! ( addr --> ) TORP ;-
\ вернуть адрес вершины стека возвратов : RP@ ( --> addr ) DUP ATRP ;
\ перенести значение с вершины стека данных на вершину стека возвратов : >R ( addr --> r: addr ) TOR ;
\ перенести значение с вершины стека возвратов на вершину стека данных : R> ( r: addr --> addr ) DUP FROMR ;
\ выложить на вершину стека данных значение, \ скомпилированное в коде за вызовом (LIT) : (LIT) ( --> n ) DUP RVAR GETLIT ;-
\ выложить на вершину стека данных значение, \ скомпилированное в коде за вызовом (LIT) : (DLIT) ( --> n ) DUP DUP RVAR GETLIT ;-
\ вернуть адрес слова, вызов которого скомпилирован в коде вслед за (') : (`) ( --> addr ) DUP RVAR GETALIT ;-
\ вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину # : (SLIT) ( --> asc # ) (SLIT) ;-
\ положить на вершину стека адрес переменной : (CREATE) ( --> addr ) DUP RVAR ;
\ положить на вершину стека значение : (CONSTANT) ( --> n ) DUP RVAR @ ;
\ проверка числа на 0 : 0= ( n --> flag ) 0= ;
\ сравнить числа na и nb : > ( na nb --> flag ) more NIP ; : U> ( ua ub --> flag ) U> ;
\ сравнить числа na и nb : < ( na nb --> flag ) less NIP ;
\ выйти из текущего определения : EXIT ( --> ) EXIT_ ;
\ безусловное ветвление : BRANCH ( --> ) BR ;-
\ условное ветвление : ?BRANCH ( n --> n ) ?BR ;-
\ условное ветвление : N?BRANCH ( n --> n ) N?BR ;-
\ размер буферов TIB и PAD в байтах 0x100 CONSTANT TIB# ( --> # ) 0x100 CONSTANT PAD# ( --> #)
\ terminal input buffer CREATE TIB TIB# ALLOT
\ указатель на первый неразобранный символ во входном буфере VARIABLE >IN
\ указатель на последний введенный символ VARIABLE #TIB
\ Дно стека данных VARIABLE S0 ( --> addr )
\ Дно стека возвратов VARIABLE R0 ( --> addr )
\ размеры стеков 0x1000 CONSTANT DataStack# 0x1000 CONSTANT ReturnStack#
\ Хранит адрес первой свободной ячейки памяти в пространстве кода и данных VARIABLE DP ( --> addr )
\ Хранит адрес первой свободной ячейки памяти в пространстве имен VARIABLE HDP ( --> addr )
\ стандартные потоки В\В VARIABLE STDIN \ входной VARIABLE STDOUT \ выходной VARIABLE STDERR \ выходной для ошибок
\ флаг необходимости извещения о повторном использовании уже существующего имени определения VARIABLE WARNING
\ текущее состоянии системы (интерпретация\компиляция) VARIABLE STATE
\ переключение состояния системы : [ ( --> ) 0 STATE ! ; IMMEDIATE : ] ( --> ) -1 STATE ! ;
4 CONSTANT CELL \ размер ячейки, байт 4 CONSTANT ADDR \ размер адресной ссылки, байт
\ преобразовать значение количетсва ячеек в количество минимально адресуемых единиц (байт) : CELLS ( u --> # ) CELLS ;
\ вернуть адрес первой свободной ячейки памят в пространстве кода и данных : HERE ( --> addr ) DP @ ;
\ вернуть адрес первой свободной ячейки памят в пространстве имен : HHERE ( haddr --> addr ) HDP @ ;
\ добавить в конец файла fid содержимое строки Asc # : WRITE-FILE ( asc # fid --> # ) >R >R >R 0 SP@ DUP R> R> SWAP R> DUP 'WriteFile CallAPI DROP ;
\ читать в буфер asc строку длиной не более # символов содержимое файла fid : READ-FILE ( asc # fid --> # ) >R >R >R 0 SP@ DUP R> R> SWAP R> DUP 'ReadFile CallAPI DROP ;
\ вывести в текущий STDOUT поток указанную строку : TYPE ( asc # --> ) STDOUT @ WRITE-FILE DROP ;
\ вывести символ в текущий поток В\В : EMIT ( char --> ) SP@ 1 TYPE DROP ;
\ текущая система счисления VARIABLE BASE
\ переключения системы счисления : DECIMAL ( --> ) 0x0A BASE ! ; : HEX ( --> ) 0x10 BASE ! ;
\ буфер для форматного преобразования чисел и строк CREATE PAD PAD# ALLOT \ буфер обычно заполняется с конца, поэтому необходим адрес конца буфера LABEL: PadTop
\ указатель на последний символ в PAD VARIABLE HLD
\ начать форматное преобразование строки : <# ( --> ) PadTop HLD ! ;
\ задать текущую систему счисления и начать форматное преобразование строки : {# ( base --> ) BASE ! <# ;
\ завершить форматное преобразование строки, вернуть адрес asc и длину # полученной строки : #} ( --> asc # ) HLD @ PAD PAD# + OVER - ;
\ то же, что и #}, только предварительно удаляет число двойной длины с вершины стека данных : #> ( d --> asc # ) NIP DROP #} ;
\ добавляет символ char в позицию HLD, сам HLD уменьшает на размер одного символа : HOLD ( char --> ) -1 HLD +!@ B! ; \ -1 HLD @ + PAD UMAX DUP HLD ! B!
\ преобразовать число в символ \ число не должно превышать значение находящееся в BASE : >DIGIT ( u --> char ) DUP 9 > IF 7 + THEN 0x30 + ;
\ добавить в буфер PAD остаток от деления двойного числа на содержимое BASE : # ( ud1 --> ud2 ) 0 BASE @ UM/MOD >R BASE @ UM/MOD R> ROT >DIGIT HOLD ;
\ Если n отрицательно, добавить в PAD символ '-' : SIGN ( n --> ) 0 < IF [CHAR] - HOLD THEN ;
\ преобразовать число двойной длинны в строку : #S ( ud --> 0 0 ) BEGIN # DDUP OR WHILE REPEAT ;
\ константы значения спецсимволов 0x20 CONSTANT Bl_ 0x0A CONSTANT Cr_ 0x0D CONSTANT Lf_
\ преобразовать число одинарной длинны в строку \ в десятичной системе независимо от значения BASE : (.) ( n --> asc # ) DUP >R ABS S>D <# #S R> SIGN #> ;
\ вывести число в текущей системе счисления в выходной поток : . ( n --> ) (.) TYPE ;
\ перевод строки : CR ( --> ) S" \n\r" TYPE ;
\ текущая глубина стека данных : DEPTH ( --> n ) SP@ S0 @ SWAP - CELL / ;
\ приглашение : PROMPT ( --> ) DEPTH . STATE @ IF S" ]" ELSE S" [" THEN TYPE ;
\ получить очередную строку из STDIN в буфер TIB : QUERY ( --> ) TIB TIB# STDIN @ READ-FILE #TIB ! 0 >IN ! ;
\ -- парсер --------------------------------------------------------------------
\ является ли символ char пробельным : n?sep ( char --> flag ) Bl_ > ;
\ адрес первого неразобранного символа : CharAddr ( --> addr ) TIB >IN @ + ;
\ прочесть символ из текущего значения >IN : PeekChar ( --> char ) CharAddr B@ ;
\ пропустить один символ во входном потоке : SkipChar ( --> ) >IN @ 1 + #TIB @ MIN >IN ! ;
\ вернуть TRUE если весь текст уже разобран : ?COMPLETE ( --> flag ) #TIB @ >IN @ < ;
\ взять очередной символ из входного потока \ flag = TRUE если входной поток исчерпан : NextChar ( --> char flag ) PeekChar ?COMPLETE SkipChar ;
\ пропустить все символы разделители до первого значащего символа, \ либо до конца разбираемой строки : MissSeparators ( --> ) INT3 BEGIN NextChar WHILENOT n?sep WHILENOT REPEAT EXIT THEN DROP ;
\ пропустить текст вплодь до разделителя : MissLexeme ( --> ) INT3 BEGIN NextChar WHILENOT n?sep WHILE REPEAT EXIT THEN DROP ;
\ выделить из буфера блок символов вплоть до разделителя : PassLexeme ( --> asc # ) CharAddr MissLexeme CharAddr OVER - ;
\ Получить адрес и длину очередной лексемы : NextWord ( --> asc # ) MissSeparators PassLexeme ;
16 CONSTANT WORDLISTS \ количество словарей в системе
\ текущий словарь ( в который ведется добавление имен) VARIABLE CURRENT \ стек словарей для поиска CREATE CONTEXT WORDLISTS CELLS ALLOT LABEL: CNSP \ вершина списка словарей
\ сделать верхний текущий словарь контекстным : DEFINITIONS ( --> ) CONTEXT @ CURRENT ! ; \ !!! написать нормально
\ идентификатор словаря FORTH : FORTH-WORDLIST ( --> wid ) 1 ; \ !!! написать нормально
\ инициализация контекста : ONLY ( --> ) FORTH-WORDLIST CONTEXT ! ; \ !!! написать нормально
\ выполнить действие над очередной лексемой : EVAL-TOKEN ( asc # --> ) CR TYPE ;
\ интерпретировать входной поток \ : INTERPRET ( --> ) BEGIN NextWord DUP WHILE EVAL-TOKEN REPEAT DDROP ; : INTERPRET ( --> ) TIB #TIB @ TYPE CR ;
\ проверка протекания стека данных : ?STACK ( --> ) SP@ S0 @ U> IF S" Исчерпание стека данных!\n\r" TYPE S0 @ SP! THEN ;
\ основной цикл системы : QUIT ( --> ) [COMPILE] [ DECIMAL CR BEGIN PROMPT QUERY INTERPRET ?STACK AGAIN ;
\ инициализация системы после ошибки : ABORT ( --> ) S0 @ SP! R0 @ RP! ONLY DEFINITIONS QUIT ;
\ инициализация идентификаторов потоков В/В : INIT-IO ( --> ) -10 DUP 'GetStdHandle CallAPI STDIN ! -11 DUP 'GetStdHandle CallAPI STDOUT ! -12 DUP 'GetStdHandle CallAPI STDERR ! ;
\ приветствие после запуска системы : TITLE ( --> ) S" \n\rHello!\n\r" TYPE ;
\ сделать вектором! : MAIN ( --> ) TITLE ;
\ холодный запуск системы : COLD ( --> ) STARTUP \ для начала раздвигаются указатели стеков RP@ DUP R0 ! \ стек возвратов под стеком данных используется для хранения \ только внутренних вызовов, т.к. АПИ очень сильно жрет стек ReturnStack# - S0 ! INIT-IO DECIMAL MAIN ABORT ;
\ последнее определение системы CREATE FENCE ( --> )
;TRANSLATE
[color=#808080]\ пример транслируемого текста[/color] [color=#FF8000]TRANSLATE: zzz[/color]
[color=#808080]\ первое определение[/color] [color=#FF8000]: NOOP[/color] [color=#0080C0]( --> )[/color] [color=#FF8000];[/color]
[color=#808080]\ удалить элемент под вершиной стека[/color] [color=#FF8000]: NIP[/color] [color=#0080C0]( a b --> b )[/color] NIP [color=#FF8000];[/color]
[color=#808080]\ удалить значение с вершины стека данных[/color] [color=#FF8000]: DROP[/color] [color=#0080C0]( n --> )[/color] DROP [color=#FF8000];[/color]
[color=#808080]\ удалить d с вершины стека данных[/color] [color=#FF8000]: DDROP[/color] [color=#0080C0]( d --> )[/color] DDROP [color=#FF8000];[/color]
[color=#808080]\ дублировать значение n на вершине стека данных[/color] [color=#FF8000]: DUP[/color] [color=#0080C0]( n --> n n )[/color] DUP [color=#FF8000];[/color]
[color=#808080]\ дублировать значение d на вершине стека данных[/color] [color=#FF8000]: DDUP[/color] [color=#0080C0]( d --> d d )[/color] DDUP [color=#FF8000];[/color]
[color=#808080]\ обменять значения двух ячеек на вершине стека данных[/color] [color=#FF8000]: SWAP[/color] [color=#0080C0]( a b --> b a )[/color] SWAP [color=#FF8000];[/color]
[color=#808080]\ положить на вершину стека данных копию значения второго элемента[/color] [color=#FF8000]: OVER[/color] [color=#0080C0]( a b --> a b a )[/color] OVER [color=#FF8000];[/color]
[color=#808080]\ Прокрутить три верхних элемента стека.[/color] [color=#FF8000]: ROT[/color] [color=#0080C0]( a b c --> b c a )[/color] ROT [color=#FF8000];[/color]
[color=#808080]\ извлечь значение с указанного адреса[/color] [color=#FF8000]: @[/color] [color=#0080C0]( addr --> n )[/color] @ [color=#FF8000];[/color]
[color=#808080]\ сохранить значение n по указанному адресу[/color] [color=#FF8000]: ![/color] [color=#0080C0]( n addr --> )[/color] STORE SKP [color=#FF8000];[/color]
[color=#808080]\ извлечь значение байта b по указанному адресу addr[/color] [color=#FF8000]: B@[/color] [color=#0080C0]( addr --> b )[/color] B@ [color=#FF8000];[/color]
[color=#808080]\ сохранить значение байта b по указанному адресу addr[/color] [color=#FF8000]: B![/color] [color=#0080C0]( b addr --> )[/color] STOREB SKP [color=#FF8000];[/color]
[color=#808080]\ сложить два числа на вершине стека данных, результат оставить на вершине[/color] [color=#FF8000]: +[/color] [color=#0080C0]( n1 n2 --> n )[/color] PLUS NIP [color=#FF8000];[/color]
[color=#808080]\ сложить два числа на вершине стека данных, результат оставить на вершине[/color] [color=#FF8000]: -[/color] [color=#0080C0]( n1 n2 --> n )[/color] MINUS NIP [color=#FF8000];[/color]
[color=#808080]\ знаковое деление чисел одинарной длины[/color] [color=#FF8000]: /[/color] [color=#0080C0]( na nb --> n )[/color] / [color=#FF8000];[/color]
[color=#808080]\ логическое или над двумя операндами на вершине стека даных[/color] [color=#FF8000]: OR[/color] [color=#0080C0]( na nb --> n )[/color] OR [color=#FF8000];[/color]
[color=#808080]\ поделить беззнаковое число двойной точности[/color] [color=#808080]\ на беззнаковое число одинарной точности[/color] [color=#808080]\ результат - частное и остаток от деления[/color] [color=#FF8000]: UM/MOD[/color] [color=#0080C0]( ud u1 --> div mod )[/color] UM/MOD [color=#FF8000];[/color]
[color=#808080]\ Преобразовать число n в двойное число d с тем же числовым значением.[/color] [color=#FF8000]: S>D[/color] [color=#0080C0]( n --> d )[/color] S>D [color=#FF8000];[/color]
[color=#808080]\ найти абсолютное значение числа[/color] [color=#FF8000]: ABS[/color] [color=#0080C0]( n --> u )[/color] ABS [color=#FF8000];[/color]
[color=#808080]\ оставить минимальное n из двух чисел na, nb на вершине стека данных[/color] [color=#FF8000]: MIN[/color] [color=#0080C0]( na nb --> n )[/color] MIN_ [color=#FF8000];[/color]
[color=#808080]\ увеличить значение, хранящееся по addr на n,[/color] [color=#808080]\ результат сохранить по addr и оставить на вершине стека данных[/color] [color=#FF8000]: +!@[/color] [color=#0080C0]( n addr --> x+n )[/color] PSFA NIP [color=#FF8000];[/color]
[color=#808080]\ переместить указатель вершины стека данных на указанный адрес[/color] [color=#808080]\ в TOS остается значение[/color] [color=#FF8000]: SP![/color] [color=#0080C0]( addr --> )[/color] TOSP [color=#FF8000];[/color]
[color=#808080]\ вернуть адрес вершины стека данных[/color] [color=#FF8000]: SP@[/color] [color=#0080C0]( --> addr )[/color] SP@ [color=#FF8000];[/color]
[color=#808080]\ переместить указатель вершины стека возвратов на указанный адрес[/color] [color=#FF8000]: RP![/color] [color=#0080C0]( addr --> )[/color] TORP [color=#FF8000];-[/color]
[color=#808080]\ вернуть адрес вершины стека возвратов[/color] [color=#FF8000]: RP@[/color] [color=#0080C0]( --> addr )[/color] DUP ATRP [color=#FF8000];[/color]
[color=#808080]\ перенести значение с вершины стека данных на вершину стека возвратов[/color] [color=#FF8000]: >R[/color] [color=#0080C0]( addr --> r: addr )[/color] TOR [color=#FF8000];[/color]
[color=#808080]\ перенести значение с вершины стека возвратов на вершину стека данных[/color] [color=#FF8000]: R>[/color] [color=#0080C0]( r: addr --> addr )[/color] DUP FROMR [color=#FF8000];[/color]
[color=#808080]\ выложить на вершину стека данных значение,[/color] [color=#808080]\ скомпилированное в коде за вызовом (LIT)[/color] [color=#FF8000]: (LIT)[/color] [color=#0080C0]( --> n )[/color] DUP RVAR GETLIT [color=#FF8000];-[/color]
[color=#808080]\ выложить на вершину стека данных значение,[/color] [color=#808080]\ скомпилированное в коде за вызовом (LIT)[/color] [color=#FF8000]: (DLIT)[/color] [color=#0080C0]( --> n )[/color] DUP DUP RVAR GETLIT [color=#FF8000];-[/color]
[color=#808080]\ вернуть адрес слова, вызов которого скомпилирован в коде вслед за (')[/color] [color=#FF8000]: (`)[/color] [color=#0080C0]( --> addr )[/color] DUP RVAR GETALIT [color=#FF8000];-[/color]
[color=#808080]\ вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину #[/color] [color=#FF8000]: (SLIT)[/color] [color=#0080C0]( --> asc # )[/color] (SLIT) [color=#FF8000];-[/color]
[color=#808080]\ положить на вершину стека адрес переменной[/color] [color=#FF8000]: (CREATE)[/color] [color=#0080C0]( --> addr )[/color] DUP RVAR [color=#FF8000];[/color]
[color=#808080]\ положить на вершину стека значение[/color] [color=#FF8000]: (CONSTANT)[/color] [color=#0080C0]( --> n )[/color] DUP RVAR @ [color=#FF8000];[/color]
[color=#808080]\ проверка числа на 0[/color] [color=#FF8000]: 0=[/color] [color=#0080C0]( n --> flag )[/color] 0= [color=#FF8000];[/color]
[color=#808080]\ сравнить числа na и nb[/color] [color=#FF8000]: >[/color] [color=#0080C0]( na nb --> flag )[/color] more NIP [color=#FF8000];[/color] [color=#FF8000]: U>[/color] [color=#0080C0]( ua ub --> flag )[/color] U> [color=#FF8000];[/color]
[color=#808080]\ сравнить числа na и nb[/color] [color=#FF8000]: <[/color] [color=#0080C0]( na nb --> flag )[/color] less NIP [color=#FF8000];[/color]
[color=#808080]\ выйти из текущего определения[/color] [color=#FF8000]: EXIT[/color] [color=#0080C0]( --> )[/color] EXIT_ [color=#FF8000];[/color]
[color=#808080]\ безусловное ветвление[/color] [color=#FF8000]: BRANCH[/color] [color=#0080C0]( --> )[/color] BR [color=#FF8000];-[/color]
[color=#808080]\ условное ветвление[/color] [color=#FF8000]: ?BRANCH[/color] [color=#0080C0]( n --> n )[/color] ?BR [color=#FF8000];-[/color]
[color=#808080]\ условное ветвление[/color] [color=#FF8000]: N?BRANCH[/color] [color=#0080C0]( n --> n )[/color] N?BR [color=#FF8000];-[/color]
[color=#808080]\ размер буферов TIB и PAD в байтах[/color] [color=#00F000]0x100[/color] [color=#FF8000]CONSTANT TIB#[/color] [color=#0080C0]( --> # )[/color] [color=#00F000]0x100[/color] [color=#FF8000]CONSTANT PAD#[/color] [color=#0080C0]( --> #)[/color]
[color=#808080]\ terminal input buffer[/color] CREATE TIB TIB# ALLOT
[color=#808080]\ указатель на первый неразобранный символ во входном буфере[/color] [color=#FF8000]VARIABLE >IN[/color]
[color=#808080]\ указатель на последний введенный символ[/color] [color=#FF8000]VARIABLE #TIB[/color]
[color=#808080]\ Дно стека данных[/color] [color=#FF8000]VARIABLE S0[/color] [color=#0080C0]( --> addr )[/color]
[color=#808080]\ Дно стека возвратов[/color] [color=#FF8000]VARIABLE R0[/color] [color=#0080C0]( --> addr )[/color]
[color=#808080]\ размеры стеков[/color] [color=#00F000]0x1000[/color] [color=#FF8000]CONSTANT DataStack#[/color] [color=#00F000]0x1000[/color] [color=#FF8000]CONSTANT ReturnStack#[/color]
[color=#808080]\ Хранит адрес первой свободной ячейки памяти в пространстве кода и данных[/color] [color=#FF8000]VARIABLE DP[/color] [color=#0080C0]( --> addr )[/color]
[color=#808080]\ Хранит адрес первой свободной ячейки памяти в пространстве имен[/color] [color=#FF8000]VARIABLE HDP[/color] [color=#0080C0]( --> addr )[/color]
[color=#808080]\ стандартные потоки В\В[/color] [color=#FF8000]VARIABLE STDIN[/color] [color=#808080]\ входной[/color] [color=#FF8000]VARIABLE STDOUT[/color] [color=#808080]\ выходной[/color] [color=#FF8000]VARIABLE STDERR[/color] [color=#808080]\ выходной для ошибок[/color]
[color=#808080]\ флаг необходимости извещения о повторном использовании уже существующего имени определения[/color] [color=#FF8000]VARIABLE WARNING[/color]
[color=#808080]\ текущее состоянии системы (интерпретация\компиляция)[/color] [color=#FF8000]VARIABLE STATE[/color]
[color=#808080]\ переключение состояния системы[/color] [color=#FF8000]: [[/color] [color=#0080C0]( --> )[/color] [color=#00F000]0[/color] STATE ! [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color] [color=#FF8000]: ][/color] [color=#0080C0]( --> )[/color] [color=#00F000]-1[/color] STATE ! [color=#FF8000];[/color]
[color=#00F000]4[/color] [color=#FF8000]CONSTANT CELL[/color] [color=#808080]\ размер ячейки, байт[/color] [color=#00F000]4[/color] [color=#FF8000]CONSTANT ADDR[/color] [color=#808080]\ размер адресной ссылки, байт[/color]
[color=#808080]\ преобразовать значение количетсва ячеек в количество минимально адресуемых единиц (байт)[/color] [color=#FF8000]: CELLS[/color] [color=#0080C0]( u --> # )[/color] CELLS [color=#FF8000];[/color]
[color=#808080]\ вернуть адрес первой свободной ячейки памят в пространстве кода и данных[/color] [color=#FF8000]: HERE[/color] [color=#0080C0]( --> addr )[/color] DP @ [color=#FF8000];[/color]
[color=#808080]\ вернуть адрес первой свободной ячейки памят в пространстве имен[/color] [color=#FF8000]: HHERE[/color] [color=#0080C0]( haddr --> addr )[/color] HDP @ [color=#FF8000];[/color]
[color=#808080]\ добавить в конец файла fid содержимое строки Asc #[/color] [color=#FF8000]: WRITE-FILE[/color] [color=#0080C0]( asc # fid --> # )[/color] [color=#C00000]>R[/color] [color=#C00000]>R[/color] [color=#C00000]>R[/color] [color=#00F000]0[/color] SP@ DUP [color=#C00000]R>[/color] [color=#C00000]R>[/color] SWAP [color=#C00000]R>[/color] DUP 'WriteFile CallAPI DROP [color=#FF8000];[/color]
[color=#808080]\ читать в буфер asc строку длиной не более # символов содержимое файла fid[/color] [color=#FF8000]: READ-FILE[/color] [color=#0080C0]( asc # fid --> # )[/color] [color=#C00000]>R[/color] [color=#C00000]>R[/color] [color=#C00000]>R[/color] [color=#00F000]0[/color] SP@ DUP [color=#C00000]R>[/color] [color=#C00000]R>[/color] SWAP [color=#C00000]R>[/color] DUP 'ReadFile CallAPI DROP [color=#FF8000];[/color]
[color=#808080]\ вывести в текущий STDOUT поток указанную строку[/color] [color=#FF8000]: TYPE[/color] [color=#0080C0]( asc # --> )[/color] STDOUT @ WRITE-FILE DROP [color=#FF8000];[/color]
[color=#808080]\ вывести символ в текущий поток В\В[/color] [color=#FF8000]: EMIT[/color] [color=#0080C0]( char --> )[/color] SP@ [color=#00F000]1[/color] TYPE DROP [color=#FF8000];[/color]
[color=#808080]\ текущая система счисления[/color] [color=#FF8000]VARIABLE BASE[/color]
[color=#808080]\ переключения системы счисления[/color] [color=#FF8000]: DECIMAL[/color] [color=#0080C0]( --> )[/color] [color=#00F000]0x0A[/color] BASE ! [color=#FF8000];[/color] [color=#FF8000]: HEX[/color] [color=#0080C0]( --> )[/color] [color=#00F000]0x10[/color] BASE ! [color=#FF8000];[/color]
[color=#808080]\ буфер для форматного преобразования чисел и строк[/color] CREATE PAD PAD# ALLOT [color=#808080]\ буфер обычно заполняется с конца, поэтому необходим адрес конца буфера[/color] [color=#FF8000]LABEL: PadTop[/color]
[color=#808080]\ указатель на последний символ в PAD[/color] [color=#FF8000]VARIABLE HLD[/color]
[color=#808080]\ начать форматное преобразование строки[/color] [color=#FF8000]: <#[/color] [color=#0080C0]( --> )[/color] PadTop HLD ! [color=#FF8000];[/color]
[color=#808080]\ задать текущую систему счисления и начать форматное преобразование строки[/color] [color=#FF8000]: {#[/color] [color=#0080C0]( base --> )[/color] BASE ! [color=#0000F0]<#[/color] [color=#FF8000];[/color]
[color=#808080]\ завершить форматное преобразование строки, вернуть адрес asc и длину # полученной строки[/color] [color=#FF8000]: #}[/color] [color=#0080C0]( --> asc # )[/color] HLD @ PAD PAD# + OVER - [color=#FF8000];[/color]
[color=#808080]\ то же, что и #}, только предварительно удаляет число двойной длины с вершины стека данных[/color] [color=#FF8000]: #>[/color] [color=#0080C0]( d --> asc # )[/color] NIP DROP [color=#0000F0]#}[/color] [color=#FF8000];[/color]
[color=#808080]\ добавляет символ char в позицию HLD, сам HLD уменьшает на размер одного символа[/color] [color=#FF8000]: HOLD[/color] [color=#0080C0]( char --> )[/color] [color=#00F000]-1[/color] HLD +!@ B! [color=#FF8000];[/color] [color=#808080]\ -1 HLD @ + PAD UMAX DUP HLD ! B![/color]
[color=#808080]\ преобразовать число в символ[/color] [color=#808080]\ число не должно превышать значение находящееся в BASE[/color] [color=#FF8000]: >DIGIT[/color] [color=#0080C0]( u --> char )[/color] DUP [color=#00F000]9[/color] > [color=#00A0A0]IF[/color] [color=#00F000]7[/color] + [color=#00A0A0]THEN[/color] [color=#00F000]0x30[/color] + [color=#FF8000];[/color]
[color=#808080]\ добавить в буфер PAD остаток от деления двойного числа на содержимое BASE[/color] [color=#FF8000]: #[/color] [color=#0080C0]( ud1 --> ud2 )[/color] [color=#00F000]0[/color] BASE @ UM/MOD [color=#C00000]>R[/color] BASE @ UM/MOD [color=#C00000]R>[/color] ROT >DIGIT [color=#0000F0]HOLD[/color] [color=#FF8000];[/color]
[color=#808080]\ Если n отрицательно, добавить в PAD символ '-'[/color] [color=#FF8000]: SIGN[/color] [color=#0080C0]( n --> )[/color] [color=#00F000]0[/color] < [color=#00A0A0]IF[/color] [color=#00F000][CHAR] -[/color] [color=#0000F0]HOLD[/color] [color=#00A0A0]THEN[/color] [color=#FF8000];[/color]
[color=#808080]\ преобразовать число двойной длинны в строку[/color] [color=#FF8000]: #S[/color] [color=#0080C0]( ud --> 0 0 )[/color] [color=#00A0A0]BEGIN[/color] [color=#0000F0]#[/color] DDUP OR [color=#00A0A0]WHILE[/color] [color=#00A0A0]REPEAT[/color] [color=#FF8000];[/color]
[color=#808080]\ константы значения спецсимволов[/color] [color=#00F000]0x20[/color] [color=#FF8000]CONSTANT Bl_[/color] [color=#00F000]0x0A[/color] [color=#FF8000]CONSTANT Cr_[/color] [color=#00F000]0x0D[/color] [color=#FF8000]CONSTANT Lf_[/color]
[color=#808080]\ преобразовать число одинарной длинны в строку[/color] [color=#808080]\ в десятичной системе независимо от значения BASE[/color] [color=#FF8000]: (.)[/color] [color=#0080C0]( n --> asc # )[/color] DUP [color=#C00000]>R[/color] ABS S>D [color=#0000F0]<#[/color] #S [color=#C00000]R>[/color] SIGN [color=#0000F0]#>[/color] [color=#FF8000];[/color]
[color=#808080]\ вывести число в текущей системе счисления в выходной поток[/color] [color=#FF8000]: .[/color] [color=#0080C0]( n --> )[/color] (.) TYPE [color=#FF8000];[/color]
[color=#808080]\ перевод строки[/color] [color=#FF8000]: CR[/color] [color=#0080C0]( --> )[/color] [color=#00F000]S" \n\r"[/color] TYPE [color=#FF8000];[/color]
[color=#808080]\ текущая глубина стека данных[/color] [color=#FF8000]: DEPTH[/color] [color=#0080C0]( --> n )[/color] SP@ S0 @ SWAP - CELL / [color=#FF8000];[/color]
[color=#808080]\ приглашение[/color] [color=#FF8000]: PROMPT[/color] [color=#0080C0]( --> )[/color] DEPTH . STATE @ [color=#00A0A0]IF[/color] [color=#00F000]S" ]"[/color] [color=#00A0A0]ELSE[/color] [color=#00F000]S" ["[/color] [color=#00A0A0]THEN[/color] TYPE [color=#FF8000];[/color]
[color=#808080]\ получить очередную строку из STDIN в буфер TIB[/color] [color=#FF8000]: QUERY[/color] [color=#0080C0]( --> )[/color] TIB TIB# STDIN @ READ-FILE #TIB ! [color=#00F000]0[/color] >IN ! [color=#FF8000];[/color]
[color=#808080]\ -- парсер --------------------------------------------------------------------[/color]
[color=#808080]\ является ли символ char пробельным[/color] [color=#FF8000]: n?sep[/color] [color=#0080C0]( char --> flag )[/color] [color=#00F000]Bl_[/color] > [color=#FF8000];[/color]
[color=#808080]\ адрес первого неразобранного символа[/color] [color=#FF8000]: CharAddr[/color] [color=#0080C0]( --> addr )[/color] TIB >IN @ + [color=#FF8000];[/color]
[color=#808080]\ прочесть символ из текущего значения >IN[/color] [color=#FF8000]: PeekChar[/color] [color=#0080C0]( --> char )[/color] CharAddr B@ [color=#FF8000];[/color]
[color=#808080]\ пропустить один символ во входном потоке[/color] [color=#FF8000]: SkipChar[/color] [color=#0080C0]( --> )[/color] >IN @ [color=#00F000]1[/color] + #TIB @ MIN >IN ! [color=#FF8000];[/color]
[color=#808080]\ вернуть TRUE если весь текст уже разобран[/color] [color=#FF8000]: ?COMPLETE[/color] [color=#0080C0]( --> flag )[/color] #TIB @ >IN @ < [color=#FF8000];[/color]
[color=#808080]\ взять очередной символ из входного потока[/color] [color=#808080]\ flag = TRUE если входной поток исчерпан[/color] [color=#FF8000]: NextChar[/color] [color=#0080C0]( --> char flag )[/color] PeekChar ?COMPLETE SkipChar [color=#FF8000];[/color]
[color=#808080]\ пропустить все символы разделители до первого значащего символа,[/color] [color=#808080]\ либо до конца разбираемой строки[/color] [color=#FF8000]: MissSeparators[/color] [color=#0080C0]( --> )[/color] INT3 [color=#00A0A0]BEGIN[/color] NextChar [color=#00A0A0]WHILENOT[/color] n?sep [color=#00A0A0]WHILENOT[/color] [color=#00A0A0]REPEAT[/color] EXIT [color=#00A0A0]THEN[/color] DROP [color=#FF8000];[/color]
[color=#808080]\ пропустить текст вплодь до разделителя[/color] [color=#FF8000]: MissLexeme[/color] [color=#0080C0]( --> )[/color] INT3 [color=#00A0A0]BEGIN[/color] NextChar [color=#00A0A0]WHILENOT[/color] n?sep [color=#00A0A0]WHILE[/color] [color=#00A0A0]REPEAT[/color] EXIT [color=#00A0A0]THEN[/color] DROP [color=#FF8000];[/color]
[color=#808080]\ выделить из буфера блок символов вплоть до разделителя[/color] [color=#FF8000]: PassLexeme[/color] [color=#0080C0]( --> asc # )[/color] CharAddr MissLexeme CharAddr OVER - [color=#FF8000];[/color]
[color=#808080]\ Получить адрес и длину очередной лексемы[/color] [color=#FF8000]: NextWord[/color] [color=#0080C0]( --> asc # )[/color] MissSeparators PassLexeme [color=#FF8000];[/color]
[color=#00F000]16[/color] [color=#FF8000]CONSTANT WORDLISTS[/color] [color=#808080]\ количество словарей в системе[/color]
[color=#808080]\ текущий словарь ( в который ведется добавление имен)[/color] [color=#FF8000]VARIABLE CURRENT[/color] [color=#808080]\ стек словарей для поиска[/color] CREATE CONTEXT WORDLISTS CELLS ALLOT [color=#FF8000]LABEL: CNSP[/color] [color=#808080]\ вершина списка словарей[/color]
[color=#808080]\ сделать верхний текущий словарь контекстным[/color] [color=#FF8000]: DEFINITIONS[/color] [color=#0080C0]( --> )[/color] CONTEXT @ CURRENT ! [color=#FF8000];[/color] [color=#808080]\ !!! написать нормально[/color]
[color=#808080]\ идентификатор словаря FORTH[/color] [color=#FF8000]: FORTH-WORDLIST[/color] [color=#0080C0]( --> wid )[/color] [color=#00F000]1[/color] [color=#FF8000];[/color] [color=#808080]\ !!! написать нормально[/color]
[color=#808080]\ инициализация контекста[/color] [color=#FF8000]: ONLY[/color] [color=#0080C0]( --> )[/color] FORTH-WORDLIST CONTEXT ! [color=#FF8000];[/color] [color=#808080]\ !!! написать нормально[/color]
[color=#808080]\ выполнить действие над очередной лексемой[/color] [color=#FF8000]: EVAL-TOKEN[/color] [color=#0080C0]( asc # --> )[/color] CR TYPE [color=#FF8000];[/color]
[color=#808080]\ интерпретировать входной поток[/color] [color=#808080]\ : INTERPRET ( --> ) BEGIN NextWord DUP WHILE EVAL-TOKEN REPEAT DDROP ;[/color] [color=#FF8000]: INTERPRET[/color] [color=#0080C0]( --> )[/color] TIB #TIB @ TYPE CR [color=#FF8000];[/color]
[color=#808080]\ проверка протекания стека данных[/color] [color=#FF8000]: ?STACK[/color] [color=#0080C0]( --> )[/color] SP@ S0 @ U> [color=#00A0A0]IF[/color] [color=#00F000]S" Исчерпание стека данных!\n\r"[/color] TYPE S0 @ SP! [color=#00A0A0]THEN[/color] [color=#FF8000];[/color]
[color=#808080]\ основной цикл системы[/color] [color=#FF8000]: QUIT[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] [[/color] DECIMAL CR [color=#00A0A0]BEGIN[/color] PROMPT QUERY INTERPRET ?STACK [color=#00A0A0]AGAIN[/color] [color=#FF8000];[/color]
[color=#808080]\ инициализация системы после ошибки[/color] [color=#FF8000]: ABORT[/color] [color=#0080C0]( --> )[/color] S0 @ SP! R0 @ RP! [color=#FF00FF]ONLY[/color] [color=#FF00FF]DEFINITIONS[/color] QUIT [color=#FF8000];[/color]
[color=#808080]\ инициализация идентификаторов потоков В/В[/color] [color=#FF8000]: INIT-IO[/color] [color=#0080C0]( --> )[/color] [color=#00F000]-10[/color] DUP 'GetStdHandle CallAPI STDIN ! [color=#00F000]-11[/color] DUP 'GetStdHandle CallAPI STDOUT ! [color=#00F000]-12[/color] DUP 'GetStdHandle CallAPI STDERR ! [color=#FF8000];[/color]
[color=#808080]\ приветствие после запуска системы[/color] [color=#FF8000]: TITLE[/color] [color=#0080C0]( --> )[/color] [color=#00F000]S" \n\rHello!\n\r"[/color] TYPE [color=#FF8000];[/color]
[color=#808080]\ сделать вектором![/color] [color=#FF8000]: MAIN[/color] [color=#0080C0]( --> )[/color] TITLE [color=#FF8000];[/color]
[color=#808080]\ холодный запуск системы[/color] [color=#FF8000]: COLD[/color] [color=#0080C0]( --> )[/color] STARTUP [color=#808080]\ для начала раздвигаются указатели стеков[/color] RP@ DUP R0 ! [color=#808080]\ стек возвратов под стеком данных используется для хранения[/color] [color=#808080]\ только внутренних вызовов, т.к. АПИ очень сильно жрет стек[/color] ReturnStack# - S0 ! INIT-IO DECIMAL MAIN ABORT [color=#FF8000];[/color]
[color=#808080]\ последнее определение системы[/color] CREATE FENCE [color=#0080C0]( --> )[/color]
[color=#FF8000];TRANSLATE[/color]
|
|
|
|
Добавлено: Вт янв 20, 2015 19:57 |
|
|
|
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
Еще один промежуточный вариант. source file: f2a.fts \ 2014.12.21 m0leg
\! сделать реверс списка имен (не обязательно)
ALSO ROOT DEFINITIONS : .S .S ; RECENT
memory/ buff.fts branch/ case.fts branch/ for-next.fts
\ -- буфер для склейки строк --------------------------------------------------- USER-VALUE outbuf
\ создать буфер размером в 1 МБ (должно хватать) : init-buf 0x100000 Buffer TO outbuf ;
\ освободить занятый буфер : del-buf outbuf Retire ;
\ добавить в буфер строку текста : +>buf ( asc # --> ) outbuf >Buffer DROP ;
\ добавить одиночный символ в буфер : ch>buf ( char --> ) <| KEEP |> +>buf ;
\ вернуть содержимое буфера : buf> ( --> asc # ) outbuf Buffer> ;
\ открыть буфер : buf< ( --> ) outbuf Clean ;
\ -- форматирование текста -----------------------------------------------------
\ отступ от начала строки на два tab-а : -| ( --> ) s" \t\t" +>buf ; \ новая линия : nl ( --> ) s" \n\r" +>buf ; \ добавить строку с одним tab-ом в начале строки, завершить переводом строки : +>> ( asc # --> ) s" \t" +>buf +>buf nl ; \ добавить строку с двумя tab-ами в начале строки, завершить переводом строки : +>l ( asc # --> ) -| +>buf nl ;
\ добавить строку в выходной буфер : o" ( / asc" --> asc # | ) [CHAR] " CookLine state IF SLIT, ['] +>buf COMPILE, THEN ; IMMEDIATE \ /--/--/ с табуляцией в начале и переводом строки в конце : o|" ( / asc" --> asc # | ) [CHAR] " CookLine state IF SLIT, ['] +>> COMPILE, THEN ; IMMEDIATE \ /--/--/ с двумя табуляциями в начале и переводом строки в конце : a" ( / asc" --> asc # | ) [CHAR] " CookLine state IF SLIT, ['] +>l COMPILE, THEN ; IMMEDIATE
\ добавить число : dd+ ( n --> ) 0x10 {# Bl_ HOLD 0 #S s" dd 0x" HOLDS #> +>buf ; : dq+ ( d --> ) 0x10 {# Bl_ HOLD #S s" dq 0x" HOLDS #> +>buf ;
\ -- сохранение содержимого в файл ---------------------------------------------
0 VALUE FId
\ создать файл с заданным именем : file ( asc # --> fid ) W/O CREATE-FILE THROW TO FId ;
\ сохранить содержимое буфера в файл : save ( fid --> ) >L buf> L@ WRITE-FILE THROW L> CLOSE-FILE THROW ;
\ добавить содержимое указанного файла : asmfile ( asc # --> ) FILE>HEAP IFNOT ERROR" не могу прочесть файл" THEN OVER >L +>buf L> FREE THROW ;
\ -- создание новой метки ------------------------------------------------------
USER-VALUE LastLab
: l>name ( lab --> asc # ) S>D 0x10 {# # # # # s" lab_" HOLDS #> ;
\ создать новую метку, вернуть имя : label ( --> lab asc # ) LastLab 1 + DUP TO LastLab DUP l>name ;
\ преобразовать специальный символ в строковое представление и добавить \ результат в буфер PAD : ?ADDCHAR ( ch --> ) CASE [CHAR] , OF s" Compile" ENDOF [CHAR] ! OF s" Store" ENDOF [CHAR] ? OF s" Question" ENDOF [CHAR] @ OF s" Fetch" ENDOF [CHAR] ' OF s" Deref" ENDOF [CHAR] ; OF s" Semicolon" ENDOF [CHAR] . OF s" Peroid" ENDOF [CHAR] : OF s" Colon" ENDOF [CHAR] > OF s" To" ENDOF [CHAR] + OF s" Plus" ENDOF [CHAR] - OF s" Minus" ENDOF [CHAR] = OF s" Equal" ENDOF [CHAR] # OF s" Size" ENDOF [CHAR] " OF s" Quote" ENDOF [CHAR] < OF s" Less" ENDOF [CHAR] / OF s" Slash" ENDOF [CHAR] \ OF s" Backslash" ENDOF [CHAR] ? OF s" Question" ENDOF [CHAR] [ OF s" lStap" ENDOF [CHAR] ] OF s" rStap" ENDOF [CHAR] ( OF s" lPar" ENDOF [CHAR] ) OF s" rPar" ENDOF [CHAR] { OF s" lBr" ENDOF [CHAR] } OF s" rBr" ENDOF [CHAR] ~ OF s" Show" ENDOF [CHAR] | OF s" Wall" ENDOF [CHAR] ` OF s" Tick" ENDOF [CHAR] * OF s" Star" ENDOF HOLD s" " ENDCASE HOLDS ;
\ преобразовать Форт-имя в метку : name>label ( asc # --> asc # ) OVER + 0x10 {# BEGIN DDUP < WHILE 1 - DUP C@ ?ADDCHAR REPEAT #> ;
\ : label, ( asc # --> asc # ) name>label DDUP SLIT, ; \ : name' ( / name --> ) NextWord label, DROP ; IMMEDIATE
\ -- создание рабочих словарей и слов для работы с ними ------------------------
\ ячейка для хранения последнего распознанного числа USER-CREATE LastNumber 2 CELLS USER-ALLOT
\ обработка чисел одинарной длины : (tLit) ( --> n ) LastNumber @ state IF o" \t\tCALL _" s" (LIT)" name>label +>buf nl -| dd+ nl THEN \! вместо dq должен быть код литерала ; IMMEDIATE \ обработка чисел двойной длины : (tdLit) ( --> d ) LastNumber D@ state IF o" \t\tCALL _" s" (DLIT)" name>label +>buf nl -| dq+ nl THEN \! вместо dq должен быть код литерала ; IMMEDIATE
\ попытаться распознать строку asc # , как число, \ в случае успеха вернуть lfa слова, ассоциируемого с числом : tNumLfa ( asc # vid --> lfa | 0 ) DROP \ vid словаря не нужен [ ALSO HIDDEN ] snNumber *IF 1 - IF LastNumber D! LFA (tdLit) ELSE LastNumber ! LFA (tLit) THEN THEN [ PREVIOUS ] ;
\ создание словаря, распознающего числа init: VOCABULARY \ создаем стандартный словарь и правим поля [ ALSO HIDDEN ] VOC-LIST A@ >L \ wordlist ['] tNumLfa L@ off_quest A! 0 L@ off_vtable A! \ отсутствует vtable 0 L@ off_last A! \ слов в словаре нет ['] no-mount L@ off_mount A! ['] no-umount L@ off_umount A! &vinit L> off_vflags B! [ PREVIOUS ] ;stop TNUMBERS \ словарь для работы с числами
VOCABULARY MACRO \ словарь для хранения макросов VOCABULARY TARGET \ словарь для хранения имен
\ показать список определений \ чтобы можно было использовать отовюсду размещается в корневом словаре ALSO ROOT DEFINITIONS : ~LIST ORDER CR ALSO TARGET WORDS PREVIOUS CR ; PREVIOUS DEFINITIONS
\ -- ---------------------------------------------------------------------------
0 VALUE LASTDEF \ хранит lfa последнего определения в TARGET
\ проверка режима компиляции : ?COMP ( --> ) state IF ;THEN ERROR" Только для режима компиляции!" ;
\ завершить создание макроса : ;M ( --> ) [COMPILE] ; IMMEDIATE DEFINITIONS ; IMMEDIATE
\ начать создание макроса с указанным именем : (:) ( asc # --> ) ALSO MACRO DEFINITIONS PREVIOUS S: ;
\ завершить создание теневого определения в TARGET : ;C ( --> ) [COMPILE] ; IMMEDIATE LATEST TO LASTDEF \ для того, чтобы удобно работать с флагами DEFINITIONS ; IMMEDIATE
\ создать теневое определение в TARGET : (C:) ( asc # --> ) ALSO TARGET DEFINITIONS PREVIOUS S: ;
\ начать создание макроса : M: ( /name --> ) NextWord (:) ;
: LastDef ( --> id ) WHO TARGET LAST-NAME ;
\ вернуть имя последнего определения : LastDef> ( --> asc # ) LastDef ID>ASC name>label ;
\ : name+>buf ( asc # --> ) o" _" name>label +>buf ;
\ добавить имя в словарь TARGET, и соответствующую метку в листинг : AddName ( /name --> ) NextWord DDUP (C:) label, <: o" \t\tCALL _" +>buf nl ;> COMPILE, [COMPILE] ;C o" _" +>buf ;
\ секция импорта : ImportSect ( --> ) nl o" section '.import' import data readable writeable" nl nl o" library kernel,'KERNEL32.DLL'" nl nl o" import kernel,\\" nl o|" LoadLibrary, 'LoadLibrary',\\" o|" GetProcAddress, 'GetProcAddress',\\" o|" ExitProcess, 'ExitProcess',\\" o|" GetStdHandle, 'GetStdHandle',\\" o|" WriteFile, 'WriteFile',\\" o|" ReadFile, 'ReadFile'" ;
\ преамбула : Preambula ( --> ) o" format PE console" nl nl o|" include 'include\\win32a.inc'" o|" include 'include\\macro\\struct.inc'" nl ImportSect ;
\ начать трансляцию текста : TRANSLATE: ( /name --> ) NextWord <| s" D:/ASM/FASM/" KEEPS KEEPS s" .asm" KEEPS 0 KEEP |> file init-buf ONLY PREVIOUS TNUMBERS ALSO TARGET DEFINITIONS ALSO MACRO Preambula nl s" f2a_m.asm" asmfile \ содержимое Preambula можно сразу внутрь f2a_m.asm \ код и данные хранятся вместе в одном сегменте, а словарь размещается в отдельном nl o" section '.fvm' code executable readable writeable" nl ;
\ проверка, установлен ли признак немедленного исполнения : ?IMM ( lfa --> asc # | 0 ) [ ALSO HIDDEN ] &ALS @ATTR [ PREVIOUS ] ;
\ создать список имен : MakeVoc ( asc # --> ) nl nl o" section '.names' data readable writeable" nl o" ; makevoc " +>buf nl nl o" ; Имя, Метка, Флаг immediate"
LastDef BEGIN *WHILE nl o" def \'" DUP ID>ASC DDUP +>buf o" ', _" name>label +>buf o" , " DUP ?IMM IF o" -1" ELSE o" 1" THEN LINK> REPEAT DROP nl o" LATEST: ; чтобы получить хвост цепочки имен" nl o" NSADDR:" nl o" allot NamesSpace-($-$$) ;" nl ;
\ создать список имен в секции импорта, таким образом в отладчике будет видно \ имя каждого определения : MakeExp ( asc # --> ) nl nl o" section '.edata' export data readable" nl o" export '" +>buf o" '"
LastDef BEGIN *WHILE o" ,\\\n\r" DUP o" _" ID>ASC DDUP name>label +>buf o" ,'" +>buf o" '" LINK> REPEAT DROP
nl nl ;
\ сохранить содержимое буфера в файл : aSave ( --> ) FId save del-buf ;
\ -- --------------------------------------------------------------------------- \! Все определения, заканчивающиеся ;M являются словами немедленного исполнения
\ коментарий в скобках копируем в коментарий целевого asm M: ( ( /comment string --> ) o" ; ( " BEGIN NEXT-WORD DDUP +>buf o" " *WHILE + <C C@ [CHAR] ) <> WHILE REPEAT nl ;THEN DDROP \ если закрывающая скобка не встретилась до конца файла ;M
\ завершить трансляцию текста M: ;TRANSLATE ( --> ) \ точкой входа считаем последнее определение в тексте nl o" entry _COLD ; точка входа" nl s" FORTH" DDUP MakeVoc \ создание словаря MakeExp \ чтобы создать список имен в секции экспорта aSave ONLY DEFINITIONS ;M
\ создать метку с именем name в тексте M: LABEL: ( /name --> ) NextWord DDUP +>buf s" : " +>buf DDUP (:) SLIT, <: nl o" \t\tCALL _" s" (LIT)" name>label +>buf nl o" \t\t dd " [COMPILE] +>buf nl ;> COMPILE, [COMPILE] ;M ;M
\ завершить определение без добавления RET В конец определения M: ;- ( --> ) [COMPILE] ;C nl ;M
\ компилировать условный переход вперед на парный THEN или ELSE M: IF ( --> label ) ?COMP o" \t\tCALL " s" ?BRANCH" name+>buf nl o" \t\tdd " label +>buf nl NOTICE" Непарная конструкция!" ;M
\ завершение ветвления M: THEN ( label par --> ) ?COMP ?PAIRS" Непарная конструкция!" l>name +>buf o" :" nl ;M
\ компилировать безусловный переход на парный THEN M: ELSE ( label_a --> label_b ) ?COMP ?PAIRS" Непарная конструкция!" o" \tCALL " s" BRANCH" name+>buf nl o" \t\tdd " label +>buf nl SWAP l>name +>buf o" :" nl NOTICE" Непарная конструкция!" ;M
\ создать безымянную метку для перехода назад M: BEGIN ( --> lab p ) ?COMP label +>buf o" :\t; метка для перехода назад" nl NOTICE" Не обнаружена метка для перехода назад!" ;M
\ компилировать выход из тела цикла M: WHILE ( lab p --> lab p lab1 p ) ?COMP DUP ?PAIRS" Не обнаружена метка для перехода назад!" o" \t\tCALL " s" ?BRANCH" name+>buf nl o" \t\tdd " label +>buf nl NOTICE" Непарная конструкция!" DSWAP ;M
\ компилировать выход из тела цикла M: WHILENOT ( lab p --> lab p lab1 p ) ?COMP DUP ?PAIRS" Не обнаружена метка для перехода назад!" o" \t\tCALL " s" N?BRANCH" name+>buf nl o" \t\tdd " label +>buf nl NOTICE" Непарная конструкция!" DSWAP ;M
\ Компилировать переход назад на BEGIN M: REPEAT ( lab p lab1 p --> ) ?COMP ?PAIRS" Не обнаружена метка для перехода назад!" o" \tJMP " l>name +>buf o" ; переход назад" nl ?PAIRS" Непарная конструкция!" l>name +>buf o" :" nl ;M
\ создать безусловный переход назад на метку lab M: AGAIN ( lab p --> ) ?COMP ?PAIRS" Не обнаружена метка для перехода назад!" o" \tJMP " l>name +>buf o" ; переход назад" nl ;M
\ начать целевое определение M: : ( / name --> ) o" align" nl NextWord DDUP (C:) label, <: o" \t\tCALL _" +>buf nl ;> COMPILE, o" _" +>buf o" : " ;M
\ завершить определение с добавлением RET В конец определения M: ; ( --> ) [COMPILE] ;C o" \t RET " nl nl ;M
\ коментарий до конца строки копируется в целевой asm файл M: \ ( --> ) -1 >IN +! o" ; " Cr_ PARSE +>buf nl ;M
\ создать имя, возвращающее адрес собственного поля параметров M: CREATE ( /name --> ) o" trialign" nl AddName o" : CALL _" s" (CREATE)" name>label +>buf nl ;M
\ создать именованную переменную M: VARIABLE ( /name --> ) o" trialign" nl AddName o" : CALL _" s" (CREATE)" name>label +>buf nl o" \tdd 0" nl nl ;M
\ создать именованную константу M: CONSTANT ( n /name --> ) o" trialign" nl DUP >L NextWord DDUP (C:) L> LIT, label, <: state IF o" \t\tCALL _" +>buf nl ELSE DROP THEN DROP ;> COMPILE, [COMPILE] ;C o" _" +>buf o" : CALL _" s" (CONSTANT)" name>label +>buf nl o" \t" dd+ nl nl ;M
\ резервировать указанное количество минимально адресуемых ячеек памяти \ в пространстве кода и данных M: ALLOT ( u --> ) 1 OVER > ABORT" должно быть быть больше 0" o" \tdb 0" 1 - *IF FOR R@ 34 MOD IFNOT o" \n\r\tdb 0" ELSE o" ,0" THEN \ заполняется нулями TILL ELSE DROP THEN nl nl ;M
\ отметить последнее определение признаком немедленного исполнения M: IMMEDIATE ( --> ) TRUE LASTDEF [ ALSO HIDDEN ] &ALS SET-ATTR \ т.к. IMMEDIATE уже занят используется &ALS [ PREVIOUS ] THROW ;M
\ добавить литеральное значение символа в текущее определение M: [CHAR] ( / ch --> ) NextWord DROP C@ o" \t\tCALL _" s" (LIT)" name>label +>buf nl -| dd+ nl ;M
\ компилировать в текущее определение указанное имя M: [COMPILE] ( /name --> ) o" \t\tCALL _" NextWord name>label +>buf nl ;M
\ добавить текстовую строку в текущее определение, \ при выполнении участка кода возвращается адрес asc и длина # M: S" ( / ascii" --> | asc # ) [CHAR] " CookLine state IF o" \t\tCALL _" s" (SLIT)" name>label +>buf nl DUP o" \t\t" dd+ nl *IF o" \t\t db " FOR DUP C@ 0x10 {# S>D #S s" 0x" HOLDS #> +>buf R@ 16 MOD IFNOT nl o" \t\t db " ELSE o" ," THEN 1 + TILL DROP ELSE DDROP THEN THEN o" 0x00" nl ;M
\ преобразовать количество ячеек в количество байт M: CELLS ( u --> u*cell ) state IF a" SAR EAX, 2" ELSE CELL * THEN ;M
\ -- определение примитивов ----------------------------------------------------
\ прерывание INT 3 - для отладки M: INT3 a" INT3" ;M
\ вызов экспортируемых функций. Все параметры должны лежать на стеке данных M: CallAPI a" MOV dword [fs:0x14], ESP" a" MOV ESP, EBP" a" CALL EAX" a" MOV EBP, ESP" a" MOV ESP, dword [fs:0x14]" a" LEA EBP, [EBP+CELL]" ;M
\ получение адреса функций АПИ M: 'GetStdHandle a" MOV EAX, dword [GetStdHandle]" ;M M: 'WriteFile a" MOV EAX, dword [WriteFile]" ;M M: 'ReadFile a" MOV EAX, dword [ReadFile]" ;M
\ макросы для работы со стеком M: CPY a" MOV EAX, [EBP]" ;M \ копировать значение второго элеметна стека данных в TOS M: SKP a" MOV EAX, [EBP+CELL]" a" LEA EBP, [EBP+8]" ;M M: ROOM a" LEA EBP, [EBP-CELL]" ;M \ определение стековых манипуляций M: NIP a" LEA EBP, [EBP+CELL]" ;M M: DROP a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" ;M M: DDROP a" MOV EAX, [EBP+CELL]" a" LEA EBP, [EBP+CELL*2]" ;M M: SWAP a" MOV EDX, EAX" a" MOV EAX, [EBP]" a" MOV dword [EBP], EDX" ;M M: DUP a" LEA EBP, [EBP-CELL]" a" MOV dword [EBP], EAX" ;M M: DDUP a" MOV EDX, [EBP]" a" MOV [EBP-CELL], EAX" a" MOV [EBP-CELL*2], EDX" a" LEA EBP, [EBP-CELL*2]" ;M M: OVER a" MOV EDX, [EBP]" a" LEA EBP, [EBP-CELL]" a" MOV dword [EBP], EAX" a" MOV EAX, EDX" ;M M: ROT a" MOV EDX, [EBP]" a" MOV [EBP], EAX" a" MOV EAX, [EBP+CELL]" a" MOV dword [EBP+CELL], EDX" ;M \ работа с памятью M: @ a" MOV EAX, [EAX]" ;M M: STORE a" MOV EDX, [EBP]" a" MOV dword [EAX], EDX" ;M M: B@ a" MOVZX EAX, byte [EAX]" ;M M: STOREB a" MOV EDX, [EBP]" a" MOV byte [EAX], DL" ;M \ литеральные значения M: GETLIT a" LEA EDX, [EAX+CELL]" a" MOV EAX, [EAX]" \ оставить на вершине стека данных литерал o|" JMP EDX" ;M \ обойти в коде литеральное значение M: GETDLIT a" LEA EDX, [EAX+CELL*2]" a" MOV EBX, [EAX]" a" MOV EAX, [EAX+CELL]" a" MOV dword [EBP], EBX" o|" JMP EDX" ;M M: GETALIT a" LEA EDX, [EAX+TOKEN]" a" MOV EAX, [EAX+1]" o|" JMP EDX" ;M M: (SLIT) a" LEA EBP, [EBP-8]" a" MOV dword [EBP+CELL], EAX" a" POP EBX" a" LEA EDX, [EBX+CELL]" a" MOV dword [EBP], EDX" a" MOV EAX, [EBX]" a" LEA EDX, [EBX+EAX+TOKEN]" o|" JMP EDX" ;M \ математика и логика M: PLUS a" ADD EAX, [EBP]" ;M M: MINUS a" MOV EDX, [EBP]" a" SUB EDX, EAX" a" MOV EAX, EDX" ;M M: OR a" OR EAX, [EBP]" a" LEA EBP, [EBP+CELL]" ;M M: 0= a" SUB EAX, 1" a" SBB EAX, EAX" ;M M: more a" CMP EAX, [EBP]" a" SETGE AL" a" AND EAX, 1" a" DEC EAX" ;M M: less a" CMP EAX, [EBP]" a" SETLE AL" a" AND EAX, 1" a" DEC EAX" ;M M: U> a" CMP EAX, [EBP]" a" SBB EAX, EAX" a" LEA EBP, [EBP+CELL]" ;M M: UM/MOD a" MOV ECX, EAX" a" MOV EDX, [EBP]" a" MOV EAX, [EBP+CELL]" a" DIV ECX" a" LEA EBP, [EBP+CELL]" a" MOV dword [EBP], EDX" ;M M: / a" MOV ECX, EAX" a" MOV EAX, [EBP]" a" CDQ" a" IDIV ECX" a" LEA EBP, [EBP+CELL]" ;M M: S>D a" CDQ" a" LEA EBP, [EBP-CELL]" a" MOV [EBP], EAX" a" MOV EAX, EDX" ;M M: ABS a" MOV EDX, EAX" a" SAR EDX, 31" a" ADD EAX, EDX" a" XOR EAX, EDX" ;M M: MIN_ a" CMP EAX, [EBP]" o|" JL _2st" a" MOV EAX, [EBP]" a" _2st: LEA EBP, [EBP+CELL]" ;M
\ перемещение между стеками M: TOSP a" MOV EBP, EAX" ;M M: SP@ a" MOV EDX, EAX" a" MOV EAX, EBP" a" LEA EBP, [EBP-CELL]" a" MOV dword [EBP], EDX" ;M M: TORP a" POP EDX" a" MOV ESP, EAX" a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" o|" JMP EDX" ;M M: ATRP a" MOV EAX, ESP" ;M M: TOR a" POP EDX" a" PUSH EAX" a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" o|" JMP EDX" ;M M: FROMR a" POP EDX" a" POP EAX" o|" JMP EDX" ;M M: RVAR a" POP EAX" ;M \ вернуть адрес следующей ячейки на вершину стека данных M: PSFA a" MOV EDX, [EAX]" \ увеличит значение ячейки на указанную величину, a" ADD EDX, [EBP]" a" MOV dword [EAX], EDX" \ оставить на вершине стека данных полученное значение a" MOV EAX, EDX" ;M \ ветвления M: BR a" POP EDX" o|" JMP dword [EDX]" ;M M: ?BR a" OR EAX, EAX" a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" o" \tJZ " s" BRANCH" name+>buf nl a" POP EDX" a" LEA EDX, [EDX+CELL]" o|" JMP EDX" ;M M: N?BR a" OR EAX, EAX" a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" o" \tJNZ " s" BRANCH" name+>buf nl a" POP EDX" a" LEA EDX, [EDX+CELL]" o|" JMP EDX" ;M M: EXIT_ a" LEA ESP, [ESP+CELL]" ;M
\ настройка системы перед запуском M: STARTUP a" LEA EBP, [EBP-256]" \ раздвинуть стеки ;M
Содержимое файла f2am.asm не изменилось. Результат можно собрать с помощью fasm и запустить, но функционально не закончено, т.к. нет времени катастрофически. Собственно, дальше только форт-систему надо развивать(текущий код в следующем посте), а сам транслятор практически завершен.
Еще один промежуточный вариант. [pre]source file: f2a.fts [b][color=#808080]\ 2014.12.21 m0leg[/color]
[color=#0080C0]\! сделать реверс списка имен (не обязательно)[/color]
[color=#FF00FF]ALSO[/color] [color=#FF00FF]ROOT[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000]: .S[/color] .S [color=#FF8000];[/color] [color=#FF00FF]RECENT[/color]
[color=#00F000]memory/ buff.fts[/color] [color=#00F000]branch/ case.fts[/color] [color=#00F000]branch/ for-next.fts[/color]
[color=#808080]\ -- буфер для склейки строк ---------------------------------------------------[/color] [color=#FF8000]USER-VALUE outbuf[/color]
[color=#808080]\ создать буфер размером в 1 МБ (должно хватать)[/color] [color=#FF8000]: init-buf[/color] [color=#00F000]0x100000[/color] Buffer TO outbuf [color=#FF8000];[/color]
[color=#808080]\ освободить занятый буфер[/color] [color=#FF8000]: del-buf[/color] outbuf Retire [color=#FF8000];[/color]
[color=#808080]\ добавить в буфер строку текста[/color] [color=#FF8000]: +>buf[/color] [color=#0080C0]( asc # --> )[/color] outbuf >Buffer DROP [color=#FF8000];[/color]
[color=#808080]\ добавить одиночный символ в буфер[/color] [color=#FF8000]: ch>buf[/color] [color=#0080C0]( char --> )[/color] [color=#0000F0]<|[/color] [color=#0000F0]KEEP[/color] [color=#0000F0]|>[/color] +>buf [color=#FF8000];[/color]
[color=#808080]\ вернуть содержимое буфера[/color] [color=#FF8000]: buf>[/color] [color=#0080C0]( --> asc # )[/color] outbuf Buffer> [color=#FF8000];[/color]
[color=#808080]\ открыть буфер[/color] [color=#FF8000]: buf<[/color] [color=#0080C0]( --> )[/color] outbuf Clean [color=#FF8000];[/color]
[color=#808080]\ -- форматирование текста -----------------------------------------------------[/color]
[color=#808080]\ отступ от начала строки на два tab-а[/color] [color=#FF8000]: -|[/color] [color=#0080C0]( --> )[/color] [color=#00F000]s" \t\t"[/color] +>buf [color=#FF8000];[/color] [color=#808080]\ новая линия[/color] [color=#FF8000]: nl[/color] [color=#0080C0]( --> )[/color] [color=#00F000]s" \n\r"[/color] +>buf [color=#FF8000];[/color] [color=#808080]\ добавить строку с одним tab-ом в начале строки, завершить переводом строки[/color] [color=#FF8000]: +>>[/color] [color=#0080C0]( asc # --> )[/color] [color=#00F000]s" \t"[/color] +>buf +>buf nl [color=#FF8000];[/color] [color=#808080]\ добавить строку с двумя tab-ами в начале строки, завершить переводом строки[/color] [color=#FF8000]: +>l[/color] [color=#0080C0]( asc # --> )[/color] -| +>buf nl [color=#FF8000];[/color]
[color=#808080]\ добавить строку в выходной буфер[/color] [color=#FF8000]: o"[/color] [color=#0080C0]( / asc" --> asc # | )[/color] [color=#00F000][CHAR] "[/color] CookLine state [color=#00A0A0]IF[/color] SLIT, [color=#00F000]['] +>buf[/color] COMPILE, [color=#00A0A0]THEN[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color] [color=#808080]\ /--/--/ с табуляцией в начале и переводом строки в конце[/color] [color=#FF8000]: o|"[/color] [color=#0080C0]( / asc" --> asc # | )[/color] [color=#00F000][CHAR] "[/color] CookLine state [color=#00A0A0]IF[/color] SLIT, [color=#00F000]['] +>>[/color] COMPILE, [color=#00A0A0]THEN[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color] [color=#808080]\ /--/--/ с двумя табуляциями в начале и переводом строки в конце[/color] [color=#FF8000]: a"[/color] [color=#0080C0]( / asc" --> asc # | )[/color] [color=#00F000][CHAR] "[/color] CookLine state [color=#00A0A0]IF[/color] SLIT, [color=#00F000]['] +>l[/color] COMPILE, [color=#00A0A0]THEN[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ добавить число[/color] [color=#FF8000]: dd+[/color] [color=#0080C0]( n --> )[/color] [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] [color=#00F000]Bl_[/color] [color=#0000F0]HOLD[/color] [color=#00F000]0[/color] #S [color=#00F000]s" dd 0x"[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] +>buf [color=#FF8000];[/color] [color=#FF8000]: dq+[/color] [color=#0080C0]( d --> )[/color] [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] [color=#00F000]Bl_[/color] [color=#0000F0]HOLD[/color] #S [color=#00F000]s" dq 0x"[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] +>buf [color=#FF8000];[/color]
[color=#808080]\ -- сохранение содержимого в файл ---------------------------------------------[/color]
[color=#00F000]0[/color] [color=#FF8000]VALUE FId[/color]
[color=#808080]\ создать файл с заданным именем[/color] [color=#FF8000]: file[/color] [color=#0080C0]( asc # --> fid )[/color] W/O CREATE-FILE [color=#C00000]THROW[/color] TO FId [color=#FF8000];[/color]
[color=#808080]\ сохранить содержимое буфера в файл[/color] [color=#FF8000]: save[/color] [color=#0080C0]( fid --> )[/color] >L buf> L@ WRITE-FILE [color=#C00000]THROW[/color] L> CLOSE-FILE [color=#C00000]THROW[/color] [color=#FF8000];[/color]
[color=#808080]\ добавить содержимое указанного файла[/color] [color=#FF8000]: asmfile[/color] [color=#0080C0]( asc # --> )[/color] FILE>HEAP [color=#00A0A0]IFNOT[/color] [color=#C00000]ERROR" не могу прочесть файл"[/color] [color=#00A0A0]THEN[/color] OVER >L +>buf L> FREE [color=#C00000]THROW[/color] [color=#FF8000];[/color]
[color=#808080]\ -- создание новой метки ------------------------------------------------------[/color]
[color=#FF8000]USER-VALUE LastLab[/color]
[color=#FF8000]: l>name[/color] [color=#0080C0]( lab --> asc # )[/color] S>D [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] [color=#0000F0]#[/color] [color=#0000F0]#[/color] [color=#0000F0]#[/color] [color=#0000F0]#[/color] [color=#00F000]s" lab_"[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] [color=#FF8000];[/color]
[color=#808080]\ создать новую метку, вернуть имя[/color] [color=#FF8000]: label[/color] [color=#0080C0]( --> lab asc # )[/color] LastLab [color=#00F000]1[/color] + DUP TO LastLab DUP l>name [color=#FF8000];[/color]
[color=#808080]\ преобразовать специальный символ в строковое представление и добавить[/color] [color=#808080]\ результат в буфер PAD[/color] [color=#FF8000]: ?ADDCHAR[/color] [color=#0080C0]( ch --> )[/color] CASE [color=#00F000][CHAR] ,[/color] OF [color=#00F000]s" Compile"[/color] ENDOF [color=#00F000][CHAR] ![/color] OF [color=#00F000]s" Store"[/color] ENDOF [color=#00F000][CHAR] ?[/color] OF [color=#00F000]s" Question"[/color] ENDOF [color=#00F000][CHAR] @[/color] OF [color=#00F000]s" Fetch"[/color] ENDOF [color=#00F000][CHAR] '[/color] OF [color=#00F000]s" Deref"[/color] ENDOF [color=#00F000][CHAR] ;[/color] OF [color=#00F000]s" Semicolon"[/color] ENDOF [color=#00F000][CHAR] .[/color] OF [color=#00F000]s" Peroid"[/color] ENDOF [color=#00F000][CHAR] :[/color] OF [color=#00F000]s" Colon"[/color] ENDOF [color=#00F000][CHAR] >[/color] OF [color=#00F000]s" To"[/color] ENDOF [color=#00F000][CHAR] +[/color] OF [color=#00F000]s" Plus"[/color] ENDOF [color=#00F000][CHAR] -[/color] OF [color=#00F000]s" Minus"[/color] ENDOF [color=#00F000][CHAR] =[/color] OF [color=#00F000]s" Equal"[/color] ENDOF [color=#00F000][CHAR] #[/color] OF [color=#00F000]s" Size"[/color] ENDOF [color=#00F000][CHAR] "[/color] OF [color=#00F000]s" Quote"[/color] ENDOF [color=#00F000][CHAR] <[/color] OF [color=#00F000]s" Less"[/color] ENDOF [color=#00F000][CHAR] /[/color] OF [color=#00F000]s" Slash"[/color] ENDOF [color=#00F000][CHAR] \[/color] OF [color=#00F000]s" Backslash"[/color] ENDOF [color=#00F000][CHAR] ?[/color] OF [color=#00F000]s" Question"[/color] ENDOF [color=#00F000][CHAR] [[/color] OF [color=#00F000]s" lStap"[/color] ENDOF [color=#00F000][CHAR] ][/color] OF [color=#00F000]s" rStap"[/color] ENDOF [color=#00F000][CHAR] ([/color] OF [color=#00F000]s" lPar"[/color] ENDOF [color=#00F000][CHAR] )[/color] OF [color=#00F000]s" rPar"[/color] ENDOF [color=#00F000][CHAR] {[/color] OF [color=#00F000]s" lBr"[/color] ENDOF [color=#00F000][CHAR] }[/color] OF [color=#00F000]s" rBr"[/color] ENDOF [color=#00F000][CHAR] ~[/color] OF [color=#00F000]s" Show"[/color] ENDOF [color=#00F000][CHAR] |[/color] OF [color=#00F000]s" Wall"[/color] ENDOF [color=#00F000][CHAR] `[/color] OF [color=#00F000]s" Tick"[/color] ENDOF [color=#00F000][CHAR] *[/color] OF [color=#00F000]s" Star"[/color] ENDOF [color=#0000F0]HOLD[/color] [color=#00F000]s" "[/color] ENDCASE [color=#0000F0]HOLDS[/color] [color=#FF8000];[/color]
[color=#808080]\ преобразовать Форт-имя в метку[/color] [color=#FF8000]: name>label[/color] [color=#0080C0]( asc # --> asc # )[/color] OVER + [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] [color=#00A0A0]BEGIN[/color] DDUP < [color=#00A0A0]WHILE[/color] [color=#00F000]1[/color] - DUP C@ ?ADDCHAR [color=#00A0A0]REPEAT[/color] [color=#0000F0]#>[/color] [color=#FF8000];[/color]
[color=#808080]\[/color] [color=#FF8000]: label,[/color] [color=#0080C0]( asc # --> asc # )[/color] name>label DDUP SLIT, [color=#FF8000];[/color] [color=#808080]\[/color] [color=#FF8000]: name'[/color] [color=#0080C0]( / name --> )[/color] NextWord label, DROP [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ -- создание рабочих словарей и слов для работы с ними ------------------------[/color]
[color=#808080]\ ячейка для хранения последнего распознанного числа[/color] USER-CREATE LastNumber [color=#00F000]2[/color] CELLS USER-ALLOT
[color=#808080]\ обработка чисел одинарной длины[/color] [color=#FF8000]: (tLit)[/color] [color=#0080C0]( --> n )[/color] LastNumber @ state [color=#00A0A0]IF[/color] o" \t\tCALL _" [color=#00F000]s" (LIT)"[/color] name>label +>buf nl -| dd+ nl [color=#00A0A0]THEN[/color] [color=#0080C0]\! вместо dq должен быть код литерала[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color] [color=#808080]\ обработка чисел двойной длины[/color] [color=#FF8000]: (tdLit)[/color] [color=#0080C0]( --> d )[/color] LastNumber D@ state [color=#00A0A0]IF[/color] o" \t\tCALL _" [color=#00F000]s" (DLIT)"[/color] name>label +>buf nl -| dq+ nl [color=#00A0A0]THEN[/color] [color=#0080C0]\! вместо dq должен быть код литерала[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ попытаться распознать строку asc # , как число,[/color] [color=#808080]\ в случае успеха вернуть lfa слова, ассоциируемого с числом[/color] [color=#FF8000]: tNumLfa[/color] [color=#0080C0]( asc # vid --> lfa | 0 )[/color] DROP [color=#808080]\ vid словаря не нужен[/color] [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] snNumber [color=#00A0A0]*IF[/color] [color=#00F000]1[/color] - [color=#00A0A0]IF[/color] LastNumber D! LFA (tdLit) [color=#00A0A0]ELSE[/color] LastNumber ! LFA (tLit) [color=#00A0A0]THEN[/color] [color=#00A0A0]THEN[/color] [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#FF8000];[/color]
[color=#808080]\ создание словаря, распознающего числа[/color] [color=#FF8000]init: VOCABULARY[/color] [color=#808080]\ создаем стандартный словарь и правим поля[/color] [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] VOC-LIST A@ >L [color=#808080]\ wordlist[/color] [color=#00F000]['] tNumLfa[/color] L@ off_quest A! [color=#00F000]0[/color] L@ off_vtable A! [color=#808080]\ отсутствует vtable[/color] [color=#00F000]0[/color] L@ off_last A! [color=#808080]\ слов в словаре нет[/color] [color=#00F000]['] no-mount[/color] L@ off_mount A! [color=#00F000]['] no-umount[/color] L@ off_umount A! &vinit L> off_vflags B! [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#FF8000];stop[/color] TNUMBERS [color=#808080]\ словарь для работы с числами[/color]
[color=#FF8000]VOCABULARY MACRO[/color] [color=#808080]\ словарь для хранения макросов[/color] [color=#FF8000]VOCABULARY TARGET[/color] [color=#808080]\ словарь для хранения имен[/color]
[color=#808080]\ показать список определений[/color] [color=#808080]\ чтобы можно было использовать отовюсду размещается в корневом словаре[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]ROOT[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000]: ~LIST[/color] ORDER CR [color=#FF00FF]ALSO[/color] TARGET WORDS [color=#FF00FF]PREVIOUS[/color] CR [color=#FF8000];[/color] [color=#FF00FF]PREVIOUS[/color] [color=#FF00FF]DEFINITIONS[/color]
[color=#808080]\ -- ---------------------------------------------------------------------------[/color]
[color=#00F000]0[/color] [color=#FF8000]VALUE LASTDEF[/color] [color=#808080]\ хранит lfa последнего определения в TARGET[/color]
[color=#808080]\ проверка режима компиляции[/color] [color=#FF8000]: ?COMP[/color] [color=#0080C0]( --> )[/color] state [color=#00A0A0]IF[/color] [color=#FF8000];THEN[/color] [color=#C00000]ERROR" Только для режима компиляции!"[/color] [color=#FF8000];[/color]
[color=#808080]\ завершить создание макроса[/color] [color=#FF8000]: ;M[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] ;[/color] [color=#C00000]IMMEDIATE[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ начать создание макроса с указанным именем[/color] [color=#FF8000]: (:)[/color] [color=#0080C0]( asc # --> )[/color] [color=#FF00FF]ALSO[/color] MACRO [color=#FF00FF]DEFINITIONS[/color] [color=#FF00FF]PREVIOUS[/color] [color=#FF8000]S: ;[/color]
[color=#808080]\ завершить создание теневого определения в TARGET[/color] [color=#FF8000]: ;C[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] ;[/color] [color=#C00000]IMMEDIATE[/color] LATEST TO LASTDEF [color=#808080]\ для того, чтобы удобно работать с флагами[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ создать теневое определение в TARGET[/color] [color=#FF8000]: (C:)[/color] [color=#0080C0]( asc # --> )[/color] [color=#FF00FF]ALSO[/color] TARGET [color=#FF00FF]DEFINITIONS[/color] [color=#FF00FF]PREVIOUS[/color] [color=#FF8000]S: ;[/color]
[color=#808080]\ начать создание макроса[/color] [color=#FF8000]: M:[/color] [color=#0080C0]( /name --> )[/color] NextWord (:) [color=#FF8000];[/color]
[color=#FF8000]: LastDef[/color] [color=#0080C0]( --> id )[/color] WHO TARGET LAST-NAME [color=#FF8000];[/color]
[color=#808080]\ вернуть имя последнего определения[/color] [color=#FF8000]: LastDef>[/color] [color=#0080C0]( --> asc # )[/color] LastDef ID>ASC name>label [color=#FF8000];[/color]
[color=#808080]\[/color] [color=#FF8000]: name+>buf[/color] [color=#0080C0]( asc # --> )[/color] o" _" name>label +>buf [color=#FF8000];[/color]
[color=#808080]\ добавить имя в словарь TARGET, и соответствующую метку в листинг[/color] [color=#FF8000]: AddName[/color] [color=#0080C0]( /name --> )[/color] NextWord DDUP (C:) label, [color=#FF8000]<: o"[/color] \t\tCALL _" +>buf nl [color=#FF8000];>[/color] COMPILE, [color=#00F000][COMPILE] ;C[/color] o" _" +>buf [color=#FF8000];[/color]
[color=#808080]\ секция импорта[/color] [color=#FF8000]: ImportSect[/color] [color=#0080C0]( --> )[/color] nl o" section '.import' import data readable writeable" nl nl o" library kernel,'KERNEL32.DLL'" nl nl o" import kernel,\\" nl o|" LoadLibrary, 'LoadLibrary',\\" o|" GetProcAddress, 'GetProcAddress',\\" o|" ExitProcess, 'ExitProcess',\\" o|" GetStdHandle, 'GetStdHandle',\\" o|" WriteFile, 'WriteFile',\\" o|" ReadFile, 'ReadFile'" [color=#FF8000];[/color]
[color=#808080]\ преамбула[/color] [color=#FF8000]: Preambula[/color] [color=#0080C0]( --> )[/color] o" format PE console" nl nl o|" include 'include\\win32a.inc'" o|" include 'include\\macro\\struct.inc'" nl ImportSect [color=#FF8000];[/color]
[color=#808080]\ начать трансляцию текста[/color] [color=#FF8000]: TRANSLATE:[/color] [color=#0080C0]( /name --> )[/color] NextWord [color=#0000F0]<|[/color] [color=#00F000]s" D:/ASM/FASM/"[/color] [color=#0000F0]KEEPS[/color] [color=#0000F0]KEEPS[/color] [color=#00F000]s" .asm"[/color] [color=#0000F0]KEEPS[/color] [color=#00F000]0[/color] [color=#0000F0]KEEP[/color] [color=#0000F0]|>[/color] file init-buf [color=#FF00FF]ONLY[/color] [color=#FF00FF]PREVIOUS[/color] TNUMBERS [color=#FF00FF]ALSO[/color] TARGET [color=#FF00FF]DEFINITIONS[/color] [color=#FF00FF]ALSO[/color] MACRO Preambula nl [color=#00F000]s" f2a_m.asm"[/color] asmfile [color=#808080]\ содержимое Preambula можно сразу внутрь f2a_m.asm[/color] [color=#808080]\ код и данные хранятся вместе в одном сегменте, а словарь размещается в отдельном[/color] nl o" section '.fvm' code executable readable writeable" nl [color=#FF8000];[/color]
[color=#808080]\ проверка, установлен ли признак немедленного исполнения[/color] [color=#FF8000]: ?IMM[/color] [color=#0080C0]( lfa --> asc # | 0 )[/color] [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] &ALS @ATTR [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#FF8000];[/color]
[color=#808080]\ создать список имен[/color] [color=#FF8000]: MakeVoc[/color] [color=#0080C0]( asc # --> )[/color] nl nl o" section '.names' data readable writeable" nl o" [color=#FF8000];[/color] makevoc " +>buf nl nl o" [color=#FF8000];[/color] Имя, Метка, Флаг immediate"
LastDef [color=#00A0A0]BEGIN[/color] [color=#00A0A0]*WHILE[/color] nl o" def \'" DUP ID>ASC DDUP +>buf o" ', _" name>label +>buf o" , " DUP ?IMM [color=#00A0A0]IF[/color] o" -1" [color=#00A0A0]ELSE[/color] o" 1" [color=#00A0A0]THEN[/color] LINK> [color=#00A0A0]REPEAT[/color] DROP nl o" [color=#FF8000]LATEST: ;[/color] чтобы получить хвост цепочки имен" nl o" NSADDR:" nl o" allot NamesSpace-($-$$) [color=#FF8000];"[/color] nl [color=#FF8000];[/color]
[color=#808080]\ создать список имен в секции импорта, таким образом в отладчике будет видно[/color] [color=#808080]\ имя каждого определения[/color] [color=#FF8000]: MakeExp[/color] [color=#0080C0]( asc # --> )[/color] nl nl o" section '.edata' export data readable" nl o" export '" +>buf o" '"
LastDef [color=#00A0A0]BEGIN[/color] [color=#00A0A0]*WHILE[/color] o" ,\\\n\r" DUP o" _" ID>ASC DDUP name>label +>buf o" ,'" +>buf o" '" LINK> [color=#00A0A0]REPEAT[/color] DROP
nl nl [color=#FF8000];[/color]
[color=#808080]\ сохранить содержимое буфера в файл[/color] [color=#FF8000]: aSave[/color] [color=#0080C0]( --> )[/color] FId save del-buf [color=#FF8000];[/color]
[color=#808080]\ -- ---------------------------------------------------------------------------[/color] [color=#0080C0]\! Все определения, заканчивающиеся ;M являются словами немедленного исполнения[/color]
[color=#808080]\ коментарий в скобках копируем в коментарий целевого asm[/color] [color=#FF8000]M: ([/color] [color=#0080C0]( /comment string --> )[/color] o" [color=#FF8000];[/color] [color=#0080C0]( " BEGIN NEXT-WORD DDUP +>buf o" " *WHILE + <C C@ [CHAR] )[/color] <> [color=#00A0A0]WHILE[/color] [color=#00A0A0]REPEAT[/color] nl [color=#FF8000];THEN[/color] DDROP [color=#808080]\ если закрывающая скобка не встретилась до конца файла[/color] [color=#FF8000];M[/color]
[color=#808080]\ завершить трансляцию текста[/color] [color=#FF8000]M: ;TRANSLATE[/color] [color=#0080C0]( --> )[/color] [color=#808080]\ точкой входа считаем последнее определение в тексте[/color] nl o" entry _COLD [color=#FF8000];[/color] точка входа" nl [color=#00F000]s" FORTH"[/color] DDUP MakeVoc [color=#808080]\ создание словаря[/color] MakeExp [color=#808080]\ чтобы создать список имен в секции экспорта[/color] aSave [color=#FF00FF]ONLY[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000];M[/color]
[color=#808080]\ создать метку с именем name в тексте[/color] [color=#FF8000]M: LABEL:[/color] [color=#0080C0]( /name --> )[/color] NextWord DDUP +>buf [color=#00F000]s" : "[/color] +>buf DDUP (:) SLIT, [color=#FF8000]<: nl[/color] o" \t\tCALL _" [color=#00F000]s" (LIT)"[/color] name>label +>buf nl o" \t\t dd " [color=#00F000][COMPILE] +>buf[/color] nl [color=#FF8000];>[/color] COMPILE, [color=#00F000][COMPILE] ;M[/color] [color=#FF8000];M[/color]
[color=#808080]\ завершить определение без добавления RET В конец определения[/color] [color=#FF8000]M: ;-[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] ;C[/color] nl [color=#FF8000];M[/color]
[color=#808080]\ компилировать условный переход вперед на парный THEN или ELSE[/color] [color=#FF8000]M: IF[/color] [color=#0080C0]( --> label )[/color] ?COMP o" \t\tCALL " [color=#00F000]s" ?BRANCH"[/color] name+>buf nl o" \t\tdd " label +>buf nl NOTICE" Непарная конструкция!" [color=#FF8000];M[/color]
[color=#808080]\ завершение ветвления[/color] [color=#FF8000]M: THEN[/color] [color=#0080C0]( label par --> )[/color] ?COMP ?PAIRS" Непарная конструкция!" l>name +>buf o" :" nl [color=#FF8000];M[/color]
[color=#808080]\ компилировать безусловный переход на парный THEN[/color] [color=#FF8000]M: ELSE[/color] [color=#0080C0]( label_a --> label_b )[/color] ?COMP ?PAIRS" Непарная конструкция!" o" \tCALL " [color=#00F000]s" BRANCH"[/color] name+>buf nl o" \t\tdd " label +>buf nl SWAP l>name +>buf o" :" nl NOTICE" Непарная конструкция!" [color=#FF8000];M[/color]
[color=#808080]\ создать безымянную метку для перехода назад[/color] [color=#FF8000]M: BEGIN[/color] [color=#0080C0]( --> lab p )[/color] ?COMP label +>buf o" :\t; метка для перехода назад" nl NOTICE" Не обнаружена метка для перехода назад!" [color=#FF8000];M[/color]
[color=#808080]\ компилировать выход из тела цикла[/color] [color=#FF8000]M: WHILE[/color] [color=#0080C0]( lab p --> lab p lab1 p )[/color] ?COMP DUP ?PAIRS" Не обнаружена метка для перехода назад!" o" \t\tCALL " [color=#00F000]s" ?BRANCH"[/color] name+>buf nl o" \t\tdd " label +>buf nl NOTICE" Непарная конструкция!" DSWAP [color=#FF8000];M[/color]
[color=#808080]\ компилировать выход из тела цикла[/color] [color=#FF8000]M: WHILENOT[/color] [color=#0080C0]( lab p --> lab p lab1 p )[/color] ?COMP DUP ?PAIRS" Не обнаружена метка для перехода назад!" o" \t\tCALL " [color=#00F000]s" N?BRANCH"[/color] name+>buf nl o" \t\tdd " label +>buf nl NOTICE" Непарная конструкция!" DSWAP [color=#FF8000];M[/color]
[color=#808080]\ Компилировать переход назад на BEGIN[/color] [color=#FF8000]M: REPEAT[/color] [color=#0080C0]( lab p lab1 p --> )[/color] ?COMP ?PAIRS" Не обнаружена метка для перехода назад!" o" \tJMP " l>name +>buf o" [color=#FF8000];[/color] переход назад" nl ?PAIRS" Непарная конструкция!" l>name +>buf o" :" nl [color=#FF8000];M[/color]
[color=#808080]\ создать безусловный переход назад на метку lab[/color] [color=#FF8000]M: AGAIN[/color] [color=#0080C0]( lab p --> )[/color] ?COMP ?PAIRS" Не обнаружена метка для перехода назад!" o" \tJMP " l>name +>buf o" [color=#FF8000];[/color] переход назад" nl [color=#FF8000];M[/color]
[color=#808080]\ начать целевое определение[/color] [color=#FF8000]M: :[/color] [color=#0080C0]( / name --> )[/color] o" align" nl NextWord DDUP (C:) label, [color=#FF8000]<: o"[/color] \t\tCALL _" +>buf nl [color=#FF8000];>[/color] COMPILE, o" _" +>buf o" [color=#FF8000]: "[/color] [color=#FF8000];M[/color]
[color=#808080]\ завершить определение с добавлением RET В конец определения[/color] [color=#FF8000]M: ;[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] ;C[/color] o" \t RET " nl nl [color=#FF8000];M[/color]
[color=#808080]\ коментарий до конца строки копируется в целевой asm файл[/color] [color=#FF8000]M: \[/color] [color=#0080C0]( --> )[/color] [color=#00F000]-1[/color] >IN +! o" [color=#FF8000];[/color] " [color=#00F000]Cr_[/color] PARSE +>buf nl [color=#FF8000];M[/color]
[color=#808080]\ создать имя, возвращающее адрес собственного поля параметров[/color] [color=#FF8000]M: CREATE[/color] [color=#0080C0]( /name --> )[/color] o" trialign" nl AddName o" [color=#FF8000]: CALL[/color] _" [color=#00F000]s" (CREATE)"[/color] name>label +>buf nl [color=#FF8000];M[/color]
[color=#808080]\ создать именованную переменную[/color] [color=#FF8000]M: VARIABLE[/color] [color=#0080C0]( /name --> )[/color] o" trialign" nl AddName o" [color=#FF8000]: CALL[/color] _" [color=#00F000]s" (CREATE)"[/color] name>label +>buf nl o" \tdd 0" nl nl [color=#FF8000];M[/color]
[color=#808080]\ создать именованную константу[/color] [color=#FF8000]M: CONSTANT[/color] [color=#0080C0]( n /name --> )[/color] o" trialign" nl DUP >L NextWord DDUP (C:) L> LIT, label, [color=#FF8000]<: state[/color] [color=#00A0A0]IF[/color] o" \t\tCALL _" +>buf nl [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] DROP [color=#FF8000];>[/color] COMPILE, [color=#00F000][COMPILE] ;C[/color] o" _" +>buf o" [color=#FF8000]: CALL[/color] _" [color=#00F000]s" (CONSTANT)"[/color] name>label +>buf nl o" \t" dd+ nl nl [color=#FF8000];M[/color]
[color=#808080]\ резервировать указанное количество минимально адресуемых ячеек памяти[/color] [color=#808080]\ в пространстве кода и данных[/color] [color=#FF8000]M: ALLOT[/color] [color=#0080C0]( u --> )[/color] [color=#00F000]1[/color] OVER > [color=#C00000]ABORT" должно быть быть больше 0"[/color] o" \tdb 0" [color=#00F000]1[/color] - [color=#00A0A0]*IF[/color] FOR R@ [color=#00F000]34[/color] MOD [color=#00A0A0]IFNOT[/color] o" \n\r\tdb 0" [color=#00A0A0]ELSE[/color] o" ,0" [color=#00A0A0]THEN[/color] [color=#808080]\ заполняется нулями[/color] TILL [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] nl nl [color=#FF8000];M[/color]
[color=#808080]\ отметить последнее определение признаком немедленного исполнения[/color] [color=#FF8000]M: IMMEDIATE[/color] [color=#0080C0]( --> )[/color] [color=#00F000]TRUE[/color] LASTDEF [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] &ALS SET-ATTR [color=#808080]\ т.к. IMMEDIATE уже занят используется &ALS[/color] [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#C00000]THROW[/color] [color=#FF8000];M[/color]
[color=#808080]\ добавить литеральное значение символа в текущее определение[/color] [color=#FF8000]M: [CHAR][/color] [color=#0080C0]( / ch --> )[/color] NextWord DROP C@ o" \t\tCALL _" [color=#00F000]s" (LIT)"[/color] name>label +>buf nl -| dd+ nl [color=#FF8000];M[/color]
[color=#808080]\ компилировать в текущее определение указанное имя[/color] [color=#FF8000]M: [COMPILE][/color] [color=#0080C0]( /name --> )[/color] o" \t\tCALL _" NextWord name>label +>buf nl [color=#FF8000];M[/color]
[color=#808080]\ добавить текстовую строку в текущее определение,[/color] [color=#808080]\ при выполнении участка кода возвращается адрес asc и длина #[/color] [color=#FF8000]M: S"[/color] [color=#0080C0]( / ascii" --> | asc # )[/color] [color=#00F000][CHAR] "[/color] CookLine state [color=#00A0A0]IF[/color] o" \t\tCALL _" [color=#00F000]s" (SLIT)"[/color] name>label +>buf nl DUP o" \t\t" dd+ nl [color=#00A0A0]*IF[/color] o" \t\t db " FOR DUP C@ [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] S>D #S [color=#00F000]s" 0x"[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] +>buf R@ [color=#00F000]16[/color] MOD [color=#00A0A0]IFNOT[/color] nl o" \t\t db " [color=#00A0A0]ELSE[/color] o" ," [color=#00A0A0]THEN[/color] [color=#00F000]1[/color] + TILL DROP [color=#00A0A0]ELSE[/color] DDROP [color=#00A0A0]THEN[/color] [color=#00A0A0]THEN[/color] o" 0x00" nl [color=#FF8000];M[/color]
[color=#808080]\ преобразовать количество ячеек в количество байт[/color] [color=#FF8000]M: CELLS[/color] [color=#0080C0]( u --> u*cell )[/color] state [color=#00A0A0]IF[/color] a" SAR EAX, 2" [color=#00A0A0]ELSE[/color] CELL * [color=#00A0A0]THEN[/color] [color=#FF8000];M[/color]
[color=#808080]\ -- определение примитивов ----------------------------------------------------[/color]
[color=#808080]\ прерывание INT 3 - для отладки[/color] [color=#FF8000]M: INT3[/color] a" INT3" [color=#FF8000];M[/color]
[color=#808080]\ вызов экспортируемых функций. Все параметры должны лежать на стеке данных[/color] [color=#FF8000]M: CallAPI[/color] a" MOV dword [fs:0x14], ESP" a" MOV ESP, EBP" a" CALL EAX" a" MOV EBP, ESP" a" MOV ESP, dword [fs:0x14]" a" LEA EBP, [EBP+CELL]" [color=#FF8000];M[/color]
[color=#808080]\ получение адреса функций АПИ[/color] [color=#FF8000]M: 'GetStdHandle[/color] a" MOV EAX, dword [GetStdHandle]" [color=#FF8000];M[/color] [color=#FF8000]M: 'WriteFile[/color] a" MOV EAX, dword [WriteFile]" [color=#FF8000];M[/color] [color=#FF8000]M: 'ReadFile[/color] a" MOV EAX, dword [ReadFile]" [color=#FF8000];M[/color]
[color=#808080]\ макросы для работы со стеком[/color] [color=#FF8000]M: CPY[/color] a" MOV EAX, [EBP]" [color=#FF8000];M[/color] [color=#808080]\ копировать значение второго элеметна стека данных в TOS[/color] [color=#FF8000]M: SKP[/color] a" MOV EAX, [EBP+CELL]" a" LEA EBP, [EBP+8]" [color=#FF8000];M[/color] [color=#FF8000]M: ROOM[/color] a" LEA EBP, [EBP-CELL]" [color=#FF8000];M[/color] [color=#808080]\ определение стековых манипуляций[/color] [color=#FF8000]M: NIP[/color] a" LEA EBP, [EBP+CELL]" [color=#FF8000];M[/color] [color=#FF8000]M: DROP[/color] a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" [color=#FF8000];M[/color] [color=#FF8000]M: DDROP[/color] a" MOV EAX, [EBP+CELL]" a" LEA EBP, [EBP+CELL*2]" [color=#FF8000];M[/color] [color=#FF8000]M: SWAP[/color] a" MOV EDX, EAX" a" MOV EAX, [EBP]" a" MOV dword [EBP], EDX" [color=#FF8000];M[/color] [color=#FF8000]M: DUP[/color] a" LEA EBP, [EBP-CELL]" a" MOV dword [EBP], EAX" [color=#FF8000];M[/color] [color=#FF8000]M: DDUP[/color] a" MOV EDX, [EBP]" a" MOV [EBP-CELL], EAX" a" MOV [EBP-CELL*2], EDX" a" LEA EBP, [EBP-CELL*2]" [color=#FF8000];M[/color] [color=#FF8000]M: OVER[/color] a" MOV EDX, [EBP]" a" LEA EBP, [EBP-CELL]" a" MOV dword [EBP], EAX" a" MOV EAX, EDX" [color=#FF8000];M[/color] [color=#FF8000]M: ROT[/color] a" MOV EDX, [EBP]" a" MOV [EBP], EAX" a" MOV EAX, [EBP+CELL]" a" MOV dword [EBP+CELL], EDX" [color=#FF8000];M[/color] [color=#808080]\ работа с памятью[/color] [color=#FF8000]M: @[/color] a" MOV EAX, [EAX]" [color=#FF8000];M[/color] [color=#FF8000]M: STORE[/color] a" MOV EDX, [EBP]" a" MOV dword [EAX], EDX" [color=#FF8000];M[/color] [color=#FF8000]M: B@[/color] a" MOVZX EAX, byte [EAX]" [color=#FF8000];M[/color] [color=#FF8000]M: STOREB[/color] a" MOV EDX, [EBP]" a" MOV byte [EAX], DL" [color=#FF8000];M[/color] [color=#808080]\ литеральные значения[/color] [color=#FF8000]M: GETLIT[/color] a" LEA EDX, [EAX+CELL]" a" MOV EAX, [EAX]" [color=#808080]\ оставить на вершине стека данных литерал[/color] o|" JMP EDX" [color=#FF8000];M[/color] [color=#808080]\ обойти в коде литеральное значение[/color] [color=#FF8000]M: GETDLIT[/color] a" LEA EDX, [EAX+CELL*2]" a" MOV EBX, [EAX]" a" MOV EAX, [EAX+CELL]" a" MOV dword [EBP], EBX" o|" JMP EDX" [color=#FF8000];M[/color] [color=#FF8000]M: GETALIT[/color] a" LEA EDX, [EAX+TOKEN]" a" MOV EAX, [EAX+1]" o|" JMP EDX" [color=#FF8000];M[/color] [color=#FF8000]M: (SLIT)[/color] a" LEA EBP, [EBP-8]" a" MOV dword [EBP+CELL], EAX" a" POP EBX" a" LEA EDX, [EBX+CELL]" a" MOV dword [EBP], EDX" a" MOV EAX, [EBX]" a" LEA EDX, [EBX+EAX+TOKEN]" o|" JMP EDX" [color=#FF8000];M[/color] [color=#808080]\ математика и логика[/color] [color=#FF8000]M: PLUS[/color] a" ADD EAX, [EBP]" [color=#FF8000];M[/color] [color=#FF8000]M: MINUS[/color] a" MOV EDX, [EBP]" a" SUB EDX, EAX" a" MOV EAX, EDX" [color=#FF8000];M[/color] [color=#FF8000]M: OR[/color] a" OR EAX, [EBP]" a" LEA EBP, [EBP+CELL]" [color=#FF8000];M[/color] [color=#FF8000]M: 0=[/color] a" SUB EAX, 1" a" SBB EAX, EAX" [color=#FF8000];M[/color] [color=#FF8000]M: more[/color] a" CMP EAX, [EBP]" a" SETGE AL" a" AND EAX, 1" a" DEC EAX" [color=#FF8000];M[/color] [color=#FF8000]M: less[/color] a" CMP EAX, [EBP]" a" SETLE AL" a" AND EAX, 1" a" DEC EAX" [color=#FF8000];M[/color] [color=#FF8000]M: U>[/color] a" CMP EAX, [EBP]" a" SBB EAX, EAX" a" LEA EBP, [EBP+CELL]" [color=#FF8000];M[/color] [color=#FF8000]M: UM/MOD[/color] a" MOV ECX, EAX" a" MOV EDX, [EBP]" a" MOV EAX, [EBP+CELL]" a" DIV ECX" a" LEA EBP, [EBP+CELL]" a" MOV dword [EBP], EDX" [color=#FF8000];M[/color] [color=#FF8000]M: /[/color] a" MOV ECX, EAX" a" MOV EAX, [EBP]" a" CDQ" a" IDIV ECX" a" LEA EBP, [EBP+CELL]" [color=#FF8000];M[/color] [color=#FF8000]M: S>D[/color] a" CDQ" a" LEA EBP, [EBP-CELL]" a" MOV [EBP], EAX" a" MOV EAX, EDX" [color=#FF8000];M[/color] [color=#FF8000]M: ABS[/color] a" MOV EDX, EAX" a" SAR EDX, 31" a" ADD EAX, EDX" a" XOR EAX, EDX" [color=#FF8000];M[/color] [color=#FF8000]M: MIN_[/color] a" CMP EAX, [EBP]" o|" JL _2st" a" MOV EAX, [EBP]" a" [color=#FF8000]_2st: LEA[/color] EBP, [EBP+CELL]" [color=#FF8000];M[/color]
[color=#808080]\ перемещение между стеками[/color] [color=#FF8000]M: TOSP[/color] a" MOV EBP, EAX" [color=#FF8000];M[/color] [color=#FF8000]M: SP@[/color] a" MOV EDX, EAX" a" MOV EAX, EBP" a" LEA EBP, [EBP-CELL]" a" MOV dword [EBP], EDX" [color=#FF8000];M[/color] [color=#FF8000]M: TORP[/color] a" POP EDX" a" MOV ESP, EAX" a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" o|" JMP EDX" [color=#FF8000];M[/color] [color=#FF8000]M: ATRP[/color] a" MOV EAX, ESP" [color=#FF8000];M[/color] [color=#FF8000]M: TOR[/color] a" POP EDX" a" PUSH EAX" a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" o|" JMP EDX" [color=#FF8000];M[/color] [color=#FF8000]M: FROMR[/color] a" POP EDX" a" POP EAX" o|" JMP EDX" [color=#FF8000];M[/color] [color=#FF8000]M: RVAR[/color] a" POP EAX" [color=#FF8000];M[/color] [color=#808080]\ вернуть адрес следующей ячейки на вершину стека данных[/color] [color=#FF8000]M: PSFA[/color] a" MOV EDX, [EAX]" [color=#808080]\ увеличит значение ячейки на указанную величину,[/color] a" ADD EDX, [EBP]" a" MOV dword [EAX], EDX" [color=#808080]\ оставить на вершине стека данных полученное значение[/color] a" MOV EAX, EDX" [color=#FF8000];M[/color] [color=#808080]\ ветвления[/color] [color=#FF8000]M: BR[/color] a" POP EDX" o|" JMP dword [EDX]" [color=#FF8000];M[/color] [color=#FF8000]M: ?BR[/color] a" OR EAX, EAX" a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" o" \tJZ " [color=#00F000]s" BRANCH"[/color] name+>buf nl a" POP EDX" a" LEA EDX, [EDX+CELL]" o|" JMP EDX" [color=#FF8000];M[/color] [color=#FF8000]M: N?BR[/color] a" OR EAX, EAX" a" MOV EAX, [EBP]" a" LEA EBP, [EBP+CELL]" o" \tJNZ " [color=#00F000]s" BRANCH"[/color] name+>buf nl a" POP EDX" a" LEA EDX, [EDX+CELL]" o|" JMP EDX" [color=#FF8000];M[/color] [color=#FF8000]M: EXIT_[/color] a" LEA ESP, [ESP+CELL]" [color=#FF8000];M[/color]
[color=#808080]\ настройка системы перед запуском[/color] [color=#FF8000]M: STARTUP[/color] a" LEA EBP, [EBP-256]" [color=#808080]\ раздвинуть стеки[/color] [color=#FF8000];M[/color] [/b][/pre] Содержимое файла f2am.asm не изменилось. Результат можно собрать с помощью fasm и запустить, но функционально не закончено, т.к. нет времени катастрофически. Собственно, дальше только форт-систему надо развивать(текущий код в следующем посте), а сам транслятор практически завершен.
|
|
|
|
Добавлено: Вт янв 20, 2015 19:56 |
|
|
|
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
VoidVolker писал(а): Компиляция асм кода из первого поста в FASM проходит успешно, но при старте приложения оно вылетает. Win7 x64. Дык, оно ж не закончено пока, как система (можно было бы в код заглянуть, что сделано-то :shuffle; а что еще не сделано, вот ). В дебаге можно посмотреть что делатется, пока не более того. Сейчас WriteFile не совсем корректно вызывается (не правильно параметры скармливаются), при желании можно поправить или дописать 8) (фиксация промежуточного результата, т.к. не знаю, будет ли еще время этим заниматься). А главное пока что в Иллюстрации подхода к реализации
[quote="VoidVolker"]Компиляция асм кода из первого поста в FASM проходит успешно, но при старте приложения оно вылетает. Win7 x64.[/quote] Дык, оно ж не закончено пока, как система (можно было бы в код заглянуть, что сделано-то :shuffle; а что еще не сделано, вот ). В дебаге можно посмотреть что делатется, пока не более того. Сейчас WriteFile не совсем корректно вызывается (не правильно параметры скармливаются), при желании можно поправить или дописать 8) (фиксация промежуточного результата, т.к. не знаю, будет ли еще время этим заниматься). А главное пока что в Иллюстрации подхода к реализации
|
|
|
|
Добавлено: Ср дек 31, 2014 07:16 |
|
|
|
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
VoidVolker писал(а): Компиляция асм кода из первого поста в FASM проходит успешно, но при старте приложения оно вылетает. Win7 x64. Можно сравнить результаты запуска с вариантом форт системы на Fasм со встоенным SPF4 (Михаила) У меня были тоже какие то проблемы с запуском его в Win7/64 в сравнении с XP, в частности это проявлялось в неработоспособности (или некорректного поведения) консольного АPI по сравнению с XP.
[quote="VoidVolker"]Компиляция асм кода из первого поста в FASM проходит успешно, но при старте приложения оно вылетает. Win7 x64.[/quote] Можно сравнить результаты запуска с вариантом форт системы на Fasм со встоенным SPF4 (Михаила) У меня были тоже какие то проблемы с запуском его в Win7/64 в сравнении с XP, в частности это проявлялось в неработоспособности (или некорректного поведения) консольного АPI по сравнению с XP.
|
|
|
|
Добавлено: Ср дек 31, 2014 06:38 |
|
|
|
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
Компиляция асм кода из первого поста в FASM проходит успешно, но при старте приложения оно вылетает. Win7 x64.
Компиляция асм кода из первого поста в FASM проходит успешно, но при старте приложения оно вылетает. Win7 x64.
|
|
|
|
Добавлено: Ср дек 31, 2014 05:56 |
|
|
|
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
да, файл f2a_m.asm содержит следующее: Код: ; типы данных
struct cell body dd ? ; ends
struct addr body dd ? ; ends
struct token call db 0xE8 ref dd ? ends
struct scnt body db ? ends
struct ref body dd ? ends
; ------------------------------------------------------------------------------ ; объявление констант
ADDR = sizeof.addr ; размер адресной ссылки CELL = sizeof.cell ; размер ячейки данных REF = sizeof.ref ; размер ссылки TOKEN = sizeof.token ; размер токена SCNT = sizeof.scnt ; размер счетчика длины
dStack equ 0x1000 ; размер стека данных rStack equ 0x1000 ; размер стека возвратов
NamesSpace = 0x10000 CodeSpace = 0x10000
; вычисляем сколько места надо выделять под стеки stack (dStack+rStack)*2, dStack+rStack
; ------------------------------------------------------------------------------
latest = 0
; описатель форт-строк macro fstr [string] { common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
macro slit [str] { local labxx call _box addr labxx fstr str align labxx: }
; формат заголовка имени (подробнее см. _sHeader) macro def string,cfa,flg { dd latest latest=$-CELL addr cfa db flg common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
allot equ rb
macro align { repeat (($+CELL-1)and -CELL)-$ nop end repeat }
macro trialign { repeat (($+CELL-1)and -CELL)-$+3 nop end repeat }
да, файл f2a_m.asm содержит следующее: [code]; типы данных
struct cell body dd ? ; ends
struct addr body dd ? ; ends
struct token call db 0xE8 ref dd ? ends
struct scnt body db ? ends
struct ref body dd ? ends
; ------------------------------------------------------------------------------ ; объявление констант
ADDR = sizeof.addr ; размер адресной ссылки CELL = sizeof.cell ; размер ячейки данных REF = sizeof.ref ; размер ссылки TOKEN = sizeof.token ; размер токена SCNT = sizeof.scnt ; размер счетчика длины
dStack equ 0x1000 ; размер стека данных rStack equ 0x1000 ; размер стека возвратов
NamesSpace = 0x10000 CodeSpace = 0x10000
; вычисляем сколько места надо выделять под стеки stack (dStack+rStack)*2, dStack+rStack
; ------------------------------------------------------------------------------
latest = 0
; описатель форт-строк macro fstr [string] { common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
macro slit [str] { local labxx call _box addr labxx fstr str align labxx: }
; формат заголовка имени (подробнее см. _sHeader) macro def string,cfa,flg { dd latest latest=$-CELL addr cfa db flg common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
allot equ rb
macro align { repeat (($+CELL-1)and -CELL)-$ nop end repeat }
macro trialign { repeat (($+CELL-1)and -CELL)-$+3 nop end repeat }
[/code]
|
|
|
|
Добавлено: Вс дек 28, 2014 19:36 |
|
|
|
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
А это код текущего варианта(как обычно для форка): source file: f2a.fts \ 2014.12.21 m0leg
\! сделать реверс списка имен (не обязательно)
ALSO ROOT DEFINITIONS : .S .S ; RECENT
memory/ buff.fts branch/ case.fts branch/ for-next.fts
\ -- буфер для склейки строк --------------------------------------------------- USER-VALUE outbuf
\ создать буфер размером в 1 МБ (должно хватать) : init-buf 0x100000 Buffer TO outbuf ;
\ освободить занятый буфер : del-buf outbuf Retire ;
\ добавить в буфер строку текста : +>buf ( asc # --> ) outbuf >Buffer DROP ;
\ добавить одиночный символ в буфер : ch>buf ( char --> ) <| KEEP |> +>buf ;
\ вернуть содержимое буфера : buf> ( --> asc # ) outbuf Buffer> ;
\ открыть буфер : buf< ( --> ) outbuf Clean ;
\ -- форматирование текста -----------------------------------------------------
\ отступ от начала строки на два tab-а : -| ( --> ) s" \t\t" +>buf ; \ новая линия : nl ( --> ) s" \n\r" +>buf ; \ добавить строку с одним tab-ом в начале строки, завершить переводом строки : +>> ( asc # --> ) s" \t" +>buf +>buf nl ; \ добавить строку с двумя tab-ами в начале строки, завершить переводом строки : +>l ( asc # --> ) -| +>buf nl ;
\ добавить строку в выходной буфер : o" ( / asc" --> asc # | ) [CHAR] " CookLine state IF SLIT, ['] +>buf COMPILE, THEN ; IMMEDIATE \ /--/--/ с табуляцией в начале и переводом строки в конце : o|" ( / asc" --> asc # | ) [CHAR] " CookLine state IF SLIT, ['] +>> COMPILE, THEN ; IMMEDIATE \ /--/--/ с двумя табуляциями в начале и переводом строки в конце : o-|" ( / asc" --> asc # | ) [CHAR] " CookLine state IF SLIT, ['] +>l COMPILE, THEN ; IMMEDIATE
\ добавить число : dd+ ( n --> ) 0x10 {# Bl_ HOLD S>D #S s" dd 0x" HOLDS #> +>buf ; : dq+ ( d --> ) 0x10 {# Bl_ HOLD #S s" dq 0x" HOLDS #> +>buf ;
\ -- сохранение содержимого в файл ---------------------------------------------
0 VALUE FId
\ создать файл с заданным именем : file ( asc # --> fid ) W/O CREATE-FILE THROW TO FId ;
\ сохранить содержимое буфера в файл : save ( fid --> ) >L buf> L@ WRITE-FILE THROW L> CLOSE-FILE THROW ;
\ добавить содержимое указанного файла : asmfile ( asc # --> ) FILE>HEAP IFNOT ERROR" не могу прочесть файл" THEN OVER >L +>buf L> FREE THROW ;
\ -- создание новой метки ------------------------------------------------------
USER-VALUE LastLab
: l>name ( lab --> asc # ) S>D 0x10 {# # # # # s" lab_" HOLDS #> ;
\ создать новую метку, вернуть имя : label ( --> lab asc # ) LastLab 1 + DUP TO LastLab DUP l>name ;
\ преобразовать специальный символ в строковое представление и добавить \ результат в буфер PAD : ?ADDCHAR ( ch --> ) CASE [CHAR] , OF s" Compile" ENDOF [CHAR] ! OF s" Store" ENDOF [CHAR] ? OF s" Question" ENDOF [CHAR] @ OF s" Fetch" ENDOF [CHAR] ' OF s" Deref" ENDOF [CHAR] ; OF s" Semicolon" ENDOF [CHAR] . OF s" Peroid" ENDOF [CHAR] : OF s" Colon" ENDOF [CHAR] > OF s" To" ENDOF [CHAR] + OF s" Plus" ENDOF [CHAR] - OF s" Minus" ENDOF [CHAR] = OF s" Equal" ENDOF [CHAR] # OF s" Size" ENDOF [CHAR] " OF s" Quote" ENDOF [CHAR] < OF s" Less" ENDOF [CHAR] / OF s" Slash" ENDOF [CHAR] \ OF s" Backslash" ENDOF [CHAR] ? OF s" Question" ENDOF [CHAR] [ OF s" lStap" ENDOF [CHAR] ] OF s" rStap" ENDOF [CHAR] ( OF s" lPar" ENDOF [CHAR] ) OF s" rPar" ENDOF [CHAR] { OF s" lBr" ENDOF [CHAR] } OF s" rBr" ENDOF [CHAR] ~ OF s" Show" ENDOF [CHAR] | OF s" Wall" ENDOF [CHAR] ` OF s" Tick" ENDOF HOLD s" " ENDCASE HOLDS ;
\ преобразовать Форт-имя в метку : name>label ( asc # --> asc # ) OVER + 0x10 {# BEGIN DDUP < WHILE 1 - DUP C@ ?ADDCHAR REPEAT #> ;
\ : name' ( / name --> ) NextWord name>label SLIT, ; IMMEDIATE
\ -- создание рабочих словарей и слов для работы с ними ------------------------
\ ячейка для хранения последнего распознанного числа USER-CREATE LastNumber 2 CELLS USER-ALLOT
\ обработка чисел одинарной длины : (tLit) ( --> n ) LastNumber @ state IF o" \t\tCALL _" s" (LIT)" name>label +>buf nl -| dd+ nl THEN \! вместо dq должен быть код литерала ; IMMEDIATE \ обработка чисел двойной длины : (tdLit) ( --> d ) LastNumber D@ state IF o" \t\tCALL _" s" (DLIT)" name>label +>buf nl -| dq+ nl THEN \! вместо dq должен быть код литерала ; IMMEDIATE
\ попытаться распознать строку asc # , как число, \ в случае успеха вернуть lfa слова, ассоциируемого с числом : tNumLfa ( asc # vid --> lfa | 0 ) DROP \ vid словаря не нужен [ ALSO HIDDEN ] snNumber *IF 1 - IF LastNumber D! LFA (tdLit) ELSE LastNumber ! LFA (tLit) THEN THEN [ PREVIOUS ] ;
\ создание словаря, распознающего числа init: VOCABULARY \ создаем стандартный словарь и правим поля [ ALSO HIDDEN ] VOC-LIST A@ >L \ wordlist ['] tNumLfa L@ off_quest A! 0 L@ off_vtable A! \ отсутствует vtable 0 L@ off_last A! \ слов в словаре нет ['] no-mount L@ off_mount A! ['] no-umount L@ off_umount A! &vinit L> off_vflags B! [ PREVIOUS ] ;stop TNUMBERS \ словарь для работы с числами
VOCABULARY MACRO \ словарь для хранения макросов VOCABULARY TARGET \ словарь для хранения имен
\ показать список определений \ чтобы можно было использовать отовюсду размещается в корневом словаре ALSO ROOT DEFINITIONS : ~LIST ORDER CR ALSO TARGET WORDS PREVIOUS CR ; PREVIOUS DEFINITIONS
\ -- ---------------------------------------------------------------------------
0 VALUE LASTDEF \ хранит lfa последнего определения в TARGET
\ завершить создание макроса : ;M ( --> ) [COMPILE] ; IMMEDIATE DEFINITIONS ; IMMEDIATE
\ начать создание макроса с указанным именем : (:) ( asc # --> ) ALSO MACRO DEFINITIONS PREVIOUS S: ;
\ завершить создание теневого определения в TARGET : ;C ( --> ) [COMPILE] ; IMMEDIATE LATEST TO LASTDEF \ для того, чтобы удобно работать с флагами DEFINITIONS ; IMMEDIATE
\ создать теневое определение в TARGET : (C:) ( asc # --> ) ALSO TARGET DEFINITIONS PREVIOUS S: ;
\ начать создание макроса : M: ( /name --> ) NextWord (:) ;
: LastDef ( --> id ) WHO TARGET LAST-NAME ;
\ вернуть имя последнего определения : LastDef> ( --> asc # ) LastDef ID>ASC name>label ;
\ добавить имя в словарь TARGET, и соответствующую метку в листинг : AddName ( /name --> ) NextWord DDUP (C:) name>label DDUP SLIT, <: o" \t\tCALL _" +>buf nl ;> COMPILE, [COMPILE] ;C o" _" +>buf ;
\ секция импорта : ImportSect ( --> ) nl o" section '.import' import data readable writeable" nl nl o" library kernel,'KERNEL32.DLL'" nl nl o" import kernel,\\" nl o|" LoadLibrary, 'LoadLibrary',\\" o|" GetProcAddress, 'GetProcAddress',\\" o|" ExitProcess, 'ExitProcess',\\" o|" GetStdHandle, 'GetStdHandle',\\" o|" WriteFile, 'WriteFile',\\" o|" ReadFile, 'ReadFile'" ;
\ преамбула : Preambula ( --> ) o" format PE console" nl nl o|" include 'include\\win32a.inc'" o|" include 'include\\macro\\struct.inc'" nl ImportSect ;
\ начать трансляцию текста : TRANSLATE: ( /name --> ) NextWord <| KEEPS s" .asm" KEEPS 0 KEEP |> file init-buf ONLY PREVIOUS TNUMBERS ALSO TARGET DEFINITIONS ALSO MACRO Preambula nl s" f2a_m.asm" asmfile \ содержимое Preambula можно сразу внутрь f2a_m.asm
\ код и данные хранятся вместе в одном сегменте, а словарь размещается в отдельном nl o" section '.fvm' code executable readable writeable" nl ;
\ проверка, установлен ли признак немедленного исполнения : ?IMM ( lfa --> asc # | 0 ) [ ALSO HIDDEN ] &ALS @ATTR [ PREVIOUS ] ;
\ создать список имен : MakeVoc ( / name --> ) nl nl o" section '.names' data readable writeable" nl o" ; makevoc " +>buf nl nl o" ; Имя, Метка, Флаг immediate" LastDef BEGIN *WHILE nl o" def \'" DUP ID>ASC DDUP +>buf o" ', _" name>label +>buf o" , " DUP ?IMM IF o" -1" ELSE o" 1" THEN LINK> REPEAT DROP nl o" LATEST: ; чтобы получить хвост цепочки имен" nl o" NSADDR:" nl o" allot NamesSpace-($-$$) ;" nl ;
\ сохранить содержимое буфера в файл : aSave ( --> ) FId save del-buf ;
\ -- --------------------------------------------------------------------------- \! Все определения, заканчивающиеся ;M являются IMMEDIATE
\ коментарий в скобках копируем в коментарий M: ( ( /comment string --> ) o" ; ( " BEGIN NEXT-WORD DDUP +>buf o" " *WHILE + <C C@ [CHAR] ) <> WHILE REPEAT nl ;THEN DDROP \ если закрывающая скобка не встретилась до конца файла ;M
\ завершить трансляцию текста M: ;TRANSLATE ( --> ) \ точкой входа считаем последнее определение в тексте nl o" entry _COLD ; точка входа" nl s" FORTH" MakeVoc aSave ONLY DEFINITIONS ;M
\ создать безымянную метку для перехода назад M: BEGIN ( --> lab p ) label +>buf o" :\t; метка для перехода назад" nl NOTICE" Не обнаружена метка для перехода назад!" ;M
\ создать безусловный переход назад на метку lab M: AGAIN ( lab p --> ) ?PAIRS" Не обнаружена метка для перехода назад!" o" \tJMP " l>name +>buf o" ; переход назад" nl ;M
\ создать метку с именем name в тексте M: LABEL: ( /name --> ) NextWord +>buf o" :\t ; свободная метка" nl ;M
\ начать целевое определение M: : ( / name --> ) o" align" nl NextWord DDUP (C:) name>label DDUP SLIT, <: o" \t\tCALL _" +>buf nl ;> COMPILE, o" _" +>buf o" : " ;M
\ завершить определение M: ; ( --> ) [COMPILE] ;C o" \t RET " nl nl ;M \ завершить определение M: ;- ( --> ) [COMPILE] ;C nl ;M
\ коментарий в тексте M: \ ( --> ) -1 >IN +! o" ; " Cr_ PARSE +>buf nl ;M
\ создать имя, возвращающее адрес собственного поля параметров M: CREATE ( /name --> ) o" trialign" nl AddName o" : CALL _" s" (CREATE)" name>label +>buf nl ;M
\ создать именованную переменную M: VARIABLE ( /name --> ) o" trialign" nl AddName o" : CALL _" s" (CREATE)" name>label +>buf nl o" \tdd 0" nl nl ;M
\ создать именованную константу M: CONSTANT ( n /name --> ) o" trialign" nl DUP >L NextWord DDUP (C:) L> LIT, name>label DDUP SLIT, <: state IF o" \t\tCALL _" +>buf nl ELSE DROP THEN DROP ;> COMPILE, [COMPILE] ;C o" _" +>buf o" : CALL _" s" (CONSTANT)" name>label +>buf nl o" \t" dd+ nl nl ;M
\ резервировать указанное количество минимально адресуемых ячеек памяти \ в пространстве кода и данных M: ALLOT ( u --> ) 1 OVER > ABORT" должно быть быть больше 0" o" \tdb 0" 1 - *IF FOR R@ 34 MOD IFNOT o" \n\r\tdb 0" ELSE o" ,0" THEN TILL ELSE DROP THEN nl nl ;M
\ отметить последнее определение признаком немедленного исполнения M: IMMEDIATE ( --> ) TRUE LASTDEF [ ALSO HIDDEN ] &ALS SET-ATTR \ т.к. IMMEDIATE уже занят используется &ALS [ PREVIOUS ] THROW ;M
\ M: S" ( / ascii" --> | asc # ) [CHAR] " CookLine state IF o" \t\tCALL _" s" (SLIT)" name>label +>buf nl DUP o" \t\t" dd+ nl *IF o" \t\t db " FOR DUP C@ 0x10 {# S>D #S s" 0x" HOLDS #> +>buf R@ 16 MOD IFNOT nl o" \t\t db " ELSE o" ," THEN 1 + TILL DROP ELSE DDROP THEN THEN o" 0x00" nl ;M
\ -- определение примитивов ----------------------------------------------------
M: NIP o-|" LEA EBP, [EBP+CELL]" ;M
M: CPY o-|" MOV EAX, [EBP]" ;M \ копировать значение второго элеметна стека данных в TOS
M: SKP o-|" MOV EAX, [EBP+CELL]" o-|" LEA EBP, [EBP+8]" ;M
M: ROOM o-|" LEA EBP, [EBP-CELL]" ;M
M: DROP o-|" MOV EAX, [EBP]" o-|" LEA EBP, [EBP+CELL]" ;M
M: SWAP o-|" MOV EDX, EAX" o-|" MOV EAX, [EBP]" o-|" MOV dword [EBP], EDX" ;M
M: DUP o-|" LEA EBP, [EBP-CELL]" o-|" MOV dword [EBP], EAX" ;M
M: OVER o-|" MOV EDX, [EBP]" o-|" LEA EBP, [EBP-CELL]" o-|" MOV dword [EBP], EAX" o-|" MOV EAX, EDX" ;M
M: RVAR o-|" POP EAX" ;M \ вернуть адрес следующей ячейки на вершину стека данных
M: FETCH o-|" MOV EAX, [EAX]" ;M
M: STORE o-|" MOV EDX, [EBP]" o-|" MOV dword [EAX], EDX" ;M
M: GETLIT o-|" LEA EDX, [EAX+CELL]" o-|" MOV EAX, [EAX]" \ оставить на вершине стека данных литерал o|" JMP EDX" ;M \ обойти в коде литеральное значение
M: GETDLIT o-|" LEA EDX, [EAX+CELL*2]" o-|" MOV EBX, [EAX]" o-|" MOV EAX, [EAX+CELL]" o-|" MOV dword [EBP], EBX" o|" JMP EDX" ;M
M: GETALIT o-|" LEA EDX, [EAX+TOKEN]" o-|" MOV EAX, [EAX+1]" o|" JMP EDX" ;M
M: PLUS o-|" ADD EAX, [EBP]" ;M
M: (SLIT) o-|" LEA EBP, [EBP-8]" o-|" MOV dword [EBP+CELL], EAX" o-|" POP EBX" o-|" LEA EDX, [EBX+CELL]" o-|" MOV dword [EBP], EDX" o-|" MOV EAX, [EBX]" o-|" LEA EDX, [EBX+EAX+TOKEN]" o|" JMP EDX" ;M
M: TOSP o-|" MOV EBP, EAX" ;M
M: TORP o-|" POP EDX" o-|" MOV ESP, EAX" o-|" MOV EAX, EDX" ;M
M: JUMP o-|" MOV EDX, EAX" o-|" MOV EAX, [EBP]" o-|" LEA EBP, [EBP+CELL]" o|" JMP EDX" ;M
M: Type o-|" MOV EDX, [EBP]" o-|" PUSH EAX" o-|" PUSH EDX" o-|" PUSH dword [_STDOUT+TOKEN]" o-|" CALL [WriteFile]" o-|" NOP" o-|" NOP" o-|" NOP" ;M
\ -- ---------------------------------------------------------------------------
\ пример транслируемого текста TRANSLATE: zzz LABEL: START
\ первое определение : NOOP ( --> ) ;
\ удалить элемент под вершиной стека : NIP ( a b --> b ) NIP ;
\ удалить значение с вершины стека данных : DROP ( n --> ) DROP ;
\ дублировать значение n на вершине стека данных : DUP ( n --> n n ) DUP ;
\ обменять значения двух ячеек на вершине стека данных : SWAP ( a b --> b a ) SWAP ;
\ положить на вершину стека данных копию значения второго элемента : OVER ( a b --> a b a ) OVER ;
\ извлечь значение с указанного адреса : @ ( addr --> n ) FETCH ;
\ сохранить значение n по указанному адресу : ! ( n addr --> ) STORE SKP ;
\ сложить два числа на вершине стека данных, результат оставить на вершине : + ( n1 n2 --> n ) PLUS NIP ;
\ переместить указатель вершины стека данных на указанный адрес \ в TOS остается значение : SP! ( addr --> ) TOSP ;
\ переместить указатель вершины стека возвратов на указанный адрес : RP! ( addr --> ) TORP JUMP ;-
\ выложить на вершину стека данных значение, \ скомпилированное в коде за вызовом (LIT) : (LIT) ( --> n ) DUP RVAR GETLIT ;-
\ выложить на вершину стека данных значение, \ скомпилированное в коде за вызовом (LIT) : (DLIT) ( --> n ) DUP DUP RVAR GETLIT ;-
\ вернуть адрес слова, вызов которого скомпилирован в коде вслед за (') : (`) ( --> addr ) DUP RVAR GETALIT ;-
\ вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину # : (SLIT) ( --> asc # ) (SLIT) ;-
\ положить на вершину стека адрес переменной : (CREATE) ( --> addr ) DUP RVAR ;
\ положить на вершину стека значение : (CONSTANT) ( --> n ) DUP RVAR FETCH ;
\ размер буферов TIB и PAD в байтах 100 CONSTANT TIB# ( --> # ) 100 CONSTANT PAD# ( --> #)
\ terminal input buffer CREATE TIB TIB# ALLOT
\ буфер для форматного преобразования чисел и строк CREATE PAD PAD# ALLOT
\ указатель на последний символ в PAD VARIABLE HLD
\ Дно стека данных VARIABLE S0 ( --> addr ) \ Дно стека возвратов VARIABLE R0 ( --> addr )
\ размеры стеков 0x1000 CONSTANT DataStack# 0x1000 CONSTANT ReturnStack#
\ Хранит адрес первой свободной ячейки памяти в пространстве кода и данных VARIABLE DP ( --> addr ) \ Хранит адрес первой свободной ячейки памяти в пространстве имен VARIABLE HDP ( --> addr )
\ стандартные потоки В\В VARIABLE STDIN VARIABLE STDOUT VARIABLE STDERR
\ вернуть адрес первой свободной ячейки памят в пространстве кода и данных : HERE ( --> addr ) DP FETCH ;
\ вернуть адрес первой свободной ячейки памят в пространстве имен : HHERE ( haddr --> addr ) HDP FETCH ;
\ вывести в текущий STDOUT поток указанную строку : TYPE ( asc # --> ) Type ;
\ холодный запуск системы : COLD ( --> ) \ LIMIT DP !
S" sample string" TYPE
0x12345678 TIB# 0x123456789ABCDEF
S0 R0 BEGIN SWAP OVER NIP DROP AGAIN ; IMMEDIATE
\ последнее определение системы CREATE LIMIT ( --> )
;TRANSLATE
~LIST
А это код текущего варианта(как обычно для [url=http://fforum.winglion.ru/viewtopic.php?p=37472#p37472]форка[/url]):
[pre]source file: f2a.fts [b][color=#808080]\ 2014.12.21 m0leg[/color]
[color=#0080C0]\! сделать реверс списка имен (не обязательно)[/color]
[color=#FF00FF]ALSO[/color] [color=#FF00FF]ROOT[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000]: .S[/color] .S [color=#FF8000];[/color] [color=#FF00FF]RECENT[/color]
[color=#00F000]memory/ buff.fts[/color] [color=#00F000]branch/ case.fts[/color] [color=#00F000]branch/ for-next.fts[/color]
[color=#808080]\ -- буфер для склейки строк ---------------------------------------------------[/color] [color=#FF8000]USER-VALUE outbuf[/color]
[color=#808080]\ создать буфер размером в 1 МБ (должно хватать)[/color] [color=#FF8000]: init-buf[/color] [color=#00F000]0x100000[/color] Buffer TO outbuf [color=#FF8000];[/color]
[color=#808080]\ освободить занятый буфер[/color] [color=#FF8000]: del-buf[/color] outbuf Retire [color=#FF8000];[/color]
[color=#808080]\ добавить в буфер строку текста[/color] [color=#FF8000]: +>buf[/color] [color=#0080C0]( asc # --> )[/color] outbuf >Buffer DROP [color=#FF8000];[/color]
[color=#808080]\ добавить одиночный символ в буфер[/color] [color=#FF8000]: ch>buf[/color] [color=#0080C0]( char --> )[/color] [color=#0000F0]<|[/color] [color=#0000F0]KEEP[/color] [color=#0000F0]|>[/color] +>buf [color=#FF8000];[/color]
[color=#808080]\ вернуть содержимое буфера[/color] [color=#FF8000]: buf>[/color] [color=#0080C0]( --> asc # )[/color] outbuf Buffer> [color=#FF8000];[/color]
[color=#808080]\ открыть буфер[/color] [color=#FF8000]: buf<[/color] [color=#0080C0]( --> )[/color] outbuf Clean [color=#FF8000];[/color]
[color=#808080]\ -- форматирование текста -----------------------------------------------------[/color]
[color=#808080]\ отступ от начала строки на два tab-а[/color] [color=#FF8000]: -|[/color] [color=#0080C0]( --> )[/color] [color=#00F000]s" \t\t"[/color] +>buf [color=#FF8000];[/color] [color=#808080]\ новая линия[/color] [color=#FF8000]: nl[/color] [color=#0080C0]( --> )[/color] [color=#00F000]s" \n\r"[/color] +>buf [color=#FF8000];[/color] [color=#808080]\ добавить строку с одним tab-ом в начале строки, завершить переводом строки[/color] [color=#FF8000]: +>>[/color] [color=#0080C0]( asc # --> )[/color] [color=#00F000]s" \t"[/color] +>buf +>buf nl [color=#FF8000];[/color] [color=#808080]\ добавить строку с двумя tab-ами в начале строки, завершить переводом строки[/color] [color=#FF8000]: +>l[/color] [color=#0080C0]( asc # --> )[/color] -| +>buf nl [color=#FF8000];[/color]
[color=#808080]\ добавить строку в выходной буфер[/color] [color=#FF8000]: o"[/color] [color=#0080C0]( / asc" --> asc # | )[/color] [color=#00F000][CHAR] "[/color] CookLine state [color=#00A0A0]IF[/color] SLIT, [color=#00F000]['] +>buf[/color] COMPILE, [color=#00A0A0]THEN[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color] [color=#808080]\ /--/--/ с табуляцией в начале и переводом строки в конце[/color] [color=#FF8000]: o|"[/color] [color=#0080C0]( / asc" --> asc # | )[/color] [color=#00F000][CHAR] "[/color] CookLine state [color=#00A0A0]IF[/color] SLIT, [color=#00F000]['] +>>[/color] COMPILE, [color=#00A0A0]THEN[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color] [color=#808080]\ /--/--/ с двумя табуляциями в начале и переводом строки в конце[/color] [color=#FF8000]: o-|"[/color] [color=#0080C0]( / asc" --> asc # | )[/color] [color=#00F000][CHAR] "[/color] CookLine state [color=#00A0A0]IF[/color] SLIT, [color=#00F000]['] +>l[/color] COMPILE, [color=#00A0A0]THEN[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ добавить число[/color] [color=#FF8000]: dd+[/color] [color=#0080C0]( n --> )[/color] [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] [color=#00F000]Bl_[/color] [color=#0000F0]HOLD[/color] S>D #S [color=#00F000]s" dd 0x"[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] +>buf [color=#FF8000];[/color] [color=#FF8000]: dq+[/color] [color=#0080C0]( d --> )[/color] [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] [color=#00F000]Bl_[/color] [color=#0000F0]HOLD[/color] #S [color=#00F000]s" dq 0x"[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] +>buf [color=#FF8000];[/color]
[color=#808080]\ -- сохранение содержимого в файл ---------------------------------------------[/color]
[color=#00F000]0[/color] [color=#FF8000]VALUE FId[/color]
[color=#808080]\ создать файл с заданным именем[/color] [color=#FF8000]: file[/color] [color=#0080C0]( asc # --> fid )[/color] W/O CREATE-FILE [color=#C00000]THROW[/color] TO FId [color=#FF8000];[/color]
[color=#808080]\ сохранить содержимое буфера в файл[/color] [color=#FF8000]: save[/color] [color=#0080C0]( fid --> )[/color] >L buf> L@ WRITE-FILE [color=#C00000]THROW[/color] L> CLOSE-FILE [color=#C00000]THROW[/color] [color=#FF8000];[/color]
[color=#808080]\ добавить содержимое указанного файла[/color] [color=#FF8000]: asmfile[/color] [color=#0080C0]( asc # --> )[/color] FILE>HEAP [color=#00A0A0]IFNOT[/color] [color=#C00000]ERROR" не могу прочесть файл"[/color] [color=#00A0A0]THEN[/color] OVER >L +>buf L> FREE [color=#C00000]THROW[/color] [color=#FF8000];[/color]
[color=#808080]\ -- создание новой метки ------------------------------------------------------[/color]
[color=#FF8000]USER-VALUE LastLab[/color]
[color=#FF8000]: l>name[/color] [color=#0080C0]( lab --> asc # )[/color] S>D [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] [color=#0000F0]#[/color] [color=#0000F0]#[/color] [color=#0000F0]#[/color] [color=#0000F0]#[/color] [color=#00F000]s" lab_"[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] [color=#FF8000];[/color]
[color=#808080]\ создать новую метку, вернуть имя[/color] [color=#FF8000]: label[/color] [color=#0080C0]( --> lab asc # )[/color] LastLab [color=#00F000]1[/color] + DUP TO LastLab DUP l>name [color=#FF8000];[/color]
[color=#808080]\ преобразовать специальный символ в строковое представление и добавить[/color] [color=#808080]\ результат в буфер PAD[/color] [color=#FF8000]: ?ADDCHAR[/color] [color=#0080C0]( ch --> )[/color] CASE [color=#00F000][CHAR] ,[/color] OF [color=#00F000]s" Compile"[/color] ENDOF [color=#00F000][CHAR] ![/color] OF [color=#00F000]s" Store"[/color] ENDOF [color=#00F000][CHAR] ?[/color] OF [color=#00F000]s" Question"[/color] ENDOF [color=#00F000][CHAR] @[/color] OF [color=#00F000]s" Fetch"[/color] ENDOF [color=#00F000][CHAR] '[/color] OF [color=#00F000]s" Deref"[/color] ENDOF [color=#00F000][CHAR] ;[/color] OF [color=#00F000]s" Semicolon"[/color] ENDOF [color=#00F000][CHAR] .[/color] OF [color=#00F000]s" Peroid"[/color] ENDOF [color=#00F000][CHAR] :[/color] OF [color=#00F000]s" Colon"[/color] ENDOF [color=#00F000][CHAR] >[/color] OF [color=#00F000]s" To"[/color] ENDOF [color=#00F000][CHAR] +[/color] OF [color=#00F000]s" Plus"[/color] ENDOF [color=#00F000][CHAR] -[/color] OF [color=#00F000]s" Minus"[/color] ENDOF [color=#00F000][CHAR] =[/color] OF [color=#00F000]s" Equal"[/color] ENDOF [color=#00F000][CHAR] #[/color] OF [color=#00F000]s" Size"[/color] ENDOF [color=#00F000][CHAR] "[/color] OF [color=#00F000]s" Quote"[/color] ENDOF [color=#00F000][CHAR] <[/color] OF [color=#00F000]s" Less"[/color] ENDOF [color=#00F000][CHAR] /[/color] OF [color=#00F000]s" Slash"[/color] ENDOF [color=#00F000][CHAR] \[/color] OF [color=#00F000]s" Backslash"[/color] ENDOF [color=#00F000][CHAR] ?[/color] OF [color=#00F000]s" Question"[/color] ENDOF [color=#00F000][CHAR] [[/color] OF [color=#00F000]s" lStap"[/color] ENDOF [color=#00F000][CHAR] ][/color] OF [color=#00F000]s" rStap"[/color] ENDOF [color=#00F000][CHAR] ([/color] OF [color=#00F000]s" lPar"[/color] ENDOF [color=#00F000][CHAR] )[/color] OF [color=#00F000]s" rPar"[/color] ENDOF [color=#00F000][CHAR] {[/color] OF [color=#00F000]s" lBr"[/color] ENDOF [color=#00F000][CHAR] }[/color] OF [color=#00F000]s" rBr"[/color] ENDOF [color=#00F000][CHAR] ~[/color] OF [color=#00F000]s" Show"[/color] ENDOF [color=#00F000][CHAR] |[/color] OF [color=#00F000]s" Wall"[/color] ENDOF [color=#00F000][CHAR] `[/color] OF [color=#00F000]s" Tick"[/color] ENDOF [color=#0000F0]HOLD[/color] [color=#00F000]s" "[/color] ENDCASE [color=#0000F0]HOLDS[/color] [color=#FF8000];[/color]
[color=#808080]\ преобразовать Форт-имя в метку[/color] [color=#FF8000]: name>label[/color] [color=#0080C0]( asc # --> asc # )[/color] OVER + [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] [color=#00A0A0]BEGIN[/color] DDUP < [color=#00A0A0]WHILE[/color] [color=#00F000]1[/color] - DUP C@ ?ADDCHAR [color=#00A0A0]REPEAT[/color] [color=#0000F0]#>[/color] [color=#FF8000];[/color]
[color=#808080]\[/color] [color=#FF8000]: name'[/color] [color=#0080C0]( / name --> )[/color] NextWord name>label SLIT, [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ -- создание рабочих словарей и слов для работы с ними ------------------------[/color]
[color=#808080]\ ячейка для хранения последнего распознанного числа[/color] USER-CREATE LastNumber [color=#00F000]2[/color] CELLS USER-ALLOT
[color=#808080]\ обработка чисел одинарной длины[/color] [color=#FF8000]: (tLit)[/color] [color=#0080C0]( --> n )[/color] LastNumber @ state [color=#00A0A0]IF[/color] o" \t\tCALL _" [color=#00F000]s" (LIT)"[/color] name>label +>buf nl -| dd+ nl [color=#00A0A0]THEN[/color] [color=#0080C0]\! вместо dq должен быть код литерала[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color] [color=#808080]\ обработка чисел двойной длины[/color] [color=#FF8000]: (tdLit)[/color] [color=#0080C0]( --> d )[/color] LastNumber D@ state [color=#00A0A0]IF[/color] o" \t\tCALL _" [color=#00F000]s" (DLIT)"[/color] name>label +>buf nl -| dq+ nl [color=#00A0A0]THEN[/color] [color=#0080C0]\! вместо dq должен быть код литерала[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ попытаться распознать строку asc # , как число,[/color] [color=#808080]\ в случае успеха вернуть lfa слова, ассоциируемого с числом[/color] [color=#FF8000]: tNumLfa[/color] [color=#0080C0]( asc # vid --> lfa | 0 )[/color] DROP [color=#808080]\ vid словаря не нужен[/color] [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] snNumber [color=#00A0A0]*IF[/color] [color=#00F000]1[/color] - [color=#00A0A0]IF[/color] LastNumber D! LFA (tdLit) [color=#00A0A0]ELSE[/color] LastNumber ! LFA (tLit) [color=#00A0A0]THEN[/color] [color=#00A0A0]THEN[/color] [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#FF8000];[/color]
[color=#808080]\ создание словаря, распознающего числа[/color] [color=#FF8000]init: VOCABULARY[/color] [color=#808080]\ создаем стандартный словарь и правим поля[/color] [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] VOC-LIST A@ >L [color=#808080]\ wordlist[/color] [color=#00F000]['] tNumLfa[/color] L@ off_quest A! [color=#00F000]0[/color] L@ off_vtable A! [color=#808080]\ отсутствует vtable[/color] [color=#00F000]0[/color] L@ off_last A! [color=#808080]\ слов в словаре нет[/color] [color=#00F000]['] no-mount[/color] L@ off_mount A! [color=#00F000]['] no-umount[/color] L@ off_umount A! &vinit L> off_vflags B! [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#FF8000];stop[/color] TNUMBERS [color=#808080]\ словарь для работы с числами[/color]
[color=#FF8000]VOCABULARY MACRO[/color] [color=#808080]\ словарь для хранения макросов[/color] [color=#FF8000]VOCABULARY TARGET[/color] [color=#808080]\ словарь для хранения имен[/color]
[color=#808080]\ показать список определений[/color] [color=#808080]\ чтобы можно было использовать отовюсду размещается в корневом словаре[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]ROOT[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000]: ~LIST[/color] ORDER CR [color=#FF00FF]ALSO[/color] TARGET WORDS [color=#FF00FF]PREVIOUS[/color] CR [color=#FF8000];[/color] [color=#FF00FF]PREVIOUS[/color] [color=#FF00FF]DEFINITIONS[/color]
[color=#808080]\ -- ---------------------------------------------------------------------------[/color]
[color=#00F000]0[/color] [color=#FF8000]VALUE LASTDEF[/color] [color=#808080]\ хранит lfa последнего определения в TARGET[/color]
[color=#808080]\ завершить создание макроса[/color] [color=#FF8000]: ;M[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] ;[/color] [color=#C00000]IMMEDIATE[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ начать создание макроса с указанным именем[/color] [color=#FF8000]: (:)[/color] [color=#0080C0]( asc # --> )[/color] [color=#FF00FF]ALSO[/color] MACRO [color=#FF00FF]DEFINITIONS[/color] [color=#FF00FF]PREVIOUS[/color] [color=#FF8000]S: ;[/color]
[color=#808080]\ завершить создание теневого определения в TARGET[/color] [color=#FF8000]: ;C[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] ;[/color] [color=#C00000]IMMEDIATE[/color] LATEST TO LASTDEF [color=#808080]\ для того, чтобы удобно работать с флагами[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ создать теневое определение в TARGET[/color] [color=#FF8000]: (C:)[/color] [color=#0080C0]( asc # --> )[/color] [color=#FF00FF]ALSO[/color] TARGET [color=#FF00FF]DEFINITIONS[/color] [color=#FF00FF]PREVIOUS[/color] [color=#FF8000]S: ;[/color]
[color=#808080]\ начать создание макроса[/color] [color=#FF8000]: M:[/color] [color=#0080C0]( /name --> )[/color] NextWord (:) [color=#FF8000];[/color]
[color=#FF8000]: LastDef[/color] [color=#0080C0]( --> id )[/color] WHO TARGET LAST-NAME [color=#FF8000];[/color]
[color=#808080]\ вернуть имя последнего определения[/color] [color=#FF8000]: LastDef>[/color] [color=#0080C0]( --> asc # )[/color] LastDef ID>ASC name>label [color=#FF8000];[/color]
[color=#808080]\ добавить имя в словарь TARGET, и соответствующую метку в листинг[/color] [color=#FF8000]: AddName[/color] [color=#0080C0]( /name --> )[/color] NextWord DDUP (C:) name>label DDUP SLIT, [color=#FF8000]<: o"[/color] \t\tCALL _" +>buf nl [color=#FF8000];>[/color] COMPILE, [color=#00F000][COMPILE] ;C[/color] o" _" +>buf [color=#FF8000];[/color]
[color=#808080]\ секция импорта[/color] [color=#FF8000]: ImportSect[/color] [color=#0080C0]( --> )[/color] nl o" section '.import' import data readable writeable" nl nl o" library kernel,'KERNEL32.DLL'" nl nl o" import kernel,\\" nl o|" LoadLibrary, 'LoadLibrary',\\" o|" GetProcAddress, 'GetProcAddress',\\" o|" ExitProcess, 'ExitProcess',\\" o|" GetStdHandle, 'GetStdHandle',\\" o|" WriteFile, 'WriteFile',\\" o|" ReadFile, 'ReadFile'" [color=#FF8000];[/color]
[color=#808080]\ преамбула[/color] [color=#FF8000]: Preambula[/color] [color=#0080C0]( --> )[/color] o" format PE console" nl nl o|" include 'include\\win32a.inc'" o|" include 'include\\macro\\struct.inc'" nl ImportSect [color=#FF8000];[/color]
[color=#808080]\ начать трансляцию текста[/color] [color=#FF8000]: TRANSLATE:[/color] [color=#0080C0]( /name --> )[/color] NextWord [color=#0000F0]<|[/color] [color=#0000F0]KEEPS[/color] [color=#00F000]s" .asm"[/color] [color=#0000F0]KEEPS[/color] [color=#00F000]0[/color] [color=#0000F0]KEEP[/color] [color=#0000F0]|>[/color] file init-buf [color=#FF00FF]ONLY[/color] [color=#FF00FF]PREVIOUS[/color] TNUMBERS [color=#FF00FF]ALSO[/color] TARGET [color=#FF00FF]DEFINITIONS[/color] [color=#FF00FF]ALSO[/color] MACRO Preambula nl [color=#00F000]s" f2a_m.asm"[/color] asmfile [color=#808080]\ содержимое Preambula можно сразу внутрь f2a_m.asm[/color]
[color=#808080]\ код и данные хранятся вместе в одном сегменте, а словарь размещается в отдельном[/color] nl o" section '.fvm' code executable readable writeable" nl [color=#FF8000];[/color]
[color=#808080]\ проверка, установлен ли признак немедленного исполнения[/color] [color=#FF8000]: ?IMM[/color] [color=#0080C0]( lfa --> asc # | 0 )[/color] [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] &ALS @ATTR [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#FF8000];[/color]
[color=#808080]\ создать список имен[/color] [color=#FF8000]: MakeVoc[/color] [color=#0080C0]( / name --> )[/color] nl nl o" section '.names' data readable writeable" nl o" [color=#FF8000];[/color] makevoc " +>buf nl nl o" [color=#FF8000];[/color] Имя, Метка, Флаг immediate" LastDef [color=#00A0A0]BEGIN[/color] [color=#00A0A0]*WHILE[/color] nl o" def \'" DUP ID>ASC DDUP +>buf o" ', _" name>label +>buf o" , " DUP ?IMM [color=#00A0A0]IF[/color] o" -1" [color=#00A0A0]ELSE[/color] o" 1" [color=#00A0A0]THEN[/color] LINK> [color=#00A0A0]REPEAT[/color] DROP nl o" [color=#FF8000]LATEST: ;[/color] чтобы получить хвост цепочки имен" nl o" NSADDR:" nl o" allot NamesSpace-($-$$) [color=#FF8000];"[/color] nl [color=#FF8000];[/color]
[color=#808080]\ сохранить содержимое буфера в файл[/color] [color=#FF8000]: aSave[/color] [color=#0080C0]( --> )[/color] FId save del-buf [color=#FF8000];[/color]
[color=#808080]\ -- ---------------------------------------------------------------------------[/color] [color=#0080C0]\! Все определения, заканчивающиеся ;M являются IMMEDIATE[/color]
[color=#808080]\ коментарий в скобках копируем в коментарий[/color] [color=#FF8000]M: ([/color] [color=#0080C0]( /comment string --> )[/color] o" [color=#FF8000];[/color] [color=#0080C0]( " BEGIN NEXT-WORD DDUP +>buf o" " *WHILE + <C C@ [CHAR] )[/color] <> [color=#00A0A0]WHILE[/color] [color=#00A0A0]REPEAT[/color] nl [color=#FF8000];THEN[/color] DDROP [color=#808080]\ если закрывающая скобка не встретилась до конца файла[/color] [color=#FF8000];M[/color]
[color=#808080]\ завершить трансляцию текста[/color] [color=#FF8000]M: ;TRANSLATE[/color] [color=#0080C0]( --> )[/color] [color=#808080]\ точкой входа считаем последнее определение в тексте[/color] nl o" entry _COLD [color=#FF8000];[/color] точка входа" nl [color=#00F000]s" FORTH"[/color] MakeVoc aSave [color=#FF00FF]ONLY[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF8000];M[/color]
[color=#808080]\ создать безымянную метку для перехода назад[/color] [color=#FF8000]M: BEGIN[/color] [color=#0080C0]( --> lab p )[/color] label +>buf o" :\t; метка для перехода назад" nl NOTICE" Не обнаружена метка для перехода назад!" [color=#FF8000];M[/color]
[color=#808080]\ создать безусловный переход назад на метку lab[/color] [color=#FF8000]M: AGAIN[/color] [color=#0080C0]( lab p --> )[/color] ?PAIRS" Не обнаружена метка для перехода назад!" o" \tJMP " l>name +>buf o" [color=#FF8000];[/color] переход назад" nl [color=#FF8000];M[/color]
[color=#808080]\ создать метку с именем name в тексте[/color] [color=#FF8000]M: LABEL:[/color] [color=#0080C0]( /name --> )[/color] NextWord +>buf o" :\t [color=#FF8000];[/color] свободная метка" nl [color=#FF8000];M[/color]
[color=#808080]\ начать целевое определение[/color] [color=#FF8000]M: :[/color] [color=#0080C0]( / name --> )[/color] o" align" nl NextWord DDUP (C:) name>label DDUP SLIT, [color=#FF8000]<: o"[/color] \t\tCALL _" +>buf nl [color=#FF8000];>[/color] COMPILE, o" _" +>buf o" [color=#FF8000]: "[/color] [color=#FF8000];M[/color]
[color=#808080]\ завершить определение[/color] [color=#FF8000]M: ;[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] ;C[/color] o" \t RET " nl nl [color=#FF8000];M[/color] [color=#808080]\ завершить определение[/color] [color=#FF8000]M: ;-[/color] [color=#0080C0]( --> )[/color] [color=#00F000][COMPILE] ;C[/color] nl [color=#FF8000];M[/color]
[color=#808080]\ коментарий в тексте[/color] [color=#FF8000]M: \[/color] [color=#0080C0]( --> )[/color] [color=#00F000]-1[/color] >IN +! o" [color=#FF8000];[/color] " [color=#00F000]Cr_[/color] PARSE +>buf nl [color=#FF8000];M[/color]
[color=#808080]\ создать имя, возвращающее адрес собственного поля параметров[/color] [color=#FF8000]M: CREATE[/color] [color=#0080C0]( /name --> )[/color] o" trialign" nl AddName o" [color=#FF8000]: CALL[/color] _" [color=#00F000]s" (CREATE)"[/color] name>label +>buf nl [color=#FF8000];M[/color]
[color=#808080]\ создать именованную переменную[/color] [color=#FF8000]M: VARIABLE[/color] [color=#0080C0]( /name --> )[/color] o" trialign" nl AddName o" [color=#FF8000]: CALL[/color] _" [color=#00F000]s" (CREATE)"[/color] name>label +>buf nl o" \tdd 0" nl nl [color=#FF8000];M[/color]
[color=#808080]\ создать именованную константу[/color] [color=#FF8000]M: CONSTANT[/color] [color=#0080C0]( n /name --> )[/color] o" trialign" nl DUP >L NextWord DDUP (C:) L> LIT, name>label DDUP SLIT, [color=#FF8000]<: state[/color] [color=#00A0A0]IF[/color] o" \t\tCALL _" +>buf nl [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] DROP [color=#FF8000];>[/color] COMPILE, [color=#00F000][COMPILE] ;C[/color] o" _" +>buf o" [color=#FF8000]: CALL[/color] _" [color=#00F000]s" (CONSTANT)"[/color] name>label +>buf nl o" \t" dd+ nl nl [color=#FF8000];M[/color]
[color=#808080]\ резервировать указанное количество минимально адресуемых ячеек памяти[/color] [color=#808080]\ в пространстве кода и данных[/color] [color=#FF8000]M: ALLOT[/color] [color=#0080C0]( u --> )[/color] [color=#00F000]1[/color] OVER > [color=#C00000]ABORT" должно быть быть больше 0"[/color] o" \tdb 0" [color=#00F000]1[/color] - [color=#00A0A0]*IF[/color] FOR R@ [color=#00F000]34[/color] MOD [color=#00A0A0]IFNOT[/color] o" \n\r\tdb 0" [color=#00A0A0]ELSE[/color] o" ,0" [color=#00A0A0]THEN[/color] TILL [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] nl nl [color=#FF8000];M[/color]
[color=#808080]\ отметить последнее определение признаком немедленного исполнения[/color] [color=#FF8000]M: IMMEDIATE[/color] [color=#0080C0]( --> )[/color] [color=#00F000]TRUE[/color] LASTDEF [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] &ALS SET-ATTR [color=#808080]\ т.к. IMMEDIATE уже занят используется &ALS[/color] [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#C00000]THROW[/color] [color=#FF8000];M[/color]
[color=#808080]\[/color] [color=#FF8000]M: S"[/color] [color=#0080C0]( / ascii" --> | asc # )[/color] [color=#00F000][CHAR] "[/color] CookLine state [color=#00A0A0]IF[/color] o" \t\tCALL _" [color=#00F000]s" (SLIT)"[/color] name>label +>buf nl DUP o" \t\t" dd+ nl [color=#00A0A0]*IF[/color] o" \t\t db " FOR DUP C@ [color=#00F000]0x10[/color] [color=#0000F0]{#[/color] S>D #S [color=#00F000]s" 0x"[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] +>buf R@ [color=#00F000]16[/color] MOD [color=#00A0A0]IFNOT[/color] nl o" \t\t db " [color=#00A0A0]ELSE[/color] o" ," [color=#00A0A0]THEN[/color] [color=#00F000]1[/color] + TILL DROP [color=#00A0A0]ELSE[/color] DDROP [color=#00A0A0]THEN[/color] [color=#00A0A0]THEN[/color] o" 0x00" nl [color=#FF8000];M[/color]
[color=#808080]\ -- определение примитивов ----------------------------------------------------[/color]
[color=#FF8000]M: NIP[/color] o-|" LEA EBP, [EBP+CELL]" [color=#FF8000];M[/color]
[color=#FF8000]M: CPY[/color] o-|" MOV EAX, [EBP]" [color=#FF8000];M[/color] [color=#808080]\ копировать значение второго элеметна стека данных в TOS[/color]
[color=#FF8000]M: SKP[/color] o-|" MOV EAX, [EBP+CELL]" o-|" LEA EBP, [EBP+8]" [color=#FF8000];M[/color]
[color=#FF8000]M: ROOM[/color] o-|" LEA EBP, [EBP-CELL]" [color=#FF8000];M[/color]
[color=#FF8000]M: DROP[/color] o-|" MOV EAX, [EBP]" o-|" LEA EBP, [EBP+CELL]" [color=#FF8000];M[/color]
[color=#FF8000]M: SWAP[/color] o-|" MOV EDX, EAX" o-|" MOV EAX, [EBP]" o-|" MOV dword [EBP], EDX" [color=#FF8000];M[/color]
[color=#FF8000]M: DUP[/color] o-|" LEA EBP, [EBP-CELL]" o-|" MOV dword [EBP], EAX" [color=#FF8000];M[/color]
[color=#FF8000]M: OVER[/color] o-|" MOV EDX, [EBP]" o-|" LEA EBP, [EBP-CELL]" o-|" MOV dword [EBP], EAX" o-|" MOV EAX, EDX" [color=#FF8000];M[/color]
[color=#FF8000]M: RVAR[/color] o-|" POP EAX" [color=#FF8000];M[/color] [color=#808080]\ вернуть адрес следующей ячейки на вершину стека данных[/color]
[color=#FF8000]M: FETCH[/color] o-|" MOV EAX, [EAX]" [color=#FF8000];M[/color]
[color=#FF8000]M: STORE[/color] o-|" MOV EDX, [EBP]" o-|" MOV dword [EAX], EDX" [color=#FF8000];M[/color]
[color=#FF8000]M: GETLIT[/color] o-|" LEA EDX, [EAX+CELL]" o-|" MOV EAX, [EAX]" [color=#808080]\ оставить на вершине стека данных литерал[/color] o|" JMP EDX" [color=#FF8000];M[/color] [color=#808080]\ обойти в коде литеральное значение[/color]
[color=#FF8000]M: GETDLIT[/color] o-|" LEA EDX, [EAX+CELL*2]" o-|" MOV EBX, [EAX]" o-|" MOV EAX, [EAX+CELL]" o-|" MOV dword [EBP], EBX" o|" JMP EDX" [color=#FF8000];M[/color]
[color=#FF8000]M: GETALIT[/color] o-|" LEA EDX, [EAX+TOKEN]" o-|" MOV EAX, [EAX+1]" o|" JMP EDX" [color=#FF8000];M[/color]
[color=#FF8000]M: PLUS[/color] o-|" ADD EAX, [EBP]" [color=#FF8000];M[/color]
[color=#FF8000]M: (SLIT)[/color] o-|" LEA EBP, [EBP-8]" o-|" MOV dword [EBP+CELL], EAX" o-|" POP EBX" o-|" LEA EDX, [EBX+CELL]" o-|" MOV dword [EBP], EDX" o-|" MOV EAX, [EBX]" o-|" LEA EDX, [EBX+EAX+TOKEN]" o|" JMP EDX" [color=#FF8000];M[/color]
[color=#FF8000]M: TOSP[/color] o-|" MOV EBP, EAX" [color=#FF8000];M[/color]
[color=#FF8000]M: TORP[/color] o-|" POP EDX" o-|" MOV ESP, EAX" o-|" MOV EAX, EDX" [color=#FF8000];M[/color]
[color=#FF8000]M: JUMP[/color] o-|" MOV EDX, EAX" o-|" MOV EAX, [EBP]" o-|" LEA EBP, [EBP+CELL]" o|" JMP EDX" [color=#FF8000];M[/color]
[color=#FF8000]M: Type[/color] o-|" MOV EDX, [EBP]" o-|" PUSH EAX" o-|" PUSH EDX" o-|" PUSH dword [_STDOUT+TOKEN]" o-|" CALL [WriteFile]" o-|" NOP" o-|" NOP" o-|" NOP" [color=#FF8000];M[/color]
[color=#808080]\ -- ---------------------------------------------------------------------------[/color]
[color=#808080]\ пример транслируемого текста[/color] [color=#FF8000]TRANSLATE: zzz[/color] [color=#FF8000]LABEL: START[/color]
[color=#808080]\ первое определение[/color] [color=#FF8000]: NOOP[/color] [color=#0080C0]( --> )[/color] [color=#FF8000];[/color]
[color=#808080]\ удалить элемент под вершиной стека[/color] [color=#FF8000]: NIP[/color] [color=#0080C0]( a b --> b )[/color] NIP [color=#FF8000];[/color]
[color=#808080]\ удалить значение с вершины стека данных[/color] [color=#FF8000]: DROP[/color] [color=#0080C0]( n --> )[/color] DROP [color=#FF8000];[/color]
[color=#808080]\ дублировать значение n на вершине стека данных[/color] [color=#FF8000]: DUP[/color] [color=#0080C0]( n --> n n )[/color] DUP [color=#FF8000];[/color]
[color=#808080]\ обменять значения двух ячеек на вершине стека данных[/color] [color=#FF8000]: SWAP[/color] [color=#0080C0]( a b --> b a )[/color] SWAP [color=#FF8000];[/color]
[color=#808080]\ положить на вершину стека данных копию значения второго элемента[/color] [color=#FF8000]: OVER[/color] [color=#0080C0]( a b --> a b a )[/color] OVER [color=#FF8000];[/color]
[color=#808080]\ извлечь значение с указанного адреса[/color] [color=#FF8000]: @[/color] [color=#0080C0]( addr --> n )[/color] FETCH [color=#FF8000];[/color]
[color=#808080]\ сохранить значение n по указанному адресу[/color] [color=#FF8000]: ![/color] [color=#0080C0]( n addr --> )[/color] STORE SKP [color=#FF8000];[/color]
[color=#808080]\ сложить два числа на вершине стека данных, результат оставить на вершине[/color] [color=#FF8000]: +[/color] [color=#0080C0]( n1 n2 --> n )[/color] PLUS NIP [color=#FF8000];[/color]
[color=#808080]\ переместить указатель вершины стека данных на указанный адрес[/color] [color=#808080]\ в TOS остается значение[/color] [color=#FF8000]: SP![/color] [color=#0080C0]( addr --> )[/color] TOSP [color=#FF8000];[/color]
[color=#808080]\ переместить указатель вершины стека возвратов на указанный адрес[/color] [color=#FF8000]: RP![/color] [color=#0080C0]( addr --> )[/color] TORP JUMP [color=#FF8000];-[/color]
[color=#808080]\ выложить на вершину стека данных значение,[/color] [color=#808080]\ скомпилированное в коде за вызовом (LIT)[/color] [color=#FF8000]: (LIT)[/color] [color=#0080C0]( --> n )[/color] DUP RVAR GETLIT [color=#FF8000];-[/color]
[color=#808080]\ выложить на вершину стека данных значение,[/color] [color=#808080]\ скомпилированное в коде за вызовом (LIT)[/color] [color=#FF8000]: (DLIT)[/color] [color=#0080C0]( --> n )[/color] DUP DUP RVAR GETLIT [color=#FF8000];-[/color]
[color=#808080]\ вернуть адрес слова, вызов которого скомпилирован в коде вслед за (')[/color] [color=#FF8000]: (`)[/color] [color=#0080C0]( --> addr )[/color] DUP RVAR GETALIT [color=#FF8000];-[/color]
[color=#808080]\ вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину #[/color] [color=#FF8000]: (SLIT)[/color] [color=#0080C0]( --> asc # )[/color] (SLIT) [color=#FF8000];-[/color]
[color=#808080]\ положить на вершину стека адрес переменной[/color] [color=#FF8000]: (CREATE)[/color] [color=#0080C0]( --> addr )[/color] DUP RVAR [color=#FF8000];[/color]
[color=#808080]\ положить на вершину стека значение[/color] [color=#FF8000]: (CONSTANT)[/color] [color=#0080C0]( --> n )[/color] DUP RVAR FETCH [color=#FF8000];[/color]
[color=#808080]\ размер буферов TIB и PAD в байтах[/color] [color=#00F000]100[/color] [color=#FF8000]CONSTANT TIB#[/color] [color=#0080C0]( --> # )[/color] [color=#00F000]100[/color] [color=#FF8000]CONSTANT PAD#[/color] [color=#0080C0]( --> #)[/color]
[color=#808080]\ terminal input buffer[/color] CREATE TIB TIB# ALLOT
[color=#808080]\ буфер для форматного преобразования чисел и строк[/color] CREATE PAD PAD# ALLOT
[color=#808080]\ указатель на последний символ в PAD[/color] [color=#FF8000]VARIABLE HLD[/color]
[color=#808080]\ Дно стека данных[/color] [color=#FF8000]VARIABLE S0[/color] [color=#0080C0]( --> addr )[/color] [color=#808080]\ Дно стека возвратов[/color] [color=#FF8000]VARIABLE R0[/color] [color=#0080C0]( --> addr )[/color]
[color=#808080]\ размеры стеков[/color] [color=#00F000]0x1000[/color] [color=#FF8000]CONSTANT DataStack#[/color] [color=#00F000]0x1000[/color] [color=#FF8000]CONSTANT ReturnStack#[/color]
[color=#808080]\ Хранит адрес первой свободной ячейки памяти в пространстве кода и данных[/color] [color=#FF8000]VARIABLE DP[/color] [color=#0080C0]( --> addr )[/color] [color=#808080]\ Хранит адрес первой свободной ячейки памяти в пространстве имен[/color] [color=#FF8000]VARIABLE HDP[/color] [color=#0080C0]( --> addr )[/color]
[color=#808080]\ стандартные потоки В\В[/color] [color=#FF8000]VARIABLE STDIN[/color] [color=#FF8000]VARIABLE STDOUT[/color] [color=#FF8000]VARIABLE STDERR[/color]
[color=#808080]\ вернуть адрес первой свободной ячейки памят в пространстве кода и данных[/color] [color=#FF8000]: HERE[/color] [color=#0080C0]( --> addr )[/color] DP FETCH [color=#FF8000];[/color]
[color=#808080]\ вернуть адрес первой свободной ячейки памят в пространстве имен[/color] [color=#FF8000]: HHERE[/color] [color=#0080C0]( haddr --> addr )[/color] HDP FETCH [color=#FF8000];[/color]
[color=#808080]\ вывести в текущий STDOUT поток указанную строку[/color] [color=#FF8000]: TYPE[/color] [color=#0080C0]( asc # --> )[/color] Type [color=#FF8000];[/color]
[color=#808080]\ холодный запуск системы[/color] [color=#FF8000]: COLD[/color] [color=#0080C0]( --> )[/color] [color=#808080]\ LIMIT DP ![/color]
[color=#00F000]S" sample string"[/color] TYPE
[color=#00F000]0x12345678[/color] TIB# [color=#00F000]0x123456789ABCDEF[/color]
S0 R0 [color=#00A0A0]BEGIN[/color] SWAP OVER NIP DROP [color=#00A0A0]AGAIN[/color] [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ последнее определение системы[/color] CREATE LIMIT [color=#0080C0]( --> )[/color]
[color=#FF8000];TRANSLATE[/color]
~LIST [/b][/pre]
|
|
|
|
Добавлено: Вс дек 28, 2014 19:33 |
|
|
|
|
|
Заголовок сообщения: |
Re: Форт-транслятор в Ассемблер _ вариант 2 |
|
|
Итак, следующий транслируемый текст: Код: \ пример транслируемого текста TRANSLATE: zzz LABEL: START
\ первое определение : NOOP ( --> ) ;
\ удалить элемент под вершиной стека : NIP ( a b --> b ) NIP ;
\ удалить значение с вершины стека данных : DROP ( n --> ) DROP ;
\ дублировать значение n на вершине стека данных : DUP ( n --> n n ) DUP ;
\ обменять значения двух ячеек на вершине стека данных : SWAP ( a b --> b a ) SWAP ;
\ положить на вершину стека данных копию значения второго элемента : OVER ( a b --> a b a ) OVER ;
\ извлечь значение с указанного адреса : @ ( addr --> n ) FETCH ;
\ сохранить значение n по указанному адресу : ! ( n addr --> ) STORE SKP ;
\ сложить два числа на вершине стека данных, результат оставить на вершине : + ( n1 n2 --> n ) PLUS NIP ;
\ переместить указатель вершины стека данных на указанный адрес \ в TOS остается значение : SP! ( addr --> ) TOSP ;
\ переместить указатель вершины стека возвратов на указанный адрес : RP! ( addr --> ) TORP JUMP ;-
\ выложить на вершину стека данных значение, \ скомпилированное в коде за вызовом (LIT) : (LIT) ( --> n ) DUP RVAR GETLIT ;-
\ выложить на вершину стека данных значение, \ скомпилированное в коде за вызовом (LIT) : (DLIT) ( --> n ) DUP DUP RVAR GETLIT ;-
\ вернуть адрес слова, вызов которого скомпилирован в коде вслед за (') : (`) ( --> addr ) DUP RVAR GETALIT ;-
\ вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину # : (SLIT) ( --> asc # ) (SLIT) ;-
\ положить на вершину стека адрес переменной : (CREATE) ( --> addr ) DUP RVAR ;
\ положить на вершину стека значение : (CONSTANT) ( --> n ) DUP RVAR FETCH ;
\ размер буферов TIB и PAD в байтах 100 CONSTANT TIB# ( --> # ) 100 CONSTANT PAD# ( --> #)
\ terminal input buffer CREATE TIB TIB# ALLOT
\ буфер для форматного преобразования чисел и строк CREATE PAD PAD# ALLOT
\ указатель на последний символ в PAD VARIABLE HLD
\ Дно стека данных VARIABLE S0 ( --> addr ) \ Дно стека возвратов VARIABLE R0 ( --> addr )
\ размеры стеков 0x1000 CONSTANT DataStack# 0x1000 CONSTANT ReturnStack#
\ Хранит адрес первой свободной ячейки памяти в пространстве кода и данных VARIABLE DP ( --> addr ) \ Хранит адрес первой свободной ячейки памяти в пространстве имен VARIABLE HDP ( --> addr )
\ стандартные потоки В\В VARIABLE STDIN VARIABLE STDOUT VARIABLE STDERR
\ вернуть адрес первой свободной ячейки памят в пространстве кода и данных : HERE ( --> addr ) DP FETCH ;
\ вернуть адрес первой свободной ячейки памят в пространстве имен : HHERE ( haddr --> addr ) HDP FETCH ;
\ вывести в текущий STDOUT поток указанную строку : TYPE ( asc # --> ) Type ;
\ холодный запуск системы : COLD ( --> )
S" sample string" TYPE
0x12345678 TIB# 0x123456789ABCDEF
S0 R0 BEGIN SWAP OVER NIP DROP AGAIN ; IMMEDIATE
\ последнее определение системы CREATE LIMIT ( --> )
;TRANSLATE
превращается в следующий: Код: format PE console
include 'include\win32a.inc' include 'include\macro\struct.inc'
section '.import' import data readable writeable
library kernel,'KERNEL32.DLL'
import kernel,\ LoadLibrary, 'LoadLibrary',\ GetProcAddress, 'GetProcAddress',\ ExitProcess, 'ExitProcess',\ GetStdHandle, 'GetStdHandle',\ WriteFile, 'WriteFile',\ ReadFile, 'ReadFile'
; типы данных
struct cell body dd ? ; ends
struct addr body dd ? ; ends
struct token call db 0xE8 ref dd ? ends
struct scnt body db ? ends
struct ref body dd ? ends
; ------------------------------------------------------------------------------ ; объявление констант
ADDR = sizeof.addr ; размер адресной ссылки CELL = sizeof.cell ; размер ячейки данных REF = sizeof.ref ; размер ссылки TOKEN = sizeof.token ; размер токена SCNT = sizeof.scnt ; размер счетчика длины
dStack equ 0x1000 ; размер стека данных rStack equ 0x1000 ; размер стека возвратов
NamesSpace = 0x10000 CodeSpace = 0x10000
; вычисляем сколько места надо выделять под стеки stack (dStack+rStack)*2, dStack+rStack
; ------------------------------------------------------------------------------
latest = 0
; описатель форт-строк macro fstr [string] { common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
macro slit [str] { local labxx call _box addr labxx fstr str align labxx: }
; формат заголовка имени (подробнее см. _sHeader) macro def string,cfa,flg { dd latest latest=$-CELL addr cfa db flg common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
allot equ rb
macro align { repeat (($+CELL-1)and -CELL)-$ nop end repeat }
macro trialign { repeat (($+CELL-1)and -CELL)-$+3 nop end repeat }
section '.fvm' code executable readable writeable START: ; свободная метка ; первое определение align _NOOP: ; ( --> ) RET
; удалить элемент под вершиной стека align _NIP: ; ( a b --> b ) LEA EBP, [EBP+CELL] RET
; удалить значение с вершины стека данных align _DROP: ; ( n --> ) MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; дублировать значение n на вершине стека данных align _DUP: ; ( n --> n n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX RET
; обменять значения двух ячеек на вершине стека данных align _SWAP: ; ( a b --> b a ) MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX RET
; положить на вершину стека данных копию значения второго элемента align _OVER: ; ( a b --> a b a ) MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX RET
; извлечь значение с указанного адреса align _Fetch: ; ( addr --> n ) MOV EAX, [EAX] RET
; сохранить значение n по указанному адресу align _Store: ; ( n addr --> ) MOV EDX, [EBP] MOV dword [EAX], EDX MOV EAX, [EBP+CELL] LEA EBP, [EBP+8] RET
; сложить два числа на вершине стека данных, результат оставить на вершине align _Plus: ; ( n1 n2 --> n ) ADD EAX, [EBP] LEA EBP, [EBP+CELL] RET
; переместить указатель вершины стека данных на указанный адрес ; в TOS остается значение align _SPStore: ; ( addr --> ) MOV EBP, EAX RET
; переместить указатель вершины стека возвратов на указанный адрес align _RPStore: ; ( addr --> ) POP EDX MOV ESP, EAX MOV EAX, EDX MOV EDX, EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JMP EDX
; выложить на вершину стека данных значение, ; скомпилированное в коде за вызовом (LIT) align _lParLITrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+CELL] MOV EAX, [EAX] JMP EDX
; выложить на вершину стека данных значение, ; скомпилированное в коде за вызовом (LIT) align _lParDLITrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+CELL] MOV EAX, [EAX] JMP EDX
; вернуть адрес слова, вызов которого скомпилирован в коде вслед за (') align _lParTickrPar: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+TOKEN] MOV EAX, [EAX+1] JMP EDX
; вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину # align _lParSLITrPar: ; ( --> asc # ) LEA EBP, [EBP-8] MOV dword [EBP+CELL], EAX POP EBX LEA EDX, [EBX+CELL] MOV dword [EBP], EDX MOV EAX, [EBX] LEA EDX, [EBX+EAX+TOKEN] JMP EDX
; положить на вершину стека адрес переменной align _lParCREATErPar: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX RET
; положить на вершину стека значение align _lParCONSTANTrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX MOV EAX, [EAX] RET
; размер буферов TIB и PAD в байтах trialign _TIBSize: CALL _lParCONSTANTrPar dd 0x64
; ( --> # ) trialign _PADSize: CALL _lParCONSTANTrPar dd 0x64
; ( --> #) ; terminal input buffer trialign _TIB: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
; буфер для форматного преобразования чисел и строк trialign _PAD: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
; указатель на последний символ в PAD trialign _HLD: CALL _lParCREATErPar dd 0
; Дно стека данных trialign _S0: CALL _lParCREATErPar dd 0
; ( --> addr ) ; Дно стека возвратов trialign _R0: CALL _lParCREATErPar dd 0
; ( --> addr ) ; размеры стеков trialign _DataStackSize: CALL _lParCONSTANTrPar dd 0x1000
trialign _ReturnStackSize: CALL _lParCONSTANTrPar dd 0x1000
; Хранит адрес первой свободной ячейки памяти в пространстве кода и данных trialign _DP: CALL _lParCREATErPar dd 0
; ( --> addr ) ; Хранит адрес первой свободной ячейки памяти в пространстве имен trialign _HDP: CALL _lParCREATErPar dd 0
; ( --> addr ) ; стандартные потоки В\В trialign _STDIN: CALL _lParCREATErPar dd 0
trialign _STDOUT: CALL _lParCREATErPar dd 0
trialign _STDERR: CALL _lParCREATErPar dd 0
; вернуть адрес первой свободной ячейки памят в пространстве кода и данных align _HERE: ; ( --> addr ) CALL _DP MOV EAX, [EAX] RET
; вернуть адрес первой свободной ячейки памят в пространстве имен align _HHERE: ; ( haddr --> addr ) CALL _HDP MOV EAX, [EAX] RET
; вывести в текущий STDOUT поток указанную строку align _TYPE: ; ( asc # --> ) MOV EDX, [EBP] PUSH EAX PUSH EDX PUSH dword [_STDOUT+TOKEN] CALL [WriteFile] NOP NOP NOP RET
; холодный запуск системы align _COLD: ; ( --> ) ; LIMIT DP ! CALL _lParSLITrPar dd 0xD db 0x73,0x61,0x6D,0x70,0x6C,0x65,0x20,0x73,0x74,0x72,0x69,0x6E,0x67,0x00 CALL _TYPE CALL _lParLITrPar dd 0x12345678 CALL _TIBSize CALL _lParDLITrPar dq 0x123456789ABCDEF CALL _S0 CALL _R0 lab_0001: ; метка для перехода назад MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX LEA EBP, [EBP+CELL] MOV EAX, [EBP] LEA EBP, [EBP+CELL] JMP lab_0001 ; переход назад RET
; последнее определение системы trialign _LIMIT: CALL _lParCREATErPar ; ( --> )
entry _COLD ; точка входа
section '.names' data readable writeable ; makevoc FORTH
; Имя, Метка, Флаг immediate def 'LIMIT', _LIMIT, 1 def 'COLD', _COLD, -1 def 'TYPE', _TYPE, 1 def 'HHERE', _HHERE, 1 def 'HERE', _HERE, 1 def 'STDERR', _STDERR, 1 def 'STDOUT', _STDOUT, 1 def 'STDIN', _STDIN, 1 def 'HDP', _HDP, 1 def 'DP', _DP, 1 def 'ReturnStack#', _ReturnStackSize, 1 def 'DataStack#', _DataStackSize, 1 def 'R0', _R0, 1 def 'S0', _S0, 1 def 'HLD', _HLD, 1 def 'PAD', _PAD, 1 def 'TIB', _TIB, 1 def 'PAD#', _PADSize, 1 def 'TIB#', _TIBSize, 1 def '(CONSTANT)', _lParCONSTANTrPar, 1 def '(CREATE)', _lParCREATErPar, 1 def '(SLIT)', _lParSLITrPar, 1 def '(`)', _lParTickrPar, 1 def '(DLIT)', _lParDLITrPar, 1 def '(LIT)', _lParLITrPar, 1 def 'RP!', _RPStore, 1 def 'SP!', _SPStore, 1 def '+', _Plus, 1 def '!', _Store, 1 def '@', _Fetch, 1 def 'OVER', _OVER, 1 def 'SWAP', _SWAP, 1 def 'DUP', _DUP, 1 def 'DROP', _DROP, 1 def 'NIP', _NIP, 1 def 'NOOP', _NOOP, 1 LATEST: ; чтобы получить хвост цепочки имен NSADDR: allot NamesSpace-($-$$) ;
Понятно, код форт-системы пока в виде наброска, но Fasm компилит, и даже можно попробовать посмотреть на результат в дебагере (хотя TYPE пока не рабочий).
Итак, следующий транслируемый текст:
[code]\ пример транслируемого текста TRANSLATE: zzz LABEL: START
\ первое определение : NOOP ( --> ) ;
\ удалить элемент под вершиной стека : NIP ( a b --> b ) NIP ;
\ удалить значение с вершины стека данных : DROP ( n --> ) DROP ;
\ дублировать значение n на вершине стека данных : DUP ( n --> n n ) DUP ;
\ обменять значения двух ячеек на вершине стека данных : SWAP ( a b --> b a ) SWAP ;
\ положить на вершину стека данных копию значения второго элемента : OVER ( a b --> a b a ) OVER ;
\ извлечь значение с указанного адреса : @ ( addr --> n ) FETCH ;
\ сохранить значение n по указанному адресу : ! ( n addr --> ) STORE SKP ;
\ сложить два числа на вершине стека данных, результат оставить на вершине : + ( n1 n2 --> n ) PLUS NIP ;
\ переместить указатель вершины стека данных на указанный адрес \ в TOS остается значение : SP! ( addr --> ) TOSP ;
\ переместить указатель вершины стека возвратов на указанный адрес : RP! ( addr --> ) TORP JUMP ;-
\ выложить на вершину стека данных значение, \ скомпилированное в коде за вызовом (LIT) : (LIT) ( --> n ) DUP RVAR GETLIT ;-
\ выложить на вершину стека данных значение, \ скомпилированное в коде за вызовом (LIT) : (DLIT) ( --> n ) DUP DUP RVAR GETLIT ;-
\ вернуть адрес слова, вызов которого скомпилирован в коде вслед за (') : (`) ( --> addr ) DUP RVAR GETALIT ;-
\ вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину # : (SLIT) ( --> asc # ) (SLIT) ;-
\ положить на вершину стека адрес переменной : (CREATE) ( --> addr ) DUP RVAR ;
\ положить на вершину стека значение : (CONSTANT) ( --> n ) DUP RVAR FETCH ;
\ размер буферов TIB и PAD в байтах 100 CONSTANT TIB# ( --> # ) 100 CONSTANT PAD# ( --> #)
\ terminal input buffer CREATE TIB TIB# ALLOT
\ буфер для форматного преобразования чисел и строк CREATE PAD PAD# ALLOT
\ указатель на последний символ в PAD VARIABLE HLD
\ Дно стека данных VARIABLE S0 ( --> addr ) \ Дно стека возвратов VARIABLE R0 ( --> addr )
\ размеры стеков 0x1000 CONSTANT DataStack# 0x1000 CONSTANT ReturnStack#
\ Хранит адрес первой свободной ячейки памяти в пространстве кода и данных VARIABLE DP ( --> addr ) \ Хранит адрес первой свободной ячейки памяти в пространстве имен VARIABLE HDP ( --> addr )
\ стандартные потоки В\В VARIABLE STDIN VARIABLE STDOUT VARIABLE STDERR
\ вернуть адрес первой свободной ячейки памят в пространстве кода и данных : HERE ( --> addr ) DP FETCH ;
\ вернуть адрес первой свободной ячейки памят в пространстве имен : HHERE ( haddr --> addr ) HDP FETCH ;
\ вывести в текущий STDOUT поток указанную строку : TYPE ( asc # --> ) Type ;
\ холодный запуск системы : COLD ( --> )
S" sample string" TYPE
0x12345678 TIB# 0x123456789ABCDEF
S0 R0 BEGIN SWAP OVER NIP DROP AGAIN ; IMMEDIATE
\ последнее определение системы CREATE LIMIT ( --> )
;TRANSLATE
[/code]
превращается в следующий: [code]format PE console
include 'include\win32a.inc' include 'include\macro\struct.inc'
section '.import' import data readable writeable
library kernel,'KERNEL32.DLL'
import kernel,\ LoadLibrary, 'LoadLibrary',\ GetProcAddress, 'GetProcAddress',\ ExitProcess, 'ExitProcess',\ GetStdHandle, 'GetStdHandle',\ WriteFile, 'WriteFile',\ ReadFile, 'ReadFile'
; типы данных
struct cell body dd ? ; ends
struct addr body dd ? ; ends
struct token call db 0xE8 ref dd ? ends
struct scnt body db ? ends
struct ref body dd ? ends
; ------------------------------------------------------------------------------ ; объявление констант
ADDR = sizeof.addr ; размер адресной ссылки CELL = sizeof.cell ; размер ячейки данных REF = sizeof.ref ; размер ссылки TOKEN = sizeof.token ; размер токена SCNT = sizeof.scnt ; размер счетчика длины
dStack equ 0x1000 ; размер стека данных rStack equ 0x1000 ; размер стека возвратов
NamesSpace = 0x10000 CodeSpace = 0x10000
; вычисляем сколько места надо выделять под стеки stack (dStack+rStack)*2, dStack+rStack
; ------------------------------------------------------------------------------
latest = 0
; описатель форт-строк macro fstr [string] { common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
macro slit [str] { local labxx call _box addr labxx fstr str align labxx: }
; формат заголовка имени (подробнее см. _sHeader) macro def string,cfa,flg { dd latest latest=$-CELL addr cfa db flg common local .count, .body .count scnt ? .body db string,0 store $-.body-1 at .count }
allot equ rb
macro align { repeat (($+CELL-1)and -CELL)-$ nop end repeat }
macro trialign { repeat (($+CELL-1)and -CELL)-$+3 nop end repeat }
section '.fvm' code executable readable writeable START: ; свободная метка ; первое определение align _NOOP: ; ( --> ) RET
; удалить элемент под вершиной стека align _NIP: ; ( a b --> b ) LEA EBP, [EBP+CELL] RET
; удалить значение с вершины стека данных align _DROP: ; ( n --> ) MOV EAX, [EBP] LEA EBP, [EBP+CELL] RET
; дублировать значение n на вершине стека данных align _DUP: ; ( n --> n n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX RET
; обменять значения двух ячеек на вершине стека данных align _SWAP: ; ( a b --> b a ) MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX RET
; положить на вершину стека данных копию значения второго элемента align _OVER: ; ( a b --> a b a ) MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX RET
; извлечь значение с указанного адреса align _Fetch: ; ( addr --> n ) MOV EAX, [EAX] RET
; сохранить значение n по указанному адресу align _Store: ; ( n addr --> ) MOV EDX, [EBP] MOV dword [EAX], EDX MOV EAX, [EBP+CELL] LEA EBP, [EBP+8] RET
; сложить два числа на вершине стека данных, результат оставить на вершине align _Plus: ; ( n1 n2 --> n ) ADD EAX, [EBP] LEA EBP, [EBP+CELL] RET
; переместить указатель вершины стека данных на указанный адрес ; в TOS остается значение align _SPStore: ; ( addr --> ) MOV EBP, EAX RET
; переместить указатель вершины стека возвратов на указанный адрес align _RPStore: ; ( addr --> ) POP EDX MOV ESP, EAX MOV EAX, EDX MOV EDX, EAX MOV EAX, [EBP] LEA EBP, [EBP+CELL] JMP EDX
; выложить на вершину стека данных значение, ; скомпилированное в коде за вызовом (LIT) align _lParLITrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+CELL] MOV EAX, [EAX] JMP EDX
; выложить на вершину стека данных значение, ; скомпилированное в коде за вызовом (LIT) align _lParDLITrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+CELL] MOV EAX, [EAX] JMP EDX
; вернуть адрес слова, вызов которого скомпилирован в коде вслед за (') align _lParTickrPar: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX LEA EDX, [EAX+TOKEN] MOV EAX, [EAX+1] JMP EDX
; вернуть адрес начала строки asc, размещенной в коде за (SLIT), и ее длину # align _lParSLITrPar: ; ( --> asc # ) LEA EBP, [EBP-8] MOV dword [EBP+CELL], EAX POP EBX LEA EDX, [EBX+CELL] MOV dword [EBP], EDX MOV EAX, [EBX] LEA EDX, [EBX+EAX+TOKEN] JMP EDX
; положить на вершину стека адрес переменной align _lParCREATErPar: ; ( --> addr ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX RET
; положить на вершину стека значение align _lParCONSTANTrPar: ; ( --> n ) LEA EBP, [EBP-CELL] MOV dword [EBP], EAX POP EAX MOV EAX, [EAX] RET
; размер буферов TIB и PAD в байтах trialign _TIBSize: CALL _lParCONSTANTrPar dd 0x64
; ( --> # ) trialign _PADSize: CALL _lParCONSTANTrPar dd 0x64
; ( --> #) ; terminal input buffer trialign _TIB: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
; буфер для форматного преобразования чисел и строк trialign _PAD: CALL _lParCREATErPar db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
; указатель на последний символ в PAD trialign _HLD: CALL _lParCREATErPar dd 0
; Дно стека данных trialign _S0: CALL _lParCREATErPar dd 0
; ( --> addr ) ; Дно стека возвратов trialign _R0: CALL _lParCREATErPar dd 0
; ( --> addr ) ; размеры стеков trialign _DataStackSize: CALL _lParCONSTANTrPar dd 0x1000
trialign _ReturnStackSize: CALL _lParCONSTANTrPar dd 0x1000
; Хранит адрес первой свободной ячейки памяти в пространстве кода и данных trialign _DP: CALL _lParCREATErPar dd 0
; ( --> addr ) ; Хранит адрес первой свободной ячейки памяти в пространстве имен trialign _HDP: CALL _lParCREATErPar dd 0
; ( --> addr ) ; стандартные потоки В\В trialign _STDIN: CALL _lParCREATErPar dd 0
trialign _STDOUT: CALL _lParCREATErPar dd 0
trialign _STDERR: CALL _lParCREATErPar dd 0
; вернуть адрес первой свободной ячейки памят в пространстве кода и данных align _HERE: ; ( --> addr ) CALL _DP MOV EAX, [EAX] RET
; вернуть адрес первой свободной ячейки памят в пространстве имен align _HHERE: ; ( haddr --> addr ) CALL _HDP MOV EAX, [EAX] RET
; вывести в текущий STDOUT поток указанную строку align _TYPE: ; ( asc # --> ) MOV EDX, [EBP] PUSH EAX PUSH EDX PUSH dword [_STDOUT+TOKEN] CALL [WriteFile] NOP NOP NOP RET
; холодный запуск системы align _COLD: ; ( --> ) ; LIMIT DP ! CALL _lParSLITrPar dd 0xD db 0x73,0x61,0x6D,0x70,0x6C,0x65,0x20,0x73,0x74,0x72,0x69,0x6E,0x67,0x00 CALL _TYPE CALL _lParLITrPar dd 0x12345678 CALL _TIBSize CALL _lParDLITrPar dq 0x123456789ABCDEF CALL _S0 CALL _R0 lab_0001: ; метка для перехода назад MOV EDX, EAX MOV EAX, [EBP] MOV dword [EBP], EDX MOV EDX, [EBP] LEA EBP, [EBP-CELL] MOV dword [EBP], EAX MOV EAX, EDX LEA EBP, [EBP+CELL] MOV EAX, [EBP] LEA EBP, [EBP+CELL] JMP lab_0001 ; переход назад RET
; последнее определение системы trialign _LIMIT: CALL _lParCREATErPar ; ( --> )
entry _COLD ; точка входа
section '.names' data readable writeable ; makevoc FORTH
; Имя, Метка, Флаг immediate def 'LIMIT', _LIMIT, 1 def 'COLD', _COLD, -1 def 'TYPE', _TYPE, 1 def 'HHERE', _HHERE, 1 def 'HERE', _HERE, 1 def 'STDERR', _STDERR, 1 def 'STDOUT', _STDOUT, 1 def 'STDIN', _STDIN, 1 def 'HDP', _HDP, 1 def 'DP', _DP, 1 def 'ReturnStack#', _ReturnStackSize, 1 def 'DataStack#', _DataStackSize, 1 def 'R0', _R0, 1 def 'S0', _S0, 1 def 'HLD', _HLD, 1 def 'PAD', _PAD, 1 def 'TIB', _TIB, 1 def 'PAD#', _PADSize, 1 def 'TIB#', _TIBSize, 1 def '(CONSTANT)', _lParCONSTANTrPar, 1 def '(CREATE)', _lParCREATErPar, 1 def '(SLIT)', _lParSLITrPar, 1 def '(`)', _lParTickrPar, 1 def '(DLIT)', _lParDLITrPar, 1 def '(LIT)', _lParLITrPar, 1 def 'RP!', _RPStore, 1 def 'SP!', _SPStore, 1 def '+', _Plus, 1 def '!', _Store, 1 def '@', _Fetch, 1 def 'OVER', _OVER, 1 def 'SWAP', _SWAP, 1 def 'DUP', _DUP, 1 def 'DROP', _DROP, 1 def 'NIP', _NIP, 1 def 'NOOP', _NOOP, 1 LATEST: ; чтобы получить хвост цепочки имен NSADDR: allot NamesSpace-($-$$) ; [/code]
Понятно, код форт-системы пока в виде наброска, но Fasm компилит, и даже можно попробовать посмотреть на результат в дебагере (хотя TYPE пока не рабочий).
|
|
|
|
Добавлено: Вс дек 28, 2014 19:25 |
|
|
|
|
|
Заголовок сообщения: |
Форт-транслятор в Ассемблер _ вариант 2 |
|
|
Продолжение оригинальной темы в дополнению к идее реализации и первому наброску продолжение развития реализации будет тут, т.к. в оригинальной теме толку не видно, и, посему, флуд и оффтопик в данной теме будет вычищаться.
Продолжение [url=http://fforum.winglion.ru/viewtopic.php?f=2&t=3025]оригинальной темы[/url] в дополнению к [url=http://fforum.winglion.ru/viewtopic.php?p=40200#p40200]идее реализации[/url] и [url=http://fforum.winglion.ru/viewtopic.php?p=40233#p40233]первому наброску[/url] продолжение развития реализации будет тут, т.к. в оригинальной теме толку не видно, и, посему, флуд и оффтопик в данной теме будет вычищаться.
|
|
|
|
Добавлено: Вс дек 28, 2014 19:21 |
|
|
|
|