! file 'fep_eam77'

!********************************
!*  emas-2900  fep am1 handler  *
!*       file: eam7             *
!*       date: 19.jul.82        *
!* modified for pcb interface   *
!********************************
!! stack size = 300

%owninteger fep no = 9;               ! number supplied on load

%control 1
%include "deimosperm"

%begin

      %conststring (13)vsn = "am1h:vsn07w
"

      %recordformat am1 linkf(%integer rxs, rxd, txs, txd)

      %constrecord (am1 linkf) %name inter A == k'075160'; ! in seg 3 ?
      %constrecord (am1 linkf) %name inter B == k'075170'; ! i/f #2

      %ownrecord (am1 linkf) %name  l == 1;  ! supplied on start

      %recordformat nsi3f(%byteintegerarray a(0:100))

      %recordformat mef(%record (mef) %name link, %c
        %byteinteger len, type, %record (nsi3f)nss)
                                     ! think about the position of 'len'

      %recordformat m2900f(%record (mef) %name link, %byteinteger len, type, %c
        %integer stream, sub ident, %c
         p2a, p2b, p3a, p3b, p4a, p4b, p5a, p5b, p6a, p6b)

      %recordformat m2900cf(%record (mef) %name link, %byteinteger len, type, %c
        %byteintegerarray b(0:23))


      %recordformat pe(%byteinteger ser, reply, %c
        fn, port, %record (mef) %name mes, %integer str)

      %recordformat p2f(%byteinteger ser, reply, %c
        fn, port, %record (mef) %name mes, %integer str)

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


      !********************************************************
      !*  formats of tables, ie stream descriptors, tcps etc  *
      !********************************************************
      %recordformat streamf(%integer owner, id 2900)
      !*************************************************************
      !*     am1 commands  (when the ninth bit is set)
      !*************************************************************
      %constinteger primary = x'00'
      %constinteger funny = 1
      %constinteger read = x'02'
      %constinteger write c = x'03'
      %constinteger sense = x'04'
      %constinteger write control = x'05'
      %constinteger identify = x'0a'
      %constinteger limit = x'0c'
      %constinteger property = x'0e'

      !*****  primary status bits  (11/34 -> 2900)
      %constinteger unsuccessful = x'80'
      %constinteger attention = x'20'
      %constinteger terminated = x'10'
      %constinteger short block = x'08'
      %constinteger long block = x'04'
      %constinteger condition x = x'02'
      %constinteger condition y = x'01'

      !******************************************
      !* 2900 constants
      !******************************************
      %constinteger property code = 14; ! as defined by k.y.
      %constinteger attn byte = x'80'
      !********************************************************
      !*    2900 am1 link transmitter & receiver bits
      !********************************************************
      %constinteger int on = k'100';    ! both
      %constinteger ready = k'200';     ! both

      %constinteger scfy = k'010';           ! transmitter only (txfy)
      %constinteger maint = k'002';           ! force parity inbound error
      %constinteger operable = k'004';       ! transmitter only

      %constinteger comm bit = k'001'
      %constinteger accept char = k'002'; ! really 'fetch next'
      %constinteger rset = k'004'
      %constinteger acfy = k'010';     ! peter calls it rxfy
      %constinteger xopl = k'020';     ! x operable - latched
      %constinteger xop  = k'040';     ! x operable
      !**************************************************************
      !*         buffer manager calls   (from and to)               *
      !**************************************************************
      %constinteger buffer here = 0
      !********** to buffer manager ***********
      %constinteger request buffer = 0
      %constinteger release buffer = 1
      !**************************************************************
      !*             calls to 2900 link handler                     *
      !**************************************************************
      %constinteger send data = 0
      %constinteger low level control = 1
      %constinteger here i am = 2
      %constinteger return control = 3
      %constinteger stop = 4

      %constinteger high lev con len = 24
      ! %constinteger low lev con len = 8
      !**************************************************************
      !*               replies from 2900 link handler                 *
      !****************************************************************
      %constinteger  interf addr = 0
      %constinteger do input = 1
      %constinteger do output = 2
      %constinteger message = 3
      %constinteger mainframe up = 4
      %constinteger mainframe down = 5
      !***************************************************
      !*      am1 link states
      !***************************************************
      %constinteger idle = 0
      %constinteger user reading = 2
      %constinteger user writing = 3
      %constinteger terminate = 4;        ! -> idle
      %constinteger prop 1 = 5;           ! -> prop 2
      %constinteger prop 2 = 6;          ! -> prop 3
      %constinteger prop 3 = 7;          ! -> prop 4
      %constinteger prop 4 = 8;          ! -> terminate
      %constinteger ident 1 = 9;         ! -> ident 2
      %constinteger ident 2 = 10;        ! -> terminate
      %constinteger next control = 11;    ! -> control m
      %constinteger control m = 12;      ! -> control m 2
      %constinteger control m2 = 13;     ! -> control m 2, or terminate
      %constinteger term x pend = 14;     ! -> term x bit ?
      %constinteger term x bit = 15;      ! (?) -> idle
      %constinteger error = 16;          ! -> idle

      !!   in state  states

      %constinteger initial 4 = 1;       ! states of in state
      %constinteger user read = 2
      %constinteger user write = 3
      %constinteger control input trf = 4
      %constinteger control output trf 1 = 5
      %constinteger control output trf 2 = 6

      %constintegerarray next state(idle:error) =
       idle, error, error, error, idle, prop 2,prop 3,
       prop 4, terminate, ident 2, terminate, 
       control m, control m2, control m2, term x bit, idle, idle
      !****************************************************************
      !********** various service numbers *************
      %constintegername no of small == k'100114'; ! in buff manager

      %constinteger gate ser = 16
      %constinteger buffer manager = 17
      %constinteger link handler = 18
      %constbyteinteger am1 rx int = -13; ! ????????????????????????
      %constbyteinteger am1 tx int = -14;  ! ???????????????????????/

      %constinteger t3 ser = 21
      %constbyteintegername change out zero == k'160310'
      !************************************************************

     !!     state variables

      %owninteger state = 0;            ! transmitter state
      %owninteger in state = idle;         ! input state
      %owninteger to 2900 control;      ! end of outward transfer buff
      %owninteger control pt;           ! start of same
      %owninteger x bit sent;           ! 1 = x bit sent (or about to)
      %owninteger tx int expected;      ! 1 = interrupt expected
      %owninteger term cond = terminated;  ! holds condition to go on terminate
      %owninteger down = 1;                ! 0 = up, 1 = down
      %owninteger clock = 0;               ! missing interrupt count
      %owninteger mon = -1;            ! monitoring flag
      %owninteger swabf = 1;           ! swab flag
      %owninteger tot out l = 0;        ! counts control output mess
      %owninteger xop status = 0
      %owninteger read rej = 0;     ! number of 'out of buffers'
      %owninteger i int, o int, ich, o ch


      %constbyteintegerarray swabx(0:23) =
        1, 0, 3, 2, 4, 5, 6, 7, 8, 9, 10, 11, 12,
        13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23
     !!

      %constinteger lower = -2, upper = 400

      %ownrecord (streamf) %array sta(lower:upper)
      %ownrecord (streamf) %name str

      %ownrecord (m2900cf) %name outm
      %ownrecord (qf) mq;         ! = k'143362'

      %record (pe) p

      %ownrecord (qf) %name buffer pool
      %owninteger no of buff = 0

      %integer i

      %owninteger prflag = 0;     ! dump print flag - temporary
      %owninteger mon pt = 0
      %constinteger mon lim = 1023
      %ownbyteintegerarray mon1(0:mon lim)
      %ownintegerarray mon2(0:mon lim)
      !**************************************************
      !*       routine specs
      !**************************************************
      %routinespec input interrupt
      %routinespec output interrupt
      %routinespec output
      %routinespec interrupt am1
      %routinespec user call
      %routinespec stop interface
      %routinespec clock int
      %routinespec up down(%integer which)
      %routinespec free buffer(%record (mef) %name mes)
      %record (m2900f) %mapspec get buffer
      %routinespec fault(%integer stream, type, add)
      %routinespec monitor(%integer type, info)
      %routinespec octal(%integer i)
      %routinespec dump regs
      !**********************************************
      !*      initialisation                        *
      !**********************************************
      map hwr(3);                       ! map top seg to seg 3
      linkin(link handler)
      linkin(am1 rx int); linkin(am1 tx int)
      printstring(vsn)

      i = map virt(buffer manager, 5, 4);   ! map to my seg 4
      i = map virt(buffer manager, 6, 5); ! and seg 6 to my 5

      sta(2)_id 2900 = 2;                ! artificially set stream 2 up

      p_ser = 0; poff(p);            ! wait for fep no
      fep no = p_fn;                ! supplied by load prog
      l == p_mes;        ! set hardware address
      printstring("fep"); printsymbol(fepno+'0')
      newline

      alarm(50)
      change out zero = t3 ser;       ! switch o/p to comm


      !! remove the tx int bit, set the rx int bit and accept char?
      l_txs=operable;  l_rxs=accept char!int on

      %cycle
         p_ser = 0; poff(p)

         %if p_ser = own id %and p_reply = 0 %start;           ! clock int
            alarm(50)
            %if 'M' <= int <= 'O' %start
               mon = int-'O';  int = 0
            %finish

            %if '1' <= int <= '2' %start
               %if down = 0 %start
                  printstring("Am1h: Wait till Emas is down
")
               %else
                  l_rxs = l_rxs&(\int on); ! ints off on old interface
                  printstring("Am1h: Going to Interface "); printsymbol(int)
                  newline
                  %if int = '1' %then l == inter A %else l == inter B
                  l_txs = operable; l_rxs = accept char!int on
               %finish
               int = 0
            %finish

            %if int = 'F' %start
               int = 0
               select output(1)
               i = mon pt
               %cycle
                  %if mon1(i) # 0 %start
                     printsymbol(mon1(i));  write(mon2(i), 3);  newline
                  %finish
                  i = (i+1)&mon lim
               %repeat %until i = mon pt
               newline
               close output
            %finish
            %if int = 'X' %start
               dump regs
               int = 0
            %finish
            %if int = 'Z' %start
               stop interface
               p_ser = 0; poff(p)
               %stop
            %finish
            %if int = '?' %start
               int = 0
               printstring("am1h: buf ="); write(no of buff, 1)
               printstring(", rej ="); write(read rej, 1); newline
               printstring("i int ="); write(i int, 1); printstring(" o int =")
               write(o int, 1); printstring(" i ch="); write(i ch, 1)
               printstring(" o ch ="); write(o ch, 1); newline
               i int = 0; o int = 0; i ch = 0; o ch = 0
            %finish

            clock int
            %continue
         %finish

         %if mon # 0 %start;          ! monitoring
            %if p_reply = 0 %then i = p_ser %else i = p_fn
            monitor('m', i) %if mon # 0
         %finish
         %if p_ser = link handler %start
            user call
         %finish %else %if p_ser = am1 rx int&x'ff' %start
            input interrupt
         %finish %else %if p_ser = am1 tx int&x'ff' %then output interrupt
      %repeat

      !********************************************************
      !*                routines                              *
      !********************************************************

      %routine input interrupt

      !*************************************************
      !*  first part of any transfer is four bytes     *
      !*  two byte stream no, two byte max length      *
      !*************************************************


      %integer pp, error type, ninth bit, sym, stream, max
      %integer ind, s2, sub ident, extra, i

      %recordformat byteaf(%byteintegerarray b(0:200))
      %recordformat intaf(%integerarray a(0:100))

      %recordformat r3f(%integername x)
      %recordformat r4f(%record (m2900f) %name m)

      %recordformat m2900df(%byteintegerarray b(0:23))
      %recordformat mbf(%integer link, two, %record (m2900df) m)

      %ownrecord (byteaf) header
      %record (intaf) %name head2

      %record (m2900f) %name m2900
      %record (r3f) r3;  %record (r4f) %name r4
      %record (mbf) %name mb

      %record (p2f) p2
      %switch state sw(idle:control output trf 2)
      %switch control(0:15)

      pp = 0
      head2 == header
      l_rxs = l_rxs&(\int on)
      i int = i int+1
      %cycle

         i = 1000
         %while l_rxs&(ready!xopl) = 0 %and i > 0 %cycle;  i = i-1;  %repeat

         monitor('*', i) %if mon # 0 %and i # 1000

         %if i = 0 %start;               ! timeout
            dump regs
            fault(instate, 't', state)
            instate = idle
            %exit
         %finish

         %if l_rxs&xopl # 0 %start;     ! x operable has gone down
            %if xop status # 0 %start; ! print change only
               printstring("xop down!");  dump regs
            %finish
            monitor('r', instate) %if mon # 0
            l_rxs = l_rxs&(\xopl)
            l_txs = l_txs&(\int on)
            in state = idle
            tx int expected = 0
            %unless outm == null %start
               push(mq, outm)
               outm == null;              ! put message back on q
            %finish
            xop status = 0
            %if l_rxs&xop # 0 %start
               printstring("xop up again
")
               l_rxs = l_rxs!accept char
            %finish
            %exit
         %finish

         %if xop status = 0 # l_rxs&xop %start;  ! xop has come back
            l_rxs = l_rxs&(\rset);    ! i/f leaves rset on after xop back
            %cycle i = 1,1,200; %repeat;       ! wait two millisecs.
            %if l_rxs&(ready!acfy!comm bit) %c
                = (ready!acfy!comm bit) %start
               xop status = 1
            %finish %else %start
               dump regs; newline
               extra = l_rxd
               error type = 6;  ->fail it
            %finish
         %finish

         ninth bit = l_rxs&comm bit
         i ch = i ch+1
         sym = l_rxd
         %if l_rxs&acfy # 0 %start;         ! failed to read
            sym = l_rxd;                    ! retry
            %if l_rxs&acfy # 0 %start;      ! hard failure
               printstring("am1: parity error
")
               error type = 7;  extra = l_rxd;  -> fail it
            %finish
         %finish
         l_rxs = l_rxs!accept char

         %if ninth bit = 0 %start;      ! 'true' data
            %if pp > 200 %start;        ! not normal
               printstring("am1h:Missing control bit on link!
")
               pp = 0;                  ! junk the bad data
                                        ! h/w has obviously had it
            %finish

            header_b(pp+swabf) = sym
            pp = pp+1;  swabf = swabf!!x'fffe'; ! flip 1 -> -1 -> 1
            !*************************************************
            !* note:  all 'data' bytes swapped on entry      *
            !*************************************************
             monitor('i', sym) %if mon # 0
            %continue;                  ! get next char
         %finish

         %if mon # 0 %then monitor('c', sym)
         ->control(sym&15);             ! control command

control(limit):
         %if state # idle %start
            monitor('x', state) %if mon # 0
            state = terminate
            %exit %if tx int expected # 0;     ! will be coming
            ->check transmitter
         %finish
control(write c):
control(read):
         ->state sw(in state)

control(property):
         to 2900 control = 0;  term cond = terminated; x bit sent = 0
         up down(0);                        ! now up

         state = prop 1;  ->check transmitter

control(identify):
         state = ident 1;  -> check transmitter

control(sense):
         state = prop 3;              ! sends 0, 0
check transmitter:                    ! attempt to send a character
         output
         %exit

state sw(initial 4):
         %if down # 0 %then error type = 9 %and -> fail it

         %if pp # 4 %start
            error type = 1;  extra = pp; -> fail it
         %finish
         stream = head2_a(0);  max = head2_a(1)
         monitor('s', stream) %if mon # 0
         str == sta(stream)
         %if stream > 0 %start;         ! data coming/going
            %if str_owner # 0 %start
               p_ser = str_owner; p_reply = link handler
               p_mes == null
               p_port = max
               p_str = stream
               pp = 0
               in state = (stream&1)+user read
                                       ! even = am1 input, odd = am1 output
               state = terminate;  output;         ! send a 'prim stat'
               %continue
               !* ie pick up the 'write c' or 'read' before going to user
            %finish
            error type = 2;  extra = stream; ->fail it;    ! stream not in use
         %finish
         !* must be a control stream transfer ********
         pp = 0
         %if stream = -2 %start
            !! inward control stream
            in state = control input trf
         %else
            !! outward control stream  (-1)
            in state = control output trf 1
         %finish
         state = terminate
         output
         %exit


state sw(user read):                    ! pick up 'read' command
state sw(user write):                   ! pick up 'write' command
         %if pp # 0 %start
            error type = 3;  extra = pp;  ->fail it;   ! data not expected
         %finish
         p_fn = in state-1;    ! read=2=doinput, write=3=dooutput
         pon(p)
         state = in state;       ! transfer 11/34 -> am1 or reverse
         %return

state sw(control input trf):            ! ie 11/34 -> 2900
         control pt = 0
         in state = idle;                ! nothing more coming in
         state = control m
         %if mq_e == null %start
            monitor('?', to 2900 control) %if mon # 0
            state = terminate
         %finish
         -> check transmitter

state sw(control output trf 2):         ! ie 2900 -> 11/34
         !* after the 'limit' - data has been read
         !! now cycle up the buffer, firing the requests
         ind = 0;  r4 == r3
         %cycle
            s2 = head2_a(ind);  r3_x == head2_a(ind)
             %if s2 # -1 %start
            sub ident = head2_a(ind+1)
            %if mon # 0 %then monitor('l', s2)
            %if s2 < lower %or s2 > upper %start
               fault(s2, 's', ind); %exit
            %finish
            str == sta(s2)
            %if str_owner = 0 %then fault(s2, 's', ind) %elsestart
               m2900 == get buffer
               mb == m2900;            ! align it to data area
               mb_m = r4_m;            ! and copy it accross

               !! pick up "id 2900" if its a connecting messgae

               %if mb_m_b(5) = 2 %then str_id 2900 = m2900_p2b

               p2_ser = str_owner; p2_reply = link handler
               p2_fn = message
               p2_mes == m2900
               pon(p2)
            %finish
            %finish
            ind = ind+high lev con len//2
            %exit %if ind >= pp//2
         %repeat
         in state = idle
         state = term x bit;           ! send x bit if necessary
         output
         %exit

control(write control):                     ! write control from 2900
         !! this can only happen at the beginning of a transfer
         !! from the 2900, so whatever the state, force it to idle
state sw(idle):
            extra = pp
            %if pp # 0 %then error type = 6 %and -> fail it
                                    ! no control char ??
            clock = 0
            swabf = 1;                    ! used to "swab" the bytes
            in state = initial 4;  %continue

state sw(control output trf 1):         ! seen the 'write' command
            in state = control output trf 2
            %if no of small+no of buff < 7 %or int='L' %start
               read rej = read rej+1
              in state = idle
              state = term x bit
              output
              %while l_txs&ready = 0 %cycle; %repeat
              i = l_rxd
              l_rxs = l_rxs!accept char
              monitor('q', read rej) %if mon # 0
              %exit
            %finish

      %repeat
      l_rxs = l_rxs!int on
      %return

control(funny):                   ! should not occur
control(primary):
control(6):control(7):control(8):
control(9):control(11):control(13):control(15):
        error type = 5;  extra = sym
fail it:
         fault(error type, 'i', extra)
         l_rxs = l_rxs!int on;   in state = idle
         term cond = unsuccessful!terminated;  state = terminate
         %unless outm == null %then free buffer(outm) %and outm==null
         output
      %end

      %routine output interrupt
         !********************************************
         !* routine handles output interrupt from am1 *
         !*********************************************
         o int = o int+1
         l_txs = l_txs&(\int on)
         %if tx int expected = 0 %start
            monitor('O', state)
         %else
            %if tx int expected = 2 %start;  ! special case of accept char

               ! user has handed back control after reading from the am1
               ! this handler must now say 'next char', but only after
               ! the GPC has seen the terminate

               tx int expected = 0
               l_rxs = l_rxs!accept char
               l_rxs = l_rxs!int on
               monitor('u', in state) %if mon # 0
               in state = idle
               %unless mq_e == null %then interrupt am1
               %return
            %finish

            tx int expected = 0;  clock = 0
            output;                  ! see whats up
         %finish
      %end

      %routine output
     
         !! this routine is entered to check whether a character can
         !! be send to the 2900
         !!    if it can, then characters are sent until -
         !!     1) it goes 'busy' - in which case an interrupt is requested
         !!     2) all has gone - the state then goes to idle

         %integer i, sym, ostate
         %switch ts(idle:error)

         %cycle
            %if l_txs&ready = 0 %start;       ! 'busy'
               l_txs = l_txs!int on;          ! put ints on
               tx int expected = 1;           ! set the flag
               %return
            %finish

            l_txs = l_txs&(\comm bit);        ! ensure ninth bit off
            ostate = state
            -> ts(state)

ts(term x bit):                       ! send terminate+x bit if necessary
            sym = term cond!x bit sent
            -> set comm bit

ts(terminate):
            sym = term cond
set comm bit:
            l_txs = l_txs!comm bit
            monitor('d', -sym) %if mon # 0
            term cond = terminated
            -> send

ts(prop 1):
            sym = property code;  -> send

ts(prop 2):
            sym = fep no;  -> send
ts(prop 3):
ts(prop 4):
ts(ident 1):
            sym = 0;  -> send

ts(ident 2):
            sym = attn byte;  -> send

ts(control m):                          ! set up transfer
         outm == pop(mq);               ! get next entry
         to 2900 control = outm_len;     ! get the length
         control pt = 0;                ! start at beginning

ts(control m2):
            sym = outm_b(swabx(control pt))
            control pt = control pt+1;  tot out l = tot out l+1

            %if control pt = to 2900 control %start
               free buffer(outm)
               outm == null
               %unless mq_e == null %or tot out l > 180 %start
                  state = next control;     ! get the next buffer
               %else
                  state = term x pend
                  !!  ** next state = term x bit   - send x bit if necessary
   
                  to 2900 control = 0
                  x bit sent = 0
                  %unless mq_e == null %then interrupt am1
               %finish
            %finish

send:
           o ch = o ch+1
           %if l_txs&comm bit # 0 %and sym  = (unsuccessful!terminated) %start
!             print string("abterm")! dump regs
              l_txd = sym
              l_rxs = l_rxs!accept char %if l_rxs&acfy = 0
            %finish %else l_txd = sym
           monitor('d', sym) %if mon # 0
            state = next state(state)
         %repeat

ts(user reading): ts(user writing):
         monitor('8', ostate)
         %return

ts(error):
ts(next control): ts(term x pend):
         fault(state, 'e', ostate)

ts(idle):
      %end

      %routine interrupt am1
         %if state = idle %and in state = idle %start
           term cond = attention;  state = terminate
           output;                     ! kick the transmitter
         %finish
         x bit sent = condition x
          tot out l = 0
      %end


      %routine user call
         !****************************************************
         !*    reasons                                       *
         !*       0) send data   - high level control        *
         !*       1) low level control                       *
         !*       2) here i am   - ipl info wanted           *
         !*       3) return control - was reading/writing    *
         !****************************************************

         %constintegerarray typea(0:5) =
           terminated, short block, long block, unsuccessful,
           condition y,  terminated

         %integer fn, i, len, pp, stream
         %byteinteger ind
         %record (m2900f) %name m2900
         %record (m2900cf) %name m2900c
         %switch user sw(send data:stop)

         ->user sw(p_fn)

