! User interface module for (Moose) INet process, GDMR, Jan. 1988

%option "-Low-NonStandard-NoCheck-NoTrace-NoDiag"

%constinteger TCP max = 32
%constinteger UDP max = 8

%constinteger requests = 32

%constinteger outbound size = 10240
%constinteger outbound priority = 6

%include "INet:Common_Formats.Inc"
%include "INet:Utility.Inc"
%include "INet:INet.Inc"

%externalrecord(queue fm)%spec TCP outbound queue
%externalrecord(queue fm)%spec UDP outbound queue
%externalrecord(queue fm)%spec ICMP outbound queue
%externalrecord(semaphore fm)%spec dispatch semaphore

%externalrecord(TCB table fm)%namespec TCB table
%externalrecord(UDP table fm)%namespec UDP table

%externalroutinespec FS insert(%string(31) what, %integer value)
%systemintegerfnspec global heap get(%integer amount)
%systemroutinespec phex2(%integer x)
%systemroutinespec phex(%integer x)

%routine copy data(%integer bytes, %bytename from, to)
   %label L
      *subq.l #1, D0
   L: *move.b (A0)+, (A1)+
      *dbra D0, L
%end


! All TCP and UDP operations take place via the following data structure.
! Depending on the state field the user requests may or may not be valid.
! The outbound queue holds user requests when the particular interface is
! blocked for flow control purposes.  The pending queue holds requests which
! require a response from the protocol module (claim, open).  The inbound queue
! holds user read requests for which there is no peer-data as yet, while the
! pending in queue holds peer-data for which there is no user-read request
! (there will, of course, only ever be one of these queues active at any
! particular time....).   In attempt to prevent misuse of TCP/UDP units,
! each interface is tagged with a user-supplied key which must match before
! the requested operation is allowed.

%recordformat interface fm(%integer state, key,
                           %record(INet user request fm)%name outbound,
                           %record(INet user request fm)%name pending,
                           %record(INet user request fm)%name inbound,
                           %record(INet user request fm)%name pending in)

! NB: idle state assumed = 0
%constinteger idle      state = 0;  ! Default, not in use
%constinteger enabled   state = 1;  ! Turned on, but free
%constinteger allocated state = 2;  ! Claimed, not yet open
%constinteger open      state = 3;  ! Open, unblocked
%constinteger blocked   state = 4;  ! Open, blocked

%constinteger write code = 1;  ! Pending inbound data
%constinteger close code = 2;  ! Pending inbound close from peer

! Because there is an autonomous process waiting for user requests, we have
! to interlock access to the interface data structures.  For simplicity
! we use one common semaphore for both TCP and UDP.  We attempt to minimise
! the time this semaphore is held.

%ownrecord(semaphore fm) interface semaphore = 0

! Pending inbound data/close packets from the peer for which there is no
! user-read requests are queued.  For convenience, the user-request format
! is employed.  Rather than return them to the heap, we keep a free list
! for speed.

%ownrecord(queue fm) free requests = 0


! Common interface procedures.  These are used by both the TCP and UDP
! code, as the functionality is common.

! Send a buffer to the user.  If there is no pending read request, queue it.

%predicate send(%record(interface fm)%name i, %record(buffer fm)%name b)
   %record(INet user request fm)%name r, n
      !! printstring("Send: ");  phex(addr(i))
      !! space;  phex(addr(b));  write(b_data bytes, 1);  newline
      semaphore wait(interface semaphore)
      %if i_state < open state %start
         ! This particular interface is not in data-transfer mode, so
         ! drop the packet.
         signal semaphore(interface semaphore)
         release buffer(b)
         %false 
      %finish
      %if i_inbound == nil %start
         ! No user-read waiting, we'll have to queue
         r == dequeue(free requests)
         r == record(global heap get(size of(r))) %if r == nil;  ! None free
         ! Fill relevant fields and queue it.
         r_INet buffer == b
         r_code = write code
         r_next == nil
         %if i_pending in == nil %start
            ! Empty
            i_pending in == r
         %else
            ! Not empty, so chain down
            n == i_pending in
            n == n_next %while n_next ## nil
            n_next == r
         %finish
         signal semaphore(interface semaphore)
      %else
         ! There's a user-read request waiting.  Unlink it and copy in our data.
         r == i_inbound
         i_inbound == r_next
         signal semaphore(interface semaphore)
         %if b_data bytes <= 0 %start
            ! No data?  Oh, well....
            r_bytes = 0
         %else
            copy data(b_data bytes, b_data start, r_buffer)
            r_bytes = b_data bytes
         %finish
         r_status = 0
         ! Now enqueue our buffer on its next queue, if required, and
         ! send the user's request on its way
         %if b_next queue == nil %start
            ! No later activity required, so free it.
            release buffer(b)
         %else
            ! Later activity, enqueue it as specified.
            enqueue buffer(b, b_next queue)
         %finish
         send message(r, r_system part_reply, nil) %c
            %if r_system part_reply ## nil
      %finish
      %true
