#-h- trsym 103 asc 07-may-80 12:36:34 ## definitions for TR tool # put on a file named 'trsym' # used only by tr define(MAXSET,100) #-h- findsym 479 asc 07-may-80 12:36:36 ## definitions for the FIND tool # put on a file named 'findsym' # Used by the find, ch, and tr tools define(ANY,QMARK) define(BOL,PERCENT) define(CCL,LBRACK) define(CCLEND,RBRACK) define(CHAR,LETA) define(CLOSIZE,4) define(CLOSURE,STAR) define(COUNT,1) define(EOL,DOLLAR) define(MAXARG,128) define(MAXPAT,128) define(NCCL,LETN) define(PREVCL,2) define(START,3) define(NEXPR,10) # maximum number of expressions allowed on cmd line #-h- tr.r 2895 asc 07-may-80 12:36:37 #-h- main 602 asc 07-may-80 12:36:09 #--------------------------------------------------------------------- # include symbol definitions # include symbols include findsym include trsym #--------------------------------------------------------------------- ## tr -- main program #BKY subroutine driver # call initr4 # call tr # call endr4 # end #BKY #assembly code main program (used to avoid loading fortran I/O) #BKY % #BKY ident main #BKY entry main #BKY vfd 42/0lmain,18/main #BKY ext driver #BKY rj uzero00 #BKY rj driver #BKY end main #BKY% #-h- trs 1417 asc 07-may-80 12:36:10 ## tr - transliterate characters on a file # subroutine tr subroutine main character getc character arg(MAXLINE), c, from(MAXSET), to(MAXSET) integer getarg, length, makset, xindex integer allbut, collap, i, lastto if (getarg(1, arg, MAXLINE) == EOF | (arg(1) == QMARK & arg(2) == EOS)) call error('usage: tr from to.') else if (arg(1) == NOT) { allbut = YES if (makset(arg, 2, from, MAXSET) == NO) call error('from: too large.') } else { allbut = NO if (makset(arg, 1, from, MAXSET) == NO) call error('from: too large.') } if (getarg(2, arg, MAXLINE) == EOF) to(1) = EOS else if (makset(arg, 1, to, MAXSET) == NO) call error('to: too large.') lastto = length(to) if (length(from) > lastto | allbut == YES) collap = YES else collap = NO repeat { i = xindex(from, getc(c), allbut, lastto) if (collap == YES & i >= lastto & lastto > 0) { # collapse call putc(to(lastto)) repeat i = xindex(from, getc(c), allbut, lastto) until (i < lastto) } if (c == EOF) break if (i > 0 & lastto > 0) # translate call putc(to(i)) else if (i == 0) # copy call putc(c) # else delete } #*** return end #-h- makset 301 asc 07-may-80 12:36:12 ## makset - make set from array(k) in set integer function makset(array, k, set, size) integer addset integer i, j, k, size character array(ARB), set(size) i = k j = 1 call filset(EOS, array, i, set, j, size) makset = addset(EOS, set, j, size) return end #-h- xindex 379 asc 07-may-80 12:36:13 ## xindex - invert condition returned by index integer function xindex(array, c, allbut, lastto) character array(ARB), c integer index integer allbut, lastto if (c == EOF) xindex = 0 else if (allbut == NO) xindex = index(array, c) else if (index(array, c) > 0) xindex = 0 else xindex = lastto + 1 return end