SUBROUTINE MAIN LOGICAL*1 LINE(402) INTEGER PARSER, SHLINE, EQUAL LOGICAL*1 QMARK(3) LOGICAL*1 ST001Z(39) LOGICAL*1 ST002Z(44) LOGICAL*1 ST003Z(13) DATA QMARK(1)/63/,QMARK(2)/10/,QMARK(3)/0/ DATA ST001Z(1)/117/,ST001Z(2)/115/,ST001Z(3)/97/,ST001Z(4)/103/,ST *001Z(5)/101/,ST001Z(6)/58/,ST001Z(7)/32/,ST001Z(8)/32/,ST001Z(9)/1 *15/,ST001Z(10)/104/,ST001Z(11)/32/,ST001Z(12)/91/,ST001Z(13)/45/,S *T001Z(14)/99/,ST001Z(15)/100/,ST001Z(16)/110/,ST001Z(17)/118/,ST00 *1Z(18)/120/,ST001Z(19)/93/,ST001Z(20)/32/,ST001Z(21)/91/,ST001Z(22 *)/102/,ST001Z(23)/105/,ST001Z(24)/108/,ST001Z(25)/101/,ST001Z(26)/ *32/,ST001Z(27)/91/,ST001Z(28)/97/,ST001Z(29)/114/,ST001Z(30)/103/, *ST001Z(31)/117/,ST001Z(32)/109/,ST001Z(33)/101/,ST001Z(34)/110/,ST *001Z(35)/116/,ST001Z(36)/115/,ST001Z(37)/93/,ST001Z(38)/93/,ST001Z *(39)/0/ DATA ST002Z(1)/84/,ST002Z(2)/121/,ST002Z(3)/112/,ST002Z(4)/101/,ST *002Z(5)/32/,ST002Z(6)/105/,ST002Z(7)/110/,ST002Z(8)/116/,ST002Z(9) */114/,ST002Z(10)/111/,ST002Z(11)/32/,ST002Z(12)/102/,ST002Z(13)/11 *1/,ST002Z(14)/114/,ST002Z(15)/32/,ST002Z(16)/97/,ST002Z(17)/110/,S *T002Z(18)/32/,ST002Z(19)/105/,ST002Z(20)/110/,ST002Z(21)/116/,ST00 *2Z(22)/114/,ST002Z(23)/111/,ST002Z(24)/100/,ST002Z(25)/117/,ST002Z *(26)/99/,ST002Z(27)/116/,ST002Z(28)/105/,ST002Z(29)/111/,ST002Z(30 *)/110/,ST002Z(31)/32/,ST002Z(32)/116/,ST002Z(33)/111/,ST002Z(34)/3 *2/,ST002Z(35)/116/,ST002Z(36)/104/,ST002Z(37)/101/,ST002Z(38)/32/, *ST002Z(39)/116/,ST002Z(40)/111/,ST002Z(41)/111/,ST002Z(42)/108/,ST *002Z(43)/115/,ST002Z(44)/0/ DATA ST003Z(1)/115/,ST003Z(2)/121/,ST003Z(3)/110/,ST003Z(4)/116/,S *T003Z(5)/97/,ST003Z(6)/120/,ST003Z(7)/32/,ST003Z(8)/101/,ST003Z(9) */114/,ST003Z(10)/114/,ST003Z(11)/111/,ST003Z(12)/114/,ST003Z(13)/0 */ CALL QUERY(ST001Z) CALL INITSH 23000 IF (.NOT.(SHLINE(LINE) .NE. -1))GOTO 23001 IF (.NOT.(LINE(1) .NE. 10))GOTO 23002 IF (.NOT.(EQUAL(LINE, QMARK) .EQ. 1))GOTO 23004 CALL REMARK(ST002Z) GOTO 23005 23004 CONTINUE IF (.NOT.(PARSER(LINE) .EQ. -3))GOTO 23006 CALL REMARK(ST003Z) GOTO 23007 23006 CONTINUE CALL EXECUT 23007 CONTINUE 23005 CONTINUE 23002 CONTINUE GOTO 23000 23001 CONTINUE CALL ENDSH(-1) RETURN END SUBROUTINE ARGLIN (BUF, I) LOGICAL*1 BUF(100) INTEGER I, K, M INTEGER GETARG LOGICAL*1 LIN COMMON / CSCLIN / LIN(402) K = 1 J=I 23008 IF (.NOT.(GETARG(J, LIN, 402) .NE. -1))GOTO 23010 IF (.NOT.(LIN(1) .EQ. 64 .AND. LIN(2) .EQ. 60 ))GOTO 23011 M = 2 GOTO 23012 23011 CONTINUE M = 1 23012 CONTINUE CALL STCOPY(LIN, M, BUF, K) CALL CHCOPY( 32, BUF, K) 23009 J=J+1 GOTO 23008 23010 CONTINUE IF (.NOT.(K .GT. 1))GOTO 23013 K = K - 1 23013 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 23015 ATBEG = 1 GOTO 23016 23015 CONTINUE ATBEG = 0 23016 CONTINUE RETURN END INTEGER FUNCTION CMDTYP (COMAND, PATH) LOGICAL*1 COMAND(100), PATH(100) INTEGER EQUAL, SHCOM INTEGER LOCCOM INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER I, JUNK INTEGER LUDEF INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN LOGICAL*1 LOCAL(6) LOGICAL*1 EXECUT(2) LOGICAL*1 SUFFIX(11) LOGICAL*1 SPATH(18) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) 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/ DATA SPATH(1)/0/,SPATH(2)/126/,SPATH(3)/47/,SPATH(4)/0/,SPATH(5)/1 *26/,SPATH(6)/117/,SPATH(7)/115/,SPATH(8)/114/,SPATH(9)/47/,SPATH(1 *0)/0/,SPATH(11)/126/,SPATH(12)/98/,SPATH(13)/105/,SPATH(14)/110/,S *PATH(15)/47/,SPATH(16)/0/,SPATH(17)/10/,SPATH(18)/0/ CALL STRCPY(COMAND, PATH) IF (.NOT.(LUDEF(PATH, COMAND, TABLE) .EQ. 0))GOTO 23017 CALL STRCPY(PATH, COMAND) 23017 CONTINUE I=1 23019 IF (.NOT.(COMAND(I) .NE. 0))GOTO 23021 IF (.NOT.(COMAND(I) .EQ. 32 .OR. COMAND(I) .EQ. 9))GOTO 23022 GOTO 23021 23022 CONTINUE PATH(I) = COMAND(I) 23023 CONTINUE 23020 I=I+1 GOTO 23019 23021 CONTINUE PATH(I) = 0 CALL SKIPBL(COMAND, I) IF (.NOT.(SHCOM(PATH) .GT. 0))GOTO 23024 CMDTYP = 17 GOTO 23025 23024 CONTINUE IF (.NOT.(EQUAL(PATH, EXECUT) .EQ. 1))GOTO 23026 CALL STRCPY(LOCAL, PATH) CMDTYP = 60 GOTO 23027 23026 CONTINUE CMDTYP = LOCCOM(PATH, SPATH, SUFFIX, PATH) I = 1 23027 CONTINUE 23025 CONTINUE CALL SCOPY(COMAND, I, COMAND, 1) RETURN END SUBROUTINE DOAMPR (NODE, DIR) INTEGER NODE, DIR, I INTEGER SSPAWN, GETCL, LOCCOM LOGICAL*1 DESC(7) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN LOGICAL*1 SHSTR(3) LOGICAL*1 SUFFIX(7) LOGICAL*1 SECOND(5) LOGICAL*1 SPATH(18) LOGICAL*1 ST004Z(32) LOGICAL*1 ST005Z(32) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) 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/ DATA SPATH(1)/0/,SPATH(2)/126/,SPATH(3)/47/,SPATH(4)/0/,SPATH(5)/1 *26/,SPATH(6)/117/,SPATH(7)/115/,SPATH(8)/114/,SPATH(9)/47/,SPATH(1 *0)/0/,SPATH(11)/126/,SPATH(12)/98/,SPATH(13)/105/,SPATH(14)/110/,S *PATH(15)/47/,SPATH(16)/0/,SPATH(17)/10/,SPATH(18)/0/ DATA ST004Z(1)/63/,ST004Z(2)/32/,ST004Z(3)/67/,ST004Z(4)/97/,ST004 *Z(5)/110/,ST004Z(6)/39/,ST004Z(7)/116/,ST004Z(8)/32/,ST004Z(9)/108 */,ST004Z(10)/111/,ST004Z(11)/99/,ST004Z(12)/97/,ST004Z(13)/116/,ST *004Z(14)/101/,ST004Z(15)/32/,ST004Z(16)/115/,ST004Z(17)/104/,ST004 *Z(18)/101/,ST004Z(19)/108/,ST004Z(20)/108/,ST004Z(21)/32/,ST004Z(2 *2)/105/,ST004Z(23)/109/,ST004Z(24)/97/,ST004Z(25)/103/,ST004Z(26)/ *101/,ST004Z(27)/32/,ST004Z(28)/102/,ST004Z(29)/105/,ST004Z(30)/108 */,ST004Z(31)/101/,ST004Z(32)/0/ DATA ST005Z(1)/67/,ST005Z(2)/97/,ST005Z(3)/110/,ST005Z(4)/110/,ST0 *05Z(5)/111/,ST005Z(6)/116/,ST005Z(7)/32/,ST005Z(8)/115/,ST005Z(9)/ *112/,ST005Z(10)/97/,ST005Z(11)/119/,ST005Z(12)/110/,ST005Z(13)/32/ *,ST005Z(14)/98/,ST005Z(15)/97/,ST005Z(16)/99/,ST005Z(17)/107/,ST00 *5Z(18)/103/,ST005Z(19)/114/,ST005Z(20)/111/,ST005Z(21)/117/,ST005Z *(22)/110/,ST005Z(23)/100/,ST005Z(24)/32/,ST005Z(25)/112/,ST005Z(26 *)/114/,ST005Z(27)/111/,ST005Z(28)/99/,ST005Z(29)/101/,ST005Z(30)/1 *15/,ST005Z(31)/115/,ST005Z(32)/0/ IF (.NOT.(DIR .EQ. 4 .OR. DIR .EQ. 1))GOTO 23028 RETURN 23028 CONTINUE IF (.NOT.( LOCCOM( SHSTR, SPATH, SUFFIX, SH) .NE. 60 ))GOTO 23030 CALL REMARK( ST004Z) RETURN 23030 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 23032 RETURN 23032 CONTINUE CALL STRIPB(CLIN) IF (.NOT.(PRCOM .EQ. 1))GOTO 23034 CALL DSPCOM(SH, CLIN) 23034 CONTINUE IF (.NOT.(EXEC .EQ. 1))GOTO 23036 IF (.NOT.(SSPAWN(SH, CLIN, DESC, 98) .EQ. -3))GOTO 23038 CALL REMARK (ST005Z) GOTO 23039 23038 CONTINUE CALL REMARK (DESC) 23039 CONTINUE 23036 CONTINUE RETURN END INTEGER FUNCTION DOCOM (NODE, DIR) INTEGER DIR, I, J, NODE, TYPE, STATUS INTEGER SSPAWN, SHELLC INTEGER CMDTYP, EQUAL, LENGTH INTEGER PICKUP, INF, OUTF, ERRF, SCRF LOGICAL*1 COMAND(36), DESC(7) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN LOGICAL*1 LOCAL(6) LOGICAL*1 ERRMSG(39) LOGICAL*1 XOFF(5) LOGICAL*1 ST006Z(2) LOGICAL*1 ST007Z(22) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) 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/ DATA XOFF(1)/120/,XOFF(2)/111/,XOFF(3)/102/,XOFF(4)/102/,XOFF(5)/0 */ DATA ST006Z(1)/39/,ST006Z(2)/0/ DATA ST007Z(1)/63/,ST007Z(2)/32/,ST007Z(3)/67/,ST007Z(4)/97/,ST007 *Z(5)/110/,ST007Z(6)/39/,ST007Z(7)/116/,ST007Z(8)/32/,ST007Z(9)/115 */,ST007Z(10)/112/,ST007Z(11)/97/,ST007Z(12)/119/,ST007Z(13)/110/,S *T007Z(14)/32/,ST007Z(15)/112/,ST007Z(16)/114/,ST007Z(17)/111/,ST00 *7Z(18)/99/,ST007Z(19)/101/,ST007Z(20)/115/,ST007Z(21)/115/,ST007Z( *22)/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 23040 CALL PUTLIN(ERRMSG, 3) CALL PUTLIN(COMAND, 3) CALL REMARK(ST006Z) DOCOM=(-3) RETURN 23040 CONTINUE J = LENGTH(CLIN) + 1 IF (.NOT.(J .GT. 1))GOTO 23042 CALL CHCOPY(32, CLIN, J) 23042 CONTINUE IF (.NOT.( TYPE .EQ. 12 ))GOTO 23044 IF (.NOT.(SCRF(NODE, COMAND, CLIN) .EQ. -3))GOTO 23046 DOCOM=(-3) RETURN 23046 CONTINUE GOTO 23045 23044 CONTINUE IF (.NOT.( TYPE .EQ. -3 ))GOTO 23048 CALL STRCPY( LOCAL, COMAND) 23048 CONTINUE I = 1 23050 IF (.NOT.(PICKUP( CLIN, J, NODE, 10, I) .NE. -3 ))GOTO 23052 CALL CHCOPY( 32, CLIN, J) 23051 I = I + 1 GOTO 23050 23052 CONTINUE IF (.NOT.( INF(NODE, CLIN, J) .NE. -3 ))GOTO 23053 CALL CHCOPY( 32, CLIN, J) 23053 CONTINUE IF (.NOT.( OUTF(NODE, CLIN, J) .NE. -3 ))GOTO 23055 CALL CHCOPY( 32, CLIN, J) 23055 CONTINUE IF (.NOT.( ERRF(NODE, CLIN, J) .NE. -3 ))GOTO 23057 CALL CHCOPY( 32, CLIN, J) 23057 CONTINUE 23045 CONTINUE CALL STRIPB( CLIN) IF (.NOT.( PRCOM .EQ. 1 .AND. EQUAL(COMAND, XOFF) .EQ. 0 ))GOTO 23 *059 CALL DSPCOM(COMAND, CLIN) 23059 CONTINUE IF (.NOT.( EXEC .EQ. 1 ))GOTO 23061 IF (.NOT.( TYPE .EQ. 17 ))GOTO 23063 STATUS = SHELLC( COMAND, CLIN) GOTO 23064 23063 CONTINUE STATUS = SSPAWN( COMAND, CLIN, DESC, 119) IF (.NOT.( STATUS .EQ. -3 ))GOTO 23065 CALL REMARK( ST007Z) GOTO 23066 23065 CONTINUE IF (.NOT.( STATUS .NE. 0 ))GOTO 23067 IF (.NOT.( STATUS .NE. -10 ))GOTO 23069 STATUS = -3 23069 CONTINUE 23067 CONTINUE 23066 CONTINUE 23064 CONTINUE GOTO 23062 23061 CONTINUE STATUS = 0 23062 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 INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 ST008Z(44) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) DATA ST008Z(1)/105/,ST008Z(2)/110/,ST008Z(3)/118/,ST008Z(4)/97/,ST *008Z(5)/108/,ST008Z(6)/105/,ST008Z(7)/100/,ST008Z(8)/32/,ST008Z(9) */116/,ST008Z(10)/111/,ST008Z(11)/107/,ST008Z(12)/101/,ST008Z(13)/1 *10/,ST008Z(14)/32/,ST008Z(15)/102/,ST008Z(16)/111/,ST008Z(17)/108/ *,ST008Z(18)/108/,ST008Z(19)/111/,ST008Z(20)/119/,ST008Z(21)/105/,S *T008Z(22)/110/,ST008Z(23)/103/,ST008Z(24)/32/,ST008Z(25)/112/,ST00 *8Z(26)/97/,ST008Z(27)/114/,ST008Z(28)/101/,ST008Z(29)/110/,ST008Z( *30)/116/,ST008Z(31)/104/,ST008Z(32)/101/,ST008Z(33)/115/,ST008Z(34 *)/105/,ST008Z(35)/115/,ST008Z(36)/32/,ST008Z(37)/40/,ST008Z(38)/10 *0/,ST008Z(39)/111/,ST008Z(40)/112/,ST008Z(41)/97/,ST008Z(42)/114/, *ST008Z(43)/41/,ST008Z(44)/0/ L = 0 P=P1 23071 IF (.NOT.(P.LT.P2))GOTO 23073 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23074 L = L + 1 GOTO 23075 23074 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23076 L = L - 1 IF (.NOT.(L .EQ. 0))GOTO 23078 GOTO 23073 23078 CONTINUE 23076 CONTINUE 23075 CONTINUE 23072 P=P+1 GOTO 23071 23073 CONTINUE IF (.NOT.(MKTREE( TKBUF( 3, P1), 112, 7, NODE) .EQ. -3))GOTO 23080 DOPAR = -3 RETURN 23080 CONTINUE PT = P1 + 1 TKBUF( 2, PT) = 1 TKBUF( 3, PT) = NODE TKBUF( 4, PT) = P CALL PUTBAC (PT) P=P+1 23082 IF (.NOT.(P.LT.P2))GOTO 23084 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60))GOTO 23085 IF (.NOT.(SETREE(NODE, 5, TKBUF( 1, P)) .EQ. -3))GOTO 23087 DOPAR = -3 RETURN 23087 CONTINUE GOTO 23086 23085 CONTINUE IF (.NOT.(TOK .EQ. 62))GOTO 23089 IF (.NOT.(SETREE(NODE, 6, TKBUF( 1, P)) .EQ. -3))GOTO 23091 DOPAR = -3 RETURN 23091 CONTINUE GOTO 23090 23089 CONTINUE IF (.NOT.(TOK .EQ. 63))GOTO 23093 IF (.NOT.(SETREE(NODE, 7, TKBUF( 1, P)) .EQ. -3))GOTO 23095 DOPAR = -3 RETURN 23095 CONTINUE GOTO 23094 23093 CONTINUE CALL STXERR(ST008Z) DOPAR = -3 RETURN 23094 CONTINUE 23090 CONTINUE 23086 CONTINUE 23083 P=P+1 GOTO 23082 23084 CONTINUE DOPAR = 0 RETURN END INTEGER FUNCTION DOPARN (NODE, DIR) INTEGER NODE, DIR INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) IF (.NOT.(DIR .EQ. 3))GOTO 23097 IF (.NOT.(TREE(NODE+5) .NE. 0))GOTO 23099 IF (.NOT.(IN .EQ. 0 .OR. (IN .NE. 0 .AND. CIN(IN) .GT. 0) ))GOTO 2 *3101 IN = IN + 1 CIN(IN) = TREE(NODE+5) TREE(NODE+5) = -TREE(NODE+5) 23101 CONTINUE 23099 CONTINUE IF (.NOT.(TREE(NODE+6) .NE. 0))GOTO 23103 IF (.NOT.(OUT .EQ. 0 .OR. (OUT .NE. 0 .AND. COUT(OUT) .GT. 0)))GOT *O 23105 OUT = OUT + 1 COUT(OUT) = TREE(NODE+6) TREE(NODE+6) = -TREE(NODE+6) 23105 CONTINUE 23103 CONTINUE IF (.NOT.(TREE(NODE+7) .NE. 0))GOTO 23107 ER = ER + 1 CERR(ER ) = TREE(NODE+7) TREE(NODE+7) = -TREE(NODE+7) 23107 CONTINUE GOTO 23098 23097 CONTINUE IF (.NOT.(TREE(NODE+5) .LT. 0))GOTO 23109 IN = IN - 1 TREE(NODE+5) = IABS(TREE(NODE+5)) 23109 CONTINUE IF (.NOT.(TREE(NODE+6) .LT. 0))GOTO 23111 OUT = OUT - 1 TREE(NODE+6) = IABS(TREE(NODE+6)) 23111 CONTINUE IF (.NOT.(TREE(NODE+7) .LT. 0))GOTO 23113 ER = ER - 1 TREE(NODE+7) = IABS(TREE(NODE+7)) 23113 CONTINUE 23098 CONTINUE DOPARN=(0) RETURN END INTEGER FUNCTION DOPIPE (NODE, DIR) INTEGER NODE, DIR INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) IF (.NOT.(DIR .EQ. 3))GOTO 23115 PCTR = PCTR + 1 PFILE(PCTR) = 0 OUT = OUT + 1 COUT(OUT) = -PCTR AOUT(OUT) = 0 GOTO 23116 23115 CONTINUE IF (.NOT.(DIR .EQ. 4))GOTO 23117 IN = IN + 1 CIN(IN) = COUT(OUT) OUT = OUT - 1 GOTO 23118 23117 CONTINUE PCTR = PCTR - 1 IN = IN - 1 23118 CONTINUE 23116 CONTINUE DOPIPE=(0) RETURN END INTEGER FUNCTION DOSEMI (NODE, DIR) INTEGER NODE, DIR INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) IF (.NOT.(DIR .EQ. 4))GOTO 23119 IF (.NOT.(OUT .GT. 0))GOTO 23121 AOUT(OUT) = AOUT(OUT) + 1 23121 CONTINUE IF (.NOT.(ER .GT. 0))GOTO 23123 AERR(ER) = AERR(ER) + 1 23123 CONTINUE GOTO 23120 23119 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23125 IF (.NOT.(OUT .GT. 0))GOTO 23127 AOUT(OUT) = AOUT(OUT) - 1 23127 CONTINUE IF (.NOT.(ER .GT. 0))GOTO 23129 AERR(ER) = AERR(ER) - 1 23129 CONTINUE 23125 CONTINUE 23120 CONTINUE DOSEMI=(0) RETURN END INTEGER FUNCTION DOVERB (P1,P2) LOGICAL*1 TOK INTEGER P, P1, P2, P3, I, NODE, NDX INTEGER MKTREE, SETREE INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 ST009Z(46) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) DATA ST009Z(1)/99/,ST009Z(2)/111/,ST009Z(3)/109/,ST009Z(4)/109/,ST *009Z(5)/97/,ST009Z(6)/110/,ST009Z(7)/100/,ST009Z(8)/32/,ST009Z(9)/ *109/,ST009Z(10)/117/,ST009Z(11)/115/,ST009Z(12)/116/,ST009Z(13)/32 */,ST009Z(14)/112/,ST009Z(15)/114/,ST009Z(16)/101/,ST009Z(17)/99/,S *T009Z(18)/101/,ST009Z(19)/101/,ST009Z(20)/100/,ST009Z(21)/32/,ST00 *9Z(22)/105/,ST009Z(23)/47/,ST009Z(24)/111/,ST009Z(25)/32/,ST009Z(2 *6)/114/,ST009Z(27)/101/,ST009Z(28)/100/,ST009Z(29)/105/,ST009Z(30) */114/,ST009Z(31)/101/,ST009Z(32)/99/,ST009Z(33)/116/,ST009Z(34)/10 *5/,ST009Z(35)/111/,ST009Z(36)/110/,ST009Z(37)/32/,ST009Z(38)/40/,S *T009Z(39)/100/,ST009Z(40)/111/,ST009Z(41)/118/,ST009Z(42)/101/,ST0 *09Z(43)/114/,ST009Z(44)/98/,ST009Z(45)/41/,ST009Z(46)/0/ NDX = TKBUF( 1, P1) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60 .OR. TOK .EQ. 62 .OR. TOK .EQ. 63))GOTO 2313 *1 CALL STXERR(ST009Z) DOVERB=(-3) RETURN 23131 CONTINUE NARGS = P2 - P1 -1 IF (.NOT.(MKTREE(TKBUF( 3, P1), 99, 9+NARGS, NODE) .EQ. -3))GOTO 2 *3133 DOVERB=(-3) RETURN 23133 CONTINUE I = 0 P=P1 23135 IF (.NOT.(P.LT.P2))GOTO 23137 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60))GOTO 23138 IF (.NOT.(SETREE(NODE, 5, TKBUF( 1, P)) .EQ. -3))GOTO 23140 DOVERB=(-3) RETURN 23140 CONTINUE NARGS = NARGS - 1 GOTO 23139 23138 CONTINUE IF (.NOT.(TOK .EQ. 62))GOTO 23142 IF (.NOT.(SETREE(NODE, 6, TKBUF( 1, P)) .EQ. -3))GOTO 23144 DOVERB=(-3) RETURN 23144 CONTINUE NARGS = NARGS - 1 GOTO 23143 23142 CONTINUE IF (.NOT.(TOK .EQ. 63))GOTO 23146 IF (.NOT.(SETREE(NODE, 7, TKBUF( 1, P)) .EQ. -3))GOTO 23148 DOVERB=(-3) RETURN 23148 CONTINUE NARGS = NARGS - 1 GOTO 23147 23146 CONTINUE IF (.NOT.(SETREE(NODE, 9+I, TKBUF( 1, P)) .EQ. -3))GOTO 23150 DOVERB=(-3) RETURN 23150 CONTINUE I = I + 1 23147 CONTINUE 23143 CONTINUE 23139 CONTINUE 23136 P=P+1 GOTO 23135 23137 CONTINUE IF (.NOT.(SETREE(NODE, 8, NARGS) .EQ. -3))GOTO 23152 DOVERB=(-3) RETURN 23152 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 * 23154 23156 IF (.NOT.(ARG(I) .NE. 32 .AND. ARG(I) .NE. 0))GOTO 23157 I = I + 1 GOTO 23156 23157 CONTINUE GOTO 23155 23154 CONTINUE CALL PUTCH(32, 3) 23155 CONTINUE CALL PUTLIN(ARG(I), 3) CALL PUTCH(10, 3) RETURN END SUBROUTINE DSPPTH(FILE) INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER I LOGICAL*1 FILE(100) LOGICAL*1 SEPSTR(5) LOGICAL*1 SPATH(18) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) DATA SEPSTR(1)/32/,SEPSTR(2)/45/,SEPSTR(3)/62/,SEPSTR(4)/32/,SEPST *R(5)/0/ DATA SPATH(1)/0/,SPATH(2)/126/,SPATH(3)/47/,SPATH(4)/0/,SPATH(5)/1 *26/,SPATH(6)/117/,SPATH(7)/115/,SPATH(8)/114/,SPATH(9)/47/,SPATH(1 *0)/0/,SPATH(11)/126/,SPATH(12)/98/,SPATH(13)/105/,SPATH(14)/110/,S *PATH(15)/47/,SPATH(16)/0/,SPATH(17)/10/,SPATH(18)/0/ CALL PWDIR(FILE, 2, 0) I = 1 23158 IF (.NOT.(SPATH(I) .NE. 10 ))GOTO 23160 IF (.NOT.( SPATH(I) .EQ. 0))GOTO 23161 IF (.NOT.(SPATH(I+1) .EQ. 10))GOTO 23163 GOTO 23160 23163 CONTINUE CALL PUTLIN(SEPSTR, 2) 23164 CONTINUE GOTO 23162 23161 CONTINUE CALL MKPATH(SPATH(I), FILE) CALL PUTLIN(FILE, 2) 23165 IF (.NOT.(SPATH(I) .NE. 0))GOTO 23166 I = I + 1 GOTO 23165 23166 CONTINUE I = I - 1 23162 CONTINUE 23159 I = I + 1 GOTO 23158 23160 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, J INTEGER PICKUP INTEGER JUNK LOGICAL*1 BUF(100) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) IF (.NOT.( ER .EQ. 0 .AND. PICKUP( BUF, I, NODE, 7, JUNK) .NE. -3 *))GOTO 23167 ERRF=(0) RETURN 23167 CONTINUE IF (.NOT.(ER .GT. 0))GOTO 23169 IF (.NOT.(CERR(ER) .GT. 0))GOTO 23171 J = CERR(ER) + 1 IF (.NOT.(AERR(ER) .NE. 0 .AND. IBUF(J) .NE. 63))GOTO 23173 CALL CHCOPY(63, BUF, I) 23173 CONTINUE CALL STCOPY(IBUF, CERR(ER), BUF, I) 23171 CONTINUE ERRF=(0) RETURN 23169 CONTINUE 23168 CONTINUE ERRF=(-3) RETURN END SUBROUTINE EXECUT INTEGER NODE, TYPE, DIR, STATUS, I, J, JUNK INTEGER MVNEXT, DOSEMI, DOAMPR, DOPIPE, DOPARN, DOCOM, REMOVE INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 ST00AZ(30) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) DATA ST00AZ(1)/63/,ST00AZ(2)/32/,ST00AZ(3)/73/,ST00AZ(4)/110/,ST00 *AZ(5)/118/,ST00AZ(6)/97/,ST00AZ(7)/108/,ST00AZ(8)/105/,ST00AZ(9)/1 *00/,ST00AZ(10)/32/,ST00AZ(11)/112/,ST00AZ(12)/97/,ST00AZ(13)/114/, *ST00AZ(14)/115/,ST00AZ(15)/101/,ST00AZ(16)/32/,ST00AZ(17)/116/,ST0 *0AZ(18)/114/,ST00AZ(19)/101/,ST00AZ(20)/101/,ST00AZ(21)/32/,ST00AZ *(22)/40/,ST00AZ(23)/101/,ST00AZ(24)/120/,ST00AZ(25)/101/,ST00AZ(26 *)/99/,ST00AZ(27)/117/,ST00AZ(28)/116/,ST00AZ(29)/41/,ST00AZ(30)/0/ IN = 0 OUT = 0 ER = 0 PCTR = 0 HFILE(1) = 0 I=1 23175 IF (.NOT.(I.LE.15))GOTO 23177 PFILE(I) = 0 CIN(I) = 0 COUT(I) = 0 CERR(I) = 0 AOUT(I) = 0 AERR(I) = 0 23176 I=I+1 GOTO 23175 23177 CONTINUE NODE = -1 23178 IF (.NOT.(MVNEXT(NODE, TYPE, DIR) .NE. -1))GOTO 23179 IF (.NOT.(TYPE .EQ. 59))GOTO 23180 STATUS = DOSEMI (NODE, DIR) GOTO 23181 23180 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23182 STATUS = DOAMPR (NODE, DIR) GOTO 23183 23182 CONTINUE IF (.NOT.(TYPE .EQ. 124))GOTO 23184 STATUS = DOPIPE (NODE, DIR) GOTO 23185 23184 CONTINUE IF (.NOT.(TYPE .EQ. 112))GOTO 23186 STATUS = DOPARN (NODE, DIR) GOTO 23187 23186 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23188 STATUS = DOCOM (NODE, DIR) GOTO 23189 23188 CONTINUE CALL REMARK(ST00AZ) STATUS = -3 23189 CONTINUE 23187 CONTINUE 23185 CONTINUE 23183 CONTINUE 23181 CONTINUE IF (.NOT.( STATUS .EQ. -3 .OR. STATUS .EQ. -10 ))GOTO 23190 GOTO 23179 23190 CONTINUE GOTO 23178 23179 CONTINUE IF (.NOT.( HFILE(1) .NE. 0 ))GOTO 23192 JUNK = REMOVE(HFILE) 23192 CONTINUE I=1 23194 IF (.NOT.(I.LE.15))GOTO 23196 IF (.NOT.(PFILE(I) .EQ. 1))GOTO 23197 J = 1 CALL GPNAME( I, HFILE, J) JUNK = REMOVE( HFILE) 23197 CONTINUE 23195 I=I+1 GOTO 23194 23196 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 INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) SNODE = NODE 23199 CONTINUE JUNK = MVNEXT(NODE, TYPE, DIR) IF (.NOT.(NODE .EQ. SNODE))GOTO 23202 GOTO 23201 23202 CONTINUE IF (.NOT.(TYPE .EQ. 59 .AND. DIR .EQ. 4))GOTO 23204 CALL CHCOPY( 59, BUF, K) GOTO 23205 23204 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23206 IF (.NOT.(DIR .EQ. 4 .OR. (DIR .EQ. 1 .AND. LASTD .EQ. 3)))GOTO 23 *208 CALL CHCOPY( 38, BUF, K) 23208 CONTINUE LASTD = DIR GOTO 23207 23206 CONTINUE IF (.NOT.(TYPE .EQ. 124 .AND. DIR .EQ. 4))GOTO 23210 CALL CHCOPY( 124, BUF, K) GOTO 23211 23210 CONTINUE IF (.NOT.(TYPE .EQ. 112))GOTO 23212 CALL GPAR(NODE, DIR, BUF, K) GOTO 23213 23212 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23214 GETCL = GTASK(NODE, BUF, K) 23214 CONTINUE 23213 CONTINUE 23211 CONTINUE 23207 CONTINUE 23205 CONTINUE 23200 GOTO 23199 23201 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 23216 CALL CHCOPY( 40, BUF, I) GOTO 23217 23216 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23218 N = I CALL STCOPY( RPST, 1, BUF, I) IF (.NOT.( PICKUP( BUF, I, NODE, 5, JUNK) .NE. -3))GOTO 23220 CALL CHCOPY( 32, BUF, I) GOTO 23221 23220 CONTINUE I = N + 2 23221 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 6, JUNK) .NE. -3))GOTO 23222 CALL CHCOPY( 32, BUF, I) 23222 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 7, JUNK) .NE. -3))GOTO 23224 CALL CHCOPY( 32, BUF, I) 23224 CONTINUE 23218 CONTINUE 23217 CONTINUE RETURN END SUBROUTINE GPNAME(N, NAME, I) LOGICAL*1 NAME(100) INTEGER ITOC, LENGTH INTEGER I, JUNK, N INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 PIPEF(5) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) 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, LENGTH LOGICAL*1 BUF(100), COMAND(36) INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN LOGICAL*1 ST00BZ(13) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) DATA ST00BZ(1)/105/,ST00BZ(2)/110/,ST00BZ(3)/118/,ST00BZ(4)/97/,ST *00BZ(5)/108/,ST00BZ(6)/105/,ST00BZ(7)/100/,ST00BZ(8)/32/,ST00BZ(9) */116/,ST00BZ(10)/97/,ST00BZ(11)/115/,ST00BZ(12)/107/,ST00BZ(13)/0/ N = J JUNK = PICKUP( BUF, J, NODE, 9, JUNK) TYPE = CMDTYP( BUF(N), COMAND) IF (.NOT.( TYPE .EQ. -3 .AND. DROP .EQ. 0 ))GOTO 23226 CALL REMARK (ST00BZ) J = N BUF(J) = 0 GTASK=(-3) RETURN 23226 CONTINUE GTASK = 0 J = LENGTH(BUF) + 1 CALL CHCOPY( 32, BUF, J) I=1 23228 IF (.NOT.(PICKUP( BUF, J, NODE, 10, I) .NE. -3))GOTO 23230 CALL CHCOPY( 32, BUF, J) 23229 I=I+1 GOTO 23228 23230 CONTINUE CALL CHCOPY( 64, BUF, J) IF (.NOT.( PICKUP( BUF, J, NODE, 5, JUNK) .NE. -3))GOTO 23231 CALL CHCOPY( 32, BUF, J) GOTO 23232 23231 CONTINUE J = J - 1 23232 CONTINUE IF (.NOT.( PICKUP( BUF, J, NODE, 6, JUNK) .NE. -3))GOTO 23233 CALL CHCOPY( 32, BUF, J) 23233 CONTINUE IF (.NOT.( PICKUP( BUF, J, NODE, 7, JUNK) .NE. -3))GOTO 23235 CALL CHCOPY( 32, BUF, J) 23235 CONTINUE BUF(J) = 0 RETURN END SUBROUTINE HERDOC(CHAR, BUF, I) LOGICAL*1 CHAR, BUF(100) INTEGER CREATE, GETLIN INTEGER INT, I, N INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN LOGICAL*1 LIN LOGICAL*1 DOC(4) LOGICAL*1 ST00CZ(34) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) COMMON / CSCLIN / LIN(402) DATA DOC(1)/100/,DOC(2)/111/,DOC(3)/99/,DOC(4)/0/ DATA ST00CZ(1)/63/,ST00CZ(2)/32/,ST00CZ(3)/67/,ST00CZ(4)/97/,ST00C *Z(5)/110/,ST00CZ(6)/39/,ST00CZ(7)/116/,ST00CZ(8)/32/,ST00CZ(9)/111 */,ST00CZ(10)/112/,ST00CZ(11)/101/,ST00CZ(12)/110/,ST00CZ(13)/32/,S *T00CZ(14)/102/,ST00CZ(15)/105/,ST00CZ(16)/108/,ST00CZ(17)/101/,ST0 *0CZ(18)/32/,ST00CZ(19)/102/,ST00CZ(20)/111/,ST00CZ(21)/114/,ST00CZ *(22)/32/,ST00CZ(23)/105/,ST00CZ(24)/110/,ST00CZ(25)/108/,ST00CZ(26 *)/105/,ST00CZ(27)/110/,ST00CZ(28)/101/,ST00CZ(29)/32/,ST00CZ(30)/1 *16/,ST00CZ(31)/101/,ST00CZ(32)/120/,ST00CZ(33)/116/,ST00CZ(34)/0/ N = I CALL CHCOPY( 60, BUF, I) CALL SCRATF(DOC, HFILE) INT = CREATE(HFILE, 2) IF (.NOT.(INT .EQ. -3))GOTO 23237 CALL REMARK(ST00CZ) HFILE(1) = 0 I = N BUF(I) = 0 RETURN 23237 CONTINUE CALL STCOPY( HFILE, 1, BUF, I) 23239 IF (.NOT.( GETLIN( LIN, SHIN) .NE. -1))GOTO 23240 IF (.NOT.(LIN(1) .EQ. CHAR))GOTO 23241 GOTO 23240 23241 CONTINUE CALL PUTLIN(LIN, INT) GOTO 23239 23240 CONTINUE CALL CLOSE(INT) RETURN END INTEGER FUNCTION INF(NODE, BUF, I) INTEGER NODE, I, N INTEGER PICKUP LOGICAL*1 BUF(100), CHAR INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR 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) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) N = I IF (.NOT.(IN .GT. 0 .AND. CIN(IN) .LT. 0))GOTO 23243 CALL CHCOPY( 60, BUF, I) CALL GPNAME( IABS(CIN(IN)), BUF, I) GOTO 23244 23243 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 5, JUNK) .EQ. -3 .AND. IN .GT. 0 *))GOTO 23245 CALL STCOPY( IBUF, CIN(IN), BUF, I) GOTO 23246 23245 CONTINUE IF (.NOT.(SCRIPT .EQ. 1 .AND. INPUT(1) .NE. 0))GOTO 23247 CALL CHCOPY( 60, BUF, I) CALL STCOPY( INPUT, 1, BUF, I) 23247 CONTINUE 23246 CONTINUE 23244 CONTINUE IF (.NOT.(BUF(N) .EQ. 60 .AND. BUF(N+1) .EQ. 60))GOTO 23249 CHAR = BUF(N+2) I = N CALL HERDOC( CHAR, BUF, I) 23249 CONTINUE IF (.NOT.(BUF(N) .NE. 0))GOTO 23251 INF=(0) RETURN 23251 CONTINUE INF=(-3) RETURN 23252 CONTINUE END SUBROUTINE INITSH INTEGER GETARG, OPEN, LOCCOM, LENGTH, INDEXC INTEGER I INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER PBP, PBSIZE LOGICAL*1 PBBUF(512) INTEGER MKTABL INTEGER MEM(500) LOGICAL*1 CMEM(1000) LOGICAL*1 ARGSTR(3) LOGICAL*1 SUFFIX(3) LOGICAL*1 SPATH(18) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) COMMON /CPBACK/ PBP, PBSIZE, PBBUF COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) DATA ARGSTR(1)/36/,ARGSTR(2)/48/,ARGSTR(3)/0/ DATA SUFFIX(1)/0/,SUFFIX(2)/10/,SUFFIX(3)/0/ DATA SPATH(1)/0/,SPATH(2)/126/,SPATH(3)/47/,SPATH(4)/0/,SPATH(5)/1 *26/,SPATH(6)/117/,SPATH(7)/115/,SPATH(8)/114/,SPATH(9)/47/,SPATH(1 *0)/0/,SPATH(11)/126/,SPATH(12)/98/,SPATH(13)/105/,SPATH(14)/110/,S *PATH(15)/47/,SPATH(16)/0/,SPATH(17)/10/,SPATH(18)/0/ DATA INPUT(1) /0/ DEPTH = 1 UNIT(1) = 1 CALL PBINIT(512) CALL DSINIT(500) TABLE = MKTABL(1) PRLIN = 0 EXEC = 1 PRCOM = 0 CARG = 0 DROP = 1 SCRIPT = 0 CALL HOMDIR( HOMEDR, 6) CALL GWDIR( OLDDIR, 6) CALL ENBINT I = 1 23253 IF (.NOT.(GETARG(I, CLIN, 402) .NE. -1 ))GOTO 23255 IF (.NOT.( I .EQ. 1 .AND. CLIN(1) .EQ. 45 ))GOTO 23256 CALL FOLD(CLIN) IF (.NOT.( INDEXC( CLIN, 118) .GT. 0 ))GOTO 23258 PRLIN = 1 23258 CONTINUE IF (.NOT.( INDEXC( CLIN, 110) .GT. 0 ))GOTO 23260 EXEC = 0 23260 CONTINUE IF (.NOT.( INDEXC( CLIN, 120) .GT. 0 ))GOTO 23262 PRCOM = 1 23262 CONTINUE IF (.NOT.( INDEXC( CLIN, 99) .GT. 0 ))GOTO 23264 CARG = 1 23264 CONTINUE IF (.NOT.( INDEXC( CLIN, 100) .GT. 0 ))GOTO 23266 DROP = 0 23266 CONTINUE CALL DELARG(I) I = I - 1 GOTO 23257 23256 CONTINUE IF (.NOT.( CARG .EQ. 1 ))GOTO 23268 CALL ARGLIN(CLIN, I) CARGDN = 0 GOTO 23255 23268 CONTINUE IF (.NOT.( I .EQ. 1 ))GOTO 23270 IF (.NOT.( LOCCOM( CLIN, SPATH, SUFFIX, INPUT) .NE. 12 ))GOTO 2327 *2 CALL CANT(CLIN) 23272 CONTINUE UNIT(DEPTH) = OPEN(INPUT, 1) IF (.NOT.( UNIT(DEPTH) .EQ. -3 ))GOTO 23274 CALL CANT(INPUT) 23274 CONTINUE SCRIPT = 1 INPUT(1) = 0 CALL ENTDEF(ARGSTR, CLIN, TABLE) I=I+1 23276 IF (.NOT.(GETARG(I, CLIN, 402) .NE. -1))GOTO 23278 IF (.NOT.( CLIN(1) .EQ. 64 .AND. CLIN(2) .EQ. 60))GOTO 23279 CALL SCOPY(CLIN, 3, INPUT, 1) GOTO 23280 23279 CONTINUE ARGSTR(2) = ARGSTR(2) + 1 CALL ENTDEF(ARGSTR, CLIN, TABLE) 23280 CONTINUE 23277 I=I+1 GOTO 23276 23278 CONTINUE GOTO 23255 23270 CONTINUE 23269 CONTINUE 23257 CONTINUE 23254 I = I + 1 GOTO 23253 23255 CONTINUE SHIN = UNIT(DEPTH) RETURN END INTEGER FUNCTION MKTOKS (LINE, K) INTEGER LENGTH INTEGER I, PAREN LOGICAL*1 LINE(100) INTEGER SHTOK INTEGER K, L INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 ST00DZ(20) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) DATA ST00DZ(1)/63/,ST00DZ(2)/32/,ST00DZ(3)/85/,ST00DZ(4)/110/,ST00 *DZ(5)/98/,ST00DZ(6)/97/,ST00DZ(7)/108/,ST00DZ(8)/97/,ST00DZ(9)/110 */,ST00DZ(10)/99/,ST00DZ(11)/101/,ST00DZ(12)/100/,ST00DZ(13)/32/,ST *00DZ(14)/113/,ST00DZ(15)/117/,ST00DZ(16)/111/,ST00DZ(17)/116/,ST00 *DZ(18)/101/,ST00DZ(19)/115/,ST00DZ(20)/0/ PAREN = 0 I = 1 CALL PUTBAK (0) CALL PBSTR (LINE) K=1 23281 IF (.NOT.(SHTOK(IBUF(I)) .NE. 0))GOTO 23283 IF (.NOT.(IBUF(I) .NE. 0))GOTO 23284 TKBUF(1,K) = I TKBUF(2,K) = 0 TKBUF(3,K) = 0 TKBUF(4,K) = 0 IF (.NOT.(IBUF(I) .EQ. 40))GOTO 23286 PAREN = PAREN + 1 GOTO 23287 23286 CONTINUE IF (.NOT.(IBUF(I) .EQ. 41))GOTO 23288 PAREN = PAREN - 1 23288 CONTINUE 23287 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 23290 CALL REMARK(ST00DZ) MKTOKS=(-3) RETURN 23290 CONTINUE I = L + 2 23284 CONTINUE 23282 K=K+1 GOTO 23281 23283 CONTINUE K = K - 1 IBUF(I) = 0 IF (.NOT.(PAREN .NE. 0))GOTO 23292 MKTOKS=(-3) RETURN 23292 CONTINUE MKTOKS=(0) RETURN 23293 CONTINUE END INTEGER FUNCTION MKTREE (PNODE, TYPE, SIZE, CNODE) INTEGER PNODE, TYPE, SIZE, CNODE, I INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 ST00EZ(35) LOGICAL*1 ST00FZ(27) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) DATA ST00EZ(1)/116/,ST00EZ(2)/114/,ST00EZ(3)/101/,ST00EZ(4)/101/,S *T00EZ(5)/32/,ST00EZ(6)/98/,ST00EZ(7)/117/,ST00EZ(8)/102/,ST00EZ(9) */102/,ST00EZ(10)/101/,ST00EZ(11)/114/,ST00EZ(12)/32/,ST00EZ(13)/11 *5/,ST00EZ(14)/105/,ST00EZ(15)/122/,ST00EZ(16)/101/,ST00EZ(17)/32/, *ST00EZ(18)/101/,ST00EZ(19)/120/,ST00EZ(20)/99/,ST00EZ(21)/101/,ST0 *0EZ(22)/101/,ST00EZ(23)/100/,ST00EZ(24)/101/,ST00EZ(25)/100/,ST00E *Z(26)/32/,ST00EZ(27)/40/,ST00EZ(28)/109/,ST00EZ(29)/107/,ST00EZ(30 *)/116/,ST00EZ(31)/114/,ST00EZ(32)/101/,ST00EZ(33)/101/,ST00EZ(34)/ *41/,ST00EZ(35)/0/ DATA ST00FZ(1)/116/,ST00FZ(2)/111/,ST00FZ(3)/111/,ST00FZ(4)/32/,ST *00FZ(5)/109/,ST00FZ(6)/97/,ST00FZ(7)/110/,ST00FZ(8)/121/,ST00FZ(9) */32/,ST00FZ(10)/99/,ST00FZ(11)/104/,ST00FZ(12)/105/,ST00FZ(13)/108 */,ST00FZ(14)/100/,ST00FZ(15)/114/,ST00FZ(16)/101/,ST00FZ(17)/110/, *ST00FZ(18)/32/,ST00FZ(19)/40/,ST00FZ(20)/109/,ST00FZ(21)/107/,ST00 *FZ(22)/116/,ST00FZ(23)/114/,ST00FZ(24)/101/,ST00FZ(25)/101/,ST00FZ *(26)/41/,ST00FZ(27)/0/ CNODE = TREEND TREEND = TREEND + SIZE IF (.NOT.(TREEND .GT.200))GOTO 23294 CALL STXERR(ST00EZ) CNODE = -3 MKTREE=(-3) RETURN 23294 CONTINUE I=1 23296 IF (.NOT.(I.LE.SIZE))GOTO 23298 TREE(CNODE+I) = 0 23297 I=I+1 GOTO 23296 23298 CONTINUE TREE(CNODE+1) = PNODE TREE(CNODE+2) = TYPE IF (.NOT.(PNODE .GE. 0))GOTO 23299 IF (.NOT.(TREE(PNODE+3) .EQ. 0))GOTO 23301 TREE(PNODE+3) = CNODE GOTO 23302 23301 CONTINUE IF (.NOT.(TREE(PNODE+4) .EQ. 0))GOTO 23303 TREE(PNODE+4) = CNODE GOTO 23304 23303 CONTINUE CALL STXERR(ST00FZ) MKTREE=(-3) RETURN 23304 CONTINUE 23302 CONTINUE 23299 CONTINUE MKTREE=(CNODE) RETURN END INTEGER FUNCTION MVNEXT (NODE, TYPE, DIR) INTEGER NODE, DIR, TYPE INTEGER NXTBR INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) IF (.NOT.(NODE .EQ. -1))GOTO 23305 MVNEXT = 0 DIR = 3 GOTO 23306 23305 CONTINUE MVNEXT = TREE(NODE+DIR) 23306 CONTINUE IF (.NOT.(MVNEXT .NE. -1))GOTO 23307 TYPE = TREE(MVNEXT+2) DIR = NXTBR(MVNEXT, NODE) 23307 CONTINUE NODE = MVNEXT RETURN END INTEGER FUNCTION NEXTP (P) INTEGER P INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) IF (.NOT.(PP .EQ. 0))GOTO 23309 P = 0 GOTO 23310 23309 CONTINUE P = STACK(PP) PP = PP - 1 23310 CONTINUE NEXTP=(P) RETURN END INTEGER FUNCTION NXTBR (NODE, LNODE) INTEGER NODE, LNODE INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) IF (.NOT.(LNODE .EQ. TREE(NODE+1)))GOTO 23311 IF (.NOT.(TREE(NODE+3) .NE. 0))GOTO 23313 NXTBR=(3) RETURN 23313 CONTINUE NXTBR=(1) RETURN 23314 CONTINUE GOTO 23312 23311 CONTINUE IF (.NOT.(LNODE .EQ. TREE(NODE+3) .AND. TREE(NODE+4) .NE. 0))GOTO *23315 NXTBR=(4) RETURN 23315 CONTINUE NXTBR=(1) RETURN 23316 CONTINUE 23312 CONTINUE END INTEGER FUNCTION OUTF (NODE, BUF, I) INTEGER NODE, I, J INTEGER PICKUP INTEGER JUNK LOGICAL*1 BUF(100) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) IF (.NOT.( OUT .EQ. 0 .AND. PICKUP( BUF, I, NODE, 6, JUNK) .NE. -3 * ))GOTO 23317 OUTF=(0) RETURN 23317 CONTINUE IF (.NOT.(OUT .GT. 0))GOTO 23319 IF (.NOT.(AOUT(OUT) .NE. 0))GOTO 23321 CALL CHCOPY( 62, BUF, I) 23321 CONTINUE IF (.NOT.(COUT(OUT) .GT. 0))GOTO 23323 J = COUT(OUT) + 1 IF (.NOT.(AOUT(OUT) .EQ. 0 .OR. IBUF(J) .NE. 62))GOTO 23325 J = J - 1 23325 CONTINUE CALL STCOPY( IBUF, J, BUF, I) GOTO 23324 23323 CONTINUE CALL CHCOPY( 62, BUF, I) CALL GPNAME( IABS(COUT(OUT)), BUF, I) 23324 CONTINUE OUTF=(0) RETURN 23319 CONTINUE 23318 CONTINUE OUTF=(-3) RETURN END INTEGER FUNCTION PARAM(C) LOGICAL*1 C, T LOGICAL*1 NGETCH, TYPE INTEGER LUDEF INTEGER I, FOUND INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN LOGICAL*1 LIN LOGICAL*1 QUBLQU(4) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) COMMON / CSCLIN / LIN(402) DATA QUBLQU(1)/34/,QUBLQU(2)/32/,QUBLQU(3)/34/,QUBLQU(4)/0/ IF (.NOT.(C .EQ. 36))GOTO 23327 FOUND = 1 LIN(1) = 36 I=2 23329 CONTINUE LIN(I) = NGETCH(LIN(I), SHIN) T = TYPE(LIN(I)) IF (.NOT.(T .NE. 1 .AND. T .NE. 2 .AND. T .NE. 95))GOTO 23332 GOTO 23331 23332 CONTINUE 23330 I=I+1 GOTO 23329 23331 CONTINUE IF (.NOT.(I .EQ. 2 .AND. (T .EQ. 42 .OR. T .EQ. 64)))GOTO 23334 I = 4 CALL PUTBAK(34) LIN(3) = 0 LIN(2) = 57 23336 IF (.NOT.(LIN(2) .GT. 48))GOTO 23338 IF (.NOT.(LUDEF(LIN, LIN(I), TABLE) .EQ. 1))GOTO 23339 CALL PBSTR(LIN(I)) IF (.NOT.(LIN(2) .EQ. 49))GOTO 23341 GOTO 23338 23341 CONTINUE IF (.NOT.(T .EQ. 64))GOTO 23343 CALL PBSTR(QUBLQU) GOTO 23344 23343 CONTINUE CALL PUTBAK(32) 23344 CONTINUE 23339 CONTINUE 23337 LIN(2) = LIN(2) - 1 GOTO 23336 23338 CONTINUE CALL PUTBAK(34) GOTO 23335 23334 CONTINUE CALL PUTBAK(LIN(I)) LIN(I) = 0 I = I + 1 IF (.NOT.(LUDEF(LIN, LIN(I), TABLE) .EQ. 1))GOTO 23345 CALL PBSTR(LIN(I)) 23345 CONTINUE 23335 CONTINUE C = NGETCH(C, SHIN) PARAM=(FOUND) RETURN 23327 CONTINUE PARAM=(0) RETURN END INTEGER FUNCTION PARSER (LINE) INTEGER P, P1, P2, MARK, I, J INTEGER SYNTAX, SYN1, SYN2, SYN3 INTEGER MKTOKS, NEXTP LOGICAL*1 LINE(100) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) TREEND = 0 PP = 0 I=1 23347 IF (.NOT.(I.LE.4))GOTO 23349 J=1 23350 IF (.NOT.(J.LE.132))GOTO 23352 TKBUF(I,J) = 0 23351 J=J+1 GOTO 23350 23352 CONTINUE 23348 I=I+1 GOTO 23347 23349 CONTINUE I=1 23353 IF (.NOT.(I.LE.200))GOTO 23355 TREE(I) = 0 23354 I=I+1 GOTO 23353 23355 CONTINUE I=1 23356 IF (.NOT.(I.LE.402))GOTO 23358 IBUF(I) = 0 23357 I=I+1 GOTO 23356 23358 CONTINUE IF (.NOT.(MKTOKS(LINE,P2) .EQ. -3))GOTO 23359 PARSER=(-3) RETURN 23359 CONTINUE TKBUF( 2, 1) = 0 TKBUF( 3, 1) = -1 TKBUF( 4, 1) = P2 CALL PUTBAC (1) 23361 IF (.NOT.(NEXTP(P1) .NE. 0))GOTO 23362 MARK = TKBUF( 2, P1) P2 = TKBUF( 4, P1) IF (.NOT.(MARK .EQ. 0))GOTO 23363 PARSER = SYNTAX(P1, P2) GOTO 23364 23363 CONTINUE IF (.NOT.(MARK .EQ. 1))GOTO 23365 PARSER = SYN1(P1, P2) GOTO 23366 23365 CONTINUE IF (.NOT.(MARK .EQ. 2))GOTO 23367 PARSER = SYN2(P1,P2) GOTO 23368 23367 CONTINUE IF (.NOT.(MARK .EQ. 3))GOTO 23369 PARSER = SYN3(P1,P2) 23369 CONTINUE 23368 CONTINUE 23366 CONTINUE 23364 CONTINUE IF (.NOT.(PARSER .EQ. -3))GOTO 23371 RETURN 23371 CONTINUE GOTO 23361 23362 CONTINUE PARSER = 0 RETURN END SUBROUTINE PASTBL (C) LOGICAL*1 C LOGICAL*1 NGETCH INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) 23373 CONTINUE C = NGETCH(C, SHIN) 23374 IF (.NOT.(C .NE. 32 .AND. C .NE. 9))GOTO 23373 23375 CONTINUE RETURN END INTEGER FUNCTION PICKUP( ARRAY, I, NODE, FIELD, ARG) INTEGER NODE, FIELD, ARG, I LOGICAL*1 ARRAY(100) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) 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 23376 CALL STCOPY( IBUF, TREE(NODE+FIELD), ARRAY, I) GOTO 23377 23376 CONTINUE IF (.NOT.(FIELD .EQ. 9 .AND. TREE(NODE+2) .EQ. 99))GOTO 23378 CALL STCOPY( IBUF, TREE(NODE+9), ARRAY, I) GOTO 23379 23378 CONTINUE IF (.NOT.(FIELD .EQ. 10 .AND. TREE(NODE+2) .EQ. 99 .AND. ARG .LE. *TREE(NODE+8) ))GOTO 23380 CALL STCOPY( IBUF, TREE(NODE+9+ARG), ARRAY, I) GOTO 23381 23380 CONTINUE PICKUP = -3 23381 CONTINUE 23379 CONTINUE 23377 CONTINUE RETURN END SUBROUTINE PUTBAC (P) INTEGER P INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 ST00GZ(29) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) DATA ST00GZ(1)/115/,ST00GZ(2)/116/,ST00GZ(3)/97/,ST00GZ(4)/99/,ST0 *0GZ(5)/107/,ST00GZ(6)/32/,ST00GZ(7)/115/,ST00GZ(8)/105/,ST00GZ(9)/ *122/,ST00GZ(10)/101/,ST00GZ(11)/32/,ST00GZ(12)/101/,ST00GZ(13)/120 */,ST00GZ(14)/99/,ST00GZ(15)/101/,ST00GZ(16)/101/,ST00GZ(17)/100/,S *T00GZ(18)/101/,ST00GZ(19)/100/,ST00GZ(20)/32/,ST00GZ(21)/40/,ST00G *Z(22)/112/,ST00GZ(23)/117/,ST00GZ(24)/116/,ST00GZ(25)/98/,ST00GZ(2 *6)/97/,ST00GZ(27)/99/,ST00GZ(28)/41/,ST00GZ(29)/0/ PP = PP + 1 IF (.NOT.(PP .GT. 15))GOTO 23382 CALL STXERR(ST00GZ) GOTO 23383 23382 CONTINUE STACK(PP) = P 23383 CONTINUE RETURN END SUBROUTINE PWDIR(FILE, FD, C) LOGICAL*1 FILE(36), C INTEGER FD CALL GWDIR( FILE, 5) IF (.NOT.( FILE(2) .EQ. 64 ))GOTO 23384 FILE(2) = 92 23384 CONTINUE CALL PUTLIN(FILE, FD) IF (.NOT.(C .NE. 0))GOTO 23386 CALL PUTCH(C, FD) 23386 CONTINUE RETURN END SUBROUTINE QS(CHAR, TOK) LOGICAL*1 C, TOK(100), CHAR INTEGER J, JUNK INTEGER PARAM LOGICAL*1 NGETCH INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) TOK(1) = CHAR J = 2 C=NGETCH(C,SHIN) 23388 IF (.NOT.(C .NE. 0))GOTO 23390 IF (.NOT.(CHAR .EQ. 34))GOTO 23391 JUNK = PARAM(C) 23391 CONTINUE IF (.NOT.(C .EQ. 0))GOTO 23393 GOTO 23390 23393 CONTINUE TOK(J) = C J = J + 1 IF (.NOT.(C .EQ. CHAR))GOTO 23395 GOTO 23390 23395 CONTINUE 23389 C=NGETCH(C, SHIN) GOTO 23388 23390 CONTINUE TOK(J) = 0 RETURN END INTEGER FUNCTION SCRF (NODE, COMAND, ARGS) LOGICAL*1 COMAND(100), ARGS(100) INTEGER PICKUP, INF, OUTF, ERRF, LENGTH, LOCCOM INTEGER I, J, TYPE INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH 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) LOGICAL*1 SPATH(18) LOGICAL*1 ST00HZ(32) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) 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/ DATA SPATH(1)/0/,SPATH(2)/126/,SPATH(3)/47/,SPATH(4)/0/,SPATH(5)/1 *26/,SPATH(6)/117/,SPATH(7)/115/,SPATH(8)/114/,SPATH(9)/47/,SPATH(1 *0)/0/,SPATH(11)/126/,SPATH(12)/98/,SPATH(13)/105/,SPATH(14)/110/,S *PATH(15)/47/,SPATH(16)/0/,SPATH(17)/10/,SPATH(18)/0/ DATA ST00HZ(1)/63/,ST00HZ(2)/32/,ST00HZ(3)/67/,ST00HZ(4)/97/,ST00H *Z(5)/110/,ST00HZ(6)/39/,ST00HZ(7)/116/,ST00HZ(8)/32/,ST00HZ(9)/108 */,ST00HZ(10)/111/,ST00HZ(11)/99/,ST00HZ(12)/97/,ST00HZ(13)/116/,ST *00HZ(14)/101/,ST00HZ(15)/32/,ST00HZ(16)/115/,ST00HZ(17)/104/,ST00H *Z(18)/101/,ST00HZ(19)/108/,ST00HZ(20)/108/,ST00HZ(21)/32/,ST00HZ(2 *2)/105/,ST00HZ(23)/109/,ST00HZ(24)/97/,ST00HZ(25)/103/,ST00HZ(26)/ *101/,ST00HZ(27)/32/,ST00HZ(28)/102/,ST00HZ(29)/105/,ST00HZ(30)/108 */,ST00HZ(31)/101/,ST00HZ(32)/0/ J = 1 CALL STCOPY( SHSTR, 1, ARGS, J) CALL CHCOPY( 32, ARGS, J) IF (.NOT.(PRLIN .EQ. 1))GOTO 23397 CALL STCOPY( PRFLAG, 1, ARGS, J) 23397 CONTINUE IF (.NOT.(PRCOM .EQ. 1))GOTO 23399 CALL STCOPY( CMFLAG, 1, ARGS, J) 23399 CONTINUE IF (.NOT.(DROP .EQ. 0))GOTO 23401 CALL STCOPY( DRFLAG, 1, ARGS, J) 23401 CONTINUE CALL STCOPY( COMAND, 1, ARGS, J) IF (.NOT.( LOCCOM( SHSTR, SPATH, SUFFIX, COMAND) .NE. 60 ))GOTO 23 *403 CALL REMARK( ST00HZ) SCRF=(-3) RETURN 23403 CONTINUE CALL CHCOPY( 32, ARGS, J) I=1 23405 IF (.NOT.(PICKUP(ARGS, J, NODE, 10, I) .NE. -3))GOTO 23407 CALL CHCOPY( 32, ARGS, J) 23406 I=I+1 GOTO 23405 23407 CONTINUE CALL CHCOPY( 64, ARGS, J) IF (.NOT.( INF(NODE, ARGS, J) .NE. -3))GOTO 23408 CALL CHCOPY( 32, ARGS, J) GOTO 23409 23408 CONTINUE J = J - 1 23409 CONTINUE IF (.NOT.( OUTF(NODE, ARGS, J) .NE. -3))GOTO 23410 CALL CHCOPY( 32, ARGS, J) 23410 CONTINUE IF (.NOT.( ERRF(NODE, ARGS, J) .NE. -3))GOTO 23412 CALL CHCOPY( 32, ARGS, J) 23412 CONTINUE ARGS(J) = 0 SCRF=(0) RETURN END INTEGER FUNCTION SETREE (NODE, POSN, VALUE) INTEGER NODE, POSN, VALUE, I INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 ST00IZ(33) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) DATA ST00IZ(1)/100/,ST00IZ(2)/111/,ST00IZ(3)/117/,ST00IZ(4)/98/,ST *00IZ(5)/108/,ST00IZ(6)/121/,ST00IZ(7)/32/,ST00IZ(8)/100/,ST00IZ(9) */101/,ST00IZ(10)/102/,ST00IZ(11)/105/,ST00IZ(12)/110/,ST00IZ(13)/1 *01/,ST00IZ(14)/100/,ST00IZ(15)/32/,ST00IZ(16)/97/,ST00IZ(17)/114/, *ST00IZ(18)/103/,ST00IZ(19)/117/,ST00IZ(20)/109/,ST00IZ(21)/101/,ST *00IZ(22)/110/,ST00IZ(23)/116/,ST00IZ(24)/32/,ST00IZ(25)/40/,ST00IZ *(26)/115/,ST00IZ(27)/101/,ST00IZ(28)/116/,ST00IZ(29)/114/,ST00IZ(3 *0)/101/,ST00IZ(31)/101/,ST00IZ(32)/41/,ST00IZ(33)/0/ I = NODE + POSN IF (.NOT.(TREE(I) .NE. 0))GOTO 23414 CALL STXERR(ST00IZ) SETREE=(-3) RETURN 23414 CONTINUE TREE(I) = VALUE SETREE=(0) RETURN END INTEGER FUNCTION SHCOM(COMAND) LOGICAL*1 COMAND(100) INTEGER I, J LOGICAL*1 INTCMD(83) DATA INTCMD(1)/99/,INTCMD(2)/100/,INTCMD(3)/1/,INTCMD(4)/104/,INTC *MD(5)/111/,INTCMD(6)/2/,INTCMD(7)/104/,INTCMD(8)/111/,INTCMD(9)/10 *9/,INTCMD(10)/101/,INTCMD(11)/3/,INTCMD(12)/108/,INTCMD(13)/111/,I *NTCMD(14)/103/,INTCMD(15)/111/,INTCMD(16)/117/,INTCMD(17)/116/,INT *CMD(18)/4/,INTCMD(19)/112/,INTCMD(20)/97/,INTCMD(21)/116/,INTCMD(2 *2)/104/,INTCMD(23)/5/,INTCMD(24)/118/,INTCMD(25)/111/,INTCMD(26)/1 *10/,INTCMD(27)/6/,INTCMD(28)/118/,INTCMD(29)/111/,INTCMD(30)/102/, *INTCMD(31)/102/,INTCMD(32)/7/,INTCMD(33)/120/,INTCMD(34)/111/,INTC *MD(35)/110/,INTCMD(36)/8/,INTCMD(37)/120/,INTCMD(38)/111/,INTCMD(3 *9)/102/,INTCMD(40)/102/,INTCMD(41)/9/,INTCMD(42)/35/,INTCMD(43)/10 */,INTCMD(44)/97/,INTCMD(45)/108/,INTCMD(46)/105/,INTCMD(47)/97/,IN *TCMD(48)/115/,INTCMD(49)/11/,INTCMD(50)/112/,INTCMD(51)/97/,INTCMD *(52)/114/,INTCMD(53)/97/,INTCMD(54)/109/,INTCMD(55)/12/,INTCMD(56) */97/,INTCMD(57)/115/,INTCMD(58)/107/,INTCMD(59)/13/,INTCMD(60)/115 */,INTCMD(61)/111/,INTCMD(62)/117/,INTCMD(63)/114/,INTCMD(64)/99/,I *NTCMD(65)/101/,INTCMD(66)/14/,INTCMD(67)/117/,INTCMD(68)/110/,INTC *MD(69)/97/,INTCMD(70)/108/,INTCMD(71)/105/,INTCMD(72)/97/,INTCMD(7 *3)/115/,INTCMD(74)/15/,INTCMD(75)/117/,INTCMD(76)/110/,INTCMD(77)/ *112/,INTCMD(78)/97/,INTCMD(79)/114/,INTCMD(80)/97/,INTCMD(81)/109/ *,INTCMD(82)/16/,INTCMD(83)/0/ I = 1 23416 IF (.NOT.(INTCMD(I) .NE. 0))GOTO 23418 J = 1 23419 IF (.NOT.(COMAND(J) .NE. 0))GOTO 23421 IF (.NOT.(COMAND(J) .NE. INTCMD(I)))GOTO 23422 GOTO 23421 23422 CONTINUE 23420 I = I + 1 J = J + 1 GOTO 23419 23421 CONTINUE IF (.NOT.(COMAND(J) .EQ. 0 .AND. INTCMD(I) .LT. 32))GOTO 23424 SHCOM=(INTCMD(I)) RETURN 23424 CONTINUE 23426 IF (.NOT.(INTCMD(I) .GT. 32))GOTO 23427 I = I + 1 GOTO 23426 23427 CONTINUE 23417 I = I + 1 GOTO 23416 23418 CONTINUE SHCOM=(0) RETURN END INTEGER FUNCTION SHELLC (COMAND, ARGS) LOGICAL*1 ARGS(100), COMAND(100) INTEGER SHCOM, CHGDIR INTEGER DASK INTEGER OPEN INTEGER I, STATUS INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN INTEGER I23428 LOGICAL*1 ST00JZ(32) LOGICAL*1 ST00KZ(15) LOGICAL*1 ST00LZ(24) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) DATA ST00JZ(1)/63/,ST00JZ(2)/32/,ST00JZ(3)/83/,ST00JZ(4)/111/,ST00 *JZ(5)/117/,ST00JZ(6)/114/,ST00JZ(7)/99/,ST00JZ(8)/101/,ST00JZ(9)/3 *2/,ST00JZ(10)/102/,ST00JZ(11)/105/,ST00JZ(12)/108/,ST00JZ(13)/101/ *,ST00JZ(14)/115/,ST00JZ(15)/32/,ST00JZ(16)/110/,ST00JZ(17)/101/,ST *00JZ(18)/115/,ST00JZ(19)/116/,ST00JZ(20)/101/,ST00JZ(21)/100/,ST00 *JZ(22)/32/,ST00JZ(23)/116/,ST00JZ(24)/111/,ST00JZ(25)/32/,ST00JZ(2 *6)/100/,ST00JZ(27)/101/,ST00JZ(28)/101/,ST00JZ(29)/112/,ST00JZ(30) */108/,ST00JZ(31)/121/,ST00JZ(32)/0/ DATA ST00KZ(1)/32/,ST00KZ(2)/45/,ST00KZ(3)/32/,ST00KZ(4)/99/,ST00K *Z(5)/97/,ST00KZ(6)/110/,ST00KZ(7)/110/,ST00KZ(8)/111/,ST00KZ(9)/11 *6/,ST00KZ(10)/32/,ST00KZ(11)/111/,ST00KZ(12)/112/,ST00KZ(13)/101/, *ST00KZ(14)/110/,ST00KZ(15)/0/ DATA ST00LZ(1)/63/,ST00LZ(2)/32/,ST00LZ(3)/73/,ST00LZ(4)/110/,ST00 *LZ(5)/118/,ST00LZ(6)/97/,ST00LZ(7)/108/,ST00LZ(8)/105/,ST00LZ(9)/1 *00/,ST00LZ(10)/32/,ST00LZ(11)/115/,ST00LZ(12)/104/,ST00LZ(13)/101/ *,ST00LZ(14)/108/,ST00LZ(15)/108/,ST00LZ(16)/32/,ST00LZ(17)/99/,ST0 *0LZ(18)/111/,ST00LZ(19)/109/,ST00LZ(20)/109/,ST00LZ(21)/97/,ST00LZ *(22)/110/,ST00LZ(23)/100/,ST00LZ(24)/0/ STATUS = 0 I23428=(SHCOM(COMAND)) GOTO 23428 23430 CONTINUE STATUS = CHGDIR(ARGS) GOTO 23429 23431 CONTINUE STATUS = CHGDIR(HOMEDR) GOTO 23429 23432 CONTINUE PRLIN = 1 GOTO 23429 23433 CONTINUE PRLIN = 0 GOTO 23429 23434 CONTINUE PRCOM = 1 GOTO 23429 23435 CONTINUE PRCOM = 0 GOTO 23429 23436 CONTINUE CALL DSPPTH(SH) GOTO 23429 23437 CONTINUE CALL ENDSH(113) GOTO 23429 23438 CONTINUE GOTO 23429 23439 CONTINUE IF (.NOT.(ARGS(1) .EQ. 0))GOTO 23440 CALL DSPTBL(ARGS, 36) GOTO 23441 23440 CONTINUE CALL PROCDF(ARGS, 36) 23441 CONTINUE GOTO 23429 23442 CONTINUE IF (.NOT.(ARGS(1) .EQ. 0))GOTO 23443 CALL DSPTBL(ARGS, 0) GOTO 23444 23443 CONTINUE CALL PROCDF(ARGS, 0) 23444 CONTINUE GOTO 23429 23445 CONTINUE STATUS = DASK(ARGS) GOTO 23429 23446 CONTINUE IF (.NOT.(DEPTH .GE. 3))GOTO 23447 CALL REMARK(ST00JZ) GOTO 23448 23447 CONTINUE DEPTH = DEPTH + 1 UNIT(DEPTH) = OPEN(ARGS, 1) IF (.NOT.(UNIT(DEPTH) .EQ. -3))GOTO 23449 CALL PUTLIN(ARGS, 3) CALL REMARK(ST00KZ) DEPTH = DEPTH - 1 GOTO 23450 23449 CONTINUE SHIN = UNIT(DEPTH) 23450 CONTINUE 23448 CONTINUE GOTO 23429 23451 CONTINUE CALL KILLDF(ARGS, 0) GOTO 23429 23452 CONTINUE CALL KILLDF(ARGS, 36) GOTO 23429 23453 CONTINUE STATUS = -3 CALL REMARK (ST00LZ) GOTO 23429 23428 CONTINUE IF (I23428.LT.1.OR.I23428.GT.16)GOTO 23453 GOTO (23430,23431,23431,23437,23436,23432,23433,23434,23435,23438, *23442,23439,23445,23446,23451,23452),I23428 23429 CONTINUE SHELLC=(STATUS) RETURN END INTEGER FUNCTION SHLINE (LINE) LOGICAL*1 LINE(100) INTEGER EQUAL, LENGTH, PROMPT LOGICAL*1 TMPARA(5) INTEGER I, K INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN LOGICAL*1 PCHAR(3) LOGICAL*1 VOFF(5) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) DATA PCHAR(1)/37/,PCHAR(2)/32/,PCHAR(3)/0/ DATA VOFF(1)/118/,VOFF(2)/111/,VOFF(3)/102/,VOFF(4)/102/,VOFF(5)/0 */ IF (.NOT.( CARG .EQ. 1 ))GOTO 23454 IF (.NOT.( CARGDN .EQ. 1 ))GOTO 23456 LINE(1) = 0 K = -1 GOTO 23457 23456 CONTINUE CALL STRCPY( CLIN, LINE) CARGDN = 1 K = LENGTH(LINE) 23457 CONTINUE GOTO 23455 23454 CONTINUE 23458 CONTINUE K = PROMPT(PCHAR, LINE, SHIN) IF (.NOT.(K .NE. -1))GOTO 23461 GOTO 23460 23461 CONTINUE IF (.NOT.(DEPTH .GT. 1))GOTO 23463 CALL CLOSE(SHIN) DEPTH = DEPTH - 1 SHIN = UNIT(DEPTH) K = 0 23463 CONTINUE 23459 IF (.NOT.(K .EQ. -1))GOTO 23458 23460 CONTINUE 23455 CONTINUE IF (.NOT.( K .NE. -1 ))GOTO 23465 I=1 23467 IF (.NOT.(I .LE. 4))GOTO 23469 TMPARA(I) = LINE(I) 23468 I = I + 1 GOTO 23467 23469 CONTINUE TMPARA(I) = 0 CALL FOLD(TMPARA) IF (.NOT.( PRLIN .EQ. 1 .AND. EQUAL(TMPARA, VOFF) .EQ. 0 ))GOTO 23 *470 CALL PUTLIN(LINE, 3) 23470 CONTINUE 23465 CONTINUE SHLINE=(K) RETURN END INTEGER FUNCTION SHTOK (TOK) LOGICAL*1 TOK(100), C, NGETCH INTEGER SPEC, PARAM, ATBEG INTEGER I, J, PSTAT INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) PSTAT = 0 23472 CONTINUE CALL PASTBL(C) J = 1 IF (.NOT.(SPEC(C) .EQ. 1))GOTO 23475 TOK(1) = C TOK(2) = 0 SHTOK = C RETURN 23475 CONTINUE IF (.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23477 CALL QS(C, TOK) SHTOK = TOK(1) RETURN 23477 CONTINUE IF (.NOT.(C .EQ. 60 .OR. C .EQ. 62 .OR. C .EQ. 63))GOTO 23479 I=1 23481 IF (.NOT.(I.LE.2))GOTO 23483 TOK(J) = C J = J + 1 CALL PASTBL(C) IF (.NOT.(C .NE. TOK(J-1)))GOTO 23484 GOTO 23483 23484 CONTINUE 23482 I=I+1 GOTO 23481 23483 CONTINUE 23479 CONTINUE 23486 IF (.NOT.(C .NE. 0))GOTO 23488 PSTAT = PARAM(C) IF (.NOT.(C .EQ. 0))GOTO 23489 GOTO 23488 23489 CONTINUE IF (.NOT.(ATBEG(C) .EQ. 1))GOTO 23491 CALL PUTBAK(C) GOTO 23488 23491 CONTINUE IF (.NOT.(C .EQ. 64))GOTO 23493 C = NGETCH(C, SHIN) IF (.NOT.(SPEC(C) .EQ. 0 .AND. (C .NE. 64 .AND. C .NE. 36)))GOTO 2 *3495 CALL PUTBAK(C) C = 64 23495 CONTINUE 23493 CONTINUE TOK(J) = C J = J + 1 23487 C=NGETCH(C, SHIN) GOTO 23486 23488 CONTINUE TOK(J) = 0 SHTOK = TOK(1) IF (.NOT.(PSTAT .EQ. 0 .OR. J .LT. 1))GOTO 23497 RETURN 23497 CONTINUE PSTAT = 0 23473 GOTO 23472 23474 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 23499 SPEC = 1 IF (.NOT.(C .EQ. 94))GOTO 23501 C = 124 23501 CONTINUE GOTO 23500 23499 CONTINUE SPEC = 0 23500 CONTINUE RETURN END SUBROUTINE STRIPB(BUF) INTEGER I INTEGER LENGTH LOGICAL*1 BUF(100) I=LENGTH(BUF) 23503 IF (.NOT.(I .GT. 0 ))GOTO 23505 IF (.NOT.( BUF(I) .NE. 32 ))GOTO 23506 GOTO 23505 23506 CONTINUE 23504 I=I-1 GOTO 23503 23505 CONTINUE BUF(I+1) = 0 RETURN END SUBROUTINE STXERR (REASON) LOGICAL*1 REASON(100) INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 FIRST(17) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) 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 INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 ST00MZ(36) LOGICAL*1 ST00NZ(35) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) DATA ST00MZ(1)/117/,ST00MZ(2)/110/,ST00MZ(3)/98/,ST00MZ(4)/97/,ST0 *0MZ(5)/108/,ST00MZ(6)/101/,ST00MZ(7)/110/,ST00MZ(8)/99/,ST00MZ(9)/ *101/,ST00MZ(10)/100/,ST00MZ(11)/32/,ST00MZ(12)/114/,ST00MZ(13)/105 */,ST00MZ(14)/103/,ST00MZ(15)/104/,ST00MZ(16)/116/,ST00MZ(17)/32/,S *T00MZ(18)/112/,ST00MZ(19)/97/,ST00MZ(20)/114/,ST00MZ(21)/101/,ST00 *MZ(22)/110/,ST00MZ(23)/116/,ST00MZ(24)/104/,ST00MZ(25)/101/,ST00MZ *(26)/115/,ST00MZ(27)/101/,ST00MZ(28)/115/,ST00MZ(29)/32/,ST00MZ(30 *)/40/,ST00MZ(31)/115/,ST00MZ(32)/121/,ST00MZ(33)/110/,ST00MZ(34)/4 *9/,ST00MZ(35)/41/,ST00MZ(36)/0/ DATA ST00NZ(1)/117/,ST00NZ(2)/110/,ST00NZ(3)/98/,ST00NZ(4)/97/,ST0 *0NZ(5)/108/,ST00NZ(6)/101/,ST00NZ(7)/110/,ST00NZ(8)/99/,ST00NZ(9)/ *101/,ST00NZ(10)/100/,ST00NZ(11)/32/,ST00NZ(12)/108/,ST00NZ(13)/101 */,ST00NZ(14)/102/,ST00NZ(15)/116/,ST00NZ(16)/32/,ST00NZ(17)/112/,S *T00NZ(18)/97/,ST00NZ(19)/114/,ST00NZ(20)/101/,ST00NZ(21)/110/,ST00 *NZ(22)/116/,ST00NZ(23)/104/,ST00NZ(24)/101/,ST00NZ(25)/115/,ST00NZ *(26)/101/,ST00NZ(27)/115/,ST00NZ(28)/32/,ST00NZ(29)/40/,ST00NZ(30) */115/,ST00NZ(31)/121/,ST00NZ(32)/110/,ST00NZ(33)/49/,ST00NZ(34)/41 */,ST00NZ(35)/0/ L = 0 P=P1 23508 IF (.NOT.(P.LT.P2))GOTO 23510 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23511 L = L + 1 GOTO 23512 23511 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23513 L = L - 1 23513 CONTINUE 23512 CONTINUE IF (.NOT.(L .LT. 0))GOTO 23515 CALL STXERR(ST00MZ) GOTO 23516 23515 CONTINUE IF (.NOT.(TOK .EQ. 38 .OR. TOK .EQ. 59))GOTO 23517 IF (.NOT.(L .EQ. 0))GOTO 23519 IF (.NOT.( MKTREE( TKBUF( 3, P1), TOK, 4, NODE) .EQ. -3))GOTO 2352 *1 SYN1=(-3) RETURN 23521 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 23519 CONTINUE 23517 CONTINUE 23516 CONTINUE 23509 P=P+1 GOTO 23508 23510 CONTINUE IF (.NOT.(L .GT. 0))GOTO 23523 CALL STXERR(ST00NZ) GOTO 23524 23523 CONTINUE TKBUF( 2, P1) = 2 CALL PUTBAC (P1) 23524 CONTINUE SYN1=(0) RETURN END INTEGER FUNCTION SYN2 (P1,P2) LOGICAL*1 TOK INTEGER P, P1, P2, L, NODE, PT, NDX INTEGER MKTREE INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) L = 0 P=P1 23525 IF (.NOT.(P.LT.P2))GOTO 23527 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23528 L = L + 1 GOTO 23529 23528 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23530 L = L - 1 GOTO 23531 23530 CONTINUE IF (.NOT.(TOK .EQ. 124))GOTO 23532 IF (.NOT.(L .EQ. 0))GOTO 23534 IF (.NOT.( MKTREE( TKBUF( 3, P1), 124, 4, NODE) .EQ. -3))GOTO 2353 *6 SYN2=(-3) RETURN 23536 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 23534 CONTINUE 23532 CONTINUE 23531 CONTINUE 23529 CONTINUE 23526 P=P+1 GOTO 23525 23527 CONTINUE TKBUF( 2, P1) = 3 CALL PUTBAC (P1) SYN2=(0) RETURN END INTEGER FUNCTION SYN3 (P1,P2) INTEGER P1, P2, NDX INTEGER DOPAR, DOVERB INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF LOGICAL*1 ST00OZ(21) COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) DATA ST00OZ(1)/101/,ST00OZ(2)/109/,ST00OZ(3)/112/,ST00OZ(4)/116/,S *T00OZ(5)/121/,ST00OZ(6)/32/,ST00OZ(7)/99/,ST00OZ(8)/111/,ST00OZ(9) */109/,ST00OZ(10)/109/,ST00OZ(11)/97/,ST00OZ(12)/110/,ST00OZ(13)/10 *0/,ST00OZ(14)/32/,ST00OZ(15)/40/,ST00OZ(16)/115/,ST00OZ(17)/121/,S *T00OZ(18)/110/,ST00OZ(19)/51/,ST00OZ(20)/41/,ST00OZ(21)/0/ IF (.NOT.(P1 .GE. P2))GOTO 23538 CALL STXERR(ST00OZ) SYN3=(-3) RETURN 23538 CONTINUE NDX = TKBUF( 1, P1) IF (.NOT.(IBUF(NDX) .EQ. 40))GOTO 23540 SYN3=( DOPAR(P1,P2)) RETURN 23540 CONTINUE SYN3=( DOVERB(P1,P2)) RETURN 23541 CONTINUE END INTEGER FUNCTION SYNTAX (P1,P2) INTEGER P, P1, P2, NDX LOGICAL*1 TOK INTEGER TKBUF INTEGER TREE INTEGER STACK INTEGER TREEND INTEGER PP LOGICAL*1 IBUF COMMON /CPARS/ TKBUF(4, 132), TREE(200), STACK(15), TREEND, PP, IB *UF(402) P=P1 23542 IF (.NOT.(P.LT.P2))GOTO 23544 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 59 .OR. TOK .EQ. 38 .OR. TOK .EQ. 10))GOTO 2354 *5 GOTO 23543 23545 CONTINUE GOTO 23544 23543 P=P+1 GOTO 23542 23544 CONTINUE IF (.NOT.(P .LT. P2))GOTO 23547 TKBUF( 2, P) = 1 TKBUF( 3, P) = TKBUF( 3, P1) TKBUF( 4, P) = TKBUF( 4, P1) CALL PUTBAC (P) 23547 CONTINUE SYNTAX=(0) RETURN END SUBROUTINE DSPTBL(BUF, C) LOGICAL*1 BUF(100), C INTEGER POSN, INFO, I, NDX INTEGER SCTABL INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN INTEGER MEM(500) LOGICAL*1 CMEM(1000) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) POSN = 0 IF (.NOT.(C .EQ. 36))GOTO 23549 NDX = 2 GOTO 23550 23549 CONTINUE NDX = 1 23550 CONTINUE 23551 IF (.NOT.(SCTABL(TABLE, BUF, INFO, POSN) .NE. -1))GOTO 23552 IF (.NOT.((C .EQ. 36 .AND. BUF(1) .EQ. 36) .OR. (C .NE. 36 .AND. B *UF(1) .NE. 36)))GOTO 23553 CALL PUTSTR(BUF(NDX), -15, 3) CALL PUTCH(32, 3) I=(2*(INFO-1)+1) 23555 IF (.NOT.(CMEM(I) .NE. 0))GOTO 23557 CALL PUTCH(CMEM(I), 3) 23556 I=I+1 GOTO 23555 23557 CONTINUE CALL PUTCH(10, 3) 23553 CONTINUE GOTO 23551 23552 CONTINUE RETURN END INTEGER FUNCTION DASK(ARGS) INTEGER I, J, STATUS INTEGER PROMPT LOGICAL*1 ARGS(100), PSTR(40), TRMC INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 QMKBLK(3) LOGICAL*1 ST00PZ(37) LOGICAL*1 ST00QZ(38) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) DATA QMKBLK(1)/63/,QMKBLK(2)/32/,QMKBLK(3)/0/ DATA ST00PZ(1)/117/,ST00PZ(2)/115/,ST00PZ(3)/97/,ST00PZ(4)/103/,ST *00PZ(5)/101/,ST00PZ(6)/58/,ST00PZ(7)/32/,ST00PZ(8)/32/,ST00PZ(9)/9 *7/,ST00PZ(10)/115/,ST00PZ(11)/107/,ST00PZ(12)/32/,ST00PZ(13)/112/, *ST00PZ(14)/97/,ST00PZ(15)/114/,ST00PZ(16)/97/,ST00PZ(17)/109/,ST00 *PZ(18)/91/,ST00PZ(19)/32/,ST00PZ(20)/112/,ST00PZ(21)/114/,ST00PZ(2 *2)/111/,ST00PZ(23)/109/,ST00PZ(24)/112/,ST00PZ(25)/116/,ST00PZ(26) */91/,ST00PZ(27)/32/,ST00PZ(28)/100/,ST00PZ(29)/101/,ST00PZ(30)/102 */,ST00PZ(31)/97/,ST00PZ(32)/117/,ST00PZ(33)/108/,ST00PZ(34)/116/,S *T00PZ(35)/93/,ST00PZ(36)/93/,ST00PZ(37)/0/ DATA ST00QZ(1)/85/,ST00QZ(2)/110/,ST00QZ(3)/101/,ST00QZ(4)/120/,ST *00QZ(5)/112/,ST00QZ(6)/101/,ST00QZ(7)/99/,ST00QZ(8)/116/,ST00QZ(9) */101/,ST00QZ(10)/100/,ST00QZ(11)/32/,ST00QZ(12)/69/,ST00QZ(13)/79/ *,ST00QZ(14)/70/,ST00QZ(15)/32/,ST00QZ(16)/112/,ST00QZ(17)/114/,ST0 *0QZ(18)/111/,ST00QZ(19)/99/,ST00QZ(20)/101/,ST00QZ(21)/115/,ST00QZ *(22)/115/,ST00QZ(23)/105/,ST00QZ(24)/110/,ST00QZ(25)/103/,ST00QZ(2 *6)/32/,ST00QZ(27)/97/,ST00QZ(28)/115/,ST00QZ(29)/107/,ST00QZ(30)/3 *2/,ST00QZ(31)/99/,ST00QZ(32)/111/,ST00QZ(33)/109/,ST00QZ(34)/109/, *ST00QZ(35)/97/,ST00QZ(36)/110/,ST00QZ(37)/100/,ST00QZ(38)/0/ IF (.NOT.(ARGS(1) .EQ. 0))GOTO 23558 CALL REMARK(ST00PZ) DASK=(-3) RETURN 23558 CONTINUE SH(1) = 36 I = 1 J = 2 23560 IF (.NOT.(ARGS(I) .NE. 0))GOTO 23562 IF (.NOT.(ARGS(I) .EQ. 32))GOTO 23563 GOTO 23562 23563 CONTINUE SH(J) = ARGS(I) 23564 CONTINUE 23561 I = I + 1 J = J + 1 GOTO 23560 23562 CONTINUE SH(J) = 0 CALL SKIPBL(ARGS, I) CALL CONCAT(SH(2), QMKBLK, PSTR) IF (.NOT.(ARGS(I) .NE. 0))GOTO 23565 IF (.NOT.(ARGS(I) .EQ. 34 .OR. ARGS(I) .EQ. 39))GOTO 23567 TRMC = ARGS(I) I = I + 1 GOTO 23568 23567 CONTINUE TRMC = 32 23568 CONTINUE IF (.NOT.(ARGS(I) .EQ. TRMC))GOTO 23569 I = I + 1 GOTO 23570 23569 CONTINUE J = 1 23571 IF (.NOT.(ARGS(I) .NE. 0))GOTO 23573 IF (.NOT.(ARGS(I) .EQ. TRMC))GOTO 23574 I = I + 1 GOTO 23573 23574 CONTINUE PSTR(J) = ARGS(I) 23575 CONTINUE 23572 J = J + 1 I = I + 1 GOTO 23571 23573 CONTINUE PSTR(J) = 0 23570 CONTINUE CALL SKIPBL(ARGS, I) 23565 CONTINUE CALL SCOPY(ARGS, I, ARGS, 1) IF (.NOT.(ARGS(1) .NE. 0))GOTO 23576 CALL ENTDEF(SH, ARGS, TABLE) GOTO 23577 23576 CONTINUE CALL RMDEF(SH, TABLE) 23577 CONTINUE J = PROMPT(PSTR, ARGS, 1) IF (.NOT.(J .EQ. -1))GOTO 23578 STATUS = -3 CALL REMARK(ST00QZ) GOTO 23579 23578 CONTINUE STATUS = 0 IF (.NOT.(PRLIN .EQ. 1))GOTO 23580 CALL PUTLIN(ARGS, 3) 23580 CONTINUE IF (.NOT.(J .GT. 1))GOTO 23582 ARGS(J) = 0 CALL ENTDEF(SH, ARGS, TABLE) 23582 CONTINUE 23579 CONTINUE DASK=(STATUS) RETURN END SUBROUTINE PROCDF(ARGS, C) LOGICAL*1 ARGS(100), C INTEGER I, J, NDX INTEGER LUDEF, SHCOM INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 UNDEF(15) LOGICAL*1 ST00RZ(36) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) DATA UNDEF(1)/32/,UNDEF(2)/45/,UNDEF(3)/32/,UNDEF(4)/110/,UNDEF(5) */111/,UNDEF(6)/116/,UNDEF(7)/32/,UNDEF(8)/100/,UNDEF(9)/101/,UNDEF *(10)/102/,UNDEF(11)/105/,UNDEF(12)/110/,UNDEF(13)/101/,UNDEF(14)/1 *00/,UNDEF(15)/0/ DATA ST00RZ(1)/65/,ST00RZ(2)/116/,ST00RZ(3)/116/,ST00RZ(4)/101/,ST *00RZ(5)/109/,ST00RZ(6)/112/,ST00RZ(7)/116/,ST00RZ(8)/32/,ST00RZ(9) */116/,ST00RZ(10)/111/,ST00RZ(11)/32/,ST00RZ(12)/114/,ST00RZ(13)/10 *1/,ST00RZ(14)/100/,ST00RZ(15)/101/,ST00RZ(16)/102/,ST00RZ(17)/105/ *,ST00RZ(18)/110/,ST00RZ(19)/101/,ST00RZ(20)/32/,ST00RZ(21)/97/,ST0 *0RZ(22)/32/,ST00RZ(23)/114/,ST00RZ(24)/101/,ST00RZ(25)/115/,ST00RZ *(26)/101/,ST00RZ(27)/114/,ST00RZ(28)/118/,ST00RZ(29)/101/,ST00RZ(3 *0)/100/,ST00RZ(31)/32/,ST00RZ(32)/119/,ST00RZ(33)/111/,ST00RZ(34)/ *114/,ST00RZ(35)/100/,ST00RZ(36)/0/ IF (.NOT.(C .NE. 0))GOTO 23584 SH(1) = C J = 2 GOTO 23585 23584 CONTINUE J = 1 23585 CONTINUE NDX = J I = 1 23586 IF (.NOT.(ARGS(I) .NE. 0))GOTO 23588 IF (.NOT.(ARGS(I) .EQ. 32))GOTO 23589 GOTO 23588 23589 CONTINUE SH(J) = ARGS(I) 23590 CONTINUE 23587 I = I + 1 J = J + 1 GOTO 23586 23588 CONTINUE SH(J) = 0 CALL SKIPBL(ARGS, I) CALL SCOPY(ARGS, I, ARGS, 1) IF (.NOT.(ARGS(1) .EQ. 0))GOTO 23591 IF (.NOT.(LUDEF(SH, ARGS, TABLE) .EQ. 1))GOTO 23593 CALL PUTSTR(SH(NDX), -15, 3) CALL PUTCH(32, 3) CALL PUTLNL(ARGS, 3) GOTO 23594 23593 CONTINUE CALL PUTLIN(SH(NDX), 3) CALL PUTLNL(UNDEF, 3) 23594 CONTINUE GOTO 23592 23591 CONTINUE IF (.NOT.(SHCOM(SH) .GT. 0))GOTO 23595 CALL REMARK(ST00RZ) GOTO 23596 23595 CONTINUE CALL ENTDEF(SH, ARGS, TABLE) 23596 CONTINUE 23592 CONTINUE RETURN END INTEGER FUNCTION CHGDIR(ARGS) LOGICAL*1 ARGS(100) INTEGER CWDIR INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR LOGICAL*1 FINISH(21) COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) DATA FINISH(1)/58/,FINISH(2)/32/,FINISH(3)/110/,FINISH(4)/111/,FIN *ISH(5)/32/,FINISH(6)/115/,FINISH(7)/117/,FINISH(8)/99/,FINISH(9)/1 *04/,FINISH(10)/32/,FINISH(11)/100/,FINISH(12)/105/,FINISH(13)/114/ *,FINISH(14)/101/,FINISH(15)/99/,FINISH(16)/116/,FINISH(17)/111/,FI *NISH(18)/114/,FINISH(19)/121/,FINISH(20)/33/,FINISH(21)/0/ CALL GWDIR(SH, 6) IF (.NOT.(ARGS(1) .EQ. 0))GOTO 23597 CALL STRCPY(OLDDIR, ARGS) 23597 CONTINUE IF (.NOT.(CWDIR(ARGS) .EQ. -3))GOTO 23599 CALL PUTLIN(ARGS, 3) CALL PUTLNL(FINISH, 3) CHGDIR=(-3) RETURN 23599 CONTINUE CALL STRCPY(SH, OLDDIR) CALL PWDIR(SH, 3, 10) 23600 CONTINUE CHGDIR=(0) RETURN END SUBROUTINE KILLDF(ARGS, C) LOGICAL*1 ARGS(100), C INTEGER IN INTEGER CIN INTEGER OUT INTEGER COUT INTEGER ER INTEGER CERR INTEGER AOUT INTEGER AERR INTEGER SCRIPT INTEGER PCTR LOGICAL*1 PFILE LOGICAL*1 HFILE LOGICAL*1 INPUT LOGICAL*1 SH LOGICAL*1 OLDDIR LOGICAL*1 HOMEDR INTEGER EXEC INTEGER PRLIN INTEGER PRCOM INTEGER CARG INTEGER DROP INTEGER CARGDN INTEGER SHIN INTEGER DEPTH INTEGER UNIT INTEGER TABLE LOGICAL*1 CLIN COMMON /STDSUB/ IN, CIN(15), OUT, COUT(15), ER, CERR(15), AOUT(15) *, AERR(15), SCRIPT, PCTR, PFILE(15), HFILE(36), INPUT(36), SH(36), * OLDDIR(36), HOMEDR(36) COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) I = 1 CALL CHCOPY(C, SH, I) CALL CONCAT(SH, ARGS, SH) CALL RMDEF(SH, TABLE) RETURN END