%end

! Peer close request has arrived.  Enqueue it for the user.

%routine send close(%record(interface fm)%name i)
   %record(INet user request fm)%name r, n
      !! printstring("Send close: ");  phex(addr(i));  newline
      semaphore wait(interface semaphore)
      %if i_state < open state %start
         ! Not in data-transfer mode, so forget it.
         signal semaphore(interface semaphore)
         %return
      %finish
      %if i_inbound == nil %start
         ! Nothing waiting, we'll have to queue.
         r == dequeue(free requests)
         r == record(global heap get(size of(r))) %if r == nil;  ! None free
         r_code = close code
         r_INet buffer == nil
         r_next == nil
         %if i_pending in == nil %start
            ! Empty
            i_pending in == r
         %else
            ! Not empty, chain down list.
            n == i_pending in
            n == n_next %while n_next ## nil
            n_next == r
         %finish
         signal semaphore(interface semaphore)
      %else
         ! There's a request waiting.  Unlink it and send back a close.
         r == i_inbound
         i_inbound == r_next
         signal semaphore(interface semaphore)
         r_status = closing error
         ! Now send the user's request on its way
         send message(r, r_system part_reply, nil) %c
            %if r_system part_reply ## nil
      %finish
%end

! Response to an open/define request.  As a side effect we mark the interface
! open for data transfer.

%recordformat connect fm(%integer ra, rp, lp)

%routine send open response(%record(interface fm)%name i,
                            %integer error, ra, rp, lp)
   %record(INet user request fm)%name r
   %record(connect fm)%name c
      !! printstring("Send open response: ");  phex(addr(i))
      !! space;  write(error, 0);  write(ra, 1);  write(rp, 1)
      !! write(lp, 1);  newline
      semaphore wait(interface semaphore)
      %if i_state = idle state %start
         ! Wasn't opening??  Forget it.
         signal semaphore(interface semaphore)
         %return
      %finish
      ! Unlink user's request and turn on the interface.
      r == i_pending;  i_pending == nil
      i_state = open state %if i_state # blocked state
      signal semaphore(interface semaphore)
      %return %if r == nil;  ! No request??
      r_status = error;  ! As supplied by protocol module
      c == record(addr(r_buffer))
      !! printstring("Connect buffer at ");  phex(addr(c));  newline
      %if c ## nil %start
         c_ra = ra;  c_rp = rp
         c_lp = lp
         r_bytes = 12
      %finish
      send message(r, r_system part_reply, nil) %c
         %if r_system part_reply ## nil
%end

! Response to a port-claim request.  Send back the port in the user's buffer.

%routine send claim response(%record(interface fm)%name i,
                             %integer error, allocated)
   %record(INet user request fm)%name r
      !! printstring("Send claim response: ");  phex(addr(i))
      !! space;  write(error, 0);  write(allocated, 1);  newline
      semaphore wait(interface semaphore)
      %if i_state = idle state %start
         ! Not allocated??  Ignore it.
         signal semaphore(interface semaphore)
         %return
      %finish
      ! Unlink the user's request.
      r == i_pending;  i_pending == nil
      signal semaphore(interface semaphore)
      !! printstring("Request at ");  phex(addr(r));  newline
      %return %if r == nil;  ! No request??
      r_status = error;  ! As supplied by procotol module
      !! printstring("Buffer at ");  phex(addr(r_buffer));  newline
      %if r_buffer ## nil %start
         ! Buffer provided, return the allocated port
         integer(addr(r_buffer)) = allocated
         r_bytes = 4
      %finish
      send message(r, r_system part_reply, nil) %c
         %if r_system part_reply ## nil
