! file 'ring8s'  - with monitoring back in

!********************************
!*    emas-2900   ring interface *
!*                    handler     *
!*      file: ring8s              *
!*   date:27.jul.82               *
!*********************************
!!  stk = 300,  strm = 1

!nb location k'140016 is used to hold the checksum so that it may
!be accessed from code


#if o
%include "deimosperm"
#else
%include "b_deimosspecs"
#fi
%constrecord (*) %name nil == 0




%begin

     %conststring (13)vsn = "ring:vsn008e "
#datestring
%ownintegername no of big buff == k'060112';     ! 3 seg position
%ownintegername big buff pt    == k'060104';     !     ditto

%constintegername no of big 2 seg == k'100112';   ! for 2 seg buff man
%constintegername big buff pt 2 seg== k'100104'







     %recordformat mef(%record (mef) %name link, %byteinteger len, %c
       type, %integer address, %integerarray a(0:100) )
                                                  ! think about the position of
                                                  ! 'len'




     %recordformat pe(%byteinteger ser, reply, fn, port, %c
       (%record (mef) %name mes, %byteinteger len, s1     %or  %c
       %integer lport, hport))


                                             !!           ring interface registers

                                                  !-----------------------------


%recordformat ringf(%integer rdata,source,sourceselect,status, %c
                tdata,dest,spare,intstat)

#if o
%constrecord (ringf) %name ring==k'004040';  ! in seg 0
%constintegername ps == k'017776';      ! processor status - in seg 0
#else
%constrecord (ringf) %name ring == k'044040';  ! in seg 2
%constintegername ps == k'057776';      ! processor status - in seg 2
#fi



!           ring command/status register bits

%constinteger  busy=1
%constinteger  unselected=2
%constinteger  accepted=4
%constinteger  ignored=8
%constinteger  badpacket=16
%constinteger  packet rejected=64


!ring interface status bits

%constinteger  receive=1
%constinteger  transmit=2
%constinteger  onoff=16
%constinteger  rintoff=k'40'
%constinteger  rinton=k'100'
%constinteger  tready=k'200'
%constinteger  tintoff=k'400'
%constinteger  tinton=k'1000'
%constinteger  iproff=k'2000'
%constinteger  ipron=k'4000'
%constinteger  iptoff=k'10000'
%constinteger  ipton=k'20000'
%constinteger  repa=k'100000'




                                                  !byte stream command codes

%constinteger  rdy=x'3000'
%constinteger  notrdy=x'5000'
%constinteger  reset=x'6300'
%constinteger  close=x'6600'
%constinteger  data=x'a000'
%constinteger  nodata=x'c000'
%constinteger  closereq=4


                                                  !transport service command codes


%constinteger  open=x'6a00'
%constinteger  openack=x'6500'
%constinteger  longblock=x'9000'
%constinteger  longblockch=x'9000'
%constinteger  longblockcs0=x'9400'
%constinteger  singleshot=x'9800'





!                      incoming function codes
!                      -------------------------


!he following values may be added to the output codes

%constinteger release flag=x'80';           !release buffer at end of output
%constinteger tell flag=x'40';             !notify at end of transfer
%constinteger cs0flag=x'20'


%constinteger command mask=x'1f';           !to get command code

%constinteger enable port=0
%constinteger xdata=1
%constinteger ssout=2;            !single shot output
%constinteger xrdy=3
%constinteger xnotrdy=4
%constinteger xnodata=5
%constinteger xclose=6
%constinteger xreset=7
%constinteger xclosereq=8
%constinteger disable port=15
%constinteger output trace=16;     !force output of trace buffer


!                              outgoing function codes
!                                 -----------------------

%constinteger output done=0
%constinteger transfer error=1
%constinteger r input done=2
%constinteger input error=3



%constinteger  timeout=2;                         !number of alarm calls


!time is incremented on every alarm call, on overflow to
!zero it is set to 1 as time 0 implies time-not-set



%owninteger ntimes=0
%owninteger time


%owninteger me;                       !ring address

