%routine newline
  printsymbol(27); printsymbol('x'); printsymbol(nl)
%end

%routine sameline
  printsymbol(27); printsymbol('x'); printsymbol(13)
%end

%Constinteger known = 10

%Conststring(17)%array texthosts (1:known) = %c
"EcsVax           ",
"CstVax           ",
"Sun 1            ",
"Altair           ",
"Itspna           ",
"Broadcast        ",
"Its63 a          ",
"Its63 b          ",
"ErcVax           ",
"Perq             "

%Conststring(17)%array dtehosts (1:known) = %c
"AA-00-03-01-0C-D7",
"AA-00-03-01-17-37",
"08-00-20-01-15-12",
"08-00-20-01-14-6D",
"00-00-8B-82-00-01",
"FF-FF-FF-FF-FF-FF",
"02-07-01-00-19-DF",
"02-07-01-00-38-E3",
"AA-00-03-01-0E-05",
"02-1C-7C-00-04-5F"

%recordformat IP header fm((%byte IHL,                { includes version }
                            %byte type of service,
                            %short total length,
                            %short identification,
                            %short fragment offset,   { includes flags }
                            %byte TTL,
                            %byte protocol,
                            %short checksum,
                            %integer source,
                            %integer destination,
                            %bytearray options(1 : 64)) %c
                       %or %shortarray x(1 : 42))

%recordformat TCP header fm(%short source, destination,
                            %integer seq,
                            %integer ack,
                            %byte data offset,
                            %byte flags,
                            %short window,
                            %short checksum,
                            %short urgent)

%constinteger FIN bit = 2_000001
%constinteger SYN bit = 2_000010
%constinteger RST bit = 2_000100
%constinteger PSH bit = 2_001000
%constinteger ACK bit = 2_010000
%constinteger URG bit = 2_100000

%recordformat UDP header fm(%short source,
                            %short destination,
                            %short length,
                            %short checksum)

!Lance receive test
%begin
%option "-nons-low"
%include "inc:util.imp"
%include "ether:ethutil.inc-list"

@16_106c %integer ipl3 vector
%integer oldvector
%integer pr=0,pt=0
%Record(ipheaderfm)%name iphead
%record(tcp header fm)%name tcp head
%record(udp header fm)%name udp head

%conststring(17)our dte = "12-34-56-78-9A-BC"
%conststring(17)vax dte = "AA-00-03-01-0C-D7"
%bytearray dte(1:6)
%bytearray vdte(1:6)
%Bytearray knowndtes (1:known,1:6)

%record(ibf)ib
%record(drf)%name rring,tring

@16_fe0000 %half lance address register, lance data register

%routine wcsr(%half r,v)
  lance address register = r
  lance data register = v
%end

%integerfn rcsr(%half r)
  lance address register = r
  %result = lance data register
%end

%predicate samedte(%bytename a,b)
%integer i
  %for i = 1,1,6 %cycle
    %falseunless a=b
    a == a[1]; b == b[1]
  %repeat
  %true
%end

%string(17)%fn identifydte (%bytename a)
   %Integer i
   %for i=1,1,known %Cycle
      %if samedte(knowndtes(i,1),a) %start
         %result = texthosts(i)
      %Finish
   %Repeat
   %Result = getdte(a)
%End

%routine interpret iso packet(%bytename b)
  %routine interpret transport header(%bytename b)
  %bytename c
  %integer i
  %switch s(0:15)
    %routine half
      phex1(b); b == b[1]
    %end
    %routine one
      phex2(b); b == b[1]
    %end
    %routine two
      one; one
    %end
    %routine param
    %integer n
      %if b=16_c1 %then printstring(" From ") -
%else %if b=16_c2 %then printstring(" To ") -
%else %if b=16_c3 %then printstring(" Check ") -
%else %if b=16_c4 %then printstring(" Version ") -
%else %if b=16_c5 %then printstring(" Security ") -
%else %if b=16_c6 %then printstring(" Options ") -
%else %if b=16_c7 %then printstring(" Altclass ") -
%else %if b=16_85 %then printstring(" AckTime ") -
%else %if b=16_89 %then printstring(" Thruput ") -
%else %if b=16_86 %then printstring(" Errate ") -
%else %if b=16_87 %then printstring(" Prio ") -
%else %if b=16_88 %then printstring(" Delay ") -
%else %if b=16_8b %then printstring(" Reass ") -
%else %if b=16_e0 %then printstring(" ExtraInfo ") -
%else %if b=16_8a %then printstring(" SubSeq ") -
%else %if b=16_8b %then printstring(" FloCo ") -
%else printstring(" Param"); phex2(b); space
      b == b[1]
      n = b; b == b[1]
      one %and n = n-1 %while n>0
    %end
    c == b; space; one; printsymbol(':')
    space %and one %for i = 1,1,c
    b == c[1]; c == c[c+1]
    newline; ->s(b>>4)
