C define(VAX) C location of system-wide "SYMBOLS." file C maximum field for integer strings C must be highest lu for standard files C C C C SRD command line generator C ========================== C C Author: William Wood C C Address: Computer Center C Institute For Cancer Research C 7701 Burholme Ave. C Philadelphia, Pa. 19111 C (215) 728 2760 C C Version: 1.1 C C Date: Dec 28, 1981 C C C C ******************************************************* C * * C * THIS SOFTWARE WAS DEVELOPED WITH SUPPORT * C * FROM THE NATIONAL INSTITUTES OF HEALTH: * C * NIH CA06927 * C * NIH CA22780 * C * * C * DIRECT INQUIRIES TO: * C * COMPUTER CENTER * C * THE INSTITUTE FOR CANCER RESEARCH * C * 7701 BURHOLME AVENUE * C * PHILADELPHIA, PENNSYLVANIA 19111 * C * * C * NO WARRANTY OR REPRESENTATION, EXPRESS OR * C * IMPLIED, IS MADE WITH RESPECT TO THE * C * CORRECTNESS, COMPLETENESS, OR USEFULNESS * C * OF THIS SOFTWARE, NOR THAT USE OF THIS * C * SOFTWARE MIGHT NOT INFRINGE PRIVATELY * C * OWNED RIGHTS. * C * * C * NO LIABILITY IS ASSUMED WITH RESPECT TO * C * THE USE OF, OR FOR DAMAGES RESULTING FROM * C * THE USE OF THIS SOFTWARE * C * * C ******************************************************* C * * C * THIS SOFTWARE WAS DESIGNED FOR USE ON A * C * PDP-11/70 OPERATING UNDER IAS V3.0 USING * C * THE FORTRAN-IV PLUS COMPILER. * C * * C ******************************************************* C C parse - return first arg in comand and delete it from comand SUBROUTINE PARSE(COMAND, ARG) BYTE COMAND(1), ARG(1) INTEGER J BYTE CUPPER J = 1 2000 IF (.NOT.(COMAND(J) .NE. ' ' .AND. COMAND(J) .NE. 0 .AND. (COMAND( *J) .NE. '/' .OR. J .EQ. 1 .OR. COMAND(1) .NE. '/'))) GOTO 2010 ARG(J) = CUPPER(COMAND(J)) J = J + 1 GOTO 2000 2010 CONTINUE ARG(J) = 0 IF (.NOT.(COMAND(J) .EQ. ' ')) GOTO 2020 J = J + 1 2020 CONTINUE CALL SCOPY(COMAND, J, COMAND, 1) RETURN END C getfil - return selected file names one at a time from a list of file specs C separated by commas. C File specs may be a simple file name, or they may reference C an indirect file if @ is specified, or C if the SRD option is in use, file names may be selected by C an SRD pattern. LOGICAL FUNCTION GETFIL(FILE, ANS, NSELEC, PROMPT) BYTE FILE(1), ANS(2), TERMC, TFILE(134), FILIST(134) INTEGER NSELEC, NC, NAME, IP, J, I, NFILE LOGICAL PROMPT, ISLIST, INBRAK INTEGER BKSCAN, LENGTH BYTE CUPPER IF (.NOT.(NSELEC .EQ. 0)) GOTO 2040 IP = 0 CALL SCOPY(FILE, 1, FILIST, 1) NFILE = 0 ISLIST = .FALSE. 2040 CONTINUE 2060 CONTINUE IF (.NOT.(NFILE .EQ. 0)) GOTO 2090 INBRAK = .FALSE. J = IP + 1 2110 IF (.NOT.(FILIST(J) .NE. 0 .AND. (INBRAK .OR. FILIST(J) .NE. ' *,'))) GOTO 2130 IF (.NOT.(FILIST(J) .EQ. '[')) GOTO 2140 INBRAK = .TRUE. GOTO 2150 2140 CONTINUE IF (.NOT.(FILIST(J) .EQ. ']')) GOTO 2160 INBRAK = .FALSE. 2160 CONTINUE 2150 CONTINUE 2120 J = J + 1 GOTO 2110 2130 CONTINUE IF (.NOT.(FILIST(J) .EQ. ',')) GOTO 2180 C this is a list of file names ISLIST = .TRUE. 2180 CONTINUE DO 2200 I = IP + 1, J FILE(I - IP) = FILIST(I) 2200 CONTINUE FILE(J - IP) = 0 IP = J NAME = 0 IF (.NOT.(FILE(1) .EQ. '@')) GOTO 2220 C Indirect file name? NAME = 2 GOTO 2230 2220 CONTINUE IF (.NOT.(FILE(BKSCAN(FILE, '/*?', 1)) .NE. 0)) GOTO 2240 C SRD wild card or switch? NAME = 1 2240 CONTINUE 2230 CONTINUE 2090 CONTINUE NC = 0 IF (.NOT.(NAME .EQ. 0 .AND. .NOT.ISLIST)) GOTO 2260 NFILE = 1 - NFILE GOTO 2270 2260 CONTINUE 2280 CONTINUE IF (.NOT.(NAME .EQ. 1)) GOTO 2310 CALL FNDFIL(1, FILE, TFILE, NFILE) GOTO 2320 2310 CONTINUE IF (.NOT.(NAME .EQ. 2)) GOTO 2330 CALL READF(1, FILE, TFILE, NFILE) GOTO 2320 2330 CONTINUE NFILE = 1 - NFILE CALL SCOPY(FILE, 1, TFILE, 1) 2320 CONTINUE IF (.NOT.(NFILE .GT. 0)) GOTO 2350 CALL SCOPY(TFILE, 1, FILE, 1) IF (.NOT.(PROMPT)) GOTO 2370 IF (.NOT.(ANS(1) .NE. 'G')) GOTO 2390 2410 CONTINUE CALL READPR(5, FILE, ANS, NC, 2, TERMC) 2420 IF (.NOT.(NC .EQ. -10 .OR. NC .GE. 0)) GOTO 2410 ANS(1) = CUPPER(ANS(1)) GOTO 2400 2390 CONTINUE CALL PUT(5, FILE, LENGTH(FILE), IER) 2400 CONTINUE 2370 CONTINUE 2350 CONTINUE 2290 IF (.NOT.(NFILE .LE. 0 .OR. NC .EQ. -10 .OR. ANS(1) .EQ. 'G' . *OR. (NC .GT. 0 .AND. ANS(1) .EQ. 'Y') .OR. .NOT.PROMPT)) GOTO 2280 2270 CONTINUE 2070 IF (.NOT.(NFILE .GT. 0 .OR. FILIST(IP) .EQ. 0 .OR. NC .EQ. -10)) G *OTO 2060 GETFIL = NFILE .GT. 0 .AND. NC .NE. - 10 IF (.NOT.(GETFIL)) GOTO 2440 NSELEC = NSELEC + 1 2440 CONTINUE IF (.NOT.(NC .EQ. -10)) GOTO 2460 CLOSE(UNIT = 1) 2460 CONTINUE RETURN END C readf - read in file names from indirect file SUBROUTINE READF(F, FILE, OUTFIL, NSELEC) INTEGER F, NSELEC, NC BYTE FILE(1), OUTFIL(1) IF (.NOT.(NSELEC .EQ. 0)) GOTO 2480 CALL DEFNAM(FILE(2), 0, 'SY:', 0, 0, '.', .FALSE.) CLOSE(UNIT = F) open(unit=f, name=file(2), type='old', readonly, shared, err=10) 2480 CONTINUE 2500 CONTINUE CALL GET(F, OUTFIL, 134 - 1, NC) 2510 IF (.NOT.(NC .NE. 0)) GOTO 2500 IF (.NOT.(NC .LT. 0)) GOTO 2530 NSELEC = 0 CLOSE(UNIT = F) GOTO 2540 2530 CONTINUE NSELEC = NSELEC + 1 OUTFIL(NC + 1) = 0 2540 CONTINUE RETURN 10 CONTINUE CALL ERR(FILE, 2, 'Can''t open file.') RETURN END C err - put out error message SUBROUTINE ERR(COMAND, CP, MSG) INTEGER CP, IER, J, K, L, SCRWID INTEGER LENGTH BYTE COMAND(1), MSG(1) DATA SCRWID/80/ J = MOD(CP - 1, SCRWID) + 1 L = LENGTH(COMAND) K = MIN0(CP + SCRWID - J, L) CALL PUT(5, COMAND, K, IER) ENCODE(J, 10, COMAND) 10 format(t,'^') CALL PUT(5, COMAND, J, IER) IF (.NOT.(K .LT. L)) GOTO 2550 CALL PUT(5, COMAND(K + 1), L - K, IER) 2550 CONTINUE CALL PUT(5, MSG, LENGTH(MSG), IER) COMAND(CP) = ERROR RETURN END