%integer t,i









                    !**************************************************************

                    !*         buffer manager calls   (from and to)               *

                    !**************************************************************

     %constinteger buffer here = 0
                                        !********** to buffer manager ***********

     %constinteger request buffer = 0
     %constinteger release buffer = 1
               !****************************************************************

                                   !********** various service numbers *************

     %constinteger ring ser = 13
     %constinteger buffer manager = 17
     %constinteger time int = 0
     %constbyteinteger tx int = -6;          
     %constbyteinteger rx int = -7;           

     %constinteger t3 ser = 21
                    !************************************************************



     %record (pe)p;         !input pon record
     %record (pe) op;          !output pon record

%owninteger x, no buffc;     ! no of 'no buff' 


!#sretry statistics variables

%ownintegerarray rhist(0:6);                      !#s

%owninteger rcount;                               !#s

                                        !#s counts of i/o pkts and interrupts;   
%owninteger ip,opkts,ints;              !#s
%owninteger im, om, timec;              !$e       #s




                                             !#e if # 0 then a transmission error is
%owninteger eflag = 0;                      !#e
                                             !#e generated on every 100'th packet

                                                  !#e efag is toggled wiuth int(e)

%owninteger ecount = 0;                           !#e




     %owninteger mon = 0

    %owninteger intloop = 10

%constinteger tracelim = 255;                    !#t keep to a power of 2 -1
                                                  !#t
   %recordformat tracef(%byteinteger type,%integer data);
   %ownrecord (tracef) %array trace(0:tracelim);  !#t
   %owninteger tracep = 0;                        !#t
   %owninteger tsent=0;                            !#t

!%ownrecord (pe) %array ptrace(0:300)
!%owninteger ptp=0

%owninteger state=0
!values of state
%constinteger closed=0;                 !before first entry
%constinteger on=1;                 !normal state
%constinteger off=2;                  !ring offline

%owninteger dstate=0;           !dynamic state (see bits below)

!values for dstate
%constinteger idle=0
%constinteger inputting=1
%constinteger outputting=256


!data used during an input transfer
!----------------------------------

%ownrecord (mef) %name inbuf
%owninteger port,csflag
%constinteger maxlen=125;                  !250 bytes of data max



!data accessed in code therefore in fixed location the gla

%constintegername ics==k'140016';         !checksum
%constintegername ocs==k'140014';         ! output block checksum

!data used during output transfer
!---------------------------------

%ownrecord (pe) outp
%ownintegerarrayname obuf
%owninteger dest, o pktcount, o pktlen, i tout, o tout, %c
          outcs, d, oretry, func;    !outcs#0 => checksum reqd

%constinteger maxretries=500;         !max number of retries of
                                       !a single packet

!data used for input transfer

%ownintegerarrayname i buf
%owninteger i pktcount, i pktlen



!data used for port-pairs list
!-----------------------------

!each record contains a port range (low, high) and the id
!of the task that will handle input on a port in this range

%recordformat ppf(%integer lport, hport, %byteinteger reply)

%constinteger nppmax=8
%ownrecord (ppf) %array ppa(1:nppmax)
%owninteger npp=0
%ownrecord (ppf) %name pp



!data used for output pon queue
!------------------------------

!all the pq records are on a cyclic list, pqfirst and pqlast point
!to the head and tail of the q, npq tells how many items are on the q.



%recordformat pqf( %record (pqf) %name link, %record (pe) p)

%constinteger maxnpq=32
%ownrecord (pqf) %array pq(1:maxnpq)
%ownrecord (pqf) %name pqfirst, pqlast
%owninteger npq=0



!data defining canned commands (rdy, nodata etc.)

!data defining 'canned' byte stream commands rdy etc. the command is
!put into the array ccbuf, ccbuf(0) is the port number, ccbuf(1) is
!the receiver command set from the reccom array, and ccbuf(2) is the
!transmitter command set from trancom array. the array sindex gives the position
!in ccbuf of the sequence number if reqd.

%ownintegerarray ccbuf(0:2)

%constintegerarray reccom(xrdy:xclosereq)=rdy, %c
             notrdy, 0, close, reset, 0

%constintegerarray trancom(xrdy:xclosereq)=0,   %c
              0, nodata, 0, 0, x'a004';               !data+closereq