user sw(send data):                     ! high level control ->2900
user sw(low level control):
         len = high lev con len

         m2900c == p_mes;  m2900 == m2900c
         stream = sta(m2900_stream)_id 2900

        %if stream = 0 %start;   ! error
           printstring("am1: attempt to send zero stream, stream = ")
           write(m2900_stream, 1);  write(m2900_sub ident, 1)
           write(m2900_p2a, 1); newline
           free buffer(m2900);  %return;    ! junk it
        %finish

        m2900_stream = stream
         m2900_len = len;             ! hold its length
         %if down = 0 %start;               ! 2900 is up
            %if mq_e == null %then interrupt am1
            push(mq, m2900)
            !******************************************************
            !* note:  stream & sub ident are alwys swabbed
            !*******************************************************
         %finish %else free buffer(m2900);    ! junk it
         %return

user sw(return control):
         %unless user reading <= state <=user writing %start
            fault(in state, 'r', state)
         %else
            ind = p_str;                ! type of termination
           %if ind&64 = 0 %start;         ! xopl not set.
               term cond = typea(ind&7)!terminated; ! send the terminate
               state = term x bit;       ! append x bit as necessary
               output
   
               %if ind&128 # 0 %start;        ! char to accept
                  l_txs = l_txs!int on;        ! wait for GPC to see terminate
                  tx int expected = 2;         ! with special flag set
                  %return;                     ! and wait
               %finish
            %finish

