%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
