%%s 5/5/347
%%d D 1.5 27-Sep-83 17:30:06 tools 5 4
%%c Added support for -x... loader flags in main and fccmd.  This permits
%%c site-dependent loader flags to be added without requiring modifications
%%c to the source for fc.
%%s 43/4/309
%%d D 1.4 31-Jul-83 09:52:02 tools 4 3
%%c When in verbose mode, the image pathname is displayed using the shorthand
%%c ./, ~/, ~usr/, and ~bin/.
%%s 10/6/303
%%d D 1.3 28-Jul-83 22:34:50 tools 3 2
%%c Made the following modifications to main:
%%c 
%%c 1. Removed call to impath and declared static path STD_PATH.
%%c 2. Removed trailing periods from quoted strings.
%%c 3. When in verbose mode, fc now shows the full local file spec from loccom
%%c    when displaying the command being executed.
%%s 27/16/282
%%d D 1.2 13-Dec-82 14:40:15 dpm 2 1
%%c Added a "-m" switch to force generation of a load map.  The "-d" option
%%c no longer forces a listing and link map, but instead forces the source
%%c to be left around ("-f").  This was done to better support the source-level
%%c debugging facilities in the V3.0 VMS debugger.
%%s 0/0/0
%%d D 1.1 27-Mar-82 14:58:50 v1.1 1 0
%%c Version 1.1 is the Spring 1982 Distribution of the LBL/Hughes release
%%c of the Software Tools Virtual Operating System software and documentation.
%%T
%%I 1
%%D 2
#-h- cfc              493  asc  25-mar-82 09:33:11  v1.1 (sw-tools v1.1)
 #----------------------------------------------------------
%%E 2
%%I 2
#-h- cfc              445  asc  10-nov-82 17:42:53  dpm (dave martin)
%%E 2
 ## cfc common block for 'fc' tool
%%D 2
 #  put on a file called 'cfc'
%%E 2
 
%%D 2
 common / cfc / load, verbos, list, errcnt, debug
%%E 2
%%I 2
 common / cfc / ldmap, load, verbos, list, errcnt, debug
%%E 2

%%I 2
 integer ldmap	# YES/NO for link map
%%E 2
 integer load	# YES/NO for link
 integer verbos	# YES/NO for verbose mutterings on terminal
 integer list	# YES/NO for listings of fortran compilations
 integer errcnt	# running count of errors in compilation -- load
		# not performed unless errcnt == 0
 integer debug	# YES/NO if -d switch seen; passed on to ld
#-h- flist            277  asc  25-mar-82 09:33:12  v1.1 (sw-tools v1.1)
  #------------------------------------------------------
  # 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
%%D 2
#-h- fc.r            5142  asc  25-mar-82 09:33:13  v1.1 (sw-tools v1.1)
%%E 2
%%I 2
%%D 3
#-h- fc.r            5237  asc  10-nov-82 17:49:35  dpm (dave martin)
%%E 3
%%E 2
%%I 3
%%D 4
#-h- fc.r            5315  asc  28-jul-83 22:33:01  tools (lblh csam sventek)
%%E 4
%%E 3
%%I 4
%%D 5
#-h- fc.r            6267  asc  31-jul-83 09:51:19  tools (lblh csam sventek)
%%E 5
%%E 4
%%I 5
#-h- fc.r            6299  asc  27-sep-83 16:49:02  tools (lblh csam sventek)
%%E 5
#-h- defns             37  asc  25-mar-82 09:32:51  v1.1 (sw-tools v1.1)
	define(EXTSIZE,4)
	define(FLMAX,25)
%%D 2
#-h- main            1990  asc  25-mar-82 09:32:52  v1.1 (sw-tools v1.1)
%%E 2
%%I 2
%%D 3
#-h- main            2082  asc  10-nov-82 17:42:43  dpm (dave martin)
%%E 3
%%E 2
%%I 3
%%D 4
#-h- main            2152  asc  28-jul-83 22:29:43  tools (lblh csam sventek)
%%E 4
%%E 3
%%I 4
%%D 5
#-h- main            2207  asc  31-jul-83 09:49:16  tools (lblh csam sventek)
%%E 5
%%E 4
%%I 5
#-h- main            2215  asc  27-sep-83 16:45:20  tools (lblh csam sventek)
%%E 5
 DRIVER(fc)

 character source(FILENAMESIZE), object(FILENAMESIZE), arg(FILENAMESIZE),
