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.0 C C Date: May 14, 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 BYTE FILE(134), OUTBUF(134), OUTTXT(134), FILENV(134), ANS(2) BYTE NODE(1), DEV(6), UIC(10), NAME(10), EXT(5) INTEGER EQUAL, BKSCAN, CONCAT, NF, I, J, FOUT, IS, IER, K BYTE CUPPER LOGICAL GETFIL, PROMPT DATA NODE(1), DEV(1), UIC(1), NAME(1), EXT(1)/5*0/ FOUT = 5 open(unit=fout, name='TI:', carriagecontrol='LIST') C no such file CALL ERRSET(29, .TRUE., .FALSE., .TRUE., .FALSE., 15) C open failure CALL ERRSET(30, .TRUE., .FALSE., .TRUE., .FALSE., 15) C file name specification CALL ERRSET(43, .TRUE., .FALSE., .FALSE., .FALSE., 15) 2000 CONTINUE CLOSE(UNIT = 2) FOUT = 5 CALL GCMD(5, 'SRDCMD> ', OUTTXT, NC, 134, IS) IF (.NOT.(NC .LE. 0)) GOTO 2030 GOTO 2020 2030 CONTINUE ANS(1) = 0 PROMPT = .FALSE. 2050 CONTINUE CALL PARSE(OUTTXT, FILE) IF (.NOT.(EQUAL(FILE, '/PR') .EQ. 1)) GOTO 2080 PROMPT = .TRUE. GOTO 2090 2080 CONTINUE IF (.NOT.(EQUAL(FILE, '/GO') .EQ. 1)) GOTO 2100 PROMPT = .TRUE. ANS(1) = 'G' GOTO 2110 2100 CONTINUE GOTO 2070 2110 CONTINUE 2090 CONTINUE 2060 GOTO 2050 2070 CONTINUE NF = 0 2120 IF (.NOT.(GETFIL(FILE, ANS, NF, PROMPT))) GOTO 2130 NODE(1) = 0 DEV(1) = 0 UIC(1) = 0 NAME(1) = 0 EXT(1) = 0 CALL DEFNAM(FILE, NODE, DEV, UIC, NAME, EXT, .TRUE.) CALL SCOPY(FILE, 1, FILENV, 1) FILENV(BKSCAN(FILENV, ';', 1)) = 0 J = 1 I = 1 2140 IF (.NOT.(OUTTXT(I) .NE. 0 .AND. J .LT. 134)) GOTO 2160 IF (.NOT.(OUTTXT(I) .EQ. '>')) GOTO 2170 K = I I = I + 1 IF (.NOT.(OUTTXT(I) .EQ. '>')) GOTO 2190 I = I + 1 IF (.NOT.(OUTTXT(I) .EQ. 0)) GOTO 2210 GOTO 10 2210 CONTINUE CALL DEFNAM(OUTTXT(I), 0, 'SY:', 0, 0, '.CMD', .FALSE.) OPEN(UNIT = 2, NAME = OUTTXT(I), TYPE = 'unknown', ACCES *S = 'append', CARRIAGECONTROL = 'list', ERR = 10) GOTO 2200 2190 CONTINUE IF (.NOT.(OUTTXT(I) .EQ. 0)) GOTO 2230 GOTO 10 2230 CONTINUE CALL DEFNAM(OUTTXT(I), 0, 'SY:', 0, 0, '.CMD', .FALSE.) OPEN(UNIT = 2, NAME = OUTTXT(I), TYPE = 'new', CARRIAGEC *ONTROL = 'list', ERR = 10) 2200 CONTINUE FOUT = 2 OUTTXT(K) = 0 GOTO 2160 2170 CONTINUE IF (.NOT.(OUTTXT(I) .NE. '''')) GOTO 2250 OUTBUF(J) = OUTTXT(I) J = J + 1 GOTO 2260 2250 CONTINUE I = I + 1 OUTBUF(J) = 0 IF (.NOT.(OUTTXT(I) .EQ. 0)) GOTO 2270 GOTO 2160 2270 CONTINUE IF (.NOT.(OUTTXT(I) .EQ. '&')) GOTO 2290 J = CONCAT(OUTBUF, FILENV, 134) + 1 GOTO 2300 2290 CONTINUE IF (.NOT.(CUPPER(OUTTXT(I)) .EQ. 'D')) GOTO 2310 J = CONCAT(OUTBUF, DEV, 134) + 1 GOTO 2320 2310 CONTINUE IF (.NOT.(CUPPER(OUTTXT(I)) .EQ. 'U')) GOTO 2330 J = CONCAT(OUTBUF, UIC, 134) + 1 GOTO 2340 2330 CONTINUE IF (.NOT.(CUPPER(OUTTXT(I)) .EQ. 'N')) GOTO 2350 J = CONCAT(OUTBUF, NAME, 134) + 1 GOTO 2360 2350 CONTINUE IF (.NOT.(CUPPER(OUTTXT(I)) .EQ. 'E')) GOTO 23 *70 J = CONCAT(OUTBUF, EXT, 134) + 1 GOTO 2380 2370 CONTINUE IF (.NOT.(CUPPER(OUTTXT(I)) .EQ. 'V')) GOTO *2390 J = CONCAT(OUTBUF, FILE(BKSCAN(FILE, ';', *1)), 134) + 1 GOTO 2400 2390 CONTINUE OUTBUF(J) = OUTTXT(I) J = J + 1 2400 CONTINUE 2380 CONTINUE 2360 CONTINUE 2340 CONTINUE 2320 CONTINUE 2300 CONTINUE 2280 CONTINUE 2260 CONTINUE 2180 CONTINUE 2150 I = I + 1 GOTO 2140 2160 CONTINUE CALL PUT(FOUT, OUTBUF, J - 1, IER) GOTO 2120 2130 CONTINUE GOTO 2010 10 CONTINUE CALL ERR(OUTTXT, I, 'Can''t open file.') 2010 IF (.NOT.(IS .LT. 0)) GOTO 2000 2020 CONTINUE C command was from MCR END C bkscan - return index of first break char in str INTEGER FUNCTION BKSCAN(STR, BRK, I) BYTE STR(1), BRK(1) INTEGER INDEX, I BKSCAN = I 2410 IF (.NOT.(STR(BKSCAN) .NE. 0)) GOTO 2430 IF (.NOT.(INDEX(BRK, STR(BKSCAN)) .NE. 0)) GOTO 2440 GOTO 2430 2440 CONTINUE 2420 BKSCAN = BKSCAN + 1 GOTO 2410 2430 CONTINUE RETURN END C scan - return index of first char in str which isn't in scstr INTEGER FUNCTION SCAN(STR, SCSTR, I) BYTE STR(1), SCSTR(1) INTEGER INDEX, I SCAN = I 2460 IF (.NOT.(STR(SCAN) .NE. 0)) GOTO 2480 IF (.NOT.(INDEX(SCSTR, STR(SCAN)) .EQ. 0)) GOTO 2490 GOTO 2480 2490 CONTINUE 2470 SCAN = SCAN + 1 GOTO 2460 2480 CONTINUE RETURN END C index - find character c in string str INTEGER FUNCTION INDEX(STR, C) BYTE C, STR(1) INDEX = 1 2510 IF (.NOT.(STR(INDEX) .NE. 0)) GOTO 2530 IF (.NOT.(STR(INDEX) .EQ. C)) GOTO 2540 RETURN 2540 CONTINUE 2520 INDEX = INDEX + 1 GOTO 2510 2530 CONTINUE INDEX = 0 RETURN END C concat - concatenate two strings INTEGER FUNCTION CONCAT(S1, S2, LIM) BYTE S1(1), S2(1) INTEGER LIM, I, LENGTH, L L = LENGTH(S1) I = L + 1 2560 IF (.NOT.(I .LT. LIM .AND. S2(I-L) .NE. 0)) GOTO 2580 S1(I) = S2(I - L) 2570 I = I + 1 GOTO 2560 2580 CONTINUE S1(I) = 0 CONCAT = I - 1 RETURN END C length - compute length of string INTEGER FUNCTION LENGTH(STR) C integer->character BYTE STR(1) LENGTH = 0 2590 IF (.NOT.(STR(LENGTH+1) .NE. 0)) GOTO 2610 2600 LENGTH = LENGTH + 1 GOTO 2590 2610 CONTINUE RETURN END C cupper - change letter to upper case BYTE FUNCTION CUPPER(C) BYTE C IF (.NOT.(C .GE. 'a' .AND. C .LE. 'z')) GOTO 2620 CUPPER = C - 'a' + 'A' GOTO 2630 2620 CONTINUE CUPPER = C 2630 CONTINUE RETURN END C equal - compare str1 to str2; return YES if equal, NO if not INTEGER FUNCTION EQUAL(STR1, STR2) BYTE STR1(1), STR2(1) INTEGER I I = 1 2640 IF (.NOT.(STR1(I) .EQ. STR2(I))) GOTO 2660 IF (.NOT.(STR1(I) .EQ. 0)) GOTO 2670 EQUAL = 1 RETURN 2670 CONTINUE 2650 I = I + 1 GOTO 2640 2660 CONTINUE EQUAL = 0 RETURN END C scopy - copy string at from(i) to to(j) SUBROUTINE SCOPY(FROM, I, TO, J) BYTE FROM(1), TO(1) INTEGER I, J, K1, K2 K2 = J K1 = I 2690 IF (.NOT.(FROM(K1) .NE. 0)) GOTO 2710 TO(K2) = FROM(K1) K2 = K2 + 1 2700 K1 = K1 + 1 GOTO 2690 2710 CONTINUE TO(K2) = 0 RETURN END C defnam - provide defaults for file name, reset new defaults SUBROUTINE DEFNAM(FILE, NODE, DEV, UIC, NAME, EXT, RESET) BYTE FILE(34) BYTE NODE(1), DEV(6), UIC(10), NAME(10), EXT(5) BYTE TEMP(34) LOGICAL RESET INTEGER L, J INTEGER INDEX, BKSCAN, CONCAT, SCAN TEMP(1) = 0 J = CONCAT(TEMP, FILE(SCAN(FILE, ' ', 1)), 34) FILE(1) = 0 J = 1 L = 0 CALL ADSTR(INDEX(TEMP(J), ':'), J, L, FILE, TEMP, DEV, 6 - 1, RESE *T) CALL ADSTR(INDEX(TEMP(J), ']'), J, L, FILE, TEMP, UIC, 10 - 1, RES *ET) CALL ADSTR(BKSCAN(TEMP, ' .;', J) - J, J, L, FILE, TEMP, NAME, 10 *- 1, RESET) CALL ADSTR(BKSCAN(TEMP, ' ;', J) - J, J, L, FILE, TEMP, EXT, 5 - 1 *, RESET) C append possible version L = CONCAT(FILE, TEMP(J), 34) RETURN END C adstr - support routine for defnam SUBROUTINE ADSTR(I, J, L, FILE, TFILE, STR, MXSTR, RESET) INTEGER I, J, L, MXSTR, K INTEGER CONCAT, SCAN BYTE FILE(1), TFILE(1), STR(1) LOGICAL RESET IF (.NOT.(I .EQ. 0)) GOTO 2720 L = CONCAT(FILE, STR, 34) GOTO 2730 2720 CONTINUE K = MIN0(MXSTR, I) L = CONCAT(FILE, TFILE(J), L + 1 + K) J = SCAN(TFILE, ' ', J + I) IF (.NOT.(RESET)) GOTO 2740 CALL SCOPY(FILE, L + 1 - K, STR, 1) 2740 CONTINUE 2730 CONTINUE RETURN END