#-h- findsym          572 asc  6-oct-80 07:30:20
 ## 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(CLOSURE1,PLUS)	# closure of one or more occurrences
			# i.e. (pat)+ == (pat)(pat)*
  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- csedit           673 asc  6-oct-80 07:30:20
 ## common block for csedit tool
 #  put on a file called 'csedit'
 #  (used only by csedit)
 
 common /csedit/ aq, iq, buf(MAXBUF), lastbf, nlines, line1, line2,
   pat(MAXPAT), prevc, nflag
   integer aq		# end of append queue
   integer iq		# end of insert queue
   character buf	# buf for commands
   integer lastbf	# next available character in buf
   integer nlines	# number of line number expressions
   integer line1	# line number 1 or index to pattern
   integer line2	# line number 2 or index to pattern
   character pat	# current pattern during compilation
   integer prevc	# index of previous command
   integer nflag	# YES to print result of "p" commands only
#-h- sedit.r        19225 asc  6-oct-80 07:30:22
#-h- defns           1569 asc  6-oct-80 07:27:32
 # include ratdef

define(NLINES,0)        # number of line numbers
define(NEXT,1)          # index of next command
define(LINE1,2)         # line number 1 or index of pattern
define(LINE2,3)         # line number 2 or index of pattern
define(COMMAND,4)       # command
define(LIST,5)          # next command on insert/append list
define(TEXT,6)          # text for insert/append or file name for read
define(APPENDCOM,LETA)  # append command
define(CHANGECOM,LETC)  # change command
define(DELETECOM,LETD)  # delete command
define(INSERTCOM,LETI)  # insert command
define(PRINTCOM,LETP)   # print command
define(READCOM,LETR)    # read command
define(SUBSTCOM,LETS)   # substitute command
  define(SUBSTGFLAG,COMMAND+1) # YES for global replacement
  define(SUBSTPFLAG,COMMAND+2) # YES for print
  define(SUBSTPAT,COMMAND+3)   # index of pattern
  define(SUBSTNEW,COMMAND+4)   # index of replacement
define(WRITECOM,LETW)   # write command
  define(WRITEFD,COMMAND+1)    # file descriptor for opened file or 0
define(EQUALCOM,EQUALS) # print line number command

define(INSERTLIST,1)    # location of list of inserts
  define(APPENDLIST,LIST+1)    # location of list of appends
define(COMMANDLIST,1)   # location of command list
  define(FIRSTFREE,APPENDLIST+TEXT)    # first free location in buf

