! 2MHz ether process for Mouse. 
! AJS Mar 1987
!
%Option "-low-nocheck-nodiag-noline-nostack"
%Include ":l:Moose:mouse.inc"

%Constinteger min = 0, max = 532, min0 = 6, max0 = 538
%Constinteger dtx=16_30, stx=16_20, rdy=16_10, nak=16_50, etx=16_0B,
              opn=16_80, cls=16_90, ack=16_C0, esa=16_05, ssa=16_07, err=16_A0

%Constinteger ion  = 2_110
%Constinteger ioff = 2_0

%constinteger port free    = 1,
              port owned   = 2
%Constinteger port closed  = 1,
              port opening = 2,
              port open    = 3,
              port closing = 4
%constinteger await RDY    = 1,
              await ACK    = 2,
              await DTX    = 1,
              await ETX    = 2,
              await NAK    = 3,
              pending DTX  = 1

%constinteger  Undefined Error   =  0,
               Success           =  1,
               Bad Function Code =  2,
               Bad Port Number   =  3,
               Port not owned    =  4,
               No Free Port      =  5,
               Port already owned=  6,
               Packet was NAKed  =  7,
               Port was closed   =  8,
               Port was open     =  9,
               Bad Transmit length=10,
               Abort             = 11

%Constinteger Max Ctrl = 128  {Size of ether event pool from station}
%Constinteger Max Port = 31   {Last Port in station}

! Format of request packet from client process
%Recordformat reqfm (%Record(messagefm) msg,
                     %Integer tag,
                     (%Byte code %or %byte result),
                     %Byte port,
                     (%Byte rdte %or %Byte port0mode),
                     (%Byte rsap %or %Byte channel),
                     %bytename buffer,
                     (%Integer length %OrInteger maxbytes %orinteger resbytes))

! Format of ether event pool. 
%Recordformat Ctrlfm (%Integer bs, be, in, out, 
                      %Record(semaphorefm)%name sem,
                      %Bytearray port,type(0:maxctrl-1))

! Port record
! OPEN  = port closed, port opening, port open, port closing
! TMODE = 0, await RDY, await ACK
! RMODE = 0, pending DTX, await DTX, await ETX
! OWNED = port free, port owned
%Recordformat PortFm (%Byte open,tmode,rmode,lsap,owned,rdte,rsap,h,
                      %Record(queuefm) tpend,rpend,
                      %Record(reqfm)%name tcurr,rcurr,mgmt,
                      %Integer inbuff,maxbytes,resbytes)

! Ether Station registers
@16_7fffc %writeonly %volatile %Byteinteger Eths, Ethd, Ethz, Ethc

%Ownrecord(mailboxfm)            mbox
%Ownrecord(semaphorefm)          eevent
%Ownrecord(interrupthandlerfm)   ih
%Ownrecord(Portfm)%array         Port (0:MaxPort) = 0(*)
%Ownrecord(Ctrlfm)               Ctrl = 0
%Ownbyte                         LDTE=0

%systemstring(127)%fnspec itos(%integer v,p)
%routine phex1(%integer x)
  x = x&15; x = x+7 %if x>9; putsym(x+'0')
%end

%routine phex2(%integer x)
  phex1(x>>4); phex1(x)
%end

%Routine Wed (%Integer x)
   %Cycle; %Repeatuntil eths&8#0; ethd=x
%End

%Routine Wec (%Integer x)
   %Cycle; %Repeatuntil eths&8#0; ethc=x
%End

%Routine Setup Interrupts
   @0(a0)%Record(portfm) p
   %label int, ethctrl, ethi0, notstx, sendctrl, nw, ethnps, ethi1, done
   %label er3,er35,er4,er5

   ctrl_sem == eevent
   ctrl_bs  = addr(ctrl_port(0))
   ctrl_be  = addr(ctrl_port(MaxCtrl-1))+1
   ctrl_in  = ctrl_bs
   ctrl_out = ctrl_bs

   setup interrupt handler (ih, addr(int))
   Add Interrupt Handler (ih,4)

   eths = ion
   %Return
 
int:
   *move.b  eths,d0
   *bpl     done
   *and.w   #2,d0
   *bne     ethctrl

   *move.b  ethd,d0  {Must be Data => ignore}
   *bra     done

