Автор |
Сообщение |
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Ах, да структурки забыл добавить
Ах, да структурки забыл добавить
|
|
|
|
Добавлено: Вт сен 05, 2017 00:22 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Код: \ ~ER 04.09.2017 \ библиотека переписана почти с нуля \ кол-во слов-гигантов стало \ гораздо меньше \ В наличии имеется некое подобие БД
\ экономия памяти \ и группировка записей отсутсвует \
REQUIRE STRUCT: ~ER\STRUCT-SUGAR.F
STRUCT: rec-event CELL -- gr-e \ КОЛИЧЕСТВО СЛОВ ПРЕДКОМПИЛЯЦИИ CELL -- gr-h \ КОЛИЧЕСТВО МОДИФИКАТОРОВ CELL -- group-name \ ПСЕВДОНИМ ДЛЯ ПОИСКА ГРУППЫ 30 CELLS -- sp-ev \ МЕСТО ДЛЯ СЛОВ ПРЕДКОМПИЯЦИИ 30 CELLS -- sp-h \ МЕСТО ДЛЯ СЛОВ-МОДИФИКАТОРОВ STRUCT;
0 VALUE EVENT-TABLE
\ превратить строку в псевдоним в виде числа \ исп. первые 4 символа : str>group-name \ addr u -- N DUP 3 > IF DROP @ ELSE 0 >R RP@ SWAP MOVE R> THEN ;
\ добавить запись со словом предкомпиляции \ выдать адрес записи : new-event-rec \ xt-e - rec EVENT-TABLE >R BEGIN R@ gr-e @ 0= R@ gr-e @ -1 = OR INVERT
WHILE R> rec-event + >R REPEAT
\ очистка на случай, если запись удалена R@ rec-event 0 FILL
1 R@ gr-e ! R@ sp-ev ! R> ;
\ пометить запись для удаления : mark-delete-ev \ rec -- rec-event -1 FILL ;
\ ПОЛОЖИТЬ НА СТЕК АДРЕСА ЗАПИСЕЙ, \ КОТОРЫЕ СООТВЕТСВУЮТ УСЛОВИЯМ : find-rec-cond \ xt-cond -- rec1 rec2 recn n|0 \ xt-cond: rec -- flag 0 >R \ количество записей с успехом EVENT-TABLE 2>R BEGIN R@ gr-e @ DUP WHILE \ до конца таблицы 0 > IF \ на случай если там удалённая запись 2R@ SWAP EXECUTE IF 2R> \ стекового DUP R> 1+ \ манипулятора 2>R \ на вас жалко! 2>R \ \ R: n xt rec -- rec n+1 xt rec THEN THEN R> rec-event + >R REPEAT DROP RDROP RDROP R@ IF NR> ELSE R> THEN ;
\ проверка некоторых полей \
: rec.find.xt-e \ xt-e rec -- xt-e flag >R R@ sp-ev @ OVER = R@ gr-e @ 1 = AND RDROP ;
: rec.find.xt-e.set \ xt-e rec -- xt-e flag >R R@ gr-e @ DUP 1 = IF DROP RDROP 0 EXIT THEN R@ sp-ev SWAP RDROP 2>R BEGIN R@ WHILE RP@ CELL+ @ @ OVER = IF RDROP RDROP -1 EXIT THEN R> 1- R> CELL+ SWAP 2>R REPEAT RDROP RDROP 0
;
: rec.find.group-name \ psevd rec -- psevd flag group-name @ OVER =
;
\ добавить обработчик к слову предкомпиляции \ если обработчик только в группе \ то создать отдельную запись : ->EVENT \ xt-h xt-e --
['] rec.find.xt-e find-rec-cond DUP 1 > IF 3000 THROW THEN \ ошибка дубляж записей IF >R DROP \ xt-e -- R@ gr-h @ CELLS R@ sp-h + ! RDROP EXIT THEN
SP@ >R ['] rec.find.xt-e.set find-rec-cond 0= IF -3001 THROW THEN \ ошибка нет такой записи R> SP! new-event-rec >R R@ gr-h 1+! R@ sp-h ! RDROP ;
\ добавить обработчик к группе записей : ->EVENT-GROUP \ xt-h addr u -- str>group-name
['] rec.find.group-name find-rec-cond >R R@ 1 > IF 3000 THROW THEN R> 0= IF -3002 THROW THEN NIP >R R@ gr-h @ CELLS R@ sp-h + ! R> gr-h 1+! ;
\ создать новую группу записей : NEW-GROUP \ xt-e1 xt-e2 xt-eN N addr u -- 0 new-event-rec >R str>group-name R@ group-name ! DUP R@ gr-e ! \ да начнётся веселье!!! \ магия стека >R SP@ R> R@ sp-ev SWAP >R R@ CELLS MOVE SP@ R> CELLS + SP! RDROP ;
\ добавить слово предкомпиляции в группу : EVENT-TO-GROUP \ xt-e addr u str>group-name ['] rec.find.group-name find-rec-cond >R R@ 1 > IF 3000 THROW THEN DROP R@ IF R@ gr-e @ CELLS R@ sp-ev + ! R@ gr-e 1+! RDROP EXIT THEN -3002 THROW ;
USER-VALUE EVENT-RP@
: EVENT-EXIT EVENT-RP@ RP! ;
: EVENT-COMPILE, \ FFA@ xt -- FFA? xt? RP@ TO EVENT-RP@ DUP >R SP@ >R \ R: xt data-point ['] rec.find.xt-e.set find-rec-cond DROP RP@ CELL+ @ ['] rec.find.xt-e find-rec-cond CELLS CELL+ SP@ + ! \ затираем xt на стеке
SP@ R> - ABS CELL / RDROP \ R: xt -- DUP 0= IF -3003 THROW THEN \ запись не найдена N>R BEGIN R@ WHILE 2R> 1- >R >R \ R: rec n -- n-1 rec R@ sp-h R@ gr-h @ 2>R BEGIN R@ WHILE RP@ CELL+ @ @ EXECUTE R> 1- CELL RP@ +! >R REPEAT RDROP RDROP RDROP REPEAT RDROP ;
Код для тестов то же ( см. выше ) По поводу разумных замечаний. MIN MAX не используются ввиду того, в моём планируемом форте этих слов не нет. Код: R@ gr-e @ 0= R@ gr-e @ -1 = OR INVERT
Эта и подобные ей записи сделаны в целях читаемости. можно, конечно, написать 1 < , но потом фиг поймёшь, что это значит.
[code]
\ ~ER 04.09.2017 \ библиотека переписана почти с нуля \ кол-во слов-гигантов стало \ гораздо меньше \ В наличии имеется некое подобие БД
\ экономия памяти \ и группировка записей отсутсвует \
REQUIRE STRUCT: ~ER\STRUCT-SUGAR.F
STRUCT: rec-event CELL -- gr-e \ КОЛИЧЕСТВО СЛОВ ПРЕДКОМПИЛЯЦИИ CELL -- gr-h \ КОЛИЧЕСТВО МОДИФИКАТОРОВ CELL -- group-name \ ПСЕВДОНИМ ДЛЯ ПОИСКА ГРУППЫ 30 CELLS -- sp-ev \ МЕСТО ДЛЯ СЛОВ ПРЕДКОМПИЯЦИИ 30 CELLS -- sp-h \ МЕСТО ДЛЯ СЛОВ-МОДИФИКАТОРОВ STRUCT;
0 VALUE EVENT-TABLE
\ превратить строку в псевдоним в виде числа \ исп. первые 4 символа : str>group-name \ addr u -- N DUP 3 > IF DROP @ ELSE 0 >R RP@ SWAP MOVE R> THEN ;
\ добавить запись со словом предкомпиляции \ выдать адрес записи : new-event-rec \ xt-e - rec EVENT-TABLE >R BEGIN R@ gr-e @ 0= R@ gr-e @ -1 = OR INVERT
WHILE R> rec-event + >R REPEAT
\ очистка на случай, если запись удалена R@ rec-event 0 FILL
1 R@ gr-e ! R@ sp-ev ! R> ;
\ пометить запись для удаления : mark-delete-ev \ rec -- rec-event -1 FILL ;
\ ПОЛОЖИТЬ НА СТЕК АДРЕСА ЗАПИСЕЙ, \ КОТОРЫЕ СООТВЕТСВУЮТ УСЛОВИЯМ : find-rec-cond \ xt-cond -- rec1 rec2 recn n|0 \ xt-cond: rec -- flag 0 >R \ количество записей с успехом EVENT-TABLE 2>R BEGIN R@ gr-e @ DUP WHILE \ до конца таблицы 0 > IF \ на случай если там удалённая запись 2R@ SWAP EXECUTE IF 2R> \ стекового DUP R> 1+ \ манипулятора 2>R \ на вас жалко! 2>R \ \ R: n xt rec -- rec n+1 xt rec THEN THEN R> rec-event + >R REPEAT DROP RDROP RDROP R@ IF NR> ELSE R> THEN ;
\ проверка некоторых полей \
: rec.find.xt-e \ xt-e rec -- xt-e flag >R R@ sp-ev @ OVER = R@ gr-e @ 1 = AND RDROP ;
: rec.find.xt-e.set \ xt-e rec -- xt-e flag >R R@ gr-e @ DUP 1 = IF DROP RDROP 0 EXIT THEN R@ sp-ev SWAP RDROP 2>R BEGIN R@ WHILE RP@ CELL+ @ @ OVER = IF RDROP RDROP -1 EXIT THEN R> 1- R> CELL+ SWAP 2>R REPEAT RDROP RDROP 0
;
: rec.find.group-name \ psevd rec -- psevd flag group-name @ OVER =
;
\ добавить обработчик к слову предкомпиляции \ если обработчик только в группе \ то создать отдельную запись : ->EVENT \ xt-h xt-e --
['] rec.find.xt-e find-rec-cond DUP 1 > IF 3000 THROW THEN \ ошибка дубляж записей IF >R DROP \ xt-e -- R@ gr-h @ CELLS R@ sp-h + ! RDROP EXIT THEN
SP@ >R ['] rec.find.xt-e.set find-rec-cond 0= IF -3001 THROW THEN \ ошибка нет такой записи R> SP! new-event-rec >R R@ gr-h 1+! R@ sp-h ! RDROP ;
\ добавить обработчик к группе записей : ->EVENT-GROUP \ xt-h addr u -- str>group-name
['] rec.find.group-name find-rec-cond >R R@ 1 > IF 3000 THROW THEN R> 0= IF -3002 THROW THEN NIP >R R@ gr-h @ CELLS R@ sp-h + ! R> gr-h 1+! ;
\ создать новую группу записей : NEW-GROUP \ xt-e1 xt-e2 xt-eN N addr u -- 0 new-event-rec >R str>group-name R@ group-name ! DUP R@ gr-e ! \ да начнётся веселье!!! \ магия стека >R SP@ R> R@ sp-ev SWAP >R R@ CELLS MOVE SP@ R> CELLS + SP! RDROP ;
\ добавить слово предкомпиляции в группу : EVENT-TO-GROUP \ xt-e addr u str>group-name ['] rec.find.group-name find-rec-cond >R R@ 1 > IF 3000 THROW THEN DROP R@ IF R@ gr-e @ CELLS R@ sp-ev + ! R@ gr-e 1+! RDROP EXIT THEN -3002 THROW ;
USER-VALUE EVENT-RP@
: EVENT-EXIT EVENT-RP@ RP! ;
: EVENT-COMPILE, \ FFA@ xt -- FFA? xt? RP@ TO EVENT-RP@ DUP >R SP@ >R \ R: xt data-point ['] rec.find.xt-e.set find-rec-cond DROP RP@ CELL+ @ ['] rec.find.xt-e find-rec-cond CELLS CELL+ SP@ + ! \ затираем xt на стеке
SP@ R> - ABS CELL / RDROP \ R: xt -- DUP 0= IF -3003 THROW THEN \ запись не найдена N>R BEGIN R@ WHILE 2R> 1- >R >R \ R: rec n -- n-1 rec R@ sp-h R@ gr-h @ 2>R BEGIN R@ WHILE RP@ CELL+ @ @ EXECUTE R> 1- CELL RP@ +! >R REPEAT RDROP RDROP RDROP REPEAT RDROP ;
[/code]
Код для тестов то же ( см. выше )
По поводу разумных замечаний. MIN MAX не используются ввиду того, в моём планируемом форте этих слов не нет.
[code] R@ gr-e @ 0= R@ gr-e @ -1 = OR INVERT [/code] Эта и подобные ей записи сделаны в целях читаемости. можно, конечно, написать [b]1 <[/b] , но потом фиг поймёшь, что это значит.
|
|
|
|
Добавлено: Вт сен 05, 2017 00:08 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Ага, спасибо заменю. А ещё лучше: Код: mov ecx 4 cmp eax, ecx cmovbe eax, ecx xor edx edx mov ebx esp lea ebx -4 [ebx] mov [ebx] edx mov ecx [ebp]
\ прыгай сюда
mov dl [ecx] mov [ebx] dl inc ecx inc ebx dec eax jne \ к фразе :) mov eax, -4 [esp] lea ebp 4 [ebp] ret
Ну,это так в порядке бреда
Ага, спасибо заменю. А ещё лучше: [code] mov ecx 4 cmp eax, ecx cmovbe eax, ecx xor edx edx mov ebx esp lea ebx -4 [ebx] mov [ebx] edx mov ecx [ebp]
\ прыгай сюда
mov dl [ecx] mov [ebx] dl inc ecx inc ebx dec eax jne \ к фразе :) mov eax, -4 [esp] lea ebp 4 [ebp] ret
[/code] Ну,это так в порядке бреда
|
|
|
|
Добавлено: Чт июн 08, 2017 18:25 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Victor__v писал(а): Код: \ создать псевдоним для группы из строки \ псевдоним имеет длину равную CELL : event-group-psevd \ addr u -- n DUP CELL < IF 0 >R RP@ SWAP MOVE R> ELSE DROP @ THEN ; MIN и MAX фортовское "наше всьо" Код: \ создать псевдоним для группы из строки \ псевдоним имеет длину равную CELL : event-group-psevd \ addr u -- n CELL UMIN 0 >R RP@ SWAP CMOVE R> ;
[quote="Victor__v"][code]\ создать псевдоним для группы из строки \ псевдоним имеет длину равную CELL : event-group-psevd \ addr u -- n DUP CELL < IF 0 >R RP@ SWAP MOVE R> ELSE DROP @ THEN ;[/code][/quote]MIN и MAX фортовское "наше всьо" :) [code]\ создать псевдоним для группы из строки \ псевдоним имеет длину равную CELL : event-group-psevd \ addr u -- n CELL UMIN 0 >R RP@ SWAP CMOVE R> ;[/code]
|
|
|
|
Добавлено: Чт июн 08, 2017 14:51 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Victor__v писал(а): Лично мне не нужна зверская оптимизация. но просматривать отъилнайненный код 10 20 + выше моих духовных сил. Вот с этим смириться не могу Не нравится LITERAL и нравится Си , ну определи : { POSTPONE [ ; IMMEDIATE : } ] POSTPONE LITERAL ; и тогда пиши вот так { 10 20 + } Красота !
[quote="Victor__v"]Лично мне не нужна зверская оптимизация. но просматривать отъилнайненный код 10 20 + выше моих духовных сил. Вот с этим смириться не могу :mrgreen:[/quote]Не нравится LITERAL и нравится Си , ну определи : { POSTPONE [ ; IMMEDIATE : } ] POSTPONE LITERAL ; и тогда пиши вот так { 10 20 + } Красота !
|
|
|
|
Добавлено: Чт июн 08, 2017 14:14 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Вот механизм предкомпиляции в действии: Код: \ Таблица предкомпияции \ 20.05.2017 ~er \
\ Избавился от хеширования \ подключил структуры \ изменил разрядность некоторых элементов структуры
REQUIRE STRUCT: ~ER\STRUCT-SUGAR.F
STRUCT: rec-event CELL -- gr-e CELL -- gr-h CELL -- group-name 30 CELLS -- sp-ev 30 CELLS -- sp-h STRUCT;
0 VALUE EVENT-TABLE
\ добавить запись-пустышку в таблицу и \ выдать адрес записи : new-event-rec \ xt-e - rec-addr EVENT-TABLE >R BEGIN R@ gr-e @ 0= R@ gr-e @ -1 = OR INVERT
WHILE R> rec-event + >R REPEAT
\ очистка на случай, если запись удалена R@ rec-event 0 FILL
1 R@ gr-e ! R@ sp-ev ! R> ;
\ если xt имееся в записях или группах записей, \ то выдать адрес записи и вернуть истину \ в противном случае xt и ложь
: event-rec? \ xt -- addr-rec -1| xt 0 EVENT-TABLE >R BEGIN R@ gr-e @ 0= IF RDROP 0 EXIT THEN R@ gr-e @ -1 <> IF DUP R@ sp-ev R@ gr-e @ CELLS ROT >R RP@ CELL SEARCH NIP NIP RDROP INVERT \ 0 ЕСЛИ ИСТИНА ELSE -1 THEN WHILE R> rec-event + >R REPEAT DROP R> -1
;
\ пометить запись для удаления в будущем : mark-delete-ev \ addr-rec -- rec-event -1 FILL ;
\ создать псевдоним для группы из строки \ псевдоним имеет длину равную CELL : event-group-psevd \ addr u -- n DUP CELL < IF 0 >R RP@ SWAP MOVE R> ELSE DROP @ THEN ;
\ собрать группу из ранее записанных \ в таблицу слов предкомпиляции, \ которые имеют адреса xt1 ... xtn количеством n \ Группа сотворяется с псевдонимом addr u \ Если среди xt есть те, которые отсутствуют в таблице, \ то ловим исключение \ Если запиcи пусты т.е. имеют только xt, \ то запись помечается для удаления \ создаётся запись-группа и возвращаеся её адрес \
: compute-group \ xt1 xt2 .. xtn n addr u -- addr-rec
event-group-psevd >R DUP >R BEGIN R@ PICK R@ - DUP \ если очередное взятие не равно n WHILE R@ + \ DUP . \ отладка event-rec? 0= IF . CR -3001 THROW THEN REPEAT DROP R@
BEGIN SWAP >R R@ gr-h @ \ если есть обработчик R@ gr-e @ 1 > \ или это группа OR 0= IF R@ mark-delete-ev THEN RDROP 1- DUP 0= UNTIL DROP DROP 0 new-event-rec >R RP@ CELL+ @ R@ gr-e !
\ переносим данные со стека в таблицу. Стек растёт вниз!!! SP@ R@ sp-ev RP@ CELL+ @ CELLS MOVE
\ очищаем стек от слов SP@ RP@ CELL+ @ CELLS + SP! R> RDROP DUP group-name R> SWAP !
;
\ добавить обработчик xt-h к слову предкомпиляции xt-e \ если xt-e не слово предкомпиляции, то ловим исключение \ если xt-e не в записи, а в группе записей, \ то создать запись xt-e с обработчиком
: ->EVENT \ xt-h xt-e -- >R R@ event-rec? 0= IF . CR -3001 THROW THEN
\ если слово предкомпиляции в группе DUP gr-e @ 1 > IF EVENT-TABLE >R rec-event + TO EVENT-TABLE RP@ CELL+ @ \ D: -- xt-e \ если слово только в группе или группах, \ то создаём запись event-rec? 0= IF R> TO EVENT-TABLE new-event-rec ELSE DROP \ rec-addr -- \ продолжаем искать запись \ \ ." RECURSER" CR \ отладка \ DEPTH .SN CR \ отладка
RP@ CELL+ @ \ D: -- xt-e RECURSE R> TO EVENT-TABLE RDROP EXIT THEN THEN
\ DEPTH .SN CR \ отладка
>R \ R: -- rec-addr R@ gr-h @ CELLS \ СМЕЩЕНИЕ R@ sp-h \ ДЛЯ ПОКЛАДА ОБРАБОТЧИКА + ! \ DEPTH .SN CR \ отдадка \ увеличить кол-во обработчиков на 1 R@ gr-h 1+!
RDROP RDROP ; : find-next-rec \ xt-e rec-addr1 -- xt-e rec-addr? -1 | xt-e 0 2>R BEGIN BEGIN R@ gr-e @ 0= R@ gr-e @ -1 = OR INVERT WHILE R@ sp-ev R@ gr-e @ CELLS RP@ CELL+ CELL SEARCH NIP NIP IF 2R> -1 EXIT THEN R> rec-event + >R REPEAT
\ Внимание!!! манипуляция со стеком потока-управления R@ gr-e @ -1 = IF R> rec-event + >R [ 2SWAP ] AGAIN THEN RDROP R> 0 ;
\ добавиь обработчик в группу слов предкомпиляции, \ которая идентифицируется псевдонимом \ если псевдоним не найден в записях \ то получаем исключение
: ->EVENT-GROUP \ xt-h addr u -- event-group-psevd EVENT-TABLE >R BEGIN R@ gr-e @ WHILE R@ @ -1 <> IF R@ group-name @ OVER = R@ gr-e @ 1 > AND IF DROP R@ sp-h R@ gr-h @ CELLS + ! R@ gr-h 1+! RDROP EXIT THEN THEN R> rec-event + >R REPEAT -3003 THROW
;
USER-VALUE EVENT-RP@
\ выйти из обработчика и EVENT-COMPILE, : EVENT-EXIT EVENT-RP@ RP! ;
: EVENT-COMPILE, \ FFA@1 xt1 -- FFA@? xt1|xt?|'noop RP@ TO EVENT-RP@ >R R@ event-rec? 0= IF -3005 THROW THEN DROP
R@ EVENT-TABLE BEGIN find-next-rec WHILE >R \ rec-addr R@ sp-h R@ gr-h @ 0 ?DO I CELLS + >R \ xt-h: \ FFA@ xt -- ??? FFA@ xt R@ @ EXECUTE R> LOOP
2DROP \ ... xt sp-h -- ... R> rec-event + R@ SWAP REPEAT RDROP ; Код для тестов Цитата: REQUIRE SEE lib\ext\disasm.f ~ER\EVENT-TABLE2.F
\ выделяем память под таблицу 100000 ALLOCATE THROW DUP 100000 0 FILL TO EVENT-TABLE
' + new-event-rec DROP ' - new-event-rec DROP ' / new-event-rec DROP ' * new-event-rec DROP
' MOD new-event-rec DROP
' XOR new-event-rec DROP ' OR new-event-rec DROP ' AND new-event-rec DROP
' + ' - ' / ' * ' MOD ' XOR ' OR ' AND 8 S" AL_O" compute-group DROP
: handlerOPT_2op \ FFA@ xt -- FFA@ xt| FFA@1 'noop
HERE 5 - \ skip MOV EAX ??? 6 - 6 ['] DUP 6 COMPARE 0= HERE 5 - 6 - 5 - \ skip MOV EAX ??? 6 - 6 ['] DUP 6 COMPARE 0= AND HERE 5 - C@ 0xB8 = \ eax mov-code HERE 5 - 6 - 5 - C@ 0xB8 = \ eax mov-code AND AND IF >R HERE 4 - @ HERE 5 - 6 - 4 - @ SWAP R@ EXECUTE HERE 5 - 6 - DP ! HERE 4 - ! DROP 1 \ immediate-flag ['] NOOP
\ стек возвратов не освобождаем \ за нас это делает слово ниже EVENT-EXIT THEN ;
' handlerOPT_2op S" AL_O" ->EVENT-GROUP
\ аналог СПФ-ского LIT, только без оптимизации на ходу : LT, \ zn -- ['] DUP 6 S, 0xB8 C, , ;
HEADER TEST 10 LT, 20 LT, 6 ' * EVENT-COMPILE, RET,
SEE TEST
Ну, и итог оптимизации: Цитата: ~ER\EVENT-TEST.F
575E7B 8D6DFC LEA EBP , FC [EBP] 575E7E 894500 MOV 0 [EBP] , EAX 575E81 B8C8000000 MOV EAX , # C8 575E86 C3 RET NEAR
Вот механизм предкомпиляции в действии:
[code] \ Таблица предкомпияции \ 20.05.2017 ~er \
\ Избавился от хеширования \ подключил структуры \ изменил разрядность некоторых элементов структуры
REQUIRE STRUCT: ~ER\STRUCT-SUGAR.F
STRUCT: rec-event CELL -- gr-e CELL -- gr-h CELL -- group-name 30 CELLS -- sp-ev 30 CELLS -- sp-h STRUCT;
0 VALUE EVENT-TABLE
\ добавить запись-пустышку в таблицу и \ выдать адрес записи : new-event-rec \ xt-e - rec-addr EVENT-TABLE >R BEGIN R@ gr-e @ 0= R@ gr-e @ -1 = OR INVERT
WHILE R> rec-event + >R REPEAT
\ очистка на случай, если запись удалена R@ rec-event 0 FILL
1 R@ gr-e ! R@ sp-ev ! R> ;
\ если xt имееся в записях или группах записей, \ то выдать адрес записи и вернуть истину \ в противном случае xt и ложь
: event-rec? \ xt -- addr-rec -1| xt 0 EVENT-TABLE >R BEGIN R@ gr-e @ 0= IF RDROP 0 EXIT THEN R@ gr-e @ -1 <> IF DUP R@ sp-ev R@ gr-e @ CELLS ROT >R RP@ CELL SEARCH NIP NIP RDROP INVERT \ 0 ЕСЛИ ИСТИНА ELSE -1 THEN WHILE R> rec-event + >R REPEAT DROP R> -1
;
\ пометить запись для удаления в будущем : mark-delete-ev \ addr-rec -- rec-event -1 FILL ;
\ создать псевдоним для группы из строки \ псевдоним имеет длину равную CELL : event-group-psevd \ addr u -- n DUP CELL < IF 0 >R RP@ SWAP MOVE R> ELSE DROP @ THEN ;
\ собрать группу из ранее записанных \ в таблицу слов предкомпиляции, \ которые имеют адреса xt1 ... xtn количеством n \ Группа сотворяется с псевдонимом addr u \ Если среди xt есть те, которые отсутствуют в таблице, \ то ловим исключение \ Если запиcи пусты т.е. имеют только xt, \ то запись помечается для удаления \ создаётся запись-группа и возвращаеся её адрес \
: compute-group \ xt1 xt2 .. xtn n addr u -- addr-rec
event-group-psevd >R DUP >R BEGIN R@ PICK R@ - DUP \ если очередное взятие не равно n WHILE R@ + \ DUP . \ отладка event-rec? 0= IF . CR -3001 THROW THEN REPEAT DROP R@
BEGIN SWAP >R R@ gr-h @ \ если есть обработчик R@ gr-e @ 1 > \ или это группа OR 0= IF R@ mark-delete-ev THEN RDROP 1- DUP 0= UNTIL DROP DROP 0 new-event-rec >R RP@ CELL+ @ R@ gr-e !
\ переносим данные со стека в таблицу. Стек растёт вниз!!! SP@ R@ sp-ev RP@ CELL+ @ CELLS MOVE
\ очищаем стек от слов SP@ RP@ CELL+ @ CELLS + SP! R> RDROP DUP group-name R> SWAP !
;
\ добавить обработчик xt-h к слову предкомпиляции xt-e \ если xt-e не слово предкомпиляции, то ловим исключение \ если xt-e не в записи, а в группе записей, \ то создать запись xt-e с обработчиком
: ->EVENT \ xt-h xt-e -- >R R@ event-rec? 0= IF . CR -3001 THROW THEN
\ если слово предкомпиляции в группе DUP gr-e @ 1 > IF EVENT-TABLE >R rec-event + TO EVENT-TABLE RP@ CELL+ @ \ D: -- xt-e \ если слово только в группе или группах, \ то создаём запись event-rec? 0= IF R> TO EVENT-TABLE new-event-rec ELSE DROP \ rec-addr -- \ продолжаем искать запись \ \ ." RECURSER" CR \ отладка \ DEPTH .SN CR \ отладка
RP@ CELL+ @ \ D: -- xt-e RECURSE R> TO EVENT-TABLE RDROP EXIT THEN THEN
\ DEPTH .SN CR \ отладка
>R \ R: -- rec-addr R@ gr-h @ CELLS \ СМЕЩЕНИЕ R@ sp-h \ ДЛЯ ПОКЛАДА ОБРАБОТЧИКА + ! \ DEPTH .SN CR \ отдадка \ увеличить кол-во обработчиков на 1 R@ gr-h 1+!
RDROP RDROP ; : find-next-rec \ xt-e rec-addr1 -- xt-e rec-addr? -1 | xt-e 0 2>R BEGIN BEGIN R@ gr-e @ 0= R@ gr-e @ -1 = OR INVERT WHILE R@ sp-ev R@ gr-e @ CELLS RP@ CELL+ CELL SEARCH NIP NIP IF 2R> -1 EXIT THEN R> rec-event + >R REPEAT
\ Внимание!!! манипуляция со стеком потока-управления R@ gr-e @ -1 = IF R> rec-event + >R [ 2SWAP ] AGAIN THEN RDROP R> 0 ;
\ добавиь обработчик в группу слов предкомпиляции, \ которая идентифицируется псевдонимом \ если псевдоним не найден в записях \ то получаем исключение
: ->EVENT-GROUP \ xt-h addr u -- event-group-psevd EVENT-TABLE >R BEGIN R@ gr-e @ WHILE R@ @ -1 <> IF R@ group-name @ OVER = R@ gr-e @ 1 > AND IF DROP R@ sp-h R@ gr-h @ CELLS + ! R@ gr-h 1+! RDROP EXIT THEN THEN R> rec-event + >R REPEAT -3003 THROW
;
USER-VALUE EVENT-RP@
\ выйти из обработчика и EVENT-COMPILE, : EVENT-EXIT EVENT-RP@ RP! ;
: EVENT-COMPILE, \ FFA@1 xt1 -- FFA@? xt1|xt?|'noop RP@ TO EVENT-RP@ >R R@ event-rec? 0= IF -3005 THROW THEN DROP
R@ EVENT-TABLE BEGIN find-next-rec WHILE >R \ rec-addr R@ sp-h R@ gr-h @ 0 ?DO I CELLS + >R \ xt-h: \ FFA@ xt -- ??? FFA@ xt R@ @ EXECUTE R> LOOP
2DROP \ ... xt sp-h -- ... R> rec-event + R@ SWAP REPEAT RDROP ; [/code]
Код для тестов
[quote]
REQUIRE SEE lib\ext\disasm.f ~ER\EVENT-TABLE2.F
\ выделяем память под таблицу 100000 ALLOCATE THROW DUP 100000 0 FILL TO EVENT-TABLE
' + new-event-rec DROP ' - new-event-rec DROP ' / new-event-rec DROP ' * new-event-rec DROP
' MOD new-event-rec DROP
' XOR new-event-rec DROP ' OR new-event-rec DROP ' AND new-event-rec DROP
' + ' - ' / ' * ' MOD ' XOR ' OR ' AND 8 S" AL_O" compute-group DROP
: handlerOPT_2op \ FFA@ xt -- FFA@ xt| FFA@1 'noop
HERE 5 - \ skip MOV EAX ??? 6 - 6 ['] DUP 6 COMPARE 0= HERE 5 - 6 - 5 - \ skip MOV EAX ??? 6 - 6 ['] DUP 6 COMPARE 0= AND HERE 5 - C@ 0xB8 = \ eax mov-code HERE 5 - 6 - 5 - C@ 0xB8 = \ eax mov-code AND AND IF >R HERE 4 - @ HERE 5 - 6 - 4 - @ SWAP R@ EXECUTE HERE 5 - 6 - DP ! HERE 4 - ! DROP 1 \ immediate-flag ['] NOOP
\ стек возвратов не освобождаем \ за нас это делает слово ниже EVENT-EXIT THEN ;
' handlerOPT_2op S" AL_O" ->EVENT-GROUP
\ аналог СПФ-ского LIT, только без оптимизации на ходу : LT, \ zn -- ['] DUP 6 S, 0xB8 C, , ;
HEADER TEST 10 LT, 20 LT, 6 ' * EVENT-COMPILE, RET,
SEE TEST
[/quote]
Ну, и итог оптимизации:
[quote]
~ER\EVENT-TEST.F
575E7B 8D6DFC LEA EBP , FC [EBP] 575E7E 894500 MOV 0 [EBP] , EAX 575E81 B8C8000000 MOV EAX , # C8 575E86 C3 RET NEAR
[/quote]
|
|
|
|
Добавлено: Сб май 20, 2017 15:27 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
F-MAP писал(а): Тогда может перейти к глобальному идентификатору GUID? Как в СОМ интерфейсах... Для каждой группы записей? Не слишком ли?
[quote="F-MAP"] Тогда может перейти к глобальному идентификатору GUID? Как в СОМ интерфейсах...[/quote] Для каждой группы записей? Не слишком ли?
|
|
|
|
Добавлено: Чт май 18, 2017 07:19 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Victor__v писал(а): Код: В этом коде наверно структуру использовать намного читабельней , например как в SPF Знаю. Просто хочется чуть больше независимости от СПФ, подправлю Цитата: А при использовании HASH, не избежать ведь коллизий, может привести к чему нибудь не хорошему Ну кол-во записей явно меньше миллиарда будет 32-битный хеш достаточно надёжен А так тоже думаю отказаться от него. Но чем тогда выразить идентификатор группы? Можно и строку в четыре байта, но это не серьёзно. А, допустим, восемь использовать. Доп.функционал или плохочитаемый код на получится. Можно конечно MMX использовать как раз документация есть, но по-хорошему значение подопытного регистра надо где-то и сохранить. Что доп.проблемы может привнести. Про реализацию двоичной арифметики молчу. Или на строке в 4 байта остановиться. Что просто, но также как и хеш малоинформативно . . Тогда может перейти к глобальному идентификатору GUID? Как в СОМ интерфейсах...
[quote="Victor__v"][code]В этом коде наверно структуру использовать намного читабельней , например как в SPF[/code] Знаю. Просто хочется чуть больше независимости от СПФ, подправлю
[quote]А при использовании HASH, не избежать ведь коллизий, может привести к чему нибудь не хорошему[/quote] Ну кол-во записей явно меньше миллиарда будет :) 32-битный хеш достаточно надёжен А так тоже думаю отказаться от него. Но чем тогда выразить идентификатор группы? Можно и строку в четыре байта, но это не серьёзно. А, допустим, восемь использовать. Доп.функционал или плохочитаемый код на получится. Можно конечно MMX использовать как раз документация есть, но по-хорошему значение подопытного регистра надо где-то и сохранить. Что доп.проблемы может привнести. Про реализацию двоичной арифметики молчу. Или на строке в 4 байта остановиться. Что просто, но также как и хеш малоинформативно . .[/quote] Тогда может перейти к глобальному идентификатору GUID? Как в СОМ интерфейсах...
|
|
|
|
Добавлено: Ср май 17, 2017 22:00 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Код: В этом коде наверно структуру использовать намного читабельней , например как в SPF Знаю. Просто хочется чуть больше независимости от СПФ, подправлю Цитата: А при использовании HASH, не избежать ведь коллизий, может привести к чему нибудь не хорошему Ну кол-во записей явно меньше миллиарда будет 32-битный хеш достаточно надёжен А так тоже думаю отказаться от него. Но чем тогда выразить идентификатор группы? Можно и строку в четыре байта, но это не серьёзно. А, допустим, восемь использовать. Доп.функционал или плохочитаемый код на получится. Можно конечно MMX использовать как раз документация есть, но по-хорошему значение подопытного регистра надо где-то и сохранить. Что доп.проблемы может привнести. Про реализацию двоичной арифметики молчу. Или на строке в 4 байта остановиться. Что просто, но также как и хеш малоинформативно . .
[code]В этом коде наверно структуру использовать намного читабельней , например как в SPF[/code] Знаю. Просто хочется чуть больше независимости от СПФ, подправлю
[quote]А при использовании HASH, не избежать ведь коллизий, может привести к чему нибудь не хорошему[/quote] Ну кол-во записей явно меньше миллиарда будет :) 32-битный хеш достаточно надёжен А так тоже думаю отказаться от него. Но чем тогда выразить идентификатор группы? Можно и строку в четыре байта, но это не серьёзно. А, допустим, восемь использовать. Доп.функционал или плохочитаемый код на получится. Можно конечно MMX использовать как раз документация есть, но по-хорошему значение подопытного регистра надо где-то и сохранить. Что доп.проблемы может привнести. Про реализацию двоичной арифметики молчу. Или на строке в 4 байта остановиться. Что просто, но также как и хеш малоинформативно . .
|
|
|
|
Добавлено: Ср май 17, 2017 21:29 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
gudleifr писал(а): Если же FORTH-программа компилируется, то нет ничего странного, что стиль ее написания тяготеет к наиболее "естественному" компилируемому языку - C, или более привычному C++. F-MAP писал(а): В этом коде наверно структуру использовать намного читабельней , например как в SPF sic!
[quote="gudleifr"]Если же FORTH-программа компилируется, то нет ничего странного, что стиль ее написания тяготеет к наиболее "естественному" компилируемому языку - C, или более привычному C++.[/quote] [quote="F-MAP"]В этом коде наверно структуру использовать намного читабельней , например как в SPF[/quote] sic!
|
|
|
|
Добавлено: Ср май 17, 2017 21:19 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Victor__v писал(а): Написал большую часть кода Код: 0 DUP CONSTANT gr-w 2+ DUP CONSTANT gr-h 2+ DUP CONSTANT name-gr-hash CELL+ DUP CONSTANT sp-ev 30 CELLS + DUP CONSTANT sp-h 30 CELLS + CONSTANT rec-event-size
В этом коде наверно структуру использовать намного читабельней , например как в SPF Код: 0 0 -- gr-w \ ? 2 -- gr-h 2 -- name-gr-hash CELL -- sp-ev 30 CELLS -- sp-h 30 CELLS -- sp-? CONSTANT rec-event-size
А при использовании HASH, не избежать ведь коллизий, может привести к чему нибудь не хорошему
[quote="Victor__v"]Написал большую часть кода
[code] 0 DUP CONSTANT gr-w 2+ DUP CONSTANT gr-h 2+ DUP CONSTANT name-gr-hash CELL+ DUP CONSTANT sp-ev 30 CELLS + DUP CONSTANT sp-h 30 CELLS + CONSTANT rec-event-size [/code][/quote]
В этом коде наверно структуру использовать намного читабельней , например как в SPF [code] 0 0 -- gr-w \ ? 2 -- gr-h 2 -- name-gr-hash CELL -- sp-ev 30 CELLS -- sp-h 30 CELLS -- sp-? CONSTANT rec-event-size [/code] А при использовании HASH, не избежать ведь коллизий, может привести к чему нибудь не хорошему
|
|
|
|
Добавлено: Ср май 17, 2017 20:57 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Hishnik писал(а): Я что-то не помню, чтобы SPF сначала был никому не нужен, а когда появился оптимизатор, то все сказали "ну вот, другое дело, сразу стало гораздо быстрее и именно этого нам тут не хватало". Более 20-ти лет назад и DOS был весьма востребованой и эффективной системой
[quote="Hishnik"]Я что-то не помню, чтобы SPF сначала был никому не нужен, а когда появился оптимизатор, то все сказали "ну вот, другое дело, сразу стало гораздо быстрее и именно этого нам тут не хватало".[/quote] Более 20-ти лет назад и DOS был весьма востребованой и эффективной системой :)
|
|
|
|
Добавлено: Вт май 16, 2017 22:26 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Victor__v писал(а): Насчёт определений в две-три строчки вопрос спорный. Ну, Броуди по этому поводу собрал достаточное количество мнений. Рациональное, видимо, такое: раз FORTH-программа предназначена не для компиляции, а для получения решения методом итераций, то следует иметь доступ к любой "единице действия". Следовательно, любой фрагмент, который можно поименовать, должен иметь имя. Причем, FORTH-илитарность требует не считать таким фрагментом, ни константы, ни переменные. Только действия и законченные мысли. Тем более, при писании FORTH-программы "как думаешь". Как только додумал до чего-то - сделал словом. Если же FORTH-программа компилируется, то нет ничего странного, что стиль ее написания тяготеет к наиболее "естественному" компилируемому языку - C, или более привычному C++.
[quote="Victor__v"]Насчёт определений в две-три строчки вопрос спорный.[/quote]Ну, Броуди по этому поводу собрал достаточное количество мнений. Рациональное, видимо, такое: раз FORTH-программа предназначена не для компиляции, а для получения решения методом итераций, то следует иметь доступ к любой "единице действия". Следовательно, любой фрагмент, который можно поименовать, должен иметь имя. Причем, FORTH-илитарность требует не считать таким фрагментом, ни константы, ни переменные. Только действия и законченные мысли. Тем более, при писании FORTH-программы "как думаешь". Как только додумал до чего-то - сделал словом. Если же FORTH-программа компилируется, то нет ничего странного, что стиль ее написания тяготеет к наиболее "естественному" компилируемому языку - C, или более привычному C++.
|
|
|
|
Добавлено: Вт май 16, 2017 20:56 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Цитата: R@ @ 0= \ если запись пуста или помечена как R@ @ -1 = \ удалённая OR INVERT
вместо
R@ @ 0> \ запись используется
Спасибо. Исправлю. Насчёт определений в две-три строчки вопрос спорный.
[quote] R@ @ 0= \ если запись пуста или помечена как R@ @ -1 = \ удалённая OR INVERT
вместо
R@ @ 0> \ запись используется [/quote] Спасибо. Исправлю.
Насчёт определений в две-три строчки вопрос спорный.
|
|
|
|
Добавлено: Вт май 16, 2017 20:34 |
|
|
|
|
|
Заголовок сообщения: |
Re: Навешивание обработчиков на компиляцию |
|
|
Hishnik писал(а): Victor__v писал(а): Вот и я про тоже. Постоянно переключать режимы - наживать ошибки. Да тут вообще надо осторожно с оптимизациями. Вот была многолетняя эпопея у Максимова с макроподстановщиком. Только сделано было топорно, вручную, через перечисление вариантов кода и замены этого кода. Разумеется, нужен был инструмент задания правил. Немного заступлюсь, все баги Макс исправил и работает достаточно стабильно, а как там реализовал ему респект
[quote="Hishnik"][quote="Victor__v"]Вот и я про тоже. Постоянно переключать режимы - наживать ошибки.[/quote] Да тут вообще надо осторожно с оптимизациями. Вот была многолетняя эпопея у Максимова с макроподстановщиком. Только сделано было топорно, вручную, через перечисление вариантов кода и замены этого кода. Разумеется, нужен был инструмент задания правил.[/quote] Немного заступлюсь, все баги Макс исправил и работает достаточно стабильно, а как там реализовал ему респект
|
|
|
|
Добавлено: Вт май 16, 2017 20:12 |
|
|
|
|