define(MAXBUF,5000)     # size of command buffer
define(LASTLINE,DOLLAR)
define(OK,YES)          # to be compatible with addset/addstr
define(GLOBAL,LETG)     # for getrhs
define(PRINT,LETP)      # for ckp
define(DITTO,(-3))
define(MAXNAME,FILENAMESIZE)
include findsym
#-h- sedit           2588 asc  6-oct-80 07:21:34
# sedit - stream editor
 subroutine main
   character arg(MAXLINE), linbuf(MAXLINE)
   integer i, j, nfiles, fd
   integer length, getarg, open, getlin
   include csedit

   prevc = COMMANDLIST  # initialize lists
   buf(COMMANDLIST+NEXT) = 0
   lastbf = FIRSTFREE
   nflag = NO
   nfiles = 0
   i = 1
   if (getarg (i, arg, MAXLINE) == EOF |
       arg(i) == QMARK & arg(2) == EOS)
      call usage
   if (arg(1) == MINUS & arg(2) == LETN) {
      nflag = YES
      i = i + 1
      }
   for (; getarg(i, arg, MAXLINE) ^= EOF; i = i + 2)
      if (arg(1) == MINUS & arg(2) == LETF) {           # -f filename
         if (getarg(i + 1, arg, MAXLINE) == EOF)
            call usage
         fd = open(arg, READ)
         if (fd == ERR)
            call cant(arg)
         while (getlin(arg, fd) ^= EOF)
            call compil(arg, fd)
         call close(fd)
         }
      else if (arg(1) == MINUS & arg(2) == LETE) {      # -e script
         if (getarg(i + 1, arg, MAXLINE) == EOF)
             call usage
         j = length(arg)
         arg(j+1) = NEWLINE
         arg(j+2) = EOS
         call compil(arg, NO)
         }
      else      # no flags
         break
   if (lastbf == FIRSTFREE) {   # use argument as script
      if (getarg(i, arg, MAXLINE) == EOF)
          call usage
      j = length(arg)
      arg(j+1) = NEWLINE
      arg(j+2) = EOS
      call compil(arg, NO)
      i = i + 1
      }
   linbuf(1) = EOS
   lineno = 0
   call docmds(linbuf, 0)       # do line 0 commands
   for (; getarg(i, arg, MAXLINE) ^= EOF; i = i + 1) {
      if (arg(1) == MINUS & arg(2) == EOS)
         fd = STDIN
      else
         fd = open(arg, READ)
      if (fd == ERR)
         call cant(arg)
      call sed(linbuf, lineno, fd)
      if (fd ^= STDIN)
         call close(fd)
      nfiles = nfiles + 1
      }
   if (nfiles == 0)
      call sed(linbuf, lineno, STDIN)
   if (linbuf(1) ^= EOS) {      # set last line number and do last line
      lineno = lineno + 1
      for (i = buf(COMMANDLIST+NEXT); i > 0; i = buf(i+NEXT)) {
         if (buf(i+LINE1) == -HUGE)
            buf(i+LINE1) = -lineno
         if (buf(i+LINE2) == -HUGE)
            buf(i+LINE2) = -lineno
         if (buf(i+COMMAND) == CHANGECOM) #clean unsatisfied c commands
            {
            if (buf(i+NLINES) == 2)
               buf(i+NLINES) = 1    # insures changed text is output
            if (buf(i+NLINES) == 3 & (buf(i+LINE2) > 0 |
               -buf(i+LINE2) >= lineno))
               buf(i+LINE2) = -lineno
            }
         }
      call docmds(linbuf, lineno)
      }
   return
   end
#-h- addstr           339 asc  6-oct-80 07:21:35

# addstr - add s to str(j) if it fits, increment j
   integer function addstr(s, str, j, maxsiz)
   character s(ARB), str(ARB)
   integer j, maxsiz
   integer i, addset

   for (i = 1; s(i) ^= EOS; i = i + 1)
      if (addset(s(i), str, j, maxsiz) == NO) {
         addstr = NO
         return
         }
   addstr = YES
   return
   end
#-h- catsub           484 asc  6-oct-80 07:21:36
 ## catsub - add replacement text to end of  new. 
    subroutine catsub(lin, from, to, sub, new, k, maxnew) 
    integer addset 
    integer from, i, j, junk, k, maxnew, to 
    character lin(MAXLINE), new(maxnew), sub(MAXPAT) 
  
    for (i = 1; sub(i) != EOS; i = i + 1) 
       if (sub(i) == DITTO) 
          for (j = from; j < to; j = j + 1) 
             junk = addset(lin(j), new, k, maxnew) 
       else 
          junk = addset(sub(i), new, k, maxnew) 
    return 
    end 
#-h- ckp              376 asc  6-oct-80 07:21:36
# ckp - check for "p" after command
   integer function ckp(lin, i, pflag, status)
   character lin(MAXLINE)
   integer i, j, pflag, status
   character clower
 
   j = i
   if (clower(lin(j)) == PRINT) {
      j = j + 1
      pflag = YES
      }
   else
      pflag = NO
   if (lin(j) == NEWLINE)
      status = OK
   else
      status = ERR
   ckp = status
   return
   end