%end

! Turn on the specified interface, allowing it to be allocated.

%routine enable(%record(interface fm)%name i)
   !! printstring("Enable ");  phex(addr(i));  newline
   semaphore wait(interface semaphore)
   %if i_state = idle state %start
      i = 0
      i_state = enabled state
   %finish
   ! Else ignore duplicate enable.
   signal semaphore(interface semaphore)
%end

! Turn off specified interface.  Purge its queues, and drop/return any
! pending requests.  Later user-requests will be bounced.

%routine disable(%record(interface fm)%name i, %integer error)
   %record(INet user request fm)%name r
   %record(buffer fm)%name b
      !! printstring("Disable ");  phex(addr(i))
      !! space;  write(error, 0);  newline
      error = reset error %if error = 0
      semaphore wait(interface semaphore)
      ! Pending user-write requests.
      %while i_outbound ## nil %cycle
         r == i_outbound
         i_outbound == r_next
         r_status = error
         send message(r, r_system part_reply, nil) %c
            %if r_system part_reply ## nil
      %repeat
      ! Open/claim requests
      %while i_pending ## nil %cycle
         r == i_pending
         i_pending == r_next
         r_status = error
         send message(r, r_system part_reply, nil) %c
            %if r_system part_reply ## nil
      %repeat
      ! User-read requests
      %while i_inbound ## nil %cycle
         r == i_inbound
         i_inbound == r_next
         r_status = error
         send message(r, r_system part_reply, nil) %c
            %if r_system part_reply ## nil
      %repeat
      ! Peer-write requests.
      %while i_pending in ## nil %cycle
         r == i_pending in
         i_pending in == r_next
         b == r_INet buffer
         release buffer(b) %if b ## nil
         enqueue(r, free requests)
      %repeat
      ! Free the interface (implicitly mark idle).
      i = 0
      signal semaphore(interface semaphore)
%end

! Flow control -- mark interface as blocked.

%routine block(%record(interface fm)%name i)
   !! printstring("Block ");  phex(addr(i));  newline
   semaphore wait(interface semaphore)
   i_state = blocked state %if i_state >= open state;  ! Only if open/blocked
   signal semaphore(interface semaphore)
%end

! Flow control -- mark interface as unblocked.  If there are any user-requests
! queued, we deal with them (all) now.

%routine unblock(%record(interface fm)%name i)
   %record(INet user request fm)%name r
   %record(buffer fm)%name b
      !! printstring("Unblock ");  phex(addr(i));  newline
      semaphore wait(interface semaphore)
      i_state = open state %if i_state > open state;  ! Only if blocked
      ! Deal with any pending user-write requests
      %while i_outbound ## nil %cycle
         ! Dequeue next.
         r == i_outbound
         i_outbound == r_next
         %if r_code & request type = TCP request %start
            ! It's a TCP request.  Copy the data (if any).
            b == claim buffer
            b_code = r_code
            b_TCB == TCB table_TCB(r_unit)
            b_TCB_slot = r_unit;  !?
            b_data start == b_data(64)
            %if r_bytes <= 0 %start
               b_data bytes = 0
            %else
               copy data(r_bytes, r_buffer, b_data start)
               b_data bytes = r_bytes
            %finish
            ! Send it on its way, then drop through to return 
            ! the user's request.
            enqueue buffer(b, TCP outbound queue)
            r_status = 0
       ! %else %if r_code & request type = UDP request
         %else
            ! Something unknown waiting, bounce it.
            r_status = bugcheck error
         %finish
         send message(r, r_system part_reply, nil) %c
            %if r_system part_reply ## nil
      %repeat
      signal semaphore(interface semaphore)
%end


! TCP interface.  Mostly these just validate the interface unit number, then
! call the TCP/UDP-common code above.