%%D 4
	   ext(EXTSIZE), listfl(FILENAMESIZE),
%%E 4
%%D 3
	   ldargs(ARGBUFSIZE), descr(PIDSIZE), spath(arith(FILENAMESIZE,*,3))
%%E 3
%%I 3
%%I 4
	   ext(EXTSIZE), listfl(FILENAMESIZE), ldfix(FILENAMESIZE),
%%E 4
	   ldargs(ARGBUFSIZE), descr(PIDSIZE)
%%E 3
 integer i, getarg, spawn, k, fortrn, loccom, index

 include flist
 include cfc
 
 string suffix IMAGE_SUFFIX
%%D 2
 string minusv "-v "
%%E 2
 string minusd "-d "
%%I 2
 string minusm "-m "
 string minusv "-v "
%%E 2
 string exto "obj"
 string extl "l"
 string ld "ld"
%%I 3
 string spath  STD_PATH
%%E 3

 flevel = 0
 load = YES
 verbos = NO		# initialize cfc and flist varibles
 list = NO
 debug = NO
%%I 2
 ldmap = NO
%%E 2
 errcnt = 0

%%D 2
 call query("usage:  fc [-cdov] [-l[libr]] [-pproc] file ...")
%%E 2
%%I 2
%%D 5
 call query("usage:  fc [-cdmov] [-l[libr]] [-pproc] file ...")
%%E 5
%%E 2
%%I 5
 call query("usage:  fc [-cdmov] [-l[libr]] [-pproc] [-x...] file ...")
%%E 5
 for (i=1; getarg(i, arg, FILENAMESIZE) != EOF; i=i+1)
    {
    if (arg(1) == '-' | arg(1) == '+')
	call fccmd(arg)
    else
	call fstack(arg)
    }

 for (k=1; k<=flevel; k=k+1)
    {
    call getext(ffiles(1,k), ext)
    if (ffiles(1,k) != '-' & ext(1) == 'f' & ext(2) == EOS)
	{
	if (index(ffiles(1,k), '/') > 0)
	    call mklocl(ffiles(1,k), source)
	else
	    call scopy(ffiles(1,k), 1, source, 1)
	call genfil(source, exto, object)
	if (list == YES)
	    call genfil(source, extl, listfl)
	else
	    listfl(1) = EOS
	if (fortrn(source, object, listfl, verbos, debug) == ERR)
	    errcnt = errcnt + 1
	}
    }


 if (load == YES & errcnt == 0)
    {
    i = 1
    call stcopy(ld, 1, ldargs, i)
    call chcopy(' ', ldargs, i)
    if (verbos == YES)
	call stcopy(minusv, 1, ldargs, i)
    if (debug == YES)
	call stcopy(minusd, 1, ldargs, i)
%%I 2
    if (ldmap == YES )
	call stcopy(minusm, 1, ldargs, i)
%%E 2
    for (k=1; k<=flevel; k=k+1)
	{
	call getext(ffiles(1,k), ext)
	if (ffiles(1,k) != '-' & ext(1) == 'f' & ext(2) == EOS)
	    call genfil(ffiles(1,k), exto, arg)
	else
	    call scopy(ffiles(1,k), 1, arg, 1)
	call stcopy(arg, 1, ldargs, i)
	call chcopy(' ', ldargs, i)
	}
    ldargs(i-1) = EOS
%%D 3
    call impath(spath)
%%E 3
    if (loccom(ld, spath, suffix, arg) != BINARY)
%%D 3
	call error("Cannot locate ld image file.")
%%E 3
%%I 3
	call error("Cannot locate ld image file")
%%E 3
    if (verbos == YES)
%%D 3
	call remark(ldargs)
%%E 3
%%I 3
        {
%%D 4
        call putlin(arg, ERROUT)
%%E 4
%%I 4
        call namfix(arg, ldfix)
        call putlin(ldfix, ERROUT)
%%E 4
        i = index(ldargs, ' ')
        call putlnl(ldargs(i), ERROUT)
        }
%%E 3
    if (spawn(arg, ldargs, descr, WAIT) == ERR)
	call remark("Error in linking process")
    }
 DRETURN
 end
