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 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 INTEGER 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 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, 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 INTEGER 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN 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(31HCannot 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 NODE, I, J, TYPE, DIR, STATUS INTEGER SSPAWN, SHELLC INTEGER CMDTYP, EQUAL INTEGER PICKUP, INF, OUTF, ERRF, LENGTH LOGICAL*1 LOCAL(6) LOGICAL*1 COMAND(40), DESC(7) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN 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/ 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 REMARK (13Hinvalid task.) DOCOM=(-3) RETURN 23036 CONTINUE IF (.NOT.(EQUAL(COMAND, LOCAL) .EQ. 1 .OR. TYPE .EQ. 17))GOTO 2303 *8 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 2305 *3 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(21Hcannot spawn process.) GOTO 23060 23059 CONTINUE IF (.NOT.(STATUS .NE. 0))GOTO 23061 STATUS = -3 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 23063 IF (.NOT.(P.LT.P2))GOTO 23065 NDX = TKBUF(1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23066 L = L + 1 GOTO 23067 23066 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23068 L = L - 1 IF (.NOT.(L .EQ. 0))GOTO 23070 GOTO 23065 23070 CONTINUE 23068 CONTINUE 23067 CONTINUE 23064 P=P+1 GOTO 23063 23065 CONTINUE IF (.NOT.(MKTREE(TKBUF(3, P1), PAR, 7, NODE) .EQ. -3))GOTO 23072 DOPAR = -3 RETURN 23072 CONTINUE PT = P1 + 1 TKBUF(2, PT) = 1 TKBUF(3, PT) = NODE TKBUF(4, PT) = P CALL PUTBAC (PT) P=P+1 23074 IF (.NOT.(P.LT.P2))GOTO 23076 NDX = TKBUF(1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60))GOTO 23077 IF (.NOT.(SETREE(NODE, 5, TKBUF(1, P)) .EQ. -3))GOTO 23079 DOPAR = -3 RETURN 23079 CONTINUE GOTO 23078 23077 CONTINUE IF (.NOT.(TOK .EQ. 62))GOTO 23081 IF (.NOT.(SETREE(NODE, 6, TKBUF(1, P)) .EQ. -3))GOTO 23083 DOPAR = -3 RETURN 23083 CONTINUE GOTO 23082 23081 CONTINUE IF (.NOT.(TOK .EQ. 63))GOTO 23085 IF (.NOT.(SETREE(NODE, 7, TKBUF(1, P)) .EQ. -3))GOTO 23087 DOPAR = -3 RETURN 23087 CONTINUE GOTO 23086 23085 CONTINUE CALL STXERR (43Hdopar--invalid token following parenthesis.) DOPAR = -3 RETURN 23086 CONTINUE 23082 CONTINUE 23078 CONTINUE 23075 P=P+1 GOTO 23074 23076 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 INTEGER 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 23089 IF (.NOT.(TREE(NODE+5) .NE. 0))GOTO 23091 IF (.NOT.(IN .EQ. 0 .OR. (IN .NE. 0 .AND. CIN(IN) .GT. 0) ))GOTO 2 *3093 IN = IN + 1 CIN(IN) = TREE(NODE+5) TREE(NODE+5) = -TREE(NODE+5) 23093 CONTINUE 23091 CONTINUE IF (.NOT.(TREE(NODE+6) .NE. 0))GOTO 23095 IF (.NOT.(OUT .EQ. 0 .OR. (OUT .NE. 0 .AND. COUT(OUT) .GT. 0)))GOT *O 23097 OUT = OUT + 1 COUT(OUT) = TREE(NODE+6) TREE(NODE+6) = -TREE(NODE+6) 23097 CONTINUE 23095 CONTINUE IF (.NOT.(TREE(NODE+7) .NE. 0))GOTO 23099 ER = ER + 1 CERR(ER ) = TREE(NODE+7) TREE(NODE+7) = -TREE(NODE+7) 23099 CONTINUE GOTO 23090 23089 CONTINUE IF (.NOT.(TREE(NODE+5) .LT. 0))GOTO 23101 IN = IN - 1 TREE(NODE+5) = IABS(TREE(NODE+5)) 23101 CONTINUE IF (.NOT.(TREE(NODE+6) .LT. 0))GOTO 23103 OUT = OUT - 1 TREE(NODE+6) = IABS(TREE(NODE+6)) 23103 CONTINUE IF (.NOT.(TREE(NODE+7) .LT. 0))GOTO 23105 ER = ER - 1 TREE(NODE+7) = IABS(TREE(NODE+7)) 23105 CONTINUE 23090 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 INTEGER 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 23107 PCTR = PCTR + 1 PFILE(PCTR) = 0 OUT = OUT + 1 COUT(OUT) = -PCTR AOUT(OUT) = 0 GOTO 23108 23107 CONTINUE IF (.NOT.(DIR .EQ. 4))GOTO 23109 IN = IN + 1 CIN(IN) = COUT(OUT) OUT = OUT - 1 GOTO 23110 23109 CONTINUE PCTR = PCTR - 1 IN = IN - 1 23110 CONTINUE 23108 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 INTEGER 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 23111 IF (.NOT.(OUT .GT. 0))GOTO 23113 AOUT(OUT) = AOUT(OUT) + 1 23113 CONTINUE GOTO 23112 23111 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23115 IF (.NOT.(OUT .GT. 0))GOTO 23117 AOUT(OUT) = AOUT(OUT) - 1 23117 CONTINUE 23115 CONTINUE 23112 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 2311 *9 CALL STXERR (43Hdoverb--command must preceed redirected IO.) DOVERB = -3 RETURN 23119 CONTINUE NARGS = P2 - P1 -1 IF (.NOT.(MKTREE(TKBUF(3, P1), 99, 9+NARGS, NODE) .EQ. -3))GOTO 23 *121 DOVERB = -3 RETURN 23121 CONTINUE I = 0 P=P1 23123 IF (.NOT.(P.LT.P2))GOTO 23125 NDX = TKBUF(1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60))GOTO 23126 IF (.NOT.(SETREE(NODE, 5, TKBUF(1, P)) .EQ. -3))GOTO 23128 DOVERB = -3 RETURN 23128 CONTINUE NARGS = NARGS - 1 GOTO 23127 23126 CONTINUE IF (.NOT.(TOK .EQ. 62))GOTO 23130 IF (.NOT.(SETREE(NODE, 6, TKBUF(1, P)) .EQ. -3))GOTO 23132 DOVERB = -3 RETURN 23132 CONTINUE NARGS = NARGS - 1 GOTO 23131 23130 CONTINUE IF (.NOT.(TOK .EQ. 63))GOTO 23134 IF (.NOT.(SETREE(NODE, 7, TKBUF(1, P)) .EQ. -3))GOTO 23136 DOVERB = -3 RETURN 23136 CONTINUE NARGS = NARGS - 1 GOTO 23135 23134 CONTINUE IF (.NOT.(SETREE(NODE, 9+I, TKBUF(1, P)) .EQ. -3))GOTO 23138 DOVERB = -3 RETURN 23138 CONTINUE I = I + 1 23135 CONTINUE 23131 CONTINUE 23127 CONTINUE 23124 P=P+1 GOTO 23123 23125 CONTINUE IF (.NOT.(SETREE(NODE, 8, NARGS) .EQ. -3))GOTO 23140 DOVERB = -3 RETURN 23140 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 2 *3142 23144 IF (.NOT.(ARG(I) .NE. 32 .AND. ARG(I) .NE. 0))GOTO 23145 I = I + 1 GOTO 23144 23145 CONTINUE GOTO 23143 23142 CONTINUE CALL PUTCH(32, 3) 23143 CONTINUE CALL PUTLIN(ARG(I), 3) CALL PUTCH(10, 3) RETURN END SUBROUTINE ENDSH 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 INTEGER 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 *23146 ERRF = 0 GOTO 23147 23146 CONTINUE IF (.NOT.(ER .GT. 0 .AND. CERR(ER) .GT. 0))GOTO 23148 IF (.NOT.(AOUT(OUT) .NE. 0))GOTO 23150 CALL CHCOPY(63, BUF, I) 23150 CONTINUE CALL STCOPY (IBUF(CERR(ER)), 1, BUF, I) ERRF = 0 23148 CONTINUE 23147 CONTINUE RETURN END SUBROUTINE EXECUT INTEGER NODE, TYPE, DIR, STATUS, I, J INTEGER MVNEXT, DOSEMI, DOAMPR, DOPIPE, DOPARN, DOCOM 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 INTEGER 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 23152 IF (.NOT.(I.LE.15))GOTO 23154 PFILE(I) = 0 23153 I=I+1 GOTO 23152 23154 CONTINUE NODE = -1 23155 IF (.NOT.(MVNEXT(NODE, TYPE, DIR) .NE. -1))GOTO 23156 IF (.NOT.(TYPE .EQ. 59))GOTO 23157 STATUS = DOSEMI (NODE, DIR) GOTO 23158 23157 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23159 STATUS = DOAMPR (NODE, DIR) GOTO 23160 23159 CONTINUE IF (.NOT.(TYPE .EQ. 124))GOTO 23161 STATUS = DOPIPE (NODE, DIR) GOTO 23162 23161 CONTINUE IF (.NOT.(TYPE .EQ. PAR))GOTO 23163 STATUS = DOPARN (NODE, DIR) GOTO 23164 23163 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23165 STATUS = DOCOM (NODE, DIR) GOTO 23166 23165 CONTINUE CALL REMARK (28Hexecut - invalid parse tree.) STATUS = -3 23166 CONTINUE 23164 CONTINUE 23162 CONTINUE 23160 CONTINUE 23158 CONTINUE IF (.NOT.(STATUS .EQ. -3))GOTO 23167 GOTO 23156 23167 CONTINUE GOTO 23155 23156 CONTINUE IF (.NOT.(HFILE(1) .NE. 0))GOTO 23169 CALL REMOVE (HFILE) 23169 CONTINUE I=1 23171 IF (.NOT.(I.LE.15))GOTO 23173 IF (.NOT.(PFILE(I) .EQ. 1))GOTO 23174 J = 1 CALL GPNAME(I, HFILE, J) CALL REMOVE(HFILE) 23174 CONTINUE 23172 I=I+1 GOTO 23171 23173 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN LOGICAL*1 CLIN SNODE = NODE 23176 CONTINUE JUNK = MVNEXT(NODE, TYPE, DIR) IF (.NOT.(NODE .EQ. SNODE))GOTO 23179 GOTO 23178 23179 CONTINUE IF (.NOT.(TYPE .EQ. 59 .AND. DIR .EQ. 4))GOTO 23181 CALL CHCOPY(59, BUF, K) GOTO 23182 23181 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23183 IF (.NOT.(DIR .EQ. 4 .OR. (DIR .EQ. 1 .AND. LASTD .EQ. 3)))GOTO 23 *185 CALL CHCOPY(38, BUF, K) 23185 CONTINUE LASTD = DIR GOTO 23184 23183 CONTINUE IF (.NOT.(TYPE .EQ. 124 .AND. DIR .EQ. 4))GOTO 23187 CALL CHCOPY(124, BUF, K) GOTO 23188 23187 CONTINUE IF (.NOT.(TYPE .EQ. PAR))GOTO 23189 CALL GPAR(NODE, DIR, BUF, K) GOTO 23190 23189 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23191 GETCL = GTASK(NODE, BUF, K) 23191 CONTINUE 23190 CONTINUE 23188 CONTINUE 23184 CONTINUE 23182 CONTINUE 23177 GOTO 23176 23178 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 23193 CALL CHCOPY(40, BUF, I) GOTO 23194 23193 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23195 N = I CALL STCOPY(RPST, 1, BUF, I) IF (.NOT.( PICKUP(BUF, I, NODE, 5, JUNK) .NE. -3))GOTO 23197 CALL CHCOPY(32, BUF, I) GOTO 23198 23197 CONTINUE I = N + 2 23198 CONTINUE IF (.NOT.( PICKUP(BUF, I, NODE, 6, JUNK) .NE. -3))GOTO 23199 CALL CHCOPY(32, BUF, I) 23199 CONTINUE IF (.NOT.( PICKUP(BUF, I, NODE, 7, JUNK) .NE. -3))GOTO 23201 CALL CHCOPY(32, BUF, I) 23201 CONTINUE 23195 CONTINUE 23194 CONTINUE BUF(I) = 0 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 INTEGER 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN 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 23203 CALL REMARK (13Hinvalid task.) J = N BUF(J) = 0 GTASK = -3 RETURN 23203 CONTINUE GTASK = 0 CALL CHCOPY(32, BUF, J) I=1 23205 IF (.NOT.(PICKUP(BUF, J, NODE, 10, I) .NE. -3))GOTO 23207 CALL CHCOPY(32, BUF, J) 23206 I=I+1 GOTO 23205 23207 CONTINUE CALL CHCOPY(64, BUF, J) IF (.NOT.( PICKUP(BUF, J, NODE, 5, JUNK) .NE. -3))GOTO 23208 CALL CHCOPY(32, BUF, J) GOTO 23209 23208 CONTINUE J = J - 1 23209 CONTINUE IF (.NOT.( PICKUP(BUF, J, NODE, 6, JUNK) .NE. -3))GOTO 23210 CALL CHCOPY(32, BUF, J) 23210 CONTINUE IF (.NOT.( PICKUP(BUF, J, NODE, 7, JUNK) .NE. -3))GOTO 23212 CALL CHCOPY(32, BUF, J) 23212 CONTINUE BUF(J) = 0 RETURN END SUBROUTINE HERDOC(CHAR, BUF, I) LOGICAL*1 CHAR, BUF(100), DOC(4) 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 INTEGER 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN LOGICAL*1 CLIN COMMON / CSCLIN / LIN(512) LOGICAL*1 LIN DATA DOC(1), DOC(2), DOC(3), DOC(4) /100, 111, 99, 0/ N = I CALL CHCOPY(60, BUF, I) CALL SCRATF(DOC, HFILE) INT = CREATE(HFILE, 2) IF (.NOT.(INT .EQ. -3))GOTO 23214 CALL REMARK (27Hcan't open 'here document'.) HFILE(1) = 0 I = N BUF(I) = 0 RETURN 23214 CONTINUE CALL STCOPY(HFILE, 1, BUF, I) 23216 IF (.NOT.(GETLIN(LIN, SHIN) .NE. -1))GOTO 23217 IF (.NOT.(LIN(1) .EQ. CHAR))GOTO 23218 GOTO 23217 23218 CONTINUE CALL PUTLIN(LIN, INT) GOTO 23216 23217 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 INTEGER 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 23220 CALL CHCOPY(60, BUF, I) CALL GPNAME (IABS(CIN(IN)), BUF, I) GOTO 23221 23220 CONTINUE IF (.NOT.(PICKUP(BUF, I,NODE, 5,JUNK) .EQ. -3 .AND. IN .GT. 0))GOT *O 23222 CALL STCOPY (IBUF(CIN(IN)), 1, BUF, I) GOTO 23223 23222 CONTINUE IF (.NOT.(SCRIPT .EQ. 1 .AND. INPUT(1) .NE. 0))GOTO 23224 CALL CHCOPY(60, BUF, I) CALL STCOPY(INPUT, 1, BUF, I) 23224 CONTINUE 23223 CONTINUE 23221 CONTINUE IF (.NOT.(BUF(N) .EQ. 60 .AND. BUF(N+1) .EQ. 60))GOTO 23226 CHAR = BUF(N+2) I = N CALL HERDOC (CHAR, BUF, I) 23226 CONTINUE IF (.NOT.(BUF(N) .NE. 0))GOTO 23228 INF = 0 GOTO 23229 23228 CONTINUE INF = -3 23229 CONTINUE RETURN END SUBROUTINE INITSH INTEGER GETARG, OPEN, LENGTH, LOCCOM, INDEX INTEGER I COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN 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(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 INTEGER PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 SUFFIX(3) DATA SUFFIX(1)/0/,SUFFIX(2)/10/,SUFFIX(3)/0/ 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 SHIN /1/ CALL PBINIT PRLIN = 0 EXEC = 1 PRCOM = 0 CARG = 0 DROP = 1 SCRIPT = 0 CALL IMPATH(SPATH) CALL HOMDIR(HOMEDR) CALL GWDIR(OLDDIR, 6) CALL ENBINT I=1 23230 IF (.NOT.(GETARG(I, CLIN, 512) .NE. -1))GOTO 23232 IF (.NOT.(I .EQ. 1 .AND. CLIN(1) .EQ. 45))GOTO 23233 CALL FOLD(CLIN) IF (.NOT.(INDEX(CLIN, 118) .GT. 0))GOTO 23235 PRLIN = 1 23235 CONTINUE IF (.NOT.(INDEX(CLIN, 120) .GT. 0))GOTO 23237 PRCOM = 1 23237 CONTINUE IF (.NOT.(INDEX(CLIN, 99) .GT. 0))GOTO 23239 CARG = 1 23239 CONTINUE IF (.NOT.(INDEX(CLIN, 110) .GT. 0))GOTO 23241 EXEC = 0 23241 CONTINUE IF (.NOT.(INDEX(CLIN, 100) .GT. 0))GOTO 23243 DROP = 0 23243 CONTINUE CALL DELARG(I) I = I - 1 GOTO 23234 23233 CONTINUE IF (.NOT.(CARG .EQ. 1))GOTO 23245 CALL ARGLIN(CLIN, I) CARGDN = 0 GOTO 23232 23245 CONTINUE IF (.NOT.(I .EQ. 1))GOTO 23247 IF (.NOT.(LOCCOM(CLIN, SPATH, SUFFIX, CLIN) .NE. 12))GOTO 23249 CALL CANT(CLIN) 23249 CONTINUE SHIN = OPEN(CLIN, 1) IF (.NOT.(SHIN .EQ. -3))GOTO 23251 CALL CANT(CLIN) 23251 CONTINUE SCRIPT = 1 GOTO 23248 23247 CONTINUE IF (.NOT.(CLIN(1) .EQ. 64))GOTO 23253 IF (.NOT.(CLIN(2) .EQ. 60))GOTO 23255 CALL SCOPY(CLIN, 3, INPUT, 1) GOTO 23256 23255 CONTINUE GOTO 23231 23256 CONTINUE CALL DELARG (I) I = I - 1 23253 CONTINUE 23248 CONTINUE 23246 CONTINUE 23234 CONTINUE 23231 I=I+1 GOTO 23230 23232 CONTINUE 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 23257 IF (.NOT.(SHTOK(IBUF(I)) .NE. 0))GOTO 23259 IF (.NOT.(IBUF(I) .NE. 0))GOTO 23260 TKBUF(1,K) = I TKBUF(2,K) = 0 TKBUF(3,K) = 0 TKBUF(4,K) = 0 IF (.NOT.(IBUF(I) .EQ. 40))GOTO 23262 PAREN = PAREN + 1 GOTO 23263 23262 CONTINUE IF (.NOT.(IBUF(I) .EQ. 41))GOTO 23264 PAREN = PAREN - 1 23264 CONTINUE 23263 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 23266 CALL REMARK(18Hunbalanced quotes.) MKTOKS = -3 RETURN 23266 CONTINUE I = L + 2 23260 CONTINUE 23258 K=K+1 GOTO 23257 23259 CONTINUE K = K - 1 IBUF(I) = 0 IF (.NOT.(PAREN .NE. 0))GOTO 23268 MKTOKS = -3 GOTO 23269 23268 CONTINUE MKTOKS = 0 23269 CONTINUE RETURN 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 23270 CALL STXERR (35Hmktree - tree buffer size exceeded.) CNODE = -3 MKTREE = -3 RETURN 23270 CONTINUE I=1 23272 IF (.NOT.(I.LE.SIZE))GOTO 23274 TREE(CNODE+I) = 0 23273 I=I+1 GOTO 23272 23274 CONTINUE TREE(CNODE+1) = PNODE TREE(CNODE+2) = TYPE IF (.NOT.(PNODE .GE. 0))GOTO 23275 IF (.NOT.(TREE(PNODE+3) .EQ. 0))GOTO 23277 TREE(PNODE+3) = CNODE GOTO 23278 23277 CONTINUE IF (.NOT.(TREE(PNODE+4) .EQ. 0))GOTO 23279 TREE(PNODE+4) = CNODE GOTO 23280 23279 CONTINUE CALL STXERR (26Hmktree--too many children.) MKTREE = -3 RETURN 23280 CONTINUE 23278 CONTINUE 23275 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 23281 MVNEXT = 0 DIR = 3 GOTO 23282 23281 CONTINUE MVNEXT = TREE(NODE+DIR) 23282 CONTINUE IF (.NOT.(MVNEXT .NE. -1))GOTO 23283 TYPE = TREE(MVNEXT+2) DIR = NXTBR(MVNEXT, NODE) 23283 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 23285 P = 0 GOTO 23286 23285 CONTINUE P = STACK(PP) PP = PP - 1 23286 CONTINUE NEXTP = P 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 23287 IF (.NOT.(TREE(NODE+3) .NE. 0))GOTO 23289 NXTBR = 3 GOTO 23290 23289 CONTINUE NXTBR = 1 23290 CONTINUE GOTO 23288 23287 CONTINUE IF (.NOT.(LNODE .EQ. TREE(NODE+3) .AND. TREE(NODE+4) .NE. 0))GOTO *23291 NXTBR = 4 GOTO 23292 23291 CONTINUE NXTBR = 1 23292 CONTINUE 23288 CONTINUE RETURN 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 INTEGER PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 SPATH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR OUTF = -3 IF (.NOT.(OUT .EQ. 0 .AND. PICKUP(BUF,I,NODE,6,JUNK) .NE. -3))GOTO * 23293 OUTF = 0 GOTO 23294 23293 CONTINUE IF (.NOT.(OUT .GT. 0))GOTO 23295 IF (.NOT.(AOUT(OUT) .NE. 0))GOTO 23297 CALL CHCOPY(62, BUF, I) 23297 CONTINUE IF (.NOT.(COUT(OUT) .GT. 0))GOTO 23299 CALL STCOPY (IBUF(COUT(OUT)), 1, BUF, I) GOTO 23300 23299 CONTINUE CALL CHCOPY(62, BUF, I) CALL GPNAME(IABS(COUT(OUT)), BUF, I) 23300 CONTINUE OUTF = 0 23295 CONTINUE 23294 CONTINUE 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN LOGICAL*1 CLIN COMMON / CSCLIN / LIN(512) LOGICAL*1 LIN IF (.NOT.(C .EQ. 36))GOTO 23301 NUM(1) = NGETCH(NUM(1), SHIN) NUM(2) = 0 I = 1 N = CTOI(NUM,I) IF (.NOT.(N .GT. 0))GOTO 23303 IF (.NOT.(GETARG(N+1, LIN, 512) .NE. -1))GOTO 23305 CALL PBSTR(LIN) 23305 CONTINUE C = NGETCH(C, SHIN) GOTO 23304 23303 CONTINUE C = NUM(1) 23304 CONTINUE PARAM = 1 GOTO 23302 23301 CONTINUE PARAM = 0 23302 CONTINUE RETURN END INTEGER FUNCTION PARSER (LINE) INTEGER P, P1, P2, MARK 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN LOGICAL*1 CLIN TREEND = 0 PP = 0 I=1 23307 IF (.NOT.(I.LE.4))GOTO 23309 J=1 23310 IF (.NOT.(J.LE.132))GOTO 23312 TKBUF(I,J) = 0 23311 J=J+1 GOTO 23310 23312 CONTINUE 23308 I=I+1 GOTO 23307 23309 CONTINUE I=1 23313 IF (.NOT.(I.LE.200))GOTO 23315 TREE(I) = 0 23314 I=I+1 GOTO 23313 23315 CONTINUE I=1 23316 IF (.NOT.(I.LE.512))GOTO 23318 IBUF(I) = 0 23317 I=I+1 GOTO 23316 23318 CONTINUE IF (.NOT.(MKTOKS(LINE,P2) .EQ. -3))GOTO 23319 PARSER = -3 RETURN 23319 CONTINUE TKBUF(2, 1) = 0 TKBUF(3, 1) = -1 TKBUF(4, 1) = P2 CALL PUTBAC (1) 23321 IF (.NOT.(NEXTP(P1) .NE. 0))GOTO 23322 MARK = TKBUF(2, P1) P2 = TKBUF(4, P1) IF (.NOT.(MARK .EQ. 0))GOTO 23323 PARSER = SYNTAX(P1, P2) GOTO 23324 23323 CONTINUE IF (.NOT.(MARK .EQ. 1))GOTO 23325 PARSER = SYN1(P1, P2) GOTO 23326 23325 CONTINUE IF (.NOT.(MARK .EQ. 2))GOTO 23327 PARSER = SYN2(P1,P2) GOTO 23328 23327 CONTINUE IF (.NOT.(MARK .EQ. 3))GOTO 23329 PARSER = SYN3(P1,P2) 23329 CONTINUE 23328 CONTINUE 23326 CONTINUE 23324 CONTINUE IF (.NOT.(PARSER .EQ. -3))GOTO 23331 RETURN 23331 CONTINUE GOTO 23321 23322 CONTINUE PARSER = 0 RETURN END SUBROUTINE PASTBL (C) LOGICAL*1 C LOGICAL*1 NGETCH COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN LOGICAL*1 CLIN C=NGETCH(C, SHIN) 23333 IF (.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23335 23334 C=NGETCH(C, SHIN) GOTO 23333 23335 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. PAR) .AND. TREE(NOD *E+FIELD) .NE. 0 ))GOTO 23336 CALL STCOPY (IBUF(TREE(NODE+FIELD)), 1, ARRAY, I) GOTO 23337 23336 CONTINUE IF (.NOT.(FIELD .EQ. 9 .AND. TREE(NODE+2) .EQ. 99))GOTO 23338 CALL STCOPY(IBUF(TREE(NODE+9)), 1, ARRAY, I) GOTO 23339 23338 CONTINUE IF (.NOT.(FIELD .EQ. 10 .AND. TREE(NODE+2) .EQ. 99 .AND. ARG .LE. *TREE(NODE+8) ))GOTO 23340 CALL STCOPY (IBUF(TREE(NODE+9+ARG)),1,ARRAY,I) GOTO 23341 23340 CONTINUE PICKUP = -3 23341 CONTINUE 23339 CONTINUE 23337 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 23342 CALL STXERR (28Hputbac--stack size exceeded.) GOTO 23343 23342 CONTINUE STACK(PP) = P 23343 CONTINUE RETURN END SUBROUTINE PWDIR(INT) LOGICAL*1 FILE(40) INTEGER INT CALL GWDIR(FILE, 5) CALL PUTLIN(FILE, INT) CALL PUTCH(10, INT) 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN LOGICAL*1 CLIN TOK(1) = CHAR J = 2 C=NGETCH(C,SHIN) 23344 IF (.NOT.(C .NE. 0))GOTO 23346 IF (.NOT.(C .EQ. 0))GOTO 23347 GOTO 23346 23347 CONTINUE TOK(J) = C J = J + 1 IF (.NOT.(C .EQ. CHAR))GOTO 23349 GOTO 23346 23349 CONTINUE 23345 C=NGETCH(C, SHIN) GOTO 23344 23346 CONTINUE TOK(J) = 0 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN 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 INTEGER 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 23351 CALL STCOPY(PRFLAG, 1, ARGS, J) 23351 CONTINUE IF (.NOT.(PRCOM .EQ. 1))GOTO 23353 CALL STCOPY(CMFLAG, 1, ARGS, J) 23353 CONTINUE IF (.NOT.(DROP .EQ. 0))GOTO 23355 CALL STCOPY(DRFLAG, 1, ARGS, J) 23355 CONTINUE CALL STCOPY(COMAND, 1, ARGS, J) IF (.NOT.(LOCCOM(SHSTR, SPATH, SUFFIX, COMAND) .NE. 60))GOTO 23357 CALL REMARK(31HCannot locate shell image file.) RETURN 23357 CONTINUE CALL CHCOPY(32, ARGS, J) I=1 23359 IF (.NOT.(PICKUP(ARGS, J, NODE, 10, I) .NE. -3))GOTO 23361 CALL CHCOPY(32, ARGS, J) 23360 I=I+1 GOTO 23359 23361 CONTINUE CALL CHCOPY(64, ARGS, J) IF (.NOT.(INF(NODE, ARGS, J) .NE. -3))GOTO 23362 CALL CHCOPY(32, ARGS, J) GOTO 23363 23362 CONTINUE J = J - 1 23363 CONTINUE IF (.NOT.(OUTF(NODE, ARGS, J) .NE. -3))GOTO 23364 CALL CHCOPY(32, ARGS, J) 23364 CONTINUE IF (.NOT.(ERRF(NODE, ARGS, J) .NE. -3))GOTO 23366 CALL CHCOPY(32, ARGS, J) 23366 CONTINUE ARGS(J) = 0 RETURN END INTEGER FUNCTION SETREE (NODE, POSN, VALUE) INTEGER NODE, POSN, VALUE 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 23368 CALL STXERR (32Hsetree--doubly defined argument.) SETREE = -3 RETURN 23368 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 23370 SHCOM = 1 GOTO 23371 23370 CONTINUE SHCOM = 0 23371 CONTINUE RETURN END INTEGER FUNCTION SHELLC (COMAND, ARGS) LOGICAL*1 COMAND(100), ARGS(100), TEMP(40) INTEGER EQUAL, CWDIR, I, STATUS 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(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 INTEGER 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN LOGICAL*1 CLIN STATUS = 0 IF (.NOT.(EQUAL(COMAND, LOGOUT) .EQ. 1))GOTO 23372 CALL ENDSH GOTO 23373 23372 CONTINUE IF (.NOT.(EQUAL(COMAND, CD) .EQ. 1))GOTO 23374 CALL STRCPY(ARGS, TEMP) CALL GWDIR(SH, 6) IF (.NOT.(TEMP(1) .EQ. 0))GOTO 23376 CALL STRCPY(OLDDIR, TEMP) 23376 CONTINUE IF (.NOT.(CWDIR(TEMP) .EQ. -3))GOTO 23378 CALL PUTLIN(TEMP, 3) CALL REMARK(28H : directory does not exist.) STATUS = -3 GOTO 23379 23378 CONTINUE CALL STRCPY(SH, OLDDIR) CALL PWDIR(3) 23379 CONTINUE GOTO 23375 23374 CONTINUE IF (.NOT.(EQUAL(COMAND, HOME) .EQ. 1))GOTO 23380 CALL GWDIR(SH, 6) IF (.NOT.(CWDIR(HOMEDR) .EQ. -3))GOTO 23382 CALL REMARK(20Hhome command failed.) STATUS = -3 GOTO 23383 23382 CONTINUE CALL STRCPY(SH, OLDDIR) CALL PWDIR(3) 23383 CONTINUE GOTO 23381 23380 CONTINUE IF (.NOT.(EQUAL(COMAND, VON) .EQ. 1))GOTO 23384 PRLIN = 1 GOTO 23385 23384 CONTINUE IF (.NOT.(EQUAL(COMAND, VOFF) .EQ. 1))GOTO 23386 PRLIN = 0 GOTO 23387 23386 CONTINUE IF (.NOT.(EQUAL(COMAND, XON) .EQ. 1))GOTO 23388 PRCOM = 1 GOTO 23389 23388 CONTINUE IF (.NOT.(EQUAL(COMAND, XOFF) .EQ. 1))GOTO 23390 PRCOM = 0 GOTO 23391 23390 CONTINUE CALL REMARK (22Hinvalid shell command.) 23391 CONTINUE 23389 CONTINUE 23387 CONTINUE 23385 CONTINUE 23381 CONTINUE 23375 CONTINUE 23373 CONTINUE SHELLC=(STATUS) RETURN END INTEGER FUNCTION SHLINE (LINE) LOGICAL*1 LINE(100) LOGICAL*1 CLOWER INTEGER LENGTH, LOGPMT, EQUAL LOGICAL*1 TMPARA(5) INTEGER K COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN 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 LOGICAL*1 PCHAR(3) DATA PCHAR(1)/37/,PCHAR(2)/32/,PCHAR(3)/0/ IF (.NOT.(CARG .EQ. 1))GOTO 23392 IF (.NOT.(CARGDN .EQ. 1))GOTO 23394 LINE(1) = 0 K = -1 GOTO 23395 23394 CONTINUE CALL STRCPY(CLIN, LINE) CARGDN = 1 K = LENGTH(LINE) 23395 CONTINUE GOTO 23393 23392 CONTINUE K = LOGPMT(PCHAR, LINE, SHIN) 23393 CONTINUE IF (.NOT.(K .NE. -1))GOTO 23396 I=1 23398 IF (.NOT.(I .LE. 4 .AND. I .LE. K))GOTO 23400 TMPARA(I) = CLOWER(LINE(I)) 23399 I=I+1 GOTO 23398 23400 CONTINUE TMPARA(I) = 0 IF (.NOT.(PRLIN .EQ. 1 .AND. EQUAL(TMPARA, VOFF) .EQ. 0))GOTO 2340 *1 CALL PUTLIN(LINE, 3) 23401 CONTINUE 23396 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, CLIN *(512) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN LOGICAL*1 CLIN 23403 CONTINUE CALL PASTBL(C) J = 1 IF (.NOT.(SPEC(C) .EQ. 1))GOTO 23406 TOK(1) = C TOK(2) = 0 SHTOK = C RETURN 23406 CONTINUE IF (.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23408 CALL QS(C, TOK) SHTOK = TOK(1) RETURN 23408 CONTINUE IF (.NOT.(C .EQ. 60 .OR. C .EQ. 62 .OR. C .EQ. 63))GOTO 23410 I=1 23412 IF (.NOT.(I.LE.2))GOTO 23414 TOK(J) = C J = J + 1 CALL PASTBL(C) IF (.NOT.(C .NE. TOK(J-1)))GOTO 23415 GOTO 23414 23415 CONTINUE 23413 I=I+1 GOTO 23412 23414 CONTINUE 23410 CONTINUE 23417 IF (.NOT.(C .NE. 0))GOTO 23419 PSTAT = PARAM(C) IF (.NOT.(C .EQ. 0))GOTO 23420 GOTO 23419 23420 CONTINUE IF (.NOT.(ATBEG(C) .EQ. 1))GOTO 23422 CALL PUTBAK(C) GOTO 23419 23422 CONTINUE IF (.NOT.(C .EQ. 64))GOTO 23424 C = NGETCH(C, SHIN) IF (.NOT.(SPEC(C) .EQ. 0 .AND. (C .NE. 64 .AND. C .NE. 36)))GOTO 2 *3426 CALL PUTBAK(C) C = 64 23426 CONTINUE 23424 CONTINUE TOK(J) = C J = J + 1 23418 N=NGETCH(C, SHIN) GOTO 23417 23419 CONTINUE TOK(J) = 0 SHTOK = TOK(1) IF (.NOT.(PSTAT .EQ. 0 .OR. J .LT. 1))GOTO 23428 RETURN 23428 CONTINUE PSTAT = 0 23404 GOTO 23403 23405 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 23430 SPEC = 1 IF (.NOT.(C .EQ. 94))GOTO 23432 C = 124 23432 CONTINUE GOTO 23431 23430 CONTINUE SPEC = 0 23431 CONTINUE RETURN END SUBROUTINE STRIPB(BUF) INTEGER I INTEGER LENGTH LOGICAL*1 BUF(100) I=LENGTH(BUF) 23434 IF (.NOT.(I .GT. 0))GOTO 23436 IF (.NOT.(BUF(I) .NE. 32))GOTO 23437 GOTO 23436 23437 CONTINUE 23435 I=I-1 GOTO 23434 23436 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 CALL PUTLIN(14Hsyntax error: , 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 23439 IF (.NOT.(P.LT.P2))GOTO 23441 NDX = TKBUF(1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23442 L = L + 1 GOTO 23443 23442 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23444 L = L - 1 23444 CONTINUE 23443 CONTINUE IF (.NOT.(L .LT. 0))GOTO 23446 CALL STXERR (35Hsyn1--unbalanced right parentheses.) GOTO 23447 23446 CONTINUE IF (.NOT.(TOK .EQ. 38 .OR. TOK .EQ. 59))GOTO 23448 IF (.NOT.(L .EQ. 0))GOTO 23450 IF (.NOT.(MKTREE(TKBUF(3, P1), TOK, 4, NODE) .EQ. -3))GOTO 23452 SYN1 = -3 RETURN 23452 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 23450 CONTINUE 23448 CONTINUE 23447 CONTINUE 23440 P=P+1 GOTO 23439 23441 CONTINUE IF (.NOT.(L .GT. 0))GOTO 23454 CALL STXERR (34Hsyn1--unbalanced left parentheses.) GOTO 23455 23454 CONTINUE TKBUF(2, P1) = 2 CALL PUTBAC (P1) 23455 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 23456 IF (.NOT.(P.LT.P2))GOTO 23458 NDX = TKBUF(1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23459 L = L + 1 GOTO 23460 23459 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23461 L = L - 1 GOTO 23462 23461 CONTINUE IF (.NOT.(TOK .EQ. 124))GOTO 23463 IF (.NOT.(L .EQ. 0))GOTO 23465 IF (.NOT.(MKTREE(TKBUF(3, P1), 124, 4, NODE) .EQ. -3))GOTO 23467 SYN2 = -3 RETURN 23467 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 23465 CONTINUE 23463 CONTINUE 23462 CONTINUE 23460 CONTINUE 23457 P=P+1 GOTO 23456 23458 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 23469 CALL STXERR (20Hsyn3--empty command.) SYN3 = -3 RETURN 23469 CONTINUE NDX = TKBUF(1, P1) IF (.NOT.(IBUF(NDX) .EQ. 40))GOTO 23471 SYN3 = DOPAR(P1,P2) GOTO 23472 23471 CONTINUE SYN3 = DOVERB(P1,P2) 23472 CONTINUE RETURN 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 23473 IF (.NOT.(P.LT.P2))GOTO 23475 NDX = TKBUF(1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 59 .OR. TOK .EQ. 38 .OR. TOK .EQ. 10))GOTO 2347 *6 GOTO 23474 23476 CONTINUE GOTO 23475 23474 P=P+1 GOTO 23473 23475 CONTINUE IF (.NOT.(P .LT. P2))GOTO 23478 TKBUF(2, P) = 1 TKBUF(3, P) = TKBUF(3, P1) TKBUF(4, P) = TKBUF(4, P1) CALL PUTBAC (P) 23478 CONTINUE SYNTAX = 0 RETURN END