Исполнимый стек словарей T32

Механизм словарного поиска T32 несколько мощнее, чем то, что положено по стандарту. А именно, можно добавить на стек словарей нечто, не являющееся списком слов, но осуществляющее какой-то поиск или анализ слова наподобие словаря.

Пример 1. Слова вида &&N, где N - число, эквивалентны фразе N PICK.

\ ( xt -- ) поместить функцию на стек словарей
: func>order CELL- CELL- >ORDER ;

\ скомпилировать или выполнить N PICK
: _&&,
	STATE @
	IF	[COMPILE] LITERAL COMPILE PICK
	ELSE	PICK
	THEN
;

\ слово, которое будет работать на стеке словарей
: do-&& ( addr len -- addr len )
	( addr len -- n cfa 1 1 )
	DUP 2 > ONTRUE
	OVER S" &&" TUCK COMPARE 0= ONTRUE
	2DUP 2 /STRING S$NUMBER?
	IF	DROP NIP NIP ['] _&&, 1 1 RDROP
	ELSE	2DROP
	THEN
;

ECHOING ON

['] do-&& func>order
1 2 3 4 5 6 .S
&&0 . &&3 .
: tst &&0 . &&2 . ;
tst
see tst
ORDER

ECHOING OFF

Прогон (исходный текст и выдача): ['] do-&& func>order 1 2 3 4 5 6 .S [6] 1 2 3 4 5 6 ; &&0 . &&3 . 6 3 : tst &&0 . &&2 . ; tst 6 4 see tst : tst LIT [0] PICK . LIT [2] PICK . EXIT ORDER 400b7c4 func: do-&& 40e2ad4 FORTH ( FORTH ) 40e2ad4 FORTH ( FORTH ) ; 40e2ad4 FORTH ( FORTH )
Нетрудно заметить, что под CFA может оставаться дополнительная информация. А если к слову &&3 применить ' (штрих)?
' &&3 ok( 3 400b79c ) >.NAMES _&&, ok( 3 )
Нам повезло: система не зависла, а штрих вернул и cfa, и дополнительную информацию, хотя это на самом деле не совсем корректно (штриху положено возвращать только одно значение). Любое слово, выполняющее что-либо типа ' SWAP , на любом из слов &&N скорее всего зависнет.
А в следующем примере возникает ошибка:
: yyy POSTPONE &&3 ; ^ unfinished control structure, or data stack changed
Ничего удивительного:
IT (see) : yyy _&&, ok
т.е. вспомогательное слово _&&, скомпилировалось, а число 3 осталось на стеке.
Поэтому:

Полностью совместимы с Форт-системой только слова, для которых в результате словарного поиска возвращается одно значение — CFA.

Рекомендуется всегда, когда это возможно, возвращать для слова только одно значение — CFA.

Если для слова в результате словарного поиска возвращается более одного значения, то не все компоненты Форт-системы смогут с ним справиться. Скорее всего Вы создадите конструкцию, с которой сможет справиться текстовый интерпретатор, однако не следует питать иллюзий на счет возможностей ее использования с остальными компонентами Форт-системы, такими как ', POSTPONE, [COMPILE].

А теперь приведем еще один пример.
Пример 2. Нахождение переопределенных фортовских слов.
\ ( xt -- ) поместить функцию на стек словарей : func>order CELL- CELL- >ORDER ; \ SEARCH-THREAD ( addr len ^^1st -- addr len 0 0 0 ) \ ( addr len ^^1st -- addr len prev-lfa lfa -1 ) \ продолжить поиск в цепочке слов -- см. SEARCH-THREAD , это почти то же самое : _CONTINUE-SEARCH ( addr len ^^1st -- addr len 0 ) ( addr len ^^1st -- cfa flag flag ) SEARCH-THREAD \ та же цепочка (нитка, thread) IF 2NIP NIP ( lfa ) DUP TO LastFoundLFA DUP HEAD> SWAP HFLAGS@ &immediate AND IF 1 ELSE -1 THEN DUP ELSE 2DROP 0 THEN ; : witholdnames ( addr len -- addr len ) ( addr len -- cfa flag flag ; exit ) DUP ONTRUE \ не пустая строка? OVER C@ '~' = ONTRUE \ начинается с '~' ? R@ -ROT ( retaddr addr len ) \ retaddr - адрес остатка стека поиска 2DUP 2>R \ сохраняем старое имя 1 /STRING \ убираем '~' в начале ROT TOKEN- ENTER ( addr len 0 ) ( cfa flag flag ) IF ( где-то найдено, продолжить поиск там же) 2DROP LastFoundNFA COUNT LastFoundLFA _CONTINUE-SEARCH ( addr len 0 ) ( cfa flag flag ) IF ( вернуть старое CFA) DUP RDROP RDROP RDROP EXIT THEN THEN ( не найдено, вернуть '~' в имя и искать снова) 2DROP 2R> ;
Здесь ^^1st — указатель на указатель на первое имя в цепочке, например, адрес поля связи (поле связи содержит адрес следующего слова, так что это действительно адрес адреса заголовка).
Слово ENTER определено как : ENTER >R ; , оно имеет стековый эффект ( codeaddr -- ) и выполняет фрагмент шитого кода, находящийся по адресу codeaddr. У нас это слово используется в конструкции R@ ... TOKEN- ENTER. Ничего особо страшного эта конструкция не делает, просто фрагмент шитого кода, начинающийся со слова witholdnames, рекурсивно вызывает сам себя. R@ возвращает адрес следующего в шитом коде обращения к функции, а TOKEN- вычитает из него размер обращения к функции (compiled token, 4 байта) и получается адрес обращения к только что вызванной функции.
Употребить RECURSE для этого нельзя, т.к. RECURSE — это рекурсивной вызов процедуры, а R@ ... TOKEN- ENTER — это рекурсивной вызов и процедуры, и остающейся за ней части шитого кода.
Таким образом, слово witholdnames рекурсивно вызывает себя, пока не "съест" все символы '~', а затем начинает искать получившееся имя в оставшейся части стека словарей. Если имя не найдено, выполняется откат к предыдущему имени (у которого "съедено" на один символ '~' меньше) и снова выполняется поиск уже этого имени в оставшейся части стека словарей.
Отличия слова _CONTINUE-SEARCH от модуля DOSEARCHVOC минимальны. Так как в перспективе — введение разбиения списков слов на несколько цепочек (multi-thread hashing), процитируем исходники:
TDOES-LABEL DOSEARCHVOC ( addr len -- addr len ) ( addr len -- cfa flag flag ; exit ) cell+ search-thread \ 1 нитка !!!!!!! IF 2NIP NIP ( lfa ) DUP TTO LastFoundLFA DUP HEAD> SWAP HFLAGS@ [&immediate] LITERAL AND IF 1 ELSE -1 THEN DUP RDROP EXIT ELSE 2DROP THEN ;

Однако, вернемся к нашей презентации. Переопределим несколько раз имена foo и ~bar:
: foo ." foo#1" ; : foo ." foo#2" ; : foo ." foo#3" ; : foo ." foo#4" ; : foo ." foo#5" ; : ~bar ." ~bar#1" ; : ~bar ." ~bar#2" ; : ~bar ." ~bar#3" ; : ~bar ." ~bar#4" ; : ~bar ." ~bar#5" ;
А теперь посмотрим, как все это будет работать.
' witholdnames func>order ok ORDER 400b7fc func: witholdnames 40e2ad4 FORTH ( FORTH ) 40e2ad4 FORTH ( FORTH ) ; 40e2ad4 FORTH ( FORTH ) ok foo foo#5 ok ~foo foo#4 ok ~~foo foo#3 ok ~~~foo foo#2 ok ~~~~foo foo#1 ok ~~~~~foo '~~~~~foo' not found bar 'bar' not found ~bar ~bar#5 ok ~~bar ~bar#4 ok ~~~bar ~bar#3 ok ~~~~bar ~bar#2 ok ~~~~~bar ~bar#1 ok ~~~~~~bar '~~~~~~bar' not found
Все работает. Правда, если в новой версии T32 будет введено разбиение словаря на несколько подсписков, определение _CONTINUE-SEARCH придется переписать.

М.Л.Гасаненко
Тимяшкино, 2000 г.