%constbyteintegerarray sindex(xrdy:xclosereq)=1,1,2,0,0,2






!%routinespec pont(%record (pe) %name p)
%routinespec do clock int
%routinespec end op transfer
%routinespec end ip transfer
%routinespec start input transfer
%routinespec start output transfer
%routinespec do forced error(%integer type);     !$s
%routinespec do timeout(%integer type)
%routinespec freebuffer(%record (mef) %name mes)
%record (mef) %mapspec getbuffer
%routinespec initialize
%routinespec input done(%integer function)
%routinespec disports
%routinespec puttrace;        !#t
%routinespec puthex(%integer d);        !#t


                         !! %permrecord (mef) %mapspec pop(%record (qf) %name q)

               !! %permroutinespec push(%record (qf) %name q, %record (mef) %name e)




                                   !**********************************************

                                   !*      initialisation                        *

                                   !**********************************************

      printstring(vsn)
      printstring(datestring); newline

#if o
     map hwr(0);                                  ! map top seg to seg 0
#else
      map hwr(2)
#fi
     i = map virt(buffer manager, 4, 3)
      %if i = 0 %start;                  ! buf man only has 2 segs
         no of big buff == no of big 2 seg
         big buff pt == big buff pt 2 seg
      %finish
      i = map virt(buffer manager, 5, 4);              ! map to my seg 4
      i = map virt(buffer manager, 6, 5);               !and to seg 5
     linkin(ring ser)
     linkin(tx int);; linkin(rx int)

#if o
     change out zero = t3 ser
#else
      use tt(t3 ser)
#fi


     initialize;                                  !initialise data structures

     alarm(20)

     %cycle
        p_ser = 0;  poff(p)

        %if p_ser = own id %start;
           %if p_reply=0 %start;                 !clock call
               alarm(20)
               do clock int

             %else;                               !from buffer manager
!                   pont(p)
                     printstring("RING:illegal message from:")
                     write(p_reply, 1); newline
                     %continue


             %finish
            %continue
        %else

            %if p_ser=ring ser %start
!                   pont(p)
                                     !decode 'normal' pon message
                   %if p_fn=enable port %start
                        %if npp >= nppmax %start
                             printstring("RING:too many ports")
                             newline
                        %else
                                    !add port pair to list
                              npp=npp+1
                             pp==ppa(npp)
                             pp_lport=p_lport
                             pp_hport=p_hport
                             pp_reply=p_reply
                             %if state=closed %start
                                  !if this is the first entry, setup
                                  !state according to the inverse of onoff
                                  !so that the state change is recognised

                                 %if ring_intstat & onoff=0 %thenc
                                        state=on                %c
                                 %elsec
                                        state=off
                             %finish
                         %finish
                   %else
                        %if p_fn=disable port %then dis ports %and %continue
                         %if p_fn=output trace %start
                                %if tsent=0 %then puttrace;       !#t
                                tsent=1;             !#t
                          %else
                                                      !assume output request
                            %if state = off %start
rel:                           %if p_fn&x'7f' < xrdy %start; ! block included
                                  %if p_fn&release flag # 0 %then %c
                                        free buffer(p_mes)
                               %finish
                               %continue;           ! ignore the request
                            %finish

                            %if npq<maxnpq %start;    !put on output queue
                                pqlast==pqlast_link
                                pqlast_p=p
                                npq=npq+1
                            %else
                                printstring("RING:queue full")
                                newline
                                ->rel
                            %finish
                       %finish
                   %finish
                  %continue %unless npq = 1;        ! ignore unless 1st req
              %finish
         %finish



   %if p_ser&x'80' # 0 %then ints = ints+1

