! anaguniv V0.0
! Sort letters within a word
!
%external %predicate Exists(%string (255) File, %integer %name len)
  %constant %integer os length index = 2
  %record %format osfile array fm (%integer %array element (0:3))
  %record (osfile array fm) osfile array
  %record %format Time stamp fm (%integer low, high)
  %record (time stamp fm) time stamp
  %external %integer %fn %spec Get file information(%c
    %record (osfile array fm) %name osfile array, 
    %record (time stamp fm) %name time stamp,
    %string (255) file name)

  %integer success = Get file information(osfile array,
                                          time stamp,
                                          File)
  %false %if success # 1
  len = osfile array_element(os length index)
  %true
%end

%external %routine loadup(%string (255) file name,
                          %integer address, actual length, max length)
  %external %routine %spec  X Load File (%string (255) file name,
                                         %integer      buffer size,
                                         %integer      address)
  %if max length < actual length %then %start
    print string("File ".file name." of ".itos(actual length,0). %c
                 " bytes is too big for buffer of ". %c
                 itos(max length,0)." bytes".nl)
    %stop
  %finish
  X Load file(file name, max length, address)
%end

%external %routine writeout(%string (255) file name, %integer address, len)
%external %integer %fn %spec Save File (%integer straddr,strlen,
                                     %integer     buffer size,
                                                  address)
%integer cc
  cc = Save file(ADDR(file name)+1, LENGTH(file name), len, address)
  %if cc < 0 %then printstring ("Failed to write out file ".file name.nl) %c
    %and %stop
%end

%external %routine Readword(%byte %array %name c, %integername len)
%byte ch
len = 0
%cycle
  readsymbol(ch) %until 'A'<=ch<='Z' %or 'a'<=ch<='z' %or ch=NL
  c(len)=ch
  %exit %if ch=NL
  len=len+1
%repeat
%end
  

%constant %integer max dict = 216000
%externalbyte %array dict(0:max dict)


%external %routine Find anagrams(%byte %array %name target,
                                 %integer word length)
%const %string (*) anagram dict dir = "adfs::0.$.words.longanag."
%string (255) file name
%owninteger dict length
%integer step factor, word index, i

  %predicate Anagram Found(%c
   %integer subdict beg, subdict end, %integer %name splitp)
  %integer i, word ptr
    %cycle
      %if subdict beg > subdict end %then %false
      splitp=(((subdict end-subdict beg)//step factor)//2)*step factor %c
             +subdict beg
      splitp=splitp+(step factor-(REM(splitp-subdict beg,step factor))) %c
             -step factor

!printstring("beg = ".itos(subdict beg,0).nl)
!printstring("splitp = ".itos(splitp,0).nl)
!printstring("end = ".itos(subdict end,0).nl)

      %if splitp>subdict end %or splitp<subdict beg %then %false

!printstring("checking against ")
!%for i = 0,1,step factor-1 %cycle
!printsymbol(dict(splitp+i))
!%repeat
!newline

      %for i = 0,1,word length-1 %cycle
        %if dict(splitp+i)>target(i) %then %start
          subdict end = splitp-step factor; ->continue2
        %finish
        %if dict(splitp+i)<target(i) %then %start
          subdict beg = splitp+step factor; ->continue2
        %finish
      %repeat
      %true
continue2:
    %repeat
  %end

%routine hquicksort(%integer a, b)
%integer l,r
%byte dump
  %return %if a>=b
  l=a;r=b; dump=target(b)
  %while l<r %cycle
    %while l<r %cycle
      %if target(l)>dump %then target(r)=target(l) %and r=r-1 %and %exit
      l=l+1
    %repeat
    %while l<r %cycle
      %if target(r)<dump %then target(l)=target(r) %and l=l+1 %and %exit
      r=r-1
    %repeat
  %repeat
  target(l)=dump
  hquicksort(a,l-1)
  hquicksort(r+1,b)
%end

%const %integer true=0,false=1
%byteinteger match
%owninteger last word length = -1
{***}printstring("base=".itos(ADDR(dict(0)),0).nl)
  hquicksort(0,word length-1)
!printstring("canonical form is ")
!%for i=0,1,word length-1 %cycle
!printsymbol(target(i))
!%repeat
!newline
  step factor = (word length+1)*2 { 1 is for NL }
  file name = anagram dict dir.itos(word length,0)
  %if word length=last word length %or exists(file name, dict length) %start
printstring("Loading ".file name.nl) %and %c
    loadup(file name, ADDR(dict(0)), dict length, max dict) %c
      %if word length#last word length
    last word length = word length
    %if REM(dict length, step factor) # 0 %start
      Printstring("??? Summat up - dict length = ".itos(dict length,0).nl)
    %finish
    ! Find and print all anagrams
    %if Anagram found(step factor, dict length-step factor, word index) %start
printstring("=> ")
      %cycle
        match=true
        word index=word index-step factor
        ! Check at word index
        %for i=0,1,word length-1 %cycle
          %if dict(word index+i)#target(i) %then match=false
        %repeat
      %repeat %until match=false
      word index=word index+step factor
      %cycle
        %for i=word length+1,1,step factor-1 %cycle
          printsymbol(dict(word index+i))
        %repeat
        match=true
        word index=word index+step factor
        ! Check again
        %for i=0,1,word length-1 %cycle
          %if dict(word index+i)#target(i) %then match=false
        %repeat
      %repeat %until match=false
    %else
!      printstring("No words found".nl)
    %finish
  %finish %else %start
    printstring("No words at all of length ".itos(word length,0).nl)
  %finish
%end
%endoffile