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

%constinteger firstboard = 16_7FFC0, nboards = 1
%constinteger maxboard = nboards-1
%constinteger maxchan = 4*nboards-1

%constinteger qsartdiags = 64
%constinteger context offset = 256; !"port" numbers >=256

%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,pc,sp,%record(devf)%name dev)
! One of these per interrupt vector.  PC points to the int handling code.
! SP points to the stack of a process waiting for a significant interrupt.
! PTR and LIM delimit a data buffer along which PTR moves.  DATA (in the
! receiver case) marks the boundary between the command part and the data
! part of an incoming packet.

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

%recordformat CHAN F(%record(intf)%name rx,tx,%integer buffer)
! 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,defaultbaud=13
! 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 where n=channel(0:3),
! m=(1:txr,5:rxr,9:txe)

%endoflist
%include "config.inc"
%include "common"
%include "utility.inc"
%include "schedule.inc"
%externalrecord(common fm)%mapspec common area
%include "i:util.inc"
%list

%ownrecord(inttabf)inttab
%ownrecord(intf)%array ints(0:16*nboards-1)
%ownrecord(chanf)%array channel(0:maxchan)
%ownrecord(common fm)%name common
%ownbytearray baudrate(0:maxchan) = default baud(*)
%constinteger no=0
%owninteger online=no

%routine set baud(%record(devf)%name dev,%integer code)
  code = code&15
  dev_bstatus = reset
  dev_bstatus = 0
  dev_mode = mode1
  dev_mode = mode2+code
  dev_command = comm
  dev_bstatus = rxie
%end

%externalroutine SET QSART BAUD RATE; !called only from oper console,
%integer unit,rate;                   !hence acquires its own params.
%record(devf)%name dev
  prompt("Qsart:"); read(unit)
  prompt("Baud code:"); read(rate)
  baud rate(unit) = rate
  set baud(board(unit>>2)_dev(unit&3),rate)
%end

%externalroutine SHOW QSART STATUS
%record(devf)%name dev
%record(chanf)%name chan
%record(intf)%name int
%integer i,j
  pdate
  %if online=no %start
    printstring("QSART off-line"); newline; %return
  %finish
  printstring("QSART status:"); newline
  %for i = 0,1,maxboard %cycle
    %for j = 0,1,3 %cycle
      spaces(7); printsymbol(i+'0'); printsymbol('_'); printsymbol(j+'0')
      dev == board(i)_dev(j)
      chan == channel(i*4+j)
      printstring(": bd"); phex2(dev_bstatus); phex2(dev_dstatus)
      printstring(" R: "); int == chan_rx
      phex(int_beg); space; phex(int_data); space; phex(int_ptr)
      printstring(" T: "); int == chan_tx
      phex(int_ptr); space; phex(int_lim); space; phex(int_sp)
      printstring(" b"); write(chan_buffer,1)
      printsymbol('+') %unless chan_buffer=0 %orc
        common_buffer(chan_buffer)_link=0
      newline
    %repeat
  %repeat
%end

%predicate all is well
!Called by initialisation code in order to decide whether or not to proceed.
!Bus error (caused by absence of device) generates event 0.
%byte status
  %onevent 0 %start
    printstring("not available"); newline
    %false
  %finish
  pdate; printstring("QSART ")
  status = board(0)_dev(0)_bstatus
  printstring("starting up"); newline
  %true
%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 context
  b == common_buffer(buffer)
  context = b_context-context offset
  %unless online#no %and 0<=context<=maxchan %start
    pdate; printstring("*** Send qsart buffer -- bad context ")
    write(context+context offset,0); newline; %return
  %finish
  %if common_diags&etherdiags#0 %start
    pdate; printstring("Send buffer "); write(buffer,0)
    printstring(" to Qsart "); write(context,0)
  %finish
  x == channel(context)_buffer
  dev == channel(context)_tx_dev
  %if x#0 %start; !Channel busy: enqueue packet
    x == common_buffer(x)_link %while x#0
    x = buffer
    b_link = 0
    %if common_diags&etherdiags#0 %start
      printstring(" - queued"); newline
    %finish
    %return
  %finish
  x = buffer
  %if common_diags&etherdiags#0 %start
    printstring(" - kicking"); newline
  %finish
  dev_bstatus = dev_bstatus!txie; !Kick tx process
