{ Talk to the Ether station -- VAX/VMS version }
{ Uses the new ELDriver protocol               }

%constinteger ether max = 532
%constinteger SS BugCheck = x'0334'
%constinteger SS CtrlErr  = x'0054'

%routine enable ether interrupts
   set AST(AST on)
%end

%routine disable ether interrupts
   set AST(AST off)
%end

%routine print buffer
   %record(ether buffer fm)%name e
   %integer i
      %return %unless 0 <= common_buffer_ether packet <= ether buffers
      e == common_ether buffer_buffer(common_buffer_ether packet)
      pdate
      printstring("In: ")
      %for i = 0, 1, e_bytes - 1 %cycle
         print symbol(' ');  pxb(e_data(i))
         %exit %if i = 20
      %repeat
      newline
      pdate
      printstring("Out:")
      %for i = 1, 1, length(common_buffer_text) %cycle
         print symbol(' ');  pxb(charno(common_buffer_text, i))
         %exit %if i = 20
      %repeat
      newline
      pdate
      printstring("Out:")
      %for i = 0, 1, common_buffer_bytes - 1 %cycle
         print symbol(' ');  pxb(common_buffer_b(i))
         %exit %if i = 20
      %repeat
      newline
      common_buffer_ether packet = -1
%end

%routine fail(%integer why)
   pdate
   printstring("Ether IO failure -- ")
   printstring(sysmess(why))
   newline
   %signal 13, why
%end


{ Port control }

%constinteger port free       = 0
%constinteger port allocated  = 1
%constinteger port opening    = 2

