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