%begin

%constinteger R0=0,   R1=1,   R2=2,   R3=3,   R4=4,   R5=5,   R6=6,   R7=7,
              R8=8,   R9=9,  R10=10, R11=11, R12=12, R13=13, R14=14, R15=15

%constinteger Sb=R9,   Fp=R10,  Sp=R12,  Link=R14,  Pc=R15

%constinteger F0=16+0, F1=16+1, F2=16+2, F3=16+3,
              F4=16+4, F5=16+5, F6=16+6, F7=16+7

%constinteger CR=13

%const %string(255) Ident = "ARMSpell V0.4.2 (c) Graham Toal 1986"
%const %string(255) Dictcopyright = "DictUtils V1.0 (c) Graham Toal 1986"

%constant %integer  true = 0, false = 1
%integer corrections wanted=false
%integer verbosity=4

%string(255)%fn cliparam
%integer strad,i
%string(255) s,arg0
  *STMFD_12!,<0,1,2,3>
  *SWI_16
  *STR_R0,Strad
  *LDMFD_12!,<0,1,2,3>
  s = ""
  %cycle
    i = byteinteger(STRAD)
    %if i <= 13 %start
      %if s -> arg0.(" ").s %start;%finish
      %if s -> s.(" -corr") %then corrections wanted=true
      %IF S -> S.(" -CORR") %THEN CORRECTIONS WANTED=TRUE
      %If S -> S.(" -Corr") %Then Corrections Wanted=True
      %result=s
    %finish
    s <- s.tostring(i)
    strad=strad+1
  %repeat
%end

%integer file end,file beg,get ptr,ft,fl

%routine deallocate(%integer ad)
!  *MOV_0,#7
!  *LDR_2,ad
!  *SWI_30
%end

%routine info(%string(255) file, %integername ftype, dict length)
%integer faddr, dict length copy, ftype copy
  file <- file.tostring(13)
  faddr = ADDR(file)+1
  *MOV_0,#5
  *LDR_1,faddr
  *SWI_8
  *STR_4,dict length copy
  *STR_0,ftype copy
  ftype=ftype copy
  dict length=dict length copy
%end

%byte %array data block(0:480*1024)
%integer next free addr=ADDR(data block(0))

%integerfn allocate(%integer dict length)
%integer dict address
!  *LDR_3,dict length
!  *MOV_0,#6
!  *SWI_30
!  *STR_2, dict address
dict address = next free addr
next free addr = next free addr+dict length
%result=dict address
%end

%routine osfile load(%string(255) file, %integer dict address)
%integer faddr
  file <- file.tostring(13)
  faddr = ADDR(file)+1
  *MOV_0,#16_ff
  *LDR_1,faddr
  *LDR_2,dict address
  *MOV_3,#0
  *SWI_8
%end

info(cliparam,ft,fl)
%if ft#1 %then printstring("Speller: file ".cliparam." not loadable".nl)
file beg=allocate(fl)
file end=file beg+fl
get ptr=file beg
osfile load(cliparam,file beg)

%predicate end of file
  %true %if get ptr>=file end
  %false
%end
%integerfn next byte
  %result = BYTEINTEGER(get ptr)
%end
%integerfn get byte
  %integer i=next byte
  %if get ptr < file end %then get ptr=get ptr+1
  %result = i
%end

%string (63) %fn str(%byte %array %name dict, %integer word length, idx)
%string(63) s
  s = ""
  s = s.dict(idx) %for idx = idx, 1, idx+word length-1
  %result = s
%end

%string (255) %fn  sub string (%string (255) s, %integer first, last)
   %integer i
   %string (255) sub
   %if last > LENGTH(s) %then %signal 15,first,last
   sub = ""
   %for i = first, 1, last %cycle
      sub = sub. char no (s, i)
   %repeat
   %result = sub
%end
! Dictionary loading/saving interface

%constant %integer  max word length = 32
%own %integer %array  dict start(1:max word length) = -1(max word length)
%own %integer %array  dict next free(1:max word length) = -1(max word length)
%own %integer %array  dict loaded(1:max word length) = false(max word length)