%%D 2
#-h- fccmd            484  asc  25-mar-82 09:32:54  v1.1 (sw-tools v1.1)
%%E 2
%%I 2
%%D 5
#-h- fccmd            493  asc  10-nov-82 17:48:12  dpm (dave martin)
%%E 5
%%E 2
%%I 5
#-h- fccmd            509  asc  27-sep-83 16:45:20  tools (lblh csam sventek)
%%E 5
##	fccmd -- handles switches in fc command line
 subroutine fccmd(arg)

 character arg(FILENAMESIZE)
 integer index

 include cfc

 call fold(arg)
 if (arg(1) == '-')
%%D 5
    if (arg(2) == 'p' | arg(2) == 'l')
%%E 5
%%I 5
    if (arg(2) == 'p' | arg(2) == 'l' | arg(2) == 'x')
%%E 5
	call fstack(arg)
    else
	{
	if (index(arg, 'c') > 0)
	    load = NO
	if (index(arg, 'd') > 0)
	    debug = YES
%%I 2
	if (index(arg, 'm') > 0)
	    ldmap = YES
%%E 2
	if (index(arg, 'o') > 0)
	    list = YES
	if (index(arg, 'v') > 0)
	    verbos = YES
	}
 else
    call badarg(arg)
%%D 2
 if (debug == YES)
    list = YES
%%E 2

 return
 end
#-h- fortrn           876  asc  25-mar-82 09:32:55  v1.1 (sw-tools v1.1)
 integer function fortrn(source, object, list, verbos, debug)

 character source(ARB), object(ARB), list(ARB), arg(80), pid(PIDSIZE)
 integer spawn, i, verbos, debug, junk, remove

 string complr "for/noop/object="
 string nolist "/nolist"
 string listst "/list="
 string debugst "/check=all/debug=all"

 i = 1
 call stcopy(complr, 1, arg, i)
 junk = remove(object)		# delete most recent version of object file
 call stcopy(object, 1, arg, i)
 if (list(1) != EOS)
    {
    junk = remove(list)		# delete most recent version of list file
    call stcopy(listst, 1, arg, i)
    call stcopy(list, 1, arg, i)
    }
 else
    call stcopy(nolist, 1, arg, i)
 if (debug == YES)
    call stcopy(debugst, 1, arg, i)
 call chcopy(' ', arg, i)
 call scopy(source, 1, arg, i)
 call fold(arg)
 if (verbos == YES)
    call remark(arg)
 fortrn = spawn("local", arg, pid, WAIT)

 return
 end
#-h- fstack           330  asc  25-mar-82 09:32:56  v1.1 (sw-tools v1.1)
   ## 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
#-h- genfil           458  asc  25-mar-82 09:32:57  v1.1 (sw-tools v1.1)
##	genfil -- generates file name with extension ext from in

 subroutine genfil(in, ext, out)

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

 string trmchr "/]"

 for (i=length(in); i > 0; i=i-1)
    if (index(trmchr, in(i)) > 0)
	break
 for (j=i+1; in(j) != EOS; j=j+1)
    if (in(j) == '.')
	break
 for (i=1; i < j; i=i+1)
    out(i) = in(i)
 call chcopy('.', out, i)
 call scopy(ext, 1, out, i)

 return
 end