%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 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
  *mtusp a1
  *sub.l d1,d6
  *mtsr #0;             !Switch to user mode stack
  *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,context

  %routine transmit(%integer length,address)
    int_beg = address
    int_ptr = address
    int_lim = address+length
    dev_bstatus = dev_bstatus!txie
    intwait(int_sp)
  %end

  context = c+context offset
  dev == board(b)_dev(d)
  chan == channel(c)
  int == chan_tx
  %unless int_dev==dev %start
    pdate; printstring("*** Qsart "); write(b,0); printsymbol('_')
    write(c,0); write(context,1); newline
  %finish
  chan_buffer = 0
  %cycle
    %cycle
      n = chan_buffer; %exitunless n=0
      %if common_diags&etherdiags#0 %start
        pdate; printstring("QsartT "); write(context-contextoffset,0)
        printstring(" waiting"); newline
      %finish
      intwait(int_sp)
    %repeat
    bu == common_buffer(n)
    %unless bu_context=context %start
      pdate; printstring("*** QsartT: bad context ")
      write(bu_context,0); newline
    %else
      %if common_diags&qsartdiags#0 %start
        pdate; printstring("Qsart "); write(context-contextoffset,0)
        printstring(" T: "); printstring(bu_text)
        newline %unless charno(bu_text,length(bu_text))=nl
      %finish
      transmit(length(bu_text),addr(bu_text)+1)
      transmit(bu_bytes,addr(bu_b(0))) %if bu_bytes>0
    %finish
    kick(bu_sync) %unless bu_sync=0
    bu_sync = 0
    chan_buffer = bu_link
    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
%record(buffer fm)%name bu
%bytearray buf(0:531)
%bytename command letter
%integer n,context,pos,size
%integername x

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

  context = c+context offset
  dev == board(b)_dev(d)
  chan == channel(c)
  int == chan_rx
  %unless int_dev==dev %start
    pdate; printstring("*** Qsart "); write(b,0); printsymbol('_')
    write(c,0); write(context,1); newline
  %finish
  %cycle  {Come back here when resetting after trouble}
    int_beg = addr(buf(0)); int_ptr = int_beg
    int_lim = int_beg+532; int_data = 0
    set baud(dev,baudrate(context-contextoffset))
    command letter == buf(0)
    %cycle {Main Loop}
      int_ptr = int_beg
      int_lim = int_beg+532
      int_data = 0
      %if common_diags&etherdiags#0 %start
        pdate; printstring("QsartR "); write(context-contextoffset,0)
        printstring(" waiting"); newline
      %finish
      dev_bstatus = dev_bstatus!rxie
      intwait(int_sp)
      size = int_data-int_beg
      %if byteinteger(int_data-1)#nl %start
        pdate; printstring("Qsart "); write(context-contextoffset,0)
        printstring(" bad line terminator "); phex2(byteinteger(int_data-1))
        newline
      %finish
      commandletter = commandletter&\32
      %if commandletter&64=0 %or size<3 %start
        pdate; printstring("*** Qsart "); write(context-contextoffset,0)
        %if commandletter&64=0 %start
          printstring(" bad command letter "); phex2(commandletter)
        %finish
        %if size<3 %start
          printstring(" short command "); phex2(size)
        %finish
        newline
        %exit
      %finish
      %if common_diags&qsartdiags#0 %start
        pdate; printstring("Qsart "); write(context-contextoffset,0)
        printstring(" R: ")
        pos = int_beg
        %while size>1 %cycle
          size = size-1; printsymbol(byteinteger(pos)); pos = pos+1
        %repeat
        newline
      %finish
      size = 0
      %unless 'W'#commandletter&95#'Y' %start
        pos = int_beg+2
        size = h; size = h %if commandletter&95='W'
        %if size<=0 %or size>512 %or int_data-int_beg>20 %start
          pdate; printstring("*** Qsart "); write(context-contextoffset,0)
          printstring(" Bad data size "); write(size,0); newline
          %exit
        %finish
        int_lim = int_data+size
        intwait(int_sp) %unless int_ptr>=int_lim
      %finish
      n = claim buffer
      bu == common_buffer(n)
      bu_context = context
      length(bu_text) = int_data-int_beg-1
      bulk move(int_data-int_beg-1,command letter,charno(bu_text,1))
      bu_bytes = size
      bulk move(size,byteinteger(int_data),bu_b(0)) %if size>0
      bu_link = 0
      x == common_proc request queue
      x == common_buffer(x)_link %while x#0
      x = n
      kick(proc request)
    %repeat
  %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_1074 %integer mainvector