%integerfn allocate port(%integer remote, port)
   { Find a port for a client.  %result is +p %if the client is new       }
   {                                       -p %if the client has revived  }
   {                                        0 %if there are no free ports }
   %integer i
   %record(port fm)%name p
      %on 15 %start;  %result = 0;  %finish
      { First check if we know the client }
      %for i = 1, 1, ports %cycle
         p == common_port info(i)
         %if p_state & port allocated # 0 %and %c
               p_remote = remote %and p_port = port %start
            p_state   = port allocated
          { p_remote  = remote
          { p_port    = port
            p_retries = -1
            p_lives = ether lives
            time stamp(p_opened stamp_date, p_opened stamp_time)
            p_active stamp = p_opened stamp
            %result   = -i 
         %finish
      %repeat
      i = ether allocate port
      p == common_port info(i)
      p_state   = port allocated
      p_remote  = remote
      p_port    = port
      p_retries = -1
      p_lives = ether lives
      time stamp(p_opened stamp_date, p_opened stamp_time)
      p_active stamp = p_opened stamp
      %result   = i
%end

%routine free port(%integer port)
   common_port info(port)_state = port free
   ether free port(port)
%end


{ Ether receiver handler }

%routinespec zap port(%integer port)

%externalroutine ether interrupt %alias "ETHER_INTERRUPT" (%integer port no)
   { NB this is an AST routine -- do not use normal I/O }
   %externalintegerspec interrupt %alias "ETHER_INTERRUPT"
   %record(ether buffer area fm)%name ether buffer
   %record(ether buffer fm)%name buffer
   %record(port fm)%name p
      %on 15 %start
         %signal 15, event_sub, event_extra %if event_sub # SS CtrlErr
         ether close port(port no)
         %if p_state = port allocated %and p_remote # 0 %start
            ether open port(port no, p_remote, p_port)
            ether enable AST(port no, addr(interrupt), port no)
         %finish
         %return
      %finish
      %signal 15, SS BugCheck %unless 0 < port no <= ports
      p == common_port info(port no)
      %return %unless p_state = port allocated 
      ether buffer == common_ether buffer
      buffer == ether buffer_buffer(ether buffer_next to use)
      ether receive block(port no, ether max, buffer_bytes, buffer_data(0))
      %if buffer_bytes = 1 %and %c
            (buffer_data(0) = 4 %or buffer_data(0) = 12) %start
         { Disconnect request }
         ! printstring("Port ");  write(port no, 0)
         ! printstring(" disconnecting...")
         ! newline
         ether context = port no
         VFSx clear context
         zap port(port no)
         free port(port no)
         %return
      %finish
      buffer_context = port no
      buffer_sequence count = 0
      ether buffer_next to use = (ether buffer_next to use + 1) & ether buffers
      wake(0, 0)
      common_monitor_ether reads = common_monitor_ether reads + 1
      common_port info(port no)_lives = ether lives
      ether enable AST(port no, addr(interrupt), port no)
%end

%externalroutine ether tick %alias "ETHER_TICK"
   %record(port fm)%name p
   %integer port no
      ! pdate
      ! printstring("Tick...");  newline
      %for port no = 1, 1, ports %cycle
         p == common_port info(port no)
         %continue %if p_state = port free
         p_lives = p_lives - 1
         %if p_lives <= 0 %start
            ether context = port no
            VFSx clear context
            zap port(port no)
            free port(port no)
         %finish
      %repeat
      start ether clock
%end


{ Ether transmission }

%routine open port(%integer port)
   %externalintegerspec done %alias "ETHER_INTERRUPT"
   %record(port fm)%name p
      p == common_port info(port)
      %signal 13, port %if p_state = 0
      %if diags & ether diags # 0 %start
         pdate
         printstring("Open port ");  write(port, 0)
         printstring(" to remote ");  pxb(p_remote)
         printstring(", port ");  write(p_port, 0)
         printstring(", state: ");  pxb(p_state)
         newline
      %finish
      ether close port(port);  !?
      ether open port(port, p_remote, p_port)
      ether enable AST(port, addr(done), port)
%end

%routine send buffer(%integer port)
   %record(ether buffer area fm)%name ether buffer
   %record(ether buffer fm)%name ebuff
   %record(port fm)%name p
   %integer f, t, s, size
   %integer retries = ether retry limit, retried = 0
   %ownbytearray out buffer(0 : 1023)
   %label retry
      %on 15 %start
         enable ether interrupts
         retries = retries - 1
         pdate
         printstring("NAK port ");  write(port, 0)
         printstring(", remote x'")
         pxb(p_remote)
         print symbol('''')
         common_monitor_ether errors = common_monitor_ether errors + 1
         %if retries = 0 %start
            printstring(" (fatal)")
            newline
            %return
         %else
            printstring(" (retrying)")
            newline
         %finish
         %if retried = 0 %start
            print buffer
            retried = 1
         %finish
         -> retry
      %finish
      %signal 15, SS BugCheck %unless 0 < port <= ports
      %if diags & ether diags # 0 %start
         pdate
         printstring("Send buffer to port ")
         write(port, 0);  newline
      %finish
      p == common_port info(port)
      %if common_buffer_text # "" %start
         s = length(common_buffer_text)
         f = addr(charno(common_buffer_text, 1))
         t = addr(out buffer(0))
         *movc3 _ s, @f, @t
         t = addr(out buffer(s))
         size = s
      %else
         t = addr(out buffer(0))
         size = 0
      %finish
      %if common_buffer_bytes # 0 %start
         f = addr(common_buffer_b(0))
         s = common_buffer_bytes
         *movc3 _ s, @f, @t
         size = size + s
      %finish
      time stamp(p_active stamp_date, p_active stamp_time)
      common_monitor_ether writes = common_monitor_ether writes + 1
      %if diags & ether diags # 0 %start
         pdate
         printstring("Sending ");  write(size, 0)
         printstring(" (");  write(length(common_buffer_text), 0)
         printstring(" + ");  write(common_buffer_bytes, 0)
         printstring(") bytes, last are ")
         s = size - 4;  s = 0 %if s < 0
         phex(integer(addr(out buffer(s))))
         newline
      %finish
retry:
      disable ether interrupts
      %unless p_state = port allocated %start
         pdate
         printstring("*** Sending to closed port ")
         write(port, 0)
         printstring(" -- IGNORING")
         newline
         enable ether interrupts
         %return
      %finish
      ether transmit block(port, size, out buffer(0))  ;! %if size # 0
      enable ether interrupts
      %if diags & ether diags # 0 %start
         pdate
         printstring("Sent ");  write(size, 0)
         printstring(" bytes, last were ")
         s = size - 4;  s = 0 %if s < 0
         phex(integer(addr(out buffer(s))))
         newline
      %finish
      %if common_buffer_sequence # 0 %start
         %if diags & (proc diags ! ether diags) # 0 %start
            pdate
            printstring("Sequence count = ")
            write(common_buffer_sequence count, 0)
            printstring(", letter = ");  print symbol(common_buffer_sequence)
            printstring(", Xno = ");  write(common_buffer_sequence Xno, 0)
            newline
         %finish
         disable ether interrupts
         ether buffer == common_ether buffer
         ebuff == ether buffer_buffer(ether buffer_next to use)
         ebuff_sequence count = 0
         ebuff_data(0) = common_buffer_sequence
         ebuff_data(1) = common_buffer_sequence Xno + '0'
         ebuff_data(2) = nl
         ebuff_bytes   = 3
         ebuff_context = port
         ether buffer_next to use = %c
            (ether buffer_next to use + 1) & ether buffers
         enable ether interrupts
      %finish
%end


{ Zap port }

%routine zap port(%integer port)
   %record(port fm)%name p
      %signal 15, SS BugCheck %unless 0 < port <= ports
      %if diags & ether diags # 0 %start
         pdate
         printstring("Zap port ");  write(port, 0)
         newline
      %finish
      p == common_port info(port)
      ether close port(port)
%end


{ Port 0 stuff -- allocate/deallocate ports }

%recordformat p0 receive fm(%integer code, facility,
                            %byte ra, rp, %integer zero,
                            %byte req fac, %bytearray b(0 : 127))
%ownrecord(p0 receive fm) p0 buffer = 0

%routine initialise port 0
   %externalintegerspec allocation %alias "ETHER_ALLOCATION"
      log on(facility code)
      queue receive(addr(allocation), addr(p0 buffer), 136)
%end
      
%externalshortspec ijoblim %alias "SYS$GW_IJOBLIM"
{ Set to 0 when logins are disabled }

%externalroutine allocation %alias "ETHER_ALLOCATION" (%integer bytes)
   { NB this is an AST routine -- do not use normal I/O }
   %recordformat reply fm(%integer code, facility,
                          %byte ra, rp, %integer zero,
                          %bytearray x(0 : 127))
   %record(reply fm) reply
   %externalintegerspec allocation %alias "ETHER_ALLOCATION"
   %string(63) text
   %integer alloc p
      alloc p = allocate port(p0 buffer_ra, p0 buffer_rp)
      %if alloc p = 0 %start
         text = "-6 No ports" . snl
      %else
         %if alloc p < 0 %start
            alloc p = -alloc p
            ether context = alloc p
            VFSx clear context
            trace(alloc p, trace in, "Reset (known client)")
            zap port(alloc p)
         %finish
         %if (ijoblim > 0 %or translate("VFS_ALLOW") # "VFS_ALLOW") %and %c
               (p0 buffer_ra = x'14' %c
                %or p0 buffer_ra = x'15' %c
                %or p0 buffer_ra = x'1B' %c
                %or translate("VFS_INHIBIT") = "VFS_INHIBIT") %start
            open port(alloc p)
            text = hdx1(alloc p) . snl
         %else
            text = "-6 Logins are disabled" . snl
            free port(alloc p)
         %finish
      %finish
      reply_ra = p0 buffer_ra
      reply_rp = p0 buffer_rp
      string(addr(reply_x(0)) - 1) = text
      reply_zero = 0
      forward(facility code, length(text) + 14, addr(reply))
      queue receive(addr(allocation), addr(p0 buffer), 136)
%end

%end %of %file