!now cycle round a few times looking at ready bits on the ring interface
! dstate contains the dynamic state either idle, inputting or outputting
!
   i=0

   %while i<intloop %cycle
      i = i+1


      !turn off all inpurrupts - do all io using ready bits
      
      ring_intstat=ring_intstat ! (tint off + ipt off + rint off %c
                   + ipr off)


      %if dstate&outputting#0 %start
                      !output packet
                      !-------------

         %if ring_intstat&tready#0 %start         ;!transmitter ready
            %if ring_status & accepted #0 %start;   !last transmission failed
               %if oretry>maxretries %start
                    do timeout(1)
                     timec = timec+1
                    %continue
               %finish
               ring_intstat=ring_intstat ! transmit;!send it again
               oretry=oretry+1
               i=0
            %else

               %if oretry<6 %start;                 !#s
                  rhist(oretry)=rhist(oretry)+1 ;   !#s
               %else;                               !#s
                  rhist(6)=rhist(6)+1;              !#s
               %finish;                             !#s
               rcount=rcount+oretry;                !#s

               %if o pktcount<o pktlen %start
                  
                  d = o buf(o pktcount)

putout:           
                  opkts=opkts+1;           !#s
                  o cs = o cs+d
                  *=k'005537';     *=k'140014';      !adc cs
                 trace(tracep)_type='o';            !#t
                  trace(tracep)_data=d;            !#t
                  tracep=(tracep+1)&tracelim  ;            !#t
                   %if eflag#0 %then do forced error('e');       !#e

                    ring_tdata=d

                  i=0
                  oretry=0
                  o pktcount=o pktcount+1
               %else
                  %if o pktcount=o pktlen %and outcs#0 %start
                     d = o cs
                     %if outp_fn&cs0flag#0 %then d=0
                     -> putout
                  %finish
                                    !end of output transfer
                                    !----------------------
end output:
                  end op transfer
                  %exit %if dstate = 0;     ! force an interupt (input buffs)
               %finish
            %finish
         %finish
      %else
          %if (ring_intstat & tready#0) %or (ring_intstat   %c
                   & onoff = 0)    %start
                           !start up output transfer (if any)
                           !----------------------------------
             %if npq#0 %then start output transfer
         %finish
      %finish
          %if dstate&inputting # 0 %start
            %if ring_intstat & repa=0 %then %continue

            d=ring_rdata
            
             trace(tracep)_type='i';                   !#t
             trace(tracep)_data=d;                     !#t
             tracep=(tracep+1) & tracelim;             !#t
            ip=ip+1;                                  !#s

!look to see if port field looks like a header and if so start transfer
!from here

               %if i pktcount=0 %and d&x'f800'=longblock %then %c
                  -> start inp

!            %if eflag # 0 %then do forced error('f');         !#e

            i=0
            %if i pktcount<i pktlen %start
               i cs = i cs+d
                *=k'005537';   *=k'140016';        ! adc cs
               ring_intstat=ring_intstat ! receive
               i buf(i pktcount)=d
               i pktcount=i pktcount+1
            %else
                             !end of input transfer
                             !-----------------------
               end ip transfer
               %exit %if dstate = 0;   ! force it to do a poff (input buffers)
            %finish
         %else;                                 ! dstate=idle
            %if ring_intstat & repa# 0 %start
                                  !start input transfer
!                                  !--------------------
start inp:
               start input transfer
               i = 0
         %finish
        %finish
      %repeat

      !need to switch interrupts back on
      ring_intstat=ring_intstat ! rinton
      %if dstate&outputting#0 %then ring_intstat=ring_intstat ! tinton

   %repeat





%routine input done( %integer function)
!-------------------

!find out who wants input to this port


%integer port,i, xx
%record (ppf) %name pp


   xx = 0;    ! compiler bug forces this !
   port=i buf(xx)
   %cycle i=npp,-1,1
      pp==ppa(i)
      %if pp_lport<=port<=pp_hport %start
         op_ser=pp_reply
         op_reply=ring ser
         op_fn=function
         %if function=r input done %start
            op_mes==inbuf
!             pont(op)
            pon(op)
            inbuf == nil
         %else
!            pont(op)
            pon(op)
         %finish
         %return
      %finish

   %repeat
!nobody wants the input
   printstring("RING:input rejected ")
   write(port, 3);     write(inbuf_address, 3)
   newline

%end