#-h- compil          3024 asc  6-oct-80 07:21:38
# compil - "compile" command in lin(i) from file fd, increment i
   subroutine compil(lin, fd)
   character lin(MAXLINE)
   integer fd
   character file(MAXNAME), sub(MAXPAT)
   integer i, gflag, pflag, status, fdw
   integer addset, addstr, create, getrhs, getfn, ckp, optpat, dotext,
      getlst, length
   character clower
   include csedit

   status = ERR
   i = 1
   if (getlst(lin, i, status) == ERR) {
      call putlin(lin, ERROUT)
      call error("bad line numbers.")
      }
   call skipbl(lin, i)
   buf(prevc+NEXT) = lastbf     # link in new command
   prevc = lastbf
   status = addset(nlines, buf, lastbf, MAXBUF)
   status = addset(0, buf, lastbf, MAXBUF)
   status = addset(line1, buf, lastbf, MAXBUF)
   status = addset(line2, buf, lastbf, MAXBUF)
                                    #fold commands to lower case
   status = addset(clower(lin(i)), buf, lastbf, MAXBUF)
   if (clower(lin(i)) == APPENDCOM & lin(i+1) == NEWLINE & fd ^= NO) {
      status = addset(0, buf, lastbf, MAXBUF)
      status = dotext(fd)
      }
   else if (clower(lin(i)) == CHANGECOM & lin(i+1) == NEWLINE & fd ^= NO) {
      status = addset(0, buf, lastbf, MAXBUF)
      status = dotext(fd)
      }
   else if (clower(lin(i)) == DELETECOM & lin(i+1) == NEWLINE)
      status = OK
   else if (clower(lin(i)) == INSERTCOM & lin(i+1) == NEWLINE & fd ^= NO) {
      status = addset(0, buf, lastbf, MAXBUF)
      status = dotext(fd)
      }
   else if (clower(lin(i)) == PRINTCOM & lin(i+1) == NEWLINE)
      status = OK
   else if (clower(lin(i)) == READCOM) {
      status = addset(0, buf, lastbf, MAXBUF)
      status = getfn(lin, i, file)
      if (status == OK) {
         status = addstr(file, buf, lastbf, MAXBUF)
         status = addset(EOS, buf, lastbf, MAXBUF)
         }
      }
   else if (clower(lin(i)) == SUBSTCOM) {
      i = i + 1
      if (optpat(lin, i) == OK)
         andif (getrhs(lin, i, sub, gflag) == OK)
            status = ckp(lin, i + 1, pflag, status)
      if (status == OK) {
         status = addset(gflag, buf, lastbf, MAXBUF)
         status = addset(pflag, buf, lastbf, MAXBUF)
         status = addset(lastbf + 2, buf, lastbf, MAXBUF)
         status = addset(lastbf + length(pat) + 2, buf, lastbf, MAXBUF)
         status = addstr(pat, buf, lastbf, MAXBUF)
         status = addset(EOS, buf, lastbf, MAXBUF)
         status = addstr(sub, buf, lastbf, MAXBUF)
         status = addset(EOS, buf, lastbf, MAXBUF)
         }
      }
   else if (clower(lin(i)) == WRITECOM) {
      status = getfn(lin, i, file)
      if (status == OK) {
         fdw = create(file, WRITE)
         if (fdw == ERR)
            call cant(file)
         }
      status = addset(fdw, buf, lastbf, MAXBUF)
      }
   else if (clower(lin(i)) == EQUALCOM & lin(i+1) == NEWLINE)
      status = OK
   else
      status = ERR
   if (status ^= OK) {
      call putlin(lin, ERROUT)
      if (lastbf > MAXBUF)
         call error("too many commands.")
      else
         call error("invalid command.")
      }
   return
   end
