! file 'btt7s'
!**************
!*  btt7s     *
!*da:24.feb.81*
!**************

%control X'4001'
%externalintegerfnspec map virt %alias "$FMAPVIRT"(%integer id, fromseg,toseg)

%begin

     %recordformat pf(%byteinteger service, reply, %c
        %integer a1, a2, a3)
     %recordformat ttf(%integer kbs, kbd, tts, ttd)
     %recordformat buff(%integer pt, last, (%bytearrayname b %or %c
         %integer arraypt))

     %constrecord (*) %name null == 0


     %constinteger rubout=k'177'
     %constinteger can=24
     %constinteger cr=13
     %constinteger bell=7
     %constinteger esc=k'33'
      %constinteger si=k'17';        ! shift into lower mode (ctrl o)
      %constinteger so=k'16';        ! shift out (ctrl n)
      %constinteger dle=k'20';       ! (ctrl p)
      %constinteger eot = k'04';     ! eof (ctrl d)
      %constinteger dc1=k'21';       ! cancel output (ctrl q)
      %constinteger tab = 9;          ! tab (implemented as 3 spaces)

     %ownrecord (ttf) %name tt == k'137560'
     %owninteger kbint=-2
     %owninteger ttint=-1
     %owninteger ttser=1; ! ???
     %owninteger tt status=0, upper=0, tt idle=0, e pt=0, efpt=0

     %record (pf) p2
     %ownrecord (pf) %name p
     %constinteger no of specs = 6

     %ownbyteintegerarray specs(0:no of specs) =
       rubout, can, esc, cr, si, so, tab

      %constinteger echo off = 10;       ! command to put echo off

     %integer char, i, e last, echofl
     %integer outid, seg, cli flag, cid, cadr

     %ownrecord (buff)  out, inh

      %recordformat hf(%record (hf) %name h, %record (pf) p)
      %recordformat qf(%record (hf) %name h)

      %ownrecord (hf) %array ha(0:15)
      %ownrecord (hf) %name h
      %ownrecord (qf) hi, ho
      %ownrecord (qf) free

      %owninteger first, last, curr
      %ownbyteintegerarray buffer(0:255)

     %ownbyteintegerarray echob(1:40)

     %switch ins(0:no of specs), state(0:7)

     %routinespec drive tt(%integer char)
     %routinespec echo(%integer x)
     %routinespec echo bell
     %routinespec transfer input
     %routinespec output reply
      %routinespec plant(%integer n)

!!     %constbyteintegerarray canm(0:3)= 3, '#', cr, nl
!!     %constbyteintegerarray clim(0:3)= 3, '<', 8, '>'

     %constinteger myseg=4, msa=k'100000'
     %constinteger myiseg=3, misa=k'060000'

     maphwr(5);        ! map regs to seg 5
     linkin(ttser); linkin(kbint); linkin(ttint)
     tt_kbs=k'100'

     %cycle i = 15, -1, 0
        push(free, ha(i))
     %repeat

     %cycle
        %if outid=0 %and %not ho_h == null  %start
         h == pop(ho); push(free, h)
         p == h_p
        %else
           p == p2
           p_service = 0
           poff(p)
        %finish
        %if p_service=kbint&x'ff' %start
           char=tt_kbd&127; ! strip parity bit
           %cycle i=no of specs, -1, 0
              ->ins(i) %if char=specs(i)
           %repeat
           !! normal char
           %if char>='A'+k'40' %and char<='Z'+k'40' %thenc
             char=char-upper;       ! turn to upper
         plant(char)
           %continue

