; $Id: dl11echo.mac 1155 2019-05-31 06:38:06Z mueller $
; Copyright 2019- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
; License disclaimer see License.txt in $RETROBASE directory
;
; Revision History:
; Date         Rev Version  Comment
; 2019-04-21  1134   1.0    Initial version
;
; DL11 echo
;   default is direct echo, only modification is to add a LF after CR
;   other mode can be selected by two ESC plus a character:
;     ESC + ESC + u -> uppercase
;     ESC + ESC + l -> lowercase
;     ESC + ESC + o -> octal echo (16 per line)
;     ESC + ESC + a -> direct echo
;
; definitions ----------------------------------------------
;
        .include  |lib/defs_cpu.mac|
        .include  |lib/defs_kwl.mac|
        .include  |lib/defs_dl.mac|

        bsize = 1024.
;
        CR  = 015
        LF  = 012
        ESC = 033
        SPC = 040
;
; vector area ----------------------------------------------
;
        .include  |lib/vec_cpucatch.mac|
        .include  |lib/vec_devcatch.mac|

        . = v..tti              ; DL11 rx vector
        .word   vh.tti
        .word   cp.ars!cp.pr7   ; use alt-reg-set !
        
        . = v..tto              ; DL11 tx vector
        .word   vh.tto
        .word   cp.ars!cp.pr7   ; use alt-reg-set !
        
        . = v..kwl              ; KW11-L vector
        .word   vh.kwl
        .word   cp.ars!cp.pr7   ; use alt-reg-set !
;
; stack area -----------------------------------------------
;
        . = 1000                        ; stack (below); code (above)
stack:  
;
; code area ------------------------------------------------
;
; main program -----------------------------------
;
start:  mov     #stack,sp               ; setup stack
        spl     7
        mov     #ti.ie,@#ti.csr         ; activate input
        mov     #kl.ie,@#kl.csr
        spl     0                       ; allow interrupts
;
; simple blinking lights null task
; RSX-11M style display, code from RSX-11M V3.1 NULTK.MAC
;
nultsk: mov     #pat,r0
        aslb    (r0)+
        rorb    (r0)
        adcb    -(r0)
;
        mov     pat,r0                  ; load pattern
        wait                            ; and wait
        mov     pat,r0
        wait
        mov     pat,r0
        wait
        mov     pat,r0
        wait
;
        br      nultsk
;
; receive interrupt handler ----------------------
;
vh.tti: mov     @#ti.buf,r0             ; read char
        movb    r0,curchr               ; and remember
        jsr     pc,@curhdl              ; call handler
        jsr     pc,chkesc               ; check for ESC
        cmp     nfree,#6.               ; enough buffer ?
        bgt     100$                    ; if <= 6
        bic     #ti.ie,@#ti.csr         ; disable ti irupt
100$:   rti
;
; transmit interrupt handler ---------------------
;
vh.tto: mov     rptr,r1                 ; load pointer
        movb    (r1)+,@#to.buf          ; send char
        cmp     r1,#bufe                ; ring wrap ?
        blo     1$
        mov     #buf,r1
1$:     mov     r1,rptr                 ; store pointer
        inc     nfree
        cmp     nfree,#bsize            ; more to do ?
        bne     2$
        bic     #to.ie,@#to.csr         ; if not disable to irupt
2$:     cmp     nfree,#6.               ; enough buffer ?
        ble     100$                    ; if > 6
        bis     #ti.ie,@#ti.csr         ; enable ti irupt
100$:   rti
;
; kw11-l line clock handler ----------------------
;
vh.kwl: rti
;
; ring buffer write routine ----------------------
;   in  r0  current character
;   use r1
;
wchar:  tst     nfree                   ; free buffer
        beq     100$                    ; if not, discard !
        mov     wptr,r1                 ; load pointer
        movb    r0,(r1)+                ; store char
        cmp     r1,#bufe                ; ring wrap ?
        blo     1$
        mov     #buf,r1
1$:     mov     r1,wptr                 ; store pointer
        bis     #to.ie,@#to.csr         ; enable to irupt
        dec     nfree
100$:   rts     pc        
;
; write CR/LF ------------------------------------
;   use r0
;
wcrlf:  mov     #CR,r0
        jsr     pc,wchar
wlf:    mov     #LF,r0
        jsr     pc,wchar
        rts     pc

;
; escape detection -------------------------------
;   use r0
;
chkesc: movb    curchr,r0
        cmpb    #ESC,r0
        bne     1$
        incb    esccnt
        rts     pc
1$:     cmpb    esccnt,#2               ; 2 ESC seen ?
        blt     200$
        cmpb    #'u,r0                  ; u -> hdluc
        bne     100$
        mov     #hdluc,curhdl
        br      200$
100$:   cmpb    #'l,r0                  ; l -> hdllc
        bne     110$
        mov     #hdllc,curhdl
        br      200$
110$:   cmpb    #'a,r0                  ; a -> hdldir
        bne     120$
        mov     #hdldir,curhdl
        br      200$
120$:   cmpb    #'o,r0                  ; o -> hdloct
        bne     200$
        mov     #hdloct,curhdl
        jsr     pc,wcrlf                ; force new line
        clrb    octcnt
200$:   clrb    esccnt
        rts     pc
;
; character handler ------------------------------
;   in  r0  current character
;   use r1,r2
;
hdldir: jsr     pc,wchar                ; direct mode
        cmpb    #CR,r0                  ; CR seen
        bne     100$
        jsr     pc,wlf                  ; then add LF
100$:   rts     pc

hdllc:  cmpb    r0,#'A                  ; lower case mode
        blt     hdldir
        cmpb    r0,#'Z
        bgt     hdldir
        add     #<'a-'A>,r0
        br      hdldir

hdluc:  cmpb    r0,#'a                  ; upper case mode
        blt     hdldir
        cmpb    r0,#'z
        bgt     hdldir
        sub     #<'a-'A>,r0
        br      hdldir

hdloct: mov     r0,r2                   ; octal mode
        ash     #-6.,r0
        jsr     pc,woct
        mov     r2,r0
        ash     #-3.,r0
        jsr     pc,woct
        mov     r2,r0
        jsr     pc,woct
        mov     #SPC,r0
        jsr     pc,wchar
        cmpb    #CR,curchr
        beq     10$
        incb    octcnt
        cmpb    octcnt,#16.
        blt     100$
10$:    jsr     pc,wcrlf
        clrb    octcnt
100$:   rts     pc
;
; print octal digit ------------------------------
;   in  r0  current character
;
woct:   bic     #^c7,r0                 ; mask
        add     #'0,r0                  ; bin->ascii
        jmp     wchar                   ; and print
;
; data area ------------------------------------------------
;
pat:    .word   170017
;
curhdl: .word   hdldir
curchr: .byte   0
esccnt: .byte   0
octcnt: .byte   0
        .even
;
nfree:  .word   bsize
wptr:   .word   buf
rptr:   .word   buf
buf:    .blkb   bsize
bufe:

        .end    start
