!**********************************************************
!*                                                        *
!*       RCO ITP to GEC Network Management Module         *
!*                                                        *
!*                       PCME                             *
!*                                                        *
!*           Version    9.3  11 Apr  1983                *
!*                                                        *
!**********************************************************

!*
%control 1 ;!No record checking.
!*
%begin
!*
!**************************
!*                        *
!*    Declarations        *
!*                        *
!**************************

!****** Constintegers ******
!*

!States
%constinteger estb = 2
%constinteger wait data = 1
%constinteger disconnected = 0

!* modes

%constinteger idle = 0
%constinteger sft sent = 1
!estb = 2
%constinteger go sent = 3
%constinteger expect data = 4

%constinteger interact = 0
%constinteger dump = 1
%constinteger hex = 1
%constinteger interp = 2
%include "inc_config"
%include "INC_VARIOUS"
%include "INC_DISCQUALS"
%include "INC_XGTFNS"
%include "INC_SERS"
%include "INC_ITPBITS"

!Reasons for grabbing buffers
%constinteger send prompt              = x'81'
%constinteger send err prompt          = x'83'
%constinteger send rpos = x'84'
%constinteger send rneg = x'85'
%constinteger send mr = x'86'
%constinteger send ss = x'87'
%constinteger send es = x'88'
%constinteger send unknown = x'89'
%constinteger send go = 1
%constinteger send er = 2
%constinteger send ms = 3
%constinteger send sft = 0

!Monitor Calls
%constinteger grotted 1                =  1
%constinteger grotted 2                =  2
%constinteger query                    =  3
%constinteger grotted 3                =  5
%constinteger grotted 4                =  6
%constinteger from rco                 =  8
%constinteger from gec                 =  9
%constinteger mon to gec               = 19
%constinteger mon to rco               = 26
%constinteger push error = 33
%constinteger pop error = 34


!Various consts
%constinteger window                   =  2

!*
!****** End of Constintegers ******
!*


!*
!****** Recordformats ******
!*
%include "INC_nFORMATS"

%recordformat sidef(%byte proc, state, inputs, outputs, %record (qf) outq)

%ownbyte param, cnsl, mode

