INTEGER FUNCTION AMOVE( NAME1, NAME2) LOGICAL*1 NAME1(480), NAME2(480) LOGICAL*1 TEMP1(480), TEMP2(480) INTEGER STATUS, JUNK INTEGER INDEXX, RENAME, REMOVE INTEGER OLD, NEW INTEGER CREATE, OPEN INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( INDEXX( NAME1, 47) .GT. 0 .OR. INDEXX( NAME1, 92) .GT. *0 ))GOTO 23000 CALL MKLOCL( NAME1, TEMP1) GOTO 23001 23000 CONTINUE CALL STRCPY( NAME1, TEMP1) 23001 CONTINUE IF (.NOT.( INDEXX( NAME2, 47) .GT. 0 .OR. INDEXX( NAME2, 92) .GT. *0 ))GOTO 23002 CALL MKLOCL( NAME2, TEMP2) GOTO 23003 23002 CONTINUE CALL STRCPY( NAME2, TEMP2) 23003 CONTINUE CALL UPPER(TEMP1) CALL UPPER(TEMP2) NEW = OPEN( TEMP2, 1) IF (.NOT.( NEW .NE. -3 ))GOTO 23004 CALL CLOSE(NEW) JUNK = REMOVE(TEMP2) 23004 CONTINUE IF (.NOT.( RENAME( TEMP1, TEMP2) .EQ. -3 ))GOTO 23006 OLD = OPEN( TEMP1, 1) IF (.NOT.( OLD .EQ. -3 ))GOTO 23008 AMOVE=(-3) RETURN 23008 CONTINUE NEW = CREATE( TEMP2, 2) IF (.NOT.( NEW .EQ. -3 ))GOTO 23010 CALL CLOSE(OLD) AMOVE=(-3) RETURN 23010 CONTINUE CALL FCOPY( OLD, NEW) CALL CLOSE(OLD) CALL CLOSE(NEW) JUNK = REMOVE(TEMP1) 23006 CONTINUE AMOVE=(0) RETURN END SUBROUTINE APPRED( FD, C, FILE, BUF) INTEGER FD INTEGER I INTEGER LENGTH LOGICAL*1 BUF(512), C, FILE(480) I = LENGTH(BUF) + 1 CALL CHCOPY( 32, BUF, I) CALL CHCOPY( C, BUF, I) CALL CHCOPY( C, BUF, I) CALL STCOPY( FILE, 1, BUF, I) CALL CLOSE(FD) RETURN END SUBROUTINE APPSTR( STR1, STR2) LOGICAL*1 STR1(2048), STR2(2048) INTEGER I INTEGER LENGTH I = LENGTH(STR2) + 1 CALL SCOPY( STR1, 1, STR2, I) RETURN END SUBROUTINE ARGGEN( PNAME, BNAME) LOGICAL*1 PNAME(2048), BNAME(2048) INTEGER I, J LOGICAL*1 ARGSTR(4) DATA ARGSTR(1)/97/,ARGSTR(2)/114/,ARGSTR(3)/103/,ARGSTR(4)/0/ J = 1 CALL STCOPY( ARGSTR, 1, BNAME, J) I = 1 23012 IF (.NOT.(PNAME(I) .NE. 0 ))GOTO 23014 IF (.NOT.( PNAME(I) .EQ. 38 ))GOTO 23015 CALL CHCOPY( 95, BNAME, J) GOTO 23016 23015 CONTINUE IF (.NOT.( PNAME(I) .NE. 46 ))GOTO 23017 CALL CHCOPY( PNAME(I), BNAME, J) 23017 CONTINUE 23016 CONTINUE 23013 I = I + 1 GOTO 23012 23014 CONTINUE BNAME(J) = 0 CALL UPPER(BNAME) RETURN END INTEGER FUNCTION ASSIGN( NAM, FD, ACCESS) LOGICAL*1 NAM(2048) INTEGER FD INTEGER CRE8AT INTEGER ACCESS INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS ASSIGN = -3 IF (.NOT.( 0 .LT. FD .AND. FD .LE. 15 ))GOTO 23019 CALL CLOSE(FD) ASSIGN = CRE8AT( NAM, ACCESS, FD, 0) 23019 CONTINUE RETURN END SUBROUTINE AUXFMT( QDATE, NAM, FMT, GRP, MEM, PROT, EOF, FREE, TYP *, AUX, DATE) INTEGER QDATE(2), GRP, MEM, PROT, EOF, FREE, TYP INTEGER AUXNDX, CNT, I, J, N, ONDX, DSC(2), TIMLEN INTEGER CTOI, INDEXX, INDEXS, ITOC, LENGTH LOGICAL*1 AUX(2048), C, DATE(2048), FMT(2048), NAM(2048), TEMP(480 *) LOGICAL*1 ASCSTR(4) LOGICAL*1 BINSTR(4) LOGICAL*1 DIRSTR(4) LOGICAL*1 OBJSTR(5) DATA ASCSTR(1)/97/,ASCSTR(2)/115/,ASCSTR(3)/99/,ASCSTR(4)/0/ DATA BINSTR(1)/98/,BINSTR(2)/105/,BINSTR(3)/110/,BINSTR(4)/0/ DATA DIRSTR(1)/100/,DIRSTR(2)/105/,DIRSTR(3)/114/,DIRSTR(4)/0/ DATA OBJSTR(1)/46/,OBJSTR(2)/111/,OBJSTR(3)/98/,OBJSTR(4)/106/,OBJ *STR(5)/0/ ONDX = 1 CALL FOLD(FMT) AUXNDX = 1 23021 IF (.NOT.(FMT(AUXNDX) .NE. 0 ))GOTO 23023 23024 IF (.NOT.( FMT(AUXNDX) .EQ. 32 .OR. FMT(AUXNDX) .EQ. 9 ))GOTO 2302 *5 CALL CHCOPY( FMT(AUXNDX), AUX, ONDX) AUXNDX = AUXNDX + 1 GOTO 23024 23025 CONTINUE CNT = CTOI( FMT, AUXNDX) IF (.NOT.( CNT .EQ. 0 ))GOTO 23026 CNT = 1 23026 CONTINUE C = FMT(AUXNDX) IF (.NOT.( C .EQ. 110 ))GOTO 23028 CALL STCOPY( NAM, 1, AUX, ONDX) CNT = CNT - LENGTH(NAM) 23030 IF (.NOT.(CNT .GT. 0 ))GOTO 23032 CALL CHCOPY( 32, AUX, ONDX) 23031 CNT = CNT - 1 GOTO 23030 23032 CONTINUE GOTO 23029 23028 CONTINUE IF (.NOT.( C .EQ. 99 ))GOTO 23033 J = 512 * EOF + ( FREE - 512 ) N = ITOC( J, TEMP, CNT ) J = CNT 23035 IF (.NOT.(J .GT. N ))GOTO 23037 CALL CHCOPY( 32, AUX, ONDX) 23036 J = J - 1 GOTO 23035 23037 CONTINUE CALL STCOPY( TEMP, 1, AUX, ONDX) GOTO 23034 23033 CONTINUE IF (.NOT.( C .EQ. 98 ))GOTO 23038 J = EOF IF (.NOT.( FREE .LE. 0 ))GOTO 23040 J = J - 1 23040 CONTINUE N = ITOC( J, TEMP, CNT ) J = CNT 23042 IF (.NOT.(J .GT. N ))GOTO 23044 CALL CHCOPY( 32, AUX, ONDX) 23043 J = J - 1 GOTO 23042 23044 CONTINUE CALL STCOPY( TEMP, 1, AUX, ONDX) GOTO 23039 23038 CONTINUE IF (.NOT.( C .EQ. 116 ))GOTO 23045 CALL STRCPY( BINSTR, TEMP) IF (.NOT.( TYP .EQ. 12 ))GOTO 23047 IF (.NOT.( INDEXS( NAM, OBJSTR) .EQ. 0 ))GOTO 23049 IF (.NOT.( INDEXX( NAM, 47) .EQ. LENGTH(NAM) ))GOTO 23051 CALL STRCPY( DIRSTR, TEMP) GOTO 23052 23051 CONTINUE CALL STRCPY( ASCSTR, TEMP) 23052 CONTINUE 23049 CONTINUE 23047 CONTINUE CALL STCOPY( TEMP, 1, AUX, ONDX) GOTO 23046 23045 CONTINUE IF (.NOT.( C .EQ. 109 ))GOTO 23053 DSC(1) = 24 DSC(2) = %LOC(TEMP) CALL SYS$ASCTIM( TIMLEN, DSC, QDATE, %VAL(0) ) J = INDEXX( TEMP, 46) TEMP(J) = 0 CALL STCOPY( TEMP, 1, AUX, ONDX) GOTO 23054 23053 CONTINUE IF (.NOT.( C .EQ. 112 ))GOTO 23055 J = 1 I = 1 23057 IF (.NOT.(I .LE. 16 ))GOTO 23059 IF (.NOT.( MOD( PROT, 2) .EQ. 1 ))GOTO 23060 TEMP(J) = 45 GOTO 23061 23060 CONTINUE IF (.NOT.( MOD( I, 4) .EQ. 1 ))GOTO 23062 TEMP(J) = 114 GOTO 23063 23062 CONTINUE IF (.NOT.( MOD( I, 4) .EQ. 2 ))GOTO 23064 TEMP(J) = 119 GOTO 23065 23064 CONTINUE IF (.NOT.( MOD( I, 4) .EQ. 3 ))GOTO 23066 TEMP(J) = 101 GOTO 23067 23066 CONTINUE TEMP(J) = 100 23067 CONTINUE 23065 CONTINUE 23063 CONTINUE 23061 CONTINUE IF (.NOT.( MOD( I, 4) .EQ. 0 .AND. I .LT. 16 ))GOTO 23068 J = J + 1 TEMP(J) = 124 23068 CONTINUE PROT = PROT / 2 J = J + 1 23058 I = I + 1 GOTO 23057 23059 CONTINUE TEMP(J) = 0 CALL STCOPY( TEMP, 6, AUX, ONDX) GOTO 23056 23055 CONTINUE IF (.NOT.( C .EQ. 111 ))GOTO 23070 CALL FMTUIC( GRP, MEM, TEMP) CALL RESUIC( TEMP, DATE) CALL STCOPY( DATE, 1, AUX, ONDX) CNT = CNT - LENGTH(DATE) 23072 IF (.NOT.(CNT .GT. 0 ))GOTO 23074 CALL CHCOPY( 32, AUX, ONDX) 23073 CNT = CNT - 1 GOTO 23072 23074 CONTINUE GOTO 23071 23070 CONTINUE CALL CHCOPY( C, AUX, ONDX) 23071 CONTINUE 23056 CONTINUE 23054 CONTINUE 23046 CONTINUE 23039 CONTINUE 23034 CONTINUE 23029 CONTINUE 23022 AUXNDX = AUXNDX + 1 GOTO 23021 23023 CONTINUE AUX(ONDX) = 0 CALL FOLD(AUX) CALL SRTTIM( QDATE, DATE) RETURN END INTEGER FUNCTION BRDCST( MSG, DEV) LOGICAL*1 DEV(2048), MSG(2048) INTEGER MSGDSC(2), DEVDSC(2) INTEGER EQUAL, SYS$BRDCST LOGICAL*1 ALL(4) DATA ALL(1)/65/,ALL(2)/76/,ALL(3)/76/,ALL(4)/0/ IF (.NOT.( DEV(1) .EQ. 0 ))GOTO 23075 BRDCST=(-3) RETURN 23075 CONTINUE CALL DSCBLD( MSGDSC, MSG) CALL UPPER(DEV) CALL DSCBLD( DEVDSC, DEV) IF (.NOT.( EQUAL( ALL, DEV) .EQ. 1 ))GOTO 23077 IF (.NOT.( SYS$BRDCST( MSGDSC, ) .NE. 1 ))GOTO 23079 BRDCST=(-3) RETURN 23079 CONTINUE GOTO 23078 23077 CONTINUE IF (.NOT.( SYS$BRDCST( MSGDSC, DEVDSC) .NE. 1 ))GOTO 23081 BRDCST=(-3) RETURN 23081 CONTINUE 23078 CONTINUE BRDCST=(0) RETURN END SUBROUTINE CLOSDR(DESC) INTEGER DESC INTEGER DFAB LOGICAL*1 DNAM LOGICAL*1 LFILE COMMON / CDIREC / DFAB(10), DNAM(480, 10), LFILE(480, 10) IF (.NOT.( 1 .LE. DESC .AND. DESC .LE. 10 ))GOTO 23083 IF (.NOT.( DFAB(DESC) .NE. 0 ))GOTO 23085 CALL DCLOSE( DFAB(DESC) ) DFAB(DESC) = 0 23085 CONTINUE 23083 CONTINUE RETURN END SUBROUTINE CLOSE(FD) INTEGER FD INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23087 IF (.NOT.( LFN(FD) .EQ. 0 ))GOTO 23089 RETURN 23089 CONTINUE IF (.NOT.( LASTC(FD) .GT. 0 .AND. MODE(FD) .EQ. 1 ))GOTO 23091 CALL PUTCH( 10, FD) 23091 CONTINUE CALL CLOSEF( FDB(FD) ) IF (.NOT.(RAWCHN(FD) .NE. 0))GOTO 23093 CALL SYS$DASSGN(%VAL(RAWCHN(FD))) 23093 CONTINUE RAWCHN(FD) = 0 LFN(FD) = 0 23087 CONTINUE RETURN END LOGICAL*1 FUNCTION CMATCH(C, ARRAY) LOGICAL*1 C, ARRAY(2048) INTEGER I I = 1 23095 IF (.NOT.(ARRAY(I) .NE. 0 ))GOTO 23097 IF (.NOT.( C .EQ. ARRAY(I) ))GOTO 23098 GOTO 23097 23098 CONTINUE 23096 I = I + 1 GOTO 23095 23097 CONTINUE CMATCH = ARRAY(I) RETURN END SUBROUTINE COPYIT( IN, START, STOP, OUT) LOGICAL*1 IN(2048), OUT(2048) INTEGER I, J, START, STOP J = 1 I = START 23100 IF (.NOT.(I .LE. STOP ))GOTO 23102 OUT(J) = IN(I) J = J + 1 23101 I = I + 1 GOTO 23100 23102 CONTINUE OUT(J) = 0 RETURN END INTEGER FUNCTION CPUTIM(START) INTEGER START, CPUBUF, CPU INTEGER*2 JPIBUF(8) EQUIVALENCE( CPUBUF, JPIBUF(3) ) DATA JPIBUF / 4, 1031, 6*0 / CPUBUF = %LOC(CPU) CALL SYS$GETJPI( , , , JPIBUF, , , ) CPUTIM = CPU - START RETURN END INTEGER FUNCTION CRE8AT( FIL, ACCESS, FD, AGE) LOGICAL*1 BUF(480), FIL(2048) INTEGER FD INTEGER OPENA, OPENN, OPENP, OPENR, OPENS, OPENW INTEGER ACCESS, CCTYPE, DEVTYP, STATUS, AGE INTEGER INDEXX INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( INDEXX( FIL, 47) .GT. 0 .OR. INDEXX( FIL, 92) .GT. 0 )) *GOTO 23103 CALL MKLOCL( FIL, BUF) GOTO 23104 23103 CONTINUE CALL STRCPY( FIL, BUF) 23104 CONTINUE CALL UPPER(BUF) IF (.NOT.( ACCESS .EQ. 1 ))GOTO 23105 STATUS = OPENR( BUF, FD, ACCESS) GOTO 23106 23105 CONTINUE IF (.NOT.( ACCESS .EQ. 2 .OR. ACCESS .EQ. 3 .OR. ACCESS .EQ. 6 ))G *OTO 23107 STATUS = OPENW( BUF, FD, ACCESS, AGE) GOTO 23108 23107 CONTINUE IF (.NOT.( ACCESS .EQ. 4 ))GOTO 23109 STATUS = OPENA( BUF, FD, ACCESS, AGE) GOTO 23110 23109 CONTINUE IF (.NOT.( ACCESS .EQ. 99 ))GOTO 23111 STATUS = OPENN( BUF, FD, ACCESS) GOTO 23112 23111 CONTINUE IF (.NOT.( ACCESS .EQ. 98 ))GOTO 23113 STATUS = OPENS( BUF, FD, ACCESS) GOTO 23114 23113 CONTINUE IF (.NOT.( ACCESS .EQ. 5 ))GOTO 23115 STATUS = OPENP( BUF, FD, ACCESS) GOTO 23116 23115 CONTINUE STATUS = -3 23116 CONTINUE 23114 CONTINUE 23112 CONTINUE 23110 CONTINUE 23108 CONTINUE 23106 CONTINUE IF (.NOT.( STATUS .EQ. -3 ))GOTO 23117 CRE8AT = -3 GOTO 23118 23117 CONTINUE CALL STRCPY( BUF, FILENM( 1, FD) ) FILACC(FD) = ACCESS CRE8AT = FD IF (.NOT.( STATUS .NE. 0 ))GOTO 23119 FLTYPE(FD) = 60 GOTO 23120 23119 CONTINUE FLTYPE(FD) = 12 23120 CONTINUE RAWCHN(FD) = 0 LFN(FD) = DEVTYP( FDB(FD) ) CHTYPE(FD) = 0 IMP_CTRL(FD) = CCTYPE( FDB(FD)) 23118 CONTINUE RETURN END INTEGER FUNCTION CREATE( FIL, ACCESS) LOGICAL*1 FIL(2048) INTEGER FD INTEGER CRE8AT, NXTLUN INTEGER ACCESS, NEWACC INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( NXTLUN(FD) .EQ. -3 ))GOTO 23121 CREATE = -3 GOTO 23122 23121 CONTINUE IF (.NOT.( ACCESS .EQ. 1 ))GOTO 23123 NEWACC = 99 GOTO 23124 23123 CONTINUE NEWACC = ACCESS 23124 CONTINUE CREATE = CRE8AT( FIL, NEWACC, FD, 0) 23122 CONTINUE RETURN END INTEGER FUNCTION CREMBX(BUF, UNIQIT, DESCR, UNIT) LOGICAL*1 BUF(2048), UNQBUF(20), NAME(64) INTEGER*4 DESCR, STATUS, SYS$CREMBX, INIT, I, LENGTH, SYS$GETCHN, *UNIQIT INTEGER LOGNM(2) INTEGER*2 UNIT, CHUNIT EQUIVALENCE( CHUNIT, NAME(13) ) DATA INIT / 0 / IF (.NOT.( INIT .EQ. 0 ))GOTO 23125 CALL UNIQUE(UNQBUF) INIT = 1 23125 CONTINUE I = 1 CALL STCOPY( BUF, 1, NAME, I) IF (.NOT.( UNIQIT .EQ. 1 ))GOTO 23127 CALL STCOPY( UNQBUF, 1, NAME, I) 23127 CONTINUE NAME(I) = 0 CALL UPPER(NAME) CALL DSCBLD( LOGNM, NAME) STATUS = SYS$CREMBX( , DESCR, %VAL(512), %VAL(512), %VAL(0), , LOG *NM) IF (.NOT.( STATUS .NE. 1 .AND. STATUS .NE. 1585 ))GOTO 23129 CREMBX = -3 GOTO 23130 23129 CONTINUE CALL SCOPY( NAME, 1, BUF, 1) LOGNM(1) = 64 STATUS = SYS$GETCHN( %VAL(DESCR), , LOGNM, , ) IF (.NOT.( STATUS .NE. 1 .AND. STATUS .NE. 1537 ))GOTO 23131 CREMBX = -3 GOTO 23132 23131 CONTINUE UNIT = CHUNIT CREMBX = 0 23132 CONTINUE 23130 CONTINUE RETURN END SUBROUTINE CTOPTR( BUF, I, PTR) LOGICAL*1 BUF(2048) INTEGER I, PTR(2) INTEGER CTOI PTR(1) = CTOI( BUF, I) PTR(2) = CTOI( BUF, I) RETURN END SUBROUTINE CVT_DTOP( IN, OUT) LOGICAL*1 IN(480), OUT(480), HOST(480) LOGICAL*1 DEVICE(480), DIRECT(480), FILE(480) LOGICAL*1 TEMP(480) INTEGER I LOGICAL*1 SLAT(3) DATA SLAT(1)/47/,SLAT(2)/64/,SLAT(3)/0/ CALL SCOPY( IN, 1, OUT, 1) CALL UPPER(OUT) CALL EXPLOG( OUT, TEMP) CALL PARSEF( TEMP, HOST, DEVICE, DIRECT, FILE) I = 1 IF (.NOT.( HOST(1) .NE. 0 ))GOTO 23133 CALL STCOPY( SLAT, 1, OUT, I) CALL STCOPY( HOST, 1, OUT, I) 23133 CONTINUE IF (.NOT.( DEVICE(1) .NE. 0 ))GOTO 23135 CALL CHCOPY( 47, OUT, I) CALL STCOPY( DEVICE, 1, OUT, I) 23135 CONTINUE IF (.NOT.( DIRECT(1) .NE. 0 ))GOTO 23137 IF (.NOT.( DIRECT(2) .EQ. 46 ))GOTO 23139 CALL DIROUT( DIRECT, OUT, I) GOTO 23140 23139 CONTINUE IF (.NOT.( DEVICE(1) .EQ. 0 ))GOTO 23141 CALL CHCOPY( 47, OUT, I) CALL GTDDEV(DEVICE) CALL STCOPY( DEVICE, 1, OUT, I) 23141 CONTINUE CALL DIROUT( DIRECT, OUT, I) 23140 CONTINUE 23137 CONTINUE IF (.NOT.(I .GT. 1))GOTO 23143 CALL CHCOPY(47, OUT, I) 23143 CONTINUE IF (.NOT.( FILE(1) .NE. 0 ))GOTO 23145 CALL STCOPY( FILE, 1, OUT, I) 23145 CONTINUE OUT(I) = 0 CALL FOLD(OUT) RETURN END INTEGER FUNCTION CWDIR(DIR) LOGICAL*1 DIR(480), PATH(480) INTEGER DESC INTEGER OPENDR CALL MKPATH( DIR, PATH) IF (.NOT.( OPENDR( PATH, DESC) .NE. -3 ))GOTO 23147 CALL CLOSDR(DESC) CALL STDPTH(PATH) CWDIR=(0) RETURN 23147 CONTINUE CWDIR=(-3) RETURN 23148 CONTINUE END INTEGER FUNCTION DCLOUT(LIN, START, STOP, ARGS) LOGICAL*1 LIN(2048), ARGS(2048), QCHAR INTEGER I, J, START, STOP, JUNK INTEGER GETWRD I = 1 23149 IF (.NOT.(LIN(I) .NE. 10 .AND. LIN(I) .NE. 0 ))GOTO 23151 IF (.NOT.( LIN(I) .EQ. 32 ))GOTO 23152 CALL SKIPBL( LIN, I) IF (.NOT.( LIN(I) .EQ. 62 ))GOTO 23154 START = I - 1 23156 IF (.NOT.(LIN(I) .EQ. 62 ))GOTO 23158 23157 I = I + 1 GOTO 23156 23158 CONTINUE JUNK = GETWRD( LIN, I, ARGS) STOP = I DCLOUT=(1) RETURN 23154 CONTINUE I = I - 1 GOTO 23153 23152 CONTINUE IF (.NOT.( LIN(I) .EQ. 39 .OR. LIN(I) .EQ. 34 ))GOTO 23159 QCHAR = LIN(I) 23161 CONTINUE I = I + 1 23162 IF (.NOT.( LIN(I) .EQ. QCHAR .OR. LIN(I) .EQ. 10 .OR. LIN(I) .EQ. *0 ))GOTO 23161 23163 CONTINUE IF (.NOT.( LIN(I) .NE. QCHAR ))GOTO 23164 I = I - 1 23164 CONTINUE 23159 CONTINUE 23153 CONTINUE 23150 I = I + 1 GOTO 23149 23151 CONTINUE DCLOUT=(0) RETURN END SUBROUTINE DEFDIR(DIRECT) INTEGER DSC(2) LOGICAL*1 DIRECT(2048) DSC(1) = 64 DSC(2) = %LOC(DIRECT) CALL SYS$SETDDIR( , DSC, DSC(1) ) DIRECT( DSC(1) + 1 ) = 0 CALL FOLD(DIRECT) RETURN END SUBROUTINE DELARG(N) INTEGER I, N INTEGER NBRARG, PTR LOGICAL*1 ARG COMMON /CARG/ NBRARG, PTR(128), ARG(512) IF (.NOT.( 0 .LE. N .AND. N .LT. NBRARG ))GOTO 23166 I = N + 1 23168 IF (.NOT.(I .LT. NBRARG ))GOTO 23170 PTR(I) = PTR( I + 1 ) 23169 I = I + 1 GOTO 23168 23170 CONTINUE NBRARG = NBRARG - 1 23166 CONTINUE RETURN END SUBROUTINE DIRFIL( DPATH, FILE, DIREC) LOGICAL*1 DPATH(2048), FILE(2048), NODE(480) LOGICAL*1 DEVICE(480), TEMP(480), DNODE(480) LOGICAL*1 DIREC(2048), DIRECT(480) INTEGER I, JUNK, GTFTOK, DEPTH, PTR(10), J, K, EQUAL LOGICAL*1 ROOTDR(9) LOGICAL*1 ST001Z(5) DATA ROOTDR(1)/91/,ROOTDR(2)/48/,ROOTDR(3)/48/,ROOTDR(4)/48/,ROOTD *R(5)/48/,ROOTDR(6)/48/,ROOTDR(7)/48/,ROOTDR(8)/93/,ROOTDR(9)/0/ DATA ST001Z(1)/46/,ST001Z(2)/100/,ST001Z(3)/105/,ST001Z(4)/114/,ST *001Z(5)/0/ I = 2 JUNK = GTFTOK( DPATH, I, NODE) IF (.NOT.( NODE(1) .EQ. 64 ))GOTO 23171 CALL SCOPY( NODE, 2, NODE, 1) JUNK = GTFTOK( DPATH, I, DEVICE) J = 3 GOTO 23172 23171 CONTINUE CALL STRCPY( NODE, DEVICE) NODE(1) = 0 J = 2 23172 CONTINUE CALL EXPPTH( DPATH, DEPTH, PTR, TEMP) IF (.NOT.( DEPTH .EQ. J ))GOTO 23173 CALL STRCPY( ROOTDR, DIRECT) GOTO 23174 23173 CONTINUE DIRECT(1) = 91 K = 2 23175 IF (.NOT.(J .LT. DEPTH ))GOTO 23177 JUNK = GTFTOK( DPATH, I, TEMP) CALL STCOPY( TEMP, 1, DIRECT, K) DIRECT(K) = 46 K = K + 1 23176 J = J + 1 GOTO 23175 23177 CONTINUE DIRECT( K - 1 ) = 93 DIRECT(K) = 0 23174 CONTINUE JUNK = GTFTOK( DPATH, I, TEMP) J = LENGTH(TEMP) + 1 CALL SCOPY( ST001Z, 1, TEMP, J) CALL HOSTNM(DNODE) IF (.NOT.( EQUAL( DNODE, NODE) .EQ. 1 ))GOTO 23178 NODE(1) = 0 23178 CONTINUE CALL FGENR8( NODE, DEVICE, DIRECT, TEMP, FILE) CALL UPPER(FILE) IF (.NOT.( EQUAL( DIRECT, ROOTDR) .EQ. 1 ))GOTO 23180 J = 2 GOTO 23181 23180 CONTINUE J = INDEXX( DIRECT, 93) DIRECT(J) = 46 J = J + 1 23181 CONTINUE K = 1 23182 IF (.NOT.(TEMP(K) .NE. 46 ))GOTO 23184 DIRECT(J) = TEMP(K) J = J + 1 23183 K = K + 1 GOTO 23182 23184 CONTINUE DIRECT(J) = 93 DIRECT( J + 1 ) = 0 CALL FGENR8( NODE, DEVICE, DIRECT, 0, DIREC) CALL UPPER(DIREC) RETURN END SUBROUTINE DIROUT( DIRECT, OUT, I) LOGICAL*1 DIRECT(2048), OUT(2048) INTEGER I, J IF (.NOT.( DIRECT(1) .NE. 91 ))GOTO 23185 RETURN 23185 CONTINUE IF (.NOT.( DIRECT(2) .EQ. 46 ))GOTO 23187 J = 3 GOTO 23188 23187 CONTINUE CALL CHCOPY( 47, OUT, I) J = 2 23188 CONTINUE 23189 IF (.NOT.( DIRECT(J) .NE. 93 ))GOTO 23190 IF (.NOT.( DIRECT(J) .EQ. 46 ))GOTO 23191 CALL CHCOPY( 47, OUT, I) J = J + 1 23191 CONTINUE 23193 IF (.NOT.(DIRECT(J) .NE. 46 .AND. DIRECT(J) .NE. 93 ))GOTO 23195 IF (.NOT.( DIRECT(J) .EQ. 0 ))GOTO 23196 OUT(I) = 0 RETURN 23196 CONTINUE CALL CHCOPY( DIRECT(J), OUT, I) 23194 J = J + 1 GOTO 23193 23195 CONTINUE GOTO 23189 23190 CONTINUE OUT(I) = 0 RETURN END SUBROUTINE DSCBLD( DSC, STRING) INTEGER DSC(2), LENGTH LOGICAL*1 STRING(2048) DSC(1) = LENGTH(STRING) DSC(2) = %LOC(STRING) RETURN END SUBROUTINE ENBINT LOGICAL*1 BUF(480) INTEGER CHAN, INIT, INTOK, MYPID, OWNID INTEGER ISATTY, RTOPEN, SYS$QIOW EXTERNAL INTSRV LOGICAL*1 ST002Z(3) LOGICAL*1 ST003Z(37) LOGICAL*1 ST004Z(27) DATA INIT / 1 / DATA ST002Z(1)/84/,ST002Z(2)/84/,ST002Z(3)/0/ DATA ST003Z(1)/67/,ST003Z(2)/97/,ST003Z(3)/110/,ST003Z(4)/110/,ST0 *03Z(5)/111/,ST003Z(6)/116/,ST003Z(7)/32/,ST003Z(8)/97/,ST003Z(9)/1 *15/,ST003Z(10)/115/,ST003Z(11)/105/,ST003Z(12)/103/,ST003Z(13)/110 */,ST003Z(14)/32/,ST003Z(15)/99/,ST003Z(16)/104/,ST003Z(17)/97/,ST0 *03Z(18)/110/,ST003Z(19)/110/,ST003Z(20)/101/,ST003Z(21)/108/,ST003 *Z(22)/32/,ST003Z(23)/102/,ST003Z(24)/111/,ST003Z(25)/114/,ST003Z(2 *6)/32/,ST003Z(27)/105/,ST003Z(28)/110/,ST003Z(29)/116/,ST003Z(30)/ *101/,ST003Z(31)/114/,ST003Z(32)/114/,ST003Z(33)/117/,ST003Z(34)/11 *2/,ST003Z(35)/116/,ST003Z(36)/115/,ST003Z(37)/0/ DATA ST004Z(1)/67/,ST004Z(2)/97/,ST004Z(3)/110/,ST004Z(4)/110/,ST0 *04Z(5)/111/,ST004Z(6)/116/,ST004Z(7)/32/,ST004Z(8)/101/,ST004Z(9)/ *110/,ST004Z(10)/97/,ST004Z(11)/98/,ST004Z(12)/108/,ST004Z(13)/101/ *,ST004Z(14)/32/,ST004Z(15)/94/,ST004Z(16)/67/,ST004Z(17)/32/,ST004 *Z(18)/105/,ST004Z(19)/110/,ST004Z(20)/116/,ST004Z(21)/101/,ST004Z( *22)/114/,ST004Z(23)/114/,ST004Z(24)/117/,ST004Z(25)/112/,ST004Z(26 *)/116/,ST004Z(27)/0/ IF (.NOT.( INIT .EQ. 1 ))GOTO 23198 CALL GETPID(MYPID) CALL GETOWN( MYPID, OWNID) INIT = 0 IF (.NOT.( ISATTY(1) .EQ. 1 .AND. OWNID .EQ. 0 ))GOTO 23200 INTOK = 1 GOTO 23201 23200 CONTINUE INTOK = 0 23201 CONTINUE IF (.NOT.( INTOK .EQ. 1 ))GOTO 23202 IF (.NOT.( RTOPEN( ST002Z, CHAN) .EQ. -3 ))GOTO 23204 INTOK = 0 CALL REMARK( ST003Z ) 23204 CONTINUE 23202 CONTINUE 23198 CONTINUE IF (.NOT.( INTOK .EQ. 1 ))GOTO 23206 IF (.NOT.( .NOT.SYS$QIOW( , %VAL(CHAN), %VAL( 291 ),,,, INTSRV,,,, *, ) ))GOTO 23208 CALL ERROR( ST004Z ) 23208 CONTINUE 23206 CONTINUE RETURN END SUBROUTINE ENDST(STATUS) INTEGER FD INTEGER STATUS, EXIT_STAT INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS FD = 1 23210 IF (.NOT.(FD .LE. 15 ))GOTO 23212 CALL CLOSE(FD) 23211 FD = FD + 1 GOTO 23210 23212 CONTINUE IF (.NOT.( STATUS .EQ. 0 ))GOTO 23213 EXIT_STAT = 1 GOTO 23214 23213 CONTINUE EXIT_STAT = 101 23214 CONTINUE CALL SYS$EXIT( %VAL( EXIT_STAT ) ) END INTEGER FUNCTION EXETIM(START) INTEGER START, TIME, LOGIN(2), LOGBUF, INIT INTEGER*2 TIMB(7), JPIBUF(8), LOGTIM(7) EQUIVALENCE( LOGBUF, JPIBUF(3) ) DATA JPIBUF / 8, 518, 6*0 / DATA INIT / 1 / IF (.NOT.( INIT .EQ. 1 ))GOTO 23215 LOGBUF = %LOC(LOGIN) CALL SYS$GETJPI( , , , JPIBUF, , , ) CALL SYS$NUMTIM( LOGTIM, LOGIN) INIT = 0 23215 CONTINUE CALL SYS$NUMTIM( TIMB, ) TIME = TIMB(4) - LOGTIM(4) TIME = 60 * TIME + TIMB(5) - LOGTIM(5) TIME = 60 * TIME + TIMB(6) - LOGTIM(6) TIME = 100 * TIME + TIMB(7) - LOGTIM(7) EXETIM=( TIME - START ) RETURN END SUBROUTINE EXITH INTEGER TERMBX INTEGER IOSB INTEGER TERMSG INTEGER DESBLK INTEGER REASON COMMON / CTRMBX / TERMBX, IOSB(2), TERMSG(21) COMMON / CEXITH / DESBLK(4), REASON CALL SYS$DASSGN( %VAL(TERMBX) ) RETURN END SUBROUTINE EXPLOG( IN, OUT) LOGICAL*1 IN(2048), OUT(2048) LOGICAL*1 NODE(480), DEVICE(480), DIRECT(480) LOGICAL*1 FILE(480), TEMP(480), NNODE(480) LOGICAL*1 NDEV(480) INTEGER TRANS, TRAN1 CALL STRCPY( IN, TEMP) 23217 CONTINUE TRANS = 0 CALL PARSEF( TEMP, NODE, DEVICE, DIRECT, FILE) IF (.NOT.( TRAN1( NODE, NNODE) .EQ. 1 ))GOTO 23220 TRANS = 1 23220 CONTINUE IF (.NOT.( TRAN1( DEVICE, NDEV) .EQ. 1 ))GOTO 23222 TRANS = 1 23222 CONTINUE CALL FGENR8( NNODE, NDEV, DIRECT, FILE, TEMP) 23218 IF (.NOT.( TRANS .EQ. 0 ))GOTO 23217 23219 CONTINUE CALL STRCPY( TEMP, OUT) RETURN END SUBROUTINE EXPPID( IN, OUT) LOGICAL*1 IN(9), OUT(9) INTEGER PID, HTOI PID = HTOI(IN) CALL PUTHEX( PID, OUT) RETURN END SUBROUTINE FGENR8( NODE, DEVICE, DIRECT, FILE, OUT) LOGICAL*1 NODE(2048), DEVICE(2048), DIRECT(2048), FILE(2048), OUT( *2048) INTEGER I INTEGER INDEXX, INDEXS LOGICAL*1 RBRLBR(3) LOGICAL*1 ST005Z(3) DATA RBRLBR(1)/93/,RBRLBR(2)/91/,RBRLBR(3)/0/ DATA ST005Z(1)/58/,ST005Z(2)/58/,ST005Z(3)/0/ I = 1 IF (.NOT.( NODE(1) .NE. 0 ))GOTO 23224 CALL STCOPY( NODE, 1, OUT, I) CALL STCOPY( ST005Z, 1, OUT, I) 23224 CONTINUE IF (.NOT.( DEVICE(1) .NE. 0 ))GOTO 23226 CALL STCOPY( DEVICE, 1, OUT, I) IF (.NOT.( INDEXX( DEVICE, 58) .EQ. 0 ))GOTO 23228 CALL CHCOPY( 58, OUT, I) 23228 CONTINUE 23226 CONTINUE CALL STCOPY( DIRECT, 1, OUT, I) CALL SCOPY( FILE, 1, OUT, I) I = INDEXS(OUT, RBRLBR) IF (.NOT.(I .GT. 0))GOTO 23230 CALL SCOPY(OUT, I+2, OUT, I) 23230 CONTINUE RETURN END INTEGER FUNCTION FILNFO( FD, NAME, ACCESS) INTEGER FD, ACCESS LOGICAL*1 NAME(2048) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23232 IF (.NOT.( LFN(FD) .NE. 0 ))GOTO 23234 CALL STRCPY( FILENM( 1, FD), NAME) ACCESS = FILACC(FD) FILNFO=(0) RETURN 23234 CONTINUE 23232 CONTINUE FILNFO=(-3) RETURN END INTEGER FUNCTION FLFIND( INFIL, OUTFIL, TYPE) LOGICAL*1 INFIL(480), OUTFIL(480) INTEGER FD INTEGER TYPE INTEGER OPEN, GETTYP FD = OPEN( INFIL, 1) IF (.NOT.( FD .NE. -3 ))GOTO 23236 TYPE = GETTYP( FD, TYPE) CALL CLOSE(FD) CALL MKLOCL( INFIL, OUTFIL) CALL FOLD(OUTFIL) 23236 CONTINUE FLFIND=(FD) RETURN END INTEGER FUNCTION FMTTIM( STRING, INTIME, BUF) INTEGER TIME(4), N, ITOC, J, K, INTIME LOGICAL*1 BUF(2048), STRING(2048), TEMP(5) TIME(3) = INTIME / 100 TIME(4) = INTIME - 100 * TIME(3) TIME(2) = TIME(3) / 60 TIME(3) = TIME(3) - 60 * TIME(2) TIME(1) = TIME(2) / 60 TIME(2) = TIME(2) - 60 * TIME(1) J = 1 CALL STCOPY( STRING, 1, BUF, J) N = 4 - ITOC( TIME(1), TEMP, 5) K = 1 23238 IF (.NOT.(K .LE. N ))GOTO 23240 BUF(J) = 32 J = J + 1 23239 K = K + 1 GOTO 23238 23240 CONTINUE CALL STCOPY( TEMP, 1, BUF, J) BUF(J) = 58 J = J + 1 N = 2 - ITOC( TIME(2), TEMP, 3) K = 1 23241 IF (.NOT.(K .LE. N ))GOTO 23243 BUF(J) = 48 J = J + 1 23242 K = K + 1 GOTO 23241 23243 CONTINUE CALL STCOPY( TEMP, 1, BUF, J) BUF(J) = 58 J = J + 1 N = 2 - ITOC( TIME(3), TEMP, 3) K = 1 23244 IF (.NOT.(K .LE. N ))GOTO 23246 BUF(J) = 48 J = J + 1 23245 K = K + 1 GOTO 23244 23246 CONTINUE CALL STCOPY( TEMP, 1, BUF, J) BUF(J) = 46 J = J + 1 N = 2 - ITOC( TIME(4), TEMP, 3) K = 1 23247 IF (.NOT.(K .LE. N ))GOTO 23249 BUF(J) = 48 J = J + 1 23248 K = K + 1 GOTO 23247 23249 CONTINUE CALL STCOPY( TEMP, 1, BUF, J) BUF(J) = 0 FMTTIM = J - 1 RETURN END SUBROUTINE FMTUIC( GRP, MEM, UIC) INTEGER*2 GRP, MEM INTEGER CTSTR(2), OUTDSC(2) LOGICAL*1 UIC(2048) LOGICAL*1 CSTRNG(10) DATA CSTRNG(1)/91/,CSTRNG(2)/33/,CSTRNG(3)/79/,CSTRNG(4)/66/,CSTRN *G(5)/44/,CSTRNG(6)/33/,CSTRNG(7)/79/,CSTRNG(8)/66/,CSTRNG(9)/93/,C *STRNG(10)/0/ CALL DSCBLD( CTSTR, CSTRNG) OUTDSC(1) = 10 OUTDSC(2) = %LOC(UIC) CALL SYS$FAO( CTSTR, , OUTDSC, %VAL(GRP), %VAL(MEM) ) UIC(10) = 0 RETURN END SUBROUTINE GDRAUX( DESC, FILE, AUX, DATE, FMT) INTEGER DESC, QDATE(2), GRP, MEM, PROT, EOF, FREE, I, FTYPE INTEGER DECNFO, INDEXX, LENGTH LOGICAL*1 FILE(2048), AUX(2048), DATE(2048), FMT(2048), TEMP(480) INTEGER DFAB LOGICAL*1 DNAM LOGICAL*1 LFILE LOGICAL*1 CANTRD(37) LOGICAL*1 QQDOT(3) LOGICAL*1 DOT1(3) LOGICAL*1 DOTDOT1(4) LOGICAL*1 DOTDIR(5) COMMON / CDIREC / DFAB(10), DNAM(480, 10), LFILE(480, 10) DATA CANTRD(1)/63/,CANTRD(2)/32/,CANTRD(3)/67/,CANTRD(4)/97/,CANTR *D(5)/110/,CANTRD(6)/39/,CANTRD(7)/116/,CANTRD(8)/32/,CANTRD(9)/114 */,CANTRD(10)/101/,CANTRD(11)/97/,CANTRD(12)/100/,CANTRD(13)/32/,CA *NTRD(14)/105/,CANTRD(15)/110/,CANTRD(16)/102/,CANTRD(17)/111/,CANT *RD(18)/114/,CANTRD(19)/109/,CANTRD(20)/97/,CANTRD(21)/116/,CANTRD( *22)/105/,CANTRD(23)/111/,CANTRD(24)/110/,CANTRD(25)/32/,CANTRD(26) */102/,CANTRD(27)/111/,CANTRD(28)/114/,CANTRD(29)/32/,CANTRD(30)/10 *2/,CANTRD(31)/105/,CANTRD(32)/108/,CANTRD(33)/101/,CANTRD(34)/32/, *CANTRD(35)/96/,CANTRD(36)/96/,CANTRD(37)/0/ DATA QQDOT(1)/39/,QQDOT(2)/39/,QQDOT(3)/0/ DATA DOT1(1)/46/,DOT1(2)/49/,DOT1(3)/0/ DATA DOTDOT1(1)/46/,DOTDOT1(2)/46/,DOTDOT1(3)/49/,DOTDOT1(4)/0/ DATA DOTDIR(1)/46/,DOTDIR(2)/100/,DOTDIR(3)/105/,DOTDIR(4)/114/,DO *TDIR(5)/0/ I = 1 CALL STCOPY( CANTRD, 1, AUX, I) CALL STCOPY( FILE, 1, AUX, I) CALL SCOPY( QQDOT, 1, AUX, I) I = 1 23250 IF (.NOT.(I .LE. 24 ))GOTO 23252 DATE(I) = 32 23251 I = I + 1 GOTO 23250 23252 CONTINUE DATE(I) = 0 IF (.NOT.( DESC .LT. 1 .OR. DESC .GT. 10 ))GOTO 23253 RETURN 23253 CONTINUE IF (.NOT.( DFAB(DESC) .EQ. 0 ))GOTO 23255 RETURN 23255 CONTINUE CALL CONCAT( DNAM( 1, DESC), FILE, TEMP) I = INDEXX( FILE, 46) + 1 IF (.NOT.( I .EQ. 1 ))GOTO 23257 I = INDEXX( FILE, 47) IF (.NOT.( I .EQ. 0 ))GOTO 23259 CALL CONCAT( TEMP, DOTDOT1, TEMP) GOTO 23260 23259 CONTINUE I = LENGTH(TEMP) TEMP(I) = 0 CALL CONCAT( TEMP, DOTDIR, TEMP) 23260 CONTINUE GOTO 23258 23257 CONTINUE IF (.NOT.( INDEXX( FILE(I), 46) .EQ. 0 ))GOTO 23261 CALL CONCAT( TEMP, DOT1, TEMP) 23261 CONTINUE 23258 CONTINUE IF (.NOT.( DECNFO( TEMP, QDATE, GRP, MEM, PROT, EOF, FREE, FTYPE) *.NE. -3 ))GOTO 23263 CALL AUXFMT( QDATE, FILE, FMT, GRP, MEM, PROT, EOF, FREE, FTYPE, A *UX, DATE) 23263 CONTINUE RETURN END INTEGER FUNCTION GDRPRM( DESC, FILE) LOGICAL*1 FILE(480), TEMP(4) INTEGER I, DESC, J, K INTEGER INDEXX, DFIND, EQUAL LOGICAL*1 DIR(4) INTEGER DFAB LOGICAL*1 DNAM LOGICAL*1 LFILE LOGICAL*1 ST006Z(8) COMMON / CDIREC / DFAB(10), DNAM(480, 10), LFILE(480, 10) DATA DIR(1)/100/,DIR(2)/105/,DIR(3)/114/,DIR(4)/0/ DATA ST006Z(1)/48/,ST006Z(2)/48/,ST006Z(3)/48/,ST006Z(4)/48/,ST006 *Z(5)/48/,ST006Z(6)/48/,ST006Z(7)/47/,ST006Z(8)/0/ 23265 CONTINUE IF (.NOT.( DESC .LT. 1 .OR. DESC .GT. 10 ))GOTO 23268 GDRPRM = -1 GOTO 23269 23268 CONTINUE IF (.NOT.( DFAB(DESC) .EQ. 0 ))GOTO 23270 GDRPRM = -1 GOTO 23271 23270 CONTINUE IF (.NOT.( DFIND( DFAB(DESC), FILE) .EQ. -1 ))GOTO 23272 GDRPRM = -1 GOTO 23273 23272 CONTINUE I = INDEXX( FILE, 93) + 1 IF (.NOT.( I .EQ. 1 ))GOTO 23274 I = INDEXX( FILE, 58) + 1 23274 CONTINUE CALL SCOPY( FILE, I, FILE, 1) CALL FOLD(FILE) IF (.NOT.( EQUAL( FILE, LFILE( 1, DESC) ) .EQ. 1 ))GOTO 23276 GDRPRM=(-1) RETURN 23276 CONTINUE CALL SCOPY( FILE, 1, LFILE( 1, DESC), 1) I = INDEXX( FILE, 59) FILE(I) = 46 I = LENGTH(FILE) IF (.NOT.( FILE(I) .EQ. 49 .AND. FILE( I - 1 ) .EQ. 46 ))GOTO 2327 *8 FILE( I - 1 ) = 0 23278 CONTINUE K = INDEXX( FILE, 46) I = K + 1 J = 1 23280 IF (.NOT.(J .LT. 4 ))GOTO 23282 TEMP(J) = FILE(I) I = I + 1 23281 J = J + 1 GOTO 23280 23282 CONTINUE TEMP(J) = 0 IF (.NOT.( EQUAL( TEMP, DIR) .EQ. 1 ))GOTO 23283 CALL CHCOPY( 47, FILE, K) GOTO 23284 23283 CONTINUE IF (.NOT.( TEMP(1) .EQ. 0 ))GOTO 23285 FILE(K) = 0 23285 CONTINUE 23284 CONTINUE IF (.NOT.( EQUAL( FILE, ST006Z ) .EQ. 1 ))GOTO 23287 GDRPRM = -3 GOTO 23288 23287 CONTINUE GDRPRM = 0 23288 CONTINUE 23273 CONTINUE 23271 CONTINUE 23269 CONTINUE 23266 IF (.NOT.( GDRPRM .NE. -3 ))GOTO 23265 23267 CONTINUE RETURN END SUBROUTINE GENDIR( PATH, OUT) INTEGER I, JUNK, J, K INTEGER GTFTOK LOGICAL*1 PATH(2048), OUT(2048), NODE(480), DEVICE(480) LOGICAL*1 DIRECT(480), TEMP(480) LOGICAL*1 NULL(1) LOGICAL*1 ZZ(7) DATA NULL(1)/0/ DATA ZZ(1)/48/,ZZ(2)/48/,ZZ(3)/48/,ZZ(4)/48/,ZZ(5)/48/,ZZ(6)/48/,Z *Z(7)/0/ I = 2 JUNK = GTFTOK( PATH, I, DEVICE) IF (.NOT.( DEVICE(1) .EQ. 64 ))GOTO 23289 CALL SCOPY( DEVICE, 2, NODE, 1) JUNK = GTFTOK( PATH, I, DEVICE) GOTO 23290 23289 CONTINUE NODE(1) = 0 23290 CONTINUE J = 1 CALL CHCOPY( 91, DIRECT, J) 23291 IF (.NOT.( GTFTOK( PATH, I, TEMP) .GT. 0 ))GOTO 23292 IF (.NOT.( J .GT. 2 ))GOTO 23293 CALL CHCOPY( 46, DIRECT, J) 23293 CONTINUE IF (.NOT.( TEMP(1) .EQ. 37 ))GOTO 23295 K = 2 GOTO 23296 23295 CONTINUE K = 1 23296 CONTINUE CALL STCOPY( TEMP, K, DIRECT, J) GOTO 23291 23292 CONTINUE IF (.NOT.( J .EQ. 2 ))GOTO 23297 CALL STCOPY( ZZ, 1, DIRECT, J) 23297 CONTINUE CALL CHCOPY( 93, DIRECT, J) CALL FGENR8( NODE, DEVICE, DIRECT, NULL, OUT) RETURN END SUBROUTINE GENPNM( PROCES, WAIT, OFFSET) LOGICAL*1 WAIT, BASE(20), LEVEL(4), C, PROCES(2048) LOGICAL*1 TYPE INTEGER N, I, J, JUNK INTEGER INDEXX, CTOI, ITOC, LENGTH LOGICAL*1 L1(3) DATA L1(1)/46/,L1(2)/49/,L1(3)/0/ CALL GETPNM(PROCES) IF (.NOT.( PROCES(1) .EQ. 36 ))GOTO 23299 N = INDEXX( PROCES, 46) IF (.NOT.( N .GT. 0 ))GOTO 23301 I = N + 1 J = CTOI( PROCES, I) + 1 LEVEL(1) = 46 JUNK = ITOC( J, LEVEL(2), 3) PROCES(N) = 0 GOTO 23302 23301 CONTINUE CALL STRCPY( L1, LEVEL) 23302 CONTINUE CALL STRCPY( PROCES, BASE) GOTO 23300 23299 CONTINUE BASE(1) = 36 J = 2 I = 1 23303 IF (.NOT.(PROCES(I) .NE. 0 ))GOTO 23305 C = TYPE( PROCES(I) ) IF (.NOT.( C .EQ. 1 .OR. C .EQ. 2 ))GOTO 23306 BASE(J) = PROCES(I) J = J + 1 23306 CONTINUE 23304 I = I + 1 GOTO 23303 23305 CONTINUE BASE(J) = 0 N = LENGTH(BASE) IF (.NOT.( N .GT. 8 ))GOTO 23308 CALL SCOPY( BASE, N - 6, BASE, 2) 23308 CONTINUE CALL STRCPY( L1, LEVEL) 23300 CONTINUE I = 1 CALL STCOPY( BASE, 1, PROCES, I) IF (.NOT.( WAIT .EQ. 98 ))GOTO 23310 CALL CHCOPY( 38, PROCES, I) JUNK = ITOC( OFFSET, PROCES(I), 3) GOTO 23311 23310 CONTINUE CALL SCOPY( LEVEL, 1, PROCES, I) 23311 CONTINUE RETURN END INTEGER FUNCTION GETARG( N, ARRAY, MAXSIZ) LOGICAL*1 ARRAY(2048) INTEGER N, MAXSIZ INTEGER NBRARG, PTR LOGICAL*1 ARG COMMON /CARG/ NBRARG, PTR(128), ARG(512) IF (.NOT.( N .GE. NBRARG ))GOTO 23312 ARRAY(1) = 0 GETARG = -1 RETURN 23312 CONTINUE J = PTR( N + 1 ) IF (.NOT.( ARG(J) .EQ. 39 .OR. ARG(J) .EQ. 34 ))GOTO 23314 J = J + 1 23314 CONTINUE I = 1 23316 IF (.NOT.(I .LE. MAXSIZ ))GOTO 23318 ARRAY(I) = ARG(J) IF (.NOT.( ARG(J) .EQ. 0 ))GOTO 23319 GOTO 23318 23319 CONTINUE J = J + 1 23317 I = I + 1 GOTO 23316 23318 CONTINUE GETARG = I - 1 ARRAY(I) = 0 RETURN END INTEGER FUNCTION GETAST(VALUE) INTEGER VALUE INTEGER GOTAST COMMON / CAST / GOTAST VALUE = GOTAST GETAST=(GOTAST) RETURN END SUBROUTINE GETBPR(PRIO) INTEGER PRIO INTEGER*2 LIST(8) INTEGER*4 LISTA EQUIVALENCE (LISTA,LIST(3)) DATA LIST/4, 777, 6*0/ LISTA = %LOC(PRIO) CALL SYS$GETJPI(,,,LIST,,,) RETURN END LOGICAL*1 FUNCTION GETCH(C, FD) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS LOGICAL*1 C LOGICAL*1 RGETCH INTEGER FD INTEGER N, COUNT INTEGER GETS, INMAP COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS CHSTAT(FD) = 0 IF (.NOT.( CHTYPE(FD) .NE. 0 ))GOTO 23321 GETCH = RGETCH( C, FD) RETURN 23321 CONTINUE IF (.NOT.( MODE(FD) .NE. 0 ))GOTO 23323 LASTC(FD) = 0 BCOUNT(FD) = 0 MODE(FD) = 0 23323 CONTINUE IF (.NOT.( LASTC(FD) .GE. BCOUNT(FD) .OR. LASTC(FD) .GE. 2048 ))GO *TO 23325 COUNT = GETS( FDB(FD), BUFFER( 1, FD), 2047) IF (.NOT.( COUNT .LT. 0 ))GOTO 23327 C = -1 CHSTAT(FD) = -1 GETCH=(C) RETURN 23327 CONTINUE IF (.NOT.( IMP_CTRL(FD) .GT. 0 ))GOTO 23329 COUNT = COUNT + 1 BUFFER( COUNT, FD) = 10 23329 CONTINUE BCOUNT(FD) = COUNT LASTC(FD) = 0 23325 CONTINUE LASTC(FD) = LASTC(FD) + 1 N = LASTC(FD) C = BUFFER( N, FD) GETCH=(C) RETURN END INTEGER FUNCTION GETDCL(LIN) LOGICAL*1 LIN(512) INTEGER DESC(2), STRLEN, STATUS INTEGER LIB$GET_FOREIGN DESC(1) = 512 - 3 DESC(2) = %LOC(LIN) STATUS = LIB$GET_FOREIGN( DESC, , STRLEN) LIN(STRLEN+1) = 0 GETDCL=(STRLEN) RETURN END SUBROUTINE GETDIR( KEY, TYPE, BUF) INTEGER JUNK, KEY, TYPE INTEGER TRNLOG LOGICAL*1 BUF(2048), TEMP(480) LOGICAL*1 ST_BIN(7) LOGICAL*1 ST_USR(7) LOGICAL*1 ST_TMP(7) LOGICAL*1 ST_LPR(7) LOGICAL*1 ST_MSG(7) LOGICAL*1 ST_SRC(7) LOGICAL*1 ST_MAN(7) LOGICAL*1 ST_INC(7) LOGICAL*1 ST_LIB(7) DATA ST_BIN(1)/83/,ST_BIN(2)/84/,ST_BIN(3)/95/,ST_BIN(4)/66/,ST_BI *N(5)/73/,ST_BIN(6)/78/,ST_BIN(7)/0/ DATA ST_USR(1)/83/,ST_USR(2)/84/,ST_USR(3)/95/,ST_USR(4)/85/,ST_US *R(5)/83/,ST_USR(6)/82/,ST_USR(7)/0/ DATA ST_TMP(1)/83/,ST_TMP(2)/84/,ST_TMP(3)/95/,ST_TMP(4)/84/,ST_TM *P(5)/77/,ST_TMP(6)/80/,ST_TMP(7)/0/ DATA ST_LPR(1)/83/,ST_LPR(2)/84/,ST_LPR(3)/95/,ST_LPR(4)/76/,ST_LP *R(5)/80/,ST_LPR(6)/82/,ST_LPR(7)/0/ DATA ST_MSG(1)/83/,ST_MSG(2)/84/,ST_MSG(3)/95/,ST_MSG(4)/77/,ST_MS *G(5)/83/,ST_MSG(6)/71/,ST_MSG(7)/0/ DATA ST_SRC(1)/83/,ST_SRC(2)/84/,ST_SRC(3)/95/,ST_SRC(4)/83/,ST_SR *C(5)/82/,ST_SRC(6)/67/,ST_SRC(7)/0/ DATA ST_MAN(1)/83/,ST_MAN(2)/84/,ST_MAN(3)/95/,ST_MAN(4)/77/,ST_MA *N(5)/65/,ST_MAN(6)/78/,ST_MAN(7)/0/ DATA ST_INC(1)/83/,ST_INC(2)/84/,ST_INC(3)/95/,ST_INC(4)/73/,ST_IN *C(5)/78/,ST_INC(6)/67/,ST_INC(7)/0/ DATA ST_LIB(1)/83/,ST_LIB(2)/84/,ST_LIB(3)/95/,ST_LIB(4)/76/,ST_LI *B(5)/73/,ST_LIB(6)/66/,ST_LIB(7)/0/ IF (.NOT.( KEY .EQ. 1 ))GOTO 23331 JUNK = TRNLOG( ST_BIN, TEMP) GOTO 23332 23331 CONTINUE IF (.NOT.( KEY .EQ. 2 ))GOTO 23333 JUNK = TRNLOG( ST_USR, TEMP) GOTO 23334 23333 CONTINUE IF (.NOT.( KEY .EQ. 3 ))GOTO 23335 JUNK = TRNLOG( ST_TMP, TEMP) GOTO 23336 23335 CONTINUE IF (.NOT.( KEY .EQ. 4 ))GOTO 23337 JUNK = TRNLOG( ST_LPR, TEMP) GOTO 23338 23337 CONTINUE IF (.NOT.( KEY .EQ. 5 ))GOTO 23339 JUNK = TRNLOG( ST_MSG, TEMP) GOTO 23340 23339 CONTINUE IF (.NOT.( KEY .EQ. 6 ))GOTO 23341 JUNK = TRNLOG( ST_MAN, TEMP) GOTO 23342 23341 CONTINUE IF (.NOT.( KEY .EQ. 7 ))GOTO 23343 JUNK = TRNLOG( ST_SRC, TEMP) GOTO 23344 23343 CONTINUE IF (.NOT.( KEY .EQ. 8 ))GOTO 23345 JUNK = TRNLOG( ST_INC, TEMP) GOTO 23346 23345 CONTINUE IF (.NOT.( KEY .EQ. 9 ))GOTO 23347 JUNK = TRNLOG( ST_LIB, TEMP) GOTO 23348 23347 CONTINUE TEMP(1) = 0 23348 CONTINUE 23346 CONTINUE 23344 CONTINUE 23342 CONTINUE 23340 CONTINUE 23338 CONTINUE 23336 CONTINUE 23334 CONTINUE 23332 CONTINUE CALL FOLD(TEMP) IF (.NOT.( TYPE .EQ. 5 ))GOTO 23349 CALL CVT_DTOP( TEMP, BUF) GOTO 23350 23349 CONTINUE CALL STRCPY( TEMP, BUF) 23350 CONTINUE RETURN END INTEGER FUNCTION GETFDB(FD) INTEGER FD INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23351 GETFDB=(FDB(FD)) RETURN 23351 CONTINUE GETFDB=(-3) RETURN 23352 CONTINUE END SUBROUTINE GETIMG(IMAGE) LOGICAL*1 IMAGE(2048), LOCAL(480) INTEGER*2 JPIBUF(8), LENGTH INTEGER ADDR, LENG EQUIVALENCE (ADDR,JPIBUF(3)), (LENG, JPIBUF(5)) DATA JPIBUF /480, 519, 6*0/ ADDR = %LOC(LOCAL) LENG = %LOC(LENGTH) CALL SYS$GETJPI(,,,JPIBUF,,,) LOCAL(LENGTH+1) = 0 CALL FOLD(LOCAL) CALL SCOPY(LOCAL, 1, IMAGE, 1) RETURN END INTEGER FUNCTION GETLIN(LINE, FD) LOGICAL*1 LINE(2048) INTEGER FD INTEGER I INTEGER GETS LOGICAL*1 GETCH INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( CHTYPE(FD) .EQ. 0 .AND. ( LASTC(FD) .NE. 0 .OR. IMP_CTR *L(FD) .EQ. 0 ) ))GOTO 23353 I = 1 23355 CONTINUE IF (.NOT.( GETCH( LINE(I), FD) .EQ. 10 ))GOTO 23358 LINE( I + 1 ) = 0 GETLIN = I RETURN 23358 CONTINUE IF (.NOT.( LINE(I) .EQ. -1 ))GOTO 23360 GETLIN = -1 LINE(I) = 0 CHSTAT(FD) = -1 RETURN 23360 CONTINUE IF (.NOT.( I .GE. 2048 - 1 ))GOTO 23362 LINE( I + 1 ) = 0 GETLIN = I RETURN 23362 CONTINUE 23356 I = I + 1 GOTO 23355 23357 CONTINUE GOTO 23354 23353 CONTINUE IF (.NOT.( MODE(FD) .NE. 0 ))GOTO 23364 MODE(FD) = 0 23364 CONTINUE LASTC(FD) = 0 BCOUNT(FD) = 0 I = GETS( FDB(FD), LINE, 2047) IF (.NOT.( I .LT. 0 ))GOTO 23366 LINE(1) = 0 GETLIN = -1 CHSTAT(FD) = -1 GOTO 23367 23366 CONTINUE IF (.NOT.( I .LT. 2047 ))GOTO 23368 IF (.NOT.( IMP_CTRL(FD) .GT. 0 ))GOTO 23370 I = I + 1 LINE(I) = 10 23370 CONTINUE LINE( I + 1 ) = 0 GETLIN = I GOTO 23369 23368 CONTINUE LINE(2048) = 0 GETLIN = 2047 23369 CONTINUE 23367 CONTINUE 23354 CONTINUE RETURN END INTEGER FUNCTION GETMSG(BUF) INTEGER FD INTEGER DONE, I, JUNK, LEN INTEGER EQUAL, GETDCL, GETLIN, LENGTH, OPEN, TRNLOG LOGICAL*1 BUF(512), PNAME(20), BNAME(20), LIN(2048) LOGICAL*1 DUMMY(3) LOGICAL*1 DCLTOOLS(10) DATA DUMMY(1)/42/,DUMMY(2)/32/,DUMMY(3)/0/ DATA DCLTOOLS(1)/68/,DCLTOOLS(2)/67/,DCLTOOLS(3)/76/,DCLTOOLS(4)/9 *5/,DCLTOOLS(5)/84/,DCLTOOLS(6)/79/,DCLTOOLS(7)/79/,DCLTOOLS(8)/76/ *,DCLTOOLS(9)/83/,DCLTOOLS(10)/0/ DATA DONE / 0 / IF (.NOT.( DONE .EQ. 1 ))GOTO 23372 CALL STRCPY( DUMMY, BUF) GETMSG=( LENGTH(BUF) ) RETURN 23372 CONTINUE DONE = 1 CALL GETPNM(PNAME) JUNK = TRNLOG( DCLTOOLS, BUF) IF (.NOT.( PNAME(1) .NE. 36 .OR. EQUAL( DCLTOOLS, BUF) .EQ. 0 ))GO *TO 23374 CALL GETIMG(LIN) I = INDEXX(LIN, 93) + 1 CALL SCOPY(LIN, I, BUF, 1) I = INDEXX(BUF, 46) CALL CHCOPY(32, BUF, I) JUNK = GETDCL( BUF(I) ) GOTO 23375 23374 CONTINUE CALL ARGGEN( PNAME, BNAME) FD = OPEN( BNAME, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23376 CALL STRCPY( DUMMY, BUF) GOTO 23377 23376 CONTINUE I = GETLIN( BUF, FD) CALL CLOSE(FD) BUF(I) = 0 23377 CONTINUE 23375 CONTINUE GETMSG=( LENGTH(BUF) ) RETURN END SUBROUTINE GETNOW(NOW) INTEGER I, NOW(7) INTEGER*2 WORD(7) CALL SYS$NUMTIM( WORD, ) I = 1 23378 IF (.NOT.(I .LE. 7 ))GOTO 23380 NOW(I) = WORD(I) 23379 I = I + 1 GOTO 23378 23380 CONTINUE RETURN END SUBROUTINE GETOWN( MYPID, OWNID) INTEGER MYPID, OWNID INTEGER*2 OWNER(8) INTEGER*4 OWNERA EQUIVALENCE (OWNERA,OWNER(3)) DATA OWNER / 4, 771, 6*0 / OWNERA = %LOC(OWNID) CALL SYS$GETJPI( , MYPID, , OWNER, , , ) RETURN END INTEGER FUNCTION GETPDB( OFFSET, WAIT) INTEGER OFFSET, START, STOP, INIT, MYPID, OWNPID LOGICAL*1 WAIT INTEGER N4GRND INTEGER SPUNIT INTEGER PDONE INTEGER PMSG INTEGER MBXCHN LOGICAL*1 PID LOGICAL*1 PNAME COMMON / CPROC / N4GRND, SPUNIT, PDONE(8), PMSG(21, 8), MBXCHN(8), * PID(9, 8), PNAME(480, 8) DATA INIT / 1 / IF (.NOT.( INIT .EQ. 1 ))GOTO 23381 CALL GETPID(MYPID) CALL GETOWN( MYPID, OWNPID) INIT = 0 23381 CONTINUE IF (.NOT.( WAIT .EQ. 98 ))GOTO 23383 START = 5 + 1 IF (.NOT.( OWNPID .EQ. 0 ))GOTO 23385 STOP = 8 GOTO 23386 23385 CONTINUE STOP = START - 1 23386 CONTINUE GOTO 23384 23383 CONTINUE START = 1 STOP = 5 23384 CONTINUE CALL SYS$SETAST( %VAL(0) ) OFFSET = START 23387 IF (.NOT.( OFFSET .LE. STOP .AND. PID( 1, OFFSET) .NE. 0 ))GOTO 23 *389 23388 OFFSET = OFFSET + 1 GOTO 23387 23389 CONTINUE CALL SYS$SETAST( %VAL(1) ) IF (.NOT.( OFFSET .LE. STOP ))GOTO 23390 GETPDB=(0) RETURN 23390 CONTINUE GETPDB=(-3) RETURN 23391 CONTINUE END SUBROUTINE GETPID(PID) INTEGER PID INTEGER*2 LIST(8) INTEGER*4 LISTA EQUIVALENCE (LISTA,LIST(3)) DATA LIST / 4, 793, 6*0 / LISTA = %LOC(PID) CALL SYS$GETJPI( , , , LIST, , , ) RETURN END SUBROUTINE GETPNM(PROCES) LOGICAL*1 PROCES(2048), LOCAL(16) INTEGER*2 JPIBUF(8), LENGTH INTEGER ADDR, LENG EQUIVALENCE( ADDR, JPIBUF(3) ), ( LENG, JPIBUF(5) ) DATA JPIBUF / 15, 796, 6*0 / ADDR = %LOC(LOCAL) LENG = %LOC(LENGTH) CALL SYS$GETJPI( , , , JPIBUF, , , ) LOCAL( LENGTH + 1 ) = 0 CALL FOLD(LOCAL) CALL STRCPY( LOCAL, PROCES) RETURN END SUBROUTINE GETPRV(PRIV) INTEGER PRIV(2), JUNK INTEGER SYS$GETJPI INTEGER*2 LIST(8) INTEGER*4 LISTA EQUIVALENCE (LISTA,LIST(3)) DATA LIST / 8, 516, 6*0 / LISTA = %LOC(PRIV) LIST(2) = 516 IF (.NOT.(.NOT. SYS$GETJPI( , , , LIST, , , )))GOTO 23392 LIST(2) = 1042 JUNK = SYS$GETJPI( , , , LIST, , , ) 23392 CONTINUE RETURN END LOGICAL*1 FUNCTION GETRLN( BUF, FD, TRMARA) LOGICAL*1 BUF(2048), C, TRMARA(2048), TRMN8R LOGICAL*1 CMATCH, GETCH INTEGER FD INTEGER I I = 1 23394 IF (.NOT.(I .LT. 2048 ))GOTO 23396 C = GETCH( BUF(I), FD) TRMN8R = CMATCH( C, TRMARA) IF (.NOT.( TRMN8R .NE. 0 ))GOTO 23397 GOTO 23396 23397 CONTINUE CALL PUTCH( C, FD) 23398 CONTINUE 23395 I = I + 1 GOTO 23394 23396 CONTINUE BUF(I) = 0 GETRLN=(TRMN8R) RETURN END INTEGER FUNCTION GETTYP( FD, TYPE) INTEGER FD INTEGER TYPE INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS TYPE = FLTYPE(FD) GETTYP=(TYPE) RETURN END SUBROUTINE GETUIC(UIC) INTEGER*4 UIC, UICA INTEGER*2 JPIBUF(8) EQUIVALENCE( JPIBUF(3), UICA) DATA JPIBUF / 4, 772, 6*0 / UICA = %LOC(UIC) CALL SYS$GETJPI( , , , JPIBUF, , , ) RETURN END SUBROUTINE GTDDEV(DEVICE) LOGICAL*1 DEVICE(2048), SCRAT(480), TEMP(480) LOGICAL*1 ST007Z(10) DATA ST007Z(1)/83/,ST007Z(2)/89/,ST007Z(3)/83/,ST007Z(4)/36/,ST007 *Z(5)/68/,ST007Z(6)/73/,ST007Z(7)/83/,ST007Z(8)/75/,ST007Z(9)/58/,S *T007Z(10)/0/ CALL EXPLOG( ST007Z, SCRAT) CALL PARSEF( SCRAT, TEMP, DEVICE, TEMP, TEMP) CALL FOLD(DEVICE) RETURN END SUBROUTINE GTDFLT( NODE, DEVICE, DIRECT) LOGICAL*1 NODE(2048), DEVICE(2048), DIRECT(2048), TEMP(480) INTEGER I INTEGER INDEXX LOGICAL*1 ST008Z(10) DATA ST008Z(1)/83/,ST008Z(2)/89/,ST008Z(3)/83/,ST008Z(4)/36/,ST008 *Z(5)/68/,ST008Z(6)/73/,ST008Z(7)/83/,ST008Z(8)/75/,ST008Z(9)/58/,S *T008Z(10)/0/ CALL DEFDIR(DIRECT) CALL EXPLOG( ST008Z, TEMP) I = INDEXX(TEMP, 93) IF (.NOT.(I .GT. 0))GOTO 23399 CALL SCOPY(DIRECT, 2, TEMP, I) GOTO 23400 23399 CONTINUE CALL CONCAT(TEMP, DIRECT, TEMP) 23400 CONTINUE CALL PARSEF( TEMP, NODE, DEVICE, DIRECT, TEMP) IF (.NOT.( NODE(1) .EQ. 0 ))GOTO 23401 CALL HOSTNM(NODE) 23401 CONTINUE CALL FOLD(NODE) CALL FOLD(DEVICE) CALL FOLD(DIRECT) RETURN END SUBROUTINE GTDPTH(DIR) LOGICAL*1 DEVICE(480), DIRECT(480) LOGICAL*1 HOST(480), DIR(2048) INTEGER I, J CALL GTDFLT( HOST, DEVICE, DIRECT) DIR(1) = 47 DIR(2) = 64 J = 3 CALL STCOPY( HOST, 1, DIR, J) DIR(J) = 47 J = J + 1 CALL STCOPY( DEVICE, 1, DIR, J) I = 1 23403 IF (.NOT.(DIRECT(I) .NE. 93 .AND. DIRECT(I) .NE. 0 ))GOTO 23405 IF (.NOT.( DIRECT(I) .EQ. 91 .OR. DIRECT(I) .EQ. 46 ))GOTO 23406 DIR(J) = 47 GOTO 23407 23406 CONTINUE DIR(J) = DIRECT(I) 23407 CONTINUE J = J + 1 23404 I = I + 1 GOTO 23403 23405 CONTINUE DIR(J) = 0 RETURN END INTEGER FUNCTION GTMODE(FD) INTEGER FD INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23408 IF (.NOT.( LFN(FD) .NE. 0 ))GOTO 23410 GTMODE=( CHTYPE(FD) ) RETURN 23410 CONTINUE 23408 CONTINUE GTMODE=(-3) RETURN END INTEGER FUNCTION GTSTAT( FD) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS INTEGER FD COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23412 GTSTAT=( CHSTAT( FD)) RETURN 23412 CONTINUE GTSTAT=(-3) RETURN 23413 CONTINUE END SUBROUTINE GTZONE(BUF) LOGICAL*1 BUF(2048), TEMP(480) INTEGER EQUAL, DSTIME INTEGER NOW(7) LOGICAL*1 SEED(12) DATA SEED(1)/83/,SEED(2)/84/,SEED(3)/95/,SEED(4)/84/,SEED(5)/73/,S *EED(6)/77/,SEED(7)/69/,SEED(8)/90/,SEED(9)/79/,SEED(10)/78/,SEED(1 *1)/69/,SEED(12)/0/ CALL TRNLOG(SEED, TEMP) IF (.NOT.(EQUAL(SEED, TEMP) .EQ. 1))GOTO 23414 BUF(1) = 80 GOTO 23415 23414 CONTINUE BUF(1) = TEMP(1) 23415 CONTINUE CALL GETNOW(NOW) IF (.NOT.(DSTIME(NOW) .EQ. 1))GOTO 23416 BUF(2) = 68 GOTO 23417 23416 CONTINUE BUF(2) = 83 23417 CONTINUE BUF(3) = 84 BUF(4) = 0 CALL UPPER(BUF) RETURN END SUBROUTINE GWDIR( BUF, DTYPE) LOGICAL*1 BUF(2048), TEMP(480) INTEGER DTYPE LOGICAL*1 ST009Z(2) DATA ST009Z(1)/47/,ST009Z(2)/0/ CALL GTDPTH(TEMP) CALL CONCAT(TEMP, ST009Z, TEMP) IF (.NOT.( DTYPE .EQ. 6 ))GOTO 23418 CALL MKLOCL( TEMP, BUF) GOTO 23419 23418 CONTINUE CALL MKPATH( TEMP, BUF) 23419 CONTINUE RETURN END SUBROUTINE HOMDIR(HOME, DTYPE) LOGICAL*1 SENDER(50), HOME(2048), BUF(2048) LOGICAL*1 USRFIL(480) INTEGER JUNK, I, FOUND, DTYPE INTEGER OPENF, N, GETS, RAB, INDEXX INTEGER EQUAL, GETWRD CALL MAILID(SENDER) I = INDEXX( SENDER, 32) IF (.NOT.( I .GT. 0 ))GOTO 23420 SENDER(I) = 0 23420 CONTINUE FOUND = 0 CALL ADRFIL(USRFIL) CALL UPPER(USRFIL) IF (.NOT.(OPENF(USRFIL, 0, 0, 1, -1, RAB) .NE. -3))GOTO 23422 23424 CONTINUE N = GETS(RAB, BUF, 2047) IF (.NOT.(N .LT. 0))GOTO 23427 GOTO 23426 23427 CONTINUE BUF(N+1) = 0 I = 1 JUNK = GETWRD(BUF, I, HOME) IF (.NOT.(EQUAL(HOME, SENDER) .EQ. 1))GOTO 23429 JUNK = GETWRD(BUF, I, USRFIL) FOUND = 1 GOTO 23426 23429 CONTINUE 23425 GOTO 23424 23426 CONTINUE CALL CLOSEF(RAB) 23422 CONTINUE IF (.NOT.(FOUND .EQ. 0))GOTO 23431 HOME(1) = 0 GOTO 23432 23431 CONTINUE IF (.NOT.(DTYPE .EQ. 6))GOTO 23433 CALL STRCPY(USRFIL, HOME) GOTO 23434 23433 CONTINUE CALL CVT_DTOP(USRFIL, HOME) 23434 CONTINUE 23432 CONTINUE CALL FOLD(HOME) RETURN END SUBROUTINE HOSTNM(TSTR) LOGICAL*1 TSTR INTEGER JUNK INTEGER TRNLOG LOGICAL*1 ST00AZ(8) DATA ST00AZ(1)/83/,ST00AZ(2)/84/,ST00AZ(3)/95/,ST00AZ(4)/78/,ST00A *Z(5)/79/,ST00AZ(6)/68/,ST00AZ(7)/69/,ST00AZ(8)/0/ JUNK = TRNLOG( ST00AZ, TSTR) CALL FOLD(TSTR) RETURN END INTEGER FUNCTION HTOI(BUF) LOGICAL*1 BUF(2048), TEMP(9) INTEGER N, INT INTEGER LENGTH CALL STRCPY( BUF, TEMP) CALL UPPER(TEMP) N = LENGTH(TEMP) IF (.NOT.( .NOT.LIB$CVT_HTB( %VAL(N), %REF(TEMP), %REF(INT) ) ))GO *TO 23435 HTOI=(-3) RETURN 23435 CONTINUE HTOI=(INT) RETURN 23436 CONTINUE END SUBROUTINE INITST LOGICAL*1 BUF(2048) INTEGER DONE, I, JUNK INTEGER GETARG, ASSIGN, INSUB, OUTSUB, OPEN, TRNLOG, EQUAL INTEGER OUTACC, ERRACC INTEGER NBRARG, PTR LOGICAL*1 ARG INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS INTEGER DESBLK INTEGER REASON EXTERNAL EXITH LOGICAL*1 INPUT(480) LOGICAL*1 OUTPUT(480) LOGICAL*1 ERROUT(480) LOGICAL*1 NEW_VER_LOG_NAM(16) LOGICAL*1 DO_NEW_VERSIONS(4) COMMON /CARG/ NBRARG, PTR(128), ARG(512) COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS COMMON / CEXITH / DESBLK(4), REASON DATA INPUT(1)/83/,INPUT(2)/89/,INPUT(3)/83/,INPUT(4)/36/,INPUT(5)/ *73/,INPUT(6)/78/,INPUT(7)/80/,INPUT(8)/85/,INPUT(9)/84/,INPUT(10)/ *0/ DATA OUTPUT(1)/83/,OUTPUT(2)/89/,OUTPUT(3)/83/,OUTPUT(4)/36/,OUTPU *T(5)/79/,OUTPUT(6)/85/,OUTPUT(7)/84/,OUTPUT(8)/80/,OUTPUT(9)/85/,O *UTPUT(10)/84/,OUTPUT(11)/0/ DATA ERROUT(1)/83/,ERROUT(2)/89/,ERROUT(3)/83/,ERROUT(4)/36/,ERROU *T(5)/69/,ERROUT(6)/82/,ERROUT(7)/82/,ERROUT(8)/79/,ERROUT(9)/82/,E *RROUT(10)/0/ DATA NEW_VER_LOG_NAM(1)/83/,NEW_VER_LOG_NAM(2)/84/,NEW_VER_LOG_NAM *(3)/95/,NEW_VER_LOG_NAM(4)/78/,NEW_VER_LOG_NAM(5)/69/,NEW_VER_LOG_ *NAM(6)/87/,NEW_VER_LOG_NAM(7)/95/,NEW_VER_LOG_NAM(8)/86/,NEW_VER_L *OG_NAM(9)/69/,NEW_VER_LOG_NAM(10)/82/,NEW_VER_LOG_NAM(11)/83/,NEW_ *VER_LOG_NAM(12)/73/,NEW_VER_LOG_NAM(13)/79/,NEW_VER_LOG_NAM(14)/78 */,NEW_VER_LOG_NAM(15)/83/,NEW_VER_LOG_NAM(16)/0/ DATA DO_NEW_VERSIONS(1)/89/,DO_NEW_VERSIONS(2)/69/,DO_NEW_VERSIONS *(3)/83/,DO_NEW_VERSIONS(4)/0/ DATA OUTACC / 2 / DATA ERRACC / 2 / DATA DONE / 0 / IF (.NOT.( DONE .EQ. 1 ))GOTO 23437 RETURN 23437 CONTINUE DONE = 1 NBRARG = 0 DESBLK(2) = %LOC(EXITH) DESBLK(3) = 0 DESBLK(4) = %LOC(REASON) I = 1 23439 IF (.NOT.(I .LE. 15 ))GOTO 23441 LFN(I) = 0 RAWCHN(I) = 0 CHSTAT(I) = 0 CHTIMO(I) = 31557600 23440 I = I + 1 GOTO 23439 23441 CONTINUE JUNK = TRNLOG(NEW_VER_LOG_NAM, TBUF) NEW_VERSIONS = EQUAL(TBUF, DO_NEW_VERSIONS) CALL MAKARG I = 1 23442 IF (.NOT.(I .LT. NBRARG ))GOTO 23444 J = PTR( I + 1 ) CALL SCOPY( ARG, J, BUF, 1) IF (.NOT.( ( INSUB( BUF, INPUT) .EQ. 1 ) .OR. ( OUTSUB( 62, BUF, O *UTPUT, OUTACC) .EQ. 1 ) .OR. ( OUTSUB( 63, BUF, ERROUT, ERRACC) .E *Q. 1 ) ))GOTO 23445 CALL DELARG(I) GOTO 23446 23445 CONTINUE I = I + 1 23446 CONTINUE 23443 GOTO 23442 23444 CONTINUE IF (.NOT.( ASSIGN( ERROUT, 3, ERRACC) .EQ. -3 ))GOTO 23447 type * , 'Cannot open ERROUT.' CALL ENDST(-3) 23447 CONTINUE IF (.NOT.( ASSIGN( INPUT, 1, 1) .EQ. -3 ))GOTO 23449 CALL CANT(INPUT) 23449 CONTINUE IF (.NOT.( ASSIGN( OUTPUT, 2, OUTACC) .EQ. -3 ))GOTO 23451 CALL CANT(OUTPUT) 23451 CONTINUE RETURN END LOGICAL*1 FUNCTION INMAP(C) LOGICAL*1 C INMAP=(C) RETURN END INTEGER FUNCTION INSUB( ARG, FILE) LOGICAL*1 ARG(2048), FILE(2048) IF (.NOT.( ARG(1) .EQ. 60 .AND. ARG(2) .NE. 0 ))GOTO 23453 CALL SCOPY( ARG, 2, FILE, 1) INSUB=(1) RETURN 23453 CONTINUE INSUB=(0) RETURN 23454 CONTINUE END SUBROUTINE INTSRV INTEGER I, JUNK INTEGER KILL INTEGER N4GRND INTEGER SPUNIT INTEGER PDONE INTEGER PMSG INTEGER MBXCHN LOGICAL*1 PID LOGICAL*1 PNAME COMMON / CPROC / N4GRND, SPUNIT, PDONE(8), PMSG(21, 8), MBXCHN(8), * PID(9, 8), PNAME(480, 8) I = 1 23455 IF (.NOT.(I .LE. 5 ))GOTO 23457 IF (.NOT.( PID( 1, I) .NE. 0 .AND. PDONE(I) .EQ. 0 ))GOTO 23458 JUNK = KILL( PID( 1, I) ) 23458 CONTINUE 23456 I = I + 1 GOTO 23455 23457 CONTINUE CALL SETAST(1) CALL ENBINT RETURN END INTEGER FUNCTION ISATTY(FD) INTEGER FD INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( LFN(FD) .EQ. 1 ))GOTO 23460 ISATTY=(1) RETURN 23460 CONTINUE ISATTY=(0) RETURN 23461 CONTINUE END SUBROUTINE ITOCZF( N, TBUF, WIDTH) INTEGER I, M, N, WIDTH INTEGER ITOC LOGICAL*1 TBUF(2048), TEMP(10) M = WIDTH - ITOC( N, TEMP, 10) IF (.NOT.( M .GE. 0 ))GOTO 23462 I = 1 23464 IF (.NOT.(I .LE. M ))GOTO 23466 TBUF(I) = 48 23465 I = I + 1 GOTO 23464 23466 CONTINUE CALL SCOPY( TEMP, 1, TBUF, I) GOTO 23463 23462 CONTINUE I = 1 - M CALL SCOPY( TEMP, I, TBUF, 1) 23463 CONTINUE RETURN END INTEGER FUNCTION KILL(PRCID) LOGICAL*1 PRCID(9) INTEGER EXIT_STAT, PID, STATUS INTEGER HTOI, SYS$FORCEX DATA EXIT_STAT / 101 / PID = HTOI(PRCID) STATUS = SYS$FORCEX( PID, , %VAL(EXIT_STAT) ) IF (.NOT.( .NOT. STATUS ))GOTO 23467 KILL=(-3) RETURN 23467 CONTINUE KILL=(0) RETURN 23468 CONTINUE END INTEGER FUNCTION LOCCOM( COMAND, SPATH, SUFFIX, PATH) LOGICAL*1 COMAND(2048), SPATH(2048), PATH(2048), TEMP(480) LOGICAL*1 SUFFIX(2048) INTEGER I, J, N, TYPE INTEGER FLFIND, INDEXX, LENGTH I = 1 23469 IF (.NOT.(SPATH(I) .NE. 10 ))GOTO 23471 CALL CONCAT( SPATH(I), COMAND, TEMP) N = LENGTH(TEMP) + 1 IF (.NOT.( INDEXX( COMAND, 46) .GT. 0 ))GOTO 23472 IF (.NOT.( FLFIND( TEMP, PATH, TYPE) .NE. -3 ))GOTO 23474 LOCCOM=(TYPE) RETURN 23474 CONTINUE GOTO 23473 23472 CONTINUE J = 1 23476 IF (.NOT.(SUFFIX(J) .NE. 10 ))GOTO 23478 CALL SCOPY( SUFFIX, J, TEMP, N) IF (.NOT.( FLFIND( TEMP, PATH, TYPE) .NE. -3 ))GOTO 23479 LOCCOM=(TYPE) RETURN 23479 CONTINUE 23477 J = J + LENGTH( SUFFIX(J) ) + 1 GOTO 23476 23478 CONTINUE 23473 CONTINUE 23470 I = I + LENGTH( SPATH(I) ) + 1 GOTO 23469 23471 CONTINUE CALL STRCPY( COMAND, PATH) LOCCOM=(-3) RETURN END SUBROUTINE MAILID(SENDER) LOGICAL*1 SENDER(2048) LOGICAL*1 BUF(2048), OUT(480) INTEGER RAB, N, JUNK INTEGER OPENF, GETS, GETWRD, EQUAL, INDEXX, LENGTH INTEGER*2 JPIBUF(8) INTEGER I, USERA LOGICAL*1 BLKLP(3) EQUIVALENCE( USERA, JPIBUF(3) ) DATA BLKLP(1)/32/,BLKLP(2)/40/,BLKLP(3)/0/ DATA JPIBUF / 12, 514, 6*0 / I = 1 23481 IF (.NOT.(I .LE. 12 ))GOTO 23483 SENDER(I) = 32 23482 I = I + 1 GOTO 23481 23483 CONTINUE USERA = %LOC(SENDER) CALL SYS$GETJPI( , , , JPIBUF, , , ) I = 12 23484 IF (.NOT.(I .GT. 0 ))GOTO 23486 IF (.NOT.( SENDER(I) .NE. 32 ))GOTO 23487 GOTO 23486 23487 CONTINUE 23485 I = I - 1 GOTO 23484 23486 CONTINUE SENDER( I + 1 ) = 0 CALL FOLD(SENDER) CALL ADRFIL(BUF) IF (.NOT.(OPENF(BUF, 0, 0, 1, -1, RAB) .NE. -3))GOTO 23489 23491 CONTINUE N = GETS(RAB, BUF, 2047) IF (.NOT.(N .LT. 0))GOTO 23494 GOTO 23493 23494 CONTINUE BUF(N+1) = 0 I = 1 JUNK = GETWRD(BUF, I, OUT) IF (.NOT.(EQUAL(OUT, SENDER) .EQ. 1))GOTO 23496 I = INDEXX(BUF, 34) IF (.NOT.(I .GT. 0))GOTO 23498 N = LENGTH(SENDER) + 1 CALL STCOPY(BLKLP, 1, SENDER, N) I=I+1 23500 IF (.NOT.(BUF(I) .NE. 0))GOTO 23502 IF (.NOT.(BUF(I) .EQ. 34))GOTO 23503 GOTO 23502 23503 CONTINUE CALL CHCOPY(BUF(I), SENDER, N) 23501 I=I+1 GOTO 23500 23502 CONTINUE CALL CHCOPY(41, SENDER, N) 23498 CONTINUE GOTO 23493 23496 CONTINUE 23492 GOTO 23491 23493 CONTINUE CALL CLOSEF(RAB) 23489 CONTINUE RETURN END SUBROUTINE MAKARG INTEGER NBRARG, PTR LOGICAL*1 ARG INTEGER IEND, J, TOG INTEGER GETMSG COMMON /CARG/ NBRARG, PTR(128), ARG(512) IEND = GETMSG(ARG) NBRARG = 0 J = 1 I = 1 23505 IF (.NOT.(I .LE. 128 ))GOTO 23507 IF (.NOT.( J .LE. IEND ))GOTO 23508 CALL SKIPBL( ARG, J) 23508 CONTINUE IF (.NOT.( J .GT. IEND ))GOTO 23510 GOTO 23507 23510 CONTINUE PTR(I) = J IF (.NOT.( ARG(J) .EQ. 39 .OR. ARG(J) .EQ. 34 ))GOTO 23512 TOG = ARG(J) J = J + 1 23514 IF (.NOT.(ARG(J) .NE. TOG .AND. ARG(J) .NE. 0 ))GOTO 23516 23515 J = J + 1 GOTO 23514 23516 CONTINUE GOTO 23513 23512 CONTINUE 23517 IF (.NOT.( ARG(J) .NE. 32 .AND. ARG(J) .NE. 0 ))GOTO 23518 J = J + 1 GOTO 23517 23518 CONTINUE 23513 CONTINUE ARG(J) = 0 J = J + 1 23506 I = I + 1 GOTO 23505 23507 CONTINUE NBRARG = I - 1 RETURN END SUBROUTINE MKLOCL( IN, OUT) INTEGER DEPTH, I, JUNK, PTR(10) INTEGER GTFTOK LOGICAL*1 IN(2048), OUT(2048), PATH(480), TEMP(480) LOGICAL*1 LSTCHR CALL MKPATH( IN, PATH) CALL EXPPTH( PATH, DEPTH, PTR, OUT) IF (.NOT.(LSTCHR(PATH) .NE. 47))GOTO 23519 I = PTR(DEPTH) PATH(I) = 0 PTR(DEPTH) = PTR(DEPTH) + 1 CALL GENDIR( PATH, OUT) I = PTR(DEPTH) JUNK = GTFTOK( PATH, I, TEMP) CALL CONCAT( OUT, TEMP, OUT) GOTO 23520 23519 CONTINUE CALL GENDIR(PATH, OUT) 23520 CONTINUE RETURN END SUBROUTINE MKPATH( IN, PATH) LOGICAL*1 IN(2048), PATH(2048), TEMP(480) INTEGER LOCAL, I INTEGER INDEXX LOGICAL*1 DECSEP(4) DATA DECSEP(1)/58/,DECSEP(2)/91/,DECSEP(3)/93/,DECSEP(4)/0/ LOCAL = 0 I = 1 23521 IF (.NOT.(DECSEP(I) .NE. 0 ))GOTO 23523 IF (.NOT.( INDEXX( IN, DECSEP(I)) .GT. 0 ))GOTO 23524 LOCAL = 1 GOTO 23523 23524 CONTINUE 23522 I = I + 1 GOTO 23521 23523 CONTINUE IF (.NOT.( LOCAL .EQ. 1 ))GOTO 23526 CALL CVT_DTOP( IN, TEMP) GOTO 23527 23526 CONTINUE CALL STRCPY( IN, TEMP) 23527 CONTINUE CALL RESDEF( TEMP, PATH) CALL STR_HOST( PATH, TEMP) RETURN END INTEGER FUNCTION NOTE(ADDR, FD) INTEGER FD INTEGER ADDR(2) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS CALL MARK( FDB(FD), ADDR(1), ADDR(2) ) NOTE=(0) RETURN END INTEGER FUNCTION NXTLUN(FD) INTEGER FD INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS FD = 1 23528 IF (.NOT.(FD .LE. 15 ))GOTO 23530 IF (.NOT.( LFN(FD) .EQ. 0 ))GOTO 23531 GOTO 23530 23531 CONTINUE 23529 FD = FD + 1 GOTO 23528 23530 CONTINUE IF (.NOT.( FD .GT. 15 ))GOTO 23533 FD = -3 23533 CONTINUE NXTLUN=(FD) RETURN END INTEGER FUNCTION OPEN( FIL, ACCESS) LOGICAL*1 FIL(2048) INTEGER FD INTEGER CRE8AT, NXTLUN INTEGER ACCESS INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( NXTLUN(FD) .EQ. -3 ))GOTO 23535 OPEN=(-3) RETURN 23535 CONTINUE OPEN=( CRE8AT( FIL, ACCESS, FD, -1)) RETURN 23536 CONTINUE END INTEGER FUNCTION OPENA( FIL, FD, ACCESS, AGE) LOGICAL*1 FIL(2048) INTEGER FD INTEGER OPENF INTEGER ACCESS, AGE INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS OPENA = OPENF( FIL, 0, 0, 4, AGE, FDB(FD) ) IF (.NOT.( OPENA .NE. -3 ))GOTO 23537 LASTC(FD) = 0 MODE(FD) = 1 23537 CONTINUE RETURN END INTEGER FUNCTION OPENDR( DIRECT, DESC) LOGICAL*1 DIRECT(480), TEMP(480) INTEGER DESC INTEGER N INTEGER DOPEN, LENGTH EXTERNAL DIR_INIT INTEGER DFAB LOGICAL*1 DNAM LOGICAL*1 LFILE LOGICAL*1 STARS(6) COMMON / CDIREC / DFAB( 10), DNAM(480, 10), LFILE(480, 10) DATA STARS(1)/42/,STARS(2)/46/,STARS(3)/42/,STARS(4)/59/,STARS(5)/ *42/,STARS(6)/0/ DESC = 1 23539 IF (.NOT.(DESC .LE. 10 ))GOTO 23541 IF (.NOT.( DFAB(DESC) .EQ. 0 ))GOTO 23542 GOTO 23541 23542 CONTINUE 23540 DESC = DESC + 1 GOTO 23539 23541 CONTINUE IF (.NOT.( DESC .GT. 10 ))GOTO 23544 DESC = -3 GOTO 23545 23544 CONTINUE CALL MKPATH( DIRECT, TEMP) CALL GENDIR( TEMP, DNAM( 1, DESC) ) CALL CONCAT( DNAM( 1, DESC), STARS, TEMP) CALL UPPER(TEMP) N = LENGTH(TEMP) IF (.NOT.( DOPEN( TEMP, N, DFAB(DESC) ) .EQ. -3 ))GOTO 23546 DFAB(DESC) = 0 DESC = -3 GOTO 23547 23546 CONTINUE LFILE( 1, DESC) = 0 23547 CONTINUE 23545 CONTINUE OPENDR=(DESC) RETURN END BLOCK DATA DIR_INIT INTEGER DFAB LOGICAL*1 DNAM LOGICAL*1 LFILE COMMON / CDIREC / DFAB( 10), DNAM(480, 10), LFILE(480, 10) DATA DFAB / 10*0 / END INTEGER FUNCTION OPENN( FIL, FD, ACCESS) LOGICAL*1 FIL(2048) INTEGER FD INTEGER ACCESS INTEGER OPENF INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS OPENN = OPENF( FIL, 0, 0, 3, 1, FDB(FD) ) IF (.NOT.( OPENN .NE. -3 ))GOTO 23548 LASTC(FD) = 0 MODE(FD) = 1 23548 CONTINUE RETURN END INTEGER FUNCTION OPENP( FIL, FD, ACCESS) LOGICAL*1 FIL(480) INTEGER FD INTEGER ACCESS INTEGER OPENF INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS OPENP = OPENF( FIL, 0, 1, 2, 1, FDB(FD) ) IF (.NOT.( OPENP .NE. -3 ))GOTO 23550 LASTC(FD) = 0 MODE(FD) = 1 23550 CONTINUE RETURN END INTEGER FUNCTION OPENR( FIL, FD, ACCESS) LOGICAL*1 FIL(2048) INTEGER FD INTEGER ACCESS INTEGER OPENF INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS OPENR = OPENF( FIL, 0, 0, 1, -1, FDB(FD) ) IF (.NOT.( OPENR .NE. -3 ))GOTO 23552 LASTC(FD) = 0 BCOUNT(FD) = 0 MODE(FD) = 0 23552 CONTINUE RETURN END INTEGER FUNCTION OPENS(FIL, FD, ACCESS) LOGICAL*1 FIL(2048) INTEGER FD INTEGER ACCESS INTEGER OPENF INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS OPENS = OPENF( FIL, 0, 0, 3, 0, FDB(FD) ) IF (.NOT.( OPENS .NE. -3 ))GOTO 23554 LASTC(FD) = 0 MODE(FD) = 1 23554 CONTINUE RETURN END INTEGER FUNCTION OPENW( FIL, FD, ACCESS, AGE) LOGICAL*1 FIL(2048) INTEGER FD INTEGER ACC, ACCESS, FILTYP, AGE, LOCAL_AGE INTEGER OPENF INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( ACCESS .EQ. 6 ))GOTO 23556 ACC = 2 FILTYP = 1 GOTO 23557 23556 CONTINUE ACC = ACCESS FILTYP = 0 23557 CONTINUE IF (.NOT.(AGE .EQ. 0 .AND. NEW_VERSIONS .EQ. 1 .AND. ACCESS .NE. 3 *))GOTO 23558 LOCAL_AGE = 1 GOTO 23559 23558 CONTINUE LOCAL_AGE = AGE 23559 CONTINUE OPENW = OPENF( FIL, FILTYP, 0, ACC, LOCAL_AGE, FDB(FD) ) IF (.NOT.( OPENW .NE. -3 ))GOTO 23560 LASTC(FD) = 0 MODE(FD) = 1 IF (.NOT.( ACC .EQ. 3 ))GOTO 23562 BCOUNT(FD) = 0 23562 CONTINUE 23560 CONTINUE RETURN END LOGICAL*1 FUNCTION OUTMAP(C) LOGICAL*1 C OUTMAP=(C) RETURN END INTEGER FUNCTION OUTSUB(C, ARG, FILE, ACCESS) LOGICAL*1 ARG(2048), C, FILE(2048) INTEGER ACCESS, I IF (.NOT.( ARG(1) .EQ. C ))GOTO 23564 IF (.NOT.( ARG(2) .EQ. C ))GOTO 23566 IF (.NOT.( ARG(3) .NE. 0 ))GOTO 23568 ACCESS = 4 CALL SCOPY( ARG, 3, FILE, 1) OUTSUB=(1) RETURN 23568 CONTINUE GOTO 23567 23566 CONTINUE IF (.NOT.( ARG(2) .NE. 0 ))GOTO 23570 ACCESS = 2 CALL SCOPY( ARG, 2, FILE, 1) OUTSUB=(1) RETURN 23570 CONTINUE 23567 CONTINUE 23564 CONTINUE OUTSUB=(0) RETURN END SUBROUTINE PARSEF( IN, NODE, DEVICE, DIRECT, FILE) LOGICAL*1 IN(2048), NODE(2048), DEVICE(2048), DIRECT(2048), FILE(2 *048) INTEGER START, STOP INTEGER INDEXX START = 1 STOP = START + INDEXX( IN(START), 58) - 1 IF (.NOT.( STOP .GE. START .AND. IN( STOP + 1 ) .EQ. 58 ))GOTO 235 *72 CALL COPYIT( IN, START, STOP - 1, NODE) START = STOP + 2 STOP = START + INDEXX( IN(START), 58) - 1 GOTO 23573 23572 CONTINUE NODE(1) = 0 23573 CONTINUE IF (.NOT.( STOP .GE. START ))GOTO 23574 CALL COPYIT( IN, START, STOP - 1, DEVICE) START = STOP + 1 GOTO 23575 23574 CONTINUE DEVICE(1) = 0 23575 CONTINUE IF (.NOT.( IN(START) .EQ. 91 ))GOTO 23576 STOP = START + INDEXX( IN(START), 93) - 1 IF (.NOT.( STOP .LT. START ))GOTO 23578 STOP = START 23578 CONTINUE CALL COPYIT( IN, START, STOP, DIRECT) START = STOP + 1 GOTO 23577 23576 CONTINUE DIRECT(1) = 0 23577 CONTINUE CALL SCOPY( IN, START, FILE, 1) RETURN END INTEGER FUNCTION PGFLTS(START) INTEGER PGF, PGFBUF, START INTEGER*2 JPIBUF(8) EQUIVALENCE( PGFBUF, JPIBUF(3) ) DATA JPIBUF / 4, 1034, 6*0 / PGFBUF = %LOC(PGF) CALL SYS$GETJPI( , , , JPIBUF, , , ) PGFLTS=( PGF - START ) RETURN END SUBROUTINE PRCDON INTEGER J, PTR INTEGER EQUAL LOGICAL*1 BUF(9) INTEGER N4GRND INTEGER SPUNIT INTEGER PDONE INTEGER PMSG INTEGER MBXCHN LOGICAL*1 PID LOGICAL*1 PNAME INTEGER TERMBX INTEGER IOSB INTEGER TERMSG LOGICAL*1 ST00BZ(20) LOGICAL*1 ST00CZ(12) LOGICAL*1 ST00DZ(30) LOGICAL*1 ST00EZ(14) COMMON / CPROC / N4GRND, SPUNIT, PDONE(8), PMSG(21, 8), MBXCHN(8), * PID(9, 8), PNAME(480, 8) COMMON / CTRMBX / TERMBX, IOSB(2), TERMSG(21) DATA ST00BZ(1)/98/,ST00BZ(2)/97/,ST00BZ(3)/99/,ST00BZ(4)/107/,ST00 *BZ(5)/103/,ST00BZ(6)/114/,ST00BZ(7)/111/,ST00BZ(8)/117/,ST00BZ(9)/ *110/,ST00BZ(10)/100/,ST00BZ(11)/32/,ST00BZ(12)/112/,ST00BZ(13)/114 */,ST00BZ(14)/111/,ST00BZ(15)/99/,ST00BZ(16)/101/,ST00BZ(17)/115/,S *T00BZ(18)/115/,ST00BZ(19)/32/,ST00BZ(20)/0/ DATA ST00CZ(1)/32/,ST00CZ(2)/116/,ST00CZ(3)/101/,ST00CZ(4)/114/,ST *00CZ(5)/109/,ST00CZ(6)/105/,ST00CZ(7)/110/,ST00CZ(8)/97/,ST00CZ(9) */116/,ST00CZ(10)/101/,ST00CZ(11)/100/,ST00CZ(12)/0/ DATA ST00DZ(1)/32/,ST00DZ(2)/97/,ST00DZ(3)/98/,ST00DZ(4)/110/,ST00 *DZ(5)/111/,ST00DZ(6)/114/,ST00DZ(7)/109/,ST00DZ(8)/97/,ST00DZ(9)/1 *08/,ST00DZ(10)/108/,ST00DZ(11)/121/,ST00DZ(12)/46/,ST00DZ(13)/32/, *ST00DZ(14)/82/,ST00DZ(15)/101/,ST00DZ(16)/116/,ST00DZ(17)/117/,ST0 *0DZ(18)/114/,ST00DZ(19)/110/,ST00DZ(20)/32/,ST00DZ(21)/115/,ST00DZ *(22)/116/,ST00DZ(23)/97/,ST00DZ(24)/116/,ST00DZ(25)/117/,ST00DZ(26 *)/115/,ST00DZ(27)/32/,ST00DZ(28)/61/,ST00DZ(29)/32/,ST00DZ(30)/0/ DATA ST00EZ(1)/32/,ST00EZ(2)/115/,ST00EZ(3)/117/,ST00EZ(4)/99/,ST0 *0EZ(5)/99/,ST00EZ(6)/101/,ST00EZ(7)/115/,ST00EZ(8)/115/,ST00EZ(9)/ *102/,ST00EZ(10)/117/,ST00EZ(11)/108/,ST00EZ(12)/108/,ST00EZ(13)/12 *1/,ST00EZ(14)/0/ PTR = 0 CALL PUTHEX( IOSB(2), BUF) J = 1 23580 IF (.NOT.(J .LE. 8 .AND. PTR .EQ. 0 ))GOTO 23582 IF (.NOT.( EQUAL( PID( 1, J), BUF) .EQ. 1 ))GOTO 23583 PTR = J 23583 CONTINUE 23581 J = J + 1 GOTO 23580 23582 CONTINUE IF (.NOT.( PTR .NE. 0 ))GOTO 23585 PDONE(PTR) = 1 J = 1 23587 IF (.NOT.(J .LE. 21 ))GOTO 23589 PMSG( J, PTR) = TERMSG(J) 23588 J = J + 1 GOTO 23587 23589 CONTINUE IF (.NOT.( PTR .LE. 5 .AND. N4GRND .GT. 0 ))GOTO 23590 N4GRND = N4GRND - 1 23590 CONTINUE 23585 CONTINUE IF (.NOT.( N4GRND .LE. 0 ))GOTO 23592 J = 5 + 1 23594 IF (.NOT.(J .LE. 8 ))GOTO 23596 IF (.NOT.( PDONE(J) .EQ. 1 .AND. PID( 1, J) .NE. 0 ))GOTO 23597 IF (.NOT.(SPUNIT .NE. -3))GOTO 23599 CALL PUTLIN( ST00BZ, SPUNIT) CALL PUTLIN( PID( 1, J), SPUNIT) CALL PUTLIN( ST00CZ, SPUNIT) IF (.NOT.( .NOT. PMSG( 2, J) .AND. PMSG( 2, J) .NE. 0 ))GOTO 23601 CALL PUTLIN( ST00DZ, SPUNIT) CALL PUTHEX( PMSG( 2, J), BUF) CALL PUTLIN( BUF, SPUNIT) GOTO 23602 23601 CONTINUE CALL PUTLIN( ST00EZ, SPUNIT) 23602 CONTINUE CALL PUTCH( 10, SPUNIT) 23599 CONTINUE CALL PUTPDB(J) 23597 CONTINUE 23595 J = J + 1 GOTO 23594 23596 CONTINUE 23592 CONTINUE CALL RDTMBX RETURN END INTEGER FUNCTION PROMPT( PBUF, LINE, IN) LOGICAL*1 BUF(2048), LINE(2048), PBUF(2048) INTEGER IN, OUT INTEGER I, N INTEGER CREATE, GETLIN, LENGTH, RDPMPT INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS LOGICAL*1 TERM(3) LOGICAL*1 CRLF(3) LOGICAL*1 UNDER(2) COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS DATA TERM(1)/84/,TERM(2)/84/,TERM(3)/0/ DATA CRLF(1)/13/,CRLF(2)/10/,CRLF(3)/0/ DATA UNDER(1)/95/,UNDER(2)/0/ IF (.NOT.( LFN(IN) .EQ. 1 .AND. PBUF(1) .NE. 0 ))GOTO 23603 N = LENGTH(PBUF) 23605 IF (.NOT.(N .GT. 0 ))GOTO 23607 IF (.NOT.( PBUF(N) .EQ. 10 ))GOTO 23608 GOTO 23607 23608 CONTINUE 23606 N = N - 1 GOTO 23605 23607 CONTINUE IF (.NOT.( N .GT. 0 ))GOTO 23610 I = 1 23612 IF (.NOT.(I .LE. N ))GOTO 23614 BUF(I) = PBUF(I) 23613 I = I + 1 GOTO 23612 23614 CONTINUE BUF(I) = 0 OUT = CREATE( TERM, 2) IF (.NOT.( OUT .NE. -3 ))GOTO 23615 CALL PUTLIN( BUF, OUT) CALL CLOSE(OUT) 23615 CONTINUE 23610 CONTINUE N = N + 1 I = 1 CALL STCOPY( CRLF, 1, BUF, I) CALL STRCPY( PBUF(N), BUF(I) ) GOTO 23604 23603 CONTINUE BUF(1) = 0 23604 CONTINUE N = 1 23617 CONTINUE IF (.NOT.( BUF(1) .EQ. 0 ))GOTO 23620 I = GETLIN( LINE(N), IN) GOTO 23621 23620 CONTINUE I = RDPMPT( FDB(IN), BUF, LENGTH(BUF), LINE(N), 2047 - N ) BUF(3) = PBUF(1) CALL STRCPY( UNDER, BUF(4) ) 23621 CONTINUE IF (.NOT.( I .LT. 0 ))GOTO 23622 PROMPT=(-1) RETURN 23622 CONTINUE N = N + I IF (.NOT.( N .LE. 2 ))GOTO 23624 GOTO 23619 23624 CONTINUE IF (.NOT.( LINE( N - 2 ) .NE. 64 ))GOTO 23626 GOTO 23619 23626 CONTINUE N = N - 1 LINE( N - 1 ) = 32 23618 GOTO 23617 23619 CONTINUE PROMPT=( N - 1 ) RETURN END INTEGER FUNCTION PSTAT(BUF) LOGICAL*1 BUF(9) INTEGER ASTATE, PID, STATE, STATUS INTEGER HTOI, SYS$GETJPI INTEGER*2 JPIBUF(8) EQUIVALENCE( ASTATE, JPIBUF(3) ) DATA JPIBUF / 4, 774, 6*0 / ASTATE = %LOC(STATE) PID = HTOI(BUF) STATUS = SYS$GETJPI( , PID, , JPIBUF, , , ) IF (.NOT.( .NOT. STATUS ))GOTO 23628 PSTAT=(-3) RETURN 23628 CONTINUE PSTAT=(0) RETURN 23629 CONTINUE END SUBROUTINE PTRCPY( IN, OUT) INTEGER IN(2), OUT(2) OUT(1) = IN(1) IF (.NOT.( IN(1) .NE. -1 ))GOTO 23630 OUT(2) = IN(2) 23630 CONTINUE RETURN END INTEGER FUNCTION PTREQ( PTR1, PTR2) INTEGER PTR1(2), PTR2(2) IF (.NOT.( PTR1(1) .EQ. PTR2(1) ))GOTO 23632 IF (.NOT.( PTR1(1) .EQ. -1 ))GOTO 23634 PTREQ=(1) RETURN 23634 CONTINUE IF (.NOT.( PTR1(2) .EQ. PTR2(2) ))GOTO 23636 PTREQ=(1) RETURN 23636 CONTINUE PTREQ=(0) RETURN 23637 CONTINUE 23635 CONTINUE GOTO 23633 23632 CONTINUE PTREQ=(0) RETURN 23633 CONTINUE END INTEGER FUNCTION PTRTOC( PTR, BUF, SIZE) INTEGER I, J, JUNK, PTR(2), SIZE INTEGER ADDSET, ITOC, LENGTH LOGICAL*1 BUF(SIZE), TEMP(7) JUNK = ITOC( PTR(1), TEMP, 7) J = 1 I = 1 23638 IF (.NOT.(TEMP(I) .NE. 0 ))GOTO 23640 JUNK = ADDSET( TEMP(I), BUF, J, SIZE) 23639 I = I + 1 GOTO 23638 23640 CONTINUE JUNK = ADDSET( 32, BUF, J, SIZE) JUNK = ITOC( PTR(2), TEMP, 7) I = 1 23641 IF (.NOT.(TEMP(I) .NE. 0 ))GOTO 23643 JUNK = ADDSET( TEMP(I), BUF, J, SIZE) 23642 I = I + 1 GOTO 23641 23643 CONTINUE IF (.NOT.( ADDSET( 0, BUF, J, SIZE) .EQ. -3 ))GOTO 23644 BUF(SIZE) = 0 23644 CONTINUE PTRTOC=( LENGTH(BUF) ) RETURN END SUBROUTINE PUTCH( C, FD) LOGICAL*1 C LOGICAL*1 OUTMAP INTEGER FD INTEGER I, N INTEGER PUTS INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS CHSTAT(FD) = 0 IF (.NOT.( CHTYPE(FD) .NE. 0 ))GOTO 23646 CALL RPUTCH( C, 1, FD) RETURN 23646 CONTINUE IF (.NOT.( MODE(FD) .NE. 1 ))GOTO 23648 MODE(FD) = 1 LASTC(FD) = 0 23648 CONTINUE N = LASTC(FD) IF (.NOT.( N .GE. 2048 .OR. C .EQ. 10 ))GOTO 23650 CHSTAT(FD) = PUTS( FDB(FD), BUFFER( 1, FD), N) LASTC(FD) = 0 23650 CONTINUE IF (.NOT.( C .NE. 10 ))GOTO 23652 LASTC(FD) = LASTC(FD) + 1 N = LASTC(FD) BUFFER( N, FD) = C 23652 CONTINUE RETURN END SUBROUTINE PUTHEX( N, BUF) INTEGER N, FMT(2), OUT(2) LOGICAL*1 BUF(2048) LOGICAL*1 FMTBUF(4) DATA FMTBUF(1)/33/,FMTBUF(2)/88/,FMTBUF(3)/76/,FMTBUF(4)/0/ CALL DSCBLD( FMT, FMTBUF) OUT(1) = 9 OUT(2) = %LOC(BUF) CALL SYS$FAO( FMT, , OUT, %VAL(N) ) BUF(9) = 0 CALL FOLD(BUF) RETURN END SUBROUTINE PUTLIN( B, FD) LOGICAL*1 B(2048) INTEGER FD INTEGER I INTEGER LENGTH INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( CHTYPE(FD) .NE. 0 ))GOTO 23654 I = LENGTH(B) CALL RPUTCH( B, I, FD) GOTO 23655 23654 CONTINUE I = 1 23656 IF (.NOT.(B(I) .NE. 0 ))GOTO 23658 CALL PUTCH( B(I), FD) 23657 I = I + 1 GOTO 23656 23658 CONTINUE 23655 CONTINUE RETURN END SUBROUTINE PUTPDB(OFFSET) INTEGER OFFSET INTEGER N4GRND INTEGER SPUNIT INTEGER PDONE INTEGER PMSG INTEGER MBXCHN LOGICAL*1 PID LOGICAL*1 PNAME COMMON / CPROC / N4GRND, SPUNIT, PDONE(8), PMSG(21, 8), MBXCHN(8), * PID(9, 8), PNAME(480, 8) CALL SYS$SETAST( %VAL(0) ) PID( 1, OFFSET) = 0 PDONE(OFFSET) = 0 CALL SYS$DASSGN( %VAL( MBXCHN(OFFSET) ) ) CALL SYS$SETAST( %VAL(1) ) RETURN END INTEGER FUNCTION PWAIT( NPROCS, PIDS, PINFO, LSTPID, FLAG) LOGICAL*1 LSTPID(9), PIDS( 9, 2048) INTEGER FLAG, I, J, K, NPROCS, PINFO(21, 2048) INTEGER EQUAL INTEGER N4GRND INTEGER SPUNIT INTEGER PDONE INTEGER PMSG INTEGER MBXCHN LOGICAL*1 PID LOGICAL*1 PNAME COMMON / CPROC / N4GRND, SPUNIT, PDONE(8), PMSG(21, 8), MBXCHN(8), * PID(9, 8), PNAME(480, 8) I = 1 23659 IF (.NOT.(I .LE. NPROCS ))GOTO 23661 J = 1 23662 IF (.NOT.( J .LE. 5 .AND. EQUAL( PID( 1, J), PIDS( 1, I)) .EQ. 0 ) *)GOTO 23664 IF (.NOT.( J .GT. 5 ))GOTO 23665 GOTO 23663 23665 CONTINUE 23663 J = J + 1 GOTO 23662 23664 CONTINUE 23667 IF (.NOT.( PDONE(J) .NE. 1 ))GOTO 23668 CALL WTMSEC(100) GOTO 23667 23668 CONTINUE K = 1 23669 IF (.NOT.(K .LE. 21 ))GOTO 23671 PINFO( K, I) = PMSG( K, J) 23670 K = K + 1 GOTO 23669 23671 CONTINUE CALL STRCPY( PIDS( 1, I), LSTPID) CALL PUTPDB(J) 23660 I = I + 1 GOTO 23659 23661 CONTINUE IF (.NOT.( PINFO( 2, 1) .EQ. 101 ))GOTO 23672 PWAIT=( 101 ) RETURN 23672 CONTINUE PWAIT=(0) RETURN 23673 CONTINUE END SUBROUTINE QUOTAS(WAIT) INTEGER*4 LONGS(40), RESULTS(13), INIT INTEGER*2 QLIST(80) LOGICAL*1 WAIT LOGICAL*1 B1, B2, B3, B4, B5, B6, B7, B8, B9, BA, BB, BC, BD, B0 INTEGER L1, L2, L3, L4, L5, L6, L7, L8, L9, LA, LB, LC, LD COMMON / CQUOTA / B1, L1, B2, L2, B3, L3, B4, L4, B5, L5, B6, L6, *B7, L7, B8, L8, B9, L9, BA, LA, BB, LB, BC, LC, BD, LD, B0 EQUIVALENCE (QLIST(1), LONGS(1)) DATA INIT/1/ DATA QLIST / 4, 1033, 4*0, 4, 784, 4*0, 4, 794, 4*0, 4, 1037, 4*0, * 4, 787, 4*0, 4, 800, 4*0, 4, 1039, 4*0, 4, 1038, 4*0, 4, 1032, 4* *0, 4, 1040, 4*0, 4, 1041, 4*0, 4, 1046, 4*0, 4, 1026, 4*0, 2*0/ IF (.NOT.(INIT .EQ. 1))GOTO 23674 INIT = 0 I = 1 23676 IF (.NOT.(I .LE. 13))GOTO 23678 J = 3 * I - 1 LONGS(J) = %LOC(RESULTS(I)) 23677 I = I + 1 GOTO 23676 23678 CONTINUE B1 = 1 B2 = 2 B3 = 3 B4 = 4 B5 = 5 B6 = 12 B7 = 6 B8 = 7 B9 = 8 BA = 9 BB = 11 BC = 13 BD = 10 B0 = 0 23674 CONTINUE CALL SYS$GETJPI( , , , QLIST, , , ) L1 = RESULTS(1) L2 = RESULTS(2) L3 = RESULTS(3) IF (.NOT.(WAIT .EQ. 98))GOTO 23679 L4 = RESULTS(4) GOTO 23680 23679 CONTINUE L4 = 0 23680 CONTINUE L5 = RESULTS(5) L6 = RESULTS(6) L7 = RESULTS(7) L8 = RESULTS(8) L9 = RESULTS(9) LA = RESULTS(10) LB = RESULTS(11) LC = RESULTS(12) LD = RESULTS(13) RETURN END SUBROUTINE RDTMBX INTEGER TERMBX INTEGER IOSB INTEGER TERMSG EXTERNAL PRCDON COMMON / CTRMBX / TERMBX, IOSB(2), TERMSG(21) CALL SYS$QIO( , %VAL(TERMBX), %VAL(49), IOSB, PRCDON, , TERMSG, %V *AL(84), , , ,) RETURN END INTEGER FUNCTION READF( BUF, N, FD) LOGICAL*1 BUF(2048) INTEGER FD INTEGER COUNT, N INTEGER GETS INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23681 IF (.NOT.( LFN(FD) .NE. 0 ))GOTO 23683 COUNT = GETS( FDB(FD), BUF, N) IF (.NOT.( COUNT .GE. 0 ))GOTO 23685 READF=(COUNT) RETURN 23685 CONTINUE 23683 CONTINUE 23681 CONTINUE READF=(-1) RETURN END INTEGER FUNCTION REAL_DEVICE(PATH) LOGICAL*1 PATH(2048), TEMP(480), TEMP1(480) INTEGER DSC(2), I, JUNK, PBD(2), PBUF INTEGER GTFTOK, SYS$GETDEV, INDEXX, TRNLOG LOGICAL*1 COLON(2) DATA COLON(1)/58/,COLON(2)/0/ I = 2 JUNK = GTFTOK( PATH, I, TEMP) CALL UPPER(TEMP) JUNK = TRNLOG( TEMP, TEMP1) IF (.NOT.( INDEXX( TEMP1, 58) .EQ. 0 ))GOTO 23687 CALL CONCAT( TEMP1, COLON, TEMP1) 23687 CONTINUE CALL DSCBLD( DSC, TEMP1) PBD(1) = 4 PBD(2) = %LOC(PBUF) IF (.NOT.( .NOT.SYS$GETDEV( DSC, , PBD, , ) ))GOTO 23689 REAL_DEVICE=(0) RETURN 23689 CONTINUE REAL_DEVICE=(1) RETURN 23690 CONTINUE END SUBROUTINE REMARK(LINE) LOGICAL*1 LINE(2048) I = 1 23691 IF (.NOT.(LINE(I) .NE. 0 ))GOTO 23693 CALL PUTCH( LINE(I), 3) 23692 I = I + 1 GOTO 23691 23693 CONTINUE IF (.NOT.(I .EQ. 1))GOTO 23694 CALL PUTCH(10, 3) GOTO 23695 23694 CONTINUE IF (.NOT.( LINE( I - 1 ) .NE. 10 ))GOTO 23696 CALL PUTCH( 10, 3) 23696 CONTINUE 23695 CONTINUE RETURN END INTEGER FUNCTION REMOVE(FIL) LOGICAL*1 FIL(480) INTEGER FD INTEGER FDEL, OPEN INTEGER STATUS INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS STATUS = 0 FD = OPEN( FIL, 1) IF (.NOT.( FD .NE. -3 ))GOTO 23698 IF (.NOT.( FDEL( FDB(FD) ) .LT. 0 ))GOTO 23700 STATUS = -3 23700 CONTINUE CALL CLOSE(FD) 23698 CONTINUE REMOVE=(STATUS) RETURN END SUBROUTINE RESDEF( CPATH, DPATH) LOGICAL*1 TPATH(480), C LOGICAL*1 CPATH(2048), DPATH(2048), TEMP(480) LOGICAL*1 LSTCHR INTEGER DEPTH, I, J, LEVEL, PTR(10) INTEGER EQUAL, GTFTOK, REAL_DEVICE LOGICAL*1 BACKSL(2) LOGICAL*1 DOTDOT(3) DATA BACKSL(1)/92/,BACKSL(2)/0/ DATA DOTDOT(1)/46/,DOTDOT(2)/46/,DOTDOT(3)/0/ CALL GTDPTH(DPATH) CALL EXPPTH( DPATH, DEPTH, PTR, TEMP) C = LSTCHR(CPATH) CALL RES_TILDE( CPATH, TPATH) IF (.NOT.( TPATH(1) .EQ. 0 ))GOTO 23702 DPATH(1) = 0 RETURN 23702 CONTINUE IF (.NOT.( TPATH(1) .EQ. 47 ))GOTO 23704 IF (.NOT.( TPATH(2) .EQ. 64 ))GOTO 23706 LEVEL = 1 GOTO 23707 23706 CONTINUE IF (.NOT.( REAL_DEVICE(TPATH) .EQ. 1 ))GOTO 23708 LEVEL = 2 GOTO 23709 23708 CONTINUE LEVEL = 3 23709 CONTINUE 23707 CONTINUE GOTO 23705 23704 CONTINUE LEVEL = DEPTH + 1 23705 CONTINUE 23703 CONTINUE J = PTR(LEVEL) I = 1 23710 IF (.NOT.( GTFTOK( TPATH, I, TEMP) .GT. 0 ))GOTO 23711 IF (.NOT.( EQUAL( TEMP, DOTDOT) .EQ. 1 .OR. EQUAL( TEMP, BACKSL) . *EQ. 1 ))GOTO 23712 LEVEL = LEVEL - 1 J = PTR(LEVEL) GOTO 23713 23712 CONTINUE PTR(LEVEL) = J LEVEL = LEVEL + 1 DPATH(J) = 47 J = J + 1 CALL STCOPY( TEMP, 1, DPATH, J) 23713 CONTINUE GOTO 23710 23711 CONTINUE IF (.NOT.(C .EQ. 47))GOTO 23714 CALL CHCOPY(47, DPATH, J) 23714 CONTINUE DPATH(J) = 0 RETURN END SUBROUTINE RES_TILDE( PATH, OUT) LOGICAL*1 BUF(2048), OUT(2048), PATH(2048), TOKEN(480) INTEGER FOUND, I, J, JUNK, KEY, N, RAB INTEGER EQUAL, GETS, GETWRD, GTFTOK, LENGTH, OPENF LOGICAL*1 BIN(4) LOGICAL*1 USR(4) LOGICAL*1 TMP(4) LOGICAL*1 LPR(4) LOGICAL*1 MSG(4) LOGICAL*1 MAN(4) LOGICAL*1 SRC(4) LOGICAL*1 INC(4) LOGICAL*1 LIB(4) LOGICAL*1 ST00FZ(4) LOGICAL*1 ST00GZ(2) DATA BIN(1)/98/,BIN(2)/105/,BIN(3)/110/,BIN(4)/0/ DATA USR(1)/117/,USR(2)/115/,USR(3)/114/,USR(4)/0/ DATA TMP(1)/116/,TMP(2)/109/,TMP(3)/112/,TMP(4)/0/ DATA LPR(1)/108/,LPR(2)/112/,LPR(3)/114/,LPR(4)/0/ DATA MSG(1)/109/,MSG(2)/115/,MSG(3)/103/,MSG(4)/0/ DATA MAN(1)/109/,MAN(2)/97/,MAN(3)/110/,MAN(4)/0/ DATA SRC(1)/115/,SRC(2)/114/,SRC(3)/99/,SRC(4)/0/ DATA INC(1)/105/,INC(2)/110/,INC(3)/99/,INC(4)/0/ DATA LIB(1)/108/,LIB(2)/105/,LIB(3)/98/,LIB(4)/0/ DATA ST00FZ(1)/115/,ST00FZ(2)/116/,ST00FZ(3)/95/,ST00FZ(4)/0/ DATA ST00GZ(1)/58/,ST00GZ(2)/0/ IF (.NOT.( PATH(1) .NE. 126 ))GOTO 23716 CALL STRCPY( PATH, OUT) IF (.NOT.(OUT(1) .EQ. 47 .AND. OUT(2) .EQ. 92))GOTO 23718 OUT(2) = 64 GOTO 23719 23718 CONTINUE IF (.NOT.(OUT(1) .EQ. 46 .AND. OUT(2) .EQ. 47))GOTO 23720 CALL SCOPY(OUT, 3, OUT, 1) 23720 CONTINUE 23719 CONTINUE GOTO 23717 23716 CONTINUE FOUND = 1 I = 2 KEY = -3 IF (.NOT.( PATH(I) .EQ. 47 .OR. PATH(I) .EQ. 0 ))GOTO 23722 CALL HOMDIR(TOKEN, 6) KEY = 0 GOTO 23723 23722 CONTINUE JUNK = GTFTOK( PATH, I, TOKEN) CALL FOLD(TOKEN) IF (.NOT.( EQUAL( TOKEN, BIN) .EQ. 1 ))GOTO 23724 KEY = 1 GOTO 23725 23724 CONTINUE IF (.NOT.( EQUAL( TOKEN, USR) .EQ. 1 ))GOTO 23726 KEY = 2 GOTO 23727 23726 CONTINUE IF (.NOT.( EQUAL( TOKEN, TMP) .EQ. 1 ))GOTO 23728 KEY = 3 GOTO 23729 23728 CONTINUE IF (.NOT.( EQUAL( TOKEN, LPR) .EQ. 1 ))GOTO 23730 KEY = 4 GOTO 23731 23730 CONTINUE IF (.NOT.( EQUAL( TOKEN, MSG) .EQ. 1 ))GOTO 23732 KEY = 5 GOTO 23733 23732 CONTINUE IF (.NOT.( EQUAL( TOKEN, MAN) .EQ. 1 ))GOTO 23734 KEY = 6 GOTO 23735 23734 CONTINUE IF (.NOT.( EQUAL( TOKEN, SRC) .EQ. 1 ))GOTO 23736 KEY = 7 GOTO 23737 23736 CONTINUE IF (.NOT.( EQUAL( TOKEN, INC) .EQ. 1 ))GOTO 23738 KEY = 8 GOTO 23739 23738 CONTINUE IF (.NOT.( EQUAL( TOKEN, LIB) .EQ. 1 ))GOTO 23740 KEY = 9 23740 CONTINUE 23739 CONTINUE 23737 CONTINUE 23735 CONTINUE 23733 CONTINUE 23731 CONTINUE 23729 CONTINUE 23727 CONTINUE 23725 CONTINUE IF (.NOT.( KEY .NE. -3 ))GOTO 23742 CALL GETDIR( KEY, 6, TOKEN) 23742 CONTINUE 23723 CONTINUE IF (.NOT.( KEY .EQ. -3 ))GOTO 23744 CALL ADRFIL(BUF) CALL UPPER(BUF) FOUND = 0 IF (.NOT.( OPENF( BUF, 0, 0, 1, -1, RAB) .NE. -3 ))GOTO 23746 23748 CONTINUE N = GETS( RAB, BUF, 2047) IF (.NOT.( N .LT. 0 ))GOTO 23751 GOTO 23750 23751 CONTINUE BUF( N + 1 ) = 0 J = 1 JUNK = GETWRD( BUF, J, OUT) IF (.NOT.( EQUAL( OUT, TOKEN) .EQ. 1 ))GOTO 23753 JUNK = GETWRD( BUF, J, TOKEN) FOUND = 1 GOTO 23750 23753 CONTINUE 23749 GOTO 23748 23750 CONTINUE CALL CLOSEF(RAB) 23746 CONTINUE 23744 CONTINUE IF (.NOT.( FOUND .EQ. 0 ))GOTO 23755 CALL STRCPY(TOKEN, OUT) CALL CONCAT(ST00FZ, OUT, TOKEN) CALL CONCAT(TOKEN, ST00GZ, TOKEN) 23755 CONTINUE CALL CVT_DTOP( TOKEN, OUT) J = LENGTH(OUT) + 1 IF (.NOT.(PATH(I) .EQ. 47))GOTO 23757 I = I + 1 23757 CONTINUE CALL SCOPY( PATH, I, OUT, J) 23717 CONTINUE RETURN END SUBROUTINE RESUIC( UIC, VALUE) LOGICAL*1 BUF(2048), NAME(480), UIC(2048), VALUE(2048) LOGICAL*1 DEFN(480) INTEGER FD INTEGER I, INIT, JUNK INTEGER GETLIN, GETWRD, LENGTH, OPEN, PR_LOOKUP INTEGER LASTP INTEGER LASTT INTEGER NAMPTR LOGICAL*1 TABLE LOGICAL*1 ST00HZ(25) COMMON / PR_CLOOK / LASTP, LASTT, NAMPTR( 2500), TABLE(62500) DATA INIT / 1 / 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)/111 */,ST00HZ(10)/112/,ST00HZ(11)/101/,ST00HZ(12)/110/,ST00HZ(13)/32/,S *T00HZ(14)/117/,ST00HZ(15)/115/,ST00HZ(16)/101/,ST00HZ(17)/114/,ST0 *0HZ(18)/39/,ST00HZ(19)/115/,ST00HZ(20)/32/,ST00HZ(21)/102/,ST00HZ( *22)/105/,ST00HZ(23)/108/,ST00HZ(24)/101/,ST00HZ(25)/0/ IF (.NOT.( INIT .EQ. 1 ))GOTO 23759 LASTP = 0 LASTT = 0 CALL ADRFIL(NAME) FD = OPEN( NAME, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23761 CALL REMARK( ST00HZ ) GOTO 23762 23761 CONTINUE 23763 IF (.NOT.( GETLIN( BUF, FD) .NE. -1 ))GOTO 23764 I = 1 JUNK = GETWRD( BUF, I, DEFN) JUNK = GETWRD( BUF, I, NAME) JUNK = GETWRD( BUF, I, NAME) CALL PR_INSTAL( NAME, DEFN) GOTO 23763 23764 CONTINUE CALL CLOSE(FD) 23762 CONTINUE INIT = 0 23759 CONTINUE IF (.NOT.( PR_LOOKUP( UIC, VALUE) .EQ. 0 ))GOTO 23765 CALL STRCPY( UIC, VALUE) 23765 CONTINUE RETURN END INTEGER FUNCTION RESUME(BUF) LOGICAL*1 BUF(9) INTEGER PID, STATUS INTEGER HTOI, SYS$RESUME PID = HTOI(BUF) STATUS = SYS$RESUME( PID, ) IF (.NOT.( .NOT. STATUS ))GOTO 23767 RESUME=(-3) RETURN 23767 CONTINUE RESUME=(0) RETURN 23768 CONTINUE END LOGICAL*1 FUNCTION RGETCH(C, CHAN) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS LOGICAL*1 C INTEGER CHAN, FUNC, IOSTAT, RAWFN, RAREFN INTEGER*2 IOSB(4) INTEGER*4 SYS$QIOW COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS DATA RAWFN / 250 / DATA RAREFN / 737 / IOSTAT = 1 IF (.NOT.( CHTYPE(CHAN) .EQ. 1 ))GOTO 23769 FUNC = RAWFN GOTO 23770 23769 CONTINUE IF (.NOT.( CHTYPE(CHAN) .EQ. 2 ))GOTO 23771 FUNC = RAREFN GOTO 23772 23771 CONTINUE IOSTAT = (.NOT. 1) 23772 CONTINUE 23770 CONTINUE IF (.NOT.( IOSTAT .EQ. 1 ))GOTO 23773 IOSTAT = SYS$QIOW( , %VAL(RAWCHN(CHAN)), %VAL(FUNC), IOSB, , , %RE *F(C), %VAL(1), %VAL(CHTIMO(CHAN)), , , ,) 23773 CONTINUE IF (.NOT.( IOSTAT .NE. 1 .OR. IOSB(1) .NE. 1 ))GOTO 23775 IF (.NOT.( IOSB(1) .EQ. 556 ))GOTO 23777 C = -4 GOTO 23778 23777 CONTINUE C = -3 23778 CONTINUE CHSTAT(CHAN) = C GOTO 23776 23775 CONTINUE CHSTAT(CHAN) = 0 23776 CONTINUE RGETCH=(C) RETURN END SUBROUTINE RPUTCH(STR, N, CHAN) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS LOGICAL*1 STR(2048) INTEGER CHAN, FUNC, IOSTAT, N INTEGER*4 SYS$QIOW INTEGER*2 IOSB(4) COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS DATA FUNC / 304 / IOSTAT = SYS$QIOW( , %VAL(RAWCHN(CHAN)), %VAL(FUNC), IOSB, , , %RE *F(STR), %VAL(N), , , , ,) IF (.NOT.( IOSTAT .NE. 1 ))GOTO 23779 CHSTAT(CHAN) = -3 RETURN 23779 CONTINUE IF (.NOT.( IOSB(1) .EQ. 1 .OR. IOSB(1) .EQ. 1545 ))GOTO 23781 CHSTAT(CHAN) = 0 GOTO 23782 23781 CONTINUE CHSTAT(CHAN) = -3 23782 CONTINUE RETURN END INTEGER FUNCTION RTOPEN( TERM, CHAN) LOGICAL*1 TERM(2048) LOGICAL*1 BUF(480) INTEGER CHAN, DSC(2), JUNK INTEGER SYS$ASSIGN, TRNLOG JUNK = TRNLOG( TERM, BUF) CALL DSCBLD( DSC, BUF) IF (.NOT.( .NOT. SYS$ASSIGN( DSC, CHAN, , ) ))GOTO 23783 RTOPEN=(-3) RETURN 23783 CONTINUE RTOPEN=(0) RETURN 23784 CONTINUE END SUBROUTINE SCRATF( START, TARGET) LOGICAL*1 DIREC(480), START(2048), TARGET(2048) INTEGER I, INIT, J, N INTEGER LENGTH DATA INIT / 1 / IF (.NOT.( INIT .EQ. 1 ))GOTO 23785 CALL GETDIR( 3, 6, DIREC) I = LENGTH(DIREC) + 1 CALL CHCOPY( 116, DIREC, I) CALL UNIQUE( DIREC(I) ) INIT = 0 23785 CONTINUE I = 1 CALL STCOPY( DIREC, 1, TARGET, I) TARGET(I) = 46 I = I + 1 N = LENGTH(START) N = MIN( N, 3) J = 1 23787 IF (.NOT.(J .LE. N ))GOTO 23789 TARGET(I) = START(J) I = I + 1 23788 J = J + 1 GOTO 23787 23789 CONTINUE TARGET(I) = 0 RETURN END SUBROUTINE SEEK( OFFSET, FD) LOGICAL*1 C LOGICAL*1 GETCH INTEGER FD INTEGER OFFSET(2), TMPOFF(2) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( OFFSET(1) .EQ. -2 ))GOTO 23790 TMPOFF(1) = 0 TMPOFF(2) = 0 CALL POINT( FDB(FD), TMPOFF(1), TMPOFF(2)) GOTO 23791 23790 CONTINUE IF (.NOT.( OFFSET(1) .EQ. -1 ))GOTO 23792 TMPOFF(1) = 0 TMPOFF(2) = 0 CALL POINT( FDB(FD), TMPOFF(1), TMPOFF(2)) 23794 IF (.NOT.( GETCH( C, FD) .NE. -1 ))GOTO 23795 GOTO 23794 23795 CONTINUE GOTO 23793 23792 CONTINUE CALL POINT( FDB(FD), OFFSET(1), OFFSET(2)) 23793 CONTINUE 23791 CONTINUE RETURN END SUBROUTINE SETAST(STATE) INTEGER STATE INTEGER GOTAST COMMON / CAST / GOTAST IF (.NOT.( STATE .EQ. 1 .OR. STATE .EQ. 0 ))GOTO 23796 GOTAST = STATE 23796 CONTINUE RETURN END SUBROUTINE SLEEP(SECNDS) INTEGER DAYS, HOURS, I, JUNK, MINS, SECNDS, SECS, SYSTIM(2), TDESC *(2) INTEGER TIMER_EFN INTEGER LIB$GET_EF, SYS$BINTIM LOGICAL*1 TBUF(5), TIME(20) LOGICAL*1 ST00IZ(4) DATA TIMER_EFN / 0 / DATA ST00IZ(1)/46/,ST00IZ(2)/48/,ST00IZ(3)/48/,ST00IZ(4)/0/ IF (.NOT.( TIMER_EFN .EQ. 0 ))GOTO 23798 JUNK = LIB$GET_EF( TIMER_EFN ) 23798 CONTINUE IF (.NOT.( SECNDS .LE. 0 ))GOTO 23800 RETURN 23800 CONTINUE DAYS = 0 HOURS = 0 MINS = 0 IF (.NOT.( SECNDS .GT. 864000 ))GOTO 23802 SECS = 864000 GOTO 23803 23802 CONTINUE SECS = SECNDS 23803 CONTINUE IF (.NOT.( SECS .GE. 60 ))GOTO 23804 MINS = SECS / 60 SECS = SECS - 60 * MINS 23804 CONTINUE IF (.NOT.( MINS .GE. 60 ))GOTO 23806 HOURS = MINS / 60 MINS = MINS - 60 * HOURS 23806 CONTINUE IF (.NOT.( HOURS .GE. 24 ))GOTO 23808 DAYS = HOURS / 24 HOURS = HOURS - 24 * DAYS 23808 CONTINUE I = 1 CALL ITOCZF( DAYS, TBUF, 4) CALL STCOPY( TBUF, 1, TIME, I) CALL CHCOPY( 32, TIME, I) CALL ITOCZF( HOURS, TBUF, 2) CALL STCOPY( TBUF, 1, TIME, I) CALL CHCOPY( 58, TIME, I) CALL ITOCZF( MINS, TBUF, 2) CALL STCOPY( TBUF, 1, TIME, I) CALL CHCOPY( 58, TIME, I) CALL ITOCZF( SECS, TBUF, 2) CALL STCOPY( TBUF, 1, TIME, I) CALL SCOPY( ST00IZ, 1, TIME, I) CALL DSCBLD( TDESC, TIME) IF (.NOT.( SYS$BINTIM( TDESC, SYSTIM) ))GOTO 23810 CALL SYS$SETIMR( %VAL( TIMER_EFN ), SYSTIM, , ) CALL SYS$WAITFR( %VAL( TIMER_EFN ) ) 23810 CONTINUE RETURN END INTEGER FUNCTION SPAWN( PROCES, ARGS, DESC, INWAIT) LOGICAL*1 PROCES(480), ARGS(512), DESC(9) LOGICAL*1 INWAIT, WAIT, MSG(512), PRNAME(20), BXNAME(20) LOGICAL*1 TERMNL(480), TTY(480) LOGICAL*1 IMAGE(480), TEMP(480) LOGICAL*1 CLOWER LOGICAL*1 OUTFIL(480), ERRFIL(480), C INTEGER INIT, JUNK, I, TERUNT, N, BOXUNT, STATUS, UIC, PRIOR, BASP *RI INTEGER STSFLG, DCL, START, STOP, J, INPDSC(2), OUTDSC(2), ERRDSC( *2) INTEGER IMGDSC(2), PRCDSC(2), PRVADR(2), UNIT, LPID, OFFSET, SYS$C *REPRC INTEGER TRM_INFO(21,1) INTEGER OPNOUT, OPNERR, OUTMOD, IND INTEGER FILNFO, GTMODE, INDEXS, STMODE INTEGER TRNLOG, CREMBX, OPEN, GETPDB, EQUAL, PWAIT, DCLOUT INTEGER N4GRND INTEGER SPUNIT INTEGER PDONE INTEGER PMSG INTEGER MBXCHN LOGICAL*1 PID LOGICAL*1 PNAME INTEGER TERMBX INTEGER IOSB INTEGER TERMSG LOGICAL*1 B1, B2, B3, B4, B5, B6, B7, B8, B9, BA, BB, BC, BD, B0 INTEGER L1, L2, L3, L4, L5, L6, L7, L8, L9, LA, LB, LC, LD LOGICAL*1 BLKGTR(3) LOGICAL*1 BLKQMK(3) LOGICAL*1 TRMBOX(20) LOGICAL*1 NULDEV(6) LOGICAL*1 LOGIN(24) LOGICAL*1 DODCL(23) LOGICAL*1 NOVER(15) LOGICAL*1 ASS1(14) LOGICAL*1 ASS2(5) LOGICAL*1 ASS3(9) LOGICAL*1 ASS4(14) LOGICAL*1 ST00JZ(3) LOGICAL*1 ST00KZ(34) LOGICAL*1 ST00LZ(42) LOGICAL*1 ST00MZ(6) COMMON / CPROC / N4GRND, SPUNIT, PDONE(8), PMSG(21, 8), MBXCHN(8), * PID(9, 8), PNAME(480, 8) COMMON / CTRMBX / TERMBX, IOSB(2), TERMSG(21) COMMON / CQUOTA / B1, L1, B2, L2, B3, L3, B4, L4, B5, L5, B6, L6, *B7, L7, B8, L8, B9, L9, BA, LA, BB, LB, BC, LC, BD, LD, B0 DATA BLKGTR(1)/32/,BLKGTR(2)/62/,BLKGTR(3)/0/ DATA BLKQMK(1)/32/,BLKQMK(2)/63/,BLKQMK(3)/0/ DATA TRMBOX(1)/84/,TRMBOX(2)/82/,TRMBOX(3)/77/,TRMBOX(4)/66/,TRMBO *X(5)/88/,TRMBOX(6)/0/ DATA NULDEV(1)/78/,NULDEV(2)/76/,NULDEV(3)/65/,NULDEV(4)/48/,NULDE *V(5)/58/,NULDEV(6)/0/ DATA LOGIN(1)/115/,LOGIN(2)/121/,LOGIN(3)/115/,LOGIN(4)/36/,LOGIN( *5)/115/,LOGIN(6)/121/,LOGIN(7)/115/,LOGIN(8)/116/,LOGIN(9)/101/,LO *GIN(10)/109/,LOGIN(11)/58/,LOGIN(12)/108/,LOGIN(13)/111/,LOGIN(14) */103/,LOGIN(15)/105/,LOGIN(16)/110/,LOGIN(17)/111/,LOGIN(18)/117/, *LOGIN(19)/116/,LOGIN(20)/46/,LOGIN(21)/101/,LOGIN(22)/120/,LOGIN(2 *3)/101/,LOGIN(24)/0/ DATA DODCL(1)/36/,DODCL(2)/64/,DODCL(3)/115/,DODCL(4)/116/,DODCL(5 *)/95/,DODCL(6)/98/,DODCL(7)/105/,DODCL(8)/110/,DODCL(9)/58/,DODCL( *10)/100/,DODCL(11)/111/,DODCL(12)/100/,DODCL(13)/99/,DODCL(14)/108 */,DODCL(15)/47/,DODCL(16)/111/,DODCL(17)/117/,DODCL(18)/116/,DODCL *(19)/112/,DODCL(20)/117/,DODCL(21)/116/,DODCL(22)/61/,DODCL(23)/0/ DATA NOVER(1)/36/,NOVER(2)/115/,NOVER(3)/101/,NOVER(4)/116/,NOVER( *5)/32/,NOVER(6)/110/,NOVER(7)/111/,NOVER(8)/118/,NOVER(9)/101/,NOV *ER(10)/114/,NOVER(11)/105/,NOVER(12)/102/,NOVER(13)/121/,NOVER(14) */10/,NOVER(15)/0/ DATA ASS1(1)/36/,ASS1(2)/97/,ASS1(3)/115/,ASS1(4)/115/,ASS1(5)/105 */,ASS1(6)/103/,ASS1(7)/110/,ASS1(8)/47/,ASS1(9)/117/,ASS1(10)/115/ *,ASS1(11)/101/,ASS1(12)/114/,ASS1(13)/32/,ASS1(14)/0/ DATA ASS2(1)/32/,ASS2(2)/84/,ASS2(3)/84/,ASS2(4)/10/,ASS2(5)/0/ DATA ASS3(1)/36/,ASS3(2)/97/,ASS3(3)/115/,ASS3(4)/115/,ASS3(5)/105 */,ASS3(6)/103/,ASS3(7)/110/,ASS3(8)/32/,ASS3(9)/0/ DATA ASS4(1)/32/,ASS4(2)/83/,ASS4(3)/89/,ASS4(4)/83/,ASS4(5)/36/,A *SS4(6)/67/,ASS4(7)/79/,ASS4(8)/77/,ASS4(9)/77/,ASS4(10)/65/,ASS4(1 *1)/78/,ASS4(12)/68/,ASS4(13)/10/,ASS4(14)/0/ DATA INIT / 1 / DATA ST00JZ(1)/84/,ST00JZ(2)/84/,ST00JZ(3)/0/ DATA ST00KZ(1)/67/,ST00KZ(2)/97/,ST00KZ(3)/110/,ST00KZ(4)/110/,ST0 *0KZ(5)/111/,ST00KZ(6)/116/,ST00KZ(7)/32/,ST00KZ(8)/99/,ST00KZ(9)/1 *14/,ST00KZ(10)/101/,ST00KZ(11)/97/,ST00KZ(12)/116/,ST00KZ(13)/101/ *,ST00KZ(14)/32/,ST00KZ(15)/116/,ST00KZ(16)/101/,ST00KZ(17)/114/,ST *00KZ(18)/109/,ST00KZ(19)/105/,ST00KZ(20)/110/,ST00KZ(21)/97/,ST00K *Z(22)/116/,ST00KZ(23)/105/,ST00KZ(24)/111/,ST00KZ(25)/110/,ST00KZ( *26)/32/,ST00KZ(27)/109/,ST00KZ(28)/97/,ST00KZ(29)/105/,ST00KZ(30)/ *108/,ST00KZ(31)/98/,ST00KZ(32)/111/,ST00KZ(33)/120/,ST00KZ(34)/0/ DATA ST00LZ(1)/67/,ST00LZ(2)/97/,ST00LZ(3)/110/,ST00LZ(4)/110/,ST0 *0LZ(5)/111/,ST00LZ(6)/116/,ST00LZ(7)/32/,ST00LZ(8)/111/,ST00LZ(9)/ *112/,ST00LZ(10)/101/,ST00LZ(11)/110/,ST00LZ(12)/32/,ST00LZ(13)/116 */,ST00LZ(14)/116/,ST00LZ(15)/121/,ST00LZ(16)/32/,ST00LZ(17)/117/,S *T00LZ(18)/110/,ST00LZ(19)/105/,ST00LZ(20)/116/,ST00LZ(21)/32/,ST00 *LZ(22)/102/,ST00LZ(23)/111/,ST00LZ(24)/114/,ST00LZ(25)/32/,ST00LZ( *26)/115/,ST00LZ(27)/112/,ST00LZ(28)/97/,ST00LZ(29)/119/,ST00LZ(30) */110/,ST00LZ(31)/32/,ST00LZ(32)/65/,ST00LZ(33)/83/,ST00LZ(34)/84/, *ST00LZ(35)/32/,ST00LZ(36)/119/,ST00LZ(37)/114/,ST00LZ(38)/105/,ST0 *0LZ(39)/116/,ST00LZ(40)/101/,ST00LZ(41)/115/,ST00LZ(42)/0/ DATA ST00MZ(1)/108/,ST00MZ(2)/111/,ST00MZ(3)/99/,ST00MZ(4)/97/,ST0 *0MZ(5)/108/,ST00MZ(6)/0/ IF (.NOT.( INIT .EQ. 1 ))GOTO 23812 INIT = 0 JUNK = TRNLOG( ST00JZ, TTY) I = 1 23814 IF (.NOT.(I .LE. 8 ))GOTO 23816 CALL PUTPDB(I) 23815 I = I + 1 GOTO 23814 23816 CONTINUE N4GRND = 0 IF (.NOT.( CREMBX( TRMBOX, 1, TERMBX, TERUNT) .EQ. -3 ))GOTO 23817 CALL ERROR( ST00KZ ) 23817 CONTINUE SPUNIT = OPEN( TTY, 2) IF (.NOT.( SPUNIT .EQ. -3 ))GOTO 23819 CALL REMARK( ST00LZ ) 23819 CONTINUE CALL ENBINT CALL RDTMBX 23812 CONTINUE IF (.NOT.( ARGS(1) .EQ. 0 ))GOTO 23821 SPAWN=(-3) RETURN 23821 CONTINUE WAIT = CLOWER(INWAIT) IF (.NOT.( GETPDB( OFFSET, WAIT) .EQ. -3 ))GOTO 23823 SPAWN=(-3) RETURN 23823 CONTINUE OPNOUT = -3 OPNERR = -3 OUTMOD = -3 CALL STRCPY( PROCES, PNAME( 1, OFFSET) ) CALL STRCPY( ARGS, MSG) CALL GENPNM( PRNAME, WAIT, OFFSET - 5 ) CALL ARGGEN( PRNAME, BXNAME) CALL GETPRV(PRVADR) CALL GETBPR(BASPRI) STSFLG = 0 STATUS = CREMBX( BXNAME, 0, MBXCHN(OFFSET), BOXUNT) IF (.NOT.( STATUS .NE. -3 ))GOTO 23825 UNIT = OPEN( BXNAME, 3) IF (.NOT.( UNIT .EQ. -3 ))GOTO 23827 STATUS = -3 23827 CONTINUE 23825 CONTINUE IF (.NOT.( STATUS .NE. -3 ))GOTO 23829 IF (.NOT.( WAIT .EQ. 98 ))GOTO 23831 CALL GETUIC(UIC) PRIOR = BASPRI / 2 CALL STRCPY( NULDEV, TERMNL) GOTO 23832 23831 CONTINUE UIC = 0 PRIOR = BASPRI CALL STRCPY( TTY, TERMNL) 23832 CONTINUE CALL STRCPY( PROCES, IMAGE) CALL FOLD(IMAGE) DCL = 0 IF (.NOT.( EQUAL( IMAGE, ST00MZ ) .EQ. 1 ))GOTO 23833 DCL = 1 IF (.NOT.(WAIT .EQ. 98))GOTO 23835 STSFLG = 64 23835 CONTINUE CALL STRCPY( LOGIN, IMAGE) I = 1 CALL STCOPY( DODCL, 1, MSG, I) CALL STRCPY( TERMNL, TEMP) STATUS = DCLOUT( ARGS, START, STOP, TEMP) CALL STCOPY( TEMP, 1, MSG, I) CALL CHCOPY( 32, MSG, I) IF (.NOT.( STATUS .EQ. 1 ))GOTO 23837 J = 1 23839 IF (.NOT.(J .LE. START ))GOTO 23841 CALL CHCOPY( ARGS(J), MSG, I) 23840 J = J + 1 GOTO 23839 23841 CONTINUE J = STOP GOTO 23838 23837 CONTINUE J = 1 23838 CONTINUE CALL SCOPY( ARGS, J, MSG, I) CALL DSCBLD( INPDSC, BXNAME) CALL DSCBLD( OUTDSC, NULDEV) GOTO 23834 23833 CONTINUE CALL DSCBLD( INPDSC, TERMNL) CALL DSCBLD( OUTDSC, TERMNL) IF (.NOT.( WAIT .EQ. 119 ))GOTO 23842 IF (.NOT.( INDEXS( MSG, BLKGTR) .EQ. 0 ))GOTO 23844 IF (.NOT.( FILNFO( 2, OUTFIL, JUNK) .EQ. 0 ))GOTO 23846 OPNOUT = 2 OUTMOD = GTMODE(2) CALL APPRED( 2, 62, OUTFIL, MSG) 23846 CONTINUE 23844 CONTINUE IND = INDEXS( MSG, BLKQMK) IF (.NOT.( IND .NE. 0 ))GOTO 23848 C = MSG( IND + 2 ) IF (.NOT.( C .EQ. 32 .OR. C .EQ. 9 .OR. C .EQ. 0 ))GOTO 23850 IND = 0 23850 CONTINUE 23848 CONTINUE IF (.NOT.( IND .EQ. 0 ))GOTO 23852 IF (.NOT.( FILNFO( 3, ERRFIL, JUNK) .EQ. 0 ))GOTO 23854 OPNERR = 3 CALL APPRED( 3, 63, ERRFIL, MSG) 23854 CONTINUE 23852 CONTINUE 23842 CONTINUE 23834 CONTINUE CALL DSCBLD( ERRDSC, TERMNL) CALL DSCBLD( IMGDSC, IMAGE) CALL DSCBLD( PRCDSC, PRNAME) CALL UPPER(IMAGE) CALL QUOTAS (WAIT) CALL SYS$SETAST( %VAL(0) ) STATUS = SYS$CREPRC( LPID, IMGDSC, INPDSC, OUTDSC, ERRDSC, PRVADR, * B1, PRCDSC, %VAL(PRIOR), %VAL(UIC), %VAL(TERUNT), %VAL(STSFLG) ) IF (.NOT.( STATUS .NE. 1 ))GOTO 23856 STATUS = -3 CALL SYS$SETAST( %VAL(1) ) GOTO 23857 23856 CONTINUE N = LENGTH(MSG) IF (.NOT.( DCL .EQ. 1 ))GOTO 23858 CALL PUTLIN( NOVER, UNIT) CALL PUTLIN( ASS1, UNIT) CALL PUTLIN( TTY, UNIT) CALL PUTLIN( ASS2, UNIT) CALL PUTLIN( ASS3, UNIT) CALL PUTLIN( TTY, UNIT) CALL PUTLIN( ASS4, UNIT) CALL PUTLIN( MSG, UNIT) CALL PUTCH( 10, UNIT) GOTO 23859 23858 CONTINUE I = 48 + 64 CALL SYS$QIOW( %VAL(1), %VAL( MBXCHN(OFFSET) ), %VAL(I), , , , MSG *, %VAL(N), , , , ,) 23859 CONTINUE CALL CLOSE(UNIT) CALL PUTHEX( LPID, DESC) CALL STRCPY( DESC, PID( 1, OFFSET) ) IF (.NOT.( WAIT .NE. 98 ))GOTO 23860 N4GRND = N4GRND + 1 23860 CONTINUE CALL SYS$SETAST( %VAL(1) ) STATUS = 0 IF (.NOT.( WAIT .EQ. 119 ))GOTO 23862 IF (.NOT.( PWAIT( 1, DESC, TRM_INFO(1,1), DESC, 50) .EQ. 101 ))GOT *O 23864 STATUS = 101 23864 CONTINUE 23862 CONTINUE 23857 CONTINUE 23829 CONTINUE CALL SRESET( OPNOUT, OUTFIL) IF (.NOT.( OUTMOD .NE. -3 ))GOTO 23866 JUNK = STMODE( 2, OUTMOD) 23866 CONTINUE CALL SRESET( OPNERR, ERRFIL) IF (.NOT.( STATUS .EQ. -3 .OR. STATUS .EQ. 101 ))GOTO 23868 CALL PUTPDB(OFFSET) 23868 CONTINUE SPAWN=(STATUS) RETURN END SUBROUTINE SRESET( UNIT, FILE) INTEGER UNIT, JUNK INTEGER ASSIGN LOGICAL*1 FILE(480) IF (.NOT.( UNIT .NE. -3 ))GOTO 23870 JUNK = ASSIGN( FILE, UNIT, 4) 23870 CONTINUE RETURN END SUBROUTINE SRTTIM( DATE, OUT) LOGICAL*1 OUT(2048), TEMP(10) INTEGER DATE(2), I, IDATE(2), J, K, N, X INTEGER ITOC INTEGER*2 JDATE(4), Y EQUIVALENCE( IDATE(1), JDATE(1) ), ( X, Y) IDATE(1) = DATE(1) IDATE(2) = DATE(2) X = 0 K = 1 I = 4 23872 IF (.NOT.(I .GT. 0 ))GOTO 23874 Y = JDATE(I) N = ITOC( X, TEMP, 10) J = 6 23875 IF (.NOT.(J .GT. N ))GOTO 23877 CALL CHCOPY( 32, OUT, K) 23876 J = J - 1 GOTO 23875 23877 CONTINUE CALL STCOPY( TEMP, 1, OUT, K) 23873 I = I - 1 GOTO 23872 23874 CONTINUE RETURN END SUBROUTINE STDFLT( HOST, DEVICE, DIRECT) LOGICAL*1 HOST(2048), DEVICE(2048), DIRECT(2048), LHOST(480) LOGICAL*1 TSTR(480) INTEGER EQL(2), I, INIT, LOG(2), STATUS INTEGER CRELOGSUP, EQUAL, SYS$CRELOG, SYS$SETDDIR LOGICAL*1 ST00NZ(3) LOGICAL*1 ST00OZ(2) LOGICAL*1 ST00PZ(9) LOGICAL*1 ST00QZ(30) LOGICAL*1 ST00RZ(37) DATA INIT / 1 / DATA ST00NZ(1)/58/,ST00NZ(2)/58/,ST00NZ(3)/0/ DATA ST00OZ(1)/58/,ST00OZ(2)/0/ DATA ST00PZ(1)/83/,ST00PZ(2)/89/,ST00PZ(3)/83/,ST00PZ(4)/36/,ST00P *Z(5)/68/,ST00PZ(6)/73/,ST00PZ(7)/83/,ST00PZ(8)/75/,ST00PZ(9)/0/ DATA ST00QZ(1)/69/,ST00QZ(2)/114/,ST00QZ(3)/114/,ST00QZ(4)/111/,ST *00QZ(5)/114/,ST00QZ(6)/32/,ST00QZ(7)/105/,ST00QZ(8)/110/,ST00QZ(9) */32/,ST00QZ(10)/97/,ST00QZ(11)/115/,ST00QZ(12)/115/,ST00QZ(13)/105 */,ST00QZ(14)/103/,ST00QZ(15)/110/,ST00QZ(16)/105/,ST00QZ(17)/110/, *ST00QZ(18)/103/,ST00QZ(19)/32/,ST00QZ(20)/115/,ST00QZ(21)/121/,ST0 *0QZ(22)/115/,ST00QZ(23)/36/,ST00QZ(24)/100/,ST00QZ(25)/105/,ST00QZ *(26)/115/,ST00QZ(27)/107/,ST00QZ(28)/58/,ST00QZ(29)/32/,ST00QZ(30) */0/ DATA ST00RZ(1)/69/,ST00RZ(2)/114/,ST00RZ(3)/114/,ST00RZ(4)/111/,ST *00RZ(5)/114/,ST00RZ(6)/32/,ST00RZ(7)/105/,ST00RZ(8)/110/,ST00RZ(9) */32/,ST00RZ(10)/115/,ST00RZ(11)/101/,ST00RZ(12)/116/,ST00RZ(13)/11 *6/,ST00RZ(14)/105/,ST00RZ(15)/110/,ST00RZ(16)/103/,ST00RZ(17)/32/, *ST00RZ(18)/100/,ST00RZ(19)/101/,ST00RZ(20)/102/,ST00RZ(21)/97/,ST0 *0RZ(22)/117/,ST00RZ(23)/108/,ST00RZ(24)/116/,ST00RZ(25)/32/,ST00RZ *(26)/100/,ST00RZ(27)/105/,ST00RZ(28)/114/,ST00RZ(29)/101/,ST00RZ(3 *0)/99/,ST00RZ(31)/116/,ST00RZ(32)/111/,ST00RZ(33)/114/,ST00RZ(34)/ *121/,ST00RZ(35)/58/,ST00RZ(36)/32/,ST00RZ(37)/0/ IF (.NOT.( INIT .EQ. 1 ))GOTO 23878 CALL HOSTNM(LHOST) INIT = 0 23878 CONTINUE CALL FOLD(HOST) I = 1 IF (.NOT.( EQUAL( HOST, LHOST) .NE. 1 .AND. HOST(1) .NE. 0 ))GOTO *23880 CALL STCOPY( HOST, 1, TSTR, I) CALL STCOPY( ST00NZ, 1, TSTR, I) 23880 CONTINUE CALL STCOPY( DEVICE, 1, TSTR, I) CALL SCOPY( ST00OZ, 1, TSTR, I) CALL UPPER(TSTR) CALL DSCBLD( LOG, ST00PZ ) CALL DSCBLD( EQL, TSTR) STATUS = CRELOGSUP( LOG, EQL) IF (.NOT.( .NOT. STATUS ))GOTO 23882 STATUS = SYS$CRELOG( %VAL(2), LOG, EQL, ) IF (.NOT.( .NOT. STATUS ))GOTO 23884 CALL PUTHEX( STATUS, TSTR) CALL PUTLIN( ST00QZ, 3) CALL REMARK(TSTR) 23884 CONTINUE 23882 CONTINUE CALL UPPER(DIRECT) CALL DSCBLD( LOG, DIRECT) STATUS = SYS$SETDDIR( LOG, , ) IF (.NOT.( .NOT. STATUS ))GOTO 23886 CALL PUTHEX( STATUS, TSTR) CALL PUTLIN( ST00RZ, 3) CALL REMARK(TSTR) 23886 CONTINUE RETURN END SUBROUTINE STDPTH(PATH) LOGICAL*1 PATH(2048), TEMP(480), NODE(480) LOGICAL*1 DEVICE(480), DIRECT(480) CALL GENDIR(PATH, TEMP) CALL PARSEF( TEMP, NODE, DEVICE, DIRECT, TEMP) CALL STDFLT( NODE, DEVICE, DIRECT) RETURN END INTEGER FUNCTION STMODE( FD, TYPE) INTEGER FD INTEGER TYPE, TEMP INTEGER RTOPEN INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23888 IF (.NOT.( LFN(FD) .EQ. 1 .AND. TYPE .NE. 0 ))GOTO 23890 IF (.NOT.( RTOPEN( FILENM( 1, FD), RAWCHN(FD) ) .EQ. -3 ))GOTO 238 *92 TEMP = 0 GOTO 23893 23892 CONTINUE TEMP = TYPE 23893 CONTINUE GOTO 23891 23890 CONTINUE TEMP = 0 23891 CONTINUE CHTYPE(FD) = TEMP IF (.NOT.( TEMP .EQ. 0 .AND. RAWCHN(FD) .NE. 0 ))GOTO 23894 CALL SYS$DASSGN( %VAL( RAWCHN(FD) ) ) RAWCHN(FD) = 0 23894 CONTINUE STMODE=(TEMP) RETURN 23888 CONTINUE STMODE=(-3) RETURN 23889 CONTINUE END SUBROUTINE STR_HOST( BUF, TEMP) LOGICAL*1 BUF(2048), TEMP(2048), SCRAT(480) INTEGER I, JUNK INTEGER EQUAL, GTFTOK IF (.NOT.( BUF(1) .NE. 47 .OR. BUF(2) .NE. 64 ))GOTO 23896 RETURN 23896 CONTINUE I = 3 JUNK = GTFTOK( BUF, I, TEMP) CALL FOLD(TEMP) CALL HOSTNM(SCRAT) IF (.NOT.( EQUAL( SCRAT, TEMP) .EQ. 1 ))GOTO 23898 CALL SCOPY( BUF, I, BUF, 1) 23898 CONTINUE RETURN END INTEGER FUNCTION STSTAT( FD, STAT) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS INTEGER FD INTEGER STAT COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23900 IF (.NOT.( STAT .EQ. 0 .OR. STAT .EQ. -3 .OR. STAT .EQ. -4 ))GOTO *23902 CHSTAT(FD) = STAT STSTAT=(0) RETURN 23902 CONTINUE 23900 CONTINUE STSTAT=(-3) RETURN END SUBROUTINE STTIMO( FD, SEC) INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS INTEGER FD INTEGER SEC COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23904 IF (.NOT.( SEC .GE. 0 ))GOTO 23906 CHTIMO(FD) = SEC 23906 CONTINUE 23904 CONTINUE RETURN END INTEGER FUNCTION SUSPND(BUF) LOGICAL*1 BUF(9) INTEGER PID, STATUS INTEGER HTOI, SYS$SUSPND PID = HTOI(BUF) STATUS = SYS$SUSPND( PID, ) IF (.NOT.( .NOT. STATUS ))GOTO 23908 SUSPND=(-3) RETURN 23908 CONTINUE SUSPND=(0) RETURN 23909 CONTINUE END INTEGER FUNCTION TRAN1( IN, OUT) LOGICAL*1 BUF1(64), BUF2(64), IN(100), OUT(100) INTEGER DSC1(2), DSC2(2), N, STATUS INTEGER INDEXX, LENGTH, SYS$TRNLOG IF (.NOT.( IN(1) .EQ. 0 ))GOTO 23910 OUT(1) = 0 TRAN1=(0) RETURN 23910 CONTINUE DSC1(2) = %LOC(BUF1) DSC2(2) = %LOC(BUF2) CALL STRCPY( IN, BUF1) DSC1(1) = LENGTH(BUF1) DSC2(1) = 64 STATUS = SYS$TRNLOG( DSC1, DSC2(1), DSC2, , , ) BUF2( DSC2(1) + 1 ) = 0 IF (.NOT.( BUF2(1) .EQ. 27 ))GOTO 23912 DSC2(1) = DSC2(1) - 4 CALL SCOPY( BUF2, 5, BUF2, 1) 23912 CONTINUE N = LENGTH(BUF2) IF (.NOT.( BUF2(N) .EQ. 58 ))GOTO 23914 BUF2(N) = 0 23914 CONTINUE CALL STRCPY( BUF2, OUT) IF (.NOT.( STATUS .EQ. 1577 ))GOTO 23916 TRAN1=(0) RETURN 23916 CONTINUE TRAN1=(1) RETURN 23917 CONTINUE END INTEGER FUNCTION TRMLST( USER, TLIST) LOGICAL*1 USER(2048), TLIST(2048) LOGICAL*1 IMAGE(480) LOGICAL*1 CMD(2048), PID(9), SCRFIL(480) LOGICAL*1 LIN(2048), NAME(480), TERM(480) INTEGER FD INTEGER OPEN INTEGER I, JUNK, TCNT, TNDX INTEGER EQUAL, GETLIN, GETWRD, LOCCOM, SPAWN, REMOVE LOGICAL*1 PATH(24) LOGICAL*1 SUFFIX(7) LOGICAL*1 BLKGTR(3) LOGICAL*1 WHOSTR(4) LOGICAL*1 ST00SZ(22) LOGICAL*1 ST00TZ(26) DATA PATH(1)/0/,PATH(2)/126/,PATH(3)/47/,PATH(4)/116/,PATH(5)/111/ *,PATH(6)/111/,PATH(7)/108/,PATH(8)/115/,PATH(9)/47/,PATH(10)/0/,PA *TH(11)/126/,PATH(12)/117/,PATH(13)/115/,PATH(14)/114/,PATH(15)/47/ *,PATH(16)/0/,PATH(17)/126/,PATH(18)/98/,PATH(19)/105/,PATH(20)/110 */,PATH(21)/47/,PATH(22)/0/,PATH(23)/10/,PATH(24)/0/ DATA SUFFIX(1)/46/,SUFFIX(2)/101/,SUFFIX(3)/120/,SUFFIX(4)/101/,SU *FFIX(5)/0/,SUFFIX(6)/10/,SUFFIX(7)/0/ DATA BLKGTR(1)/32/,BLKGTR(2)/62/,BLKGTR(3)/0/ DATA WHOSTR(1)/119/,WHOSTR(2)/104/,WHOSTR(3)/111/,WHOSTR(4)/0/ DATA ST00SZ(1)/63/,ST00SZ(2)/32/,ST00SZ(3)/67/,ST00SZ(4)/97/,ST00S *Z(5)/110/,ST00SZ(6)/39/,ST00SZ(7)/116/,ST00SZ(8)/32/,ST00SZ(9)/115 */,ST00SZ(10)/112/,ST00SZ(11)/97/,ST00SZ(12)/119/,ST00SZ(13)/110/,S *T00SZ(14)/32/,ST00SZ(15)/96/,ST00SZ(16)/96/,ST00SZ(17)/119/,ST00SZ *(18)/104/,ST00SZ(19)/111/,ST00SZ(20)/39/,ST00SZ(21)/39/,ST00SZ(22) */0/ DATA ST00TZ(1)/63/,ST00TZ(2)/32/,ST00TZ(3)/67/,ST00TZ(4)/97/,ST00T *Z(5)/110/,ST00TZ(6)/39/,ST00TZ(7)/116/,ST00TZ(8)/32/,ST00TZ(9)/114 */,ST00TZ(10)/101/,ST00TZ(11)/97/,ST00TZ(12)/100/,ST00TZ(13)/32/,ST *00TZ(14)/115/,ST00TZ(15)/99/,ST00TZ(16)/114/,ST00TZ(17)/97/,ST00TZ *(18)/116/,ST00TZ(19)/99/,ST00TZ(20)/104/,ST00TZ(21)/32/,ST00TZ(22) */102/,ST00TZ(23)/105/,ST00TZ(24)/108/,ST00TZ(25)/101/,ST00TZ(26)/0 */ CALL SCRATF( WHOSTR, SCRFIL) JUNK = LOCCOM( WHOSTR, PATH, SUFFIX, IMAGE) I = 1 CALL STCOPY( WHOSTR, 1, CMD, I) CALL CHCOPY( 32, CMD, I) CALL STCOPY( USER, 1, CMD, I) CALL STCOPY( BLKGTR, 1, CMD, I) CALL STCOPY( SCRFIL, 1, CMD, I) IF (.NOT.( SPAWN( IMAGE, CMD, PID, 119) .EQ. -3 ))GOTO 23918 CALL ERROR(ST00SZ) GOTO 23919 23918 CONTINUE FD = OPEN( SCRFIL, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23920 CALL ERROR(ST00TZ) 23920 CONTINUE TCNT = 0 TNDX = 1 CALL FOLD(USER) 23922 IF (.NOT.( GETLIN( LIN, FD) .NE. -1 ))GOTO 23923 I = 1 CALL FOLD(LIN) JUNK = GETWRD( LIN, I, TERM) JUNK = GETWRD( LIN, I, NAME) IF (.NOT.( EQUAL( USER, NAME) .EQ. 1 ))GOTO 23924 IF (.NOT.( TNDX .GT. 1 ))GOTO 23926 CALL CHCOPY( 32, TLIST, TNDX) 23926 CONTINUE CALL STCOPY( TERM, 1, TLIST, TNDX) TCNT = TCNT + 1 23924 CONTINUE GOTO 23922 23923 CONTINUE CALL CLOSE(FD) JUNK = REMOVE(SCRFIL) 23919 CONTINUE TRMLST=(TCNT) RETURN END INTEGER FUNCTION TRNLOG( IN, OUT) LOGICAL*1 BUF1(64), BUF2(64), IN(100), OUT(100) INTEGER D1(2), D2(2), N, STATUS INTEGER LENGTH, SYS$TRNLOG D1(2) = %LOC(BUF1) D2(2) = %LOC(BUF2) CALL STRCPY( IN, BUF1) D1(1) = LENGTH(IN) 23928 CONTINUE D2(1) = 64 STATUS = SYS$TRNLOG( D1, N, D2, , , %VAL(0) ) BUF2( N + 1 ) = 0 IF (.NOT.( BUF2(1) .EQ. 27 ))GOTO 23931 N = N - 4 CALL SCOPY( BUF2, 5, BUF2, 1) 23931 CONTINUE D1(1) = N CALL STRCPY( BUF2, BUF1) 23929 IF (.NOT.( STATUS .EQ. 1577 ))GOTO 23928 23930 CONTINUE CALL STRCPY( BUF1, OUT) TRNLOG=( D1(1) ) RETURN END SUBROUTINE UNIQUE(BUF) LOGICAL*1 BUF(2048) INTEGER MYPID CALL GETPID(MYPID) CALL PUTHEX(MYPID, BUF) RETURN END INTEGER FUNCTION WRITEF( BUF, N, FD) LOGICAL*1 BUF(2048) INTEGER FD INTEGER N INTEGER PUTS INTEGER LFN INTEGER LASTC INTEGER FDB INTEGER RAWCHN INTEGER BCOUNT INTEGER CHSTAT INTEGER CHTIMO LOGICAL*1 IMP_CTRL LOGICAL*1 MODE LOGICAL*1 FILACC LOGICAL*1 FLTYPE LOGICAL*1 CHTYPE LOGICAL*1 FILENM LOGICAL*1 BUFFER INTEGER NEW_VERSIONS COMMON / IO / LFN(15), LASTC(15), FDB(15), RAWCHN(15), BCOUNT(15), * CHSTAT(15), CHTIMO(15), IMP_CTRL(15), MODE(15), FILACC(15), FLTYP *E(15), CHTYPE(15), FILENM(480, 15), BUFFER(2048, 15), NEW_VERSIONS IF (.NOT.( 1 .LE. FD .AND. FD .LE. 15 ))GOTO 23933 IF (.NOT.( LFN(FD) .NE. 0 ))GOTO 23935 IF (.NOT.( PUTS( FDB(FD), BUF, N) .NE. -3 ))GOTO 23937 WRITEF=(N) RETURN 23937 CONTINUE 23935 CONTINUE 23933 CONTINUE WRITEF=(-3) RETURN END SUBROUTINE WTMSEC(N) INTEGER JUNK, M, N, TIMER_EFN INTEGER LIB$GET_EF, SYSTIM(2) DATA SYSTIM(2) / -1 / , TIMER_EFN / 0 / IF (.NOT.( TIMER_EFN .EQ. 0 ))GOTO 23939 JUNK = LIB$GET_EF( TIMER_EFN ) 23939 CONTINUE M = MAX( N, 1) M = MIN( M, 1000) SYSTIM(1) = M * -10000 CALL SYS$SETIMR( %VAL( TIMER_EFN ), SYSTIM, , ) CALL SYS$WAITFR( %VAL( TIMER_EFN ) ) RETURN END LOGICAL*1 FUNCTION LSTCHR(BUF) LOGICAL*1 BUF(2048), C INTEGER I C = 0 I=1 23941 IF (.NOT.(BUF(I) .NE. 0))GOTO 23943 C = BUF(I) 23942 I=I+1 GOTO 23941 23943 CONTINUE LSTCHR=(C) RETURN END SUBROUTINE DSPPRV(WHICH_PRIV) LOGICAL*1 BUF(1280), WORD(20), OUT(2048), ARG(480) INTEGER PID, NXTCOL, I, J, N, STATUS, WHICH_PRIV, K INTEGER GET_PRIV LOGICAL*1 BLANKS(20) LOGICAL*1 DIVIDE(55) LOGICAL*1 ST010Z(39) INTEGER I23946 LOGICAL*1 ST011Z(9) LOGICAL*1 ST012Z(8) LOGICAL*1 ST013Z(9) LOGICAL*1 ST014Z(9) DATA BLANKS(1)/32/,BLANKS(2)/32/,BLANKS(3)/32/,BLANKS(4)/32/,BLANK *S(5)/32/,BLANKS(6)/32/,BLANKS(7)/32/,BLANKS(8)/32/,BLANKS(9)/32/,B *LANKS(10)/32/,BLANKS(11)/32/,BLANKS(12)/32/,BLANKS(13)/32/,BLANKS( *14)/32/,BLANKS(15)/32/,BLANKS(16)/32/,BLANKS(17)/32/,BLANKS(18)/32 */,BLANKS(19)/32/,BLANKS(20)/0/ DATA DIVIDE(1)/32/,DIVIDE(2)/32/,DIVIDE(3)/32/,DIVIDE(4)/32/,DIVID *E(5)/32/,DIVIDE(6)/32/,DIVIDE(7)/32/,DIVIDE(8)/32/,DIVIDE(9)/32/,D *IVIDE(10)/32/,DIVIDE(11)/32/,DIVIDE(12)/32/,DIVIDE(13)/32/,DIVIDE( *14)/32/,DIVIDE(15)/32/,DIVIDE(16)/32/,DIVIDE(17)/32/,DIVIDE(18)/32 */,DIVIDE(19)/32/,DIVIDE(20)/45/,DIVIDE(21)/45/,DIVIDE(22)/45/,DIVI *DE(23)/45/,DIVIDE(24)/45/,DIVIDE(25)/45/,DIVIDE(26)/45/,DIVIDE(27) */45/,DIVIDE(28)/45/,DIVIDE(29)/45/,DIVIDE(30)/45/,DIVIDE(31)/45/,D *IVIDE(32)/45/,DIVIDE(33)/45/,DIVIDE(34)/45/,DIVIDE(35)/45/,DIVIDE( *36)/45/,DIVIDE(37)/45/,DIVIDE(38)/45/,DIVIDE(39)/45/,DIVIDE(40)/45 */,DIVIDE(41)/45/,DIVIDE(42)/45/,DIVIDE(43)/45/,DIVIDE(44)/45/,DIVI *DE(45)/45/,DIVIDE(46)/45/,DIVIDE(47)/45/,DIVIDE(48)/45/,DIVIDE(49) */45/,DIVIDE(50)/45/,DIVIDE(51)/45/,DIVIDE(52)/45/,DIVIDE(53)/45/,D *IVIDE(54)/10/,DIVIDE(55)/0/ DATA ST010Z(1)/58/,ST010Z(2)/32/,ST010Z(3)/69/,ST010Z(4)/114/,ST01 *0Z(5)/114/,ST010Z(6)/111/,ST010Z(7)/114/,ST010Z(8)/32/,ST010Z(9)/1 *03/,ST010Z(10)/101/,ST010Z(11)/116/,ST010Z(12)/116/,ST010Z(13)/105 */,ST010Z(14)/110/,ST010Z(15)/103/,ST010Z(16)/32/,ST010Z(17)/112/,S *T010Z(18)/114/,ST010Z(19)/105/,ST010Z(20)/118/,ST010Z(21)/101/,ST0 *10Z(22)/108/,ST010Z(23)/101/,ST010Z(24)/103/,ST010Z(25)/101/,ST010 *Z(26)/115/,ST010Z(27)/32/,ST010Z(28)/102/,ST010Z(29)/111/,ST010Z(3 *0)/114/,ST010Z(31)/32/,ST010Z(32)/112/,ST010Z(33)/114/,ST010Z(34)/ *111/,ST010Z(35)/99/,ST010Z(36)/101/,ST010Z(37)/115/,ST010Z(38)/115 */,ST010Z(39)/0/ DATA ST011Z(1)/97/,ST011Z(2)/117/,ST011Z(3)/116/,ST011Z(4)/104/,ST *011Z(5)/112/,ST011Z(6)/114/,ST011Z(7)/105/,ST011Z(8)/118/,ST011Z(9 *)/0/ DATA ST012Z(1)/99/,ST012Z(2)/117/,ST012Z(3)/114/,ST012Z(4)/112/,ST *012Z(5)/114/,ST012Z(6)/105/,ST012Z(7)/118/,ST012Z(8)/0/ DATA ST013Z(1)/105/,ST013Z(2)/109/,ST013Z(3)/97/,ST013Z(4)/103/,ST *013Z(5)/112/,ST013Z(6)/114/,ST013Z(7)/105/,ST013Z(8)/118/,ST013Z(9 *)/0/ DATA ST014Z(1)/112/,ST014Z(2)/114/,ST014Z(3)/111/,ST014Z(4)/99/,ST *014Z(5)/112/,ST014Z(6)/114/,ST014Z(7)/105/,ST014Z(8)/118/,ST014Z(9 *)/0/ CALL GETPID(PID) IF (.NOT.(GET_PRIV(WHICH_PRIV, PID, ARG, BUF) .EQ. -3))GOTO 23944 CALL PUTLIN(ARG, 3) CALL REMARK(ST010Z) GOTO 23945 23944 CONTINUE CALL INPACK(NXTCOL, 80, OUT, 3) CALL PUTLIN(BLANKS, 3) CALL PUTSTR(ARG, -17, 3) CALL PUTHEX(PID, ARG) CALL PUTLIN(ARG, 3) CALL PUTCH(32, 3) I23946=(WHICH_PRIV) GOTO 23946 23948 CONTINUE CALL PUTLIN(ST011Z, 3) GOTO 23947 23949 CONTINUE CALL PUTLIN(ST012Z, 3) GOTO 23947 23950 CONTINUE CALL PUTLIN(ST013Z, 3) GOTO 23947 23951 CONTINUE CALL PUTLIN(ST014Z, 3) GOTO 23947 23946 CONTINUE IF (I23946.EQ.516)GOTO 23951 IF (I23946.EQ.1024)GOTO 23949 IF (I23946.EQ.1042)GOTO 23948 IF (I23946.EQ.1043)GOTO 23950 23947 CONTINUE CALL PUTCH(10, 3) CALL PUTLIN(DIVIDE, 3) I=1 23952 IF (.NOT.(BUF(I) .NE. 10))GOTO 23954 J=1 23955 IF (.NOT.(BUF(I) .NE. 0))GOTO 23957 CALL CHCOPY(BUF(I), WORD, J) 23956 I=I+1 GOTO 23955 23957 CONTINUE WORD(J) = 0 I = I + 1 CALL DOPACK(WORD, NXTCOL, 80, OUT, 3) 23953 GOTO 23952 23954 CONTINUE CALL FLPACK(NXTCOL, 80, OUT, 3) CALL PUTCH(10, 3) 23945 CONTINUE RETURN END SUBROUTINE PR_INSTAL(NAME, DEFN) LOGICAL*1 DEFN(2048), NAME(2048) INTEGER LENGTH INTEGER DLEN, NLEN INTEGER LASTP INTEGER LASTT INTEGER NAMPTR LOGICAL*1 TABLE LOGICAL*1 ST015Z(23) COMMON / PR_CLOOK / LASTP, LASTT, NAMPTR( 2500), TABLE(62500) DATA ST015Z(1)/58/,ST015Z(2)/32/,ST015Z(3)/116/,ST015Z(4)/111/,ST0 *15Z(5)/111/,ST015Z(6)/32/,ST015Z(7)/109/,ST015Z(8)/97/,ST015Z(9)/1 *10/,ST015Z(10)/121/,ST015Z(11)/32/,ST015Z(12)/100/,ST015Z(13)/101/ *,ST015Z(14)/102/,ST015Z(15)/105/,ST015Z(16)/110/,ST015Z(17)/105/,S *T015Z(18)/116/,ST015Z(19)/105/,ST015Z(20)/111/,ST015Z(21)/110/,ST0 *15Z(22)/115/,ST015Z(23)/0/ NLEN = LENGTH(NAME) + 1 DLEN = LENGTH(DEFN) + 1 IF (.NOT.(LASTT + NLEN + DLEN .GT. 62500 .OR. LASTP .GE. 2500))GO *TO 23958 CALL PUTLIN(NAME, 3) CALL PUTLNL(ST015Z, 3) RETURN 23958 CONTINUE LASTP = LASTP + 1 NAMPTR(LASTP) = LASTT + 1 CALL SCOPY(NAME, 1, TABLE, LASTT+1) CALL SCOPY(DEFN, 1, TABLE, LASTT+NLEN+1) LASTT = LASTT + NLEN + DLEN RETURN END INTEGER FUNCTION PR_LOOKUP(NAME, DEFN) LOGICAL*1 NAME(2048), DEFN(2048) INTEGER I, J, K INTEGER LASTP INTEGER LASTT INTEGER NAMPTR LOGICAL*1 TABLE COMMON / PR_CLOOK / LASTP, LASTT, NAMPTR( 2500), TABLE(62500) I = LASTP 23960 IF (.NOT.(I .GT. 0))GOTO 23962 J = NAMPTR(I) K = 1 23963 IF (.NOT.(NAME(K) .EQ. TABLE(J) .AND. NAME(K) .NE. 0))GOTO 23965 J = J + 1 23964 K = K + 1 GOTO 23963 23965 CONTINUE IF (.NOT.(NAME(K) .EQ. TABLE(J)))GOTO 23966 CALL SCOPY(TABLE, J+1, DEFN, 1) PR_LOOKUP=(1) RETURN 23966 CONTINUE 23961 I = I - 1 GOTO 23960 23962 CONTINUE PR_LOOKUP=(0) RETURN END