Forth http://fforum.winglion.ru/ |
|
Навешивание обработчиков на компиляцию http://fforum.winglion.ru/viewtopic.php?f=2&t=3126 |
Страница 3 из 3 |
Автор: | gudleifr [ Ср май 17, 2017 21:19 ] |
Заголовок сообщения: | Re: Навешивание обработчиков на компиляцию |
gudleifr писал(а): Если же FORTH-программа компилируется, то нет ничего странного, что стиль ее написания тяготеет к наиболее "естественному" компилируемому языку - C, или более привычному C++. F-MAP писал(а): В этом коде наверно структуру использовать намного читабельней , например как в SPF sic! |
Автор: | Victor__v [ Ср май 17, 2017 21:29 ] |
Заголовок сообщения: | Re: Навешивание обработчиков на компиляцию |
Код: В этом коде наверно структуру использовать намного читабельней , например как в SPF Знаю. Просто хочется чуть больше независимости от СПФ, подправлю Цитата: А при использовании HASH, не избежать ведь коллизий, может привести к чему нибудь не хорошему Ну кол-во записей явно меньше миллиарда будет 32-битный хеш достаточно надёжен А так тоже думаю отказаться от него. Но чем тогда выразить идентификатор группы? Можно и строку в четыре байта, но это не серьёзно. А, допустим, восемь использовать. Доп.функционал или плохочитаемый код на получится. Можно конечно MMX использовать как раз документация есть, но по-хорошему значение подопытного регистра надо где-то и сохранить. Что доп.проблемы может привнести. Про реализацию двоичной арифметики молчу. Или на строке в 4 байта остановиться. Что просто, но также как и хеш малоинформативно . . |
Автор: | F-MAP [ Ср май 17, 2017 22:00 ] |
Заголовок сообщения: | Re: Навешивание обработчиков на компиляцию |
Victor__v писал(а): Код: В этом коде наверно структуру использовать намного читабельней , например как в SPF Знаю. Просто хочется чуть больше независимости от СПФ, подправлю Цитата: А при использовании HASH, не избежать ведь коллизий, может привести к чему нибудь не хорошему Ну кол-во записей явно меньше миллиарда будет 32-битный хеш достаточно надёжен А так тоже думаю отказаться от него. Но чем тогда выразить идентификатор группы? Можно и строку в четыре байта, но это не серьёзно. А, допустим, восемь использовать. Доп.функционал или плохочитаемый код на получится. Можно конечно MMX использовать как раз документация есть, но по-хорошему значение подопытного регистра надо где-то и сохранить. Что доп.проблемы может привнести. Про реализацию двоичной арифметики молчу. Или на строке в 4 байта остановиться. Что просто, но также как и хеш малоинформативно . . Тогда может перейти к глобальному идентификатору GUID? Как в СОМ интерфейсах... |
Автор: | Victor__v [ Чт май 18, 2017 07:19 ] |
Заголовок сообщения: | Re: Навешивание обработчиков на компиляцию |
F-MAP писал(а): Тогда может перейти к глобальному идентификатору GUID? Как в СОМ интерфейсах... Для каждой группы записей? Не слишком ли? |
Автор: | Victor__v [ Сб май 20, 2017 15:27 ] |
Заголовок сообщения: | 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 |
Автор: | Ethereal [ Чт июн 08, 2017 14:14 ] |
Заголовок сообщения: | Re: Навешивание обработчиков на компиляцию |
Victor__v писал(а): Лично мне не нужна зверская оптимизация. Не нравится LITERAL и нравится Си , ну определино просматривать отъилнайненный код 10 20 + выше моих духовных сил. Вот с этим смириться не могу : { POSTPONE [ ; IMMEDIATE : } ] POSTPONE LITERAL ; и тогда пиши вот так { 10 20 + } Красота ! |
Автор: | Ethereal [ Чт июн 08, 2017 14:51 ] |
Заголовок сообщения: | Re: Навешивание обработчиков на компиляцию |
Victor__v писал(а): Код: \ создать псевдоним для группы из строки \ псевдоним имеет длину равную CELL : event-group-psevd \ addr u -- n DUP CELL < IF 0 >R RP@ SWAP MOVE R> ELSE DROP @ THEN ; Код: \ создать псевдоним для группы из строки
\ псевдоним имеет длину равную CELL : event-group-psevd \ addr u -- n CELL UMIN 0 >R RP@ SWAP CMOVE R> ; |
Автор: | Victor__v [ Чт июн 08, 2017 18:25 ] |
Заголовок сообщения: | 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 Ну,это так в порядке бреда |
Автор: | Victor__v [ Вт сен 05, 2017 00:08 ] |
Заголовок сообщения: | 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 < , но потом фиг поймёшь, что это значит. |
Автор: | Victor__v [ Вт сен 05, 2017 00:22 ] |
Заголовок сообщения: | Re: Навешивание обработчиков на компиляцию |
Ах, да структурки забыл добавить |
Страница 3 из 3 | Часовой пояс: UTC + 3 часа [ Летнее время ] |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |