| netlib.narod.ru | < Назад | Оглавление | Далее > |
Приводимый ниже текст представляет собой ядро системы ФОРТ-ЕС (см. приложение 2), из которого исключены запускающая часть и реализации слов нижнего уровня для обмена с терминалом и внешней памятью. Общий объем ядра — 8 Кбайт (свыше 200 слов). Текст состоит из двух частей — списка слов с их краткими спецификациями и экранов с определениями на встроенном языке ассемблера и на языке Форт.
Помимо слов, которым соответствуют статьи в словаре, внутри ассемблерных определений используются метки и адреса. В спецификациях эти объекты отмечены буквами М и А. Они определяются с помощью слов М: и А: соответственно. Метки используются в машинных командах, а адреса порождают двухбайтное значение, содержащее данный адрес. Адресные операнды FIRST и SECOND обозначают соответственно первый и второй элементы стека. Макрокоманды PUSH, POP и PULL можно рассматривать как команды с одним регистровым операндом. Операция PUSH помещает на стек значение из регистра, POP снимает верхнее значение со стека, засылая его в регистр, и PULL копирует верхнее значение стека в регистр. Кроме того, в ассемблерных определениях используются локальные метки [11, с. 191], обозначаемые целыми числами и словами =F (для ссылки вперед) и =B (для ссылки назад). Определяется локальная метка через слово =H, которое полагает ее равной текущему значению счетчика адреса. Регистры общего назначения обозначаются специальными словами и имеют следующий смысл:
RW1 — рабочий регистр, старший в паре;
RW2 — рабочий регистр, младший в паре;
RI — указатель адресного интерпретатора;
RRET — абсолютный адрес вершины стека возвратов;
RSTACK — абсолютный адрес вершины стека данных;
RD — форт-адрес текущей вершины словаря;
RFORTH — абсолютный адрес начала словаря, соответствующий нулевому форт-адресу;
RNEXT — адрес точки NEXT адресного интерпретатора (тот же адрес, что и в RFORTH);
RTWO — константа 2;
RMASK — константа 65535.
Предполагается также, что в регистре 13 находится адрес области сохранения и регистры 0, 1, 14 и 15 свободно используются внутри определений как рабочие.
Тексты определений представлены в виде распечаток стандартных форт-текстов и занимают экраны с номерами от 1 до 47. В последнем столбце спецификации для каждого слова указан номер экрана, на котором оно определено. Главным словом модели является слово ФОРТ-СИСТЕМА.
В списке спецификаций слова расположены по возрастанию в кодировке ДКОИ. Они могут иметь следующие отметки:
А — адрес;
М — метка;
Н — слово немедленного исполнения;
К — требуется режим компиляции;
П — переменная, размещенная в пользовательской области;
С — системная переменная, размещенная в словаре;
Э — требуется режим обработки экрана;
+ — слово из дополнения к стандарту «Форт-83»;
* — нестандартное слово.
Для каждого слова указываются значения, которые оно снимает со стека (слева от знака ->), и результат, который оно оставляет на стеке (справа от знака ->). Если перечисляется несколько значений, то верхнее (вершина стека) находится справа.
Для задания параметров и результатов, передаваемых через стек данных, используются следующие обозначения:
+N — неотрицательное целое со знаком;
А — двухбайтный форт-адрес;
С — однобайтное значение (старший байт, как правило, нулевой);
CFA — двухбайтный адрес поля кода словарной статьи;
D — четырехбайтное целое со знаком;
F — булевское значение (0 — ЛОЖЬ, не 0 — ИСТИНА);
FF — булевское значение ЛОЖЬ (0);
L — абсолютный машинный адрес (четырехбайтный);
LFA — двухбайтный адрес поля связи словарной статьи;
N — двухбайтное целое со знаком;
NFA — двухбайтный адрес поля имени словарной статьи;
PFA — двухбайтный адрес поля параметров словарной статьи;
Т — двухбайтный адрес строки со счетчиком;
TF — булевское значение ИСТИНА (не 0, обычно -1);
U — двухбайтное целое без знака;
UD — четырехбайтное целое без знака;
W — двухбайтное целое со знаком или без него (N или U);
WD — четырехбайтное целое со знаком или без него (D или UD).
Для некоторых слов указаны две группы результатов, отделяемые друг от друга косой чертой (/). Они различаются по булевскому значению на вершине стека: не 0 (ИСТИНА) означает успех, 0 (ЛОЖЬ) — неудачу.
*Н -> (ПУСТОЕ СЛОВО) - ЗАКОНЧИТЬ ИНТЕРПРЕТАЦИЮ 40
ВХОДНОГО ПОТОКА
[ Н -> ПЕРЕКЛЮЧИТЬ ТЕКСТОВЫЙ ИНТЕРПРЕТАТОР 22
В РЕЖИМ ИСПОЛНЕНИЯ
['] НК -> /КОМПИЛЯЦИЯ/ СКОМПИЛИРОВАТЬ CFA 41
->CFA /ИСПОЛНЕНИЕ/ СЛЕДУЮЩЕГО СЛОВА КАК
ЧИСЛОВОЙ ЛИТЕРАЛ
[COMPILE] НК -> СКОМПИЛИРОВАТЬ СЛЕДУЮЩЕЕ СЛОВО 41
НЕЗАВИСИМО ОТ ЕГО ПРИЗНАКА "IMMEDIATE"
. N-> НАПЕЧАТАТЬ N НА ТЕРМИНАЛЕ И ДАТЬ ПРОБЕЛ 38
.( Н -> НАПЕЧАТАТЬ СЛЕДУЮЩИЕ ЛИТЕРЫ ДО 28
ЗАКРЫВАЮЩЕЙ СКОБКИ ИСКЛЮЧИТЕЛЬНО
." НК -> ПРИ ИСПОЛНЕНИИ НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ 28
СЛЕДУЮЩИЕ ЛИТЕРЫ ДО КАВЫЧКИ ИСКЛЮЧИТЕЛЬНО 37
.R + N1,+N2-> НАПЕЧАТАТЬ N1 НА ТЕРМИНАЛЕ 38
В ПОЛЕ ДЛИНЫ +N2 СПРАВА
.VOC * PFA+2-> НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ ИМЯ 43
СЛОВАРНОЙ СТАТЬИ ДЛЯ СПИСКА СЛОВ
< N1,N2->F F НЕ НУЛЬ, ЕСЛИ N1 МЕНЬШЕ N2 19
<> + W1,W2->F F НЕ НУЛЬ, ЕСЛИ W1 НЕ РАВНО W2 19
<# -> НАЧАТЬ ФОРМАТНОЕ ПРЕОБРАЗОВАНИЕ 37
<MARK K ->A ОТМЕТИТЬ ТЕКУЩИЙ АДРЕС ДЛЯ ССЫЛКИ НАЗАД 19
<RESOLVE K A-> РАЗРЕШИТЬ ССЫЛКУ НАЗАД В АДРЕС А 19
( Н -> КОММЕНТАРИЙ - ПРОПУСТИТЬ СЛЕДУЮЩИЙ ТЕКСТ 28
ДО ЗАКРЫВАЮЩЕЙ КРУГЛОЙ СКОБКИ
(.") *K -> ПРОЦЕДУРА, КОМПИЛИРУЕМАЯ В ." 28
(+LOOP) * N-> ТЕСТ НА ЗАВЕРШЕНИЕ ЦИКЛА "DO +LOOP" 5
С ШАГОМ N
(;CODE) *K -> ЗАПИСАТЬ В ПОЛЕ КОДА ПОСЛЕДНЕЙ СТАТЬИ 31
СЛЕДУЮЩИЙ АДРЕС И ЗАКОНЧИТЬ ОПРЕДЕЛЕНИЕ
(#SCR) * N->A,T ПЕРЕВЕСТИ НОМЕР ЭКРАНА N В ТЕКСТ 46
(A") * F-> ПРОЦЕДУРА, КОМПИЛИРУЕМАЯ В ABORT" 29
(DO) *K W1,W2-> ВХОД В ЦИКЛ СО СЧЕТЧИКОМ ОТ W2 ДО W1 24
(EXPECT) * A,+N1->A,+N2 ВВЕСТИ С ТЕРМИНАЛА 6
+N1 ЛИТЕР ПО АДРЕСУ А ДО ПЕРЕВОДА СТРОКИ;
+N2 - ФАКТИЧЕСКОЕ ЧИСЛО ВВЕДЕННЫХ ЛИТЕР
(FIND) * -1,AN,,,A1,T->CFA,C,TF/FF ИСКАТЬ СЛОВО Т 34
В СПИСКАХ А1,,,AN; ПРИ УСПЕХЕ ДАТЬ CFA
ЕГО СТАТЬИ И С - БАЙТ ДЛИНЫ С ПРИЗНАКАМИ
(FORGET) * A-> УДАЛИТЬ СЛОВАРНЫЕ СТАТЬИ ПОСЛЕ АДРЕСА А 45
(LOOP) * -> ТЕСТ НА ЗАВЕРШЕНИЕ ЦИКЛА "DO LOOP" 5
(VOC) * PFA1+2->PFA2,N/0,N ДАТЬ ЧИСЛО СТАТЕЙ N В 43
СПИСКЕ PFA1+2 И PFA СЛЕДУЮЩЕГО СПИСКА
ИЛИ НУЛЬ, ЕСЛИ ЕГО НЕТ
+ W1,W2->W3 СУММА ЧИСЕЛ W1 И W2 17
+! W,A-> УВЕЛИЧИТЬ ЗНАЧЕНИЕ ПО АДРЕСУ А НА W 17
+BUF * A1->A2,F ПЕРЕЙТИ К СЛЕДУЮЩЕМУ БУФЕРУ В ПУЛЕ 25
+LOOP HK A1,A2,3-> /КОМПИЛЯЦИЯ/ КОНЕЦ ЦИКЛА 47
N-> /ИСПОЛНЕНИЕ/ "DO +LOOP" С ШАГОМ N
! W,A-> ЗАСЛАТЬ ЗНАЧЕНИЕ W ПО АДРЕСУ А 11
!CSP * -> ЗАПОМНИТЬ АДРЕС ВЕРШИНЫ СТЕКА В CSP 29
] -> ПЕРЕКЛЮЧИТЬ ТЕКСТОВЫЙ ИНТЕРПРЕТАТОР 22
В РЕЖИМ КОМПИЛЯЦИИ
* N1,N2->N3 ПРОИЗВЕДЕНИЕ ЧИСЕЛ N1 И N2 18
*/ N1,N2,N3->N4 ЧАСТНОЕ ОТ ДЕЛЕНИЯ N1*N2 НА N3 18
*/MOD N1,N2,N3->N4,N5 ОСТАТОК N4 И ЧАСТНОЕ N5 18
ОТ ДЕЛЕНИЯ ПРОИЗВЕДЕНИЯ N1*N2 НА N3
; HK -> ЗАКОНЧИТЬ ОПРЕДЕЛЕНИЕ ЧЕРЕЗ ДВОЕТОЧИЕ 32
;S +НЭ -> ЗАКОНЧИТЬ ИНТЕРПРЕТАЦИЮ ЭКРАНА 41
- W1,W2->W3 ВЫЧЕСТЬ W2 ИЗ W1 17
--> +НЭ -> ИНТЕРПРЕТИРОВАТЬ СЛЕДУЮЩИЙ ЭКРАН 41
-FIND * ->A,N ВВЕСТИ СЛОВО И ИСКАТЬ В СЛОВАРЕ; 35
РЕЗУЛЬТАТ ТОТ ЖЕ, ЧТО И У FIND
-TRAILING A,N1->A,N2 ОТСЕЧЬ КОНЕЧНЫЕ ПРОБЕЛЫ 41
/ N1,N2->N3 ЧАСТНОЕ ОТ ДЕЛЕНИЯ N1 НА N2 18
/MOD N1,N2->N3,N4 ОСТАТОК N3 И ЧАСТНОЕ N4 18
ОТ ДЕЛЕНИЯ N1 НА N2
, W-> СКОМПИЛИРОВАТЬ W НА ВЕРШИНУ СЛОВАРЯ 11
," * -> СКОМПИЛИРОВАТЬ СТРОКУ СО СЧЕТЧИКОМ 28
> N1,N2->F F НЕ НУЛЬ, ЕСЛИ N1 БОЛЬШЕ N2 19
>= * N1,N2->F F НЕ НУЛЬ, ЕСЛИ N1 НЕ МЕНЬШЕ N2 19
>BODY CFA->PFA ОТ ПОЛЯ КОДА К ПОЛЮ ПАРАМЕТРОВ 30
>IN П ->A ПЕРЕМЕННАЯ - СМЕЩЕНИЕ ОЧЕРЕДНОЙ ЛИТЕРЫ 8
ВО ВХОДНОМ ТЕКСТОВОМ БУФЕРЕ ИЛИ ЭКРАНЕ
>LINK * CFA->LFA ПЕРЕЙТИ ОТ ПОЛЯ КОДА К ПОЛЮ СВЯЗИ 30
>MARK K ->A ОТМЕТИТЬ ТЕКУЩИЙ АДРЕС ДЛЯ ССЫЛКИ ВПЕРЕД 19
>NAME * CFA->NFA ПЕРЕЙТИ ОТ ПОЛЯ КОДА К ПОЛЮ ИМЕНИ 30
>R K W-> ПЕРЕНЕСТИ W НА СТЕК ВОЗВРАТОВ 9
>RESOLVE K A-> РАЗРЕШИТЬ ССЫЛКУ ВПЕРЕД В АДРЕСЕ А 19
? * A-> НАПЕЧАТАТЬ ЗНАЧЕНИЕ ПО АДРЕСУ А 38
?+ * +N->+N ПРОВЕРИТЬ, ЧТО +N НЕОТРИЦАТЕЛЬНО 29
?ABORT * F,T-> ЕСЛИ F НЕ НУЛЬ, ТО НАПЕЧАТАТЬ НА 29
ТЕРМИНАЛЕ СТРОКУ Т И УЙТИ НА ABORT
?BRANCH K F-> ЕСЛИ F "ЛОЖЬ", ТО КАК BRANCH, ИНАЧЕ 5
ПРОДОЛЖИТЬ ИНТЕРПРЕТАЦИЮ ОТ АДРЕСА,
СЛЕДУЮЩЕГО ЗА АДРЕСОМ ПЕРЕХОДА
?COMP * -> ПРОВЕРИТЬ, ЧТО ТЕКУЩИЙ РЕЖИМ - КОМПИЛЯЦИЯ 29
?CSP * -> ВЫДАТЬ ОШИБКУ "СБИЛСЯ УКАЗАТЕЛЬ СТЕКА" 29
ЕСЛИ ОН НЕ РАВЕН ЗНАЧЕНИЮ В CSP
?DUP W->W,W ПРОДУБЛИРОВАТЬ W, ЕСЛИ ЭТО НЕ НУЛЬ 9
?GAP * N-> ВЫДАТЬ ОШИБКУ "ИСЧЕРПАНИЕ ПАМЯТИ", ЕСЛИ 29
ЗАЗОР МЕЖДУ ВЕРШИНАМИ СТЕКА И СЛОВАРЯ
МЕНЕЕ N БАЙТОВ
?LOADING * -> ВЫДАТЬ ОШИБКУ "НЕТОБРАБОТКИ ЭКРАНА", 29
ЕСЛИ ВХОДНОЙ ТЕКСТ ИДЕТ НЕ С ЭКРАНА
?PAIRS * W1,W2-> ВЫДАТЬ ОШИБКУ "НЕПАРНЫЕ СКОБКИ", 29
ЕСЛИ W1 НЕ РАВНО W2
?STACK * -> ВЫДАТЬ ОШИБКУ "ИСЧЕРПАНИЕ СТЕКА", ЕСЛИ 29
ОН БОЛЕЕ, ЧЕМ ПУСТ, И "ИСЧЕРПАНИЕ ПАМЯТИ"
ПРИ ЗАЗОРЕ, МЕНЬШЕМ 10 БАЙТОВ
: -> НАЧАТЬ ОПРЕДЕЛЕНИЕ СЛОВА ЧЕРЕЗ ДВОЕТОЧИЕ 32
# D1->D2 ДЕЛЕНИЕМ D1 НА ЗНАЧЕНИЕ BASE 37
ВЫДЕЛИТЬ 1 ЦИФРУ С КОНЦА И ДОБАВИТЬ ЕЕ
В БУФЕР PAD, ОСТАВИВ ЧАСТНОЕ D2
#> D->A,+N ЗАКОНЧИТЬ ФОРМАТНОЕ ПРЕОБРАЗОВАНИЕ; 37
ДАТЬ АДРЕС А НАЧАЛА ЛИТЕР И ИХ ЧИСЛО +N
#S D1->0,0 ВЫДЕЛЯТЬ ЦИФРЫ D1 ПО СЛОВУ # ДО 37
ПОЛУЧЕНИЯ НУЛЯ
#TIB П ->A ПЕРЕМЕННАЯ - ЧИСЛО ЛИТЕР В БУФЕРЕ TIB 8
@ A->W ДАТЬ ЗНАЧЕНИЕ ПО АДРЕСУ А 11
' ->CFA ДАТЬ CFA ДЛЯ СЛЕДУЮЩЕГО СЛОВА 41
= W1,W2->F F НЕ НУЛЬ, ЕСЛИ W1 РАВНО W2 19
" *НК -> /КОМПИЛЯЦИЯ/ СКОМПИЛИРОВАТЬ СЛЕДУЮЩИЕ 28
->T /ИСПОЛНЕНИЕ/ ЛИТЕРЫ ДО КАВЫЧКИ
ИСКЛЮЧИТЕЛЬНО КАК СТРОКУ СО СЧЕТЧИКОМ
". * T-> НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ СТРОКУ T 28
ABORT -> СБРОСИТЬ СТЕК И УЙТИ ПО QUIT 28
ABORT" КН -> /КОМПИЛЯЦИЯ/ ЕСЛИ F "ИСТИНА" (НЕ НУЛЬ) 29
F-> /ИСПОЛНЕНИЕ/ ТО НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ
СЛЕДУЮЩИЙ ТЕКСТ ДО КАВЫЧКИ И УЙТИ НА ABORT
ABORT8 * -> ВЫДАТЬ ОШИБКУ "НЕПРАВИЛЬНОЕ ЗНАЧЕНИЕ" 29
ABS N1->N2 АБСОЛЮТНАЯ ВЕЛИЧИНА 17
AGAIN +НК A,1-> /КОМПИЛЯЦИЯ/ КОНЕЦ ЦИКЛА "BEGIN AGAIN" 47
-> /ИСПОЛНЕНИЕ/
ALIGN * +N-> ВЫРОВНЯТЬ ВЕРШИНУ СЛОВАРЯ НА +N 10
ALIGNH * -> ВЫРОВНЯТЬ ВЕРШИНУ СЛОВАРЯ НА ПОЛУСЛОВО 10
ALLOT W-> СМЕСТИТЬ ВЕРШИНУ СЛОВАРЯ НА W БАЙТОВ 10
ALPHA * N->C ПРЕОБРАЗОВАТЬ N В ЛИТЕРУ С КАК ЦИФРУ 37
AND W1,W2->W3 ПОРАЗРЯДНОЕ ЛОГИЧЕСКОЕ "И" 13
B/BUF + ->1024 ЧИСЛО БАЙТОВ В БЛОЧНОМ БУФЕРЕ 7
BADWORD * A-> СООБЩИТЬ О НЕОПОЗНАНОМ СЛОВЕ 29
BASE П ->A ПЕРЕМЕННАЯ - ТЕКУЩЕЕ ОСНОВАНИЕ СИСТЕМЫ 8
СЧИСЛЕНИЯ ПРИ ВВОДЕ-ВЫВОДЕ ЧИСЕЛ
BEGIN НК ->A,1 /КОМПИЛЯЦИЯ/ НАЧАЛО ЦИКЛА "BEGIN" 47
-> /ИСПОЛНЕНИЕ/
BL + ->64 КОНСТАНТА - КОД ПРОБЕЛА В ДКОИ 7
BLANK + A,U-> ЗАСЛАТЬ ПРОБЕЛЫ В U БАЙТОВ ПО АДРЕСУ А 22
BLK П ->A ПЕРЕМЕННАЯ - НОМЕР ВХОДНОГО БЛОКА-ЭКРАНА 8
BLOCK +N->A ДАТЬ АДРЕС А БУФЕРА С БЛОКОМ +N 25
BODY> * PFA->CFA ОТ ПОЛЯ ПАРАМЕТРОВ К ПОЛЮ КОДА 30
BRANCH K -> ПРОДОЛЖИТЬ ИНТЕРПРЕТАЦИЮ ОТ ЗНАЧЕНИЯ 5
СЛЕДУЮЩЕГО СКОМПИЛИРОВАННОГО АДРЕСА
BRANCH# M ПРОДОЛЖЕНИЕ ИНТЕРПРЕТАЦИИ ОТ АДРЕСА В 5
СЛЕДУЮЩЕМ ПОЛУСЛОВЕ
BUFFER +N->A ПРИПИСАТЬ БЛОКУ +N БУФЕР 25
C! C,A-> ЗАСЛАТЬ БАЙТ С ПО АДРЕСУ А 11
C, + C-> СКОМПИЛИРОВАТЬ БАЙТ С НА ВЕРШИНУ СЛОВАРЯ 11
С@ A->C ДАТЬ БАЙТ ПО АДРЕСУ А 11
C" *H -> /КОМПИЛЯЦИЯ/ СКОМПИЛИРОВАТЬ КОД ПЕРВОЙ 28
->C /ИСПОЛНЕНИЕ/ ЛИТЕРЫ СЛЕДУЮЩЕГО СЛОВА
КАК ЛИТЕРАЛ
CMOVE A1,A2,U-> ПЕРЕСЛАТЬ U БАЙТОВ ОТ A1 В A2 21
CMOVE> A1,A2,U-> ПЕРЕСЛАТЬ U БАЙТОВ ОТ АДРЕСА A1 21
ПО АДРЕСУ А2 НАЧИНАЯ С БОЛЬШИХ АДРЕСОВ
COMPILE K -> КОМПИЛИРОВАТЬ СЛЕДУЮЩИЙ АДРЕС 22
CONSTANT W-> ОПРЕДЕЛИТЬ СЛЕДУЮЩЕЕ СЛОВО 32
КАК КОНСТАНТУ СО ЗНАЧЕНИЕМ W
CONTEXT П ->A ПЕРЕМЕННАЯ - СПИСОК, С КОТОРОГО 7
НАЧИНАЕТСЯ ПОИСК ВВОДИМЫХ СЛОВ
CONVERT WD1,A1->WD2,A2 ПРЕОБРАЗОВАТЬ WD1 И ЛИТЕРЫ 39
ОТ А1+1 В WD2 И А2 - АДРЕС 1-ОЙ НЕ ЦИФРЫ
COUNT T->A,N ДАТЬ АДРЕС ПЕРВОЙ ЛИТЕРЫ И ЧИСЛО 28
ЛИТЕР N СТРОКИ СО СЧЕТЧИКОМ T
CR -> ВЫВЕСТИ НА ТЕРМИНАЛ ПЕРЕВОД СТРОКИ 6
CREATE -> СОЗДАТЬ НАЧАЛО СТАТЬИ (ДО PFA) ДЛЯ 36
СЛЕДУЮЩЕГО СЛОВА;
ЕГО ИСПОЛНЕНИЕ КЛАДЕТ PFA НА СТЕК
CREATE# A НАЧАЛО ИСПОЛНИТЕЛЬНОЙ ЧАСТИ "VARIABLE" 3
CSP *П ->A ПЕРЕМЕННАЯ ДЛЯ КОНТРОЛЬНОГО ХРАНЕНИЯ 8
ЗНАЧЕНИЯ УКАЗАТЕЛЯ СТЕКА
CURRENT П ->A ПЕРЕМЕННАЯ - СПИСОК ДЛЯ ДОБАВЛЕНИЯ СЛОВ 7
D. D-> НАПЕЧАТАТЬ D НА ТЕРМИНАЛЕ И ДАТЬ ПРОБЕЛ 38
D.R D,+N-> НАПЕЧАТАТЬ D В ПОЛЕ ДЛИНЫ +N СПРАВА 38
D< D1,D2->F F "ИСТИНА", ЕСЛИ D1 МЕНЬШЕ D2 15
D+ WD1,WD2->WD3 СУММА ДВОЙНЫХ ЧИСЕЛ WD1 И WD2 14
D- WD1,WD2->WD3 РАЗНОСТЬ ДВОЙНЫХ ЧИСЕЛ WD1-WD2 14
D/ * D1,D2->D3 ЧАСТНОЕ D3 ОТ ДЕЛЕНИЯ D1 НА D2 15
D/MOD * D1,D2->D3,D4 ОСТАТОК D3 И ЧАСТНОЕ D4 ОТ 15
ДЕЛЕНИЯ ДВОЙНЫХ ЧИСЕЛ D1 НА D2
D= WD1,WD2->F F "ИСТИНА", ЕСЛИ WD1 И WD2 РАВНЫ 15
DABS D1->D2 АБСОЛЮТНАЯ ВЕЛИЧИНА ДВОЙНОГО ЧИСЛА 14
DECIMAL -> ПЕРЕЙТИ В ДЕСЯТИЧНУЮ СИСТЕМУ 22
DEFINITIONS -> УСТАНОВИТЬ СПИСОК CURRENT НА CONTEXT 31
DEPTH ->+N КОЛИЧЕСТВО ЗНАЧЕНИЙ НА СТЕКЕ ДАННЫХ 20
DIGIT * C,N1->N2,TF/FF N2 - ЗНАЧЕНИЕ ЛИТЕРЫ С КАК 39
ЦИФРЫ В СИСТЕМЕ СЧИСЛЕНИЯ ПО ОСНОВАНИЮ N1
DMAX WD1,WD2->WD3 БОЛЬШЕЕ ИЗ ДВУХ ЧИСЕЛ 16
DMIN WD1,WD2->WD3 МЕНЬШЕЕ ИЗ ДВУХ ЧИСЕЛ 16
DMOD * D1,D2->D3 ОСТАТОК D3 ОТ ДЕЛЕНИЯ D1 НА D2 15
DNEGATE D1->D2 РЕЗУЛЬТАТ ВЫЧИТАНИЯ D1 ИЗ НУЛЯ 14
DO HK ->A1,A2,3 /КОМПИЛЯЦИЯ/ НАЧАЛО ЦИКЛА DO СО 47
N1,N2-> /ИСПОЛНЕНИЕ/ СЧЕТЧИКОМ ОТ N2 ДО N1
DOES> HK -> НАЧАЛО "ИСПОЛНЕНИЯ" В ОПРЕДЕЛЯЮЩЕМ СЛОВЕ 36
DOES# M ПОДПРОГРАММА - НАЧАЛО РАСШИРЕНИЯ DOES> 3
DP! * A-> УСТАНОВИТЬ ВЕРШИНУ СЛОВАРЯ НА АДРЕС А 10
DPL +П ->A ПЕРЕМЕННАЯ - ПОЗИЦИЯ ПОСЛЕДНЕЙ ТОЧКИ 8
В ПОСЛЕДНЕМ ВВЕДЕННОМ ЧИСЛЕ ОТ КОНЦА
DROP W-> УБРАТЬ СО СТЕКА ВЕРХНЕЕ ЗНАЧЕНИЕ 9
DU< UD1,UD2->F F "ИСТИНА", ЕСЛИ UD1 МЕНЬШЕ UD2 14
DUMP + A,U-> РАСПЕЧАТАТЬ НА ТЕРМИНАЛЕ U БАЙТОВ 42
ОТ АДРЕСА А
DUP W->W,W ПРОДУБЛИРОВАТЬ ВЕРХНЕЕ ЗНАЧЕНИЕ 9
D0< D->F F "ИСТИНА", ЕСЛИ D МЕНЬШЕ НУЛЯ 15
D0= WD->F F "ИСТИНА", ЕСЛИ WD НУЛЬ 15
D2/ D1->D2 РАЗДЕЛИТЬ НА ДВА 15
ELSE HK A1,2->A2,2 /КОМПИЛЯЦИЯ/ НАЧАЛО 2-ОЙ ВЕТВИ 47
-> /ИСПОЛНЕНИЕ/ ВЕТВЛЕНИЯ IF
EMIT C-> ВЫВЕСТИ НА ТЕРМИНАЛ ЛИТЕРУ С КОДОМ С 6
EMPTY-BUFFERS + -> ОЧИСТИТЬ БУФЕРНЫЙ ПУЛ 25
ENCLOSE * A,C->A,N1,N2,N3 ВВОД СЛОВА 27
ERASE + A,U-> ЗАСЛАТЬ НУЛИ В U БАЙТОВ ПО АДРЕСУ А 22
ERCOND8 M СИГНАЛИЗАЦИЯ О НЕПРАВИЛЬНОМ ЗНАЧЕНИИ 4
EXECUTE CFA-> ИСПОЛНИТЬ СЛОВО ПО CFA ЕГО СТАТЬИ 11
EXIT K -> ЗАКОНЧИТЬ ИСПОЛНЕНИЕ ТЕКУЩЕГО ОПРЕДЕЛЕНИЯ 4
EXIT# M ТОЧКА "EXIT" АДРЕСНОГО ИНТЕРПРЕТАТОРА 4
EXPECT A,+N-> ВВЕСТИ С ТЕРМИНАЛА +N ЛИТЕР ПО 40
АДРЕСУ А; В ПЕРЕМЕННУЮ SPAN ЗАСЛАТЬ
ФАКТИЧЕСКОЕ ЧИСЛО ВВЕДЕННЫХ ЛИТЕР;
ЛИТЕРЫ НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ
FENCE *П ->A ПЕРЕМЕННАЯ - ГРАНИЦА ЗАЩИТЫ ОТ FORGET 7
FILL A,U,C-> ЗАСЛАТЬ С В U БАЙТОВ ПО АДРЕСУ А 22
FIND T->A,N ИСКАТЬ СЛОВО Т В ТЕКУЩЕМ КОНТЕКСТЕ 35
ЕСЛИ N=0, ТО А=Т И СЛОВО НЕ НАЙДЕНО;
ИНАЧЕ А=CFA НАЙДЕННОЙ СТАТЬИ, N=1 ДЛЯ
СЛОВ "IMMEDIATE" И N=-1 ДЛЯ ОСТАЛЬНЫХ
FIRST * ->A КОНСТАНТА - АДРЕС НАЧАЛА БУФЕРНОГО ПУЛА 2
FIRST# М ЗНАЧЕНИЕ КОНСТАНТЫ FIRST 2
FL# A ПОЛЕ СВЯЗИ ДЛЯ СПИСКОВ В ПОЛЕ ПАРАМЕТРОВ 33
СЛОВАРНОЙ СТАТЬИ СЛОВА FORTH
FLUSH -> ЗАПИСАТЬ БЛОКИ НА ДИСК И ОЧИСТИТЬ ПУЛ 26
FORGET -> УДАЛИТЬ СЛОВАРНУЮ СТАТЬЮ СЛЕДУЮЩЕГО СЛОВА 45
И ВСЕХ СЛОВ, ОПРЕДЕЛЕННЫХ ПОСЛЕ НЕГО
FORTH -> УСТАНОВИТЬ CONTEXT НА НАЧАЛЬНЫЙ СПИСОК 33
FORTH-83 -> СТАНДАРТНЫЙ КОНТЕКСТ ФОРТ-СИСТЕМЫ 33
FORTH# A PFA+2 ДЛЯ СЛОВАРНОЙ СТАТЬИ FORTH 33
GOTO M ПОДПРОГРАММА ПЕРЕХОДА ПО ССЫЛКЕ 4
H. + U-> НАПЕЧАТАТЬ U НА ТЕРМИНАЛЕ 38
В 16-НОЙ СИСТЕМЕ И ДАТЬ ПРОБЕЛ
HERE ->A ДАТЬ АДРЕС ТЕКУЩЕЙ ВЕРШИНЫ СЛОВАРЯ 10
HEX + -> ПЕРЕЙТИ В ШЕСТНАДЦАТИРИЧНУЮ СИСТЕМУ 22
HLD *П ->A ПЕРЕМЕННАЯ - ПОЗИЦИЯ ПОСЛЕДНЕЙ ЛИТЕРЫ, 8
ПЕРЕНЕСЕННОЙ В БУФЕР PAD ПО HOLD
HOLD C-> ПЕРЕНЕСТИ ЛИТЕРУ С НА ВЕРШИНУ БУФЕРА PAD 37
I K ->W ТЕКУЩЕЕ ЗНАЧЕНИЕ W СЧЕТЧИКА ЦИКЛА DO 24
I' +K ->W КОНЕЧНОЕ ЗНАЧЕНИЕ W СЧЕТЧИКА ЦИКЛА DO 24
ID. * NFA-> НАПЕЧАТАТЬ ИМЯ СЛОВА И ДАТЬ ПРОБЕЛ 31
IF HK ->A,2 /КОМПИЛЯЦИЯ/ НАЧАЛО ВЕТВЛЕНИЯ IF 47
F-> /ИСПОЛНЕНИЕ/
IMMEDIATE -> ДАТЬ ПРИЗНАК IMMEDIATE ПОСЛЕДНЕЙ 31
СОЗДАННОЙ СЛОВАРНОЙ СТАТЬЕ
INDEX + N1,N2-> РАСПЕЧАТАТЬ НАЧАЛЬНУЮ СТРОКУ ЭКРАНОВ 46
С НОМЕРАМИ ОТ N1 ДО N2
INTERPRET + -> ИНТЕРПРЕТИРОВАТЬ ВХОДНОЙ ПОТОК 40
IPUSH M ПОДПРОГРАММА - ПОМЕСТИТЬ НА СТЕК УКАЗАТЕЛЬ 4
ИНТЕРПРЕТАЦИИ И ОБОЙТИ СЛЕДУЮЩУЮ СТРОКУ
J K ->W ТЕКУЩЕЕ ЗНАЧЕНИЕ W СЧЕТЧИКА ВТОРОГО 24
ОБЪЕМЛЮЩЕГО ЦИКЛА DO
KEY ->C ВВЕСТИ ЛИТЕРУ С ТЕРМИНАЛА 6
L>NAME * LFA->NFA ПЕРЕЙТИ ОТ ПОЛЯ СВЯЗИ К ПОЛЮ ИМЕНИ 30
LATEST * ->NFA ДАТЬ NFA ПОСЛЕДНЕЙ СОЗДАННОЙ СТАТЬИ 31
LEAVE K -> ЗАКОНЧИТЬ ИСПОЛНЕНИЕ ЦИКЛА DO 24
LENGMASK M ПОЛНОЕ СЛОВО - МАСКА ДЛЯ УДАЛЕНИЯ 2
БИТА IMMEDIATE ИЗ БАЙТА ДЛИНЫ
LENG1MSK M ПОЛНОЕ СЛОВО - МАСКА ДЛЯ УДАЛЕНИЯ 2
БИТОВ IMMEDIATE И SMUDGE ИЗ БАЙТА ДЛИНЫ
LENG2MSK M ПОЛНОЕ СЛОВО - МАСКА ДЛЯ ВЫСЕЧЕНИЯ 2
ЧИСТОЙ ДЛИНЫ ИЗ БАЙТА ДЛИНЫ С ПРИЗНАКАМИ
LHRW12 M ПОДПРОГРАММА ЗАГРУЗКИ ДВУХ ВЕРХНИХ ЗНАЧЕНИЙ 4
НА СТЕКЕ В РЕГИСТРЫ RW2 (ВЕРХНЕЕ) И RW1
LIMIT * ->A КОНСТАНТА - АДРЕС КОНЦА БУФЕРНОГО ПУЛА 2
LIMIT# M ЗНАЧЕНИЕ КОНСТАНТЫ LIMIT 2
LINK> * LFA->CFA ПЕРЕЙТИ ОТ ПОЛЯ СВЯЗИ К ПОЛЮ КОДА 30
LIST + N-> РАСПЕЧАТАТЬ НА ТЕРМИНАЛЕ ЭКРАН N 46
LIT *K ->W ПОМЕСТИТЬ НА СТЕК СЛЕДУЮЩИЙ КОД 23
LIT" *K ->T ДАТЬ АДРЕС СКОМПИЛИРОВАННОЙ СТРОКИ И 28
ПРОДОЛЖИТЬ ИНТЕРПРЕТАЦИЮ, ОБОЙДЯ ЕЕ
LITERAL H W-> /КОМПИЛЯЦИЯ/ СКОМПИЛИРОВАТЬ W КАК 23
->W /ИСПОЛНЕНИЕ/ ЛИТЕРАЛ
LOAD +N-> ИНТЕРПРЕТИРОВАТЬ ЭКРАН С НОМЕРОМ +N 41
LOOP HK A1,A2,3-> /КОМПИЛЯЦИЯ/ КОНЕЦ ЦИКЛА"DO LOOP" 47
-> /ИСПОЛНЕНИЕ/
LRW1 M ПОДПРОГРАММА ЗАГРУЗКИ ДВОЙНОГО ЗНАЧЕНИЯ НА 4
ВЕРШИНЕ СТЕКА В РЕГИСТР RW1
LRW12 M ПОДПРОГРАММА ЗАГРУЗКИ ДВУХ ВЕРХНИХ ДВОЙНЫХ 4
ЗНАЧЕНИЙ НА СТЕКЕ В РЕГИСТРЫ RW2 (ВЕРХНЕЕ) И RW1
M* * N1,N2->D ПРОИЗВЕДЕНИЕ ДВОЙНОЙ ДЛИНЫ N1 И N2 18
M/ * D,N1->N2,N3 ОСТАТОК N2 И ЧАСТНОЕ N3 ОТ 18
ДЕЛЕНИЯ ДВОЙНОГО D НА ОДИНАРНОЕ N1
M/MOD * UD1,U2->U3,UD4 ОСТАТОК U3 И ДВОЙНОЕ 16
ЧАСТНОЕ UD4 ОТ ДЕЛЕНИЯ UD1 НА U2
MAX N1,N2->N3 БОЛЬШЕЕ ИЗ ЧИСЕЛ N1 И N2 22
MIN N1,N2->N3 МЕНЬШЕЕ ИЗ ЧИСЕЛ N1 И N2 22
MOD N1,N2->N3 ОСТАТОК ОТ ДЕЛЕНИЯ N1 НА N2 18
MSG * ->A КОНСТАНТА - АДРЕС НАЧАЛА БУФЕРА MSG 2
MSG# M ЗНАЧЕНИЕ КОНСТАНТЫ MSG 2
N>LINK * NFA->LFA ПЕРЕЙТИ ОТ ПОЛЯ ИМЕНИ К ПОЛЮ СВЯЗИ 30
NAME> * NFA->CFA ПЕРЕЙТИ ОТ ПОЛЯ ИМЕНИ К ПОЛЮ КОДА 30
NEGATE W1->W2 РЕЗУЛЬТАТ ВЫЧИТАНИЯ W1 ИЗ НУЛЯ 17
NEXT M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР 1
NEXT1 M ПРОДОЛЖЕНИЕ АДРЕСНОЙ ИНТЕРПРЕТАЦИИ ОТ 1
ФОРТ-АДРЕСА В РЕГИСТРЕ 14
NOT W1->W2 ПОРАЗРЯДНОЕ ИНВЕРТИРОВАНИЕ 13
NUMBER + T->WD ПРЕОБРАЗОВАТЬ СТРОКУ Т В ЧИСЛО WD 39
OFFSET +П ->A ПЕРЕМЕННАЯ - ДОБАВКА К НОМЕРУ БЛОКА 8
OR W1,W2->W3 ПОРАЗРЯДНОЕ ЛОГИЧЕСКОЕ "ИЛИ" 13
OVER W1,W2->W1,W2,W1 ПРОДУБЛИРОВАТЬ ВТОРОЕ СВЕРХУ 9
PAD ->A ДАТЬ АДРЕС ТЕКУЩЕЙ ВЕРШИНЫ БУФЕРА PAD 37
PICK WN,...,W0,+N->WN,...,W0,WN ПРОДУБЛИРОВАТЬ 12
N-Е СВЕРХУ ЗНАЧЕНИЕ
POP M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР СО СНЯТИЕМ 3
ВЕРХНЕГО ЗНАЧЕНИЯ С ВЕРШИНЫ СТЕКА
POPPUT1 M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР СО СНЯТИЕМ 3
ВЕРХНЕГО И ЗАМЕНОЙ ПРЕДЫДУЩЕГО НА ЗНАЧЕНИЕ
ИЗ РЕГИСТРА RW1
PREV *C ->A ПЕРЕМЕННАЯ - ТЕКУЩИЙ БЛОЧНЫЙ БУФЕР 7
PUSHRW1 M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР С ПОМЕЩЕНИЕМ 3
ЗНАЧЕНИЯ ИЗ РЕГИСТРА RW1 НА ВЕРШИНУ СТЕКА
PUSH2RW1 M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР С ЗАМЕНОЙ 3
ВЕРХНЕГО НА ДВОЙНОЕ ЗНАЧЕНИЕ ИЗ РЕГИСТРА RW1
PUTRW1 M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР С ЗАМЕНОЙ 3
ВЕРХНЕГО ЗНАЧЕНИЯ НА ЗНАЧЕНИЕ ИЗ RW1
QUERY + -> ВВЕСТИ С ТЕРМИНАЛА ЛИТЕРЫ В БУФЕР TIB; 40
ЧИСЛО ВВЕДЕННЫХ ЛИТЕР ЗАСЛАТЬ В #TIB
QUIT -> СБРОСИТЬ СТЕК ВОЗВРАТОВ, ПЕРЕЙТИ В РЕЖИМ 28
ИСПОЛНЕНИЯ И ПРОДОЛЖИТЬ ИНТЕРПРЕТАЦИЮ
R. * -> РАСПЕЧАТАТЬ НА ТЕРМИНАЛЕ СТЕК ВОЗВРАТОВ 42
R> K ->W ПЕРЕНЕСТИ ЗНАЧЕНИЕ СО СТЕКА ВОЗВРАТОВ 9
R@ K ->W СКОПИРОВАТЬ ВЕРШИНУ СТЕКА ВОЗВРАТОВ 9
RBLK * A,+N-> ПРОЧЕСТЬ ЭКРАН +N ПО АДРЕСУ A 6
RDROP *K -> СНЯТЬ ЗНАЧЕНИЕ СО СТЕКА ВОЗВРАТОВ 9
RECURSE +HK -> СКОМПИЛИРОВАТЬ ОБРАЩЕНИЕ К КОМПИЛИРУЕМОМУ 31
В ДАННЫЙ МОМЕНТ ОПРЕДЕЛЕНИЮ
REMEMBER + -> ОПРЕДЕЛИТЬ СЛОВО, ИСПОЛНЕНИЕ КОТОРОГО 45
УНИЧТОЖАЕТ ВСЕ ПОСЛЕДУЮЩИЕ ОПРЕДЕЛЕНИЯ
REPEAT HK A1,1,A2,2-> /КОМПИЛЯЦИЯ/ КОНЕЦ ЦИКЛА 47
-> /ИСПОЛНЕНИЕ/ BEGIN WHILE REPEAT
ROLL WN,WN-1,...,W0,+N->WN-1,...,W0,WN ЦИКЛИЧЕСКИ 12
ПЕРЕСТАВИТЬ N ВЕРХНИХ ЗНАЧЕНИЙ
ROT W1,W2,W3->W2,W3,W1 ПЕРЕСТАВИТЬ ТРИ 9
ВЕРХНИХ ЗНАЧЕНИЯ ПО ЧАСОВОЙ СТРЕЛКЕ
RP! * A-> УСТАНОВИТЬ УКАЗАТЕЛЬ ВЕРШИНЫ СТЕКА 20
ВОЗВРАТОВ НА А
RP@ * ->A АДРЕС ТЕКУЩЕЙ ВЕРШИНЫ СТЕКА ВОЗВРАТОВ 20
R0 *C ->A ПЕРЕМЕННАЯ - АДРЕС ДНА СТЕКА ВОЗВРАТОВ 7
S. * -> РАСПЕЧАТАТЬ НА ТЕРМИНАЛЕ СТЕК ДАННЫХ 42
S>D * N->D РАСШИРИТЬ N ДО ЧИСЛА ДВОЙНОЙ ДЛИНЫ D 14
SAVE-BUFFERS -> ЗАПИСАТЬ НА ДИСК ВСЕ ИСПРАВЛЕННЫЕ БЛОКИ 26
SCR +П ->A ПЕРЕМЕННАЯ - НОМЕР ЭКРАНА В LIST 8
SIGN N-> ДОБАВИТЬ В ФОРМАТНУЮ СТРОКУ ЗНАК 37
МИНУС, ЕСЛИ ЧИСЛО N ОТРИЦАТЕЛЬНО
SMUDGE * -> УСТАНОВИТЬ В ЕДИНИЦУ ФЛАГ SMUDGE 31
В ПОСЛЕДНЕЙ СОЗДАННОЙ СТАТЬЕ
SNAPSTK * A1,A2,A3-> РАСПЕЧАТКА СТЕКА ОТ А1 ДО А2 42
С ТЕКСТОМ А3; ВОЗВРАТ "ЧЕРЕЗ ОДИН"
SP! * A-> УСТАНОВИТЬ УКАЗАТЕЛЬ ВЕРШИНЫ СТЕКА НА А 20
SP@ + ->A АДРЕС ТЕКУЩЕЙ ВЕРШИНЫ СТЕКА ДАННЫХ 20
SPACE -> НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ ПРОБЕЛ 23
SPACES +N-> НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ +N ПРОБЕЛОВ 23
SPAN П ->A ПЕРЕМЕННАЯ ДЛЯ РЕЗУЛЬТАТА EXPECT 8
STATE П ->A ПЕРЕМЕННАЯ С СОСТОЯНИЕМ ТЕКСТОВОГО 8
ИНТЕРПРЕТАТОРА: "ИСТИНА" - КОМПИЛЯЦИЯ
SWAP W1,W2->W2,W1 ОБМЕНЯТЬ МЕСТАМИ 2 ВЕРХНИХ 9
S0 +П ->A ПЕРЕМЕННАЯ - АДРЕС ДНА СТЕКА ДАННЫХ 7
TEMP M РАБОЧАЯ ОБЛАСТЬ ИЗ ДВУХ ДВОЙНЫХ СЛОВ 2
THEN HK A,2-> /КОМПИЛЯЦИЯ/ КОНЕЦ ВЕТВЛЕНИЯ IF 47
-> /ИСПОЛНЕНИЕ/
THRU + +N1,+N2-> ИНТЕРПРЕТИРОВАТЬ ЭКРАНЫ С НОМЕРАМИ 41
ОТ +N1 ДО +N2 ВКЛЮЧИТЕЛЬНО
TIB ->A АДРЕС ВХОДНОГО ТЕКСТОВОГО БУФЕРА 2
ДЛЯ ВВОДА С ТЕРМИНАЛА
TIB# M ФОРТ-АДРЕС НАЧАЛА БУФЕРА TIB 2
TYPE A,+N-> НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ +N ЛИТЕР 6
ОТ АДРЕСА А
U. U-> НАПЕЧАТАТЬ U НА ТЕРМИНАЛЕ КАК 38
ЧИСЛО БЕЗ ЗНАКА
U.R + U,+N-> НАПЕЧАТАТЬ НА ТЕРМИНАЛЕ ЧИСЛО U 38
В ПОЛЕ ДЛИНЫ +N СПРАВА
U< U1,U2->F F "ИСТИНА", ЕСЛИ U1 МЕНЬШЕ U2 16
UM* U1,U2->UD ПРОИЗВЕДЕНИЕ UD ЧИСЕЛ U1 И U2 16
UM/MOD UD,U1->U2,U3 ОСТАТОК U2 И ЧАСТНОЕ U3 ОТ 16
ДЕЛЕНИЯ UD НА U1
UNSMUDGE * -> УСТАНОВИТЬ В НУЛЬ ФЛАГ SMUDGE 31
В ПОСЛЕДНЕЙ СОЗДАННОЙ СТАТЬЕ
UNTIL HK A,1-> /КОМПИЛЯЦИЯ/ КОНЕЦ ЦИКЛА "BEGIN UNTIL" 47
F-> /ИСПОЛНЕНИЕ/
UPDATE -> ОТМЕТИТЬ ТЕКУЩИЙ БЛОК КАК ИЗМЕНЕННЫЙ 25
USE *C ->A ПЕРЕМЕННАЯ - СЛЕДУЮЩИЙ БЛОЧНЫЙ БУФЕР 7
VARIABLE -> ОПРЕДЕЛИТЬ СЛЕДУЮЩЕЕ СЛОВО КАК 32
ПЕРЕМЕННУЮ С НАЧАЛЬНЫМ ЗНАЧЕНИЕМ НУЛЬ
VOC-LINK *П ->A ПЕРЕМЕННАЯ - АДРЕС ПОЛЯ СВЯЗИ ПОСЛЕДНЕГО 33
СОЗДАННОГО ПО VOCABULARY СПИСКА СЛОВ
VOCABULARY -> ОПРЕДЕЛИТЬ СЛЕДУЮЩЕЕ СЛОВО КАК 33
СПИСОК НАД ТЕКУЩИМ ЗНАЧЕНИЕМ CURRENT
VOCABULARY# A НАЧАЛО ИСПОЛНИТЕЛЬНОЙ ЧАСТИ VOCABULARY 33
VOCS * -> РАСПЕЧАТАТЬ НА ТЕРМИНАЛЕ ТЕКУЩИЙ 43
ПОРЯДОК ПОИСКА СЛОВ В СЛОВАРЕ
WBLK * A,+N-> ЗАПИСАТЬ ЭКРАН +N ИЗ АДРЕСА А 6
WHILE HK 1->A,2 /КОМПИЛЯЦИЯ/ ВЕТВЛЕНИЕ WHILE В 47
F-> /ИСПОЛНЕНИЕ/ ЦИКЛЕ "BEGIN WHILE REPEAT"
WIDTH * ->N КОНСТАНТА - МАКСИМАЛЬНАЯ ДЛИНА ИМЕНИ 7
WORD C->T ВВЕСТИ СЛОВО ДО СТОП-ЛИТЕРЫ С; 27
ДАТЬ ЕГО АДРЕС КАК СТРОКИ СО СЧЕТЧИКОМ
WORDS + -> РАСПЕЧАТАТЬ НА ТЕРМИНАЛЕ ИМЕНА СЛОВ 44
ИЗ СПИСКА CONTEXT
XOR W1,W2->W3 ПОРАЗРЯДНОЕ "ИСКЛЮЧАЮЩЕЕ ИЛИ" 13
0 * ->0 КОНСТАНТА НУЛЬ (ЗНАЧЕНИЕ "ЛОЖЬ") 7
0< N->F F "ИСТИНА", ЕСЛИ N ОТРИЦАТЕЛЬНО 13
0<> * W->F F "ИСТИНА", ЕСЛИ W НЕ НУЛЬ 19
0! * A-> ЗАСЛАТЬ НУЛЬ ПО АДРЕСУ А 11
0= W->F F "ИСТИНА", ЕСЛИ W РАВНО НУЛЮ 13
1+ W1->W2 УВЕЛИЧИТЬ W1 НА 1 17
1+! + A-> УВЕЛИЧИТЬ НА 1 ЗНАЧЕНИЕ ПО АДРЕСУ А 17
1- W1->W2 УМЕНЬШИТЬ W1 НА 1 17
2+ W1->W2 УВЕЛИЧИТЬ W1 НА 2 17
2! WD,A-> ЗАСЛАТЬ ДВОЙНОЕ WD ПО АДРЕСУ A 20
2* + W1->W2 АРИФМЕТИЧЕСКИЙ СДВИГ ВЛЕВО НА 1 20
2- W1->W2 УМЕНЬШИТЬ W1 НА 2 17
2/ W1->W2 АРИФМЕТИЧЕСКИЙ СДВИГ ВПРАВО НА 1 20
2@ A->WD ДАТЬ ДВОЙНОЕ ЗНАЧЕНИЕ ПО АДРЕСУ А 20
2CONSTANT WD-> ОПРЕДЕЛИТЬ СЛЕДУЮЩЕЕ СЛОВО КАК 32
КОНСТАНТУ СО ЗНАЧЕНИЕМ WD
2DROP WD-> СНЯТЬ ВЕРХНЕЕ ДВОЙНОЕ ЗНАЧЕНИЕ 12
2DUP WD->WD,WD ПРОДУБЛИРОВАТЬ ДВОЙНОЕ ЗНАЧЕНИЕ 12
2LIT *K ->WD ПОМЕСТИТЬ НА СТЕК СЛЕДУЮЩИЕ 2 КОДА 23
2LITERAL *H WD-> /КОМПИЛЯЦИЯ/ СКОМПИЛИРОВАТЬ WD КАК 23
->WD /ИСПОЛНЕНИЕ/ ЛИТЕРАЛ
2OVER WD1,WD2->WD1,WD2,WD1 ПРОДУБЛИРОВАТЬ ВТОРОЕ 12
ДВОЙНОЕ СВЕРХУ
2POP M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР СО СНЯТИЕМ 3
ДВОЙНОГО ЗНАЧЕНИЯ С ВЕРШИНЫ СТЕКА
2POPPUT1 M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР СО СНЯТИЕМ 3
ДВОЙНОГО ВЕРХНЕГО ЗНАЧЕНИЯ СО СТЕКА И
ЗАМЕНОЙ ПРЕДЫДУЩЕГО ДВОЙНОГО НА 4-БАЙТНОЕ
ЗНАЧЕНИЕ ИЗ РЕГИСТРА RW1
2PUSHRW1 M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР С ПОМЕЩЕНИЕМ 3
ДВОЙНОГО ЗНАЧЕНИЯ ИЗ RW1 НА ВЕРШИНУ СТЕКА
2PUTRW1 M ВХОД В АДРЕСНЫЙ ИНТЕРПРЕТАТОР С ЗАМЕНОЙ 3
ДВОЙНОГО ВЕРХНЕГО ЗНАЧЕНИЯ НА 4-БАЙТНОЕ
ЗНАЧЕНИЕ ИЗ РЕГИСТРА RW1
2ROT WD1,WD2,WD3->WD2,WD3,WD1 ПЕРЕСТАВИТЬ ТРИ 12
ВЕРХНИХ ДВОЙНЫХ ПО ЧАСОВОЙ СТРЕЛКЕ
2SWAP WD1,WD2->WD2,WD1 ОБМЕНЯТЬ МЕСТАМИ ДВА 12
ВЕРХНИХ ДВОЙНЫХ ЗНАЧЕНИЯ
2VARIABLE -> ОПРЕДЕЛИТЬ СЛЕДУЮЩЕЕ СЛОВО КАК ПЕРЕМЕННУЮ 32
ДВОЙНОЙ ДЛИНЫ С НАЧАЛЬНЫМ ЗНАЧЕНИЕМ НУЛЬ
ФОРТ-СИСТЕМА * -> ТЕКСТОВЫЙ ИНТЕРПРЕТАТОР ФОРТ-СИСТЕМЫ 40
Экран номер 1
( 09.09.86 НАЧАЛО МОДЕЛИ ФОРТ-СИСТЕМЫ )
DECIMAL ( КОНСТАНТЫ ПЕРИОДА КОМПИЛЯЦИИ )
128 CONSTANT &IFLAG ( ПРИЗНАК "IMMEDIATE")
32 CONSTANT &SFLAG ( ПРИЗНАК "SMUDGE")
31 CONSTANT &LENG ( МАСКА ДЛЯ ВЫСЕЧЕНИЯ ДЛИНЫ)
&SFLAG 256 * 64 + CONSTANT &DWORD ( ФИКТИВНОЕ ИМЯ )
( НАЧАЛЬНОЕ ЯДРО С АДРЕСАЦИЕЙ ОТ РЕГИСТРА RFORTH)
START-CODE *, RFORTH USING, ( АДРЕСНЫЙ ИНТЕРПРЕТАТОР)
M: NEXT 14 0 (, RI RFORTH LH, RI RTWO AR,
M: NEXT1 14 RMASK NR, 15 0 (, 14 RFORTH LH,
15 RMASK NR, 15 RFORTH AR, 14 RTWO AR, 15 BR,
Экран номер 2
( 09.09.86 СИСТЕМНЫЕ ПЕРЕМЕННЫЕ И КОНСТАНТЫ )
CONST MSG M: MSG# 0 H, ( АДРЕС НАЧАЛА БУФЕРА MSG)
CONST FIRST M: FIRST# 0 H, ( АДРЕС НАЧАЛА ПУЛА)
CONST LIMIT M: LIMIT# 0 H, ( АДРЕС КОНЦА ПУЛА)
CONST TIB M: TIB# 0 H, ( АДРЕС НАЧАЛА БУФЕРА TIB)
4 ALIGN
M: LENGMASK 255 &IFLAG - S>D F, ( БАЙТ ДЛИНЫ БЕЗ IMMEDIATE)
M: LENG1MSK 255 &IFLAG - &SFLAG - S>D F, ( БЕЗ IMMD И SMDG)
M: LENG2MSK &LENG S>D F, ( БАЙТ ДЛИНЫ С ЧИСТОЙ ДЛИНОЙ)
8 ALIGN
M: TEMP 16 ALLOT ( РАБОЧАЯ ОБЛАСТЬ)
Экран номер 3
( 09.09.86 ДОПОЛНИТЕЛЬНЫЕ ВХОДЫ В АДРЕСНЫЙ ИНТЕРПРЕТАТОР)
M: DOES# RI RPUSH, RI 4 (, 15 LA, RI RFORTH SR,
A: CREATE# RW1 14 LR, ( ПОМЕСТИТЬ PFA СТАТЬИ)
M: PUSHRW1 RSTACK RTWO SR, ( ПОМЕСТИТЬ ЗНАЧЕНИЕ ИЗ RW1)
M: PUTRW1 RW1 PUT, RNEXT BR, ( ЗАМЕНИТЬ ВЕРХНЕЕ)
M: 2POP RSTACK RTWO AR, ( СНЯТЬ ДВА ВЕРХНИХ)
M: POP RSTACK RTWO AR, RNEXT BR, ( СНЯТЬ ВЕРХНЕЕ)
M: POPPUT1 RSTACK RTWO AR, ( СНЯТЬ ВЕРХНЕЕ И ЗАМЕНИТЬ)
RW1 PUT, RNEXT BR, ( ЗНАЧЕНИЕМ ИЗ RW1)
M: 2PUSHRW1 RSTACK RTWO SR, ( ПОЛОЖИТЬ ДВОЙНОЕ НА СТЕК)
M: PUSH2RW1 RSTACK RTWO SR, ( ЗАМЕНИТЬ ВЕРХНЕЕ НА ДВОЙНОЕ)
M: 2PUTRW1 RW1 TEMP ST, ( ЗАМЕНИТЬ ДВОЙНОЕ ВЕРХНЕЕ)
FIRST (, 4 ), TEMP MVC, RNEXT BR,
M: 2POPPUT1 RSTACK RTWO AR, RSTACK RTWO AR, 2PUTRW1 B,
Экран номер 4
( 09.09.86 ВСПОМОГАТЕЛЬНЫЕ ПОДПРОГРАММЫ: ВОЗВРАТ В РЕГ.14)
M: LHRW12 RW1 SECOND LH, RW2 PULL, 14 BR,
M: LRW1 TEMP (, 4 ), FIRST MVC, RW1 TEMP L, 14 BR,
M: LRW12 TEMP (, 8 ), FIRST MVC, RW1 TEMP 4 +(, L,
RW2 TEMP L, 14 BR,
M: GOTO 14 0 (, 0 14 LH, NEXT1 B,
M: IPUSH RI PUSH, RW2 RW2 SR, RW2 0 (, RI RFORTH IC,
RI 2 (, RI RW2 LA, 14 BR,
CODE EXIT
M: EXIT# RI RPOP, RI RMASK NR, RNEXT BR, END-CODE
M: ERCOND8 14 GOTO BAL, ] ABORT8 [
Экран номер 5
( 09.09.86 BRANCH ?BRANCH (LOOP/ (+LOOP/ )
CODE BRANCH M: BRANCH#
RI 0 (, RI RFORTH LH, RI RMASK NR, RNEXT BR,
CODE ?BRANCH RW1 POP, RW1 RW1 LTR, BRANCH# BZ,
RI RTWO AR, RNEXT BR,
CODE (LOOP) RW1 1 LA, 1 =F B,
CODE (+LOOP) RW1 POP,
1 =H 0 RFIRST LH, 0 RSECOND SH, 0 RMASK NR,
0 RW1 AR, RW1 RFIRST AH, RW1 RFIRST STH,
0 RMASK CLR, BRANCH# BNH, RRET 6 (, 0 RRET LA,
RI RTWO AR, RNEXT BR, END-CODE
Экран номер 6
( 09.09.86 KEY CR EMIT TYPE (EXPECT/ RBLK WBLK )
( СЛЕДУЮЩИЕ ОПРЕДЕЛЕНИЯ ДАЮТ ТОЛЬКО ИМЕНА ПРОЦЕДУР)
CODE KEY ( ->C ВВЕСТИ ЛИТЕРУ С ТЕРМИНАЛА) END-CODE
CODE CR ( -> ВЫВЕСТИ ПЕРЕВОД СТРОКИ ) END-CODE
CODE EMIT ( C-> ВЫВЕСТИ ЛИТЕРУ С КОДОМ С НА ТЕРМИНАЛ)
END-CODE
CODE TYPE ( A,N-> ВЫВЕСТИ НА ТЕРМИНАЛ N ЛИТЕР ПО АДРЕСУ А)
END-CODE
CODE (EXPECT) ( A,N1->A,N2 ВВЕСТИ С ТЕРМИНАЛА НЕ БОЛЕЕ
N1 ЛИТЕР /ДО ПЕРЕВОДА СТРОКИ/ В БУФЕР ПО АДРЕСУ А;
N2 - ФАКТИЧЕСКОЕ ЧИСЛО ВВЕДЕННЫХ ЛИТЕР) END-CODE
CODE RBLK ( A,N-> ПРОЧИТАТЬ ЭКРАН N В БУФЕР А) END-CODE
CODE WBLK ( A,N-> ЗАПИСАТЬ ЭКРАН N ИЗ БУФЕРА А) END-CODE
Экран номер 7
( 09.09.86 КОНСТАНТЫ И СИСТЕМНЫЕ ПЕРЕМЕННЫЕ )
64 CONSTANT BL ( КОД ПРОБЕЛА)
1024 CONSTANT B/BUF ( ДЛИНА БУФЕРА ДЛЯ ЭКРАНА)
&LENG CONSTANT WIDTH ( МАКСИМАЛЬНАЯ ДЛИНА СЛОВА )
0 CONSTANT 0 ( ЧИСЛО НОЛЬ)
VARIABLE USE ( ТЕКУЩИЙ БУФЕР В ПУЛЕ)
VARIABLE PREV ( СЛЕДУЮЩИЙ БУФЕР В ПУЛЕ)
VARIABLE S0 ( АДРЕС ДНА СТЕКА ДАННЫХ)
VARIABLE R0 ( АДРЕС ДНА СТЕКА ВОЗВРАТОВ)
VARIABLE FENCE ( ГРАНИЦА ЗАЩИТЫ ОТ "FORGET")
VARIABLE CONTEXT ( ТЕКУЩИЙ СПИСОК - НАЧАЛО ПОИСКА)
VARIABLE CURRENT ( ТЕКУЩИЙ СПИСОК - КУДА ДОБАВЛЯЕМ)
Экран номер 8
( 09.09.86 СИСТЕМНЫЕ ПЕРЕМЕННЫЕ - ОКОНЧАНИЕ)
VARIABLE OFFSET ( ДОБАВКА К НОМЕРУ ЭКРАНА)
VARIABLE BASE ( ОСНОВАНИЕ СИСТЕМЫ СЧИСЛЕНИЯ)
VARIABLE STATE ( СОСТОЯНИЕ ТЕКСТОВОГО ИНТЕРПРЕТАТОРА)
VARIABLE DPL ( ПОЗИЦИЯ ДЕСЯТИЧНОЙ ТОЧКИ В ЧИСЛЕ)
VARIABLE CSP ( ДЛЯ КОНТРОЛЬНОГО ХРАНЕНИЯ УКАЗАТЕЛЯ)
VARIABLE HLD ( УКАЗАТЕЛЬ ВЕРШИНЫ БУФЕРА "PAD")
VARIABLE BLK ( НОМЕР ВХОДНОГО ЭКРАНА ИЛИ НОЛЬ)
VARIABLE >IN ( ПОЗИЦИЯ ОЧЕРЕДНОЙ ЛИТЕРЫ НА ВХОДЕ)
VARIABLE SPAN ( ЧИСЛО ЛИТЕР, ВВЕДЕННЫХ ПО "EXPECT")
VARIABLE #TIB ( ЧИСЛО ЛИТЕР, ВВЕДЕННЫХ В БУФЕР "TIB")
VARIABLE SCR ( НОМЕР ЭКРАНА, РАСПЕЧАТАННОГО В "LIST")
Экран номер 9
( 31.03.86 DUP ?DUP DROP SWAP OVER >R R> R@ RDROP ROT )
CODE DUP ( W->W,W) RW1 PULL, PUSHRW1 B, END-CODE
: ?DUP ( W->W,W; 0->0 ) DUP IF DUP THEN ;
CODE DROP ( W-> ) RSTACK RTWO AR, RNEXT BR, END-CODE
CODE SWAP ( W1,W2->W2,W1)
14 LHRW12 BAL, RW2 SECOND STH, PUTRW1 B, END-CODE
CODE OVER ( W1,W2->W1,W2,W1) RW1 SECOND LH, PUSHRW1 B, END-CODE
CODE >R ( W-> ) RW1 POP, RW1 RPUSH, RNEXT BR, END-CODE
CODE R> ( ->W) RW1 RPOP, PUSHRW1 B, END-CODE
CODE R@ ( ->W) RW1 RPULL, PUSHRW1 B, END-CODE
CODE RDROP ( -> ) RRET RTWO AR, RNEXT BR, END-CODE
: ROT ( N1,N2,N3->N2,N3,N1 ) >R SWAP R> SWAP ;
Экран номер 10
( 31.03.86 HERE ALLOT ALIGN ALIGNH DP! )
CODE HERE ( ->A ) RW1 RD LR, PUSHRW1 B, END-CODE
CODE ALLOT ( N-> ) RD FIRST AH, POP B, END-CODE
CODE ALIGN ( N-> ) RW1 0 (, RD RFORTH LA,
0 (, RW1 0 MVI, 1 (, 7 RW1 ), 0 (, RW1 MVC,
RW1 PULL, RW2 RW1 LCR, RD RW1 AR, RD 0 BCTR,
RD RW2 NR, POP B, END-CODE
: ALIGNH ( -> ) 2 ALIGN ;
CODE DP! ( A-> ) RD PULL, RD RMASK NR, POP B,
END-CODE
Экран номер 11
( 31.03.86 ! 0! @ C! C@ , C, EXECUTE )
CODE ! ( W,A-> ЗАСЛАТЬ W ПО АДРЕСУ А) 14 LHRW12 BAL,
RW2 RMASK NR, RW1 0 (, RW2 RFORTH STH, 2POP B, END-CODE
: 0! ( A-> ) 0 SWAP ! ;
CODE @ ( A->W РАЗЫМЕНОВАТЬ А) RW2 PULL, RW2 RMASK NR,
RW1 0 (, RW2 RFORTH LH, PUTRW1 B, END-CODE
CODE C@ ( A->C) RW2 PULL, RW2 RMASK NR, RW1 RW1 SR,
RW1 0 (, RW2 RFORTH IC, PUTRW1 B, END-CODE
CODE C! ( C,A-> ) 14 LHRW12 BAL, RW2 RMASK NR,
RW1 0 (, RW2 RFORTH STC, 2POP B, END-CODE
: , ( W-> ) HERE 2 ALLOT ! ;
: C, ( C-> ) HERE 1 ALLOT C! ;
CODE EXECUTE ( CFA-> ) 14 POP, NEXT1 B, END-CODE
Экран номер 12
( 31.03.86 ROLL PICK 2DUP 2DROP 2SWAP 2OVER 2ROT )
CODE ROLL ( WN,WN-1,...,W0,+N->WN-1,...,W0,WN)
RW2 PULL, RW2 RW2 AR, ERCOND8 BM, RW1 SECOND (, RW2 LH,
BEGIN, 0 FIRST (, RW2 LH, 0 SECOND (, RW2 STH,
RW2 RTWO SR, ?NP UNTIL, POPPUT1 B, END-CODE
CODE PICK ( WN,...,W0,+N->WN,...,W0,WN)
RW2 PULL, RW2 RW2 AR, ERCOND8 BM,
RW1 2 (, RW2 RSTACK LH, PUTRW1 B, END-CODE
: 2DUP ( WD->WD,WD) OVER OVER ;
: 2DROP ( WD->) DROP DROP ;
: 2SWAP ( WD1,WD2->WD2,WD1) 3 ROLL 3 ROLL ;
: 2OVER ( WD1,WD2->WD1,WD2,WD1) 3 PICK 3 PICK ;
: 2ROT ( WD1,WD2,WD3->WD2,WD3,WD1) 5 ROLL 5 ROLL ;
Экран номер 13
( 31.03.86 AND OR XOR NOT 0= 0< )
CODE AND ( W1,W2->W3)
14 LHRW12 BAL, RW1 RW2 NR, POPPUT1 B, END-CODE
CODE OR ( W1,W2->W3)
14 LHRW12 BAL, RW1 RW2 OR, POPPUT1 B, END-CODE
CODE XOR ( W1,W2->W3)
14 LHRW12 BAL, RW1 RW2 XR, POPPUT1 B, END-CODE
: NOT ( W1->W2 ) -1 XOR ;
CODE 0= ( W->F) RW1 RW1 SR, RW2 PULL, RW2 RW2 LTR,
PUTRW1 BNZ, RW1 0 BCTR, PUTRW1 B, END-CODE
CODE 0< ( N->F) RW1 RW1 SR, RW2 PULL, RW2 RW2 LTR,
PUTRW1 BNM, RW1 0 BCTR, PUTRW1 B, END-CODE
Экран номер 14
( 31.03.86 S>D DABS DNEGATE D+ D- DU< )
CODE S>D ( N->D ) RW1 PULL, PUSH2RW1 B, END-CODE
CODE DABS ( D1->D2)
14 LRW1 BAL, RW1 RW1 LPR, 2PUTRW1 B, END-CODE
CODE DNEGATE ( WD1->WD2)
14 LRW1 BAL, RW1 RW1 LCR, 2PUTRW1 B, END-CODE
CODE D+ ( WD1,WD2->WD3)
14 LRW12 BAL, RW1 RW2 AR, 2POPPUT1 B, END-CODE
CODE D- ( WD1,WD2->WD3)
14 LRW12 BAL, RW1 RW2 SR, 2POPPUT1 B, END-CODE
CODE DU< ( UD1,UD2->F) 14 LRW12 BAL, 0 0 SR, RW1 RW2 CLR,
?L IF, 0 0 BCTR, THEN, RSTACK 6 (, 0 RSTACK LA,
0 PUT, RNEXT BR, END-CODE
Экран номер 15
( 31.03.86 D/MOD D/ DMOD D0= D= D0< D< D2/ )
CODE D/MOD ( D1,D2->D3,D4) 14 LRW12 BAL, 1 RW1 LR, 0 RW2 LR,
RW1 32 SRDA, RW1 0 DR, 1 0 XR, 1 1 LTR, ?M IF, RW1 0 AR,
RW1 0 BCTR, THEN, RW1 TEMP ST, FIRST 4 +(, 4 ), TEMP MVC,
RW1 RW2 LR, 2PUTRW1 B, END-CODE
: D/ ( D1,D2->D3) D/MOD 2SWAP 2DROP ;
: DMOD ( D1,D2->D3) D/MOD 2DROP ;
: D0= ( WD->F) OR 0= ;
: D= ( WD1,WD2->F) D- D0= ;
: D0< ( D->F) SWAP DROP 0< ;
: D< ( D1,D2->F) D- D0< ;
CODE D2/ ( D1->D2) 14 LRW1 BAL, RW1 1 SRA, PUTRW1 B, END-CODE
Экран номер 16
( 09.09.86 UM* UM/MOD U< M/MOD DMAX DMIN )
CODE UM* ( U1,U2->UD) 14 LHRW12 BAL, RW1 RMASK NR,
RW2 RMASK NR, RW1 RW1 MR, RW1 RW2 LR, 2PUTRW1 B, END-CODE
CODE UM/MOD ( UD,U1->U2,U3) 1 POP, 1 RMASK NR, 14 LRW1 BAL,
RSTACK RTWO SR, RW2 RW1 LR, RW1 RW1 SR, RW1 1 DR,
RW1 FIRST 4 +(, STH, RW1 RW2 LR, POPPUT1 B, END-CODE
CODE U< ( U1,U2->F) RW1 RW1 SR, RW2 PULL, RW2 RMASK NR,
0 SECOND LH, 0 RMASK NR, 0 RW2 CR, POPPUT1 BNL,
RW1 0 BCTR, ( РЕЗУЛЬТАТ "ИСТИНА") POPPUT1 B, END-CODE
: M/MOD ( UD1,U2->U3,UD4) >R 0 R@ UM/MOD R> SWAP >R UM/MOD R> ;
: DMAX ( D1,D2->D3) 2OVER 2OVER D< IF 2SWAP THEN 2DROP ;
: DMIN ( D1,D2->D3) 2OVER 2OVER D< NOT IF 2SWAP THEN 2DROP ;
Экран номер 17
( 31.03.86 NEGATE ABS + - 1+ 1- 2+ 2- +! 1+! )
CODE NEGATE ( W1->W2) RW1 PULL, RW1 RW1 LCR, PUTRW1 B, END-CODE
: ABS ( N1->+N2) S>D DABS DROP ;
CODE + 14 LHRW12 BAL, RW1 RW2 AR, POPPUT1 B, END-CODE
: - ( W1,W2->W3) NEGATE + ;
: 1+ ( W1->W2) 1 + ;
: 1- ( W1->W2) -1 + ;
: 2+ ( W1->W2) 2 + ;
: 2- ( W1->W2) 2 - ;
CODE +! ( W,A->) 14 LHRW12 BAL, RW2 RMASK NR, RW1 0 (,
RW2 RFORTH AH, RW1 0 (, RW2 RFORTH STH, 2POP B, END-CODE
: 1+! ( A->) 1 SWAP +! ;
Экран номер 18
( 03.10.86 M* M/ * /MOD / MOD */MOD */ )
CODE M* ( N1,N2->D)
RW1 SECOND LH, RW1 FIRST MH, 2PUTRW1 B, END-CODE
CODE M/ ( D,N1->N2,N3) 1 POP, 14 LRW1 BAL, RSTACK RTWO SR,
RW1 32 SRDA, 0 RW1 LR, RW1 1 DR, 0 1 XR, 0 0 LTR,
?M IF, RW1 1 AR, RW2 0 BCTR, THEN, RW1 FIRST 4 +(, STH,
RW1 RW2 LR, ( ЧАСТНОЕ) POPPUT1 B, END-CODE
: * ( N1,N2->N3) M* DROP ;
: /MOD ( N1,N2->N3,N4) >R S>D R> M/ ;
: / ( N1,N2->N3) /MOD SWAP DROP ;
: MOD ( N1,N2->N3) /MOD DROP ;
: */MOD ( N1,N2,N3->N4,N5) >R M* R> M/ ;
: */ ( N1,N2,N3->N4) */MOD SWAP DROP ;
Экран номер 19
( 31.03.86 СРАВНЕНИЯ И РАЗРЕШЕНИЯ В ШИТОМ КОДЕ )
: 0<> ( N->F) 0= NOT ;
: = ( W1,W2->F) - 0= ;
: <> ( W1,W2->F) - 0<> ;
: < ( N1,N2->F) - 0< ;
: >MARK ( ->A ) HERE 0 , ;
: >RESOLVE ( A-> ) HERE SWAP ! ;
: <MARK ( ->A ) HERE ;
: <RESOLVE ( A-> ) , ;
Экран номер 20
( 31.03.86 SP@ SP! RP@ RP! 2/ 2* 2@ 2! DEPTH )
CODE SP@ ( ->A)
RW1 RSTACK LR, RW1 RFORTH SR, PUSHRW1 B, END-CODE
CODE SP! ( A->) RSTACK PULL, RSTACK RMASK NR,
RSTACK RFORTH AR, RNEXT BR, END-CODE
CODE RP@ ( ->A) RW1 RRET LR, RW1 RFORTH SR, PUSHRW1 B, END-CODE
CODE RP! ( A->) RRET POP, RRET RMASK NR,
RRET RFORTH AR, RNEXT BR, END-CODE
CODE 2/ ( W1->W2 ) RW1 PULL, RW1 1 SRA, PUTRW1 B, END-CODE
: 2* ( W1->W2 ) DUP + ;
: 2@ ( A->WD) DUP 2+ @ SWAP @ ;
: 2! ( WD,A->) DUP >R ! R> 2+ ! ;
: DEPTH ( ->+N) SP@ S0 @ SWAP - 2/ ;
Экран номер 21
( 31.03.86 CMOVE CMOVE> )
CODE CMOVE ( A1,A2,U->) 14 LHRW12 BAL, RW2 RMASK NR, 2 =F BZ,
RW1 RMASK NR, RW1 RFORTH AR, 1 FIRST 4 +(, LH, 1 RMASK NR,
1 RFORTH AR, 0 256 LA, 1 =F B, BEGIN,
0 (, 256 RW1 ), 0 (, 1 MVC, RW1 0 AR, 1 0 AR,
1 =H RW2 0 SR, ?M UNTIL, RW2 0 BCTR, RW2 0 AR,
?NM IF, RW2 3 =F EX, THEN,
2 =H RSTACK 6 (, 0 RSTACK LA, RNEXT BR,
3 =H 0 (, 1 RW1 ), 0 (, 1 MVC, END-CODE
CODE CMOVE> ( A1,A2,U->) 14 LHRW12 BAL, RW2 RMASK NR, 1 =F BZ,
RW1 RMASK NR, RW1 RFORTH AR, RW1 0 BCTR,
1 FIRST 4 +(, LH, 1 RMASK NR, 1 RFORTH AR, 1 0 BCTR,
DO, 0 0 (, 1 RW2 IC, 0 0 (, RW1 RW2 STC, RW2 LOOPBCT,
1 =H RSTACK 6 (, 0 RSTACK LA, RNEXT BR, END-CODE
Экран номер 22
( 31.03.86 FILL ERASE BLANK COMPILE [ ] MIN MAX HEX DECIMAL)
: FILL ( A,U,C->) SWAP ?DUP IF >R OVER C!
DUP 1+ R> 1- CMOVE EXIT THEN 2DROP ;
: ERASE ( A,U-> ) 0 FILL ;
: BLANK ( A,U-> ) BL FILL ;
: COMPILE ( -> ) R> DUP 2+ >R @ , ;
: [ ( -> ) STATE 0! ; IMMEDIATE
: ] ( -> ) -1 STATE ! ;
CODE MIN ( N1,N2->N3 ) 14 LHRW12 BAL, RW1 RW2 CR,
POP BNH, RW1 RW2 LR, POPPUT1 B, END-CODE
CODE MAX ( N1,N2->N3 ) 14 LHRW12 BAL, RW1 RW2 CR,
POP BNL, RW1 RW2 LR, POPPUT1 B, END-CODE
: HEX ( ->) 16 BASE ! ;
: DECIMAL ( ->) 10 BASE ! ;
Экран номер 23
( 31.03.86 LIT 2LIT LITERAL 2LITERAL SPACE SPACES )
CODE LIT ( ->W ) RW1 0 (, RI RFORTH LH,
RI RTWO AR, PUSHRW1 B, END-CODE
CODE 2LIT ( ->WD ) RW1 4 LA, RSTACK RW1 SR,
RW2 0 (, RI RFORTH LA, FIRST (, 4 ), 0 (, RW2 MVC,
RI RW1 AR, RNEXT BR, END-CODE
: LITERAL ( W->) STATE @ IF COMPILE LIT , THEN ; IMMEDIATE
: 2LITERAL ( WD->) STATE @ IF COMPILE 2LIT , , THEN ; IMMEDIATE
: SPACE ( ->) BL EMIT ;
: SPACES ( +N->) 0 OVER < IF 0 DO SPACE LOOP EXIT THEN DROP ;
Экран номер 24
( 09.09.86 ЦИКЛЫ СО СЧЕТЧИКОМ: (DO/ I I' J LEAVE )
CODE (DO) ( U1,U2-> ) 14 LHRW12 BAL,
1 =H 1 0 (, RI RFORTH LH, 1 RPUSH, RI RTWO AR,
RW1 RPUSH, RW2 RPUSH, 2POP B, END-CODE
CODE I ( ->U ТЕКУЩЕЕ ЗНАЧЕНИЕ СЧЕТЧИКА ЦИКЛА)
RW1 RPULL, PUSHRW1 B, END-CODE
CODE I' ( ->U ВЕРХНЯЯ ГРАНИЦА ЦИКЛА)
RW1 RSECOND LH, PUSHRW1 B, END-CODE
CODE J ( ->U ТЕКУЩЕЕ ЗНАЧЕНИЕ СЧЕТЧИКА 2-ГО ЦИКЛА)
RW1 RFIRST 6 +(, LH, PUSHRW1 B, END-CODE
CODE LEAVE ( ->) RI RFIRST 4 +(, LH, RI RMASK NR,
RRET 6 (, 0 RRET LA, RNEXT BR, END-CODE
Экран номер 25
( 31.03.86 +BUF BUFFER BLOCK EMPTY-BUFFERS UPDATE )
: +BUF ( A1->A2,F ПЕРЕЙТИ К СЛЕДУЮЩЕМУ БУФЕРУ В ПУЛЕ)
B/BUF 4 + + DUP LIMIT = IF DROP FIRST THEN DUP PREV @ - ;
: BUFFER ( +N->A) OFFSET @ + USE @ DUP >R
( ИЩЕМ СВОБОДНЫЙ БУФЕР) BEGIN +BUF UNTIL USE !
R@ @ 0< IF ( УСТАНОВЛЕН ПРИЗНАК "UPDATE")
R@ 2+ R@ @ 32767 AND WBLK THEN R@ ! R@ PREV ! R> 2+ ;
: BLOCK ( +N->A) OFFSET @ + >R PREV @ DUP @ R@ - DUP + IF
BEGIN +BUF 0= IF DROP R@ OFFSET @ - BUFFER DUP R@ RBLK
2- THEN DUP @ R@ - DUP + 0=
UNTIL DUP PREV ! THEN RDROP 2+ ;
: EMPTY-BUFFERS ( -> ) FIRST LIMIT OVER - ERASE ;
: UPDATE ( -> ) PREV @ @ 32768 OR PREV @ ! ;
Экран номер 26
( 31.03.86 SAVE-BUFFERS FLUSH )
: SAVE-BUFFERS ( -> )
LIMIT FIRST DO I @ 32768 AND
IF I @ 32767 AND DUP I !
I 2+ SWAP WBLK
THEN
B/BUF 4 + +LOOP ;
: FLUSH ( -> ) SAVE-BUFFERS EMPTY-BUFFERS ;
Экран номер 27
( 31.03.86 ENCLOSE WORD )
CODE ENCLOSE ( A,C->A,N1,N2,N3) 14 LHRW12 BAL, RW1 RMASK NR,
RW1 RFORTH AR, 14 14 SR, 0 0 SR,
BEGIN, 0 0 (, 14 RW1 IC, 0 0 LTR 2 =F BZ,
14 1 (, 0 14 LA, 0 RW2 CR, ?NE UNTIL, 14 0 BCTR,
2 =H 14 PUT,
BEGIN, 1 14 LR, 0 0 (, 1 RW1 IC, 0 0 LTR,
2 =F BZ, 14 1 (, 0 14 LA, 0 RW2 CR, ?E UNTIL,
2 =H 1 PUSH, RW1 14 LR, PUSHRW1 B, END-CODE
: WORD ( C->T ) BLK @ IF BLK @ BLOCK ELSE TIB THEN
>IN @ + SWAP ENCLOSE >IN +!
HERE >R OVER - >R + ALIGNH HERE 1+ R@ CMOVE
HERE R> 1+ ALLOT ALIGNH HERE OVER - 2- OVER C! R> DP! ;
Экран номер 28
( 31.03.86 LIT" COUNT ," " ". (."/ ." C" ( .( QUIT ABORT )
CODE LIT" ( ->T ) 14 IPUSH BAL, RNEXT BR, END-CODE
: COUNT ( T->A,N) DUP 1+ SWAP C@ 2DUP + C@ IF 1+ THEN ;
: ," ( -> ) C" " WORD C@ 2+ ALLOT ALIGNH ;
: " ( ->T) ?COMP COMPILE LIT" ," ; IMMEDIATE
: ". ( T-> ) COUNT TYPE ;
CODE (.") ( ->) 14 IPUSH BAL, 14 GOTO BAL, ] ". [
: ." ( -> ) ?COMP COMPILE (.") ," ; IMMEDIATE
: C" ( ->C) BL WORD 1+ C@ [COMPILE] LITERAL ; IMMEDIATE
: ( ( ->) C" ) WORD DROP ; IMMEDIATE
: .( ( ->) C" ) WORD COUNT TYPE ; IMMEDIATE
: QUIT ( ->) [COMPILE] [ S0 @ SP! R0 @ RP! ФОРТ-СИСТЕМА ;
Экран номер 29
( 31.03.86 ПРОВЕРКИ И СИГНАЛИЗАЦИИ ОБ ОШИБКАХ )
: ?ABORT ( F,T->) SWAP IF COUNT CR TYPE ABORT THEN DROP ;
CODE (A") ( F->) 14 IPUSH BAL, 14 GOTO BAL, ] ?ABORT [ END-CODE
: ABORT" ( F->) COMPILE (A") ," ; IMMEDIATE
: ABORT8 ( ->) -1 ABORT" НЕПРАВИЛЬНОЕ ЗНАЧЕНИЕ В СТЕКЕ" ;
: !CSP ( ->) SP@ CSP 1 ;
: ?CSP ( ->) SP@ CSP @ - ABORT" СБИЛСЯ УКАЗАТЕЛЬ СТЕКА" ;
: ?PAIRS ( N1,N2-> ) - ABORT" НЕПАРНЫЕ СКОБКИ" ;
CODE ?+ ( N->N ) FIRST 128 TM, RNEXT BZR, ERCOND8 B, END-CODE
: ?COMP ( ->) STATE @ NOT ABORT" ТРЕБУЕТСЯ РЕЖИМ КОМПИЛЯЦИИ" ;
: BADWORD ( T->) CR ". ." ?" ABORT ;
Экран номер 30
( 31.03.86 >BODY BODY> >LINK LINK> L>NAME N>LINK >NAME NAME> )
: >BODY ( CFA->PFA) 2+ ;
: BODY> ( PFA->CFA) 2- ;
: >LINK ( CFA->LFA) 2- ;
: LINK> ( LFA->CFA) 2+ ;
CODE L>NAME ( LFA->NFA) RW2 PULL, RW2 RMASK NR, RW1 RW2 LR,
14 &LENG LA, 1 1 SR, DO, RW1 RTWO SR, 1 0 (, RW1 RFORTH IC,
1 LENG1MSK N, 0 2 (, 1 RW1 LA, 0 RW2 CR, PUTRW1 BE,
14 LOOPBCT, PUTRW1 B, END-CODE
: N>LINK ( NFA->LFA) DUP C@ 31 AND + 2+ ;
: >NAME ( CFA->NFA) >LINK L>NAME ;
: NAME> ( NFA->CFA) N>LINK LINK> ;
Экран номер 31
( 31.03.86 LATEST DEFINITIONS SMUDGE UNSMUDGE IMMEDIATE ID.)
: LATEST ( ->NFA) CURRENT @ @ ; ( (;CODE/ RECURSE )
: DEFINITIONS ( ->) CONTEXT @ CURRENT ! ;
: SMUDGE ( ->) LATEST C@ [ &SFLAG ] LITERAL OR LATEST C! ;
: UNSMUDGE ( ->) LATEST C@ [ 255 &SFLAG - ] LITERAL
AND LATEST C! ;
: IMMEDIATE ( ->) LATEST C@ [ &IFLAG ] LITERAL OR LATEST C! ;
: ID. ( NFA-> ) DUP 1+ SWAP C@ [ &LENG ] LITERAL AND
2DUP + C@ IF 1+ THEN TYPE SPACE ;
: (;CODE) ( -> ) R> LATEST NAME> ! ;
: RECURSE ( -> ) LATEST NAME> , ; IMMEDIATE
Экран номер 32
( 31.03.86 CONSTANT VARIABLE 2CONSTANT 2VARIABLE : ; )
: ?LOADING ( ->) BLK @ 0= ABORT" НЕТ ОБРАБОТКИ ЭКРАНА" ;
: ?GAP ( N->) HERE + SP@ SWAP U< ABORT" ИСЧЕРПАНИЕ ПАМЯТИ" ;
: ?STACK ( ->) S0 @ SP@ U< ABORT" ИСЧЕРПАНИЕ СТЕКА" 10 ?GAP ;
: CONSTANT ( W-> ) CREATE , ;CODE
RW1 0 (, 14 RFORTH LH, PUSHRW1 B, END-CODE
: VARIABLE ( -> ) CREATE 0 , ;
: 2VARIABLE ( -> ) CREATE 0 , 0 , ;
: 2CONSTANT ( WD-> ) CREATE , , DOES> 2@ ;
: : ( -> ) !CSP CREATE ] SMUDGE ;CODE
RI RPUSH, RI 14 LR, RNEXT BR, END-CODE
: ; ( -> ) ?CSP COMPILE EXIT UNSMUDGE [COMPILE] [ ; IMMEDIATE
Экран номер 33
( 09.09.86 FORTH FORTH# FL# VOC-LINK VOCABULARY VOCABULARY# )
VOC FORTH &DWORD H, ( FORTH-83 )
A: FORTH# LASTWORD ( ВХОД В СПИСОК СЛОВАРНЫХ СТАТЕЙ)
A: FL# 0 H, ( ПОЛЕ СВЯЗИ ДЛЯ СПИСКОВ СТАТЕЙ)
CREATE VOC-LINK FL# ( ВХОД В СПИСОК СПИСКОВ СТАТЕЙ)
: VOCABULARY ( -> ) CREATE [ &DWORD ] LITERAL ,
LIT [ FORTH# ]
CONTEXT @ - IF CONTEXT @ 2- ELSE 0 THEN ,
HERE VOC-LINK @ , VOC-LINK ! DOES>
[ THERE 4 - :A: VOCABULARY# ]
2+ CONTEXT ! ;
: FORTH-83 ( ->) FORTH DEFINITIONS DECIMAL ;
Экран номер 34
( 31.03.86 (FIND/ )
CODE (FIND) ( -1,AN,...,A1,T->CFA,C,TF/FF ) RW2 POP,
RW2 RMASK NR, RW2 RFORTH AR, ( ОБРАЗЕЦ) 0 0 SR,
0 0 (, 0 RW2 IC, 0 LENG1MSK N, ( ДЛИНА) 1 1 SR, 1 0 BCTR,
BEGIN, RW1 PULL, ( ВХОД В ОЧЕРЕДНОЙ СПИСОК СЛОВ) 2 =F B,
BEGIN, RW1 RFORTH AR, 14 0 (, 0 RW1 IC, 14 LENGMASK N,
14 0 CR, ?E IF, 14 4 =F EX, 3 =F BE, THEN,
14 LENG1MSK N, RW1 2 (, 14 RW1 LH,
2 =H RW1 RMASK NR, ?Z UNTIL,
RSTACK RTWO AR, 1 FIRST CH, ?E UNTIL, PUTRW1 B,
BEGIN, RSTACK RTWO AR, 3 =H 1 FIRST CH, ?E UNTIL,
0 0 (, 0 RW1 IC, RW1 RFORTH SR, RW1 4 (, 14 RW1 LA,
RW1 PUT, 0 PUSH, RW1 1 LR, PUSHRW1 B,
4 =H 1 (, 1 RW1 ), 1 (, RW2 CLC, END-CODE
Экран номер 35
( 31.03.86 FIND -FIND )
: FIND ( T->A,N)
DUP >R -1 LIT [ FORTH# ] @
CURRENT @ @ 2DUP = IF DROP THEN
CONTEXT @ @ 2DUP = IF DROP THEN
R> (FIND) DUP IF
DROP ROT DROP [ &IFLAG ] LITERAL AND IF 1 ELSE -1 THEN
THEN ;
: -FIND ( ->A,N) BL WORD FIND ;
Экран номер 36
( 09.09.86 CREATE DOES> )
: CREATE ( -> ) 100 ?GAP
ALIGNH -FIND SWAP DROP
IF HERE ID. ." УЖЕ ЕСТЬ " ABORT THEN
HERE DUP C@ WIDTH AND 2+ ALLOT ALIGNH
HERE OVER - 2- OVER C! LATEST , CURRENT @ !
LIT [ CREATE# ] , ;
: DOES> ( -> ) COMPILE (;CODE) 2LIT
[ DOES# B, ] , , ; IMMEDIATE
Экран номер 37
( 31.03.86 PAD HOLD ALPHA <# #> # #S SIGN )
: PAD ( ->A) HERE 100 + ;
: HOLD ( C-> ) -1 HLD +! HLD @ C! ;
CODE ALPHA ( N->C) RW2 FIRST LH,
RW1 RW1 SR, RW1 1 =F (, RW2 IC, PUTRW1 B,
1 =H C,' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
END-CODE
: <# ( -> ) PAD HLD ! ;
: #> ( D->A,+N) 2DROP HLD @ PAD OVER - ;
: # ( D1->D2) BASE @ M/MOD ROT ALPHA HOLD ;
: #S ( D->0,0) BEGIN # 2DUP OR 0= UNTIL ;
: SIGN ( N->) 0< IF C" - HOLD THEN ;
Экран номер 38
( 31.03.86 D.R D. .R . H. U. U.R ? )
: D.R ( D,+N-> ) ?+ >R DUP >R DABS
<# #S R> SIGN #> R> OVER - SPACES TYPE ;
: D. ( D-> ) 0 D.R SPACE ;
: .R ( N1,+N2->) >R S>D R> D.R ;
: . ( N-> ) S>D D. ;
: H. ( N->) BASE @ SWAP 0 HEX <# # # # # #> TYPE SPACE
BASE ! ;
: U. ( U->) 0 D. ;
: U.R ( U,+N->) >R 0 >R D.R ;
: ? ( A-> ) @ . ;
Экран номер 39
( 31.03.86 DIGIT CONVERT NUMBER )
: DIGIT ( C,N1->N2,TF/FF) 0 ROT ROT 0
DO I ALPHA OVER = IF 2DROP I -1 0 LEAVE THEN LOOP DROP ;
: CONVERT ( WD1,A1->WD2,A2)
BEGIN 1+ DUP >R C@ BASE @ DIGIT WHILE
SWAP BASE @ UM* DROP ROT BASE @ UM* D+
DPL @ 1+ IF DPL 1+! THEN R> REPEAT R> ;
: NUMBER ( T->WD )
0 0 ROT DUP >R COUNT OVER + OVER C@ C" - =
DUP >R SWAP >R IF ELSE 1- THEN -1
BEGIN DPL ! CONVERT DUP R@ < WHILE DUP C@
C" . <> IF RDROP RDROP R> BADWORD THEN 0
REPEAT DROP RDROP R> IF DNEGATE THEN RDROP ;
Экран номер 40
( 31.03.86 EXPECT QUERY INTERPRET ФОРТ-СИСТЕМА X )
: EXPECT ( A,+N-> ) DUP >R (EXPECT) DUP SPAN !
TYPE R> SPAN @ - IF SPACE THEN ;
: QUERY ( ->) TIB 80 EXPECT >IN 0! BLK 0! SPAN @ #TIB ! ;
: INTERPRET ( ->) BEGIN -FIND ?DUP IF
1+ IF EXECUTE ELSE STATE @ IF , ELSE EXECUTE THEN THEN
ELSE NUMBER DPL @ 1+ IF [COMPILE] 2LITERAL
ELSE DROP [COMPILE] LITERAL THEN THEN ?STACK AGAIN ;
: ФОРТ-СИСТЕМА ( ->) BEGIN QUERY INTERPRET AGAIN ;
CODE X ( ->) ЗАБИТЬ-X ( НУЛЕВОЙ КОД ВМЕСТО БУКВЫ "X")
EXIT# B, END-CODE IMMEDIATE
Экран номер 41
( 31.03.86 -TRAILING ' ['] [COMPILE] LOAD THRU ;S --> )
CODE -TRAILING ( A,N1->A,N2) 14 LHRW12 BAL, RW1 RMASK NR,
RW1 RFORTH AR, 0 RW1 LR, RW1 RW2 AR, BEGIN, RW1 0 CR,
1 =F BNH, RW1 0 BCTR, 0 (, RW1 64 CLI, ?NE UNTIL, 0 0 BCTR,
1 =H RW1 0 SR, PUTRW1 B, END-CODE
: ' ( ->CFA) -FIND 0= IF BADWORD THEN ;
: ['] ( -> ) ?COMP ' [COMPILE] LITERAL ; IMMEDIATE
: [COMPILE] ( ->) -FIND IF , EXIT THEN BADWORD ; IMMEDIATE
: LOAD ( N-> ИНТЕРПРЕТИРОВАТЬ ВЛОК С НОМЕРОМ N )
>IN @ >R BLK @ >R BLK ! >IN 0! INTERPRET R> BLK ! R> >IN ! ;
: THRU ( N1,N2-> ИНТЕРПРЕТИРОВАТЬ БЛОКИ ОТ N1 ДО N2 )
1+ SWAP DO I LOAD LOOP ;
: ;S ( ->) ?LOADING RDROP ; IMMEDIATE
: --> ( ->) ?LOADING >IN 0! BLK 1+! ; IMMEDIATE
Экран номер 42
( 09.09.86 DUMP SNAPSTK S. R. )
: DUMP ( A,U-> РАСПЕЧАТАТЬ U БАЙТОВ ) DUP IF
BASE @ >R HEX OVER + SWAP DO CR I <# C" * HOLD
0 15 DO DUP I + C@ HOLD -1 +LOOP C" * HOLD
0 15 DO BL HOLD DUP I + C@ 0 # # 2DROP -1 +LOOP
BL HOLD BL HOLD 0 # # # # #> TYPE 16 +LOOP
R> BASE ! ELSE 2DROP THEN ;
: SNAPSTK RDROP CR ". ." , ВСЕГО ЗНАЧЕНИЙ "
2DUP SWAP - 2/ DUP . 0 SWAP , IF ." (ВЕРШИНА СПРАВА)" CR
2- DO I @ . -2 +LOOP ELSE 2DROP THEN ;
: S. ( ->) SP@ S0 @ " СТЕК ДАННЫХ" SNAPSTK ;
: R. ( ->) RP@ 2+ R0 @ " СТЕК ВОЗВРАТОВ" SNAPSTK ;
Экран номер 43
( 31.03.86 .VOC (VOC/ VOCS )
: .VOC ( PFA+2-> ) 2- BODY> >NAME ID. ;
: (VOC) ( PFA1+2->PFA2,N) @ 0
BEGIN OVER DUP IF @ [ &DWORD ] LITERAL <> THEN
WHILE 1+ ( СЧЕТЧИК СЛОВ) SWAP N>LINK @ SWAP REPEAT ;
: VOCS ( -> ) -1 ['] FORTH >BODY 2+
CURRENT @ ." СПИСОК CURRENT: " DUP .VOC OVER @ OVER @ =
IF DROP THEN CONTEXT @ ." СПИСОК CONTEXT: " DUP .VOC
OVER @ OVER @ = IF DROP THEN
CR ." СТАНДАРТНЫЙ ПОРЯДОК ПОИСКА: "
BEGIN 2- BEGIN 2+ DUP .VOC (VOC) DROP DUP 0= UNTIL
DROP DUP -1 = UNTIL DROP
CR ." НАЛИЧНЫЕ СПИСКИ СЛОВ: " VOC-LINK @
BEGIN DUP 2- .VOC @ DUP 0= UNTIL DROP ;
Экран номер 44
( 31.03.86 WORDS )
: WORDS ( -> )
." СПИСОК " CONTEXT @ DUP .VOC DUP (VOC)
." ВСЕГО СЛОВ - " . ." CЛЕДУЮЩИЙ СПИСОК - "
?DUP IF 2+ .VOC THEN
CR @ BEGIN DUP DUP IF @ [ &DWORD ] LITERAL <> THEN
WHILE DUP C@ [ &SFLAG ] LITERAL AND 0=
IF DUP ID. SPACE THEN
N>LINK @ REPEAT DROP ;
Экран номер 45
( 31.03.86 (FORGET/ FORGET REMEMBER FORGET0 )
: (FORGET) ( A-> ИСКЛЮЧИТЬ ВСЕ СЛОВА ВЫШЕ АДРЕСА А )
DUP FENCE @ U< ABORT" ЗАЩИТА ПО FENCE"
>R VOC-LINK @
BEGIN R@ OVER U< WHILE
FORTH DEFINITIONS
@ DUP VOC-LINK !
REPEAT ( ДОШЛИ ДО СПИСКА, ГДЕ ЕСТЬ ЭТО СЛОВО )
BEGIN DUP 4 -
BEGIN N>LINK @ DUP R@ U< UNTIL
OVER 2- ! @ ?DUP 0= UNTIL R> DP! ;
: FORGET ( ->) ' >NAME (FORGET) ;
: REMEMBER ( ->) CREATE DOES> (FORGET) ;
Экран номер 46
( 31.09.86 (#SCR/ LIST SCR? INDEX )
: (#SCR) ( N->A,T ПЕРЕВЕСТИ НОМЕР N ЭКРАНА В ТЕКСТОВОЕ ИМЯ )
BASE @ >R DECIMAL 0 <# #S #> R> BASE ! ;
: LIST ( N-> РАСПЕЧАТАТЬ ЭКРАН N, ЗАПОМНИТЬ ЕГО В "SCR" )
DUP SCR ! CR ." ЭКРАН " DUP (#SCR) TYPE
BLOCK 16 0 DO DUP I 64 * +
CR I 3 .R SPACE 64 TYPE LOOP DROP ;
Экран номер 47
( 31.03.86 СТАНДАРТНЫЕ СТРУКТУРЫ УПРАВЛЕНИЯ )
: BEGIN ?COMP <MARK 1 ; IMMEDIATE
: UNTIL 1 ?PAIRS COMPILE ?BRANCH <RESOLVE ; IMMEDIATE
: AGAIN 1 ?PAIRS COMPILE BRANCH <RESOLVE ; IMMEDIATE
: IF ?COMP COMPILE ?BRANCH >MARK 2 ; IMMEDIATE
: THEN 2 ?PAIRS >RESOLVE ; IMMEDIATE
: ELSE 2 ?PAIRS COMPILE BRANCH >MARK
SWAP >RESOLVE 2 ; IMMEDIATE
: WHILE 1 ?PAIRS 1 [COMPILE] IF ; IMMEDIATE
: REPEAT >R >R [COMPILE] AGAIN
R> R> [COMPILE] THEN ; IMMEDIATE
: DO ?COMP COMPILE (DO) >MARK <MARK 3 ; IMMEDIATE
: LOOP 3 ?PAIRS COMPILE (LOOP) <RESOLVE >RESOLVE ; IMMEDIATE
: +LOOP 3 ?PAIRS COMPILE (+LOOP) <RESOLVE >RESOLVE ; IMMEDIATE
| netlib.narod.ru | < Назад | Оглавление | Далее > |