%ownrecord(interface fm)%array TCP interface(1 : TCP max) = 0(*)

%externalpredicate TCP send to user(%record(buffer fm)%name b)
   %false %unless 0 < b_TCB_slot <= TCP max
   %false %unless send(TCP interface(b_TCB_slot), b)
   %true
%end

%externalroutine TCP send close(%integer unit)
   send close(TCP interface(unit)) %if 0 <= unit <= TCP max
%end

%externalroutine TCP open response(%integer unit, error, ra, rp, lp)
   send open response(TCP interface(unit), error, ra, rp, lp) %if 0 <= unit <= TCP max
%end

%externalroutine TCP claim response(%integer unit, error, allocated)
   send claim response(TCP interface(unit), error, allocated) %if 0 <= unit <= TCP max
%end

%externalroutine TCP enable(%integer unit)
   enable(TCP interface(unit)) %if 0 <= unit <= TCP max
%end

%externalroutine TCP disable(%integer unit, error)
   disable(TCP interface(unit), error) %if 0 <= unit <= TCP max
%end

%externalroutine TCP block(%integer unit)
   block(TCP interface(unit)) %if 0 <= unit <= TCP max
%end

%externalroutine TCP unblock(%integer unit)
   unblock(TCP interface(unit)) %if 0 <= unit <= TCP max
%end

! This next should never fail, provided the rest of the code in this
! module is working correctly.  It's in to provide compatibility with the
! VMS version.

%externalpredicate TCP interpret user request(%record(buffer fm)%name b)
   %true %if TCP abort request <= b_code <= TCP close request
   printstring("INet: Dud TCP user request code ");  phex2(b_code);  newline
   %false
%end

! The following procedure is called by the autonomous user-request handler
! to decide what to do with the request it has just received.  If the
! request has been completed immediately it returns %true, else returns
! %false to indicate that the request remains pending.