ins(0):                     ! rubout
          %if last#curr %start
               last = (last-1)&255
              echo('\')
           %finish %else echo bell
           %continue
ins(1):    ! cancel
           %if last#curr %start
              last = curr
              echo('#');  echo(cr);  echo(nl);  e last=e pt
           %finish %else echo bell
           %continue

ins(2):         ! escape - go to cli
            cli flag = 1
               last = 0; curr = 0; first = 0
ins2:         echo('<');  echo(13);  echo('>')
           %continue

ins(4):             ! shift in
            upper = 0;  %continue

ins(5):             ! shift out
             upper = 32;  %continue

ins(6):             ! tab
             plant(' '); plant(' '); plant(' '); %continue

ins(3):              ! cr
            echofl = 0;           ! echo turned on at nl
            plant(nl); curr = last
           transfer input
           e last=e pt;       ! allow it to do output now

        %finish %else %if p_service=tt int&x'ff' %start
           ->state(tt status)

do out:
state(5):                       ! going idle
           tt status=0
           %if e pt>0 %then tt status=2 %elsestart
              %if out_last#0 %then tt status=1
           %finish
           ->state(tt status)

state(1):                      ! normal op
           char=out_b(out_pt);  out_pt=out_pt+1
           %if out_pt>=out_last %then tt status=5 %and output reply
           drive tt(char)
state(0):  %continue

state(2):                       ! echo op
           %if efpt<e pt %start
              efpt=efpt+1
              char=echob(efpt)
              %if efpt=e last %then tt status=5 %and e last=-1
              drive tt (char)
           %else
              tt status = 6
              %if efpt=e last %start
                 e last=-1;  e pt=0;  efpt=0
                 ->do out
              %finish
           %finish
           %if efpt=e pt %then e pt=0 %and efpt=0
           %continue

state(3):                     ! normal cr
state(4):                     ! echo cr
state(7):                     ! end of line - newline
           tt status=5
           drive tt(nl+128)
           %continue

state(6):                  ! in echo line
           %cycle; %repeat

        %finish %else %if p_service=tt ser %start; ! user request
           %if p_a1=1 %start;        ! output request
              %if outid#0 %start
                 h == pop(free)
                 %if h == null %start
rej:                p_service= p_reply; p_reply = tt ser
                    p_a1 = 1; pon(p)
                    %continue
                 %finish
                 h_p = p;       ! copy p into safe place
                 push(ho, h);   ! and queue it
                 %continue
              %finish
              outid=p_reply
              seg=p_a2>>13;         ! seg no of buffer
              i = map virt(outid, seg, my seg)
               %continue %if i = 0
              out_arraypt=msa+(p_a2&k'17777')
              out_pt=0;  out_last=p_a3;   ! length
              %if out_last=0 %then output reply %elsestart
                    ->do out %if tt status=0;   ! tt idle
               %finish
           %else
              !! input request

               %if p_a1 = echo off %then echo fl = echo fl+1 %andcontinue

              %if p_a1 # 0 %start
                cid = p_reply;  cadr = p_a2
                %continue %if p_a3 # 0; ! just read from cli
              %finish

              h == pop(free)
              -> rej %if h == null
              h_p = p;         ! copy p into a safe place
              push(hi, h);     ! and q it
               %if p_a1#0 %and first=last %then -> ins2
               %if first#curr %start;   ! non empty line
                  transfer input
              %finish
           %finish
        %finish
     %repeat

     %routine drive tt(%integer char)
        %if char=nl %start
           tt status=tt status+2
           char=cr
        %finish
        tt_ttd=char
        tt_tts=tt_tts!k'100'; ! ints on
     %end

     %routine echo(%integer x)
        %return %if e pt>40 %or echo fl # 0
        e pt=e pt+1;  echob(e pt)=x
        %if tt status=0 %or tt status=6 %start
           tt status=2
           drive tt(x)
           efpt=1
        %finish
     %end


     %routine echo bell
        echo(bell);  e last=e pt
     %end

     %routine plant(%integer char)
        buffer(last) = char
        last = (last+1)&255
        echo(char)
     %end

     %routine transfer input
        %integer seg, i, id, adr, n
retry:
        %if cli flag # 0 %start;  ! preempted by cli
           id = cid;  adr = c adr; cli flag = 0
        %else
           %if hi_h == null %then %return
           h == pop(hi);  push(free, h)
           id = h_p_reply; adr = h_p_a2
        %finish

        %if id#0 %start
           seg=adr>>13
           i = map virt(id, seg, myiseg)
           -> retry %if i = 0;    ! task has gone away/illegal addr
           inh_array pt=misa+(adr&k'17777')
           %cycle i = 0, 1, 80
               n = buffer(first)
               inh_b(i) = n
               first = (first+1)&255
               %exit %if n = nl
           %repeat
           p_service=id;  p_reply=ttser
           p_a1=i+1
           pon(p)
           i =map virt(0, -1, myiseg)
        %finish
     %end

     %routine output reply
        %integer i
        i = map virt(0, -1, myseg)
        p_service=outid;  p_reply=ttser
        p_a1=0
        pon(p)
        outid=0; out_last = 0
     %end

%endofprogram