SUBROUTINE MAIN LOGICAL*1 LINE(512) INTEGER PARSER, SHLINE CALL QUERY(40Husage: hsh [-cdnvx] [file [arguments]].) CALL INITSH 23000 CONTINUE IF (.NOT.(SHLINE(LINE) .EQ. -1))GOTO 23003 GOTO 23002 23003 CONTINUE IF (.NOT.(LINE(1) .EQ. 10 .OR. LINE(1) .EQ. 35))GOTO 23005 GOTO 23001 23005 CONTINUE IF (.NOT.(LINE(1) .EQ. 63 .AND. LINE(2) .EQ. 10))GOTO 23007 CALL REMARK(44HType intro for an introduction to the tools.) GOTO 23001 23007 CONTINUE IF (.NOT.(PARSER(LINE) .EQ. -3))GOTO 23009 CALL REMARK (13Hsyntax error.) GOTO 23010 23009 CONTINUE CALL EXECUT 23010 CONTINUE 23001 GOTO 23000 23002 CONTINUE CALL ENDSH(-1) RETURN END SUBROUTINE ARGLIN (BUF, I) LOGICAL*1 BUF(100) INTEGER I, K, M INTEGER GETARG COMMON / CSCLIN / LIN(512) LOGICAL*1 LIN K = 1 J=I 23011 IF (.NOT.(GETARG(J, LIN, 512) .NE. -1))GOTO 23013 IF (.NOT.(LIN(1) .EQ. 64 .AND. LIN(2) .EQ. 60 ))GOTO 23014 M = 2 GOTO 23015 23014 CONTINUE M = 1 23015 CONTINUE CALL STCOPY(LIN, M, BUF, K) CALL CHCOPY( 32, BUF, K) 23012 J=J+1 GOTO 23011 23013 CONTINUE IF (.NOT.(K .GT. 1))GOTO 23016 K = K - 1 23016 CONTINUE BUF(K) = 10 BUF(K+1) = 0 RETURN END INTEGER FUNCTION ATBEG(C) LOGICAL*1 C INTEGER SPEC IF (.NOT.(SPEC(C) .EQ. 1 .OR. C .EQ. 60 .OR. C .EQ. 62 .OR. C .EQ. * 63 .OR. C .EQ. 32 .OR. C .EQ. 9 .OR. C .EQ. 39 .OR. C .EQ. 34))GO *TO 23018 ATBEG = 1 GOTO 23019 23018 CONTINUE ATBEG = 0 23019 CONTINUE RETURN END INTEGER FUNCTION CMDTYP (COMAND, PATH) LOGICAL*1 COMAND(100), PATH(100) INTEGER EQUAL, SHCOM INTEGER LOCCOM COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 LOCAL(6) LOGICAL*1 EXECUT(2) LOGICAL*1 SUFFIX(11) DATA LOCAL(1)/108/,LOCAL(2)/111/,LOCAL(3)/99/,LOCAL(4)/97/,LOCAL(5 *)/108/,LOCAL(6)/0/ DATA EXECUT(1)/120/,EXECUT(2)/0/ DATA SUFFIX(1)/46/,SUFFIX(2)/115/,SUFFIX(3)/104/,SUFFIX(4)/0/,SUFF *IX(5)/46/,SUFFIX(6)/116/,SUFFIX(7)/115/,SUFFIX(8)/107/,SUFFIX(9)/0 */,SUFFIX(10)/10/,SUFFIX(11)/0/ CALL STRCPY(COMAND, PATH) IF (.NOT.(SHCOM(COMAND) .EQ. 1))GOTO 23020 CMDTYP = 17 GOTO 23021 23020 CONTINUE IF (.NOT.(EQUAL(COMAND, EXECUT) .EQ. 1))GOTO 23022 CALL STRCPY(LOCAL, PATH) CMDTYP = 60 GOTO 23023 23022 CONTINUE CMDTYP = LOCCOM(COMAND, SPATH, SUFFIX, PATH) 23023 CONTINUE 23021 CONTINUE RETURN END SUBROUTINE DOAMPR (NODE, DIR) INTEGER NODE, DIR, I INTEGER SSPAWN, GETCL, LOCCOM LOGICAL*1 DESC(7) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN LOGICAL*1 SHSTR(3) LOGICAL*1 SUFFIX(7) LOGICAL*1 SECOND(5) DATA SHSTR(1)/115/,SHSTR(2)/104/,SHSTR(3)/0/ DATA SUFFIX(1)/46/,SUFFIX(2)/116/,SUFFIX(3)/115/,SUFFIX(4)/107/,SU *FFIX(5)/0/,SUFFIX(6)/10/,SUFFIX(7)/0/ DATA SECOND(1)/32/,SECOND(2)/45/,SECOND(3)/99/,SECOND(4)/32/,SECON *D(5)/0/ IF (.NOT.(DIR .EQ. 4 .OR. DIR .EQ. 1))GOTO 23024 RETURN 23024 CONTINUE IF (.NOT.( LOCCOM( SHSTR, SPATH, SUFFIX, SH) .NE. 60 ))GOTO 23026 CALL REMARK( 32H? Can't locate shell image file.) RETURN 23026 CONTINUE I = 1 CALL STCOPY( SHSTR, 1, CLIN, I) CALL STCOPY( SECOND, 1, CLIN, I) IF (.NOT.(GETCL(NODE, DIR, CLIN, I) .EQ. -3))GOTO 23028 RETURN 23028 CONTINUE CALL STRIPB(CLIN) IF (.NOT.(PRCOM .EQ. 1))GOTO 23030 CALL DSPCOM(SH, CLIN) 23030 CONTINUE IF (.NOT.(EXEC .EQ. 1))GOTO 23032 IF (.NOT.(SSPAWN(SH, CLIN, DESC, 98) .EQ. -3))GOTO 23034 CALL REMARK (32HCannot spawn background process.) GOTO 23035 23034 CONTINUE CALL REMARK (DESC) 23035 CONTINUE 23032 CONTINUE RETURN END INTEGER FUNCTION DOCOM (NODE, DIR) INTEGER DIR, I, J, NODE, TYPE, STATUS INTEGER SSPAWN, SHELLC INTEGER CMDTYP, EQUAL INTEGER PICKUP, INF, OUTF, ERRF, LENGTH LOGICAL*1 COMAND(40), DESC(7) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN COMMON /SHCMD/ CD(3), E(2), HO(3), HOME(5), LOGOUT(7), VON(4), VOF *F(5), XON(4), XOFF(5), SHOPTH(5) LOGICAL*1 CD LOGICAL*1 E LOGICAL*1 HO LOGICAL*1 HOME LOGICAL*1 LOGOUT LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF LOGICAL*1 SHOPTH LOGICAL*1 LOCAL(6) LOGICAL*1 ERRMSG(39) DATA LOCAL(1)/108/,LOCAL(2)/111/,LOCAL(3)/99/,LOCAL(4)/97/,LOCAL(5 *)/108/,LOCAL(6)/0/ DATA ERRMSG(1)/63/,ERRMSG(2)/32/,ERRMSG(3)/67/,ERRMSG(4)/97/,ERRMS *G(5)/110/,ERRMSG(6)/39/,ERRMSG(7)/116/,ERRMSG(8)/32/,ERRMSG(9)/102 */,ERRMSG(10)/105/,ERRMSG(11)/110/,ERRMSG(12)/100/,ERRMSG(13)/32/,E *RRMSG(14)/112/,ERRMSG(15)/114/,ERRMSG(16)/111/,ERRMSG(17)/103/,ERR *MSG(18)/114/,ERRMSG(19)/97/,ERRMSG(20)/109/,ERRMSG(21)/32/,ERRMSG( *22)/111/,ERRMSG(23)/114/,ERRMSG(24)/32/,ERRMSG(25)/115/,ERRMSG(26) */99/,ERRMSG(27)/114/,ERRMSG(28)/105/,ERRMSG(29)/112/,ERRMSG(30)/11 *6/,ERRMSG(31)/32/,ERRMSG(32)/110/,ERRMSG(33)/97/,ERRMSG(34)/109/,E *RRMSG(35)/101/,ERRMSG(36)/100/,ERRMSG(37)/32/,ERRMSG(38)/96/,ERRMS *G(39)/0/ J = 1 JUNK = PICKUP(CLIN, J, NODE, 9, JUNK) CALL FOLD(CLIN) TYPE = CMDTYP( CLIN, COMAND) IF (.NOT.( TYPE .EQ. -3 .AND. DROP .EQ. 0 ))GOTO 23036 CALL PUTLIN(ERRMSG, 3) CALL PUTLIN(COMAND, 3) CALL REMARK(2H'.) DOCOM=(-3) RETURN 23036 CONTINUE IF (.NOT.( EQUAL( COMAND, LOCAL) .EQ. 1 .OR. TYPE .EQ. 17 ))GOTO 2 *3038 J = 1 GOTO 23039 23038 CONTINUE CALL CHCOPY( 32, CLIN, J) 23039 CONTINUE IF (.NOT.( TYPE .EQ. 12 ))GOTO 23040 CALL SCRF(NODE, COMAND, CLIN) GOTO 23041 23040 CONTINUE IF (.NOT.( TYPE .EQ. -3 ))GOTO 23042 CALL STRCPY( LOCAL, COMAND) 23042 CONTINUE I = 1 23044 IF (.NOT.(PICKUP( CLIN, J, NODE, 10, I) .NE. -3 ))GOTO 23046 CALL CHCOPY( 32, CLIN, J) 23045 I = I + 1 GOTO 23044 23046 CONTINUE IF (.NOT.( INF(NODE, CLIN, J) .NE. -3 ))GOTO 23047 CALL CHCOPY( 32, CLIN, J) 23047 CONTINUE IF (.NOT.( OUTF(NODE, CLIN, J) .NE. -3 ))GOTO 23049 CALL CHCOPY( 32, CLIN, J) 23049 CONTINUE IF (.NOT.( ERRF(NODE, CLIN, J) .NE. -3 ))GOTO 23051 CALL CHCOPY( 32, CLIN, J) 23051 CONTINUE 23041 CONTINUE CALL STRIPB( CLIN) IF (.NOT.( PRCOM .EQ. 1 .AND. EQUAL(COMAND, XOFF) .EQ. 0 ))GOTO 23 *053 CALL DSPCOM(COMAND, CLIN) 23053 CONTINUE IF (.NOT.( EXEC .EQ. 1 ))GOTO 23055 IF (.NOT.( TYPE .EQ. 17 ))GOTO 23057 STATUS = SHELLC( COMAND, CLIN) GOTO 23058 23057 CONTINUE STATUS = SSPAWN( COMAND, CLIN, DESC, 119) IF (.NOT.( STATUS .EQ. -3 ))GOTO 23059 CALL REMARK( 22H? Can't spawn process.) GOTO 23060 23059 CONTINUE IF (.NOT.( STATUS .NE. 0 ))GOTO 23061 IF (.NOT.( STATUS .NE. -10 ))GOTO 23063 STATUS = -3 23063 CONTINUE 23061 CONTINUE 23060 CONTINUE 23058 CONTINUE GOTO 23056 23055 CONTINUE STATUS = 0 23056 CONTINUE DOCOM=(STATUS) RETURN END INTEGER FUNCTION DOPAR (P1,P2) LOGICAL*1 TOK INTEGER P, P1, P2, L, PNODE, NODE, PT, NDX INTEGER SETREE, MKTREE COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF L = 0 P=P1 23065 IF (.NOT.(P.LT.P2))GOTO 23067 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23068 L = L + 1 GOTO 23069 23068 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23070 L = L - 1 IF (.NOT.(L .EQ. 0))GOTO 23072 GOTO 23067 23072 CONTINUE 23070 CONTINUE 23069 CONTINUE 23066 P=P+1 GOTO 23065 23067 CONTINUE IF (.NOT.(MKTREE( TKBUF( 3, P1), 112, 7, NODE) .EQ. -3))GOTO 23074 DOPAR = -3 RETURN 23074 CONTINUE PT = P1 + 1 TKBUF( 2, PT) = 1 TKBUF( 3, PT) = NODE TKBUF( 4, PT) = P CALL PUTBAC (PT) P=P+1 23076 IF (.NOT.(P.LT.P2))GOTO 23078 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60))GOTO 23079 IF (.NOT.(SETREE(NODE, 5, TKBUF( 1, P)) .EQ. -3))GOTO 23081 DOPAR = -3 RETURN 23081 CONTINUE GOTO 23080 23079 CONTINUE IF (.NOT.(TOK .EQ. 62))GOTO 23083 IF (.NOT.(SETREE(NODE, 6, TKBUF( 1, P)) .EQ. -3))GOTO 23085 DOPAR = -3 RETURN 23085 CONTINUE GOTO 23084 23083 CONTINUE IF (.NOT.(TOK .EQ. 63))GOTO 23087 IF (.NOT.(SETREE(NODE, 7, TKBUF( 1, P)) .EQ. -3))GOTO 23089 DOPAR = -3 RETURN 23089 CONTINUE GOTO 23088 23087 CONTINUE CALL STXERR(44Hinvalid token following parenthesis (dopar).) DOPAR = -3 RETURN 23088 CONTINUE 23084 CONTINUE 23080 CONTINUE 23077 P=P+1 GOTO 23076 23078 CONTINUE DOPAR = 0 RETURN END INTEGER FUNCTION DOPARN (NODE, DIR) INTEGER NODE, DIR COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR IF (.NOT.(DIR .EQ. 3))GOTO 23091 IF (.NOT.(TREE(NODE+5) .NE. 0))GOTO 23093 IF (.NOT.(IN .EQ. 0 .OR. (IN .NE. 0 .AND. CIN(IN) .GT. 0) ))GOTO 2 *3095 IN = IN + 1 CIN(IN) = TREE(NODE+5) TREE(NODE+5) = -TREE(NODE+5) 23095 CONTINUE 23093 CONTINUE IF (.NOT.(TREE(NODE+6) .NE. 0))GOTO 23097 IF (.NOT.(OUT .EQ. 0 .OR. (OUT .NE. 0 .AND. COUT(OUT) .GT. 0)))GOT *O 23099 OUT = OUT + 1 COUT(OUT) = TREE(NODE+6) TREE(NODE+6) = -TREE(NODE+6) 23099 CONTINUE 23097 CONTINUE IF (.NOT.(TREE(NODE+7) .NE. 0))GOTO 23101 ER = ER + 1 CERR(ER ) = TREE(NODE+7) TREE(NODE+7) = -TREE(NODE+7) 23101 CONTINUE GOTO 23092 23091 CONTINUE IF (.NOT.(TREE(NODE+5) .LT. 0))GOTO 23103 IN = IN - 1 TREE(NODE+5) = IABS(TREE(NODE+5)) 23103 CONTINUE IF (.NOT.(TREE(NODE+6) .LT. 0))GOTO 23105 OUT = OUT - 1 TREE(NODE+6) = IABS(TREE(NODE+6)) 23105 CONTINUE IF (.NOT.(TREE(NODE+7) .LT. 0))GOTO 23107 ER = ER - 1 TREE(NODE+7) = IABS(TREE(NODE+7)) 23107 CONTINUE 23092 CONTINUE DOPARN=(0) RETURN END INTEGER FUNCTION DOPIPE (NODE, DIR) INTEGER NODE, DIR COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR IF (.NOT.(DIR .EQ. 3))GOTO 23109 PCTR = PCTR + 1 PFILE(PCTR) = 0 OUT = OUT + 1 COUT(OUT) = -PCTR AOUT(OUT) = 0 GOTO 23110 23109 CONTINUE IF (.NOT.(DIR .EQ. 4))GOTO 23111 IN = IN + 1 CIN(IN) = COUT(OUT) OUT = OUT - 1 GOTO 23112 23111 CONTINUE PCTR = PCTR - 1 IN = IN - 1 23112 CONTINUE 23110 CONTINUE DOPIPE=(0) RETURN END INTEGER FUNCTION DOSEMI (NODE, DIR) INTEGER NODE, DIR COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR IF (.NOT.(DIR .EQ. 4))GOTO 23113 IF (.NOT.(OUT .GT. 0))GOTO 23115 AOUT(OUT) = AOUT(OUT) + 1 23115 CONTINUE GOTO 23114 23113 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23117 IF (.NOT.(OUT .GT. 0))GOTO 23119 AOUT(OUT) = AOUT(OUT) - 1 23119 CONTINUE 23117 CONTINUE 23114 CONTINUE DOSEMI=(0) RETURN END INTEGER FUNCTION DOVERB (P1,P2) LOGICAL*1 TOK INTEGER P, P1, P2, P3, I, NODE, NDX INTEGER MKTREE, SETREE COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF NDX = TKBUF( 1, P1) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60 .OR. TOK .EQ. 62 .OR. TOK .EQ. 63))GOTO 2312 *1 CALL STXERR(46Hcommand must preceed i/o redirection (doverb).) DOVERB=(-3) RETURN 23121 CONTINUE NARGS = P2 - P1 -1 IF (.NOT.(MKTREE(TKBUF( 3, P1), 99, 9+NARGS, NODE) .EQ. -3))GOTO 2 *3123 DOVERB=(-3) RETURN 23123 CONTINUE I = 0 P=P1 23125 IF (.NOT.(P.LT.P2))GOTO 23127 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60))GOTO 23128 IF (.NOT.(SETREE(NODE, 5, TKBUF( 1, P)) .EQ. -3))GOTO 23130 DOVERB=(-3) RETURN 23130 CONTINUE NARGS = NARGS - 1 GOTO 23129 23128 CONTINUE IF (.NOT.(TOK .EQ. 62))GOTO 23132 IF (.NOT.(SETREE(NODE, 6, TKBUF( 1, P)) .EQ. -3))GOTO 23134 DOVERB=(-3) RETURN 23134 CONTINUE NARGS = NARGS - 1 GOTO 23133 23132 CONTINUE IF (.NOT.(TOK .EQ. 63))GOTO 23136 IF (.NOT.(SETREE(NODE, 7, TKBUF( 1, P)) .EQ. -3))GOTO 23138 DOVERB=(-3) RETURN 23138 CONTINUE NARGS = NARGS - 1 GOTO 23137 23136 CONTINUE IF (.NOT.(SETREE(NODE, 9+I, TKBUF( 1, P)) .EQ. -3))GOTO 23140 DOVERB=(-3) RETURN 23140 CONTINUE I = I + 1 23137 CONTINUE 23133 CONTINUE 23129 CONTINUE 23126 P=P+1 GOTO 23125 23127 CONTINUE IF (.NOT.(SETREE(NODE, 8, NARGS) .EQ. -3))GOTO 23142 DOVERB=(-3) RETURN 23142 CONTINUE DOVERB=(0) RETURN END SUBROUTINE DSPCOM(COM, ARG) INTEGER I INTEGER EQUAL, SHCOM LOGICAL*1 COM(100), ARG(100) LOGICAL*1 LOCAL(6) DATA LOCAL(1)/108/,LOCAL(2)/111/,LOCAL(3)/99/,LOCAL(4)/97/,LOCAL(5 *)/108/,LOCAL(6)/0/ CALL PUTLIN(COM, 3) I = 1 IF (.NOT.( EQUAL( COM, LOCAL) .EQ. 0 .AND. SHCOM(COM) .EQ. 0))GOTO * 23144 23146 IF (.NOT.(ARG(I) .NE. 32 .AND. ARG(I) .NE. 0))GOTO 23147 I = I + 1 GOTO 23146 23147 CONTINUE GOTO 23145 23144 CONTINUE CALL PUTCH(32, 3) 23145 CONTINUE CALL PUTLIN(ARG(I), 3) CALL PUTCH(10, 3) RETURN END SUBROUTINE DSPPTH COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER I LOGICAL*1 SEPSTR(5) DATA SEPSTR(1)/32/,SEPSTR(2)/45/,SEPSTR(3)/62/,SEPSTR(4)/32/,SEPST *R(5)/0/ CALL PWDIR(2, 0) I = 1 23148 IF (.NOT.(SPATH(I) .NE. 10 ))GOTO 23150 IF (.NOT.( SPATH(I) .EQ. 0 .AND. SPATH(I+1) .NE. 10 ))GOTO 23151 CALL PUTLIN(SEPSTR, 2) GOTO 23152 23151 CONTINUE CALL PUTCH(SPATH(I), 2) 23152 CONTINUE 23149 I = I + 1 GOTO 23148 23150 CONTINUE CALL PUTCH(10, 2) RETURN END SUBROUTINE ENDSH(COMAND) LOGICAL*1 COMAND INTEGER JUNK LOGICAL*1 NULL(1) DATA NULL(1)/0/ IF (.NOT.(COMAND .NE. -1))GOTO 23153 CALL LOGEND(NULL, JUNK) 23153 CONTINUE CALL ENDST(0) END INTEGER FUNCTION ERRF (NODE, BUF, I) INTEGER NODE, I INTEGER PICKUP INTEGER JUNK LOGICAL*1 BUF(100) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR ERRF = -3 IF (.NOT.( ER .EQ. 0 .AND. PICKUP( BUF, I, NODE, 7, JUNK) .NE. -3 *))GOTO 23155 ERRF = 0 GOTO 23156 23155 CONTINUE IF (.NOT.(ER .GT. 0 .AND. CERR(ER) .GT. 0))GOTO 23157 IF (.NOT.(AOUT(OUT) .NE. 0))GOTO 23159 CALL CHCOPY( 63, BUF, I) 23159 CONTINUE CALL STCOPY (IBUF, CERR(ER), BUF, I) ERRF = 0 23157 CONTINUE 23156 CONTINUE RETURN END SUBROUTINE EXECUT INTEGER NODE, TYPE, DIR, STATUS, I, J, JUNK INTEGER MVNEXT, DOSEMI, DOAMPR, DOPIPE, DOPARN, DOCOM, REMOVE COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR IN = 0 OUT = 0 ER = 0 PCTR = 0 HFILE(1) = 0 I=1 23161 IF (.NOT.(I.LE.15))GOTO 23163 PFILE(I) = 0 23162 I=I+1 GOTO 23161 23163 CONTINUE NODE = -1 23164 IF (.NOT.(MVNEXT(NODE, TYPE, DIR) .NE. -1))GOTO 23165 IF (.NOT.(TYPE .EQ. 59))GOTO 23166 STATUS = DOSEMI (NODE, DIR) GOTO 23167 23166 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23168 STATUS = DOAMPR (NODE, DIR) GOTO 23169 23168 CONTINUE IF (.NOT.(TYPE .EQ. 124))GOTO 23170 STATUS = DOPIPE (NODE, DIR) GOTO 23171 23170 CONTINUE IF (.NOT.(TYPE .EQ. 112))GOTO 23172 STATUS = DOPARN (NODE, DIR) GOTO 23173 23172 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23174 STATUS = DOCOM (NODE, DIR) GOTO 23175 23174 CONTINUE CALL REMARK(30H? Invalid parse tree (execut).) STATUS = -3 23175 CONTINUE 23173 CONTINUE 23171 CONTINUE 23169 CONTINUE 23167 CONTINUE IF (.NOT.( STATUS .EQ. -3 .OR. STATUS .EQ. -10 ))GOTO 23176 GOTO 23165 23176 CONTINUE GOTO 23164 23165 CONTINUE IF (.NOT.( HFILE(1) .NE. 0 ))GOTO 23178 JUNK = REMOVE(HFILE) 23178 CONTINUE I=1 23180 IF (.NOT.(I.LE.15))GOTO 23182 IF (.NOT.(PFILE(I) .EQ. 1))GOTO 23183 J = 1 CALL GPNAME( I, HFILE, J) JUNK = REMOVE( HFILE) 23183 CONTINUE 23181 I=I+1 GOTO 23180 23182 CONTINUE RETURN END INTEGER FUNCTION GETCL(NODE, DIR, BUF, K) INTEGER NODE, JUNK, SNODE, TYPE, DIR, LASTD, K LOGICAL*1 BUF(100) INTEGER MVNEXT, GTASK COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN SNODE = NODE 23185 CONTINUE JUNK = MVNEXT(NODE, TYPE, DIR) IF (.NOT.(NODE .EQ. SNODE))GOTO 23188 GOTO 23187 23188 CONTINUE IF (.NOT.(TYPE .EQ. 59 .AND. DIR .EQ. 4))GOTO 23190 CALL CHCOPY( 59, BUF, K) GOTO 23191 23190 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23192 IF (.NOT.(DIR .EQ. 4 .OR. (DIR .EQ. 1 .AND. LASTD .EQ. 3)))GOTO 23 *194 CALL CHCOPY( 38, BUF, K) 23194 CONTINUE LASTD = DIR GOTO 23193 23192 CONTINUE IF (.NOT.(TYPE .EQ. 124 .AND. DIR .EQ. 4))GOTO 23196 CALL CHCOPY( 124, BUF, K) GOTO 23197 23196 CONTINUE IF (.NOT.(TYPE .EQ. 112))GOTO 23198 CALL GPAR(NODE, DIR, BUF, K) GOTO 23199 23198 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23200 GETCL = GTASK(NODE, BUF, K) 23200 CONTINUE 23199 CONTINUE 23197 CONTINUE 23193 CONTINUE 23191 CONTINUE 23186 GOTO 23185 23187 CONTINUE RETURN END SUBROUTINE GPAR(NODE, DIR, BUF, I) INTEGER NODE, DIR, I, N LOGICAL*1 BUF(100) INTEGER PICKUP, LENGTH LOGICAL*1 RPST(4) DATA RPST(1)/41/,RPST(2)/32/,RPST(3)/64/,RPST(4)/0/ IF (.NOT.(DIR .EQ. 3))GOTO 23202 CALL CHCOPY( 40, BUF, I) GOTO 23203 23202 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23204 N = I CALL STCOPY( RPST, 1, BUF, I) IF (.NOT.( PICKUP( BUF, I, NODE, 5, JUNK) .NE. -3))GOTO 23206 CALL CHCOPY( 32, BUF, I) GOTO 23207 23206 CONTINUE I = N + 2 23207 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 6, JUNK) .NE. -3))GOTO 23208 CALL CHCOPY( 32, BUF, I) 23208 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 7, JUNK) .NE. -3))GOTO 23210 CALL CHCOPY( 32, BUF, I) 23210 CONTINUE 23204 CONTINUE 23203 CONTINUE RETURN END SUBROUTINE GPNAME(N, NAME, I) LOGICAL*1 NAME(100) INTEGER ITOC, LENGTH INTEGER I, JUNK, N COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 PIPEF(5) DATA PIPEF(1)/112/,PIPEF(2)/0/ PFILE(N) = 1 JUNK = ITOC( N, PIPEF(2), 3) CALL SCRATF( PIPEF, NAME(I)) I = I + LENGTH( NAME(I)) RETURN END INTEGER FUNCTION GTASK(NODE, BUF, J) INTEGER NODE, JUNK, TYPE, J, K, N INTEGER PICKUP, CMDTYP LOGICAL*1 BUF(100) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN N = J JUNK = PICKUP( BUF, J, NODE, 9, JUNK) K = J + 1 TYPE = CMDTYP( BUF(N), BUF(K)) IF (.NOT.( TYPE .EQ. -3 .AND. DROP .EQ. 0 ))GOTO 23212 CALL REMARK (12Hinvalid task) J = N BUF(J) = 0 GTASK=(-3) RETURN 23212 CONTINUE GTASK = 0 CALL CHCOPY( 32, BUF, J) I=1 23214 IF (.NOT.(PICKUP( BUF, J, NODE, 10, I) .NE. -3))GOTO 23216 CALL CHCOPY( 32, BUF, J) 23215 I=I+1 GOTO 23214 23216 CONTINUE CALL CHCOPY( 64, BUF, J) IF (.NOT.( PICKUP( BUF, J, NODE, 5, JUNK) .NE. -3))GOTO 23217 CALL CHCOPY( 32, BUF, J) GOTO 23218 23217 CONTINUE J = J - 1 23218 CONTINUE IF (.NOT.( PICKUP( BUF, J, NODE, 6, JUNK) .NE. -3))GOTO 23219 CALL CHCOPY( 32, BUF, J) 23219 CONTINUE IF (.NOT.( PICKUP( BUF, J, NODE, 7, JUNK) .NE. -3))GOTO 23221 CALL CHCOPY( 32, BUF, J) 23221 CONTINUE BUF(J) = 0 RETURN END SUBROUTINE HERDOC(CHAR, BUF, I) LOGICAL*1 CHAR, BUF(100) INTEGER CREATE, GETLIN INTEGER INT, I, N COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN COMMON / CSCLIN / LIN(512) LOGICAL*1 LIN LOGICAL*1 DOC(4) DATA DOC(1)/100/,DOC(2)/111/,DOC(3)/99/,DOC(4)/0/ N = I CALL CHCOPY( 60, BUF, I) CALL SCRATF(DOC, HFILE) INT = CREATE(HFILE, 2) IF (.NOT.(INT .EQ. -3))GOTO 23223 CALL REMARK(34H? Can't open file for inline text.) HFILE(1) = 0 I = N BUF(I) = 0 RETURN 23223 CONTINUE CALL STCOPY( HFILE, 1, BUF, I) 23225 IF (.NOT.( GETLIN( LIN, SHIN) .NE. -1))GOTO 23226 IF (.NOT.(LIN(1) .EQ. CHAR))GOTO 23227 GOTO 23226 23227 CONTINUE CALL PUTLIN(LIN, INT) GOTO 23225 23226 CONTINUE CALL CLOSE(INT) RETURN END INTEGER FUNCTION INF(NODE, BUF, I) INTEGER NODE, I, N INTEGER PICKUP LOGICAL*1 BUF(100), CHAR COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF N = I IF (.NOT.(IN .GT. 0 .AND. CIN(IN) .LT. 0))GOTO 23229 CALL CHCOPY( 60, BUF, I) CALL GPNAME( IABS(CIN(IN)), BUF, I) GOTO 23230 23229 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 5, JUNK) .EQ. -3 .AND. IN .GT. 0 *))GOTO 23231 CALL STCOPY( IBUF, CIN(IN), BUF, I) GOTO 23232 23231 CONTINUE IF (.NOT.(SCRIPT .EQ. 1 .AND. INPUT(1) .NE. 0))GOTO 23233 CALL CHCOPY( 60, BUF, I) CALL STCOPY( INPUT, 1, BUF, I) 23233 CONTINUE 23232 CONTINUE 23230 CONTINUE IF (.NOT.(BUF(N) .EQ. 60 .AND. BUF(N+1) .EQ. 60))GOTO 23235 CHAR = BUF(N+2) I = N CALL HERDOC( CHAR, BUF, I) 23235 CONTINUE IF (.NOT.(BUF(N) .NE. 0))GOTO 23237 INF=(0) RETURN 23237 CONTINUE INF=(-3) RETURN 23238 CONTINUE END SUBROUTINE INITSH INTEGER GETARG, OPEN, LOCCOM, LENGTH, INDEXC INTEGER I COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN COMMON /SHCMD/ CD(3), E(2), HO(3), HOME(5), LOGOUT(7), VON(4), VOF *F(5), XON(4), XOFF(5), SHOPTH(5) LOGICAL*1 CD LOGICAL*1 E LOGICAL*1 HO LOGICAL*1 HOME LOGICAL*1 LOGOUT LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF LOGICAL*1 SHOPTH COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER PBP, PBSIZE LOGICAL*1 PBBUF(512) COMMON/CPBACK/PBP, PBSIZE, PBBUF LOGICAL*1 SUFFIX(3) DATA SUFFIX(1)/0/,SUFFIX(2)/10/,SUFFIX(3)/0/ DATA CD /99, 100, 0/ DATA HO /104, 111, 0/ DATA HOME /104, 111, 109, 101, 0/ DATA LOGOUT /108, 111, 103, 111, 117, 116, 0/ DATA SHOPTH /112, 97, 116, 104, 0/ DATA VON /118, 111, 110, 0/ DATA VOFF /118, 111, 102, 102, 0/ DATA XON /120, 111, 110, 0/ DATA XOFF /120, 111, 102, 102, 0/ DATA INPUT(1) /0/ DATA SHIN /1/ CALL PBINIT(512) PRLIN = 0 EXEC = 1 PRCOM = 0 CARG = 0 DROP = 1 SCRIPT = 0 CALL IMPATH(SPATH) CALL HOMDIR( HOMEDR, 6) CALL GWDIR( OLDDIR, 6) CALL ENBINT I = 1 23239 IF (.NOT.(GETARG(I, CLIN, 512) .NE. -1 ))GOTO 23241 IF (.NOT.( I .EQ. 1 .AND. CLIN(1) .EQ. 45 ))GOTO 23242 CALL FOLD(CLIN) IF (.NOT.( INDEXC( CLIN, 118) .GT. 0 ))GOTO 23244 PRLIN = 1 23244 CONTINUE IF (.NOT.( INDEXC( CLIN, 110) .GT. 0 ))GOTO 23246 EXEC = 0 23246 CONTINUE IF (.NOT.( INDEXC( CLIN, 120) .GT. 0 ))GOTO 23248 PRCOM = 1 23248 CONTINUE IF (.NOT.( INDEXC( CLIN, 99) .GT. 0 ))GOTO 23250 CARG = 1 23250 CONTINUE IF (.NOT.( INDEXC( CLIN, 100) .GT. 0 ))GOTO 23252 DROP = 0 23252 CONTINUE CALL DELARG(I) I = I - 1 GOTO 23243 23242 CONTINUE IF (.NOT.( CARG .EQ. 1 ))GOTO 23254 CALL ARGLIN(CLIN, I) CARGDN = 0 GOTO 23241 23254 CONTINUE IF (.NOT.( I .EQ. 1 ))GOTO 23256 IF (.NOT.( LOCCOM( CLIN, SPATH, SUFFIX, CLIN) .NE. 12 ))GOTO 23258 CALL CANT(CLIN) 23258 CONTINUE SHIN = OPEN(CLIN, 1) IF (.NOT.( SHIN .EQ. -3 ))GOTO 23260 CALL CANT(CLIN) 23260 CONTINUE SCRIPT = 1 GOTO 23257 23256 CONTINUE IF (.NOT.( CLIN(1) .EQ. 64 ))GOTO 23262 IF (.NOT.( CLIN(2) .EQ. 60 ))GOTO 23264 CALL SCOPY(CLIN, 3, INPUT, 1) GOTO 23265 23264 CONTINUE GOTO 23240 23265 CONTINUE CALL DELARG (I) I = I - 1 23262 CONTINUE 23257 CONTINUE 23255 CONTINUE 23243 CONTINUE 23240 I = I + 1 GOTO 23239 23241 CONTINUE CALL RLOGIN RETURN END INTEGER FUNCTION MKTOKS (LINE, K) INTEGER LENGTH INTEGER I, PAREN LOGICAL*1 LINE(100) INTEGER SHTOK INTEGER K, L COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF PAREN = 0 I = 1 CALL PUTBAK (0) CALL PBSTR (LINE) K=1 23266 IF (.NOT.(SHTOK(IBUF(I)) .NE. 0))GOTO 23268 IF (.NOT.(IBUF(I) .NE. 0))GOTO 23269 TKBUF(1,K) = I TKBUF(2,K) = 0 TKBUF(3,K) = 0 TKBUF(4,K) = 0 IF (.NOT.(IBUF(I) .EQ. 40))GOTO 23271 PAREN = PAREN + 1 GOTO 23272 23271 CONTINUE IF (.NOT.(IBUF(I) .EQ. 41))GOTO 23273 PAREN = PAREN - 1 23273 CONTINUE 23272 CONTINUE L = I + LENGTH(IBUF(I)) - 1 IF (.NOT.((IBUF(I) .EQ. 39 .OR. IBUF(I) .EQ. 34) .AND. IBUF(L) .NE *. IBUF(I)))GOTO 23275 CALL REMARK(20H? Unbalanced quotes.) MKTOKS=(-3) RETURN 23275 CONTINUE I = L + 2 23269 CONTINUE 23267 K=K+1 GOTO 23266 23268 CONTINUE K = K - 1 IBUF(I) = 0 IF (.NOT.(PAREN .NE. 0))GOTO 23277 MKTOKS=(-3) RETURN 23277 CONTINUE MKTOKS=(0) RETURN 23278 CONTINUE END INTEGER FUNCTION MKTREE (PNODE, TYPE, SIZE, CNODE) INTEGER PNODE, TYPE, SIZE, CNODE, I COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF CNODE = TREEND TREEND = TREEND + SIZE IF (.NOT.(TREEND .GT.200))GOTO 23279 CALL STXERR(34Htree buffer size exceeded (mktree)) CNODE = -3 MKTREE=(-3) RETURN 23279 CONTINUE I=1 23281 IF (.NOT.(I.LE.SIZE))GOTO 23283 TREE(CNODE+I) = 0 23282 I=I+1 GOTO 23281 23283 CONTINUE TREE(CNODE+1) = PNODE TREE(CNODE+2) = TYPE IF (.NOT.(PNODE .GE. 0))GOTO 23284 IF (.NOT.(TREE(PNODE+3) .EQ. 0))GOTO 23286 TREE(PNODE+3) = CNODE GOTO 23287 23286 CONTINUE IF (.NOT.(TREE(PNODE+4) .EQ. 0))GOTO 23288 TREE(PNODE+4) = CNODE GOTO 23289 23288 CONTINUE CALL STXERR(26Htoo many children (mktree)) MKTREE=(-3) RETURN 23289 CONTINUE 23287 CONTINUE 23284 CONTINUE MKTREE=(CNODE) RETURN END INTEGER FUNCTION MVNEXT (NODE, TYPE, DIR) INTEGER NODE, DIR, TYPE INTEGER NXTBR COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF IF (.NOT.(NODE .EQ. -1))GOTO 23290 MVNEXT = 0 DIR = 3 GOTO 23291 23290 CONTINUE MVNEXT = TREE(NODE+DIR) 23291 CONTINUE IF (.NOT.(MVNEXT .NE. -1))GOTO 23292 TYPE = TREE(MVNEXT+2) DIR = NXTBR(MVNEXT, NODE) 23292 CONTINUE NODE = MVNEXT RETURN END INTEGER FUNCTION NEXTP (P) INTEGER P COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF IF (.NOT.(PP .EQ. 0))GOTO 23294 P = 0 GOTO 23295 23294 CONTINUE P = STACK(PP) PP = PP - 1 23295 CONTINUE NEXTP=(P) RETURN END SUBROUTINE NODIR(DIR) LOGICAL*1 DIR(100) LOGICAL*1 START(31) DATA START(1)/63/,START(2)/32/,START(3)/67/,START(4)/97/,START(5)/ *110/,START(6)/39/,START(7)/116/,START(8)/32/,START(9)/102/,START(1 *0)/105/,START(11)/110/,START(12)/100/,START(13)/32/,START(14)/100/ *,START(15)/105/,START(16)/114/,START(17)/101/,START(18)/99/,START( *19)/116/,START(20)/111/,START(21)/114/,START(22)/121/,START(23)/32 */,START(24)/110/,START(25)/97/,START(26)/109/,START(27)/101/,START *(28)/100/,START(29)/32/,START(30)/96/,START(31)/0/ CALL PUTLIN( START, 3) CALL PUTLIN( DIR, 3) CALL REMARK( 2H'.) RETURN END INTEGER FUNCTION NXTBR (NODE, LNODE) INTEGER NODE, LNODE COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF IF (.NOT.(LNODE .EQ. TREE(NODE+1)))GOTO 23296 IF (.NOT.(TREE(NODE+3) .NE. 0))GOTO 23298 NXTBR=(3) RETURN 23298 CONTINUE NXTBR=(1) RETURN 23299 CONTINUE GOTO 23297 23296 CONTINUE IF (.NOT.(LNODE .EQ. TREE(NODE+3) .AND. TREE(NODE+4) .NE. 0))GOTO *23300 NXTBR=(4) RETURN 23300 CONTINUE NXTBR=(1) RETURN 23301 CONTINUE 23297 CONTINUE END INTEGER FUNCTION OUTF (NODE, BUF, I) INTEGER NODE, I INTEGER PICKUP INTEGER JUNK LOGICAL*1 BUF(100) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR IF (.NOT.( OUT .EQ. 0 .AND. PICKUP( BUF, I, NODE, 6, JUNK) .NE. -3 * ))GOTO 23302 OUTF=(0) RETURN 23302 CONTINUE IF (.NOT.(OUT .GT. 0))GOTO 23304 IF (.NOT.(AOUT(OUT) .NE. 0))GOTO 23306 CALL CHCOPY( 62, BUF, I) 23306 CONTINUE IF (.NOT.(COUT(OUT) .GT. 0))GOTO 23308 CALL STCOPY( IBUF, COUT(OUT), BUF, I) GOTO 23309 23308 CONTINUE CALL CHCOPY( 62, BUF, I) CALL GPNAME( IABS(COUT(OUT)), BUF, I) 23309 CONTINUE OUTF=(0) RETURN 23304 CONTINUE 23303 CONTINUE OUTF=(-3) RETURN END INTEGER FUNCTION PARAM(C) LOGICAL*1 C, NUM(2), NGETCH INTEGER GETARG, CTOI, I, JUNK COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN COMMON / CSCLIN / LIN(512) LOGICAL*1 LIN IF (.NOT.(C .EQ. 36))GOTO 23310 NUM(1) = NGETCH( NUM(1), SHIN) NUM(2) = 0 I = 1 N = CTOI( NUM, I) IF (.NOT.(N .GT. 0))GOTO 23312 IF (.NOT.( GETARG( N+1, LIN, 512) .NE. -1))GOTO 23314 CALL PBSTR(LIN) 23314 CONTINUE C = NGETCH( C, SHIN) GOTO 23313 23312 CONTINUE C = NUM(1) 23313 CONTINUE PARAM=(1) RETURN 23310 CONTINUE PARAM=(0) RETURN 23311 CONTINUE END INTEGER FUNCTION PARSER (LINE) INTEGER P, P1, P2, MARK, I, J INTEGER SYNTAX, SYN1, SYN2, SYN3 INTEGER MKTOKS, NEXTP LOGICAL*1 LINE(100) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN TREEND = 0 PP = 0 I=1 23316 IF (.NOT.(I.LE.4))GOTO 23318 J=1 23319 IF (.NOT.(J.LE.132))GOTO 23321 TKBUF(I,J) = 0 23320 J=J+1 GOTO 23319 23321 CONTINUE 23317 I=I+1 GOTO 23316 23318 CONTINUE I=1 23322 IF (.NOT.(I.LE.200))GOTO 23324 TREE(I) = 0 23323 I=I+1 GOTO 23322 23324 CONTINUE I=1 23325 IF (.NOT.(I.LE.512))GOTO 23327 IBUF(I) = 0 23326 I=I+1 GOTO 23325 23327 CONTINUE IF (.NOT.(MKTOKS(LINE,P2) .EQ. -3))GOTO 23328 PARSER=(-3) RETURN 23328 CONTINUE TKBUF( 2, 1) = 0 TKBUF( 3, 1) = -1 TKBUF( 4, 1) = P2 CALL PUTBAC (1) 23330 IF (.NOT.(NEXTP(P1) .NE. 0))GOTO 23331 MARK = TKBUF( 2, P1) P2 = TKBUF( 4, P1) IF (.NOT.(MARK .EQ. 0))GOTO 23332 PARSER = SYNTAX(P1, P2) GOTO 23333 23332 CONTINUE IF (.NOT.(MARK .EQ. 1))GOTO 23334 PARSER = SYN1(P1, P2) GOTO 23335 23334 CONTINUE IF (.NOT.(MARK .EQ. 2))GOTO 23336 PARSER = SYN2(P1,P2) GOTO 23337 23336 CONTINUE IF (.NOT.(MARK .EQ. 3))GOTO 23338 PARSER = SYN3(P1,P2) 23338 CONTINUE 23337 CONTINUE 23335 CONTINUE 23333 CONTINUE IF (.NOT.(PARSER .EQ. -3))GOTO 23340 RETURN 23340 CONTINUE GOTO 23330 23331 CONTINUE PARSER = 0 RETURN END SUBROUTINE PASTBL (C) LOGICAL*1 C LOGICAL*1 NGETCH COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN 23342 CONTINUE C = NGETCH(C, SHIN) 23343 IF (.NOT.(C .NE. 32 .AND. C .NE. 9))GOTO 23342 23344 CONTINUE RETURN END INTEGER FUNCTION PICKUP( ARRAY, I, NODE, FIELD, ARG) INTEGER NODE, FIELD, ARG, I LOGICAL*1 ARRAY(100) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF PICKUP = 0 IF (.NOT.( (FIELD .EQ. 5 .OR. FIELD .EQ. 6 .OR. FIELD .EQ. 7) .AND *. (TREE(NODE+2) .EQ. 99 .OR. TREE(NODE+2) .EQ. 112) .AND. TREE(NOD *E+FIELD) .NE. 0 ))GOTO 23345 CALL STCOPY( IBUF, TREE(NODE+FIELD), ARRAY, I) GOTO 23346 23345 CONTINUE IF (.NOT.(FIELD .EQ. 9 .AND. TREE(NODE+2) .EQ. 99))GOTO 23347 CALL STCOPY( IBUF, TREE(NODE+9), ARRAY, I) GOTO 23348 23347 CONTINUE IF (.NOT.(FIELD .EQ. 10 .AND. TREE(NODE+2) .EQ. 99 .AND. ARG .LE. *TREE(NODE+8) ))GOTO 23349 CALL STCOPY( IBUF, TREE(NODE+9+ARG), ARRAY, I) GOTO 23350 23349 CONTINUE PICKUP = -3 23350 CONTINUE 23348 CONTINUE 23346 CONTINUE RETURN END SUBROUTINE PUTBAC (P) INTEGER P COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF PP = PP + 1 IF (.NOT.(PP .GT. 15))GOTO 23351 CALL STXERR(28Hstack size exceeded (putbac)) GOTO 23352 23351 CONTINUE STACK(PP) = P 23352 CONTINUE RETURN END SUBROUTINE PWDIR( FD, C) LOGICAL*1 FILE(40), C INTEGER FD CALL GWDIR( FILE, 5) IF (.NOT.( FILE(2) .EQ. 64 ))GOTO 23353 FILE(2) = 92 23353 CONTINUE CALL PUTLIN(FILE, FD) IF (.NOT.(C .NE. 0))GOTO 23355 CALL PUTCH(C, FD) 23355 CONTINUE RETURN END SUBROUTINE QS(CHAR, TOK) LOGICAL*1 C, TOK(100), CHAR INTEGER J, JUNK INTEGER PARAM LOGICAL*1 NGETCH COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN TOK(1) = CHAR J = 2 C=NGETCH(C,SHIN) 23357 IF (.NOT.(C .NE. 0))GOTO 23359 IF (.NOT.(C .EQ. 0))GOTO 23360 GOTO 23359 23360 CONTINUE TOK(J) = C J = J + 1 IF (.NOT.(C .EQ. CHAR))GOTO 23362 GOTO 23359 23362 CONTINUE 23358 C=NGETCH(C, SHIN) GOTO 23357 23359 CONTINUE TOK(J) = 0 RETURN END SUBROUTINE RLOGIN INTEGER OPEN COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 LGIN(9) DATA LGIN(1)/108/,LGIN(2)/111/,LGIN(3)/103/,LGIN(4)/105/,LGIN(5)/1 *10/,LGIN(6)/46/,LGIN(7)/115/,LGIN(8)/104/,LGIN(9)/0/ INUNIT = SHIN CALL TOOLDR(SH, 6) CALL CONCAT(SH, LGIN, HFILE) LOGFD = OPEN(HFILE, 1) IF (.NOT.(LOGFD .NE. -3))GOTO 23364 SHIN = LOGFD 23364 CONTINUE RETURN END SUBROUTINE SCRF (NODE, COMAND, ARGS) LOGICAL*1 COMAND(100), ARGS(100) INTEGER PICKUP, INF, OUTF, ERRF, LENGTH, LOCCOM INTEGER I, J, TYPE COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 SUFFIX(7) LOGICAL*1 PRFLAG(4) LOGICAL*1 CMFLAG(4) LOGICAL*1 DRFLAG(4) LOGICAL*1 SHSTR(3) DATA SUFFIX(1)/46/,SUFFIX(2)/116/,SUFFIX(3)/115/,SUFFIX(4)/107/,SU *FFIX(5)/0/,SUFFIX(6)/10/,SUFFIX(7)/0/ DATA PRFLAG(1)/45/,PRFLAG(2)/118/,PRFLAG(3)/32/,PRFLAG(4)/0/ DATA CMFLAG(1)/45/,CMFLAG(2)/120/,CMFLAG(3)/32/,CMFLAG(4)/0/ DATA DRFLAG(1)/45/,DRFLAG(2)/100/,DRFLAG(3)/32/,DRFLAG(4)/0/ DATA SHSTR(1)/115/,SHSTR(2)/104/,SHSTR(3)/0/ J = 1 CALL STCOPY( SHSTR, 1, ARGS, J) CALL CHCOPY( 32, ARGS, J) IF (.NOT.(PRLIN .EQ. 1))GOTO 23366 CALL STCOPY( PRFLAG, 1, ARGS, J) 23366 CONTINUE IF (.NOT.(PRCOM .EQ. 1))GOTO 23368 CALL STCOPY( CMFLAG, 1, ARGS, J) 23368 CONTINUE IF (.NOT.(DROP .EQ. 0))GOTO 23370 CALL STCOPY( DRFLAG, 1, ARGS, J) 23370 CONTINUE CALL STCOPY( COMAND, 1, ARGS, J) IF (.NOT.( LOCCOM( SHSTR, SPATH, SUFFIX, COMAND) .NE. 60 ))GOTO 23 *372 CALL REMARK( 32H? Can't locate shell image file.) RETURN 23372 CONTINUE CALL CHCOPY( 32, ARGS, J) I=1 23374 IF (.NOT.(PICKUP(ARGS, J, NODE, 10, I) .NE. -3))GOTO 23376 CALL CHCOPY( 32, ARGS, J) 23375 I=I+1 GOTO 23374 23376 CONTINUE CALL CHCOPY( 64, ARGS, J) IF (.NOT.( INF(NODE, ARGS, J) .NE. -3))GOTO 23377 CALL CHCOPY( 32, ARGS, J) GOTO 23378 23377 CONTINUE J = J - 1 23378 CONTINUE IF (.NOT.( OUTF(NODE, ARGS, J) .NE. -3))GOTO 23379 CALL CHCOPY( 32, ARGS, J) 23379 CONTINUE IF (.NOT.( ERRF(NODE, ARGS, J) .NE. -3))GOTO 23381 CALL CHCOPY( 32, ARGS, J) 23381 CONTINUE ARGS(J) = 0 RETURN END INTEGER FUNCTION SETREE (NODE, POSN, VALUE) INTEGER NODE, POSN, VALUE, I COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF I = NODE + POSN IF (.NOT.(TREE(I) .NE. 0))GOTO 23383 CALL STXERR(32Hdoubly defined argument (setree)) SETREE=(-3) RETURN 23383 CONTINUE TREE(I) = VALUE SETREE=(0) RETURN END INTEGER FUNCTION SHCOM(COMAND) LOGICAL*1 COMAND(100) INTEGER EQUAL COMMON /SHCMD/ CD(3), E(2), HO(3), HOME(5), LOGOUT(7), VON(4), VOF *F(5), XON(4), XOFF(5), SHOPTH(5) LOGICAL*1 CD LOGICAL*1 E LOGICAL*1 HO LOGICAL*1 HOME LOGICAL*1 LOGOUT LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF LOGICAL*1 SHOPTH IF (.NOT.( EQUAL( COMAND, CD) .EQ. 1 .OR. EQUAL( COMAND, HO) .EQ. * 1 .OR. EQUAL( COMAND, HOME) .EQ. 1 .OR. EQUAL( COMAND, LOGOUT) .E *Q. 1 .OR. EQUAL( COMAND, VON) .EQ. 1 .OR. EQUAL( COMAND, VOFF) .EQ *. 1 .OR. EQUAL( COMAND, XON) .EQ. 1 .OR. EQUAL( COMAND, XOFF) .EQ. * 1 .OR. EQUAL( COMAND, SHOPTH) .EQ. 1 ))GOTO 23385 SHCOM=(1) RETURN 23385 CONTINUE SHCOM=(0) RETURN 23386 CONTINUE END INTEGER FUNCTION SHELLC (COMAND, ARGS) LOGICAL*1 ARGS(100), COMAND(100) INTEGER CWDIR, EQUAL INTEGER I, STATUS COMMON /SHCMD/ CD(3), E(2), HO(3), HOME(5), LOGOUT(7), VON(4), VOF *F(5), XON(4), XOFF(5), SHOPTH(5) LOGICAL*1 CD LOGICAL*1 E LOGICAL*1 HO LOGICAL*1 HOME LOGICAL*1 LOGOUT LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF LOGICAL*1 SHOPTH COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, SCRIPT, PCTR, PFILE(15), HFILE(40), INPUT(40), SH(40), SPATH(120 *), OLDDIR(40), HOMEDR(40) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN STATUS = 0 IF (.NOT.( EQUAL( COMAND, CD) .EQ. 1))GOTO 23387 CALL GWDIR( SH, 6) IF (.NOT.( ARGS(1) .EQ. 0 ))GOTO 23389 CALL STRCPY( OLDDIR, ARGS) 23389 CONTINUE IF (.NOT.( CWDIR(ARGS) .EQ. -3 ))GOTO 23391 CALL NODIR( ARGS) STATUS = -3 GOTO 23392 23391 CONTINUE CALL STRCPY( SH, OLDDIR) CALL PWDIR(3, 10) 23392 CONTINUE GOTO 23388 23387 CONTINUE IF (.NOT.( EQUAL( COMAND, HO) .EQ. 1 .OR. EQUAL( COMAND, HOME) .EQ *. 1 ))GOTO 23393 CALL GWDIR( SH, 6) IF (.NOT.( CWDIR(HOMEDR) .EQ. -3 ))GOTO 23395 CALL NODIR( HOMEDR) STATUS = -3 GOTO 23396 23395 CONTINUE CALL STRCPY( SH, OLDDIR) CALL PWDIR( 3, 10) 23396 CONTINUE GOTO 23394 23393 CONTINUE IF (.NOT.( EQUAL(COMAND, VON) .EQ. 1 ))GOTO 23397 PRLIN = 1 GOTO 23398 23397 CONTINUE IF (.NOT.( EQUAL(COMAND, VOFF) .EQ. 1 ))GOTO 23399 PRLIN = 0 GOTO 23400 23399 CONTINUE IF (.NOT.( EQUAL(COMAND, XON) .EQ. 1 ))GOTO 23401 PRCOM = 1 GOTO 23402 23401 CONTINUE IF (.NOT.( EQUAL(COMAND, XOFF) .EQ. 1 ))GOTO 23403 PRCOM = 0 GOTO 23404 23403 CONTINUE IF (.NOT.( EQUAL(COMAND, SHOPTH) .EQ. 1 ))GOTO 23405 CALL DSPPTH GOTO 23406 23405 CONTINUE IF (.NOT.( EQUAL(COMAND, LOGOUT) .EQ. 1 ))GOTO 23407 CALL ENDSH(113) GOTO 23408 23407 CONTINUE CALL REMARK (24H? Invalid shell command.) 23408 CONTINUE 23406 CONTINUE 23404 CONTINUE 23402 CONTINUE 23400 CONTINUE 23398 CONTINUE 23394 CONTINUE 23388 CONTINUE SHELLC=(STATUS) RETURN END INTEGER FUNCTION SHLINE (LINE) LOGICAL*1 LINE(100) INTEGER EQUAL, LENGTH, LOGPMT LOGICAL*1 TMPARA(5) INTEGER I, K COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN COMMON /SHCMD/ CD(3), E(2), HO(3), HOME(5), LOGOUT(7), VON(4), VOF *F(5), XON(4), XOFF(5), SHOPTH(5) LOGICAL*1 CD LOGICAL*1 E LOGICAL*1 HO LOGICAL*1 HOME LOGICAL*1 LOGOUT LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF LOGICAL*1 SHOPTH LOGICAL*1 PCHAR(3) DATA PCHAR(1)/37/,PCHAR(2)/32/,PCHAR(3)/0/ IF (.NOT.( CARG .EQ. 1 ))GOTO 23409 IF (.NOT.( CARGDN .EQ. 1 ))GOTO 23411 LINE(1) = 0 K = -1 GOTO 23412 23411 CONTINUE CALL STRCPY( CLIN, LINE) CARGDN = 1 K = LENGTH(LINE) 23412 CONTINUE GOTO 23410 23409 CONTINUE 23413 CONTINUE K = LOGPMT( PCHAR, LINE, SHIN) IF (.NOT.(K .NE. -1))GOTO 23416 GOTO 23415 23416 CONTINUE IF (.NOT.( SHIN .EQ. LOGFD ))GOTO 23418 CALL CLOSE(SHIN) SHIN = INUNIT K = 0 23418 CONTINUE 23414 IF (.NOT.(K .EQ. -1))GOTO 23413 23415 CONTINUE 23410 CONTINUE IF (.NOT.( K .NE. -1 ))GOTO 23420 I=1 23422 IF (.NOT.(I .LE. 4 .AND. I .LE. K ))GOTO 23424 TMPARA(I) = LINE(I) 23423 I = I + 1 GOTO 23422 23424 CONTINUE TMPARA(I) = 0 CALL FOLD(TMPARA) IF (.NOT.( PRLIN .EQ. 1 .AND. EQUAL(TMPARA, VOFF) .EQ. 0 ))GOTO 23 *425 CALL PUTLIN(LINE, 3) 23425 CONTINUE 23420 CONTINUE SHLINE=(K) RETURN END INTEGER FUNCTION SHTOK (TOK) LOGICAL*1 TOK(100), C, NGETCH INTEGER SPEC, PARAM, ATBEG INTEGER I, J, PSTAT COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, LOGF *D, INUNIT, CLIN(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER LOGFD INTEGER INUNIT LOGICAL*1 CLIN PSTAT = 0 23427 CONTINUE CALL PASTBL(C) J = 1 IF (.NOT.(SPEC(C) .EQ. 1))GOTO 23430 TOK(1) = C TOK(2) = 0 SHTOK = C RETURN 23430 CONTINUE IF (.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23432 CALL QS(C, TOK) SHTOK = TOK(1) RETURN 23432 CONTINUE IF (.NOT.(C .EQ. 60 .OR. C .EQ. 62 .OR. C .EQ. 63))GOTO 23434 I=1 23436 IF (.NOT.(I.LE.2))GOTO 23438 TOK(J) = C J = J + 1 CALL PASTBL(C) IF (.NOT.(C .NE. TOK(J-1)))GOTO 23439 GOTO 23438 23439 CONTINUE 23437 I=I+1 GOTO 23436 23438 CONTINUE 23434 CONTINUE 23441 IF (.NOT.(C .NE. 0))GOTO 23443 PSTAT = PARAM(C) IF (.NOT.(C .EQ. 0))GOTO 23444 GOTO 23443 23444 CONTINUE IF (.NOT.(ATBEG(C) .EQ. 1))GOTO 23446 CALL PUTBAK(C) GOTO 23443 23446 CONTINUE IF (.NOT.(C .EQ. 64))GOTO 23448 C = NGETCH(C, SHIN) IF (.NOT.(SPEC(C) .EQ. 0 .AND. (C .NE. 64 .AND. C .NE. 36)))GOTO 2 *3450 CALL PUTBAK(C) C = 64 23450 CONTINUE 23448 CONTINUE TOK(J) = C J = J + 1 23442 C=NGETCH(C, SHIN) GOTO 23441 23443 CONTINUE TOK(J) = 0 SHTOK = TOK(1) IF (.NOT.(PSTAT .EQ. 0 .OR. J .LT. 1))GOTO 23452 RETURN 23452 CONTINUE PSTAT = 0 23428 GOTO 23427 23429 CONTINUE END INTEGER FUNCTION SPEC (C) LOGICAL*1 C LOGICAL*1 SP(8) DATA SP(1), SP(2), SP(3), SP(4), SP(5), SP(6), SP(7), SP(8) /38, 4 *0, 41, 59, 124, 94, 10, 0/ IF (.NOT.(INDEXC(SP, C) .NE. 0))GOTO 23454 SPEC = 1 IF (.NOT.(C .EQ. 94))GOTO 23456 C = 124 23456 CONTINUE GOTO 23455 23454 CONTINUE SPEC = 0 23455 CONTINUE RETURN END SUBROUTINE STRIPB(BUF) INTEGER I INTEGER LENGTH LOGICAL*1 BUF(100) I=LENGTH(BUF) 23458 IF (.NOT.(I .GT. 0 ))GOTO 23460 IF (.NOT.( BUF(I) .NE. 32 ))GOTO 23461 GOTO 23460 23461 CONTINUE 23459 I=I-1 GOTO 23458 23460 CONTINUE BUF(I+1) = 0 RETURN END SUBROUTINE STXERR (REASON) LOGICAL*1 REASON(100) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 FIRST(17) DATA FIRST(1)/63/,FIRST(2)/32/,FIRST(3)/83/,FIRST(4)/121/,FIRST(5) */110/,FIRST(6)/116/,FIRST(7)/97/,FIRST(8)/120/,FIRST(9)/32/,FIRST( *10)/101/,FIRST(11)/114/,FIRST(12)/114/,FIRST(13)/111/,FIRST(14)/11 *4/,FIRST(15)/58/,FIRST(16)/32/,FIRST(17)/0/ CALL PUTLIN(FIRST, 3) CALL PUTLIN (REASON, 3) CALL PUTCH (10, 3) RETURN END INTEGER FUNCTION SYN1 (P1,P2) LOGICAL*1 TOK INTEGER P, P1, P2, NODE, L, PT, NDX INTEGER MKTREE COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF L = 0 P=P1 23463 IF (.NOT.(P.LT.P2))GOTO 23465 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23466 L = L + 1 GOTO 23467 23466 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23468 L = L - 1 23468 CONTINUE 23467 CONTINUE IF (.NOT.(L .LT. 0))GOTO 23470 CALL STXERR(35Hunbalenced right parentheses (syn1)) GOTO 23471 23470 CONTINUE IF (.NOT.(TOK .EQ. 38 .OR. TOK .EQ. 59))GOTO 23472 IF (.NOT.(L .EQ. 0))GOTO 23474 IF (.NOT.( MKTREE( TKBUF( 3, P1), TOK, 4, NODE) .EQ. -3))GOTO 2347 *6 SYN1=(-3) RETURN 23476 CONTINUE PT = P + 1 TKBUF( 2, PT) = 0 TKBUF( 3, PT) = NODE TKBUF( 4, PT) = TKBUF( 4, P1) CALL PUTBAC(PT) TKBUF( 2, P1) = 2 TKBUF( 3, P1) = NODE TKBUF( 4, P1) = P CALL PUTBAC (P1) SYN1=(0) RETURN 23474 CONTINUE 23472 CONTINUE 23471 CONTINUE 23464 P=P+1 GOTO 23463 23465 CONTINUE IF (.NOT.(L .GT. 0))GOTO 23478 CALL STXERR(34Hunbalenced left parentheses (syn1)) GOTO 23479 23478 CONTINUE TKBUF( 2, P1) = 2 CALL PUTBAC (P1) 23479 CONTINUE SYN1=(0) RETURN END INTEGER FUNCTION SYN2 (P1,P2) LOGICAL*1 TOK INTEGER P, P1, P2, L, NODE, PT, NDX INTEGER MKTREE COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF L = 0 P=P1 23480 IF (.NOT.(P.LT.P2))GOTO 23482 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23483 L = L + 1 GOTO 23484 23483 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23485 L = L - 1 GOTO 23486 23485 CONTINUE IF (.NOT.(TOK .EQ. 124))GOTO 23487 IF (.NOT.(L .EQ. 0))GOTO 23489 IF (.NOT.( MKTREE( TKBUF( 3, P1), 124, 4, NODE) .EQ. -3))GOTO 2349 *1 SYN2=(-3) RETURN 23491 CONTINUE PT = P + 1 TKBUF( 2, PT) = 2 TKBUF( 3, PT) = NODE TKBUF( 4, PT) = TKBUF( 4, P1) CALL PUTBAC(PT) TKBUF( 2, P1) = 3 TKBUF( 3, P1) = NODE TKBUF( 4, P1) = P CALL PUTBAC (P1) SYN2=(0) RETURN 23489 CONTINUE 23487 CONTINUE 23486 CONTINUE 23484 CONTINUE 23481 P=P+1 GOTO 23480 23482 CONTINUE TKBUF( 2, P1) = 3 CALL PUTBAC (P1) SYN2=(0) RETURN END INTEGER FUNCTION SYN3 (P1,P2) INTEGER P1, P2, NDX INTEGER DOPAR, DOVERB COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF IF (.NOT.(P1 .GE. P2))GOTO 23493 CALL STXERR(20Hempty command (syn3)) SYN3=(-3) RETURN 23493 CONTINUE NDX = TKBUF( 1, P1) IF (.NOT.(IBUF(NDX) .EQ. 40))GOTO 23495 SYN3=( DOPAR(P1,P2)) RETURN 23495 CONTINUE SYN3=( DOVERB(P1,P2)) RETURN 23496 CONTINUE END INTEGER FUNCTION SYNTAX (P1,P2) INTEGER P, P1, P2, NDX LOGICAL*1 TOK COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(512) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF P=P1 23497 IF (.NOT.(P.LT.P2))GOTO 23499 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 59 .OR. TOK .EQ. 38 .OR. TOK .EQ. 10))GOTO 2350 *0 GOTO 23498 23500 CONTINUE GOTO 23499 23498 P=P+1 GOTO 23497 23499 CONTINUE IF (.NOT.(P .LT. P2))GOTO 23502 TKBUF( 2, P) = 1 TKBUF( 3, P) = TKBUF( 3, P1) TKBUF( 4, P) = TKBUF( 4, P1) CALL PUTBAC (P) 23502 CONTINUE SYNTAX=(0) RETURN END