s(0):s(3):s(9):s(10): printstring("Not available"); ->rest
s(*): printstring("Not defined"); ->rest
s(14): printstring("CR Cdt="); half; space; two; space; two
       printstring(" cl="); phex1(b>>4)
       printstring(" opt="); half
end:   param %while addr(b)<addr(c); %return
s(13): printstring("CC Cdt="); half; space; two; space; two
       printstring(" cl="); phex1(b>>4)
       printstring(" opt="); half
       ->end
s(8):  printstring("DR."); half; space; two
       printstring(" Reason="); one
       ->end
s(12): printstring("DR."); half; space; two; ->end
s(15): printstring("DT."); half; space; two
rest:  space %and one %while addr(b)<addr(c)
       %return
s(1):  printstring("ED."); half; space; two
       ->rest
s(6):  printstring("AK Cdt="); half; space; two
       ->rest
s(2):  printstring("EA."); half; space; two
       ->rest
s(5):  printstring("RJ Cdt="); half; space; two
       ->rest
s(7):  printstring("ER."); half; space; two
       printstring(" Cause="); one
       ->rest
  %end
  %if b&1=0 %start
    printstring("PF ") %if b[1]&1#0
    printstring("I "); phex2(b>>1); printsymbol('/'); phex2(b[1]>>1)
    b == b[2]
    interpret transport header(b[b+1])
  %elseif b=1
    printstring("PF ") %if b[1]&1#0; printstring("RR "); phex2(b[1]>>1)
  %elseif b=5
    printstring("PF ") %if b[1]&1#0; printstring("RNR "); phex2(b[1]>>1)
  %elseif b=9
    printstring("PF ") %if b[1]&1#0; printstring("REJ "); phex2(b[1]>>1)
  %else
    %if b&16#0 %start
      printstring("PF "); b = b&16_ef
    %finish
    %if b=3 %start
      printstring("UI")
      b == b[1]
      interpret transport header(b[b+1])
    %elseif b=16_af
      printstring("XID")
    %elseif b=16_ef
      printstring("TEST")
    %elseif b=16_6f
      printstring("SABME")
    %elseif b=16_43
      printstring("DISC")
    %elseif b=16_87
      printstring("FRMR")
    %elseif b=15
      printstring("DM")
    %elseif b=16_67
      printstring("SI0")
    %elseif b=16_e7
      printstring("SI1")
    %else
      printstring("Crap "); phex2(b)
    %finish
  %finish
  newline
%end

%integerfn swab(%integer x)
  *rol.w #8,d0
%end

%integerfn swap(%integer x)
  *swap d0
%end

%routine setup data structure
%integer i
%record(df)%name d
  ib = 0
  set dte(dte(1), our dte)
  %for i = 1,1,known %cycle
     set dte (knowndtes(i,1),dtehosts(i))
  %Repeat
  convert dte to halfwords(dte(1), ib_pa0)
  rring == new ring
  tring == new ring
  point(ib_highrad,ib_lowrad,rring)
  point(ib_hightad,ib_lowtad,tring)
  ib_rcount = 16_e0
  ib_tcount = 0
  %for i = 0,1,127 %cycle
    d == rring_desc(i)
    d = 0; d_minus = -900
    point(d_highad,d_lowad,new buffer)
    d_control = r own
  %repeat
  d == tring_desc(0)
  d = 0; d_minus = -20
  point(d_highad,d_lowad,new buffer)
%end

%routine setup device
%half l
%byte h
  point(h,l,ib)
  wcsr(0, c stop)
  wcsr(1,l)
  wcsr(2,h)
  wcsr(3, bswp)
  wcsr(0, c init ! c strt ! c inea)
%end

%ownhalf intcsr=0,idon=0,rint=0,tint=0

%routine intwait
!%cycle
  *move.w #16_2000,d0; *trap#0; *stop #16_2000; *mtsr #0
!  %exitif intcsr & c intr#0
!  intcsr = lance data register
!  idon = intcsr
!  rint = intcsr
!  tint = intcsr
!%repeatuntil intcsr & c intr # 0
%end