%routine Load dict(%string (255) dict dir prefix, %integer word length)
%integer dict length, dict address, i, ftype, SaveArea
%string(255) file, sav
%label not found
  SaveArea = ADDR(Sav)
  %if dict loaded(word length) = true %then %start
    %return
  %finish

  file <- dict dir prefix.".".itos(word length,0)

  info(file, ftype, dict length)
  %return %if ftype#1

  ! Claim space (+ a bit) off RMA for dict...
  dict address=allocate(dict length+2*(word length+1))

  ! Load file into RMA block
  osfile load(file, dict address+word length+1)

  dict start(word length)=dict address
  dict next free(word length)=dict address %c
                               + dict length + (word length+1)*2
  dict loaded(word length)=true

  %if verbosity > 4 %then %c
    printstring(itos(word length,0)."-letter words loaded".nl)

  %for i = dict address, 1, dict address+word length-1 %cycle
    BYTE(i) = ' '
  %repeat
  BYTE(i+1)=nl

  %for i = dict address + word length+1 + dict length, 1, %c
             dict address + word length+1 + dict length + word length-1 %cycle
    BYTE(i)='~'
  %repeat
  BYTE(i+1)=nl
%end

%routine  preload dicts(%string(255) dict dir prefix)
%integer word length
  %for word length=1,1,max word length %cycle
    load dict(dict dir prefix, word length)
  %repeat
%end

! ######################################################################
! Dictionary procedures

%constant %integer less = -1, equal = 0, greater = 1

%integerfn compare(%byte %array %name dict, %integer word length,
                   word 1 index, word 2 index)
%integer ix
%for ix = 0,1,word length-1 %cycle
  %if dict(word 1 index+ix) < dict(word 2 index+ix) %then %result=less
  %if dict(word 1 index+ix) > dict(word 2 index+ix) %then %result=greater
%repeat
%result=equal
%end

%routine Sort(%byte %array %name dict, %integer word length, a, b)
  %integer step factor=word length+1
%routine vsort(%integer l,r)
%byte %array v(0:max word length),t(0:max word length)
%byte test
%integer i,ix,j
resort:
%if l>=r %then %return
%for ix=0,1,word length %cycle
  v(ix)=dict(r+ix)
%repeat
i = l-step factor
j = r
%cycle
  %cycle
    i=i+step factor
    ! test = dict(i+ix)>=v
    test=true
    %for ix=0,1,word length %cycle
      %if dict(i+ix)<v(ix) %then test=false %and %exit
      %if dict(i+ix)>v(ix) %then test=true %and %exit
    %repeat
  %repeat %until test=true
  %cycle
    j=j-step factor
    ! test = dict(j+ix)<=v
    test=true
    %for ix=0,1,word length %cycle
      %if dict(j+ix)>v(ix) %then test=false %and %exit
      %if dict(j+ix)<v(ix) %then test=true %and %exit
    %repeat
  %repeat %until test=true
  ! t = dict(i)
  t(ix)=dict(i+ix) %for ix=0,1,word length
  ! dict(i) = dict(j)
  dict(i+ix)=dict(j+ix) %for ix=0,1,word length
  ! dict(j) = t
  dict(j+ix)=t(ix) %for ix=0,1,word length
%repeat %until j<=i
! dict(j)=dict(i)
dict(j+ix)=dict(i+ix) %for ix=0,1,word length
! dict(i)=dict(r)
dict(i+ix)=dict(r+ix) %for ix=0,1,word length
! dict(r)=t
dict(r+ix)=t(ix) %for ix=0,1,word length
%if i-step factor - l > r - i+step factor %start
  vsort(i+step factor,r)
  r = i-step factor; -> resort
%else
  vsort(l,i-step factor)
  l = i+step factor; -> resort
%finish
%end
  vsort(a,b)
%end