ethctrl:             {Control Msg}
   *move.b  ethc,d1
   *move.b  #16_F0,d0
   *and.b   d1,d0
   *beq     ethnps

! Port Specific Code
ethi0:
   *btst.b  #0,eths
   *beq     ethi0
   *moveq  #31,d1
   *and.b   ethd,d1    {D0 = control code, D1 = port}

   *cmp.b   #stx,d0
   *bne     notstx
   eths = ioff
{   putsym('[')
   *movem.l  d1-d2/a1-a3,-(sp)
   a0 = addr(port(d1))
   *move.l  a0,-(sp)
   d1 = p_maxbytes
   a0 = p_inbuff
   *lea     eths, a2
   *lea     ethd, a3
   *moveq   #-1,d0
er3:
   *subq    #1,d1
   *bmi     er4
er35:
   *move.b  (a2),d2
   *btst    #0,d2
   *beq     er35
   *move.b  (a2),d2
   *addq.l  #1,d0
   *btst    #1,d2
   *bne     er5
   *move.b  (a3),(a0)+
   *bra     er3
er4:                    ;! Now discard rest
   *move.b  (a2),d2
   *btst    #0,d2
   *beq     er4
   *move.b  (a2),d2
   *addq.l  #1,d0
   *btst    #1,d2
   *bne     er5
   *move.b  (a3),d2
   *bra     er4
er5:
   *move.l  (sp)+,a0
   *movem.l (sp)+,d1-d2/a1-a3
   p_resbytes = d0
   {putsym(']')
   eths = ion
   *move.b  #etx,d0
   *bra     sendctrl

notstx:
   *cmp.b   #rdy,d0
   *beq     sendctrl
   *cmp.b   #dtx,d0
   *beq     sendctrl
   *cmp.b   #ack,d0
   *beq     sendctrl
   *cmp.b   #nak,d0
   *beq     sendctrl
   *cmp.b   #err,d0
   *bne     done
sendctrl:
{   *move.l   d0,-(sp)
{   *move.l   d0,-(sp)
{   Putsym('%')
{   *move.l  (sp)+, d0
{   putlong(d0);putsym(' ');putlong(d1);putsym(nl)
{   *move.l  (sp)+, d0
   *move.l  ctrl_in, a0
   *move.b  d1,(a0)
   *move.b  d0,maxctrl(a0)
   *addq    #1,a0
   *cmp.l   ctrl_be,a0
   *bne     nw
   *move.l  ctrl_bs,a0
nw:
   *cmp.l   ctrl_out,a0
   *beq     done           {Reject it - no space}
   *move.l  a0,ctrl_in
   int signal semaphore (ctrl_sem)
   *bra     done

! Non Port Specific code  -  D1 = code
ethnps:
   *cmp.b   #ssa,d1
   *bne     done     {Ignore if not SSA}

ethi1:               {Read LDTE from station}
   *btst.b  #0,eths
   *beq     ethi1
   *moveq   #0,d1
   *move.b  ethd,d1
   *move.b  d1,ldte
   *bra     done
   
done:
   return from interrupt
   *move.l d0,d0    {Disuade Hamish}
%End

%Routine Reply to Client (%Record(reqfm)%name r)
   Send Message (r,r_msg_reply,nil)
%End

%Predicate Check Port Number (%Record(reqfm)%name r)
   %Trueif 0 <= r_port <= max port
   r_result = bad port number
   Reply to Client (r)
   %false
%End

%Predicate Check Port Owned (%Record(reqfm)%name r)
   %Trueif port(r_port)_owned = port owned
   r_result = port not owned
   Reply to Client (r)
   %False
%End

%Predicate Check Port Status (%Record(reqfm)%name r, %integer expect)
! fail and %False if expect # port status

   %Routine Do Fail (%Integer fail)
      r_result = fail
      Reply to Client (r)
   %End      

   %if port(r_port)_open = port open %start
      do fail (port was open) %andfalseif expect = port closed
   %Else            
      do fail (port was closed) %andfalseif expect = port open
   %Finish
   %True
%End

%Routine Bounce Queue (%record(queuefm)%name q)
   %Record(reqfm)%name r
   r == dequeue (q)
   %while r ## NIL %cycle
      r_result = abort
      Reply To Client (r)
      r == dequeue (q)
   %Repeat
%End

%Routine Claim Port (%Record(reqfm)%Name r, %Integer state)
   %Integer i

   %Routine Allocate (%Integer p)
      %If Port(p)_owned = port free %Start
         Port(p)_owned = port owned
         r_result = success
         r_port = p
      %Else
         r_result = port already owned
      %Finish
      Reply To Client (r)
   %End

   %if r_port = 255 %start
      %For i = 1, 1, Max Port %Cycle
         %If Port(i)_owned = port free %Start
            Allocate (i)
            %Return
         %Finish
      %Repeat
      r_result = no free port
      Reply to Client (r)
   %Else
      %returnunless check port number(r) 
      Allocate (r_port)
   %Finish
%End

%Routine Free Port (%Record(reqfm)%Name r, %Integer state)
   %Integer p

   %Returnunless check port number (r)
   %Returnunless check port owned  (r)
   %unless r_port = 0 %start
      %Returnunless check port status (r,port closed)
   %finish

   port(r_port)_Owned = port free
   r_result = success
   Reply to Client (r)
%End

%Routine Open Port (%Record(reqfm)%name r, %Integer state)
   %Record(portfm)%name p
   %switch sw(0:1)

   p == port(r_port)
   -> sw(state)

sw(0):   ;! User Request In
   %if r_port = 0 %start      ;! Null Operation
      r_result = success
      Reply to Client (r)
      %Return
   %Finish
   %Returnunless check port number (r)
   %Returnunless check port owned (r)
   %Returnunless check port status (r,port closed)

{ Putstring("Opening ");phex2(p_lsap);putstring(" to ");phex2(r_rdte)
{ putsym(' ');phex2(r_rsaP);putsym(nl)
   wec(opn); wed(p_lsap)
   p_mgmt == r
   p_open = port opening
   %Return

sw(await RDY):   ;! RDY received
   wec(stx)
   wed(p_lsap); wed(r_rdte); wed(r_rsap)
   wec(etx)
{   Putstring("Port ");phex2(p_lsap);putstring(" to ");phex2(r_rdte);
{   putsym(' ');phex2(r_rsap);putsym(nl)
   p_tcurr == NIL; p_rcurr == NIL; p_mgmt == NIL
   p_tmode = 0; p_rmode = 0
   setup queue (p_tpend)
   setup queue (p_rpend)
   p_open = port open
   p_rdte = r_rdte; p_rsap = r_rsap
   r_result = success
{   putstring("Port opened, ")
   Reply to Client (r)
{ putstring("Client informed");putsym(nl)
%End

%Routine Close Port (%Record(reqfm)%name r, %integer state)
   %Record(portfm)%Name p
   %switch sw(0:2)

   p == port(r_port)
   -> sw(state)

sw(0):   ;! User request in
{ Putstring("Close port ");phex2(p_lsap);putsym(nl)
   %returnunless check port number (r)
   %Returnunless check port status (r,port open)

   p_mgmt == r
   p_open = port closing
   Bounce queue (p_tpend); { Putstring("Bounce transmit, ")
   Bounce queue (p_rpend); { Putstring("Bounce receive");putsym(nl)
   %Returnif p_rmode = await ETX

sw(await ETX):  ;! the STX arrived or wasn't awaited

   %unless p_rcurr == NIL %start
      { Putstring("Bounce active receive, ")
      p_rcurr_result = abort
      Reply To Client (p_rcurr)
      p_rcurr == NIL
   %finish
   p_rmode = 0
   %Returnif p_tmode = await RDY

sw(await RDY):

   %unless p_tcurr == NIL %start
      { Putstring("Bounce active transmit");putsym(nl)
      p_tcurr_result = abort
      Reply To Client (p_tcurr)
      p_tcurr == NIL
   %finish
   p_tmode = 0 %unless p_tmode = await ACK
{   putstring("Close to station");putsym(nl)
   wec (cls); wed(p_lsap)
   r_result = success
{Putstring("Sending reply,")
   Reply to Client (r)
{PUtstring("send...");putsym(nl)
   %if p_lsap = 0 %start
      p_open = port open   ;! Reopenif 0
   %Else
      p_open = port closed
   %finish

%End

%predicate check transmit length (%Record(reqfm)%name r,
                                  %integer min,max)
   %trueif min <= r_length <= max
   r_result = bad transmit length
   Reply to client (r)
   %false
%End

%Routine Transmit Block (%Record(reqfm)%name r, %integer state)
   %Record(reqfm)%name nr
   %Record(portfm)%name p
   %switch sw(0:3)
   %label ew2,ew3

   p == port(r_port)
   -> sw(state)

sw(0):   ;! User request in
   %returnunless check port number (r)
   %Returnunless check port status (r,port open)
!   %if p_lsap = 0 %start
!      %returnunless check transmit length (r,min0,max0)
!   %Else
!      %Returnunless check transmit length (r,min,max)
!   %Finish
      
   %if p_tcurr ## NIL %start
      enqueue (r,p_tpend)
      %Return
   %Finish
   p_tcurr == r
{Putstring("Send DTX")
   wec(DTX); wed (p_lsap)
   p_tmode = await RDY
   %Return

sw(await RDY):  ;! Get here when RDY arrives
{Putstring("Send STX")
   wec (STX); wed (p_lsap)

   -> ew3 %if r_length <= 0

   d1 = r_length
   a0 = addr(r_buffer)
ew2:
   *btst    #3,eths
   *beq     ew2
   *move.b  (a0)+, ethd
   *subq    #1,d1
   *bgt     ew2
ew3:
   wec(etx)
   p_tmode = await ACK
   %Return

sw(await ACK): ;! Get here if ACK arrives
   r_result = success
   -> next

sw(await NAK): ;! Come here if NAK arrived
   r_result = packet was naked
   -> next

next:
   Reply to Client (r)
   p_tcurr == NIL; p_tmode = 0
   nr == dequeue(p_tpend)
   transmit block (nr,0) %unless nr == NIL
%End

%Routine Receive Block (%Record(reqfm)%Name r, %integer state)
   %Record(reqfm)%name nr
   %Record(portfm)%name p
   %switch sw(0:2)

   p == port(r_port)
   -> sw(state)

sw(0): ;! User request in
   %returnunless check port number (r)
   %Returnunless check port status (r,port open)
   
   %if p_rcurr ## NIL %Start
      enqueue (r,p_rpend)
      %Return
   %Finish
   p_rcurr == r
   %if p_rmode # pending DTX %start
      p_rmode = await DTX
      %Return
   %Finish

sw(await DTX):   ;! DTX has arrived
   {Putstring("Receive has DTX")
   p_inbuff = addr(r_buffer)
   p_maxbytes = r_maxbytes
   p_rmode = await ETX
   wec (rdy); wed(p_lsap)
   %Return

sw(await ETX):   ;! STX (really ETX) has arrived
   r_resbytes = p_resbytes
   p_rmode = 0
   p_rcurr == NIL
   r_result = success
   Reply to Client (r)
   nr == dequeue (p_rpend)
   receive block (nr,0) %unless nr == NIL
%End

%Routine Station Address (%Record(reqfm)%name r, %Integer state)
   r_result = success
   r_port = ldte
   Reply to Client (r)
%End

      
%Routine Handle Ether Event (%Integer eport,etype)
   %Switch sw(0:255)
   %Record(portfm)%Name p
   
   %Routine Ether Fail (%String(255) s)
      Putsym(7);putsym(32)
      Putstring(s);putsym(32)
      putlong(eport<<16+etype)
      putsym(nl)
   %End

   p == port(eport)
   -> sw(etype)

sw(rdy):
   {putstring("<rdy>")
   %if p_tmode = await RDY %start
      %if p_open = port closing %start
         Close Port (p_mgmt, await RDY)
      %Else
         Transmit Block (p_tcurr,await RDY)
      %Finish
   %elseif p_open = port opening
      Open Port (p_mgmt,await RDY)
   %Else
      Ether Fail ("Unexpected RDY")
   %Finish
   %Return
      
sw(etx):
   {putstring("<etx>")
   %if p_open = port closing %start
      close port (p_mgmt,await ETX)
   %elseif p_rmode = await ETX
      Receive Block (p_rcurr,await ETX)
   %Else
      Ether Fail ("Unexpected ETX")
   %Finish
   %Return

sw(dtx):
   {putstring("<dtx>")
   %if p_rmode = await DTX %start
      Receive Block (p_rcurr,await DTX)
   %Elseif p_open = port open %and p_rmode = 0
      p_rmode = pending DTX
   %Elseif p_open = port closing
      wec (ack); wed(eport)
   %Else
      Ether Fail ("Unexpected DTX (".itos(p_rmode,0).")")
   %Finish
   %Return

sw(nak):
   {putstring("<nak>")
   %if p_tmode = await ACK %start
      %if p_open = port closed %start
         p_tmode = 0
      %Else
         Transmit Block (p_tcurr,await NAK)
      %Finish
   %Else
      Ether Fail ("Unexpected NAK")
   %Finish
   %Return

sw(ack):
   {putstring("<ack>")
   %if p_tmode = await ACK %start
      %if p_open = port closed %start
         p_tmode = 0
      %Else
         Transmit Block (p_tcurr,await ACK)
      %Finish
   %Else
      Ether Fail ("Unexpected ACK")
   %Finish
   %Return

sw(*): 
   Ether Fail ("Unexpected Ether Event")
%End


%Routine Handle Request (%Record(reqfm)%Name r, %Integer state)
   %Constinteger last = 7
   %Switch sw(1:7)

   -> bum %unless 1 <= r_code <= Last
   -> sw(r_code)
   
sw(1):  Claim Port (r,state)         ; %Return
sw(2):  Free Port (r,state)          ; %Return
sw(3):  Open Port (r,state)          ; %Return
sw(4):  Close Port (r,state)         ; %Return
sw(5):  Transmit Block (r,state)     ; %Return
sw(6):  Receive Block (r,state)      ; %Return
sw(7):  Station Address (r,state)    ; %Return
bum:
   r_result = bad function code
   reply to client (r)
%End

%Routine Initialise
   %Integer i
   %record(dictfm)%name m
   %record(portfm)%name cp

   %For i = 0, 1, Max Port %cycle
      cp == Port (i)
      cp_open = port closed; cp_lsap = i
      cp_owned = port free
      setup queue (cp_tpend)
      setup queue (cp_rpend)
      cp_tcurr == NIL; cp_tmode = 0
      cp_rcurr == NIL; cp_rmode = 0
      cp_mgmt == NIL
   %Repeat      

   port(0)_open = port open   ;! Port 0 always open

   Put String ("Ether (2MHz) process. Version of 18th March 1987. Station = ")

   setup semaphore (eevent)
   setup mailbox (mbox, eevent)

   Setup Interrupts

   wec(16_0F)     ;! Reset Station
   wec(esa)       ;! Enquire LDTE
   %Cycle; %Repeatuntil ldte # 0
   phex2 (ldte) ; putsym(10)

   m == poa_logdict
   m == m_alt %while m_alt ## nil
   i = Make Entry ("ETHER_REQ",m)
   %if i = 0 %start
      putstring("Ether process failed to create mailbox");putsym(10)
      %stop
   %Finish
   integer(i) = addr(mbox)
%End

%Integerfn Remove Control (%Integername port,type)
   %Integer t,p

   t = ctrl_out
   %if ctrl_in # t %start
      port = byteinteger(t)
      type = byteinteger(t+maxctrl)
{      putstring("Port = ");putlong(port);putsym(' ')
{      putstring("type = ");putlong(type);putsym(nl)
      t = t + 1
      t = ctrl_bs %if t=ctrl_be
      ctrl_out = t
   %Else
      %Result = -1
   %Finish
   %Result = 0
%End

%Begin
   %integer p,port,etype
   %record(reqfm)%name req

   %on 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
      Putstring("Ether process fatal - ")
      putstring(event_message);putsym(10)
      %Stop
   %Finish

   Initialise
   %Cycle
      Semaphore Wait (eEvent)
      req == Dequeue (mbox_queue)
      %If req ## NIL %start
         Handle Request (Req,0)
      %Else
         p = Remove Control (port,etype)
         %If p = -1 %start
            Putstring ("* Ether : Superfluous signal");putsym(10)
            %Continue
         %Finish
         Handle Ether Event (port,etype)
      %Finish
   %Repeat
%End