! QSART Module for Filestore
! (Quadruple Synchronous/Asynchronous Receiver/Transmitter)
! (RS232 board with four Signetics-2651-type chips)

%option "-low-nocheck-nostack-nodiag-noline"
%constinteger firstboard = 16_7FFC0{60|80|A0|C0}, nboards = 1{4|3|2|1}
%constinteger maxboard = nboards-1
%constinteger maxchan = 4*nboards-1

%constintegerarray baudrate(0:15)=
   46,   50,   75,  110,
  135,  150,  300,  600,
 1200, 1800, 2000, 2400,
 4800, 9600,19200,38400
%constinteger -
 baud46    =  0, baud50    =  1, baud75    =  2, baud110   =  3,
 baud135   =  4, baud150   =  5, baud300   =  6, baud600   =  7,
 baud1200  =  8, baud1800  =  9, baud2000  = 10, baud2400  = 11,
 baud4800  = 12, baud9600  = 13, baud19200 = 14, baud38400 = 15

%constinteger sec=1000,min=60*sec,hour=60*min

%constintegerarray timeout(0:maxchan)=hour,min(*)

%constbytearray default(0:maxchan)=-
  baud9600, baud9600, baud4800, baud9600(*)

%constinteger context offset = 256; !"port" numbers >=256
%constinteger xon='Q'-64,xoff='S'-64

%recordformat DEV F(%byte bstatus,data,intvec,dstatus,x,mode,y,command)
! BSTATUS and INTVEC are board registers, X and Y "do not exist",
! DATA, DSTATUS, MODE, COMMAND are registers in the 2651s.

%recordformat BOARD F(%record(devf)%array dev(0:3))

%recordformat INT F(%integer ptr,lim,beg,data,pos,pc,sp,%record(devf)%name dev)
! One of these per interrupt vector.
! PC points to the int handling code.
! SP, if >0, points to the stack of a process waiting for a significant
! interrupt. SP<=0 if the process is not waiting. SP<0 if the interrupt
! happened before the process wanted it.
! For receivers:
! BEG and LIM delimit a fixed-site data buffer.
! PTR is the position at which the interrupt handler will insert the
! next character, POS is that at which the process will extract the next
! character.  DATA=0 if a command is being read.  DATA>0 denotes the
! number of data bytes (in a write block command) that must be read
! before waking up the process.
! For transmitters:
! DATA, POS unused.  BEG and LIM delimit a variable-size buffer to be
! transmitted, PTR scans it, and once it reaches LIM, the process is
! awakened and the transmitter's interrupts area disabled.
! DATA non-zero if x-offed.

%recordformat INTTAB F(%record(intf)%namearray int(0:16*nboards-1))

%recordformat CHAN F(%record(intf)%name rx,tx,%integer buffer,baudcode)
! One of these per client machine.  BUFFER is the (queue of) outgoing buffer(s).

@firstboard %record(boardf)%array board(0:maxboard)

%constinteger mode1=16_4e,mode2=16_30,comm=16_37
! Hardware initialisation values:
! 1 stop bit, no odd parity, 8 bits, async 16*baud clock,
! internal clocks, normal operation, force RTS active,
! reset error, no break, enable rx, force DTR active, enable tx.

%constinteger errormask=16_38
! Dev status: [dsr|dcd|fe|oe|pe|txe/dsrc/dcdc|rxr|txr]

%constinteger txie=1,rxie=2,reset=8
! Board command/status: [inting|0|0|0|reset|txeie|rxrie|txrie]

%constinteger txvec=1,rxvec=5
! Board interrupt vector is (n+m)*4 where n=channel(0:3),
! m=(1:txr,5:rxr,9:txe)

%include "config.inc"
%include "system:common"
%include "system:utility.inc"
%include "system:schedule.inc"
%externalrecord(common fm)%mapspec common area
%include "inc:util.imp"

%ownrecord(inttabf)inttab
%ownrecord(intf)%array ints(0:16*nboards-1)
%ownrecord(chanf)%array channel(0:maxchan)
%ownrecord(common fm)%name common
@16_1008 %integer beh
%owninteger oldbeh
%constinteger no=0
%owninteger online=no

