!*************************** DIAGMON *****************************************
                                                                
!ETHERNET DIAGNOSTIC MONITOR SOFTWARE PROGRAM.
!W.I.WALKER MSC PROJECT 1984

%include "inc:util.imp"
%include "inc:fs.imp"

%begin

@16_1070 %integer EV
@16_1078 %integer CV
%constantbyte tbe=8

%constantbyte nl=10,esc=27,str=1,stp=2,tic=3,stx=16_20
%constantinteger infobytes=4
%constantinteger buffsiz=16_40000,screenwidth=80,screenlength=22
%constantstring(127) monfirm="diagmonf.bin"

%byte rcvmode,stat1,port1,stat2,port2,monstat
%byte answer
%short segnum,lastseg,stp seg,strt seg
%integer q,op mode,sel dis,stp rec md,str pb md,stp pb md
%integer bytes,maxblcksiz,maxsegnum,segsiz,maxdatbytperline
%integer temp,file end,original CV,original EV,segaddr,maxpacks
%integer fifo of cnt,dma or cnt,crce cnt,rece cnt,timing cnt,buff of cnt
%integer empty cnt,coll cnt,gap cnt,tick,trace strt,trace end,intrprt level
%integer blcks,disblcks,packs,buff full,delay
%integer curr window
%bytearray buffer(0:buffsiz-1)
%recordformat bd(%integer top,bot,put,%integerarray get(1:2))
%record(bd) buffdet 
%recordformat windf(%integer currline,topline,botline)
%record(windf) %array window(1:2)

%label begin
%switch reply(1:32)

