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

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

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

%constinteger last facility = 16

%include "Moose:Mouse.Inc"
%include "Sys:Ether.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, z1, z2, z3, z4, req fac,
                           %bytearray x(0 : 532))

%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

%routine locate mailboxes
   %string(31) name
   %integer i, x
      %for i = 1, 1, last facility %cycle
         name = "PORT_0_FACILITY_" . itos(i, 0)
         %if FS lookup(name, x) %start
            !! printstring("Found ");  printstring(name)
            !! printstring(" at ");  phex(x);  newline
            facility boxes(i) == record(x)
      !! %else
            !! printstring("No ");  printstring(name)
            !! newline
         %finish
      %repeat
%end

%begin
   %record(p0 buffer fm) p0 buffer
   %record(mailbox fm) our reply mailbox = 0
   %record(semaphore fm) our reply semaphore = 0
   %record(mailbox fm)%name reply
   %integer bytes
   %ownrecord(semaphore fm) disaster = 0
   %record(poa fm)%name P
   %integer i
      %on 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 %start
         %if event_event = 3 %start
            printstring("P_Port0: ");  printstring(event_message)
            newline
            %stop
         %else %if event_event = 15
            {} printstring("P_Port 0: ether error ")
            {} printstring(event_message);  newline
            -> try for next one
         %finish
         ! Last-chance disaster-trap
         P == POA
         printstring("P_Port0: unexpected event ");  write(P_event, 0)
         space;  write(P_event sub, 0);  space;  phex(P_event extra)
         space;  printstring(P_event message)
         printstring(" at or about PC ");  phex(P_event PC)
         newline
         %for i = 0, 1, 15 %cycle
            phex(P_event r(i));  space
            newline %if i & 7 = 7
         %repeat
         semaphore wait(disaster)
      %finish
      open input(0, ":N");  select input(0)
      open output(0, ":T");  select output(0)
      setup semaphore(disaster)
      setup semaphore(our reply semaphore)
      setup mailbox(our reply mailbox, our reply semaphore)
      setup message(p0 buffer, size of(p0 buffer))
      locate mailboxes
      set priority(nil, 6)
      ether allocate zero
      {} printstring("P_Port0: ");  write(free store, 0)
      {} printstring(" free");  newline
      %cycle
try for next one:
         ether receive block(0, 532, bytes, p0 buffer_ra)
         !! printstring("Message received from ");  phex2(p0 buffer_ra)
         !! print symbol('.');  phex2(p0 buffer_rp)
         !! printstring(" for facility ");  write(p0 buffer_req fac, 0)
         !! newline
         %if 0 < p0 buffer_req fac <= last facility %start
            %if facility boxes(p0 buffer_req fac) == nil %start
               string(addr(p0 buffer_z4)) = "-- Unregistered facility" . SNL
            %else
               send message(p0 buffer, facility boxes(p0 buffer_req fac),
                            our reply mailbox)
               reply == receive message(our reply mailbox)
               !! printstring("Replying ")
               !! xprintstring(string(addr(p0 buffer_z4)));  newline
               ! Assume we get a string back, starting at z4
            %finish
         %else
            string(addr(p0 buffer_z4)) = "-- Invalid facility" . SNL
         %finish
         bytes = p0 buffer_z4;  p0 buffer_z4 = 0
         ether transmit block(0, bytes + 6, p0 buffer_ra)
      %repeat
%end %of %program
