%begin
%constinteger ihash=59
%ownintegerarray hilink(0: 58)= 0(59)
%ownintegerarray ilink(1:256)= 0(256)
%ownstring(5)%array instr(1:256)= ""(256)
%ownintegerarray icode(1:256)= 0(256)
%ownintegerarray itype(1:256)= 0(256)
%ownintegerarray icycles(1:256) = 0(256)
%routinespec read line
%routinespec get instr(%integername id)
%routinespec get const(%integername cval)
%string(4)%fnspec strhex(%integer n,d)
%byteintegerarray line(1:73)
%integer lp,iid,nnames,i,j
   %on %event 9 %start; -> print; %finish
   nnames=0
!-----------------------------------------------------------------------
  select input(1)
   %cycle
      read line
       lp = 1
       lp = lp+1 %while line(lp)=' '
       get instr(iid)
       lp = lp+1 %while line(lp)=' '
       get const(icode(iid))
       lp = lp+1 %while line(lp)=' '
       get const(itype(iid))
      lp = lp+1 %while line(lp)=' '
      get const(icycles(iid))
   %repeat
print:
   select output(1)
   print string("%constant %byte %integer %array hilink(0:58) = %c")
   new line
   print string("   ")
   j = 0
   %for i = 0, 1, 58 %cycle
      write(hilink(i), 3)
      print symbol(',') %unless i=58
      j = j+1
      newline %and print string("   ") %and j=0 %if j=12
   %repeat
   new line
   print string("%constant %byte %integer %array ilink(1:")
   write(nnames, 0)
   print string(") = %c")
   new line
   print string("   ")
   j = 0
   %for i = 1, 1, nnames %cycle
      write(ilink(i), 3)
      print symbol(',') %unless i=nnames
      j = j+1
      newline %and print string("   ") %and j = 0 %if j=12
   %repeat
   newline
   print string("%constant %string(5) %array instr(1:")
   write(nnames, 0)
   print string(") = %c")
   new line
   print string("   ")
   j = 0
   %for i= 1, 1, nnames %cycle
      print symbol('"')
      print string(instr(i))
      print symbol('"')
      print symbol(',') %unless i=nnames
      j = j+1
      newline %and print string("   ") %and j=0 %if j=9
   %repeat
   new line
   print string("%constant %integer %array icode(1:")
   write(nnames, 0)
   print string(") = %c")
   new line
   print string("   ")
   j = 0
   %for i = 1, 1, nnames %cycle
      print string("16_")
      %if 0<=icode(i)<=255 %start
         print string(strhex(icode(i), 2))
      %else
         print string(strhex(icode(i), 4))
      %finish
      print symbol(',') %unless i=nnames
      j = j+1
      new line %and print string("   ") %and j = 0 %if j=9
   %repeat
   new line
   print string("%constant %byte %integer %array itype(1:")
   write(nnames, 0)
   print string(") = %c")
   new line
   print string("   ")
   j = 0
   %for i = 1, 1, nnames %cycle
      write(itype(i), 2)
      print symbol(',') %unless i=nnames
      j = j+1
      new line %and print string("   ") %and j = 0 %if j=15
   %repeat
   new line
   print string("%constant %integer %array icycles(1:")
   write(nnames, 0)
   print string(") = %c")
   new line
   print string("   ")
   j = 0
   %for i = 1, 1, nnames %cycle
      write(icycles(i), 2)
      print symbol(',') %unless i=nnames
      j = j+1
      new line %and print string("   ") %and j = 0 %if j=15
   %repeat
   new line
   %stop
!-----------------------------------------------------------------------
%routine read line
%integer i
  %cycle i=1,1,73
rl: read symbol(line(i))
    %if line(i)=nl %then %start
      %if i=1 %then ->rl %else %return
    %finish
  %repeat
  read symbol(line(i)) %until line(i)=nl    ;! skip beyond 72
%end
!-----------------------------------------------------------------------
%routine get instr(%integername iid)
%string(5) i
%integer h,l,sym
  iid=0
  %while line(lp)=' ' %then lp=lp+1
  %return %unless 'A'<=line(lp)<='Z'
  h=line(lp)-'0'
  i=tostring(line(lp))
  %cycle l=2,1,5
    lp=lp+1
    sym=line(lp)
    %unless 'A'<=sym<='Z' %or '0'<=sym<='Z' %then ->goti
    h=h<<4+sym-'0'
    i=i.tostring(sym)
  %repeat
  lp=lp+1
  %return %if 'A'<=line(lp)<='Z'
goti: h=h&32767
   h=h-h//ihash*ihash
  l=hilink(h)
   %if l=0 %start
      nnames =nnames+1
      hilink(h) = nnames
   %else
      %cycle
         iid=l %and %return %if instr(l)=i
         %exit %if ilink(l)=0
         l=ilink(l)
      %repeat
      nnames = nnames+1
      ilink(l) = nnames
   %finish
   instr(nnames) = i
   iid = nnames
%end
!-----------------------------------------------------------------------
%routine get const(%integername cval)
%integer i, started
   started=1
  cval=0
  %if '0'<=line(lp)<='9' %then %start    ;! decimal
    %cycle
      cval=10*cval+line(lp)-'0'
      lp=lp+1
      %return %unless '0'<=line(lp)<='9'
    %repeat
  %finish
  %if line(lp)='$' %then %start    ;! hex
    %cycle
      lp=lp+1
      %if '0'<=line(lp)<='9' %then cval=cval<<4!(line(lp)-'0') %c
        %else %start
        %if 'A'<=line(lp)<='F' %then cval=cval<<4!(line(lp)-'A'+10) %c
          %else %return
      %finish
      started = 0
    %repeat
  %finish
  %if line(lp)='@' %then %start    ;! octal
    %cycle
      lp = lp+1
      %return %unless '0'<=line(lp)<='7'
      cval = (cval<<3)!(line(lp)-'0')
      started = 0
    %repeat
  %finish
   %if line(lp)='%' %start
      %cycle
         lp = lp+1
         %return %unless '0'<=line(lp)<='1'
         cval = (cval<<1)!(line(lp)-'0')
         started = 0
      %repeat
   %finish
  %if line(lp)='''' %then %start
    lp=lp+1
    %return %if lp=73
    cval=line(lp)
    lp=lp+1
   %return
  %finish
   %return
%end
!-----------------------------------------------------------------------
%string(4)%fn strhex(%integer n,d)
%conststring(1)%array h(0:15)="0","1","2","3","4","5","6","7","8","9",
  "A","B","C","D","E","F"
%integer i
%string(4) s
  s=""
  %cycle i=1,1,d
    s=h(n&15).s
    n=n>>4
  %repeat
   %result = s
%end
!-----------------------------------------------------------------------
%end %of %program
