Оптимизация Форта (1этап).
(Письмо) Относиться к версии SPF 4.0 (build 007).
Преамбула
Очень хотелось бы сделать Форт профессиональным языком. Все возможности в нем
есть!!! Но давайте сразу писать профессиональные проги, а не временные заглушки.
Как говорил один персонаж: "Лучше день потратить, а потом за час долететь".
Кстати, это мой девиз.
Итак к делу:
1) Будет значительно проще организовывать Форт-асмовые процы, если
в тупую поменять местами регистры EBP и ESI. Это сразу дает
уменьшение кода на 1 байт при каждом обращении к стеку (нет чистой
команды [ebp], есть только [ebp+0], тогда как ESI изначально
указатель).
При этом значительно проще можно брать числа из стека:
Раньше drop:
LEA EBP, -4 [EBP] ; 3b
MOV EAX, [EBP] ; 3b
Теперь:
LODSB ; 1b = drop
Ну как?
Будет принято или нет, не знаю, но дальше продолжаю, полагая, что
ничего в SPF не изменилось.
2) По поводу арифметики. Команды типа: lea eax, [eax+1] занимает 3
байта, и ни чем по функциональным возможностям не уступает inc eax (1 байт).
Делайте выводы...
3) Многие команды не оптимизированы (смотри в конце документа).
И вообще...
4) Что это за команда LEA?
Она оптимальна только для вычислений: LEA eax, [edi+4*ebx+num]
lea ebp, [ebp-4] ; коды 8В 6В -4
гораздо и понятней и наверно быстрее (так как простая АЛУ математика):
sub ebp, 4 ; 83 ED 4
так еще и традиционней.
P.S. Кстати есть собственный компилятор ассемблера. Если у меня будет
времени достаточно, адаптирую его под SPF.
Достоинства. нет необходимости для оптимальных операций писать:
CODE PICK ( xu ... x1 x0 u -- xu ... x1 x0 xu )
A; 8B C, 44 C, 85 C, 00 C, \ MOV EAX, [EBP + EAX*4 ]
RET
END-CODE
Достаточно просто:
CODE PICK ( xu ... x1 x0 u -- xu ... x1 x0 xu )
MOV EAX, [EBP + EAX*4 ]
next ; next - RET для удобства, мало ли какой я Next захочу.
; может отладочный...
END-CODE
Там уже компилится короткий код...
(Я над ним год потел)
Гневные пожелания и не очень жду по e-mail: winforth@narod.ru(Ежу)
Appendix.
Все что закоментировано - было раньше
spf_find, spf_win_api
попозже.
Модуль spf_defwords:
: (DOES2) asm
sub ebp, 4
mov [ebp], eax
pop ebx, eax ; извиняюсь, моя фича = pop ebx, pop eax
jmp ebx
; или так, если важна скорость
; mov eax, [esp+4]
; ret 4 ; C2 4 0
; хотя я бы предпочел первый вариант, он короче на 2 байта.
; было
; LEA EBP, -4 [EBP]
; MOV [EBP], EAX
; MOV EAX, 4 [ESP]
; MOV EBX, [ESP]
; LEA ESP, 8 [ESP]
; JMP EBX
ENDCODE
Модуль spf_wordlist:
CODE NAME>F ( NFA -> FFA )
dec eax
; LEA EAX, -1 [EAX] ; ????????????? 80 <- смайлик
RET
END-CODE
CODE NAME>L ( NFA -> LFA )
MOVZX EBX, BYTE [EAX]
; LEA EAX, [EBX] [EAX]
; LEA EAX, 1 [EAX]
lea eax, [eax+ebx+1]
RET
END-CODE
CODE CDR ( NFA1 -> NFA2 )
xchg eax, ecx ; 1б
jcxz @@1
MOVZX EBX, BYTE [ECX]
MOV EAX, 1 [EBX] [ECX]
; OR EAX, EAX
; JZ SHORT @@1
; MOVZX EBX, BYTE [EAX]
; MOV EAX, 1 [EBX] [EAX]
@@1: RET
END-CODE
Модуль spf_immed_loop:
: LOOP \ 94
\ Интерпретация: ( C: do-sys -- )
\ Добавить семантику времени выполнения, данную ниже, к текущему определению.
\ Разрешить все появления LEAVE между позицией, данной do-sys и следующей
\ позицией передачи управления для выполнения слов за LOOP.
\ Время выполнения: ( -- ) ( R: loop-sys1 -- | loop-sys2 )
\ Неопределенная ситуация возникает, если параметры цикла недоступны.
\ Прибавить единицу к индексу цикла. Если индекс цикла стал равным пределу,
\ убрать параметры цикла и продолжить выполнение сразу за циклом. Иначе
\ продолжить выполнение с начала цикла.
?COMP
24 04FF W, C, \ inc dword [esp]
HERE 2+ - DUP SHORT?
IF
71 C, C, \ jno short
ELSE
4 - 0F C, 81 C, , \ jno near
THEN
\ 0C24648D , \ lea esp, 0c [esp] !!!!!!!!!
0cc483 , \ add esp, 0c
HERE SWAP !
; IMMEDIATE
: +LOOP - тоже, тамже
: LEAVE \ 94
\ Интерпретация: семантика неопределена.
\ Выполнение: ( -- ) ( R: loop-sys -- )
\ Убрать текущие параметры цикла. Неопределенная ситуация возникает, если
\ они недоступны. Продолжить выполнение сразу за самыми внутренними DO ... LOOP
\ или DO ... +LOOP.
?COMP
\ 0824648D , \ lea esp, 08 [esp]
08c483 , \ add esp, 08 или pop ebx, ebx
C3 C, \ ret
; IMMEDIATE
: UNLOOP - тоже
Модуль spf_compile:
: BRANCH, ( ADDR -> ) \ скомпилировать инструкцию ADDR JMP
HERE CELL+ 1+ -
dup -128 127 within if EB C, C, else E9 C, , then
;
: RLIT, ( u -- )
\ Скомпилировать следующую семантику:
\ Положить на стек возвратов литерал u
dup -128 127 within if 6A C, C, else 68 C, , then
;
Модуль spf_nonopt:
CODE1 RDROP ( -> )
; POP EBX
; LEA ESP, 4 [ESP]
; JMP EBX
ret 4 ; C2 4 0
;C
CODE1 >R \ 94
\ Исполнение: ( x -- ) ( R: -- x )
\ Перенести x на стек возвратов.
\ Интерпретация: семантика в режиме интерпретации не определена.
; В принципе размер не изменился, ни скорость также, но в конце ret
xchg eax, [esp]
push eax
; POP EBX
; PUSH EAX
MOV EAX, [EBP]
LEA EBP, 4 [EBP]
; JMP EBX
ret ; а вдруг мы захотим изменить ret на более функциональный next
;C
тоже с r>
CODE1 ?DUP ( x -- 0 | x x ) \ 94
\ Продублировать x, если не ноль.
OR EAX, EAX
JZ short @@1
sub ebp, 4
mov [ebp], eax ; длинее на 2 байта, зато отвязались от лишней команды
; будет нужно, если вдруг нужно будет загружать библу
; но решай сам...
@@1: RET
;C
Модуль spf_forthproc:
CODE 2DUP ( x1 x2 -- x1 x2 x1 x2 ) \ 94
\ Продублировать пару ячеек x1 x2.
MOV ECX, [EBP]
sub ebp, 8
mov [ebp+4], eax
mov [ebp], ecx ; если бы была команда [ebp], то байт сэкономили бы
; MOV -4 [EBP], EAX
; MOV -8 [EBP], ECX
; LEA EBP, -8 [EBP]
RET
END-CODE
CODE SWAP ( x1 x2 -- x2 x1 ) \ 94
\ поменять местами два верхних элемента стека
XCHG EAX, [EBP] почему нет????????? = 240487
\ MOV EDX, [EBP]
\ MOV [EBP], EAX
\ MOV EAX, EDX
RET
END-CODE
CODE 2SWAP ( x1 x2 x3 x4 -- x3 x4 x1 x2 ) \ 94
\ Поменять местами две верхние пары ячеек.
MOV ECX, [EBP]
xchg eax, [ebp+4]
xchg ecx, [ebp+8]
mov [ebp], ecx
\ MOV ECX, [EBP]
\ MOV EBX, 4 [EBP]
\ MOV EDX, 8 [EBP]
\ MOV 8 [EBP], ECX
\ MOV 4 [EBP], EAX
\ MOV [EBP], EDX
\ MOV EAX, EBX
RET
END-CODE
CODE ROT ( x1 x2 x3 -- x2 x3 x1 ) \ 94
\ Прокрутить три верхних элемента стека.
xchg eax, [ebp]
xchg eax, [ebp+4]
\ MOV EDX, [EBP]
\ MOV [EBP], EAX
\ MOV EAX, 4 [EBP]
\ MOV 4 [EBP], EDX
RET
END-CODE
CODE -ROT ( x1 x2 x3 -- x3 x1 x2 ) \ 94
\ Прокрутить три верхних элемента стека.
xchg eax, [ebp+4]
xchg eax, [ebp]
\ MOV EDX, 4 [EBP]
\ MOV 4 [EBP], EAX
\ MOV EAX, [EBP]
\ MOV [EBP], EDX
RET
END-CODE
CODE ROLL ( xu xu-1 ... x0 u -- xu-1 ... x0 xu ) \ 94 CORE EXT
\ Убрать u. Повернуть u+1 элемент на вершине стека.
\ Неопределенная ситуация возникает, если перед выполнением ROLL
\ на стеке меньше чем u+2 элементов.
xchg eax, ecx
mov eax, [ebp]
add ebp, 4
jcxz @@1
mov ebx, ebp
@@2:
xchg [ebx], eax
add ebx, 4
loop @@2
@@1:
ret
\ OR EAX, EAX
\ JZ SHORT @@1
\ MOV ECX, EAX
\ LEA EAX, [EAX*4]
\ MOV EDX, EBP
\ ADD EDX, EAX
\ MOV EBX, [EDX]
\@@2: LEA EDX, -4 [EDX]
\ MOV EAX, [EDX]
\ MOV 4 [EDX], EAX
\ DEC ECX
\ JNZ SHORT @@2
\ MOV EAX, EBX
\ JMP SHORT @@3
\@@1: MOV EAX, [EBP]
\@@3: LEA EBP, 4 [EBP]
\ RET
END-CODE
CODE TUCK ( x1 x2 -- x2 x1 x2 )
\ Copy the first (top) stack item below the second stack item.
mov ebx, eax
xchg [ebp], ebx
sub ebp, 4
mov [ebp], ebx
\ LEA EBP, -4 [EBP]
\ MOV EDX, 4 [EBP]
\ MOV [EBP], EDX
\ MOV 4 [EBP], EAX
RET
END-CODE
CODE 2R> \ 94 CORE EXT
\ Интерпретация: семантика неопределена.
\ Выполнение: ( -- x1 x2 ) ( R: x1 x2 -- )
\ Перенести пару ячеек x1 x2 со стека возвратов. Семантически
\ эквивалентно R> R> SWAP.
pop ebx
MOV -4 [EBP], EAX
pop eax, ecx
sub ebp, 8
mov [ebp], ecx
\ MOV EBX, [ESP]
\ MOV -4 [EBP], EAX
\ MOV ECX, 8 [ESP]
\ MOV EAX, 4 [ESP]
\ MOV -8 [EBP], ECX
\ LEA EBP, -8 [EBP]
\ LEA ESP, 0C [ESP]
JMP EBX
END-CODE
CODE 1+ ( n1|u1 -- n2|u2 ) \ 94
\ Прибавить 1 к n1|u1 и получить сумму u2|n2.
\ LEA EAX, 1 [EAX]
inc eax
RET
END-CODE
CODE 1- ( n1|u1 -- n2|u2 ) \ 94
\ Вычесть 1 из n1|u1 и получить разность n2|u2.
\ LEA EAX, -1 [EAX]
dec eax
RET
END-CODE
CODE 2+ ( W -> W+2 )
\ LEA EAX, 2 [EAX]
inc eax ; короче на 1 байт
inc eax
RET
END-CODE
CODE 2- ( W -> W-2 )
\ LEA EAX, -2 [EAX]
dec eax
dec eax
RET
END-CODE
CODE 2*
\ LEA EAX, [EAX*2] ; 4 байта
add eax, eax ; 2 байта, так еще и быстрее
RET
END-CODE
CODE CELL+
add eax, 4 ; помоему это проще
RET
END-CODE
CODE CELLS
LEA EAX, [EAX*4]
RET
END-CODE
CODE 0! ( A -> )
push 0
pop dwp [eax] ; 3б
\ MOV DWORD [EAX], # 0 ; 5 байт
MOV EAX, [EBP]
LEA EBP, 4 [EBP]
RET
END-CODE
CODE DNEGATE ( d1 -- d2 ) \ 94 DOUBLE
\ d2 результат вычитания d1 из нуля.
\ MOV EBX, [EBP]
NEG EAX
\ NEG EBX
NEG dword ptr [EBP] ; разве не работала???
SBB EAX, # 0
\ MOV [EBP], EBX
RET
END-CODE
CODE S>D ( n -- d ) \ 94
\ Преобразовать число n в двойное число d с тем же числовым значением.
CDQ
LEA EBP, -4 [EBP]
MOV [EBP], EAX
\ MOV EAX, EDX
xchg EAX, EDX ; 1 байт
RET
END-CODE
CODE / ( n1 n2 -- n3 ) \ 94
\ Делить n1 на n2, получить частное n3.
\ Исключительная ситуация возникает, если n2 равен нулю.
\ Если n1 и n2 различаются по знаку - возвращаемый результат зависит от
\ реализации.
xchg eax, [ebp]
cdq
idiv dword [ebp]
add ebp, 4
\ MOV ECX, EAX
\ MOV EAX, [EBP]
\ CDQ
\ IDIV ECX
\ LEA EBP, 4 [EBP]
RET
END-CODE
CODE U/ ( W1, W2 -> W3 ) \ беззнаковое деление W1 на W2
xchg eax, [ebp]
xor edx, edx
div dword ptr [ebp]
add ebp, 4
\ MOV ECX, EAX
\ MOV EAX, [EBP]
\ LEA EBP, 4 [EBP]
\ XOR EDX, EDX
\ DIV ECX
\ RET
END-CODE
CODE +! ( n|u a-addr -- ) \ 94
\ Прибавить n|u к одинарному числу по адресу a-addr.
mov ebx, [ebp]
add [eax], ebx
mov eax, [ebp+4]
add ebp, 8
\ MOV EBX, [EAX]
\ ADD EBX, [EBP]
\ MOV [EAX], EBX
\ LEA EBP, 8 [EBP]
\ MOV EAX, -4 [EBP]
RET
END-CODE
CODE MOD ( n1 n2 -- n3 ) \ 94
\ Делить n1 на n2, получить остаток n3.
\ Исключительная ситуация возникает, если n2 равен нулю.
\ Если n1 и n2 различаются по знаку - возвращаемый результат зависит от
\ реализации.
xchg eax, [ebp]
cdq
idiv dword [ebp]
xchg eax, edx
add ebp, 4
\ MOV EBX, EAX
\ MOV EAX, [EBP]
\ CDQ
\ IDIV EBX
\ LEA EBP, 4 [EBP]
\ MOV EAX, EDX
RET
END-CODE
CODE UMOD ( W1, W2 -> W3 ) \ остаток от деления W1 на W2
xchg eax, [ebp]
xor edx, edx
div dword [ebp]
xchg eax, edx
add ebp, 4
\ MOV EBX, EAX
\ MOV EAX, [EBP]
\ XOR EDX, EDX
\ DIV EBX
\ LEA EBP, 4 [EBP]
\ MOV EAX, EDX
RET
END-CODE
CODE UM/MOD ( ud n -- u2 u3 ) \ 94
\ CODE UM/MOD ( ud u1 -- u2 u3 ) \ 94
\ Делить ud на u1, получить частное u3 и остаток u2.
\ Все значения и арифметика беззнаковые.
\ Исключительная ситуация возникает, если u1 ноль или частное
\ находится вне диапазона одинарных беззнаковых чисел.
xchg eax, [ebp+4]
mov edx, [ebp]
add ebp, 4
div dword ptr [ebp]
mov [ebp], edx
\ MOV EBX, EAX
\ MOV EDX, [EBP]
\ MOV EAX, 4 [EBP]
\ DIV EBX
\ LEA EBP, 4 [EBP]
\ MOV [EBP], EDX
RET
END-CODE
CODE */MOD ( n1 n2 n3 -- n4 n5 ) \ 94
\ Умножить n1 на n2, получить промежуточный двойной результат d.
\ Разделить d на n3, получить остаток n4 и частное n5.
xchg eax, [ebp]
imul dword ptr [ebp+4]
idiv dword ptr [ebp]
add ebp, 4
mov [ebp], edx
\ MOV EBX, EAX
\ MOV EAX, [EBP]
\ MOV ECX, 4 [EBP]
\ IMUL ECX
\ IDIV EBX
\ MOV 4 [EBP], EDX
\ LEA EBP, 4 [EBP]
RET
END-CODE
CODE M* ( n1 n2 -- d ) \ 94
\ d - знаковый результат умножения n1 на n2.
imul dword ptr [ebp]
xchg eax, edx
mov [ebp], edx
\ IMUL DWORD [EBP]
\ MOV [EBP], EAX
\ MOV EAX, EDX
RET
END-CODE
CODE LSHIFT ( x1 u -- x2 ) \ 94
\ Сдвинуть x1 на u бит влево. Поместить нули в наименее значимые биты,
\ освобождаемые при сдвиге.
\ Неоднозначная ситуация возникает, если u больше или равно
\ числу бит в ячейке.
xchg eax, ecx
shl dword ptr [ebp], cl
mov eax, dwp [ebp]
add ebp, 4
\ MOV ECX, EAX
\ MOV EAX, [EBP]
\ SHL EAX, CL
\ LEA EBP, 4 [EBP]
RET
END-CODE
CODE RSHIFT ( x1 u -- x2 ) \ 94
\ Сдвинуть x1 на u бит вправо. Поместить нули в наиболее значимые биты,
\ освобождаемые при сдвиге.
\ Неоднозначная ситуация возникает, если u больше или равно
\ числу бит в ячейке.
xchg eax, ecx
shr dword ptr [ebp], cl
mov eax, dwp [ebp]
add ebp, 4
\ MOV ECX, EAX
\ MOV EAX, [EBP]
\ SHR EAX, CL
\ LEA EBP, 4 [EBP]
RET
END-CODE
CODE SM/REM ( d1 n1 -- n2 n3 ) \ 94
\ Разделить d1 на n1, получить симметричное частное n3 и остаток n2.
\ Входные и выходные аргументы знаковые.
\ Неоднозначная ситуация возникает, если n1 ноль, или частное вне
\ диапазона одинарных знаковых чисел.
xchg eax, [ebp+4]
mov edx, [ebp]
add ebp, 4
idiv dword ptr [ebp]
mov [ebp], edx
\ MOV EBX, EAX
\ MOV EDX, [EBP]
\ MOV EAX, 4 [EBP]
\ IDIV EBX
\ LEA EBP, 4 [EBP]
\ MOV [EBP], EDX
RET
END-CODE
CODE FM/MOD ( d1 n1 -- n2 n3 ) \ 94
\ Разделить d1 на n1, получить частное n3 и остаток n2.
\ Входные и выходные аргументы знаковые.
\ Неоднозначная ситуация возникает, если n1 ноль, или частное вне
\ диапазона одинарных знаковых чисел.
xchg eax, ebx
mov edx, [ebp]
add ebp, 4
mov eax, [ebp]
idiv ebx
or eax, eax
jns short @@E
or edx, edx
jz short @@E
dec eax
add edx, ebx
@@E: mov [ebp], edx
\ XCHG EBP, ESP
\ MOV EBX, EAX
\ POP EDX
\ POP EAX
\ PUSH EAX
\ IDIV EBX
\ OR EAX, EAX
\ JS SHORT @@1
\@@2: POP EBX
\ PUSH EDX
\ XCHG EBP, ESP
\ RET
\@@1: OR EDX, EDX
\ JZ @@2
\ DEC EAX
\ MOV ECX, EAX
\ IMUL EBX
\ POP EBX
\ SUB EBX, EAX
\ PUSH EBX
\ MOV EAX, ECX
\ XCHG EBP, ESP
RET
END-CODE
CODE D< ( d1 d2 -- flag ) \ DOUBLE
\ flag "истина" тогда и только тогда, когда d1 меньше d2.
xor ecx, ecx
mov ebx, [ebp]
add ebp, 12
cmp [ebp-4], ebx
sbb [ebp-8], eax
jge short @@1
dec ecx
@@1: xchg eax, ecx
\ MOV EBX, [EBP]
\ CMP 8 [EBP], EBX
\ SBB 4 [EBP], EAX
\ MOV EAX, # 0
\ JGE SHORT @@1
\ DEC EAX
\ @@1: LEA EBP, 0C [EBP]
RET
END-CODE
CODE D> ( d1 d2 -- flag ) \ DOUBLE
\ flag "истина" тогда и только тогда, когда d1 больше d2.
xor ecx, ecx
mov ebx, [ebp]
add ebp, 12
cmp ebx, [ebp-4]
sbb [ebp-8], eax
jge short @@1
dec ecx
@@1: xchg eax, ecx
\ MOV EBX, 8 [EBP]
\ CMP [EBP], EBX
\ SBB EAX, 4 [EBP]
\ MOV EAX, # 0
\ JGE SHORT @@1
\ DEC EAX
\@@1: LEA EBP, 0C [EBP]
RET
END-CODE
CODE CMOVE ( c-addr1 c-addr2 u -- ) \ 94 STRING
\ Если u больше нуля, копировать u последовательных символов из пространства
\ данных начиная с адреса c-addr1 в c-addr2, символ за символом, начиная с
\ младших адресов к старшим.
xchg eax, ecx
push edi
mov edi, [ebp]
mov esi, [ebp+4]
rep movsb
@@1: pop edi
add ebp, 12
mov eax, [ebp-4]
\ MOV EDX, EDI
\ MOV ECX, EAX
\ MOV EDI, [EBP]
\ MOV ESI, 4 [EBP]
\ CLD ; давай считать что у нас везде по умолчанию стоит...
\\ SAR ECX, # 2
\\ REP MOVS DWORD
\\ MOV ECX, EAX
\\ AND ECX, # 3
\ REP MOVS BYTE
\ LEA EBP, 0C [EBP]
\ MOV EAX, -4 [EBP]
\ MOV EDI, EDX
RET
END-CODE
CODE QCMOVE ( c-addr1 c-addr2 u -- ) \ 94 STRING
\ Если u больше нуля, копировать u последовательных символов из пространства
\ данных начиная с адреса c-addr1 в c-addr2, символ за символом, начиная с
\ младших адресов к старшим.
push edi, eax
mov edi, [ebp]
mov esi, [ebp+4]
sar eax, 2
xchg eax, ecx
pop eax
rep movsd
and eax, 3
xchg eax, ecx
rep movsb
@@1: add ebp, 12
mov eax, [ebp-4]
pop edi
\ MOV EDX, EDI
\ MOV ECX, EAX
\ MOV EDI, [EBP]
\ MOV ESI, 4 [EBP]
\ CLD
\ SAR ECX, # 2
\ REP MOVS DWORD
\ MOV ECX, EAX
\ AND ECX, # 3
\ REP MOVS BYTE
\ LEA EBP, 0C [EBP]
\ MOV EAX, -4 [EBP]
\ MOV EDI, EDX
RET
END-CODE
CODE CMOVE> ( c-addr1 c-addr2 u -- ) \ 94 STRING
\ Если u больше нуля, копировать u последовательных символов из пространства
\ данных начиная с адреса c-addr1 в c-addr2, символ за символом, начиная со
\ старших адресов к младшим.
push edi
xchg eax, ecx
mov edi, [ebp]
mov esi, [ebp]
lea edi, [edi+ecx-1]
lea esi, [esi+ecx-1]
std
rep movsb
cld
pop edi
add ebp, 12
mov eax, [ebp-4]
\ MOV EDX, EDI
\ MOV ECX, EAX
\ MOV EDI, [EBP]
\ MOV ESI, 4 [EBP]
\ STD
\ ADD EDI, ECX
\ DEC EDI
\ ADD ESI, ECX
\ DEC ESI
\ REP MOVS BYTE
\ MOV EDI, EDX
\ LEA EBP, 0C [EBP]
\ MOV EAX, -4 [EBP]
RET
END-CODE
CODE FILL ( c-addr u char -- ) \ 94
\ Если u больше нуля, заслать char в u байтов по адресу c-addr.
push edi
mov ecx, [ebp]
mov edi, [ebp+4]
rep stosb
add ebp, 12
mov eax, [ebp-4]
\ MOV EDX, EDI
\ MOV ECX, [EBP]
\ MOV EDI, 4 [EBP]
\ CLD
\ REP STOS BYTE
\ MOV EDI, EDX
\ LEA EBP, 0C [EBP]
\ MOV EAX, -4 [EBP]
RET
END-CODE
CODE ASCIIZ> ( c-addr -- c-addr u )
sub ebp, 4
mov [ebp], eax
push edi
xchg edi, eax
xor ecx, ecx
dec ecx
xor eax, eax
repnz scasb
not ecx
dec ecx
pop edi
\ MOV ECX, EAX
\@@1: MOV BL, [EAX]
\ inc eax ; LEA EAX, 1 [EAX]
\ OR BL, BL
\ JNZ SHORT @@1
\ dec eax ; LEA EAX, -1 [EAX]
\ SUB EAX, ECX
\ LEA EBP, -4 [EBP]
\ MOV [EBP], ECX
RET
END-CODE
позже
-TRAILING COMPARE SEARCH
CODE SP! ( A -> )
lea ebp, [eax+4]
mov eax, [ebp-4]
\ MOV EBP, EAX
\ MOV EAX, [EBP]
\ LEA EBP, 4 [EBP]
RET
END-CODE
CODE TlsIndex! ( x -- ) \ указатель локального пула потока
xchg eax, edi ; MOV EDI, EAX
MOV EAX, [EBP]
LEA EBP, 4 [EBP]
RET
END-CODE
CODE TlsIndex@ ( -- x )
LEA EBP, -4 [EBP]
MOV [EBP], EAX
xchg eax, edi ; MOV EAX, EDI
RET
END-CODE
CODE C-RDROP ?????
pop ebx ; ADD ESP, # 4
^^^^^^^^ - адрес возврата из процы
RET
END-CODE
VVVVVVVVVVVVVVV
CODE C-RDROP
RET 4
END-CODE
CODE C-EXECUTE ( i*x xt -- j*x ) \ 94
\ Убрать xt со стека и выполнить заданную им семантику.
\ Другие изменения на стеке определяются словом, которое выполняется.
xchg eax, [ebp]
add ebp, 4
call dwp [ebp-4]
\ MOV EBX, EAX
\ MOV EAX, [EBP]
\ LEA EBP, 4 [EBP]
\ CALL EBX
RET
END-CODE
позже DRMOVE N>R NR> NRCOPY
CODE RALLOT ( n -- addr )
\ зарезервировать n ячеек на стеке возвратов,
\ сделаем с инициализацией (а то если больше 8К выделим, exception может)
pop edx
xchg eax, ecx
@@1: push 0
loop @@1
mov eax, esp
\ POP EDX
\ MOV ECX, EAX
\ XOR EAX, EAX
\@@1: PUSH EAX
\ DEC ECX
\ JNZ SHORT @@1
\ MOV EAX, ESP
JMP EDX
END-CODE
CODE (RALLOT) ( n -- )
\ зарезервировать n ячеек на стеке возвратов
pop edx
xchg eax, ecx
@@1: push 0
loop @@1
mov eax, [ebp]
sub ebp, 4
\ POP EDX
\ MOV ECX, EAX
\ XOR EAX, EAX
\@@1: PUSH EAX
\ DEC ECX
\ JNZ SHORT @@1
\ MOV EAX, [EBP]
\ LEA EBP, 4 [EBP]
JMP EDX
END-CODE
позже HASH
позже macroopt.f, tc_spf.F, spf_floatkern.f - когда разберусь
Модуль spf_defkern:
CODE _USER-CODE
LEA EBP, -4 [EBP]
MOV [EBP], EAX
POP EAX
MOV EAX, [EAX]
add eax, edi ; LEA EAX, [EDI] [EAX]
RET
END-CODE
CODE USER+ ( offs -- addr )
add eax, edi ; LEA EAX, [EDI] [EAX]
RET
END-CODE
CODE _USER-VALUE-CODE
LEA EBP, -4 [EBP]
MOV [EBP], EAX
POP EAX
MOV EAX, [EAX]
; LEA EAX, [EDI] [EAX]
; MOV EAX, [EAX]
mov eax, [edi+eax]
RET
END-CODE
CODE _USER-VECT-CODE
POP EBX
MOV EBX, [EBX]
; LEA EBX, [EDI] [EBX]
; MOV EBX, [EBX]
; JMP EBX
; RET
jmp dwp [ebx+edi]
END-CODE
CODE _TOVALUE-CODE
pop ebx
mov [ebx-9], eax
mov eax, [ebp]
lea ebp, 4 [ebp]
\ POP EBX
\ LEA EBX, -9 [EBX]
\ MOV [EBX], EAX
\ MOV EAX, [EBP]
\ LEA EBP, 4 [EBP]
RET
END-CODE
CODE _TOUSER-VALUE-CODE
pop ebx
mov ebx, [ebx-9]
mov [edi+ebx], eax
mov eax, [ebp]
lea ebp, 4 [ebp]
\ POP EBX
\ LEA EBX, -9 [EBX]
\ MOV EBX, [EBX]
\ LEA EBX, [EDI] [EBX]
\ MOV [EBX], EAX
\ MOV EAX, [EBP]
\ LEA EBP, 4 [EBP]
RET
END-CODE
CODE _SLITERAL-CODE
sub ebp, 8
mov [ebp+4], eax
pop ebx
movzx eax, byte [ebx]
inc ebx
mov [ebp], ebx
lea ebx, [ebx+eax+1]
\ LEA EBP, -8 [EBP]
\ MOV 4 [EBP], EAX
\ POP EBX
\ MOVZX EAX, BYTE [EBX]
\ LEA EBX, 1 [EBX]
\ MOV [EBP], EBX
\ LEA EBX, [EBX] [EAX]
\ LEA EBX, 1 [EBX]
JMP EBX
END-CODE
CODE _CLITERAL-CODE
sub ebp, 4
mov [ebp], eax
pop eax
movzx ebx, byte [eax]
lea ebx, [ebx+eax+2]
jmp ebx
\ LEA EBP, -4 [EBP-4]
\ MOV [EBP], EAX
\ POP EAX
\ MOVZX EBX, BYTE [EAX]
\ LEA EBX, [EBX] [EAX]
\ LEA EBX, 2 [EBX]
\ JMP EBX
\ RET
END-CODE
Это далеко не весь список. Более полную оптимизацию думаю
провести со временем.