#-h- getext           456  asc  25-mar-82 09:32:58  v1.1 (sw-tools v1.1)
 subroutine getext(file, ext)

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

 string trmchr "/]"

 for (i=length(file); i > 0; i=i-1)
    if (index(trmchr, file(i)) > 0)
	break
 for (j=i+1; file(j) != EOS; j=j+1)
    if (file(j) == '.')
	{
	j = j + 1
	break
	}
 for (i=1; file(j) != EOS & file(j) != ';' & file(j) != '.'; i=i+1)
    {
    ext(i) = file(j)
    j = j + 1
    }
 ext(i) = EOS
 call fold(ext)

 return
 end
%%D 2
#-h- fc.fmt          1441  asc  25-mar-82 09:33:15  v1.1 (sw-tools v1.1)
%%E 2
%%I 2
%%I 4
#-h- namfix           819  asc  31-jul-83 09:49:17  tools (lblh csam sventek)
subroutine namfix(file, fixfil)

character file(FILENAMESIZE), fixfil(FILENAMESIZE)
integer i, n
integer indexs, length

for (i = 1; i <= 5; i = i + 1)
   {
   switch (i)
      {
      case 1: call gwdir(fixfil, LOCAL)
      case 2: call tooldr(fixfil, LOCAL)
      case 3: call getdir(USRDIRECTORY, LOCAL, fixfil)
      case 4: call getdir(BINDIRECTORY, LOCAL, fixfil)
      case 5: fixfil(1) = EOS
      }
   if (i == 5)
      break
   if (indexs(file, fixfil) == 1)
      break
   }
n = length(fixfil) + 1
switch (i)
   {
   case 1: call strcpy("./", fixfil)
ifdef(TREE_STRUCT_FILE_SYS)
   case 2: call strcpy("~/tools/", fixfil)
elsedef
   case 2: call strcpy("~/", fixfil)
enddef
   case 3: call strcpy("~usr/", fixfil)
   case 4: call strcpy("~bin/", fixfil)
   }
call concat(fixfil, file(n), fixfil)

return
end
%%E 4
#-h- fc.fmt          1515  asc  13-dec-82 14:09:10  dpm (dave martin)
%%E 2
.so ~bin/manhdr
%%D 2
.hd Fc (1) 12-Aug-81
%%E 2
%%I 2
.hd Fc (1) 13-Dec-82
%%E 2
fortran compiler
.sy
%%D 2
fc [-cdov] file ...
%%E 2
%%I 2
fc [-cdmov] file ...
%%E 2
.ds
fc is the fortran compiler callable from the software tools shell.  It accepts
the following types of arguments:

.in +3
.ti -3
1. Files whose names end in '.f' are assumed to be fortran source programs.   
They are compiled, and the object file is left on a file whose name is
that of the source with '.obj' substituted for '.f'.

.ti -3
2. Other arguments (except for the flags listed in 3 below) are assumed to
be either loader flags, or object files, typically created by an earlier
fc
run.  These programs, together with the results of any compilations, are
loaded (in the order given) to produce an executable program.

.ti -3
%%D 2
3. Four flags which affect the actions of the compiler are:
%%E 2
%%I 2
3. The flags which affect the actions of the compiler are:
%%E 2

.in +3
.ti -3
-c
suppress the loading phase, as does any compilation error in any routine
%%I 2

%%E 2
.ti -3
-d do whatever is necessary to prepare the object files for the
system-specific debugger.  This flag is passed on to `ld' if the -c
switch is not specified.
%%I 2

%%E 2
.ti -3
%%I 2
-m
passed on to `ld' to cause a load map to be produced.

.ti -3
%%E 2
-o
generates a fortran listing for 'file.f' on 'file.l'
%%I 2

%%E 2
.ti -3
-v
%%D 2
verbose option; prints name of file as it is compiled at the terminal
%%E 2
%%I 2
verbose option; prints additional information about the compilation
process
%%E 2
.in -3
.in -3
.sa

rc, the ratfor compiler, which provides a more pleasant programming dialect and
environment

ld, the loader, for descriptions of loader flags and process naming conventions

.au
Joe Sventek wrote the interface of fc to the DEC ForTran compiler.
.bu
%%E 1