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