#-h- docmds          2291 asc  6-oct-80 07:21:39
# docmds-execute commands in buf on linbuf, which contains line lineno
   subroutine docmds(linbuf, lineno)
   character linbuf(MAXLINE)
   integer lineno
   integer i, n
   integer match
   include csedit

   aq = APPENDLIST      # initialize append and insert queues
   buf(aq+LIST) = 0
   iq = INSERTLIST
   buf(iq+LIST) = 0
   for (i = buf(COMMANDLIST+NEXT); i ^= 0; i = buf(i+NEXT)) {
      nlines = buf(i+NLINES)
      line1 = buf(i+LINE1)
      line2 = buf(i+LINE2)
     if (nlines == 0)
         call docom(i, linbuf, lineno)
      else if (nlines == 1) {
         if (-line1 == lineno)
            call docom(i, linbuf, lineno)
         else if (line1 > 0)
                 andif (match(linbuf, buf(line1)) > 0)
                    call docom(i, linbuf, lineno)
         }
      else if (nlines == 2) {   # 2 line numbers, searching for line1
         if (-line1 == lineno) {
            buf(i+NLINES) = 3   # found it, change state
            call docom(i, linbuf, lineno)
            }
         else if (line1 > 0)
                 andif (match(linbuf, buf(line1)) > 0) {
                    buf(i+NLINES) = 3
                    call docom(i, linbuf, lineno)
                    }
         }
      else if (nlines == 3) {   # 2 line numbers, searching for line2
         if (line2 <= 0) {
            if (lineno >= -line2)
               buf(i+NLINES) = 2        # found it, change state
            if (lineno <= -line2)
               call docom(i, linbuf, lineno)
            }
         else if (line2 > 0) {
            if (match(linbuf, buf(line2)) > 0)
               buf(i+NLINES) = 2
            call docom(i, linbuf, lineno)
            }
         }
      else
         call error("in docmds: can't happen.")
      if (linbuf(1) == EOS & lineno > 0)
         break
      }
                                           # output inserts
   for (i = buf(INSERTLIST+LIST); i > 0; i = buf(i+LIST))
      call putlin(buf(i+TEXT), STDOUT)
   if (nflag == NO)
      call putlin(linbuf, STDOUT)
                                      # output appends
   for (i = buf(APPENDLIST+LIST); i > 0; i = buf(i+LIST))  
      if (buf(i+COMMAND) == READCOM)
         call fcopy(buf(i+TEXT), STDOUT)        # do r command
      else
         call putlin(buf(i+TEXT), STDOUT)
   return
   end
#-h- docom           1253 asc  6-oct-80 07:21:41
# docom - execute a single command at buf(i) on linbuf and lineno
   subroutine docom(i, linbuf, lineno)
   character linbuf(MAXLINE)
   integer i, lineno
   character cmd
   integer k1, k2, junk
   include csedit

   cmd = buf(i+COMMAND)
   if (cmd == APPENDCOM) {
      buf(aq+LIST) = i
      aq = i
      buf(i+LIST) = 0
      }
   else if (cmd == CHANGECOM) {
      linbuf(1) = EOS
      if (buf(i+NLINES) <= 2) {
         buf(aq+LIST) = i
         aq = i
         buf(i+LIST) = 0
         }
      }
   else if (cmd == DELETECOM)
      linbuf(1) = EOS
   else if (cmd == INSERTCOM) {
      buf(iq+LIST) = i
      iq = i
      buf(i+LIST) = 0
      }
   else if (cmd == PRINTCOM)
      call putlin(linbuf, STDOUT)
   else if (cmd == READCOM) {
      buf(aq+LIST) = i
      aq = i
      buf(i+LIST) = 0
      }
   else if (cmd == SUBSTCOM) {
      k1 = buf(i+SUBSTPAT)
      k2 = buf(i+SUBSTNEW)
      call subst(linbuf, buf(k1), buf(k2),
                buf(i+SUBSTGFLAG), buf(i+SUBSTPFLAG))
      }
   else if (cmd == WRITECOM) {
      if (buf(i+WRITEFD) ^= 0)
         call putlin(linbuf, buf(i+WRITEFD))
      }
   else if (cmd == EQUALCOM) {
      call putdec(lineno, 1)
      call putc(NEWLINE)
      }
   # else ignore command
   return
   end
