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