include  "i:fs.inc"
include  "i:util.inc"

begin ; !Ethernet monitor station (Aug 83)

bytespec (16_7fffc)status
bytespec (16_7fffd)data
bytespec (16_7ffff)control
constinteger  tbe=8,rd=4,rc=2,rbf=1

integer  sym,fileend,i
integer  phase=0,count=0
constinteger  filebeg=16_1000

recordformat  intf(integer  top,bot,put,get)
record (intf)intbuf
integer  bufsize=16_50000
bytearray  buffer(0:bufsize-1)

constinteger  cr=13,esc=27,nopage=8
integer  crc=0,col=0,dov=0,fov=0,pak=0,ack=0,ret=0,qqq=0

routine  preload; !Read Z80 object file into an array
integer  sym
  onevent  9 start 
    closeinput; selectinput(0); return 
  finish 
  selectinput(1)
  fileend = filebeg
  cycle 
    readsymbol(sym); buffer(fileend) = sym; fileend = fileend+1
  repeat 
end 

routine  load; !Load Station's Z80 (cutting filestore umbilical)
integer  sym,ad
  sym = 0; status = sym; ! Disable station interrupts
  control = 16_03
  cycle 
  repeatuntil  status&tbe#0
  ad = 16_1000
  while  ad<fileend cycle 
    sym = buffer(ad)
    data = sym
    cycle 
    repeatuntil  status&tbe#0
    ad = ad+1
  repeat 
  control = 16_0b
  cycle 
  repeatuntil  status&tbe#0
end 

routine  ether interrupt handler(record (*)name  r)
*=16_43FA;*=16_000C;          !   lea int,a1
*=16_21C9;*=16_1070;          !   move.l a1,$1070
*=16_2348;*=16_0006;          !   move.l a0,6(a1)
*=16_4E75;                    !   rts
*=16_48E7;*=16_C0C0;          ! int movem.l d0/d1/a0/a1,-(sp)
*=16_207C;*=16_0006;*=16_00A1;!   move.l #$000600a1,a0; !Overwriten with A0
*=16_1039;*=16_0007;*=16_FFFC;!   move.b $7fffc,d0
*=16_0800;*=16_0001;          !   btst #1,d0
*=16_6734;                    !   beq.s data
*=16_2268;*=16_0008;          !   move.l 8(a0),a1
*=16_720E;                    !   moveq #14,d1
*=16_12F9;*=16_0007;*=16_FFFF;!   move.b $7ffff,(a1)+
*=16_1039;*=16_0007;*=16_FFFC;! loop move.b $7fffc,d0
*=16_0800;*=16_0002;          !   btst #2,d0
*=16_67F4;                    !   beq loop
*=16_12F9;*=16_0007;*=16_FFFD;!   move.b $7fffd,(a1)+
*=16_51C9;*=16_FFEC;          !   dbra d1,loop
*=16_B3E8;*=16_0004;          !   cmp.l 4(a0),a1
*=16_6602;                    !   bne.s x1
*=16_2250;                    !   move.l (a0),a1
*=16_2149;*=16_0008;          ! x1 move.l a1,8(a0)
*=16_4CDF;*=16_0303;          ! intret movem.l (sp)+,d0/d1/a0/a1
*=16_4E73;                    !   rte
*=16_1039;*=16_0007;*=16_FFFD;! data move.b $7fffd,d0
*=16_60F2;                    !   bra intret
end 

routine  date time
string (31)s
  length(s) = fcommr('G'<<8,"",charno(s,1),31)
  printstring(s)
end 

routine  at(integer  line,col)
  printsymbol(esc); printsymbol('Y')
  printsymbol(line+' '); printsymbol(col+' ')
end 

routine  log(integername  err)
  err = err+1
  if  err=1 start 
        if  err==pak then  at(1,40) and  printstring("Pak=") c 
    elseif  err==ack then  at(1,50) and  printstring("Ack=") c 
    elseif  err==crc then  at(1, 0) and  printstring("CRC=") c 
    elseif  err==col then  at(1,10) and  printstring("COL=") c 
    elseif  err==dov then  at(1,20) and  printstring("DOV=") c 
    elseif  err==fov then  at(1,30) and  printstring("FOV=") c 
    elseif  err==ret then  at(1,60) and  printstring("Ret=") c 
                     else  at(1,70) and  printstring("???=")
  finish 
      if  err==pak then  at(1,44) c 
  elseif  err==ack then  at(1,54) c 
  elseif  err==crc then  at(1, 4) c 
  elseif  err==col then  at(1,14) c 
  elseif  err==dov then  at(1,24) c 
  elseif  err==fov then  at(1,34) c 
  elseif  err==ret then  at(1,64) c 
                   else  at(1,74)
  phex4(err)
end 

recordformat  rawf(byte  st,ds,dp,ss,sp,ty,sq,dsl,dsh,psl,psh,d1,d2,d3,d4,d5)
record (rawf)name  raw

routine  process packet
  routine  p(integer  x)
    if  '!'<=x<='~' start 
      printsymbol(x); printsymbol('_') if  x='_'
    else 
      printsymbol('_'); phex2(x)
    finish 
  end 
  raw == record(intbuf_get)
  intbuf_get = intbuf_get+16
  intbuf_get = intbuf_top if  intbuf_get=intbuf_bot
  if  raw_st&15#0 start 
    printsymbol('*'); phex1(raw_st); newline; return 
  finish 
  phex2(raw_ss); phex2(raw_sp); printstring("->")
  phex2(raw_ds); phex2(raw_dp); printsymbol(':')
  phex2(raw_ty); phex2(raw_sq); space
  phex2(raw_dsh); phex2(raw_dsl)
  if  raw_dsh=raw_psh and  raw_dsl=raw_psl c 
    then  printsymbol('=') else  printsymbol('#')
  phex2(raw_psh); phex2(raw_psl)
  if  raw_ty&128=0 start 
    space; p(raw_d1); p(raw_d2); p(raw_d3); p(raw_d4); p(raw_d5)
  finish 
  newline
end 

routine  intervene
integer  sym,i
  sym = testsymbol
  returnif  sym<0
  if  sym='@' start 
    intbuf_get = intbuf_put-16*22
  elseif  sym='-' start 
    printsymbol(7)
    read(sym); readsymbol(i) until  i=nl
    intbuf_get = intbuf_put-16*(22+sym)
  finishelsereturn 
  if  intbuf_get<intbuf_top start 
    intbuf_get = intbuf_get+intbuf_bot-intbuf_top
  elseif  intbuf_get>=intbuf_bot start 
    intbuf_get = intbuf_get+intbuf_top-intbuf_bot
  finish 
  process packet for  i=1,1,22
  printstring("::")
  sym = testsymbol until  sym=nl
  newline
end 

!*   I N I T I A L I S E

  set terminal mode(nopage)
  intbuf_top = addr(buffer(0))
  intbuf_bot = intbuf_top+bufsize
  intbuf_put = intbuf_top; intbuf_get = intbuf_top
  openinput(1,"ether:monitor.bin"); preload
  load
  ether interrupt handler(intbuf)
  status = 6; ! Re-enable station interrupts (receive-only)

!** Main Program Loop

cycle 
  while  intbuf_get#intbuf_put cycle 
    process packet
    intervene
  repeat 
  intervene
repeat 

endofprogram