C+ C Title: PATMAT C Author: T. R. Wyant C Date: 11-Sep-1987 C Modified: C Remarks: C INTEGER*2 FUNCTION PATMAT performs a generic match of C a pattern against a template. Neither pattern nor C template may be null. If a match occurs, the value C .TRUE. is returned; otherwise, .FALSE. is returned. C C The arguments are a template and a pattern to be matched C against that template, and three "special" characters: C - A character to be interpreted as a multicharacter C wildcard if it appears in the template. This C character matches any number of characters in C the pattern (including zero). This would C normally be an asterisk ('*'). C - A character to be interpreted as a single character C wildcard if it appears in the template. This C character matches any one character in the C pattern. This would normally be a percent sign C ('%'). C - A character to be ignored if it appears as the C trailing string in the pattern. This would C normally be a space (' '). C- FUNCTION PATMAT (PATLEN, PATTRN, TMPLEN, TMPLAT, BUG, PCT, BLK) INTEGER*2 PATMAT ! .TRUE. if pattern matches. INTEGER*2 PATLEN ! Length of pattern. LOGICAL*1 PATTRN (PATLEN) ! Pattern. INTEGER*2 TMPLEN ! Length of template. LOGICAL*1 TMPLAT (TMPLEN) ! Template. LOGICAL*1 BUG ! Multicharacter wildcard. LOGICAL*1 PCT ! Single character wildcard. LOGICAL*1 BLK ! Character to ignore at end. INTEGER*2 PATLOC ! Location in pattern. INTEGER*2 TMPLOC ! Location in template. INTEGER*2 PATBCK ! Pattern backtrack location. INTEGER*2 TMPBCK ! Template backtrack location. C C Initialize the pointers; C PATLOC = 0 TMPLOC = 0 PATBCK = 0 TMPBCK = 0 CC CC C Try_again: C 2000 CONTINUE CC C Go to the next location in both pattern and template; C PATLOC = PATLOC + 1 TMPLOC = TMPLOC + 1 C C IF (we have used up the template) THEN C GO TO Check_for_end; C IF (TMPLOC .GT. TMPLEN) GO TO 3000 C C IF (the current template character is a C multi-character wildcard) THEN C BEGIN C Save our current context in both pattern and template; C Back up a character in the pattern (to compensate for C the spurious advance we get at Try_again); C GO TO Try_again; C END; C IF (TMPLAT (TMPLOC) .NE. BUG) GO TO 2400 PATBCK = PATLOC TMPBCK = TMPLOC PATLOC = PATLOC - 1 GO TO 2000 C C IF (we have used up all of the pattern) THEN C GO TO Exit_with_error; C 2400 IF (PATLOC .GT. PATLEN) GO TO 9000 C C IF (the current template character is a C single-character wildcard) THEN C GO TO Try_again; C IF (TMPLAT (TMPLOC) .EQ. PCT) GO TO 2000 C C IF (the current template character matches the C current pattern character) THEN C GO TO Try_again; C IF (TMPLAT (TMPLOC) .EQ. PATTRN (PATLOC)) GO TO 2000 C C GO TO Check_for_backtrack; C GO TO 3600 CC CC C Check_for_end: C 3000 CONTINUE CC C IF (we have used up all the pattern) THEN C GO TO Exit_with_success; C IF (PATLOC .GT. PATLEN) GO TO 9100 C C IF (the pattern character is not the null character) THEN C GO TO Check_for_backtrack; C IF (PATTRN (PATLOC) .NE. BLK) GO TO 3600 C C Increment pattern pointer; C PATLOC = PATLOC + 1 C C GO TO Check_for_end; C GO TO 3000 CC CC C Check_for_backtrack; C 3600 CONTINUE CC C IF (we have no location to backtrack to) THEN C GO TO Exit_with_error; C IF (TMPBCK .LE. 0) GO TO 9000 C C Restore current pattern and template locations to the C last backtrack point; C PATLOC = PATBCK TMPLOC = TMPBCK C C Increment the pattern backtrack point; C PATBCK = PATBCK + 1 C C GO TO Try_again; C GO TO 2000 CC CC C Exit_with_error: C 9000 CONTINUE CC C STATUS = failure; C GO TO Exit_subroutine; C PATMAT = .FALSE. GO TO 9900 CC CC C Exit_with_success: C 9100 CONTINUE CC C STATUS = success; C GO TO Exit_subroutine; C PATMAT = .TRUE. GO TO 9900 CC CC C Exit_subroutine: C 9900 CONTINUE CC C END. C RETURN END