#-h- dotext           382 asc  6-oct-80 07:21:42
# dotext - append text in file fd onto buf
   integer function dotext(fd)
   integer fd
   integer getlin, addset, addstr
   character lin(MAXLINE)
   include csedit

   while (getlin(lin, fd) ^= EOF) {
      if (lin(1) == PERIOD & lin(2) == NEWLINE)
         break
      junk = addstr(lin, buf, lastbf, MAXBUF)
      }
   dotext = addset(EOS, buf, lastbf, MAXBUF)
   return
   end
#-h- fcopy            339 asc  6-oct-80 07:21:42
# fcopy - copy file name to opened file fdo
   subroutine fcopy(name, fdo)
   character name(ARB)
   integer fdo
   integer fdi
   integer open
   character c
   character getch

   fdi = open(name, READ)
   if (fdi == ERR)
      call cant(name)
   while (getch(c, fdi) ^= EOF)
      call putch(c, fdo)
   call close(fdi)
   return
   end
#-h- getfn            461 asc  6-oct-80 07:21:43
# getfn - get file name from lin(i)...
   integer function getfn(lin, i, file)
   character lin(MAXLINE), file(MAXLINE)
   integer i, j, k
 
   getfn = ERR
   if (lin(i + 1) == BLANK | lin(i + 1) == TAB) {
      j = i + 2      # get new file name
      call skipbl(lin, j)
      for (k = 1; lin(j) ^= NEWLINE; k = k + 1) {
         file(k) = lin(j)
         j = j + 1
         }
      file(k) = EOS
      if (k > 1)
         getfn = OK
      }
   return
   end
#-h- getlst           505 asc  6-oct-80 07:21:44
# getlst - get a list of line numbers starting at lin(i), increment i
   integer function getlst(lin, i, status)
   character lin(MAXLINE)
   integer i
   integer status    # ignored
   integer num
   integer getone
   include csedit
 
   nlines = 0
   if (getone(lin, i, num) == EOF)
      return(OK)
   line1 = num
   nlines = nlines + 1
   if (lin(i) ^= COMMA)
      return(OK)
   i = i + 1
   if (getone(lin, i, num) ^= OK)
      return(ERR)
   line2 = num
   nlines = nlines + 1
   return(OK)
   end
#-h- getone          1026 asc  6-oct-80 07:21:45
# getone - evaluate one line number expression, increment i
   integer function getone(lin, i, num)
   character lin(MAXLINE)
   integer i, istart, num
   integer addstr, addset, ctoi, optpat
   include csedit
 
   getone = OK
   call skipbl(lin, i)
   istart = i
   if (lin(i) >= DIG0 & lin(i) <= DIG9) {
      num = ctoi(lin, i)
      i = i - 1   # move back; to be advanced at the end
      if (num < 0)
         getone = ERR
      num = -num
      }
   else if (lin(i) == LASTLINE)
      num = -HUGE
   else if (lin(i) == SLASH) {
      if (optpat(lin, i) == ERR)   # build the pattern
         getone = ERR
      else if (lin(i) == SLASH) {
         num = lastbf
         junk = addstr(pat, buf, lastbf, MAXBUF)
         if (addset(EOS, buf, lastbf, MAXBUF) == NO)
            getone = ERR
         }
      }
   else
      getone = EOF
   if (getone == OK)
      i = i + 1   # point at next character to be examined
   call skipbl(lin, i)
   if (i <= istart)
      getone = EOF
   else
      getone = OK
   return
   end
#-h- getrhs           494 asc  6-oct-80 07:21:45
# getrhs - get substitution string for "s" command
   integer function getrhs(lin, i, sub, gflag)
   character lin(MAXLINE), sub(MAXPAT)
   integer maksub
   character clower
   integer gflag, i
 
   getrhs = ERR
   if (lin(i) == EOS)
      return
   if (lin(i + 1) == EOS)
      return
   i = maksub(lin, i + 1, lin(i), sub)
   if (i == ERR)
      return
   if (clower(lin(i + 1)) == GLOBAL) {
      i = i + 1
      gflag = YES
      }
   else
      gflag = NO
   getrhs = OK
   return
   end
