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