%integerfn bus error
! NB this assumes 68000 layout for exception stack frame
! and hence will go berserk on 68010.
! Code suspected of generating bus errors should be
! bracketed as follows:
! IOF
! %IF BUSERROR#0 %START
!   BEH = OLDBEH; ION
!   <recovery code>
! %FINISH
! <suspect code>
! BEH = OLDBEH; ION
! <rest of code>
%label newbeh
    *lea newbeh,a0
    *move.l a0,beh
    *move.l (sp),-4(a0)
    *mfsr d0
    *move.w d0,-6(a0)
    *move.l a0,beh
    %result = 0
    *=0; *=0; *=0
newbeh:
    *mtsr #16_2700
    *move.l 2(sp),d0
    *lea 8(sp),sp
    *lea newbeh,a0
    *move.w -6(a0),(sp)
    *move.l -4(a0),2(sp)
    *rte
%end

%routine clobber(%record(chanf)%name chan)
%integer i
%record(bufferfm)%name bu
  iof
    chan_rx_pos = chan_rx_ptr
    chan_rx_data = 0
    chan_tx_ptr = 0
    chan_tx_lim = 0
    %cycle
      i = chan_buffer; %exitif i=0
      bu == common_buffer(i)
      chan_buffer = bu_link
      ion
        printstring("Zapping buffer "); write(i,0)
        printstring(" context "); write(bu_context,0)
        printstring(" sync "); write(bu_sync,0); newline
        kick(bu_sync) %unless bu_sync=0
        bu_sync = 0
        releasebuffer(i)
      iof
    %repeat
  ion
%end

%predicate set baud(%integer unit,%integer code)
%record(devf)%name dev
%record(chanf)%name chan
%integer {zero=0,}state=0
  chan == channel(unit); chan_baudcode = code
  dev == board(unit>>2)_dev(unit&3)
  iof
  %if buserror#0 %start
    beh = oldbeh; ion
    pdate
    printstring("*** Qsart "); write(unit,0)
    printstring(" not responding ")
    printsymbol(state+'0'); newline
    chan_baudcode = -1
    ints(unit>>2<<4)_dev == nil
    %false
  %finish
  dev_bstatus = reset;   state = 1
  dev_bstatus = {zero}0; state = 2
  dev_mode = mode1;      state = 3
  dev_mode = mode2+code; state = 4
  dev_command = comm;    state = 5
  dev_bstatus = rxie!txie
  beh = oldbeh; ion
  %true
%end