%predicate TCP interpret(%record(INet user request fm)%name r)
   %record(INet user request fm)%name n
   %record(interface fm)%name i
   %record(buffer fm)%name b
   %integer x
      ! Was the user's request sensible?
      %unless TCP first request <= r_code <= TCP last request %start
         r_status = dud op error
         %true
      %finish
      ! Does the user want to allocate a TCP unit?  If so, scan the tables
      ! looking for any that are turned on but not otherwise in use (only
      ! enabled state).  Allocate the first one found and copy in the
      ! user-supplied key -- this will later be used to try to prevent
      ! bogus use of someone else's unit.
      %if r_code = TCP allocate unit request %start
         semaphore wait(interface semaphore)
         %for x = 1, 1, TCP max %cycle
            i == TCP interface(x)
            %if i_state = enabled state %start
               ! Got one.  Mark it allocated and return the unit number
               ! in the user's request.
               i_state = allocated state
               i_key = r_key
               signal semaphore(interface semaphore)
               r_status = 0
               r_unit = x
               %true
            %finish
         %repeat
         ! None free, bounce the request.
         signal semaphore(interface semaphore)
         r_status = none free error
         %true
      %finish
      ! For everything but an allocate request the user is required to
      ! quote a valid unit number.  Unfortunately we can't check that the
      ! user really does have access to that particular unit; the best we can
      ! do is to compare the quoted key fields and assume that a match is not
      ! due to luck or forgery.....  From now on the unit must be at least
      ! in the allocated state.
      %unless 0 < r_unit <= TCP max %start
         r_status = dud op error
         %true
      %finish
      i == TCP interface(r_unit)
      semaphore wait(interface semaphore)
      %if i_state < allocated state %start
         signal semaphore(interface semaphore)
         r_status = dud op error
         %true
      %finish
      %unless r_key = i_key %start
         ! Mismatch, bounce it.
         signal semaphore(interface semaphore)
         r_status = dud op error
         %true
      %finish
      ! The next range of requests are valid whenever the unit is allocated.
      %if TCP abort request <= r_code <= TCP open request %start
         ! All except the abort request expect a response from the
         ! protocol module.  As we're only geared up for one such
         ! request at a time we bounce any such while we're still
         ! processing a previous one...
         %if r_code # TCP abort request %start
            %if i_pending == nil %start
               ! Nothing being processed, so pend our request.
               r_next == nil
               i_pending == r
            %else
               ! Something already being processed
               signal semaphore(interface semaphore)
               r_status = dud op error
               %true
            %finish
         %finish
         signal semaphore(interface semaphore)
         ! OK so far.  Claim a buffer, copy in any data, and then
         ! send it on to the main dispatcher for processing.
         b == claim buffer
         b_code = r_code
         b_privilege = 1;  ! Always!
         b_TCB == TCB table_TCB(r_unit)
         b_TCB_slot = r_unit;  !?
         b_data start == b_data(64)
         %if r_code # TCP open request %or r_bytes <= 0 %start
            ! No data.
            b_data bytes = 0
         %else
            ! Copy it
            copy data(r_bytes, r_buffer, b_data start)
            b_data bytes = r_bytes
         %finish
         enqueue buffer(b, TCP outbound queue)
         signal semaphore(dispatch semaphore)
         ! An abort request is completed immediately, while anything
         ! else is held pending the protocol module's response.
         %if r_code = TCP abort request %start
            r_status = 0
            %true
         %else
            %false
         %finish
      %finish
      ! Sending and receiving is subject to the interface being opened.
      ! Sending of data is subject to flow control: if the interface
      ! is blocked the request must be queued.
      %if r_code = TCP send request %or r_code = TCP close request %start
         %if i_state = open state %start
            ! Open, not blocked, so send it on.
            signal semaphore(interface semaphore)
            b == claim buffer
            b_code = r_code
            b_TCB == TCB table_TCB(r_unit)
            b_TCB_slot = r_unit;  !?
            b_data start == b_data(64)
            %if r_bytes <= 0 %start
               b_data bytes = 0
            %else
               copy data(r_bytes, r_buffer, b_data start)
               b_data bytes = r_bytes
            %finish
            enqueue buffer(b, TCP outbound queue)
            signal semaphore(dispatch semaphore)
            r_status = 0
            %true
         %else %if i_state = blocked state
            ! Open, blocked, so enqueue it.
            r_next == nil
            %if i_outbound == nil %start
               i_outbound == r
            %else
               n == i_outbound
               n == n_next %while n_next ## nil
               n_next == r
            %finish
            %false
         %else
            ! Not open, so bounce it.
            signal semaphore(interface semaphore)
            r_status = dud op error
            %true
         %finish
      %finish
      ! Only thing left is receive request.  The unit must be at least open.
      %if i_state < open state %start
         signal semaphore(interface semaphore)
         r_status = dud op error
         %true
      %finish
      ! There are two cases to consider: either there is data pending from
      ! our peer (on the pending in queue) in which case we can complete
      ! the request immediately, or there is nothing pending in which case
      ! we will have to wait.
      %if i_pending in == nil %start
         ! Nothing immediately available, so we'll have to wait.
         ! Put ourselves on the tail of the inbound queue.
         r_next == nil
         %if i_inbound == nil %start
            i_inbound == r
         %else
            n == i_inbound
            n == n_next %while n_next ## nil
            n_next == r
         %finish
         signal semaphore(interface semaphore)
         %false
      %else
         ! There's something immediately available.  Unlink it and copy its
         ! data into our buffer.
         n == i_pending in;  i_pending in == n_next
         signal semaphore(interface semaphore)
         b == n_INet buffer
         %if n_code = write code %start
            ! Data from our peer.  Copy it
            %if b_data bytes > 0 %and r_buffer ## nil %start
               copy data(b_data bytes, b_data start, r_buffer)
               r_bytes = b_data bytes
            %else
               ! No data or no buffer??
               r_bytes = 0
            %finish
         %else
            ! Must be a close from our peer.
            r_code = closing error
            r_bytes = 0
         %finish
         r_status = 0
         ! The INet buffer may now need to be enqueued on another queue.
         %if b_next queue == nil %start
            ! Nothing more for this one, free it.
            release buffer(b)
         %else
            ! This one has further to go.  Enqueue it and notify the
            ! dispatcher that something has happened.
            enqueue buffer(b, b_next queue)
            signal semaphore(dispatch semaphore)
         %finish
         %true
      %finish