ints on:
            l_rxs = l_rxs!int on;  in state = idle
         %finish
         %return

user sw(here i am):
         stream = p_str
         sta(stream)_owner = p_reply;           ! enable the stream
         %if stream < 10 %start;       ! control streams
            p_ser = p_reply;  p_reply = link handler
            p_fn = interf addr;  p_mes == l;  ! pass addr of "l"
            pon(p)
         %finish
         %return

user sw(stop):                          ! stop the am1
         stop interface
      %end



!*     routine  clock int


      %routine stop interface
         l_txs = l_txs&(\(operable!int on))
         l_rxs = l_rxs&(\int on)
      %end

      %routine clock int

         !! handles clock interrupts

         %integer i

         %if tx int expected # 0 %or x bit sent # 0 %start
            clock = clock+1
            monitor('w', clock) %if mon < 0 %and clock&3 = 0
            %if clock = 5 %start;          ! emergency action
              printstring("am1:dying")
              dump regs
              l_txs = l_txs&(\operable);   ! drop operable
              %cycle i = 1,1,10; %repeat;    ! delay
              l_txs = l_txs!operable
              %return
            %finish

            %if clock = 10 %and l_txs&ready#0 %then interrupt am1

            %if clock = 20 %start;          ! 20 sec timeout
               fault(x bit sent, 'c', tx int expected)
               up down(1)
               state = idle;  in state = idle
               l_txs = l_txs&(\int on)
               int = 'F'
             %finish
         %finish %else clock = 0
      %end




