%begin; ! Z80 assembler source profiler

%constinteger maxtag=511,maxcell=5000

%recordformat tf(%integer t1,t2,first)
%recordformat lf(%integer line,next)
%record(tf)%array tag(0:maxtag)
%record(lf)%array list(1:maxcell)
%integerarray sortp(0:maxtag)

%record(tf)%name t
%record(lf)%name l

%integer line=1
%integer free=1
%integer max=maxtag
%integer sym,t1,t2,i,p,pos,temp

%routine skipnumber
%integer max,num,base
   base=10; num=sym-'0'
   %cycle
      max=base-1+'0'; max=max+7 %if base>10
      %cycle
         sym=nextsymbol
         %exitif sym='_'
         %returnif sym<'0'
         sym=sym-32 %if 'a'<=sym<='z'
         %returnif sym>max
         sym=sym-'0'; sym=sym-7 %if sym>9
         num=num*base+sym
         readsymbol(sym)
      %repeat
      readsymbol(sym)
      base=num; num=0
   %repeat
%end

%integerfn gettag
%integer t,i
   t=0
   %for i=2,-1,0 %cycle
      %if '0'<=sym<='9' %start
         sym=sym-'0'+1
      %elseif 'A'<=sym<='Z' %start
         sym=sym-'A'+11
      %elsestart
         %result=t
      %finish
      t=38\\i*sym+t
      readsymbol(sym)
      sym=sym-32 %if 'a'<=sym<='z'
   %repeat
   %result=t
%end

%routine puttag(%integer t)
%ownintegerarray x(0:36)=' ','0','1','2','3','4','5','6','7','8','9',
'A','B','C','D','E','F','G','H','I','J','K','L','M',
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'
%integer a,b,c
   b=(t>>1)//19; c=t-b*38
   a=b//38; b=b-a*38
   printsymbol(x(a)); printsymbol(x(b)); printsymbol(x(c))
%end

%routine print
   %for i=0,1,max %cycle
      t==tag(sortp(i)); p=t_first
      %if p#0 %start
         pos=0
         %cycle
            l==list(p); temp=l_next; l_next=pos
            %exitif temp=0; l_next=pos; pos=p; p=temp
         %repeat
         puttag(t_t1); puttag(t_t2); space; pos=7
         %cycle
            line=l_line; p=l_next
            spaces(7) %and pos=7 %if pos=0
            write(line<<2>>2,4); pos=pos+6
            %if line<0 %start
               %if line<<1<0 %then printsymbol('#') %else printsymbol('*')
            %finish
            %if pos>=74 %start
               pos=0; newline
            %finish
            space %if line>=0 %and pos#0
            p=l_next; %exitif p=0
            l==list(p)
         %repeat
         newline %unless pos=0
      %finish
   %repeat
%end

%routine sort
   %integerfn dif(%integer i,j)
   %integer k
      k=(i>>1)-(j>>1); k=(i&1)-(j&1) %if k=0
      %result=k
   %end
   %integerfn compare(%integer i,j)
   %record(tf)%name ii,jj
      ii==tag(sortp(i)); jj==tag(sortp(j))
      i=dif(ii_t1,jj_t1); %result=i %unless i=0
      %result=dif(ii_t2,jj_t2)
   %end
   %routine swop(%integer i,j)
   %integer k
      k=sortp(i); sortp(i)=sortp(j); sortp(j)=k
   %end
%integer i,j
   max=-1
   %for i=0,1,maxtag %cycle
      %if tag(i)_first#0 %start
         max=max+1; sortp(max)=i
      %finish
   %repeat
   write(max+1,1)
   %for i=max,-1,1 %cycle
      %for j=1,1,i %cycle
         swop(j-1,j) %if compare(j-1,j)>0
      %repeat
      newline %if i&63=0; printsymbol('.')
   %repeat
   newline
%end

%onevent 9 %start
   selectoutput(2); sort
   selectoutput(1); print
   %stop
%finish

%for i=0,1,maxtag %cycle
   tag(i)_first=0
%repeat

selectoutput(0)
selectinput(1)
%cycle
   readsymbol(sym) %until sym#' '
   sym=sym-32 %if 'a'<=sym<='z'
   %if 'A'<=sym<='Z' %start
      t1=gettag; t2=gettag
      %unless t2=0 %start
         %cycle; %repeatuntil gettag=0
      %finish
      i=maxtag; p=(t1!!t2)&maxtag
      %cycle
         t==tag(p); p=(p+1)&maxtag
         %if t_first=0 %start
            t_t1=t1; t_t2=t2; t_first=free
            l==list(free); free=free+1
            l_next=0; l_line=line
            %exit
         %finish
         %if t_t1=t1 %and t_t2=t2 %start
            l==list(t_first)
            %exitif l_line<<1>>1=line
            l==list(free); free=free+1
            l_next=t_first; t_first=free-1
            l_line=line
            %exit
         %finish
         i=i-1
         %if i<0 %start
            printstring("Too many tags
");         %signal 9
         %finish
      %repeat
   %finish
   %if '0'<=sym<='9' %start
      skipnumber
   %elseif sym=',' %start
      l_line=l_line!16_8000
   %elseif sym=':' %or sym='=' %start
      l_line=l_line!16_c000
   %elseif sym=nl %start
      line=line+1
   %elseif sym='/' %start
      line=line+1
      readsymbol(sym) %until sym=nl
   %finish
%repeat

%endofprogram