%end


! UDP interface.  These are similar to the TCP versions, in that in
! most cases they merely validate their arguments before calling the
! common procedures above.  There is, as yet, no block/unblock.

%ownrecord(interface fm)%array UDP interface(1 : UDP max) = 0(*)

%externalroutine UDP send to user(%record(buffer fm)%name b)
   !! printstring("UDP send to user");  newline
   %if 0 < b_UDP entry_slot <= UDP max %c
      %and send(UDP interface(b_UDP entry_slot), b) %start;  %finish
%end

%externalroutine UDP open response(%integer unit, error, ra, rp, lp)
   !! printstring("UDP open response: ");  write(unit, 0);  space
   !! write(error, 0);  write(ra, 1);  write(rp, 1);  write(lp, 1);  newline
   send open response(UDP interface(unit), error, ra, rp, lp) %if 0 <= unit <= UDP max
%end

%externalroutine UDP claim response(%integer unit, error, allocated)
   !! printstring("UDP claim response: ");  write(unit, 0);  space
   !! write(error, 0);  write(allocated, 1);  newline
   send claim response(UDP interface(unit), error, allocated) %if 0 <= unit <= UDP max
%end

%externalroutine UDP enable(%integer unit)
   !! printstring("UDP enable ");  write(unit, 0);  newline
   enable(UDP interface(unit)) %if 0 <= unit <= UDP max
%end

%externalroutine UDP disable(%integer unit, error)
   !! printstring("UDP disable ");  write(unit, 0);  space
   !! write(error, 0);  newline
   disable(UDP interface(unit), error) %if 0 <= unit <= UDP max
%end

! Once again this should never fail, provided the rest of the code in this
! module is working correctly.  It's in to provide compatibility with the
! VMS version.

%externalpredicate UDP interpret user request(%record(buffer fm)%name b)
   %true %if UDP forget context request <= b_code <= UDP data request
   printstring("INet: Dud UDP user request code ");  phex2(b_code);  newline
   %false
%end

! The following is very similar to the TCP version above.  Unfortunately
! there are sufficient variations that a common version is not feasible.
! Note that we are set up to cope with flow control even though the
! protocol module doesn't enforce any -- it seems sennsible just to leave
! it in for later, though.....