#-h- optpat           546 asc  6-oct-80 07:21:46
# optpat - make pattern if specified at lin(i)
   integer function optpat(lin, i)
   character lin(MAXLINE)
   integer makpat
   integer i
   include csedit
 
   if (lin(i) == EOS)
      i = ERR
   else if (lin(i + 1) == EOS)
      i = ERR
   else if (lin(i + 1) == lin(i))   # repeated delimiter
      i = i + 1         # leave existing pattern alone
   else
      i = makpat(lin, i + 1, lin(i), pat)
   if (pat(1) == EOS)
      i = ERR
   if (i == ERR) {
      pat(1) = EOS
      optpat = ERR
      }
   else
      optpat = OK
   return
   end
#-h- maksub           648 asc  6-oct-80 07:21:47
 ## maksub - make substitution string in sub (/*/sor/chr) 
    integer function maksub(arg, from, delim, sub) 
    character esc 
    character arg(MAXARG), delim, sub(MAXPAT) 
    integer addset 
    integer from, i, j, junk 
  
    j = 1 
    for (i = from; arg(i) != delim & arg(i) != EOS; i = i + 1) 
       if (arg(i) == AND) 
          junk = addset(DITTO, sub, j, MAXPAT) 
       else 
          junk = addset(esc(arg, i), sub, j, MAXPAT) 
    if (arg(i) != delim)   # missing delimiter 
       maksub = ERR 
    else if (addset(EOS, sub, j, MAXPAT) == NO)   # no room 
       maksub = ERR 
    else 
       maksub = i 
    return 
    end 
#-h- sed              818 asc  6-oct-80 07:21:48
# sed-execute all commands for file fd, use linbuf and increment lineno
   subroutine sed(linbuf, lineno, fd)
   character linbuf(MAXLINE)
   integer lineno, fd
   character buf1(MAXLINE), buf2(MAXLINE)
   integer getlin
   include csedit

   if (getlin(buf1, fd) == EOF)
      return
   if (lineno > 0) {    # do previous last line
      lineno = lineno + 1
      call docmds(linbuf, lineno)
      }
   repeat {
      if (getlin(buf2, fd) == EOF) {    # buf1 contains last line
         call scopy(buf1, 1, linbuf, 1)
         break
         }
      lineno = lineno + 1
      call docmds(buf1, lineno)
      if (getlin(buf1, fd) == EOF) {    # buf2 contains last line
         call scopy(buf2, 1, linbuf, 1)
         break
         }
      lineno = lineno + 1
      call docmds(buf2, lineno)
      }
   return
   end
#-h- subst           1001 asc  6-oct-80 07:21:49
# subst - substitute sub for occurrences of pat in txt
   subroutine subst(txt, pat, sub, gflag, pflag)
   character txt(MAXLINE), pat(ARB), sub(ARB)
   integer gflag, pflag
   character new(MAXLINE)
   integer addset, amatch
   integer j, junk, k, lastm, m, subbed
 
   j = 1
   subbed = NO
   lastm = 0
   for (k = 1; txt(k) ^= EOS; ) {
      if (gflag == YES | subbed == NO)
         m = amatch(txt, k, pat)
      else
         m = 0
      if (m > 0 & lastm ^= m) {   # replace matched text
         subbed = YES
         call catsub(txt, k, m, sub, new, j, MAXLINE)
         lastm = m
         }
      if (m == 0 | m == k) {   # no match or null match
         junk = addset(txt(k), new, j, MAXLINE)
         k = k + 1
         }
      else            # skip matched text
         k = m
      }
   if (subbed == YES) {
      if (addset(EOS, new, j, MAXLINE) == NO)
         return
      call scopy(new, 1, txt, 1)
      if (pflag == YES)
         call putlin(txt, STDOUT)
      }
   return
   end
#-h- usage            150 asc  6-oct-80 07:21:50
# usage - print usage message
  subroutine usage

  call error(_
   "usage: sedit [-n] [[-e script | -f sfiles] | script] [files].")
   return
   end