! Misc Imp Library

%option "-low-nocheck-nodiag-noline"
%systemroutinespec phex(%Integer x)

%externalroutine newline
  printsymbol(nl)
%end

%systemroutine newlines(%integer n)
  %while n>0 %cycle
    n = n-1; printsymbol(nl)
  %repeat
%end

%systemroutine space
  printsymbol(' ')
%end

%systemroutine spaces(%integer n)
  %while n>0 %cycle
    n = n-1; printsymbol(' ')
  %repeat
%end

%systempredicate resolves(%string(*)%name var,match,fore,aft)
!!Resolve the string specified by VAR into FORE and AFT split by MATCH
!![FORE and/or AFT absent is conventionally represented by an address
!! of zero]
@0%string(*) null
%integer i
%option "-noline" {Required due to V2 compiler bug}
  %integerfn resol(%string(*)%name var,match)
  !Return index position of first occurrence of MATCH within VAR
  %label yes,no
    *clr.l d0
    *clr.w d1
    *move.b (a1)+,d1  {length(match)
    *beq yes          {match="" ->
    *clr.w d2
    *move.b (a0)+,d2  {length(var)
    *sub.b d1,d2
    *bcs no           {length(match)>length(var) ->  {*bug: was bmi
    *subq.w #1,d1
loop1:
    *lea 0(a0,d0),a2
    *move.l a1,a3
    *move d1,d3
loop2:
    *cmpm.b (a2)+,(a3)+
    *dbne d3,loop2 {*bug?was dbeq
    *beq yes
    *addq.w #1,d0
    *dbra d2,loop1
no: *moveq #-1,d0
yes:*addq.l #1,d0
  !** (to be) re-coded for efficiency **
!  %integer i=0,j,l
!    l = length(match)
!    %cycle
!      %result = 0 %if i > length(var)-l
!      i = i+1
!      j = 0
!      %cycle
!        %result = i %if j = l
!        j = j+1
!      %repeat %until charno(var,i+j-1) # charno(match,j)
!    %repeat
  %end

  %routine assign(%string(*)%name dest, %integer from,to)
  !! **NB use of TOSTRING is compiled in-line **
  !! **OK when DEST is also source **
    dest = ""
    %while from <= to %cycle
      dest = dest.tostring(charno(var,from));  from = from+1
    %repeat
  %end

  %routine do aft
    assign(aft,i+length(match),length(var)) %unless aft==null
  %end

  i = resol(var,match)
  %false %if i = 0
  %if fore ## null %start
    %if fore ## var %start
      assign(fore,1,i-1)
      do aft
    %finish %else %start
      do aft
      length(var) = i-1
    %finish
  %finish %else do aft
  %true
%end

%systemstring(255)%fn readstring
! a STRING is deemed a sequence of non-control characters,
! hence, as for numbers, leading control characters are skipped,
! and the terminating one is not.
%string(255)s
%integer k
  s = ""
  readsymbol(k) %until k>' '
  %cycle
    s = s.tostring(k)
    %exitif nextsymbol<=' '
    readsymbol(k)
  %repeat
  %result = s
%end

%systemroutine readline(%string(255)%name s)
! a LINE is a sequence of non-NL characters and may be empty,
! hence blank lines are not skipped, and leading and trailing
! spaces are significant.  The terminating NL is skipped, to
! make it "pipe-compatible" with printline.
%integer k
  s = ""
  %cycle
    readsymbol(k); %exitif k=nl
    s = s.tostring(k)
  %repeat
%end

%systemroutine printline(%string(255)s)
  printstring(s)
  printsymbol(nl)
%end

%systemstring(9)%fn itoh(%integer n)
%string(9)s=""
%integer i,k
  %for i = 28,-4,0 %cycle
    k = n>>i&15; k = k+7 %if k>9; s = s.tostring(k+'0')
  %repeat
  %result = s
%end

%systemintegerfn htoi(%string(255)s)
%integer n=0,p=0,k
  %cycle
    p = p+1
    %result = n %if p>length(s)
    k = charno(s,p); %continueif k<=' '
    k = k-'0'
    %if k>9 %start
      k = k-7 %if k-7>9
      k = k-32 %if k>15
    %finish
    %result = n %unless 0<=k<=15
    n = n<<4+k
  %repeat
%end

%systemintegerfn stoi(%string(255) S)
%integer i,k
%integer sign=0, val=0
  i = 0
  %while i < length(s) %cycle
    i = i+1;  k = charno(s,i)
    %continue %if k <= ' '
    %if k = '-' %start
      sign = 1
    %else %if '0' <= k <= '9'
      val = val<<3+val+val+k-'0'
    %elseunless k='+'
      %signal 4, 1, k, "Non-numeric character"
    %finish
  %repeat
  %result = val %if sign = 0
  %result = -val
%end

%systemstring(127)%fn itos(%integer v,p)
%string(127)store
%bytename l
  %routine printsymbol(%integer x)
    l = l+1; charno(store,l) = x
  %end
  %routine spaces(%integer x)
    x = x-1 %and printsymbol(' ') %while x>0
  %end
  %routine write(%integer n,p)
  %integer q,r
    %if p>0 %start
      p = \p; printsymbol(' ') %and p = p+1 %if n>=0
    %finish
    p = -120 %if p<-120
    q = n//10; *move.l d1,r
    %if q=0 %start
      p = p+1 %if n<0; spaces(-1-p); printsymbol('-') %if n<0
    %else
      p = p+1 %if p<0; write(q,p)
    %finish
    printsymbol(|r|+'0')
  %end
  store = ""; l == length(store)
  write(v,p)
  %result = store
%end

%systemstring(127)%fn rtos(%real r,%integer n,m)
  %constreal pmax = 2147483647.0
  %real y,z
  %integer i=0,l,count=0,sign
  %string(127) result = ""
  !
  sign = ' '
  sign = '-' %if r < 0
  y = |r|+0.5/10.0\{^}m;  !modulus, rounded
  %if y > pmax %start
    count = count+1 %and y = y/10.0 %until y < 10.0
  %finish
  z = 1.0
  %cycle
    i = i+1;  z = z*10.0
  %repeat %until z > y
  result = result." " %for l = 1,1,n-i;  !l not used before here
  result = result.tostring(sign) %unless sign = ' ' %and n <= 0
  %cycle
    z = z/10.0
    l = int pt(y/z)
    y = y-l*z
    result = result.tostring(l+'0')
    i = i-1
    %exit %if i+m <= 0
    result = result."." %if i = 0
  %repeat
  result = result."@".itos(count,0) %if count # 0
  %result = result
%end;  !rtos

%systemstring(127)%fn rtof(%real x, %integer n)
  %real y,round
  %integer count=-99,sign=0
  %string(127) result=""
  !
  %if x # 0 %start
    x = -x %and sign = 1 %if x < 0
   !Adjust X so that 1.0 <= rounded(X) < 10.0
    count = 0;  round = 0.5\{^}n
    y = 1.0-round
    %if x < y %start;  !ie rounded(X) < 1.0
      count = count-1 %and x = x*10.0 %until x >= y
    %finish %else %start
      y = 10.0-round
      %while x >= y %cycle;  !ie rounded(X) > 10.0
        count = count+1;  x = x/10.0
      %repeat
    %finish
    x = -x %if sign # 0
  %finish
  result = rtos(x,1,n)
  result = result."@".itos(count,0)
  %result = result
%end;  !flrtos

%system %real %function S To R (%string (255) Input) {rmm}
  %integer Sign = 0,
           Sym,
           Pos = 1
  %real Value,
        Exp

   %routine Next
      Pos = Pos + 1
      %if Pos > Length (Input) %start
         Sym = 0
      %else
         Sym = Char No (Input, Pos)
      %finish
   %end

   Sym = Char No (Input, Pos)
   %if Sym = '-' %start
      Sign = 1
      Next
   %finish
   Value = 0
   %if Sym # '.' %start
      %signal 6, 5, Pos %unless '0' <= Sym <= '9'           {Char No out of range}
      %cycle
         Value = Value*10.0 + (Sym - '0')
         Next
      %repeat %until %not '0' <= Sym <= '9'
   %finish
   %if Sym = '.' %start
      Exp = 10.0
      %cycle
         Next
         %exit %unless '0' <= Sym <= '9'
         Value = Value + (Sym - '0')/Exp
         Exp = Exp * 10.0
      %repeat
   %finish
   %if Sym = '@' %start
      Sym = S To I (Sub String (Input, Pos + 1, Length (Input)))
      Value = Value * 10.0\Sym
   %finish
   Value = -Value %if Sign # 0
   %result = Value
%end {S To R}

%systemrealfn ftor(%string(255)s)
  %result = stor(s)
%end

%systemintegerfn xread %alias "read"
%integer i,k,sign,ten=10,max='9'
  %cycle
    k = next symbol
    %exit %if k > ' '
    skip symbol
  %repeat
  sign = 0
  %if k = '-' %start
    sign = 1
    skip symbol;  k = next symbol
  %finish
  %cycle
    %signal 4,1,nextsymbol,"Non-numeric character to READ" %unless '0'<=k<=max
    i = k-'0'
    %cycle
      skip symbol
      k = next symbol
      k = k-32 %if k>='a'
      %if k>'9' %start
        %exitif k<'A'
        k = k-7
      %finish
      %exit %unless '0' <= k <= max
      i = i*ten-'0'+k
    %repeat
    %exitunless k='_'-7
    ten = i; max = '0'+ten-1
    skipsymbol; k = nextsymbol
    k = k-32 %if k>='a'
    %if k>'9' %start
      k = -1 %if k<'A'
      k = k-7
    %finish
  %repeat
  i = -i %if sign # 0
  %result = i
%end

%systemrealfn readreal
%integer sign=0,sym
%real value,exp

  %routine read(%integername n)
    n = xread
  %end

  %cycle
    sym = nextsymbol
    %exit %if sym > ' '
    skipsymbol
  %repeat
  %if sym = '-' %start
    sign = 1
    skip symbol;  sym = nextsymbol
  %finish
  value = 0
  %if sym # '.' %start
    %signal 4,1,sym,"Non-numeric character to READ" %unless '0' <= sym <= '9'
    %cycle
      value = value*10.0+(sym-'0')
      skip symbol;  sym = nextsymbol
    %repeat %until %not '0' <= sym <= '9'
  %finish
  %if sym = '.' %start
    exp = 10.0
    %cycle
      skip symbol;  sym = nextsymbol
      %exit %unless '0' <= sym <= '9'
      value = value+(sym-'0')/exp
      exp = exp*10.0
    %repeat
  %finish
  %if sym = '@' %start
    skipsymbol
    read(sym)
    value = value*10.0\sym {^}
  %finish
  value = -value %if sign # 0
  %result = value
%end;  !read real

%systemroutine write(%integer n,p)
%integer q,r
  %if p>0 %start
    p = \p; printsymbol(' ') %and p = p+1 %if n>=0
  %finish
  p = -120 %if p<-120
  q = n//10; *move.l d1,r
  %if q=0 %start
    p = p+1 %if n<0; spaces(-1-p); printsymbol('-') %if n<0
  %else
    p = p+1 %if p<0; write(q,p)
  %finish
  printsymbol(|r|+'0')
%end

%systemroutine print(%real x, %integer n,m)
%constreal pmax = 2147483647.0
%real y,z
%integer i=0,l,count=0,sign
  sign = ' '
  sign = '-' %if x < 0
  y = |x|+0.5/10.0\{^}m;  !modulus, rounded
  %if y > pmax %start
    count = count+1 %and y = y/10.0 %until y < 10.0
  %finish
  z = 1.0
  %cycle
    i = i+1;  z = z*10.0
  %repeat %until z > y
  spaces(n-i)
  printsymbol(sign) %unless sign = ' ' %and n <= 0
  %cycle
    z = z/10.0
    l = int pt(y/z)
    y = y-l*z
    printsymbol(l+'0')
    i = i-1
    %exit %if i+m <= 0
    print symbol('.') %if i = 0
  %repeat
  printsymbol('@') %and write(count,0) %if count # 0
%end;  !print

%systemroutine printfl(%real x, %integer n)
%real y,round
%integer count=-99,sign=0
  %if x # 0 %start
    x = -x %and sign = 1 %if x < 0
   !Adjust X so that 1.0 <= rounded(X) < 10.0
    count = 0;  round = 0.5\{^}n
    y = 1.0-round
    %if x < y %start;  !ie rounded(X) < 1.0
      count = count-1 %and x = x*10.0 %until x >= y
    %finish %else %start
      y = 10.0-round
      %while x >= y %cycle;  !ie rounded(X) > 10.0
        count = count+1;  x = x/10.0
      %repeat
    %finish
    x = -x %if sign # 0
  %finish
  print(x,1,n)
  printsymbol('@')
  write(count,0)
%end;  !printfl

%systemroutine phex1(%integer x)
  x = x&15; x = x+7 %if x>9; printsymbol(x+'0')
%end

%systemroutine phex2(%integer x)
  phex1(x>>4); phex1(x)
%end

%systemroutine phex4(%integer x)
  phex2(x>>8); phex2(x)
%end

%systemroutine phex(%integer x)
  phex4(x>>16); phex4(x)
%end

%systemintegerfn rhex
%integer n=0,s
  %onevent 4 %start
    %signal 4,1,s,"Non-numeric character to RHEX"
  %finish
  %cycle
    s = nextsymbol; %exitif s>' '
    skipsymbol
  %repeat
  s = s&95 %if s>='a'
  %signal 4 %unless '0'<=s<='9' %or 'A'<=s<='F'
  %while '0'<=s<='9' %or 'A'<=s<='F' %cycle
    s = s-'0'; s = s-7 %if s>9
    n = n<<4+s; skipsymbol; s = nextsymbol
    s = s&95 %if s>='a'
  %repeat
  %result = n
%end

! Bulk move

%systemroutine smoveblock(%integer bytes,from,to)
!"signed" move block
!if bytes>0 then move (from)+ to (to)+ but
!if bytes<0 then from:=from-bytes, to:=to-bytes, move -(from) to -(to)
%label f1,f2,f3,f4,f5,f6,f7,b0,b1,b2,b3,b4,b5,b6,b7,end
  *move.l d1,a0
  *move.l d2,a1
  *eor d1,d2
  *tst.l d0
  *bmi b0;       !copy backwards ->
  *beq end;      !copy nothing ->
  *btst #0,d2;   !if (from!!to)&1#0 then
  *bne f5;       !copy bytewise ->
  *btst #0,d1;   !if from&1=0 then
  *beq f1;       !go for longword loop ->
  *move.b (a0)+,(a1)+; !copy first byte to even up
  *subq.l #1,d0
f1: *moveq #3,d2
  *and d0,d2;    !remainder for byte loop
  *subq.l #4,d0
  *bmi f4;       !bytes<4 ->
  *lsr.l #2,d0;  !longwords-1
  *bra f3
f2: *swap d0;    !longword loop
f3: *move.l (a0)+,(a1)+
  *dbra d0,f3
  *swap d0
  *dbra d0,f2
f4: *move.l d2,d0
f5: *subq.l #1,d0; !bytes-1
  *bmi end
  *bra f7
f6: *swap d0;      !byte loop
f7: *move.b (a0)+,(a1)+
  *dbra d0,f7
  *swap d0
  *dbra d0,f6
  *bra end
b0: *neg.l d0;   !backwards copy
  *add.l d0,a0;  !adjust addresses for -()
  *add.l d0,a1
  *btst #0,d2
  *bne b5
  *move a0,d1;   !!
  *btst #0,d1
  *beq b1
  *move.b -(a0),-(a1)
  *subq.l #1,d0
b1: *moveq #3,d2
  *and d0,d2
  *subq.l #4,d0
  *bmi b4
  *lsr.l #2,d0
  *bra b3
b2: *swap d0
b3: *move.l -(a0),-(a1)
  *dbra d0,b3
  *swap d0
  *dbra d0,b2
b4: *move.l d2,d0
b5: *subq.l #1,d0
  *bmi end
  *bra b7
b6: *swap d0
b7: *move.b -(a0),-(a1)
  *dbra d0,b7
  *swap d0
  *dbra d0,b6
end:
%end

%systemroutine moveblock(%integer bytes,from,to)
!in case of overlap copy without propagating
!  %returnif bytes<=0
!  bytes = -bytes %if from<to<from+bytes
!  smoveblock(bytes,from,to)
%label x,y
  *tst.l d0
  *ble y
  *cmp.l d2,d1
  *bge x
  *move.l d1,d3
  *add.l d0,d3
  *cmp.l d3,d2
  *bge x
  *neg.l d0
x:*jsr smoveblock
y:
%end

!%systemstring(31)%fn DATETIME
!  %result = "dd/mm/yy  hh.mm"
!%end
!!
!%systemstring(8)%fn DATE;                !** No owns
!  %result = "dd/mm/yy"
!%end
!!
!%systemstring(5)%fn TIME;                !** No owns
!  %result = "hh.mm"
!%end

%include "moose:mouse.inc"

%externalpredicate exists(%string(255)file)
%integer x
  %onevent 3 %start
    selectinput(x)
    %false
  %finish
  x = poa_instream
  openinput(3,file); selectinput(3); closeinput
  selectinput(x)
  %true
%end

%externalintegerfn filesize(%string(255)file)
%integer x,y
  %onevent 3 %start
    selectinput(x)
    %result = 0
  %finish
  x = poa_instream
  openinput(3,file); selectinput(3)
  y = poa_curin_fl-poa_curin_fs
  closeinput
  selectinput(x)
  %result = y
%end

%constinteger wildmax=10
%Own%string(127)%array wc(1:wildmax)
%Own%integer wp=0

%External %Predicate Matches (%string(*)%name value,template)
! The bits in VALUE corresponding to wildcards in TEMPLATE are
! stored in global array WC at index position WP upwards.
! The global WC index pointer WP is updated appropriately.
%integer vlen,tlen
  %predicate m(%integer spos,ppos,wpos)
  %integer psym,ssym
    %cycle
      %if ppos=tlen %start
        %trueif spos=vlen; %false
      %finish
      ppos = ppos+1; psym = charno(template,ppos)
      %exitif psym='*'
      %falseif spos=vlen
      spos = spos+1; ssym = charno(value,spos)
      psym = ssym %if ssym!32=psym!32 %and 'a'<=psym!32<='z'
      %unless ssym=psym %start
        %falseunless psym='%'
        wpos = wpos+1; wc(wpos) = tostring(ssym)
        wp = wpos
      %finish
    %repeat
    wpos = wpos+1; wc(wpos) = ""; wp = wpos
    %cycle
      %trueif m(spos,ppos,wpos)
      %exitif spos=vlen
      spos = spos+1; ssym = charno(value,spos)
      wc(wpos) = wc(wpos).tostring(ssym)
    %repeat
    wp = wpos-1; %false
  %end
!Printstring("Match ".value." ".template);newline
  vlen = length(value); tlen = length(template)
  wp = 0
  %trueif m(0,0,0); %false
%end

%externalroutine translate(%string(*)%name template,input,output)
! Substitutes the wild cards in OUTPUT with the bits of INPUT
! that correspond to the wildcards in TEMPLATE.
%string(255)s,f,a,r
%integer i
  %returnunless matches(input,template)
{printstring("With ".template." ".input." translates to ")
  r = ""; s = output
  s = f."*".a %while s->f.("%").a
  i = 1
  %while s->f.("*").a %cycle
    r = r.f
    r = r.wc(i) %and i = i+1 %if i<=wp
    s = a
  %repeat
  r = r.s
  output = r
{printstring(r);newline
%end

!%Routine trim (%String(*)%name s)
!   %Integer l=length(s)
!   length(s) = l-1 %if charno(s,l) = ':'
!%End
!
!%String(255)%Fn Cleanup (%String(255) s)
!   %String(255) f,a
!
!   %while s->f.(":.:").a %cycle
!      s = f.(":").a
!   %Repeat
!   %Result = s
!%ENd
!
!%Recordformat filefm (%String(255) f,%Record(filefm)%name n)
!
!%Routine Do Local Wild (%String(255) fore,aft,
!                        %Routine dothing (%String(255) in))
!   %record(filefm)%name top==NIL,next,last
!   %String(255) f,a,file,temp,temp2
!
!   Mark
!!   Printstring("Fore=".fore." aft=".aft);newline
!   Open Input (2,fore{.":"});selectinput(2)
!   %Begin
!      %Routine insert
!         %if top == NIL %start
!            top==new(top);top=0
!            top_f = file
!            last==top
!         %else
!            last_n == new(last_n);last_n=0
!            last == last_n
!            last_f = file
!         %finish
!      %End
!      %Routine push
!         next == new(next); next=0
!         next_f = file
!         next_n == top
!         top == next
!      %End
!      %on 9 %Start
!         close input
!         %signal 9,event_sub,0,event_message %if event_sub # 0
!         %Return
!      %Finish
!      %cycle
!         readline(file)
!         to lower (file)
!         insert ;! %or push
!      %Repeat
!   %End
!     
!   %If aft -> f.(":").a %Start
!      %if f = "..." %Start
!         next == TOP
!         %while next ## nil %cycle
!            file=next_f
!            %if charno(file,length(file))=':' %start
!               do local wild (fore.file,"...:".a,dothing)
!            %Else
!               temp=file
!               %if matches(temp,a) %start
!                  temp = cleanup(fore.{":".}file)
!                  dothing(temp)
!               %finish
!            %finish
!            next == next_n
!         %Repeat
!      %Else
!         temp = f.":"
!         temp2 = f.">"
!{ Printstring("Temp2=".temp2);newline
!         next == TOP
!         %while next ## NIL %cycle
!            file=next_f
!            %if matches (file,temp) %start
!!                trim(file)
!               do local wild (fore.file,a,dothing)
!            %elseif temp2 = file
!               do local wild (fore.f.":",a,dothing)
!            %Finish
!            next == next_n
!         %Repeat
!      %Finish
!   %Else
!      next == TOP
!      %while next ## NIL %Cycle
!        file = next_f
!!printstring("Try match ".file." ".aft);newline
!        temp=file
!!         trim(temp)
!        %if matches (temp,aft) %start
!!             printstring(file." = ".aft);newline
!!             trim(file)
!            temp = cleanup(fore.file)
!            do thing (temp)
!         %Else
!!             printstring(file." # ".aft);newline
!         %Finish
!         next==next_n
!      %Repeat
!   %finish
!   release
!%end
!
!%Externalroutine  Do Wild (%string(255) filespec,
!                           %Routine dothing(%String(255)in))
!   %String(255) fore
!
!   %Routine trans (%String(*)%Name s)
!      %STring(255)f,a
!      %While s -> f.(":").a %cycle
!         %exitif f=""
!         %Exitunless translate logicalname (f)
!         s = f.":".a
!      %Repeat
!   %End
!
!   to lower (filespec)
!   trans (filespec)
!   %if charno(filespec,1) = ':' %start
!      filespec -> (":").filespec 
!      %if filespec="" %Start
!         %Signal 9,2,0,"Bad filename - no device specified"
!      %Finish
!      %if filespec -> fore.(":").filespec %start
!         fore=":".fore.":"
!      %Else
!         %Signal 9,2,0,"Bad filename"
!      %Finish
!   %else
!      fore="default:"
!      trans(fore)
!   %Finish
!!   trim(fore)
!   do local wild (fore,filespec,dothing)
!%End      

%Externalroutine  Do Wild (%string(255) filespec,%integer mode,
                           %Routine dothing(%String(255)in, %integer flag))
{This routine should be rewritten - here temp only}
   %String(255) fore

   %Routine Do Local Wild (%String(255) fore,aft)
      {this routine is ok ?}
      %Recordformat filefm (%String(255) f,%Record(filefm)%name n)
      %record(filefm)%name top==NIL,next,last
      %String(255) f, r,rest, file, trest
      %Integer dir, bottom

      %on 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
         dothing(event_message,1)    {maybe more should be sent}
         %return
      %finish
         
      open input (2, fore) ; select input (2)
      mark 
      %begin
         %routine insert
            %if top == NIL %start
               top==new(top);top=0
               top_f = file
               last==top
            %else
               last_n == new(last_n);last_n=0
               last == last_n
               last_f = file
            %finish
         %end
         %on 9 %Start
            close input
            dothing (event_message,1) %if event_sub # 0
            %Return
         %Finish
         %cycle
            readline(file)
            to lower (file)
            insert
         %Repeat
      %End
   
      %if aft -> f.(":").rest %start
         %if f = "..." %start
            next == top
            %if rest = "" %then trest = "*:" %else trest = rest
            %while next ## nil %cycle
               file = next_f ; dir = 0
               dir = 1 %if charno (file, length(file)) = ':'
               %if matches (file, trest) %start
                  %if mode = 1 %start
                     do thing (fore.file,0) 
                  %elseif mode = 2
                     do thing (fore.file,0)
                     do local wild (fore.file, "...:".trest) %if dir = 1
                  %elseif mode = 3
                     do local wild (fore.file, "...:".trest) %if dir = 1
                     do thing (fore.file,0)
                  %else
                     {Internal consistency error}
                     {}Printstring("Bad mode - ");write(mode,0);newline
                  %finish
               %finish
               next == next_n
            %repeat
            %if mode = 1 %start
               next == top
               %while next ## nil %cycle
                  file = next_f
                  %if charno (file, length(file)) = ':' %start
                     do local wild (fore.file,"...:".trest)
                  %finish
                  next == next_n
               %repeat
            %finish
         %else
            next == top ; r = f.">" ; f = f.":"
            %if rest = "" %then bottom = 1 %else bottom = 0
            %while next ## nil %cycle
               file = next_f
               %if matches (f, file) %start
                  %if bottom = 1 %start
                     do thing (fore.file,0)
                  %else
                     do local wild (fore.file,rest)
                  %finish
               %elseif matches (r,file)
                 charno (file,length(file))=':'
                 do local wild (fore.file,rest)
               %Finish
               next == next_n
            %repeat
         %finish
      %else
         next == top
         %while next ## nil %cycle
            file = next_f ; dir = 0
            %if matches (file, aft) %start
               do thing (fore.file,0)
            %finish
            next == next_n
         %repeat
      %finish
      release {should also be done if problems occur}
   %end

   %Routine trans (%String(*)%Name s)
      %String(255)f,a
      %While s -> f.(":").a %cycle
         %exitif f=""
         %Exitunless translate logicalname (f)
         s = f.":".a
      %Repeat
   %End

   to lower (filespec)
   trans (filespec)
   %if charno(filespec,1) = ':' %start
      filespec -> (":").filespec 
      %if filespec="" %Start
         %Signal 9,2,0,"Bad filename - no device specified"
      %Finish
      %if filespec -> fore.(":").filespec %start
         fore=":".fore.":"
      %Else
         %Signal 9,2,0,"Bad filename"
      %Finish
   %else
      fore="default:"
      trans(fore)
   %Finish
   filespec = "...:*" %if filespec = "..."
   do local wild (fore,filespec)
%End