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