! 2 meg port0 listener.  Receive messages, interpret the first byte as
! a facility code, and forward the remainder to whichever mailbox was in
! existence when we started up.  This version converted to use new raw-mode
! ether handler.

%externalstring(47) copyright %alias "GDMR_(C)_P_PORT0" = %c
   "Copyright (C) 1987 George D.M. Ross"

%option "-nonstandard-nocheck-nodiag-noline-nostack"
!%option "-nonstandard"

%constinteger last facility = 16

%include "Moose:Mouse.Inc"
%include "GDMR_E:2Meg.Inc"

%conststring(1) SNL = "
"

%externalpredicatespec FS lookup(%string(31) what, %integername where)

%systemroutinespec phex(%integer i)
%systemroutinespec phex2(%integer i)
%systemstring(127)%fnspec itos(%integer i, j)
%systemintegerfnspec free store

%recordformat p0 buffer fm(%record(message fm) system part,
                           %byte ra, rp,
                           (%bytearray x(0 : 532) %c
                        %or %byte facility %c
                            %or %string(127) reply text))

%ownrecord(mailbox fm)%namearray facility boxes(1 : last facility) == nil(*)

!! %routine xprintstring(%string(255) s)
!!    %integer i, ch
!!       %return %if s = ""
!!       %for i = 1, 1, length(s) %cycle
!!          ch = charno(s, i)
!!          %if ' ' <= ch <= '~' %start
!!             print symbol(ch)
!!          %else
!!             print symbol('<')
!!             write(ch, 0)
!!             print symbol('>')
!!          %finish
!!       %repeat
!! %end

%record(mailbox fm)%map locate mailbox(%integer which)
   %string(31) name
   %integer x
      name = "PORT_0_FACILITY_" . itos(which, 0)
      %if FS lookup(name, x) %start
         !! printstring("Found ");  printstring(name)
         !! printstring(" at ");  phex(x);  newline
         %result == record(x)
      %else
         !! printstring("No ");  printstring(name)
         !! newline
         %result == nil
      %finish
%end

%begin
   %ownrecord(semaphore fm) ether semaphore = 0
   %ownrecord(mailbox fm) ether reply box = 0
   %ownrecord(mailbox fm)%name ether box == nil
   %ownrecord(ether request fm) ether request = 0
   %ownrecord(ether request fm)%name ether reply == nil
   %ownrecord(semaphore fm) client semaphore = 0
   %ownrecord(mailbox fm) client mailbox = 0
   %ownrecord(p0 buffer fm) p0 buffer = 0
   %ownrecord(p0 buffer fm)%name client reply == nil
   %integer i
      open input(3, ":N");  select input(3)
      open output(3, ":T");  select output(3)
      %if FS lookup(ether mailbox name, i) %start
         ether box == record(i)
      %else
         printstring("P_Port0: No ether mailbox?");  newline
         %stop
      %finish
      setup semaphore(client semaphore)
      setup mailbox(client mailbox, client semaphore)
      setup semaphore(ether semaphore)
      setup mailbox(ether reply box, ether semaphore)
      setup message(ether request, size of(ether request))
      ether request_code = ether old register0
      send message(ether request, ether box, ether reply box)
      ether reply == receive message(ether reply box)
      %if ether reply_status < 0 %start
         printstring("P_Port0: ")
         printstring(ether errors(ether reply_status))
         newline
         %stop
      %finish
      {} printstring("P_Port0: ");  write(free store, 0)
      {} printstring(" free");  newline
      %cycle
         ether request_code = ether old read
         ether request_buffer == p0 buffer_facility
         send message(ether request, ether box, ether reply box)
         ether reply == receive message(ether reply box)
         %if ether reply_status < 0 %start
            printstring("P_Port0: ")
            printstring(ether errors(ether reply_status))
            newline
         %else
            p0 buffer_ra = ether reply_ra
            p0 buffer_rp = ether reply_rp
            !! printstring("P_Port0: request for facility ")
            !! write(p0 buffer_facility, 0);  printstring(" from ")
            !! phex2(p0 buffer_ra);  print symbol('.')
            !! phex2(p0 buffer_rp);  newline
            %if 0 < p0 buffer_facility <= last facility %start
               facility boxes(p0 buffer_facility) == locate mailbox(p0 buffer_facility) %c
                  %if facility boxes(p0 buffer_facility) == nil
               %if facility boxes(p0 buffer_facility) == nil %start
                  p0 buffer_reply text = "-- Unregistered facility" . SNL
               %else
                  send message(p0 buffer, facility boxes(p0 buffer_facility),
                               client mailbox)
                  client reply == receive message(client mailbox)
                  %if client reply ## p0 buffer %start
                     printstring("P_Port0: Bogus reply from facility");  newline
                     p0 buffer_reply text = "-- Bogus facility response" . SNL
                  %finish
                  !! printstring("Client's reply: ")
                  !! printstring(p0 buffer_reply text);  newline
               %finish
            %else
               p0 buffer_reply text = "-- Invalid facility" . SNL
            %finish
            ether request_code = ether old write
            ether request_ra = p0 buffer_ra
            ether request_rp = p0 buffer_rp
            ether request_buffer == charno(p0 buffer_reply text, 1)
            ether request_bytes = length(p0 buffer_reply text)
            send message(ether request, ether box, ether reply box)
            ether reply == receive message(ether reply box)
            %if ether reply_status < 0 %start
               printstring("P_Port0: ")
               printstring(ether errors(ether reply_status))
               newline
            %finish
         %finish
      %repeat
%end %of %program