%routine do clock int
!--------------------
               %integer i
               time=time+1
               %if time=0 %then time=1;               !time=0 => time not set

                  

                %if ring_intstat & onoff = 0 %start
          
                        %if dstate&outputting#0 %then do timeout(1)
                        %if dstate&inputting#0 %then do timeout(0)
                      %if state=on %start
                           %cycle i=1,1,5
                                printstring("****************** ring switched off")
                                newline
                            %repeat
                            state=off
                         %finish
                 %else
                      %if state=off %start
                                           !calculate my ring address
                            !turn off all inpurrupts

                           ring_intstat=ring_intstat!(tint off+ipt off+rint off %c
                          +ipr off)
                             me=0
                             %cycle
                               %cycle i=1,1,254
                                   ring_sourceselect=i
                                   ring_intstat=ring_intstat ! receive
                                   ring_dest=i
                                   ring_tdata=x'f0f0'
                                   %while ring_intstat & tready=0 %cycle
                                     %if ring_intstat&onoff = 0 %then ->out
                                   %repeat
                                   %if ring_intstat#0 %and ring_rdata= %c
                                       x'f0f0' %then me=i %andexit
                                %repeat
                              %repeat %until me # 0
                              printstring("ring online")
                              write(me, 3)
                              newline
                             state=on
                              
                                            !initialize ring interface
                             ring_intstat=ring_intstat !      %c
                                 ( receive+iproff+iptoff+rinton)
                             ring_sourceselect=-1
                       %finish
                %finish

out:

               %if 'M' <= int <= 'P' %start
                  mon = int-'O';  int = 0
               %finish
               %if int = '?' %start
                  int = 0
                  printstring("o/p queued ="); write(npq, 1); newline
               %finish
    
    
               x = x+1;                               !#s
             %if x >= 150 %start;                     !#s
                  %if no buffc # 0 %start
                     printstring("RING: No buffer count =")
                     write(no buffc, 1); newline
                     no buffc = 0
                  %finish

                  %if mon>0 %start;                  !#s
                     select output(1)
                     printstring("RING:");           !#s
                     write(rcount, 5);               !#s
                     %cycle i=0,1,6;                 !#s
                           write(rhist(i),4);        !#s
                     %repeat;                        !#s
                     write(ip,4);                    !#s
                      write(opkts, 4);               !#s
                     write(ints, 4);                 !#s
                     write(im, 5);                  !#s
                     write(om, 1);                  !#s
                     write(timec, 1);               !#s
                     newline;                        !#s
                     select output(0);             !$s
                   %finish;                            !#s
                  im = 0;                              !#s
                  om = 0;                              !#s
                   rcount=0;                           !#s
                   x=0;                                !#s
                   ip=0;                               !#s
                   opkts=0;                            !#s
                   ints=0;                             !#s
                   %cycle i=0,1,6;                     !#s
                        rhist(i)=0;                    !#s
                   %repeat;                            !#s
               %finish;                               !#s
    
              %if int = 'E' %start;                   !#e
                       eflag = (eflag + 1) & 1;       !#e
                        printstring("eflag=");        !#e
                              write(eflag,1);         !#e
                        newline;                      !#e
                        int=0;                        !#e
               %finish;                               !#e


               %if int='T' %start;                    !#t
                       puttrace;                      !#t
                       int = 0;                       !#t
               %finish;                               !#t
    
                trace(tracep)_type='s';               !#t
                trace(tracep)_data=time;              !#t
                 tracep=(tracep+1) & tracelim;        !#t


                 %if i tout#0 %and time-i tout>timeout %then do timeout(0)
                  %if o tout#0 %and time- o tout>timeout %then do timeout(1)
%end

%routine end op transfer
!-----------------------
                   dstate = dstate&(\outputting)
                   o tout=0
                  %if outp_fn & release flag # 0 %then  %c
                      freebuffer(outp_mes)
                  %if outp_fn & tell flag # 0 %start
                      op_ser=outp_reply
                      op_reply=ring ser
                      op_fn=output done
                      pon(op)
                  %finish
%end

%routine end ip transfer
!-----------------------
               ring_sourceselect= -1
               ring_intstat=ring_intstat ! receive
               %if csflag#0 %then i cs=0;        !zero checksum reqd.
               %if  d = i cs %start
                  input done(r input done)
               %else
                     printstring("RING:checksum fail from ")
                      write(inbuf_address, 3)
                      write(d,3);  write(i cs,3);  newline
               %finish
               i tout=0
               dstate = dstate&(\inputting)
