#-h- cld              335 asc 12-oct-80 17:28:52
#----------------------------------------------------------------
 ## cld common block for 'ld' tool
 #  put on a file named 'cld'
 common / cld / verbos, debug, task(FILENAMESIZE)

 integer verbos		# if verbose taskbuild; init = NO
 integer debug		# if debugging aid to be included in task; init=NO
 character task		# task image name
#-h- flist            277 asc 12-oct-80 17:28:53
  #------------------------------------------------------
  # 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- ldnofp.r        4616 asc 12-oct-80 17:28:55
#-h- ldmain.q          43 asc 08-oct-80 09:21:54
# call initr4
# call ld
# call endr4
# end
#-h- lds.q           2876 asc 12-oct-80 17:28:45
	define(FLMAX,25)
	define(EXTSIZE,4)

#---------------------------------------------------------------------------

# subroutine ld
 subroutine main

 character arg(FILENAMESIZE), templ8(FILENAMESIZE),
	   scrat(FILENAMESIZE), rlib(FILENAMESIZE),
	   args(80), map(FILENAMESIZE)
 integer i, getarg, int, create, status, spawn, rlibdn, open, inp

 include cld
 include flist

 string tkb "tkb"
 string ext "tsk"
 string mapext "map"
 string debsw "/da,"
 string lib "/lb"
 string rlibst "rlib/lb"
 string mainst ":.main."
 string infile "tools.tkb"
 string imgsw "/-fp/cp"

 flevel = 0
 task(1) = EOS
 verbos = NO
 debug = NO
 rlibdn = NO

 for (i=1; getarg(i, arg, FILENAMESIZE) != EOF; i=i+1)
    {
    if (arg(1) == MINUS | arg(1) == PLUS | arg(1) == QMARK)
	call ldcmd(arg)
    else
	call fstack(arg)
    }

 if (task(1) == EOS)
    {
    for (i=1; i<=flevel; i=i+1)
	if (ffiles(1,i) != MINUS) break
    if (i <= flevel)
	call scopy(ffiles(1,i), 1, task, 1)
    }

 if (task(1) == EOS)
    call lderr
 call scratf(tkb, scrat)
 int = create(scrat, WRITE)
 if (int == ERR)
    call error("Error creating TKB command file.")
 call getdir(BINDIRECTORY, LOCAL, rlib)
 call concat(rlib, infile, templ8)
 call concat(rlib, rlibst, rlib)
 call genfil(task, ext, arg)
 call genfil(task, mapext, args)
 call mklocl(arg, task)
 call remove(task)		# delete most recent version of task image
 call putlin(task, int)
 call putlin(imgsw, int)
 if (debug == YES)
    {
    call mklocl(args, map)
    call remove(map)		# delete most recent version of map file
    call putlin(debsw, int)
    call putlin(map, int)
    }
 call putch(EQUALS, int)
 call putch(NEWLINE, int)
 for (i=1; i<=flevel; i=i+1)
    {
    if (ffiles(1,i) == MINUS)
	{
	if (ffiles(3,i) == EOS)		# desires rlib in odd place
	    {
	    call putlin(rlib, int)
	    call putch(NEWLINE, int)
	    rlibdn = YES
	    }
	else
	    {
	    call mklocl(ffiles(3,i), arg)
	    call putlin(arg, int)
	    call putlin(lib, int)
	    call putch(NEWLINE, int)
	    }
	}
    else
	{
	call mklocl(ffiles(1,i), arg)
	call putlin(arg, int)
	call putch(NEWLINE, int)
	}
    }
 call putlin(rlib, int)
 call putlin(mainst, int)
 call putch(NEWLINE, int)
 if (rlibdn == NO)
    {
    call putlin(rlib, int)
    call putch(NEWLINE, int)
    }
 inp = open(templ8, READ)
 if (inp == ERR)
    call error("Error opening tools.tkb template file.")
 call fcopy(inp, int)
 call close(inp)
 call close(int)
 i = 1
 call stcopy(tkb, 1, args, i)
 call chcopy(BLANK, args, i)
 call chcopy(ATSIGN, args, i)
 call scopy(scrat, 1, args, i)
 if (verbos ==  YES)
    {
    int = open(scrat, READ)
    if (int == ERR)
	call error("Error in opening TKB command file.")
    call fcopy(int, ERROUT)
    call close(int)
    }
 status = spawn("local", args, arg, WAIT)
 if (status == ERR)
    call remark("Error in spawning TKB.")
 call remove(scrat)
 
 return
 end
#-h- ldcmd.q          523 asc 08-oct-80 09:21:58
 subroutine ldcmd(arg)

 character arg(FILENAMESIZE)

 include cld

 if (arg(1) == MINUS & (arg(2) == LETP | arg(2) == BIGP))
    call scopy(arg, 3, task, 1)
 else if (arg(1) == QMARK & arg(2) == EOS)
    call lderr
 else if (arg(1) == MINUS & (arg(2) == LETL | arg(2) == BIGL))
    call fstack(arg)
 else if (arg(1) == MINUS & (arg(2) == LETV | arg(2) == BIGV))
    verbos = YES
 else if (arg(1) == MINUS & (arg(2) == LETD | arg(2) == BIGD))
    debug = YES
 else
    call remark('Ignoring invalid argument')
 return
 end
#-h- fstack.q         395 asc 08-oct-80 09:21:59
   #------------------------------------------------------------
   ## 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.q         380 asc 08-oct-80 09:22:00
#--------------------------------------------------------------------
##	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- lderr.q          105 asc 08-oct-80 09:22:01
 subroutine lderr

 call error("usage:  ld [-v] [-d] [-l[library]] [-pprocname] file ...")

 return
 end