!Graham Toal - last working version of SKIMPA 10/02/81  11.57

!!%external %string (127) %fn %spec cliparam
%external %integer %fn %spec outstream
%external %routine %spec resetinput
%external %routine %spec closeinput
%external %routine %spec closeoutput
%external %routine %spec openinput(%integer stream, %string (255) file)
%external %routine %spec openoutput(%integer stream, %string (255) file)
%const %string (1) snl = "
"

%external %integer %spec faults

%routine do(%string (127) text)
!?%EXTERNALROUTINESPEC M6809
  !! For invoking assembler after successful compilation...
  ! system(text)
  printstring(text); newline
%end

%external %integer %array a(1 : 500)

! initialisation for i/o routines
%external %byte %integer %array named(1 : 1024) = %c
  10, 'R', 'E', 'A', 'D', 'S', 'Y', 'M', 'B', 'O', 'L',
  10, 'N', 'E', 'X', 'T', 'S', 'Y', 'M', 'B', 'O', 'L',
  10, 'S', 'K', 'I', 'P', 'S', 'Y', 'M', 'B', 'O', 'L',
  11, 'P', 'R', 'I', 'N', 'T', 'S', 'Y', 'M', 'B', 'O', 'L',
   5, 'S', 'P', 'A', 'C', 'E',
   6, 'S', 'P', 'A', 'C', 'E', 'S',
   7, 'N', 'E', 'W', 'L', 'I', 'N', 'E',
   8, 'N', 'E', 'W', 'L', 'I', 'N', 'E', 'S',
   7, 'N', 'E', 'W', 'P', 'A', 'G', 'E',
   4, 'R', 'E', 'A', 'D',
   5, 'W', 'R', 'I', 'T', 'E',
   0(930)

%external %integer %array namedlink(0 : 255) = 0, 76, 0(12), 89, 0(54), 84,
 0(118), 52, 0(11), 1, 12, 23, 34, 0(4), 67, 0(23), 46, 0(5), 59, 0(17)

%external %integer %array taglink(0 : 255) = 0, 13, 0(12), 16, 0(54), 14,
 0(118), 8, 0(11), 1, 3, 4, 5, 0(4), 11, 0(23), 7, 0(5), 10, 0(17)

%external %integer %array tag(1 : 512) = 16_40100001, 16_11010002, 16_41000002,
 16_40000003, 16_40100004, 16_01010002, 16_40000005, 16_40100006, 16_01010002,
 16_40000007, 16_40100008, 16_01010002, 16_40000009, 16_4010000A, 16_11010002,
 16_4020000B, 16_01010002, 16_01010003, 0(494)

%external %integer %array link(1 : 512) = 2, 0, 0, 0, 6, 0, 0, 9, 0, 0, 12, 0,
 0, 15, 0, 17, 18, 0, 0(494)