%predicate UDP interpret(%record(INet user request fm)%name r)
   %record(INet user request fm)%name n
   %record(interface fm)%name i
   %record(buffer fm)%name b
   %integer x
      !! printstring("UDP interpret: ");  phex2(r_code);  newline
      ! Was the user's request sensible?
      %unless UDP first request <= r_code <= UDP last request %start
         r_status = dud op error
         %true
      %finish
      ! Does the user want to allocate a UDP unit?  If so, scan the tables
      ! looking for any that are turned on but not otherwise in use (only
      ! enabled state).  Allocate the first one found and copy in the
      ! user-supplied key -- this will later be used to try to prevent
      ! bogus use of someone else's unit.
      %if r_code = UDP allocate unit request %start
         !! printstring("Allocate");  newline
         semaphore wait(interface semaphore)
         %for x = 1, 1, UDP max %cycle
            i == UDP interface(x)
            %if i_state = enabled state %start
               ! Got one.  Mark it allocated and return the unit number
               ! in the user's request.
               i_state = allocated state
               i_key = r_key
               signal semaphore(interface semaphore)
               r_status = 0
               r_unit = x
               !! printstring("Allocated ");  write(x, 0);  newline
               %true
            %finish
         %repeat
         ! None free, bounce the request.
         signal semaphore(interface semaphore)
         r_status = none free error
         %true
      %finish
      ! For everything but an allocate request the user is required to
      ! quote a valid unit number.  Unfortunately we can't check that the
      ! user really does have access to that particular unit; the best we can
      ! do is to compare the quoted key fields and assume that a match is not
      ! due to luck or forgery.....  From now on the unit must be at least
      ! in the allocated state.
      %unless 0 < r_unit <= UDP max %start
         r_status = dud op error
         %true
      %finish
      i == UDP interface(r_unit)
      semaphore wait(interface semaphore)
      %if i_state < allocated state %start
         signal semaphore(interface semaphore)
         r_status = dud op error
         %true
      %finish
      %unless r_key = i_key %start
         ! Mismatch, bounce it.
         signal semaphore(interface semaphore)
         r_status = dud op error
         %true
      %finish
      ! The next range of requests are valid whenever the unit is allocated.
      ! Query context is somewhat dubious for an undefined unit, but we'll
      ! let it through for now....
      %if UDP forget context request <= r_code <= UDP query context request %start
         ! All except the abort request expect a response from the
         ! protocol module.  As we're only geared up for one such
         ! request at a time we bounce any such while we're still
         ! processing a previous one...
         !! printstring("Forget..query");  newline
         %if r_code # UDP forget context request %start
            !! printstring("Not forget");  newline
            %if i_pending == nil %start
               ! Nothing being processed, so pend our request.
               r_next == nil
               i_pending == r
            %else
               ! Something already being processed
               signal semaphore(interface semaphore)
               r_status = dud op error
               %true
            %finish
         %finish
         signal semaphore(interface semaphore)
         ! OK so far.  Claim a buffer, copy in any data, and then
         ! send it on to the main dispatcher for processing.
         !! printstring("Buffer at ");  phex(addr(b));  newline
         b == claim buffer
         b_code = r_code
         b_privilege = 1;  ! Always!
         b_UDP entry == UDP table_UDP(r_unit)
         b_UDP entry_slot = r_unit;  !?
         b_data start == b_data(64)
         %if r_code # UDP define context request %or r_bytes <= 0 %start
            ! No data.
            !! printstring("No data");  newline
            b_data bytes = 0
         %else
            ! Copy it
            !! printstring("Copy ");  write(r_bytes, 0);  newline
            copy data(r_bytes, r_buffer, b_data start)
            b_data bytes = r_bytes
         %finish
         enqueue buffer(b, UDP outbound queue)
         signal semaphore(dispatch semaphore)
         !! printstring("Enqueued");  newline
         ! A forget request is completed immediately, while anything
         ! else is held pending the protocol module's response.
         %if r_code = UDP forget context request %start
            r_status = 0
            %true
         %else
            %false
         %finish
      %finish
      ! Sending and receiving is subject to the interface being opened.
      ! Sending of data is subject to flow control: if the interface
      ! is blocked the request must be queued.
      %if r_code = UDP data request %start
         !! printstring("UDP data: ");  write(r_bytes, 0);  newline
         %if i_state = open state %start
            ! Open, not blocked, so send it on.
            signal semaphore(interface semaphore)
            b == claim buffer
            b_code = r_code
            b_UDP entry == UDP table_UDP (r_unit)
            b_UDP entry_slot = r_unit;  !?
            b_data start == b_data(64)
            %if r_bytes <= 0 %start
               b_data bytes = 0
            %else
               copy data(r_bytes, r_buffer, b_data start)
               b_data bytes = r_bytes
            %finish
            enqueue buffer(b, UDP outbound queue)
            signal semaphore(dispatch semaphore)
            r_status = 0
            %true
         %else %if i_state = blocked state
            ! Open, blocked, so enqueue it.
            r_next == nil
            %if i_outbound == nil %start
               i_outbound == r
            %else
               n == i_outbound
               n == n_next %while n_next ## nil
               n_next == r
            %finish
            %false
         %else
            ! Not open, so bounce it.
            signal semaphore(interface semaphore)
            r_status = dud op error
            %true
         %finish
      %finish
      ! Only thing left is receive request.  The unit must be at least open.
      %if i_state < open state %start
         signal semaphore(interface semaphore)
         r_status = dud op error
         %true
      %finish
      !! printstring("UDP receive");  newline
      ! There are two cases to consider: either there is data pending from
      ! our peer (on the pending in queue) in which case we can complete
      ! the request immediately, or there is nothing pending in which case
      ! we will have to wait.
      %if i_pending in == nil %start
         ! Nothing immediately available, so we'll have to wait.
         ! Put ourselves on the tail of the inbound queue.
         r_next == nil
         %if i_inbound == nil %start
            i_inbound == r
         %else
            n == i_inbound
            n == n_next %while n_next ## nil
            n_next == r
         %finish
         signal semaphore(interface semaphore)
         %false
      %else
         ! There's something immediately available.  Unlink it and copy its
         ! data into our buffer.
         n == i_pending in;  i_pending in == n_next
         signal semaphore(interface semaphore)
         b == n_INet buffer
         ! Data from our peer.  Copy it
         %if b_data bytes > 0 %and r_buffer ## nil %start
            copy data(b_data bytes, b_data start, r_buffer)
            r_bytes = b_data bytes
         %else
            ! No data or no buffer??
            r_bytes = 0
         %finish
         r_status = 0
         ! UDP buffers never have any further to go, so we just free it
         ! up then return a reply indicator to our caller.
         release buffer(b)
         %true
      %finish
