#-h- shcbl 4971 asc 19-jun-80 17:49:35 #-h- shsym 1096 asc 19-jun-80 17:49:10 # definitions for shell # put on a file named 'shsym' # Used only by the shell define(TSIZE,4) define(MAXSHLINE,MAXLINE) #maximum command line length define(SHELL,17) #flag for shell command define(IBPTR,1) #array index for token pointers define(TMARK,2) #array index for token marks define(NODEPTR,3) #array index for node pointers define(ESCAN,4) #array index for end of scan define(MAXTOK,132) #max token size define(TREESIZE,200) #max size of tree define(ROOT,-1) #flag for beginning of tree define(PARENT,1) define(NTYPE,2) define(LCHILD,3) define(RCHILD,4) define(REDIN,5) define(REDOUT,6) define(REDERR,7) define(NENT,8) define(CMD,9) define(ARGUMENT,10) define(COM,LETC) define(SSYNTAX,0) define(SSYN1,1) define(SSYN2,2) define(SSYN3,3) define(MAXSTACK,20) define(PIPE,BAR) define(SEPCHAR,SEMICOL) # character to separate commands on line define(SCRIPT,2) define(OWNER,-1) #flag for receiving message from parent define(BUFSIZE,MAXLINE) define(MAXPATHSIZE,80) # maximum size of search path #-h- stdsub 1471 asc 19-jun-80 09:25:38 # /stdsub/ - common block holding file info for shell # put on a file named 'stdsub' # Used only by the shell common /stdsub/ in, cin(MAXSTACK), out, cout(MAXSTACK), er, cerr(MAXSTACK), aout(MAXSTACK), script, pctr, pfiles(FILENAMESIZE,MAXSTACK), hfile(FILENAMESIZE), input(FILENAMESIZE), output(FILENAMESIZE), error(FILENAMESIZE), sh(FILENAMESIZE), spath(MAXPATHSIZE) integer in #input stack count integer cin #input substitution stack integer out #output stack count integer cout #output stack integer er #errout stack count integer cerr #errout stack integer aout #append flag integer script #flag showing if script file being processed integer pctr #running pipe count character pfiles #names of pipe files character hfile #names of heredocument files character input #holds name of standard input file for script #init input(1) = EOS character output #holds name of standard output file for script #init output(1) = EOS character error #holds name of standard error file for script; #init error(1) = EOS character sh # holds name of shell for script and background character spath # search path for loccom calls - initialized by initsh #-h- cpars 537 asc 19-jun-80 09:25:41 # /cpars/ - holds token and tree info for shell # put on a file called 'cpars' # Used only by the shell common /cpars/ ibuf(MAXLINE), tkbuf(TSIZE, MAXTOK), tree(TREESIZE), stack(MAXSTACK), treend, pp character ibuf #input buffer integer tkbuf #token table for parsing integer tree #parse tree integer stack #push down stack for tokens integer treend #next available tree node; init by parse integer pp #push down counter; init by parse #-h- shflag 761 asc 19-jun-80 09:25:43 # shflag - common block to hold shell flags # put on a file called 'shflag' # Used only by the shell common /shflag/ exec, prlin, prcom, carg, drop, shin, clin(MAXLINE) integer exec #flag to cause/suppress command execution #init = YES integer prlin #flag to cause printing of lines as read #init = NO integer prcom #flag to cause printing of command as executed #init = NO integer carg #flag to cause execution of shell command line as input #init = NO integer drop # flag to cause drop through to native CLI upon search # error - init = YES integer shin #file identifier for shell input (generally STDIN) character clin #buffer to hold shell arg to be used as input #-h- shcmd 533 asc 19-jun-80 09:25:45 ## shcmd - common block holding shell commands # Put on a file called 'shcmd' # Used only by the shell common /shcmd/ logout(7), cd(3), home(5), von(4), voff(5), xon(4), xoff(5) character logout #logout (same as end-of-file) character cd # change working directory - cd character home # change working directory to home directory character von # equivalent to -v in command line character voff # turns off von character xon # equivalent to -x in command line character xoff # turns off xon #-h- cdefio 279 asc 19-jun-80 09:25:47 ## preprocessor common block to hold input characters # Put on a file called 'cdefio' # Used by ratfor preprocessor, macro, form, and shell tools common /cdefio/ bp, buf(BUFSIZE) integer bp # next available character; init = 0 character buf # pushed-back characters #-h- main 311 asc 07-may-80 12:32:34 #--------------------------------------------------------------------- # include symbol definitions # include symbols include shsym #--------------------------------------------------------------------- ## main - main program for DEH shell # call initsh # call sh # call endsh # end #-h- shs 562 asc 07-may-80 12:32:35 ## sh - driver subroutine for DEH shell # subroutine sh subroutine main character line(MAXSHLINE) integer parser, shline call initsh repeat { if (shline(line) == EOF) break if (line(1) == NEWLINE | line(1) == SHARP) next if (line(1) == QMARK & line(2) == NEWLINE) { call remark("Type intro for an introduction to the tools.") next } if (parser(line) == ERR) call remark ('syntax error.') else call execut } call endsh return end #-h- atbeg 414 asc 07-may-80 12:32:36 ## atbeg - return YES if at beginning of new shell token integer function atbeg(c) character c integer spec if (spec(c) == YES | #special shell character c == LESS | c == GREATER | c == QMARK | #redirected IO c == BLANK | c == TAB | #arg separator c == SQUOTE | c == DQUOTE) #new quoted string atbeg = YES else atbeg = NO return end #-h- arglin 587 asc 07-may-80 12:32:38 ## arglin - pick up all arguments starting with i subroutine arglin (buf, i) character buf(ARB), line(MAXLINE) integer i, k, m integer getarg k = 1 for (j=i; getarg(j, line, MAXLINE) != EOF; j=j+1) { if (line(1) == ESCAPE & (line(2) == LESS | line(2) == GREATER | line(2) == QMARK)) m = 2 else m = 1 call scopy(line, m, buf, k) k = length(buf) + 2 buf(k-1) = BLANK } if (k > 1) k = k - 1 #delete last blank buf(k) = NEWLINE buf(k+1) = EOS return end #-h- cmdtyp 489 asc 13-may-80 12:17:00 ## cmdtyp - check command and prepare for appropriate fetching integer function cmdtyp (comand, path) character comand(ARB), path(ARB) integer equal, shcom integer loccom include stdsub string local "local" string execut "x" call scopy(comand, 1, path, 1) if (shcom(comand) == YES) cmdtyp = SHELL else if (equal(comand, execut) == YES) { call scopy(local, 1, path, 1) cmdtyp = BINARY } else cmdtyp = loccom(comand, spath, path) return end #-h- doampr 706 asc 20-aug-80 09:49:48 ## doampr - process ampersand node of parse tree subroutine doampr (node, dir) integer node, dir, i integer spawn, getcl character desc(PIDSIZE) include stdsub include cpars include shflag string first "sh -c " if (dir == RCHILD | dir == PARENT) return i = 1 call stcopy(first, 1, clin, i) if (getcl(node, dir, clin(i)) == ERR) return if (prcom == YES) #user wishes to see command call dspcom(sh, clin) if (exec == YES) #execute command { if (spawn(sh, clin, desc, BACKGR) == ERR) call remark ('Cannot spawn background process.') else call remark (desc) } return end #-h- doverb 1889 asc 07-may-80 12:32:43 ## doverb - handle final command syntax integer function doverb (p1,p2) character tok, gtokn integer p, p1, p2, p3, i, node integer mktree, setree, gibptr, gpnode tok = gtokn(p1) #check token if (tok == LESS | tok == GREATER | tok == QMARK) { call stxerr ('doverb--command must preceed redirected IO.') doverb = ERR return } nargs = p2 - p1 -1 if (mktree(gpnode(p1), COM, 9+nargs, node) == ERR) #make tree entry { doverb = ERR return } i = 0 #enter pointers for (p=p1; p 0) ) { in = in + 1 cin(in) = tree(node+REDIN) #flag substitution by setting to negative tree(node+REDIN) = -tree(node+REDIN) } } if (tree(node+REDOUT) != 0) { if (out == 0 | #output substitution (out != 0 & cout(out) > 0)) { out = out + 1 cout(out) = tree(node+REDOUT) #flag substitution tree(node+REDOUT) = -tree(node+REDOUT) } } if (tree(node+REDERR) != 0) { er = er + 1 cerr(er ) = tree(node+REDERR) #flag substitution tree(node+REDERR) = -tree(node+REDERR) } } else { if (tree(node+REDIN) < 0) { in = in - 1 tree(node+REDIN) = abs(tree(node+REDIN)) } if (tree(node+REDOUT) < 0) { out = out - 1 tree(node+REDOUT) = abs(tree(node+REDOUT)) } if (tree(node+REDERR) < 0) { er = er - 1 tree(node+REDERR) = abs(tree(node+REDERR)) } } return end #-h- dopipe 477 asc 07-may-80 12:32:53 ## dopipe - process pipe node of parse tree subroutine dopipe (node, dir) integer node, dir include stdsub if (dir == LCHILD) { pctr = pctr + 1 pfiles(1,pctr) = EOS out = out + 1 cout(out) = -pctr aout(out) = 0 } else if (dir == RCHILD) { in = in + 1 cin(in) = cout(out) out = out - 1 } else { pctr = pctr - 1 in = in - 1 } return end #-h- dosemi 345 asc 07-may-80 12:32:54 ## dosemi - process semicolon node of parse tree subroutine dosemi (node, dir) integer node, dir include stdsub if (dir == RCHILD) { if (out > 0) aout(out) = aout(out) + 1 } else if (dir == PARENT) { if (out > 0) aout(out) = aout(out) - 1 } return end #-h- endsh 82 asc 07-may-80 12:32:55 ## endsh - terminate execution of the shell subroutine endsh call endr4 end #-h- errf 1016 asc 07-may-80 12:32:56 ## errf - pick up errout file substitution for command integer function errf (node, buf) integer node integer pickup integer junk character buf(ARB) include cpars include stdsub buf(1) = EOS errf = ERR if (er == 0 & pickup(buf,node,REDERR,junk) != ERR) errf = OK else if (er > 0 & cerr(er) > 0) #check for parens { ### Er may not be properly set if (aout(out) != 0) #append { buf(1) = QMARK i = 2 } else i = 1 call scopy (ibuf(cerr(er)), 1, buf, i) errf = OK } else if (script == YES & error(1) != EOS) { if (error(2) != QMARK) { buf(1) = QMARK #append on all but first call scopy(error, 1, buf, 2) call scopy(buf, 1, error, 1) } else call scopy(error, 1, buf, 1) errf = OK } return end #-h- execut 1031 asc 07-may-80 12:32:58 ## execut - process shell parse tree subroutine execut integer node, type, dir integer mvnext, dosemi, doampr, dopipe, doparn, docom include stdsub in = 0 #initialize file substitution stacks out = 0 er = 0 pctr = 0 hfile(1) = EOS for (i=1; i<=MAXSTACK; i=i+1) pfiles(1,i) = EOS node = ROOT while (mvnext(node, type, dir) != ROOT) #move thru tree { if (type == SEPCHAR) call dosemi (node, dir) else if (type == AMPER) call doampr (node, dir) else if (type == PIPE) call dopipe (node, dir) else if (type == PAR) call doparn (node, dir) else if (type == COM) call docom (node, dir) else call remark ('execut - invalid parse tree.') } for (i=1; i<=MAXSTACK; i=i+1) #remove scratch files if (pfiles(1,i) != EOS) call remove(pfiles(1,i)) if (hfile(1) != EOS) call remove (hfile) return end #-h- gescan 147 asc 07-may-80 12:33:00 ## gescan - get end of scan pointer for pth node integer function gescan(p) integer p include cpars gescan = tkbuf(ESCAN,p) return end #-h- gibptr 145 asc 07-may-80 12:33:01 ## gibptr - get pointer to ibuf for pth token integer function gibptr (p) integer p include cpars gibptr = tkbuf(IBPTR,p) return end #-h- gmark 136 asc 07-may-80 12:33:02 ## gmark - get syntax mark of pth token integer function gmark (p) integer p include cpars gmark = tkbuf(TMARK,p) return end #-h- gpname 400 asc 07-may-80 12:33:04 ## gpname - make unique pipe name for file id n subroutine gpname(n, name) character name(ARB) integer itoc, length integer i, junk, n character pipef(5) include stdsub if (pfiles(1,n) == EOS) #get name for pipe { pipef(1) = LETP junk = itoc(n, pipef(2), 3) call scratf(pipef, pfiles(1,n)) } call scopy(pfiles(1,n), 1, name, 1) return end #-h- gpnode 142 asc 07-may-80 12:33:05 ## gpnode - get parent node of pth token integer function gpnode (p) integer p include cpars gpnode = tkbuf(NODEPTR,p) return end #-h- gtokn 149 asc 07-may-80 12:33:06 ## gtokn - get first character of pth token character function gtokn (p) integer p include cpars gtokn = ibuf(tkbuf(IBPTR,p)) return end #-h- herdoc 656 asc 07-may-80 12:33:07 ## herdoc - generate 'here document' for shell subroutine herdoc(char, buf) character char, buf(ARB), line(MAXLINE), doc(4) integer create, getlin integer int include stdsub include shflag data doc(1), doc(2), doc(3), doc(4) /LETD, LETO, LETC, EOS/ buf(1) = LESS call scratf(doc, buf(2)) int = create(buf(2), WRITE) if (int == ERR) { call remark ("can't open 'here document'.") buf(1) = EOS return } call scopy(buf, 2, hfile, 1) while(getlin(line, shin) != EOF) { if (line(1) == char) break call putlin(line, int) } call close(int) return end #-h- inf 786 asc 07-may-80 12:33:09 ## inf - pick up input substitution for command integer function inf(node, buf) integer node integer pickup character buf(ARB), char include stdsub include cpars buf(1) = EOS if (in > 0 & cin(in) < 0) #receive input from pipe { buf(1) = LESS call gpname (abs(cin(in)), buf(2)) } else if (pickup(buf,node, REDIN,junk) == ERR & in > 0) call scopy (ibuf(cin(in)), 1, buf, 1) else if (script == YES & input(1) != EOS) { buf(1) = LESS call scopy(input, 1, buf, 2) } if (buf(1) == LESS & buf(2) == LESS) #check for 'here document' { char = buf(3) call herdoc (char, buf) } if (buf(1) != EOS) inf = OK else inf = ERR return end #-h- initsh 2977 asc 10-oct-80 20:55:43 ## initsh - initialize shell subroutine initsh integer getarg, assign, i, open, loccom, length include shflag include shcmd include stdsub include cdefio data logout(1), logout(2), logout(3), logout(4), logout(5), logout(6), logout(7) /LETL, LETO, LETG, LETO, LETU, LETT, EOS/ data cd/LETC, LETD, EOS/ data home/LETH, LETO, LETM, LETE, EOS/ data von/LETV, LETO, LETN, EOS/ data voff/LETV, LETO, LETF, LETF, EOS/ data xon/LETX, LETO, LETN, EOS/ data xoff/LETX, LETO, LETF, LETF, EOS/ data input(1) /EOS/ data output(1) /EOS/ data error(1) /EOS/ data sh(1), sh(2), sh(3)/LETS, LETH, EOS/ # initialize push-back buffer data bp /0/ # initialize standard input file data shin /STDIN/ # call initr4 prlin = NO exec = YES prcom = NO carg = NO drop = YES script = NO # initialize search path # search path is :~home:~usr:~bin spath(1) = EOS # current working directory first i = 2 call mailid(clin, spath(i)) # user's home director second i = i + length(spath(i)) + 1 call getdir(USRDIRECTORY, LOCAL, spath(i)) # usr directory third i = i + length(spath(i)) + 1 call getdir(BINDIRECTORY, LOCAL, spath(i)) # bin directory fourth i = i + length(spath(i)) + 1 spath(i) = NEWLINE # NEWLINE signals end of path spath(i+1) = EOS if (loccom(sh, spath, sh) != BINARY) { call remark("Cannot locate shell.") call endsh } call enbint # enable kil interrupt handling for (i=1; getarg(i, clin, MAXLINE) != EOF; i=i+1) { if (i == 1 & clin(1) == MINUS) #shell flag { if (clin(2) == LETV | clin(2) == BIGV) prlin = YES else if (clin(2) == LETN | clin(2) == BIGN) exec = NO else if (clin(2) == LETX | clin(2) == BIGX) prcom = YES else if (clin(2) == LETC | clin(2) == BIGC) carg = YES else if (clin(2) == LETD | clin(2) == BIGD) drop = NO call delarg(i) i = i - 1 } else if (carg == YES) { call arglin(clin, i) break } else if (i == 1) { if (loccom(clin, spath, clin) != ASCII) call cant(clin) shin = open(clin, READ) if (shin == ERR) call cant(clin) script = YES } else if (clin(1) == ESCAPE) { if (clin(2) == LESS) call scopy(clin, 3, input, 1) else if (clin(2) == GREATER) call scopy(clin, 3, output, 1) else if (clin(2) == QMARK) call scopy(clin, 3, error, 1) else next call delarg (i) i = i - 1 } } return end #-h- mktoks 1195 asc 07-may-80 12:33:13 ## mktoks - create parse tables for shell parser integer function mktoks (line, k) integer length integer i, paren character line(ARB) integer shtok integer k, l include cpars include cdefio paren = 0 i = 1 call putbak (EOS) #initialize buffer call pbstr (line) for (k=1; shtok(ibuf(i)) != EOS; k=k+1) { if (ibuf(i) != EOS) { tkbuf(IBPTR,k) = i tkbuf(TMARK,k) = 0 tkbuf(NODEPTR,k) = 0 tkbuf(ESCAN,k) = 0 if (ibuf(i) == LPAREN) paren = paren + 1 else if (ibuf(i) == RPAREN) paren = paren - 1 l = i + length(ibuf(i)) - 1 if ((ibuf(i) == SQUOTE | ibuf(i) == DQUOTE) & ibuf(l) != ibuf(i)) { call remark('unbalanced quotes.') mktoks = ERR return } i = l + 2 } } k = k - 1 ibuf(i) = EOS if (paren != 0) mktoks = ERR else mktoks = OK return end #-h- mktree 942 asc 07-may-80 12:33:15 ## mktree - create child node for given parent integer function mktree (pnode, type, size, cnode) integer pnode, type, size, cnode, i include cpars cnode = treend treend = treend + size #next available space if (treend >TREESIZE) { call stxerr ('mktree - tree buffer size exceeded.') cnode = ERR mktree = ERR return } for (i=1; i<=size; i=i+1) #clear entries tree(cnode+i) = 0 tree(cnode+PARENT) = pnode tree(cnode+NTYPE) = type if (pnode >= 0) #install back pointer { if (tree(pnode+LCHILD) == 0) tree(pnode+LCHILD) = cnode else if (tree(pnode+RCHILD) == 0) tree(pnode+RCHILD) = cnode else { call stxerr ('mktree--too many children.') mktree = ERR return } } mktree = cnode return end #-h- mvnext 430 asc 07-may-80 12:33:17 ## mvnext - move to next node in parse tree integer function mvnext (node, type, dir) integer node, dir, type integer nxtbr include cpars if (node == ROOT) #just starting { mvnext = 0 dir = LCHILD } else mvnext = tree(node+dir) if (mvnext != ROOT) { type = tree(mvnext+NTYPE) dir = nxtbr(mvnext, node) } node = mvnext return end #-h- nextp 230 asc 07-may-80 12:33:18 ## nextp - get next pointer from pushdown stack integer function nextp (p) integer p include cpars if (pp == 0) p = EOS else { p = stack(pp) pp = pp - 1 } nextp = p return end #-h- nxtbr 498 asc 07-may-80 12:33:20 ## nxtbr - determine next direction for moving in parse tree integer function nxtbr (node, lnode) integer node, lnode include cpars if (lnode == tree(node+PARENT)) #going down { if (tree(node+LCHILD) != 0) nxtbr = LCHILD else nxtbr = PARENT } else if (lnode == tree(node+LCHILD) & #going up tree(node+RCHILD) != 0) nxtbr = RCHILD else nxtbr = PARENT return end #-h- outf 1215 asc 07-may-80 12:33:21 ## outf - pick up output file substitution for command integer function outf (node, buf) integer node integer pickup integer junk character buf(ARB) include cpars include stdsub buf(1) = EOS outf = ERR if (out == 0 & pickup(buf,node,REDOUT,junk) != ERR) outf = OK else if (out > 0) #check for pipes and parens { if (aout(out) != 0) #append { buf(1) = GREATER i = 2 } else i = 1 if (cout(out) > 0) #use paren substitution call scopy (ibuf(cout(out)), 1, buf, i) else #pipe { buf(i) = GREATER call gpname(abs(cout(out)), buf(i+1)) } outf = OK } else if (script == YES & output(1) != EOS) { if (output(2) != GREATER) { buf(1) = GREATER #append on all but first call scopy(output, 1, buf, 2) call scopy(buf, 1, output, 1) } else call scopy(output, 1, buf, 1) outf = OK } return end #-h- param 639 asc 07-may-80 12:33:23 ## param - handle parameter substitution for the shell integer function param(c) character c, num(2), ngetch, tbuf(MAXLINE) integer getarg, ctoi, i, junk include shflag if (c == DOLLAR) #handle param substitution { num(1) = ngetch(num(1), shin) num(2) = EOS i = 1 n = ctoi(num,i) if (n > 0) { if (getarg(n+1, tbuf, MAXLINE) != EOF) call pbstr(tbuf) c = ngetch(c, shin) } else c = num(1) param = YES } else param = NO return end #-h- parser 1625 asc 07-may-80 12:33:25 ## parser - parse shell command line # syntax : empty # | syn1 # syn1 : syn2 # | syn2 & syntax # | syn2 ; syntax # syn2 : syn3 # | syn3 | syn2 # syn3 : (syn1) [out] [?errout] # | tok tok* [out] [?errout] integer function parser (line) integer p, p1, p2, mark integer syntax, syn1, syn2, syn3 integer mktoks, nextp, gmark, gescan character line(ARB) include cpars include shflag treend = 0 #initialize tree pointer pp = 0 #initialize stack pointer for (i=1; i<=TSIZE; i=i+1) #initialize token table for (j=1; j<=MAXTOK; j=j+1) tkbuf(i,j) = 0 for (i=1; i<=TREESIZE; i=i+1) #initialize parse tree tree(i) = 0 for (i=1; i<=MAXLINE; i=i+1) #initialize input buffer ibuf(i) = EOS if (mktoks(line,p2) == ERR) { parser = ERR return } call setokn (TMARK, 1, SSYNTAX) #set root syntax call setokn (NODEPTR, 1, -1) call setokn (ESCAN, 1, p2) call putbac (1) while (nextp(p1) != EOS) #generate parse tree { mark = gmark(p1) p2 = gescan(p1) if (mark == SSYNTAX) parser = syntax(p1, p2) else if (mark == SSYN1) parser = syn1(p1, p2) else if (mark == SSYN2) parser = syn2(p1,p2) else if (mark == SSYN3) parser = syn3(p1,p2) if (parser == ERR) return } parser = OK return end #-h- pastbl 210 asc 07-may-80 12:33:28 ## pastbl - read past blanks and tabs on input subroutine pastbl (c) character c character ngetch include shflag for (c=ngetch(c, shin); c == BLANK | c == TAB; c=ngetch(c, shin)) ; return end #-h- pickup 721 asc 07-may-80 12:33:29 ## pickup - pick up character string from parse tree integer function pickup (array, node, field, arg) integer node, field, arg character array(ARB) include cpars array(1) = EOS pickup = OK if ( (field == REDIN | field == REDOUT | field == REDERR) & (tree(node+NTYPE) == COM | tree(node+NTYPE) == PAR) & tree(node+field) != 0 ) call scopy (ibuf(tree(node+field)), 1, array, 1) else if (field == CMD & tree(node+NTYPE) == COM) call scopy(ibuf(tree(node+CMD)), 1, array, 1) else if (field == ARGUMENT & tree(node+NTYPE) == COM & arg <= tree(node+NENT) ) call scopy (ibuf(tree(node+CMD+arg)),1,array,1) else pickup = ERR return end #-h- putbac 224 asc 07-may-80 12:33:31 ## putbac - put pointer on pushdown stack subroutine putbac (p) integer p include cpars pp = pp + 1 if (pp > MAXSTACK) call stxerr ('putbac--stack size exceeded.') else stack(pp) = p return end #-h- qs 584 asc 07-may-80 12:33:32 ## qs - handle extract quoted string token in shell subroutine qs(char, tok) character c, tok(ARB), char integer j, junk integer param character ngetch include shflag tok(1) = char j = 2 for (c=ngetch(c,shin); c != EOS; c=ngetch(c, shin)) { # if (c == DOLLAR & tok(j-1) == ESCAPE) #escape dollar # j = j - 1 # else # junk = param(c) if (c == EOS) break tok(j) = c j = j + 1 if (c == char) #done break } tok(j) = EOS return end #-h- remov 172 asc 07-may-80 12:33:33 ## remov - remove piped file subroutine remov character name(FILENAMESIZE) integer desc include stdsub call gpname (pctr, name) call remove (name) return end #-h- setokn 172 asc 07-may-80 12:33:34 ## setokn - insert value in given position of pth token subroutine setokn (posn, p, value) integer posn, p, value include cpars tkbuf(posn,p) = value return end #-h- setree 341 asc 07-may-80 12:33:36 ## setree - put 'value' in given node at given position integer function setree (node, posn, value) integer node, posn, value include cpars i = node + posn if (tree(i) != 0) { call stxerr ('setree--doubly defined argument.') setree = ERR return } tree(i) = value setree = OK return end #-h- shcom 419 asc 13-may-80 11:55:12 ## shcom - see if command is shell command integer function shcom(comand) character comand(ARB) integer equal include shcmd if (equal(comand, logout) == YES | equal(comand, cd) == YES | equal(comand, home) == YES | equal(comand, von) == YES | equal(comand, voff) == YES | equal(comand, xon) == YES | equal(comand, xoff) == YES) shcom = YES else shcom = NO return end #-h- shellc 868 asc 13-may-80 11:55:12 ## shellc - execute shell command subroutine shellc (comand, args) character comand(ARB), args(ARB) integer equal, cwdir, i include shcmd include stdsub include shflag if (equal(comand, logout) == YES) call endsh else if (equal(comand, cd) == YES) { for (i=1; args(i) != BLANK & args(i) != EOS; i=i+1) ; args(i) = EOS if (cwdir(args) == ERR) { call putlin(args, ERROUT) call remark(" : directory does not exist.") } } else if (equal(comand, home) == YES) { if (cwdir(spath(2)) == ERR) call remark("home command failed.") } else if (equal(comand, von) == YES) prlin = YES else if (equal(comand, voff) == YES) prlin = NO else if (equal(comand, xon) == YES) prcom = YES else if (equal(comand, xoff) == YES) prcom = NO else call remark ('invalid shell command.') return end #-h- shline 1490 asc 14-may-80 14:16:10 ## shline - prompt and get input line for shell integer function shline (line) character line(ARB) character clower integer length, prompt, equal character pchar(3, 2), tmpara(5) integer pptr, i, k include shflag include shcmd data pchar/PERCENT, BLANK, EOS, PERCENT, UNDERLINE, EOS/ if (carg == YES) #get input from command line { if (clin(1) == EOF) #done { shline = EOF return } call scopy(clin, 1, line, 1) clin(1) = EOF } else { pptr = 1 # first prompt is bare % k = 1 repeat #pick up entire buffer { if (prompt(pchar(1,pptr), line(k), shin) == EOF) { shline = EOF return } k = length(line) if (line(k) == NEWLINE & line(k-1) != ESCAPE) #end of line break k = k - 1 #get more input pptr = 2 # continuation prompt is %_ } } shline = k for (i=1; i <= 4 & i <= k; i=i+1) tmpara(i) = clower(line(i)) tmpara(i) = EOS if (prlin == YES & equal(tmpara, voff) == NO) #user wishes to see line call putlin(line, STDOUT) #save statistics return end #-h- shtok 2065 asc 07-may-80 12:33:42 ## shtok - extract next shell token integer function shtok (tok) character tok(ARB), c, ngetch integer spec, param, atbeg integer i, j, pstat include shflag repeat #loop until non-null token found { call pastbl(c) #skip leading blanks & tabs j = 1 if (spec(c) == YES) #single shell special character { tok(1) = c tok(2) = EOS shtok = c return } if (c == SQUOTE | c == DQUOTE) #quoted string { call qs(c, tok) shtok = tok(1) return } if (c == LESS | c == GREATER | c == QMARK) #redirected IO for (i=1; i<=2; i=i+1) { tok(j) = c j = j + 1 call pastbl(c) if (c != tok(j-1)) break } for ( ; c != EOS; n=ngetch(c, shin)) { pstat = param(c) if (c == EOS) break if (atbeg(c) == YES) { call putbak(c) break } if (c == ESCAPE) { c = ngetch(c, shin) if (spec(c) == NO & #ignore if not shell char. (c != ESCAPE & c != DOLLAR)) { call putbak(c) c = ESCAPE } } tok(j) = c j = j + 1 } tok(j) = EOS shtok = tok(1) if (pstat == NO | j < 1) return #continue if null token produced by empty parameter substitution pstat = NO } end #-h- spec 440 asc 07-may-80 12:33:44 ## spec - handle special characters in shell commands integer function spec (c) character c character sp(8) data sp(1), sp(2), sp(3), sp(4), sp(5), sp(6), sp(7), sp(8) /AMPER, LPAREN, RPAREN, SEPCHAR, BAR, CARET, NEWLINE, EOS/ if (index(sp, c) != 0) { spec = YES if (c == CARET) #allow CARET for PIPE c = BAR } else spec = NO return end #-h- stxerr 216 asc 07-may-80 12:33:45 ## stxerr - report syntax error subroutine stxerr (reason) character reason(ARB) include cpars call putlin('syntax error: ', ERROUT) call putlin (reason, ERROUT) call putch (NEWLINE, ERROUT) return end #-h- syn1 1584 asc 07-may-80 12:33:47 ## syn1 - parse shell syntax level 1 # SYN1 -> SYN2 # -> SYN2 ; SYNTAX # -> SYN2 & SYNTAX integer function syn1 (p1,p2) character tok, gtokn integer p, p1, p2, node, l integer gpnode, gescan, mktree l = 0 for (p=p1; p 0) call stxerr ('syn1--unbalanced left parentheses.') else { call setokn (TMARK, p1, SSYN2) call putbac (p1) } syn1 = OK return end #-h- syn2 1362 asc 07-may-80 12:33:49 ## syn2 - parse shell syntax level 2 # SYN2 -> SYN3 # -> SYN3 | SYN2 integer function syn2 (p1,p2) character tok, gtokn integer p, p1, p2, l, node integer gpnode, gescan, mktree l = 0 for (p=p1; p (SYN1) [out] [?errout] # -> word word* [out] [?errout] integer function syn3 (p1,p2) character gtokn integer p1, p2 integer dopar, doverb if (p1 >= p2) { call stxerr ('syn3--empty command.') syn3 = ERR return } if (gtokn(p1) == LPAREN) syn3 = dopar(p1,p2) else syn3 = doverb(p1,p2) return end #-h- syntax 573 asc 07-may-80 12:33:52 ## syntax - parse shell syntax level zero # SYNTAX -> EMPTY # -> SYN1 integer function syntax (p1,p2) integer p, p1, p2 character tok, gtokn for (p=p1; p