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