.NLIST
.INCLUDE /DSMAC.MAC/
.INCLUDE /MYMAC.MAC/
.INCLUDE /ASCII.MAC/

.INCLUDE /181WA.MAC/
.LIST

MODULE NAME=<181ROM>, REL=<KX>, VER=<01>, LIBR=<KCGD>, COMM=<KCGD 1801PE2-181>, TYPE=<NOSECT>

  .SBTTL Import

;  FROM SYSLIB.DEF    IMPORT PR7
  PR0 =: ^O<0*40>
  PR7 =: ^O<7*40>

;  FROM KCGDWA IMPORT $ROMBS, $YPTR, $YPTRE, $YPTRL, $TAB, $TABE, $TABL, $QMOD, RAMR1, RAMR1E, RAMR1L, $KSCN1
;  FROM KCGDWA IMPORT $KSCN2, $VAR1, $KSCAN, $SPALL, $TVST, $TVCH, $PCH3, $PCRLF, $PCH2, $PCH1, $PCH4, $ONOFF
;  FROM KCGDWA IMPORT $QCRLF, $V1PP, $QCURS, $MASK, LINATR, $QDBLW, QVT52, CURATR, GLP, GRP, G0P, G1P, G2P
;  FROM KCGDWA IMPORT G3P, XCOOR, YCOOR, REVERS, UNDLN, OCHP, FCOLOR, BCOLOR, QSCRND, ATRLEN, $VAR1E, $VAR1L
;  FROM KCGDWA IMPORT GRAM1, SAVATR, GRAM1E, GRAM1L, $$G0, $$G1, $$G3, $$G2, PRVEC, $CH8BT, $SC200, $SC377
;  FROM KCGDWA IMPORT $ECSIS, $CSIL, $CSIM, $CSIX, $CSII, $CSISY, $CSIAT, $CSIP, PRVECE, PRVECL, V.DCS, SYMSWT
;  FROM KCGDWA IMPORT $SCRSV, SCRS, SCRE, $SCAN, $QDRAW, $QCTRL, $QFXD, $QURG, $QRUS, $QSURG, $QKPAD, $QCD1
;  FROM KCGDWA IMPORT $QCD2, RAMR0, RAMR0E, RAMR0L, $ARGS, $ARG1, $ARG2, $ARG3, $ARG4, $ARG5, $ARG6, $ARG7
;  FROM KCGDWA IMPORT $ARG8, $ARG9, $ARG10, $ARG11, $ARG12, $ARG13, $ARG14, $ARG15, $ARG16, $ARG17, $ARG18
;  FROM KCGDWA IMPORT $ARG19, $ARG20, $ARG21, GRAM0, GRAM0E, GRAM0L, ZG1MAP, ZG2MAP, ANSW, $$TEMP, $VCLK
;  FROM KCGDWA IMPORT IIDRA, IIDRD, CPIVEC, CPOVEC, CPICSR, CPIBUF, CPOCSR, CPOBUF
;  FROM KCGDWA IMPORT KBIVEC, KBICSR, KBIBUF, KBOCSR, KBOBUF