{diagnostic vars
{%integer n,h,l,m,flag1,f1,lf1,flag2,f2,lf2,flag3,flag4,lf4,f4,recaddr,badbyts
{%integer stage1,stage2,bladdr,dsaddr,put1,put2,put3,put4,put5,padd1,padd2,byts
{%integer put26,ff
{%short blen,pacr,pact,bytt
{%byte s,f,b
{%constantinteger ntst=10

%routine %spec reset apm


%on %event 0,13 %start            
  %if event_event=0 %and event_sub=1 %then %start 
    %if monstat & 1 # 0 %then reset apm  {this event is signalled by <ctrl y>
    %stop                                {leave program under control
  %finish %else %if event_event=13 %and event_sub=1 %then %start
    ->reply(q)                        {this event is signaled when input
  %finish                             {'readinteger' is not valid.
%finish                               {the prompt for the question is
                                      {returned to.



!---- VDU Control Routines -------------------------------------------------------

%routine clear screen

  printsymbol(esc)
  printsymbol('v')
%end


%routine delete line

  printsymbol(esc)
  printsymbol('M')
%end


%routine insert line

  printsymbol(esc)
  printsymbol('L')
%end


%routine cursor to(%integer row,col)

  printsymbol(esc)
  printsymbol('Y')
  row = row + ' '
  col = col + ' ' 
  printsymbol(row)
  printsymbol(col)
%end



!---- Special Input Routines ----------------------------------------------------------

%routine read 1 char(%bytename char)

!this routine reads the first character in an input 
!stream that is not a space.

  %byte sym

  %cycle
    readsymbol(sym)
  %repeat %until sym#' '
  char=sym
  %while sym#nl %cycle
    readsymbol(sym)
  %repeat
%end


%integerfunction readinteger(%integer base)

!this function takes input and returns an integer value.
!the input may be in any base.

  %integer num
  %byte sym,neg
  %label inputerr
 
  neg=0;num=0
  %cycle
    readsymbol(sym)
  %repeat %until sym#' '
  %if sym='+' %then readsymbol(sym) %else %start
    %if sym='-' %then %start
      neg=1
      readsymbol(sym)
    %finish
  %finish
  %if sym=nl %then ->inputerr
  %while '0'<=sym<='9' %or 'a'<=sym<='z' %or 'A'<= sym<='Z' %cycle
    %if 'a'<=sym<='z' %then sym=sym-87 %else %start
      %if 'A'<=sym<='Z' %then sym=sym-55 %else sym=sym-48
    %finish
    %if sym>=base %then ->inputerr
    num=num*base
    num=num+sym
    readsymbol(sym)
  %repeat
  %if sym#nl %then %start
inputerr:
    %while sym#nl %cycle
      readsymbol(sym)
    %repeat 
    %signal %event 13,1
  %finish
  %if neg=1 %then num=-num
  %result=num
%end



!---- Window Management Routines ---------------------------------------------------

%routine select window(%integer window num)

!this routine is used to select a window
!the cursor is moved to the current line in the selected window
!if selected window is 1 then cursor moved to top line

  %if window num = 1 %then window(1)_currline=window(1)_topline
  curr window=window num
  cursor to(window(window num)_currline,0)
%end


%routine scroll(%integer lines)

!this routine is used for scrolling the currently selected window
!line no is incremented and if scrolling is required then cursor
!is moved to bottom line of window

!max value of lines must be screen length-botline+1
!scroll must be used after this number of nl chars 
!have been sent to the screen.

  %integer l

  %for l=1,1,lines %cycle
    window(curr window)_currline = window(curr window)_currline + 1
    %if window(curr window)_currline>window(curr window)_botline %then %start
      cursor to(window(curr window)_topline,0)
      delete line
      cursor to(window(curr window)_botline,0)
      insert line
      window(curr window)_currline = window(curr window)_botline
    %finish
  %repeat
%end
 


!---- diagnostics routines -------------------------------------------------------

{%routine diags1
{
{  select window(2)
{  printline("top       bot       put       get(1)      get(2)");scroll(1)
{  phex(buffdet_top);spaces(2);phex(buffdet_bot);spaces(2)
{  phex(buffdet_put);spaces(2);phex(buffdet_get(1));spaces(2);phex(buffdet_get(2))
{  newline;scroll(1)
{%end



!---- Monitor Set Up Routines --------------------------------------------------------

%routine preload(%string(127) file,%bytearrayname area(0:buffsiz-1))

!this routine loads a file from the fs into an array in the apm RAM

  %byte sym

  %on %event 9 %start
    close input
    select input(0)
    %return
  %finish
  open input(1,file)
  select input(1)
  file end=0
  %cycle
    readsymbol(sym)
    area(file end)=sym
    file end=file end + 1
  %repeat
%end


%routine set firm vars(%bytename params)
  
!this routine places initial values of variables into 
!locations in the binary file of the firmware.
!params points to the location in the binary code that
!contains the address of the 1st location.
!a0 contains the addr that stcktop points to.

  *lea maxblcksiz,a1
  *move.b 3(a1),(a0)+       
  *move.b 2(a1),(a0)+
  *move.b rcvmode,(a0)+     
  *move.b stat1,(a0)+       
  *move.b port1,(a0)+
  *move.b stat2,(a0)+       
  *move.b port2,(a0)+
%end
    

%routine load(%bytearrayname area(0:buffsiz-1))

!this routine loads the binary file of the firmware into the station

  %byte sym
  %integer ad

  sym=0; ETHS=sym                     {disable station interrupts
  ETHC=16_03                          {following data to be loaded into
  ad=0                                {station RAM
  %while ad<file end %cycle
    %cycle                              
    %repeat %until ETHS & tbe # 0
    sym=area(ad)
    ETHD=sym                          {pass data to station through data
    ad=ad+1                           {register
  %repeat
  %cycle                                 
  %repeat %until ETHS & tbe # 0
  ETHC=16_0B                          {end of data,return to normal procedures
%end                                     {for handling data arriving at station


%routine prime monitor

  %routine clock tick

  !the first part of this routine changes the address in the clock
  !interrupt vector and loads the jmp instr in the new ISR with the old 
  !address.
  !the 2nd part of the routine is the clock interrupt service routine.
  !when a clock interrupt occurs ETHC is loaded to cause an interrupt
  !to the z80 and then the service routine jumps to the start of the
  !original service routine.

    %label clock,newclck

    *lea clock,a0                       {load jmp instr with original
    *move.l CV,2(a0)                    {address in CV
    *lea newclck,a0                     {load CV with new address
    *move.l a0,CV                      
    *rts

  newclck:
    *btst #3,ETHS                       {wait til tbe is set
    *beq newclck                       
    *move.b #tic,ETHC                   {causes interrupt to z80
    *addq.l #1,delay                    {increment pb delay counter
  clock:
    *jmp 16_12345678                    {jmp to original service routine

  %end

  %routine ether interrupt handler(%record(*)%name r)

  !the 1st part of this routine changes the address in the ether interrupt
  !vector and loads the address of the location r points to into the 
  !1st lea instr of the new service routine.
  !the 2nd part of the routine is the new ether interrupt service routine.

    %label intaddr,ccstr,ccstp,ccstx,erwait,loop,blck done
    %label notctrl,newput,intretn
    %label bit1,bit2,bit3,bit4,bit6,bit7

{diagnostics
{%label temp1,temp2,temp3,temp4,ccchk

    *lea intaddr,a1                     {load EV with new address
    *move.l a1,EV                       {
    *move.l a0,6(a1)                    {load 1st movea with addr 
    *rts                                {that r points to

  intaddr:
    *movem.l d0-d7/a0-a7,-(sp)
    *movea.l #16_12345678,a0

{diagnostics
{*move.l packs,d6
{*cmpi.l #0,d6
{*bgt temp4
{*move.l 8(a0),put26
{temp4:

    *btst #1,ETHS                     {if intrpt not from ctrl reg then
    *beq notctrl                      {do nothing and jmp to notctrl

{diagnostics
{*addq.l #1,byts

    *move.b ETHC,d1                   {read ctrl char
    *cmpi.b #stx,d1                   {jump to piece of code handling
    *beq ccstx                        {the response to ctrl char
    *cmpi.b #str,d1                   
    *beq ccstr                        
    *cmpi.b #stp,d1                     
    *beq ccstp                        
    *bra intretn                      
  
  ccstr:                              {station fully operational for recording

{diagnostics
{*move.l #1,stage1
{*move.l 8(a0),put1
{*move.l a0,padd1

    *bset #1,monstat                  {indicates that firmware is recording
    *bra intretn

  ccstp:                              {station no longer passing on received
                                      {packets
{read diagnostics from station
{*move.l #1,f1
{*bsr erwait
{*move.b ETHD,d1
{*bsr erwait
{*move.b ETHD,d2
{*lea pacr,a1
{*move.b d2,(a1)+
{*move.b d1,(a1)+
{*bsr erwait
{*move.b ETHD,d1
{*bsr erwait
{*move.b ETHD,d2
{*lea pact,a1
{*move.b d2,(a1)+
{*move.b d1,(a1)+
{*bsr erwait
{*move.b ETHD,d1
{*bsr erwait
{*move.b ETHD,d2
{*lea bytt,a1
{*move.b d2,(a1)+
{*move.b d1,(a1)+

    *bclr #1,monstat               {indicates that firmware is not recording
    *bra intretn                      

  ccstx:
    *movea.l 8(a0),a1                  {load buffdet_put int a1

{diagnostics
{*move.l #1,stage2
{*move.l packs,d6
{*cmpi.l #1,d6
{*bne temp1
{*move.l 8(a0),put3
{*move.l a0,padd2
{temp1:

    *bsr erwait                        {wait until next char arrives
    *move.b ETHD,d1                    {load contents of ETHD into buffer

    *moveq #0,d2
    *bsr erwait                       {wait for next char
    *move.b ETHD,d2                   {load high byte of blcklen into buffer
    *move.b d2,(a1)+                  {and into 2nd byte of d2
    *lsl #8,d2                        {
    *move.b d1,(a1)+                  {load low byte of blcklen into buffer
    *move.b d1,d2                     {and into 1st byte of d2
    *move.l d2,d3                     {d2 now contains the length of the block

    *bsr erwait                       
    *move.b ETHD,d1                   {load status field into d1
    *move.b d1,(a1)+

    *moveq #0,d0
    *bsr erwait
    *move.b ETHD,d0                   {load time field into d0
    *move.b d0,(a1)+
    *subi.l #infobytes+1,d2           {subtract 5 as d2 will act as counter.

    *add.l d0,timing cnt              {update timing cnt
                                       
    *btst #0,d1                       {update status bit cnts
    *beq bit1
    *addq.l #1,fifo of cnt
  bit1:
    *btst #1,d1
    *beq bit2
    *addq.l #1,dma or cnt
  bit2:
    *btst #2,d1
    *beq bit3
    *addq.l #1,coll cnt
  bit3:
    *btst #3,d1
    *beq bit4
    *addq.l #1,crce cnt
  bit4:
    *btst #4,d1
    *beq bit6
    *addq.l #1,rece cnt
  bit6:
    *btst #6,d1
    *beq bit7
    *addq.l #1,buff of cnt
  bit7:
    *btst #7,d1
    *beq loop
    *addq.l #1,empty cnt                {if set then no more data to
    *bra blck done                      {receive

  loop:
    *bsr erwait                         {wait for next char
    *move.b ETHD,(a1)+                  {loaded remainder of block into buffer
    *dbra d2,loop                       {
    *addq.l #1,packs                    {update packs cnt

  blck done:
    *addq.l #1,blcks                    {update blcks cnt
    *move.l segsiz,d4                   {find start point of next block
    *sub.l d3,d4                        {to be recorded
    *adda.l d4,a1                       {

    *cmp.l 4(a0),a1                     {if a1 (next value of put) is greater
    *blt newput                         {buffdet_bot
    *movea.l (a0),a1                    {tput becomes buffdet_top and
    *addq.l #2,a1                       {buff full is set
    *move.l #1,buff full

{diagnostics
{*addq.l #1,ff

  newput:
    *move.l a1,8(a0)                    {update buffdet_put

{diagnostics
{*cmpi.l #1,d6
{*bne intretn
{*move.l 8(a0),put4


  intretn:

{diagnostics
{*cmpi.b #str,d1
{*bne temp2
{*move.l 8(a0),put2
{temp2:
{*cmpi.l #1,d6
{*bne temp3
{*move.l 8(a0),put5
{temp3:


    *movem.l (sp)+,d0-d7/a0-a7
    *rte

  notctrl:

{diagnostics
{*addq.l #1,badbyts

    *move.b ETHD,d0                     {read ETHD to clear interrupt
    *bra intretn

  erwait:                               {wait for next char to arrive
    *btst #2,ETHS
    *beq erwait

{diagnostics
{*addq.l #1,byts

    *rts

  %end

  original CV=CV
  original EV=EV
  monstat=1                           {indicates that apm should be
                                      {considered to be conrolled by
  clock tick                          
  ether interrupt handler(buffdet)
  ETHS=6                                {enable normal interrupts
%end


%routine buffer initialisation

!this routine sets up the segmented,circular buffer

  segsiz=maxblcksiz + 2 + rem(maxblcksiz+2,2)
  maxsegnum=buffsiz//segsiz - 1
  segaddr=addr(buffer(0))
  segnum=0
  %while segnum <= maxsegnum %cycle    {init. segment number fields
    shortinteger(segaddr)=segnum
    segnum=segnum + 1
    segaddr=segaddr + segsiz
  %repeat
  buffdet_top=addr(buffer(0)) 
  buffdet_bot=buffdet_top + segsiz*(maxsegnum + 1)
  buffdet_put=buffdet_top + 2 
  buffdet_get(1)=buffdet_top
  buffdet_get(2)=buffdet_top
  trace strt=0
  trace end=0
  buff full=0
%end


%routine  reset apm

!this routine resets the ether station for normal use

  %integer i

  ETHS=16_40                            {reset hardware
  %for i=1,1,100 %cycle
  %repeat
  CV=original CV                        {replace original interrupt
  EV=original EV                        {vectors
  ETHS=6                                {reenable station interrupts
  %for i=1,1,1000 %cycle
  %repeat
  etheropen(lsap,rdte<<8+rsap)          {reconnect to file store
  newline
  printline("APM has been reset for normal use.")
  newline
%end



!---- Stop Mechanism -------------------------------------------------

%integerfunction stop op(%integer stop mode)

!this function is used to check whether the current operation
!should be stopped as requested by the user.
!there are 3 stop modes.

  %integer stop
  %label stop op done
  %switch mode(1:3)

  %integerfunction manual stop

  !this function checks for input from the keyboard indicating
  !a manual request to stop an operation.

    %integer sym

    sym=testsymbol
    %if sym>=0 %then %start
      %cycle
      %repeat %until testsymbol<0
    %finish 
    %result=sym
  %end

  %integerfunction auto stop 1
  
  !this function checks to see if the number of packets
  !received exceeds the maximum number requested by the user

    %result=packs-maxpacks
  %end

  %integerfunction auto stop 2

  !this function is used only in playback operation
  !this function checks to see if a segment specified by the
  !user has just been reviewed

    %result=shortinteger(buffdet_get(2)) - (stp seg+1)
  %end

  stop=0
  ->mode(stop mode)

mode(1):
  %if manual stop>=0 %then stop=1
  ->stop op done
mode(2):
  %if auto stop 1 >= 0 %or manual stop >= 0 %then stop=1
  ->stop op done
mode(3):
  %if auto stop 2 = 0 %or manual stop  >= 0 %then stop=1

stop op done:
  %result=stop
%end



!---- Interpretation Module ----------------------------------------------------

%routine interpret (%integer intrprt mode,user fn) 

!this routine presents a single block,in the requested format,
!onto the VDU.
!this routine is called by both record and playback modules.

  %short blcklen
  %label interpretation done 
  %switch interpretation(0:2)


  %routine present byte

  !this routine presents a byte as an ASCII char in hex form.

    phex2(byteinteger(buffdet_get(user fn)))
    buffdet_get(user fn)=buffdet_get(user fn) + 1
  %end


  %routine present blck hdr

  !this routine presents a block header as a stream of bytes.

    present byte
    present byte
    printsymbol(' ')
    present byte
    present byte
    printsymbol(' ')
    present byte
    printsymbol (' ')
    present byte
    printsymbol(nl)
    scroll(1)
  %end


  %routine present pckt hdr

  !this routine presents a packet header as a stream of bytes.

    %integer n

    %for n=1,1,6 %cycle
      present byte
    %repeat
    printsymbol(' ')
    %for n=1,1,6 %cycle
      present byte
    %repeat
    printsymbol(' ')
    present byte
    printsymbol(' ')
    present byte
    printsymbol(nl)
    scroll(1)
  %end


  %routine present pckt data(%integer data bytes)

  !this routine presents packet data as a stream of bytes.

    %integer full lines,rem bytes,n,m

    full lines=data bytes//maxdatbytperline
    rem bytes=rem(data bytes,maxdatbytperline)
    %for n=1,1,full lines %cycle
      %for m=1,1,maxdatbytperline %cycle
        present byte
        printsymbol(' ')
      %repeat
      printsymbol(nl)
      scroll(1)
    %repeat
    %if rem bytes > 0 %then %start
      %for n=1,1,rem bytes %cycle
        present byte
        printsymbol(' ')
      %repeat
      printsymbol(nl)
      scroll(1)
    %finish
  %end


  %routine interpret blck hdr

  !this routine presents any significant information
  !in the block header if there is any.

    %byte status,time

    %routine present tick

    !this routine presents timing info

      tick=tick + time
      printstring("** T=")
      write(tick,5)
      printline(" **")
      printsymbol(nl)
      scroll(2)
    %end

    status=byteinteger(buffdet_get(user fn)+4)  
    time=byteinteger(buffdet_get(user fn)+5)
    %if time>0 %then present tick
    %if status & 128 > 0 %then %start    {empty block
      %if status !! 128 = 0 %then %start {end of trace marker
        printline("** D(t) **")
        printsymbol(nl)
        scroll(2)
      %finish %else %start
        %if status & 1 > 0 %then %start  {check fifo o/f bit
          printline("** D(f) **")
          printsymbol(nl)
          scroll(2)
        %finish
      %finish
                                         {move get to end of block header
      buffdet_get(user fn)=buffdet_get(user fn) + infobytes + 2  
    %finish %else %start                 {block contains packet
      %if status & 64 > 0 %then %start   {check buff o/f bit
        printline("** D(b) **")
        printsymbol(nl)
        scroll(2)
      %finish
      printstring("SEG NO.= ")
      present byte
      present byte
      spaces(4)
      printstring("BLCK LN.= ")
      present byte
      present byte
      spaces(4)
                                         {check other status bits
      %if status & 8 > 0 %then printstring("* CRCE *   ")
      %if status & 4 > 0 %then printstring("* COLL *   ")
      %if status & 2 > 0 %then printstring("* LONG *   ")
      %if status & 16> 0 %then printstring("* RECE *   ")
      printsymbol(nl)
      scroll(1)
                                         {move get to end of block header
      buffdet_get(user fn)=buffdet_get(user fn) + infobytes - 2  
    %finish
  %end
      

{old routine that has been superceded
!  %routine interpret pckt hdr
!
!    %byte type
!
!  %routine interpret addr
!
!    %integer n
!
!    printstring("stat= ")
!    present byte
!    printstring("   port= ")
!    present byte
!    printstring("   rdnt= ")
!    %for n=1,1,4 %cycle
!      present byte
!    %repeat
!    printsymbol(nl)
!    scroll(1)
!  %end
!
!  printstring("DEST ADDR      ")
!  interpret addr
!  printstring("SRCE ADDR      ")
!  interpret addr
!  type=byteinteger(buffdet_get(user fn))
!  buffdet_get(user fn)=buffdet_get(user fn) + 1
!  %if type=1 %then printline("TYPE           data") %c
!  %else %if type=129 %then printline("TYPE           ack") %c
!  %else %start
!    printstring("TYPE           ")
!    phex2(type)
!    printline("  * INVALID *")
!  %finish
!  scroll(1)
!  printstring("SEQ NO.        ")
!  present byte
!  printsymbol(nl)
!  scroll(1)
!%end


  %routine interpret pckt hdr

  !this routine presents a packet header in symbolic form.

    %integer dest loc,srce loc,type loc,type

    %routine interpret addr(%integer addr loc)

      %integer rdnt,n
  
      buffdet_get(user fn)=addr loc
      present byte
      printsymbol(':')
      present byte
      rdnt=integer(buffdet_get(user fn))
      %if rdnt#0 %then %start              {if error in address field
        printsymbol(':')                   {then display it.
        %for n=1,1,4 %cycle
          present byte
        %repeat
      %finish %else buffdet_get(user fn)=buffdet_get(user fn) + 4       
                                   {move get to end of addr field
    %end

    dest loc=buffdet_get(user fn)
    srce loc=buffdet_get(user fn) + 6
    type loc=buffdet_get(user fn) + 12
    interpret addr(srce loc)
    printstring(" -> ")
    interpret addr(dest loc)
    buffdet_get(user fn)=type loc
    type=byteinteger(buffdet_get(user fn))
    %if type=1 %then printstring("   data") %c
    %else %if type=129 %then printstring("   ack") %c
    %else %start                         {if error in type field display it
      spaces(3)
      phex2(type)
    %finish
    buffdet_get(user fn)=buffdet_get(user fn) + 1
    printsymbol('(')
    present byte
    printsymbol(')')
    printsymbol(nl)
    scroll(1)
  %end

  select window(2)

{diagnostics
{printstring("put");spaces(8);printstring("get(1)");newline;scroll(1)
{phex(buffdet_put);spaces(3);phex(buffdet_get(1));newline;scroll(1)

  blcklen=shortinteger(buffdet_get(user fn)+2)  
  ->interpretation(intrprt mode)

interpretation(0):
  present blck hdr
  %if blcklen >=14+infobytes %then %start    {block contains a packet
    present pckt hdr
    present pckt data(blcklen - (14+infobytes))
  %finish
  ->interpretation done

interpretation(1):
  interpret blck hdr
  %if blcklen >= 14+infobytes %then %start
    present pckt hdr
    present pckt data(blcklen - (14+infobytes))
  %finish
  ->interpretation done

interpretation(2):
  interpret blck hdr
  %if blcklen >= 14+infobytes %then %start
    interpret pckt hdr
    present pckt data(blcklen - (14+infobytes))
  %finish
  
interpretation done:
  printsymbol(nl)
  printsymbol(nl)
  scroll(2)
                                        {move get to beginning of next segment
  buffdet_get(user fn)=buffdet_get(user fn) + segsiz - (blcklen+2)
  %if buffdet_get(user fn)>=buffdet_bot %then buffdet_get(user fn)=buffdet_top

{diagnostics
{printstring("put");spaces(8);printstring("dget");newline;scroll(1)
{phex(buffdet_put);spaces(3);phex(buffdet_get(1));newline;scroll(1)
{printstring("ff");write(ff,2);newline;scroll(1)

%end



!---- Recording Module -----------------------------------------------------------

%routine record(%integer display on)

!this routine provides control of the recording operation.


  %routine set screen for recording

  !a 2 window arrangement is used in recording mode

   %integer c

    clear screen
    window(1)_topline=1
    window(1)_botline=4
    window(2)_topline=6
    window(2)_botline=screenlength-1
    %for c=1,1,2 %cycle
      window(c)_currline=window(c)_topline
    %repeat
    cursor to(window(1)_botline + 1,0)
    %for c=0,1,79 %cycle
      printsymbol('-')
    %repeat
    select window(1)
    printline("Packets Recorded=                 Time (sec)= ")
    printsymbol(nl)
    printstring("Status Bits:  fifo o/f  dma o/r     coll     crce")
    printline("     rece  buff o/f    empty")
    printline("Count")
    maxdatbytperline=screenwidth//3
  %end

  
  %routine recording initialisation
  
  !initialise recording vars

    fifo of cnt=0
    dma or cnt=0
    coll cnt=0
    crce cnt=0
    rece cnt=0
    timing cnt=0
    buff of cnt=0
    empty cnt=0
    packs=0
    blcks=0
    disblcks=0
    tick=0
    buffdet_get(1)=buffdet_put-2         {get and put start at same segment
    trace strt=buffdet_get(1)

{diagnostics vars
{stage1=0;stage2=0
{put1=0;put2=0;put3=0;put4=0;put5=0
{padd1=0;padd2=0
{pacr=0;pact=0
{bytt=0;byts=0
{badbyts=0
{f1=0
{ff=0
{diags1

  %end


  %routine recording finalisation

  !wind up recording operation

    trace end=buffdet_put-2
    shortinteger(buffdet_put)=infobytes      {create an empty block to
    byteinteger(buffdet_put + 2)=128         {mark end of trace.
    byteinteger(buffdet_put + 3)=0
    buffdet_put=buffdet_put + segsiz         {move put to next segment
    %if buffdet_put>=buffdet_bot %then %start 
      buffdet_put=buffdet_top+2
      buff full=1
    %finish
                                             {if trace filled buffer then
                                             {find earliest block in trace
    %if blcks>maxsegnum %then trace strt=buffdet_put-2
    select window(2)
    printstring("Trace Started at Segment No. ")
    phex4(shortinteger(trace strt))
    printline("(H)")
    scroll(1)
    printstring("Trace Ended at Segment No. ")
    %if trace end=buffdet_top %then phex4(maxsegnum) %c
    %else phex4(shortinteger(trace end - segsiz))
    printline("(H)")
    printsymbol(nl)
    scroll(2)

{diagnostics
{diags1

    printstring("Type <return> to exit recording mode:")
    skipsymbol
    %cycle
    %repeat %until testsymbol < 0
  %end


  %routine recording status review

  !this routine presents the recording operation statistics
  !onto the VDU

    select window(1)
    cursor to(window(1)_currline,19)
{phex4(packs)
    write(packs,6)
    cursor to(window(1)_currline,47)
    write(timing cnt//10,6)
    cursor to(window(1)_currline + 3,15)
    write(fifo of cnt,6)
    spaces(2)
    write(dma or cnt,6)
    spaces(2)
    write(coll cnt,6)
    spaces(2)
    write(crce cnt,6)
    spaces(2)
    write(rece cnt,6)
    spaces(3)
    write(buff of cnt,6)
    spaces(2)
{phex4(empty cnt)
    write(empty cnt,6)
  %end


  %routine start recording

  !this routine sends a ctrl char to the ether 
  !station which activates the station

    %cycle 
    %repeat %until ETHS & tbe # 0
    ETHC=str
    %cycle                              {wait for signal that recording
    %repeat %until monstat & 2 # 0      {has started
    select window(2)
    printsymbol(nl)
    scroll(1)
    printline("RECORDING STARTED")
    printsymbol(nl)
    scroll(2)

{diagnostics
{write(stage1,1);write(stage2,1);newline;scroll(1)
{phex(padd1);spaces(2);phex(padd2);newline;scroll(1)
{phex(put1);spaces(2);phex(put2);spaces(2);phex(put26);spaces(2)
{phex(put3);spaces(2);phex(put4);spaces(2);phex(put5);newline;scroll(1)
{phex(buffdet_top);spaces(2);phex(buffdet_bot);spaces(2)
{phex(buffdet_put);spaces(2);phex(buffdet_get(1));spaces(2)
{phex(buffdet_get(2));newline;scroll(1)

  %end


  %routine stop recording

  !this routine sends a ctrl char to the ether station which disables
  !the station until start recording is called again

    %cycle 
    %repeat %until ETHS & tbe # 0
    ETHC=stp
    %cycle                                {wait for signal that recording
    %repeat %until monstat & 2 =0         {has stopped
    select window(2)
    printsymbol(nl)
    scroll(1)
    printline("RECORDING STOPPED")
    printsymbol(nl)
    scroll(2)
  
{diagnostics
{printstring("packs=");phex(packs);newline;scroll(1)
{printstring("pacr=");phex4(pacr);newline;scroll(1)
{printstring("pact=");phex4(pact);newline;scroll(1)
{printstring("byts=");phex(byts);newline;scroll(1)
{printstring("bytt=");phex4(bytt);newline;scroll(1)
{printstring("badbyts=");phex4(badbyts);newline;scroll(1)

    recording status review               {present final stats.
  %end
  

  %routine record only

  !this routine stops recorded as requested and presents
  !recording stats.

    %if monstat & 2 = 0 %then %start      {if recording not started
      set screen for recording
      recording initialisation
      start recording
    %finish
    %cycle

{diagnostics
{select window(2)
{phex(buffdet_put);newline;scroll(1)

      %if stop op(stp rec md)=1 %then %start
        stop recording
        recording finalisation
        %return
      %finish
      recording status review
    %repeat
  %end
  

  %routine record and display

  !this routine displays recorded data while recording

    set screen for recording
    recording initialisation
    start recording
    %cycle
      %cycle
        %if stop op(stp rec md)=1 %then %start   
          stop recording                          
          recording finalisation
          %return
        %finish

!    %if monstat & 2 # 0 %then %start              {this code displays
!      %if stop op(stp rec md)=1 %then %start   {packets recorded
!        stop recording   {even after recording
!         recording finalisation
!      %finish                                     {has stopped
!    %finish %else %start
!      %if buffdet_get(1)+2=buffdet_put %then %return
!    %finish

      %repeat %until buffdet_get(1)+2#buffdet_put 
      %if blcks-disblcks>maxsegnum %then %start  {check if recording has
        select window(2)                         {lapped display
        printsymbol(nl)
        scroll(1)
        printline("DISPLAY STOPPED:recording overtaken display")
        scroll(1)

{diagnostics
{printstring("put");spaces(8);printstring("get(1)");newline;scroll(1)
{phex(buffdet_put);spaces(3);phex(buffdet_get(1));newline;scroll(1)
{printstring("blcks=");phex(blcks);spaces(2)
{printstring("disblcks=");phex(disblcks);newline;scroll(1)
{printstring("maxsegnum=");phex(maxsegnum);newline;scroll(1)
{printstring("ff");write(ff,2);newline;scroll(1)

        record only                              {continue recording
        %return
      %finish
      interpret (intrprt level,op mode)
      disblcks=disblcks+1
      recording status review
    %repeat
  %end
  

  %if display on>0 %then record and display %else record only
%end


!---- Playback Module -----------------------------------------------------------

%routine playback
 
!this routine presents data already recorded and provides
!control over which data is presented.


  %routine set screen for playback

  !a 2 window arrangement is used in playback mode

    %integer c

    clear screen
    window(1)_topline=1
    window(1)_botline=4
    window(2)_topline=6
    window(2)_botline=screenlength-1
    %for c=1,1,2 %cycle
      window(c)_currline=window(c)_topline
    %repeat
    cursor to(window(1)_botline + 1,0)
    %for c=0,1,79 %cycle
      printsymbol('-')
    %repeat
    select window(1)
    printstring("Strt Seg No.= ")
    spaces(10)
    printstring("Blcks= ")
    spaces(16)
    printline("Packet Count= ")
    newline
    printstring("Events:       D(t)      D(f)      D(b)")
    printline("      crce      coll      long      rece")
    printline("Count")
    maxdatbytperline=screenwidth//3
  %end


  %routine playback initialisation

  !initialise playback vars

    %if str pb md=3 %then buffdet_get(2) = trace strt  %c
    %else %if str pb md=2 %then buffdet_get(2)=buffdet_top + strt seg*segsiz
    %if stp pb md=4 %then %start
      %if trace end=buffdet_top %then stp seg=maxsegnum %c
      %else stp seg=shortinteger(trace end - segsiz)
      stp pb md=3
    %finish
    tick=0
    packs=0
    blcks=0
    gap cnt=0
    fifo of cnt=0
    buff of cnt=0
    crce cnt=0
    coll cnt=0
    dma or cnt=0
    rece cnt=0
    delay=0
    select window(1)
    cursor to(window(1)_currline,15)       {indicate at which segment
    phex4(shortinteger(buffdet_get(2)))    {playback is starting
    printstring("(H)")

{diagnostics
{diags1

  %end


  %routine playback finalisation

  !wind up playback operation

{diagnostics
{diags1

    select window(2)
    printstring("Type <return> to exit playback mode:")
    skipsymbol
    %cycle
    %repeat %until testsymbol<0
  %end


  %routine playback status update

  !this routine checks the status field of the next
  !block to be displayed and updates the playback
  !operation statistics

    %byte next status

    blcks=blcks + 1
    next status=byteinteger(buffdet_get(2) + 4)
    %if next status & 128 > 0 %then %start     {empty block
      %if next status !! 128 = 0 %then gap cnt=gap cnt + 1  %c
      %else %if next status & 1 > 0 %then fifo of cnt=fifo of cnt + 1
    %finish %else %start                     {block contains a packet
      packs=packs +1 
      %if next status & 64> 0 %then buff of cnt=buff of cnt + 1
      %if next status & 8 > 0 %then crce cnt=crce cnt + 1
      %if next status & 4 > 0 %then coll cnt=coll cnt + 1
      %if next status & 2 > 0 %then dma or cnt=dma or cnt + 1
      %if next status & 16> 0 %then rece cnt=rece cnt + 1
    %finish
  %end


  %routine playback status review
  
  !this routine presents the playback operation statistics
  !onto the VDU

    select window(1)
    cursor to(window(1)_currline,32)
    phex4(blcks)
    printstring("(H)")
    cursor to(window(1)_currline,62)
    write(packs,6)
    cursor to(window(1)_currline + 3,11)
    write(gap cnt,6)
    spaces(3)
    write(fifo of cnt,6)
    spaces(3)
    write(buff of cnt,6)
    spaces(3)
    write(crce cnt,6)
    spaces(3)
    write(coll cnt,6)
    spaces(3)
    write(dma or cnt,6)
    spaces(3)
    write(rece cnt,6)
  %end
  

  set screen for playback
  playback initialisation
  %cycle
    %cycle                                {pb delay cycle
    %repeat %until delay>5                {present next block 0.5 sec
    delay=0                               {after last one
    %if stop op(stp pb md)=1 %then %start
      playback status review
      select window(2)
      printsymbol(nl)
      scroll(1)
      printline("PLAYBACK COMPLETE")
      printsymbol(nl)
      scroll(2)
      playback finalisation
      %return
    %finish
                       {check if an unused segment has been reached
    %if buff full=0 %and buffdet_get(2)+2>=buffdet_put %then %start
      playback status review
      select window(2)
      printsymbol(nl)
      scroll(1)
      printline("PLAYBACK STOPPED:end of recorded data reached")
      printsymbol(nl)
      scroll(2)
      playback finalisation
      %return
    %finish
    playback status update
    interpret (intrprt level,op mode)
    playback status review
  %repeat
%end
  


!---- Program Body - User Interface ------------------------------------------------------------------

begin:
  monstat=0
  set terminal mode(8)
  prompt("")
  clear screen

  newlines(3)
  q=2
  printline("Please specify the maximum number of bytes in a single packet")
  printline("that you wish to record.")
  newline
  printline("The 2 Mbps network runs the EUCSD protocol which has a packet")
  printline("with a 14 byteheader,0-532 bytes of data and a 2 byte trailer")
  printline("(excluding the 2 byte checksum).")
  printline("You may record between 14 and 548 bytes.")
  newline
reply(2):
  %cycle
    printstring("No. of bytes= ")
    bytes=readinteger(10)
    newline
  %repeat %until 14 <= bytes <= 548 
  maxblcksiz=bytes+infobytes                

  newlines(3)
  q=3
  printline("Which Receive Mode do you require ?")
  newline
  printline("Mode 00: accept all packets.")
  printline("Mode 10: accept all packets to or from a specified station.")
  printline("Mode 20: accept all packets exchanged between 2 specified stations.")
  newline
reply(3):
  %cycle
    printstring("Mode= ")
    rcvmode=readinteger(10)
    newline
  %repeat %until rcvmode=0 %or rcvmode=10 %or rcvmode=20

  %if rcvmode>0 %then %start
    newlines(3)
    %if rcvmode=10 %then %start
      q=4
      printline("Please specify station address for Receive Mode 10 operation.")
      newline
      printline("Give address in hex.")
      newline
reply(4):
      printstring("Stat Addr= ")
      stat1=readinteger(16)

      newlines(2)
      q=5
      printstring("Do you wish to only accept packets using a particular port")
      printline(" of this station?")  
      newline
reply(5):
      %cycle
        printstring("Y or N ? ")
        read 1 char(answer)
        %if 'a'<=answer<='z' %then answer=answer-32
        newline
      %repeat %until answer='Y' %or answer='N'

      %if answer='Y' %then %start
        newline
        q=6
        printline("Please specify port number in decimal.")
        newline
        printline("Range for port numbers is 0 - 31.")
        newline
reply(6):
        %cycle
          printstring("Port No= ")
          port1=readinteger(10)
          newline
        %repeat %until 0<=port1<=31
        rcvmode=11
        newline
        printline("You will now be using Receive Mode 11.")
      %finish

    %finish %else %start
      q=7
      printline("Please specify 1st station address for Receive Mode 20 operation.")
      newline
      printline("Give address in hex.")
      newline
reply(7):
      printstring("Stat1 Addr= ")
      stat1=readinteger(16)

      newlines(2)
      q=8
      printstring("Do you wish to only accept packets using a particular")
      printline(" port of this station?")
      newline
reply(8):
      %cycle
        printstring("Y or N ? ")
        read 1 char(answer)
        %if 'a'<=answer<='z' %then answer=answer-32
        newline
      %repeat %until answer='Y' %or answer='N'

      %if answer='Y' %then %start
        newline
        q=9
        printline("Please specify port number in decimal.")
        newline
        printline("Range for port numbers is 0 - 31.")
        newline
reply(9):
        %cycle
          printstring("Port1 No= ")
          port1=readinteger(10)
          newline
        %repeat %until 0<=port1<=31
        rcvmode=21
      %finish

      newline
      q=10
      printline("Please specify 2nd station address for Receive Mode 20 operation.")
      newline
      printline("Give address in hex.")
      newline
reply(10):
      printstring("Stat2 Addr= ")
      stat2=readinteger(16)

      newlines(2)
      q=11
      printstring("Do you wish to only accept packets using a particular")
      printline(" port of this station?")
      newline
reply(11):
      %cycle
        printstring("Y or N ? ")
        read 1 char(answer)
        %if 'a'<=answer<='z' %then answer=answer-32
        newline
      %repeat %until answer='Y' %or answer='N'
      
      %if answer='Y' %then %start
        newline
        q=12
        printline("Please specify port number in decimal.")
        newline
        printline("Range for port numbers is 0 - 31.")
        newline
reply(12):
        %cycle
          printstring("Port2 No= ")
          port2=readinteger(10)
          newline
        %repeat %until 0<=port2<=31
        %if rcvmode=20 %then %start
          temp=stat1
          stat1=stat2
          stat2=temp
          port1=port2
          rcvmode=21
          newline
          printline("You will now be using Receive Mode 21.")
        %finish %else %start
          rcvmode=22
          newline
          printline("You will now be using Receive Mode 22.")
        %finish
      %finish %else %start
        %if rcvmode=21 %then %start
          newline
          printline("You will now be using Receive Mode 21.")
        %finish
      %finish
    %finish
  %finish

{set up ether station
preload(monfirm,buffer)
set firm vars(buffer(16_3))
load(buffer)

{set up APM
prime monitor
buffer initialisation

{diagnostics
{newlines(2)
{printstring("buff addr");phex(addr(buffer(0)));printstring("  ")
{phex(addr(buffer(buffsiz-1)));newline
{printstring("buffdet addr");phex(addr(buffdet));newline
{printstring("buffdet_top");phex(buffdet_top);newline
{printstring("buffdet_bot");phex(buffdet_bot);newline
{printstring("buffdet_put");phex(buffdet_put);newline
{printstring("buffdet_get(1)");phex(buffdet_get(1));newline
{printstring("maxsegnum= ");phex(maxsegnum);newline
{printstring("segsize=");write(segsiz,1);newline
{printstring("rcvmode=");write(rcvmode,1);newline
{printstring("stat1=");write(stat1,1);newline
{printstring("port1=");write(port1,1);newline
{printstring("stat2=");write(stat2,1);newline
{printstring("port2=");write(port2,1);newline

newlines(3) 
printstring("Buffer segment number range is 0000 to ")
phex4(maxsegnum)
printline("(H).")

%cycle
  newlines(3)
  q=13
  printline("Now select one of the following operation modes.")
  newline
  printline("Mode 1:operate monitor in record mode")
  printline("Mode 2:operate monitor in playback mode")
  printline("Mode 3:reinitialise monitor")
  printline("Mode 4:exit monitor")
  newline
reply(13):
  %cycle
    printstring("Mode= ")
    op mode=readinteger(10)
    newline
  %repeat %until 1<=op mode<=4

  %if op mode= 1 %then %start
    newlines(2)
    q=14
    printline("Select 'Stop Recording Mode'.")
    newline
    printline("Stp Rec Mode 1:manual stop after any key is hit")
    printstring("Stp Rec Mode 2:auto stop after a specified ")
    printline("number of packets have been recorded")
    newline
reply(14):
    %cycle
      printstring("Stp Rec Mode= ")
      stp rec md=readinteger(10)
      newline
    %repeat %until 1<=stp rec md<=2

    %if stp rec md=2 %then %start
      newlines(1)
      q=15
      printline("Specify the number of packets you wish to record.")
      newline
reply(15):
      %cycle
        printstring("No. of Packets= ")
        maxpacks=readinteger(10)
        newline
      %repeat %until maxpacks>=0
    %finish

    newlines(2)
    q=17
    printline("Do you wish to display data received during recording?")
    newline
reply(17):
    %cycle
      printstring("Y or N ? ")
      read 1 char(answer)
      %if 'a'<=answer<='z' %then answer=answer-32
      newline
    %repeat %until answer='Y' %or answer='N'
    %if answer='Y' %then sel dis=1 %else sel dis=0

    %if sel dis=1 %then %start
      newlines(1)
      q=18
      printline("Select Block Interpretation Level.")
      newline
      printline("Level 0:no interpretation")
      printline("Level 1:monitor block interpretation")
      printline("Level 2:link level packet interpretation")
      newline
reply(18):
      %cycle
        printstring("Level= ")
        intrprt level=readinteger(10)
        newline
      %repeat %until 0<=intrprt level<=2
    %finish
 
    newlines(2)
    q=19
reply(19):
    printstring("Type <return> to begin recording:")
    skipsymbol
    %cycle
    %repeat %until testsymbol<0 
    record(sel dis)
  %finish %else %start

    %if op mode=2 %then %start
      %if trace strt=0 %then %start
        printline("No trace recorded yet,reselect Option.")
        newline
        ->reply(13)
      %finish

      newlines(2)
      q=20
      printline("Select 'Start Playback Mode'.")
      newline
      printline("Strt Pb Mode 1:playback from where playback last stopped")
      printline("Strt Pb Mode 2:playback from a specified segment")
      printline("Strt Pb Mode 3:playback from beginning of last trace recorded")
      newline
reply(20):
      %cycle
        printstring("Strt Pb Mode= ")
        str pb md=readinteger(10)
        newline
      %repeat %until 1<=str pb md<=3

      %if str pb md=2 %then %start
        %if bufffull=1 %then lastseg=maxsegnum %else %c
          lastseg=shortinteger(trace end)
        newlines(1)
        q=21
        printline("Specify playback start segment number (in hex).")
        printstring("Recorded segment number range is 0000 to ")
        phex4(lastseg)
        printsymbol('.')
        newlines(2)
reply(21):
        printstring("Start Segment No.= ")
        strt seg=readinteger(16)
        newline
        %if 0>strt seg %or strt seg>lastseg %then %start
          printstring("This segment has not been recorded on,")
          printline("respecify start segment number.")
          newline
          ->reply(21)
        %finish
      %finish

      newlines(2)
      q=22
      printline("Select 'Stop Playback Mode'.")
      newline
      printline("Stp Pb Mode 1:manual stop after any key is hit")
      printstring("Stp Pb Mode 2:auto stop after a specified number of packets")
      printline(" have been replayed")
      printline("Stp Pb Mode 3:auto stop at a specified segment")
      printline("Stp Pb Mode 4:auto stop at the end of last trace recorded")
      newline
reply(22):
      %cycle 
        printstring("Stp Pb Mode= ")
        stp pb md=readinteger(10)
        newline
      %repeat %until 1<=stp pb md<=4

      %if stp pb md=2 %then %start
        newlines(1)
        q=23
        printline("Specify the number of packets you wish to playback.")
        newline
reply(23):
        %cycle
          printstring("No. of Packets= ")
          maxpacks=readinteger(10)
        %repeat %until maxpacks>=0
      %finish %else %start

        %if stp pb md=3 %then %start
          %if buff full=1 %then lastseg=maxsegnum %else %c
            lastseg=shortinteger(trace end)
          newlines(1)
          q=24
          printline("Specify playback stop segment number (in hex).")
          printstring("Recorded segment number range is 0000 to ")
          phex4(lastseg);newline
          newline
reply(24):
          printstring("Stop Segment No.= ")
          stp seg=readinteger(16)
          newline
          %if 0>stp seg %or stp seg>lastseg %then %start
            printstring("This segment has not been recorded on,")
            printline("respecify stop segment number.")
            newline
            ->reply(24)
          %finish
        %finish
      %finish

      newlines(2)
      q=25
      printline("Select Block Interpretation Level")
      newline
      printline("Level 0:no interpretation")
      printline("Level 1:monitor block interpretation")
      printline("Level 2:link level packet interpretation")
      newline
reply(25):
      %cycle 
        printstring("Level= ")
        intrprt level=readinteger(10)
        newline
      %repeat %until 0<=intrprt level<=2

      newlines(2)
      printstring("Type <return> to begin playback:")
      skipsymbol
      %cycle
      %repeat %until testsymbol<0
      playback

    %finish %else %start             {op mode= 3 or 4
      reset apm
      %if op mode=4 %then %return 
      -> begin
    %finish
  %finish

  clear screen
%repeat

%endofprogram
