!**********************
!* nipolls/nipolly   *
!*                   *
!*********************
%conststring (13) vsn = "nipoll..1b"

#options

#datestring
!! stack = 300, streams = 1

%control x'4001'
%include "b_deimosspecs"


%begin

#if ~b
%recordformat lev3f(%byteintegerarray reserved(0:6), %c
       %byteintegerarray a(0:239))
%recordformat mef(%record(mef)%name link,%byteinteger len,type,  %c
   (%record(lev3f) lev3 %or %bytearray a(0:241)))

%recordformat pf(%byteinteger service,reply,(%byte fn,ss1,  %c
%record(mef)%name mes,%byteinteger gate port, task port %or %c
  %byte a1, a2, b1, b2, c1, c2))
#else
%recordformat lev3f(%bytearray reserved(0:6), %bytearray a(0:239))

%recordformat mef(%integer buff no, len, %byte owner, type, %c
    (%record (lev3f) lev3 %or %bytearray a(0:241)))

%recordformat pf(%byte service, reply, (%byte fn, ss1, %c
%integer buff no, %byte gate port, task port %or %c
 %byte a1, a2, b1, b2, c1, c2))
#fi

%recordformat qf(%record (mef) %name m)

%recordformat lcnf(%integer state, caaf, %record (qf) outQ, %c
                   %integer task port, gate port, reason, diag, %c
                   %string (63) address, %string (127) data)

%recordformat ttf(%integer rxs,rxd, txs, txd)

%constrecord (ttf) %name tt == k'076170';    ! in seg 3

%constinteger init = 1,
              call = 2,
              clr  = 3,
              caa  = 4,
              data = 5

%constinteger syn flag = x'fe'


%constinteger max lcns = 16
%owninteger next lcn = 1;      ! the next ref we will use
%owninteger indatap =0, outdatap = 0, outend = 0
%owninteger istate, ilen, ilcn, glcn
%ownbytearray indata(0:256)
%ownrecord (mef) %name outmes

%constinteger tt in = -11
%constinteger tt out = -12

%ownrecord (lcnf) %array lcna(0:max lcns)
%ownrecord (lcnf) %name lcn

%record (pf) p

%ownrecord (qf) Qout

%constinteger gate ser=24, buffer manager=17
%constinteger request buffer=0, release buffer=1
%include "b_ygatecalls"
      %integer i, node, term, strm, k, flag, pktlen, pktinc
      %owninteger seq number
      %owninteger sta, pkts, tim, ticks, pk, comm
      %owninteger fast = 30
      %owninteger conn ok, g port, power, kill it
      %record (mef) %name mes

      %ownstring (63) address = ""
      %ownstring (63) facil = ""
      %owninteger mon = 0
      %owninteger i mon = -1;       ! individual line monitoring
      %owninteger check inp=0;      ! don't check input
      %owninteger d1, d2
      %owninteger slow = 0;         ! send a packet every 2 secs or so
      %ownstring(1) snil = ""
      %ownstring (255) I data

      %routinespec start output
      %routinespec to gate(%integer fn, %record (mef) %name mes, %integer flag)

      %routine mon mes(%record (mef) %name mes)
         %integer i, j, k, n
         %recordformat itp2f(%bytearray a(0:128))
         %record (itp2f) %name itp

         k = mes_len;  itp == mes_lev3
         write(k, 1); space; space
         j = 0
         %cycle i = 0, 1, k
            %if mon > 0 %and i > 3 %start;        ! 'p' and not header
               n = itp_a(i)
               printsymbol(n) %unless n = 0 %or n = 4
            %else
                  write(itp_a(i), 1)
               j = j+1;  %if j = 25 %then j = 0 %and newline
            %finish
         %repeat
         newline;  select output(0)
      %end
   
      %routine mon p(%record (pf)%name p)
         %record (mef) %name mes
         %integer i
         printstring(" fn ="); write(p_fn, 1)
         printstring(" gate port"); write(p_gate port, 1)
         printstring(" task port"); write(p_task port, 1)
         printstring(" a2"); write(p_a2, 1)