;  FROM KCGD99 IMPORT $SYMBM, $BLCHR, $CD013, $CD1A, $CD2, $CD3A

  .SBTTL Export

  EXPORT QUALIFIED ROM0B
  EXPORT QUALIFIED $START
  EXPORT QUALIFIED $V4
  EXPORT QUALIFIED $BITS
  EXPORT QUALIFIED $SHCUR
  EXPORT QUALIFIED $HALT
  EXPORT QUALIFIED $2HALT
  EXPORT QUALIFIED DBLBTS	; Сдвоить биты в младшем байте R5
  EXPORT QUALIFIED $IVERR
  EXPORT QUALIFIED RCASE	; Оператор-case
  EXPORT QUALIFIED V1.100
  EXPORT QUALIFIED V2.100
  EXPORT QUALIFIED SRPALL

  EXPORT QUALIFIED V100E1
  EXPORT QUALIFIED V100E2
  EXPORT QUALIFIED V100E3
  EXPORT QUALIFIED $LOAD	; Загрузить программу-приложение
  EXPORT QUALIFIED $LOAD2
  EXPORT QUALIFIED UPR		; Вверх на одну строка, в первой - обратный скроллинг
  EXPORT QUALIFIED UP		; Вверх
  EXPORT QUALIFIED $LF		; Процедура "Перевод строки"
  EXPORT QUALIFIED $VT		; Процедура "Вертикальная табуляция"
  EXPORT QUALIFIED $FF		; Процедура "Перевод формата"
  EXPORT QUALIFIED BOL		; Перейти в начало следующей строки
  EXPORT QUALIFIED DOWNR	; Вниз на одну строку, в последней - скроллинг
  EXPORT QUALIFIED DOWN 	; Вниз
  EXPORT QUALIFIED $USCRL	; Скроллинг вверх
  EXPORT QUALIFIED $DSCRL	; Скроллинг вниз
  EXPORT QUALIFIED ESCC2	; Отмена ESC-последовательности (второй вид)
  EXPORT QUALIFIED CHDRW	; Нарисовать символ в тек. позиции и переместить курсор
  EXPORT QUALIFIED $VRAM	; Вычисление адреса ВОЗУ для текущих координат
  EXPORT QUALIFIED $HT		; Процедура горизонтальной табуляции
  EXPORT QUALIFIED $GETCH	; Получить следующий символ - от ЭВМ или с клавиатуры
  EXPORT QUALIFIED ESCC 	; Отмена Esc-последовательности (первый вид)
  EXPORT QUALIFIED $ESC 	; Корневая процедура ESC-последовательностей
  EXPORT QUALIFIED $RESET	; Инициализация дисплея
  EXPORT QUALIFIED $EDCS
  EXPORT QUALIFIED $DCSR
  EXPORT QUALIFIED $DCS 	; Корневая процедура dcs-последовательностей
  EXPORT QUALIFIED STLATR	; Установка аттрибутов текущей строки
  EXPORT QUALIFIED $CSI 	; Корневая процедура csi-последовательностей
  EXPORT QUALIFIED STNMG0
  EXPORT QUALIFIED STNMG1
  EXPORT QUALIFIED STNMG2
  EXPORT QUALIFIED STNMG3
  EXPORT QUALIFIED $CRLF
  EXPORT QUALIFIED SW2H2L
  EXPORT QUALIFIED SW2H2H
  EXPORT QUALIFIED SW2H1
  EXPORT QUALIFIED SW1H1
  EXPORT QUALIFIED SVT100	; Установить режим VT100
  EXPORT QUALIFIED $SVATR
  EXPORT QUALIFIED $RSATR
  EXPORT QUALIFIED CPWRDS	; Копирование из (R1)+ в (R0)+ R2 слов
  EXPORT QUALIFIED ZGUNPK	; Распаковка знакогенератора
  EXPORT QUALIFIED KPAD0	; Установить режим цифровой клавиатуры
  EXPORT QUALIFIED KPAD2	; Установить режим дополнительной клавиатуры
  EXPORT QUALIFIED STAB 	; Установить остановку табуляции в тек. позиции
  EXPORT QUALIFIED INITAB	; Инициализация позиций горизонтальной табуляции
  EXPORT QUALIFIED $BS		; Процедура бацкспаце и влево
  EXPORT QUALIFIED RIGHT	; Вправо
  EXPORT QUALIFIED SYX		; Установить позицию курсора - VT52
  EXPORT QUALIFIED HOME
  EXPORT QUALIFIED $CR		; Процедура возврата каретки
  EXPORT QUALIFIED EEOS 	; Стереть до конца экрана, Стереть в экране
  EXPORT QUALIFIED EEOL 	; Стереть до конца строки, Стереть в строке
  EXPORT QUALIFIED SGRG1	; Установка GR в ug1
  EXPORT QUALIFIED SGRG2	; Установка GR в g2
  EXPORT QUALIFIED SGRG3	; Установка GR в g3
  EXPORT QUALIFIED S1GLG2	; Установка G2 на один символ
  EXPORT QUALIFIED S1GLG3	; Установка G3 на один символ
  EXPORT QUALIFIED $EZA
  EXPORT QUALIFIED $ESCZ	; Послать ответ на запросе типа терминала
  EXPORT QUALIFIED $OUTCH	; Послать символ в центральную машину или на экран
  EXPORT QUALIFIED $ESCZ2	; Запрос типа дисплея
  EXPORT QUALIFIED IANSW
  EXPORT QUALIFIED IANSWL
  EXPORT QUALIFIED $MCH 	; Клавиши, генерирующие мултипоследовательности
  EXPORT QUALIFIED $MOVE	; Клавиши управления курсором
  EXPORT QUALIFIED $KPAD	; Обработка клавиш с внутренним кодом 215..300
  EXPORT QUALIFIED $KPF 	; Обработка клавиш с внутренним кодом 301..350
  EXPORT QUALIFIED MCHOUT
  EXPORT QUALIFIED $SK1 	; Обработка клавиш с внутренним кодом 201..206
  EXPORT QUALIFIED $SK2
  EXPORT QUALIFIED V.60 	; Процедура обработки прерывания по вектору 60
  EXPORT QUALIFIED EV.60
  EXPORT QUALIFIED $KRPT
  EXPORT QUALIFIED $SRGM
  EXPORT QUALIFIED $URG
  EXPORT QUALIFIED $CTRL
  EXPORT QUALIFIED $CHABC
  EXPORT QUALIFIED $STST
  EXPORT QUALIFIED $KUP
  EXPORT QUALIFIED $SC372
  EXPORT QUALIFIED $FXD
  EXPORT QUALIFIED $BELL	; Процедура звонка
  EXPORT QUALIFIED $KBOUT	; Вывод в буфер клавиатуры
  EXPORT QUALIFIED SGLG0	; Установка GL в G0
  EXPORT QUALIFIED SGLG1	; Установка GL в G1
  EXPORT QUALIFIED SGLG2	; Установка GL в G2
  EXPORT QUALIFIED SGLG3	; Установка GL в G3
  EXPORT QUALIFIED $IVR1
  EXPORT QUALIFIED $IVR1E
  EXPORT QUALIFIED START

  .SBTTL Implementation

  .ASECT
  .=0

  ROM0B:

  $START:
    .WORD $ROMBS+START, PR7

  $V4:
    .WORD $ROMBS+START, PR7

  $V10:
    .WORD $ROMBS+START, PR7

  $BITS:
    .BYTE   200, 100, 40, 20, 10, 4, 2, 1


  PROCEDURE $SHCUR			; C2
  BEGIN
    COMB L11023
    IF RESULT IS NE THEN
      MOVB $SPALL+5, L11024
    ELSE
      MOVB $SPALL+10., L11024
    END
    ADD  $QCURS, PC		; пропуск RETURN, если курсор есть
    RETURN

    ADD  L04450, IIDRA
    MOV  CURATR+XCOOR, R4
    ASL  R4
    IF $QDBLW EQ #0 THEN
      ASL  R4
      CALL (PC) 		; !!!!!!
    END
    PUSH IIDRA
    BIC  #^C<7>, R4
    ADD  L07474+00-$ROMBS(R4), @SP
    MOV  L07474+10-$ROMBS(R4), R1
    MOV  L07474+20-$ROMBS(R4), R2

    THRU R3 := L04446
      XOR  R1, IIDRD
      INC  IIDRA
      XOR  R2, IIDRD
      ADD  #100.-1, IIDRA
    END

    POP  IIDRA
    TST  (R4)+
    RETURN
  END $SHCUR

  $HALT:			; 170
    .WORD $ROMBS+START, PR7

  $2HALT:			; 174
    .WORD $ROMBS+START, PR7

  PROCEDURE P00200			; C4
  BEGIN
    CALL P00226
    GOTO P00226
  END P00200

  PROCEDURE P00206			; C2
  BEGIN

    ASH #2,R4
    ASH #2,R3

    IF RESULT IS CC GOTO 10$

    BIS  #60,R4
    GOTO 10$

  ENTRY P00226				; C8

    ASH #2,R4

  ENTRY 10$				; C3

    ASH #2,R3

    IF RESULT IS CS
      BIS #60,R4
    END

    RETURN
  END P00206

  ;
  ; Сдвоить биты в младшем байте R5.
  ; Результат - В R4
  ;
  PROCEDURE DBLBTS			; C3
  BEGIN
    MOV  #8.,R3 	; 8 бит
    CLR  R4		; начальное
    THRU R3
      ASH  #2,R4	; сдвиг на 2 бита
      ASLB R5		; очередной бит установлен ?
      IF RESULT IS CS	; переход, если нет
	BIS  #3,R4	; иначе установить в результате
      END
    END 		; цикл
    RETURN
  END DBLBTS

  $IVERR:
    .WORD   $ROMBS+START, PR7	; 274

  ;
  ; Оператор CASE
  ;
  PROCEDURE RCASE			; C15
  BEGIN
    PUSH #0
    REPEAT
      MOV  (R4)+,@SP
      BEQ  10$
    UNTIL (R4)+ EQ R0

    POP  R4
    RTS  R4

  10$:

    POP
    RTS  R4
  END RCASE

  PROCEDURE V1.100			; C1
  BEGIN
    PUSH <R0, R1, R2, R3, R4>
    DEC  $SCRSV

    IF RESULT IS EQ THEN
      DECB $SCRSV+2
      IF RESULT IS EQ THEN
	MOV  #$ROMBS+V2.100,@#$VCLK
	COMB $SCRSV+2
	MOV  #$ROMBS+$BLCHR,R0
	CMP  (SP)+,(SP)+
	BR   SRPALL
      END
      MOV  #77777,$SCRSV
    END

    TSTB L11025
    BNE  P00536

    TSTB L11022
    BEQ  V100E1

    DECB L11021
    BNE  V100E1

    PUSH IIDRA
      CALL $SHCUR
      MOVB #30.,L11021
    POP  IIDRA
    MOVB L11024,$SPALL+15.
    MOV  #$ROMBS+$SPALL,R0
    POP  <R4, R3>
    GOTO SRPALL
  END V1.100

  PROCEDURE V2.100			; C1(+один из инициализации)
  BEGIN
    TSTB $SCRSV+2
    BMI  V100E3
    PUSH R0
      MOV  #$ROMBS+$SPALL,R0
      MOV  #$ROMBS+V1.100,@#$VCLK
    PUSH <R1, R2>
    $GOTO SRPALL
  END V2.100

  PROCEDURE SRPALL			; C3
  BEGIN
    MOV  #16.,R1
    CLR  R2
    THRU R1
      MOVB  R2,    $ROMBS+167772
      MOVB  (R0)+, $ROMBS+167773
      CMP   (R2)+, (R2)+		; R2:=R2+4
    END
    GOTO V100E2
  END SRPALL

  ;; ?????
  PROCEDURE P00536			; C1
  BEGIN
    MOV  L11026,R2
    SUB  L11030,R2
    ASH  #-2,R2
    MOV  L04474,R3
    SUB  R3,R2
    INC  R3
    MOV  R3,R1
    ASH  #2,R1
    MOV  L11010,R4

    IFB L11025 PL #0 THEN

      MOV  L11026,R0
      TST  (R0)+
      NEG  R1
      ADD  R0,R1

      THRU R2
	MOV  -(R1),-(R0)
	MOV  -(R1),-(R0)
      END
      THRU R3
	MOV  R4,-(R0)
	MOV  R4,-(R0)
	DECB L11025
	ADD  #100.,R4
      END

    ELSE

      MOV  L11030,R0
      TST  -(R0)
      ADD  R0,R1

      THRU R2
	MOV  (R1)+,(R0)+
	MOV  (R1)+,(R0)+
      END
      THRU R3
	MOV  R4,(R0)+
	MOV  R4,(R0)+
	INCB L11025
        SUB  #100.,R4
      END

    END

    MOV     R4,L11010
    $GOTO V100E1
  END P00536

  PROCEDURE V100EX
  BEGIN

  ENTRY V100E1				; C3

    POP   <R4, R3>

  ENTRY V100E2				; C2

    POP   <R2, R1, R0>

  ENTRY V100E3				; C2

    RTI

  END V100EX

  ;
  ; Загрузить программу-приложение
  ;   ESC X - VT52
  ;
  PROCEDURE $LOAD			; C1(from rcase)
  BEGIN
    MTPS  #PR7
    MOV   #^C<377>,$MASK
    CALL  $GETCH
    PUSH  #$ROMBS+$LOAD2
    CALL  (PC)
    MOV   R1,R2
    CALL  $GETCH
    MOV   R0,R1
    CALL  $GETCH
    SWAB  R0
    BIS   R0,R1
    RETURN
  END $LOAD

  PROCEDURE $LOAD2			; C1
  BEGIN
    MOV     R1,R3
    THRU R2
      CALL  $GETCH
      MOVB  R0,(R1)+
    END
    JMP  @R3
  END $LOAD2

  PROCEDURE UPS
  BEGIN

  ;
  ; Вверх на одну строка, в первой - обратный скроллинг
  ;   ESC I - VT52
  ;   ESC M - VT100
  ;
  ENTRY UPR				; C2(from rcase)

    IF CURATR+YCOOR NE SCRS GOTO UP1
    GOTO $USCRL

  ;
  ; Вверх
  ;   ESC A        - VT52  - на одну строку
  ;   ESC [ <nn> A - VT100 - на nn строк
  ;
  ENTRY UP				; C2(from rcase)

    IF CURATR+YCOOR EQ SCRS GOTO DOWN2

  ENTRY UP1				; C2(UPR, UP)

    NEG  R3
    GOTO DOWN1
  END UPS

  ;
  ; Процедура "Перевод строки"
  ;   lf
  ;
  ; Процедура "Вертикальная табуляция"
  ;   vt
  ;
  ; Процедура "Перевод формата"
  ;   ff
  ;
  PROCEDURE LFVTFF
  ENTRY     $LF				; C1(from rcase)
  ENTRY     $VT				; C1(from rcase)
  ENTRY     $FF				; C1(from rcase)
  BEGIN
    ADD $QCRLF, PC
  END LFVTFF

  ;
  ; Перейти в начало следующей строки
  ;   ESC E - VT100
  ;
  PROCEDURE BOL				; C2
  BEGIN
    CLR CURATR+XCOOR
    $GOTO DOWNR
  END BOL

  PROCEDURE DOWNS
  BEGIN

  ;
  ; Вниз на одну строку, в последней - скроллинг
  ;   ESC D - VT100
  ;
  ENTRY DOWNR				; C2

    IF CURATR+YCOOR NE SCRE GOTO DOWN1
    GOTO $DSCRL

  ;
  ; Вниз
  ;   ESC B        - VT52 - на одну строку
  ;   ESC [ <nn> B - VT100 - на nn строк
  ;
  ENTRY DOWN				; C2

    IF CURATR+YCOOR EQ SCRE GOTO DOWN2

  ENTRY DOWN1				; C2

    ADD R3,CURATR+YCOOR

  ENTRY DOWN2				; C2

    RETURN
  END DOWNS

  PROCEDURE $SCRL
  BEGIN

  ;
  ; Скроллинг вверх
  ;
  ENTRY     $USCRL			; C1

    NEG R3

  ;
  ; Скроллинг вниз
  ;
  ENTRY     $DSCRL			; C1

    MOV  SCRE,R4
    MOV  SCRS,R5
    MOV  R4,R2
    SUB  R5,R2
    ASHC #2,R4
    MOV  #$YPTR-$ROMBS,R0
    MOV  R0,R1
    MUL  #10.,R3

    IF RESULT IS MI
      MOV R4,R5
    END

    ADD R5,R1
    ADD R5,R0
    MOV (R1)+,R4
    TST (R1)+
    MOV #11012,R5

    IFB R3 PL #0 THEN

      THRU R2
	MOV (R1)+,(R0)+
	MOV (R1)+,(R0)+
      END

      MOV @R5,(R0)+
      MOV LINATR,@R0

    ELSE

      THRU R2
	MOV -(R0),-(R1)
	MOV -(R0),-(R1)
      END

      MOV LINATR,-(R1)
      MOV @R5,-(R1)
      ADD #1604,@R5

    END

    REPEAT
    UNTILB L11025 EQ #0

    MOV  (R5)+,L11010
    MOVB R3,L11025
    MOV  @R5,-(R5)
    MOV  (R5)+,R0
    MOV  R4,@R5

    $GOTO P01230
  END $SCRL

  PROCEDURE P01230			; C2
  BEGIN
    PUSH IIDRA
      MOV  #1750,R1
      MOV  R0,IIDRA
      THRU R1
	CLR	IIDRD
	INC	IIDRA
      END
    POP  IIDRA
    RETURN
  END P01230

  ;
  ; Отмена ESC-последовательности (второй вид)
  ;   sub
  ;
  PROCEDURE ESCC2			; C1(from rcase)
  BEGIN
    MOV  #$ROMBS+ESCC,@SP
    MOV  #26274,R4
    GOTO CHDRW2
  END ESCC2

  ;
  ; R0 - символ
  ; R1 -
  ; R2 -
  ; R3 - указатель алфавита
  ; R4 -
  ; R5 -
  ;

  PROCEDURE CHDRAW
  BEGIN

  ENTRY CHDRW				; C1

    ADD  CURATR+ATTR1,PC  ; 4536
      CALL W10724

    ADD  L04434,PC        ; 4434
      CALL W10730

    SUB  #40,R0
    ADD  CURATR+OCHP,R0

    IF CURATR+OCHP EQ #0 THEN LET R0 := R0 + R3

    CLR  CURATR+OCHP
    MOVB @R0,R1
    BIC  #^C<377>,R1
    MUL  #20.,R1	  ; *10. СТРОК РАСТРА *2
    MOV  R1,R4

    IF R3 EQ L04470 THEN
      ADD  #ZG2MAP,R4
    ELSE
      ADD  #ZG1MAP,R4
    END

  ENTRY CHDRW2				; C1

    IF $QDBLW EQ #0 THEN
      MOV  #1000,R1
      MOV  #10.,R2
      MOV  R4,R0
      THRU R2
	MOV  (R0)+,R5
	CALL DBLBTS
	MOV  R4,24(R1)
	SWAB R5
	CALL DBLBTS
	MOV  R4,(R1)+
      END
      MOV  #1000,R4
    END
    MOV  CURATR+XCOOR,R5
    INC  CURATR+XCOOR
    ADD  $QDBLW,PC
    ASL  R5
    ASL  R5
    BIC  #^C<7>,R5
    MOV  IIDRA,L13500
    ADD  L07474+00-$ROMBS(R5),L13500
    MOV  L07474+10-$ROMBS(R5),R2
    MOV  L07474+20-$ROMBS(R5),R3
    MOV  L07474+30-$ROMBS(R5),L13476
    IF $QDBLW EQ #0 THEN
      BIS  #17,R2
      ASH  #-4,R3

      IF RESULT IS EQ THEN LET L13500 := L13500 + #1

      BIC  #4, L13476
      CALL (PC) 		  ; !!!!!!!
    END

    THRU R5 := #10.
      CLR  R0
      MOV  (R4)+,R1
      ADD  CURATR+UNDLN,PC

	  IF R5 EQ #2 THEN LET R1 := #-1

      ADD  CURATR+REVERS,PC
	  COM  R1

      IF R1 MI #0 THEN LET R0 := NOT R0

      ASHC L13476,R0

      BIC  R2,IIDRD
      COM  R2
      BIC  R2,R0
      BIC  CURATR+FCOLOR,R0
      COM  R2
      BIS  R0,IIDRD

      INC  IIDRA

      BIC  R3,IIDRD
      COM  R3
      BIC  R3,R1
      BIC  CURATR+FCOLOR,R1
      COM  R3
      BIS  R1,IIDRD

      ADD  #100.-1 ,IIDRA
    END

    MOV  L13500,IIDRA

    IF $QDBLW EQ #0 THEN
      INC  L13500

      IF L07534 EQ #0 THEN
        CLRB R2
        SWAB R2

        BNE  10$

        INC  L13500

        GOTO 10$
      END	

      IF R3 EQ #0 THEN
        DEC  L13500
        CLRB R2
      END
      CLR  R3
    END

  10$:

    RETURN
  END CHDRAW

  ;
  ; Вычисление адреса WOZU для текущих координат
  ;
  PROCEDURE $VRAM			; C7
  BEGIN
    MOV  CURATR+YCOOR,R3	; Y-координата
    CLR  R5			; первая строка скроллинга
    MOV  #23.,R2		; последняя строка скроллинга
    IF CURATR+QSCRND EQ #0 THEN ; зона скроллинга определена ?
      MOV  SCRS,R5		; первая строка скроллинга
      MOV  SCRE,R2		; последняя строка скроллинга
    END 			;

    IF R3 LT R5 THEN LET R3 := R5	; ниже последней строки скроллинга ? да - взять последнюю

    IF R3 GT R2 THEN LET R3 := R2	; выше первой строки скроллинга ? да - взять первую

    MOV  R3,CURATR+YCOOR	; установить правильную
    ASH  #2,R3			; Y*4
    ADD  #$YPTR-$ROMBS,R3	; $YPTR+Y*4
    MOV  (R3)+,R5		; адрес GOZU

    BIT  #2,@R3
    BEQ  10$
    ADD  $QDBLW,PC
    GOTO 20$

    ASR  L07536
    CLR  $QDBLW
    ASL  L07540
    GOTO 20$

10$:

    TST  $QDBLW
    BNE  20$
    ASL  L07536
    INC  L07536
    ASR  L07540
    MOV  #2,$QDBLW

20$:

    MOV  L07536,R1
    MOV  CURATR+XCOOR,R0

    IF RESULT IS MI THEN LET R0 := #0

    IF R0 GT R1 THEN LET R0 := R1

    MOV     R0,CURATR+XCOOR
    MUL     L07540,R0
    DIV     #10,R0
    ADD     R0,R5
    MOV     R5,IIDRA
    RETURN
  END $VRAM

  ;
  ; Процедура горизонтальной табуляции
  ;   ht
  ;
  PROCEDURE $HT				; C1(from rcase)
  BEGIN
    CALL    P02254
    ADD     #$TAB-$ROMBS,R0
    MOVB    $ROMBS+$BITS(R1),R1
    BIC     #^C<377>,R1
    REPEAT

      IF CURATR+XCOOR GE L07536 LEAVE LOOP

      INC  CURATR+XCOOR
      ASR  R1
      IF RESULT IS CS THEN
	BIS  #200,R1
	INC  R0
      END

    UNTILB R1 SET.IN @R0
    RETURN
  END $HT

  PROCEDURE P02254			; C3
  BEGIN
    MOV CURATR+XCOOR,R1
    CLR R0
    DIV #8.,R0
    RETURN
  END P02254

  ;
  ; Получить следующий символ - от ЭВМ или с клавиатуры
  ;
  PROCEDURE $GETCH			; C5
  BEGIN

    REPEAT
      REPEAT
        ADD $ONOFF,PC	; если режим off line, - BR off line

        $TEMP$=.

      ; ON LINE
      UNTILB @#CPICSR MI #0

      MOV  #77777,$SCRSV
      MOVB #3,$SCRSV+2
      MOV  @#CPIBUF,R0
      GOTO 20$

      $ONOFL =: .-$TEMP$

    ; OFF LINE
    UNTILB L35625 NE #0

    MOVB L35625,R0
    CLRB L35625

  20$:

    BIC $MASK,R0
    RETURN
  END $GETCH

  ;
  ; Отмена esc-последовательности (первый вид)
  ;   can
  ;
  PROCEDURE ESCC			; C4
  BEGIN
    MOV L11006,SP
    CLR SYMSWT
    $GOTO P02360
  END ESCC

  PROCEDURE P02360			; C2
  BEGIN
    CLR  L00274
    CLR  $ARG1
    CLR  $ARG2
    MOVB #1,L00265
    CLR  L00266
    CLR  L00270
    $GOTO P02412
  END P02360

  PROCEDURE P02412			; C10
  BEGIN
    IF CURATR+XCOOR GT L07536 THEN

      ADD CURATR+ATTR2,PC

        MOV  #1,R3
        CALL BOL
        GOTO 10$

        MOV L07536,CURATR+XCOOR

      10$:

      CALL $VRAM
    END

    MTPS #PR7
    INCB L11022
    MOVB #2,L11021
    MTPS #PR0
    PUSH #$ROMBS+P02412
    CALL $GETCH
    MTPS #PR7
    CLRB L11022
    MTPS #PR0

    IFB L11023 NE #0 THEN
      PUSH IIDRA
        CALL $SHCUR
      POP IIDRA
    END

    IF R0 MI #0 THEN JUMPTO $CH8BT	; символ в диапазоне 0200C..0377C ? переход, если да

    IF R0 GE #40 THEN	; в диапазоне 040С..0177C ?

      MOV CURATR+GLP,R3

      IF SYMSWT EQ #0 THEN JUMPTO CHDRW

      POP
      RETURN

    END

    MOV  #1,R3		; текущий счетчик повтора
    CALL L10660		; предобработка

    JSR R4, RCASE

    .WORD $ROMBS+$BELL, bel	; bell
    .WORD $ROMBS+SGLG1, so	; GL:=G1
    .WORD $ROMBS+SGLG0, si	; GL:=G0
    .WORD $ROMBS+ESCC2, sub	; отмена ESC-последовательности, первый вид
    .WORD $ROMBS+ESCC,  can	; отмена ESC-последовательности, второй вид
    .WORD $ROMBS+$ESC,  esc	; начало ESC-последовательности
    .WORD 0

    IF #dcs NE SYMSWT THEN

      PUSH #$ROMBS+$VRAM		; ПОСЛЕ ОТРАБОТКИ П/П ВЫЗВАТЬ ВЫЧИСЛИТЕЛЬ ТЕК. АДРЕСА WOZU
      JSR  R4, RCASE

      .WORD $ROMBS+$CR, cr 	; carriage return
      .WORD $ROMBS+$BS, bs 	; backspace
      .WORD $ROMBS+$HT, ht 	; horizontal tab
      .WORD $ROMBS+$LF, lf 	; line feed
      .WORD $ROMBS+$VT, vt 	; vertical tab
      .WORD $ROMBS+$FF, ff 	; form feed
      .WORD 0

    END

    $GOTO STUBP1
  END P02412

  PROCEDURE STUBP1			; C2(from rcase)
  BEGIN
    RETURN
  END STUBP1

  ;
  ; Корневая процедура ESC-последовательностей
  ;   ESC
  ;
  PROCEDURE $ESC			; C1(from rcase)
  BEGIN
    MOV  #$ROMBS+ESCC,@SP
    MOV  R0,SYMSWT
    CALL P02360

    IFB QVT52 EQ #0 GOTO ESC100	; Если 0 - режим VT100, переход на обработку VT100
    				; Иначе - режим VT52

  ;
  ; VT52
  ;

    MOV  #1,R3
    CALL L10700		; предобработка
    PUSH #$ROMBS+$VRAM	; после отработки п/п вызвать вычислитель тек. адреса WOZU

    JSR	R4, RCASE
    .WORD $ROMBS+KPAD2,   '=	; режим доп. клавиатуры
    .WORD $ROMBS+KPAD0,   '>	; режим цифр. клавиатуры
    .WORD $ROMBS+SGLG3,   'F	; GL:=G3 - псевдографика
    .WORD $ROMBS+SGLG0,   'G	; GL:=G0
    .WORD $ROMBS+$ESCZ,   'Z	; послать ответ ESC \ Z
    .WORD $ROMBS+SVT100,  '<	; в режим VT100
    .WORD $ROMBS+SYX,     'Y	; установка курсора
    .WORD $ROMBS+EEOL,    'K	; стереть до конца строки
    .WORD $ROMBS+EEOS,    'J	; стереть до конца экрана
    .WORD $ROMBS+UPR,     'I	; вверх с рулоном
    .WORD $ROMBS+UP,      'A	; вверх без рулона
    .WORD $ROMBS+DOWN,    'B	; вниз без рулона
    .WORD $ROMBS+RIGHT,   'C	; вправо
    .WORD $ROMBS+LEFT,    'D	; влево
    .WORD $ROMBS+HOME,    'H	; в позицию 1,1
    .WORD $ROMBS+$LOAD,   'X	; загрузка доп. ПО
    .WORD $ROMBS+$RESET,  'V	; реинициализация
    .WORD 0

    RETURN

  ;
  ; Инициализация дисплея
  ;   ESC V - VT52
  ;
  ENTRY $RESET			; C1(from rcase)

    JMP @$START

  ;
  ; VT100
  ;
  ENTRY ESC100			; C1

    IF R0 LT #60 THEN
      MOV R0,L00266

      REPEAT
        CALL P02412
      UNTIL R0 GE #60

    END

    IF L00266 NE #0 GOTO P03322

    MOV	#1,R3

    JSR	R4, RCASE

    .WORD $ROMBS+KPAD2,  '=	; режим доп. клавиатуры
    .WORD $ROMBS+KPAD0,  '>	; режим цифр. клавиатуры
    .WORD $ROMBS+$CSI,   '[	; CSI последовательность
    .WORD $ROMBS+$DCS,   'P	; DCS последовательность
    .WORD $ROMBS+SGRG1,  '~	; GR:=G1
    .WORD $ROMBS+SGLG2,  'n	; GL:=G2
    .WORD $ROMBS+SGRG2,  '}	; GR:=G2
    .WORD $ROMBS+SGLG3,  'o	; GL:=G3
    .WORD $ROMBS+SGRG3,  '|	; GR:=G3
    .WORD $ROMBS+S1GLG2, 'N	; GL:=G2 на один символ
    .WORD $ROMBS+S1GLG3, 'O	; GL:=G3 на один символ
    .WORD $ROMBS+STAB,   'H	; установить таб. в тек. позиции
    .WORD $ROMBS+$EDCS,  '\	; конец DCS последовательности
    .WORD $ROMBS+$SVATR, '7	; сохранить состояние
    .WORD $ROMBS+$ESCZ2, 'Z	; запрос типа
    .WORD $ROMBS+START,  'c	; реинициализация
    .WORD 0

    PUSH #$ROMBS+$VRAM		; после отработки п/п вызвать вычислитель тек. адреса WOZU

    JSR	R4, RCASE

    .WORD $ROMBS+BOL,    'E	; новая строка
    .WORD $ROMBS+DOWNR,  'D	; вниз с руллоном
    .WORD $ROMBS+UPR,    'M	; вверх с руллоном
    .WORD $ROMBS+$RSATR, '8	; восстановить состояние
    .WORD 0

  ;
  ; конец DCS последовательности
  ;
  ENTRY $EDCS				; C1

    RETURN

  END $ESC

  PROCEDURE $DCSR			; C1
  BEGIN
    CALL P02412
    GOTO $DCSR
  END $DCSR

  ;
  ; Корневая процедура dcs-последовательностей
  ;   ESC+P
  ;
  PROCEDURE $DCS			; C1(from rcase)
  BEGIN
    MOV #dcs,SYMSWT
    JMP @V.DCS				; -> $DCSR
  END $DCS

  PROCEDURE P03322			; C1
  BEGIN

    MOV R0,L00270
    MOV L00266,R0

    JSR R4, RCASE

    .WORD $ROMBS+STLATR, '#	; установка аттрибутов строки
    .WORD $ROMBS+$ECSIS, 40	; F - передача 7-бит. упр. посл.
    				; G -	- // - 8   -  // -
    .WORD $ROMBS+STNMG0, '(	; установ имени G0
    .WORD $ROMBS+STNMG1, ')	; установ имени G1
    .WORD $ROMBS+STNMG2, '*	; установ имени G2
    .WORD $ROMBS+STNMG3, '+	; установ имени G3
    .WORD 0

    RETURN
  END P03322

  ;
  ; Установка аттрибутов текущей строки
  ;
  PROCEDURE STLATR		; C1(from rcase)
  BEGIN
    PUSH  #$ROMBS+$VRAM		; после отработки п/п вызвать вычислитель тек. адреса WOZU

    MOV  #144,R1
    MOV  CURATR+YCOOR,R5
    ASH  #2,R5			; Y*4
    MOV  R5,R3
    ADD  #$YPTR-$ROMBS,R5	; $YPTR+Y*4
    MUL  #10.,R3 	 	;     Y*4*10.
    MOV  #GRAM0E-$ROMBS,R4	; конец+2 таблицы адрес строк
    SUB  R3,R4			; указатель на адрес текущей строки
    MOV  (R5)+,R3		;
    MOV  R3,R2			;

    REPEAT
    UNTILB L11025 EQ #0

    MOV	L00270,R0

    ;
    ; R0 - содержимое ячейки L00270
    ; R1 - 144
    ; R2 - адрес первой строки растра
    ; R3 - адрес первой строки растра
    ; R4 -
    ; R5 -
    ;
    JSR R4, RCASE

    .WORD	$ROMBS+SW2H2H, '3	; двойная   ширина, двойная   высота, верхняя половина
    .WORD	$ROMBS+SW2H2L, '4	; двойная   ширина, двойная   высота, нижняя  половина
    .WORD	$ROMBS+SW1H1,  '5	; одинарная ширина, одинарная высота
    .WORD	$ROMBS+SW2H1,  '6	; двойная   ширина, одинарная высота
    .WORD	L10740-$ROMBS, '8
    .WORD	0

    RETURN
  END STLATR

  ;
  ; Корневая процедура CSI-последовательностей
  ;   ESC+[
  ;
  PROCEDURE $CSI			; C1(from rcase)
  BEGIN
    LET SYMSWT := #csi
    LET L00272 := #0
    LET R0     := #21. 	; ДО 21 ПАРАМЕТРА
    LET R1     := #$ROMBS+$ARGS
    LET L00276 := R1

    THRU R0
      LET (R1)+ := #0
    END

    CALL P02412

    CMP R0,#'?
    BEQ 10$

	CMP	R0,#'>
	BNE	40$

10$:
	NEGB	L00265

30$:
20$:
	CALL	P02412


40$:
	CMP	R0,#'0
	BLT	110$
	CMP	R0,#'@
	BGE	140$
	CMP	R0,#'9
	BLE	70$
	CMP	R0,#';
	BNE	80$

    IF L00274 NE #20. THEN
      LET L00274  := L00274 + #1
      LET @L00276 := L00272
      LET L00276  := L00276 + #2
    END

60$:
	CLR	L00272
	BR	20$

70$:
	SUB	#'0,R0
	MOV	L00272,R1
	MUL	#10.,R1
	ADD	R0,R1
	MOV	R1,L00272
	BR	30$

80$:
90$:
	CALL	P02412
	CMP	R0,#'0
	BLT	100$
	CMP	R0,#'@
	BGE	130$
	CMP	R0,#';
	BNE	90$
	BR	60$

110$:
100$:

    REPEAT
      MOV  R0,L00266
      CALL P02412
    UNTIL R0 GT #'/

130$:
140$:

    MOV L00272,@L00276
    INC L00274

    IF L00266 NE #0 THEN JUMPTO L10664

    MOV #1,R3

    JSR	R4, RCASE

    .WORD $ROMBS+P06106, 'g
    .WORD $ROMBS+P04612, 'm
    .WORD $ROMBS+$ESCZ2, 'c	; запрос типа
    .WORD $ROMBS+P07270, 'n
    .WORD 0

    PUSH  #$ROMBS+$VRAM		; после отработки п/п вызвать вычислитель тек. адреса WOZU

    JSR	R4, RCASE

    .WORD $ROMBS+P04326, 'h
    .WORD $ROMBS+P04330, 'l
    .WORD 0

    MOV $ARG1,R3

    IF RESULT IS EQ THEN LET R3 := R3 + #1

    JSR R4, RCASE

    .WORD $ROMBS+UP,     'A	; вверх на nn строк
    .WORD $ROMBS+DOWN,   'B	; вниз на nn строк
    .WORD $ROMBS+RIGHT,  'C	; вправо на nn строк
    .WORD $ROMBS+LEFT,   'D	; влево на nn строк
    .WORD $ROMBS+P06342, 'H
    .WORD $ROMBS+P06342, 'f
    .WORD $ROMBS+$CSIL,  'L	; csi L
    .WORD $ROMBS+$CSIM,  'M	; csi M
    .WORD $ROMBS+$CSIX,  'X	; csi X
    .WORD $ROMBS+EEOL,   'K	;
    .WORD $ROMBS+EEOS,   'J	;
    .WORD $ROMBS+P06230, 'r	;
    .WORD $ROMBS+$CSII,  'I	; csi I
    .WORD $ROMBS+$CSISY, 'y	; csi y
    .WORD $ROMBS+$CSIAT, '@	; csi @
    .WORD $ROMBS+$CSIP,  'P	; csi P
    .WORD 0

    RETURN
  END $CSI

  PROCEDURE STNMG0			; ???????????????????????????
  BEGIN
    MOV  #CURATR+G0P-$ROMBS,R3
    GOTO STNMCM
  END STNMG0

  PROCEDURE STNMG1
  BEGIN
    MOV  #CURATR+G1P-$ROMBS,R3
    GOTO STNMCM
  END STNMG1	

  PROCEDURE STNMG2
  BEGIN
    MOV  #CURATR+G2P-$ROMBS,R3
    GOTO STNMCM
  END STNMG2

  PROCEDURE STNMG3
  BEGIN
    MOV   #CURATR+G3P-$ROMBS,R3
    $GOTO STNMCM
  END STNMG3

  PROCEDURE STNMCM
  BEGIN
    MOV L00270,R0

    JSR R4, RCASE

      .WORD $ROMBS+P04276, 'B
      .WORD $ROMBS+P04304, '<
      .WORD $ROMBS+P04320, '0
      .WORD $ROMBS+P04312, 'u
      .WORD 0

    IF R0 EQ L04466 THEN
      MOV    L04464, @R3
      RETURN
    END

    IF R0 EQ L04472 THEN LET @R3 := L04470

    RETURN
  END STNMCM

  PROCEDURE P04276
  BEGIN
    MOV    L04454,@R3
    RETURN
  END P04276

  PROCEDURE P04304
  BEGIN
    MOV    L04456,@R3
    RETURN
  END P04304

  PROCEDURE P04312
  BEGIN
    MOV    L04460,@R3
    RETURN
  END P04312

  PROCEDURE P04320
  BEGIN
    MOV    L04462,@R3
    RETURN
  END P04320

  PROCEDURE P04326
  BEGIN
    CLR   R3
    $GOTO P04330
  END P04326

  PROCEDURE P04330
  BEGIN
    MOV   #$ROMBS+$ARGS,R5
    $GOTO P04334
  END P04330

  PROCEDURE P04334
  BEGIN
    PUSH R3
    MOV  (R5)+,R0	; $ARG1
    PUSH R5
    PUSH #$ROMBS+P04454

    IFB L00265 MI #0 THEN

      JSR R4, RCASE

      .WORD $ROMBS+STUBP1, 0.
      .WORD $ROMBS+P04470, 1.
      .WORD $ROMBS+P05524, 2.
      .WORD $ROMBS+P07040, 3.
      .WORD $ROMBS+P04510, 4.
      .WORD $ROMBS+P04560, 5.
      .WORD $ROMBS+P06330, 6.
      .WORD $ROMBS+P04546, 7.
      .WORD $ROMBS+P04530, 25.
      .WORD 0

      JMP L10670
    END

    JSR R4, RCASE

    .WORD $ROMBS+STUBP1, 0.
    .WORD $ROMBS+$CRLF, 20.
    .WORD 0

    JMP L10674
  END P04334

  PROCEDURE P04454
  BEGIN
    POP <R5, R3>
    DEC L00274
    BNE P04334
    RETURN
  END P04454

  PROCEDURE P04470
  BEGIN
    MOV #$ROMBS+$PCH3,R0
    MUL #$PCH2-$PCH3,R3 ; R3 - 0/1 -> 0/6
    ADD R3,R0
    MOV R0,$V1PP
    RETURN
  END P04470

  PROCEDURE P04510
  BEGIN
    REPEAT
    UNTILB L11025 EQ #0
    MUL #11,R3
    MOV R3,L04474
    RETURN
  END P04510

  PROCEDURE P04530
  BEGIN
    ASL R3
    MOV $ROMBS+M04542(R3),$QCURS
    RETURN
  END P04530

M04542:
  .WORD 2, 0

  PROCEDURE P04546
  BEGIN
    MUL #12,R3
    MOV R3,CURATR+ATTR2
    RETURN
  END P04546

  PROCEDURE P04560
  BEGIN
    MOVB $SPALL+5,R3
    MOVB $SPALL+0,$SPALL+5
    MOVB R3,$SPALL+0
    RETURN
  END P04560

  PROCEDURE $CRLF
  BEGIN
    ASH #2,R3		; R3*4 (R3 - 0/1)
    MOV R3,$QCRLF
    RETURN
  END $CRLF

  ;
  ; ESC [ <nn1> ; <nn2> ; ... ; <nnN> М
  ;
  PROCEDURE P04612
  BEGIN
    MOV #$ROMBS+$ARGS,R5
  END P04612

  PROCEDURE P04616
  BEGIN
    PUSH #$ROMBS+P04700
    MOV (R5)+,R0	; $ARG1

    JSR R4, RCASE

    .WORD $ROMBS+P04710, 0.	; все аттрибуты выключены
    .WORD $ROMBS+P05020, 1.	; oтображать символы дополнительной яркостью (цветом)
    .WORD $ROMBS+P05002, 4.	; oтображать символы с подчеркиванием
    .WORD $ROMBS+P04734, 5.	; oтображать мерцающий символ
    .WORD $ROMBS+P04774, 7.	; oтображать с реверсом яркости (цвета) фона и символа
    .WORD $ROMBS+P05026, 22.	; oтображать символы нормальной яркостью (цветом)
    .WORD $ROMBS+P05010, 24.	; oтображать символы без подчеркивания
    .WORD $ROMBS+P04756, 25.	; oтображать немерцающий символ
    .WORD $ROMBS+P04724, 27.	; oтображать без реверса яркости (цвета) фона и символа
    .WORD 0

    RETURN
  END P04616

  PROCEDURE P04700
  BEGIN
    DEC L00274
    BNE P04616
    RETURN
  END P04700

  ;
  ; Все аттрибуты выключены
  ; ESC [ <0> М	- VT100
  ;
  PROCEDURE P04710
  BEGIN
    MOV	#125252,CURATR+FCOLOR
    MOV	#12,CURATR+UNDLN
  END P04710

  ;
  ; Отображать без реверса яркости (цвета) фона и символа
  ; ESC [ <27> М	 - VT100
  ;
  PROCEDURE P04724
  BEGIN
    MOV #2,CURATR+REVERS
    RETURN
  END P04724

  ;
  ; Отображать мерцающий символ
  ; ESC [ <5> М	- VT100
  ;
  PROCEDURE P04734
  BEGIN
    IF CURATR+FCOLOR NE #0 THEN
      LET CURATR+BCOLOR := CURATR+FCOLOR
      LET CURATR+FCOLOR := #0
    END
    RETURN
  END P04734

  ;
  ; Отображать немерцающий символ
  ; ESC [ <25> М	 - VT100
  ;
  PROCEDURE P04756
  BEGIN
    IF CURATR+FCOLOR EQ #0 THEN LET CURATR+FCOLOR := CURATR+BCOLOR
    RETURN
  END P04756

  ;
  ; Отображать с реверсом яркости (цвета) фона и символа
  ; ESC [ <7> М	- VT100
  ;
  PROCEDURE P04774
  BEGIN
    CLR CURATR+REVERS
    RETURN
  END P04774

  ;
  ; Отображать символы с подчеркиванием
  ; ESC [ <4> М	- VT100
  ;
  PROCEDURE P05002
  BEGIN
    CLR CURATR+UNDLN
    RETURN
  END P05002

  ;
  ; Отображать символы без подчеркивания
  ; ESC [ <24> М	 - VT100
  ;
  PROCEDURE P05010
  BEGIN
    MOV #12,CURATR+UNDLN
    RETURN
  END P05010

  ;
  ; Отображать символы дополнительной яркостью (цветом)
  ; ESC [ <1> М	- VT100
  ;
  PROCEDURE P05020
  BEGIN
    MOV #52525,R0
    BR P05032
  END P05020

  ;
  ; Отображать символы нормальной яркостью (цветом)
  ; ESC [ <22> М	 - VT100
  ;
  PROCEDURE P05026
  BEGIN
    MOV #125252,R0
  END P05026

  PROCEDURE P05032
  BEGIN
    IF CURATR+FCOLOR EQ #0 THEN
      MOV R0,CURATR+BCOLOR
      RETURN
    END

    MOV R0,CURATR+FCOLOR
    RETURN
  END P05032

  PROCEDURE P05054
  BEGIN
    REPEAT
    UNTILB L11025 EQ #0
    MOV R0,R5
    MUL #50,R5
    MOV #17472,R4
    SUB R5,R4
    MOV R4,L11026
    RETURN
  END P05054

  PROCEDURE SW2H2L
  BEGIN
    ADD   #764,R2
    $GOTO SW2H2H
  END SW2H2L

  PROCEDURE SW2H2H
  BEGIN
    CALL P05464
    GOTO P05122
  END SW2H2H

  PROCEDURE SW2H1
  BEGIN
    CALL  P05506
    $GOTO P05122
  END SW2H1

  PROCEDURE P05122
  BEGIN
    IF $QDBLW NE #0 THEN

      BIS #2,(R5)
      MOV #10., L13474
      ADD #61, R3

      REPEAT

        PUSH R3
        MOV  #62, R4
        ADD  R4, (SP)

        THRU R4

          MOV R3, IIDRA
          MOV IIDRD, R0
          POP IIDRA

          PUSH #$ROMBS+40$

          CALL (PC)
          CLR R2

          THRU R5 := #4

            CLR  R1
            ASHC #-2,R0
            ASH  #-2,R2
            BIC  #^C<37777>,R2
            BIS  R1,R2
            ASH  #-2,R2
            BIC  #^C<37777>,R2
            BIS  R1,R2
          END

          MOV  R2,IIDRD
          DEC  IIDRA
          RETURN

40$:
          PUSH IIDRA
          DEC  R3
	END

        ADD #144,IIDRA
        BIC L07534,IIDRD
        ADD #226,R3
        POP

        DEC L13474
      UNTIL RESULT IS EQ
    END

    RETURN
  END P05122


  PROCEDURE SW1H1
  BEGIN
    CALL P05506
    IF $QDBLW EQ #0 THEN

      BIC #2, (R5)
      MOV #10., L13474
      REPEAT

        MOV R3, R2

        THRU R4 := #62

          MOV  R2, IIDRA

          PUSH #$ROMBS+40$
          CALL (PC)

          MOV IIDRD,R1

          THRU R5 := #4

            ASHC #2,R0
            ASH  #2,R1
          END

          INC IIDRA
          RETURN

40$:
          MOV IIDRA,R2
          MOV R3,IIDRA
          MOV R0,IIDRD
          INC R3
        END

        THRU R4 := #62
          INC IIDRA
          CLR IIDRD
        END

        ADD #62,R3
        DEC L13474
      UNTIL RESULT IS EQ

    END

    RETURN
  END SW1H1

  PROCEDURE P05464
  BEGIN
    THRU R0 := #5
      MOV R2,-(R4)
      MOV R2,-(R4)
      MOV R2,-(R4)
      MOV R2,-(R4)
      ADD R1,R2
    END
    RETURN
  END P05464

  PROCEDURE P05506
  BEGIN
    THRU R0 := #10.
      MOV R2,-(R4)
      MOV R2,-(R4)
      ADD R1,R2
    END
    $GOTO STUBP2
  END P05506

  PROCEDURE STUBP2
  BEGIN
    RETURN
  END STUBP2

  PROCEDURE P05524
  BEGIN
    IF R3 EQ #0 GOTO STUBP2
    MOVB R3,QVT52
    MOV  L04454,CURATR+G0P
    MOV  L04460,CURATR+G1P
    MOV  L04462,CURATR+G3P
    RETURN
  END P05524	

  ;
  ; Установить режим VT100
  ;   ESC < - VT52
  ;
  PROCEDURE SVT100
  BEGIN
    CLRB QVT52
    RETURN
  END SVT100

  PROCEDURE $SVATR
  BEGIN
    MOV  #SAVATR-$ROMBS,R0
    MOV  #CURATR-$ROMBS,R1
    GOTO $CMATR
  END $SVATR

  PROCEDURE $RSATR
  BEGIN
    MOV   #SAVATR-$ROMBS,R1
    MOV   #CURATR-$ROMBS,R0
    $GOTO $CMATR
  END $RSATR

  PROCEDURE $CMATR
  BEGIN
    MOV  #ATRLEN/2,R2
    $GOTO CPWRDS
  END $CMATR

  ;
  ; Копирование из (R1)+ в (R0)+ R2 слов
  ;
  PROCEDURE CPWRDS
  BEGIN
    THRU R2
      MOV  (R1)+,(R0)+
    END
    RETURN
  END CPWRDS
  ;
  ; Распаковка знакогенератора
  ;
  PROCEDURE ZGUNPK
  BEGIN
    MOV     #ZG1MAP,R0
    MOV     #$ROMBS+$SYMBM,R1
    THRU R2 := #256.*10.*2/2
      MOVB (R1)+,R5		; образ
      CALL    DBLBTS		; сдвоить биты
      MOV     R4,(R0)+		; заслать
    END 			; цикл

    MOV #$ROMBS+M07456,R1	; из	; ??????
    $GOTO P05654
  END ZGUNPK

  PROCEDURE P05654
  BEGIN
    MOV     #L07474-$ROMBS,R0	; в
    MOV     #T7474L,R2		; слов
    BR	    CPWRDS
  END P05654

  PROCEDURE P05666
  BEGIN
    LET R0 := #ZG2MAP
    LET R1 := #2304
    LET R5 := #4716

    THRU R2 := #^O<12000/2>

      LET  R4 := #0
      LET  R3 := -(R0)
      CALL P00226

      IF R2 LT R5 THEN

        IF R2 LT R1 THEN
          CALL P00206
          CALL P00200
          CALL P00226
          CALL P00206
          GOTO 10$
        END

        CALL P00200
        ASH  #2,R3
        CALL P00226
        ASH  #2,R3
        CALL P00200
        GOTO 10$
      END

      CALL P00226
      ASH  #2,R3
      CALL P00226
      ASH  #2,R3
      CALL P00200
      CALL P00226
10$:
      LET @R0 := R4
    END

    LET R1 := #$ROMBS+M07524	; ??????
    GOTO P05654

  END P05666

  ;
  ; Установить режим цифровой клавиатуры
  ;   ESC > - VT52/VT100
  ;
  PROCEDURE KPAD0
  BEGIN
    CLR   R3
    $GOTO KPAD2
  END KPAD0

  ;
  ; Установить режим дополнительной клавиатуры
  ;   ESC = - VT52/VT100
  ;
  PROCEDURE KPAD2
  BEGIN
    MOVB R3,$QKPAD
    RETURN
  END KPAD2

  PROCEDURE CTAB
  BEGIN
    CALL P02254
    BICB $ROMBS+$BITS(R1),$ROMBS+$TAB(R0)
    RETURN
  END CTAB

  ;
  ; Установить остановку табуляции в тек. позиции
  ;   ESC H - VT100
  ;
  PROCEDURE STAB
  BEGIN
    CALL P02254
    BISB $ROMBS+$BITS(R1),$ROMBS+$TAB(R0)
    RETURN
  END STAB

  ;
  ; Инициализация позиций горизонтальной табуляции
  ;

  PROCEDURE $TABS
  BEGIN

  ENTRY INITAB
    MOV  #200,R3
    GOTO 10$

  ENTRY P06106

    IF $ARG1 EQ #0 GOTO CTAB
    IF $ARG1 NE #3 GOTO 20$

    CLR R3

  ENTRY 10$

    MOV  #$TAB-$ROMBS,R0
    MOV  #$TABL-1,R1
    CLRB (R0)+
    THRU R1
      MOVB R3,(R0)+
    END

  ENTRY 20$

    RETURN
  END $TABS

  PROCEDURE HMOVE
  BEGIN

  ;
  ; Процедура backspace и влево
  ;   bs		 - VT52/VT100
  ;   ESC D	 - VT52 - на одну строку
  ;   ESC [ <nn> D - VT100 - на nn строк
  ;
  ENTRY LEFT				; C2(rcase)

  ENTRY $BS				; C1(rcase)

    NEG R3

  ;
  ; Вправо
  ;   ESC C	 - VT52 - на одну строку
  ;   ESC [ <nn> C - VT100 - на nn строк
  ;

  ENTRY RIGHT				; C2(rcase)

    ADD R3,CURATR+XCOOR
    RETURN
  END HMOVE

  ;
  ; Установить позицию курсора
  ;   ESC Y y+40 x+40 - VT52
  ;
  PROCEDURE SYX				; C1(rcase)
  BEGIN
    CALL P02412
    SUB  #40,R0

    IF RESULT IS PL AND R0 LE #23. THEN LET CURATR+YCOOR := R0

    CALL P02412
    SUB  #40,R0

    IF RESULT IS PL AND R0 LE #79. THEN LET CURATR+XCOOR := R0

    RETURN
  END SYX

  PROCEDURE P06230			; C1(rcase)
  BEGIN
    DEC R3

    IF R3 GE #26 THEN LET R3 := #0

10$:

    MOV $ARG2,R0
    BNE 30$

20$:
    MOV #27,R0
    BR  40$

30$:
    DEC R0
    CMP R3,R0
    BGE 20$

40$:
    MOV   R0,SCRE
    MOV   R3,SCRS
    CALL  P05054
    MOV   L11026,L11030
    SUB   #44,L11030
    MOV   R3,R0
    CALL  P05054
    $GOTO HOME
  END P06230

  PROCEDURE HOME
  BEGIN  
    CLR  R3				; C1(rcase)
    CLR  R4
    GOTO P06354
  END HOME

  PROCEDURE P06330			; C1(rcase)
  BEGIN
    ASH	 #2,R3
    MOV	 R3,CURATR+QSCRND
    GOTO HOME
  END P06330

  PROCEDURE PS01
  BEGIN

  ENTRY P06342				; C1(rcase)

    DEC R3
    MOV $ARG2,R4
    IF RESULT IS NE THEN LET R4 := R4 - #1

  ENTRY P06354

    ADD CURATR+QSCRND,PC		; !!!
    ADD SCRS,R3
    MOV R3,CURATR+YCOOR

  ENTRY P06370

    MOV R4,CURATR+XCOOR
    RETURN
  END PS01

  ;
  ; Процедура возврата каретки
  ;   cr - VT52/VT100
  ;
  PROCEDURE $CR
  BEGIN
    CLR R4
    BR P06370
  END $CR

  ;
  ; Стереть до конца экрана
  ;   ESC J - VT52
  ; Стереть в экране
  ;   ESC [ <nn> J - VT100
  ;     nn=0 - до конца экрана
  ;     nn=1 - до начала экрана
  ;     nn=2 - весь экран
  ;
  PROCEDURE EEOS
  BEGIN

    IFB L00265 LE #0
      JUMPTO L10644
    END
    
    IF $ARG1 EQ #2 GOTO P06472

    IF RESULT IS GE THEN
      RETURN
    END

    CALL EEOL
    MOV  CURATR+YCOOR,R1
    INC  R1

    IF $ARG1 EQ #0 THEN

      IF CURATR+XCOOR NE #0 GOTO P06474

      DEC  R1
      GOTO P06474

    END

    TST  -(R1)
    MOV  R1,R3
    CLR  R1
    GOTO P06500
  END EEOS

  PROCEDURE P06472
  BEGIN
    CLR R1

  ENTRY P06474

    MOV #27,R3

  ENTRY P06500

    SUB R1,R3

    IF RESULT IS PL THEN

      INC R3
      ASH #2,R1
      MOV R1,R5
      MUL #10.,R1
      ADD #$YPTR-$ROMBS,R5
      MOV #17474,R4
      SUB R1,R4

      REPEAT

      UNTILB L11025 EQ #0

      THRU R3
        MOV	@R5,R0
        CALL	P01230
        MOV	(R5)+,R2
        MOV	#144,R1
        CALL	P05506
        MOV	LINATR,(R5)+
      END

    END

    RETURN
  END P06472

  ;
  ; Стереть до конца строки
  ;   ESC K - VT52
  ; Стереть в строке
  ;   ESC [ <nn> K - VT100
  ;	nn=0 - до конца строки
  ;	nn=1 - до начала строки
  ;	nn=2 - всю строку
  ;
  PROCEDURE EEOL
  BEGIN
    IFB L00265 LE #0 THEN JUMPTO L10650

    MOV  L07536,R1
    MOV  R1,R2
    MOV  CURATR+XCOOR,R0

    CMP  $ARG1,#2
    BEQ  20$
    BLT  10$
    RETURN

  10$:

    TST  $ARG1
    BEQ  30$
    MOV  R0,R2

  20$:

    CLR  R0

  30$:

    INC  R2
    MUL  L07540,R0
    DIV  #10,R0
    MOV  $ROMBS+M07466(R1),R1
    MUL  L07540,R2
    DIV  #10,R2
    MOV  $ROMBS+M07466(R3),R3
    COM  R3
    SUB  R0,R2
    DEC  R2
    MOV  CURATR+YCOOR,R5
    ASH  #2,R5
    ADD  #$YPTR-$ROMBS,R5
    ADD  @R5,R0
    THRU R4 := #10.
      MOV  R0,IIDRA
      BIC  R1,IIDRD
      INC  IIDRA
      MOV  R2,R5
      IF RESULT IS NE THEN
	THRU R5
	  CLR  IIDRD
	  INC  IIDRA
	END
      END
      BIC  R3,IIDRD
      ADD  #100.,R0
    END
    RETURN
  END EEOL

  PROCEDURE SGR
  BEGIN

  ;
  ; Установка GR в G1
  ;   ESC ~ - VT100
  ;
  ENTRY SGRG1
    MOV  CURATR+G1P,R3
    GOTO 10$

  ;
  ; Установка GR в G2
  ;   ESC } - VT100
  ;
  ENTRY SGRG2
    MOV CURATR+G2P,R3
    GOTO 10$

  ;
  ; Установка GR в G3
  ;   ESC | - VT100
  ;
  ENTRY SGRG3
    MOV CURATR+G3P,R3

  10$:

    MOV R3,CURATR+GRP
    RETURN
  END SGR

  ;
  ; Установка G2 на один символ
  ;   ESC N - VT100
  ;
  PROCEDURE S1GLG2
  BEGIN
    MOV CURATR+G2P,CURATR+OCHP
    RETURN
  END S1GLG2

  ;
  ; Установка G3 на один символ
  ;   ESC O - VT100
  ;

  PROCEDURE S1GLG3
  BEGIN
    MOV   CURATR+G3P,CURATR+OCHP
    $GOTO STUBP3
  END S1GLG3

  PROCEDURE STUBP3
  BEGIN
    RETURN
  END STUBP3

  PROCEDURE P07040			; C1(rcase)
  BEGIN
    IF R3 EQ #0 THEN
      IF L07534 NE #0 GOTO STUBP3
      CALL P05666
    ELSE
      IF L07534 EQ #0 GOTO STUBP3
      CALL ZGUNPK
    END
     CALL P06472
       CLR SCRS
       MOV #17472,L11026
       MOV #15576,L11030
       MOV #27,SCRE
       CLR CURATR+XCOOR
       CLR CURATR+YCOOR
       MOV #4,CURATR+QSCRND
    RETURN
  END P07040

  PROCEDURE M07144			; ???
  BEGIN
    MOV #310,R1
    BR  P07162
  END M07144

  $EZA:
    .ASCIZ  <33>"/Z"

  ;
  ; Послать ответ на запросе типа терминала
  ;   ESC Z - VT52
  ;
  PROCEDURE $ESCZ
  BEGIN
    MOV   #$ROMBS+$EZA,R1
    $GOTO P07162
  END $ESCZ

  PROCEDURE P07162
  BEGIN
    WHILEB @R1 NE #0 DO
      CALL    $OUTCH
    END
    $GOTO STUBP4
  END P07162

  PROCEDURE STUBP4
  BEGIN
    RETURN
  END STUBP4

  ;
  ; Послать символ в центральную машину или на экран
  ;
  PROCEDURE $OUTCH
  BEGIN
    IF $ONOFF EQ #0 THEN

      TSTB CPOCSR
      BPL  $OUTCH

      MOVB (R1)+,CPOBUF
      PUSH R1
	THRU R1 := #1500
	END
      POP  R1
      RETURN
    END
    MOVB (R1)+,L35625
    RETURN
  END $OUTCH

  ;
  ; Запрос типа дисплея
  ;   ESC Z -   VT100
  ;   ESC [ Ц - VT100
  ;
  PROCEDURE $ESCZ2
  BEGIN
    IF $ARG1 NE #0 GOTO STUBP4

    IFB L00265 PL #0 THEN
      MOV #ANSW-$ROMBS,R1
    ELSE
      MOV #$TVCH-$ROMBS,R1
    END

    GOTO P07162
  END $ESCZ2

  PROCEDURE P07270
  BEGIN
    IF $ARG1 EQ #5 THEN

      MOV  #$TVST-$ROMBS,R1
      GOTO P07162

    END

    IF $ARG1 NE #6 GOTO STUBP4

    MOV  #$$TEMP-$ROMBS,R4
    MOV  $PCH2,(R4)+
    MOV	 CURATR+YCOOR,R0
    ADD	 CURATR+QSCRND,PC
    SUB	 SCRS,R0
    CALL P07376
    MOVB #';,(R4)+
    MOV	 CURATR+XCOOR,R0
    CALL P07376
    MOVB #'R,(R4)+
    CLRB @R4
    MOV  #$$TEMP-$ROMBS,R1
    GOTO P07162
  END P07270

  PROCEDURE P07376
  BEGIN
    INC R0
    MOV #$ROMBS+$DIV10,R3

    REPEAT
    UNTIL R0 HIS -(R3)

    TST (R3)+

    LOOP
      MOVB #'0,R1
      TST  -(R3)

      IF RESULT IS NE GOTO 10$

      ADD  R0,R1
      MOVB R1,(R4)+
      RETURN

      REPEAT
        INC R1
10$:
        SUB @R3,R0
      UNTIL RESULT IS LO
      ADD  @R3,R0
      MOVB R1,(R4)+
    END

  END P07376

  .WORD 0, 10., 100., 1000., 10000.
$DIV10:

M07456:
  .WORD ^B<0000000000000001>	; 7474
  .WORD ^B<0000000000000001>	; 7476
  .WORD ^B<0000000000000001>	; 7500
  .WORD ^B<0000000000000010>	; 7502

M07466:
  .WORD ^B<1111111111111111>	; 7504
  .WORD ^B<0000111111111111>	; 7506
  .WORD ^B<0000000011111111>	; 7510
  .WORD ^B<0000000000001111>	; 7512

  .WORD ^B<1111000000000000>	; 7514
  .WORD ^B<1111111100000000>	; 7516
  .WORD ^B<1111111111110000>	; 7520
  .WORD ^B<1111111111111111>	; 7522

  .WORD ^B<0000000000001100>	; 7524
  .WORD ^B<0000000000001000>	; 7526
  .WORD ^B<0000000000000100>	; 7530
  .WORD ^B<0000000000000000>	; 7532

  .WORD ^B<0000000000000000>	; 7534
  .WORD ^B<0000000001001111>	; 7536
  .WORD ^B<0000000000001010>	; 7540

M07524:		; ???

  .WORD ^B<0000000000000000>	; 7542

.IIF NE <.-M07456>/2-T7474L .ERROR ; length mismatch

M07526:
	.BYTE	1,0
	.BYTE	1,0
	.BYTE	1,0
	.BYTE	360,377
	.BYTE	17,0
	.BYTE	377,0
	.BYTE	377,17
	.BYTE	0,0
	.BYTE	0,377
	.BYTE	0,360
	.BYTE	0,0
	.BYTE	20,0
	.BYTE	4,0
	.BYTE	10,0
	.BYTE	14,0
	.BYTE	377,377
	.BYTE	203,0
	.BYTE	6,0

IANSW:	.ASCIZ	<33>/[?1;2c/
IANSWL=.-IANSW
	.EVEN

;
; Клавиши, генерирующие мултипоследовательности
;
  PROCEDURE $MCH
  BEGIN
    JSR R4, RCASE

    .WORD $ROMBS+$KRPT,   214	; скан-код автоповтора
    .WORD $ROMBS+$MOVE,   351	; Up
    .WORD $ROMBS+$MOVE,   352	; Down
    .WORD $ROMBS+$MOVE,   353	; Right
    .WORD $ROMBS+$MOVE,   354	; Left
    .WORD $ROMBS+$CTRL,   207	; СУ (Ctrl)
    .WORD $ROMBS+$FXD,    210	; ФКС
    .WORD $ROMBS+$URG,    211	; вр
    .WORD $ROMBS+$CHABC,  212	; rus/lat
    .WORD $ROMBS+$KUP,    213	; скан-код отпускания
    .WORD $ROMBS+$SRGM,   367	; УСТ режима
    .WORD $ROMBS+$SC372,  372	; внутренний код 372
    .WORD $ROMBS+$STST,   362	; стоп кадр
    .WORD $ROMBS+$SC200,  200	; внутренний код 200
    .WORD $ROMBS+$SC377,  377	; внутренний код 377
    .WORD 0

;
; После табличной обработки коды делятся на
; следующие порции:
;
; 201..206 - п/п SGLG2 (при установленном флаге L04501(byte))
; 215..300 - сюда попадают клавиши доп. клавиатуры:  <ВВОД> , - . 0 1 2 3 4 5 6 7 8 9
; 301..354 - на самом деле 301..350 - сюда попадают клавиши доп. клавиатуры PF(1..4)
;	     351..354 - клавиши управления курсором, выбраны таблицей
;
; 355..361 \  - 21..25
; 363..366  \ - 27..31	п/п SGLG2 (при установленном
; 370..371  / - 33..34		   флаге L04501(byte))
; 373..376 /  - 36..41
;
    IF R0 LE #206 GOTO $SK1 	; 201..206 ?

    IF R0 LE #300 GOTO $KPAD 	; 215..300 ?

    IF R0 LT #355 GOTO $KPF 	; 301..355 ?

    SUB  #334,R0		; 355..361, 363..366, 370..371, 373..376
    GOTO $SK2
  END $MCH

  ;
  ; Клавиши управления курсором
  ; R0 - 351..354 - внутренний код
  ; R1 - 247..252 - скан-код
  ;
  PROCEDURE $MOVE
  BEGIN
    MOV  R1,$SCAN	; сохранить скан-код
    SUB  #250,R0 	; 101..104

    IFB QVT52 NE #0 GOTO P10036

    MOV  $V1PP,R1
    GOTO MCHOUT
  END $MOVE

  ;
  ; Обработка клавиш с внутренним кодом 215..300
  ; Сюда попадает доп. клавиатура: <ВВОД> , - . 0 1 2 3 4 5 6 7 8 9
  ;
  PROCEDURE $KPAD
  BEGIN
    MOV R1,$SCAN	; сохранить скан-код
    SUB #200,R0
    IFB $QKPAD EQ #0 GOTO M10240	; режим цифровой. клавиатуры ?

    ADD #100,R0

    IFB QVT52 NE #0 THEN

      MOV #$PCH4-$ROMBS,R1
      GOTO MCHOUT

    END

    MOV #$PCH3-$ROMBS,R1
    GOTO MCHOUT
  END $KPAD

  ;
  ; Обработка клавиш с внутренним кодом 301..350
  ; Сюда попадают PF1 PF2 PF3 PF4
  ;
  PROCEDURE $KPF
  BEGIN
    SUB #200,R0
    IFB QVT52 NE #0 THEN

  ENTRY P10036

      MOV  #$PCH1-$ROMBS,R1
      GOTO MCHOUT
    END

    MOV #$PCH3-$ROMBS,R1

    $GOTO MCHOUT
  END $KPF

  PROCEDURE MCHOUT
  BEGIN

    CALL P07162
    GOTO M10366

  END MCHOUT

  ;
  ; Ообработка клавиш с внутренним кодом 201..206
  ;
  PROCEDURE $SK1
  BEGIN

    SUB   #200,R0
    $GOTO $SK2

  END $SK1

  ;
  ; 355..361 \  - 21..25
  ; 363..366  \ - 27..31
  ; 370..371  / - 33..34
  ; 373..376 /  - 36..41
  ;
  PROCEDURE $SK2
  BEGIN

    IFB L04501 EQ #0 GOTO EV.60
    JUMPTO W10720

  END $SK2

  ;
  ; Процедура обработки прерывания по вектору 60
  ;
  PROCEDURE V.60
  BEGIN

    MOV  #77777,$SCRSV	; счетчик
    MOVB #3,$SCRSV+2	; гашения экрана
    PUSH <R0, R1, R4>	; сохранить некоторые регистры
    MOV  @#KBIBUF,R0	; скан нажатой клавиши
    MOV  R0,R1		; копия в R1

  ENTRY P10124

    SUB #126,R0			; начиная со 126

    IF RESULT IS PL THEN	; переход, если 0..125

      MOVB $KSCAN-$ROMBS(R0),R0	; перекодировка
      BIC  #^C<377>,R0		; только байт

      IF RESULT IS NE THEN 	; переход, если не обрабатывается

        IF R0 NE #del THEN	; del ?

          IF RESULT IS GT GOTO $MCH	; 200..377

          IFB $QRUS EQ #0 ANDB $QCD1 NE #0 THEN		; не РУС и ...
            MOVB $KSCN1-$ROMBS(R0),R0
            BIC  #^C<377>,R0
          END

          MOV  R1,$SCAN

          IFB L11047 NE #0 THEN JUMPTO L10704

          IFB $QCTRL NE #0 THEN
            SUB  #100,R0
            GOTO M10366
          END

          IF R0 LE #40 THEN

  ENTRY M10240

            IF R0     NE #cr GOTO M10366
            IF $QCRLF NE #0  GOTO M10366

            MOV  #$PCRLF-$ROMBS,R1
            CALL P07162
            BR   EV.60
          END

          IF R0 EQ #60 GOTO M10366

          IF RESULT IS GE THEN

            IFB $QSURG NE #0 THEN LET R0 := R0 + #40

            IFB $QRUS EQ #0 GOTO M10366

            IFB $QCD2 EQ #0 GOTO M10366

            MOVB $KSCN2-$ROMBS(R0),R0
            BIC  #^C<377>,R0

            GOTO M10366

          END

          CMP  R0,#54
          BLT  20$

          IFB $QURG EQ #0 GOTO M10366

10$:
          ADD  #20,R0
          BR   M10366
20$:
          TSTB $QURG
          BEQ  10$
        END

    ;
    ; Переход, если del
    ;
  ENTRY M10366

        PUSH R0
        MOV  SP,R1
        CALL $OUTCH
        POP
      END
    END

  ENTRY EV.60

    POP <R4, R1, R0>
    RTI

  END V.60

  PROCEDURE $KRPT
  BEGIN
    MOV $SCAN,R0
    MOV R0,R1
    BR  P10124
  END $KRPT

  PROCEDURE $SRGM
  BEGIN
    IF $ONOFF NE #0 THEN
      LET  $ONOFF := #0
      GOTO EV.60
    END
    LET  $ONOFF := #$ONOFL
    GOTO EV.60
  END $SRGM

  PROCEDURE $URG
  BEGIN
    COMB $QURG
    MOVB $QFXD,$QSURG
    COMB $QSURG
    GOTO EV.60
  END $URG

  PROCEDURE $CTRL
  BEGIN
    COMB $QCTRL
    GOTO EV.60
  END $CTRL

  PROCEDURE $CHABC
  BEGIN
    MOV #17,R0

    IFB $QRUS EQ #0 THEN LET R0 := R0 - #1

    GOTO M10366
  END $CHABC

  PROCEDURE $STST
  BEGIN
    MOV  #23,R0
    COMB $QDRAW

    IF RESULT IS EQ THEN
      TST -(R0)
    END

    PUSH R0
    MOV  #210,R1
    CALL P10654
    POP R0
    GOTO M10366
  END $STST

  PROCEDURE $KUP
  BEGIN
    IFB $QCTRL NE #0 THEN
      CLRB $QCTRL
      GOTO EV.60
    END

    IFB $QURG EQ #0 GOTO EV.60

    COMB $QURG
    MOVB $QFXD,$QSURG

    GOTO EV.60
  END $KUP

  PROCEDURE $SC372
  BEGIN
    IFB L04501 EQ #0 GOTO EV.60

    COMB L11047

    GOTO EV.60
  END $SC372

  PROCEDURE $FXD
  BEGIN
    IFB $QURG EQ #0 GOTO EV.60

    MOV  #23,R0
    COMB $QFXD
    MOVB $QFXD,$QSURG

    IF RESULT IS EQ THEN
      TST -(R0)
    END

    MOV  #204,R1
    PUSH #$ROMBS+EV.60
    $GOTO P10654
  END $FXD

  PROCEDURE P10654
  BEGIN
    CALL $KBOUT
    MOV  R1,R0
    BR  $KBOUT
  END P10654

  ;
  ; Процедура звонка
  ;   bel - VT52/VT100
  ;
  PROCEDURE $BELL
  BEGIN
    MOV   #247,R0
    $GOTO $KBOUT
  END $BELL

  ;
  ; Вывод в буфер клавиатуры
  ;
  PROCEDURE $KBOUT
  BEGIN
    REPEAT
    UNTILB KBOCSR MI #0
    MOVB R0,KBOBUF

  ENTRY P10702

    RETURN
  END $KBOUT

  ;
  ; Установка GL в G0
  ;   so    - VT52/VT100
  ;   ESC G - VT52
  ;
  PROCEDURE SGLG0
  BEGIN
    MOV  CURATR+G0P,R3
    GOTO SGLCMN
  END SGLG0

  ;
  ; Установка GL в G1
  ;   si - VT52/VT100
  ;
  PROCEDURE SGLG1
  BEGIN
    MOV  CURATR+G1P,R3
    GOTO SGLCMN
  END SGLG1

  ;
  ; Установка GL в G2
  ;   ESC Н - VT100
  ;
  PROCEDURE SGLG2
  BEGIN
    MOV  CURATR+G2P,R3
    GOTO SGLCMN
  END SGLG2

  ;
  ; Установка GL в G3
  ;   ESC F - VT52
  ;   ESC О - VT100
  ;
  PROCEDURE SGLG3
  BEGIN
    MOV  CURATR+G3P,R3
    $GOTO SGLCMN
  END SGLG3

  PROCEDURE SGLCMN
  BEGIN
    MOV	R3,CURATR+GLP
    MOV	#21,R0
    MOV	#$ROMBS+$QRUS,R1

    IF R3 EQ CURATR+G0P THEN

      IFB @R1 EQ #0 GOTO P10702

      CLRB @R1
      GOTO P10774

    END

    IFB @R1 NE #0 GOTO P10702

    COMB @R1
    TST  (R0)+

  ENTRY P10774

    MOV	#220,R1
    GOTO P10654
  END SGLCMN

$IVR1:
;			  ;
;			  ; НР - КЛАВИШИ БЕЗ ПОВТОРА
; $IKSCAN		  ; УП - КЛАВИШИ С КОДОМ ОТПУСКАНИЯ
;			  ;
	.BYTE	362,   0  ; 126, 127  СТОП КАДР(НР)  ПЕЧАТЬ КАДРА(НР)
	.BYTE	  0, 367  ; 130, 131  ПАУЗА(НР)      УСТ РЕЖИМА(НР)
	.BYTE	  0,   0  ; 132, 133  F5(НР)
	.BYTE	  0,   0  ; 134, 135
	.BYTE	  0,   0  ; 136, 137
	.BYTE	  0,   0  ; 140, 141
	.BYTE	  0,   0  ; 142, 143
	.BYTE	  0,   0  ; 144, 145  ПРЕРЫВ(НР)     ПРОДОЛЖ(НР)
	.BYTE	  0,   0  ; 146, 147  ОТМЕНА(НР)     ОСНОВН КАДР(НР)
	.BYTE	  0,   0  ; 150, 151  ВЫХОД(НР)
	.BYTE	  0,   0  ; 152, 153
	.BYTE	  0,   0  ; 154, 155
	.BYTE	  0,   0  ; 156, 157
	.BYTE	  0, ESC  ; 160, 161  F11 AR2(НР)    F12 W[(НР)
	.BYTE	 bs,  lf  ; 162, 163  F13 PS(НР)     ДОП ВАРИАНТ(НР)
	.BYTE	  0,   0  ; 164, 165
	.BYTE	  0,   0  ; 166, 167
	.BYTE	  0,   0  ; 170, 171
	.BYTE	  0,   0  ; 172, 173
	.BYTE	  0,  cr  ; 174, 175  PM(НР)	     ISP(НР)
	.BYTE	  0,   0  ; 176, 177
	.BYTE	  0,   0  ; 200, 201  F17(НР)	     F18(НР)
	.BYTE	  0,   0  ; 202, 203  F19(НР)	     F20(НР)
	.BYTE	  0,   0  ; 204, 205
	.BYTE	  0,   0  ; 206, 207
	.BYTE	  0,   0  ; 210, 211
	.BYTE	  0,   0  ; 212, 213  NT(НР)	     WST(НР)
	.BYTE	  0,   0  ; 214, 215  UDAL(НР)	     WYBR(НР)
	.BYTE	  0,   0  ; 216, 217  PRED KADR(НР)  SLED KADR(НР)
	.BYTE	  0,   0  ; 220, 221
	.BYTE	260,   0  ; 222, 223  0-ДОП
	.BYTE	256, 215  ; 224, 225  .-ДОП	     ВВОД-ДОП
	.BYTE	261, 262  ; 226, 227  1-ДОП	     2-ДОП
	.BYTE	263, 264  ; 230, 231  3-ДОП	     4-ДОП
	.BYTE	265, 266  ; 232, 233  5-ДОП	     6-ДОП
	.BYTE	254, 267  ; 234, 235  ,-ДОП	     7-ДОП
	.BYTE	270, 271  ; 236, 237  8-ДОП	     9-ДОП
	.BYTE	255, 320  ; 240, 241  --ДОП	     PF1
	.BYTE	321, 322  ; 242, 243  PF2	     PF3
	.BYTE	323,   0  ; 244, 245  PF4
	.BYTE	  0, 354  ; 246, 247		     ЛЕФТ
	.BYTE	353, 352  ; 250, 251  РИГХТ	     ДОВН
	.BYTE	351,   0  ; 252, 253  УП
	.BYTE	  0,   0  ; 254, 255
	.BYTE	211, 207  ; 256, 257  WR(УП)	     SU(УП)
	.BYTE	210,   0  ; 260, 261  FKS	     KMP
	.BYTE	212, 213  ; 262, 263  RUS LAT	     <УП>
	.BYTE	214,   0  ; 264, 265  <РЕПЕАТ>
	.BYTE	  0,   0  ; 266, 267
	.BYTE	  0,   0  ; 270, 271
	.BYTE	  0,   0  ; 272, 273
	.BYTE	del,  cr  ; 274, 275  ZB	     WK
	.BYTE	 ht,  '+  ; 276, 277  TAB	     ;+
	.BYTE	 '!,  'J  ; 300, 301  1!	     JJ
	.BYTE	 'F,  'Q  ; 302, 303  FF	     QQ
	.BYTE	  0,  '"  ; 304, 305  Ч 	     2"
	.BYTE	 'C,  'Y  ; 306, 307  CC	     YY
	.BYTE	 '^,  '+  ; 310, 311  ^^	     <ПУСТЫШКА>
	.BYTE	 '/,  '#  ; 312, 313  /?	     3#
	.BYTE	 'U,  'W  ; 314, 315  UU	     WW
	.BYTE	 'S,   0  ; 316, 317  SS
	.BYTE	 '$,  'K  ; 320, 321  4$	     KK
	.BYTE	 'A,  'M  ; 322, 323  AA	     MM
	.BYTE	 ' ,   0  ; 324, 325  <ПРОБЕЛ>
	.BYTE	 '%,  'E  ; 326, 327  5%	     EE
	.BYTE	 'P,  'I  ; 330, 331  PP	     II
	.BYTE	  0,  '&  ; 332, 333		     6&
	.BYTE	 'N,  'R  ; 334, 335  NN	     RR
	.BYTE	 'T,   0  ; 336, 337  TT
	.BYTE	 '',  'G  ; 340, 341  7'	     GG
	.BYTE	 'O,  'X  ; 342, 343  OO	     XX
	.BYTE	  0,  '(  ; 344, 345		     8(
	.BYTE	 '[,  'L  ; 346, 347  [[	     LL
	.BYTE	 'B,   0  ; 350, 351  BB
	.BYTE	 '),  ']  ; 352, 353  9)	     ]]
	.BYTE	 'D,  '@  ; 354, 355  DD	     @@
	.BYTE	  0,  '0  ; 356, 357		     0
	.BYTE	 'Z,  '_  ; 360, 361  ZZ	     _
	.BYTE	 'V,  ',  ; 362, 363  VV	     ,<
	.BYTE	  0,   0  ; 364, 365		     ХОМЕ
	.BYTE	 'H,  '.  ; 366, 367  HH	     .>
	.BYTE	  0,  '-  ; 370, 371		     -=
	.BYTE	 '*,  '\  ; 372, 373  :*	     \\
	.BYTE	  0,   0  ; 374, 375  ШЭ	     ТВЕРДЫЙ ЗНАК

	.BYTE	 0, 0, 0, 0, 0	; 4344 $SPALL - ТАБЛИЦА СОХРАНЕННОЙ
	.BYTE	17, 0, 0, 0, 0	; 4351 - 5	ПАЛЕТТЫ НА ВРЕМЯ
	.BYTE	11, 0, 0, 0, 0	; 4356 - 10.	SCREEN
	.BYTE	17		; 4363 - 15.	SAVE'ЕРА

	.ASCIZ	<ESC>/[0n/	; 4364 $TVST
	.ASCIZ	<ESC>/[>7;501c/ ; 4371 $TVCH
	.EVEN			;
	.ASCIZ	<ESC>/O/	; 4404 $PCH3
	.ASCIZ	<cr><lf>	; 4407 $PCRLF
	.ASCIZ	<ESC>/[/	; 4412 $PCH2
	.ASCIZ	<ESC>		; 4415 $PCH1
	.ASCIZ	<ESC>/?/	; 4417 $PCH4
	.WORD	0		; 4422 $ONOFF
	.WORD	0		; 4424
	.WORD	4		; 4426 $QCRLF
	.WORD	2		; 4430
	.WORD	4		; 4432
	.WORD	4		; 4434 L04434
	.WORD	$PCH2-$ROMBS	; 4436 $V1PP
	.WORD	1		; 4440
	.WORD	2		; 4442 $QCURS
	.WORD	^C<177> 	; 4444 $MASK
	.WORD	12		; 4446 L04446
	.WORD	0		; 4450 L04450
	.WORD	0		; 4452 LINATR
	.WORD	$$G0-$ROMBS	; 4454
	.WORD	$$G2-$ROMBS	; 4456
	.WORD	$$G1-$ROMBS	; 4460
	.WORD	$$G3-$ROMBS	; 4462
	.WORD	0		; 4464
	.WORD	0		; 4466
	.WORD	0		; 4470 L04470
	.WORD	0		; 4472
	.WORD	11		; 4474 L04474
	.WORD	2		; 4476 $QDBLW
	.WORD	1		; 4500 QVT52
				;      CURATR
	.WORD	$$G0-$ROMBS	; 4502	 +GLP
	.WORD	$$G1-$ROMBS	; 4504	 +GRP
	.WORD	$$G0-$ROMBS	; 4506	 +G0P
	.WORD	$$G1-$ROMBS	; 4510	 +G1P
	.WORD	$$G2-$ROMBS	; 4512	 +G2P
	.WORD	$$G3-$ROMBS	; 4514	 +G3P
	.WORD	0		; 4516	 +XCOOR
	.WORD	0		; 4520	 +YCOOR
	.WORD	2		; 4522	 +REVERS
	.WORD	12		; 4524	 +UNDLN
	.WORD	0		; 4526	 +OCHP
	.WORD	125252		; 4530	 +FCOLOR
	.WORD	0		; 4532	 +BCOLOR
	.WORD	4		; 4534	 +QSCRND
	.WORD	4		; 4536	 +ATTR1	(вызвать процедуру @#W10724 0-нет/4-да)
	.WORD	0		; 4540	 +ATTR2
$IVR1E:
.IIF NE <$IVR1E-$IVR1>/2-$VAR1L .ERROR ; length mismatch

M11450:
	.WORD	0	; 11004  SYMSWT
	.WORD	77774	; 11006  L11006
	.WORD	0	; 11010  L11010
	.WORD	116700	; 11012
	.WORD	120650	; 11014
	.WORD	77777	; 11016  $SCRSV
	.BYTE	3	; 11020  $SCRSV+2
	.BYTE	2	; 11021  L11021
	.WORD	0	; 11022  L11022
	.WORD	13	; 11024  L11024
	.WORD	17472	; 11026  L11026
	.WORD	15576	; 11030  L11030
	.WORD	0.	; 11032  SCRS
	.WORD	23.	; 11034  SCRE
	.WORD	0	; 11036  $SCAN
	.BYTE	0	; 11040  $QDRAW
	.BYTE	0	; 11041  $QCTRL
	.BYTE	0	; 11042  $QFXD
	.BYTE	0	; 11043  $QURG
	.BYTE	0	; 11044  $QRUS
	.BYTE	0	; 11045  $QSURG
	.BYTE	0	; 11046  $QKPAD
	.BYTE	0	; 11047  L11047
	.BYTE	0	; 11050  $QCD1
	.BYTE	0	; 11051  $QCD2

  PROCEDURE START
  BEGIN
    MOV  #$ROMBS+$START,SP
    PUSH <(SP), (SP)>	; 77776:=START, 77774:=START
    RESET
    MOV  #RAMR0L,R0
    CLR  R1
    MOV  #RAMR0E-$ROMBS,R2
  ;
  ; Заполнение таблицы регенрации OZU #0
  ;   13472:=0
  ;   13470:=2400    (+2400)
  ;	  ...
  ;   11430:=xx
  ;
    THRU R0
      MOV     R1,-(R2)
      ADD     #5*400,R1
    END
  ;
  ; Инициализация вектров с 0 до 74
  ;
  ; CLR     R0
    MOV  #PR7,R3
    MOV  #20,R2 	; вектора V0..V74
    MOV  R2,R1
    THRU R2
      MOVB R0,@#167772	; перебор регистров цветности
      CLRB @#167773
      MOV  @SP,(R0)+	; инициализация векторов V0..V74 в процедуру рестарта
      MOV  R3,(R0)+	; с приоритетом 7
    END

    TST  (R0)+		; R0:=102
    MOV  R3,@R0 	; (102):=PR7
    SUB  R1,R0		; R0:=102-20=62
    MOV  #$ROMBS+V.60,-(R0)	; V60

    CALL INITAB 	; инициализация позиций HT
  ;
  ; Инициализация программных векторов в <RETURN>
  ;
    MOV  #$ROMBS+PRVEC,R2	; начало таблицы
    MOV  (PC)+,R1	; команда
	 RETURN
    THRU R0 := #PRVECL	; длина таблицы
      MOV  R1,(R2)+
      MOV  R1,(R2)+
    END

    MOV  #$ROMBS+$DCSR,(R2)+	; V.DCS[11000]:=103302
  ;
  ; Инициализация программных ячеек
  ;
    MOV  #$ROMBS+$IVR1,R1	; из
    MOV  #$VAR1-$ROMBS,R0	; в
    MOV  #$VAR1L,R2	; слов
    CALL CPWRDS 	; копируй
  ;
  ; Инициализация таблиц перекодировок во внутреннюю кодировк
  ;
    MOV  #$ROMBS+$CD013,R0	; откуда
    MOV  #$$G0-$ROMBS,R1	; в G0, G1, G3
    MOV  #96./2,R2		; слов
    MOV  #$ROMBS+$CD2,R3	; откуда
    MOV  #$$G2-$ROMBS,R4	; в G2

    THRU R2
      MOV  @R0,$$G1-$$G0(R1)	; В G1
      MOV  @R0,$$G3-$$G0(R1)	; В G3
      MOV  (R0)+,(R1)+		; В G0
      MOV  (R3)+,(R4)+		; В G2
    END

    MOV  #$ROMBS+$CD1A,R1	; откуда
    MOV  #$$G1-$ROMBS+100-40,R0	; в G1 (100..177)
    MOV  #64./2,R2		; слов
    CALL CPWRDS			; копируй

    MOVB #261,$$G1+44-40	; в G1 (44)

    MOV  #$ROMBS+$CD3A,R0	; откуда
    MOV  #$$G3-$ROMBS+137-40,R1	; в G3 (137..176)
    THRU R2 := #32.		; байт
      MOVB (R0)+,(R1)+		; копируй
    END

    CALL ZGUNPK 	 ; распаковка знакогенератора

    MOV     #ANSW-$ROMBS,R0
    MOV     #$ROMBS+IANSW,R1	; ответ
    THRU R2 := #IANSWL		; длина ответа
      MOVB (R1)+,(R0)+
    END
  ;
  ; Обнуление GOZU
  ;
    MOV  #40000,IIDRA	; 40000*2 = 100000
    TST  (R2)+		; R2:=2
    THRU R2
      THRU R1 := #60000 ; 60000 слов
	CLR  IIDRD	; в 0
	INC  IIDRA	; следующее слово
      END		; по словам
    END 		; два раза
  ;
  ; Установка строк растра
  ;
    MOV  #GRAM0L/2.,R0	; 240 строк растра
    MOV  #40000,R4	; начальный адрес GOZU
    MOV  R4,IIDRA	; установить
    MOV  R4,R5		; копия
    MOV  #GRAM0-$ROMBS+<GRAM0L*2>,R3	; конец таблицы #0 строк растра + 2
    THRU R0
      MOV  R4,-(R3)	; очередная
      MOV  R4,-(R3)	;   строка (сдвоенная)
      ADD  #800./8.,R4	; 100.*16./2=800 точек по 2 бита или 400 точек по 4 бита
    END 		; цикл по всем строкам

    MOV  #$ROMBS+M11450,R1	; откуда
    MOV  #L11004-$ROMBS,R0	; куда
    MOV  #24.,R2 	; слов
    CALL CPWRDS 	; скопировать

    CALL $SVATR 	; сохранить текущие аттрибуты

    MOV  #$YPTR-$ROMBS,R0	; таблица указателей
    MOV  #800./8.*10.,R1; смещение - 10 строк растра, 800 точек
    MOV  #$YPTRL/2,R2	; 24 строки
    MOV  R5,R3		; начальный адрес
    THRU R2
      MOV  R3,(R0)+	; адрес
      MOV  LINATR,(R0)+ ; аттрибуты строки
      ADD  R1,R3	; смещение до следующей строки растра
    END 		; цикл

    CMP  (R2)+,(R2)+		; R2:=4
    PUSH @R2			; сохранить вектор 4
    MOV  #$ROMBS+10$,@R2	; новое
    JMP  120000-$ROMBS		; попробовать ПЗУ 1

  ;
  ; Возврат сюда, если нет ПЗУ 1
  ;

  10$:

    CMP  (SP)+,(SP)+	; сброс стека
    POP  @R2		; восстановить вектор 4
    CALL $VRAM		; вызвать вычислитель тек. адреса ВОЗУ
    MOV  #100,@#KBICSR	; разрешить прерывания по вводу от клавиатуры

    MOV  #21,R0
    PUSH <#$ROMBS+ESCC, #0>
    PUSH  #$ROMBS+P10774
    JMP  V2.100
  END START

  .INCLUDE /181Z.MAC/

END 181ROM
.END