%predicate spell check(%byte %array %name target, %integer word length,
                       %byte %array %name dict, %integer next free)
  %integer i, splitp, step factor=word length+1
  %integer subdict beg=step factor, subdict end=next free-step factor
    %cycle
      %if subdict beg > subdict end %then %false
      splitp=(((subdict end-subdict beg)//step factor)//2)*step factor %c
             +subdict beg
      splitp=splitp-REM(splitp-subdict beg,step factor)
      %if verbosity>5 %start
        printstring("beg = ".itos(subdict beg,0).nl)
        printstring("splitp = ".itos(splitp,0).nl)
        printstring("end = ".itos(subdict end,0).nl)
      %finish
      %if splitp>subdict end %or splitp<subdict beg %then %false
      %if verbosity > 5 %start
        printstring("checking against ")
        %for i = 0,1,step factor-1 %cycle
          printsymbol(dict(splitp+i))
        %repeat
        newline
      %finish
      %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

%integerfn Byte Compare(%integer word length, word 1 index, word 2 index)
%integer ix
%for ix = 0,1,word length %cycle
  %if BYTE(word 1 index+ix) < BYTE(word 2 index+ix) %then %result=less
  %if BYTE(word 1 index+ix) > BYTE(word 2 index+ix) %then %result=greater
%repeat
%result=equal
%end

%routine Common(%integer word length,
                        ad1, ad2, commonad,
                        len1, len2,
               %integername result len)
%routine Step(%integername i, count)
  i = i + (word length+1); count = count + (word length+1)
%end
%routine Transfer(%integer srce,dest)
%integer i
  %for i = 0,1,word length %cycle
    BYTE(dest+i)=BYTE(srce+i)
  %repeat
  result len=result len+(word length+1)
  commonad=commonad+(word length+1)
%end
%integer cc,count1=0,count2=0,i
  result len=0
  %cycle
    %if count1=len1 %or count2=len2 %then %return
    cc = Byte Compare(word length, ad1, ad2)
    %if verbosity > 5 %start
      printsymbol(BYTE(i)) %for i = ad1,1,ad1+word length-1
    %finish
    %if cc=equal %then %start
      %if verbosity>5 %start
        printstring(" = ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      Transfer(ad1,commonad); Step(ad1,count1); Step(ad2,count2)
    %else %if cc = less
      %if verbosity>5 %start
        printstring(" < ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      Step(ad1,count1)
    %else ;! Greater
      %if verbosity>5 %start
        printstring(" > ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      Step(ad2,count2)
    %finish
  %repeat
%end

%routine Exclude(%integer word length,
                        ad1, ad2, commonad,
                        len1, len2,
               %integername result len)
%routine Step(%integername i, count)
  i = i + (word length+1); count = count + (word length+1)
%end
%routine Transfer(%integer srce,dest)
%integer i
  %for i = 0,1,word length %cycle
    BYTE(dest+i)=BYTE(srce+i)
  %repeat
  result len=result len+(word length+1)
  commonad=commonad+(word length+1)
%end
%integer cc,count1=0,count2=0,i
  result len=0
  %cycle
    %if count2=len2 %then %return
    %if count1=len1 %start
      %cycle
        %if count2=len2 %then %return
        Transfer(ad2,commonad)
        Step(ad2,count2)
      %repeat
    %finish
    cc = Byte Compare(word length, ad1, ad2)
    %if verbosity > 5 %start
      printsymbol(BYTE(i)) %for i = ad1,1,ad1+word length-1
    %finish
    %if cc=equal %then %start
      %if verbosity>5 %start
        printstring(" = ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      ! f1 = f2
      Step(ad1,count1)
      Step(ad2,count2)
    %else %if cc = less
      %if verbosity>5 %start
        printstring(" < ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      ! f1 < f2
      Step(ad1,count1)
    %else ;! Greater
      %if verbosity>5 %start
        printstring(" > ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      ! f1 > f2
      Transfer(ad2,commonad)
      Step(ad2,count2)
    %finish
  %repeat
%end

%routine Merge(%integer word length,
                        ad1, ad2, commonad,
                        len1, len2,
               %integername result len)
%routine Step(%integername i, count)
  i = i + (word length+1); count = count + (word length+1)
%end
%routine Transfer(%integer srce,dest)
%integer i
  %for i = 0,1,word length %cycle
    BYTE(dest+i)=BYTE(srce+i)
  %repeat
  result len=result len+(word length+1)
  commonad=commonad+(word length+1)
%end
%integer cc,count1=0,count2=0,i
  result len=0
  %cycle
    %if count2=len2 %start
      %cycle
        %if count1=len1 %then %return
        Transfer(ad1,commonad)
        Step(ad1,count1)
      %repeat
    %finish

    %if count1=len1 %start
      %cycle
        %if count2=len2 %then %return
        Transfer(ad2,commonad)
        Step(ad2,count2)
      %repeat
    %finish
    cc = Byte Compare(word length, ad1, ad2)
    %if verbosity > 5 %start
      printsymbol(BYTE(i)) %for i = ad1,1,ad1+word length-1
    %finish
    %if cc=equal %then %start
      %if verbosity>5 %start
        printstring(" = ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      ! f1 = f2
      Transfer(ad2,commonad)
      Step(ad1,count1)
      Step(ad2,count2)
    %else %if cc = less
      %if verbosity>5 %start
        printstring(" < ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      ! f1 < f2
      Transfer(ad1,commonad)
      Step(ad1,count1)
    %else ;! Greater
      %if verbosity>5 %start
        printstring(" > ")
        printsymbol(BYTE(i)) %for i = ad2,1,ad2+word length
      %finish
      ! f1 > f2
      Transfer(ad2,commonad)
      Step(ad2,count2)
    %finish
  %repeat
%end


! ######################################################################
! Console IO

%routine Readalpha(%string(255) prompt, 
                  %byte %array %name c, %integername len)
%byte ch
len = 0
printstring(prompt)
%cycle
  readsymbol(ch) %until 'A'<=ch<='Z' %or 'a'<=ch<='z' %or ch=NL
  ch=ch!32 %if 'A'<=ch<='Z'
  c(len)=ch
  %exit %if ch=NL
  len=len+1
%repeat
%end


%routine Put byte(%integer ch)
  *SWI_0
%end

%routine Put inv byte(%integer ch)
 %integer i
  put byte(32);put byte(8)
  put byte(23)
  put byte(17)
  put byte(5)
  put byte(0) %for i=0,1,6
  put byte(ch)
  put byte(23)
  put byte(17)
  put byte(5)
  put byte(0) %for i=0,1,6
%end
!
! END OF DictUtils
!

%record %format dict fm(%byte %array ch(0:2000000))
%record (dict fm) %name %array dict(1:max word length)
%integer %array next free(1:max word length)
%integer word length, text length, ch

  Preload dicts("<spell$dict>")
  %for word length = 1,1,max word length %cycle
    %if dict loaded(word length)=true %start
      dict(word length) == RECORD(dict start(word length))
      next free(word length) = dict next free(word length)-dict start(word length)
    %else
      dict(word length) == RECORD(0)
      next free(word length) = 0
    %finish
  %repeat

  ! Dict_ch(0:next free-1) contains the word list.

! #$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$#

%byte %array target(0:max word length),
             literal(0:max word length)

%routine transfer garbage
%integer sym
  %cycle
    %exit %if end of file
    sym = next byte
    %if 'a'<=sym<='z' %or 'A'<=sym<='Z' %then %exit
    %if 32<=sym<=126 %then put byte(sym) %else put byte(32)
    sym = get byte
    %if sym=NL %or sym=CR %then put byte(10) %and put byte(13)
  %repeat
%end

%routine Read Word ;! Assert - next char IS a letter
%integer sym, i = 0
  %cycle
    %exit %if end of file
    sym = next byte
    %unless 'a'<=sym<='z' %or 'A'<=sym<='Z' %then %exit
    sym = get byte
    literal(i) = sym
    target(i) = sym!32
    i=i+1
  %repeat %until i=max word length
  word length = i
  target(i)=NL; literal(i)=NL
%end

%routine print inv word(%byte %array %name t)
%integer i = 0
  %cycle
    %if t(i)=NL %then %exit
    put inv byte(t(i))
    i=i+1
  %repeat
%end


%routine print word(%byte %array %name t)
%integer i = 0
  %cycle
    %if t(i)=NL %then %exit
    put byte(t(i))
    i=i+1
  %repeat
%end
%constant %integer on = 1, off = 0


%routine Correct(%byte %array %name ch, %integer word length)
%integer max errs=5, delta,sign
%integer pos,original,alternative,i,wrong words=0
%byte %array ch2,ch3(0:max word length)
  %return %if word length <= 3
  ! Single char typos
  %if 0 <= word length <= 4 %then max errs = 1
  %if 5 <= word length <= 6 %then max errs = 2
  %if 7 <= word length <= 9 %then max errs = 3
  %if word length > 9 %then max errs = 1
  %for pos = 1, 1, word length-2 %cycle
    original = ch(pos)
    %for alternative = 'a',1,'z' %cycle
      ch(pos)=alternative
      %if spell check(ch, word length,
                      dict(word length)_ch, next free(word length)) %start
        put inv byte('=');print inv word(ch)
        wrong words=wrong words+1;%return %if wrong words>max errs
      %finish
    %repeat
    ch(pos) = original
  %repeat
  ! transposition errors
  %for pos = 1, 1, word length-2 %cycle
    ! Swap(pos,pos+1)
    alternative = ch(pos)
    ch(pos) = ch(pos+1)
    ch(pos+1) = alternative
    %if spell check(ch, word length,
                    dict(word length)_ch, next free(word length)) %start
      put inv byte('=');print inv word(ch)
      wrong words=wrong words+1;%return %if wrong words>max errs
    %finish
    ! Swap(pos,pos+1)
    alternative = ch(pos)
    ch(pos) = ch(pos+1)
    ch(pos+1) = alternative
  %repeat
  ! Letter missing {assumed not first or last letter}
  %for pos=0,1,word length-2 %cycle
    ! insert char between pos and pos+1
    %for i = 0,1,pos %cycle
      ch2(i)=ch(i)
    %repeat
    %for i = pos+1,1,word length %cycle
      ch2(i+1)=ch(i)
    %repeat
    %for alternative = 'a',1,'z' %cycle
      ch2(pos+1)=alternative
      %if spell check(ch2, word length+1,
                      dict(word length+1)_ch, next free(word length+1)) %start
        put inv byte('=');print inv word(ch2)
        wrong words=wrong words+1;%return %if wrong words>max errs
      %finish
    %repeat
  %repeat
  ! Letter inserted
  %for pos = 1,1,word length-2 %cycle
    ! remove char at pos
    %for i = 0,1,pos-1 %cycle
      ch2(i)=ch(i)
    %repeat
    %for i = pos+1,1,word length %cycle
      ch2(i-1)=ch(i)
    %repeat
    %if spell check(ch2, word length-1,
                    dict(word length-1)_ch, next free(word length-1)) %start
      put inv byte('=');print inv word(ch2)
      wrong words=wrong words+1;%return %if wrong words>max errs
    %finish
  %repeat
  ! fist/last letter missing
    ! First...
    %for i = 0,1,word length %cycle
      ch2(i+1)=ch(i)
    %repeat
    %for alternative = 'a',1,'z' %cycle
      ch2(0)=alternative
      %if spell check(ch2, word length+1,
                      dict(word length+1)_ch, next free(word length+1)) %start
        put inv byte('=');print inv word(ch2)
        wrong words=wrong words+1;%return %if wrong words>max errs
      %finish
    %repeat
    ! Last...
    %for i = 0,1,word length %cycle
      ch2(i)=ch(i)
    %repeat
    ch2(word length+1)=NL
    %for alternative = 'a',1,'z' %cycle
      ch2(word length)=alternative
      %if spell check(ch2, word length+1,
                      dict(word length+1)_ch, next free(word length+1)) %start
        put inv byte('=');print inv word(ch2)
        wrong words=wrong words+1;%return %if wrong words>max errs
      %finish
    %repeat
  ! first/last letter inserted
    ! spurious last letter
    %for i = 0,1,word length-1 %cycle
      ch2(i)=ch(i)
    %repeat
    ch2(word length-1)=NL
    %if spell check(ch2, word length-1,
                    dict(word length-1)_ch, next free(word length-1)) %start
      put inv byte('=');print inv word(ch2)
      wrong words=wrong words+1;%return %if wrong words>max errs
    %finish
    ! spurious first letter
    %for i = 0,1,word length-1 %cycle
      ch2(i)=ch(i+1)
    %repeat
    %if spell check(ch2, word length-1,
                    dict(word length-1)_ch, next free(word length-1)) %start
      put inv byte('=');print inv word(ch2)
      wrong words=wrong words+1;%return %if wrong words>max errs
    %finish
  ! hyphen missing
  %for delta = 0,1,wordlength %cycle
  %for sign = -1,2,1 %cycle
    pos = (word length//2) + (delta*sign)
    %if pos <= 2 %or word length-pos <= 2 %then -> next test
    ! get left-hand half
    %for i = 0, 1, pos %cycle
      ch2(i) = ch(i)
    %repeat
    ch2(pos)=nl
    ! get right-hand half
    %for i = pos,1,word length %cycle
      ch3(i-pos) = ch(i)
    %repeat
    %if (pos > 2 %and word length-pos > 2) %and spell check(ch2, pos,
                    dict(pos)_ch, next free(pos)) %c
    %and spell check(ch3, word length-pos,
                    dict(word length-pos)_ch,
                    next free(word length-pos)) %start
      put inv byte('=');print inv word(ch2);put inv byte('-')
      print inv word(ch3)
      wrong words=wrong words+1
      -> next test {only one hyphenation to be suggested}
    %finish
  %repeat {sign}
  %repeat {delta}
next test:
  ! Complex transposition (anagram) ?????
%end


%routine Check
  %cycle
    Transfer Garbage
    %exit %if end of file
    Read Word
    %if word length>1 %and (%not spell check(target, word length,
                         dict(word length)_ch, next free(word length))) %start
      Print inv word(literal)
      Correct(target, word length) %if corrections wanted=true
    %else
      Print word(literal)
    %finish
    %exit %if end of file
  %repeat
%end

Check
%begin
  %integer i
  %for i = 1, 1, max word length %cycle
    %if dict loaded(i)=true %start
      deallocate(dict start(i))
    %finish
  %repeat
%end
deallocate(file beg)
%endofprogram