Б: Определение DOER/MAKE
ПРИЛОЖЕНИЕ Б
О П Р Е Д Е Л Е Н И Е D O E R / M A K E ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
----------------------------------------------------------------
Если в Вашей системе слова DOER и MAKE еще не определены, это приложение призвано помочь Вам их ввести и, при необходимости, понять принцип их работы. Поскольку по природе своей эти конструкции системно-зависимы, я привел несколько различных реализаций в конце приложения в надежде, что одна из них будет работать и у Вас. Если же этого не произойдет, и если в этом разделе Вам не хватит информации для того, чтобы заставить все работать, то, видимо, у Вас какая-то необычная система. Пожалуйста, не обращайтесь за помощью ко мне; спросите поставщиков Вашего Форта. Вот как это работает. DOER - это определяющее слово, которое создает словарную статью с одной ячейкой памяти в поле ее параметров. Эта ячейка содержит адрес вектора и инициализируется указанием на слово, которое ничего не делает (по имени NOTHING). Потомки слова DOER исполняют код после DOES> в нем, который делает всего две вещи: достает адрес вектора и заносит его на стек возвратов. Это все. Продолжение исполнения Форта производится с этого адреса со стека возвратов, что вызывает исполнение векторизованной функции. Это все равно, что сказать (в стандарте '83)
' NOTHING >BODY >R
что даст исполнение NOTHING. (Такой трюк годится только для определений через двоеточие.) Вот иллюстрация по словарной статье, созданной после ввода
DOER ДЖО
+-------------------+--------------------+ | Д Ж О | pfa слова NOTHING | +-------------------+--------------------+ заголовок поле параметров
Теперь предположим, мы определили
: ТЕСТ MAKE ДЖО CR ;
то есть мы создали слово, которое может направить ДЖО на выдачу перевода каретки. - 284 -
Вот рисунок, изображающий скомпилированное определение слова ТЕСТ:
+----------+--------+-------+-------+-------+-------+ | Т Е С Т | адр. | 0 | адр. | адр. | адр. | | | (MAKE) | | ДЖО | CR | EXIT | +----------+--------+-------+-------+-------+-------+ заголовок маркер
Давайте глянем на код для MAKE. Поскольку мы используем его внутри определения через двоеточие, переменная STATE будет в состоянии "истина", и мы исполним фразу
COMPILE (MAKE) HERE MARKER ! 0 ,
Можно видеть, как MAKE скомпилировало адрес программы времени исполнения (MAKE), после которого записала ноль. (Мы объясним, для чего этот ноль и почему мы записали его адрес в переменную MARKER, попозже.) Теперь посмотрим, что (MAKE) делает, когда мы исполняем новое определение ТЕСТ:
R> Получает адрес со стека возвратов. Этот адрес указывает на ячейку сразу после (MAKE), где находится ноль. DUP 2+ Получает адрес следующей ячейки после (MAKE), где размещен адрес ДЖО. DUP 2+ Получает адрес третьей ячейки после (MAKE), где начинается код, который мы хотим исполнить. На стеке теперь ( 'маркера 'джо 'кода ) SWAP @ >BODY Берет содержимое адреса, указывающего на ДЖО (т.е. получает адрес самого ДЖО) и вычисляет pfa ДЖО, где хранится адрес вектора. ! Записывает адрес, по которому начинается новый код (CR и т.д.) по адресу вектора ДЖО. Теперь ДЖО указывает внутрь определения слова ТЕСТ. Если мы введем ДЖО, мы получим возврат каретки. @ ?DUP Берет содержимое ячейки, содержащей ноль. IF >R THEN Поскольку там ноль, тело IF THEN не исполняется.
Вот основная идея. Но как насчет ячейки с нулем? Она - для использования слова ;AND. Предположим, мы изменили ТЕСТ так:
: ТЕСТ MAKE ДЖО CR ;AND SPACE ; - 285 -
То есть когда мы вызываем ТЕСТ, оно направит вектор ДЖО на CR, а затем немедленно исполнит SPACE. Вот как будет выглядеть новая версия ТЕСТ:
+--------------------------- | \/ +---------+------+------+------+------+------+------+------+ | Т Е С Т | адр. | адр. | адр. | адр. | адр. | адр. | адр. | | |(MAKE)| | ДЖО | CR | EXIT | SPACE| EXIT | +---------+------+------+------+------+------+------+------+ заголовок маркер
Вот определение ;AND:
: ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE
Видно, что ;AND скомпилировало EXIT так же, как это сделало бы слово ;. Далее, припомните что MAKE сохранило адрес нуля в переменной MARKER.
Теперь ;AND записывает HERE ( место начала следующего участка кода, начинающегося со SPACE) в ячейку, которая содержала ноль. Теперь (MAKE) имеет указатель на место продолжения исполнения. Фраза
IF >R THEN
теперь положит на стек возвратов адрес кода, начинающегося со слова SPACE. Так выполнение перескочит через код между MAKE и ;AND и продолжится для остальной части определения через двоеточие. Слово UNDO получает адрес слова-DOERа и записывает в него ссылку на слово NOTHING. Одно последнее замечание: на некоторых системах может возникнуть проблема. Если Вы используете MAKE вне определения через двоеточие для создания ссылки вперед, то можете оказаться не в состоянии найти самое последнее из определенных слов. К примеру, если у Вас имеется
: ПРИПЕВ ТРАМ- ПАМ- ПАМ- ; MAKE ПЕСНЯ КУПЛЕТ ПРИПЕВ ;
то Ваша система может подумать, что ПРИПЕВ еще не определен. Проблема заключается в месторасположении слова SMUDGE. В качестве решения попытайтесь перегруппировать порядок определений или, при необходимости, уберите код с MAKE внутрь определения, которое потом можно исполнить:
: УСТАНОВКА MAKE ПЕСНЯ КУПЛЕТ ПРИПЕВ ; УСТАНОВКА - 286 -
В системе Laboratory Microsystems PC/FORTH 2.0 слово UNSMUDGE в 9-й строке устраняет эту проблему. В модели Форта Лексена/Перри/Харриса этой проблемы нет. Последний блок - это пример использования DOER/MAKE. После загрузки блока введите
RECITAL
а затем введите
WHY?
и возврат каретки столько раз, сколько захочется. (Всякий раз у Вас будет для этого своя причина.)
Блок # 21 0 ( DOER/MAKE Теневой блок LPB 12/05/83 ) 1 NOTHING нет операции 2 DOER определяет слово с векторизуемым поведением 3 MARKER хранит адрес служебного указателя продолжения 4 (MAKE) устанавлиает адрес последующего кода в поле 5 параметров слова типа DOER 6 MAKE интерпретация: MAKE doer-имя Форт-код ; 7 или внутри определения: 8 : ОПР MAKE doer-имя Форт-код ; 9 векторизует слово doer-имя на Форт-код. 10 ;AND разрешает продолжение определения с MAKE. 11 UNDO использование: UNDO doer-имя делает его 12 безопасным в использовании. 13 14 15
Блок # 22 0 \ DOER/MAKE FORTH-83 Laxen/Perry/Harris LPB 12/05/83 1 : NOTHING ; 2 : DOER CREATE ['] NOTHING >BODY , DOES> @ >R ; 3 VARIABLE MARKER 4 : (MAKE) R> DUP 2+ DUP 2+ SWAP @ >BODY ! 5 @ ?DUP IF >R THEN ; 6 : MAKE STATE @ IF ( компиляция) 7 COMPILE (MAKE) HERE MARKER ! 0 , 8 ELSE HERE [COMPILE] ' >BODY ! 9 [COMPILE] ] THEN ; IMMEDIATE 10 : ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE 11 : UNDO ['] NOTHING >BODY [COMPILE] ' >BODY ! ; 12 13 \ Код в этом блоке является общественным достоянием. 14 15 - 287 -
Блок # 23 0 ( DOER/MAKE FORTH-83 LabMicro PC/FORTH 2.0 LPB 12/05/83 ) 1 : NOTHING ; 2 : DOER CREATE ['] NOTHING >BODY , DOES> @ >R ; 3 VARIABLE MARKER 4 : (MAKE) R> DUP 2+ DUP 2+ SWAP @ >BODY ! 5 @ ?DUP IF >R THEN ; 6 : MAKE STATE @ IF ( компиляция) 7 COMPILE (MAKE) HERE MARKER ! 0 , 8 ELSE HERE [COMPILE] ' >BODY ! 9 [COMPILE] ] UNSMUDGE THEN ; IMMEDIATE 10 : ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE 11 : UNDO ['] NOTHING >BODY [COMPILE] ' >BODY ! ; 12 13 ( Код в этом блоке является общественным достоянием.)
Блок # 24 0 ( DOER/MAKE FIG model LPB 10/25/84 ) 1 : NOTHING ; 2 : DOES-APF ( apf -- arf-потомка- ) 2+ ; 3 : DOER @ >R ; 4 VARIABLE MARKER 5 : (MAKE) R> DUP 2+ DUP 2+ SWAP @ 2+ DOES-APF ! 6 @ -DUP IF >R THEN ; 7 : MAKE STATE @ IF ( компиляция) 8 COMPILE (MAKE) HERE MARKER ! 0 , 9 ELSE HERE [COMPILE] ' DOES-APF ! 10 SMUDGE [COMPILE] ] THEN ; IMMEDIATE 11 : ;AND COMPILE ;S HERE MARKER @ ! ; IMMEDIATE 12 : UNDO ' NOTHING [COMPILE] ' DOES-APF ! ; 13 ;S 14 ( Код в этом блоке является общественным достоянием.)
Блок # 25 0 ( DOER/MAKE Стандарт-79 MVP FORTH LPB 12/05/83 ) 1 : NOTHING ; 2 : DOER CREATE ' NOTHING , DOES> @ >R ; 3 VARIABLE MARKER 4 : (MAKE) R> DUP 2+ DUP 2+ SWAP @ 2+ ( apf) ! 5 @ ?DUP IF >R THEN ; 6 : MAKE STATE @ IF ( компиляция) 7 COMPILE (MAKE) HERE MARKER ! 0 , 8 ELSE HERE [COMPILE] ' ! 9 [COMPILE] ] THEN ; IMMEDIATE 10 : ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE 11 : UNDO ' NOTHING [COMPILE] ' ! ; 12 13 14 ( Код в этом блоке является общественным достоянием.) - 288 -
Блок # 26 0 ( Пример на DOER/MAKE 12/27/84 ) 1 DOER ANSWER 2 : RECITAL CR 3 ." Ваш папа стоит на столе. Спросите его 'WHY?' (почему)" 4 MAKE ANSWER ." Для замены лампочки." 5 BEGIN 6 MAKE ANSWER ." Потому что она сгорела." 7 MAKE ANSWER ." Потому что была старая." 8 MAKE ANSWER ." Потому что мы ее привинтили очень давно." 9 MAKE ANSWER ." Потому что было темно!" 10 MAKE ANSWER ." Потому что стояла ночь!!" 11 MAKE ANSWER ." Перестань спрашивать ПОЧЕМУ?" 12 MAKE ANSWER ." Потому что я с тобой свихнусь." 13 MAKE ANSWER ." Дай мне просто поменять эту лампочку!" 14 FALSE UNTIL ; 15 : WHY? CR ANSWER QUIT ;
---------------------------------------------------------------- - 289 -