%end


! ICMP has no inbound interface.


! Outbound process.  Receives user TCP/UDP requests and calls the appropriate
! processing procedure.  If these expect to send an immediate reply they return
! %true, else %false to indicate no reply as yet.  ICMP requests are handled
! immediately and always receive an immediate reply.

%ownrecord(semaphore fm) outbound semaphore = 0
%ownrecord(mailbox fm) outbound mailbox = 0

%routine outbound process
   %record(buffer fm)%name b
   %record(INet user request fm)%name r
      open input(2, ":N");  select input(2)
      open output(2, ":T");  select output(2)
      %cycle
         r == receive message(outbound mailbox)
         !! printstring("Outbound: ");  phex(r_code);  newline
         %if r_code & request type = TCP request %start
            send message(r, r_system part_reply, nil) %c
               %if TCP interpret(r) %and r_system part_reply ## nil
         %else %if r_code & request type = UDP request
            send message(r, r_system part_reply, nil) %c
               %if UDP interpret(r) %and r_system part_reply ## nil
         %else %if r_code & request type = ICMP request
            ! ICMP handled in-line.  The buffer format is somewhat
            ! non-standard w.r.t. TCP/UDP.
            !! printstring("ICMP");  newline
            b == claim buffer
            !! printstring("Buffer at ");  phex(addr(b));  newline
            b_data start == b_data(64);  b_data bytes = 8
            integer(addr(b_data start)    ) = r_code
            integer(addr(b_data start) + 4) = integer(addr(r_buffer))
            !! printstring("Enqueue on ICMP queue at ")
            !! phex(addr(ICMP outbound queue));  newline
            enqueue buffer(b, ICMP outbound queue)
            !! printstring("Signal dispatch semaphore at ")
            !! phex(addr(dispatch semaphore));  newline
            signal semaphore(dispatch semaphore)
            !! printstring("Done, responding");  newline
            r_status = 0
            send message(r, r_system part_reply, nil) %c
               %if r_system part_reply ## nil
         %else
            ! Dud code
            r_status = dud op error
            send message(r, r_system part_reply, nil) %c
               %if r_system part_reply ## nil
         %finish
      %repeat
%end


! Initialisation.  For compatibility we return the number of TCP and
! UDP interfaces configured in, though these are static compile-time
! parameters.  We set up the semaphore/mailbox for user-requests and
! initialise the pending request buffer pool before starting the
! user-request process and returning.

%externalroutine start user interfaces(%integername max TCP, max UDP)
   %record(process fm)%name p
   %record(INet user request fm)%name r
   %integer i
   %label do outbound process
      setup semaphore(outbound semaphore)
      setup mailbox(outbound mailbox, outbound semaphore)
      FS insert(INet mailbox name, addr(outbound mailbox))
      setup semaphore(interface semaphore)
      signal semaphore(interface semaphore)
      setup queue(free requests)
      %for i = 1, 1, requests %cycle
         r == record(global heap get(size of(r)))
         enqueue(r, free requests)
      %repeat
      p == create process(outbound size, addr(do outbound process),
                          outbound priority, nil)
      max TCP = TCP max
      max UDP = UDP max
      %return

do outbound process:
      outbound process
%end

%end %of %file