%end

%routine start input transfer
!----------------------------
               d=ring_rdata
               trace(tracep)_type='i';             !#t
               trace(tracep)_data=d;               !#t
                tracep=(tracep+1) & tracelim;      !#t
               %if d & x'f800'=longblock %start
                  csflag=d & x'400'
                  i pktlen=d & x'3ff' +2
                  %if i pktlen>maxlen %then -> skip
                  i pktcount=0
                  %if inbuf==nil %start;       !$e - kent fault
                     inbuf == get buffer;       ! grab a buffer from buf man
                     %if inbuf == nil %start
                        no buffc = no buffc+1
skip:
                        ring_intstat=ring_intstat ! receive
                        %return
                     %finish
                     im = im+1;                  !$s
                  %finish
                  inbuf_len = i pktlen-2
                  i buf==inbuf_a
                  inbuf_address=ring_source
                  ring_sourceselect=ring_source
                  ring_intstat=ring_intstat ! receive
                  dstate = dstate!inputting
                  i cs = d
                  i tout=time
                  %return
               %finish
                -> skip
%end

%routine start output transfer
!-----------------------------
                    outp=pqfirst_p
                   pqfirst==pqfirst_link;        !remove record
                   npq=npq-1;                    !from output q
                  func=outp_fn & command mask
                  om = om+1;                  !#s
                  %if func=ssout %start;               !single shot block
                       dest=outp_mes_address
                       o pktcount=1
                       o buf==outp_mes_a
                       o pktlen=outp_mes_len
                       %if o pktlen=0 %start
                           end op transfer
                           %return
                       %finish

                       o cs = o buf(0);          !first packet
                       outcs=0;                         !no checksum
                  %else
                      %if func<xrdy %start
                                     !output given buffer
                                     !-------------------
                         dest=outp_mes_address
                         o buf==outp_mes_a
                         o pktlen=outp_mes_len+2
                      %else
                                     !output byte stream command
                                     !----------------------------
                         dest=outp_len
                        o pktlen=3
                          ccbuf(0)=outp_lport
                           ccbuf(1)=reccom(func)
                          ccbuf(2)=trancom(func)
                          o buf==ccbuf
                                     !see if sequence number reqd
                         i=sindex(func)
                         %if i#0 %thenc
                            ccbuf(i)=ccbuf(i)+(outp_s1<<8);      !add in sequence
   
                      %finish
                     o cs=longblockch+o pktlen-2
                     %if outp_fn&cs0flag # 0 %then o cs = o cs!longblockcs0
                     outcs=1;          !checksum reqd
                      o pktcount=0
                %finish
                ring_dest=dest


                ring_tdata = o cs
                trace(tracep)_type='o';       !#t
                trace(tracep)_data = o cs;           !#t
                tracep=(tracep+1)&tracelim;              !#t
                oretry=0
                  o tout=time
                  dstate = dstate!outputting
                  i=0
%end

%routine do forced error(%integer type);          !$s
!---------------------------------------
                       ecount=ecount+1;       !#e
                       %if ecount>1000 %start;       !#e
                            d=d+1;                  !#e corrupt the data
                            ecount=0;       !#e
                            trace(tracep)_type=type;       !#e
                            trace(tracep)_data=0;       !#e
                            tracep=(tracep+1)&tracelim;       !#e
                        %finish;       !#e
%end

%routine do timeout(%integer type)
!----------------



   %if type = 1 %start;       ! outputting timeout
      o tout = 0; timec = timec+1
      %if mon<0 %start
         printstring("RING:output timeout to")
         write(dest,3);    newline
      %finish
      op_ser=outp_reply
      op_reply=ring ser
      op_fn=transfer error
      op_port=outp_port
!       pont(op)
      pon(op)
      %if outp_fn& release flag # 0 %then freebuffer(outp_mes)
      dstate = dstate&(\outputting)
   %else
        ! must be input timeout
         !send message if port number has been input
         i tout = 0
         %if i pktcount>0 %then inputdone(input error)

