SUBROUTINE MAIN LOGICAL*1 LINE(512) INTEGER PARSER, SHLINE CALL QUERY(39Husage: sh [-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 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 23153 ERRF = 0 GOTO 23154 23153 CONTINUE IF (.NOT.(ER .GT. 0 .AND. CERR(ER) .GT. 0))GOTO 23155 IF (.NOT.(AOUT(OUT) .NE. 0))GOTO 23157 CALL CHCOPY( 63, BUF, I) 23157 CONTINUE CALL STCOPY (IBUF, CERR(ER), BUF, I) ERRF = 0 23155 CONTINUE 23154 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 23159 IF (.NOT.(I.LE.15))GOTO 23161 PFILE(I) = 0 23160 I=I+1 GOTO 23159 23161 CONTINUE NODE = -1 23162 IF (.NOT.(MVNEXT(NODE, TYPE, DIR) .NE. -1))GOTO 23163 IF (.NOT.(TYPE .EQ. 59))GOTO 23164 STATUS = DOSEMI (NODE, DIR) GOTO 23165 23164 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23166 STATUS = DOAMPR (NODE, DIR) GOTO 23167 23166 CONTINUE IF (.NOT.(TYPE .EQ. 124))GOTO 23168 STATUS = DOPIPE (NODE, DIR) GOTO 23169 23168 CONTINUE IF (.NOT.(TYPE .EQ. 112))GOTO 23170 STATUS = DOPARN (NODE, DIR) GOTO 23171 23170 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23172 STATUS = DOCOM (NODE, DIR) GOTO 23173 23172 CONTINUE CALL REMARK(30H? Invalid parse tree (execut).) STATUS = -3 23173 CONTINUE 23171 CONTINUE 23169 CONTINUE 23167 CONTINUE 23165 CONTINUE IF (.NOT.( STATUS .EQ. -3 .OR. STATUS .EQ. -10 ))GOTO 23174 GOTO 23163 23174 CONTINUE GOTO 23162 23163 CONTINUE IF (.NOT.( HFILE(1) .NE. 0 ))GOTO 23176 JUNK = REMOVE(HFILE) 23176 CONTINUE I=1 23178 IF (.NOT.(I.LE.15))GOTO 23180 IF (.NOT.(PFILE(I) .EQ. 1))GOTO 23181 J = 1 CALL GPNAME( I, HFILE, J) JUNK = REMOVE( HFILE) 23181 CONTINUE 23179 I=I+1 GOTO 23178 23180 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 23183 CONTINUE JUNK = MVNEXT(NODE, TYPE, DIR) IF (.NOT.(NODE .EQ. SNODE))GOTO 23186 GOTO 23185 23186 CONTINUE IF (.NOT.(TYPE .EQ. 59 .AND. DIR .EQ. 4))GOTO 23188 CALL CHCOPY( 59, BUF, K) GOTO 23189 23188 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23190 IF (.NOT.(DIR .EQ. 4 .OR. (DIR .EQ. 1 .AND. LASTD .EQ. 3)))GOTO 23 *192 CALL CHCOPY( 38, BUF, K) 23192 CONTINUE LASTD = DIR GOTO 23191 23190 CONTINUE IF (.NOT.(TYPE .EQ. 124 .AND. DIR .EQ. 4))GOTO 23194 CALL CHCOPY( 124, BUF, K) GOTO 23195 23194 CONTINUE IF (.NOT.(TYPE .EQ. 112))GOTO 23196 CALL GPAR(NODE, DIR, BUF, K) GOTO 23197 23196 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23198 GETCL = GTASK(NODE, BUF, K) 23198 CONTINUE 23197 CONTINUE 23195 CONTINUE 23191 CONTINUE 23189 CONTINUE 23184 GOTO 23183 23185 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 23200 CALL CHCOPY( 40, BUF, I) GOTO 23201 23200 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23202 N = I CALL STCOPY( RPST, 1, BUF, I) IF (.NOT.( PICKUP( BUF, I, NODE, 5, JUNK) .NE. -3))GOTO 23204 CALL CHCOPY( 32, BUF, I) GOTO 23205 23204 CONTINUE I = N + 2 23205 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 6, JUNK) .NE. -3))GOTO 23206 CALL CHCOPY( 32, BUF, I) 23206 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 7, JUNK) .NE. -3))GOTO 23208 CALL CHCOPY( 32, BUF, I) 23208 CONTINUE 23202 CONTINUE 23201 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 23210 CALL REMARK (12Hinvalid task) J = N BUF(J) = 0 GTASK=(-3) RETURN 23210 CONTINUE GTASK = 0 CALL CHCOPY( 32, BUF, J) I=1 23212 IF (.NOT.(PICKUP( BUF, J, NODE, 10, I) .NE. -3))GOTO 23214 CALL CHCOPY( 32, BUF, J) 23213 I=I+1 GOTO 23212 23214 CONTINUE CALL CHCOPY( 64, BUF, J) IF (.NOT.( PICKUP( BUF, J, NODE, 5, JUNK) .NE. -3))GOTO 23215 CALL CHCOPY( 32, BUF, J) GOTO 23216 23215 CONTINUE J = J - 1 23216 CONTINUE IF (.NOT.( PICKUP( BUF, J, NODE, 6, JUNK) .NE. -3))GOTO 23217 CALL CHCOPY( 32, BUF, J) 23217 CONTINUE IF (.NOT.( PICKUP( BUF, J, NODE, 7, JUNK) .NE. -3))GOTO 23219 CALL CHCOPY( 32, BUF, J) 23219 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 23221 CALL REMARK(34H? Can't open file for inline text.) HFILE(1) = 0 I = N BUF(I) = 0 RETURN 23221 CONTINUE CALL STCOPY( HFILE, 1, BUF, I) 23223 IF (.NOT.( GETLIN( LIN, SHIN) .NE. -1))GOTO 23224 IF (.NOT.(LIN(1) .EQ. CHAR))GOTO 23225 GOTO 23224 23225 CONTINUE CALL PUTLIN(LIN, INT) GOTO 23223 23224 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 23227 CALL CHCOPY( 60, BUF, I) CALL GPNAME( IABS(CIN(IN)), BUF, I) GOTO 23228 23227 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 5, JUNK) .EQ. -3 .AND. IN .GT. 0 *))GOTO 23229 CALL STCOPY( IBUF, CIN(IN), BUF, I) GOTO 23230 23229 CONTINUE IF (.NOT.(SCRIPT .EQ. 1 .AND. INPUT(1) .NE. 0))GOTO 23231 CALL CHCOPY( 60, BUF, I) CALL STCOPY( INPUT, 1, BUF, I) 23231 CONTINUE 23230 CONTINUE 23228 CONTINUE IF (.NOT.(BUF(N) .EQ. 60 .AND. BUF(N+1) .EQ. 60))GOTO 23233 CHAR = BUF(N+2) I = N CALL HERDOC( CHAR, BUF, I) 23233 CONTINUE IF (.NOT.(BUF(N) .NE. 0))GOTO 23235 INF=(0) RETURN 23235 CONTINUE INF=(-3) RETURN 23236 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 23237 IF (.NOT.(GETARG(I, CLIN, 512) .NE. -1 ))GOTO 23239 IF (.NOT.( I .EQ. 1 .AND. CLIN(1) .EQ. 45 ))GOTO 23240 CALL FOLD(CLIN) IF (.NOT.( INDEXC( CLIN, 118) .GT. 0 ))GOTO 23242 PRLIN = 1 23242 CONTINUE IF (.NOT.( INDEXC( CLIN, 110) .GT. 0 ))GOTO 23244 EXEC = 0 23244 CONTINUE IF (.NOT.( INDEXC( CLIN, 120) .GT. 0 ))GOTO 23246 PRCOM = 1 23246 CONTINUE IF (.NOT.( INDEXC( CLIN, 99) .GT. 0 ))GOTO 23248 CARG = 1 23248 CONTINUE IF (.NOT.( INDEXC( CLIN, 100) .GT. 0 ))GOTO 23250 DROP = 0 23250 CONTINUE CALL DELARG(I) I = I - 1 GOTO 23241 23240 CONTINUE IF (.NOT.( CARG .EQ. 1 ))GOTO 23252 CALL ARGLIN(CLIN, I) CARGDN = 0 GOTO 23239 23252 CONTINUE IF (.NOT.( I .EQ. 1 ))GOTO 23254 IF (.NOT.( LOCCOM( CLIN, SPATH, SUFFIX, CLIN) .NE. 12 ))GOTO 23256 CALL CANT(CLIN) 23256 CONTINUE SHIN = OPEN(CLIN, 1) IF (.NOT.( SHIN .EQ. -3 ))GOTO 23258 CALL CANT(CLIN) 23258 CONTINUE SCRIPT = 1 GOTO 23255 23254 CONTINUE IF (.NOT.( CLIN(1) .EQ. 64 ))GOTO 23260 IF (.NOT.( CLIN(2) .EQ. 60 ))GOTO 23262 CALL SCOPY(CLIN, 3, INPUT, 1) GOTO 23263 23262 CONTINUE GOTO 23238 23263 CONTINUE CALL DELARG (I) I = I - 1 23260 CONTINUE 23255 CONTINUE 23253 CONTINUE 23241 CONTINUE 23238 I = I + 1 GOTO 23237 23239 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 23264 IF (.NOT.(SHTOK(IBUF(I)) .NE. 0))GOTO 23266 IF (.NOT.(IBUF(I) .NE. 0))GOTO 23267 TKBUF(1,K) = I TKBUF(2,K) = 0 TKBUF(3,K) = 0 TKBUF(4,K) = 0 IF (.NOT.(IBUF(I) .EQ. 40))GOTO 23269 PAREN = PAREN + 1 GOTO 23270 23269 CONTINUE IF (.NOT.(IBUF(I) .EQ. 41))GOTO 23271 PAREN = PAREN - 1 23271 CONTINUE 23270 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 23273 CALL REMARK(20H? Unbalanced quotes.) MKTOKS=(-3) RETURN 23273 CONTINUE I = L + 2 23267 CONTINUE 23265 K=K+1 GOTO 23264 23266 CONTINUE K = K - 1 IBUF(I) = 0 IF (.NOT.(PAREN .NE. 0))GOTO 23275 MKTOKS=(-3) RETURN 23275 CONTINUE MKTOKS=(0) RETURN 23276 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 23277 CALL STXERR(34Htree buffer size exceeded (mktree)) CNODE = -3 MKTREE=(-3) RETURN 23277 CONTINUE I=1 23279 IF (.NOT.(I.LE.SIZE))GOTO 23281 TREE(CNODE+I) = 0 23280 I=I+1 GOTO 23279 23281 CONTINUE TREE(CNODE+1) = PNODE TREE(CNODE+2) = TYPE IF (.NOT.(PNODE .GE. 0))GOTO 23282 IF (.NOT.(TREE(PNODE+3) .EQ. 0))GOTO 23284 TREE(PNODE+3) = CNODE GOTO 23285 23284 CONTINUE IF (.NOT.(TREE(PNODE+4) .EQ. 0))GOTO 23286 TREE(PNODE+4) = CNODE GOTO 23287 23286 CONTINUE CALL STXERR(26Htoo many children (mktree)) MKTREE=(-3) RETURN 23287 CONTINUE 23285 CONTINUE 23282 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 23288 MVNEXT = 0 DIR = 3 GOTO 23289 23288 CONTINUE MVNEXT = TREE(NODE+DIR) 23289 CONTINUE IF (.NOT.(MVNEXT .NE. -1))GOTO 23290 TYPE = TREE(MVNEXT+2) DIR = NXTBR(MVNEXT, NODE) 23290 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 23292 P = 0 GOTO 23293 23292 CONTINUE P = STACK(PP) PP = PP - 1 23293 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 23294 IF (.NOT.(TREE(NODE+3) .NE. 0))GOTO 23296 NXTBR=(3) RETURN 23296 CONTINUE NXTBR=(1) RETURN 23297 CONTINUE GOTO 23295 23294 CONTINUE IF (.NOT.(LNODE .EQ. TREE(NODE+3) .AND. TREE(NODE+4) .NE. 0))GOTO *23298 NXTBR=(4) RETURN 23298 CONTINUE NXTBR=(1) RETURN 23299 CONTINUE 23295 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 23300 OUTF=(0) RETURN 23300 CONTINUE IF (.NOT.(OUT .GT. 0))GOTO 23302 IF (.NOT.(AOUT(OUT) .NE. 0))GOTO 23304 CALL CHCOPY( 62, BUF, I) 23304 CONTINUE IF (.NOT.(COUT(OUT) .GT. 0))GOTO 23306 CALL STCOPY( IBUF, COUT(OUT), BUF, I) GOTO 23307 23306 CONTINUE CALL CHCOPY( 62, BUF, I) CALL GPNAME( IABS(COUT(OUT)), BUF, I) 23307 CONTINUE OUTF=(0) RETURN 23302 CONTINUE 23301 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 23308 NUM(1) = NGETCH( NUM(1), SHIN) NUM(2) = 0 I = 1 N = CTOI( NUM, I) IF (.NOT.(N .GT. 0))GOTO 23310 IF (.NOT.( GETARG( N+1, LIN, 512) .NE. -1))GOTO 23312 CALL PBSTR(LIN) 23312 CONTINUE C = NGETCH( C, SHIN) GOTO 23311 23310 CONTINUE C = NUM(1) 23311 CONTINUE PARAM=(1) RETURN 23308 CONTINUE PARAM=(0) RETURN 23309 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 23314 IF (.NOT.(I.LE.4))GOTO 23316 J=1 23317 IF (.NOT.(J.LE.132))GOTO 23319 TKBUF(I,J) = 0 23318 J=J+1 GOTO 23317 23319 CONTINUE 23315 I=I+1 GOTO 23314 23316 CONTINUE I=1 23320 IF (.NOT.(I.LE.200))GOTO 23322 TREE(I) = 0 23321 I=I+1 GOTO 23320 23322 CONTINUE I=1 23323 IF (.NOT.(I.LE.512))GOTO 23325 IBUF(I) = 0 23324 I=I+1 GOTO 23323 23325 CONTINUE IF (.NOT.(MKTOKS(LINE,P2) .EQ. -3))GOTO 23326 PARSER=(-3) RETURN 23326 CONTINUE TKBUF( 2, 1) = 0 TKBUF( 3, 1) = -1 TKBUF( 4, 1) = P2 CALL PUTBAC (1) 23328 IF (.NOT.(NEXTP(P1) .NE. 0))GOTO 23329 MARK = TKBUF( 2, P1) P2 = TKBUF( 4, P1) IF (.NOT.(MARK .EQ. 0))GOTO 23330 PARSER = SYNTAX(P1, P2) GOTO 23331 23330 CONTINUE IF (.NOT.(MARK .EQ. 1))GOTO 23332 PARSER = SYN1(P1, P2) GOTO 23333 23332 CONTINUE IF (.NOT.(MARK .EQ. 2))GOTO 23334 PARSER = SYN2(P1,P2) GOTO 23335 23334 CONTINUE IF (.NOT.(MARK .EQ. 3))GOTO 23336 PARSER = SYN3(P1,P2) 23336 CONTINUE 23335 CONTINUE 23333 CONTINUE 23331 CONTINUE IF (.NOT.(PARSER .EQ. -3))GOTO 23338 RETURN 23338 CONTINUE GOTO 23328 23329 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 23340 CONTINUE C = NGETCH(C, SHIN) 23341 IF (.NOT.(C .NE. 32 .AND. C .NE. 9))GOTO 23340 23342 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 23343 CALL STCOPY( IBUF, TREE(NODE+FIELD), ARRAY, I) GOTO 23344 23343 CONTINUE IF (.NOT.(FIELD .EQ. 9 .AND. TREE(NODE+2) .EQ. 99))GOTO 23345 CALL STCOPY( IBUF, TREE(NODE+9), ARRAY, I) GOTO 23346 23345 CONTINUE IF (.NOT.(FIELD .EQ. 10 .AND. TREE(NODE+2) .EQ. 99 .AND. ARG .LE. *TREE(NODE+8) ))GOTO 23347 CALL STCOPY( IBUF, TREE(NODE+9+ARG), ARRAY, I) GOTO 23348 23347 CONTINUE PICKUP = -3 23348 CONTINUE 23346 CONTINUE 23344 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 23349 CALL STXERR(28Hstack size exceeded (putbac)) GOTO 23350 23349 CONTINUE STACK(PP) = P 23350 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 23351 FILE(2) = 92 23351 CONTINUE CALL PUTLIN(FILE, FD) IF (.NOT.(C .NE. 0))GOTO 23353 CALL PUTCH(C, FD) 23353 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) 23355 IF (.NOT.(C .NE. 0))GOTO 23357 IF (.NOT.(C .EQ. 0))GOTO 23358 GOTO 23357 23358 CONTINUE TOK(J) = C J = J + 1 IF (.NOT.(C .EQ. CHAR))GOTO 23360 GOTO 23357 23360 CONTINUE 23356 C=NGETCH(C, SHIN) GOTO 23355 23357 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 LOGFD = -3 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 23362 CALL STCOPY( PRFLAG, 1, ARGS, J) 23362 CONTINUE IF (.NOT.(PRCOM .EQ. 1))GOTO 23364 CALL STCOPY( CMFLAG, 1, ARGS, J) 23364 CONTINUE IF (.NOT.(DROP .EQ. 0))GOTO 23366 CALL STCOPY( DRFLAG, 1, ARGS, J) 23366 CONTINUE CALL STCOPY( COMAND, 1, ARGS, J) IF (.NOT.( LOCCOM( SHSTR, SPATH, SUFFIX, COMAND) .NE. 60 ))GOTO 23 *368 CALL REMARK( 32H? Can't locate shell image file.) RETURN 23368 CONTINUE CALL CHCOPY( 32, ARGS, J) I=1 23370 IF (.NOT.(PICKUP(ARGS, J, NODE, 10, I) .NE. -3))GOTO 23372 CALL CHCOPY( 32, ARGS, J) 23371 I=I+1 GOTO 23370 23372 CONTINUE CALL CHCOPY( 64, ARGS, J) IF (.NOT.( INF(NODE, ARGS, J) .NE. -3))GOTO 23373 CALL CHCOPY( 32, ARGS, J) GOTO 23374 23373 CONTINUE J = J - 1 23374 CONTINUE IF (.NOT.( OUTF(NODE, ARGS, J) .NE. -3))GOTO 23375 CALL CHCOPY( 32, ARGS, J) 23375 CONTINUE IF (.NOT.( ERRF(NODE, ARGS, J) .NE. -3))GOTO 23377 CALL CHCOPY( 32, ARGS, J) 23377 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 23379 CALL STXERR(32Hdoubly defined argument (setree)) SETREE=(-3) RETURN 23379 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 23381 SHCOM=(1) RETURN 23381 CONTINUE SHCOM=(0) RETURN 23382 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 23383 CALL GWDIR( SH, 6) IF (.NOT.( ARGS(1) .EQ. 0 ))GOTO 23385 CALL STRCPY( OLDDIR, ARGS) 23385 CONTINUE IF (.NOT.( CWDIR(ARGS) .EQ. -3 ))GOTO 23387 CALL NODIR( ARGS) STATUS = -3 GOTO 23388 23387 CONTINUE CALL STRCPY( SH, OLDDIR) CALL PWDIR(3, 10) 23388 CONTINUE GOTO 23384 23383 CONTINUE IF (.NOT.( EQUAL( COMAND, HO) .EQ. 1 .OR. EQUAL( COMAND, HOME) .EQ *. 1 ))GOTO 23389 CALL GWDIR( SH, 6) IF (.NOT.( CWDIR(HOMEDR) .EQ. -3 ))GOTO 23391 CALL NODIR( HOMEDR) STATUS = -3 GOTO 23392 23391 CONTINUE CALL STRCPY( SH, OLDDIR) CALL PWDIR( 3, 10) 23392 CONTINUE GOTO 23390 23389 CONTINUE IF (.NOT.( EQUAL(COMAND, VON) .EQ. 1 ))GOTO 23393 PRLIN = 1 GOTO 23394 23393 CONTINUE IF (.NOT.( EQUAL(COMAND, VOFF) .EQ. 1 ))GOTO 23395 PRLIN = 0 GOTO 23396 23395 CONTINUE IF (.NOT.( EQUAL(COMAND, XON) .EQ. 1 ))GOTO 23397 PRCOM = 1 GOTO 23398 23397 CONTINUE IF (.NOT.( EQUAL(COMAND, XOFF) .EQ. 1 ))GOTO 23399 PRCOM = 0 GOTO 23400 23399 CONTINUE IF (.NOT.( EQUAL(COMAND, SHOPTH) .EQ. 1 ))GOTO 23401 CALL DSPPTH GOTO 23402 23401 CONTINUE IF (.NOT.( EQUAL(COMAND, LOGOUT) .EQ. 1 ))GOTO 23403 CALL ENDSH(113) GOTO 23404 23403 CONTINUE CALL REMARK (24H? Invalid shell command.) 23404 CONTINUE 23402 CONTINUE 23400 CONTINUE 23398 CONTINUE 23396 CONTINUE 23394 CONTINUE 23390 CONTINUE 23384 CONTINUE SHELLC=(STATUS) RETURN END INTEGER FUNCTION SHLINE (LINE) LOGICAL*1 LINE(100) INTEGER EQUAL, LENGTH, PROMPT 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 23405 IF (.NOT.( CARGDN .EQ. 1 ))GOTO 23407 LINE(1) = 0 K = -1 GOTO 23408 23407 CONTINUE CALL STRCPY( CLIN, LINE) CARGDN = 1 K = LENGTH(LINE) 23408 CONTINUE GOTO 23406 23405 CONTINUE 23409 CONTINUE K = PROMPT( PCHAR, LINE, SHIN) IF (.NOT.(K .NE. -1))GOTO 23412 GOTO 23411 23412 CONTINUE IF (.NOT.( SHIN .EQ. LOGFD ))GOTO 23414 CALL CLOSE(SHIN) SHIN = INUNIT K = 0 23414 CONTINUE 23410 IF (.NOT.(K .EQ. -1))GOTO 23409 23411 CONTINUE 23406 CONTINUE IF (.NOT.( K .NE. -1 ))GOTO 23416 I=1 23418 IF (.NOT.(I .LE. 4 .AND. I .LE. K ))GOTO 23420 TMPARA(I) = LINE(I) 23419 I = I + 1 GOTO 23418 23420 CONTINUE TMPARA(I) = 0 CALL FOLD(TMPARA) IF (.NOT.( PRLIN .EQ. 1 .AND. EQUAL(TMPARA, VOFF) .EQ. 0 ))GOTO 23 *421 CALL PUTLIN(LINE, 3) 23421 CONTINUE 23416 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 23423 CONTINUE CALL PASTBL(C) J = 1 IF (.NOT.(SPEC(C) .EQ. 1))GOTO 23426 TOK(1) = C TOK(2) = 0 SHTOK = C RETURN 23426 CONTINUE IF (.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23428 CALL QS(C, TOK) SHTOK = TOK(1) RETURN 23428 CONTINUE IF (.NOT.(C .EQ. 60 .OR. C .EQ. 62 .OR. C .EQ. 63))GOTO 23430 I=1 23432 IF (.NOT.(I.LE.2))GOTO 23434 TOK(J) = C J = J + 1 CALL PASTBL(C) IF (.NOT.(C .NE. TOK(J-1)))GOTO 23435 GOTO 23434 23435 CONTINUE 23433 I=I+1 GOTO 23432 23434 CONTINUE 23430 CONTINUE 23437 IF (.NOT.(C .NE. 0))GOTO 23439 PSTAT = PARAM(C) IF (.NOT.(C .EQ. 0))GOTO 23440 GOTO 23439 23440 CONTINUE IF (.NOT.(ATBEG(C) .EQ. 1))GOTO 23442 CALL PUTBAK(C) GOTO 23439 23442 CONTINUE IF (.NOT.(C .EQ. 64))GOTO 23444 C = NGETCH(C, SHIN) IF (.NOT.(SPEC(C) .EQ. 0 .AND. (C .NE. 64 .AND. C .NE. 36)))GOTO 2 *3446 CALL PUTBAK(C) C = 64 23446 CONTINUE 23444 CONTINUE TOK(J) = C J = J + 1 23438 C=NGETCH(C, SHIN) GOTO 23437 23439 CONTINUE TOK(J) = 0 SHTOK = TOK(1) IF (.NOT.(PSTAT .EQ. 0 .OR. J .LT. 1))GOTO 23448 RETURN 23448 CONTINUE PSTAT = 0 23424 GOTO 23423 23425 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 23450 SPEC = 1 IF (.NOT.(C .EQ. 94))GOTO 23452 C = 124 23452 CONTINUE GOTO 23451 23450 CONTINUE SPEC = 0 23451 CONTINUE RETURN END SUBROUTINE STRIPB(BUF) INTEGER I INTEGER LENGTH LOGICAL*1 BUF(100) I=LENGTH(BUF) 23454 IF (.NOT.(I .GT. 0 ))GOTO 23456 IF (.NOT.( BUF(I) .NE. 32 ))GOTO 23457 GOTO 23456 23457 CONTINUE 23455 I=I-1 GOTO 23454 23456 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 23459 IF (.NOT.(P.LT.P2))GOTO 23461 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23462 L = L + 1 GOTO 23463 23462 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23464 L = L - 1 23464 CONTINUE 23463 CONTINUE IF (.NOT.(L .LT. 0))GOTO 23466 CALL STXERR(35Hunbalenced right parentheses (syn1)) GOTO 23467 23466 CONTINUE IF (.NOT.(TOK .EQ. 38 .OR. TOK .EQ. 59))GOTO 23468 IF (.NOT.(L .EQ. 0))GOTO 23470 IF (.NOT.( MKTREE( TKBUF( 3, P1), TOK, 4, NODE) .EQ. -3))GOTO 2347 *2 SYN1=(-3) RETURN 23472 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 23470 CONTINUE 23468 CONTINUE 23467 CONTINUE 23460 P=P+1 GOTO 23459 23461 CONTINUE IF (.NOT.(L .GT. 0))GOTO 23474 CALL STXERR(34Hunbalenced left parentheses (syn1)) GOTO 23475 23474 CONTINUE TKBUF( 2, P1) = 2 CALL PUTBAC (P1) 23475 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 23476 IF (.NOT.(P.LT.P2))GOTO 23478 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23479 L = L + 1 GOTO 23480 23479 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23481 L = L - 1 GOTO 23482 23481 CONTINUE IF (.NOT.(TOK .EQ. 124))GOTO 23483 IF (.NOT.(L .EQ. 0))GOTO 23485 IF (.NOT.( MKTREE( TKBUF( 3, P1), 124, 4, NODE) .EQ. -3))GOTO 2348 *7 SYN2=(-3) RETURN 23487 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 23485 CONTINUE 23483 CONTINUE 23482 CONTINUE 23480 CONTINUE 23477 P=P+1 GOTO 23476 23478 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 23489 CALL STXERR(20Hempty command (syn3)) SYN3=(-3) RETURN 23489 CONTINUE NDX = TKBUF( 1, P1) IF (.NOT.(IBUF(NDX) .EQ. 40))GOTO 23491 SYN3=( DOPAR(P1,P2)) RETURN 23491 CONTINUE SYN3=( DOVERB(P1,P2)) RETURN 23492 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 23493 IF (.NOT.(P.LT.P2))GOTO 23495 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 59 .OR. TOK .EQ. 38 .OR. TOK .EQ. 10))GOTO 2349 *6 GOTO 23494 23496 CONTINUE GOTO 23495 23494 P=P+1 GOTO 23493 23495 CONTINUE IF (.NOT.(P .LT. P2))GOTO 23498 TKBUF( 2, P) = 1 TKBUF( 3, P) = TKBUF( 3, P1) TKBUF( 4, P) = TKBUF( 4, P1) CALL PUTBAC (P) 23498 CONTINUE SYNTAX=(0) RETURN END