! Program to discover people will a null password

%include "SYSTEM:CONFIG.INC"
%include "Inc:FS.IMP"

%ownbytearray buffer(0 : 511)
%ownbytename next
%ownbytename last

%routine do(%integer what, %string(31) param)
   %integer i
      i = fcommr(what << 8, param, buffer(0), 512)
      next == buffer(0)
      last == next[i]
%end

%integerfn next sym
   %integer ch
      %result = -1 %if next == last
      ch = next
      next == next[1]
      %result = ch
%end

%routine skip to(%integer what)
   %integer ch
      ch = next sym %until ch = what
%end

%string(31)%fn next word
   %string(31) s
   %integer ch
      s = ""
      ch = next sym %until ch > ' '
      %cycle
         s = s . to string(ch)
         ch = next sym
      %repeat %until ch <= ' '
      %result = s
%end

%ownstring(7)%array users(1 : 128 * (last partition + 1)) = "***" (*)

%routine get users(%integer p)
   %integer i, a
      a = 128 * p
      do('\', to string('0' + (p << 1)))
      users(i) = next word %for i = a + 1, 1, a + 64
      do('\', to string('0' + (p << 1) + 1))
      users(i) = next word %for i = a + 65, 1, a + 128
%end

%routine sort users(%integer from, to)
   %string(7) d
   %integer l, u
   %label up, fi, fo, do
      %return %if from >= to
      l = from;  u = to
      d = users(u)
      -> fi
up:   l = l + 1;  -> fo %if l = u
fi:   -> up %unless users(l) >= d
      users(u) = users(l)
do:   u = u - 1;  -> fo %if l = u
      -> do %unless users(u) <= d
      users(l) = users(u)
      -> up
fo:   users(u) = d
      sort users(from, l - 1)
      sort users(u + 1, to)
%end

%predicate nullp(%string(7) who)
   %integer u
      %on 9 %start
         %false
      %finish
      u = fcomm('L0', who)
      u = fcomm('M0' + u, "")
      %true
%end

%begin
   %integer p, u
      get users(p) %for p = 0, 1, last partition
      sort users(1, 128 * (last partition + 1))
      select output(1)
      %for u = 1, 1, 128 * (last partition + 1) %cycle
         %if users(u) # "---" %start
            %if nullp(users(u)) %start
               printstring(users(u))
               newline
            %finish
         %finish
      %repeat
%end

             
%end %of %program