1
2 .CHARSET 1251
3
4 ; Каллисто версия 0.9.5б ∗∗∗ БЕТА−ВЕРСИЯ ∗∗∗
5 ; Авторское право (c) Васильев Илья Владимирович, г. Москва, 15 июля 2016 г.
6 ; Каллисто это язык программирования для "Электроники МК−161", основанный на Форте и ЯМК.
7 ; Документацию по Каллисто см. на вики http://pmk.the-hacker.ru/
8
9 ; Каллисто поставляется под свободной лицензией, совместимой с GNU GPL v3
10 ; Текст лицензии на русском языке размером в 56 строк находится в файле PRAVA.TXT
11 ; Каллисто нельзя распространять без исходного текста и файла PRAVA.TXT
12 ; Если вы несогласны с правами, которые предоставляет свободное программное обеспечение
13 ; и обязанностями, которые оно налагает, удалите Каллисто со своих носителей.
14
15 ; Минимальная версия компилятора: MK.EXE v1.25, MKL2MKP v0.27
16
17 ; R0 временный регистр слова−примитива
18 ; R1 временный регистр слова−примитива
19 ; R2 RP, указатель целочисленного стека возвратов (RS) −− растёт вниз от 5090
20 ; R3 S=SP, указатель десятичного стека (DS с плавающей запятой) −− растёт вниз от 998
21 ;
22 ; R4 временный регистр слова−примитива
23 ; R5 временный регистр слова−примитива, может быть изменён NEXT, CALL, EXIT
24 ; R6 RI указатель шитого кода, он же IP указатель инструкций, указывает на следующий CFA (когда R9==NEXTD)
25 ;
26 ; R7 W=WP, указатель слов Форта, содержит CFA исполняемого слова, слово−примитив может менять R7
27 ; R8 JP указатель/регистр передачи управления NEXT, временный регистр слова−примитива
28 ; R9 = NEXTP/NEXTD, точка NEXT
29 ; RA временный регистр, его может изменить BIOS
30 ; RB временный регистр слова−примитива
31 ; RC = RPUSHRIP/RPUSHRID, адрес подпрограммы сохранения указателя шитого кода RI в стеке возвратов
32 ; RD при загрузке/сохранении словаря содержит номер версии Каллисто
33 ; RE = 256 (литерал)
34 ;
35 ; R15 RX Здесь сохраняется стек МК−161 при считывании регистра словом ИП
36 ; R16 RY
37 ; R17 RZ
38 ; R18 RT
39 ; R19 = 9007/9008 (DARK/LIGHT) номер регистра прокрутки для текущего цвета фона
40 ;
41 ; R9042 RI указатель шитого кода (когда R9==NEXTP)
42 ; R9044 читает байт шитого кода, RI++
43 ;
44 ; Источники
45 ; 1. Семёнов Ю.А. Программирование на языке Форт, 1991 (FORTH ИТЭФ Семёнова Ю.А., 1988)
46 ; 2. Баранов С.Н., Ноздрунов Н.Р. Язык Форт и его реализации, 1988 (ФОРТ−ЕС Баранова С.Н., 1986)
47 ; 3. Forth 200x Standardisation Committee. Forth Standard 2012, 10th November 2014
48 ; 4. НПП "СЕМИКО". Организация работы с функциями, адресуемыми через регистры памяти.
49 ; НПКД.401348.001 Д1 изм. 9. Новосибирск, 2009
50 ; 5. Стандарт FORTH−79
51 ; 6. Журнал "BYTE" N8, 1980.
52 ; 7. Стандарт FORTH−83
53 ; 8. Стандарт FORTH ANSI 1994
54
55 ; В Каллисто переменные хранятся в области двоичных регистров
56 ; Двойная нумерация вызвана необходимостью обращения к переменным как из ЯМК, так и из Форта
57 ; Третья нумерация p использована для экономии памяти и времени исполнения в поле параметров переменных USER
58 ;
59
60 rrXS0 .EQU 998 ; 10998 Дно стека данных (DS)
61 rrXR0 .EQU 5090 ; 15092 Дно стека возвратов (RS)
62 rrBUFBLK .EQU 5094 ; 15094 = 3af6 Номер блока в буфере и признак UPDATE
63 rlBUFBLK .EQU 5095
64 rrDISKBUF .EQU 5096 ; 15096 = 3af8
65 rrENDBUF .EQU 8167 ; 18167
66
67 rRX .EQU 15 ; 10015 R15
68 rRY .EQU 16 ; 10016 R16
69 rRZ .EQU 17 ; 10017 R17
70 rRT .EQU 18 ; 10018 R18
71
72 rrXTIB .EQU 1000 ; 11000 Входной буфер терминала (94 байта) и 2 нулевых байта (адрес фиксирован)
73
74 ; Область переменных USER проходит инициализацию при запуске Форта
75 ; Изначально предназначена для многозадачности
76 ; Эта часть переменных обнуляется при COLD
77
78 rrSAVIN .EQU 1096 ; 11096 SAVIN − Сохранение >IN в INTERPRET для NUMBER и BASE для FL
79 pSAVIN .EQU 96
80 rrBLK .EQU 1098 ; 11098 BLK − BLK=0, работа Каллисто с пульта (TIB)
81 pBLK .EQU 98 ; BLK!=0, работа с блоком номер BLK @
82 rrIN .EQU 1100 ; 11100 >IN − Указатель смещения во входном (или экранном) буфере
83 pIN .EQU 100
84 rrSCR .EQU 1102 ; 11102 SCR − Номер редактируемого экрана
85 pSCR .EQU 102
86 rrCONTEXT .EQU 1104 ; 11104 CONTEXT − Указатель, с какого словаря следует начать просмотр при интерпретации
87 pCONTEXT .EQU 104
88 rlCONTEXT .EQU 1105
89 rrCURRENT .EQU 1106 ; 11106 CURRENT − Указатель, к какому словарю будет отнесено новое слово
90 pCURRENT .EQU 106
91 rlCURRENT .EQU 1107
92 rrSTATE .EQU 1108 ; 11108 STATE − STATE=0 − исполнение, STATE=128 − компиляция
93 pSTATE .EQU 108
94 rlSTATE .EQU 1109 ;
95 rrBASE .EQU 1110 ; 11110 BASE − основание действующей системы счисления
96 pBASE .EQU 110
97 rlBASE .EQU 1111
98 rrDPL .EQU 1112 ; 11112 DPL − позиция (десятичной) запятой в числе
99 pDPL .EQU 112
100 rrCSP .EQU 1114 ; 11114 CSP − контрольное хранение значения указателя стека
101 pCSP .EQU 114
102 rlCSP .EQU 1115
103 rrRNUM .EQU 1116 ; 11116 R# − позиция курсора при редактировании экрана или возникновении ошибки
104 pRNUM .EQU 116
105 rrHLD .EQU 1118 ; 11118 HLD − Указатель позиции в выходном буфере, обычно PAD
106 pHLD .EQU 118
107 rlHLD .EQU 1119
108 rrEXP .EQU 1120 ; 11120 EE − Десятичное значение порядка вводимого числа
109 pEXP .EQU 120
110 rrERB .EQU 1122 ; 11122 ERB − Блокировка ухода в систему Форт при ERROR
111 pERB .EQU 122
112 rrKbdMode .EQU 1124 ; 11124 Флаг клавиатуры 1: цифра / латинские / русские буквы = 0 / 1 / 2
113 rrKbdCaps .EQU 1125 ; 11125 Флаг клавиатуры 2: строчные / заглавные = 0 / 1
114 pKBDFLG .EQU 124 ; 11124 KBDFLG − Флаги клавиатуры
115
116 rrCHWM1 .EQU 1125 ; адрес rrCHW−1 для косвенной адресации с прединкриментом
117
118 ; Эта часть переменных инициализируется в COLD
119 ;
120 nbEmpty .EQU 126 ; 126 сколько байт обнулит COLD перед инициализацией _FONT и далее
121
122 ; Описание активного шрифта
123 ; Порядок полей важен, они заполняются словом FONT!
124 ;
125 pFONT .EQU 126 ; 11126 _FONT − Структура терминала, описывающая активный шрифт
126 rrCHW .EQU 1126 ; 11126 +0 максимальная ширина символа при выводе на индикатор
127 rrCHH .EQU 1127 ; 11127 +1 высота символа при выводе на индикатор
128 rrBSW .EQU 1128 ; 11128 +2 ширина курсора и среднего символа для BS
129 rrSCRLN .EQU 1129 ; 11129 +3 на сколько линий поднять экран при прокрутке
130 rrSCRLFIX .EQU 1130 ; 11130 +4 на сколько строк поднять курсор после прокрутки
131
132 rrS0 .EQU 1131 ; 11131 S0 − Указатель начала стека параметров
133 rlS0 .EQU 1132
134 pS0 .EQU 131
135 rrR0 .EQU 1133 ; 11133 R0 − Указатель начала стека возвратов
136 rlR0 .EQU 1134
137 pR0 .EQU 133
138 rrDDP .EQU 1135 ; 11135 ДH − Указатель на первую свободную ячейку десятичного словаря
139 rlDDP .EQU 1136
140 pDDP .EQU 135
141 rrDP .EQU 1137 ; 11137 H − Указатель на первую свободную ячейку словаря H @ = HERE
142 pDP .EQU 137
143 rlDP .EQU 1138
144 rrVOCLINK .EQU 1139 ; 11139 VOC−LINK − Переменная связи наборов слов
145 pVOCLINK .EQU 139
146 rrAUTOEXEC .EQU 1141 ; 11141 APP − код отсюда будет выполняться сразу после WARM
147 pAUTOEXEC .EQU 141
148 rlAUTOEXEC .EQU 1142
149
150 rrDict .EQU 1143 ; 11143 bufDict: Отсюда начнётся словарь в байтовой области
151 rrXVOC .EQU 1159 ; 11159 bufDict + 16
152 ;frTASKM7 .EQU 11161 ; 11161 Начало слова TASK в байтовой области, bufDict + 10018
153 rrXDP .EQU 1170 ; 11170 Конец словаря в байтовой области, bufDict + 27
154
155 .ORG 0
156 GOTO INIT ; Начало исполнения Каллисто по В/О С/П
157
158 ; ∗∗ Подпрограммы адресного интерпретатора ∗∗
159 ;
160 ; От скорости адресного интерпретатора зависит скорость всего языка, ради неё разрабатывают процессоры.
161 ; Оптимизация приветствуется. Скорость работы этих процедур очень важна.
162 ;
163 ; 1. 1 EE 4 быстрее, чем 4 F10^X
164 ; 2. <−> быстрее, чем FR
165 ; 3. PPRM 9044 быстрее, чем KRMD
166 ; 4. Cx EE быстрее, чем 1 EE
167 ;
168 ; Проверить:
169 ; 1. 65536 vs RME FX^2
170 ; 2. FX^2 vs ENT ∗
171 ; 3. 1000 vs PRM20
172 ;
173 ; Лучше всего скажется на быстродействии Каллисто реализация адресного интерпретатора ( NEXT CALL RETURN ),
174 ; а также (FIND) и наиболее часто встречающихся длительных комбинаций на уровне машинного кода, то есть
175 ; встроенной программы МК−161. Тогда даже возможна реализация современного механизма CREATE .. DOES>
176 ; например, через механику модифицированного косвенного шитого кода.
177
178 ; Следующие две подпрограммы вызваются косвенно через RC (КППС) из : и DOES>
179 ; SETRIPRG и SETRIDAT внутри тела ":" содержат ссылки на RPUSHRIP и RPUSHRID
180 ; В релизе их можно сделать двумя шагами
181
182 ; Начало CALL при вызове из памяти программ.
183 RPUSHRIP:
184 PPRM 9042 ; RX := RI ; Текущий указатель шитого кода
185 ENT RME / FANS <−> KINT M5 ∗ − KM2 RM5 KM2 ; RPUSH (RX)
186 RM7 RTN ; RX := W, оптимизация
187
188 ;
189 ; Начало CALL при вызове из памяти данных.
190 RPUSHRID:
191 RM6 10001 + ; RX := RI ; Текущий указатель шитого кода
192 ENT RME / FANS <−> KINT M5 ∗ − KM2 RM5 KM2 ; RPUSH (RX)
193 RM7 RTN ; RX := W, оптимизация
194
195 ; Выяснить, надо ли очищать словари: COLD или WARM ?
196 INIT:
197 2 PPM 9048 ; Теперь С/П это обычная клавиша, не останавливает Каллисто
198 GSB SVER ; RX := номер версии Каллисто
199 RMD FX>=0 INIT1 ; Отрицательное число в RД может означать возобновление работы после BYE
200 2 PPM 9010 FR +/− ; Инициализация (очистка) графического экрана
201 INIT1: + PX=0 JCOLD ; Если RД не содержит правильный номер версии, COLD
202 MD ; RД := 0
203 .NUMT RWARM ; WARM −− слово высокого уровня, обращение к нему сложнее
204 PGOTO SETRIPRG ; Исполнение шитого кода с WARM
205
206 JBYE: ; Обработчик BYE
207 GSB SVER +/− ; Перезапуск произойдёт без очистки индикатора
208 MD ; Дать шанс INIT продолжить работу по WARM
209 R/S ; Выйти в режим автоматической работы калькулятора
210 KGOTO9 ; Теоретически оператор может вернуться в Каллисто с помощью С/П
211
212 JVERSION: GSB SVER KM3 ; Обработчик VERSION
213 JNOP: KGOTO9 ; Обработчик NOP
214 SVER: ,905 RTN ; Коду ЯМК тоже иногда требуется проверять номер версии.
215
216 ;−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
217 ; BIOS: терминальный ввод/вывод на основе регистров функций МК−161
218 ;−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
219
220 ; Обычно код располагается в теле примитива, но мы хотим использовать 2−х байтовые ПП
221 JCR: PGSB CHPUTCR GSB CHPUTLF KGOTO9 ; Обработчик CR
222
223 CHPUTLF: PPRM9000 <−> ; Нам важна координата y курсора
224 PPRM rrCHH + ; Увеличиваем на высоту данного шрифта
225 65 FANS − − PX<0 CHPUTSCROLL ; Прокрутка экрана, если не вмещаемся
226 FANS + <−> PPM9000 RTN ; Обычный LF вниз на rrCHH строк
227 CHPUTCR: PPRM9000 Cx PPM9000 RTN ; CR
228 CHPUTSCROLL: PPRM rrSCRLN PKM19 ; Прокрутить на то число линий, на которое данный шрифт прокручивается
229 PPRM 9000 <−> ; Позиция курсора по y
230 PPRM rrSCRLFIX − ; Корректируем, ведь прокрутка у МК−161 слишком грубая
231 <−> PPM 9000 RTN ; Устанавливаем курсор на новую позицию и выходим
232
233 ;−−−−− ДРАЙВЕР ЭКРАНА −−−−−
234 ; Пока вывод ограничен встроенными шрифтами, в будущем предусмотреть загружаемые шрифты, включая оба микро−шрифта
235 ; Не меняет R0, но затрагивает стек МК−161 и RA
236 ; Не делает КГРФ
237 CHPUT: MA
238 32 − FX>=0 CHPUT1 ; Управляющие символы разбираем отдельно
239 CHPUT3: PPRM9000 ; Где находится курсор
240 129 PPRM rrCHW − ; Предельная координата по горизонтали
241 − FX>=0 CHPUT2 ; Грубая проверка, что символ уместится −− потом доработать
242 Cx PPM9000 ; CR, по достижении конца строки
243 PGSB CHPUTLF ; LF
244 CHPUT2: RMA PPM9020 RTN ; Вывести символ
245 CHPUT1: 19 + FX!=0 CHPUTCR ; 13 −> CR ; наверняка можно сократить
246 1 + PX!=0 CHPUTCLS ; 12 −> CLS ; с помощью FL1
247 1 + PX!=0 CHPUTHOME ; 11 −> HOME
248 1 + PX!=0 CHPUTLF ; 10 −> LF
249 1 + PX!=0 CHPUTTAB ; 9 −> TAB
250 1 + PX!=0 CHPUTBS ; 8 −> BS
251 1 + PX=0 CHPUT3 ; 7 −> BELL
252 CHPUTBELL: 440 ENT 10 PPM9052 RTN ; Издать короткий звуковой сигнал
253 CHPUTBS: PPRM9000 PPRM rrBSW − ; BS на заданное в описании шрифта количество точек назад
254 0 KMAX <−> FR ; Остановка у левой границы индикатора
255 PPM9000 RTN ; Установить курсор
256
257 CHPUTCLS: 8 PKM19 ; 8 линий при прокрутке означает очистку экрана
258 CHPUTHOME: Cx ENT PPM9000 RTN
259 CHPUTTAB: PPRM9000 32 + 224 KAND PPM9000 RTN
260
261 JPAGE: GSB CHPUTCLS KGRPH KGOTO9 ; Обработчик примитива PAGE
262
263 ;−−−−− ДРАЙВЕР КЛАВИАТУРЫ −−−−−
264
265 JKEY: GSB CHGET KM3 KGOTO9 ; Обработчик примитива KEY
266
267 ;−−−−−−− Показать курсор, дождаться нажатия клавиши, убрать курсор
268 CHGKEY:
269 GSB CSRON
270 CHGKwait: PPRM9029 MA
271 KNOT FX!=0 CHGKwait
272
273 ;−−−−−− Показать/убрать курсор
274 CSROFF:
275 CSRON: PPRM9001 + ; Сохраним атрибут в X1
276 3 PPM9001 ; Установим атрибут XOR
277 PPRM rrCHH PPRM rrBSW ; Размер курсора для активного шрифта
278 PPM9013 ; Вывод прямоугольника
279 KGRPH
280 FANS PPM9001 ; Восстановим атрибут
281 CHGETR1: RTN
282
283 ; Можно предусмотреть внешнюю клавиатуру −− через последовательный порт
284 ; Также неплохо сделать курсор мигающим, отдельную форму для режима вставки
285 ; Можно попробовать упростить, сделав линейный поиск при 0 в таблице.
286 CHGET: GSB CHGKEY
287 PPRM rrKbdMode
288 PX=0 CHGET7
289 .NUM tblKeyNum ; Клавиша нажата в цифровом режиме
290 RMA + KPRGM ; Считываем код символа из таблицы клавиатуры
291 FX=0 CHGETR2
292 RMA 20 − FX=0 CHGET01 ; F ?
293 PGSB CHGKEY ; Получить код клавиши после F
294 .NUM tblKeyFNum
295 RMA + KPRGM
296 FX=0 CHGETR2
297 RMA 20 − FX!=0 JCHGET ; F F ?
298 2 − FX=0 CHGET02 ; F P ?
299 CHGETCAPS: 1 PPRM rrKbdCaps − PPM rrKbdCaps
300 JCHGET: PGOTO CHGET
301 CHGET02: 9 − FX=0 JCHGET ; F РУС/ЛАТ ?
302 CHGSETRUS: 2 ; rrKbdMode := 2 ; русские буквы
303 CHGSETMODE: PPM rrKbdMode
304 GOTO JCHGET
305 CHGET01: 11 − FX=0 JCHGET ; РУС/ЛАТ ?
306 CHGSETLAT: 1 GOTO CHGSETMODE ; rrKbdMode := 1 ; английские буквы
307
308 CHGET7: ; Клавиша нажата в алфавитном режиме
309 Cx PGSB KbdToChar ; Код символа без F
310 FX=0 CHGETR2 ; Если он не нулевой, его и возвращаем
311 RMA 12 − FX=0 CHGET2NSP ; Это ВП?
312 32 ; ВП это пробел!
313 CHGETR2: RTN
314 CHGET2NSP: 1 − FX=0 CHGET6CX
315 8 RTN ; CX это 8 (Backspace)
316 CHGET6CX: 7 − ; F ?
317 PX=0 CHGET6 ; Разобрать остальные клавиши
318 PGSB CHGKEY ; Ввести алфавитный символ после F
319 1 PGSB KbdToChar ; Получить код символа от клавиши после F
320 FX=0 CHGETR2 ; Если он не нулевой, его и возвращаем
321 RMA 12 − FX=0 CHGET11NTAB ; Это F + ВП ?
322 9 RTN ; Значит, табуляция.
323 CHGET11NTAB: 1 − FX=0 CHGET15CX
324 127 RTN ; F + CX это 127 (Delete)
325 CHGET15CX: 9 − PX!=0 CHGETCAPS ; F P ?
326 1 − FX=0 CHGET15a ; ШГ−>
327 96 RTN ; '`'
328 CHGET15a: 8 − PX!=0 CHGSETRUS ; F РУС/ЛАТ ?
329 2 −
330 JEQCHGET: PX=0 CHGET
331 10 RTN ; F+ВВОД будет LF
332 CHGET6: 2 − ; P ?
333 PX!=0 CHGSETMODE ; Установка режима NUM
334 9 − ; РУС/ЛАТ ?
335 PX!=0 CHGSETLAT ; Если да, установим латинский режим
336 8 + FX=0 JEQCHGET ; ШГ−>
337 95 ; '_'
338 CHGETR: RTN
339
340 ;−−−−−−−− Обращение к таблицам клавиатуры −−−−−−−−
341 ; Вход: RX = 0/1 означает обычное нажатие или с F
342 ; RA = код нажатой клавиши
343 ; Выход: RX = код символа или 0 (из таблицы)
344 ;
345 KbdToChar: PPRM rrKbdCaps
346 − ; 0 строчные, иначе заглавные
347 PPRM rrKbdMode
348 1 − ; 0 лат, 1 рус
349 <−> FX!=0 KTClow
350 <−> FX=0 KTC1
351 .NUMT tblKeyL
352 GOTO KTCfetch
353 KTC1: .NUMT tblKeyR
354 GOTO KTCfetch
355 KTClow:
356 <−> FX=0 KTC2
357 .NUMT tblKeyLL
358 GOTO KTCfetch
359 KTC2: .NUMT tblKeyRL
360 KTCfetch: RMA + KPRGM ; Считываем код символа из таблицы клавиатуры
361 RTN
362
363 tblKeyNum: ; Таблицы клавиатуры
364 .TEXT "0123456789,. "
365 .DB 8,24
366 .TEXT "+−"
367 .DB 179,176,183 ; ∗ / <−>
368 .TEXT "\0?\0():"
369 .DB 59 ; ";"
370 .TEXT "@![]\0"
371 .DB 27,13
372 .DB 26,27,24,25 ; Клавиши выбора
373 tblKeyFNum: .DB 190 ; 0
374 .TEXT "'" ; 1
375 .DB 34 ; 2 это "
376 .TEXT "#$%^&∗∼" ; 4 5 6 7 8 9
377 .DB 181 ; ,
378 .TEXT "\\"
379 .DB 9,127,192 ; ВП Cx B^
380 .DB 185,251,189 ; + − ∗
381 .TEXT "/" ; /
382 .DB 191 ; <−>
383 .TEXT "\0?\0<="
384 .DB 177,178
385 .TEXT ">|{}\0"
386 .DB 200,10 ; Выход, Ввод
387 .DB 26,27,24,25 ; Клавиши выбора
388 tblKeyR:
389 .DB 09dH,098H,099H,09aH ; 0Э 1Ш 2Щ 3Ъ
390 .DB 093H,094H,095H,08eH ; 4У 5Ф 6Х 7О
391 .DB 08fH,090H,09eH,09fH ; 8П 9Р ,Ю /−/Я
392 .DB 0,0,09cH,096H ; ВП" " СxBS B^Ь +Ц
393 .DB 091H,097H,092H,09bH ; −С xЧ /Т <−>Ы
394 .DB 0,0f0H,0,86H ; F KЁ P >Ж
395 .DB 087H,088H,089H,08aH ; <З В/ОИ С/ПЙ ИПК
396 .DB 08bH,08cH,08dH,0 ; ПЛ БПМ ППН Р−ГРД−Г
397 .DB 084H,085H,080H,081H ; Выход Ввод −>А <−Б
398 .DB 082H,083H ; ^В _Г
399 tblKeyRL:
400 .DB 0edH,0e8H,0e9H,0eaH ; 0э 1ш 2щ 3ъ
401 .DB 0e3H,0e4H,0e5H,0aeH ; 4у 5ф 6х 7о
402 .DB 0afH,0e0H,0eeH,0efH ; 8п 9р ,ю /−/я
403 .DB 0,0,0ecH,0e6H ; ВП" " СxBS B^ь +ц
404 .DB 0e1H,0e7H,0e2H,0ebH ; −с xч /т <−>ы
405 .DB 0,0f1H,0,0a6H ; F Kё P >ж
406 .DB 0a7H,0a8H,0a9H,0aaH ; <з В/Ои С/Пй ИПк
407 .DB 0abH,0acH,0adH,0 ; Пй БПк ППл Р−ГРД−Г
408 .DB 0a4H,0a5H,0a0H,0a1H ; Выход Ввод −>а <−б
409 .DB 0a2H,0a3H ; ^в _г
410 tblKeyL:
411 .TEXT "XSTUNOPI" ; 0X 1S 2T 3U 4N 5O 6P 7I
412 .TEXT "JKYZ" ; 8J 9K ,Y /−/Z
413 .DB 0,0 ; ВП Сx
414 .TEXT "WQLRMV" ; B^W +Q −L xR /M <−>V
415 .TEXT "\0D\0\0" ; F KD P >_
416 .TEXT "ABCEFGH\0" ; <A В/ОB С/ПC ИПE ПF БПG ППH Р−ГРД−Г
417 .DB 27,13,0c5H,0c4H ; Выход Ввод −> <−
418 .DB 0c6H,0c7H ; ^ _
419 tblKeyLL:
420 .TEXT "xstunopi" ; 0x 1s 2t 3u 4n 5o 6p 7i
421 .TEXT "jkyz" ; 8j 9k ,y /−/z
422 .DB 0,0 ; ВП Сx
423 .TEXT "wqlrmv" ; B^w +q −l xr /m <−>v
424 .TEXT "\0d\0\0" ; F Kd P >`
425 .TEXT "abcefgh\0" ; <a В/Оb С/Пc ИПe Пf БПg ППh Р−ГРД−Г
426 .DB 27,13,0c5H,0c4H ; Выход Ввод −> <−
427 .DB 0c6H,0c7H ; ^ _
428
429 ;#COLD
430 ; COLD ( −− ) Холодная перезагрузка, со сбросом словарей.
431 ;−−−−−−−−−−−−−−−−−−−−−−−−
432 ; Первая словарная статья
433 ; Слово COLD может использоваться, как более суровый вариант FORGET TASK
434 ; На будущее −− вместо тупой очистки памяти можно самостоятельно подгрузить словарь Форта.
435 LCOLD: .DB 4 ; NFA: 4 − длина имени
436 .TEXT "COLD" ; К Имя слова
437 .DW 0 ; LFA: Поле связи равно 0, завершающее слово набора FORTH
438 COLD: .DW JCOLD ; CFA: Поле кода ссылается на поле параметров, слово на ЯМК
439 JCOLD: ; PFA: Поле параметров содержит программу на ЯМК
440 2 PPM 9010 ; Инициализация графического экрана, шрифт 0
441 256 ME ; В RE всегда 256, экономит память и время
442 .NUMT nbEmpty ; Столько байт предстоит обнулить
443 M0
444 999 M5 ; Начиная с R1000, прединкримент
445 Cx
446 COLD0: KM5 FL0 COLD0 ; Обнулим их все!
447 .NUMT SSTR
448 PPM 9042 ; Читаем из памяти программ
449 44 M0 ; Всего 17+27 байт
450 CLDCPY: PPRM 9044 KM5 FL0 CLDCPY ; Копируем область USER + заготовку словаря
451 PGOTO SETPRG ; Начать исполнять код из памяти программ
452
453 SSTR:
454 ; Теневая таблица для инициализации _FONT и шести переменных USER (5+12=17 байт)
455
456 .DB 8,8,6,1,0 ; 11126..11130 rrCHW, rrCHH, rrBSW, rrSCRLN, rrSCRFIX для шрифта 0
457 ;
458 ; S0 R0 ДH H VOC−LINK APP
459 ; 1131 1133 1135 1137 1139 1141 ∗
460 ; .DW rrXS0, rrXR0, 10020, rrXDP, rrXVOC, QUIT
461 ; .DW 10998, 15090, 10020, 11170, 11159, QUIT ∗
462 .DB 2aH,0f6H, 3aH,0f2H, 27H,24H, 2bH,0a2H, 2bH,97H
463 .DW QUIT ; APP
464
465 ; Эти две статьи (27 байт) COLD переносит в словарь в области двоичных регистров
466 ; Их поле данных сможет меняться
467 ;
468 ;#FORTH
469 ; FORTH ( −− ) Сделать набор слов FORTH контекстным.
470 ; LFORTH:
471 .DB 5 ; 11143 = 2b87 = LFORTH:
472 .TEXT "FORTH" ; 11144: F79
473 .DW LLOADQ ; 11149:
474 .DW SDOEP ; 11151 = 2b8f = FORTH: (xt)
475 .DW DOVOC ; 11153: Обработчик VOCABULARY для DOES>
476 .DB 1,20H ; 11155: псевдозаголовок первого слова
477 .DB 2bH,99H ; 11157: ссылка на LTASK в новой адресации
478
479 ; Этим адресом инициализируется VOC−LINK
480 .DW 0 ; 11159 = 2b97 = XVOC: Это должно быть уже в байтовой памяти
481
482 ;#TASK
483 ; TASK ( −− ) Последнее слово ядра Каллисто.
484 ; В Форте слово TASK чаще всего используется оператором FORGET для сброса словаря в начальное состояние.
485 ;LTASK:
486 .DB 4 ; 11161 = 2b99 = LTASK
487 .TEXT "TASK" ; 11162:
488 .DB 2bH,87H ; 11166: 11143 rrDict, ссылка на LFORTH в единой адресации
489 .DW JNOP ; 11168 = TASK: (xt)
490 ; 11170 = 2ba2: этим адресом инициализируется H
491
492 ; Отсюда, из памяти программ, запускается шитый код −− сразу после "болванки" для инициализации USER и словаря.
493 ;
494 .DW SPSTO,RPSTO ; Инициализируем оба стека
495 .DW DARK,PDOTQ ; Вывод названия и версии транслятора
496 .DB 24 ; Длина первой строки
497 strForthM1: .DB 12 ; Начнём с CLS
498 .TEXT "Каллисто версия 0.9.5б" ; Фраза означает, что Каллисто удалила пользовательский словарь
499 .DB 10 ; Закончим LF
500 .DW BRAN,RWARM ; Передаём управление WARM (оптимизация)
501
502 ;#WARM
503 ; WARM ( −− ) Тёплая перезагрузка, словарь сохраняется.
504 ; Если может, запускает слово, токен которого лежит в APP
505 LWARM: .DB 4
506 .TEXT "WARM" ; К
507 .DW LCOLD
508 WARM: .DW CALL
509 RWARM: .DW SPSTO,RPSTO,DEC ; Объём памяти выводится в десятичной системе
510 .DW ZERO,FONTSTO,DARK,LITB ; Установка шрифта 0, вывод тёмным по светлому
511 .DB 13 ; RC
512 .DW EMIT,FREE,DOT ; Выводим размер свободной памяти
513 .DW PDOTQ
514 .DB 13 ; Начнём с CR
515 .TEXT "байт свободно" ; Суровое московское приветствие Каллисто
516 .DW BUFN,ZSTORE ; Сбрасываем флаг UPDATE и номер загруженного блока
517 .DW DISKOFF,LBRAC
518 .DB 2bH,8fH ; 11151 FORTH (xt)
519 .DW DEFIN, AUTOEXEC,UAT
520 .DW QDUP,ZBRAN,RQUIT ; Или на ABORT?
521 .DW EXEC ; Начать исполнение стартового кода, обычно это QUIT
522 .DW BRAN,RQUIT ; На случай, если слово вернуло управление
523
524 ;#UNUSED
525 ; UNUSED ( −− U ) Оценить количество свободных байт.
526 LFREE: .DB 6 ; ( −− n)
527 .TEXT "UNUSED"
528 .DW LWARM
529 FREE: .DW CALL, RPAT,PAD,SUB, EXIT ; Положить на стек количество свободных байт в словаре.
530
531 ;#BYE
532 ; BYE ( −− ) Выход из Каллисто в калькулятор МК−161.
533 LBYE: .DB 3
534 .TEXT "BYE"
535 .DW LFREE
536 BYE: .DW JBYE ; BYE может использоваться как временный, отладочный останов.
537
538 ;#VERSION
539 ; VERSION ( −− p) Версия Каллисто.
540 LVERSION: .DB 7
541 .TEXT "VERSION" ; ( −− r) К
542 .DW LBYE
543 VERSION: .DW JVERSION ; Кладёт на стек номер версии Каллисто.
544
545 ;#EXECUTE
546 ; EXECUTE ( т −− ) Исполнить слово с токеном т (CFA).
547 LEXEC: .DB 7
548 .TEXT "EXECUTE" ; ( i∗x xt −− j∗x) F79
549 .DW LVERSION
550 EXEC: .DW JEXEC ; Исполняет слово, CFA которого хранится в стеке.
551
552 ;#NOP
553 ; НОП ( −− ) Нет операции.
554 LNOP: .DB 3,141,142,143 ; "НОП"
555 .DW LEXEC
556 SNOP: .DW JNOP ; Пустая операция для инициализации DEFER −− ничего не делает.
557
558 ;#qBREAK
559 ; ?BREAK ( −− ) Проверить клавиатуру на паузу и аварийную остановку.
560 ; Проверяем клавиатуру на паузу и аварийную остановку.
561 ; +++ Возможно, код можно оптимизировать. Слово уникально для Каллисто.
562 LQBREAK: .DB 6
563 .TEXT "?BREAK" ; К
564 .DW LNOP
565 QBREAK: .DW JQBREAK
566 JQBREAK: PPRM 9028 ; Клавиша нажата?
567 21 − KX=09 ; Если нажата не К, продолжить
568 PGSB CSRON
569 QBL: PPRM 9028
570 KNOT FX=0 QBL
571 PPM 9029 ; Очистим буфер клавиатуры
572 QBL2: PPRM 9029 MA ; Читаем код клавиши
573 KNOT FX!=0 QBL2
574 PGSB CSROFF
575 RMA 26 − KX=09 ; Если не С/П, продолжаем
576 94 PPM 9020 ; "^"
577 67 PPM 9020 ; "C"
578 .NUM RABORT
579 PGOTO SETRIPRG ; Перейти на исполнение шитого кода с ABORT
580
581 ;#xLITERAL
582 ; (LITERAL) ( −− x ) Код периода выполнения для литерала.
583 ; В шитом коде за (LITERAL) идёт двухбайтовое целое со знаком в шестнадцатеричном формате.
584 LLIT: .DB 9
585 .TEXT "(LITERAL)"
586 .DW LQBREAK
587 LITD: .DW JLITD
588 JLITD: KRM6 RME ∗ KRM6
589 PLUSKM3M: + ; Код повторно используется обработчиком CONSTANT
590 KM3 ; PUSH MEMW[RI++]
591 32768 − KX>=09 ; Если число положительное, NEXT
592 FANS − PKM03 KGOTO9 ; Обработка отрицательных чисел, NEXT
593 LITP: .DW JLITP ; Литералы в области памяти программ
594 JLITP: PPRM9044 RME ∗ PPRM9044 + ; Все литералы в области программ положительные!
595 KM3 KGOTO9 ; PUSH MEMW[RI++]
596 LITB: .DW JLITB
597 JLITB: PPRM9044 KM3 KGOTO9 ; Специальный байтовый литерал для памяти программ.
598
599 ;#TYPE
600 ; TYPE ( a u −− ) Напечатать на индикаторе u литер от адреса a.
601 ; Передаёт u литер, начиная с адреса a на индикатор. В Форте вывод может дублироваться на принтер.
602 ; Подразумеваем, что строка не пересекает границу областей памяти.
603 LTYPE: .DB 4
604 .TEXT "TYPE" ; F79
605 .DW LLIT
606 TYPE: .DW JTYPE ; Примитив
607 JTYPE: RM3 M8 1 + MB 1 + M3
608 KRM8 M0 +/− KX<09 ; R0 := длина
609 KRMB MB 1 EE 4 − FX<0 TYPER
610 RMB
611 TYPEP: KPRGM PGSB CHPUT ; вывести очередную литеру из памяти программ
612 RMB 1 + MB FL0 TYPEP
613 KGRPH KGOTO9 ; NEXT
614 TYPER: 1 − M5
615 TYPERL: KRM5 PGSB CHPUT ; вывести очередную литеру из регистровой памяти
616 FL0 TYPERL
617 KGRPH KGOTO9 ; NEXT
618
619 ;#TYPE1
620 ; TYPE1 ( a u −− ) Напечатать на индикаторе в одну строку u литер от адреса a.
621 ; Вывести строку из памяти данных, заменяя управляющие коды и строго в одну строчку, до конца индикатора.
622 LTYPE1: .DB 5
623 .TEXT "TYPE1"
624 .DW LTYPE
625 TYPE1: .DW JTYPE1 ; Примитив
626 JTYPE1: 9 EE 3 MA
627 RM3 M8 1 + MB 1 + M3
628 KRM8 M0 +/− KX<09 ; R0 := длина
629 KRMB 1 EE 4 − KX>=09
630 1 − M5
631 TYPE1C: KRMA MB
632 KRM5 PPM9020 ; Вывести литеру
633 KRMA RMB − PX=0 TYPEC3 ; Курсор сдвинулся с места?
634 PPM9020 ; Вывести '.' ( RX==0)
635 KRMA RMB − FX=0 TYPEC3 ; По−прежнему застряли?
636 Cx 127 MB KMA ; Возможно, RB уже 127, но мы перестрахуемся
637 Cx 7 + RMB PPM 9012 ; Вывод линии, признак продолжения строки
638 KGRPH KGOTO9
639 TYPEC3: PFL0 TYPE1C
640 KGRPH KGOTO9
641
642 ;#qBRANCH
643 ; ?BRANCH ( ф −− ) Условное ветвление. Переход в шитом коде, если ф=0.
644 ; Служебное слово для реализации структур управления −− таких, как IF WHILE
645 LZBRAN: .DB 7
646 .TEXT "?BRANCH" ; ( f −− )
647 .DW LTYPE1
648 ZBRAND: .DW JZBRAND ; ?BRANCH в памяти данных
649 JZBRAND: RM3 M8 1 + M3 KRM8 ; POP RX
650 FX!=0 CNTD
651 KRM6 KRM6 KGOTO9 ; RI := RI+2, NEXT
652
653 ZBRAN: .DW JZBRAN ; ?BRANCH в памяти программ
654 JZBRAN: RM3 M8 1 + M3 KRM8 ; POP RX
655 FX!=0 CNT ; если RX==0, переход
656 PPRM9044 PPRM9044 ; RI := RI+2, пропускаем ячейку
657 KGOTO9 ; NEXT
658
659 ;#BRANCH
660 ; BRANCH ( −− ) Ветвление. Безусловный переход в шитом коде.
661 ; Служебное слово для реализации структур управления −− таких, как ELSE BEGIN
662 LBRAN: .DB 6
663 .TEXT "BRANCH"
664 .DW LZBRAN
665 BRAND: .DW CNTD ; Безусловный переход для памяти данных
666 POPCNTD: RM3 1 + M3
667 CNTD: KRM6 RME ∗ KRM6 + M6 KGOTO9
668
669 BRAN: .DW CNT ; Безусловный переход для памяти программ
670 POPCNT: RM3 1 + M3
671 CNT:
672 Cx PPM9210 ; Чтение двухбайтового значения по номеру X=0
673 PPM9042 ; RI := MEMW[RI]
674 KGOTO9 ; NEXT
675
676 ;#xFOR
677 ; (FOR) ( n −− ) Начало цикла со счётчиком в шитом коде (слово без заголовка).
678 ; Заголовок убран, слово (FOR) используется только словом FOR
679 ; Можно убрать второе слово на стеке возвратов и сделать компиляцию LEAVE более интеллектуальной.
680 ;LXFOR: .DB 5
681 ; .TEXT "(FOR)"
682 ; .DW LBRAN
683 XFORD: .DW JXFORD ; (FOR) в памяти данных
684 JXFORD: PKRM03 MA +/− PX<0 POPCNTD ; Защита от n<=0
685 RM3 1 + M3 ; POP n
686 KRM6 KRM6 KM2 <−> KM2 ; RPUSH MEMW[RI] ; RI := RI+2
687 RMA ENT RME / KINT MA RME ∗ − KM2 RMA KM2 ; RPUSH n
688 KGOTO9 ; NEXT
689
690 XFOR: .DW JXFOR ; (FOR) в памяти программ
691 JXFOR: PKRM03 MA +/− PX<0 POPCNT
692 RM3 1 + M3 ; POP n
693 PPRM9044 PPRM9044 KM2 <−> KM2 ; RPUSH MEMW[RI] ; RI := RI+2
694 RMA ENT RME / KINT MA RME ∗ − KM2 RMA KM2 ; RPUSH n
695 KGOTO9 ; NEXT
696
697 ;#xNEXT
698 ; (NEXT) ( −− ) Конец цикла со счётчиком в шитом коде (слово без заголовка).
699 ; Заголовок убран, слово (NEXT) используется только словом NEXT
700 ;LXNEXT: .DB 6
701 ; .TEXT "(NEXT)"
702 ; .DW LXFOR
703 XNEXTD: .DW JXNEXTD ; (NEXT) в памяти данных
704 JXNEXTD: RM2 MA 1 + MB
705 KRMB 1 − PX!=0 XNEQ0D ; Переход если мл.байт был равен 1
706 FX<0 KMBCNTD
707 KRMA PX!=0 XNEXITD ; Сюда перешли, если после декремента мл.байт < 0
708 1 − PX>=0 XNEXITD
709 KMA 255 ; +++ Можно попробовать RME, вдруг само ограничит до 255
710 KMBCNTD: KMB PGOTO CNTD
711 XNEQ0D: KRMA FX!=0 XNEXITD ; Переход, если счётчик == 0
712 Cx
713 PGOTO KMBCNTD
714 XNEXITD: KRM6 KRM6 ; Пропустить адрес перехода
715 JUNLOOP: 4 ; Обработчик UNLOOP
716 NLEV: RM2 + M2 ; Убрать из стека возвратов два слова, счётчик и адрес
717 KGOTO9
718
719 XNEXT: .DW JXNEXT ; (NEXT) в памяти программ
720 JXNEXT: RM2 MA 1 + MB
721 KRMB 1 − FX!=0 XNEQ0
722 FX<0 KMBCNT
723 KRMA FX!=0 XNEXIT
724 1 − FX>=0 XNEXIT
725 KMA 255 ; +++ Можно попробовать RME, вдруг само ограничит до 255
726 KMBCNT: KMB PGOTO CNT
727 XNEQ0: KRMA FX!=0 XNEXIT
728 Cx
729 GOTO KMBCNT
730 XNEXIT: PPRM9044 PPRM9044 ; Пропустить адрес перехода
731 GOTO JUNLOOP
732 JLEV: 2 GOTO NLEV ; Обработчик RDROP
733
734
735 ;#xFIND
736 ; (FIND) ( a1 a2 −− a3 c 1 | 0 ) Поиск слова a1 в словаре a2. Если найдено, вернуть nfa и байт счётчика.
737 ; Адрес_строки NFA => NFA длина TRUE/FALSE
738 ; В отличии от Форта ИТЭФ мы возвращаем NFA
739 ; a1 адрес строки со счётчиком −− слово, которое мы ищем (пока только в байтовой области)
740 ; a2 NFA первого слова в начале списка слов, где мы ищем
741 ; a3 CFA найденного слова в списке (может, всё−таки NFA?)
742 ; c байт длины и флагов найденого в списке слова
743 ; Сделать поиск и сравнение по словам
744 ;
745 ; Здесь в качестве истины возвращается 1, хотя Каллисто перешло на стандарт −1/0
746 ; +++ Возможно, слово нуждается в переделке.
747 LPFIND: .DB 6
748 .TEXT "(FIND)" ; ( a1 a2 −− a3 c 1 | 0 ) К
749 .DW LBRAN
750 PFIND: .DW JPFIND
751 JPFIND:
752 ; Сперва ищем в памяти данных
753 RM3 MA 1 + M3
754 PKRM03 1 EE 4 − MB ; RB адрес слова, которое мы ищем (строка со счётчиком)
755 KRMB M0 ; R0 Длина слова, которое мы ищем
756 RMB 1 + MB ; RB адрес первого символа слова, который мы ищем
757 KRMA
758 DFAST: M5 1 EE 4 − PX>=0 PFIND2
759 MA M5 ; RA=M5 адрес NFA слова в списке слов, с которым сравниваем
760 KRMA PKM03 63 KAND ; TOS байт длины и флагов очередного слова из списка
761 RM0 − FX=0 DSKIP ; Если длины и флаг SMUDGE различны, пропустить слово
762 KRM5 KRMB − FX!=0 SLO ; Если ещё и первые символы равны, сравнить слова подробней
763 DSKIP: PKRM03 31 KAND RMA + M5
764 KRM5 RME ∗ KRM5 + PX=0 DFAST ; LFA, Смотреть след. слово
765 PKM03 KGOTO9 ; Не нашли, в RX уже 0
766 SLO: RM0 M1 RMB M5 RMA 1 + M4 GOTO SLOIN ; Возможно можно обыграть R5 и сократить, ускорить поиск
767 SLOL: KRM4 KRM5 − FX=0 DSKIP
768 SLOIN: FL1 SLOL
769 PKRM03 RMA 1 EE 4 +
770 PGOTO PFTAIL ; NFA, нашли!
771
772 ; Затем ищем в памяти программ
773 PFIND2: RM5
774 FAST: MA ; RA адрес NFA слова в списке слов, с которым сравниваем
775 KPRGM PKM03 63 KAND ; TOS байт длины и флагов очередного слова из списка
776 RM0 − FX=0 SKIP ; Если длины и флаг SMUDGE различны, пропустить слово
777 RMA 1 + KPRGM KRMB − PX!=0 SLOW ; Если ещё и первые символы равны, сравнить слова подробней
778 SKIP: PKRM03 31 KAND 1 + RMA +
779 KPRGM FANS 1 + KPRGM
780 <−> RME ∗ + PX=0 FAST ; LFA, Смотреть след. слово
781 PKM03 KGOTO9 ; Не нашли, в RX уже 0
782 SLOW: RM0 M1 RMB M5 RMA 1 + GOTO SLOWIN
783 SLOWL: 1 + M8 ; R8 следующий символ
784 KPRGM KRM5 − PX=0 SKIP
785 RM8
786 SLOWIN: FL1 SLOWL
787 PKRM03 RMA
788 PFTAIL: PKM03 ; NFA, нашли!
789 <−> KM3 ; c
790 1 KM3 KGOTO9 ; 1
791
792 ;#DIGIT
793 ; DIGIT ( c u1 −− u2 1 | 0 ) Цифра. Преобразовать литеру c в число u2, используя основание u1.
794 ; ASCII−DIGIT BASE => DIGIT−VALUE TRUE / FALSE
795 ; Признаёт только заглавные буквы
796 ; Здесь в качестве истины возвращается 1, хотя Каллисто перешло на стандарт −1/0
797 ; +++ Возможно, слово нуждается в переделке.
798 LDIGIT: .DB 5
799 .TEXT "DIGIT" ; ( литера основание −− значение 1 | 0 ) Форт ИТЭФ
800 .DW LPFIND
801 DIGIT: .DW JDIGIT
802
803 ;#pe
804 ; П ( t z y x U −− t z y ) Запись в регистр МК−161 с номером U.
805 ; Запись в регистр МК−161 RU при стеке МК−161, заполненном на основе стека Форта.
806 ; Не осуществляет преобразование адресов, полностью "сырое" обращение к регистру.
807 LRSTO: .DB 1,143 ; "П"
808 .DW LDIGIT ; ( r1 r2 r3 значение номер −− r1 r2 r3 ) К
809 RSTO: .DW JRSTO
810 JRSTO: PKRM03 MA RM3 2 + M3 ; RA := u
811 3 + M0
812 KRM0 KRM0 KRM0 KRM0
813 KMA KGOTO9
814
815 ;#ipe
816 ; ИП ( U −− x ) Чтение регистра МК−161 с номером U.
817 ; Чтение из регистра МК−161 RU с сохранением стека МК−161 в переменных RX RY RZ RT
818 ; Не осуществляет преобразование адресов, полностью "сырое" обращение к регистру.
819 LIP: .DB 2,136,143 ; "ИП"
820 .DW LRSTO ; ( номер −− содержимое) К
821 IP: .DW JIP
822 JIP: CX ENT ENT
823 PKRM03 MA CX KRMA
824 PKM03
825 PM rRX FR PM rRY FR PM rRZ <−> PM rRT
826 KGOTO9
827
828 ;#xipe
829 ; (ИП) ( −− x ) Чтение регистра МК−161, указанного в шитом коде.
830 ; Чтение из регистра, номер которого зашит в шитом коде.
831 ; Помогает в реализации литералов с плавающей запятой.
832 ; Похожа на команду РР ИП (МК−152), но номер регистра в шестнадцатеричном формате
833 ; и считывание происходит в стек данных Каллисто. Слово уникально для Каллисто.
834 LXREG: .DB 4
835 .TEXT "("
836 .DB 136,143 ; "(ИП)"
837 .TEXT ")" ; ( −− n) К
838 .DW LIP
839 XREG: .DW JXREG
840 JXREG: KRM6 RME ∗ KRM6 +
841 MA KRMA KM3
842 KGOTO9
843
844 ;#ipeerghe
845 ; ИПРГ ( U −− c ) Чтение байта из памяти программ.
846 LIPRG: .DB 4,136,143,144,131 ; ( адрес −− значение ) "ИПРГ" К
847 .DW LXREG
848 IPRG: .DW JIPRG
849 JIPRG: PKRM03 KPRGM PKM03 ; Обёртка вокруг К ИПРГ (МК−161).
850 KGOTO9
851
852 JDIGIT: ; Обработчик DIGIT
853 RM3 MA ; [RA] == BASE
854 1 + M3
855 PKRM03 48 − FX>=0 STF ; Правильная цифра = ASCII − 48
856 MB 10 − FX>=0 MO9 ; Если >9
857 3 + MB
858 10 − FX>=0 STF
859 MO9: RMB KRMA − FX<0 STF ; Если не меньше BASE, то ошибка
860 RMB PKM03 ; Запись цифры в стек, "успешный" выход
861 JONE: ; Обработчик 1
862 1 KM3 KGOTO9
863
864 ; ∗∗ Стандартные слова ∗∗
865 ; ∗∗ Условные операторы ∗∗
866 ;
867 ;#ZeroEqual
868 ; 0= ( x −− f ) Проверка на равенство нулю.
869 ; Слово 0= часто используется, как логическое отрицание NOT. Заменяет 0 на −1 и наоборот.
870 LZEQU: .DB 2
871 .TEXT "0=" ; ( x −− флаг )
872 .DW LIPRG
873 ZEQU: .DW JZEQU
874 JZEQU: PKRM03 FX!=0 STT
875 STF: Cx PKM03 KGOTO9 ; [SP] := 0; NEXT
876
877 ;#ZeroMore
878 ; 0> ( x −− f ) Проверка на положительность.
879 LZGRET: .DB 2
880 .TEXT "0>" ; ( x −− флаг )
881 .DW LZEQU
882 ZGRET: .DW JZGRET
883 JZGRET: PKRM03 +/− FX<0 STF
884 STT: 1 +/− PKM03 KGOTO9 ; [SP] := −1; NEXT
885
886 JZLESS: ; Обработчик 0<
887 PKRM03 PX>=0 STT
888 Cx PKM03 KGOTO9
889
890 ;#ZeroLess
891 ; 0< ( x −− f ) Проверка на отрицательность.
892 LZLESS: .DB 2
893 .TEXT "0<" ; ( x −− флаг )
894 .DW LZGRET
895 ZLESS: .DW JZLESS
896
897 ;#Equal
898 ; = ( y x −− f ) Равно. Проверка на равенство.
899 ; В стандарте Форта слово = сравнивает значения на вершине стека побитово.
900 LEQUAL: .DB 1
901 .TEXT "=" ; ( a b −− флаг )
902 .DW LZLESS
903 EQUAL: .DW JEQUAL
904 JEQUAL: RM3 M8 1 + M3
905 PKRM03 KRM8 − PX!=0 STT
906 Cx PKM03 KGOTO9
907
908 ;#Less
909 ; < ( y x −− f ) Меньше. f равно −1 если и только если y меньше, чем x.
910 LLESS: .DB 1
911 .TEXT "<" ; ( a b −− флаг ) F83
912 .DW LEQUAL
913 LESS: .DW JLESS
914 JLESS: RM3 M8 1 + M3
915 PKRM03 KRM8 − PX>=0 STT
916 Cx PKM03 KGOTO9
917
918 ;#More
919 ; > ( y x −− f ) Больше. f равно −1 если и только если y больше, чем x.
920 LGREAT: .DB 1
921 .TEXT ">" ; ( a b −− флаг )
922 .DW LLESS
923 GREAT: .DW JGREAT
924 JGREAT: RM3 M8 1 + M3
925 KRM8 PKRM03 − PX>=0 STT ; +++ Здесь можно сократить 5 байт с помощью GOTO внутрь "<"
926 Cx PKM03 KGOTO9
927
928 ;#ENCLOSE
929 ; ENCLOSE ( a1 c −− a2 u1 u2 ) Окружить. Выделить лексему с адреса a1 и ограничительным символом c.
930 ; ∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗∗
931 ; Делает смелое предположение, что дело происходит не в памяти программ
932 ; Возможно, стоит разделить на пробел и не пробел или вообще переписать с нуля, пользуясь автоинкриментом.
933 ; В Форте−2012 передаётся размер строки и нет специального значения нуля.
934 LENCL: .DB 7
935 .TEXT "ENCLOSE" ; ENCLOSE ( a1 c −− a2 len da ) Форт ИТЭФ
936 .DW LGREAT
937 ENCL: .DW JENCL
938 JENCL: RM3 MA 1 + MB
939 KRMA M0 ; R0 Разделитель
940 KRMB 1 EE 4 − M8 M5 ; R5 Начальный адрес
941 A: Cx KRM8 RM0 − ; Обход разделителей в начале
942 FX=0 NOTEQ
943 AAA: RM8 1 + M8 PGOTO A
944 NOTEQ: RM0 32 − FX=0 ENCLNSP ; Только если пробел, проверять другие символы
945 KRM8 9 − FX!=0 AAA ; 9 TAB
946 1 − FX!=0 AAA ; 10 LF
947 3 − FX!=0 AAA ; 13 CR
948 ENCLNSP: Cx EE 4 RM8 M7 + KMB ; Начало лексемы
949 RM0 32 − FX!=0 AASP
950 AA: Cx KRM8 PX!=0 ZZZ ; Если нуль
951 RM0 − PX!=0 EQW
952 RM8 1 + M8 PGOTO AA
953 AASP0: RM8 1 + M8
954 AASP: Cx KRM8 PX!=0 ZZZ ; Если нуль
955 32 − PX!=0 EQW ; 32 пробел
956 PX<0 AASP0 ; Пропускаем всё, что больше пробела
957 23 + PX!=0 EQW ; 9 TAB
958 1 − PX!=0 EQW ; 10 LF
959 3 − PX=0 AASP0 ; 13 CR
960 EQW: RM8 RM7 − KMA
961 RM8 1 + RM5 − KM3
962 KGOTO9
963 ZZZ: RM8 RM7 − FX=0 EQW0
964 EE ; 0 −> 1
965 EQW0: KMA
966 RM8 RM5 − KM3
967 KGOTO9
968
969 ; ∗∗ Дисплей: вывод текста на индикатор ∗∗
970 ;
971 ;#EMI
972 ; EMI ( c n −− ) Вывод нескольких символов на индикатор.
973 LEMI: .DB 3
974 .TEXT "EMI"
975 .DW LENCL ; Слово FORTH ИТЭФ
976 EMI: .DW JEMI
977 JEMI: PKRM03 M0 ; Число символов
978 RM3 1 + M8 1 + M3
979 RM0 +/− KX<09 ; Проверка на отрицательное или нулевое число символов
980 EMIS1: KRM8 PGSB CHPUT ; Вывод символа
981 FL0 EMIS1
982 KGRPH KGOTO9
983
984 ;#EMIT
985 ; EMIT ( c −− ) Отобразить символ.
986 LEMIT: .DB 4
987 .TEXT "EMIT" ; F79
988 .DW LEMI
989 EMIT: .DW JEMIT
990 JEMIT: PKRM03 PGSB CHPUT ; Отображает на экране символ, код которого находится в стеке.
991 PGOTO CHPUTC3 ; Медленно, но пока так
992
993 JCDOT: PKRM03 MA ; Обработчик C.
994 PPRM9000 MB 121 − FX>=0 CHPUTC2 ; Грубая проверка, что символ уместится −− потом доработать
995 Cx MB PPM9000 ; CR, по достижении конца строки
996 PGSB CHPUTLF ; LF
997 CHPUTC2: RMA PPM9020 ; Вывести символ
998 PPRM9000 RMB − FX=0 CHPUTC3 ; Курсор сдвинулся с места?
999 Cx PPM9020 ; Вывести '.'
1000 CHPUTC3: KGRPH
1001 PGOTO JDROP
1002
1003 ;#Cd
1004 ; C. ( c −− ) Отобразить символ, заменяя управляющие на прямоугольники.
1005 LCDOT: .DB 2
1006 .TEXT "C." ; К
1007 .DW LEMIT
1008 CDOT: .DW JCDOT ; Выводит символ как в дампе, управляющие символы заменяются на '.'
1009
1010 ;#CR
1011 ; ↵ ( −− ) Возврат каретки. Продолжить вывод с начала следующей строки.
1012 LCR: .DB 1,192 ; К
1013 .DW LCDOT
1014 CR: .DW JCR ; Ради оптимизации обработчик перенесён поближе к CHPUT
1015
1016 ; ∗∗∗ Электронный звук ∗∗∗
1017
1018 ;#BELL
1019 ; BELL ( −− ) Звонок. Озвучить гудок терминала.
1020 LBELL: .DB 4
1021 .TEXT "BELL" ; F79
1022 .DW LCR
1023 BELL: .DW JBELL
1024 JBELL: PGSB CHPUTBELL KGOTO9
1025
1026 ;#BEEP
1027 ; BEEP ( p1 p2 −− ) Пищать. Издать звук частотой p1 Гц и длительностью p2 × 10 мс.
1028 ; +++ Лучше длительность сделать машинно−независимой −− в секундах или миллисекундах.
1029 LBEEP: .DB 4
1030 .TEXT "BEEP" ; ( частота длительность −− )
1031 .DW LBELL
1032 BEEP: .DW JBEEP
1033 JBEEP: RM3 MA 1 + MB 1 + M3
1034 KRMA FX!=0 BPL2 ; Нулевая длительность −− остановка воспроизведения
1035 BPL1: PPRM 9052 FX=0 BPL1 ; Ожидание конца предыдущего сигнала
1036 KRMB
1037 BPL2: KRMA PPM 9052 ; Формирование звукового сигнала
1038 KGOTO9
1039
1040 ;#xPLAY
1041 ; (PLAY) ( a u −− ) Играть музыку. Проиграть u нот, начиная с адреса a.
1042 ; +++ Потом сделать не частоту, а ноту от 25 до 25000 Гц
1043 ; Также темп записать в переменную и умножать длительность на неё
1044 ; Расчёт стакатто/легатто и т.п. лучше сделать до компиляции мелодии на ММЯ
1045 ; В результате таблица будет занимать меньше места, состоя из 2−байтовых элементов
1046 LXPLAY: .DB 6
1047 .TEXT "(PLAY)" ; ( адрес число−нот −−)
1048 .DW LBEEP
1049 XPLAY: .DW JXPLAY
1050 JXPLAY: PKRM03 KINT M0 ; число нот
1051 RM3 1 + MA 1 + M3
1052 RM0 +/− KX<09 ; число−нот должно быть положительным
1053 KRMA 10001 − KX>=09 M5
1054 9052 M8 ; быстрее? Надо проверить!
1055 XPL1: KRM5 RME ∗ KRM5 + MA ; 2 байта: длительность
1056 KRM5 RME ∗ KRM5 + 10 / MB ; 2 байта: частота∗10
1057 XPL2: KRM8 FX=0 XPL2 ; Ожидание конца предыдущего сигнала
1058 RMB RMA KM8 ; Формирование звукового сигнала
1059 PFL0 XPL1
1060 KGOTO9
1061
1062 ; ∗∗∗ Машинная графика ∗∗∗
1063
1064 ;#LIGHT
1065 ; LIGHT ( −− ) Установить вывод на индикатор светлым по тёмному.
1066 ; Выбрать светлый (зелёный) цвет для рисования (хорошо выглядит на тёмном фоне). Также делает прокрутку тёмной.
1067 LLIGHT: .DB 5
1068 .TEXT "LIGHT" ; К
1069 .DW LXPLAY
1070 LIGHT: .DW JLIGHT
1071 JLIGHT: 4 PPM 9001 9008 PM19 KGOTO9
1072
1073 ;#DARK
1074 ; DARK ( −− ) Установить вывод на индикатор тёмным по светлому.
1075 ; Выбрать тёмный (чёрный) цвет для рисования (хорошо выглядит на светлом фоне). Также делает прокрутку светлой.
1076 LDARK: .DB 4
1077 .TEXT "DARK" ; К
1078 .DW LLIGHT
1079 DARK: .DW JDARK
1080 JDARK: Cx PPM 9001 9007 PM19 KGOTO9
1081
1082 ;#DOTStore
1083 ; DOT! ( c1 c2 −− ) Отобразить точку на индикаторе в колонке c1 строки c2.
1084 ; Отображение точки на экране (R9011)
1085 ; x y DOT! − значения координат x и y
1086 ; Позиция курсора не меняется.
1087 ; Атрибут из R9001. Обёртка вокруг R9011, но порядок аргументов взят из colorForth.
1088 LPLOT: .DB 4
1089 .TEXT "DOT!" ; ( X Y −− )
1090 .DW LDARK
1091 PLOT: .DW JPLOT
1092 JPLOT: 11 ENT ; 9011 Вывод точки
1093 JPL0: 9 EE 3 + M8 ; +++ В железном МК−161 после БП не нужен ENT
1094 RM3 MB M5 2 + M3
1095 KRMB KRM5 KM8
1096 KGOTO9
1097 JFIX: 0
1098 JJPL0: PGOTO JPL0 ; 9000 AT Установить курсор
1099 JDRAW: 12 GOTO JJPL0 ; 9012 BAR Вывод линии
1100 JBOX: 13 GOTO JJPL0 ; 9013 +BOX Вывод прямоугольника
1101 JFRAME: 14 GOTO JJPL0 ; 9014 +FRAME Вывод рамки
1102
1103 ;#BAR
1104 ; BAR ( c1 c2 −− ) Прочертить линию на индикаторе до точки (x,y)=(c1,c2).
1105 ; x y BAR рисует прямые линии (R9012), x и y − координаты конца линии
1106 ; Линия начинается из текущей позиции курсора, заданной AT
1107 ; Позиция курсора не меняется.
1108 ; Атрибут из R9001. Обёртка вокруг R9012, но порядок аргументов взят из colorForth.
1109 LDRAW: .DB 3
1110 .TEXT "BAR" ; ( X Y −− )
1111 .DW LPLOT
1112 DRAW: .DW JDRAW
1113
1114 ;#PlusBOX
1115 ; +BOX ( c1 c2 −− ) Нарисовать на индикаторе прямоугольник шириной c1 высотой c2.
1116 ; dX dY +BOX рисует прямоугольник, dX и dY − размер прямоугольника
1117 ; Прямоугольник начинается от текущей позиции курсора, заданной AT
1118 ; Атрибут из R9001. Обёртка вокруг R9013, но порядок аргументов взят из colorForth.
1119 LBOX: .DB 4
1120 .TEXT "+BOX" ; ( dX dY −− )
1121 .DW LDRAW
1122 BOX: .DW JBOX
1123
1124 ;#PlusFRAME
1125 ; +FRAME ( c1 c2 −− ) Нарисовать на индикаторе рамку шириной c1 высотой c2.
1126 ; dX dY +FRAME рисует рамку, dX и dY − размер рамки
1127 ; Рамка начинается от текущей позиции курсора, заданной AT
1128 ; Атрибут из R9001. Обёртка вокруг R9014, но порядок аргументов взят из colorForth.
1129 LFRAME: .DB 6
1130 .TEXT "+FRAME" ; ( dX dY −− )
1131 .DW LBOX
1132 FRAME: .DW JFRAME
1133
1134 ;#gheeref
1135 ; ГРФ ( −− ) Вывести графическую информацию. Обновить индикатор.
1136 LGRPH: .DB 3,131,144,148 ; "ГРФ"
1137 .DW LFRAME
1138 GRPH: .DW JGRPH
1139 JGRPH: KGRPH KGOTO9 ; Вывод графической информации. Обётка вокруг К ГРФ.
1140
1141 ;#PAGE
1142 ; ↖ ( −− ) Очистить индикатор. Курсор в левый верхний угол.
1143 LPAGE: .DB 1,200 ; К
1144 .DW LGRPH
1145 PAGE: .DW JPAGE ; Очищаем экран, курсор в левый верхний угол. Шрифт не меняем.
1146
1147 ;#AT
1148 ; AT ( c1 c2 −− ) Установить курсор в столбец c1 строки c2.
1149 LFIX: .DB 2
1150 .TEXT "AT" ; ( x y −− )
1151 .DW LPAGE
1152 FIX: .DW JFIX ; Позиционирование курсора: x y AT
1153
1154 ;#FONTStore
1155 ; FONT! ( u −− ) Установить на индикаторе шрифт u (0−2).
1156 ; Установка шрифта на индикаторе МК−161 и сопутствующего ему описания, см. _FONT
1157 LFONTSTO: .DB 5
1158 .TEXT "FONT!"
1159 .DW LFIX
1160 FONTSTO: .DW JFONTSTO
1161 JFONTSTO: RM3 MA 1 + M3 ; Убираем u из стека
1162 .NUM rrCHWM1
1163 M5 ; R5 указывает на 5 байт, описывающих шрифт
1164 KRMA ; RX: номер шрифта, который устанавливаем
1165 PPM9003 ; Установим заказанный шрифт
1166 PX=0 FS12 ; Это шрифт 0?
1167 8 KM5 KM5 6 KM5 1 KM5 Cx KM5 ; Описание шрифта 0
1168 KGOTO9
1169 FS12: 1 − FX=0 FS2 ; Это шрифт 1?
1170 8 KM5 14 KM5 9 KM5 2 KM5 KM5 ; Описание шрифта 1
1171 KGOTO9
1172 FS2: 19 KM5 KM5 12 KM5 3 KM5 5 KM5 ; Описание шрифта 2
1173 KGOTO9 ; А самопальные шрифты пусть сами устанавливаются
1174
1175 ;#DISKOFF
1176 ; DISKOFF ( −− ) Запрет дисковых операций.
1177 LDISKOFF: .DB 7
1178 .TEXT "DISKOFF" ; К
1179 .DW LFONTSTO
1180 DISKOFF: .DW JDISKOFF
1181 JDISKOFF: Cx PPM 9120 KGOTO9
1182
1183 ; ∗∗ Клавиатура ∗∗
1184
1185 ;#KEY
1186 ; KEY ( −− c ) Ввод символа с клавиатуры.
1187 LKEY: .DB 3
1188 .TEXT "KEY" ; F79
1189 .DW LDISKOFF
1190 KEY: .DW JKEY ; Ожидает ввод символа с клавиатуры, при вводе кладёт его код на стек.
1191
1192 ;#EKEY
1193 ; EKEY ( −− c ) Ожидание нажатия клавиши и получение её кода.
1194 LEKEY: .DB 4
1195 .TEXT "EKEY"
1196 .DW LKEY
1197 EKEY: .DW JEKEY
1198 JEKEY: KM3 ; Чтение клавиатуры МК−161 −− клавиш, а не символов.
1199 EKEYL: PPRM 9029
1200 PKM03
1201 KNOT FX!=0 EKEYL
1202 KGOTO9
1203
1204 ;#INKEY
1205 ; INKEY ( −− b ) Получить код нажатой клавиши или −1, если клавиши не нажаты.
1206 LINKEY: .DB 5
1207 .TEXT "INKEY"
1208 .DW LEKEY
1209 INKEY: .DW JINKEY
1210 JINKEY: PPRM 9028 ; Чтение состояния клавиатуры МК−161
1211 KM3
1212 KNOT KX=09
1213 PGOTO STT ; 1 +/− PKM03 KGOTO9
1214
1215 ;#ACCEPT
1216 ; ACCEPT ( a c1 −− c2 ) Ввести с клавиатуры строку в буфер с адресом a длиной c1. c2 −− число введённых литер.
1217 ; Этот код большой и важный, его можно вынести в BIOS.
1218 ; В конце два нуля не добавляются, теперь это обязанность вызывающей стороны.
1219 ; Теоретически в стеке возвратов можно хранить только "толщину" символов.
1220 ; Можно предусмотреть редактирование предыдущей строки, если такая была в буфере.
1221 LACCE: .DB 6
1222 .TEXT "ACCEPT" ; ( a n1 −− n2 )
1223 .DW LINKEY
1224 ACCE: .DW JACCE
1225 JACCE: RM3 MA 1 + MB M3 ; Можно встроить проверку, куда идёт запись
1226 KRMB 4 F10^X − MB ; RB − адрес, куда записываются символы
1227 KRMA M7 ; R7 − максимальное количество символов
1228 PPRM rrSCRLN ; Заранее готовим данные для прокрутки
1229 8 ∗ M4 ; R4 − на сколько линий корректируем y при прокрутке
1230 RM2 M1 ; R1 − буфер в стеке возвратов, хранящий "откат"
1231 ACCST: CX M0 ; R0 − количество введённых символов
1232 EXPE0: PGSB CHGET
1233 MA 8 − FX=0 EXPE1 ; Введён код BS?
1234 RM0 FX!=0 EXPE0 ; Если ничего не введено, игнорировать
1235 1 − M0 PGSB ACCBS ; Удалим последний символ
1236 JEXPE0: GOTO EXPE0
1237 EXPE1: 5 − FX=0 EXPE2 ; ENTER?
1238 RM0 PKM03 KGOTO9 ; Возвращаем длину строки
1239 EXPE2: 114 − FX=0 ACCECH ; F CX?
1240 RM0 FX!=0 EXPE0 ; Если ничего не введено, игнорировать
1241 ACCLP: PGSB ACCBS
1242 FL0 ACCLP
1243 GOTO ACCST
1244 ACCECH:
1245 RM0 RM7 − FX<0 EXPE0 ; Введены все символы?
1246 RM0 1 + M0 ; Увеличим счётчик символов
1247 RMA KMB RMB 1 + MB ; Добавим символ к строчке
1248 PPRM9000 ; Берём координаты курсора
1249 129 PPRM rrCHW − ; Предельная координата по горизонтали
1250 − PX>=0 EXPE3 ; В конце экранной строки?
1251 <−> PPRM rrCHH + ; Увеличиваем на высоту данного шрифта
1252 65 FANS − − PX<0 EXPE4 ; На последней строке?
1253 FANS + 0 PPM9000 ; Просто опускаемся на строчку вниз, в начало
1254 GOTO EXPE3
1255 EXPE4: PGSB CHPUTCR ; Курсор в начало строки
1256 PGSB CHPUTSCROLL ; Прокрутка экрана нужным цветом на нужное число строк
1257 RM1 ; Начало буфера откатов
1258 EXPE5: M8 RM2 − FX<0 EXPE3 ; Всё скорректировали?
1259 KRM8 RM4 − 0 KMAX KM8 ; y −= 8 ∗ кол−во линий прокрутки или 0
1260 RM8 3 + GOTO EXPE5
1261 EXPE3: ; Вывод обычного символа на экран
1262 RM1 3 − M1 1 − M5 ; Новый элемент в буфере откатов
1263 PPRM9000 <−> KM5 FANS KM5 ; Записываем Y, X; X в RX1
1264 RMA PPM9020 ; Выводим символ на индикатор
1265 PPRM9000 FANS − KM5 ; Записываем dX
1266 PGOTO EXPE0
1267 ACCBS: ; Клавиша Cx, делаем "пробел назад" (BS)
1268 RMB 1 − MB ; Укоротить введённую строку, можно использовать FL1 ?
1269 RM1 3 + M1 4 − M5 ; Укоротить буфер откатов на 3 байта
1270 KRM5 KRM5 PPM9000 ; Считать y, x; Установить курсор на предыдущий символ
1271 4 PPRM9001 KXOR ; Сохранить атрибуты вывода в RX1
1272 PPM9001 ; Установить атрибут 4 для DARK и 0 для LIGHT
1273 PPRM rrCHH KRM5 PPM9013 ; Шрифтовой dy; Считать dX; Вывод прямоугольника (dX может быть равен нулю)
1274 FANS PPM9001 ; Восстановить атрибуты вывода из X1
1275 RTN
1276
1277 ; ∗∗ Арифметика ∗∗
1278 ;
1279 ;#OnePlus
1280 ; 1+ ( x −− x1 ) Увеличить. x1 := x+1
1281 LONEP: .DB 2
1282 .TEXT "1+" ; ( x −− x+1) F79
1283 .DW LACCE
1284 ONEP: .DW JONEP ; Прибавление 1.
1285
1286 ;#TwoPlus
1287 ; 2+ ( x −− x1 ) Прибавить два. x1 := x+2
1288 LTWOP: .DB 2
1289 .TEXT "2+" ; ( x −− x+2) F79
1290 .DW LONEP
1291 TWOP: .DW JTWOP ; Прибавление 2.
1292 JTWOP: 2
1293 .DB 59H ; FX>=0 aka пропустить 1 байт
1294 JONEP: 1
1295 NONEP: PKRM03 + PKM03 KGOTO9
1296 JONEM: 1 +/− GOTO NONEP
1297 JTWOM: 2 +/− GOTO NONEP
1298 JMUL2: PKRM03 GOTO NONEP
1299
1300 ;#toBODY
1301 ; >BODY ( т −− a ) К телу. Преобразовать адрес поля кода в адрес поля параметров.
1302 LGBODY: .DB 5
1303 .TEXT ">BODY" ; ( cfa −− pfa) F83
1304 .DW LTWOP
1305 GBODY: .DW JTWOP ; Синоним 2+
1306
1307 ;#OneMinus
1308 ; 1− ( x −− x1 ) Уменьшить. x1 := x−1
1309 LONEM: .DB 2
1310 .TEXT "1−" ; ( x −− x−1) F79
1311 .DW LGBODY
1312 ONEM: .DW JONEM ; Вычитание 1.
1313
1314 ;#TwoTimes
1315 ; 2× ( x −− x1 ) Удвоить. x1 := x×2
1316 LMUL2: .DB 2
1317 .TEXT "2" ; "2∗" ( x −− 2∗x) К
1318 .DB 179 ; Символ умножения МК−161
1319 .DW LONEM
1320 MUL2: .DW JMUL2 ; Умножение на 2 (двоичный сдвиг влево).
1321
1322 ;#TwoDiv
1323 ; 2/ ( x −− n ) Половина. n := Trunc [x/2]
1324 ; +++ Проверить работу с отрицательными числами.
1325 LDIV2: .DB 2
1326 .TEXT "2/" ; ( n −− [n/2]) F79
1327 .DW LMUL2
1328 DIV2: .DW JDIV2
1329 JDIV2: PKRM03 2 / KINT PKM03 KGOTO9 ; Целочисленное деление на 2 (двоичный сдвиг вправо).
1330
1331 ;#TwoMinus
1332 ; 2− ( x −− x1 ) Вычесть два. x1 := x−2
1333 LFDIV2: .DB 2
1334 .TEXT "2−" ; ( x −− x−2) К
1335 .DW LDIV2
1336 TWOM: .DW JTWOM ; Вычитание 2.
1337
1338 ;#Plus
1339 ; + ( y x −− x1 ) Сложить. x1 := y+x
1340 LPLUS: .DB 1
1341 .TEXT "+" ; ( a b −− a+b) F79
1342 .DW LFDIV2
1343 PLUS: .DW JPLUS ; Сложение.
1344 JPLUS: RM3 MB 1 + MA M3
1345 KRMA KRMB + KMA ; Обёртка вокруг +
1346 KGOTO9
1347
1348 ;#Minus
1349 ; − ( y x −− x1 ) Вычесть. x1 := y−x
1350 LSUB: .DB 1
1351 .TEXT "−" ; ( a b −− a−b) F79
1352 .DW LPLUS
1353 SUB: .DW JSUB ; Вычитание x из y.
1354 JSUB: RM3 MB 1 + MA M3
1355 KRMA KRMB − KMA ; Обёртка вокруг −
1356 KGOTO9
1357
1358 ;#Times
1359 ; × ( y x −− x1 ) Умножить. x1 := y×x
1360 LSTAR: .DB 1,179 ; "∗" Символ умножения на МК−161.
1361 .DW LSUB ; ( a b −− a∗b) К
1362 STAR: .DW JSTAR ; Произведение чисел y и x.
1363 JSTAR: RM3 MB 1 + MA M3
1364 KRMA KRMB ∗ KMA ; Обёртка вокруг ∗
1365 KGOTO9
1366
1367 ;#Div
1368 ; ÷ ( y x −− x1 ) Разделить. x1 := y÷x
1369 ; Деление с десятичной плавающей запятой.
1370 LFDIV: .DB 1,176 ; Символ деления на МК−161.
1371 .DW LSTAR ; ( делимое делитель −− частное) К
1372 FDIV: .DW JFDIV ; ( a b −− a/b)
1373 JFDIV: RM3 MB 1 + MA M3
1374 KRMA KRMB / KMA ; Обёртка вокруг /
1375 KGOTO9
1376
1377 ;#Slash
1378 ; / ( y x −− n ) Делить нацело. n := Trunc [y/x]
1379 ; +++ Проверить работу с отрицательными числами.
1380 LSLASH: .DB 1
1381 .TEXT "/" ; ( делимое делитель −− частное) F79
1382 .DW LFDIV ; ( a b −− [a/b] )
1383 SLASH: .DW JSLASH
1384 JSLASH: RM3 MB 1 + MA M3 ; Целочисленное деление делимого x1 на делитель x2, кладёт частное n на стек.
1385 KRMA KRMB / KINT KMA
1386 KGOTO9
1387
1388 ;#MOD
1389 ; MOD ( y x −− x1 ) Получение остатка от деления y на x. x1 := y mod x
1390 ; +++ Проверить работу с отрицательными числами.
1391 LMOD: .DB 3
1392 .TEXT "MOD" ; ( делимое делитель −− остаток) F79
1393 .DW LSLASH
1394 MOD: .DW JMOD
1395 JMOD: RM3 MB 1 + MA M3 ; Получение остатка x1 от деления делимого y на делитель x.
1396 KRMA ENT KRMB / KINT KRMB ∗ − KMA
1397 KGOTO9
1398
1399 ;#SlashMOD
1400 ; /MOD ( y x −− y1 n ) Делить y на x с частным n и остатком y1. n := Trunc [y/x], y1 := y mod x
1401 ; +++ Проверить работу с отрицательными числами.
1402 LSLMOD: .DB 4
1403 .TEXT "/MOD" ; ( делимое делитель −− остаток частное) F79
1404 .DW LMOD
1405 SLMOD: .DW JSLMOD
1406 JSLMOD: RM3 MB 1 + MA ; Деление с остатком делимого y на делитель x.
1407 KRMA KRMA KRMB / FANS <−> KINT KMB ∗ − KMA
1408 KGOTO9
1409
1410 ;#TimesSlash
1411 ; ×/ ( z y x −− n ) Поделить произведение z×y на x. n := Trunc [x1×x2/x3]
1412 ; Операция масштабирования −− умножение z на y с последующим делением на x.
1413 ; Промежуточный результат умножения z∗y содержит 14 десятичных разрядов.
1414 ; Присутствует ещё в Форте−79, но везде обозначается ∗/
1415 LSSLA: .DB 2
1416 .DB 179 ; Символ умножения МК−161.
1417 .TEXT "/" ; ( множитель1 множитель2 делитель −− частное) К
1418 .DW LSLMOD ; ( a b c −− [a∗b/c] )
1419 SSLA: .DW JSSLA
1420 JSSLA: RM3 M8 1 + MA 1 + MB M3
1421 KRMB KRMA ∗ KRM8 / KINT KMB
1422 KGOTO9
1423
1424 ;#TimesSlashMOD
1425 ; ×/MOD ( z y x −− y1 n ) Получение частного n и остатка y1 от деления произведения z×y на x.
1426 ; Остаток y1 и частное n от деления произведения z∗y на x.
1427 ; Промежуточный результат z∗y содержит 14 десятичных разрядов.
1428 LSSMOD: .DB 5
1429 .DB 179 ; Символ умножения МК−161.
1430 .TEXT "/MOD" ; "∗/MOD" ( множитель1 множитель2 делитель −− остаток частное) К
1431 .DW LSSLA
1432 SSMOD: .DW JSSMOD
1433 JSSMOD: RM3 M8 1 + MA M3 1 + MB
1434 KRMB KRMA ∗ ENT KRM8 / FANS <−> KINT KMA ∗ − KMB
1435 KGOTO9
1436
1437 ;#NEGATE
1438 ; /−/ ( x −− x1 ) Смена знака. x1 := −x
1439 LNEGATE: .DB 3
1440 .TEXT "/−/" ; ( x −− −x) К
1441 .DW LSSMOD
1442 NEGATE: .DW JNEGATE ; Смена знака числа в стеке.
1443 JNEGATE: PKRM03 +/− PKM03 KGOTO9 ; Обёртка вокруг /−/
1444
1445 ;#SWAB
1446 ; >< ( U −− U1 ) Обменять старший и младший байты в 16−битном числе U.
1447 ; +++ Предусмотреть отрицательные и запредельные числа.
1448 LSWAB: .DB 2
1449 .TEXT "><" ; F79
1450 .DW LNEGATE
1451 SWAB: .DW JSWAB
1452 JSWAB: RM3 M8
1453 KRM8 ENT RME / FANS <−> KINT MA ∗ −
1454 RME ∗ RMA + KM8 KGOTO9
1455
1456 ;#StoD
1457 ; S>D ( n −− u1 u2 ) Преобразовывает 32−битное число n в пару 16−битных чисел u2 u1.
1458 ; Немного сложнее DUP 0< т.к. мы преобразовываем 12−разрядные десятичные числа, а не 16−битные двоичные.
1459 ; +++ Можно сократить, сделав RME FX^2 вместо ENT 65536.
1460 LSTOD: .DB 3
1461 .TEXT "S>D" ; ( n −− dd ) F12
1462 .DW LSWAB
1463 STOD: .DW JSTOD
1464 JSTOD: RM3 M8 KRM8 PGSB Norm32
1465 ENT ENT 65536 / FANS <−> KINT KM3 ∗ − KM8 KGOTO9
1466
1467 ;#ABS
1468 ; |X| ( x −− p ) Вычисление модуля. p := |x|
1469 LABS: .DB 3
1470 .TEXT "|X|" ; ( x −− |x| ) К
1471 .DW LSTOD
1472 ABS: .DW JABS ; Получение абсолютного значения.
1473 JABS: PKRM03 KABS PKM03 KGOTO9 ; Обёртка вокруг K |x|
1474
1475 ;#AND
1476 ; AND ( n1 n2 −− i ) 32−битное логическое умножение (и). i := n1 & n2
1477 ; +++ Цикл можно развернуть и оптимизировать, если будет достаточно памяти.
1478 LSAND: .DB 3
1479 .TEXT "AND" ; ( a b −− a & b ) F79
1480 .DW LABS
1481 SAND: .DW JSAND ; 32−битное побитовое логическое умножение (И).
1482 JSAND: RM3 MB 1 M1 + MA M3
1483 CX M8 4 M0
1484 KRMB PGSB Norm32 MB
1485 KRMA PGSB Norm32 MA
1486 PGOTO SANDIN
1487 SANDL: M8 RM1 RME ∗ M1
1488 RMA
1489 SANDIN: ENT RME / FANS <−> KINT MA ∗ −
1490 RMB ENT RME / FANS <−> KINT MB ∗ −
1491 KAND RM1 ∗ RM8 +
1492 PFL0 SANDL
1493 PGSB Sign32
1494 PKM03 KGOTO9
1495
1496 ; Приводит 32−битное число в беззнаковый вид.
1497 ; Можно также подогнать под двоичные машины переполнения, в обе стороны.
1498 Norm32: FX<0 N32A
1499 65536 FX^2 + ; FX^2 vs ENT ∗
1500 N32A: RTN
1501
1502 ;#OR
1503 ; OR ( n1 n2 −− i ) 32−битное логическое сложение (или). i := n1 ∨ n2
1504 LSOR: .DB 2
1505 .TEXT "OR" ; ( a b −− a OR b ) F79
1506 .DW LSAND ; 32−битное побитовое логическое сложение (ИЛИ).
1507 SOR: .DW JSOR
1508 JSOR: RM3 MB 1 M1 + MA M3
1509 CX M8 4 M0
1510 KRMB GSB Norm32 MB
1511 KRMA GSB Norm32 MA
1512 GOTO SORIN
1513 SORL: M8 RM1 RME ∗ M1
1514 RMA
1515 SORIN: ENT RME / FANS <−> KINT MA ∗ −
1516 RMB ENT RME / FANS <−> KINT MB ∗ −
1517 KOR RM1 ∗ RM8 +
1518 PFL0 SORL
1519 GSB Sign32
1520 PKM03 KGOTO9
1521 ;
1522 ; Преобразование 32−битного беззнакового в 32−битное знаковое.
1523 Sign32:
1524 32768 ENT 65536 ∗ ; 2 147 483 648
1525 − FX<0 S32Fix
1526 FANS + RTN ; Восстановить исходное число
1527 S32Fix: FANS − RTN ; Преобразовать
1528
1529 ;#XOR
1530 ; XOR ( n1 n2 −− i ) 32−битное сложение по модулю два (исключающее или). i := n1 ⊕ n2
1531 LSXOR: .DB 3
1532 .TEXT "XOR" ; ( a b −− a XOR b) F79
1533 .DW LSOR
1534 SXOR: .DW JSXOR ; 32−битное побитовое логическое исключающее ИЛИ (XOR).
1535 JSXOR: RM3 MB 1 M1 + MA M3
1536 CX M8 4 M0
1537 KRMB PGSB Norm32 MB
1538 KRMA PGSB Norm32 MA
1539 GOTO SXORIN
1540 SXORL: M8 RM1 RME ∗ M1
1541 RMA
1542 SXORIN: ENT RME / FANS <−> KINT MA ∗ −
1543 RMB ENT RME / FANS <−> KINT MB ∗ −
1544 KXOR RM1 ∗ RM8 +
1545 FL0 SXORL
1546 PGSB Sign32
1547 PKM03 KGOTO9
1548
1549 ;#NOT
1550 ; NOT ( n −− i ) 32−битная логическая инверсия (не). i := ∼n
1551 LINVERT: .DB 3
1552 .TEXT "NOT" ; ( n −− NOT n ) К
1553 .DW LSXOR
1554 INVERT: .DW JINVERT ; 32−битное побитовое логическое отрицание (НЕ).
1555 JINVERT: PKRM03 PGSB Sign32
1556 1 + +/− PKM03 KGOTO9 ; Отрицание через арифметику.
1557
1558 ;#MIN
1559 ; MIN ( y x −− x1 ) Меньшее из двух чисел. x1 := min (x, y)
1560 LMIN: .DB 3
1561 .TEXT "MIN" ; ( a b −− min) F79
1562 .DW LINVERT
1563 MIN: .DW JMIN
1564 JMIN: RM3 MB 1 + MA M3
1565 KRMB KRMA KMAX <−> KMA ; Выделение минимума, обёртка вокруг K MAX (МК−161).
1566 KGOTO9
1567
1568 ;#MAX
1569 ; MAX ( y x −− x1 ) Большее из двух чисел. x1 := max (x, y)
1570 LMAX: .DB 3
1571 .TEXT "MAX" ; ( a b −− max) F79
1572 .DW LMIN
1573 MAX: .DW JMAX
1574 JMAX: RM3 MB 1 + MA M3
1575 KRMB KRMA KMAX KMA ; Выделение максимума, обёртка вокруг K MAX.
1576 KGOTO9
1577
1578 ; ∗∗∗ Примитивы МК−161 ∗∗∗
1579 ;#FALOG
1580 ; 10ˣ ( x −− p ) Десятичный антилогарифм. p := 10^x
1581 LEXP10: .DB 3
1582 .TEXT "10" ; ( x −− 10^x) К
1583 .DB 190 ; 10^X
1584 .DW LMAX
1585 EXP10: .DW JEXP10
1586 JEXP10: PKRM03 F10^X PKM03 KGOTO9 ; Обёртка вокруг F10^X.
1587
1588 ;#FEXP
1589 ; Eˣ ( x −− p ) Экспонента. p := e^x
1590 LEXPE: .DB 2
1591 .TEXT "E" ; ( x −− e^x) К
1592 .DB 190 ; E^X
1593 .DW LEXP10
1594 EXPE: .DW JEXPE
1595 JEXPE: PKRM03 FEXP PKM03 KGOTO9 ; Обёртка вокруг FEXP.
1596
1597 ;#LG
1598 ; LG ( p −− x ) Десятичный логарифм. x := lg p
1599 LLG: .DB 2
1600 .TEXT "LG" ; ( x −− lg x) К
1601 .DW LEXPE
1602 LG: .DW JLG
1603 JLG: PKRM03 FLG PKM03 KGOTO9 ; Обёртка вокруг Flg.
1604
1605 ;#LN
1606 ; LN ( p −− x ) Натуральный логарифм. x := ln p
1607 LLN: .DB 2
1608 .TEXT "LN" ; ( x −− ln x) К
1609 .DW LLG
1610 LN: .DW JLN
1611 JLN: PKRM03 FLN PKM03 KGOTO9 ; Обёртка вокруг Fln.
1612
1613 ;#Xcaret2
1614 ; X² ( x −− p ) Квадрат числа. p := x^2
1615 LX2: .DB 2
1616 .TEXT "X" ; ( x −− x^2) К
1617 .DB 189 ; X^2
1618 .DW LLN
1619 X2: .DW JX2
1620 JX2: PKRM03 FX^2 PKM03 KGOTO9 ; Обёртка вокруг FX^2.
1621
1622 ;#FSQRT
1623 ; √ ( p −− p1 ) Квадратный корень. p1 := sqrt p
1624 LSQRT: .DB 1,251 ; ( r −− sqrt r) К
1625 .DW LX2
1626 SQRT: .DW JSQRT
1627 JSQRT: PKRM03 FSQRT PKM03 KGOTO9 ; Обёртка вокруг FSQRT.
1628
1629 ;#OneDivX
1630 ; 1/X ( x −− x1 ) Обратная величина. x1 := 1/x
1631 LONEX: .DB 3
1632 .TEXT "1/X" ; ( r −− 1/r) К
1633 .DW LSQRT
1634 ONEX: .DW JONEX
1635 JONEX: PKRM03 F1/X PKM03 KGOTO9 ; Обёртка вокруг F1/x.
1636
1637 ;#FTimesTimes
1638 ; Yˣ ( p x −− x1 ) Возведение в степень положительного числа. x1 := p^x
1639 ; +++ Убрать артефакты ПМК, степенная функция там имеет проблемы!
1640 LPOWER: .DB 2
1641 .TEXT "Y" ; Y^X ( y x −− y^x) К
1642 .DB 190
1643 .DW LONEX
1644 POWER: .DW JPOWER
1645 JPOWER: RM3 MB 1 + M3 MA
1646 KRMB KRMA FX^Y KMA KGOTO9 ; Степенная функция, обёртка вокруг FX^Y.
1647
1648 ;#RND
1649 ; СЧ ( −− p ) Псевдослучайное число. 0<=p<1
1650 LRND: .DB 2,145,151 ; "СЧ" ( −− x) К
1651 .DW LPOWER
1652 RND: .DW JRND
1653 JRND: KRAN KM3 KGOTO9 ; Обёртка вокруг KRAN.
1654
1655 ;#SGN
1656 ; ЗН ( x −− n ) Знак числа. n := −1 / 0 / 1
1657 LSGN: .DB 2,135,141 ; "ЗН" ( x −− sgn x) К
1658 .DW LRND
1659 SGN: .DW JSGN
1660 JSGN: PKRM03 KSGN PKM03 KGOTO9 ; Обёртка вокруг KSGN.
1661
1662 ;#FTRUNC
1663 ; [X] ( x −− x1 ) Усечение (целая часть) числа. x1 := Trunc [x]
1664 LINT: .DB 3 ; ( x −− [x]) К
1665 .TEXT "[X]"
1666 .DW LSGN
1667 INT: .DW JINT
1668 JINT: PKRM03 KINT PKM03 KGOTO9 ; Обёртка вокруг KINT.
1669
1670 ;#FRAC
1671 ; {X} ( x −− x1 ) Дробная часть числа. x1 := x − Trunc [x]
1672 LFRAC: .DB 3 ; ( x −− {x}) К
1673 .TEXT "{X}"
1674 .DW LINT
1675 FRAC: .DW JFRAC
1676 JFRAC: PKRM03 KFRAC PKM03 KGOTO9 ; Обёртка вокруг KFRAC.
1677
1678
1679 ; ∗∗∗ Тригонометрия МК−161 ∗∗∗
1680 ;
1681 ;#DEGREES
1682 ; DEGREES ( −− ) Градусы. Установить градусную меру измерения угла.
1683 LDEGR: .DB 7
1684 .TEXT "DEGREES" ; MMSFORTH
1685 .DW LFRAC
1686 DEGR: .DW JDEGR ; Даёт указание Каллисто (и МК−161) принимать углы в градусах
1687 JDEGR: Cx GOTO SETANG
1688
1689 ;#RADIANS
1690 ; RADIANS ( −− ) Радианы. Установить радианную меру измерения угла.
1691 LRAD: .DB 7
1692 .TEXT "RADIANS" ; MMSFORTH
1693 .DW LDEGR
1694 RAD: .DW JRAD ; Даёт указание Каллисто (и МК−161) принимать углы в радианах
1695 JRAD: 1
1696 SETANG: PPM 9045 KGOTO9 ; Задание размерности аргумента при вычислении тригонометрических функций
1697
1698 ;#ARCSIN
1699 ; ARCSIN ( x −− x1 ) Арксинус. x1 := arcsin x
1700 LASIN: .DB 6
1701 .TEXT "ARCSIN" ; ( x −− arcsin x) К
1702 .DW LRAD
1703 ASIN: .DW JASIN
1704 JASIN: PKRM03 FARCSIN PKM03 KGOTO9 ; Обёртка вокруг FARCSIN.
1705
1706 ;#ARCCOS
1707 ; ARCCOS ( x −− x1 ) Арккосинус. x1 := arccos x
1708 LACOS: .DB 6
1709 .TEXT "ARCCOS" ; ( x −− arccos x) К
1710 .DW LASIN
1711 ACOS: .DW JACOS
1712 JACOS: PKRM03 FARCCOS PKM03 KGOTO9 ; Обёртка вокруг FARCCOS.
1713
1714 ;#ARCTG
1715 ; ARCTG ( x −− x1 ) Арктангенс. x1 := arctg x
1716 LATG: .DB 5
1717 .TEXT "ARCTG" ; ( x −− arctg x) К
1718 .DW LACOS
1719 ATG: .DW JATG
1720 JATG: PKRM03 FARCTG PKM03 KGOTO9 ; Обёртка вокруг FARCTG.
1721
1722 ;#SIN
1723 ; SIN ( x −− x1 ) Синус. x1 := sin x
1724 LSIN: .DB 3
1725 .TEXT "SIN" ; ( x −− sin x) К
1726 .DW LATG
1727 SIN: .DW JSIN
1728 JSIN: PKRM03 FSIN PKM03 KGOTO9 ; Обёртка вокруг FSIN.
1729
1730 ;#COS
1731 ; COS ( x −− x1 ) Косинус. x1 := cos x
1732 LCOS: .DB 3
1733 .TEXT "COS" ; ( x −− cos x) К
1734 .DW LSIN
1735 COS: .DW JCOS
1736 JCOS: PKRM03 FCOS PKM03 KGOTO9 ; Обёртка вокруг FCOS.
1737
1738 ;#TG
1739 ; TG ( x −− x1 ) Тангенс. x1 := tg x
1740 LTG: .DB 2
1741 .TEXT "TG" ; ( x −− tg x) К
1742 .DW LCOS
1743 TG: .DW JTG
1744 JTG: PKRM03 FTG PKM03 KGOTO9 ; Обёртка вокруг FTG.
1745
1746 ; ∗∗∗ Стек ∗∗∗
1747 ;
1748 ;#SPFetch
1749 ; SP@ ( −− a ) Считать SP. Адрес текущей вершины стека данных.
1750 LSPAT: .DB 3
1751 .TEXT "SP@" ; F79
1752 .DW LTG
1753 SPAT: .DW JSPAT ; Кладёт на стек адрес вершины стека, до исполнения команды SP@
1754 JSPAT: RM3
1755 SPAT0: 1 EE 4 + KM3 KGOTO9
1756
1757 ;#StoreSP
1758 ; !SP ( −− ) Восстановить SP. Присвоить указателю стека данных исходное значение из переменной S0.
1759 LSPSTO: .DB 3
1760 .TEXT "!SP"
1761 .DW LSPAT
1762 SPSTO: .DW JSPSTO ; Устанавливает указатель стека в исходное состояние из переменной S0.
1763 JSPSTO: PPRM rrS0 RME ∗ PPRM rlS0 + ; Считывание переменой S0
1764 1 EE 4 − M3 KGOTO9 ; SP := S0
1765
1766 ; ∗∗ Стек возвратов ∗∗
1767 ;
1768 ;#RPFetch
1769 ; RP@ ( −− a ) Считать RP. Адрес текущей вершины стека возвратов.
1770 LRPAT: .DB 3
1771 .TEXT "RP@"
1772 .DW LSPSTO
1773 RPAT: .DW JRPAT
1774 JRPAT: RM2 GOTO SPAT0
1775
1776 ;#StoreRP
1777 ; !RP ( −− ) Восстановить RP. Присвоить указателю стека возвратов исходное значение из переменной R0.
1778 LRPSTO: .DB 3
1779 .TEXT "!RP"
1780 .DW LRPAT
1781 RPSTO: .DW JRPSTO ; Присваивает указателю стека возвратов исходное (базовое) значение из переменной R0.
1782 JRPSTO: PPRM rrR0 RME ∗ PPRM rlR0 + ; Считывание переменной R0
1783 1 EE 4 − M2 KGOTO9 ; RP := R0
1784
1785 ;#EXIT
1786 ; EXIT ( −− ) Закончить исполнение текущего определения.
1787 LEXIT: .DB 4
1788 .TEXT "EXIT" ; F79
1789 .DW LRPSTO
1790 EXIT: .DW RETURN ; При использовании EXIT внутри FOR .. NEXT нужно предварительно выполнить UNLOOP
1791
1792 ;#LEAVE
1793 ; LEAVE ( −− ) Выйти из цикла FOR досрочно.
1794 ; Досрочно прерывает цикл FOR .. NEXT (только для области данных)
1795 ; В стандарте Форт−83 это слово IMMEDIATE −− в данной реализации Каллисто обычное.
1796 ; Можно изменить цикл FOR .. NEXT так, чтобы он работал быстрее, а LEAVE содержало адрес ячейки, следующей за NEXT
1797 LLEAVE: .DB 5
1798 .TEXT "LEAVE" ; F83
1799 .DW LEXIT
1800 LEAVE: .DW JLEAVE
1801 JLEAVE: RM2 1 + M5 3 + M2
1802 KRM5 RME ∗ KRM5 + M6
1803 KGOTO9
1804
1805 ;#UNLOOP
1806 ; UNLOOP ( −− ) Снять со стека возвратов параметры управления циклом FOR для текущего уровня вложенности.
1807 LUNLOOP: .DB 6
1808 .TEXT "UNLOOP"
1809 .DW LLEAVE
1810 UNLOOP: .DW JUNLOOP ; Обычно используется перед EXIT для выхода изнутри цикла со счётчиком.
1811
1812 ;#toR
1813 ; >R ( d −− ) Перенести d на стек возвратов.
1814 LTOR: .DB 2
1815 .TEXT ">R" ; ( n −− ) ( R: −− n ) F79
1816 .DW LUNLOOP
1817 TOR: .DW JTOR ; Переносит 16−битное целое из стека данных на стек возвратов.
1818 JTOR: PKRM03 KINT
1819 FX<0 TOR1
1820 65536 +
1821 TOR1: RME / ENT KFRAC RME ∗ KM2 ; +++ может возникнуть ошибка округления
1822 FR KINT KM2
1823 PGOTO JDROP
1824
1825 ;#Rfrom
1826 ; R> ( −− D ) Перемещает D из стека возвратов на стек данных.
1827 LFROMR: .DB 2
1828 .TEXT "R>" ; ( −− n) ( R: n −−) F79
1829 .DW LTOR
1830 FROMR: .DW JFROMR ; Переносит 16−битное целое со знаком из стека возвратов на стек данных.
1831 JFROMR: RM2 MA M5 2 + M2
1832 JFR2: KRMA RME ∗ KRM5 + M0
1833 32768 −
1834 PX>=0 FROMR1
1835 FANS − KM3 KGOTO9
1836 FROMR1: RM0 KM3 KGOTO9
1837
1838 ;#RFetch
1839 ; R@ ( −− D ) Скопировать значение D со стека возвратов.
1840 LRAT: .DB 2
1841 .TEXT "R@" ; ( −− n)
1842 .DW LFROMR
1843 RAT: .DW JR
1844 JR: RM2 MA M5 PGOTO JFR2 ; Тоже, что и I −− но для целых со знаком.
1845
1846 ;#I
1847 ; I ( −− U ) Значение счётчика цикла FOR.
1848 LI: .DB 1
1849 .TEXT "I" ; ( −− n) F79
1850 .DW LRAT
1851 I: .DW JI ; Копирует верхнее 16−битное число из стека возвратов в стек данных.
1852 JI: RM2
1853 I0: MA M5
1854 KRMA RME ∗ KRM5 + KM3 KGOTO9
1855
1856 ;#J
1857 ; J ( −− U ) Значение счётчика внешнего цикла FOR.
1858 LJ: .DB 1
1859 .TEXT "J" ; ( −− n)
1860 .DW LI
1861 J: .DW JJ ; Узнать значение переменной цикла из вложенного цикла.
1862 JJ: 4
1863 JJ0: RM2 + GOTO I0
1864
1865 ;#K
1866 ; K ( −− U ) Значение счётчика третьего объемлющего цикла FOR.
1867 LK: .DB 1 ; ( −− n)
1868 .TEXT "K"
1869 .DW LJ
1870 K: .DW JK ; Узнать значение переменной цикла из дважды вложенного цикла.
1871 JK: 8 GOTO JJ0
1872
1873 ;#RDROP
1874 ; RDROP ( −− ) Удалить верхний адрес со стека возвратов.
1875 LLEV: .DB 5
1876 .TEXT "RDROP"
1877 .DW LK
1878 LEV: .DW JLEV
1879
1880 ; ∗∗ Операции со стеком параметров ∗∗
1881 ;
1882 ;#PICK
1883 ; PICK ( xu .. x1 x0 u −− xu .. x1 x0 xu ) Дублировать u−ное сверху.
1884 LPICK: .DB 4
1885 .TEXT "PICK" ; F83
1886 .DW LLEV
1887 PICK: .DW JPICK ; Копирует элемент стека с номером u и записывает его наверх стека, 0 PICK это DUP
1888 JPICK: PKRM03 KX>=09 ; Проверка на неверное значение
1889 RM3 + M5 KRM5 PKM03 ; Косвенная адресация с R5 использует прединкремент
1890 KGOTO9
1891
1892 ;#OVER
1893 ; OVER ( y x −− y x y ) Дублировать второй сверху.
1894 LOVER: .DB 4
1895 .TEXT "OVER" ; ( a b −− a b a) F79
1896 .DW LPICK
1897 OVER: .DW JOVER
1898 JOVER: RM3 M5 KRM5 KM3 KGOTO9 ; Копировать 2−й сверху элемент стека и занести его наверх.
1899
1900 ;#SWAP
1901 ; ↔ ( y x −− x y ) Обмен.
1902 LSWAP: .DB 1,183 ; ( a b −− b a) К
1903 .DW LOVER
1904 SWAP: .DW JSWAP
1905 JSWAP: RM3 M8 M5
1906 KRM5 KRM8 PKM05 <−> KM8 ; Меняет местами два верхних элемента стека.
1907 KGOTO9
1908
1909 ;#TwoSWAP
1910 ; 2SWAP ( t z y x −− y x t z ) Обмен двух пар.
1911 ; +++ Возможно, использование R5 поможет сократить и ускорить код.
1912 LDSWAP: .DB 5
1913 .TEXT "2SWAP" ; ( dd1 dd2 −− dd2 dd1) F79
1914 .DW LSWAP
1915 DSWAP: .DW JDSWAP ; Меняет местами верхние две пары чисел в стеке.
1916 JDSWAP: RM3 M8 2 + MA
1917 KRMA KRM8 KMA <−> KM8
1918 RM3 1 + M8 2 + MA
1919 KRMA KRM8 KMA <−> KM8
1920 KGOTO9
1921
1922 ;#DUP
1923 ; ↑ ( x −− x x ) Дублировать.
1924 LDUP: .DB 1,24
1925 .DW LDSWAP
1926 DUP: .DW JDUP
1927 JDUP: PKRM03 KM3 KGOTO9 ; Дублирует верхний элемент стека.
1928
1929 ;#qDUP
1930 ; ?DUP ( x −− 0 | x x ) Дублировать, если x≠0.
1931 LQDUP: .DB 4
1932 .TEXT "?DUP"
1933 .DW LDUP
1934 QDUP: .DW JQDUP
1935 JQDUP: PKRM03 KX!=09 ; Если x<>0
1936 KM3 KGOTO9 ; ..делает DUP
1937
1938 ;#TwoDUP
1939 ; 2DUP ( y x −− y x y x ) Дублировать пару чисел.
1940 LDUP2: .DB 4
1941 .TEXT "2DUP" ; ( dd −− dd dd )
1942 .DW LQDUP
1943 DUP2: .DW CALL, OVER,OVER, EXIT ; Дублирует верхнюю пару чисел в стеке.
1944
1945 ;#ROT
1946 ; ROT ( z y x −− y x z ) Вращать. Перенести наверх третий сверху.
1947 LROT: .DB 3
1948 .TEXT "ROT" ; ( a b c −− b c a) F79
1949 .DW LDUP2
1950 ROT: .DW JROT ; Переносит 3−й элемент стека наверх. ("Вращение трёх верхних элементов по часовой стрелке.")
1951 JROT: RM3 M8 M5
1952 KRM5 KRM8 PKM05 <−>
1953 KRM5 KM8 <−>
1954 PKM05
1955 KGOTO9
1956 ; x1 x2 x3 −− a b c = x2 x3 x1
1957 ;
1958 ; T |
1959 ; Z | x3 x3 x3 x3
1960 ; Y | x2 x2 x3 x2 x2 x1 x1
1961 ; X | x2 x3 b:=x3 x2 x1 c:=x1 x2 a:=x2
1962 ; −−+−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
1963 ; KRM5 KRM8 PKM05 <−> KRM5 KM8 <−> PKM05
1964
1965 ;#TwoDROP
1966 ; 2DROP ( y x −− ) Убрать пару чисел.
1967 LDDROP: .DB 5
1968 .TEXT "2DROP" ; ( dd −− ) F79
1969 .DW LROT
1970 DDROP: .DW JDDROP
1971 JDDROP: 2 PGOTO NDROP ; Удаляет из стека число двойной длины.
1972
1973 ;#DROP
1974 ; DROP ( x −− ) Убрать. Удалить верхний элемент стека.
1975 LDROP: .DB 4
1976 .TEXT "DROP" ; ( x −− ) F79
1977 .DW LDDROP
1978 DROP: .DW JDROP ; JDROP: 1 RM3 + M3 KGOTO9
1979
1980 ; ∗∗ Работа с памятью ∗∗
1981 ;
1982 ;#CMOVE
1983 ; CMOVE ( a1 a2 U −− ) Копировать U байтов из a1 в a2.
1984 ; Копирует побайтно область памяти размером U байт, начиная с a1, и записывает её начиная с a2.
1985 ; Сперва копируем содержимое байта с адресом a1, продолжаем в сторону больших адресов.
1986 ; Мы считаем, что блок не пересекает границ адресных пространств.
1987 LCMOVE: .DB 5
1988 .TEXT "CMOVE" ; ( откуда куда сколько −− ) F79
1989 .DW LDROP
1990 CMOVE: .DW JCMOVE
1991 JCMOVE: PKRM03 M0 ; Счётчик
1992 RM3 1 + M8 1 + MA 1 + M3
1993 RM0 +/− KX<09
1994 KRM8 1 EE 4 − KX>=09 1 − M5 ; Куда ( только в память данных)
1995 KRMA MA 1 EE 4 − PX<0 CMOVER0 ; Откуда
1996 RMA
1997 CMOVEP: KPRGM KM5 RMA 1 + MA
1998 PFL0 CMOVEP KGOTO9
1999 CMOVER0: 1 − M4 ; Прединкримент
2000 CMOVERL: Cx KRM4 KM5 FL0 CMOVERL KGOTO9
2001
2002 ;#CMOVEtop
2003 ; CMOVE> ( a1 a2 U −− ) Копировать U байтов из a1 в a2, начиная с больших адресов.
2004 LCMOVEG: .DB 6
2005 .TEXT "CMOVE>" ; ( откуда куда сколько −−)
2006 .DW LCMOVE
2007 CMOVEG: .DW JCMOVEG
2008 JCMOVEG: PKRM03 M0 ; Счётчик
2009 RM3 1 + MB 1 + MA 1 + M3 M8 ; R8 := SP (R3)
2010 KRMB 1 EE 4 − KX>=09
2011 RM0 +/− KX<09 − M1 ; R1 := Куда, конец блока
2012 KRMA MA 1 EE 4 − FX<0 CMVGR0
2013 RMA RM0 +
2014 CMVGP: MA KPRGM KM1 RMA 1 − FL0 CMVGP KGOTO9
2015 CMVGR0: RM0 + M3
2016 CMVGRL: Cx KRM3 KM1 FL0 CMVGRL
2017 RM8 M3 KGOTO9 ; R3 (SP) := R8
2018
2019 ;#FILL
2020 ; FILL ( a U c −− ) Заполнить. Записать U байтов c, начиная с адреса a.
2021 ; Записывает U байт c в память начиная с адреса a
2022 ; Заполнение массивов памяти идентичными символами
2023 ; а − адрес первого байта памяти, куда будет засылаться байт c
2024 ; U − число заполняемых байтов
2025 ; Подразумевается, что мы не пересекаем границу памяти программ и данных
2026 LFILL: .DB 4
2027 .TEXT "FILL" ; ( куда сколько что −− ) F79
2028 .DW LCMOVEG
2029 FILL: .DW JFILL
2030 JFILL: PKRM03 MB ; Символ
2031 RM3 1 +
2032 JFILL2: M8 1 + MA 1 + M3
2033 KRM8 M0 +/− KX<09 ; Счётчик символов
2034 KRMA 1 EE 4 − KX>=09 1 − M5 RMB
2035 FILL1: KM5 FL0 FILL1
2036 KGOTO9
2037 JBLANK: ; Обработчик FILL
2038 32
2039 .DB 59H ; FX>=0 aka пропустить 1 байт
2040 JERASE: CX ; Обработчик ERASE
2041 JJFILL: MB RM3 PGOTO JFILL2
2042
2043 ;#ERASE
2044 ; ERASE ( a U −− ) Стереть. Записать U нулей в память, начиная с адреса a.
2045 LERASE: .DB 5
2046 .TEXT "ERASE" ; ( где сколько −−) F79
2047 .DW LFILL
2048 ERASE: .DW JERASE ; Записывает U нулевых байтов в память, начиная с адреса a (обнуление массивов).
2049
2050 ;#BLANK
2051 ; BLANK ( a U −− ) Опробелить. Записать U пробелов в память, начиная с адреса a.
2052 LBLANK: .DB 5
2053 .TEXT "BLANK" ; ( где сколько −−) F83
2054 .DW LERASE
2055 BLANK: .DW JBLANK ; Записывает U кодов пробела (32) в память, начиная с адреса a.
2056
2057 ;#HOLD
2058 ; HOLD ( c −− ) Перенести литеру c на вершину буфера PAD.
2059 ; Вводит в текущую ячейку выходного буфера PAD символ, код которого в стеке
2060 ; Для использования между <# и U#>
2061 LHOLD: .DB 4
2062 .TEXT "HOLD" ; ( символ −−) F79
2063 .DW LBLANK
2064 HOLD: .DW JHOLD
2065 JHOLD: PPRM rlHLD 1 −
2066 FX<0 HOLD1
2067 PPRM rrHLD 1 − PPM rrHLD 255
2068 HOLD1: PPM rlHLD
2069 PPRM rrHLD RME ∗ + 1 EE 4 − MA
2070 PKRM03 KMA
2071 JDROP: 1 ; Да, это обработчик DROP
2072 NDROP: RM3 + M3 ; А сюда сваливается 2DROP
2073 KGOTO9
2074
2075 ;#TIB
2076 ; TIB ( −− a ) Дать адрес TIB (входного буфера терминала).
2077 LTIB: .DB 3
2078 .TEXT "TIB" ; ( −− адрес_TIB) F83
2079 .DW LHOLD ; Кладёт на стек начальный адрес входного буфера терминала (Terminal Input Buffer).
2080 TIB: .DW SCONP ; Входной буфер терминала
2081 .DB 2aH,0f8H ; 11000
2082
2083 ;#PlusStore
2084 ; +! ( y a −− ) Увеличить на y содержимое ячейки с адресом a.
2085 ; Добавляет к содержимому ячейки с адресом a число y
2086 ; Подразумевается, что ячейка не пересекает границ областей памяти
2087 ; Может увеличивать содержимое десятичных регистров, но не регистров функций
2088 LPSTOR: .DB 2
2089 .TEXT "+!" ; F79
2090 .DW LTIB
2091 PSTOR: .DW JPSTOR
2092 JPSTOR: RM3 MA 1 + M8 1 + M3
2093 KRMA 1 EE 4 − KX>=09 MA ; Защита от "переменных" в памяти программ
2094 1000 − FX>=0 PSTOR1 ; 1000 быстрее, чем 1 ВП 3
2095 RMA 1 + MB
2096 KRMA RME ∗ KRMB + ; @
2097 KRM8 + ; +
2098 RME FX^2 + ; X1 := 65536
2099 PSTOR3: FANS − FX<0 PSTOR3
2100 PSTOR4: FANS + FX>=0 PSTOR4
2101 PSTOR2: ENT RME / KINT KMA
2102 RME ∗ − KMB KGOTO9 ; ! EXIT
2103 PSTOR1: KRMA KRM8 + KMA KGOTO9
2104
2105 ;#PlusPlusStore
2106 ; ++! ( y a −− ) Косвенная запись y по указателю в a с предварительным автоувеличением (аналог КП4..КП6).
2107 ; 1. Добавляет единицу к содержимому ячейки с адресом a
2108 ; 2. Записывает x по адресу, содержащемуся в этой ячейке (в байтовой области это адрес байта, а не ячейки)
2109 ; Подразумевается, что ячейка не пересекает границ областей памяти.
2110 ; Указатель может располагаться в десятичных регистрах, но не регистрах функций.
2111 LPPSTOR: .DB 3
2112 .TEXT "++!" ; ( число адрес −− ) К
2113 .DW LPSTOR
2114 PPSTOR: .DW JPPSTOR
2115 JPPSTOR: RM3 MA 1 + M8 1 + M3
2116 KRMA 1 EE 4 − KX>=09 MA ; Защита от "указателей" в памяти программ
2117 1000 − PX>=0 PPSTOR1 ; 1000 быстрее, чем 1 ВП 3
2118 1 ; 1+
2119 PPSTOR0: RMA 1 + MB <−>
2120 KRMA RME ∗ KRMB + ; @
2121 + ; 1+ или 1−
2122 ENT ; Сохраним адрес, нам по нему ещё x записывать
2123 ENT RME / KINT KMA ; Старший байт
2124 RME ∗ − KMB ; Младший байт
2125 Cx GOTO PPSTOR2
2126 MMSTOR1: 1 +/− ; автодекремент десятичного регистра
2127 .DB 5cH ; FX<0 aka пропустить 1 байт
2128 PPSTOR1: 1 ; автоинкремент десятичного регистра
2129 PPSTOR1A: KRMA KINT + KMA
2130 1
2131 PPSTOR2: EE 4 − KX>=09 MA ; Защита от обращения в память программ
2132 1000 − FX>=0 PPSTOR4 ; Если десятичный регистр, записываем туда любой x
2133 KRM8 FX<0 PPSTOR5
2134 RME + KMA KGOTO9 ; Отрицательные числа в байтовые регистры приводятся к 128..255
2135 PPSTOR4: KRM8
2136 PPSTOR5: KMA KGOTO9 ; !
2137
2138 ;#MinusMinusStore
2139 ; −−! ( y a −− ) Косвенная запись y по указателю в a с предварительным автоуменьшением (аналог КП0..КП3).
2140 ; 1. Вычитает единицу из содержимого ячейки с адресом a
2141 ; 2. Записывает x по адресу, содержащемуся в этой ячейке (в байтовой области это адрес байта, а не ячейки)
2142 ; Подразумевается, что ячейка не пересекает границ областей памяти.
2143 ; Указатель может располагаться в десятичных регистрах, но не регистрах функций.
2144 LMMSTOR: .DB 3
2145 .TEXT "−−!" ; ( число адрес −− ) К
2146 .DW LPPSTOR
2147 MMSTOR: .DW JMMSTOR
2148 JMMSTOR: RM3 MA 1 + M8 1 + M3
2149 KRMA 1 EE 4 − KX>=09 MA ; Защита от "указателей" в памяти программ
2150 1000 − FX>=0 MMSTOR1 ; 1000 быстрее, чем 1 ВП 3
2151 1 +/− ; 1−
2152 PGOTO PPSTOR0
2153
2154 ;#TOGGLE
2155 ; TOGGLE ( a c −− ) Изменить байт с адресом a по xor−маске c.
2156 ; У TOGGLE стандартный, но необычный порядок операндов. Будьте внимательны!
2157 LTOGL: .DB 6
2158 .TEXT "TOGGLE" ; fig−Форт, FORTH ИТЭФ
2159 .DW LMMSTOR
2160 TOGL: .DW JTOGL
2161 JTOGL: RM3 M8 1 + MA 1 + M3
2162 KRMA 1 EE 4 − KX>=09 ; Не меняем ничего в памяти программ
2163 MA KRM8 KRMA KXOR KMA
2164 KGOTO9
2165
2166 ;#Fetch
2167 ; @ ( a −− x ) Извлечь. Считать значение ячейки по адресу a.
2168 ; Замещает адрес в стеке его содержимым, двухбайтовая ячейка содержит число со знаком.
2169 ; Также может считать десятичный регистр, если адрес указывает на него.
2170 ; Не предназначена для считывания регистров функций!
2171 LAT: .DB 1
2172 .TEXT "@" ; ( адрес −− целое) F79
2173 .DW LTOGL
2174 AT: .DW JAT
2175 JAT: PKRM03
2176 ;AT0:
2177 MA 1
2178 ;AT00:
2179 EE 4 − FX>=0 AT1
2180 MA M5 1000 − FX>=0 AT2 ; 1000 быстрее, чем 1 ВП 3
2181 KRMA 128 − PX>=0 UAT0
2182 RME ∗ KRM5
2183 GOTO AT01
2184 AT2: KRMA PKM03 KGOTO9
2185 AT1: RMA KPRGM 128 − PX>=0 UAT1
2186 RME ∗ RMA 1 + KPRGM
2187 AT01: +
2188 32768 − PKM03 KGOTO9
2189
2190 ;#UFetch
2191 ; U@ ( a −− U ) Извлечь беззнаковое. Считать беззнаковое значение ячейки с адресом a.
2192 ; Считываем из регистров и кладём на стек 2−х байтовое целое без знака.
2193 ; Единый адрес должен указывать на память программ или на байтовые регистры.
2194 ; Не предназначена для считывания регистров функций и десятичных регистров!
2195 ; Без лишних проверок, очень быстро.
2196 LUAT: .DB 2
2197 .TEXT "U@" ; ( адрес −− беззнаковое ) К
2198 .DW LAT
2199 UAT: .DW JUAT
2200 JUAT: PKRM03 MA 1 EE 4 − FX>=0 UAT1
2201 MA M5
2202 UAT0: KRMA RME ∗ KRM5 + PKM03 KGOTO9 ; Сюда есть переход из @
2203 UAT1: RMA KPRGM RME ∗ ; Сюда есть переход из @
2204 RMA 1 + KPRGM +
2205 PKM03 KGOTO9
2206
2207 ;#CFetch
2208 ; C@ ( a −− x ) Извлечь байт. Считать значение по адресу a.
2209 ; Извлекает байт информации из ячейки, адрес которой находится в стеке.
2210 ; Если читаем байт из памяти программ или байтовой памяти, старшие биты будут равны нулю.
2211 ; Так можно читать значения из регистров функций и десятичных регистров.
2212 LCAT: .DB 2
2213 .TEXT "C@" ; ( адрес −− байт ) F79
2214 .DW LUAT
2215 CAT: .DW JCAT
2216 JCAT: PKRM03 1 EE 4 − FX>=0 CAT1
2217 CAT0: MA KRMA PKM03 KGOTO9
2218 CAT1: PKRM03
2219 CAT2: KPRGM PKM03 KGOTO9
2220
2221 ;#PlusPlusFetch
2222 ; ++@ ( a −− x ) Косвенное чтение по указателю в a с предварительным автоувеличением (аналог КИП4..КИП6).
2223 ; 1. Добавляет единицу к содержимому ячейки с адресом a
2224 ; 2. Кладёт на стек x, расположенное по адресу, содержащемуся в этой ячейке (в байтовой области это адрес байта, а не ячейки)
2225 ; Подразумевается, что ячейка не пересекает границ областей памяти.
2226 ; Указателем может быть десятичный регистр, но не регистр функций.
2227 LPPAT: .DB 3
2228 .TEXT "++@" ; ( адрес −− x ) К
2229 .DW LCAT
2230 PPAT: .DW JPPAT
2231 JPPAT: PKRM03 1 EE 4 − KX>=09 MA ; Защита от "указателей" в памяти программ
2232 1000 − PX>=0 PPAT1
2233 1 ; 1+
2234 PPAT0: RMA 1 + MB <−>
2235 KRMA RME ∗ KRMB + ; @
2236 + ENT ; 1+ или 1−
2237 ENT RME / KINT KMA ; Старший байт
2238 RME ∗ − KMB ; Младший байт
2239 Cx GOTO PPAT00
2240 MMAT1: 1 +/− ; автодекремент десятичного регистра
2241 .DB 5cH ; FX<0 aka пропустить 1 байт
2242 PPAT1: 1 ; автоинкремент десятичного регистра
2243 PPAT1A: KRMA KINT + KMA
2244 1
2245 PPAT00: EE 4 − PX<0 CAT0
2246 FANS + PGOTO CAT2
2247
2248 ;#MinusMinusFetch
2249 ; −−@ ( a −− x ) Косвенное чтение по указателю в a с предварительным автоуменьшением (аналог КИП0..КИП3).
2250 ; 1. Вычитает единицу из содержимого ячейки с адресом a
2251 ; 2. Кладёт на стек x, расположенное по адресу, содержащемуся в этой ячейке (в байтовой области это адрес байта, а не ячейки)
2252 ; Подразумевается, что ячейка не пересекает границ областей памяти.
2253 ; Указателем может быть десятичный регистр, но не регистр функций.
2254 LMMAT: .DB 3
2255 .TEXT "−−@" ; ( адрес −− x ) К
2256 .DW LPPAT
2257 MMAT: .DW JMMAT
2258 JMMAT: PKRM03 1 EE 4 − KX>=09 MA ; Защита от "указателей" в памяти программ
2259 1000 − PX>=0 MMAT1 ; 1000 быстрее, чем 1 ВП 3
2260 1 +/− ; 1−
2261 PGOTO PPAT0
2262
2263 ;#Store
2264 ; ! ( y a −− ) Присвоить. Записывает y в ячейку с адресом a.
2265 ; Записывает число y в ячейку с адресом a. Может записать число в десятичный регистр, но не в регистр функций.
2266 LSTORE: .DB 1
2267 .TEXT "!" ; ( значение адрес −− ) F79
2268 .DW LMMAT
2269 STORE: .DW JSTORE
2270 JSTORE: RM3 M8 1 + MA 1 + M3
2271 KRM8 1 EE 4 − KX>=09 ; Защита от записи в память программ
2272 M8 M5 1000 − PX>=0 STORE1 ; 1000 быстрее, чем 1 ВП 3
2273 KRMA FX<0 STORE2
2274 65536 + ; При записи отрицательных чисел в двоичную память
2275 STORE2: ENT RME / KINT KM8 ; Запишем старший байт
2276 RME ∗ − KM5 ; Потом младший байт
2277 KGOTO9
2278 STORE1: KRMA KM8 KGOTO9 ; Запись в десятичный регистр
2279
2280 ;#ZeroStore
2281 ; 0! ( a −− ) Обнулить. Записывает ноль в ячейку с адресом a.
2282 ; Записывает число 0 в ячейку с адресом a. Может обнулять десятичные регистры, но не регистры функций.
2283 LZSTORE: .DB 2
2284 .TEXT "0!" ; ( адрес −− )
2285 .DW LSTORE
2286 ZSTORE: .DW JZSTORE
2287 JZSTORE: RM3 M8 1 + M3
2288 KRM8 1 EE 4 − KX>=09 ; Защита от записи в память программ
2289 M8 M5 1000 − FX>=0 ZSTORE1 ; 1000 быстрее, чем 1 ВП 3
2290 Cx KM8 KM5 KGOTO9 ; Обнуление двоичной ячейки
2291 ZSTORE1: Cx KM8 KGOTO9 ; Обнуление десятичного регистра
2292
2293 ;#CStore
2294 ; C! ( y a −− ) Записывает байт y по адресу a.
2295 ; Может также записать число y в десятичный регистр, но не регистр функций.
2296 ; +++ Форт−79 требует, чтобы записывались только младшие 8 бит числа в стеке −− проверить.
2297 LCSTOR: .DB 2
2298 .TEXT "C!" ; ( байт адрес −− ) F79
2299 .DW LZSTORE
2300 CSTOR: .DW JCSTOR
2301 JCSTOR: RM3 M8 1 + MA 1 + M3
2302 KRM8 1 EE 4 − KX>=09 ; Защита от записи в память программ
2303 M8 1000 − PX<0 STORE1 ; 1000 быстрее, чем 1 ВП 3
2304 KRMA FX<0 CSTOR2
2305 RME +
2306 CSTOR2: KM8 KGOTO9
2307
2308 ;#BODYfrom
2309 ; BODY> ( a −− т ) От тела. От поля параметров к полю кода.
2310 LCFA: .DB 5
2311 .TEXT "BODY>" ; ( pfa −− cfa ) F83
2312 .DW LCSTOR
2313 CFA: .DW JTWOM ; В FORTH ИТЭФ использовалось, как 2−
2314
2315 ;#StoreCSP
2316 ; !CSP ( −− ) Запомнить адрес вершины стека в CSP.
2317 LSCSP: .DB 4
2318 .TEXT "!CSP" ; fig−Форт, ФОРТ−ЕС, FORTH ИТЭФ
2319 .DW LCFA
2320 SCSP: .DW JSCSP
2321 JSCSP: Cx EE 4 RM3 +
2322 ENT RME / KINT PPM rrCSP RME ∗ − PPM rlCSP ; 13
2323 KGOTO9
2324
2325 ;#HERE
2326 ; HERE ( −− a ) Здесь. Дать адрес текущей вершины словаря.
2327 LHERE: .DB 4
2328 .TEXT "HERE" ; F79
2329 .DW LSCSP
2330 HERE: .DW JHERE
2331 JHERE: PPRM rrDP RME ∗ PPRM rlDP + KM3 ; Выдаёт адрес первой свободной ячейки в словаре.
2332 KGOTO9
2333
2334 ;#ALLOT
2335 ; ALLOT ( D −− ) Занять. Сместить вершину словаря на n байт.
2336 ; +++ Проверить размер и эффективность высокоуровневого определения.
2337 LALLOT: .DB 5
2338 .TEXT "ALLOT" ; ( n −− ) F79
2339 .DW LHERE
2340 ALLOT: .DW JALLOT ; Добавляет D байт к полю параметров слова, описанного последним.
2341 JALLOT: RM3 MA 1 + M3
2342
2343 PPRM rlDP KRMA + ; 5
2344 ENT RME / FANS <−> KINT MA ∗ − PPM rlDP ; 12
2345 RMA KX!=09 ; 2
2346 PPRM rrDP + PPM rrDP ; 7
2347
2348 ; PPRM rrDP RME ∗ PPRM rlDP + KRMA + ; 11
2349 ; ENT RME / FANS <−> KINT PPM rrDP ∗ − PPM rlDP ; 14
2350 KGOTO9
2351
2352 ;#deHERE
2353 ; ДHERE ( −− a ) Дать адрес текущей вершины десятичного словаря.
2354 LDHERE: .DB 5,132
2355 .TEXT "HERE" ; "ДHERE" К
2356 .DW LALLOT
2357 DHERE: .DW JDHERE ; Выдаёт адрес первого свободного десятичного регистра в десятичном словаре.
2358 JDHERE: PPRM rrDDP RME ∗ PPRM rlDDP + KM3
2359 KGOTO9
2360
2361 ;#deALLOT
2362 ; ДALLOT ( D −− ) Сместить вершину десятичного словаря на D регистров.
2363 ; +++ Проверить размер и эффективность высокоуровневого определения.
2364 LDALLOT: .DB 6,132
2365 .TEXT "ALLOT" ; "ДALLOT" ( n −− ) К
2366 .DW LDHERE
2367 DALLOT: .DW JDALLOT ; Резервирует D десятичных регистров в десятичном словаре.
2368 JDALLOT: RM3 MA 1 + M3
2369
2370 PPRM rlDDP KRMA + ; 5
2371 ENT RME / FANS <−> KINT MA ∗ − PPM rlDDP ; 12
2372 RMA KX!=09 ; 2
2373 PPRM rrDDP + PPM rrDDP ; 7
2374
2375 ; PPRM rrDDP RME ∗ PPRM rlDDP + KRMA +
2376 ; ENT RME / FANS <−> KINT PPM rrDDP ∗ − PPM rlDDP
2377 KGOTO9
2378
2379 ;#Bracket
2380 ; [ ( −− ) Установить состояние исполнения.
2381 LLBRAC: .DB 81H
2382 .TEXT "[" ; F79
2383 .DW LDALLOT
2384 LBRAC: .DW JLBRAC ; Переключить текстовый интерпретатор в состояние исполнения
2385 JLBRAC: CX ; Прекращение компиляции, начало исполнения (обнуление STATE)
2386 SETSTATE: PPM rlSTATE
2387 CX
2388 PPM rrSTATE
2389 KGOTO9
2390 ; .DW STATE,ZSTORE, EXIT ; 6 байт шитого кода vs 9 байт ЯМК
2391
2392 ;#right−bracket
2393 ; ] ( −− ) Установить состояние компиляции.
2394 LRBRAC: .DB 1
2395 .TEXT "]" ; F79
2396 .DW LLBRAC
2397 RBRAC: .DW JRBRAC ; Переключить текстовый интерпретатор в состояние компиляции.
2398 JRBRAC: 128 ; Начало компиляции
2399 PGOTO SETSTATE
2400 ; .DW LITB
2401 ; .DB 128
2402 ; .DW STATE,STORE, EXIT ; 9 байт шитого кода vs 6 байт ЯМК
2403
2404 ;#HEX
2405 ; HEX ( −− ) Установить шестнадцатеричную систему счисления.
2406 LHEX: .DB 3
2407 .TEXT "HEX" ; F79
2408 .DW LRBRAC
2409 HEX: .DW JHEX ; Устанавливает шестнадцатеричную систему счисления для ввода−вывода.
2410 JHEX: 16
2411 SETBASE: PPM rlBASE
2412 CX PPM rrBASE
2413 KGOTO9
2414 ; .DW LIT,16, BASE,STORE, EXIT ; 9−10 байт шитого кода vs 10 байт ЯМК
2415
2416 ;#DECIMAL
2417 ; DECIMAL ( −− ) Установить десятичную систему счисления.
2418 LDEC: .DB 7
2419 .TEXT "DECIMAL" ; F79
2420 .DW LHEX
2421 DEC: .DW JDEC ; Устанавливает десятичную систему счисления для ввода−вывода.
2422 JDEC: 10
2423 PGOTO SETBASE
2424 ; .DW LIT,10, BASE,STORE, EXIT ; 9−10 байт шитого кода vs 5 байт ЯМК
2425
2426 ;#MinusTRAILING
2427 ; −TRAILING ( a U1 −− a U2 ) Отсечь конечные пробелы.
2428 ; Преобразует число символов U1 в строке, начинающейся с адреса a, в число U2, не включающее
2429 ; число пробелов, которые имеются в конце строки. Адрес a остаётся неизменным.
2430 ; Можно попробовать пропускать табуляции, ВК и ПС
2431 ; Мы считаем, что дело происходит в области данных.
2432 LDTRAI: .DB 9
2433 .TEXT "−TRAILING" ; F79
2434 .DW LDEC
2435 DTRAI: .DW JDTRAI
2436 JDTRAI: RM3 M8 M5 KRM5
2437 1 EE 4 − KX>=09
2438 KRM8 M0 +/− KX<09
2439 − M1
2440 DTRAI1: KRM1 32 −
2441 FX=0 DTRAI2
2442 FL0 DTRAI1
2443 CX M0
2444 DTRAI2: RM0 KM8
2445 KGOTO9
2446
2447 ;#UPPER
2448 ; UPPER ( a u −− ) Перевести в верхний регистр u литер по адресу a.
2449 LUPPER: .DB 5
2450 .TEXT "UPPER" ; Форт ИТЭФ
2451 .DW LDTRAI
2452 UPPER: .DW JUPPER ; Перевести строку символов в верхний регистр.
2453 JUPPER: RM3 M8 1 + MA 1 + M3
2454 KRM8 M0 +/− KX<09
2455 KRMA 10001 − KX>=09 M5
2456 UPPERL: KRM5
2457 97 − PX>=0 UPPER2 ; 'a'
2458 26 − PX>=0 UPPER3 ; 'z'−96
2459 37 − PX>=0 UPPER2 ; 'а'−123
2460 16 − PX>=0 UPPER4 ; 'п'−159
2461 48 − PX>=0 UPPER2 ; 'р'−176
2462 16 − FX>=0 UPPER6 ; 'я'−223
2463 1 − PX=0 UPPER2 ; 'ё'−241
2464 240 PGOTO UPPER5 ; 'Ё'
2465 UPPER6: 160 GOTO UPPER7 ; 'Р'+16
2466 UPPER4: 144 ; 'А'+16
2467 .DB 0f9H ; PX>=0 aka PGOTO UPPER7, пропустить 2 шага
2468 UPPER3: 91 ; 'A'+26
2469 UPPER7: +
2470 UPPER5: PKM05
2471 UPPER2: PFL0 UPPERL
2472 UPPERR: KGOTO9
2473
2474 ;#DEFINITIONS
2475 ; DEFINITIONS ( −− ) Делает контекстный набор слов текущим. Новые слова добавляются в него.
2476 ; Это старинный способ менять значение переменной CURRENT.
2477 LDEFIN: .DB 11
2478 .TEXT "DEFINITIONS" ; F79
2479 .DW LUPPER
2480 DEFIN: .DW CALL, CONT,UAT, CURR,STORE, EXIT ; 10 байт шитого кода vs 13 байт ЯМК
2481
2482 ;#UPDATE
2483 ; UPDATE ( −− ) Отметить блочный буфер, как изменённый.
2484 LUPDAT: .DB 6
2485 .TEXT "UPDATE" ; ( −−) F79
2486 .DW LDEFIN
2487 UPDAT: .DW JUPDAT
2488 JUPDAT: 128 PPM rrBUFBLK ; Устанавливает в буфере флаг "спасения".
2489 KGOTO9
2490
2491 ;#BUFBLK
2492 ; BUFBLK ( −− a ) Переменная. Номер блока, загруженного в буфер.
2493 LX: .DB 6
2494 .TEXT "BUFBLK" ; ( −− +n ) К
2495 .DW LUPDAT
2496 BUFN: .DW SCONP
2497 .DB 3aH,0f6H ; 15094 rrBUFBLK
2498
2499 ; ∗∗ Управляющие слова ∗∗
2500 ;
2501 ;#Colon
2502 ; : ( −− ) Начать определение слова через двоеточие.
2503 LCOLON: .DB 1
2504 .TEXT ":" ; ( "<пр>имя" −− ) F94
2505 .DW LX
2506 COLON: .DW CALL,QEXEC,SCSP,CREAT,SMUG ; +++ Раньше было: CURR,UAT,CONT,STORE
2507 .DW RBRAC,PSCOD
2508 CALLD: ;∗∗ CALL, когда управление передаётся в память данных
2509 KGSBC ; RPUSH RI ; RX := W, адрес поля кода нового слова
2510 1 + ; RX := PFA−1, передаём в указатель шитого кода R6=RI−1
2511 SETRIDAT:
2512 M6 ; RI := RX
2513 SETDAT: .NUMT RPUSHRID
2514 MC ; RC := RPUSHRID ;∗∗ Следующий вызов −− из памяти данных
2515 .NUM NEXTD
2516 M9 ; R9 := NEXTD ;∗∗
2517 NEXTD: ; NEXT для шитого кода из памяти данных.
2518 KRM6 RME ∗ KRM6 + M7 ; W := MEMW[RI++] считываем шитый код
2519 1 EE 4 − PX>=0 NEXTPP ; Слово из памяти программ?
2520 NEXTDD: M7 M5 KRM7 RME ∗ KRM5 + ; Считываем MEMW[W], это должно быть CFA очередного слова в шитом коде
2521 M8 KGOTO8 ; передаём управление на адрес, записанный в CFA
2522 ;
2523 RETURN: ; Обработчик EXIT
2524 RM2 1 − M5 3 + M2
2525 KRM5 RME ∗ KRM5 +
2526 PPM 9042 ; Регистр, увы, мучаем в любом случае
2527 10001 −
2528 PX<0 SETRIDAT
2529 GOTO SETPRG
2530 ;
2531 CALL: ;∗∗ CALL, когда управление передаётся в память программ
2532 KGSBC ; RPUSH RI ; RX := W, адрес поля кода нового слова
2533 2 + ; Теперь RX указывает на его тело
2534 SETRIPRG:
2535 PPM 9042 ; R9042 := RX
2536 SETPRG: .NUMT RPUSHRIP
2537 MC ; RC := RPUSHRIP ;∗∗ Следующий вызов −− из памяти программ
2538 .NUM NEXTP
2539 M9 ; R9 := NEXTP ;∗∗
2540 NEXTP: ; NEXT для шитого кода из памяти программ.
2541 PPRM 9044 RME ∗ PPRM 9044 +
2542 DOEXECRX: M7 ; W := MEMW[RI++] считываем шитый код
2543 1 EE 4 − PX<0 NEXTDD ; Слово из области двоичных данных?
2544 NEXTPP: RM7 KPRGM RME ∗ RM7 1 + KPRGM + ; Считываем MEMW[W], это должно быть CFA очередного слова в шитом коде
2545 M8 KGOTO8 ; передаём управление на адрес, записанный в CFA
2546
2547 JEXEC: ; Обработчик EXECUTE
2548 RM3 M8 1 + M3 KRM8 ; POP RX
2549 GOTO DOEXECRX ; W := RX, JMP MEMW[W]
2550
2551 ;#Semi
2552 ; ; ( −− ) Закончить определение через двоеточие.
2553 ; Форт−79 требует выводить сообщение об ошибке, если после чтения с диска мы всё ещё не встретили ;
2554 LSMI: .DB 81H
2555 .DB 3BH ; ";" F79
2556 .DW LCOLON
2557 SMI: .DW CALL, QCSP, COMP,EXIT, SMUG, LBRAC, EXIT
2558
2559 ;#CONSTANT
2560 ; CONSTANT ( D −− ) Определить следующее слово, как константу со значением D.
2561 ; Константы в памяти двоичных данных всегда 16−битные со знаком.
2562 ; Мы избавились от констант в памяти программ, реализовав их быстрыми примитивами.
2563 LCON: .DB 8
2564 .TEXT "CONSTANT" ; ( x "<пр>имя" −− ) F79
2565 .DW LSMI
2566 CON: .DW CALL
2567 RCON: .DW CREAT, COMMA, PSCOD
2568 SCOND: RM7 1 + M5 ; ( −− x ) из памяти данных
2569 KRM5 RME ∗ KRM5
2570 PGOTO PLUSKM3M ; Можно раскрыть, ускорить за счёт места в памяти программ
2571 SCONP: RM7 3 + KPRGM ; ( −− x ) в памяти программ всегда беззнаковые
2572 FANS 1 − KPRGM RME ∗ + KM3 KGOTO9
2573
2574 ;#VARIABLE
2575 ; VARIABLE ( −− ) Определить следующее слово, как переменную с начальным значением 0.
2576 LVAR: .DB 8
2577 .TEXT "VARIABLE" ; ( "<пр>имя" −− ) F79 F83 F12
2578 .DW LCON
2579 VAR: .DW CALL, CREAT,ZERO,COMMA,EXIT ; Действие по умолчание от CREATE нам вполне подходит.
2580
2581 ;#FVARIABLE
2582 ; FVARIABLE ( −− ) Определить следующее слово, как десятичную переменную с начальным значением 0.
2583 LFVAR: .DB 9
2584 .TEXT "FVARIABLE" ; ( "<пр>имя" −− )
2585 .DW LVAR
2586 FVAR: .DW CALL, DHERE,ZERO,DCOMMA,BRAN,RCON ; ДHERE 0 Д, CONSTANT
2587
2588 ;#VALUE
2589 ; VALUE ( x −− ) Определить следующее слово, как десятичную величину с начальным значением x.
2590 ; Используем десятичные регистры для хранения величин VALUE
2591 ; Данные хранятся в ячейке между двумя CFA, чтобы программист мог создавать собственные
2592 ; порождающие слова с двумя обработчиками высокого уровня, использущие стандартное TO
2593 LVALUE: .DB 5
2594 .TEXT "VALUE" ; ( x "<пр>имя" −− ) F12
2595 .DW LFVAR
2596 VALUE: .DW CALL, CREAT, DHERE, LITP
2597 .DB 39,16 ; 10000
2598 .DW SUB, COMMA, DCOMMA, LITP,TOVALUE,COMMA, PSCOD
2599 ; Исполняющая часть VALUE (обычное вхождение величины)
2600 RM7 1 + M5 ; ( −− x ) из десятичного регистра
2601 KRM5 RME ∗ KRM5 + M7 ; Получаем номер регистра
2602 KRM7 KM3 KGOTO9 ; Кладём значение на стек, NEXT
2603 TOVALUE: RM7 3 − M5 ; ( x −− ) в десятичный регистр
2604 KRM5 RME ∗ KRM5 + M7 ; Получаем номер регистра
2605 RM3 MA 1 + M3 ; RA := адрес значения
2606 KRMA KM7 KGOTO9 ; Записываем значение в десятичный регистр, NEXT
2607
2608 ;#DEFER
2609 ; DEFER ( −− ) Определить следующее слово, как действие с начальным значением НОП (нет операции).
2610 ; Используем поле данных DEFER для хранения xt (в виде адреса в единой адресации)
2611 ; Соглашение по векторному поля кода такое же, как у VALUE −− ведь мы используем одно и то же слово TO
2612 LDEFER: .DB 5
2613 .TEXT "DEFER" ; ( "<пр>имя" −− )
2614 .DW LVALUE
2615 DEFER: .DW CALL, CREAT,LITP,SNOP,COMMA ; Инициализируем DEFER токеном НОП
2616 .DW LITP,TODEFER,COMMA, PSCOD ; TODEFER −− второй элемент векторного поля кода
2617 ; Исполняющая часть DEFER (обычное вхождение слова)
2618 RM7 M5 KRM5 ; ( −− ) выполнить сохранённый xt
2619 KRM5 RME ∗ KRM5 + ; RX := сохранённый xt
2620 PGOTO DOEXECRX ; W := RX, JMP MEMW[W]
2621 TODEFER:
2622 RM7 3 − M5 ; R5 готов к косвенной адресации с предв. автоинкрементом
2623 RM3 MA 1 + M3 ; RA содержит номер регистра, в котором хранится новый xt
2624 KRMA ; Получаем новый CFA
2625 ENT RME / FANS <−> KINT KM5 ; Сохраняем старший байт нового CFA
2626 ∗ − KM5 KGOTO9 ; Сохраняем младший байт нового CFA, NEXT
2627
2628 ;#USER
2629 ; USER ( −− a ) Обработчик переменных типа USER (слово без заголовка).
2630 ; Переменные USER могут быть только в памяти программ и их поле параметров занимает всего 1 байт.
2631 ; Поэтому определяющая часть слова некорректна и излишня
2632 ; +++ Точно 12 переменных USER ? А если их в CONSTANT ?
2633 ;LUSER: .DB 4
2634 ; .TEXT "USER" ; F79
2635 ; .DW LDEFER
2636 ;USER: .DW CALL, CON, PSCOD
2637 SUSE: RM7 2 + KPRGM 11000 + KM3 KGOTO9 ; 000 быстрее, чем ВП 3
2638
2639 ;#DOES
2640 ; DOES> ( −− a ) Начало обработчика в порождающем слове.
2641 ; Все слова, определённые через DOES> находятся в памяти данных
2642 ; DOES> переводится с Форта на русский как "исполняется".
2643 ; Слово присутствует во всех фортах, но начиная с Форта−83 его реализация сильно отличается из−за отсутствия в этих языках слова <BUILDS
2644 LDOES: .DB 5
2645 .TEXT "DOES>" ; ( −− pfa) F79
2646 .DW LDEFER
2647 DOESD: .DW CALL, FROMR, LITP
2648 .DB 39,16 ; 10000
2649 .DW SUB, LATES,N2PFA,STORE, PSCOD
2650 ;∗∗ CALL по адресу из @PFA с засылкой в стек PFA+2
2651 SDOED: ; Обработчик в памяти данных, обычный случай
2652 KGSBC ; RPUSH RI; RX := W
2653 2 + M7 M5 ; W указывало на SDOED, а теперь указывает на xt (CFA) обработчика
2654 10002 + KM3 ; PUSH W+2 ; PFA+2 с трансляцией адресов
2655 KRM7 RME ∗ KRM5 + ; CFA всегда считывается из памяти данных
2656 1 − ; RX := PFA−1, передаём в указатель шитого кода R6=RI
2657 PGOTO SETRIDAT ; Переходим на NEXT для области данных
2658
2659 DOESP: .DW CALL ; Сейчас используется только для слова VOCABULARY
2660 .DW FROMR,LATES,N2PFA,STORE,PSCOD
2661 SDOEP: ; Обработчик в памяти программ, единичный случай
2662 KGSBC ; RPUSH RI; RX := W
2663 2 + M7 M5 ; W указывало на SDOE, а теперь на xt (CFA) обработчика
2664 10002 + KM3 ; PUSH W+2 ; PFA+2 с трансляцией адресов
2665 KRM7 RME ∗ KRM5 + ; .NUM DOVOC
2666 PGOTO SETRIPRG ; Переходим на NEXT для области программ
2667
2668 ;#FnumS
2669 ; F#S ( x −− ) Преобразовать десятичное число.
2670 LDIGF: .DB 3
2671 .TEXT "F#S" ; ( r −− ) К
2672 .DW LDOES
2673 DIGF: .DW JDIGF ; Преобразовывает число с плавающей запятой в строку символов.
2674 JDIGF: CX PPM 9030 ; Программирование индексного регистра 0
2675 PPM 9031 ; Программирование индексного регистра 1
2676 PKRM03 PPM 9035 ; Преобразование числа с естественной или плавающей запятой в строку символов
2677 RM3 1 + M3
2678 PPRM rrHLD RME ∗ PPRM rlHLD + ; HLD
2679 10001 M0 − M5
2680 .DB 0f9H ; PX>=0 aka PGOTO ED1 aka пропустить 2 байта
2681 ED0: FANS KM5
2682 ED1: PPRM 9034 KNOT FX=0 ED0 ; Чтение данных по индексному регистру 1 с автоинкриментом
2683 RM5 RM0 +
2684 ENT RME / FANS <−> KINT PPM rrHLD ∗ − PPM rlHLD
2685 KGOTO9
2686
2687 ; ∗∗ Константы ∗∗
2688 ;
2689 ;#FALSE
2690 ; FALSE ( −− 0 ) Ложь. Число 0.
2691 LZERO: .DB 5
2692 .TEXT "FALSE"
2693 .DW LDIGF
2694 ZERO: .DW JZERO
2695
2696 ;#One
2697 ; 1 ( −− 1 ) Число 1.
2698 LONE: .DB 1
2699 .TEXT "1"
2700 .DW LZERO
2701 ONE: .DW JONE
2702
2703 ;#Two
2704 ; 2 ( −− 2 ) Число 2.
2705 LTWO: .DB 1
2706 .TEXT "2"
2707 .DW LONE
2708 TWO: .DW JTWO
2709
2710 ;#TRUE
2711 ; TRUE ( −− −1 ) Истина. Число −1.
2712 LTRUE: .DB 4
2713 .TEXT "TRUE"
2714 .DW LTWO
2715 TRUE: .DW JTRUE
2716 JTRUE: 1 +/− KM3 KGOTO9
2717
2718 ;#Pi
2719 ; π ( −− 3,14159265359 ) Число пи.
2720 LPI: .DB 1,185 ; ( −− r ) К
2721 .DW LTRUE
2722 PI: .DW JPI
2723 JPI: FPI KM3 KGOTO9
2724
2725 ;#BL
2726 ; BL ( −− 32 ) Пробел. Число 32.
2727 LBL: .DB 2
2728 .TEXT "BL" ; ( −− 32) F79
2729 .DW LPI
2730 BL: .DW JBL
2731 JBL: 3
2732 JTWO: 2 KM3 KGOTO9 ; Обработчик 2
2733
2734 ;#CDivL
2735 ; C/L ( −− 64 ) Длина строки. Число 64.
2736 LCL0: .DB 3
2737 .TEXT "C/L" ; ( −− 64)
2738 .DW LBL ; Количество символов в одной строке экрана Форта.
2739 LIT64: .DW SCONP,64 ; CHAR# PER LINE, осторожней, иногда исп. как 64
2740
2741 ;#BDivBUF
2742 ; B/BUF ( −− 3072 ) Размер буфера в байтах. Число 3072.
2743 ; Вообще−то в Форте−79 зафиксирован размер блока 1024 байт. Но у нас блок побольше будет!
2744 ; Многие древние программы для Форта ожидают, что эта константа равна 1024 и будут удивлены.
2745 ; Если это слово используется в чужой программе, её работоспособность на Каллисто надо проверять тщательней.
2746 LB3BUF: .DB 5
2747 .TEXT "B/BUF" ; ( −− 3072) F79
2748 .DW LCL0
2749 B3BUF: .DW SCONP, 3072
2750
2751 ;#RT
2752 ; RT ( −− a ) Десятичная переменная, куда сохраняется регистр T стека МК−161.
2753 LRT: .DB 2
2754 .TEXT "RT"
2755 .DW LB3BUF
2756 RT: .DW SCONP
2757 .DB 27H,1fH ; 10015 rRT
2758
2759 ;#RZ
2760 ; RZ ( −− a ) Десятичная переменная, куда сохраняется регистр Z стека МК−161.
2761 LRZ: .DB 2
2762 .TEXT "RZ"
2763 .DW LRT
2764 RZ: .DW SCONP
2765 .DB 27H,20H ; 10016 rRZ
2766
2767 ;#RY
2768 ; RY ( −− a ) Десятичная переменная, куда сохраняется регистр Y стека МК−161.
2769 LRY: .DB 2
2770 .TEXT "RY"
2771 .DW LRZ
2772 RY: .DW SCONP
2773 .DB 27H,21H ; 10017 rRY
2774
2775 ;#RX
2776 ; RX ( −− a ) Десятичная переменная, куда сохраняется регистр X стека МК−161.
2777 LRX: .DB 2
2778 .TEXT "RX"
2779 .DW LRY
2780 RX: .DW SCONP
2781 .DB 27H,22H ; 10018 rRX
2782
2783 ;#ATRStore
2784 ; ATR! ( c −− ) Установить атрибут вывода на индикатор c (0..7).
2785 LATR: .DB 4
2786 .TEXT "ATR!" ; ( −− 19001) К
2787 .DW LRX
2788 ATR: .DW JATR
2789 JATR: PKRM03 PPM9001 ; R9001 Программирование атрибутов вывода.
2790 PGOTO JDROP ; 1 RM3 + M3 KGOTO9
2791
2792 ; ∗∗ USER−переменные ∗∗
2793 ;
2794 ;#SZero
2795 ; S0 ( −− a ) Переменная, адрес дна стека данных.
2796 LSZERO: .DB 2
2797 .TEXT "S0" ; F83
2798 .DW LATR
2799 SZERO: .DW SUSE
2800 .DB pS0
2801
2802 ;#RZero
2803 ; R0 ( −− a ) Переменная, адрес дна стека возвратов.
2804 LRZERO: .DB 2
2805 .TEXT "R0"
2806 .DW LSZERO
2807 RZERO: .DW SUSE
2808 .DB pR0
2809
2810 ;#deH
2811 ; ДH ( −− a ) Переменная, адрес вершины десятичного словаря.
2812 LDDP: .DB 2,132
2813 .TEXT "H" ; "ДH" К
2814 .DW LRZERO
2815 DDP: .DW SUSE
2816 .DB pDDP
2817
2818 ;#H
2819 ; H ( −− a ) Переменная, адрес вершины словаря.
2820 LDP: .DB 1
2821 .TEXT "H"
2822 .DW LDDP
2823 DP: .DW SUSE
2824 .DB pDP
2825
2826 ;#VOC−LINK
2827 ; VOC−LINK ( −− a ) Переменная связи, начало списка из наборов слов.
2828 LVOCLINK: .DB 8
2829 .TEXT "VOC−LINK"
2830 .DW LDP
2831 VOCLINK: .DW SUSE
2832 .DB pVOCLINK
2833
2834 ;#APP
2835 ; APP ( −− a ) Переменная, токен запускающего слова.
2836 ; Слово, xt которого хранится в переменной APP, будет выполнено после загрузки сохранения по LOAD"
2837 ; COLD записывает сюда адрес QUIT
2838 LAUTOEXEC: .DB 3
2839 .TEXT "APP" ; К
2840 .DW LVOCLINK
2841 AUTOEXEC: .DW SUSE
2842 .DB pAUTOEXEC
2843
2844 ;#KBDFLG
2845 ; KBDFLG ( −− a ) Переменная, двухбайтовый флаг клавиатуры.
2846 LKBDF: .DB 6
2847 .TEXT "KBDFLG" ; К Флаги клавиатуры: заглавные/строчные, цифры/буквы
2848 .DW LAUTOEXEC
2849 KBDF: .DW SUSE
2850 .DB pKBDFLG
2851
2852 ;#lowFONT
2853 ; _FONT ( −− a ) Адрес структуры терминала из 5 байт, описывающей активный шрифт.
2854 LFONT: .DB 5
2855 .TEXT "_FONT" ; К
2856 .DW LKBDF
2857 FONT: .DW SUSE
2858 .DB pFONT
2859
2860 ;#BLK
2861 ; BLK ( −− a ) Переменная, номер интерпретируемого блока.
2862 ; Переменная BLK переключает ввод информации на терминальный буфер ввода (BLK=0) или на экранный (BLK равнен номеру экрана).
2863 LBLK: .DB 3
2864 .TEXT "BLK" ; F79
2865 .DW LFONT
2866 BLK: .DW SUSE
2867 .DB pBLK
2868
2869 ;#toIN
2870 ; >IN ( −− a ) Переменная, внутренний указатель входного буфера (0..3071).
2871 LIN: .DB 3
2872 .TEXT ">IN" ; F79
2873 .DW LBLK
2874 IN: .DW SUSE
2875 .DB pIN ; Смещение внутри терминального или экранного буфера в зависимости от значения BLK
2876
2877 ;#SCR
2878 ; SCR ( −− a ) Переменная, номер редактируемого экрана.
2879 LSCR: .DB 3
2880 .TEXT "SCR" ; F79
2881 .DW LIN
2882 SCR: .DW SUSE ; Слово LIST записывает сюда номер последнего отображённого экрана.
2883 .DB pSCR
2884
2885 ;#CONTEXT
2886 ; CONTEXT ( −− a ) Переменная, контекстный список слов.
2887 LCONTEXT: .DB 7
2888 .TEXT "CONTEXT" ; F79
2889 .DW LSCR
2890 CONT: .DW SUSE
2891 .DB pCONTEXT ; Переменная указывает на список слов, в котором происходит поиск слов во время интерпретации.
2892
2893 ;#CURRENT
2894 ; CURRENT ( −− a ) Переменная, текущий пополняемый список слов.
2895 LCURRENT: .DB 7
2896 .TEXT "CURRENT" ; F79
2897 .DW LCONTEXT
2898 CURR: .DW SUSE
2899 .DB pCURRENT ; Переменная указывает список слов, в который вводятся определения новых слов.
2900
2901 ;#STATE
2902 ; STATE ( −− a ) Переменная, состояние текстового интерпретатора.
2903 LSTATE: .DB 5
2904 .TEXT "STATE" ; F79 F83
2905 .DW LCURRENT
2906 STATE: .DW SUSE
2907 .DB pSTATE ; 0 => Исполнение
2908
2909 ;#BASE
2910 ; BASE ( −− a ) Переменная, основание системы счисления для ввода−вывода чисел.
2911 LBASE: .DB 4
2912 .TEXT "BASE" ; F79
2913 .DW LSTATE
2914 BASE: .DW SUSE
2915 .DB pBASE
2916
2917 ;#DPL
2918 ; DPL ( −− a ) Переменная, позиция последней запятой в последнем введённом числе от конца.
2919 LDPL: .DB 3
2920 .TEXT "DPL"
2921 .DW LBASE
2922 DPL: .DW SUSE
2923 .DB pDPL
2924
2925 ;#CSP
2926 ; CSP ( −− a ) Переменная, контрольное значение указателя стека данных.
2927 LCSP: .DB 3
2928 .TEXT "CSP"
2929 .DW LDPL
2930 CSP: .DW SUSE
2931 .DB pCSP
2932
2933 ;#Rnum
2934 ; R# ( −− a ) Переменная, позиция курсора при редактировании экрана или возникновении ошибки.
2935 ; Позиция курсора при редактировании экрана.
2936 ; Также сюда записывается указатель >IN когда был выведен последний MESSAGE
2937 LRNUM: .DB 2
2938 .TEXT "R#"
2939 .DW LCSP
2940 RNUM: .DW SUSE
2941 .DB pRNUM
2942
2943 ;#HLD
2944 ; HLD ( −− a ) Переменная, указатель вершины буфера PAD.
2945 LHLD: .DB 3
2946 .TEXT "HLD"
2947 .DW LRNUM
2948 HLD: .DW SUSE
2949 .DB pHLD ; Позиция последней литеры, перенесённой в буфер PAD словом HOLD
2950
2951 ;#EE
2952 ; EE ( −− a ) Переменная, порядок вводимого числа.
2953 LEXP: .DB 2
2954 .TEXT "EE"
2955 .DW LHLD
2956 SEXP: .DW SUSE
2957 .DB pEXP
2958
2959 ;#ERB
2960 ; ERB ( −− a ) Переменная, флаг блокировки выхода в QUIT при ошибке ERROR.
2961 ; Если ERB=0, ERROR уходит в систему Форт
2962 ; В противном случае переменная ERB обнуляется, а уход из программы в Форт через QUIT блокируется.
2963 ; Блокировка осуществляется как при "неузнанном" имени, так и при неправильном вводе чисел,
2964 ; включая ошибки, связанные с конфликтами по системе счисления.
2965 ; Ошибку считывания состояния системы по LOAD" заблокировать невозможно.
2966 LERB: .DB 3
2967 .TEXT "ERB"
2968 .DW LEXP
2969 ERB: .DW SUSE
2970 .DB pERB
2971
2972 ;#SAVIN
2973 ; SAVIN ( −− a ) Переменная, значение >IN для NUMBER и BASE для FL.
2974 LSAVIN: .DB 5
2975 .TEXT "SAVIN"
2976 .DW LERB
2977 SAVIN: .DW SUSE
2978 .DB pSAVIN ; Сохраняем >IN в INTERPRET для NUMBER и BASE для FL
2979
2980 ; ∗∗ Слова высокого уровня ∗∗
2981
2982 ;#Comma
2983 ; , ( d −− ) Скомпилировать d в первую свободную ячейку словаря.
2984 LCOMMA: .DB 1
2985 .TEXT "," ; ( n −− ) F79
2986 .DW LSAVIN
2987 COMMA: .DW CALL
2988 RCOMMA: .DW HERE,STORE, TWO,ALLOT, EXIT ; Компилируем число n в первую свободную ячейку словаря.
2989
2990 ;#CComma
2991 ; C, ( b −− ) Скомпилировать b в первый свободный байт словаря.
2992 LCCOM: .DB 2
2993 .TEXT "C," ; ( c −− ) F79
2994 .DW LCOMMA
2995 CCOM: .DW CALL, HERE,CSTOR, ONE,ALLOT, EXIT ; Компилируем байт c в очередной свободный байт словаря.
2996
2997 ;#deComma
2998 ; Д, ( x −− ) Скомпилировать x в первый свободный регистр десятичного словаря.
2999 LDCOMMA: .DB 2,132
3000 .TEXT "," ; "Д," ( x −− ) К
3001 .DW LCCOM
3002 DCOMMA: .DW CALL, DHERE,STORE, ONE,DALLOT, EXIT ; Компилирует число x в первую свободную ячейку десятичного словаря.
3003
3004 ;#LAST
3005 ; LAST ( −− a ) Дать NFA последней созданной статьи.
3006 LLATES: .DB 4
3007 .TEXT "LAST" ; ( −− NFA )
3008 .DW LDCOMMA
3009 LATES: .DW CALL, CURR,UAT,UAT, EXIT ; Даёт ссылку на слово, определённое последним в текущем наборе слов.
3010
3011 ;#SPACE
3012 ; SPACE ( −− ) Пробел. Вывести пробел на индикатор.
3013 LSPACE: .DB 5
3014 .TEXT "SPACE" ; ( −−) F79
3015 .DW LLATES
3016 SPACE: .DW CALL
3017 RSPACE: .DW BL,EMIT, EXIT ; Вывод одного пробела. Каллисто выдаёт обычный пробел, по ширине может быть тоньше цифры.
3018
3019 ;#NtoLINK
3020 ; N>LINK ( a1 −− a2 ) От имени к связи. Преобразовать NFA в LFA.
3021 LNLINK: .DB 6
3022 .TEXT "N>LINK" ; ( nfa −− lfa ) F83
3023 .DW LSPACE
3024 NLINK: .DW CALL, DUP,CAT,BL,MOD,PLUS,ONEP,EXIT ; BL == 32
3025
3026 ;#NAMEfrom
3027 ; NAME> ( a −− т ) Получить токен по имени. Преобразовать NFA в CFA.
3028 LN2CFA: .DB 5
3029 .TEXT "NAME>" ; ( nfa −− cfa ) F83
3030 .DW LNLINK
3031 N2CFA: .DW CALL
3032 RN2CFA: .DW DUP,CAT,BL,MOD, PLUS, LITB ; BL == 32
3033 .DB 3
3034 .DW PLUS, EXIT
3035
3036 ;#NtoBODY
3037 ; N>BODY ( a1 −− a2 ) От имени к телу. Преобразовать NFA в PFA.
3038 ; Тоже самое, что последовательность NAME> >BODY
3039 LN2PFA: .DB 6
3040 .TEXT "N>BODY" ; ( nfa −− pfa ) К
3041 .DW LN2CFA
3042 N2PFA: .DW CALL, DUP,CAT,BL,MOD, PLUS, LITB ; BL == 32
3043 .DB 5
3044 .DW PLUS, EXIT
3045
3046 ;#qERROR
3047 ; ?ERROR ( ф c −− ) Сгенерировать ошибку номер c, если флаг ф истинен (ф≠0).
3048 LQERR: .DB 6
3049 .TEXT "?ERROR" ; ( флаг номер −− ) ?ERROR диагностика ошибок Форт ИТЭФ
3050 .DW LN2PFA
3051 QERR: .DW CALL
3052 RQERR: .DW SWAP, ZBRAN,TTT, BRAN,RERROR ; +++ Можно сократить с помощью ZEQU ?
3053 TTT: .DW DROP,EXIT
3054
3055 ;#qCOMP
3056 ; ?COMP ( −− ) Сгенерировать ошибку 17, если нет состояния компиляции.
3057 LQCOMP: .DB 5
3058 .TEXT "?COMP"
3059 .DW LQERR
3060 QCOMP: .DW CALL, STATE,UAT,ZEQU, LITB
3061 .DB 17
3062 .DW BRAN,RQERR
3063
3064 ;#qEXEC
3065 ; ?EXEC ( −− ) Сгенерировать ошибку 18, если нет состояния исполнения.
3066 LQEXEC: .DB 5
3067 .TEXT "?EXEC"
3068 .DW LQCOMP
3069 QEXEC: .DW CALL, STATE,UAT, LITB
3070 .DB 18
3071 .DW BRAN,RQERR
3072
3073 ;#qPAIRS
3074 ; ?PAIRS ( y x −− ) Сгенерировать ошибку 19, если x отлично от y.
3075 LQPAIR: .DB 6
3076 .TEXT "?PAIRS"
3077 .DW LQEXEC
3078 QPAIR: .DW CALL, SUB, LITB
3079 .DB 19
3080 .DW BRAN,RQERR
3081
3082 ;#qCSP
3083 ; ?CSP ( −− ) Сгенерировать ошибку 20, если указатель стека отличен от CSP.
3084 LQCSP: .DB 4
3085 .TEXT "?CSP"
3086 .DW LQPAIR ; Выдать ошибку "сбился указатель стека" если он не равен значению в "CSP".
3087 QCSP: .DW CALL, SPAT,CSP,UAT,SUB, LITB
3088 .DB 20
3089 .DW BRAN,RQERR
3090
3091 ;#qLOADING
3092 ; ?LOADING ( −− ) Сгенерировать ошибку 22, если входной текст идёт не с экрана.
3093 LQLOAD: .DB 8
3094 .TEXT "?LOADING"
3095 .DW LQCSP
3096 QLOAD: .DW CALL, BLK,UAT,ZEQU, LITB ; BLK U@ 0= 22 ?ERROR
3097 .DB 22
3098 .DW BRAN,RQERR
3099
3100 ;#COMPILE
3101 ; COMPILE ( −− ) Скомпилировать токен −− пару байт, следующих за COMPILE.
3102 ; Компиляция 16−битного слова, следующего за оператором. Обычно это токен (CFA).
3103 LCOMP: .DB 7
3104 .TEXT "COMPILE" ; F79
3105 .DW LQLOAD ; ?COMP R> DUP 2+ >R U@ ,
3106 COMP: .DW CALL, QCOMP, FROMR, DUP,TWOP,TOR, UAT, BRAN,RCOMMA
3107
3108 ;#SMUDGE
3109 ; SMUDGE ( −− ) Изменить признак невидимости последней созданной статьи.
3110 LSMUG: .DB 6
3111 .TEXT "SMUDGE"
3112 .DW LCOMP ; Изменить флаг "SMUDGE" в последней созданной статье.
3113 SMUG: .DW CALL ; LAST BL TOGGLE
3114 RSMUG: .DW LATES,BL,TOGL,EXIT ; BL == 32
3115
3116 ;#xSemiCODE
3117 ; (;CODE) ( −− ) Записать в поле кода LAST следующий адрес и EXIT (слово без заголовка).
3118 ; Слово (;CODE) невозможно использовать в прикладных программах, т.к. код ЯМК выполняется лишь из памяти программ.
3119 ; Для экономии места слово (;CODE) лишено заголовка.
3120 ;
3121 ; Записать в поле кода последней статьи следующий адрес и закончить определение.
3122 ;LPSCOD: .DB 7
3123 ; .TEXT "(" ; "(;CODE)"
3124 ; .DB 3BH
3125 ; .TEXT "CODE)"
3126 ; .DW LSMUG ; >R LAST NAME> !
3127 PSCOD: .DW CALL, FROMR, LATES,N2CFA, STORE, EXIT
3128
3129 ;#BUILDS
3130 ; <BUILDS ( −− ) Начало определяющей части порождающего слова.
3131 ; <BUILDS переводится с Форта на русский как "компилируется".
3132 ; Слово взято из Форта−79 и ранее, в Форте−83 и последующих вместо него можно использовать просто CREATE
3133 LBUILD: .DB 7
3134 .TEXT "<BUILDS" ; ( −− a) F79
3135 .DW LSMUG
3136 BUILD: .DW CALL, ZERO,BRAN,RCON ; 0 CONSTANT
3137
3138 ;#COUNT
3139 ; COUNT ( a −− a1 U ) Подсчёт. Даёт адрес a1 и длину U строки со счётчиком a.
3140 LCOUNT: .DB 5
3141 .TEXT "COUNT" ; ( a −− a+1 u ) F79
3142 .DW LBUILD ; Преобразование строки со счётчиком в адрес−длина.
3143 COUNT: .DW CALL, DUP,ONEP,SWAP,CAT, EXIT ; DUP 1+ SWAP C@
3144
3145 ;#XDotq
3146 ; (.") ( −− ) Слово, компилируемое в ."
3147 LPDOTQ: .DB 4 ; (.")
3148 .TEXT "(."
3149 .DB 34
3150 .TEXT ")"
3151 .DW LCOUNT
3152 PDOTQ: .DW CALL, I,COUNT,DUP,ONEP ; I COUNT DUP 1+
3153 .DW FROMR,PLUS,TOR,TYPE,EXIT ; R> + >R TYPE
3154
3155 ;#Dotq
3156 ; ." ( −− ) При исполнении вывести строку, ограниченную кавычкой.
3157 ; ." XXX" выводит строку XXX на индикатор во время выполнения определяемого слова. Код " завершает строку.
3158 ; Это слово нельзя употреблять вне определения через двоеточие.
3159 LDOTQ: .DB 82H
3160 .TEXT "." ; ." F83
3161 .DB 34
3162 .DW LPDOTQ
3163 DOTQ: .DW CALL, COMP,PDOTQ,LITB
3164 .DB 34 ; '"'
3165 .DW WORD,CAT,ONEP,ALLOT,EXIT
3166
3167 ;#Dotp
3168 ; .( ( −− ) При компиляции вывести строку, вплоть до закрывающей скобки.
3169 ; Выводит текст сообщения, ограниченного правой круглой скобкой.
3170 ; Может использоваться как вне, так и внутри определений через двоеточие.
3171 LCOMQ: .DB 82H
3172 .TEXT ".(" ; F83
3173 .DW LDOTQ
3174 COMQ: .DW CALL, LITB
3175 .DB 41 ; '('
3176 .DW WORD,COUNT,TYPE,EXIT
3177
3178 ;#QUERY
3179 ; QUERY ( −− ) Ввести строку с пульта в TIB, ограничив её двумя нулями.
3180 ; Осуществляет ввод строки символов с клавиатуры.
3181 ; Ввод прекращается, если нажата клавиша Ввод или заполнен входной буфер.
3182 ; Максимальный размер строки 94 символа.
3183 LQUERY: .DB 5
3184 .TEXT "QUERY" ; F79
3185 .DW LCOMQ
3186 QUERY: .DW CALL, ZERO,TIB,DUP,LITB
3187 .DB 94
3188 .DW ACCE,PLUS,STORE, IN,ZSTORE, BRAN,RSPACE
3189
3190 ;#null
3191 ; без имени ( −− ) Пустышка. Закончить интерпретацию входного потока.
3192 ; Нулевое слово прерывает цикл INTERPRET
3193 ; Старый, но весьма сомнительный приём. В Каллисто 2.0 будет удалён.
3194 LNULL: .DB 81H
3195 .DB 0 ; "\0"
3196 .DW LQUERY
3197 NULL: .DW CALL, BLK,UAT,ZBRAN,NUL
3198 .DW ONE,BLK,PSTOR, IN,ZSTORE, QEXEC ; +++ автоматом на следующий экран для THRU −− нужно ли?
3199 NUL: .DW LEV,EXIT
3200
3201 ;#PAD
3202 ; PAD ( −− a ) Адрес буфера промежуточного хранения последовательности литер.
3203 ; Выдаёт адрес буфера для промежуточного хранения последовательностей символов
3204 ; Положение временного буфера жёстко связано с верхней границей словаря, определяемой словом HERE
3205 LPAD: .DB 3
3206 .TEXT "PAD" ; F79
3207 .DW LNULL
3208 PAD: .DW CALL, HERE,LITB
3209 .DB 84 ; Размер PAD −− 84 байта
3210 .DW PLUS,EXIT
3211
3212 ;#WORD
3213 ; WORD ( c −− a ) Ввести слово до стоп−литеры c. Дать его адрес, как строки со счётчиком.
3214 ; Считывает одно слово из входного или экранного буфера и размещает его, начиная с адреса HERE
3215 ; Первый байт содержит число символов в слове.
3216 ; Кладёт адрес считанного слова на стек, как это требует Форт−79.
3217 ; Этот адрес a всегда HERE −− как и в большинстве реализаций Форта.
3218 LWORD: .DB 4
3219 .TEXT "WORD" ; ( c "<c>ccc<c>" −− HERE ) F79 F83
3220 .DW LPAD
3221 WORD: .DW CALL, BLK,UAT, QDUP,ZBRAN,WD1, BLOCK, BRAN,WD2
3222 WD1: .DW TIB
3223 WD2: .DW IN,UAT, PLUS, SWAP, ENCL
3224 .DW HERE, BL,BLANK ; BL == 32 ( 31 имя и 1 байт длины)
3225 .DW IN,PSTOR, DUP,TOR, HERE,CSTOR
3226 .DW HERE,ONEP, FROMR, CMOVE, HERE, EXIT
3227
3228 ;#UCONVERT
3229 ; UCONVERT ( u a −− u1 a1 ) Преобразовать u и литеры от a+1 в u1 и a1 −− адрес первой не цифры.
3230 LPNUMB: .DB 8
3231 .TEXT "UCONVERT"
3232 .DW LWORD
3233 PNUMB: .DW CALL
3234 BN: .DW ONEP, DUP,TOR, CAT, BASE,UAT, DIGIT, ZBRAN,MMO
3235 .DW SWAP, BASE,UAT,STAR, PLUS
3236 .DW DPL,AT, ONEP, ZBRAN,BN1, ONE,DPL,PSTOR ; Увеличить DPL на единицу, если там не −1
3237 BN1: .DW FROMR, BRAN,BN
3238 MMO: .DW FROMR, EXIT
3239
3240 ;#FINDN
3241 ; FINDN ( a −− a1 c 1 | 0 ) Поиск слова в активных наборах. При успехе дать NFA и байт счётчика.
3242 ; Поиск слова в активных наборах слов
3243 ; a −− адрес начала счётной строки, содержащей имя слова, которое нужно найти в словаре
3244 ; В отличии от Форта ИТЭФ a1 это NFA
3245 ; −FIND Форта ИТЭФ может быть имитирован BL WORD FINDN NAME>
3246 ; Может изменить строчку a, переведя всё в заглавные буквы.
3247 ; +++ Доработать возвращаемые параметры до Форта−83
3248 LFIND: .DB 5
3249 .TEXT "FINDN" ; ( a −− nfa c 1 | 0 ) К
3250 .DW LPNUMB
3251 FIND: .DW CALL, DUP,TOR, COUNT, UPPER
3252 .DW CONT,UAT, CURR,UAT, SUB, ZBRAN,ONCE ; Если словарь один, ускоряем поиск вдвое
3253 .DW I, CONT,UAT,UAT, PFIND, QDUP, ZEQU, ZBRAN,FIN
3254 ONCE: .DW I, LATES, PFIND
3255 FIN: .DW LEV, EXIT ; R> DROP
3256
3257 ;#NUMBER
3258 ; NUMBER ( a −− n ) Преобразовать строку в целое число n, начиная с a+1.
3259 ; Преобразует в число последовательность символов, начиная с a+1 с учётом BASE,
3260 ; a может содержать число символов в строке.
3261 ; Подразумевается, что после числа всегда идёт пробел, а строчные буквы уже преобразованы в заглавные.
3262 ; Переписать для Форта−2012 и требований Каллисто
3263 ; Трюк с SAVIN делает NUMBER при обработке 'c' интимно зависимым от INTERPRET
3264 ; при переписывании под стандарт символьное число придётся вынести в отдельное слово
3265 ; Слово присутствует ещё в Форте−79, но у нас оно возвращает одну ячейку стека, а не двойную.
3266 ; +++ Возможно, стоит сделать вызов FL здесь.
3267 ; +++ Убрать зависимость от WORD и входного потока
3268 LNUMB: .DB 6
3269 .TEXT "NUMBER" ; ( адрес −− число ) К
3270 .DW LFIND
3271 NUMB: .DW CALL, SEXP,ZSTORE ; Обнуляем порядок
3272 .DW TRUE,DPL,STORE ; DPL := −1
3273 .DW BASE,UAT, ZERO, ROT ; 0 значит положительное число
3274 .DW ONEP,DUP, CAT
3275 .DW DUP,LITB
3276 .DB 39 ; "'"
3277 .DW EQUAL, ZBRAN,NH2
3278
3279 ; .DW DROP, SAVIN,UAT, IN,STORE, BL,WORD, DROP ; Восстанавливаем регистр символа
3280 ; .DW ONEP,DUP, CAT, SWAP ; Символ
3281 ;
3282 ; DROP a мусор −− a
3283 ; SAVIN U@ a −− a adr
3284 ; IN ! a adr −− a
3285 ; BL WORD a −− a adr
3286 ; DROP a adr −− a
3287 ; 1+ DUP a −− a+1 a+1
3288 ; C@ a+1 a+1 −− a+1 c
3289 ; SWAP a+1 c −− c a+1
3290
3291 ; DROP SAVIN C@ SWAP 1+ a мусор −− c a+1
3292
3293 .DW DROP, SAVIN,CAT, SWAP, TWOP ; Считываем литеру из старшего байта SAVIN
3294
3295 ; .DW ONEP,
3296 .DW DUP, CAT, LITB
3297 .DB 39 ; "'"
3298 .DW SUB, ZBRAN,NH21
3299 .DW DROP, BRAN,ER2
3300 NH21: .DW ONEP,CAT, BL,EQUAL, ZBRAN,ER2
3301 NH22: .DW ROT,ROT, DDROP, EXIT ; Выход, символ определён
3302 NH2: .DW DUP, LITB
3303 .DB 35 ; "#"
3304 .DW EQUAL, ZBRAN,NH01
3305 .DW DROP, DEC, BRAN,NH03 ; Десятичное число
3306 NH01: .DW DUP, LITB
3307 .DB 36 ; "$"
3308 .DW EQUAL, ZBRAN,NH02
3309 .DW DROP, HEX, BRAN,NH03 ; Шестнадцатеричное число
3310 NH02: .DW LITB
3311 .DB 37 ; "%"
3312 .DW EQUAL, ZBRAN,NH04
3313 .DW TWO,BASE,STORE ; Двоичное число
3314 NH03: .DW ONEP
3315 NH04: .DW DUP,CAT, LITB
3316 .DB 45 ; "−"
3317 .DW EQUAL, ZBRAN,NH3
3318 .DW SWAP,ONEP, SWAP,ONEP ; 1 значит отрицательное число
3319 NH3: .DW ONEM
3320 NH4: .DW ZERO, SWAP, PNUMB
3321 .DW DUP,CAT, BL,SUB, ZBRAN,NH6
3322 .DW DUP,CAT, LITB
3323 .DB 44 ; ","
3324 .DW EQUAL, ZBRAN,NEXP
3325 .DW DPL,ZSTORE, PNUMB, DUP,CAT, BL,SUB, ZBRAN,NH6
3326 NEXP: .DW DPL,AT, ZERO,MAX, SWAP ; Теперь числа с E, но без запятой ловятся по DPL
3327 .DW DUP,CAT, LITB
3328 .DB 69 ; "E"
3329 .DW EQUAL, ZBRAN,ER1
3330 .DW ONEP, DUP,CAT, LITB
3331 .DB 45 ; "−"
3332 .DW EQUAL, ZBRAN,NEMI, ONE, BRAN,NH0
3333 NEMI: .DW ONEM, ZERO
3334 NH0: .DW SWAP,ZERO,SWAP, PNUMB, CAT, BL,EQUAL, ZBRAN,ER
3335 .DW SWAP, ZBRAN,NH5, NEGATE ; Если был "−", изменить знак порядка
3336 NH5: .DW SEXP,STORE, DPL,STORE, ZERO
3337 NH6: .DW DROP, SWAP, ZBRAN,NH7, NEGATE ; Если был "−", изменить знак числа
3338 NH7: .DW SWAP, BASE, DUP,UAT,SAVIN,STORE, STORE, EXIT
3339 ER: .DW DROP
3340 ER1: .DW DDROP
3341 ER2: .DW DDROP
3342 .DW BASE, DUP,UAT,SAVIN,STORE, STORE,ZERO,ERROR ; Эксперимент: восстановим систему счисления при ошибке
3343 .DW ZERO, EXIT ; Возвращаем 0, если выключена обработка ошибок
3344
3345 ;#FL
3346 ; FL ( n −− x ) Преобразовать возвращённое NUMBER целое в десятичное число.
3347 ; +++ Слово из расширения Форта ИТЭФ вошло в ядро Каллисто, возможно нуждается в переименовании.
3348 LFL: .DB 2
3349 .TEXT "FL" ; ( n −− f ) В Каллисто вызывается автоматически
3350 .DW LNUMB
3351 FL: .DW CALL, SAVIN,UAT ; В SAVIN слово NUMBER записало использовавшуюся систему счисления
3352 .DW SEXP,AT, DPL,AT, SUB
3353 .DW DUP, LITP,333,LESS, ZBRAN,FLER1 ; Робкая попытка защититься от переполнения без учёта BASE (2^333).
3354 .DW POWER, STAR, EXIT
3355 FLER1: .DW DDROP, ZERO, BRAN,RERROR
3356
3357 ;#ERROR
3358 ; ERROR ( c −− ) Вывести сообщение об ошибке c и уйти в QUIT если ERB=0.
3359 LERROR: .DB 5
3360 .TEXT "ERROR" ; ( номер −− ) Диагностика ошибок Форт ИТЭФ
3361 .DW LNUMB
3362 ERROR: .DW CALL ; Уход в среду Каллисто, если ERB=0
3363 RERROR: .DW HERE,COUNT,TYPE, PDOTQ
3364 .DB 3
3365 .TEXT " ? "
3366 .DW ERB,UAT, ZBRAN,XER
3367 .DW ERB,ZSTORE, DROP, EXIT
3368 XER: .DW MESS, SPSTO, DISKOFF, BRAN,RQUIT ; Каллисто также запрещает дисковые операции
3369
3370 ;#IDd
3371 ; ID. ( a −− ) Напечатать имя слова (по NFA) и дать пробел.
3372 ; Печатает имя слова, записанное в соответствии с требованиями поля имени.
3373 LIDDOT: .DB 3
3374 .TEXT "ID." ; ( nfa −− )
3375 .DW LERROR
3376 IDDOT: .DW CALL, COUNT, BL,MOD, TYPE, BRAN,RSPACE ; BL == 32
3377
3378 ;#CREATE
3379 ; CREATE ( −− ) Создать начало статьи (до PFA) для следующего слова.
3380 ; Формирует слово с именем XXX (заголовок и CFA), оставляя его поле параметров пустым.
3381 ; При обращении к XXX на стек кладётся его адрес.
3382 ; Длина имени слова ограничивается 31 литерой
3383 ; Слово присутствует в Форте−79 и последующих, но имеет небольшие отличия из−за принятия на себя функций <BUILDS
3384 LCREAT: .DB 6
3385 .TEXT "CREATE" ; ( "<пр>имя" −− ) К
3386 .DW LIDDOT
3387 CREAT: .DW CALL, BL,WORD, FIND, ZBRAN,CRE
3388 .DW DROP,IDDOT,LITB ; Наш FIND возвращает NFA
3389 .DB 4
3390 .DW MESS ; Сообщение, что такое слово уже есть
3391 CRE: .DW HERE, DUP,CAT, LITB
3392 .DB 31
3393 .DW MIN ; Обрезать длину по 31 литеру
3394 .DW DUP, CCOM ; биты SMUDGE и IMMEDIATE сброшены
3395 .DW ALLOT ; Оставить слово как поле имени
3396 .DW LATES, COMMA ; NFA прошлого слова в поле связи
3397 .DW CURR,UAT, STORE ; Сделать слово последним в словаре CURRENT @
3398 .DW LITP,SCRE, BRAN,RCOMMA ; CFA: созданное слово кладёт на стек свой PFA
3399 SCRE: RM7 10002 + KM3 KGOTO9 ; Созданные слова размещаются в области двоичных данных
3400
3401 ;#BracketCOMPILE
3402 ; [COMPILE] ( −− ) Скомпилировать следующее слово, независимо от его признака IMMEDIATE.
3403 ; Заставляет следующее слово скомпилироваться, даже если оно обладает признаком немедленного исполнения.
3404 ; Используется внутри определений через двоеточие. Сейчас используется мало, в моде POSTPONE
3405 LBCOM: .DB 89H
3406 .TEXT "[COMPILE]" ; ( "<пр>имя" −−) F79
3407 .DW LCREAT
3408 BCOM: .DW CALL, BL,WORD, FIND, ZEQU, ZERO,QERR, DROP, N2CFA, BRAN,RCOMMA
3409
3410 ;#TO
3411 ; TO ( x −− ) Записать x в десятичную величину или переменную действия.
3412 LTO: .DB 82H
3413 .TEXT "TO" ; ( x "<пр>имя" −− ) F12
3414 .DW LBCOM
3415 TO: .DW CALL, BL,WORD, FIND, ZEQU, ZERO,QERR, DROP, N2PFA, TWOP
3416 .DW STATE,UAT, ZBRAN,TO1, COMMA, EXIT
3417 TO1: .DW EXEC, EXIT
3418
3419 ;#LITERAL
3420 ; LITERAL ( D −− | D ) Скомпилировать D в литерал. В режиме исполнения оставляет D на стеке.
3421 ; 1. При компиляции переносит код D из стека в описание нового слова,
3422 ; а при интерпретации описанного слова кладёт D на стек.
3423 ; Скомпилированный код может зависеть от значения компилируемого числа.
3424 ; 2. При исполнении оставляет D на вершине стека.
3425 LLITER: .DB 87H
3426 .TEXT "LITERAL" ; ( n −− ) F79
3427 .DW LTO
3428 LITER: .DW CALL
3429 RLITER: .DW STATE,UAT, ZBRAN,REXIT, COMP,LITD, BRAN,RCOMMA
3430
3431 ;#FLITERAL
3432 ; FLITERAL ( x −− | x ) Скомпилировать x в литерал. В режиме исполнения оставляет x на стеке.
3433 ; Тоже, что и LITERAL, но для плавучки. Литерал компилируется в десятичный словарь, откуда его читает (ИП)
3434 LFLITE: .DB 88H
3435 .TEXT "FLITERAL"
3436 .DW LLITER
3437 FLITE: .DW CALL, STATE,UAT, ZBRAN,REXIT, COMP,XREG, DCOMMA, DHERE, LITP
3438 .DB 39,17 ; 10001
3439 .DW SUB, BRAN,RCOMMA
3440
3441 ;#qSTACK
3442 ; ?STACK ( −− ) Сгенерировать ошибку 1, если стек вычерпан (или переполнен).
3443 LQSTAC: .DB 6
3444 .TEXT "?STACK"
3445 .DW LFLITE
3446 QSTAC: .DW CALL
3447 .DW SZERO,UAT, ONEM, SPAT, LESS, ONE, BRAN,RQERR
3448 ; .DW LITP
3449 ; .DB 255,80H ; .DW −80H не работает, т.к. литералы все положительные в памяти программ
3450 ; .DW SPAT,LESS,TWO,BRAN,RQERR ; +++ проверить с ДHERE на сохранность десятичных переменных
3451
3452 ;#INTERPRET
3453 ; INTERPRET ( −− ) Интерпретировать входной поток.
3454 LINTER: .DB 9
3455 .TEXT "INTERPRET"
3456 .DW LQSTAC
3457 INTER: .DW CALL ; Интерпретирует последовательность слов, пока во входном потоке что−то есть.
3458 IT1: .DW BL,WORD
3459 .DW DUP,TWOP,CAT, SAVIN,CSTOR ; Сохраняем второй символ, важный для обработки констант литер в NUMBER
3460 .DW FIND, ZBRAN,IT3, STATE,UAT, LESS
3461 .DW ZBRAN,IT2, N2CFA, COMMA, BRAN,IT5
3462 IT2: .DW N2CFA, EXEC, BRAN,IT5
3463 IT3: .DW HERE, NUMB, DPL,AT, ONEP, ZBRAN,IT4, FL, FLITE, BRAN,IT5
3464 IT4: .DW LITER ; Проверить здесь стек
3465 IT5: .DW QSTAC, BRAN,IT1
3466
3467 ;#IMMEDIATE
3468 ; IMMEDIATE ( −− ) Изменить признак IMMEDIATE последней созданной статьи.
3469 LIMMED: .DB 9
3470 .TEXT "IMMEDIATE"
3471 .DW LINTER
3472 IMMED: .DW CALL, LATES, LITB ; Преобразует слово, за описанием которого следует, в оператор, исполняемый при компиляции.
3473 .DB 128
3474 .DW TOGL, EXIT
3475
3476 ;#VOCABULARY
3477 ; VOCABULARY ( −− ) Определить следующее слово, как набор слов над набором CURRENT.
3478 ; Порождающее слово, которое создаёт новые наборы слов. Исполнение созданного слова делает набор контекстом CONTEXT
3479 LVOCAB: .DB 10
3480 .TEXT "VOCABULARY" ; F79
3481 .DW LIMMED
3482 VOCAB: .DW CALL, BUILD, LITP
3483 .DB 1,32 ; +++ Здесь может потребоваться переставить байты местами
3484 .DW COMMA, CURR,UAT, CFA, COMMA
3485 .DW HERE, VOCLINK,UAT, COMMA, VOCLINK,STORE, DOESP
3486 DOVOC: .DW TWOP, CONT,STORE, EXIT
3487
3488 ;#p
3489 ; ( ( −− ) Комментарий. Игнорировать входные литеры до закрывающей круглой скобки.
3490 ; Комментарий. Игнорировать всё до первой встречной ")" или конца строки (терминал) / экрана (интерпретация блока).
3491 ; +++ Проверить насчёт конца строки/экрана.
3492 LPAREN: .DB 81H
3493 .TEXT "(" ; F79
3494 .DW LVOCAB
3495 PAREN: .DW CALL, LITB
3496 .DB 41 ; ")"
3497 .DW WORD, DROP, EXIT
3498
3499 ;#QUIT
3500 ; QUIT ( −− ) Передать управление на пульт. Ждёт команду молча, без приглашения.
3501 ; Очищает стек возвратов, устанавливает состояние исполнения и возвращает управление на пульт Каллисто.
3502 ; Не выдаётся никаких сообщений. Резидентный монитор среды Каллисто.
3503 LQUIT: .DB 4
3504 .TEXT "QUIT" ; F79
3505 .DW LPAREN
3506 QUIT: .DW CALL
3507 RQUIT: .DW BLK,ZSTORE, LBRAC
3508 QUI: .DW RPSTO, CR, QUERY, INTER, STATE,UAT
3509 .DW ZEQU, ZBRAN,QUI, PDOTQ
3510 .DB 3
3511 .TEXT " ok" ; Это приглашение не будет видно при 2 FONT!
3512 .DW BRAN,QUI
3513
3514 ;#ABORT
3515 ; ABORT ( −− ) Очищает стек, устанавливает набор слов FORTH и молча делает QUIT.
3516 ; Прерывает исполнение, делает набор FORTH контекстным, исполняет QUIT
3517 ;
3518 ; Очистить стеки возвратов и данных, установить состояние исполнения. Вернуть контроль терминалу. (F79)
3519 ;
3520 ; Очистка стека данных и выполнение функций слова QUIT. Сообщения не выдаются (Броуди)
3521 ;
3522 ; Используется при инициализации системы, обработке всевозможных ошибок
3523 ; и выходе системы из нештатных ситуаций.
3524 LABORT: .DB 5
3525 .TEXT "ABORT" ; F79 В Форте−2012 есть ABORT и ABORT"
3526 .DW LQUIT
3527 ABORT: .DW CALL
3528 RABORT: .DW SPSTO, RAD, DEC
3529 .DB 2bH,8fH ; 11151 FORTH (xt)
3530 .DW DEFIN, BRAN,RQUIT
3531
3532 ;#EMPTY−BUFFERS
3533 ; EMPTY−BUFFERS ( −− ) Очистить буфер, независимо от содержания. Ничего на диск не записывать.
3534 ; Буфер отмечается как пустой, независимо от содержания. Обновлённый блок на диск не записывается.
3535 ; +++ По хорошему содержимое буфера можно не стирать, даже быстрее будет.
3536 LMTBUF: .DB 13
3537 .TEXT "EMPTY−BUFFERS" ; F79 F84
3538 .DW LABORT
3539 MTBUF: .DW CALL
3540 RMTBUF: .DW BUFN, LITP,3074, ERASE, EXIT
3541
3542 ;#SAVE−BUFFERS
3543 ; SAVE−BUFFERS ( −− ) Если установлен флаг UPDATE, сбросить блок на диск.
3544 ; Если находящийся в буфере экран был изменён, скидывает его на диск. Буфер остаётся распределённым.
3545 LSVBUF: .DB 12
3546 .TEXT "SAVE−BUFFERS" ; F79 F84
3547 .DW LMTBUF
3548 SVBUF: .DW CALL, BUFN,AT, ZLESS, ZBRAN,REXIT
3549 .DW ZERO,BUFN,CSTOR ; Сбросить флаг UPDATE
3550 .DW BUFN,UAT, ZERO, BRAN,RRW ; Записать буфер на диск
3551
3552 ;#FLUSH
3553 ; FLUSH ( −− ) Если буфер изменён, сохранить на диск. Очистить буфер.
3554 LFLUSH: .DB 5
3555 .TEXT "FLUSH" ; F83
3556 .DW LSVBUF
3557 FLUSH: .DW CALL ; Если экран изменён, скидывает его на диск и выкидывает его из памяти.
3558 RFLUSH: .DW SVBUF ; Записать буфер на диск
3559 .DW BRAN,RMTBUF ; Очистить буфер
3560
3561 ;#BUFFER
3562 ; BUFFER ( c −− a ) Приписать буферу блок c и дать адрес буфера. Сам блок с диска не считывать.
3563 ; Резервирует блок в памяти и приписывает ему номер u (как и BLOCK ), но сам блок с диска не считывается.
3564 LBUFFE: .DB 6
3565 .TEXT "BUFFER" ; ( №блока −− 15096 ) F79
3566 .DW LFLUSH
3567 BUFFE: .DW CALL, BUFN
3568 .DW DUP,AT,ZLESS, ZBRAN,BR2 ; Буфер был изменён?
3569 .DW BUFN,ONEP,CAT ; Достать номер изменённого блока
3570 .DW ZERO,RW ; Записать буфер на диск
3571 BR2: .DW STORE ; Сохранить новый номер блока, сбросив флаг UPDATE
3572 BR3: .DW LITP
3573 .DB 3aH,0f8H ; rrDISKBUF 15096 = 3af8
3574 REXIT: .DW EXIT
3575
3576 ;#BLOCK
3577 ; BLOCK ( c −− a ) Убедиться, что в буфере блок c. Дать адрес буфера.
3578 ; Кладёт на стек адрес первого байта в буфере с блоком, номером которого u.
3579 ; Если блок не находится в памяти, он переносится с носителя в буфер.
3580 ; Если блок, занимавший буфер, был ранее изменён (UPDATE), то этот блок сначала записывается на диск,
3581 ; и только затем на его место будет занесён новый блок.
3582 LBLOCK: .DB 5
3583 .TEXT "BLOCK" ; ( №блока −− 15096 ) F79
3584 .DW LBUFFE
3585 BLOCK: .DW CALL, TOR ; Сохраним номер запрошенного блока на вершине стека возвратов
3586 .DW BUFN,ONEP,CAT ; Какой у нас сейчас блок в буфере?
3587 .DW I,SUB, ZBRAN,BLC ; Блок уже считан? Вернуть адрес буфера.
3588 .DW I, BUFN ; rrBUFBLK 15094 = 3af6
3589 .DW DUP,AT,ZLESS, ZBRAN,BL1 ; Блок изменялся?
3590 .DW BUFN,ONEP,CAT, ZERO,RW ; Записать старый блок
3591 BL1: .DW I,ONE,RW ; Считать запрошенный блок
3592 .DW STORE ; Сохранить новый номер блока, заодно сбросив флаг UPDATE
3593 BLC: .DW LEV ; Удалим номер блока со стека возвратов
3594 .DW BRAN,BR3 ; Вернём наш фиксированный адрес
3595
3596 ;#xLINE
3597 ; (LINE) ( c1 c2 −− a c ) Вернуть адрес и длину строки номер c1 с экрана c2.
3598 ; Выдаёт адрес a и длину c строки c1 с экрана c2. В Каллисто выдаёт длину без пробелов в конце.
3599 LDLINE: .DB 6
3600 .TEXT "(LINE)" ; ( №строки №экрана −− адрес длина) К
3601 .DW LBLOCK
3602 DLINE: .DW CALL
3603 RDLINE: .DW TOR, LIT64,B3BUF,SSMOD, FROMR,PLUS, BLOCK
3604 .DW PLUS, LIT64, DTRAI, EXIT
3605
3606
3607 ;#MESSAGE
3608 ; MESSAGE ( c −− ) Сохранить >IN в R# и вывести сообщение номер c.
3609 ; Если доработать до Форта−2012, можно приблизить к стр.99
3610 ; В Форте ИТЭФ сообщения при WARNING=1 хранились в блоке №4.
3611 ;
3612 ; Сообщение Значения Сообщение при WARNING=1 Кто генерирует ошибку
3613 ; ( нет в Каллисто 1.0)
3614 ;
3615 ; MSG# 0 Слово не узнано. [COMPILE] TO 'N '
3616 ; Число не узнано.
3617 ; Нет соответствия системе счисления
3618 ; MSG# 1 Попытка извлечь нечто из пустого стека EMPTY STACK ?STACK
3619 ; MSG# 2 Переполнение стека или словаря STACK OR DIRECTORY OVERFLOW ?STACK
3620 ; MSG# 4 Повторное описание слова (не является IT ISN'T UNIQUE
3621 ; фатальной ошибкой)
3622 ; MSG# 17 Используется только при компиляции COMPILATION ONLY ?COMP
3623 ; MSG# 18 Используется только при исполнении EXECUTION ONLY ?EXEC
3624 ; MSG# 19 IF и THEN или другие операторы CONDITIONALS AREN'T PAIRED ?PAIRS
3625 ; не имеют пары
3626 ; MSG# 20 Определение не завершено DEFINITION ISN'T FINISHED ?CSP
3627 ; MSG# 21 Неверный аргумент слова FORGET PROTECTED DIRECTORY FORGET ( нет в Каллисто 1.0)
3628 ; Слово в защищённой области словаря
3629 ; MSG# 22 Должно использоваться только USED AT LOADING ONLY ?LOADING
3630 ; при загрузке
3631 ; MSG# 23 Строка экрана вне диапазона 0..47
3632 ; MSG# 24 ??? ??? FORGET ( нет в Каллисто 1.0)
3633 ; MSG# 26 Деление на 0 0 DIVISION ( нет в Каллисто)
3634 ; (только в Каллисто, ошибки дисковых операций)
3635 ; MSG# 39 Сохранение от другой версии LOAD" ( не может быть игнорировано)
3636 ; MSG# 40 Файл не найден LOAD"
3637 ; MSG# 41 Нет диска
3638 ; MSG# 42 Диск не форматирован
3639 ; MSG# 43 Нет места на диске
3640 ; MSG# 44 Нет места в каталоге
3641 ; MSG# 45 Ошибка имени файла/каталога
3642 ; MSG# 46 Невозможно удалить/создать/загрузить файл/каталог
3643 ; MSG# 47 Файл/каталог не выбран
3644 ; MSG# 48 Нет разрешения дисковой операции
3645 ;
3646 ; +++ Установить DECIMAL на время вывода номера ошибки
3647 LMESS: .DB 7
3648 .TEXT "MESSAGE"
3649 .DW LDLINE
3650 MESS: .DW CALL, IN,UAT, RNUM,STORE, PDOTQ
3651 .DB 5
3652 .TEXT "MSG #"
3653 .DW BRAN,RDOT
3654
3655 ;#LOAD
3656 ; LOAD ( c −− ) Загрузить с диска и интерпретировать экран номер c.
3657 LLOAD: .DB 4
3658 .TEXT "LOAD" ; ( i∗x №блока −− j∗x) F79
3659 .DW LMESS ; Загружает экран с номером u (компилирует или исполняет)
3660 LOAD: .DW CALL, BLK,UAT,TOR, IN,UAT,TOR, IN,ZSTORE, BLK,STORE
3661 .DW INTER, FROMR,IN,STORE, FROMR,BLK,STORE, EXIT
3662
3663 ;#bs
3664 ; \ ( −− ) Комментарий. Игнорировать остаток строки.
3665 ; +++ Также сделать, чтобы сбрасывала ввод с клавиатуры, это требования Форта−2012.
3666 LBSLASH: .DB 81H,92 ; "\" ( −− ) F83
3667 .DW LLOAD ; Закончить интерпретацию строки.
3668 BSLASH: .DW CALL, IN,UAT, LIT64,SLASH, ONEP, LIT64,STAR, IN,STORE, EXIT
3669
3670 ;#bsS
3671 ; \S ( −− ) Комментарий. Игнорировать остаток экрана.
3672 LSEMIS: .DB 82H,92 ; "\S" ( −− ) Броуди
3673 .TEXT "S"
3674 .DW LBSLASH ; Закончить интерпретацию экрана.
3675 SEMIS: .DW CALL, QLOAD, LEV, EXIT ; Выход из INTERPRET в LOAD
3676
3677 ;#THRU
3678 ; THRU ( c1 c2 −− ) Интерпретировать экраны с номерами от c1 до c2 включительно.
3679 ; +++ Проверить!
3680 LTHRU: .DB 4
3681 .TEXT "THRU" ; ( первый последний −− )
3682 .DW LSEMIS
3683 THRU: .DW CALL, OVER,SUB,ONEP, XFOR,THRU2
3684 THRU1: .DW DUP,LOAD, ONEP, XNEXT,THRU1 ; Можно ли вообще без LOAD, опираясь на реализацию \0 ?
3685 THRU2: .DW DROP, EXIT
3686
3687 ;#Arrow
3688 ; −−> ( −− ) Интерпретировать следующий экран.
3689 ; Даёт команду немедленно приступить к интерпретации следующего по порядку экрана.
3690 ; Может быть использовано внутри определения через двоеточие, которое пересекает границу экрана.
3691 ; +++ Проверить!
3692 ; Броуди рекомендует вместо −−> использовать THRU
3693 ; +++ Может убрать её нафиг?
3694 ;LARROW: .DB 83H
3695 ; .TEXT "−−>" ; ( −−) F79
3696 ; .DW LTHRU
3697 ;ARROW: .DW CALL, QLOAD, IN,ZSTORE, ONE,BLK,PSTOR, EXIT
3698
3699 ;#TickN
3700 ; 'N ( −− a ) Ищет следующее слово, возвращая его NFA.
3701 ; Фраза 'N XXX ищет слово с именем XXX (из входного или экранного буфера) в словаре Форта.
3702 ; Если поиск увенчался успехом, кладёт на стек адрес поля имени (NFA, а не PFA) XXX
3703 ; При неудачном поиске выдаётся сообщение об ошибке.
3704 LTICK: .DB 2
3705 .TEXT "'N" ; ( −− nfa ) К
3706 .DW LTHRU
3707 TICK: .DW CALL, BL,WORD, FIND, ZEQU, ZERO,QERR, DROP, EXIT
3708
3709 ;#Tick
3710 ; ' ( −− т ) Дать токен (CFA) следующего слова.
3711 ; +++ Проверить и переделать под Форт−2012.
3712 LTICKCFA: .DB 1
3713 .TEXT "'" ; ( −− cfa )
3714 .DW LTICK
3715 TICKCFA: .DW CALL, TICK,BRAN,RN2CFA ; Настоящий ' из Форта реализован поверх каллистянского 'N
3716
3717 ;#BracketTick
3718 ; ['] ( −− | т ) Скомпилировать токен (CFA) следующего слова, как числовой литерал.
3719 ; Используется только в определении через двоеточие. Компиляция адреса (CFA) следующего слова из определения как литерала.
3720 ; +++ Проверить!
3721 LBTICK: .DB 83H
3722 .TEXT "[']" ; состояние компиляции: ( "<пр>имя" −− ) F83
3723 .DW LTICKCFA ; состояние выполнения: ( −− cfa )
3724 BTICK: .DW CALL, TICKCFA, BRAN,RLITER
3725
3726 ; Здесь было слово FORGET, которое не вместилось в Каллисто 1.0
3727 ; Оно удаляет из словаря, начиная с конца, все слова вплоть до XXX включительно.
3728 ; Правильная реализация (стр. 65, 151) проходится по наборам слов и урезает их.
3729 ; А ещё лучше сделать маркеры.
3730
3731 ;#FwdMARK
3732 ; >MARK ( −− a ) Отметить текущий адрес для ссылки вперёд.
3733 LGMARK: .DB 5
3734 .TEXT ">MARK"
3735 .DW LBTICK
3736 GMARK: .DW CALL, HERE, ZERO, BRAN,RCOMMA
3737
3738 ;#FwdRESOLVE
3739 ; >RESOLVE ( a −− ) Разрешить ссылку вперёд в адресе a.
3740 LGRESOLVE: .DB 8
3741 .TEXT ">RESOLVE"
3742 .DW LGMARK
3743 GRESOLVE: .DW CALL
3744 RGRESOLVE: .DW HERE, LITP
3745 .DB 39,17 ; 10001
3746 .DW SUB, SWAP, STORE, EXIT
3747
3748 ;#BkwMARK
3749 ; <MARK ( −− a ) Отметить текущий адрес для ссылки назад.
3750 LLMARK: .DB 5
3751 .TEXT "<MARK"
3752 .DW LGRESOLVE
3753 LMARK: .DW JHERE
3754
3755 ;#BkwRESOLVE
3756 ; <RESOLVE ( a −− ) Разрешить ссылку назад в адрес a.
3757 LLRESOLVE: .DB 8
3758 .TEXT "<RESOLVE"
3759 .DW LLMARK
3760 LRESOLVE: .DW CALL
3761 RLRESOLVE: .DW LITP
3762 .DB 39,17 ; 10001
3763 .DW SUB, BRAN,RCOMMA
3764
3765 ;#UNTIL
3766 ; UNTIL ( ф −− ) Если ф ложен (ф=0), повторить цикл BEGIN UNTIL ещё раз.
3767 LUNTIL: .DB 85H
3768 .TEXT "UNTIL" ; ( флаг −− ) F79 F84
3769 .DW LLRESOLVE ; Конец цикла "BEGIN UNTIL".
3770 UNTIL: .DW CALL, ONE,QPAIR, COMP,ZBRAND, BRAN,RLRESOLVE
3771
3772 ;#AGAIN
3773 ; AGAIN ( −− ) Перейти к началу бесконечого цикла BEGIN AGAIN.
3774 LAGAIN: .DB 85H
3775 .TEXT "AGAIN" ; F79
3776 .DW LUNTIL ; Конец бесконечного цикла "BEGIN AGAIN".
3777 AGAIN: .DW CALL, ONE,QPAIR, COMP,BRAND, BRAN,RLRESOLVE
3778
3779 ;#BEGIN
3780 ; BEGIN ( −− ) Начало циклов "BEGIN".
3781 LBEGIN: .DB 85H
3782 .TEXT "BEGIN" ; F79
3783 .DW LAGAIN
3784 BEGIN: .DW CALL, QCOMP, LMARK, ONE, EXIT
3785
3786 ;#THEN
3787 ; THEN ( −− ) Конец ветвления IF.
3788 LTHEN: .DB 84H
3789 .TEXT "THEN" ; F79 F84
3790 .DW LBEGIN
3791 THEN: .DW CALL
3792 RTHEN: .DW TWO,QPAIR, BRAN,RGRESOLVE
3793
3794 ;#ELSE
3795 ; ELSE ( −− ) Начало второй ветви ветвления IF.
3796 LELSE: .DB 84H
3797 .TEXT "ELSE" ; F79
3798 .DW LTHEN
3799 SELSE: .DW CALL, TWO,QPAIR, COMP,BRAND, GMARK, SWAP, GRESOLVE, TWO, EXIT
3800
3801 ;#IF
3802 ; IF ( ф −− ) Если ф ложен (ф=0), перейти к парному THEN (или ELSE).
3803 LIF: .DB 82H
3804 .TEXT "IF" ; ( флаг −−) F79
3805 .DW LELSE
3806 SIF: .DW CALL ; Начало ветвления "IF".
3807 RIF: .DW QCOMP, COMP,ZBRAND, GMARK, TWO, EXIT
3808
3809 ;#WHILE
3810 ; WHILE ( ф −− ) Если ф ложен (ф=0), выйти из цикла BEGIN WHILE REPEAT.
3811 LWHILE: .DB 85H
3812 .TEXT "WHILE" ; ( флаг −−) F79
3813 .DW LIF ; Ветвление "WHILE" в цикле "BEGIN WHILE REPEAT".
3814 WHILE: .DW CALL, ONE,QPAIR, ONE, BRAN,RIF
3815
3816 ;#REPEAT
3817 ; REPEAT ( −− ) Вернуться к самому началу цикла BEGIN WHILE REPEAT.
3818 LREPEAT: .DB 86H
3819 .TEXT "REPEAT" ; F79
3820 .DW LWHILE ; Конец цикла "BEGIN WHILE REPEAT".
3821 REPEAT: .DW CALL, TOR,TOR, AGAIN, FROMR,FROMR, BRAN,RTHEN
3822
3823 ;#FOR
3824 ; FOR ( n −− ) Повторить n раз цикл FOR NEXT. Если n<=0, цикл не исполнять.
3825 ; Начало цикла со счётчиком. Цикл исполнится ровно n раз, если n положительное число.
3826 ; Ситуация не определена, если n>65535.
3827 LFOR: .DB 83H
3828 .TEXT "FOR" ; ( сколько −− ) К
3829 .DW LREPEAT
3830 FOR: .DW CALL, QCOMP, COMP,XFORD, GMARK, LMARK, PI, EXIT
3831
3832 ;#NEXT
3833 ; NEXT ( −− ) Вернуться к FOR, если ещё остались повторения цикла.
3834 LSNEXT: .DB 84H
3835 .TEXT "NEXT" ; К
3836 .DW LFOR ; Конец цикла со счётчиком.
3837 SNEXT: .DW CALL, PI,QPAIR, COMP,XNEXTD, LRESOLVE, BRAN,RGRESOLVE
3838
3839 ;#SPACES
3840 ; SPACES ( b −− ) Если b>0, отобразить b пробелов шириной в цифру.
3841 ; +++ Проверить если b=0, b<0
3842 LSPACS: .DB 6
3843 .TEXT "SPACES" ; ( сколько −− ) F79
3844 .DW LSNEXT ; Вывод заданного числа "цифровых" (шириной в цифру) пробелов на индикатор.
3845 SPACS: .DW CALL, LITB
3846 .DB 31
3847 .DW SWAP, EMI, EXIT
3848
3849 ;#Unum−end
3850 ; U#> ( x −− a c ) Завершить преобразование целого числа. Дать адрес и длину для TYPE.
3851 LEDIGS: .DB 3
3852 .TEXT "U#>" ; ( x −− PAD длина ) K
3853 .DW LSPACS ; На стеке остаётся число полученных символов и адрес, как это требуется для слова TYPE
3854 EDIGS: .DW CALL
3855 REDIGS: .DW DROP, HLD,UAT, PAD,OVER,SUB, EXIT
3856
3857 ;#Fnum−end
3858 ; F#> ( −− a c ) Завершить преобразование десятичного числа. Дать адрес и длину для TYPE.
3859 ; Завершает преобразование числа с плавающей запятой
3860 ; На стеке остаётся число полученных символов и адрес, как это требуется для слова TYPE
3861 LEFDIGS: .DB 3
3862 .TEXT "F#>" ; ( −− HERE длина ) K
3863 .DW LEDIGS
3864 EDIGF: .DW CALL
3865 REFDIGS: .DW HERE, HLD,UAT, OVER, SUB, EXIT
3866
3867 ;#SIGN
3868 ; SIGN ( x −− ) Добавить к форматной строке литеру '−', если число x отрицательно.
3869 ; Вводит знак "минус" в выходной буфер PAD, если x<0
3870 ; Обычно используется непосредственно после U#S
3871 LSIGN: .DB 4
3872 .TEXT "SIGN" ; F79 F83
3873 .DW LEFDIGS
3874 SIGN: .DW CALL, ZLESS, ZBRAN,SIG, LITB
3875 .DB 45
3876 .DW HOLD
3877 SIG: .DW EXIT
3878
3879 ;#Unum
3880 ; U# ( u −− u1 ) Преобразовать в литеру последнюю цифру из u и добавить к форматной строке.
3881 ; Преобразует одну цифру целого числа и записывает её в выходной буфер PAD
3882 ; Выдаёт цифру всегда, если преобразовывать нечего, записывается '0'.
3883 LDIG: .DB 2
3884 .TEXT "U#" ; ( x1 −− x2) К
3885 .DW LSIGN
3886 DIG: .DW CALL, BASE,UAT, SLMOD, SWAP, LITB
3887 .DB 9
3888 .DW OVER, LESS, ZBRAN,DIGI, LITB
3889 .DB 39 ; 7 если заглавные буквы
3890 .DW PLUS
3891 DIGI: .DW LITB
3892 .DB 48
3893 .DW PLUS, HOLD, EXIT
3894
3895 ;#UnumS
3896 ; U#S ( u −− 0 ) Выделять цифры числа u словом U# до получения нуля.
3897 ; Преобразует целое число u до тех пор, пока не будет получен 0
3898 ; Одна цифра выдаётся в любом случае ('0')
3899 LDIGS: .DB 3
3900 .TEXT "U#S" ; ( целое −− 0) К
3901 .DW LDIG
3902 DIGS: .DW CALL
3903 DIS: .DW DIG, DUP,ZEQU, ZBRAN,DIS, EXIT
3904
3905 ;#num−start
3906 ; <# ( −− ) Начать форматное преобразование целого числа.
3907 LBDIGS: .DB 2
3908 .TEXT "<#" ; F79
3909 .DW LDIGS ; Начинает процесс преобразования целого числа в последовательность кодов символов.
3910 BDIGS: .DW CALL, PAD,HLD,STORE, EXIT
3911
3912 ;#Fnum−start
3913 ; <F# ( −− ) Начать форматное преобразование десятичного числа.
3914 LBFDIGS: .DB 3
3915 .TEXT "<F#" ; F79
3916 .DW LBDIGS ; Начинает процесс преобразования числа с плавающей запятой в последовательность кодов символов.
3917 BDIGF: .DW CALL, HERE,HLD,STORE, EXIT ; +++ Можно сократить на 2 байта с помощью BRAN
3918
3919 ;#xd
3920 ; (.) ( n −− a c ) Преобразовать целое n в строку, вернуть её адрес a и длину c.
3921 LXDOT: .DB 3
3922 .TEXT "(.)" ; ( целое −− адрес длина ) Форт ЕС
3923 .DW LBFDIGS ; Как I. −− только выводит число не на индикатор, а возвращает нам адрес и длину строки.
3924 XDOT: .DW CALL, INT, DUP,ABS, BDIGS, DIGS, SWAP,SIGN, BRAN,REDIGS
3925
3926 ;#Id
3927 ; I. ( n −− ) Вывести целое n на индикатор и дать пробел.
3928 LDOT: .DB 2
3929 .TEXT "I." ; ( целое −− ) К
3930 .DW LXDOT
3931 DOT: .DW CALL ; Удаляет целое число из стека, преобразует и отображает его на индикаторе с учётом BASE.
3932 RDOT: .DW XDOT, TYPE, BRAN,RSPACE
3933
3934 ;#d
3935 ; . ( x −− ) Вывод x на индикатор и дать пробел. Совпадает с I. если BASE≠10.
3936 LFDOT: .DB 1
3937 .TEXT "." ; ( число −− ) К
3938 .DW LDOT
3939 FDOT: .DW CALL ; Вывод десятичного числа x, за которым следует один пробел.
3940 RFDOT: .DW BASE,UAT, LITB
3941 .DB 10
3942 .DW EQUAL,ZBRAN,RDOT ; Если система счисления не десятичная, вывести целую часть числа
3943 .DW BDIGF, DIGF, EDIGF, TYPE, BRAN,RSPACE
3944
3945 ;#IdR
3946 ; I.R ( n c −− ) Вывести целое n на индикатор в поле длиной c справа.
3947 ; Печатает целое число n так, что младшая цифра занимает самое правое положение в выделенном поле, заданном числом c.
3948 ; +++ Можно доработать до выравнивания по левому краю при отрицательных c.
3949 LDOTR: .DB 3
3950 .TEXT "I.R" ; ( целое поле −− ) К
3951 .DW LFDOT
3952 DOTR: .DW CALL, TOR,XDOT,FROMR, OVER,SUB,SPACS, TYPE, EXIT
3953
3954 ; ∗∗ Вспомогательные процедуры ∗∗
3955
3956 ;#q
3957 ; ? ( a −− ) Вывести значение ячейки по адресу a.
3958 ; Удаляет число из стека и отображает на экране содержимое ячейки, адрес которой равен этому числу.
3959 ; В Каллисто может выдать число с плавающей запятой, если оно считывается из десятичного регистра.
3960 LQUEST: .DB 1
3961 .TEXT "?" ; ( адрес −− ) F79
3962 .DW LDOTR
3963 QUEST: .DW CALL, AT, BRAN,RFDOT
3964
3965 ;#LIST
3966 ; LIST ( c −− ) Вывести экран c и записать его номер в переменную SCR.
3967 ; +++ Проверить, можно ли сделать лучше под нужды МК−161.
3968 USLIST: .DB 4
3969 .TEXT "LIST" ; ( №блока −−) F79
3970 .DW LQUEST ; Распечатывает экран с номером u и записывает его номер в переменную SCR
3971 SLIST: .DW CALL, DEC, DUP,SCR,STORE, PDOTQ ; Без CR, экономим одну строчку.
3972 .DB 3
3973 .TEXT "S #"
3974 .DW DOT, ZERO, LITB
3975 .DB 48
3976 .DW XFOR,LST1
3977 LSTI: .DW CR, DUP,TWO,DOTR, SPACE, QBREAK
3978 .DW DUP, SCR,UAT, DLINE, TYPE1, ONEP, XNEXT,LSTI
3979 LST1: .DW DROP, EXIT
3980
3981 ;#INDEX
3982 ; INDEX ( c1 c2 −− ) Вывести начальную строку экранов с номерами от c1 до c2.
3983 ; Выводит на индикатор верхние строчки экранов, номера блоков которых входят в диапазон от нач до кон.
3984 ; Для экономии места на индикаторе после номера экрана пробела нет.
3985 ; +++ Проверить, можно ли сделать лучше под нужды МК−161.
3986 LINDEX: .DB 5
3987 .TEXT "INDEX" ; ( нач кон −−) F79
3988 .DW USLIST
3989 INDEX: .DW CALL, OVER,SUB,ONEP, XFOR,INDX2
3990 INDX: .DW CR, DUP, LITB
3991 .DB 3
3992 .DW DOTR, QBREAK, ZERO, OVER, DLINE, TYPE1
3993 .DW ONEP, XNEXT,INDX
3994 INDX2: .DW DROP, EXIT
3995
3996 ;#WORDS
3997 ; WORDS ( −− ) Слова. Отобразить имена всех слов контекста.
3998 LWORDS: .DB 5
3999 .TEXT "WORDS" ; ( −− )
4000 .DW LINDEX ; Просмотр полного списка операторов, хранящихся в данный момент в контексте
4001 WORDS: .DW CALL, CONT,UAT,UAT
4002 W1: .DW DUP,IDDOT, QBREAK, NLINK,UAT, DUP,ZEQU, ZBRAN,W1, DROP, EXIT
4003
4004 ;#COPY
4005 ; COPY ( c1 c2 −− ) Копировать блок c1 в блок c2.
4006 ; n m COPY копирует экран n на экран m
4007 ; Часто это команда редактора, но её удобно иметь в ядре.
4008 ; +++ Почему−то зависает в эмуляторе!
4009 LCOPY: .DB 4
4010 .TEXT "COPY" ; ( откуда куда −− ) Форт ИТЭФ
4011 .DW LWORDS
4012 COPY: .DW CALL, SWAP, BLOCK,TWOM,STORE, UPDAT, BRAN,RFLUSH
4013
4014 ;#DEPTH
4015 ; DEPTH ( −− U ) Глубина стека. U −− количество значений на стеке данных до исполнения DEPTH.
4016 LDEPTH: .DB 5
4017 .TEXT "DEPTH" ; ( −− глубина ) F79
4018 .DW LCOPY ; Кладёт на стек полное количество чисел, хранившихся на стеке до исполнения DEPTH
4019 DEPTH: .DW CALL, SZERO,UAT, SPAT,ONEP,SUB, EXIT
4020
4021 ;#DUMP
4022 ; DUMP ( a c −− ) Дамп. Вывести c байт от адреса a.
4023 ; +++ сделать роскошный дамп
4024 LDUMP: .DB 4
4025 .TEXT "DUMP" ; ( адрес длина −− ) F79
4026 .DW LDEPTH ; Отображает c байт памяти, начиная с адреса a
4027 DUMP: .DW CALL, DUP2, XFOR,DP1E
4028 DP1: .DW DUP,CAT,FDOT, ONEP, XNEXT,DP1
4029 DP1E: .DW DROP, XFOR,DP2E
4030 DP2: .DW DUP,CAT,CDOT, ONEP, XNEXT,DP2
4031 DP2E: .DW DROP, BRAN,RSPACE ; +++ Нужен ли пробел или ok уже даёт его?
4032
4033 ;#dS
4034 ; .S ( −− ) Печать стека, вершина справа.
4035 LSTY: .DB 2
4036 .TEXT ".S" ; ( −− ) F12
4037 .DW LDUMP
4038 STY: .DW CALL, DEPTH, XFOR,STY3 ; Распечатка всего содержимого стека, оставляющая стек без изменений.
4039 STY1: .DW I,ONEM,PICK, FDOT, XNEXT,STY1
4040 STY3: .DW EXIT
4041
4042 ;#kaate
4043 ; КАТ ( c −− ) Перейти в каталог Каллисто с литерой c. Если каталога нет, создать его.
4044 ; Поиск каталога Каллисто и переход в него. Если каталога нет, он создаётся.
4045 ; c −− код символа, стоящего сразу после "Каллисто" в названии каталога
4046 LKATALOG: .DB 3
4047 .TEXT "КАТ" ; ( c −− ) К
4048 .DW LSTY
4049 KAT: .DW JKAT
4050 JKAT: PKRM03 MB RM3 1 + M3 ; RB := символ
4051 9034 MA
4052 KATRY: 1 PPM 9120 ; Разрешить дисковые операции
4053 Cx
4054 ; PPM 9128 PPM 9121 ; 1. Выбор корневого каталога диска A
4055 M8 ; Начинаем с нулевой строки каталога
4056 KATNEXT1: Cx PPM 9030 PPM 9031 ; Сброс индексных регистров 0 и 1
4057 RM8 PPM 9122 ; 2. Чтение строки каталога
4058 KRMA 2 − PX=0 KATNEXT ; 4. Подкаталог?
4059 KRMA KRMA ; Пропустить поле 2 ( номер кластера, 2 байта)
4060 .NUM strForthM1
4061 M5 8 M0
4062 KATZ: RM5 1 + M5 KPRGM KRMA − PX=0 KATNEXT
4063 PFL0 KATZ
4064 KRMA RMB − FX=0 KATNEXT ; 5. Имя начинается с "Каллисто" и переданного символа?
4065 RM8 PPM9128 PPM 9123 ; 6. Перейти в каталог, всё
4066 KGOTO9 ; NEXT
4067 KATNEXT: ;−−− Перейти к следующей строке каталога
4068 RM8 1 + M8 64 − PX=0 KATNEXT1 ; Просмотрели весь каталог?
4069 PPM 9030 3 PPM 9031 ; Настройка индексных регистров 0 и 1
4070 .NUM strForthM1
4071 M5 8 M0
4072 KATW: RM5 1 + M5 KPRGM KMA FL0 KATW ; 7. Загрузить строку "Каллисто" в буфер
4073 RMB KMA
4074 11 M0 32
4075 KATQ: KMA FL0 KATQ ; Заполняем пробелами неиспользуемый конец поля имени
4076 2 PPM 9128 PPM 9125 ; 8. Создание каталога
4077 PGOTO KATRY ; Переходим в него
4078
4079 ;#SAVE−TEXT
4080 ; SAVE−TEXT ( −− ) Сохранить область текста в энергонезависимую память.
4081 LSAVETEXT: .DB 9
4082 .TEXT "SAVE−TEXT"
4083 .DW LKATALOG
4084 SAVETEXT: .DW JSAVETEXT
4085 JSAVETEXT: 5095 M5 3072 PGSB SMLM0
4086 KGOTO9
4087
4088 ;#veyerukael
4089 ; ВЫКЛ ( −− ) Сохранить сеанс работы в энергонезависимой памяти МК−161.
4090 ; Позволяет выключить на время МК−161, сохранив сеанс работы в энергонезависимой памяти
4091 ; Область текста не сохраняется, а флаг UPDATE и номер блока сбросятся при включении
4092 ; Поэтому нужно сперва делать FLUSH, а уже потом ВЫКЛ
4093 LWYKL: .DB 4,130,155,138,139 ; "ВЫКЛ"
4094 .DW LSAVETEXT
4095 WYKL: .DW JWYKL
4096 JWYKL: PGSB SVER MD ; После включения не стирать память, но экран очистить
4097 GSB SAVDEC GSB SAVBIN ; Сохранить все десятичные и двоичные регистры в энергонезависимую память
4098 8 PPM 9008 ; Тёмный экран
4099 4 PPM 9001 ; Светлым
4100 0 ENT 127 PPM 9000 ; Курсор в (0,127)
4101 2 / <−> PPM 9012 KGRPH ; Линию до (63,0)
4102 HALT: GOTO HALT ; Бесконечный цикл в ожидании выключения питания
4103
4104 ; Сохранить регистры в энергонезависимую память
4105 ; R1 = 4 для десятичных регистров (0..999), всего 1000
4106 ; = 2 для двоичных регистров (1000..5095), всего 4096
4107 SAVRGS:
4108 RM1 4 − FX=0 SAVBIN
4109 SAVDEC: 1 M5 998 ; R0, R1 не сохранять
4110 GOTO SMLM0
4111 SAVBIN: 999 M5 4096
4112 SMLM0: M0
4113 SML: 1 PPM 9047
4114 KRM5 PKM05
4115 FL0 SML
4116 RTN
4117
4118 ;#RGRW
4119 ; RGRW ( a c1 c2 −− c ) Чтение/запись (c2=1/0) десятичного/двоичного (c1=4/2) файла с именем из 20 литер по адресу a+1.
4120 ; +++ Следующие два слова можно разбить на подпрограммы и сэкономить кучу памяти
4121 ; Только делать это надо очень аккуратно, ведь все регистры запомнятся/изменятся
4122 ; В Каллисто 2.0 код надо переписать на высокий уровень такими полезными словами,
4123 ; которыми было бы удобно пользоваться и в других целях
4124 ; В существующем виде RGRW не может потребоваться прикладному программисту, поэтому его заголовок можно убрать.
4125
4126 ; Чтение/запись файла регистров (словаря) в загруженном каталоге.
4127 ; Выдаёт код ошибки дисковой операции, 0 если успех.
4128 ; a − адрес имени файла, состоящего из 20 символов, минус 1
4129 ; c1 − тип файла (c1=4 для десятичных регистров, c1=2 для двоичных регистров)
4130 ; c2 − флаг "чтение−запись" (c2=1 для чтения, c2=0 для записи)
4131 ; c − статус операции (c=0 нет ошибок, c<>0 код ошибки дисковой операции)
4132 LRERW: .DB 4
4133 .TEXT "RGRW" ; ( a t flg −− f ) К
4134 .DW LWYKL
4135 RERW: .DW JRERW
4136 JRERW: PKRM03 MA ; RA := flg ( флаг R/W)
4137 RM3 1 + M8 1 + M7 1 + M3
4138 KRM7 1 EE 4 − M7 ; R7 := a−1 ( адрес 20−символьного имени файла − 1)
4139 KRM8 M1 ; R1 := t ( тип файла)
4140 Cx M8 9034 MB ; R8 := 0 ( номер строки в каталоге) ; RB := 9034 ( чтение по индексу 1)
4141 RERWN1: Cx PPM 9030 PPM 9031 ; Сброс индексных регистров 0 и 1
4142 RM8 PPM 9122 ; 1. Считать строчка каталога.
4143 KRMB RM1 − FX=0 JZRERWNXT ; 2. Нужный нам тип файла?
4144 KRMB KRMB ; Пропустить поле 2 ( двухбайтовое)
4145 RM7 M5 20 M0 ; R5 := R7 ( адрес имени − 1) ; R0 := 20 ( длина имени)
4146 RERWZ: KRMB KRM5 −
4147 JZRERWNXT: FX=0 RERWNXT
4148 FL0 RERWZ ; 3. Совпадает имя в каталоге с нужным?
4149 RMA FX!=0 RERWR1 ; 4. R/W ?
4150 RMC ; Нужно только при чтении дестичных регистров
4151 RM8 PPM 9128 PPM 9123 ; 5. Считать найденный файл
4152 <−> MC ; Восстановление RC
4153 256 ME
4154 GOTO JRERWRET ; 6. Выход
4155 RERWR1: PGSB SAVRGS
4156 RM8 PPM 9128 PPM 9126 ; 7. Перезаписать найденный файл
4157 JRERWRET: PGOTO RERWRET ; 8. Выход
4158 RERWNXT: RM8 1 + M8 64 − PX=0 RERWN1 ; 9−10. Следующая строчка. Она 64−я?
4159 RMA FX!=0 RERWR2 ; 12. R/W ?
4160 4 ; 13−14. Выход с кодом ошибки 40 "файл не найден".
4161 JZERO: 0 KM3 KGOTO9 ; Обработчик FALSE
4162 RERWR2: PPM 9030 3 PPM 9031 ; RX==0 ( инициализация индексных регистров)
4163 RM7 M5 20 M0
4164 RERWS: KRM5 KMB PFL0 RERWS ; 11. Записать имя файла в буфер.
4165 PGSB SAVRGS
4166 RM1 PPM 9128 PPM 9125 ; 15. Создать файл.
4167 RERWRET: PPRM 9129 FX!=0 RERW0 ; 16. Выход
4168 40 + ; Преобразовать код ошибки дисковой операции в код ошибки Каллисто
4169 RERW0: KM3 KGOTO9
4170
4171 ;#LORW
4172 ; LORW ( a c −− ) Чтение/запись (c=1/0) блока из файла с именем из 4 литер по адресу a.
4173 ; Чтение/запись блока из файла в загруженном каталоге.
4174 ; Если файла нет, он создаётся.
4175 ; a − адрес имени файла, состоящего из 4 символов
4176 ; c − флаг "чтение−запись" (c=1 для чтения, c=0 для записи)
4177 LLORW: .DB 4
4178 .TEXT "LORW" ; ( a flg −− ) К
4179 .DW LRERW
4180 LORW: .DW JLORW
4181 JLORW: PKRM03 MA ; RA := flg ( флаг R/W)
4182 RM3 1 + M7 1 + M3
4183 KRM7 10001 − M7 ; R7 := a−1 ( адрес четырёхсимвольного имени файла − 1)
4184 Cx M8 9034 MB ; R8 := 0 ( номер строки в каталоге) ; RB := 9034 ( чтение по индексу 1)
4185 LORWN1: Cx PPM 9030 PPM 9031 ; Сброс индексных регистров 0 и 1
4186 RM8 PPM 9122 ; 1. Считать строчку каталога
4187 KRMB 5 − PX=0 LORWNXT ; 2. Это файл с текстом?
4188 KRMB KRMB ; Пропустить поле 2 ( двухбайтовое)
4189 RM7 M5 4 M0 ; R5 := R7 ( адрес имени − 1) ; R0 := 4 ( длина имени)
4190 LORWZ: KRMB KRM5 − PX=0 LORWNXT ; Символы равны?
4191 FL0 LORWZ ; 3. Это Bxxx ? ( сравниваем 4 символа имени)
4192 RMA PX!=0 LORWR1 ; 4. R/W ?
4193 RM8 PPM 9128 PPM 9123 ; 5. Считать найденный файл
4194 KGOTO9 ; 6. NEXT
4195 LORWR1: ;−−− Файл найден, записываем в него.
4196 RM8 PPM 9128 PPM 9126 ; 8. Перезаписать найденный файл
4197 KGOTO9 ; 9. NEXT
4198 LORWNXT: RM8 1 + M8 64 − PX=0 LORWN1 ;−−− Перейдём к следующей строчке каталога. Закончились?
4199 RMA FX!=0 LORWR2 ; 10. R/W ?
4200 5095 M5 3072 M0 32 ; R5 := 5095 ( начало текста − 1) ; R0 := 3072 ( длина текста)
4201 LORWE: KM5 FL0 LORWE ; 11. Заполнить текст пробелами −− переход на BLANK ?
4202 KGOTO9 ; 16. Всё, "считан" ещё не существующий блок. Сюрприз: он весь состоит из пробелов!
4203 LORWR2: ;−−− Файл не найден, надо создать и записать текст в него.
4204 PPM 9030 3 PPM 9031 ; Инициализация индексных регистров 0 и 1
4205 RM7 M5 4 M0 ; R5 := R7 ( адрес имени − 1) ; R0 := 4 ( длина имени)
4206 LORWS: KRM5 KMB FL0 LORWS ; Переносим имя в буфер
4207 16 M0 32 ; R0 := 16 ( кол−во пробелов) ; RX := 32 ( код пробела)
4208 LORWS1: KMB FL0 LORWS1 ; 12. Строка "Bxxx" ( 4 символа имени + 16 символов пробела)
4209 5 PPM 9128 PPM 9125 ; 13. Создать файл ( записать текст)
4210 KGOTO9 ; 14. NEXT
4211
4212 ;#lowRW
4213 ; _RW ( c1 c2 −− ) Чтение/запись (c2=1/0) блока номер c1.
4214 ; c1 − номер экрана (блока)
4215 ; c2 − флаг "чтение−запись" (c2=1 для чтения, c2=0 для записи)
4216 LRW: .DB 3
4217 .TEXT "_RW" ; ( bl# flg −− ) К
4218 .DW LLORW
4219 RW: .DW CALL
4220 RRW: .DW DUP,ZEQU, ZBRAN,RW1, SAVETEXT
4221 RW1: .DW SWAP
4222 .DW DUP,ONEM,ABS, LITB
4223 .DB 60
4224 .DW SLASH,LITB
4225 .DB 3
4226 .DW MIN,LITB
4227 .DB 49
4228 .DW PLUS,KAT ; Выбираем нужный каталог
4229 .DW BDIGS, DIG,DIG,DIG, LITB
4230 .DB 66
4231 .DW HOLD, EDIGS, DROP ; Генерируем имя файла "Bxxx"
4232 .DW SWAP, LORW ; Читаем/записываем
4233 .DW DISKOFF, EXIT ; Запретить все дисковые операции
4234
4235 ;#SAVEq
4236 ; SAVE" ( −− ) Сохранить сеанс в файлы D/B с именем, взятым из входного потока.
4237 ; Сохранить в файлы словарь Форта и десятичный словарь.
4238 LSAVEQ: .DB 5
4239 .TEXT "SAVE" ; SAVE" ( "<пр>имя−файла" −− ) К
4240 .DB 34 ; '"'
4241 .DW LRW
4242 SAVEQ: .DW CALL, FLUSH ; Сохранения с флагом UPDATE −− мина замедленного действия
4243 .DW BL,KAT, LITB
4244 .DB 34
4245 .DW WORD, COUNT, UPPER ; Перейти в каталог "Каллисто ", получить имя файла.
4246 .DW LITB
4247 .DB 13 ; 13
4248 .DW DUP,IP, SWAP ; ( 13 −− @R13,13)
4249 .DW VERSION, OVER, RSTO ; ( @R13,13 −− @R13,13)
4250 .DW HERE,LITB
4251 .DB 4
4252 .DW ZERO,RERW, DUP,QERR ; Записать десятичный файл.
4253 .DW HERE,LITB
4254 .DB 6
4255 .DW ZERO,RERW, DUP,QERR ; Записать двоичный файл.
4256 .DW RSTO, DISKOFF, EXIT ; Восстановить R13 и выйти.
4257
4258 ;#LOADq
4259 ; LOAD" ( −− ) Восстановить сеанс из файлов D/B с именем, взятым из входного потока.
4260 ; Считать из файла словарь Форта и десятичный словарь.
4261 ; +++ Проверить, работает ли защита от другой версии Каллисто.
4262 LLOADQ: .DB 5
4263 .TEXT "LOAD" ; LOAD" ( "<пр>имя−файла" −− ) К
4264 .DB 34 ; '"'
4265 .DW LSAVEQ
4266 LOADQ: .DW CALL, BL,KAT, LITB
4267 .DB 34
4268 .DW WORD, COUNT,UPPER
4269 .DW HERE, LITB
4270 .DB 4
4271 .DW ONE,RERW, DUP,QERR ; +++ Проверить безопасность QERR
4272 .DW ZERO,LITB
4273 .DB 13 ; 13
4274 .DW DUP,IP, VERSION,SUB, ZBRAN,LQOK
4275 ; .DW SPSTO, RPSTO
4276 .DW LITB
4277 .DB 39
4278 .DW MESS, KEY, COLD ; 39 Сохранение от другой версии
4279 LQOK: .DW RSTO ; Обнуляем R13
4280 .DW HERE,LITB
4281 .DB 6
4282 .DW ONE,RERW, DUP,QERR, PDOTQ ; +++ Проверить безопасность QERR
4283 .DB 4
4284 .TEXT " ok" ; Подделываем приглашение от QUIT
4285 .DB 10
4286 .DW BRAN,RWARM
4287
4288 .ENDP