%externalroutine SET QSART BAUD RATE; !called only from oper console,
%integer n,unit,r,rate,code,dif;      !hence acquires its own params.
%integer unit1,unitn
%integer nearest=baud9600,best=infinity
%record(chanf)%name chan
  %onevent 3,4,9 %start
    printstring("*ouch!"); newline; %return
  %finish
  prompt("Qsarts (N or N:M):")
  read(unit1); unitn = unit1
  skipsymbol %while nextsymbol=' '
  skipsymbol %and read(unitn) %if nextsymbol=':'
  prompt("Baud rate:"); read(rate); r = rate { <0: clobber, <=0: no change
  skipsymbol
  unit = unitn
  %cycle
    chan == channel(unit)
    rate = r
    clobber(chan) %if rate<0
    rate = baudrate(chan_baudcode) %if rate<=0
    %for code = 0,1,15 %cycle
      dif = |baudrate(code)-rate|
      best = dif %and nearest = code %if dif<=best
      %exitif dif=0
    %repeat
    code = nearest
    %unless best=0 %start
      printstring("Using ")
      write(baud rate(code),0); newline
    %finish
    %unless set baud(unit,code) %start; %finish
    unit = unit-1
  %repeatuntil unit<unit1
%end

%externalroutine QSART TICK(%integer now)
! Then scheduler calls this every now and then (once a second).
! For each port, if no activity has occurred during the timeout
! period (5 secs), clobber it unless it is already quasi-clobbered.
%recordformat f(%integer timer,rxp,txp)
%record(f)%name this
%record(chanf)%name c
%ownrecord(f)%array status(0:maxchan)
%owninteger initialised=0
%integer b,d,r,t,i
  %if initialised#0 %start
    %for i = 0,1,maxchan %cycle
      this == status(i)
      c == channel(i)
      this_timer = now %and this_rxp = c_rx_ptr %if c_rx_ptr#this_rxp
      this_timer = now %and this_txp = c_tx_ptr %if c_tx_ptr#this_txp
      %if now-this_timer-timeout(i) >= 0 %start  {nothing happened recently
        b = c_buffer
        d = c_rx_data
        r = c_rx_ptr-c_rx_pos
        t = c_tx_lim-c_tx_ptr
        %if b!d!r!t#0 %start
          pdate; printstring("Qsart "); write(i,0)
          printstring(" timeout")
          r = r+532 %if r<0
          printstring(", rd"); write(r,1)
          printstring(", rg"); write(d,1)
          printstring(", tg"); write(t,1)
          printstring(" and"); write(b,1)
          %if {d!r!t=0 %and} this_timer#0 %start
            printstring(" recovering")
            iof
            c_tx_data = 0
            c_rx_data = 0
            c_rx_pos = c_rx_ptr
            %if buserror=0 %start
              c_tx_dev_bstatus = c_tx_dev_bstatus!txie
              this_timer = 0
              beh = oldbeh; ion
            %else
              beh = oldbeh; ion
              printstring(" *failed*")
            %finish
            newline
          %else
            printstring(" clobbering"); newline
            clobber(c)
          %finish
        %finish
      %finish
    %repeat
  %else   {first time round
    initialised = -1
    %for i = 0,1,maxchan %cycle
      this == status(i)
      c == channel(i)
      this_timer = now
      this_rxp = c_rx_ptr
      this_txp = c_tx_ptr
    %repeat
  %finish
%end

%externalroutine SHOW QSART STATUS
%integer u
%record(chanf)%name chan
%record(intf)%name int
%record(devf)%name dev
%integer b,d,e,x,y
  printstring("QSART status:"); newline
  %for u = 0,1,maxchan %cycle
    b = u>>2; d = u&3
    chan == channel(u)
    dev == board(b)_dev(d)
    write(u,2)
    %if chan_baudcode<0 %start
      printstring(" ignored")
    %else
      iof
      %if buserror#0 %start
        beh = oldbeh; ion
        printstring(" not responding"); newline
        %return
      %finish
      x = dev_bstatus; y = dev_dstatus
      beh = oldbeh; ion
      printstring(" bd:"); phex2(x); phex2(y)
      int == chan_rx
      %if int_data#0 %or int_ptr#int_beg %start
        printstring(" R:")
        phex(int_beg); space; phex(int_pos); space; phex(int_ptr)
        write(int_data,3)
      %finish
      int == chan_tx
      printstring(" T:"); write(int_data,1)
      %if int_lim#0 %start
        space; phex(int_ptr); space; phex(int_lim)
      %finish
      %if chan_buffer#0 %start
        printstring(" b"); write(chan_buffer,1)
        printsymbol('+') %unless chan_buffer=0 %orc
          common_buffer(chan_buffer)_link=0
      %finish
      write(baudrate(chan_baudcode),1)
    %finish
    newline
  %repeat
%end

%externalroutine SEND QSART BUFFER(%integer buffer)
! Called by routine SEND BUFFER in the ETHER module whenever
! the context number is >= context offset.
%record(buffer fm)%name b
%record(dev f)%name dev
%integername x
%integer unit
  b == common_buffer(buffer)
  unit = b_context-context offset
  %unless online#no %and 0<=unit<=maxchan %start
    pdate; printstring("*** Send qsart buffer -- bad unit ")
    write(unit,0); newline; %return
  %finish
  %if common_diags&etherdiags#0 %start
    pdate; printstring("Send buffer "); write(buffer,0)
    printstring(" to Qsart "); write(unit,0)
  %finish
  dev == channel(unit)_tx_dev
  b_link = 0
  iof
  x == channel(unit)_buffer
  x == common_buffer(x)_link %while x#0
  x = buffer
  %if channel(unit)_tx_data#0 %start
    ion
!   printstring("SQ"); newline
    %return
  %finish
  %if buserror=0 %start
    dev_bstatus = dev_bstatus!txie
    beh = oldbeh; ion
  %else
    beh = oldbeh; ion
    pdate; printstring("*** Qsart"); write(unit,1)
    printstring(" kick T fails"); newline
  %finish
%end

%externalroutine START QSART
! This should be called (once only) during system initialisation.
%integer b,d,c; !Board and device number, channel number.

%routine create local process(%integer stack,code)
! Create a new process, which is to run in user mode.  Stack creator's
! context such that it resumes when the createe does his first INTWAIT.
  *add.l #512,d0;       !add an extra half k for A5 area
  *add.l d0,d6;         !Nibble off low end of creator's stack
  *move.l (sp)+,d2;     !Return address
  *mfsr d3;             !and SR
  *move.l d1,a0;        !Code address
  *move.l d0,d1;        !Stack requirement
  *move.w #16_2700,d0;  !Ints off and switch to interrupt stack
  *trap #0
  *move.l d2,-(sp);     !Stack creator's context
  *move.w d3,-(sp)
  *movem.l d0-d7/a0-a6,-(sp)
  *mfusp a1
  *move.l a1,-(sp)
!Now as createe
  *move.l d6,a1;        !Set up stack
  *lea -256(a1),a1
  *lea -512(a1),a5;     !Set up A5 area
  *mtusp a5
  *clr.l (a5);          !No event traps active
  *sub.l d1,d6
  *mtsr #16_500;        !Switch to user mode stack with
                        !interrupts off to start with
  *jmp (a0);            !Call specified routine
%end

%routine intwait(%integername s)
! Preserve partial context of a local process on its own
! stack and record the SP in S.
  s = 0 %andreturnif s<0; !Interrupt already pending
  %unless s=0 %start
    pdate; printstring("*** Intwait fails"); newline; %stop
  %finish
  *movem.l d5-d7/a4-a6,-(sp)
  *move.l sp,(a0)
!Now return from the interrupt which invoked this process
  *move.w #16_2700,d0
  *trap #0
  *move.l (sp)+,a0
  *mtusp a0
  *movem.l (sp)+,d0-d7/a0-a6
  *rte
%end

%routine txproc
! Code for each of the transmit processes
%record(dev f)%name dev
%record(chan f)%name chan
%record(int f)%name int
%record(buffer fm)%name bu
%integer n,unit

  %routine transmit(%integer length,address)
    %returnif length<=0
    int_beg = address
    int_ptr = address
    int_lim = address+length
    %cycle
      %if int_data#0 %start
!       printstring("TD"); newline
      %else
        iof
        %if buserror=0 %start
          dev_bstatus = dev_bstatus!txie
          beh = oldbeh; ion
        %else
          beh = oldbeh; ion
          pdate; printstring("Qsart "); write(unit,0)
          printstring(" Transmit kick fails"); newline
        %finish
      %finish
      intwait(int_sp)
      %exitif int_ptr>=int_lim
      pdate; printstring("*qsart");write(unit,1)
      printstring(" spurious txint"); newline
    %repeat
  %end

  unit = c
  dev == board(b)_dev(d)
  chan == channel(c)
  int == chan_tx
  chan_buffer = 0
  %cycle
    %cycle
      n = chan_buffer; %exitunless n=0
      intwait(int_sp)
    %repeat
    bu == common_buffer(n)
    %unless bu_context=unit+contextoffset %and chan_baudcode>=0 %start
      pdate; printstring("*** Qsart "); write(unit,0)
      printstring(" T: bad context ")
      write(bu_context,0); printstring(" in "); write(n,0); newline
    %else
      %if common_diags&qsartdiags#0 %start
        pdate; printstring("Qsart "); write(unit,0)
        write(bu_sync,1)
        printstring(" T: "); printstring(bu_text)
        newline %if bu_text=""
      %finish
!?!   trace(unit+context offset,trace out,bu_text)
      transmit(length(bu_text),addr(bu_text)+1)
      transmit(bu_bytes,addr(bu_b(0)))
    %finish
    iof
      chan_buffer = bu_link
    ion
    %unless bu_sync=0 %start
      kick(bu_sync)
      bu_sync = 0
    %finish
    release buffer(n)
  %repeat
compiler bug label:
%end

%routine rxproc
! Code for each of the receive processes
%record(dev f)%name dev
%record(chan f)%name chan
%record(int f)%name int,tint
%record(buffer fm)%name bu
%bytearray buf(0:531)
%integer k,n,unit,p1,size
%integername x,pos

  %routine inc; !increment POS, wrapping round as necessary
    pos = pos+1
    pos = int_beg %if pos=int_lim
  %end

  %integerfn h
  ! Read HMDhex number at (POS)+ but not beyond control character
  %integer n=0,k
    %cycle
      k = byteinteger(pos)-'0'; %result = n %if k<' '-'0'
      inc; %result = n %if k<0
      n = n<<4+k
    %repeat
  %end

  %routine bm(%integer bytes,from,%bytename to)
! Bulk Move out of circular buffer
    %returnunless bytes>0
    %if from+bytes>int_lim %start
      bulkmove(int_lim-from,byteinteger(from),to)
      to == to[int_lim-from]
      bytes = bytes-int_lim+from
      from = int_beg
    %finish
    bulkmove(bytes,byteinteger(from),to)
  %end

  unit = c
  dev == board(b)_dev(d)
  chan == channel(c)
  int == chan_rx; tint == chan_tx
  pos == int_pos
  pos = addr(buf(0))
  int_beg = pos; int_ptr = pos; int_lim = pos+532
  %unless set baud(unit,chan_baudcode) %start
    %cycle
      int_data = 9999
      intwait(int_sp)
    %repeat
  %finish
  %cycle {Main Loop}
    int_data = 0
    iof
    %if buserror=0 %start
      dev_bstatus = dev_bstatus!rxie
      beh = oldbeh; ion
    %else
      beh = oldbeh; ion
      pdate; printstring("Qsart"); write(unit,2)
      printstring(" RXIE fails"); newline
    %finish
    intwait(int_sp)
clobbered:
    p1 = pos; k = byteinteger(pos); inc; size = 0
    %if k&\31=0 %start;      !single control character
      %if k='L'-64 %start;   !FF: abort
        %unless common_system open&system open=0 %start
          n = claim buffer
          ->nob %if n<=0
          bu == common_buffer(n)
          bu_context = unit+context offset
          bu_bytes = -1
          bu_text = "Ctrl-L"
          ->enkew
        %finish
      %elseif k=xoff;        !^S
        tint_data = 1
        %if common_diags&qsartdiags#0 %start
          pdate; printstring("^S on"); write(unit,2); newline
        %finish
        trace(unit+contextoffset,tracein,"X-Off")
      %elseif k=xon;         !^Q
        tint_data = 0
        iof
        dev_bstatus = dev_bstatus!txie %if buserror=0
        beh = oldbeh; ion
        %if common_diags&qsartdiags#0 %start
          pdate; printstring("^Q on"); write(unit,2); newline
        %finish
        trace(unit+contextoffset,traceout,"X-On")
      %else
        pdate; printstring("Qsart "); write(unit,0)
        printstring(": ^")
        printsymbol(k+64); newline
      %finish
      %continue
    %finish
    k = k&95
    %if k&64=0 %start
      pdate; printstring("*** Qsart "); write(unit,0)
      printstring(" bad command letter "); phex2(k)
      newline
      k = byteinteger(pos) %and inc %until k<' '
      %continue
    %finish
    %unless 'W'#k#'Y' %start; !data expected
      inc
      size = h; size = h %if k='W'
      inc
      %if size<=0 %or size>512 %start
        pdate; printstring("*** Qsart "); write(unit,0)
        printstring(" Bad data size "); write(size,0); newline
        %continue
      %finish
      iof
        int_data = int_data-512+size
        %if int_data>0 %start
          ion
          %cycle
            intwait(int_sp); %exitif int_data=0
            %if int_data=512 %start
              trace(unit+contextoffset,tracein,"Timeout")
              ->clobbered
            %finish
            pdate; printstring("*qsart"); write(unit,1)
            printstring(" spurious rxint "); write(int_data,0)
            newline
          %repeat
          %continueunless int_data=0
        %finishelsec
      ion
    %else
      k = byteinteger(pos) %and inc %until k<' '
    %finish
    n = claim buffer
    %if n<=0 %start
nob:  pdate; printstring("*** Qsart "); write(unit,0)
      printstring(" No buffer"); write(size,1); newline
      pos = pos+size
      pos = pos+int_beg-int_lim %if pos>=int_lim
      %continue
    %finish
    bu == common_buffer(n)
    bu_context = unit+context offset
    %if common_system open&system open=0 %start
      bu_text = "-6: System not open".snl
      bu_bytes = 0; bu_link = 0
      send qsart buffer(n)
    %else
      k = pos-p1-1; k = k+532 %if k<0
      length(bu_text) = k
      bm(k,p1,charno(bu_text,1))
      bu_bytes = size
      bm(size,pos,bu_b(0))
      %if common_diags&qsartdiags#0 %start
        pdate; printstring("Qsart "); write(unit,0)
        printstring(" R: ")
        printstring(bu_text)
        printsymbol('+') %and write(bu_bytes,0) %unless bu_bytes=0
        newline
      %finish
enkew:bu_link = 0
      trace(bu_context,trace in,bu_text)
      iof
        x == common_proc request queue
        x == common_buffer(x)_link %while x#0
        x = n
      ion
      kick(proc request)
    %finish
    pos = pos+size
    pos = pos-int_lim+int_beg %if pos>=int_lim
  %repeat
compiler bug label:
%end
    
%routine setup interrupt handler
%integer i,j,k
%record(devf)%name dev
%record(intf)%name int
%record(chanf)%name chan
@16_4000c1 %byte vdus
@16_1074 %integer mainvector
%label inttabref,mainvecref,thishandler
%label presigged,txint,rxint,next,vduh
%label yes,no,txon,txoff,presignal,rxnoerr,nowrap

!Initialisation

! First install null handlers for all potential interrupt vectors
  %for i = 0,1,16*nboards-1 %cycle
    int == ints(i); inttab_int(i) == int
    int = 0; int_pc = addr(next)
  %repeat
! Then install TX and RX handlers for appropriate vectors
  %for i = 0,1,maxboard %cycle
    ints(i<<4)_dev == board(i)_dev(0)
    %for j = 0,1,3 %cycle
      chan == channel(4*i+j); chan_buffer = 0; chan_baudcode = default(4*i+j)
      dev == board(i)_dev(j)
      k = 16*i+(j!!3)
      int == ints(k+txvec); int_pc = addr(txint); int_dev == dev; chan_tx == int
      int == ints(k+rxvec); int_pc = addr(rxint); int_dev == dev; chan_rx == int
    %repeat
  %repeat
! Plug interrupt table address into handler code
  *lea inttab,a0
  *lea inttabref,a1
  *move.l a0,2(a1)
! Insert this handler before existing level 5 handler
  *lea mainvecref,a0
  *move.l mainvector,2(a0)
  *lea thishandler,a0
  *move.l a0,mainvector
  %return

! Main interrupt handler

thishandler:
! Preserve full interrupted context (a bit expensive, but ...)
  *movem.l d0-d7/a0-a6,-(sp)
  *mfusp a0
  *move.l a0,-(sp)
presigged:
  *move.l beh,-(sp)
  *jsr buserror;               !*SET AND KEEP THE TRAP*
  *tst.l d0
  *bne vduh;                   !Bus error ->
next:
  *moveq #maxboard,d0;         !Find next interrupting board
inttabref:
  *move.l #1234567,a1;         !Address of interrupt table
loop:
  *tst.b vdus;                 !Give VDU priority
  *bmi vduh
  *move.l (a1),a0;             !address of interrupt record 0 of this board
  *move.l 28(a0),d1;           !addr of board_dev(0)
  *beq no;                     !board disabled ->
  *move.l d1,a0
  *tst.b (a0);                 !Inspect board_dev(0)_bstatus
  *bmi yes;                    !This board is interrupting ->
no:
  *lea 64(a1),a1;              !@Next*16 int record
  *dbra d0,loop
vduh:
  *move.l (sp)+,beh;           !*REMOVE TRAP*
  *move.l (sp)+,a0;            !No interrupting board found
  *mtusp a0
  *movem.l (sp)+,d0-d7/a0-a6;  !Restore interrupted context
mainvecref:
  *jmp 16_1234567;             !Dive into next int handler
yes:
  *move.b 2(a0),d0;            !Read board_dev(0)_intvec
*ror.b #2,d0
*ble next;                   !vector too small ->
*cmp.b #8,d0
*bgt next;                   !vector too big ->
*rol.b #2,d0
  *move.l 0(a1,d0),a1;         !A1 -> appropriate INT record
  *move.l 28(a1),a0;           !A0 -> INT_DEV
  *move.l 20(a1),-(sp);        !Jump to (INT_PC)
  *rts

! Transmitter handler

txint:
  *btst #0,3(a0);      !False alarm?
  *beq next;           !No ->
  *move.l (a1),a2;     !int_ptr
  *cmp.l 4(a1),a2;     !>=int_lim?
  {bhs}*bcc txoff;     !Yes ->
  *move.b (a2)+,1(a0); !send character
  *move.l a2,(a1);     !update int_ptr
  *bra next
txoff:
  *and.b #\txie,(a0);  !disable int

! Common TX/RX signalling code

rxsig:
  *move.l (sp)+,beh;   !*REMOVE TRAP*
  *move.l 24(a1),d0;   !int_sp
  *ble presignal;      !no process waiting - >
  *clr.l 24(a1)
  *move.l d0,a0
  *mtusp a0
  *mtsr #16_400 {(frig) should be *atsr #16_dfff}
  *movem.l (sp)+,d5-d7/a4-a6
  *rts
presignal:
  *moveq #-1,d0
  *move.l d0,24(a1)
  *bra presigged

! Receiver handler

rxint:
  *move.b 3(a0),d1;    !Inspect dev_dstatus
  *moveq #errormask,d0
  *and.b d1,d0;        !Parity (or other) error?
  *beq rxnoerr;        !Yes ->
  *move.b #comm,7(a0); !Clear error
  *or.b d1,20(a1);     !record error somewhere
rxnoerr:
  *btst #1,d1;         !False alarm?
  *beq next;           !Yes ->
  *move.b 1(a0),d0;    !Read dev_data
  *move.l (a1),a2;     !int_ptr
  *move.b d0,(a2)+;    !Insert character
  *move.l a2,(a1);     !update int_ptr
  *cmp.l 4(a1),a2;     !buffer limit reached?
  *bne nowrap
  *move.l 8(a1),(a1)
nowrap:
  *subq.l #1,12(a1);   !adjust quota
  *bgt next;           !not expired ->
  *beq rxsig;          !just expired ->
  *clr.l 12(a1);       !(was zero): command mode
  *and.b #127,d0;      !remove parity bit (in command part only)
  *move.b d0,-1(a2)
  *and.b #\31,d0;      !control char?
  *bne next;           !no ->
  *cmp.b #xoff,-1(a2); !^S?
  *beq txoff
  *cmp.b #xon,-1(a2);  !^Q?
  *beq txon
  *cmp.b #nl,-1(a2);   !newline?
  *bne rxsig;          !no (no data quota) ->
  *move.l #512,12(a1); !set data quota to 512 bytes initially
  *bra rxsig
txon: *or.b #txie,(a0)
  *bra rxsig
%end

%label txinit,rxinit

! Main code of SETUP QSART

  oldbeh = beh
  common == common area
  pdate
  printstring("QSART starting"); newline
  setup interrupt handler
  %for b = 0,1,maxboard %cycle
    %for d = 0,1,3 %cycle
      c = 4*b+d
      create local process(3000,addr(txinit))
      create local process(4000,addr(rxinit))
    %repeat
  %repeat
  online = \no {i.e. yes}
  %return
txinit: txproc; *stop #0
rxinit: rxproc; *stop #0

%end

%endoffile