SUBROUTINE MAIN LOGICAL*1 LINE(402) INTEGER PARSER, SHLINE, EQUAL LOGICAL*1 QMARK(3) LOGICAL*1 ST001Z(41) 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 *04/,ST001Z(10)/115/,ST001Z(11)/104/,ST001Z(12)/32/,ST001Z(13)/91/, *ST001Z(14)/45/,ST001Z(15)/99/,ST001Z(16)/100/,ST001Z(17)/110/,ST00 *1Z(18)/118/,ST001Z(19)/120/,ST001Z(20)/93/,ST001Z(21)/32/,ST001Z(2 *2)/91/,ST001Z(23)/102/,ST001Z(24)/105/,ST001Z(25)/108/,ST001Z(26)/ *101/,ST001Z(27)/32/,ST001Z(28)/91/,ST001Z(29)/97/,ST001Z(30)/114/, *ST001Z(31)/103/,ST001Z(32)/117/,ST001Z(33)/109/,ST001Z(34)/101/,ST *001Z(35)/110/,ST001Z(36)/116/,ST001Z(37)/115/,ST001Z(38)/93/,ST001 *Z(39)/93/,ST001Z(40)/46/,ST001Z(41)/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 LENGTH 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) 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) I = LENGTH(COMAND) + 1 IF (.NOT.(SHCOM(PATH) .GT. 0))GOTO 23017 CMDTYP = 17 GOTO 23018 23017 CONTINUE IF (.NOT.(EQUAL(PATH, EXECUT) .EQ. 1))GOTO 23019 CALL STRCPY(LOCAL, PATH) CMDTYP = 60 GOTO 23020 23019 CONTINUE CMDTYP = LOCCOM(PATH, SPATH, SUFFIX, PATH) I = 1 23020 CONTINUE 23018 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, 100), TREE(160), 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 23021 RETURN 23021 CONTINUE IF (.NOT.( LOCCOM( SHSTR, SPATH, SUFFIX, SH) .NE. 60 ))GOTO 23023 CALL REMARK( ST004Z) RETURN 23023 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 23025 RETURN 23025 CONTINUE CALL STRIPB(CLIN) IF (.NOT.(PRCOM .EQ. 1))GOTO 23027 CALL DSPCOM(SH, CLIN) 23027 CONTINUE IF (.NOT.(EXEC .EQ. 1))GOTO 23029 IF (.NOT.(SSPAWN(SH, CLIN, DESC, 98) .EQ. -3))GOTO 23031 CALL REMARK (ST005Z) GOTO 23032 23031 CONTINUE CALL REMARK (DESC) 23032 CONTINUE 23029 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 23033 CALL PUTLIN(ERRMSG, 3) CALL PUTLIN(COMAND, 3) CALL REMARK(ST006Z) DOCOM=(-3) RETURN 23033 CONTINUE J = LENGTH(CLIN) + 1 IF (.NOT.(J .GT. 1))GOTO 23035 CALL CHCOPY(32, CLIN, J) 23035 CONTINUE IF (.NOT.( TYPE .EQ. 12 ))GOTO 23037 IF (.NOT.(SCRF(NODE, COMAND, CLIN) .EQ. -3))GOTO 23039 DOCOM=(-3) RETURN 23039 CONTINUE GOTO 23038 23037 CONTINUE IF (.NOT.( TYPE .EQ. -3 ))GOTO 23041 CALL STRCPY( LOCAL, COMAND) 23041 CONTINUE I = 1 23043 IF (.NOT.(PICKUP( CLIN, J, NODE, 10, I) .NE. -3 ))GOTO 23045 CALL CHCOPY( 32, CLIN, J) 23044 I = I + 1 GOTO 23043 23045 CONTINUE IF (.NOT.( INF(NODE, CLIN, J) .NE. -3 ))GOTO 23046 CALL CHCOPY( 32, CLIN, J) 23046 CONTINUE IF (.NOT.( OUTF(NODE, CLIN, J) .NE. -3 ))GOTO 23048 CALL CHCOPY( 32, CLIN, J) 23048 CONTINUE IF (.NOT.( ERRF(NODE, CLIN, J) .NE. -3 ))GOTO 23050 CALL CHCOPY( 32, CLIN, J) 23050 CONTINUE 23038 CONTINUE CALL STRIPB( CLIN) IF (.NOT.( PRCOM .EQ. 1 .AND. EQUAL(COMAND, XOFF) .EQ. 0 ))GOTO 23 *052 CALL DSPCOM(COMAND, CLIN) 23052 CONTINUE IF (.NOT.( EXEC .EQ. 1 ))GOTO 23054 IF (.NOT.( TYPE .EQ. 17 ))GOTO 23056 STATUS = SHELLC( COMAND, CLIN) GOTO 23057 23056 CONTINUE STATUS = SSPAWN( COMAND, CLIN, DESC, 119) IF (.NOT.( STATUS .EQ. -3 ))GOTO 23058 CALL REMARK( ST007Z) GOTO 23059 23058 CONTINUE IF (.NOT.( STATUS .NE. 0 ))GOTO 23060 IF (.NOT.( STATUS .NE. -10 ))GOTO 23062 STATUS = -3 23062 CONTINUE 23060 CONTINUE 23059 CONTINUE 23057 CONTINUE GOTO 23055 23054 CONTINUE STATUS = 0 23055 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, 100), TREE(160), 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 23064 IF (.NOT.(P.LT.P2))GOTO 23066 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23067 L = L + 1 GOTO 23068 23067 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23069 L = L - 1 IF (.NOT.(L .EQ. 0))GOTO 23071 GOTO 23066 23071 CONTINUE 23069 CONTINUE 23068 CONTINUE 23065 P=P+1 GOTO 23064 23066 CONTINUE IF (.NOT.(MKTREE( TKBUF( 3, P1), 112, 7, NODE) .EQ. -3))GOTO 23073 DOPAR = -3 RETURN 23073 CONTINUE PT = P1 + 1 TKBUF( 2, PT) = 1 TKBUF( 3, PT) = NODE TKBUF( 4, PT) = P CALL PUTBAC (PT) P=P+1 23075 IF (.NOT.(P.LT.P2))GOTO 23077 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60))GOTO 23078 IF (.NOT.(SETREE(NODE, 5, TKBUF( 1, P)) .EQ. -3))GOTO 23080 DOPAR = -3 RETURN 23080 CONTINUE GOTO 23079 23078 CONTINUE IF (.NOT.(TOK .EQ. 62))GOTO 23082 IF (.NOT.(SETREE(NODE, 6, TKBUF( 1, P)) .EQ. -3))GOTO 23084 DOPAR = -3 RETURN 23084 CONTINUE GOTO 23083 23082 CONTINUE IF (.NOT.(TOK .EQ. 63))GOTO 23086 IF (.NOT.(SETREE(NODE, 7, TKBUF( 1, P)) .EQ. -3))GOTO 23088 DOPAR = -3 RETURN 23088 CONTINUE GOTO 23087 23086 CONTINUE CALL STXERR(ST008Z) DOPAR = -3 RETURN 23087 CONTINUE 23083 CONTINUE 23079 CONTINUE 23076 P=P+1 GOTO 23075 23077 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, 100), TREE(160), 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 23090 IF (.NOT.(TREE(NODE+5) .NE. 0))GOTO 23092 IF (.NOT.(IN .EQ. 0 .OR. (IN .NE. 0 .AND. CIN(IN) .GT. 0) ))GOTO 2 *3094 IN = IN + 1 CIN(IN) = TREE(NODE+5) TREE(NODE+5) = -TREE(NODE+5) 23094 CONTINUE 23092 CONTINUE IF (.NOT.(TREE(NODE+6) .NE. 0))GOTO 23096 IF (.NOT.(OUT .EQ. 0 .OR. (OUT .NE. 0 .AND. COUT(OUT) .GT. 0)))GOT *O 23098 OUT = OUT + 1 COUT(OUT) = TREE(NODE+6) TREE(NODE+6) = -TREE(NODE+6) 23098 CONTINUE 23096 CONTINUE IF (.NOT.(TREE(NODE+7) .NE. 0))GOTO 23100 ER = ER + 1 CERR(ER ) = TREE(NODE+7) TREE(NODE+7) = -TREE(NODE+7) 23100 CONTINUE GOTO 23091 23090 CONTINUE IF (.NOT.(TREE(NODE+5) .LT. 0))GOTO 23102 IN = IN - 1 TREE(NODE+5) = IABS(TREE(NODE+5)) 23102 CONTINUE IF (.NOT.(TREE(NODE+6) .LT. 0))GOTO 23104 OUT = OUT - 1 TREE(NODE+6) = IABS(TREE(NODE+6)) 23104 CONTINUE IF (.NOT.(TREE(NODE+7) .LT. 0))GOTO 23106 ER = ER - 1 TREE(NODE+7) = IABS(TREE(NODE+7)) 23106 CONTINUE 23091 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 23108 PCTR = PCTR + 1 PFILE(PCTR) = 0 OUT = OUT + 1 COUT(OUT) = -PCTR AOUT(OUT) = 0 GOTO 23109 23108 CONTINUE IF (.NOT.(DIR .EQ. 4))GOTO 23110 IN = IN + 1 CIN(IN) = COUT(OUT) OUT = OUT - 1 GOTO 23111 23110 CONTINUE PCTR = PCTR - 1 IN = IN - 1 23111 CONTINUE 23109 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 23112 IF (.NOT.(OUT .GT. 0))GOTO 23114 AOUT(OUT) = AOUT(OUT) + 1 23114 CONTINUE IF (.NOT.(ER .GT. 0))GOTO 23116 AERR(ER) = AERR(ER) + 1 23116 CONTINUE GOTO 23113 23112 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23118 IF (.NOT.(OUT .GT. 0))GOTO 23120 AOUT(OUT) = AOUT(OUT) - 1 23120 CONTINUE IF (.NOT.(ER .GT. 0))GOTO 23122 AERR(ER) = AERR(ER) - 1 23122 CONTINUE 23118 CONTINUE 23113 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, 100), TREE(160), 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 2312 *4 CALL STXERR(ST009Z) DOVERB=(-3) RETURN 23124 CONTINUE NARGS = P2 - P1 -1 IF (.NOT.(MKTREE(TKBUF( 3, P1), 99, 9+NARGS, NODE) .EQ. -3))GOTO 2 *3126 DOVERB=(-3) RETURN 23126 CONTINUE I = 0 P=P1 23128 IF (.NOT.(P.LT.P2))GOTO 23130 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 60))GOTO 23131 IF (.NOT.(SETREE(NODE, 5, TKBUF( 1, P)) .EQ. -3))GOTO 23133 DOVERB=(-3) RETURN 23133 CONTINUE NARGS = NARGS - 1 GOTO 23132 23131 CONTINUE IF (.NOT.(TOK .EQ. 62))GOTO 23135 IF (.NOT.(SETREE(NODE, 6, TKBUF( 1, P)) .EQ. -3))GOTO 23137 DOVERB=(-3) RETURN 23137 CONTINUE NARGS = NARGS - 1 GOTO 23136 23135 CONTINUE IF (.NOT.(TOK .EQ. 63))GOTO 23139 IF (.NOT.(SETREE(NODE, 7, TKBUF( 1, P)) .EQ. -3))GOTO 23141 DOVERB=(-3) RETURN 23141 CONTINUE NARGS = NARGS - 1 GOTO 23140 23139 CONTINUE IF (.NOT.(SETREE(NODE, 9+I, TKBUF( 1, P)) .EQ. -3))GOTO 23143 DOVERB=(-3) RETURN 23143 CONTINUE I = I + 1 23140 CONTINUE 23136 CONTINUE 23132 CONTINUE 23129 P=P+1 GOTO 23128 23130 CONTINUE IF (.NOT.(SETREE(NODE, 8, NARGS) .EQ. -3))GOTO 23145 DOVERB=(-3) RETURN 23145 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 * 23147 23149 IF (.NOT.(ARG(I) .NE. 32 .AND. ARG(I) .NE. 0))GOTO 23150 I = I + 1 GOTO 23149 23150 CONTINUE GOTO 23148 23147 CONTINUE CALL PUTCH(32, 3) 23148 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 23151 IF (.NOT.(SPATH(I) .NE. 10 ))GOTO 23153 IF (.NOT.( SPATH(I) .EQ. 0))GOTO 23154 IF (.NOT.(SPATH(I+1) .EQ. 10))GOTO 23156 GOTO 23153 23156 CONTINUE CALL PUTLIN(SEPSTR, 2) 23157 CONTINUE GOTO 23155 23154 CONTINUE CALL MKPATH(SPATH(I), FILE) CALL PUTLIN(FILE, 2) 23158 IF (.NOT.(SPATH(I) .NE. 0))GOTO 23159 I = I + 1 GOTO 23158 23159 CONTINUE I = I - 1 23155 CONTINUE 23152 I = I + 1 GOTO 23151 23153 CONTINUE CALL PUTCH(10, 2) RETURN END SUBROUTINE ENDSH(COMAND) LOGICAL*1 COMAND INTEGER JUNK LOGICAL*1 NULL(1) DATA NULL(1)/0/ IF (.NOT.(COMAND .NE. -1))GOTO 23160 CALL LOGEND(NULL, JUNK) 23160 CONTINUE 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, 100), TREE(160), 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 23162 ERRF=(0) RETURN 23162 CONTINUE IF (.NOT.(ER .GT. 0))GOTO 23164 IF (.NOT.(CERR(ER) .GT. 0))GOTO 23166 J = CERR(ER) + 1 IF (.NOT.(AERR(ER) .NE. 0 .AND. IBUF(J) .NE. 63))GOTO 23168 CALL CHCOPY(63, BUF, I) 23168 CONTINUE CALL STCOPY(IBUF, CERR(ER), BUF, I) 23166 CONTINUE ERRF=(0) RETURN 23164 CONTINUE 23163 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 23170 IF (.NOT.(I.LE.15))GOTO 23172 PFILE(I) = 0 CIN(I) = 0 COUT(I) = 0 CERR(I) = 0 AOUT(I) = 0 AERR(I) = 0 23171 I=I+1 GOTO 23170 23172 CONTINUE NODE = -1 23173 IF (.NOT.(MVNEXT(NODE, TYPE, DIR) .NE. -1))GOTO 23174 IF (.NOT.(TYPE .EQ. 59))GOTO 23175 STATUS = DOSEMI (NODE, DIR) GOTO 23176 23175 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23177 STATUS = DOAMPR (NODE, DIR) GOTO 23178 23177 CONTINUE IF (.NOT.(TYPE .EQ. 124))GOTO 23179 STATUS = DOPIPE (NODE, DIR) GOTO 23180 23179 CONTINUE IF (.NOT.(TYPE .EQ. 112))GOTO 23181 STATUS = DOPARN (NODE, DIR) GOTO 23182 23181 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23183 STATUS = DOCOM (NODE, DIR) GOTO 23184 23183 CONTINUE CALL REMARK(ST00AZ) STATUS = -3 23184 CONTINUE 23182 CONTINUE 23180 CONTINUE 23178 CONTINUE 23176 CONTINUE IF (.NOT.( STATUS .EQ. -3 .OR. STATUS .EQ. -10 ))GOTO 23185 GOTO 23174 23185 CONTINUE GOTO 23173 23174 CONTINUE IF (.NOT.( HFILE(1) .NE. 0 ))GOTO 23187 JUNK = REMOVE(HFILE) 23187 CONTINUE I=1 23189 IF (.NOT.(I.LE.15))GOTO 23191 IF (.NOT.(PFILE(I) .EQ. 1))GOTO 23192 J = 1 CALL GPNAME( I, HFILE, J) JUNK = REMOVE( HFILE) 23192 CONTINUE 23190 I=I+1 GOTO 23189 23191 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 23194 CONTINUE JUNK = MVNEXT(NODE, TYPE, DIR) IF (.NOT.(NODE .EQ. SNODE))GOTO 23197 GOTO 23196 23197 CONTINUE IF (.NOT.(TYPE .EQ. 59 .AND. DIR .EQ. 4))GOTO 23199 CALL CHCOPY( 59, BUF, K) GOTO 23200 23199 CONTINUE IF (.NOT.(TYPE .EQ. 38))GOTO 23201 IF (.NOT.(DIR .EQ. 4 .OR. (DIR .EQ. 1 .AND. LASTD .EQ. 3)))GOTO 23 *203 CALL CHCOPY( 38, BUF, K) 23203 CONTINUE LASTD = DIR GOTO 23202 23201 CONTINUE IF (.NOT.(TYPE .EQ. 124 .AND. DIR .EQ. 4))GOTO 23205 CALL CHCOPY( 124, BUF, K) GOTO 23206 23205 CONTINUE IF (.NOT.(TYPE .EQ. 112))GOTO 23207 CALL GPAR(NODE, DIR, BUF, K) GOTO 23208 23207 CONTINUE IF (.NOT.(TYPE .EQ. 99))GOTO 23209 GETCL = GTASK(NODE, BUF, K) 23209 CONTINUE 23208 CONTINUE 23206 CONTINUE 23202 CONTINUE 23200 CONTINUE 23195 GOTO 23194 23196 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 23211 CALL CHCOPY( 40, BUF, I) GOTO 23212 23211 CONTINUE IF (.NOT.(DIR .EQ. 1))GOTO 23213 N = I CALL STCOPY( RPST, 1, BUF, I) IF (.NOT.( PICKUP( BUF, I, NODE, 5, JUNK) .NE. -3))GOTO 23215 CALL CHCOPY( 32, BUF, I) GOTO 23216 23215 CONTINUE I = N + 2 23216 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 6, JUNK) .NE. -3))GOTO 23217 CALL CHCOPY( 32, BUF, I) 23217 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 7, JUNK) .NE. -3))GOTO 23219 CALL CHCOPY( 32, BUF, I) 23219 CONTINUE 23213 CONTINUE 23212 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 23221 CALL REMARK (ST00BZ) J = N BUF(J) = 0 GTASK=(-3) RETURN 23221 CONTINUE GTASK = 0 J = LENGTH(BUF) + 1 CALL CHCOPY( 32, BUF, J) I=1 23223 IF (.NOT.(PICKUP( BUF, J, NODE, 10, I) .NE. -3))GOTO 23225 CALL CHCOPY( 32, BUF, J) 23224 I=I+1 GOTO 23223 23225 CONTINUE CALL CHCOPY( 64, BUF, J) IF (.NOT.( PICKUP( BUF, J, NODE, 5, JUNK) .NE. -3))GOTO 23226 CALL CHCOPY( 32, BUF, J) GOTO 23227 23226 CONTINUE J = J - 1 23227 CONTINUE IF (.NOT.( PICKUP( BUF, J, NODE, 6, JUNK) .NE. -3))GOTO 23228 CALL CHCOPY( 32, BUF, J) 23228 CONTINUE IF (.NOT.( PICKUP( BUF, J, NODE, 7, JUNK) .NE. -3))GOTO 23230 CALL CHCOPY( 32, BUF, J) 23230 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 23232 CALL REMARK(ST00CZ) HFILE(1) = 0 I = N BUF(I) = 0 RETURN 23232 CONTINUE CALL STCOPY( HFILE, 1, BUF, I) 23234 IF (.NOT.( GETLIN( LIN, SHIN) .NE. -1))GOTO 23235 IF (.NOT.(LIN(1) .EQ. CHAR))GOTO 23236 GOTO 23235 23236 CONTINUE CALL PUTLIN(LIN, INT) GOTO 23234 23235 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, 100), TREE(160), STACK(15), TREEND, PP, IB *UF(402) N = I IF (.NOT.(IN .GT. 0 .AND. CIN(IN) .LT. 0))GOTO 23238 CALL CHCOPY( 60, BUF, I) CALL GPNAME( IABS(CIN(IN)), BUF, I) GOTO 23239 23238 CONTINUE IF (.NOT.( PICKUP( BUF, I, NODE, 5, JUNK) .EQ. -3 .AND. IN .GT. 0 *))GOTO 23240 CALL STCOPY( IBUF, CIN(IN), BUF, I) GOTO 23241 23240 CONTINUE IF (.NOT.(SCRIPT .EQ. 1 .AND. INPUT(1) .NE. 0))GOTO 23242 CALL CHCOPY( 60, BUF, I) CALL STCOPY( INPUT, 1, BUF, I) 23242 CONTINUE 23241 CONTINUE 23239 CONTINUE IF (.NOT.(BUF(N) .EQ. 60 .AND. BUF(N+1) .EQ. 60))GOTO 23244 CHAR = BUF(N+2) I = N CALL HERDOC( CHAR, BUF, I) 23244 CONTINUE IF (.NOT.(BUF(N) .NE. 0))GOTO 23246 INF=(0) RETURN 23246 CONTINUE INF=(-3) RETURN 23247 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) 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 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) PRLIN = 0 EXEC = 1 PRCOM = 0 CARG = 0 DROP = 1 SCRIPT = 0 CALL HOMDIR( HOMEDR, 6) CALL GWDIR( OLDDIR, 6) CALL ENBINT I = 1 23248 IF (.NOT.(GETARG(I, CLIN, 402) .NE. -1 ))GOTO 23250 IF (.NOT.( I .EQ. 1 .AND. CLIN(1) .EQ. 45 ))GOTO 23251 CALL FOLD(CLIN) IF (.NOT.( INDEXC( CLIN, 118) .GT. 0 ))GOTO 23253 PRLIN = 1 23253 CONTINUE IF (.NOT.( INDEXC( CLIN, 110) .GT. 0 ))GOTO 23255 EXEC = 0 23255 CONTINUE IF (.NOT.( INDEXC( CLIN, 120) .GT. 0 ))GOTO 23257 PRCOM = 1 23257 CONTINUE IF (.NOT.( INDEXC( CLIN, 99) .GT. 0 ))GOTO 23259 CARG = 1 23259 CONTINUE IF (.NOT.( INDEXC( CLIN, 100) .GT. 0 ))GOTO 23261 DROP = 0 23261 CONTINUE CALL DELARG(I) I = I - 1 GOTO 23252 23251 CONTINUE IF (.NOT.( CARG .EQ. 1 ))GOTO 23263 CALL ARGLIN(CLIN, I) CARGDN = 0 GOTO 23250 23263 CONTINUE IF (.NOT.( I .EQ. 1 ))GOTO 23265 IF (.NOT.( LOCCOM( CLIN, SPATH, SUFFIX, INPUT) .NE. 12 ))GOTO 2326 *7 CALL CANT(CLIN) 23267 CONTINUE UNIT(DEPTH) = OPEN(INPUT, 1) IF (.NOT.( UNIT(DEPTH) .EQ. -3 ))GOTO 23269 CALL CANT(INPUT) 23269 CONTINUE SCRIPT = 1 INPUT(1) = 0 GOTO 23266 23265 CONTINUE IF (.NOT.( CLIN(1) .EQ. 64 ))GOTO 23271 IF (.NOT.( CLIN(2) .EQ. 60 ))GOTO 23273 CALL SCOPY(CLIN, 3, INPUT, 1) GOTO 23274 23273 CONTINUE GOTO 23249 23274 CONTINUE CALL DELARG (I) I = I - 1 23271 CONTINUE 23266 CONTINUE 23264 CONTINUE 23252 CONTINUE 23249 I = I + 1 GOTO 23248 23250 CONTINUE CALL RLOGIN 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, 100), TREE(160), 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 23275 IF (.NOT.(SHTOK(IBUF(I)) .NE. 0))GOTO 23277 IF (.NOT.(IBUF(I) .NE. 0))GOTO 23278 TKBUF(1,K) = I TKBUF(2,K) = 0 TKBUF(3,K) = 0 TKBUF(4,K) = 0 IF (.NOT.(IBUF(I) .EQ. 40))GOTO 23280 PAREN = PAREN + 1 GOTO 23281 23280 CONTINUE IF (.NOT.(IBUF(I) .EQ. 41))GOTO 23282 PAREN = PAREN - 1 23282 CONTINUE 23281 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 23284 CALL REMARK(ST00DZ) MKTOKS=(-3) RETURN 23284 CONTINUE I = L + 2 23278 CONTINUE 23276 K=K+1 GOTO 23275 23277 CONTINUE K = K - 1 IBUF(I) = 0 IF (.NOT.(PAREN .NE. 0))GOTO 23286 MKTOKS=(-3) RETURN 23286 CONTINUE MKTOKS=(0) RETURN 23287 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, 100), TREE(160), 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.160))GOTO 23288 CALL STXERR(ST00EZ) CNODE = -3 MKTREE=(-3) RETURN 23288 CONTINUE I=1 23290 IF (.NOT.(I.LE.SIZE))GOTO 23292 TREE(CNODE+I) = 0 23291 I=I+1 GOTO 23290 23292 CONTINUE TREE(CNODE+1) = PNODE TREE(CNODE+2) = TYPE IF (.NOT.(PNODE .GE. 0))GOTO 23293 IF (.NOT.(TREE(PNODE+3) .EQ. 0))GOTO 23295 TREE(PNODE+3) = CNODE GOTO 23296 23295 CONTINUE IF (.NOT.(TREE(PNODE+4) .EQ. 0))GOTO 23297 TREE(PNODE+4) = CNODE GOTO 23298 23297 CONTINUE CALL STXERR(ST00FZ) MKTREE=(-3) RETURN 23298 CONTINUE 23296 CONTINUE 23293 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, 100), TREE(160), STACK(15), TREEND, PP, IB *UF(402) IF (.NOT.(NODE .EQ. -1))GOTO 23299 MVNEXT = 0 DIR = 3 GOTO 23300 23299 CONTINUE MVNEXT = TREE(NODE+DIR) 23300 CONTINUE IF (.NOT.(MVNEXT .NE. -1))GOTO 23301 TYPE = TREE(MVNEXT+2) DIR = NXTBR(MVNEXT, NODE) 23301 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, 100), TREE(160), STACK(15), TREEND, PP, IB *UF(402) IF (.NOT.(PP .EQ. 0))GOTO 23303 P = 0 GOTO 23304 23303 CONTINUE P = STACK(PP) PP = PP - 1 23304 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, 100), TREE(160), STACK(15), TREEND, PP, IB *UF(402) IF (.NOT.(LNODE .EQ. TREE(NODE+1)))GOTO 23305 IF (.NOT.(TREE(NODE+3) .NE. 0))GOTO 23307 NXTBR=(3) RETURN 23307 CONTINUE NXTBR=(1) RETURN 23308 CONTINUE GOTO 23306 23305 CONTINUE IF (.NOT.(LNODE .EQ. TREE(NODE+3) .AND. TREE(NODE+4) .NE. 0))GOTO *23309 NXTBR=(4) RETURN 23309 CONTINUE NXTBR=(1) RETURN 23310 CONTINUE 23306 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, 100), TREE(160), 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 23311 OUTF=(0) RETURN 23311 CONTINUE IF (.NOT.(OUT .GT. 0))GOTO 23313 IF (.NOT.(AOUT(OUT) .NE. 0))GOTO 23315 CALL CHCOPY( 62, BUF, I) 23315 CONTINUE IF (.NOT.(COUT(OUT) .GT. 0))GOTO 23317 J = COUT(OUT) + 1 IF (.NOT.(AOUT(OUT) .EQ. 0 .OR. IBUF(J) .NE. 62))GOTO 23319 J = J - 1 23319 CONTINUE CALL STCOPY( IBUF, J, BUF, I) GOTO 23318 23317 CONTINUE CALL CHCOPY( 62, BUF, I) CALL GPNAME( IABS(COUT(OUT)), BUF, I) 23318 CONTINUE OUTF=(0) RETURN 23313 CONTINUE 23312 CONTINUE OUTF=(-3) RETURN END INTEGER FUNCTION PARAM(C) LOGICAL*1 C, NUM(2), NGETCH INTEGER GETARG, CTOI, I, JUNK 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 COMMON /SHFLAG/ EXEC, PRLIN, PRCOM, CARG, DROP, CARGDN, SHIN, DEPT *H, UNIT(3), TABLE, CLIN(402) COMMON / CSCLIN / LIN(402) IF (.NOT.(C .EQ. 36))GOTO 23321 NUM(1) = NGETCH( NUM(1), SHIN) NUM(2) = 0 I = 1 N = CTOI( NUM, I) IF (.NOT.(N .GT. 0))GOTO 23323 IF (.NOT.( GETARG( N+1, LIN, 402) .NE. -1))GOTO 23325 CALL PBSTR(LIN) 23325 CONTINUE C = NGETCH( C, SHIN) PARAM=(1) RETURN 23323 CONTINUE C = NUM(1) 23321 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, 100), TREE(160), 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 23327 IF (.NOT.(I.LE.4))GOTO 23329 J=1 23330 IF (.NOT.(J.LE.100))GOTO 23332 TKBUF(I,J) = 0 23331 J=J+1 GOTO 23330 23332 CONTINUE 23328 I=I+1 GOTO 23327 23329 CONTINUE I=1 23333 IF (.NOT.(I.LE.160))GOTO 23335 TREE(I) = 0 23334 I=I+1 GOTO 23333 23335 CONTINUE I=1 23336 IF (.NOT.(I.LE.402))GOTO 23338 IBUF(I) = 0 23337 I=I+1 GOTO 23336 23338 CONTINUE IF (.NOT.(MKTOKS(LINE,P2) .EQ. -3))GOTO 23339 PARSER=(-3) RETURN 23339 CONTINUE TKBUF( 2, 1) = 0 TKBUF( 3, 1) = -1 TKBUF( 4, 1) = P2 CALL PUTBAC (1) 23341 IF (.NOT.(NEXTP(P1) .NE. 0))GOTO 23342 MARK = TKBUF( 2, P1) P2 = TKBUF( 4, P1) IF (.NOT.(MARK .EQ. 0))GOTO 23343 PARSER = SYNTAX(P1, P2) GOTO 23344 23343 CONTINUE IF (.NOT.(MARK .EQ. 1))GOTO 23345 PARSER = SYN1(P1, P2) GOTO 23346 23345 CONTINUE IF (.NOT.(MARK .EQ. 2))GOTO 23347 PARSER = SYN2(P1,P2) GOTO 23348 23347 CONTINUE IF (.NOT.(MARK .EQ. 3))GOTO 23349 PARSER = SYN3(P1,P2) 23349 CONTINUE 23348 CONTINUE 23346 CONTINUE 23344 CONTINUE IF (.NOT.(PARSER .EQ. -3))GOTO 23351 RETURN 23351 CONTINUE GOTO 23341 23342 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) 23353 CONTINUE C = NGETCH(C, SHIN) 23354 IF (.NOT.(C .NE. 32 .AND. C .NE. 9))GOTO 23353 23355 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, 100), TREE(160), 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 23356 CALL STCOPY( IBUF, TREE(NODE+FIELD), ARRAY, I) GOTO 23357 23356 CONTINUE IF (.NOT.(FIELD .EQ. 9 .AND. TREE(NODE+2) .EQ. 99))GOTO 23358 CALL STCOPY( IBUF, TREE(NODE+9), ARRAY, I) GOTO 23359 23358 CONTINUE IF (.NOT.(FIELD .EQ. 10 .AND. TREE(NODE+2) .EQ. 99 .AND. ARG .LE. *TREE(NODE+8) ))GOTO 23360 CALL STCOPY( IBUF, TREE(NODE+9+ARG), ARRAY, I) GOTO 23361 23360 CONTINUE PICKUP = -3 23361 CONTINUE 23359 CONTINUE 23357 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, 100), TREE(160), 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 23362 CALL STXERR(ST00GZ) GOTO 23363 23362 CONTINUE STACK(PP) = P 23363 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 23364 FILE(2) = 92 23364 CONTINUE CALL PUTLIN(FILE, FD) IF (.NOT.(C .NE. 0))GOTO 23366 CALL PUTCH(C, FD) 23366 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) 23368 IF (.NOT.(C .NE. 0))GOTO 23370 IF (.NOT.(CHAR .EQ. 34))GOTO 23371 JUNK = PARAM(C) 23371 CONTINUE IF (.NOT.(C .EQ. 0))GOTO 23373 GOTO 23370 23373 CONTINUE TOK(J) = C J = J + 1 IF (.NOT.(C .EQ. CHAR))GOTO 23375 GOTO 23370 23375 CONTINUE 23369 C=NGETCH(C, SHIN) GOTO 23368 23370 CONTINUE TOK(J) = 0 RETURN END SUBROUTINE RLOGIN INTEGER OPEN 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 LGIN(9) 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 LGIN(1)/108/,LGIN(2)/111/,LGIN(3)/103/,LGIN(4)/105/,LGIN(5)/1 *10/,LGIN(6)/46/,LGIN(7)/115/,LGIN(8)/104/,LGIN(9)/0/ CALL TOOLDR(SH, 6) CALL CONCAT(SH, LGIN, HFILE) UNIT(2) = OPEN(HFILE, 1) IF (.NOT.(UNIT(2) .NE. -3))GOTO 23377 DEPTH = 2 23377 CONTINUE 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 23379 CALL STCOPY( PRFLAG, 1, ARGS, J) 23379 CONTINUE IF (.NOT.(PRCOM .EQ. 1))GOTO 23381 CALL STCOPY( CMFLAG, 1, ARGS, J) 23381 CONTINUE IF (.NOT.(DROP .EQ. 0))GOTO 23383 CALL STCOPY( DRFLAG, 1, ARGS, J) 23383 CONTINUE CALL STCOPY( COMAND, 1, ARGS, J) IF (.NOT.( LOCCOM( SHSTR, SPATH, SUFFIX, COMAND) .NE. 60 ))GOTO 23 *385 CALL REMARK( ST00HZ) SCRF=(-3) RETURN 23385 CONTINUE CALL CHCOPY( 32, ARGS, J) I=1 23387 IF (.NOT.(PICKUP(ARGS, J, NODE, 10, I) .NE. -3))GOTO 23389 CALL CHCOPY( 32, ARGS, J) 23388 I=I+1 GOTO 23387 23389 CONTINUE CALL CHCOPY( 64, ARGS, J) IF (.NOT.( INF(NODE, ARGS, J) .NE. -3))GOTO 23390 CALL CHCOPY( 32, ARGS, J) GOTO 23391 23390 CONTINUE J = J - 1 23391 CONTINUE IF (.NOT.( OUTF(NODE, ARGS, J) .NE. -3))GOTO 23392 CALL CHCOPY( 32, ARGS, J) 23392 CONTINUE IF (.NOT.( ERRF(NODE, ARGS, J) .NE. -3))GOTO 23394 CALL CHCOPY( 32, ARGS, J) 23394 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, 100), TREE(160), 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 23396 CALL STXERR(ST00IZ) SETREE=(-3) RETURN 23396 CONTINUE TREE(I) = VALUE SETREE=(0) RETURN END INTEGER FUNCTION SHCOM(COMAND) LOGICAL*1 COMAND(100) INTEGER I, J LOGICAL*1 INTCMD(44) 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)/0/ I = 1 23398 IF (.NOT.(INTCMD(I) .NE. 0))GOTO 23400 J = 1 23401 IF (.NOT.(COMAND(J) .NE. 0))GOTO 23403 IF (.NOT.(COMAND(J) .NE. INTCMD(I)))GOTO 23404 GOTO 23403 23404 CONTINUE 23402 I = I + 1 J = J + 1 GOTO 23401 23403 CONTINUE IF (.NOT.(COMAND(J) .EQ. 0 .AND. INTCMD(I) .LT. 32))GOTO 23406 SHCOM=(INTCMD(I)) RETURN 23406 CONTINUE 23408 IF (.NOT.(INTCMD(I) .GT. 32))GOTO 23409 I = I + 1 GOTO 23408 23409 CONTINUE 23399 I = I + 1 GOTO 23398 23400 CONTINUE SHCOM=(0) RETURN END INTEGER FUNCTION SHELLC (COMAND, ARGS) LOGICAL*1 ARGS(100), COMAND(100) INTEGER SHCOM, CHGDIR 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 I23410 LOGICAL*1 ST00JZ(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)/73/,ST00JZ(4)/110/,ST00 *JZ(5)/118/,ST00JZ(6)/97/,ST00JZ(7)/108/,ST00JZ(8)/105/,ST00JZ(9)/1 *00/,ST00JZ(10)/32/,ST00JZ(11)/115/,ST00JZ(12)/104/,ST00JZ(13)/101/ *,ST00JZ(14)/108/,ST00JZ(15)/108/,ST00JZ(16)/32/,ST00JZ(17)/99/,ST0 *0JZ(18)/111/,ST00JZ(19)/109/,ST00JZ(20)/109/,ST00JZ(21)/97/,ST00JZ *(22)/110/,ST00JZ(23)/100/,ST00JZ(24)/0/ STATUS = 0 I23410=(SHCOM(COMAND)) GOTO 23410 23412 CONTINUE STATUS = CHGDIR(ARGS) GOTO 23411 23413 CONTINUE STATUS = CHGDIR(HOMEDR) GOTO 23411 23414 CONTINUE PRLIN = 1 GOTO 23411 23415 CONTINUE PRLIN = 0 GOTO 23411 23416 CONTINUE PRCOM = 1 GOTO 23411 23417 CONTINUE PRCOM = 0 GOTO 23411 23418 CONTINUE CALL DSPPTH(SH) GOTO 23411 23419 CONTINUE CALL ENDSH(113) GOTO 23411 23420 CONTINUE GOTO 23411 23421 CONTINUE STATUS = -3 CALL REMARK (ST00JZ) GOTO 23411 23410 CONTINUE IF (I23410.LT.1.OR.I23410.GT.10)GOTO 23421 GOTO (23412,23413,23413,23419,23418,23414,23415,23416,23417,23420) *,I23410 23411 CONTINUE SHELLC=(STATUS) RETURN END INTEGER FUNCTION SHLINE (LINE) LOGICAL*1 LINE(100) INTEGER EQUAL, LENGTH, LOGPMT INTEGER 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 23422 IF (.NOT.( CARGDN .EQ. 1 ))GOTO 23424 LINE(1) = 0 K = -1 GOTO 23425 23424 CONTINUE CALL STRCPY( CLIN, LINE) CARGDN = 1 K = LENGTH(LINE) 23425 CONTINUE GOTO 23423 23422 CONTINUE 23426 CONTINUE IF (.NOT.(DEPTH .GT. 1))GOTO 23429 K = PROMPT(PCHAR, LINE, SHIN) GOTO 23430 23429 CONTINUE K = LOGPMT(PCHAR, LINE, SHIN) 23430 CONTINUE IF (.NOT.(K .NE. -1))GOTO 23431 GOTO 23428 23431 CONTINUE IF (.NOT.(DEPTH .GT. 1))GOTO 23433 CALL CLOSE(SHIN) DEPTH = DEPTH - 1 SHIN = UNIT(DEPTH) K = 0 23433 CONTINUE 23427 IF (.NOT.(K .EQ. -1))GOTO 23426 23428 CONTINUE 23423 CONTINUE IF (.NOT.( K .NE. -1 ))GOTO 23435 I=1 23437 IF (.NOT.(I .LE. 4))GOTO 23439 TMPARA(I) = LINE(I) 23438 I = I + 1 GOTO 23437 23439 CONTINUE TMPARA(I) = 0 CALL FOLD(TMPARA) IF (.NOT.( PRLIN .EQ. 1 .AND. EQUAL(TMPARA, VOFF) .EQ. 0 ))GOTO 23 *440 CALL PUTLIN(LINE, 3) 23440 CONTINUE 23435 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 23442 CONTINUE CALL PASTBL(C) J = 1 IF (.NOT.(SPEC(C) .EQ. 1))GOTO 23445 TOK(1) = C TOK(2) = 0 SHTOK = C RETURN 23445 CONTINUE IF (.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23447 CALL QS(C, TOK) SHTOK = TOK(1) RETURN 23447 CONTINUE IF (.NOT.(C .EQ. 60 .OR. C .EQ. 62 .OR. C .EQ. 63))GOTO 23449 I=1 23451 IF (.NOT.(I.LE.2))GOTO 23453 TOK(J) = C J = J + 1 CALL PASTBL(C) IF (.NOT.(C .NE. TOK(J-1)))GOTO 23454 GOTO 23453 23454 CONTINUE 23452 I=I+1 GOTO 23451 23453 CONTINUE 23449 CONTINUE 23456 IF (.NOT.(C .NE. 0))GOTO 23458 PSTAT = PARAM(C) IF (.NOT.(C .EQ. 0))GOTO 23459 GOTO 23458 23459 CONTINUE IF (.NOT.(ATBEG(C) .EQ. 1))GOTO 23461 CALL PUTBAK(C) GOTO 23458 23461 CONTINUE IF (.NOT.(C .EQ. 64))GOTO 23463 C = NGETCH(C, SHIN) IF (.NOT.(SPEC(C) .EQ. 0 .AND. (C .NE. 64 .AND. C .NE. 36)))GOTO 2 *3465 CALL PUTBAK(C) C = 64 23465 CONTINUE 23463 CONTINUE TOK(J) = C J = J + 1 23457 C=NGETCH(C, SHIN) GOTO 23456 23458 CONTINUE TOK(J) = 0 SHTOK = TOK(1) IF (.NOT.(PSTAT .EQ. 0 .OR. J .LT. 1))GOTO 23467 RETURN 23467 CONTINUE PSTAT = 0 23443 GOTO 23442 23444 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 23469 SPEC = 1 IF (.NOT.(C .EQ. 94))GOTO 23471 C = 124 23471 CONTINUE GOTO 23470 23469 CONTINUE SPEC = 0 23470 CONTINUE RETURN END SUBROUTINE STRIPB(BUF) INTEGER I INTEGER LENGTH LOGICAL*1 BUF(100) I=LENGTH(BUF) 23473 IF (.NOT.(I .GT. 0 ))GOTO 23475 IF (.NOT.( BUF(I) .NE. 32 ))GOTO 23476 GOTO 23475 23476 CONTINUE 23474 I=I-1 GOTO 23473 23475 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, 100), TREE(160), 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 ST00KZ(36) LOGICAL*1 ST00LZ(35) COMMON /CPARS/ TKBUF(4, 100), TREE(160), STACK(15), TREEND, PP, IB *UF(402) DATA ST00KZ(1)/117/,ST00KZ(2)/110/,ST00KZ(3)/98/,ST00KZ(4)/97/,ST0 *0KZ(5)/108/,ST00KZ(6)/101/,ST00KZ(7)/110/,ST00KZ(8)/99/,ST00KZ(9)/ *101/,ST00KZ(10)/100/,ST00KZ(11)/32/,ST00KZ(12)/114/,ST00KZ(13)/105 */,ST00KZ(14)/103/,ST00KZ(15)/104/,ST00KZ(16)/116/,ST00KZ(17)/32/,S *T00KZ(18)/112/,ST00KZ(19)/97/,ST00KZ(20)/114/,ST00KZ(21)/101/,ST00 *KZ(22)/110/,ST00KZ(23)/116/,ST00KZ(24)/104/,ST00KZ(25)/101/,ST00KZ *(26)/115/,ST00KZ(27)/101/,ST00KZ(28)/115/,ST00KZ(29)/32/,ST00KZ(30 *)/40/,ST00KZ(31)/115/,ST00KZ(32)/121/,ST00KZ(33)/110/,ST00KZ(34)/4 *9/,ST00KZ(35)/41/,ST00KZ(36)/0/ DATA ST00LZ(1)/117/,ST00LZ(2)/110/,ST00LZ(3)/98/,ST00LZ(4)/97/,ST0 *0LZ(5)/108/,ST00LZ(6)/101/,ST00LZ(7)/110/,ST00LZ(8)/99/,ST00LZ(9)/ *101/,ST00LZ(10)/100/,ST00LZ(11)/32/,ST00LZ(12)/108/,ST00LZ(13)/101 */,ST00LZ(14)/102/,ST00LZ(15)/116/,ST00LZ(16)/32/,ST00LZ(17)/112/,S *T00LZ(18)/97/,ST00LZ(19)/114/,ST00LZ(20)/101/,ST00LZ(21)/110/,ST00 *LZ(22)/116/,ST00LZ(23)/104/,ST00LZ(24)/101/,ST00LZ(25)/115/,ST00LZ *(26)/101/,ST00LZ(27)/115/,ST00LZ(28)/32/,ST00LZ(29)/40/,ST00LZ(30) */115/,ST00LZ(31)/121/,ST00LZ(32)/110/,ST00LZ(33)/49/,ST00LZ(34)/41 */,ST00LZ(35)/0/ L = 0 P=P1 23478 IF (.NOT.(P.LT.P2))GOTO 23480 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23481 L = L + 1 GOTO 23482 23481 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23483 L = L - 1 23483 CONTINUE 23482 CONTINUE IF (.NOT.(L .LT. 0))GOTO 23485 CALL STXERR(ST00KZ) GOTO 23486 23485 CONTINUE IF (.NOT.(TOK .EQ. 38 .OR. TOK .EQ. 59))GOTO 23487 IF (.NOT.(L .EQ. 0))GOTO 23489 IF (.NOT.( MKTREE( TKBUF( 3, P1), TOK, 4, NODE) .EQ. -3))GOTO 2349 *1 SYN1=(-3) RETURN 23491 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 23489 CONTINUE 23487 CONTINUE 23486 CONTINUE 23479 P=P+1 GOTO 23478 23480 CONTINUE IF (.NOT.(L .GT. 0))GOTO 23493 CALL STXERR(ST00LZ) GOTO 23494 23493 CONTINUE TKBUF( 2, P1) = 2 CALL PUTBAC (P1) 23494 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, 100), TREE(160), STACK(15), TREEND, PP, IB *UF(402) L = 0 P=P1 23495 IF (.NOT.(P.LT.P2))GOTO 23497 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 40))GOTO 23498 L = L + 1 GOTO 23499 23498 CONTINUE IF (.NOT.(TOK .EQ. 41))GOTO 23500 L = L - 1 GOTO 23501 23500 CONTINUE IF (.NOT.(TOK .EQ. 124))GOTO 23502 IF (.NOT.(L .EQ. 0))GOTO 23504 IF (.NOT.( MKTREE( TKBUF( 3, P1), 124, 4, NODE) .EQ. -3))GOTO 2350 *6 SYN2=(-3) RETURN 23506 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 23504 CONTINUE 23502 CONTINUE 23501 CONTINUE 23499 CONTINUE 23496 P=P+1 GOTO 23495 23497 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 ST00MZ(21) COMMON /CPARS/ TKBUF(4, 100), TREE(160), STACK(15), TREEND, PP, IB *UF(402) DATA ST00MZ(1)/101/,ST00MZ(2)/109/,ST00MZ(3)/112/,ST00MZ(4)/116/,S *T00MZ(5)/121/,ST00MZ(6)/32/,ST00MZ(7)/99/,ST00MZ(8)/111/,ST00MZ(9) */109/,ST00MZ(10)/109/,ST00MZ(11)/97/,ST00MZ(12)/110/,ST00MZ(13)/10 *0/,ST00MZ(14)/32/,ST00MZ(15)/40/,ST00MZ(16)/115/,ST00MZ(17)/121/,S *T00MZ(18)/110/,ST00MZ(19)/51/,ST00MZ(20)/41/,ST00MZ(21)/0/ IF (.NOT.(P1 .GE. P2))GOTO 23508 CALL STXERR(ST00MZ) SYN3=(-3) RETURN 23508 CONTINUE NDX = TKBUF( 1, P1) IF (.NOT.(IBUF(NDX) .EQ. 40))GOTO 23510 SYN3=( DOPAR(P1,P2)) RETURN 23510 CONTINUE SYN3=( DOVERB(P1,P2)) RETURN 23511 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, 100), TREE(160), STACK(15), TREEND, PP, IB *UF(402) P=P1 23512 IF (.NOT.(P.LT.P2))GOTO 23514 NDX = TKBUF( 1, P) TOK = IBUF(NDX) IF (.NOT.(TOK .EQ. 59 .OR. TOK .EQ. 38 .OR. TOK .EQ. 10))GOTO 2351 *5 GOTO 23513 23515 CONTINUE GOTO 23514 23513 P=P+1 GOTO 23512 23514 CONTINUE IF (.NOT.(P .LT. P2))GOTO 23517 TKBUF( 2, P) = 1 TKBUF( 3, P) = TKBUF( 3, P1) TKBUF( 4, P) = TKBUF( 4, P1) CALL PUTBAC (P) 23517 CONTINUE SYNTAX=(0) 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 23519 CALL STRCPY(OLDDIR, ARGS) 23519 CONTINUE IF (.NOT.(CWDIR(ARGS) .EQ. -3))GOTO 23521 CALL PUTLIN(ARGS, 3) CALL PUTLNL(FINISH, 3) CHGDIR=(-3) RETURN 23521 CONTINUE CALL STRCPY(SH, OLDDIR) CALL PWDIR(SH, 3, 10) 23522 CONTINUE CHGDIR=(0) RETURN END