%label inttabref,mainvecref,thishandler
%label badint,txint,rxint
%label yes,txoff,rxoff,presignal,rxerr

!Initialisation

  %for i = 0,1,16*nboards-1 %cycle
    int == ints(i); inttab_int(i) == int
    int = 0; int_pc = addr(badint)
  %repeat
  %for i = 0,1,maxboard %cycle
    %for j = 0,1,3 %cycle
      chan == channel(4*i+j); chan_buffer = 0
      dev == board(i)_dev(j)
      dev_bstatus = reset
      k = 16*i+(j!!3)+txvec
      int == ints(k); int_pc = addr(txint); int_dev == dev; chan_tx == int
      k = k-txvec+rxvec
      int == ints(k); 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:
  *movem.l d0-d7/a0-a6,-(sp);  !Preserve full interrupted context
  *mfusp a0
  *move.l a0,-(sp)
badint:
next:
  *moveq #maxboard,d0;         !Find next interrupting board
  *lea board,a0
inttabref:
  *move.l #1234567,a1;         !Address of interrupt table
loop:
  *tst.b (a0);                 !Inspect board_dev(0)_bstatus
  *bmi yes;                    !This board is interrupting ->
  *lea 32(a0),a0;              !Next board
  *lea 64(a1),a1;              !Next*16 int record
  *dbra d0,loop
  *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
  *move.l 0(a1,d0),a1;         !A1 -> appropriate INT record
  *move.l 24(a1),a0;           !A0 -> INT_DEV
  *move.l 16(a1),-(sp);        !Jump to (INT_PC)
  *rts

! Transmitter handler

txint:
  *btst #0,3(a0);      !False alarm?
  *beq next;           !Yes ->
  *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 20(a1),d0;   !int_sp
  *bmi next;           !already pre-signalled ->
  *beq presignal;      !no process waiting - >
  *clr.l 20(a1)
  *move.l d0,a0
  *mtusp a0
  *mtsr #0
  *movem.l (sp)+,d5-d7/a4-a6
  *rts
presignal:
  *moveq #-1,d0
  *move.l d0,20(a1)
  *bra next

! Receiver handler

rxint:
  *move.b 3(a0),d1;    !Inspect dev_dstatus
  *moveq #errormask,d0
  *and.b d1,d0;        !Parity (or other) error?
  *bne rxerr;          !Yes ->
  *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;     !limit reached?
  {bhs}*bcc rxoff;     !yes ->
  *tst.l 12(a1);       !control char expected (int_data=0) ?
  *bne next;           !no ->
{}*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 ->
  *move.l a2,12(a1);   !set int_data = int_ptr (note eol position)
  *move.l 8(a1),a2;    !inspect command letter
  *moveq #95,d0
  *and.b (a2),d0
  *cmp.b #'W',d0
  *beq rxsig;          !writeda ->
  *cmp.b #'Y',d0
  *beq rxsig;          !writesq ->
rxoff:
  *and.b #\rxie,(a0);  !disable further interrupts
  *bra rxsig
rxerr:
  *move.b #comm,7(a0); !clear error
  *bra next
%end

%label txinit,rxinit

! Main code of SETUP QSART

  common == common area
  %if all is well %start
    setup interrupt handler
    %for b = 0,1,maxboard %cycle
      %for d = 0,1,3 %cycle
        c = 4*b+d
        create local process(1000,addr(txinit))
        create local process(2000,addr(rxinit))
      %repeat
    %repeat
    online = \no {i.e. yes}
  %finish
  %return
txinit: txproc; *stop #0
rxinit: rxproc; *stop #0
%end

%endoffile