!*
!****** Monitoring Information ******
!*
%ownbyte monbyte = 1 ;!EXT
!*
!****** Names ******
!*
%ownrecord (sidef) rco
%ownrecord (sidef) gec
%ownrecord (sidef) %name this side
%ownrecord (sidef) %name other side
!*
!****** Records and Recordarrays ******
!*
%constrecord (qf) %name null == 0
%ownrecord (pf) p = 0
%owninteger i,j,logopt, dataopt,option,buffers held = 0
%ownstring (255) itpbuff
!*
!****** Routine Specs ******
!*
%include "INC_EXTS"
%externalstring (31) %fnspec itos(%integer no, posns)
%routinespec ask for buffer(%record (mef) %name mes, %byte reason)
%routinespec free buffer(%record (mef) %name mes) ;!EXT
%routinespec handle gec data(%record (pf) %name p)
%routinespec handle outq(%record (sidef) %name side)
%routinespec handle ts packet(%byte ser)
%routinespec handle rco data(%record (mef) %name mes)
#if ~f
%routinespec monitor(%record (pf) %name p, %integer type) ;!EXT
#fi
%routinespec query process
%routinespec pass on(%record (pf) %name p)
%record (qf) %mapspec pop(%record (qf) %name q) ;!EXT
%routinespec push(%record (qf) %name q,item) ;!EXT
%routinespec send(%record (mef) %name mes, %c
%integer fn,%record (sidef) %name side)
%routinespec stop(%integer reason)
!*
!****** Others ******
!*
%constinteger textmax = 9
%ownstring (8) %array text(0:textmax) = %c
"<>",
"<>?:",
"",
"Err<>?:",
"Rpos<>",
"Rneg<>?:",
"MR",
"SS<>",
"ES<>",
"Unkn<>"
!************************
!*                      *
!*    Main Program      *
!*                      *
!************************
!*
change out zero = t3 ser
printstring("PCME Running
")

linkin(pcme ser)
map virt(buffer manager, 6, 5)
map virt(buffer manager, 5, 4)

%for i = 0,1,textmax %cycle
   %if length(text(i)) > 0 %start
      %for j = 1, 1, length(text(i)) %cycle
         %if charno(text(i), j) = '<' %then charno(text(i), j) = 10
         %if charno(text(i), j) = '>' %then charno(text(i), j) = 13
      %repeat
   %finish
%repeat

!Tell ACCOUNT we're up
p_ser = account ser
p_reply = own id
p_fn = hello
p_s1 = pcme ser
pon(p)

%cycle
   p_ser = 0
   poff(p)
   %if int = '?' %start
      query process
#if ~f
      monitor(null, query)
#fi

   %elseif int&x'df' = 'Z'
      p_ser = account ser ;p_reply = own id
      p_fn = goodbye ;p_s1 = pcme ser
      pon(p)
      %stop

   %elseif '0' <= int <= '9'
      monbyte = monbyte - '0'

   %finish
   int = 0

   buffers held = buffers held + 1 %unless p_m == null
   handle ts packet(p_reply)
%repeat

!*********************
!*                   *
!*    Routines       *
!*                   *
!*********************



%routine ask for buffer(%record (mef) %name mes, %byte reason)
   !This routine fires off a buffer request to Buffer Manager
   %record (pf) p
   %integer i,j,k,ol
   
   %if mes == null %start
      p_ser = buffer manager ;p_reply = own id
      p_fn = request buffer 
      p_len = 0
      ponoff(p)
      mes == p_m
   %finish


   free buffer(mes) %and %return %unless this side_state = estb

   %if reason <= 127 %start
      %if reason = send sft %start
         mes_l = 5
         mes_data(0) = x'84' ;mes_data(1) = 3 ;mes_data(2) = 0
         mes_data(3) = param >>8 ;mes_data(4) = param & 255

      %elseif reason = send go
         mes_l = 3
         mes_data(0) = x'82' ;mes_data(1) = 2 ;mes_data(2) = 0

      %elseif reason = send er
         mes_l = 3
         mes_data(0) = 0 ;mes_data(1) = 4 ;mes_data(2) = 0

      %elseif reason = send ms
         mes_l = 3
         mes_data(0) = 0 ;mes_data(1) = 3 ;mes_data(2) = param

      %finish

      push(gec_outq, mes)
      handle outq(gec)

   %else
      mes_itp_hb2 = 0
      mes_itp_hb3 = terminate bit
      mes_itp_s = text(reason&127)
      %if reason = send mr %start
         mes_itp_s = mes_itp_s.itos(param, 1)
         mes_itp_s = mes_itp_s.text(0)
      %finish
      mes_l = length(mes_itp_s) + 4

      push(rco_outq, mes)
      handle outq(rco)

   %finish
   %return

%end ;!of Buffer Arrived


%routine free buffer(%record (mef) %name mes)
   %record (pf) p
   %if mes == null %then %return ;!No buffer to free
   p_ser = buffer manager ;p_reply = own id
   p_fn = release buffer
   p_m == mes
   buffers held = buffers held - 1
   stop(grotted 2) %if 0 # mes_type # 64
   pon(p)
%end ;!of Free Buffer


%routine handle gec data(%record (pf) %name p)
   %routinespec interpret(%byte char)
   %routinespec pack(%byte char)
   %routinespec packhex(%integer n, places)
   %integer i, m, n, q
   %string (255) s
   %record (mef) %name mes
   mes == p_m

   %if rco_state = estb %start

      %if mode = sft sent %start
         %if mes_data(1) = 0 %and mes_data(2) = 0 %start
            !Rpos rec'd ok
            ask for buffer(mes, send go) ;mes == null
            ask for buffer(null, send rpos) %if logopt # 0
            mode = go sent

         %else
            ask for buffer(mes, send rneg) ;mes == null
            mode = idle

         %finish

      %elseif mode = go sent
         ask for buffer(null, send ss) %if logopt # 0
         mode = expect data

      %elseif mes_data(0) = 0 %and (mode = estb %or mode = expect data)
         %if mes_data(1) = 1 %start
            param = mes_data(2)
            ask for buffer(mes, send ms) ;mes == null
            ask for buffer(null, send mr) %if logopt # 0
            mode = expect data

         %elseif mes_data(1) = 2
            ask for buffer(mes, send er) ;mes == null
            ask for buffer(null, send es) %if logopt # 0
            mode = idle
            ask for buffer(null, send prompt)

         %else
            ask for buffer(null, send unknown)
            write(mes_data(0), 1) ;write(mes_data(1), 1) ;write(mes_data(2), 1) ;newline

         %finish
      %elseif mode = expect data
         %if mes_data(0) > 127 %then mode = estb %and mes_data(0) = mes_data(0) & 127
         %if dataopt = hex %start
            itpbuff = ""
            %if length(mes_ds) # 0 %start
               %for i = 1, 1, length(mes_ds) %cycle
                  packhex(mes_data(i), 2)
                  %if i = 32 %then pack(10) %and pack(13)

               %repeat
            %finish
            pack(13) ;pack(10)

         %elseif dataopt = interp
            %if length(mes_ds) # 0 %start
               %for i = 1, 1, length(mes_ds) %cycle
                  interpret(mes_data(i))
               %repeat
            %finish

         %else
            itpbuff = mes_ds

         %finish

         %if option = interact %start
            %if length(itpbuff) # 0 %start
               mes_itp_s = itpbuff
               mes_l = length(itpbuff) + 4
               mes_itp_hb2 = 0 ;mes_itp_hb3 = terminatebit
               push(rco_outq, mes)
               mes == null ;itpbuff = ""
            %finish
         %else
            selectoutput(2) ;printstring(s) ;selectoutput(0)

         %finish

      %finish
   %finish

   free buffer(mes)

   %return
   %routine interpret(%byte char)
      %if inst = hdr %start
         hdr(inct) = char ;inct = inct + 1
         %if inct = 8 %start
            %if hdr(6) = 255 %and hdr(7) = 255 %then inst = initdata %else inst = datal1
            inct = 0
         %finish

      %elseif inst = datal1
         datal = char
         inst = datal2

      %elseif inst = datal2
         datal = datal << 8 + char
         state = data

      %elseif inst = initdata
         inct = inct + 1
         %if inct = 4 %start
            inst = hdr ;inct = 0
         %finish

      %elseif inst = data
         data(inct)  =char ;inct = inct + 1
         %if inct = datal %start
            packhex(hdr(6)<<8 + hdr(7), 4) ;pack(' ')
            packhex(hdr(2)<<8 + hdr(3), 4) ;pack(' ')
            %for i = 0, 1, 3 %cycle
               packhex(data(i), 2) ;pack(' ')
            %repeat
            pack(10) ;pack(13)
            inst = hdr ;inct = 0
         %finish

      %finish
   %end ;!of interpret

   %routine pack(%byte char)
      length(itpbuff) = length(itpbuff) + 1 ;charno(itpbuff, length(itpbuff)) = char
   %end ;!of pack

   %routine packhex(%integer val, places)
   %integer i,j,mask
   mask=15<<((d-1)<<2)

   %cycle i=0,1,d-1
      j=(n&mask)>>((d-i-1)<<2) ;mask=mask>>4
      %if j>9 %then j=j+7
      j=j+'0'
      pack(j)
   %repeat
   %end ;!of packhex
%end ;!of Handle GEC Data

%routine handle outq(%record (sidef) %name side)
   !Sends off data waiting to go to side unless we are out of transmission window
   %record (mef) %name mes
   %byte fn
   %if cnsl # 0 %or side == gec %start
      %while side_outq_count # 0 %and side_outputs < window %cycle
         mes == pop(side_outq)
         p_s1 = 0 ;!Don't PUSH it
         mes_itp_cnsl = cnsl %if side == rco
         send(mes, data, side)
      %repeat
   %finish

%end ;!of Handle outq

%routine handle rco data(%record (mef) %name mes)
   %string (127) s
   %integer i, j, q
   q = send err prompt
   %if gec_state = estb %start
   %if mes_itp_hb2 & controlbit = 0 %start ;!User data
      %if mes_itp_s -> ("+").s %start
         %if s -> ("F").s %and mode = idle %start
            i = charno(s, 1) - '0' ;j = charno(s, 2) - '0'
            i = i - 7 %if i > 9 ;j = j - 7 %if j > 9
            param = i <<8 + j
            mode = sft sent
            param = i<<8 + j
            q = send sft

         %elseif s -> ("L").s
            logopt = 1 ;!Switch on logging
            q = send prompt

         %elseif s -> ("H").s
            dataopt = hex
            q = send prompt

         %elseif s -> ("I").s
            dataopt = interp
            q = send prompt

         %elseif s -> ("D").s %and mode = idle
            option = dump
            q = send prompt

         %finish
      %finish

      ask for buffer(mes, q) ;mes == null

   %elseif mes_itp_hb2 & hellobit # 0
      cnsl = mes_itp_cnsl
      ask for buffer(mes, send prompt) ;mes == null

   %finish
   %finish
   free buffer(mes)

%end ;!of Handle RCO Data

%routine handle ts packet(%byte ser)
   %record (mef) %name mes
   %integer gate port, task port
   mes == p_m
   task port = p_task port
   gate port = p_gate port
#if ~f
   %if ser = gatex ser %then monitor(p, from gec) %else %c
   monitor(p, from rco)
#fi
   %if ser = gatex ser %then this side == gec %and other side == rco %else this side == rco %and other side == gec

%if p_fn = accept call %start
   cnsl = 0 ;mode = 0 ;rco = 0 ;gec = 0 
   logopt = 0 ;dataopt = 0 ;option = 0
   itpbuff = ""
   rco_proc = task port ;gec_proc = gate port
   rco_state = estb ;gec_state = estb
   pass on(p)
   send(null, no goaheads, rco)

%elseif p_fn = data %or p_fn = control data
   this side_inputs = this side_inputs + 1
   %if this side == rco %then handle rco data(mes) %else %c
   handle gec data(p)
   %if other side_outputs + other side_outq_count < window %and %c
   this side_inputs # 0 %start
      p_s1 = this side_inputs ;this side_inputs = 0
      send(null, ack, this side)
   %finish

%elseif p_fn = disconnect
   rco_proc = task port %if rco_proc = 0
   gec_proc = gate port %if gec_proc = 0
   free buffer(pop(this side_outq)) %while this side_outq_count # 0
   this side_outputs = 0
   other side_state = disconnected
   pass on(p)
   %return

%elseif p_fn = connect
   %if rco_state = disconnected %and gec_state = disconnected %start
      p_s1 = 1 ;!Not T.S.
      pass on(p)

   %else
      i = p_ser ;p_ser = p_reply ;p_reply = i
      p_fn = disconnect
      pon(p)

   %finish
   %return

%elseif p_fn = ack
   this side_outputs = this side_outputs - p_s1
   %if this side_outputs + this side_outq_count < window %and %c
   other side_inputs # 0 %start
      p_s1 = other side_inputs ;other side_inputs = 0
      send(null, ack, other side)
   %finish

%else
   pass on(p)
   %return

%finish

   handle outq(rco)
   handle outq(gec)
   %return

%end ;!of Handle TS packet

#if ~f
%routine monitor(%record (pf) %name p,%integer type)
   %recordformat pfa(%bytearray a(0:27))
   %record (pfa) %name pa
   %integer i,j,k
   %record (mef) %name mes
   
   %if monbyte & 2 # 0 %start ;!Log to .TT
      printstring("*PCME") ;write(type,1) ;newline
   %finish
   selectoutput(1)
   %if p == null %start
      printsymbol(2) ;printsymbol(pcme ser) ;printsymbol(type)
   %else
      pa == p
      printsymbol(10) ;printsymbol(pcme ser) ;printsymbol(type)
      %for i = 0,1,7 %cycle
         printsymbol(pa_a(i))
      %repeat
      %unless p_m == null %start
         pa == p_m
         printsymbol(28)
         %for i = 0,1,27 %cycle
            printsymbol(pa_a(i))
         %repeat
      %finish
   %finish
   selectoutput(0)
   %return
%end ;!of Monitor
#fi

%routine pass on(%record (pf) %name p)
   %if p_reply = gatex ser %start
      p_ser = bridge ser
      p_reply = pcme ser
#if ~f
      monitor(p, mon to rco)
#fi
   %else
      p_ser = gatex ser 
      p_reply = pcme ser
#if ~f
      monitor(p, mon to gec)
#fi
   %finish
   %unless p_m == null %start
      buffers held = buffers held - 1
      stop(grotted 3) %if 0 # p_m_type # 64
   %finish
   pon(p)
%end ;!of Pass On

%routine push(%record (qf) %name q,new)
   %if new == null %then stop(push error)
   %if q_link == null %start
      q_link == new
      new_link == new
   %else
      new_link == q_link_link
      q_link_link == new
      q_link == new
   %finish
   q_count = q_count + 1
%end ;!of Push


%record (qf) %map pop(%record (qf) %name q)
   %record (qf) %name old
   %if q_link == null %or q_count = 0 %then stop(pop error)
   %if q_link_link == q_link %start ;!One element only on Q
      old == q_link
      q_link == null
   %else
      old == q_link_link
      q_link_link == old_link
   %finish
   q_count = q_count - 1
   %result == old
%end ;!of Pop


%routine query process
   %integer i,j
   %routinespec monside(%record (sidef) %name side)
   printstring("BH=") ;write(buffers held, 1) ;newline
   printstring("CL,IQ:")
   write(cnsl, 1) ;write(mode, 1)
   printstring(" RCO:") ;monside(rco)
   printstring(" GEC:") ;monside(gec)
   newline

   %routine monside(%record (sidef) %name side)
      write(side_proc, 2)
      write(side_state, 1)
      write(side_inputs, 1)
      write(side_outputs, 1)
      write(side_outq_count, 1)
   %end ;!of Monside (in Query Processes)
%end ;!of Query Process








%routine send(%record (mef) %name mes, %integer fn ,%record (sidef) %name side)
   %byte q
   %if fn = data %or fn = control data %then side_outputs = side_outputs + 1
   p_reply = pcme ser
   p_fn = fn
   p_m == mes
   p_gate port = gec_proc
   p_task port = rco_proc
   %if side == rco %start
      p_ser = bridge ser
#if ~f
      monitor(p, mon to rco)
#fi
   %else
      p_ser = gatex ser
#if ~f
      monitor(p, mon to gec)
#fi
   %finish
   %unless p_m == null %start
      buffers held = buffers held - 1
      stop(grotted 4) %if 0 # p_m_type # 64
   %finish
   pon(p)
   %return
%end ;!of Send

%routine stop(%integer reason)
   printstring("PCME Stopped") ;write(reason, 1)
#if ~f
   monitor(null, query)
#fi
   %cycle
   %repeat
%end ;!of Stop





%endofprogram