C========== miscellaneous support for all programs ========== C C C C C C maximum field for integer strings C max card size C must be 2 more than MAXCARD C C must be highest lu for standard files C C C C 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 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/ 2070 IF (.NOT.(IN(I) .EQ. ' ' .OR. IN(I) .EQ. 9)) GOTO 2080 I = I + 1 GOTO 2070 2080 CONTINUE CTOI = 0 2090 IF (.NOT.(IN(I) .NE. 0)) GOTO 2110 D = INDEX(DIGITS, IN(I)) IF (.NOT.(D .EQ. 0)) GOTO 2120 C non-digit GOTO 2110 2120 CONTINUE CTOI = 10*CTOI + D - 1 2100 I = I + 1 GOTO 2090 2110 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 2140 IF (.NOT.(I .LT. LIM .AND. S2(I-L) .NE. 0)) GOTO 2160 S1(I) = S2(I - L) 2150 I = I + 1 GOTO 2140 2160 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 2170 IF (.NOT.(STR1(I) .EQ. STR2(I))) GOTO 2190 IF (.NOT.(STR1(I) .EQ. 0)) GOTO 2200 EQUAL = 1 RETURN 2200 CONTINUE 2180 I = I + 1 GOTO 2170 2190 CONTINUE EQUAL = 0 RETURN END C index - find character c in string str INTEGER FUNCTION INDEX(STR, C) BYTE C, STR(1) INDEX = 1 2220 IF (.NOT.(STR(INDEX) .NE. 0)) GOTO 2240 IF (.NOT.(STR(INDEX) .EQ. C)) GOTO 2250 RETURN 2250 CONTINUE 2230 INDEX = INDEX + 1 GOTO 2220 2240 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 = IABS(INT) STR(1) = 0 I = 1 2270 CONTINUE C generate digits I = I + 1 D = MOD(INTVAL, 10) STR(I) = DIGITS(D + 1) INTVAL = INTVAL/10 2280 IF (.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE)) GOTO 2270 2290 CONTINUE IF (.NOT.(INT .LT. 0 .AND. I .LT. SIZE)) GOTO 2300 C then sign I = I + 1 STR(I) = '-' 2300 CONTINUE ITOC = I - 1 J = 1 2320 IF (.NOT.(J .LT. I)) GOTO 2340 C then reverse K = STR(I) STR(I) = STR(J) STR(J) = K I = I - 1 2330 J = J + 1 GOTO 2320 2340 CONTINUE RETURN END C length - compute length of string INTEGER FUNCTION LENGTH(STR) C integer->character BYTE STR(1) LENGTH = 0 2350 IF (.NOT.(STR(LENGTH+1) .NE. 0)) GOTO 2370 2360 LENGTH = LENGTH + 1 GOTO 2350 2370 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 2380 IF (.NOT.(FROM(K1) .NE. 0)) GOTO 2400 TO(K2) = FROM(K1) K2 = K2 + 1 2390 K1 = K1 + 1 GOTO 2380 2400 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 2410 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 2410 CONTINUE RETURN END C fold - fold all letters to upper case SUBROUTINE FOLD(TOKEN) BYTE TOKEN(1) CALL UPPER(TOKEN) RETURN END C upper - fold all alphas to upper case SUBROUTINE UPPER(TOKEN) BYTE TOKEN(1) INTEGER I I = 1 2430 IF (.NOT.(TOKEN(I) .NE. 0)) GOTO 2450 IF (.NOT.(TOKEN(I) .GE. 'a' .AND. TOKEN(I) .LE. 'z')) GOTO 2460 TOKEN(I) = TOKEN(I) - 'a' + 'A' 2460 CONTINUE 2440 I = I + 1 GOTO 2430 2450 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 2480 Cnull string must match exactly RETURN 2480 CONTINUE I = 1 2500 IF (.NOT.(IN(I) .NE. 0)) GOTO 2520 IF (.NOT.(IN(I) .NE. CMDSTR(I))) GOTO 2530 RETURN 2530 CONTINUE 2510 I = I + 1 GOTO 2500 2520 CONTINUE IF (.NOT.(RESULT .NE. 0)) GOTO 2550 RESULT = - 1 GOTO 2560 2550 CONTINUE IF (.NOT.(CODE .GE. 0)) GOTO 2570 RESULT = CODE GOTO 2580 2570 CONTINUE IF (.NOT.(CMDSTR(I) .EQ. 0)) GOTO 2590 C if code neg., must match exactly RESULT = - CODE 2590 CONTINUE 2580 CONTINUE 2560 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 2610 PMATCH = 0 GOTO 2620 2610 CONTINUE PMATCH = 1 2620 CONTINUE RETURN END