! Simple (non-interrupt) access procedures for the QSART
! (Quadruple Synchronous/Asynchronous Receiver/Transmitter)
! (RS232 board with four Signetics-2651-like chips)
! RWT 17/06/86

%option "-low-nons"

%recordformat DEV F(%byte bstatus,data,intvec,dstatus,*,mode,*,command)
! BSTATUS and INTVEC are board registers,
! DATA, DSTATUS, MODE, COMMAND are chip registers.

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

@16_7ff60 %record(boardf)%array board(0:3) {NB standard board is (3) @7ffc0}
%ownrecord(devf)%name dev == nil
%externalinteger qsarts present = 0

%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 default baudrate = 9600
%constintegerarray baud(0:15)=
   46,   50,   75,  110,
  135,  150,  300,  600,
 1200, 1800, 2000, 2400,
 4800, 9600,19200,38400

%integerfn baudcode(%integer baudrate)
%integer mindif = 0, best, dif, i
  baudrate = default baudrate %if baudrate<=0
  %for i = 0,1,15 %cycle
    dif = |baud(i)-baudrate|
    mindif = dif %and best = i %if dif<mindif %or mindif=0
  %repeat
  %result = best
%end

%predicate set baud(%record(devf)%name d,%integer code)
%integer zero=0
  %onevent 0 %start
    %false %if event_sub=2; %signal 0,event_sub,event_extra,event_message
  %finish
  d_bstatus = reset
  d_bstatus = zero
  d_mode = mode1
  d_mode = mode2+code
  d_command = comm
  d_bstatus = zero
  dev == d
  %true
%end

%routine abandon(%integer n)
  %signal 3,3,n,"QSART select error"
%end

%externalroutine qsart select(%integer n)
  abandon(n) %unless setbaud(board(n>>2&3)_dev(n&3),0)
%end

%externalroutine qsart baud rate(%integer b)
  abandon(-1) %unless setbaud(dev,b)
%end

%externalroutine qsart setup
%integer i=15,j=1<<15
  qsarts present = 0
  %cycle
    qsarts present = qsarts present ! j %if setbaud(board(i>>2)_dev(i&3),0)
    i = i-1; j = j>>1
  %repeatuntil j=0
%end

%externalpredicate qsart t ready
  %trueif dev_dstatus&1#0; %false
%end

%externalpredicate qsart t empty
%integer s1,s2
  s1 = dev_dstatus; %falseif s1&4=0
  s2 = s1 %and s1 = dev_dstatus %until (s1!!s2)&16_c0=0
  %trueif s2&4#0; %false
%end
  
%externalpredicate qsart r ready
%integer s = dev_dstatus
  dev_command = comm %if s&errormask#0
  %trueif s&2#0; %false
%end

%externalintegerfn qsart readsymbol
  %cycle
    %result = dev_data %if qsart r ready
  %repeat
%end

%externalroutine qsart printsymbol(%integer k)
  %cycle
    dev_data = k %andreturnif qsart t ready
  %repeat
%end

%externalroutine qsart printstring(%string(255)s)
%integer i
  qsart printsymbol(charno(s,i)) %for i = 1,1,length(s)
%end