%routine scan rring
%ownintegerarray logged(0:3)=0(*)
%ownintegerarray lost(0:3)=0(*)
%owninteger lastin=-1
%integer seqno,nomsize,n=0,j
%record(df)%name d
%record(bf)%name b
%owninteger pos=0
  %predicate from vax
    %trueif same dte(vdte(1),b_sdte(1))
    %false
  %end
  %predicate to us
    %trueif same dte(dte(1),b_ddte(1))
    %false
  %end
  %routine pp(%integer a,b)
    b = b+a; b = 1 %if b=0
    a = 99 %and b = 100 %if a=b
    write((a*100)//b,2)
  %end
  %cycle
    d == rring_desc(pos)
    %if d_control & r own = 0 %start
      n = n+1
      b == buffer of(d)
      nomsize = b_decpty
      printstring (identifydte(b_ddte(1)));space
      printstring (identifydte(b_sdte(1)));space
      %if nomsize <= 1518 %start
         printstring("ISO "); phex4(nomsize); phex4(b_isolength); space
         interpret iso packet(b_data(1))
      %else %if nomsize = 16_0800
         iphead == record(addr(b_isolength))
         %if ip head_protocol = 1 %start
            printstring("ICMP/IP")
         %else %if ip head_protocol = 6
            printstring("TCP/IP ")
            tcp head == record(addr(ip head) + 4 * (ip head_IHL & 15))
            printstring("S=");  write(tcp head_source, 0)
            printstring(", D=");  write(tcp head_destination, 0)
      !      printstring(", S/A=");  phex(tcp head_seq)
      !      print symbol('/');  phex(tcp head_ack)
            printstring(", F=")
            print symbol('F') %if tcp head_flags & FIN bit # 0
            print symbol('S') %if tcp head_flags & SYN bit # 0
            print symbol('R') %if tcp head_flags & RST bit # 0
            print symbol('P') %if tcp head_flags & PSH bit # 0
            print symbol('A') %if tcp head_flags & ACK bit # 0
            print symbol('U') %if tcp head_flags & URG bit # 0
         %else %if ip head_protocol = 17
            printstring("UDP/IP ")
            udp head == record(addr(ip head) + 4 * (ip head_IHL & 15))
            printstring("S=");  write(udp head_source, 0)
            printstring(", D=");  write(udp head_destination, 0)
         %else
            printstring("???/IP type ");  write(ip head_protocol, 0)
         %finish
         sameline
      %Else
         Printstring ("Type=");phex4(b_decpty)
         sameline
      %Finish
      d_control=rown ; pos=(pos+1)&127
    %finishelseexit
  %repeat
%return
!  %returnif n=0
  printstring("Got")
  %for j = 0,1,3 %cycle
    space; phex4(logged(j))
  %repeat
! printstring(" lost")
! %for j = 0,1,3 %cycle
!   space; phex4(lost(j))
! %repeat
  pp(logged(j),lost(j)) %for j = 0,1,3
  pp(logged(0)+logged(1)+logged(2)+logged(3),
     lost(0)+lost(1)+lost(2)+lost(3))
  printsymbol(13)
  pr = pr+n
! %returnif n=128
! write(n,0); printstring(" received"); newline
%end

%owninteger lives=9

%onevent 0 %start
  lives = lives-1
  %if lives>=0 %start
    %if event_sub=2 %start
      printstring("Bus error at "); phex(event_extra); newline
    %elseunless event_sub=1
      printstring("Event 0 "); write(event_sub,1); newline
    %finish
    write(pr,0); write(pt,1); printstring(" R T"); newline
    phex4(intcsr); space; phex4(lance data register)
    printstring("Int Csr"); newline
    wcsr(0,c stop)
  %finish
  ipl3 vector = oldvector
  %stop
%finish

->begin

handler:
  *move.w d0,-(sp)
  *move.w lance data register, d0
  *move.w d0,intcsr
  *and.w #(cbabl!ccerr!cmiss!cmerr!crint!ctint!cidon!cinea),d0
  *move.w d0,lance data register
  *move.w (sp)+,d0
  *rte

begin:

  set terminalmode(nopage)
  printstring("Starting")
    oldvector = ipl3 vector
    ipl3 vector = addr(handler)
    setup data structure
    ib_mode = m prom ! m dtx
    setup device
    setdte(vdte(1),vaxdte)
  newline

  %cycle
    intwait
    %stop %if testsymbol>=0
    %if intcsr& c err # 0 %or intcsr&(c rxon ! c txon) # c rxon %start
      printstring("Int: "); phex4(intcsr); newline
    %finish
    %if idon & c idon # 0 %start
      idon = 0
      lance data register = (intcsr & c inea) ! c idon
    %finish
    %if rint & c rint # 0 %start
      rint = 0
      lance data register = (intcsr & c inea) ! c rint
    %finish
    scan rring
    %if tint & c tint # 0 %start
      tint = 0
      lance data register = (intcsr & c inea) ! c tint
      printstring("T INT ?"); newline
    %finish
  %repeat
  
%endofprogram