#if b
         printstring(", buff:"); write(p_buff no, 1)
#fi
         newline
      %end

      %routine do mon
         %integer i
         printstring("
Ind  State  Task-p Gate-p reason diag
")
         %cycle i = 1, 1, 16
            lcn == lcna(i)
            write(i, 5); write(lcn_state, 3)
            write(lcn_task port, 5); write(lcn_gate port, 5)
            write(lcn_reason, 5); write(lcn_diag, 5)
            newline
         %repeat
      %end

      %integerfn check(%integer n)
         %result = n %unless n = 10
         %result = x'fc'
      %end

      %routine scheck(%string (*) %name s)
         %integer i
         %return %if length(s) = 0
         %cycle i = 1, 1, length(s)
            charno(s, i) = check(charno(s, i))
         %repeat
      %end

      %routine pack(%record(mef) %name mes, %string (*) %name s)
         string(addr(mes_a(mes_len))) = s
         mes_len = mes_len+length(s)+1
      %end


      %routine do connect(%record (mef) %name mes)
      !============================================================

      %string (63) facn

         glcn = p_c2;    ! find the process
         lcn == lcna(glcn)
         p_service = gate ser; p_reply = own id
         p_fn = connect
         p_gate port = 0; p_task port = lcn_task port
         p_ss1 = 0
#if ~b
         p_mes == mes
#else
         p_buff no = mes_buff no
#fi
         mes_len = 0
         facn = lcn_address
         pack(mes, facn)
         pack(mes,snil);                ! calling address
         pack(mes, snil)
         pack(mes, snil)
         %if mon # 0 %or imon = glcn %start
            select output(1)
            write(glcn, 1)
            printstring(" C:"); write(lcn_task port, 1); space
            printstring(lcn_address); newline
            select output(0)
         %finish
         pon(p)
         lcn_caaf = 0
         lcn_gate port = 0;      ! filled in on the accept
      %end

#if ~b
      %routine get buffer(%integer reason, proc)
         p_service=buffer manager;   p_reply=id
         p_fn=request buffer;   p_c2=proc;   p_a2=reason
         p_c1 = 0
         pon(p)
      %end

%routine free buffer(%record(mef)%name mes)
      p_service=buffer manager;   p_reply=id
      p_fn=release buffer;   p_mes==mes
      pon(p)
%end
#else
     %record (mef) %map map(%integer buff no)
        ! New compiler  - so must get 0
        *mov_1,0
        *mov_#8,1;     ! desired vm seg no *2 ie 4*2
        *iot
        %result == record(k'100000')
     %end
%routine free buff no(%integer buff no)
     ! not mapped, so send it straight back
   p_service= buffer manager; p_reply = id
   p_fn = release buffer
   p_buff no = buff no
   pon(p)
%end

%routine free buffer(%record (mef) %name mes)
   %record (pf) p
   %integer buff no

       ! nb: routine ASSUMES buffer is mapped on
   buff no = mes_buff no
   %unless mes == null %start
      !There really is a buffer
         !Tell Buffer Manager it can have its buffer back.
         p_service = buffer manager ;p_reply = id
         p_fn = release buffer
         p_buff no = buff no
         pon(p)
   %finish
%end ;!of Free Buffer

%routine get buffer(%byte reason)
   p_a2 = reason
   !Check on reason prevents recursive calls
      p_service = buffer manager ;p_reply = id
      p_fn = request buffer 
      p_c1 = 0
      pon(p)
   
%end ;!of get buffer
#fi

      %routine buffer here(%record (mef) %name mes, %integer reason)
         %integer i, gl
                      ! Sends Init, CAA, CLR and DATA

         glcn = p_c2; lcn == lcna(glcn)
         gl = glcn

         %if p_ss1 = 254 %start;  ! -2 = data from torch
            %if lcn_data = "" %start
               write(glcn, 1); printstring(" No data now!
")
               free buffer(mes)
               %return
            %finish
            string(addr(mes_lev3_a(0))) = lcn_data
            mes_len = length(lcn_data)
            lcn_data = ""
            to gate(data, mes, 0)
            %return
         %finish

         mes_a(1) = check(glcn)
         mes_a(2) = reason
         mes_a(3) = 0
         mes_a(4) = 10
         mes_a(0) = 4;   ! for init, caa

         %if reason = clr %start;  ! more to go
            mes_a(3) = 2
            mes_a(4) = check(lcn_reason)
            mes_a(5) = check(lcn_diag)
            mes_a(6) = 10
            mes_a(0) = 6;          ! overall length (internal only)
         %else
            %if reason = data %start
               SCHECK(IDATA)
               string(addr(mes_a(3))) = I Data
               mes_a(length(I Data)+4) = 10
               mes_a(0) = length(I Data)+4
               mes_a(3) = check(mes_a(3))
            %finish
         %finish

         %if outdatap = 0 %start
            outmes == mes; start output;  ! get it going NOW
         %else
            push(Qout, mes);          ! line active, so queue it
         %finish

         %if reason = caa %start
            lcn_caaf = 0;                 ! clear 'in progress' flag
            %if lcn_outQ_m ## null %start; ! data waiting to go
               glcn = gl
               buffer here(pop(lcn_outQ), data)
            %finish
         %finish
      %end


     %routine to gate(%integer fn,%record(mef)%name mes,%integer flag)
         p_service=gate ser;   p_reply=id
#if ~b
         p_fn=fn;   p_mes==mes;   p_ss1=flag
#else
         p_fn = fn;  p_buff no = mes_buff no; p_ss1 = flag
#fi
         p_gate port = lcn_gate port; p_task port = lcn_task port
         %if mon < 0 %or imon = glcn  %start
            select output(1)
            printstring("to gate:"); write(fn, 1)
            printstring(" g port, t port:"); write(p_gate port, 1)
            write(p_task port, 1)
            newline
            select output(0)
         %finish
         pon(p)
      %end


      %routine do init
         %integer i

         printstring("Torch IPL
")
         %cycle i = 1, 1, max lcns
            lcn == lcna(i)
            %if lcn_state # 0 %start
               %while lcn_outQ_m ## null %cycle; free buffer(pop(lcn_outq))
               %repeat
               to gate(disconnect, null, x'f1')
               lcn_state = 0
               lcn_gate port = 0
            %finish
         %repeat
      %end

      %routine start output
                 ! block in outmes, send it
         outend = outmes_a(0);  ! length
         outdatap = 1;          ! 1st char that goes is _a(1)
         tt_txd = synflag;      ! but send the flag char first
         tt_txs = k'100';       ! switch on ints (may be 1st block of o/p)
                                ! and wait for interrupt
      %end

      %routine check Q
                 ! check for more ouput
         %return %if Qout_m == null
         outmes == pop(Qout)
         start output
      %end

      %routine process command(%integer comm)

         %integer i
         %switch cm(1:5)

         %if mon < 0 %or imon = ilcn %start
            write(ilcn, 1); printstring(" mCo:"); write(comm, 1)
            newline
         %finish

         -> cm(comm)

cm(1):    ! init
         do init
         %return

cm(2):    ! call
         lcn == lcna(ilcn)
         %if lcn_state # 0 %start
            write(ilcn, 1)
            printstring(" Active call to:"); printstring(Lcn_address)
            write(lcn_state, 1); write(lcn_gate port, 1)
            printstring(" New call to:"); printstring(string(addr(indata(3))))
            newline
            %return
         %finish

         address = string(addr(indata(3)))
         lcn_task port = next lcn
         next lcn = next lcn+1
         %if next lcn = 256 %then next lcn = 1
         lcn_address = address
         get buffer(-1, ilcn)
         lcn_state = 1;                ! set state to call sent
         ! process call
         %return;                      ! wait for buffer

cm(3):    ! clr
         lcn == lcna(ilcn)
         %if lcn_state <1 %or lcn_state > 2 %start
            write(ilcn, 1)
            printstring(" Clr ?, state ="); write(lcn_state, 1)
            newline
            i mon = ilcn
            %return
         %finish
           %if mon # 0 %or imon = ilcn %start
             select output(1)
             write(ilcn, 1); printstring(" mclr
")
             select output(0)
         %finish
         to gate(disconnect, null, indata(5))
         lcn_state = 0
         lcn_task port = 0
         %return

cm(4):    ! caa
         printstring("CAA is invalid
")
         %return

cm(5):    ! data
         printstring("Data
")
        lcn == lcna(ilcn)
        %if lcn_data # "" %start
           printstring("data already here - see bg
")
           %return
        %finish
        lcn_data = string(addr(indata(3)))
        get buffer(-2, ilcn)
        %return


%end

%routine do ttin
      %integer char
      %switch sw(0:4)

      char = tt_rxd
      %if mon = -1 %start
         printstring("I:"); write(char, 1); write(istate, 1)
         write(indatap, 1); newline
      %finish
      indata(indatap) = char; indatap = indatap+1

      %if istate # 0 %and char = syn flag %start
         printstring("flag in block, pos ="); write(indatap, 1)
         newline
         istate = 1
         %return
      %finish

      -> sw(istate)

sw(0):   ! idle
      %if char # syn flag %start
         printstring("exp flag, act ="); write(char, 1); newline
         istate = 0; %return
      %finish
      istate = 1
      indatap = 1;    ! lcn to go to byte 1
      %return

sw(1):  ! the LCN
      ilcn = char
      %if ilcn < 0 %or ilcn > 16 %start
         printstring("Illegal lcn ="); write(ilcn, 1); newline
         ilcn = 0
      %finish
      istate = istate+1
      %return

sw(2):  ! the command
      comm = char
      %if comm < 1 %or comm > 5 %start
         printstring("Bad Comm ="); write(comm, 1); newline
         istate = 0
         %return
      %finish
      istate = 3
      %return

sw(3):  ! the length
      ilen = char
      %if ilen = 0 %then -> process
      istate = 4
      %return

sw(4):  ! the data
      ilen = ilen-1
      %if ilen = 0 %then -> process
      %return


process:  process command(comm)
      istate = 0

%end

%routine do ttout

      %if outdatap > outend %start
         outdatap = 0; free buffer(outmes)
         check Q
         %return
      %finish

      tt_txd = outmes_a(outdatap)
      %if mon = -1 %start
         printstring("O:"); write(outmes_a(outdatap), 1); newline
      %finish
      outdatap = outdatap+1
%end

      %routine from gate
         %integer i, x
#if b
            mes == map(p_buff no)
            mes_owner = own id %unless p_buff no = 0
#else
            mes == p_mes
#fi
            glcn = 0
            %cycle i = 1, 1, 16
               %if lcna(i)_task port = p_task port %start
                  glcn = i; lcn == lcna(i)
                  %exit
               %finish
            %repeat

            %if glcn = 0 %and p_fn # disconnect %start
                                   ! must have a valid one (except in call)

               printstring("No call for T port:"); write(p_task port, 1)
               printstring(", Gate fn:"); write(p_fn, 1); newline
               do mon
               %return
            %finish


            %if p_fn = accept call %start;  ! 2nd reply
               free buffer(mes) %unless mes == null
               i = p_gate port;   ! gate port number !!
               lcn_gate port = i
               %if mon # 0 %or imon = glcn %start
                  select output(1)
                  write(glcn, 1)
                  printstring(" CAA
")
                  select output(0)
               %finish
               %if lcn_state # 1 %start
                  write(glcn, 1)
                  printstring(" CAA in wrong state ="); write(lcn_state, 1)
                  newline
               %finish

               lcn_state = 2
               lcn_caaf = 1;           ! set flag to signify that caa is requested
               get buffer(caa, glcn)
               %return
            %finish

            %if p_fn = disconnect %start
               x = p_ss1
               d1=mes_lev3_reserved(2); d2 = mes_lev3_reserved(3)
               free buffer(mes) %unless mes == null
               %if mon # 0 %or imon = glcn %start
                  select output(1)
                  write(glcn, 1)
                  printstring(" Clr")
                  write(x, 1)
                  write(d1, 3); write(d2, 1); newline
                                   ! bit tacky here -
                  select output(0)
               %finish
                                   ! after Mark  has dropped a connection we
                                   ! assume it will tidy up cleanly before
                                   ! all 256 lcns are used again
               %if glcn # 0 %start;   ! ie mark wants to know
                  To Gate(disconnect, null, 1) %if lcn_state = 2
                  lcn_reason = d1; lcn_diag = d2
                  get buffer(clr, glcn)
                  lcn_state = 0
                  lcn_task port = 0
               %finish
               %return
            %finish

            %if p_fn = enable output %start
               %return
            %finish

            %if p_fn = input here %start
               pkts = pkts+1
               
               %if lcn_state # 2 %start
                  write(glcn, 1)
                  printstring(" Data in wrong state ="); write(lcn_state, 1)
                  newline
               %finish

               ! deal with the data

               mes_lev3_a(0) = mes_len
               I Data = string(addr(mes_lev3_a(0))); ! copy out of way
               p_c2 = glcn;               ! set up for buffer here
               %if lcn_caaf # 0 %start
                  push(lcn_outQ, mes); ! CAA in progress, so Q it.
               %else
                  buffer here(mes, data);    ! and reformat block
               %finish
               to gate(enable input,null,1)
               %if mon # 0 %or imon = glcn %start
                  select output(1)
                  write(glcn, 1); printstring(" D ")
                  %if lcn_caaf # 0 %then printstring("Q")
                  newline
                  select output(0)
               %finish
               %return
            %finish

            %if p_fn = reset %start
                free buffer(mes) %unless mes == null
               to gate(Disconnect, null, 0); kill it = -1
               %return
            %finish

            printstring("funny fn"); write(p_fn, 1); newline
      %end

! *************************************************************************
!               s t a r t    o f   m a i n   p r o g r a m
! *************************************************************************

      printstring(vsn); printstring(datestring); newline
       i = map virt(buffer manager, 5, 4)
       i = map virt(buffer manager, 6, 5)

      map hwr(3);               ! map the asynch line in

      linkin(tt in)
      linkin(tt out)

      use tt(t3 ser)

      alarm(2*50)

      tt_rxs = 0;                  ! zero the tt descriptor
      tt_txs = 0
      tt_rxs = tt_rxs!k'100';  ! switch on input ints

      set prio(3)

      get buffer(Init, 0)

      %cycle
         p_service = 0; poff(p)

         %if p_service = ttin&255 %start
            do ttin; %continue
         %finish

         %if p_service = ttout&255 %start
            do ttout; %continue
         %finish

         %if p_reply = 0 %start;    ! clock
               alarm(2*50);             ! 2 secs
               %if int = 'A' %start
                  kill it = -1
                  printstring("killing it
")
                  int = 0
                  %continue
               %finish
            ticks = ticks+1

            %if int = 'X' %start;  ! re-synch
               get buffer(Init, 0)
               int = 0
               %continue
            %finish

            %if int='?' %start
               do mon
               int = 0
            %finish
             %continue
         %finish

         %if 'M' <= int <= 'P' %start
            mon = int-'O'; int = 0
            imon = -1
         %finish
         %if mon < 0 %start
            select output(1)
            printstring("poff:"); write(p_reply, 1)
            write(p_fn, 1); write(p_ss1, 1)
            %if p_reply = gate ser %then mon p(p)
            newline
            select output(0)
         %finish

         %if p_reply = buffer manager %start
#if b
            mes == map(p_buff no)
            mes_owner = own id
#else
            mes == p_mes
#fi
            %if kill it < 0 %then free buffer(mes) %and %continue
            %if p_ss1 = 255 %then do connect(mes) %else %c
            buffer here(mes, p_ss1)
            %continue
         %finish
         %if p_reply = gate ser %start
            from gate
            %continue
         %finish
      %repeat
%endofprogram