SUBROUTINE MAIN LOGICAL*1 LINE(400) INTEGER PARSER, SHLINE 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 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))GOT *O 23011 ATBEG = 1 GOTO 23012 23011 CONTINUE ATBEG = 0 23012 CONTINUE RETURN END SUBROUTINE ARGLIN (BUF, I) LOGICAL*1 BUF(100), LINE(400) INTEGER I, K, M INTEGER GETARG K = 1 J=I 23013 IF(.NOT.(GETARG(J, LINE, 400) .NE. -1))GOTO 23015 IF(.NOT.(LINE(1) .EQ. 64 .AND. (LINE(2) .EQ. 60 .OR. LINE(2) .EQ. *62 .OR. LINE(2) .EQ. 63)))GOTO 23016 M = 2 GOTO 23017 23016 CONTINUE M = 1 23017 CONTINUE CALL SCOPY(LINE, M, BUF, K) K = LENGTH(BUF) + 2 BUF(K-1) = 32 23014 J=J+1 GOTO 23013 23015 CONTINUE IF(.NOT.(K .GT. 1))GOTO 23018 K = K - 1 23018 CONTINUE BUF(K) = 10 BUF(K+1) = 0 RETURN END INTEGER FUNCTION CMDTYP (COMAND, PATH) LOGICAL*1 COMAND(100), PATH(100) INTEGER EQUAL, SHCOM INTEGER LOCCOM COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 LOCAL(6) LOGICAL*1 EXECUT(2) 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/ CALL SCOPY(COMAND, 1, PATH, 1) IF(.NOT.(SHCOM(COMAND) .EQ. 1))GOTO 23020 CMDTYP = 17 GOTO 23021 23020 CONTINUE IF(.NOT.(EQUAL(COMAND, EXECUT) .EQ. 1))GOTO 23022 CALL SCOPY(LOCAL, 1, PATH, 1) CMDTYP = 60 GOTO 23023 23022 CONTINUE CMDTYP = LOCCOM(COMAND, SPATH, PATH) 23023 CONTINUE 23021 CONTINUE RETURN END SUBROUTINE DOAMPR (NODE, DIR) INTEGER NODE, DIR, I INTEGER SSPAWN, GETCL LOGICAL*1 DESC(7) COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN LOGICAL*1 FIRST(7) DATA FIRST(1)/115/,FIRST(2)/104/,FIRST(3)/32/,FIRST(4)/45/,FIRST(5 *)/99/,FIRST(6)/32/,FIRST(7)/0/ IF(.NOT.(DIR .EQ. 4 .OR. DIR .EQ. 1))GOTO 23024 RETURN 23024 CONTINUE I = 1 CALL STCOPY(FIRST, 1, CLIN, I) IF(.NOT.(GETCL(NODE, DIR, CLIN(I)) .EQ. -3))GOTO 23026 RETURN 23026 CONTINUE IF(.NOT.(PRCOM .EQ. 1))GOTO 23028 CALL DSPCOM(SH, CLIN) 23028 CONTINUE IF(.NOT.(EXEC .EQ. 1))GOTO 23030 IF(.NOT.(SSPAWN(SH, CLIN, DESC, 98) .EQ. -3))GOTO 23032 CALL REMARK (32HCannot spawn background process.) GOTO 23033 23032 CONTINUE CALL REMARK (DESC) 23033 CONTINUE 23030 CONTINUE RETURN END INTEGER FUNCTION DOVERB (P1,P2) LOGICAL*1 TOK, GTOKN INTEGER P, P1, P2, P3, I, NODE INTEGER MKTREE, SETREE, GIBPTR, GPNODE TOK = GTOKN(P1) IF(.NOT.(TOK .EQ. 60 .OR. TOK .EQ. 62 .OR. TOK .EQ. 63))GOTO 23034 CALL STXERR (43Hdoverb--command must preceed redirected IO.) DOVERB = -3 RETURN 23034 CONTINUE NARGS = P2 - P1 -1 IF(.NOT.(MKTREE(GPNODE(P1), 99, 9+NARGS, NODE) .EQ. -3))GOTO 23036 DOVERB = -3 RETURN 23036 CONTINUE I = 0 P=P1 23038 IF(.NOT.(P.LT.P2))GOTO 23040 TOK = GTOKN(P) IF(.NOT.(TOK .EQ. 60))GOTO 23041 IF(.NOT.(SETREE(NODE, 5, GIBPTR(P)) .EQ. -3))GOTO 23043 DOVERB = -3 RETURN 23043 CONTINUE NARGS = NARGS - 1 GOTO 23042 23041 CONTINUE IF(.NOT.(TOK .EQ. 62))GOTO 23045 IF(.NOT.(SETREE(NODE, 6, GIBPTR(P)) .EQ. -3))GOTO 23047 DOVERB = -3 RETURN 23047 CONTINUE NARGS = NARGS - 1 GOTO 23046 23045 CONTINUE IF(.NOT.(TOK .EQ. 63))GOTO 23049 IF(.NOT.(SETREE(NODE, 7, GIBPTR(P)) .EQ. -3))GOTO 23051 DOVERB = -3 RETURN 23051 CONTINUE NARGS = NARGS - 1 GOTO 23050 23049 CONTINUE IF(.NOT.(SETREE(NODE, 9+I, GIBPTR(P)) .EQ. -3))GOTO 23053 DOVERB = -3 RETURN 23053 CONTINUE I = I + 1 23050 CONTINUE 23046 CONTINUE 23042 CONTINUE 23039 P=P+1 GOTO 23038 23040 CONTINUE IF(.NOT.(SETREE(NODE, 8, NARGS) .EQ. -3))GOTO 23055 DOVERB = -3 RETURN 23055 CONTINUE DOVERB = 0 RETURN END SUBROUTINE DOCOM (NODE, DIR) INTEGER NODE, I, J, TYPE, DIR INTEGER SSPAWN INTEGER CMDTYP, EQUAL INTEGER PICKUP, INF, OUTF, ERRF, LENGTH LOGICAL*1 BUF(400), LOCAL(6) LOGICAL*1 COMAND(40), DESC(7) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN COMMON /SHCMD/ LOGOUT(7), CD(3), HOME(5), VON(4), VOFF(5), XON(4), * XOFF(5) LOGICAL*1 LOGOUT LOGICAL*1 CD LOGICAL*1 HOME LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF DATA LOCAL/108, 111, 99, 97, 108, 0/ JUNK = PICKUP(BUF, NODE, 9, JUNK) CALL FOLD(BUF) TYPE = CMDTYP(BUF, COMAND) IF(.NOT.(TYPE .EQ. -3 .AND. DROP .EQ. 0))GOTO 23057 CALL REMARK (13Hinvalid task.) RETURN 23057 CONTINUE IF(.NOT.(EQUAL(COMAND, LOCAL) .EQ. 1 .OR. TYPE .EQ. 17))GOTO 23059 J = 1 GOTO 23060 23059 CONTINUE J = LENGTH(BUF) + 2 BUF(J-1) = 32 23060 CONTINUE IF(.NOT.(TYPE .EQ. 12))GOTO 23061 CALL SCRF(NODE, COMAND, BUF) GOTO 23062 23061 CONTINUE IF(.NOT.(TYPE .EQ. -3))GOTO 23063 CALL SCOPY(LOCAL, 1, COMAND, 1) 23063 CONTINUE I=1 23065 IF(.NOT.(PICKUP(BUF(J),NODE,10,I) .NE. -3))GOTO 23067 J = LENGTH(BUF) + 2 BUF(J-1) = 32 23066 I=I+1 GOTO 23065 23067 CONTINUE IF(.NOT.(INF(NODE,BUF(J)) .NE. -3))GOTO 23068 J = LENGTH(BUF) + 2 BUF(J-1) = 32 23068 CONTINUE IF(.NOT.(OUTF(NODE, BUF(J)) .NE. -3))GOTO 23070 J = LENGTH(BUF) + 2 BUF(J-1) = 32 23070 CONTINUE IF(.NOT.(ERRF(NODE,BUF(J)) .NE. -3))GOTO 23072 J = LENGTH(BUF) + 2 BUF(J-1) = 32 23072 CONTINUE BUF(J) = 0 23062 CONTINUE IF(.NOT.(PRCOM .EQ. 1 .AND. EQUAL(COMAND, XOFF) .EQ. 0))GOTO 23074 CALL DSPCOM(COMAND, BUF) 23074 CONTINUE IF(.NOT.(EXEC .EQ. 1))GOTO 23076 IF(.NOT.(TYPE .EQ. 17))GOTO 23078 CALL SHELLC(COMAND, BUF) GOTO 23079 23078 CONTINUE IF(.NOT.(SSPAWN (COMAND, BUF, DESC, 119) .EQ. -3 .AND. TYPE .NE. - *3))GOTO 23080 CALL REMARK (21Hcannot spawn process.) 23080 CONTINUE 23079 CONTINUE 23076 CONTINUE RETURN END INTEGER FUNCTION DOPAR (P1,P2) LOGICAL*1 TOK, GTOKN INTEGER P, P1, P2, L, PNODE, NODE INTEGER SETREE, MKTREE, GIBPTR, GPNODE L = 0 P=P1 23082 IF(.NOT.(P.LT.P2))GOTO 23084 IF(.NOT.(GTOKN(P) .EQ. 40))GOTO 23085 L = L + 1 GOTO 23086 23085 CONTINUE IF(.NOT.(GTOKN(P) .EQ. 41))GOTO 23087 L = L - 1 IF(.NOT.(L .EQ. 0))GOTO 23089 GOTO 23084 23089 CONTINUE 23087 CONTINUE 23086 CONTINUE 23083 P=P+1 GOTO 23082 23084 CONTINUE IF(.NOT.(MKTREE(GPNODE(P1), PAR, 7, NODE) .EQ. -3))GOTO 23091 DOPAR = -3 RETURN 23091 CONTINUE CALL SETOKN (2, P1+1, 1) CALL SETOKN (3, P1+1, NODE) CALL SETOKN (4, P1+1, P) CALL PUTBAC (P1+1) P=P+1 23093 IF(.NOT.(P.LT.P2))GOTO 23095 IF(.NOT.(GTOKN(P) .EQ. 60))GOTO 23096 IF(.NOT.(SETREE(NODE, 5, GIBPTR(P)) .EQ. -3))GOTO 23098 DOPAR = -3 RETURN 23098 CONTINUE GOTO 23097 23096 CONTINUE IF(.NOT.(GTOKN(P) .EQ. 62))GOTO 23100 IF(.NOT.(SETREE(NODE, 6, GIBPTR(P)) .EQ. -3))GOTO 23102 DOPAR = -3 RETURN 23102 CONTINUE GOTO 23101 23100 CONTINUE IF(.NOT.(GTOKN(P) .EQ. 63))GOTO 23104 IF(.NOT.(SETREE(NODE, 7, GIBPTR(P)) .EQ. -3))GOTO 23106 DOPAR = -3 RETURN 23106 CONTINUE GOTO 23105 23104 CONTINUE CALL STXERR (43Hdopar--invalid token following parenthesis.) DOPAR = -3 RETURN 23105 CONTINUE 23101 CONTINUE 23097 CONTINUE 23094 P=P+1 GOTO 23093 23095 CONTINUE DOPAR = 0 RETURN END SUBROUTINE DOPARN (NODE, DIR) INTEGER NODE, DIR COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH IF(.NOT.(DIR .EQ. 3))GOTO 23108 IF(.NOT.(TREE(NODE+5) .NE. 0))GOTO 23110 IF(.NOT.(IN .EQ. 0 .OR. (IN .NE. 0 .AND. CIN(IN) .GT. 0) ))GOTO 23 *112 IN = IN + 1 CIN(IN) = TREE(NODE+5) TREE(NODE+5) = -TREE(NODE+5) 23112 CONTINUE 23110 CONTINUE IF(.NOT.(TREE(NODE+6) .NE. 0))GOTO 23114 IF(.NOT.(OUT .EQ. 0 .OR. (OUT .NE. 0 .AND. COUT(OUT) .GT. 0)))GOTO * 23116 OUT = OUT + 1 COUT(OUT) = TREE(NODE+6) TREE(NODE+6) = -TREE(NODE+6) 23116 CONTINUE 23114 CONTINUE IF(.NOT.(TREE(NODE+7) .NE. 0))GOTO 23118 ER = ER + 1 CERR(ER ) = TREE(NODE+7) TREE(NODE+7) = -TREE(NODE+7) 23118 CONTINUE GOTO 23109 23108 CONTINUE IF(.NOT.(TREE(NODE+5) .LT. 0))GOTO 23120 IN = IN - 1 TREE(NODE+5) = IABS(TREE(NODE+5)) 23120 CONTINUE IF(.NOT.(TREE(NODE+6) .LT. 0))GOTO 23122 OUT = OUT - 1 TREE(NODE+6) = IABS(TREE(NODE+6)) 23122 CONTINUE IF(.NOT.(TREE(NODE+7) .LT. 0))GOTO 23124 ER = ER - 1 TREE(NODE+7) = IABS(TREE(NODE+7)) 23124 CONTINUE 23109 CONTINUE RETURN END SUBROUTINE DOPIPE (NODE, DIR) INTEGER NODE, DIR COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH IF(.NOT.(DIR .EQ. 3))GOTO 23126 PCTR = PCTR + 1 PFILES(1,PCTR) = 0 OUT = OUT + 1 COUT(OUT) = -PCTR AOUT(OUT) = 0 GOTO 23127 23126 CONTINUE IF(.NOT.(DIR .EQ. 4))GOTO 23128 IN = IN + 1 CIN(IN) = COUT(OUT) OUT = OUT - 1 GOTO 23129 23128 CONTINUE PCTR = PCTR - 1 IN = IN - 1 23129 CONTINUE 23127 CONTINUE RETURN END SUBROUTINE DOSEMI (NODE, DIR) INTEGER NODE, DIR COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH IF(.NOT.(DIR .EQ. 4))GOTO 23130 IF(.NOT.(OUT .GT. 0))GOTO 23132 AOUT(OUT) = AOUT(OUT) + 1 23132 CONTINUE GOTO 23131 23130 CONTINUE IF(.NOT.(DIR .EQ. 1))GOTO 23134 IF(.NOT.(OUT .GT. 0))GOTO 23136 AOUT(OUT) = AOUT(OUT) - 1 23136 CONTINUE 23134 CONTINUE 23131 CONTINUE RETURN END SUBROUTINE ENDSH CALL R4EXIT(0) END INTEGER FUNCTION ERRF (NODE, BUF) INTEGER NODE INTEGER PICKUP INTEGER JUNK LOGICAL*1 BUF(100) COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH BUF(1) = 0 ERRF = -3 IF(.NOT.(ER .EQ. 0 .AND. PICKUP(BUF,NODE,7,JUNK) .NE. -3))GOTO 231 *38 ERRF = 0 GOTO 23139 23138 CONTINUE IF(.NOT.(ER .GT. 0 .AND. CERR(ER) .GT. 0))GOTO 23140 IF(.NOT.(AOUT(OUT) .NE. 0))GOTO 23142 BUF(1) = 63 I = 2 GOTO 23143 23142 CONTINUE I = 1 23143 CONTINUE CALL SCOPY (IBUF(CERR(ER)), 1, BUF, I) ERRF = 0 GOTO 23141 23140 CONTINUE IF(.NOT.(SCRIPT .EQ. 1 .AND. ERROR(1) .NE. 0))GOTO 23144 IF(.NOT.(ERROR(2) .NE. 63))GOTO 23146 BUF(1) = 63 CALL SCOPY(ERROR, 1, BUF, 2) CALL SCOPY(BUF, 1, ERROR, 1) GOTO 23147 23146 CONTINUE CALL SCOPY(ERROR, 1, BUF, 1) 23147 CONTINUE ERRF = 0 23144 CONTINUE 23141 CONTINUE 23139 CONTINUE RETURN END SUBROUTINE EXECUT INTEGER NODE, TYPE, DIR INTEGER MVNEXT, DOSEMI, DOAMPR, DOPIPE, DOPARN, DOCOM COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH IN = 0 OUT = 0 ER = 0 PCTR = 0 HFILE(1) = 0 I=1 23148 IF(.NOT.(I.LE.20))GOTO 23150 PFILES(1,I) = 0 23149 I=I+1 GOTO 23148 23150 CONTINUE NODE = -1 23151 IF(.NOT.(MVNEXT(NODE, TYPE, DIR) .NE. -1))GOTO 23152 IF(.NOT.(TYPE .EQ. 59))GOTO 23153 CALL DOSEMI (NODE, DIR) GOTO 23154 23153 CONTINUE IF(.NOT.(TYPE .EQ. 38))GOTO 23155 CALL DOAMPR (NODE, DIR) GOTO 23156 23155 CONTINUE IF(.NOT.(TYPE .EQ. 124))GOTO 23157 CALL DOPIPE (NODE, DIR) GOTO 23158 23157 CONTINUE IF(.NOT.(TYPE .EQ. PAR))GOTO 23159 CALL DOPARN (NODE, DIR) GOTO 23160 23159 CONTINUE IF(.NOT.(TYPE .EQ. 99))GOTO 23161 CALL DOCOM (NODE, DIR) GOTO 23162 23161 CONTINUE CALL REMARK (28Hexecut - invalid parse tree.) 23162 CONTINUE 23160 CONTINUE 23158 CONTINUE 23156 CONTINUE 23154 CONTINUE GOTO 23151 23152 CONTINUE I=1 23163 IF(.NOT.(I.LE.20))GOTO 23165 IF(.NOT.(PFILES(1,I) .NE. 0))GOTO 23166 CALL REMOVE(PFILES(1,I)) 23166 CONTINUE 23164 I=I+1 GOTO 23163 23165 CONTINUE IF(.NOT.(HFILE(1) .NE. 0))GOTO 23168 CALL REMOVE (HFILE) 23168 CONTINUE RETURN END INTEGER FUNCTION GESCAN(P) INTEGER P COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP GESCAN = TKBUF(4,P) RETURN END INTEGER FUNCTION GIBPTR (P) INTEGER P COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP GIBPTR = TKBUF(1,P) RETURN END INTEGER FUNCTION GMARK (P) INTEGER P COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP GMARK = TKBUF(2,P) RETURN END SUBROUTINE GPNAME(N, NAME) LOGICAL*1 NAME(100) INTEGER ITOC, LENGTH INTEGER I, JUNK, N LOGICAL*1 PIPEF(5) COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH IF(.NOT.(PFILES(1,N) .EQ. 0))GOTO 23170 PIPEF(1) = 112 JUNK = ITOC(N, PIPEF(2), 3) CALL SCRATF(PIPEF, PFILES(1,N)) 23170 CONTINUE CALL SCOPY(PFILES(1,N), 1, NAME, 1) RETURN END INTEGER FUNCTION GPNODE (P) INTEGER P COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP GPNODE = TKBUF(3,P) RETURN END LOGICAL*1 FUNCTION GTOKN (P) INTEGER P COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP GTOKN = IBUF(TKBUF(1,P)) RETURN END SUBROUTINE HERDOC(CHAR, BUF) LOGICAL*1 CHAR, BUF(100), LINE(400), DOC(4) INTEGER CREATE, GETLIN INTEGER INT COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN DATA DOC(1), DOC(2), DOC(3), DOC(4) /100, 111, 99, 0/ BUF(1) = 60 CALL SCRATF(DOC, BUF(2)) INT = CREATE(BUF(2), 2) IF(.NOT.(INT .EQ. -3))GOTO 23172 CALL REMARK (27Hcan't open 'here document'.) BUF(1) = 0 RETURN 23172 CONTINUE CALL SCOPY(BUF, 2, HFILE, 1) 23174 IF(.NOT.(GETLIN(LINE, SHIN) .NE. -1))GOTO 23175 IF(.NOT.(LINE(1) .EQ. CHAR))GOTO 23176 GOTO 23175 23176 CONTINUE CALL PUTLIN(LINE, INT) GOTO 23174 23175 CONTINUE CALL CLOSE(INT) RETURN END INTEGER FUNCTION INF(NODE, BUF) INTEGER NODE INTEGER PICKUP LOGICAL*1 BUF(100), CHAR COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP BUF(1) = 0 IF(.NOT.(IN .GT. 0 .AND. CIN(IN) .LT. 0))GOTO 23178 BUF(1) = 60 CALL GPNAME (IABS(CIN(IN)), BUF(2)) GOTO 23179 23178 CONTINUE IF(.NOT.(PICKUP(BUF,NODE, 5,JUNK) .EQ. -3 .AND. IN .GT. 0))GOTO 23 *180 CALL SCOPY (IBUF(CIN(IN)), 1, BUF, 1) GOTO 23181 23180 CONTINUE IF(.NOT.(SCRIPT .EQ. 1 .AND. INPUT(1) .NE. 0))GOTO 23182 BUF(1) = 60 CALL SCOPY(INPUT, 1, BUF, 2) 23182 CONTINUE 23181 CONTINUE 23179 CONTINUE IF(.NOT.(BUF(1) .EQ. 60 .AND. BUF(2) .EQ. 60))GOTO 23184 CHAR = BUF(3) CALL HERDOC (CHAR, BUF) 23184 CONTINUE IF(.NOT.(BUF(1) .NE. 0))GOTO 23186 INF = 0 GOTO 23187 23186 CONTINUE INF = -3 23187 CONTINUE RETURN END SUBROUTINE INITSH INTEGER GETARG, ASSIGN, I, OPEN, LOCCOM, LENGTH COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN COMMON /SHCMD/ LOGOUT(7), CD(3), HOME(5), VON(4), VOFF(5), XON(4), * XOFF(5) LOGICAL*1 LOGOUT LOGICAL*1 CD LOGICAL*1 HOME LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH COMMON /CDEFIO/ BP, BUF(400) INTEGER BP LOGICAL*1 BUF DATA LOGOUT(1), LOGOUT(2), LOGOUT(3), LOGOUT(4), LOGOUT(5), LOGOUT *(6), LOGOUT(7) /108, 111, 103, 111, 117, 116, 0/ DATA CD/99, 100, 0/ DATA HOME/104, 111, 109, 101, 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 OUTPUT(1) /0/ DATA ERROR(1) /0/ DATA SH(1), SH(2), SH(3)/115, 104, 0/ DATA BP /0/ DATA SHIN /1/ PRLIN = 0 EXEC = 1 PRCOM = 0 CARG = 0 DROP = 1 SCRIPT = 0 SPATH(1) = 0 I = 2 CALL MAILID(CLIN, SPATH(I)) I = I + LENGTH(SPATH(I)) + 1 CALL GETDIR(2, 6, SPATH(I)) I = I + LENGTH(SPATH(I)) + 1 CALL GETDIR(1, 6, SPATH(I)) I = I + LENGTH(SPATH(I)) + 1 SPATH(I) = 10 SPATH(I+1) = 0 IF(.NOT.(LOCCOM(SH, SPATH, SH) .NE. 60))GOTO 23188 CALL REMARK(20HCannot locate shell.) CALL ENDSH 23188 CONTINUE CALL ENBINT I=1 23190 IF(.NOT.(GETARG(I, CLIN, 400) .NE. -1))GOTO 23192 IF(.NOT.(I .EQ. 1 .AND. CLIN(1) .EQ. 45))GOTO 23193 IF(.NOT.(CLIN(2) .EQ. 118 .OR. CLIN(2) .EQ. 86))GOTO 23195 PRLIN = 1 GOTO 23196 23195 CONTINUE IF(.NOT.(CLIN(2) .EQ. 110 .OR. CLIN(2) .EQ. 78))GOTO 23197 EXEC = 0 GOTO 23198 23197 CONTINUE IF(.NOT.(CLIN(2) .EQ. 120 .OR. CLIN(2) .EQ. 88))GOTO 23199 PRCOM = 1 GOTO 23200 23199 CONTINUE IF(.NOT.(CLIN(2) .EQ. 99 .OR. CLIN(2) .EQ. 67))GOTO 23201 CARG = 1 GOTO 23202 23201 CONTINUE IF(.NOT.(CLIN(2) .EQ. 100 .OR. CLIN(2) .EQ. 68))GOTO 23203 DROP = 0 23203 CONTINUE 23202 CONTINUE 23200 CONTINUE 23198 CONTINUE 23196 CONTINUE CALL DELARG(I) I = I - 1 GOTO 23194 23193 CONTINUE IF(.NOT.(CARG .EQ. 1))GOTO 23205 CALL ARGLIN(CLIN, I) GOTO 23192 23205 CONTINUE IF(.NOT.(I .EQ. 1))GOTO 23207 IF(.NOT.(LOCCOM(CLIN, SPATH, CLIN) .NE. 12))GOTO 23209 CALL CANT(CLIN) 23209 CONTINUE SHIN = OPEN(CLIN, 1) IF(.NOT.(SHIN .EQ. -3))GOTO 23211 CALL CANT(CLIN) 23211 CONTINUE SCRIPT = 1 GOTO 23208 23207 CONTINUE IF(.NOT.(CLIN(1) .EQ. 64))GOTO 23213 IF(.NOT.(CLIN(2) .EQ. 60))GOTO 23215 CALL SCOPY(CLIN, 3, INPUT, 1) GOTO 23216 23215 CONTINUE IF(.NOT.(CLIN(2) .EQ. 62))GOTO 23217 CALL SCOPY(CLIN, 3, OUTPUT, 1) GOTO 23218 23217 CONTINUE IF(.NOT.(CLIN(2) .EQ. 63))GOTO 23219 CALL SCOPY(CLIN, 3, ERROR, 1) GOTO 23220 23219 CONTINUE GOTO 23191 23220 CONTINUE 23218 CONTINUE 23216 CONTINUE CALL DELARG (I) I = I - 1 23213 CONTINUE 23208 CONTINUE 23206 CONTINUE 23194 CONTINUE 23191 I=I+1 GOTO 23190 23192 CONTINUE RETURN END INTEGER FUNCTION MKTOKS (LINE, K) INTEGER LENGTH INTEGER I, PAREN LOGICAL*1 LINE(100) INTEGER SHTOK INTEGER K, L COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP COMMON /CDEFIO/ BP, BUF(400) INTEGER BP LOGICAL*1 BUF PAREN = 0 I = 1 CALL PUTBAK (0) CALL PBSTR (LINE) K=1 23221 IF(.NOT.(SHTOK(IBUF(I)) .NE. 0))GOTO 23223 IF(.NOT.(IBUF(I) .NE. 0))GOTO 23224 TKBUF(1,K) = I TKBUF(2,K) = 0 TKBUF(3,K) = 0 TKBUF(4,K) = 0 IF(.NOT.(IBUF(I) .EQ. 40))GOTO 23226 PAREN = PAREN + 1 GOTO 23227 23226 CONTINUE IF(.NOT.(IBUF(I) .EQ. 41))GOTO 23228 PAREN = PAREN - 1 23228 CONTINUE 23227 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 23230 CALL REMARK(18Hunbalanced quotes.) MKTOKS = -3 RETURN 23230 CONTINUE I = L + 2 23224 CONTINUE 23222 K=K+1 GOTO 23221 23223 CONTINUE K = K - 1 IBUF(I) = 0 IF(.NOT.(PAREN .NE. 0))GOTO 23232 MKTOKS = -3 GOTO 23233 23232 CONTINUE MKTOKS = 0 23233 CONTINUE RETURN END INTEGER FUNCTION MKTREE (PNODE, TYPE, SIZE, CNODE) INTEGER PNODE, TYPE, SIZE, CNODE, I COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP CNODE = TREEND TREEND = TREEND + SIZE IF(.NOT.(TREEND .GT.200))GOTO 23234 CALL STXERR (35Hmktree - tree buffer size exceeded.) CNODE = -3 MKTREE = -3 RETURN 23234 CONTINUE I=1 23236 IF(.NOT.(I.LE.SIZE))GOTO 23238 TREE(CNODE+I) = 0 23237 I=I+1 GOTO 23236 23238 CONTINUE TREE(CNODE+1) = PNODE TREE(CNODE+2) = TYPE IF(.NOT.(PNODE .GE. 0))GOTO 23239 IF(.NOT.(TREE(PNODE+3) .EQ. 0))GOTO 23241 TREE(PNODE+3) = CNODE GOTO 23242 23241 CONTINUE IF(.NOT.(TREE(PNODE+4) .EQ. 0))GOTO 23243 TREE(PNODE+4) = CNODE GOTO 23244 23243 CONTINUE CALL STXERR (26Hmktree--too many children.) MKTREE = -3 RETURN 23244 CONTINUE 23242 CONTINUE 23239 CONTINUE MKTREE = CNODE RETURN END INTEGER FUNCTION MVNEXT (NODE, TYPE, DIR) INTEGER NODE, DIR, TYPE INTEGER NXTBR COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP IF(.NOT.(NODE .EQ. -1))GOTO 23245 MVNEXT = 0 DIR = 3 GOTO 23246 23245 CONTINUE MVNEXT = TREE(NODE+DIR) 23246 CONTINUE IF(.NOT.(MVNEXT .NE. -1))GOTO 23247 TYPE = TREE(MVNEXT+2) DIR = NXTBR(MVNEXT, NODE) 23247 CONTINUE NODE = MVNEXT RETURN END INTEGER FUNCTION NEXTP (P) INTEGER P COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP IF(.NOT.(PP .EQ. 0))GOTO 23249 P = 0 GOTO 23250 23249 CONTINUE P = STACK(PP) PP = PP - 1 23250 CONTINUE NEXTP = P RETURN END INTEGER FUNCTION NXTBR (NODE, LNODE) INTEGER NODE, LNODE COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP IF(.NOT.(LNODE .EQ. TREE(NODE+1)))GOTO 23251 IF(.NOT.(TREE(NODE+3) .NE. 0))GOTO 23253 NXTBR = 3 GOTO 23254 23253 CONTINUE NXTBR = 1 23254 CONTINUE GOTO 23252 23251 CONTINUE IF(.NOT.(LNODE .EQ. TREE(NODE+3) .AND. TREE(NODE+4) .NE. 0))GOTO 2 *3255 NXTBR = 4 GOTO 23256 23255 CONTINUE NXTBR = 1 23256 CONTINUE 23252 CONTINUE RETURN END INTEGER FUNCTION OUTF (NODE, BUF) INTEGER NODE INTEGER PICKUP INTEGER JUNK LOGICAL*1 BUF(100) COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH BUF(1) = 0 OUTF = -3 IF(.NOT.(OUT .EQ. 0 .AND. PICKUP(BUF,NODE,6,JUNK) .NE. -3))GOTO 23 *257 OUTF = 0 GOTO 23258 23257 CONTINUE IF(.NOT.(OUT .GT. 0))GOTO 23259 IF(.NOT.(AOUT(OUT) .NE. 0))GOTO 23261 BUF(1) = 62 I = 2 GOTO 23262 23261 CONTINUE I = 1 23262 CONTINUE IF(.NOT.(COUT(OUT) .GT. 0))GOTO 23263 CALL SCOPY (IBUF(COUT(OUT)), 1, BUF, I) GOTO 23264 23263 CONTINUE BUF(I) = 62 CALL GPNAME(IABS(COUT(OUT)), BUF(I+1)) 23264 CONTINUE OUTF = 0 GOTO 23260 23259 CONTINUE IF(.NOT.(SCRIPT .EQ. 1 .AND. OUTPUT(1) .NE. 0))GOTO 23265 IF(.NOT.(OUTPUT(2) .NE. 62))GOTO 23267 BUF(1) = 62 CALL SCOPY(OUTPUT, 1, BUF, 2) CALL SCOPY(BUF, 1, OUTPUT, 1) GOTO 23268 23267 CONTINUE CALL SCOPY(OUTPUT, 1, BUF, 1) 23268 CONTINUE OUTF = 0 23265 CONTINUE 23260 CONTINUE 23258 CONTINUE RETURN END INTEGER FUNCTION PARAM(C) LOGICAL*1 C, NUM(2), NGETCH, TBUF(400) INTEGER GETARG, CTOI, I, JUNK COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN IF(.NOT.(C .EQ. 36))GOTO 23269 NUM(1) = NGETCH(NUM(1), SHIN) NUM(2) = 0 I = 1 N = CTOI(NUM,I) IF(.NOT.(N .GT. 0))GOTO 23271 IF(.NOT.(GETARG(N+1, TBUF, 400) .NE. -1))GOTO 23273 CALL PBSTR(TBUF) 23273 CONTINUE C = NGETCH(C, SHIN) GOTO 23272 23271 CONTINUE C = NUM(1) 23272 CONTINUE PARAM = 1 GOTO 23270 23269 CONTINUE PARAM = 0 23270 CONTINUE RETURN END INTEGER FUNCTION PARSER (LINE) INTEGER P, P1, P2, MARK INTEGER SYNTAX, SYN1, SYN2, SYN3 INTEGER MKTOKS, NEXTP, GMARK, GESCAN LOGICAL*1 LINE(100) COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN TREEND = 0 PP = 0 I=1 23275 IF(.NOT.(I.LE.4))GOTO 23277 J=1 23278 IF(.NOT.(J.LE.132))GOTO 23280 TKBUF(I,J) = 0 23279 J=J+1 GOTO 23278 23280 CONTINUE 23276 I=I+1 GOTO 23275 23277 CONTINUE I=1 23281 IF(.NOT.(I.LE.200))GOTO 23283 TREE(I) = 0 23282 I=I+1 GOTO 23281 23283 CONTINUE I=1 23284 IF(.NOT.(I.LE.400))GOTO 23286 IBUF(I) = 0 23285 I=I+1 GOTO 23284 23286 CONTINUE IF(.NOT.(MKTOKS(LINE,P2) .EQ. -3))GOTO 23287 PARSER = -3 RETURN 23287 CONTINUE CALL SETOKN (2, 1, 0) CALL SETOKN (3, 1, -1) CALL SETOKN (4, 1, P2) CALL PUTBAC (1) 23289 IF(.NOT.(NEXTP(P1) .NE. 0))GOTO 23290 MARK = GMARK(P1) P2 = GESCAN(P1) IF(.NOT.(MARK .EQ. 0))GOTO 23291 PARSER = SYNTAX(P1, P2) GOTO 23292 23291 CONTINUE IF(.NOT.(MARK .EQ. 1))GOTO 23293 PARSER = SYN1(P1, P2) GOTO 23294 23293 CONTINUE IF(.NOT.(MARK .EQ. 2))GOTO 23295 PARSER = SYN2(P1,P2) GOTO 23296 23295 CONTINUE IF(.NOT.(MARK .EQ. 3))GOTO 23297 PARSER = SYN3(P1,P2) 23297 CONTINUE 23296 CONTINUE 23294 CONTINUE 23292 CONTINUE IF(.NOT.(PARSER .EQ. -3))GOTO 23299 RETURN 23299 CONTINUE GOTO 23289 23290 CONTINUE PARSER = 0 RETURN END SUBROUTINE PASTBL (C) LOGICAL*1 C LOGICAL*1 NGETCH COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN C=NGETCH(C, SHIN) 23301 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23303 23302 C=NGETCH(C, SHIN) GOTO 23301 23303 CONTINUE RETURN END INTEGER FUNCTION PICKUP (ARRAY, NODE, FIELD, ARG) INTEGER NODE, FIELD, ARG LOGICAL*1 ARRAY(100) COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP ARRAY(1) = 0 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. PAR) .AND. TREE(NODE *+FIELD) .NE. 0 ))GOTO 23304 CALL SCOPY (IBUF(TREE(NODE+FIELD)), 1, ARRAY, 1) GOTO 23305 23304 CONTINUE IF(.NOT.(FIELD .EQ. 9 .AND. TREE(NODE+2) .EQ. 99))GOTO 23306 CALL SCOPY(IBUF(TREE(NODE+9)), 1, ARRAY, 1) GOTO 23307 23306 CONTINUE IF(.NOT.(FIELD .EQ. 10 .AND. TREE(NODE+2) .EQ. 99 .AND. ARG .LE. T *REE(NODE+8) ))GOTO 23308 CALL SCOPY (IBUF(TREE(NODE+9+ARG)),1,ARRAY,1) GOTO 23309 23308 CONTINUE PICKUP = -3 23309 CONTINUE 23307 CONTINUE 23305 CONTINUE RETURN END SUBROUTINE PUTBAC (P) INTEGER P COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP PP = PP + 1 IF(.NOT.(PP .GT. 20))GOTO 23310 CALL STXERR (28Hputbac--stack size exceeded.) GOTO 23311 23310 CONTINUE STACK(PP) = P 23311 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, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN TOK(1) = CHAR J = 2 C=NGETCH(C,SHIN) 23312 IF(.NOT.(C .NE. 0))GOTO 23314 IF(.NOT.(C .EQ. 0))GOTO 23315 GOTO 23314 23315 CONTINUE TOK(J) = C J = J + 1 IF(.NOT.(C .EQ. CHAR))GOTO 23317 GOTO 23314 23317 CONTINUE 23313 C=NGETCH(C, SHIN) GOTO 23312 23314 CONTINUE TOK(J) = 0 RETURN END SUBROUTINE REMOV LOGICAL*1 NAME(40) INTEGER DESC COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH CALL GPNAME (PCTR, NAME) CALL REMOVE (NAME) RETURN END SUBROUTINE SETOKN (POSN, P, VALUE) INTEGER POSN, P, VALUE COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP TKBUF(POSN,P) = VALUE RETURN END INTEGER FUNCTION SETREE (NODE, POSN, VALUE) INTEGER NODE, POSN, VALUE COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP I = NODE + POSN IF(.NOT.(TREE(I) .NE. 0))GOTO 23319 CALL STXERR (32Hsetree--doubly defined argument.) SETREE = -3 RETURN 23319 CONTINUE TREE(I) = VALUE SETREE = 0 RETURN END INTEGER FUNCTION SHCOM(COMAND) LOGICAL*1 COMAND(100) INTEGER EQUAL COMMON /SHCMD/ LOGOUT(7), CD(3), HOME(5), VON(4), VOFF(5), XON(4), * XOFF(5) LOGICAL*1 LOGOUT LOGICAL*1 CD LOGICAL*1 HOME LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF IF(.NOT.(EQUAL(COMAND, LOGOUT) .EQ. 1 .OR. EQUAL(COMAND, CD) .EQ. *1 .OR. EQUAL(COMAND, HOME) .EQ. 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))GOTO 23321 SHCOM = 1 GOTO 23322 23321 CONTINUE SHCOM = 0 23322 CONTINUE RETURN END SUBROUTINE SHELLC (COMAND, ARGS) LOGICAL*1 COMAND(100), ARGS(100) INTEGER EQUAL, CWDIR, I COMMON /SHCMD/ LOGOUT(7), CD(3), HOME(5), VON(4), VOFF(5), XON(4), * XOFF(5) LOGICAL*1 LOGOUT LOGICAL*1 CD LOGICAL*1 HOME LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN IF(.NOT.(EQUAL(COMAND, LOGOUT) .EQ. 1))GOTO 23323 CALL ENDSH GOTO 23324 23323 CONTINUE IF(.NOT.(EQUAL(COMAND, CD) .EQ. 1))GOTO 23325 I=1 23327 IF(.NOT.(ARGS(I) .NE. 32 .AND. ARGS(I) .NE. 0))GOTO 23329 23328 I=I+1 GOTO 23327 23329 CONTINUE ARGS(I) = 0 IF(.NOT.(CWDIR(ARGS) .EQ. -3))GOTO 23330 CALL PUTLIN(ARGS, 3) CALL REMARK(28H : directory does not exist.) 23330 CONTINUE GOTO 23326 23325 CONTINUE IF(.NOT.(EQUAL(COMAND, HOME) .EQ. 1))GOTO 23332 IF(.NOT.(CWDIR(SPATH(2)) .EQ. -3))GOTO 23334 CALL REMARK(20Hhome command failed.) 23334 CONTINUE GOTO 23333 23332 CONTINUE IF(.NOT.(EQUAL(COMAND, VON) .EQ. 1))GOTO 23336 PRLIN = 1 GOTO 23337 23336 CONTINUE IF(.NOT.(EQUAL(COMAND, VOFF) .EQ. 1))GOTO 23338 PRLIN = 0 GOTO 23339 23338 CONTINUE IF(.NOT.(EQUAL(COMAND, XON) .EQ. 1))GOTO 23340 PRCOM = 1 GOTO 23341 23340 CONTINUE IF(.NOT.(EQUAL(COMAND, XOFF) .EQ. 1))GOTO 23342 PRCOM = 0 GOTO 23343 23342 CONTINUE CALL REMARK (22Hinvalid shell command.) 23343 CONTINUE 23341 CONTINUE 23339 CONTINUE 23337 CONTINUE 23333 CONTINUE 23326 CONTINUE 23324 CONTINUE RETURN END INTEGER FUNCTION SHLINE (LINE) LOGICAL*1 LINE(100) LOGICAL*1 CLOWER INTEGER LENGTH, PROMPT, EQUAL LOGICAL*1 PCHAR(3, 2), TMPARA(5) INTEGER PPTR, I, K COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN COMMON /SHCMD/ LOGOUT(7), CD(3), HOME(5), VON(4), VOFF(5), XON(4), * XOFF(5) LOGICAL*1 LOGOUT LOGICAL*1 CD LOGICAL*1 HOME LOGICAL*1 VON LOGICAL*1 VOFF LOGICAL*1 XON LOGICAL*1 XOFF DATA PCHAR/37, 32, 0, 37, 95, 0/ IF(.NOT.(CARG .EQ. 1))GOTO 23344 IF(.NOT.(CLIN(1) .EQ. -1))GOTO 23346 SHLINE = -1 RETURN 23346 CONTINUE CALL SCOPY(CLIN, 1, LINE, 1) CLIN(1) = -1 GOTO 23345 23344 CONTINUE PPTR = 1 K = 1 23348 CONTINUE IF(.NOT.(PROMPT(PCHAR(1,PPTR), LINE(K), SHIN) .EQ. -1))GOTO 23351 SHLINE = -1 RETURN 23351 CONTINUE K = LENGTH(LINE) IF(.NOT.(LINE(K) .EQ. 10 .AND. LINE(K-1) .NE. 64))GOTO 23353 GOTO 23350 23353 CONTINUE K = K - 1 PPTR = 2 23349 GOTO 23348 23350 CONTINUE 23345 CONTINUE SHLINE = K I=1 23355 IF(.NOT.(I .LE. 4 .AND. I .LE. K))GOTO 23357 TMPARA(I) = CLOWER(LINE(I)) 23356 I=I+1 GOTO 23355 23357 CONTINUE TMPARA(I) = 0 IF(.NOT.(PRLIN .EQ. 1 .AND. EQUAL(TMPARA, VOFF) .EQ. 0))GOTO 23358 CALL PUTLIN(LINE, 2) 23358 CONTINUE 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, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN 23360 CONTINUE CALL PASTBL(C) J = 1 IF(.NOT.(SPEC(C) .EQ. 1))GOTO 23363 TOK(1) = C TOK(2) = 0 SHTOK = C RETURN 23363 CONTINUE IF(.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23365 CALL QS(C, TOK) SHTOK = TOK(1) RETURN 23365 CONTINUE IF(.NOT.(C .EQ. 60 .OR. C .EQ. 62 .OR. C .EQ. 63))GOTO 23367 I=1 23369 IF(.NOT.(I.LE.2))GOTO 23371 TOK(J) = C J = J + 1 CALL PASTBL(C) IF(.NOT.(C .NE. TOK(J-1)))GOTO 23372 GOTO 23371 23372 CONTINUE 23370 I=I+1 GOTO 23369 23371 CONTINUE 23367 CONTINUE 23374 IF(.NOT.(C .NE. 0))GOTO 23376 PSTAT = PARAM(C) IF(.NOT.(C .EQ. 0))GOTO 23377 GOTO 23376 23377 CONTINUE IF(.NOT.(ATBEG(C) .EQ. 1))GOTO 23379 CALL PUTBAK(C) GOTO 23376 23379 CONTINUE IF(.NOT.(C .EQ. 64))GOTO 23381 C = NGETCH(C, SHIN) IF(.NOT.(SPEC(C) .EQ. 0 .AND. (C .NE. 64 .AND. C .NE. 36)))GOTO 23 *383 CALL PUTBAK(C) C = 64 23383 CONTINUE 23381 CONTINUE TOK(J) = C J = J + 1 23375 N=NGETCH(C, SHIN) GOTO 23374 23376 CONTINUE TOK(J) = 0 SHTOK = TOK(1) IF(.NOT.(PSTAT .EQ. 0 .OR. J .LT. 1))GOTO 23385 RETURN 23385 CONTINUE PSTAT = 0 23361 GOTO 23360 23362 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.(INDEX(SP, C) .NE. 0))GOTO 23387 SPEC = 1 IF(.NOT.(C .EQ. 94))GOTO 23389 C = 124 23389 CONTINUE GOTO 23388 23387 CONTINUE SPEC = 0 23388 CONTINUE RETURN END SUBROUTINE STXERR (REASON) LOGICAL*1 REASON(100) COMMON /CPARS/ IBUF(400), TKBUF(4, 132), TREE(200), STACK(20), TRE *END, PP LOGICAL*1 IBUF INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP CALL PUTLIN(14Hsyntax error: , 3) CALL PUTLIN (REASON, 3) CALL PUTCH (10, 3) RETURN END INTEGER FUNCTION SYN1 (P1,P2) LOGICAL*1 TOK, GTOKN INTEGER P, P1, P2, NODE, L INTEGER GPNODE, GESCAN, MKTREE L = 0 P=P1 23391 IF(.NOT.(P.LT.P2))GOTO 23393 TOK = GTOKN(P) IF(.NOT.(TOK .EQ. 40))GOTO 23394 L = L + 1 GOTO 23395 23394 CONTINUE IF(.NOT.(TOK .EQ. 41))GOTO 23396 L = L - 1 23396 CONTINUE 23395 CONTINUE IF(.NOT.(L .LT. 0))GOTO 23398 CALL STXERR (35Hsyn1--unbalanced right parentheses.) GOTO 23399 23398 CONTINUE IF(.NOT.(TOK .EQ. 38 .OR. TOK .EQ. 59))GOTO 23400 IF(.NOT.(L .EQ. 0))GOTO 23402 IF(.NOT.(MKTREE(GPNODE(P1), TOK, 4, NODE) .EQ. -3))GOTO 23404 SYN1 = -3 RETURN 23404 CONTINUE CALL SETOKN (2, P+1, 0) CALL SETOKN (3, P+1, NODE) CALL SETOKN (4, P+1, GESCAN(P1)) CALL PUTBAC(P+1) CALL SETOKN (2, P1, 2) CALL SETOKN (3, P1, NODE) CALL SETOKN (4, P1, P) CALL PUTBAC (P1) SYN1 = 0 RETURN 23402 CONTINUE 23400 CONTINUE 23399 CONTINUE 23392 P=P+1 GOTO 23391 23393 CONTINUE IF(.NOT.(L .GT. 0))GOTO 23406 CALL STXERR (34Hsyn1--unbalanced left parentheses.) GOTO 23407 23406 CONTINUE CALL SETOKN (2, P1, 2) CALL PUTBAC (P1) 23407 CONTINUE SYN1 = 0 RETURN END INTEGER FUNCTION SYN2 (P1,P2) LOGICAL*1 TOK, GTOKN INTEGER P, P1, P2, L, NODE INTEGER GPNODE, GESCAN, MKTREE L = 0 P=P1 23408 IF(.NOT.(P.LT.P2))GOTO 23410 TOK = GTOKN(P) IF(.NOT.(TOK .EQ. 40))GOTO 23411 L = L + 1 GOTO 23412 23411 CONTINUE IF(.NOT.(TOK .EQ. 41))GOTO 23413 L = L - 1 GOTO 23414 23413 CONTINUE IF(.NOT.(TOK .EQ. 124))GOTO 23415 IF(.NOT.(L .EQ. 0))GOTO 23417 IF(.NOT.(MKTREE(GPNODE(P1), 124, 4, NODE) .EQ. -3))GOTO 23419 SYN2 = -3 RETURN 23419 CONTINUE CALL SETOKN(2, P+1, 2) CALL SETOKN(3, P+1, NODE) CALL SETOKN (4, P+1, GESCAN(P1)) CALL PUTBAC(P+1) CALL SETOKN(2, P1, 3) CALL SETOKN(3, P1, NODE) CALL SETOKN(4, P1, P) CALL PUTBAC (P1) SYN2 = 0 RETURN 23417 CONTINUE 23415 CONTINUE 23414 CONTINUE 23412 CONTINUE 23409 P=P+1 GOTO 23408 23410 CONTINUE CALL SETOKN (2, P1, 3) CALL PUTBAC (P1) SYN2 = 0 RETURN END INTEGER FUNCTION SYN3 (P1,P2) LOGICAL*1 GTOKN INTEGER P1, P2 INTEGER DOPAR, DOVERB IF(.NOT.(P1 .GE. P2))GOTO 23421 CALL STXERR (20Hsyn3--empty command.) SYN3 = -3 RETURN 23421 CONTINUE IF(.NOT.(GTOKN(P1) .EQ. 40))GOTO 23423 SYN3 = DOPAR(P1,P2) GOTO 23424 23423 CONTINUE SYN3 = DOVERB(P1,P2) 23424 CONTINUE RETURN END INTEGER FUNCTION SYNTAX (P1,P2) INTEGER P, P1, P2 LOGICAL*1 TOK, GTOKN P=P1 23425 IF(.NOT.(P.LT.P2))GOTO 23427 TOK = GTOKN(P) IF(.NOT.(TOK .EQ. 59 .OR. TOK .EQ. 38 .OR. TOK .EQ. 10))GOTO 23428 GOTO 23426 23428 CONTINUE GOTO 23427 23426 P=P+1 GOTO 23425 23427 CONTINUE IF(.NOT.(P .LT. P2))GOTO 23430 CALL SETOKN (2, P, 1) CALL SETOKN (3, P, GPNODE(P1)) CALL SETOKN (4, P, GESCAN(P1)) CALL PUTBAC (P) 23430 CONTINUE SYNTAX = 0 RETURN END SUBROUTINE SCRF (NODE, COMAND, ARGS) LOGICAL*1 COMAND(100), ARGS(100) INTEGER PICKUP, INF, OUTF, ERRF, LENGTH INTEGER I, J, TYPE COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN COMMON /STDSUB/ IN, CIN(20), OUT, COUT(20), ER, CERR(20), AOUT(20) *, SCRIPT, PCTR, PFILES(40,20), HFILE(40), INPUT(40), OUTPUT(40), E *RROR(40), SH(40), SPATH(80) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILES LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 OUTPUT LOGICAL*1 ERROR LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 PRFLAG(4) LOGICAL*1 CMFLAG(4) LOGICAL*1 DRFLAG(4) LOGICAL*1 SHSTR(4) 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)/32/,SHSTR(4)/0/ J = 1 CALL STCOPY(SHSTR, 1, ARGS, J) IF(.NOT.(PRLIN .EQ. 1))GOTO 23432 CALL STCOPY(PRFLAG, 1, ARGS, J) 23432 CONTINUE IF(.NOT.(PRCOM .EQ. 1))GOTO 23434 CALL STCOPY(CMFLAG, 1, ARGS, J) 23434 CONTINUE IF(.NOT.(DROP .EQ. 0))GOTO 23436 CALL STCOPY(DRFLAG, 1, ARGS, J) 23436 CONTINUE CALL SCOPY(COMAND, 1, ARGS, J) CALL SCOPY(SH, 1, COMAND, 1) J = LENGTH(ARGS) + 2 ARGS(J-1) = 32 I=1 23438 IF(.NOT.(PICKUP(ARGS(J), NODE, 10, I) .NE. -3))GOTO 23440 J = LENGTH(ARGS) + 2 ARGS(J-1) = 32 23439 I=I+1 GOTO 23438 23440 CONTINUE ARGS(J) = 64 IF(.NOT.(INF(NODE, ARGS(J+1)) .NE. -3))GOTO 23441 J = LENGTH(ARGS) + 2 ARGS(J) = 64 ARGS(J-1) = 32 23441 CONTINUE IF(.NOT.(OUTF(NODE, ARGS(J+1)) .NE. -3))GOTO 23443 J = LENGTH(ARGS) + 2 ARGS(J) = 64 ARGS(J-1) = 32 23443 CONTINUE IF(.NOT.(ERRF(NODE, ARGS(J+1)) .NE. -3))GOTO 23445 J = LENGTH(ARGS) + 2 23445 CONTINUE IF(.NOT.(ARGS(J) .EQ. 32))GOTO 23447 J = J - 1 23447 CONTINUE ARGS(J) = 0 RETURN END INTEGER FUNCTION GETCL(NODE, DIR, BUF) INTEGER NODE, JUNK, SNODE, TYPE, DIR, LASTD LOGICAL*1 BUF(100) INTEGER MVNEXT, GTASK COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN SNODE = NODE BUF(1) = 0 23449 CONTINUE JUNK = MVNEXT(NODE, TYPE, DIR) IF(.NOT.(NODE .EQ. SNODE))GOTO 23452 GOTO 23451 23452 CONTINUE K = LENGTH(BUF) + 1 IF(.NOT.(TYPE .EQ. 59 .AND. DIR .EQ. 4))GOTO 23454 BUF(K) = 59 BUF(K+1) = 0 GOTO 23455 23454 CONTINUE IF(.NOT.(TYPE .EQ. 38))GOTO 23456 IF(.NOT.(DIR .EQ. 4 .OR. (DIR .EQ. 1 .AND. LASTD .EQ. 3)))GOTO 234 *58 BUF(K) = 38 BUF(K+1) = 0 23458 CONTINUE LASTD = DIR GOTO 23457 23456 CONTINUE IF(.NOT.(TYPE .EQ. 124 .AND. DIR .EQ. 4))GOTO 23460 BUF(K) = 124 BUF(K+1) = 0 GOTO 23461 23460 CONTINUE IF(.NOT.(TYPE .EQ. PAR))GOTO 23462 CALL GPAR(NODE, DIR, BUF(K)) GOTO 23463 23462 CONTINUE IF(.NOT.(TYPE .EQ. 99))GOTO 23464 GETCL = GTASK(NODE, BUF(K)) 23464 CONTINUE 23463 CONTINUE 23461 CONTINUE 23457 CONTINUE 23455 CONTINUE 23450 GOTO 23449 23451 CONTINUE RETURN END SUBROUTINE GPAR(NODE, DIR, BUF) INTEGER NODE, DIR LOGICAL*1 BUF(100) INTEGER PICKUP, LENGTH IF(.NOT.(DIR .EQ. 3))GOTO 23466 BUF(1) = 40 BUF(2) = 0 GOTO 23467 23466 CONTINUE IF(.NOT.(DIR .EQ. 1))GOTO 23468 BUF(1) = 41 BUF(2) = 32 BUF(3) = 64 K = 3 IF(.NOT.( PICKUP(BUF(K+1), NODE, 5, JUNK) .NE. -3))GOTO 23470 K = LENGTH(BUF) + 2 BUF(K-1) = 32 BUF(K) = 64 23470 CONTINUE IF(.NOT.( PICKUP(BUF(K+1), NODE, 6, JUNK) .NE. -3))GOTO 23472 K = LENGTH(BUF) + 2 BUF(K-1) = 32 BUF(K) = 64 23472 CONTINUE IF(.NOT.( PICKUP(BUF(K+1), NODE, 7, JUNK) .NE. -3))GOTO 23474 K = LENGTH(BUF) + 2 23474 CONTINUE BUF(K-1) = 0 23468 CONTINUE 23467 CONTINUE RETURN END INTEGER FUNCTION GTASK(NODE, BUF) INTEGER NODE, JUNK, TYPE INTEGER PICKUP, CMDTYP LOGICAL*1 BUF(100) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, SHIN, CLIN(400) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER SHIN LOGICAL*1 CLIN JUNK = PICKUP(BUF, NODE, 9, JUNK) K = LENGTH(BUF) + 2 TYPE = CMDTYP(BUF, BUF(K)) IF(.NOT.(TYPE .EQ. -3 .AND. DROP .EQ. 0))GOTO 23476 CALL REMARK (13Hinvalid task.) GTASK = -3 RETURN 23476 CONTINUE GTASK = 0 K = LENGTH(BUF) + 2 BUF(K-1) = 32 I=1 23478 IF(.NOT.(PICKUP(BUF(K), NODE, 10, I) .NE. -3))GOTO 23480 K = LENGTH(BUF) + 2 BUF(K-1) = 32 23479 I=I+1 GOTO 23478 23480 CONTINUE BUF(K) = 64 IF(.NOT.( PICKUP(BUF(K+1), NODE, 5, JUNK) .NE. -3))GOTO 23481 K = LENGTH(BUF) + 2 BUF(K-1) = 32 BUF(K) = 64 23481 CONTINUE IF(.NOT.( PICKUP(BUF(K+1), NODE, 6, JUNK) .NE. -3))GOTO 23483 K = LENGTH(BUF) + 2 BUF(K-1) = 32 BUF(K) = 64 23483 CONTINUE IF(.NOT.( PICKUP(BUF(K+1), NODE, 7, JUNK) .NE. -3))GOTO 23485 K = LENGTH(BUF) + 2 23485 CONTINUE BUF(K-1) = 0 RETURN END SUBROUTINE DSPCOM(COM, ARG) INTEGER I INTEGER EQUAL 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, 2) I = 1 IF(.NOT.(EQUAL(COM, LOCAL) .EQ. 0))GOTO 23487 23489 IF(.NOT.(ARG(I) .NE. 32 .AND. ARG(I) .NE. 0))GOTO 23490 I = I + 1 GOTO 23489 23490 CONTINUE GOTO 23488 23487 CONTINUE CALL PUTCH(32, 2) 23488 CONTINUE CALL PUTLIN(ARG(I), 2) CALL PUTCH(10, 2) RETURN END