! 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
'