C max card size C maximum field for integer strings C must be 2 more than MAXCARD C must be highest lu for standard files C C C C RATFIV structured Fortran compiler C ================================== C C Authors: Original by B. Kernighan and P. J. Plauger, C with rewrites and enhancements by David Hanson and C friends (U. of Arizona), Joe Sventek and Debbie C Scherrer (Lawrence Berkely Laboratory), and C William Wood (Institute For Cancer Research). C C Address: William Wood C 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 C========== miscellaneous support for all programs ========== C alldig - return YES if str is all digits INTEGER FUNCTION ALLDIG(STR) INTEGER I BYTE STR(1) ALLDIG = 0 IF (.NOT.(STR(1) .EQ. 0)) GOTO 2000 RETURN 2000 CONTINUE I = 1 2020 IF (.NOT.(STR(I) .NE. 0)) GOTO 2040 IF (.NOT.(STR(I) .LT. '0' .OR. STR(I) .GT. '9')) GOTO 2050 RETURN 2050 CONTINUE 2030 I = I + 1 GOTO 2020 2040 CONTINUE ALLDIG = 1 RETURN END C ctoi - convert string at in(i) to integer, increment i INTEGER FUNCTION CTOI(IN, I) BYTE IN(1) INTEGER INDEX INTEGER D, I LOGICAL NEG BYTE MINUS C string digits "0123456789" BYTE DIGITS(11) DATA MINUS/'-'/ DATA DIGITS(1)/'0'/ DATA DIGITS(2)/'1'/ DATA DIGITS(3)/'2'/ DATA DIGITS(4)/'3'/ DATA DIGITS(5)/'4'/ DATA DIGITS(6)/'5'/ DATA DIGITS(7)/'6'/ DATA DIGITS(8)/'7'/ DATA DIGITS(9)/'8'/ DATA DIGITS(10)/'9'/ DATA DIGITS(11)/0/ 2070 IF (.NOT.(IN(I) .EQ. ' ' .OR. IN(I) .EQ. 9)) GOTO 2080 I = I + 1 GOTO 2070 2080 CONTINUE IF (.NOT.(IN(I) .EQ. MINUS)) GOTO 2090 NEG = .TRUE. I = I + 1 GOTO 2100 2090 CONTINUE NEG = .FALSE. 2100 CONTINUE CTOI = 0 2110 IF (.NOT.(IN(I) .NE. 0)) GOTO 2130 D = INDEX(DIGITS, IN(I)) IF (.NOT.(D .EQ. 0)) GOTO 2140 C non-digit GOTO 2130 2140 CONTINUE CTOI = 10*CTOI + D - 1 2120 I = I + 1 GOTO 2110 2130 CONTINUE IF (.NOT.(NEG)) GOTO 2160 CTOI = - CTOI 2160 CONTINUE 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 2180 IF (.NOT.(I .LT. LIM .AND. S2(I-L) .NE. 0)) GOTO 2200 S1(I) = S2(I - L) 2190 I = I + 1 GOTO 2180 2200 CONTINUE S1(I) = 0 CONCAT = I - 1 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 2210 IF (.NOT.(STR1(I) .EQ. STR2(I))) GOTO 2230 IF (.NOT.(STR1(I) .EQ. 0)) GOTO 2240 EQUAL = 1 RETURN 2240 CONTINUE 2220 I = I + 1 GOTO 2210 2230 CONTINUE EQUAL = 0 RETURN END C getwrd - get non-blank word from in(i) into out, increment i INTEGER FUNCTION GETWRD(IN, I, OUT) BYTE IN(1), OUT(1) INTEGER I, J 2260 IF (.NOT.(IN(I) .EQ. ' ' .OR. IN(I) .EQ. 9)) GOTO 2270 I = I + 1 GOTO 2260 2270 CONTINUE J = 1 2280 IF (.NOT.(IN(I) .NE. 0 .AND. IN(I) .NE. ' ' .AND. IN(I) .NE. 9 .AN *D. IN(I) .NE. 13)) GOTO 2290 OUT(J) = IN(I) I = I + 1 J = J + 1 GOTO 2280 2290 CONTINUE OUT(J) = 0 GETWRD = J - 1 RETURN END C index - find character c in string str INTEGER FUNCTION INDEX(STR, C) BYTE C, STR(1) INDEX = 1 2300 IF (.NOT.(STR(INDEX) .NE. 0)) GOTO 2320 IF (.NOT.(STR(INDEX) .EQ. C)) GOTO 2330 RETURN 2330 CONTINUE 2310 INDEX = INDEX + 1 GOTO 2300 2320 CONTINUE INDEX = 0 RETURN END C itoc - convert integer int to char string in str INTEGER FUNCTION ITOC(INT, STR, SIZE) INTEGER IABS, MOD INTEGER D, I, INT, INTVAL, J, K, SIZE BYTE STR(1) C string digits "0123456789" BYTE DIGITS(11) DATA DIGITS(1)/'0'/ DATA DIGITS(2)/'1'/ DATA DIGITS(3)/'2'/ DATA DIGITS(4)/'3'/ DATA DIGITS(5)/'4'/ DATA DIGITS(6)/'5'/ DATA DIGITS(7)/'6'/ DATA DIGITS(8)/'7'/ DATA DIGITS(9)/'8'/ DATA DIGITS(10)/'9'/ DATA DIGITS(11)/0/ INTVAL = INT STR(1) = 0 I = 1 2350 CONTINUE C generate digits I = I + 1 D = MOD(INTVAL, 10) STR(I) = DIGITS(IABS(D) + 1) INTVAL = (INTVAL - D)/10 2360 IF (.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE)) GOTO 2350 2370 CONTINUE IF (.NOT.(INT .LT. 0 .AND. I .LT. SIZE)) GOTO 2380 C then sign I = I + 1 STR(I) = '-' 2380 CONTINUE ITOC = I - 1 J = 1 2400 IF (.NOT.(J .LT. I)) GOTO 2420 C then reverse K = STR(I) STR(I) = STR(J) STR(J) = K I = I - 1 2410 J = J + 1 GOTO 2400 2420 CONTINUE RETURN END C itocrj - convert integer to character in a right-adjusted field INTEGER FUNCTION ITOCRJ(INT, STR, SIZE) INTEGER INT, SIZE, J INTEGER ITOC BYTE STR(1), TBUF(10) J = ITOC(INT, TBUF, 10) I = SIZE - 1 2430 IF (.NOT.(J .GT. 0 .AND. I .GT. 0)) GOTO 2450 STR(I) = TBUF(J) J = J - 1 2440 I = I - 1 GOTO 2430 2450 CONTINUE 2460 IF (.NOT.(I .GT. 0)) GOTO 2480 STR(I) = ' ' 2470 I = I - 1 GOTO 2460 2480 CONTINUE STR(SIZE) = 0 ITOCRJ = SIZE - 1 RETURN END C length - compute length of string INTEGER FUNCTION LENGTH(STR) C integer->character BYTE STR(1) LENGTH = 0 2490 IF (.NOT.(STR(LENGTH+1) .NE. 0)) GOTO 2510 2500 LENGTH = LENGTH + 1 GOTO 2490 2510 CONTINUE RETURN END C putnum - put integer SUBROUTINE PUTNUM(INT, F) INTEGER INT, F, I, N BYTE CHARS(10) INTEGER ITOC N = ITOC(INT, CHARS, 10) I = 1 2520 IF (.NOT.(I .LE. N)) GOTO 2540 CALL PUTCH(CHARS(I), F) 2530 I = I + 1 GOTO 2520 2540 CONTINUE RETURN END C putdec - put decimal integer n in field width >= w SUBROUTINE PUTDEC(N, W) BYTE CHARS(10) INTEGER ITOC INTEGER I, N, ND, W ND = ITOC(N, CHARS, 10) I = ND + 1 2550 IF (.NOT.(I .LE. W)) GOTO 2570 CALL PUTC(' ') 2560 I = I + 1 GOTO 2550 2570 CONTINUE I = 1 2580 IF (.NOT.(I .LE. ND)) GOTO 2600 CALL PUTC(CHARS(I)) 2590 I = I + 1 GOTO 2580 2600 CONTINUE 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 2610 IF (.NOT.(FROM(K1) .NE. 0)) GOTO 2630 TO(K2) = FROM(K1) K2 = K2 + 1 2620 K1 = K1 + 1 GOTO 2610 2630 CONTINUE TO(K2) = 0 RETURN END C type - determine type of character BYTE FUNCTION TYPE(C) BYTE C BYTE CTYPE( - 128:127) C A-Z and a-z are alphabetic; C 0-9 are digits; DATA CTYPE/128*0, 48*0, 10*2, 7*0, 26*1, 6*0, 26*1, 5*0/ TYPE = CTYPE(C) IF (.NOT.(TYPE .EQ. 0)) GOTO 2640 TYPE = C C$ if( c >= '0' & c <= '9' ) C$ type = DIGIT C$ else if( c >= 'a' & c <= 'z' ) C$ type = LETTER C$ else if( c >= 'A' & c <= 'Z' ) C$ type = LETTER C$ else C$ type = c 2640 CONTINUE RETURN END C fold - fold all letters to lower case SUBROUTINE FOLD(TOKEN) BYTE TOKEN(1) INTEGER I I = 1 2660 IF (.NOT.(TOKEN(I) .NE. 0)) GOTO 2680 IF (.NOT.(TOKEN(I) .GE. 'A' .AND. TOKEN(I) .LE. 'Z')) GOTO 2690 TOKEN(I) = TOKEN(I) - 'A' + 'a' 2690 CONTINUE 2670 I = I + 1 GOTO 2660 2680 CONTINUE RETURN END C clower - change letter to lower case BYTE FUNCTION CLOWER(C) BYTE C IF (.NOT.(C .GE. 'A' .AND. C .LE. 'Z')) GOTO 2710 CLOWER = C - 'A' + 'a' GOTO 2720 2710 CONTINUE CLOWER = C 2720 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 2730 CUPPER = C - 'a' + 'A' GOTO 2740 2730 CONTINUE CUPPER = C 2740 CONTINUE RETURN END C lower - fold all alphas to lower case SUBROUTINE LOWER(TOKEN) BYTE TOKEN(1) INTEGER I I = 1 2750 IF (.NOT.(TOKEN(I) .NE. 0)) GOTO 2770 IF (.NOT.(TOKEN(I) .GE. 'A' .AND. TOKEN(I) .LE. 'Z')) GOTO 2780 TOKEN(I) = TOKEN(I) - 'A' + 'a' 2780 CONTINUE 2760 I = I + 1 GOTO 2750 2770 CONTINUE RETURN END C upper - fold all alphas to upper case SUBROUTINE UPPER(TOKEN) BYTE TOKEN(1) INTEGER I I = 1 2800 IF (.NOT.(TOKEN(I) .NE. 0)) GOTO 2820 IF (.NOT.(TOKEN(I) .GE. 'a' .AND. TOKEN(I) .LE. 'z')) GOTO 2830 TOKEN(I) = TOKEN(I) - 'a' + 'A' 2830 CONTINUE 2810 I = I + 1 GOTO 2800 2820 CONTINUE RETURN END C uniqm - find command string which matches input string uniquely SUBROUTINE UNIQM(IN, CMDSTR, CODE, RESULT) BYTE IN(1), CMDSTR(1) INTEGER CODE, RESULT, I IF (.NOT.(IN(1) .EQ. 0 .AND. CMDSTR(1) .NE. 0)) GOTO 2850 Cnull string must match exactly RETURN 2850 CONTINUE I = 1 2870 IF (.NOT.(IN(I) .NE. 0)) GOTO 2890 IF (.NOT.(IN(I) .NE. CMDSTR(I))) GOTO 2900 RETURN 2900 CONTINUE 2880 I = I + 1 GOTO 2870 2890 CONTINUE IF (.NOT.(RESULT .NE. 0)) GOTO 2920 RESULT = - 1 GOTO 2930 2920 CONTINUE IF (.NOT.(CODE .GE. 0)) GOTO 2940 RESULT = CODE GOTO 2950 2940 CONTINUE IF (.NOT.(CMDSTR(I) .EQ. 0)) GOTO 2960 C if code neg., must match exactly RESULT = - CODE 2960 CONTINUE 2950 CONTINUE 2930 CONTINUE RETURN END C pmatch - return YES if str1 is a partial match to str2 INTEGER FUNCTION PMATCH(STR1, STR2) BYTE STR1(1), STR2(1) INTEGER C C = 0 CALL UNIQM(STR1, STR2, 1, C) IF (.NOT.(C .EQ. 0)) GOTO 2980 PMATCH = 0 GOTO 2990 2980 CONTINUE PMATCH = 1 2990 CONTINUE RETURN END C search - find a pattern in a line INTEGER FUNCTION SEARCH(TEXT, PATTRN) BYTE TEXT(1), PATTRN(1) INTEGER N, M, J, LENGTH, I SEARCH = 0 M = LENGTH(PATTRN) IF (.NOT.(M .EQ. 0)) GOTO 3000 RETURN 3000 CONTINUE N = LENGTH(TEXT) J = M 3020 IF (.NOT.(J .LE. N)) GOTO 3030 DO 3040 I = M, 1, - 1 IF (.NOT.(TEXT(J-M+I) .NE. PATTRN(I))) GOTO 3060 J = J + 1 GOTO 3020 3060 CONTINUE 3040 CONTINUE 3050 CONTINUE SEARCH = J - M + 1 RETURN 3030 CONTINUE RETURN END C-h- conc 191 asc 3-oct-80 11:28:26 SUBROUTINE CONC(FIRST, SECOND, OUT) BYTE FIRST(1), SECOND(1), OUT(1) INTEGER I I = 1 CALL STCOPY(FIRST, 1, OUT, I) CALL SCOPY(SECOND, 1, OUT, I) RETURN END C-h- stcopy 201 asc 3-oct-80 11:28:26 SUBROUTINE STCOPY(IN, I, OUT, J) BYTE IN(1), OUT(1) INTEGER I, J, K K = I 3080 IF (.NOT.(IN(K) .NE. 0)) GOTO 3100 OUT(J) = IN(K) J = J + 1 3090 K = K + 1 GOTO 3080 3100 CONTINUE OUT(J) = 0 RETURN END C-h- skipbl 186 asc 3-oct-80 11:28:23 C# skipbl - skip blanks and tabs at lin(i) SUBROUTINE SKIPBL(LIN, I) BYTE LIN(1) INTEGER I 3110 IF (.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9)) GOTO 3120 I = I + 1 GOTO 3110 3120 CONTINUE RETURN 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 3130 IF (.NOT.(STR(BKSCAN) .NE. 0)) GOTO 3150 IF (.NOT.(INDEX(BRK, STR(BKSCAN)) .NE. 0)) GOTO 3160 GOTO 3150 3160 CONTINUE 3140 BKSCAN = BKSCAN + 1 GOTO 3130 3150 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 3180 IF (.NOT.(STR(SCAN) .NE. 0)) GOTO 3200 IF (.NOT.(INDEX(SCSTR, STR(SCAN)) .EQ. 0)) GOTO 3210 GOTO 3200 3210 CONTINUE 3190 SCAN = SCAN + 1 GOTO 3180 3200 CONTINUE RETURN END C# esc - map array(i) into escaped character if appropriate BYTE FUNCTION ESC(ARRAY, I) BYTE ARRAY(1) INTEGER I IF (.NOT.(ARRAY(I) .NE. 64)) GOTO 3230 ESC = ARRAY(I) GOTO 3240 3230 CONTINUE IF (.NOT.(ARRAY(I+1) .EQ. 0)) GOTO 3250 C |*a not special at end ESC = 64 GOTO 3260 3250 CONTINUE I = I + 1 IF (.NOT.(ARRAY(I) .EQ. 110 .OR. ARRAY(I) .EQ. 78)) GOTO 3270 ESC = 13 GOTO 3280 3270 CONTINUE IF (.NOT.(ARRAY(I) .EQ. 116 .OR. ARRAY(I) .EQ. 84)) GOTO 329 *0 ESC = 9 GOTO 3300 3290 CONTINUE IF (.NOT.(ARRAY(I) .EQ. 98 .OR. ARRAY(I) .EQ. 66)) GOTO 33 *10 ESC = 32 GOTO 3320 3310 CONTINUE ESC = ARRAY(I) 3320 CONTINUE 3300 CONTINUE 3280 CONTINUE 3260 CONTINUE 3240 CONTINUE RETURN END