!*     routine  up down


      %routine up down(%integer which)
         %integer i, ser
         down = which

         %cycle i = 2, 1, 6;    ! send 'status' message to itp, rje & ftp
            ser = sta(i)_owner
            %if ser # 0 %start
               %if down = 0 %start;        ! going up
                  p_ser = ser; p_reply = link handler
                  p_fn = interf addr; p_mes == l;      ! pass 'l' (it may have changed)
                  pon(p)
               %finish

               p_ser = ser;  p_reply = link handler
               p_fn = mainframe up+which
               p_mes == null
               pon(p)
            %finish
         %repeat

        !* tidy up variables

        x bit sent = 0;  tx int expected = 0
        %while %not mq_e == null %cycle
           free buffer(pop(mq))
        %repeat
      %unless outm == null %then free buffer(outm) %and outm==null
      %end

      %routine free buffer(%record (mef) %name mes)
         %record (pe) p

         %if no of buff > 13 %or mes_type = 0 %start
                  ! release if q to big, or its a big block
            p_ser = buffer manager; p_reply = own id
            p_fn = release buffer; p_mes == mes
            pon(p)
         %else
            !! q it
            mes_link == buffer pool;  buffer pool == mes
            no of buff = no of buff+1
         %finish
      %end

      %record (m2900f) %map get buffer

         %if buffer pool == null %start; ! ask for it
            p_ser = buffer manager;  p_reply = own id
            p_fn = request buffer; p_str = 1;   ! short buffer
            ponoff(p)
         %else
            p_mes == buffer pool;  buffer pool == p_mes_link
            p_mes_link == null
            no of buff = no of buff-1
         %finish
         %result == p_mes
      %end

      %routine fault(%integer stream, type, add)

         printstring("am1: fault "); printsymbol(type)
         write(stream, 3)
         printstring(", "); write(add, 1); newline
         monitor('F', type) %if int # 'A'
      %end

     %routine monitor(%integer type, info)
        mon1(mon pt) = type;  mon2(mon pt) = info
        mon pt = (mon pt+1)&mon lim
     %end

      %routine octal(%integer i)
         %integer n
         space
         %cycle n = 15, -3, 0
            printsymbol((i>>n)&7+'0')
         %repeat
      %end

      %routine dump regs
         printstring("  r"); octal(l_rxs)
         printstring("  t"); octal(l_txs)
         newline
      %end

%endofprogram
            mes_link == buffer pool;  buffer pool == mes