# # # # SRD command line generator # ========================== # # Author: William Wood # # Address: Computer Center # Institute For Cancer Research # 7701 Burholme Ave. # Philadelphia, Pa. 19111 # (215) 728 2760 # # Version: 1.0 # # Date: May 14, 1981 # # # # ******************************************************* # * * # * THIS SOFTWARE WAS DEVELOPED WITH SUPPORT * # * FROM THE NATIONAL INSTITUTES OF HEALTH: * # * NIH CA06927 * # * NIH CA22780 * # * * # * DIRECT INQUIRIES TO: * # * COMPUTER CENTER * # * THE INSTITUTE FOR CANCER RESEARCH * # * 7701 BURHOLME AVENUE * # * PHILADELPHIA, PENNSYLVANIA 19111 * # * * # * NO WARRANTY OR REPRESENTATION, EXPRESS OR * # * IMPLIED, IS MADE WITH RESPECT TO THE * # * CORRECTNESS, COMPLETENESS, OR USEFULNESS * # * OF THIS SOFTWARE, NOR THAT USE OF THIS * # * SOFTWARE MIGHT NOT INFRINGE PRIVATELY * # * OWNED RIGHTS. * # * * # * NO LIABILITY IS ASSUMED WITH RESPECT TO * # * THE USE OF, OR FOR DAMAGES RESULTING FROM * # * THE USE OF THIS SOFTWARE * # * * # ******************************************************* # * * # * THIS SOFTWARE WAS DESIGNED FOR USE ON A * # * PDP-11/70 OPERATING UNDER IAS V3.0 USING * # * THE FORTRAN-IV PLUS COMPILER. * # * * # ******************************************************* # include symbols.rat byte file(MAXLINE), outbuf(MAXLINE), outtxt(MAXLINE), filenv(MAXLINE), ans(2) byte node(NODESIZE), dev(DEVSIZE), uic(UICSIZE), name(NAMESIZE), ext(EXTSIZE) integer equal, bkscan, concat, nf, i, j, fout, is, ier, k byte cupper logical getfil, prompt data node(1), dev(1), uic(1), name(1), ext(1) /5*EOS/ fout = TERM % open(unit=fout, name='TI:', carriagecontrol='LIST') % call errset(29,.true.,.false.,.true.,.false.,15) # no such file call errset(30,.true.,.false.,.true.,.false.,15) # open failure call errset(43,.true.,.false.,.false.,.false.,15) # file name specification repeat { close(unit=FILEOUT) fout = TERM call gcmd(TERM, 'SRDCMD> ', outtxt, nc, MAXLINE, is) if (nc <= 0) break ans(1) = EOS prompt = .false. repeat { call parse(outtxt, file) if (equal(file, '/PR') == YES) prompt = .true. else if (equal(file, '/GO') == YES) { prompt = .true. ans(1) = 'G' } else break } nf = 0 while (getfil(file, ans, nf, prompt)) { node(1) = EOS; dev(1) = EOS; uic(1) = EOS; name(1) = EOS; ext(1) = EOS call defnam(file, node, dev, uic, name, ext, .true.) call scopy(file, 1, filenv, 1) filenv(bkscan(filenv, ';', 1)) = EOS j = 1 for (i = 1; outtxt(i) != EOS & j < MAXLINE; i = i+1) if (outtxt(i) == '>') { k = i i = i+1 if (outtxt(i) == '>') { i = i+1 if (outtxt(i) == EOS) goto 10 call defnam(outtxt(i), EOS, 'SY:', EOS, EOS, '.CMD', .false.) open(unit=FILEOUT, name=outtxt(i), type='unknown', access='append',carriagecontrol='list',err=10) } else { if (outtxt(i) == EOS) goto 10 call defnam(outtxt(i), EOS, 'SY:', EOS, EOS, '.CMD', .false.) open(unit=FILEOUT, name=outtxt(i), type='new', carriagecontrol='list', err=10) } fout = FILEOUT outtxt(k) = EOS break } else if (outtxt(i) != '''') { outbuf(j) = outtxt(i) j = j+1 } else { i = i+1 outbuf(j) = EOS if (outtxt(i) == EOS) break else if (outtxt(i) == '&') j = concat(outbuf, filenv, MAXLINE) + 1 else if (cupper(outtxt(i)) == 'D') j = concat(outbuf, dev, MAXLINE) + 1 else if (cupper(outtxt(i)) == 'U') j = concat(outbuf, uic, MAXLINE) + 1 else if (cupper(outtxt(i)) == 'N') j = concat(outbuf, name, MAXLINE) + 1 else if (cupper(outtxt(i)) == 'E') j = concat(outbuf, ext, MAXLINE) + 1 else if (cupper(outtxt(i)) == 'V') j = concat(outbuf, file(bkscan(file, ';', 1)), MAXLINE) + 1 else { outbuf(j) = outtxt(i) j = j+1 } } call put(fout, outbuf, j-1, ier) } next 10 continue call err(outtxt, i, "Can't open file.") } until (is < 0) # command was from MCR end # bkscan - return index of first break char in str integer function bkscan(str, brk, i) character str(ARB), brk(ARB) integer index, i for (bkscan = i; str(bkscan) != EOS; bkscan = bkscan+1) if (index(brk, str(bkscan)) != 0) break return end # scan - return index of first char in str which isn't in scstr integer function scan(str, scstr, i) character str(ARB), scstr(ARB) integer index, i for (scan = i; str(scan) != EOS; scan = scan+1) if (index(scstr, str(scan)) == 0) break return end # index - find character c in string str integer function index(str, c) character c, str(ARB) for (index = 1; str(index) != EOS; index = index + 1) if (str(index) == c) return index = 0 return end # concat - concatenate two strings integer function concat(s1,s2,lim) character s1(ARB),s2(ARB) integer lim, i, length, l l = length(s1) for (i=l+1; i integer->character for (length = 0; str(length+1) != EOS; length = length + 1) ; return end # cupper - change letter to upper case character function cupper (c) character c if (c >= 'a' & C <= 'z') cupper = c - 'a' + 'A' else cupper = c return end # equal - compare str1 to str2; return YES if equal, NO if not integer function equal(str1, str2) character str1(ARB), str2(ARB) integer i for (i = 1; str1(i) == str2(i); i = i + 1) if (str1(i) == EOS) { equal = YES return } equal = NO return end # scopy - copy string at from(i) to to(j) subroutine scopy(from, i, to, j) character from(ARB), to(ARB) integer i, j, k1, k2 k2 = j for (k1 = i; from(k1) != EOS; k1 = k1 + 1) { to(k2) = from(k1) k2 = k2 + 1 } to(k2) = EOS return end # defnam - provide defaults for file name, reset new defaults subroutine defnam(file, node, dev, uic, name, ext, reset) byte file(FILENAMESIZE) byte node(NODESIZE), dev(DEVSIZE), uic(UICSIZE), name(NAMESIZE), ext(EXTSIZE) byte temp(FILENAMESIZE) logical reset integer l, j integer index, bkscan, concat, scan temp(1) = EOS j = concat(temp, file(scan(file, ' ', 1)), FILENAMESIZE) file(1) = EOS j = 1 l = 0 call adstr(index(temp(j), ':'), j, l, file, temp, dev, DEVSIZE-1, reset) call adstr(index(temp(j), ']'), j, l, file, temp, uic, UICSIZE-1, reset) call adstr(bkscan(temp, ' .;', j) - j, j, l, file, temp, name, NAMESIZE-1, reset) call adstr(bkscan(temp, ' ;', j) - j, j, l, file, temp, ext, EXTSIZE-1, reset) l = concat(file, temp(j), FILENAMESIZE) # append possible version return end # adstr - support routine for defnam subroutine adstr(i, j, l, file, tfile, str, mxstr, reset) integer i, j, l, mxstr, k integer concat, scan byte file(1), tfile(1), str(1) logical reset if (i == 0) l = concat(file, str, FILENAMESIZE) else { k = min0(mxstr, i) l = concat(file, tfile(j), l+1+k) j = scan(tfile, ' ', j+i) if (reset) call scopy(file, l+1-k, str, 1) } return end