!return the input buffer
         %unless inbuf == nil %start
            printstring("RING:Input Timeout from")
            write(inbuf_address, 3); newline
         %finish

         ring_intstat=ring_intstat ! receive
         ring_sourceselect=-1
         dstate = dstate&(\inputting)
   %finish

   trace(tracep)_type='x';                 !#t
   trace(tracep)_data=0;                   !#t
   tracep=(tracep+1)&tracelim;             !#t


%end


%routine initialize
!------------------
%integer i

!initialise pon q as cyclic list
   pqfirst==pq(1)
   pqlast==pq(maxnpq)
   %cycle i=1,1,maxnpq-1
      pq(i)_link==pq(i+1)
   %repeat
   pq(maxnpq)_link==pq(1)
   npq=0

%end



%routine freebuffer( %record (mef) %name mes)
!-----------------------------------------------


      %integer x
      ps = ps!k'340';                   ! put processor status = 7
      no of big buff = no of big buff+1
      x = addr(mes)+k'20000';           ! addr wrt buffer manager vm
      integer(addr(mes)) = big buff pt; ! copy in top of chain
      big buff pt = x;                  ! and remake 1st entry
      ps = ps&(\k'340');                ! and allow ints again
      %end


%record (mef) %map getbuffer
!-----------------

      %integer x
      ps = ps!k'340';                   ! stop processor interrupts
      %if no of big buff > 5 %start;    ! leave some (no queuing done)
         no of big buff = no of big buff-1
         x = big buff pt;               ! get buffer managers free pointer
         x = x-k'20000';                ! make it my vm (my seg 3 = bm seg 4)
         big buff pt = integer(x);      ! copy rest of free queue
         ps = ps&(\k'340');             ! allow ints again
         %result == record(x);          ! and pass back result
      %finish
      ps = ps&(\k'340')
      %result == null

%end




%routine disports;                         !disable port by removing
!-----------------                        !from port pairs list

%integer i,j

   %cycle i=1,1,npp
      pp==ppa(i)
      %if pp_lport=p_lport %and pp_hport=p_hport %andc
          pp_reply=p_reply %start
          %cycle j=i,1,npp-1
            ppa(j)=ppa(j+1)
         %repeat
         npp=npp-1
         %return
      %finish
   %repeat
%end




%routine puthex(%integer d);              !#t
!--------------------------;              !#t

%integer i;              !#t
%byteinteger s;              !#t

   printsymbol(' ');              !#t
   %cycle i=12,-4,0;              !#t
      s=(d>>i)&x'f';              !#t
      %if s>9 %then s=s-'0'+'a'-10;              !#t
      printsymbol(s+'0');              !#t
   %repeat;              !#t
%end;              !#t





%routine puttrace;              !#t
!----------------;              !#t

%integer tplast,tp,tc;              !#t
%integer ty,type;              !#t

   tc=0;              !#t
   tp=(tracep+1)&tracelim;              !#t
   selectoutput(1);              !#t
   type=0;              !#t
   %cycle;              !#t
      ty=trace(tp)_type;              !#t
      %if ty#0 %start;              !#t
         trace(tp)_type=0;              !#t
         %if ty#type %start;              !#t
            newline;              !#t
           printstring("******** ");              !#t
            printsymbol(ty);              !#t
            tc=2;              !#t
            type=ty;              !#t
         %finish;              !#t
         %if tc>=16 %then newline %and tc=0;              !#t
         puthex(trace(tp)_data);              !#t
         tc=tc+1;              !#t
      %finish;              !#t
      tp=(tp+1)&x'3ff';              !#t
   %repeat %until tp=tracep;              !#t
   newline;              !#t
   printstring("end of trace");              !#t
   newline;              !#t
   %cycle tc=1,1,40;              !#t
      printstring("************");              !#t
      newline;              !#t
   %repeat;              !#t

   selectoutput(0);              !#t
   printstring("done");              !#t
   newline;              !#t

%end;              !#t
!%routine pont(%record (pe) %name p)
!   ptrace(ptp)=p
!   ptp=ptp+1
!   %if ptp>300 %then ptp=0
!%end
%endofprogram