!*************************** DIAGMON *****************************************
                                                                
!ETHERNET DIAGNOSTIC MONITOR SOFTWARE PROGRAM.
!W.I.WALKER MSC PROJECT 1984
!Modded JHB 1/1985

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

%begin

@16_1070 %integer EV
@16_1078 %integer CV

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

%ownbyte rcvmode=0,stat1=0,port1=0,stat2=0,port2=0,monstat=0
%short segnum,lastseg
%owninteger stp seg=0,strt seg=0,op mode=0,sel dis=0,stp rec md=0,str pb md=0,stp pb md=0
%owninteger bytes=0,maxblcksiz=534,maxsegnum=0,segsiz=0,maxdatbytperline=0
%integer temp,file end,original CV,original EV,maxpacks
%integer timing cnt,gap cnt,tick,trace strt,trace end,intrprt level
%integer blcks,disblcks,buff full,delay
%integer i
%bytearray buffer(0:buffsiz-1)
%recordformat bd(%integer top,bot,put,%integerarray get(1:2))
%ownrecord(bd) buffdet 

%routine %spec reset apm


%on %event 0 %start            
  %if event_sub=1 %start 
    %if monstat & 1 # 0 %then reset apm  {this event is signalled by <ctrl y>
    %stop                                {leave program under control
  %finish
%finish                               {the prompt for the question is
                                      {returned to.



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

%routine clear screen
  printsymbol(esc);  printsymbol('v')
%end


%routine prline(%string (255) s)
  newline; printline(s); newline
%end


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

%routine wait for return
    printstring("Type <return> to continue")
    skipsymbol
    %cycle
    %repeat %until testsymbol < 0
%end


%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

  %on %event 3,9 %start
    close input
    select input(0)
    %return
  %finish

  open input(1,file);  select input(1)

  %for file end=0,1,buffsiz %cycle ;!Guaranteed to exit via %event
    readsymbol(area(file end))
  %repeat
%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
  %for ad=0, 1, file end-1 %cycle
    twait
    ETHD=area(ad)                     {pass data to station through data
  %repeat
  twait
  ETHC=16_0B                          {end of data,return to normal procedures
%end                                     {for handling data arriving at station


%routine prime monitor

  %routine clock tick
    %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)
    %label intaddr,ccstr,ccstp,ccstx,erwait,loop,blck done
    %label notctrl,newput,intretn

    *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
    *btst #1,ETHS                     {if intrpt not from ctrl reg then
    *beq notctrl                      {do nothing and jmp to notctrl

    *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
    *bset #1,monstat                  {indicates that firmware is recording
    *bra intretn

  ccstp:                              {station no longer passing on received
                                      {packets
    *bclr #1,monstat                  {indicates that firmware is not recording
    *bra intretn                      

  ccstx:
    *movea.l 8(a0),a1                 {load buffdet_put int a1
    *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 #7,d1
    *beq loop
    *bra blck done                      {receive

  loop:
    *bsr erwait                         {wait for next char
    *move.b ETHD,(a1)+                  {loaded remainder of block into buffer
    *dbra d2,loop                       {

  blck done:
    *addq.l #1,blcks
    *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

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

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

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

  erwait:                               {wait for next char to arrive
    *btst #2,ETHS
    *beq erwait
    *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 fillblock(%integer bytes,from,filler)
!  %returnif bytes<=0
%label x,y
   *tst.l d0
   *ble y
   *move.l d1,a1
   *sub.l #1,d0
x: *move.b d2,(a1)+
   *dbra d0,x
   *bra y
y:
%end

%routine buffer initialisation
!this routine sets up the segmented,circular buffer
  %integer segaddr,i

  fillblock(buffsiz, addr(buffer(0)), 0)

  segsiz=maxblcksiz + 2 + rem(maxblcksiz+2,2)
  maxsegnum=buffsiz//segsiz - 1

  %for segnum=0, 1, maxsegnum %cycle   {init. segment number fields
    shortinteger(addr(buffer(segnum*segsiz)))=segnum
  %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
  prline("APM has been reset for normal use.")
%end



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

%predicate stop condition occurred(%integer stop mode)
    %if testsymbol>=0 %start
      %cycle
      %repeat %until testsymbol<0
      %true
    %finish 
    %false
%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

  %routine present bytes(%integer bytes, spcs)

  !this routine presents <bytes> bytes as ASCII chars in hex form.
  %integer i

  %for i=1,1,bytes %cycle
    phex2(byteinteger(buffdet_get(user fn)))
    buffdet_get(user fn)=buffdet_get(user fn) + 1
  %repeat

  %if spcs>=0 %then spaces(spcs) %else newline
  %end


  %routine present pckt hdr

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

    present bytes(6,1)
    present bytes(6,1)
    present bytes(1,1)
    present bytes(1,-1)
  %end


  %routine present pckt data(%integer data bytes)

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

    %integer full lines,act lines,rem bytes,n,m

    full lines=data bytes//maxdatbytperline
    %if full lines <=2 %then act lines = full lines %else act lines = 2
    rem bytes=rem(data bytes,maxdatbytperline)
    %for n=1,1,act lines %cycle
      %for m=1,1,maxdatbytperline %cycle
        present bytes(1,1)
      %repeat
      newline
    %repeat
    buffdet_get(user fn)=buffdet_get(user fn)+ (full lines-act lines)*maxdatbytperline
    printline("...") %if act lines # full lines
    %if rem bytes > 0 %start
      %for n=1,1,rem bytes %cycle
        present bytes(1,1)
      %repeat
      newline
    %finish
  %end


  %routine interpret blck hdr
    !this routine presents any significant information
    !in the block header if there is any.
    %byte status,time

    status=byteinteger(buffdet_get(user fn)+4)  
    time=byteinteger(buffdet_get(user fn)+5)

    %if time#0 %start
      tick=tick + time
      printsymbol('['); write(tick,-1); printsymbol(']')
      newline
    %finish

    %if status & 128 # 0 %start    {empty block
      %if status !! 128 = 0 %start {end of trace marker
        printline("** D(t) **")
      %elseif status & 1 # 0  {check fifo o/f bit
        printline("** D(f) **")
      %finish
                                         {move get to end of block header
      buffdet_get(user fn)=buffdet_get(user fn) + infobytes + 2  
    %else                                {block contains packet
      %if status & 64 # 0 %start   {check buff o/f bit
        printline("** D(b) **")
      %finish
      printstring("Seg No.= ")
      present bytes(2,4)
      printstring("Blck Ln.= ")
      present bytes(2,4)
                                         {check other status bits
      %if status & 16_1E#0 %start
         printsymbol('*')
         %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")
         printline(" *")
      %finish
                                         {move get to end of block header
      buffdet_get(user fn)=buffdet_get(user fn) + infobytes - 2  
    %finish
  %end
      

  blcklen=shortinteger(buffdet_get(user fn)+2)  

  interpret blck hdr

  %if blcklen >=14+infobytes %start    {block contains a packet
    present pckt hdr
    present pckt data(blcklen - (14+infobytes))
  %finish

  newline
                                        {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

%end


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

%routine record(%integer display on)
 !this routine provides control of the recording operation.


  %routine set screen for recording
    clear screen
    %if stat1 > 127 %then printstring("All") %else phex2(stat1)
    printstring(" <-> ")
    %if stat2 > 127 %then printstring("All") %else phex2(stat2)
    newlines(2)
    maxdatbytperline=screenwidth//3
  %end

  
  %routine recording initialisation
  
    !initialise recording vars
    %integer i
    timing cnt=0
    disblcks=0;     tick=0
    buffdet_get(1)=buffdet_put-2         {get and put start at same segment
    trace strt=buffdet_get(1)
  %end


  %routine recording finalisation
    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 %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
    printstring("Trace Occupies Segments ")
    write(shortinteger(trace strt), 3)
    printstring(" to ")
    %if trace end=buffdet_top %then write(maxsegnum, 3) %c
    %else write(shortinteger(trace end - segsiz), 3)
    newline

    wait for return
  %end

  %routine start recording
    set screen for recording; recording initialisation
    twait
    ETHC=str
    %cycle                              {wait for signal that recording
    %repeat %until monstat & 2 # 0      {has started
    printline("RECORDING STARTED")
%end


  %routine stop recording(%string (63) why, %integer extra)
    twait
    ETHC=stp
    %cycle                                {wait for signal that recording
    %repeat %until monstat & 2 =0         {has stopped
    newline
    printline("Recording Stopped - ".why)
     recording finalisation               {present final stats.
  %end
  

  %routine record and display
    %on 0 %start
       %if event_sub=1 %then stop recording("User abort",0) %else %c
       stop recording("Unspecified event 0/".itos(event_sub,-1), event_extra)
       %return
    %finish

    start recording
    %cycle
      %cycle
        %if stop condition occurred(stp rec md) %start   
          stop recording("Specified stop occurred",0)
          %return
        %finish

      %repeat %until buffdet_get(1)+2#buffdet_put 
      %if blcks-disblcks>maxsegnum %start  {check if recording has
        newline
        printline("Display Stopped: recording overtaken display")

        reset apm
        %stop
      %finish
      interpret (intrprt level,op mode)
      disblcks=disblcks+1
    %repeat
  %end
  

  record and display
%end


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

  monstat=0; stat1=128; stat2=128
  set terminal mode(8)
  maxblcksiz=534+infobytes+14

  newline

  op mode=1
  stp rec md=1

  sel dis=1
  intrprt level=0

  stat1=16_71; port1=0; stat2=16_80; port2=0
  preload(monfirm,buffer)
      
  buffer(3)<-maxblcksiz
  buffer(4)<-maxblcksiz>>8
  buffer(5)=10
  buffer(6)=16_71
  buffer(7)=0
  buffer(8)=16_80
  buffer(9)=0
    
  load(buffer)
  buffer initialisation
  printline("Buffer segment number range is 0 to ".itos(maxsegnum,3))
  prompt("")
  wait for return
  prime monitor

  record(sel dis)
  reset apm
  clear screen

%endofprogram