%external %integer namedp = 95
%external %integer tagasl = 19
%external %integer expropt = 0
%external %integer condopt = 0
%external %integer tagsopt = 0
%external %integer traceopt = 0
%external %integer checkopt = 0
%external %integer infoopt = 0
!-----------------------------------------------------------------------
%external %routine %spec statement(%integer statementp)
%external %string (255) %fn %spec strint(%integer n, p)
%external %routine %spec fault(%string (63) mess)
%external %routine %spec dump(%string (7) opn, reg, base, %integer disp)
%external %string (255) %fn %spec name(%integer ident)
!-----------------------------------------------------------------------
%external %routine skimp(%string (255) cliparam)
   %string (63) s, param
   %routine %spec readps
   %routine %spec readstatement
   %routine %spec rpsym(%integer %name l)
   %integer %fn %spec findk(%string (*) %name k)
   %integer %fn %spec compare(%integer p)
   %record %format kdf(%byte %integer l, n, a, b)
   %record (kdf) %array kd(1 : 255)
   %string (15) %array pn(256 : 319)
   %integer %array pp(256 : 319)
   %integer %array ps(1 : 512)
   %integer %array t, tt(1 : 256)
   %integer tp, ap, ttp, i, j, psflag
   %string (63) file, options, option, as
   %own %integer lexopt = 0
   %own %integer analopt = 0
   %own %integer codeopt = 1
   %own %integer listopt = 1
   %own %integer assmopt = 0
   %own %integer shift = 32
   %own %string (63) assopt = ""
   s = cliparam
   %if s -> ("/") . options %then %start
      %unless options -> options . (" ") . file %then file = ""
      %cycle 
         %unless options -> option . ("/") . options %then %c
           option = options %and options = ""
         %if option -> ("NO") . option %then i = 0 %else i = 1
         %if option = "LEX" %then lexopt = i %and %continue %c
         %else %if option = "ANAL" %then analopt = i %and %continue %c
         %else %if option = "EXPR" %then expropt = i %and %continue %c
         %else %if option = "COND" %then condopt = i %and %continue %c
         %else %if option = "TAGS" %then tagsopt = i %and %continue %else %start
            %if option -> ("OPT=") . assopt %then assmopt = i %and %continue %c
            %else %if option = "TRACE" %then traceopt = i %and %continue %c
            %else %if option = "CHECK" %then checkopt = i %and %continue %c
            %else %if option = "LIST" %then listopt = i %and %continue %c
            %else %if option = "CODE" %then codeopt = i %and %continue %c
            %else %if option = "INFO" %then infoopt = i %and %continue
         %finish
         printstring(option . " OPTION ?
")
         %stop
      %repeat %until options = ""
   %finish %else file = s
   %begin
   %on %event 9, 13 %start
      closeinput
      closeoutput
      printstring("FILE NOT FOUND - OR SOME OTHER ERROR!" . snl) ;! %if event_event = 9
      %stop %if file = "" %or codeopt = listopt = 0 %or faults > 0
      param = ""
      %if codeopt = 0 %then param = param . "/NOOBJECT"
      %if listopt = 1 %then param = param . "/LIST"
      do("ass68 " . file . " " . param)
      %stop
   %finish
   readps
   %if file = "" %then openoutput(1, "/dev/stdout") %else openoutput(1, file . ".asm")
   selectoutput(1)
   printstring("          NAM " . file . snl) %if file # ""
   printstring("          OPT " . assopt . snl) %if assmopt = 1
   printstring("
*                File: " . file . "
*                Options: ")
   %if lexopt = 1 %then printstring("/LEX ")
   %if analopt = 1 %then printstring("/ANAL ")
   %if expropt = 1 %then printstring("/EXPR ")
   %if condopt = 1 %then printstring("/COND ")
   %if tagsopt = 1 %then printstring("/TAGS ")
   %if infoopt = 1 %then printstring("/INFO ")
   %if traceopt = 1 %then printstring("/TRACE ")
   %if checkopt = 1 %then printstring("/CHECK ")
   %if listopt = 0 %then printstring("/NOLIST ")
   %if codeopt = 0 %then printstring("/NOCODE ")
   %if assmopt = 1 %then printstring("/OPT=" . assopt)
   newline
   %if psflag # 0 %then fault("PHRASE STRUCTURE FAULTY") %and %stop
   %if file = "" %then openinput(1, "/dev/stdout") %else openinput(1, file . ".imp")
   selectinput(1)
   ! set up tags available space list
   %for i = tagasl, 1, 511 %cycle
      link(i) = i + 1
   %repeat
   !  PRINTSTRING("          NAM ".FILE.SNL) %IF FILE#""
   !  PRINTSTRING("          OPT ".ASSOPT.SNL) %IF ASSMOPT=1
   %cycle 
      ! for each statement
      readstatement
      ttp = tp - 1
      tp = 1
      ap = 1
      %if compare(259) = 0 %or tp # ttp %then fault("SYNTAX ?") %else %start
         !**FRIG** above for printtext...
         %if analopt = 1 %then %start
            newline
            j = 0
            %for i = 1, 1, ap - 1 %cycle
               ! print analysis record
               %if a(i) < 0 %then as = "  (" . strint(i, 1) . "/" . pn(a(i) << 1 >> 17) . ")" %c
                 %and printstring(as) %and j = j + length(as) %and a(i) = a(i) & 16_FFFF
               write(a(i), 4)
               j = j + 5
               %if j > 60 %then newline %and j = 0
            %repeat
            newlines(2)
         %finish %else %start
            %for i = 1, 1, ap - 1 %cycle
               ! remove phrase numbers
               %if a(i) < 0 %then a(i) = a(i) & 16_FFFF
            %repeat
         %finish
         statement(1)
         ! generate code for statement
      %finish
   %repeat
   %end
   !-----------------------------------------------------------------------
   %routine readps
      ! read phrase structure from file 'SKIMPPS' and reduce it
      %string (31) %array ka(1 : 128)
      %integer %array kna(1 : 128)
      %string (31) k
      %integer kap, kdasl, kn, i, l, psp, pnp, alt
      %integer %name np
      %routine %spec insert(%string (15) k)
      %routine %spec extract(%integer i, %string (15) k)
      %routine %spec assign(%integer i)
      %integer %fn %spec newkd
      %routine %spec returnkd(%integer i)
      %routine %spec returnlist(%integer i)
      %integer %fn %spec phrase
      %routine %spec literal
      %routine %spec keyword
      openinput(2, "skimpps.new")
      selectinput(2)
      %if infoopt = 1 %then openoutput(2, "skimpps.lis") %else openoutput(2, "/dev/null")
      selectoutput(2)
      printstring("

PHRASE STRUCTURE

")
      ! scan file to build keyword dictionary
      kap = 1
      %cycle 
         rpsym(l)
         %if l = '$' %then %exit
         %if l = '"' %then %start
            k = ""
            %cycle 
               rpsym(l)
               %if l = '"' %then %exit
               %if 'A' <= l <= 'Z' %then k = k . tostring(l)
            %repeat
            ka(kap) = k
            kap = kap + 1
         %finish
      %repeat
      %for i = 1, 1, 26 %cycle
         kd(i) = 0
      %repeat
      %for i = 27, 1, 254 %cycle
         kd(i)_b = i + 1
      %repeat
      kdasl = 27
      i = 1
      insert(ka(i)) %and i = i + 1 %until i = kap
      kn = 128
      %for i = 1, 1, 26 %cycle
         %if kd(i)_l # 0 %then assign(i)
      %repeat
      kap = 1
      %for i = 1, 1, 26 %cycle
         %if kd(i)_l # 0 %then extract(i, "")
      %repeat
      printstring("

KEYWORDS

")
      %for i = 1, 1, kap - 1 %cycle
         printstring(strint(kna(i), 3) . "  " . ka(i) . "
")
      %repeat
      ! reread file and reduce phrase structure
      resetinput
      pn(256) = "NAME"
      pp(256) = 0
      pn(257) = "CONST"
      pp(257) = 0
      pn(258) = "STRING"
      pp(258) = 0
      pnp = 259
      psp = 1
      %cycle 
         ! for each phrase definition
         readsymbol(l)
         %if l = '$' %then %exit
         %if l = '<' %then %start
            ! start of phrase definition
            pp(phrase) = psp
            %cycle 
               ! for each alternative
               alt = psp
               np == ps(psp + 1)
               np = 0
               ! number of phrases
               psp = psp + 2
               %cycle 
                  ! for each item
                  readsymbol(l)
                  %if l = '<' %then ps(psp) = phrase %and psp = psp + 1 %and np = np + 1
                  %if l = '''' %then literal
                  %if l = '"' %then keyword
                  %if l = ',' %or l = ';' %then %exit
               %repeat
               ps(alt) = psp
               %if l = ';' %then %exit
            %repeat
            ps(psp) = 0
            psp = psp + 1
         %finish
      %repeat
      psflag = 0
      %for i = 259, 1, pnp - 1 %cycle
         %if pp(i) = 0 %then fault("<" . pn(i) . "> NOT DEFINED") %and psflag = 1
      %repeat
      printstring("

PHRASES

")
      %for i = 256, 1, pnp - 1 %cycle
         printstring(strint(i, 3) . strint(pp(i), 6) . "   " . pn(i) . "
")
      %repeat
      printstring("

REDUCED PHRASE STRUCTURE

")
      %for i = 1, 1, psp - 1 %cycle
         %if (i - 1) & 15 = 0 %then printstring("
" . strint(i, 3) . "   ")
         write(ps(i), 3)
      %repeat
      newlines(2)
      %return
      !-----------------------------------------------------------------------
      %routine insert(%string (15) k)
         ! search for and insert keyword into dictionary
         %integer i, j, l
         l = charno(k, 1)
         k -> (tostring(l)) . k
         i = l - 'A' + 1
         %if kd(i)_l # 0 %then %start
search: 
            %if k = "" %then %start
               %if kd(i)_a # 0 %then extract(kd(i)_a, "") %c
               %and returnlist(kd(i)_a) %and kd(i)_a = 0
               %return
            %finish
            %if kd(i)_a = 0 %then insert(k) %and %return
            l = charno(k, 1)
            k -> (tostring(l)) . k
            i = kd(i)_a
            %cycle 
               %if kd(i)_l = l %then -> search
               %if kd(i)_b = 0 %then %exit
               i = kd(i)_b
            %repeat
            j = i
            i = newkd
            kd(j)_b = i
         %finish
         ! insert remainder of letters
         %cycle 
            kd(i)_l = l
            %if k = "" %then %return
            l = charno(k, 1)
            k -> (tostring(l)) . k
            j = i
            i = newkd
            kd(j)_a = i
         %repeat
      %end
      !-----------------------------------------------------------------------
      %routine extract(%integer i, %string (15) k)
         %string (15) kk
         %if i = 0 %then %return
         kk = k . tostring(kd(i)_l)
         %if kd(i)_a = 0 %then ka(kap) = kk %and kna(kap) = kd(i)_n %c
           %and kap = kap + 1 %else extract(kd(i)_a, kk)
         extract(kd(i)_b, k)
      %end
      !-----------------------------------------------------------------------
      %routine assign(%integer i)
         %if i = 0 %then %return
         %if kd(i)_a = 0 %then kd(i)_n = kn %and kn = kn + 1 %else assign(kd(i)_a)
         assign(kd(i)_b)
      %end
      !-----------------------------------------------------------------------
      %integer %fn newkd
         %integer i
         %if kdasl = 0 %then printstring("KD ASL EMPTY") %and %stop
         i = kdasl
         kdasl = kd(i)_b
         kd(i) = 0
         %result = i
      %end
      !-----------------------------------------------------------------------
      %routine returnkd(%integer i)
         kd(i)_b = kdasl
         kdasl = i
      %end
      !-----------------------------------------------------------------------
      %routine returnlist(%integer i)
         %if i = 0 %then %return
         returnlist(kd(i)_a)
         returnlist(kd(i)_b)
         returnkd(i)
      %end
      !-----------------------------------------------------------------------
      %integer %fn phrase
         %string (15) p
         %integer i, l
         p = ""
         %cycle 
            readsymbol(l)
            %if l = '>' %then %exit %else p = p . tostring(l)
         %repeat
         %for i = 256, 1, pnp - 1 %cycle
            %if pn(i) = p %then %result = i
         %repeat
         pn(pnp) = p
         pp(pnp) = 0
         pnp = pnp + 1
         %result = pnp - 1
      %end
      !-----------------------------------------------------------------------
      %routine literal
         %integer l
         %cycle 
            readsymbol(l)
            %if l = '''' %then %return %else ps(psp) = l %and psp = psp + 1
         %repeat
      %end
      !-----------------------------------------------------------------------
      %routine keyword
         %string (31) k
         %integer l
         k = ""
         %cycle 
            readsymbol(l)
            %if l = '"' %then %exit
            %if 'A' <= l <= 'Z' %then k = k . tostring(l)
         %repeat
         ps(psp) = findk(k) %and psp = psp + 1 %until k = ""
      %end
   %end
   !-----------------------------------------------------------------------
   %routine readstatement
      %routine %spec store(%integer l)
      %routine %spec keyword
      %routine %spec name
      %routine %spec const
      %routine %spec stringconst
      %integer i, l, ksh, ttp, ttpp
      ! line reconstruct phase
      newlines(2)
      ttp = 1
      ksh = 0
      %cycle 
         ! for each character
         rpsym(l)
         %if l = '%' %then ksh = 128 %else %start
            %unless 'A' <= l <= 'Z' %then ksh = 0
            %if l # ' ' %then %start
               ! discard spaces
               %if l = '!' %and ttp = 1 %then %start
                  rpsym(l) %until l = ';' %or l = nl
                  ! discard comments
               %finish %else %start
                  store(l)
                  %if l = '"' %then %start
                     shift = 0
                     rpsym(l) %and store(l) %until l = '"'
                     shift = 32
                  %finish %else %start
                     %if l = '''' %then %start
                        shift = 0
                        rpsym(l) %and store(l) %until l = ''''
                        shift = 32
                     %finish %else %start
                        %if l = ';' %or l = nl %then %start
                           %if ttp = 2 %then ttp = 1 %else %start
                              %if l = ';' %then newline %and %exit
                              %if tt(ttp - 2) = 'C' + 128 %then ttp = ttp - 2 %else %exit
                           %finish
                        %finish
                     %finish
                  %finish
               %finish
            %finish
         %finish
      %repeat
      ! lexical phase
      tp = 1
      ttpp = 1
      %cycle 
         ! for each lexical item
         i = tt(ttpp)
         %if i >= 128 %then keyword %else %start
            %if 'A' <= i <= 'Z' %then name %else %start
               %if i = '"' %then stringconst %else %start
                  %if '0' <= i <= '9' %or i = '''' %or i = '$' %then %c
                    const %else t(tp) = i %and tp = tp + 1 %and ttpp = ttpp + 1
               %finish
            %finish
         %finish
      %repeat %until ttpp = ttp
      %if lexopt = 1 %then %start
         newline
         %for ttpp = 1, 1, tp - 2 %cycle
            write(t(ttpp), 4)
            %if ttpp & 16_F = 0 %then newline
         %repeat
         newline
      %finish
      %return
      !-----------------------------------------------------------------------
      %routine store(%integer l)
         %if ttp > 256 %then fault("STATEMENT TOO LONG") %and %stop
         tt(ttp) = l + ksh
         ttp = ttp + 1
      %end
      !-----------------------------------------------------------------------
      %routine keyword
         %string (255) k
         %integer i
         k = ""
         k = k . tostring(tt(ttpp) - 128) %and ttpp = ttpp + 1 %while tt(ttpp) > 128
         i = findk(k) %and t(tp) = i %and tp = tp + 1 %until k = "" %or i = 0
      %end
      !-----------------------------------------------------------------------
      %routine name
         %string (*) %name sname
         %integer i, l, hash
         sname == string(addr(named(namedp)))
         hash = 0
         sname = ""
         l = tt(ttpp)
         %cycle 
            %if namedp + length(sname) >= 1022 %then fault("NAME DICTIONARY FULL") %and %stop
            %if length(sname) = 255 %then fault("NAME TOO LONG") %and %stop
            sname = sname . tostring(l)
            hash = hash << 8 ! l
            ttpp = ttpp + 1
            l = tt(ttpp)
         %repeat %until l < '0' %or '9' < l < 'A' %or l > 'Z'
         hash = hash - hash // 251 * 251
         i = hash
         %cycle 
            ! scan dictionary
            %if namedlink(i) = 0 %then namedlink(i) = namedp %c
              %and namedp = namedp + length(sname) + 1 %and %exit
            ! insert name
            %if sname = string(addr(named(namedlink(i)))) %then %exit
            i = (i + 1) & 255
            %if i = hash %then fault("NAME DICTIONARY FULL") %and %stop
         %repeat
         t(tp) = 256
         ! <name>
         t(tp + 1) = i
         ! ident
         tp = tp + 2
      %end
      !-----------------------------------------------------------------------
      %routine const
         %integer l, value, flag, count, maxby10, maxld
         value = 0
         flag = 0
         %if tt(ttpp) = '$' %then %start
            %cycle 
               ttpp = ttpp + 1
               %exit %unless '0' <= tt(ttpp) <= '9' %or 'A' <= tt(ttpp) <= 'F'
               %if tt(ttpp) < 'A' %then value = value << 4 ! (tt(ttpp) - '0') %c
               %else value = value << 4 ! (tt(ttpp) - 'A' + 10)
               flag = 1 %and %exit %if value > 16_FFFF
            %repeat
         %finish %else %start
            %if tt(ttpp) = '''' %then %start
               count = 0
               %cycle 
                  ttpp = ttpp + 1
                  %if tt(ttpp) = '''' %then %start
                     ttpp = ttpp + 1
                     %if tt(ttpp) # '''' %then %exit
                  %finish
                  value = value << 8 ! tt(ttpp)
                  count = count + 1
               %repeat
               %unless count <= 2 %then flag = 1
               ! Only one char per word on M6809
            %finish %else %start
               maxby10 = 16_7FFF // 10
               maxld = 16_7FFF - maxby10 * 10 + '0'
               ! Bug fixed.
               l = tt(ttpp)
               %cycle 
                  %if value > maxby10 %or (value = maxby10 %and l > maxld) %c
                  %then flag = 1 %else value = value * 10 + l - '0'
                  ttpp = ttpp + 1
                  l = tt(ttpp)
               %repeat %until l < '0' %or l > '9'
            %finish
         %finish
         t(tp) = 257
         ! <const>
         %if flag # 0 %then fault("CONSTANT INVALID") %and value = 0
         t(tp + 1) = value
         tp = tp + 2
      %end
      !-----------------------------------------------------------------------
      %routine stringconst
         t(tp) = 258
         ! <STRING>
         %if tt(ttpp) # '"' %then %start
            fault("INVALID STRING")
            t(tp + 1) = 16_80
            %return
         %finish
         %cycle 
            tp = tp + 1
            ! Skip the first quote
            ttpp = ttpp + 1
            %if tt(ttpp) = '"' %then %start
               %if tt(ttpp + 1) = '"' %then ttpp = ttpp + 1 %c
              %and t(tp) = '"' %and %continue
               t(tp) = 16_80
               tp = tp + 1
               ttpp = ttpp + 1
               %return
            %finish
            t(tp) = tt(ttpp)
         %repeat
      %end
   %end
   !-----------------------------------------------------------------------
   %routine rpsym(%integer %name l)
      %own %integer flag = 1
      readsymbol(l)
      %if flag = 1 %and outstream = 1 %then printstring("*     ") %and flag = 0
      printsymbol(l)
      %if outstream = 1 %and l = ';' %and shift # 0 %then newline
      %if outstream = 1 %and (l = nl %or (l = ';' %and shift # 0)) %then flag = 1
      %if 'a' <= l <= 'z' %then l = l !! shift
   %end
   !-----------------------------------------------------------------------
   %integer %fn findk(%string (*) %name k)
      ! look keyword up in dictionary
      %integer i, l
      l = charno(k, 1)
      k -> (tostring(l)) . k
      i = l - 'A' + 1
      %if kd(i)_l = 0 %then %result = 0
search: 
      %if k = "" %or kd(i)_a = 0 %then %result = kd(i)_n
      l = charno(k, 1)
      k -> (tostring(l)) . k
      i = kd(i)_a
      %cycle 
         %if kd(i)_l = l %then -> search
         %if kd(i)_b = 0 %then %result = 0
         i = kd(i)_b
      %repeat
   %end
   !-----------------------------------------------------------------------
   %integer %fn compare(%integer p)
      %integer app, tpp, alt, altend, psp, psi
      a(ap) = p << 16 ! 16_80000001
      ! phrase number & alternative 1
      %if p <= 257 %then %start
         ! <name> or <const>
         %if p = t(tp) %then %start
            ! success
            a(ap + 1) = t(tp + 1)
            ap = ap + 2
            tp = tp + 2
            %result = 1
         %finish %else %result = 0
      %finish
      %if p = 258 %then %start
         %if t(tp) # p %then %result = 0
         alt = 1
         a(ap + alt) = t(tp + alt) %and alt = alt + 1 %until t(tp + alt) = 16_80
         a(ap + alt) = 16_80
         ap = ap + alt + 1
         tp = tp + alt + 1
         %result = 1
      %finish
      tpp = tp
      ! preserve text pointer
      app = ap
      ! preserve analysis record pointer
      psp = pp(p)
      ! start of phrase definition
      %cycle 
         ! for each alternative
         alt = ap + 1
         altend = ps(psp)
         ap = alt + ps(psp + 1)
         ! leave gap for forward pointers
         %if ap > 255 %then fault("ANALYSIS RECORD TOO LONG") %and %stop
         psp = psp + 2
         %cycle 
            ! for each item
            %if psp = altend %then %result = 1
            ! success
            psi = ps(psp)
            %if psi >= 256 %then %start
               ! phrase
               a(alt) = ap
               ! forward pointer
               %if compare(psi) = 0 %then %exit
               alt = alt + 1
            %finish %else %start
               ! literal or keyword
               %if psi # t(tp) %then %exit
               tp = tp + 1
            %finish
            psp = psp + 1
         %repeat
         %if ps(altend) = 0 %then %result = 0
         ! failure
         psp = altend
         tp = tpp
         ! backtrack text pointer
         ap = app
         ! backtrack analysis record pointer
         a(ap) = a(ap) + 1
         ! next alternative number
      %repeat
   %end
%end
%end %of %file