#-h- crc              523 asc 08-oct-80 09:49:43
 #---------------------------------------------------------------
 ## crc common block for 'rc' tool
 #  put on a file named 'crc'
 
 common / crc / load, savef, ratonl, verbos, list, debug

 integer load		# YES/NO for link after compilation
 integer savef		# YES/NO for saving intermediate .f files
 integer ratonl		# YES/NO for rat4 only => savef == YES
 integer verbos		# YES/NO for verbose mutterings
 integer list		# YES/NO for fortran listings during compilation
 integer debug		# YES/NO for debugging aid; init = NO
#-h- flist            277 asc 08-oct-80 09:49:45
  #------------------------------------------------------
  # flist - common block
  # should be put on a file named 'flist'
 
  common /flist/  flevel, ffiles(FILENAMESIZE, FLMAX)
    
    integer flevel	#pointer to current file
    character ffiles	#list of files to process
#-h- rc.r            4712 asc 08-oct-80 09:49:46
#-h- rcmain.q          43 asc 08-oct-80 09:49:31
# call initr4
# call rc
# call endr4
# end
#-h- rcs.q           2377 asc 08-oct-80 09:49:32
	define(FLMAX,25)
	define(EXTSIZE,4)

# subroutine rc
 subroutine main

 character arg(FILENAMESIZE), ext(EXTSIZE), extf(EXTSIZE), args(ARGBUFSIZE),
	   minusc(4), minusv(4), minuso(4), fc(3), rat4s(5), rat4(FILENAMESIZE),
	   descr(PIDSIZE), spath(80)
 integer errcnt, i, k, status, spawn, getarg, loccom

 include flist
 include crc

 string minusd "-d "

 data rat4s /LETR, LETA, LETT, DIG4, EOS/
 data fc /LETF, LETC, EOS/
 data extf(1), extf(2)/LETF, EOS/
 data minusc/MINUS, LETC, BLANK, EOS/
 data minusv/MINUS, LETV, BLANK, EOS/
 data minuso/MINUS, LETO, BLANK, EOS/

 load = YES
 savef = NO
 ratonl = NO
 verbos = NO
 list = NO
 debug = NO
 errcnt = 0

 for (i=1; getarg(i, arg, FILENAMESIZE) != EOF; i=i+1)
    {
    if (arg(1) == MINUS | arg(1) == PLUS | arg(1) == QMARK)
	call rccmd(arg)
    else
	call fstack(arg)
    }
 call impath(spath)
 if (loccom(rat4s, spath, rat4) != BINARY)
    call error("Cannot locate rat4 image file.")
 for (i=1; i <= flevel; i=i+1)
    {
    call getext(ffiles(1,i), ext)
    if (ffiles(1,i) != MINUS & ext(1) == LETR & ext(2) == EOS)
	{
	call genfil(ffiles(1,i), extf, arg)
	k = 1
	call stcopy(rat4s, 1, args, k)
	call chcopy(BLANK, args, k)
	call stcopy(ffiles(1,i), 1, args, k)
	call chcopy(BLANK, args, k)
	call chcopy(GREATER, args, k)
	call scopy(arg, 1, args, k)
	if (verbos == YES)
	    call remark(args)
	if (spawn(rat4, args, descr, WAIT) == ERR)
	    errcnt = errcnt + 1
	k = 1
	if (savef == NO)
	    {
	    ffiles(1,i) = GREATER
	    k = 2
	    }
	call scopy(arg, 1, ffiles(1,i), k)
	}
    }

 if (ratonl == NO & errcnt == 0)
    {
    k = 1
    call stcopy(fc, 1, args, k)
    call chcopy(BLANK, args, k)
    if (load == NO)
	call stcopy(minusc, 1, args, k)
    if (verbos == YES)
	call stcopy(minusv, 1, args, k)
    if (list == YES)
	call stcopy(minuso, 1, args, k)
    if (debug == YES)
	call stcopy(minusd, 1, args, k)
    for (i=1; i <= flevel; i=i+1)
	{
	if (ffiles(1,i) == GREATER)
	    call stcopy(ffiles(1,i), 2, args, k)
	else
	    call stcopy(ffiles(1,i), 1, args, k)
	call chcopy(BLANK, args, k)
	}
    args(k-1) = EOS
    if (verbos == YES)
	call remark(args)
    if (loccom(fc, spath, arg) != BINARY)
	call error("Cannot locate fc image file.")
    status = spawn(arg, args, descr, WAIT)
    for (i=1; i <= flevel; i=i+1)
	{
	if (ffiles(1,i) == GREATER)
	    call remove(ffiles(2,i))
	}
    }
 return
 end
#-h- rccmd.q          873 asc 08-oct-80 09:49:34
 subroutine rccmd(arg)

 character arg(FILENAMESIZE)

 include crc

 if (arg(1) == QMARK & arg(2) == EOS)
    call error("usage:  rc [-c][-f][-r][-v][-o][-d][-l[libr]][-pproc] file ...")
 else if (arg(1) == MINUS & (arg(2) == LETC | arg(2) == BIGC))
    load = NO
 else if (arg(1) == MINUS & (arg(2) == LETF | arg(2) == BIGF))
    savef = YES
 else if (arg(1) == MINUS & (arg(2) == LETR | arg(2) == BIGR))
    {
    ratonl = YES
    savef = YES
    }
 else if (arg(1) == MINUS & (arg(2) == LETV | arg(2) == BIGV))
    verbos = YES
 else if (arg(1) == MINUS & (arg(2) == LETO | arg(2) == BIGO))
    list = YES
 else if (arg(1) == MINUS & (arg(2) == LETD | arg(2) == BIGD))
    debug = YES
 else if (arg(1) == MINUS & (arg(2) == LETL | arg(2) == BIGL |
	  arg(2) == LETP | arg(2) == BIGP))
    call fstack(arg)
 else
    call remark('Ignoring invalid argument')
 return
 end
#-h- genfil.q         380 asc 08-oct-80 09:49:36
#--------------------------------------------------------------------
##	genfil -- generates file name with extension ext from in

 subroutine genfil(in, ext, out)

 integer i, j
 character in(FILENAMESIZE), ext(EXTSIZE), out(FILENAMESIZE)

 for (i=1; in(i) != PERIOD & in(i) != EOS; i=i+1)
    out(i) = in(i)
 call chcopy(PERIOD, out, i)
 call scopy(ext, 1, out, i)
 return
 end
#-h- getext.q         350 asc 08-oct-80 09:49:37
 subroutine getext(file, ext)

 character file(FILENAMESIZE), ext(EXTSIZE)
 integer i, j

 for (i=1; file(i) != PERIOD & file(i) != EOS; i=i+1) ;
 if (file(i) == PERIOD)
    i = i + 1
 for (j=1; file(i) != EOS & file(i) != SEMICOL & file(i) != PERIOD; j=j+1)
    {
    ext(j) = file(i)
    i = i + 1
    }
 ext(j) = EOS
 call fold(ext)

 return
 end
#-h- fstack.q         395 asc 08-oct-80 09:49:38
   #------------------------------------------------------------
   ## fstack - generate stack of input files
 
   subroutine fstack (iarg)
 
   integer i
   character iarg(FILENAMESIZE)
 
   include flist
 
   if (flevel < FLMAX)
     {
     flevel = flevel + 1
     for (i=1; i<=FILENAMESIZE; i=i+1)
         ffiles(i,flevel) = iarg(i)
    call fold(ffiles(1, flevel))
     }
   return
   end