<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">
                               					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   1
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

0001    	INTEGER*4 FUNCTION WCCOPY( MATCH_STRING, SOURCE_STRING, REP_STRING,
0002         &amp;		DEST_STRING, DEST_LENGTH)
0003    C
0004    C This function creates a character string from a source string using wild-
0005    C card pattern matching and replacement.  The wildcard characters are "*"
0006    C (match 0 or more chars) and '%' (match any 1 char).  The function returns
0007    C the following values:
0008    C	1	if "source_string" is of the pattern specified by "match_string"
0009    C    STR$_TRU	if a pattern match was found but the output string was longer
0010    C		than could be placed in the destination
0011    C	0	otherwise
0012    C
0013    C Arguments:
0014    C	MATCH_STRING	is a string expression defining the pattern to be
0015    C			matched
0016    C	SOURCE_STRING	is a string expression containing the string to be
0017    C			redefined
0018    C	REP_STRING	is a string expression defining the replacement pattern
0019    C	DEST_STRING	is the address of a string descriptor defining where the
0020    C			new string is to be placed
0021    C	DEST_LENGTH	is the address of a word into which the length of the
0022    C			redefined string will be placed
0023    C
0024    C For creation of the new string, the match string is used to separate the source
0025    C string into one or more "fields";  each field is bounded by the start of the
0026    C string, the end of the string or a wildcard character.  Each wildcard characters
0027    C are themselves considered to be a field.  The new character string is created
0028    C by concatenating fields from the source and replacement strings, as defined by
0029    C the replacement string.
0030    C
0031    C This routine is implemented essentially as a code-driven finite state machine,
0032    C except that a little bit of additional "memory" is kept to save the starting
0033    C and ending indexes of the source and match string when searching for a pattern
0034    C match after a "*".
0035    C
0036    C
0037    C   Date	By		Comments
0038    C 12/17/82	D.E.Greenwood	Original
0039    C
0040    C
0041    	CHARACTER DEST_STRING*(*), M_CHAR*1, MATCH_STRING*(*), REP_STRING*(*),
0042         &amp;		R_CHAR*1, SOURCE_STRING*(*)
0043    	INTEGER*2 D_INDEX, DEST_LEN, DEST_LENGTH, M_INDEX, MATCH_LEN, M_TEMP,
0044         &amp;		R_INDEX, REP_LEN,  S_INDEX, S_WC_START, STR_LEN, S_TEMP
0045    	INTEGER*4 STATUS
0046    C
0047    C
0048    	COMMON /WC_COMMON/ D_INDEX, DEST_LEN, R_CHAR, R_INDEX, REP_LEN, STATUS
0049    C
0050    	D_INDEX = 0
0051    	DEST_LEN = LEN(DEST_STRING)
0052    	M_INDEX = 0
0053    	MATCH_LEN = LEN(MATCH_STRING)
0054    	R_INDEX = 0
0055    	REP_LEN = LEN(REP_STRING)
0056    	CALL WC_NEXT_REPCHAR(REP_STRING)
0057    	S_INDEX = 0

WCCOPY                         					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   2
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

0058    	STR_LEN = LEN(SOURCE_STRING)
0059    	STATUS = 1
0060    C
0061    C "State 1" - String is of form specified by match string, so far.  We check
0062    C the strings on a character by character basis, until the end of a string
0063    C or a "*" is reached.
0064    C
0065    10100	M_INDEX = M_INDEX + 1
0066    	S_INDEX = S_INDEX + 1
0067    	IF (M_INDEX .GT. MATCH_LEN .AND. S_INDEX .GT. STR_LEN) THEN
0068    	    CALL WC_COPY_STR(REP_STRING(R_INDEX:REP_LEN), DEST_STRING)
0069    	    GOTO 80000
0070    	ENDIF
0071    	IF (M_INDEX .GT. MATCH_LEN) GOTO 82000
0072    	M_CHAR = MATCH_STRING(M_INDEX:M_INDEX)
0073    	IF (M_CHAR .EQ. '*') GOTO 10200
0074    	IF (S_INDEX .GT. STR_LEN) GOTO 82000
0075    	IF (M_CHAR .EQ. '%') GOTO 10300
0076    	IF (M_CHAR .EQ. SOURCE_STRING(S_INDEX:S_INDEX)) GOTO 10100
0077    	GOTO 82000
0078    C
0079    C "State 2" - Last match char was a "*"
0080    C
0081    10200	M_INDEX = M_INDEX + 1
0082    	CALL WC_COPY_TO_WC(REP_STRING, DEST_STRING)
0083    	S_WC_START = S_INDEX
0084    	IF (M_INDEX .GT. MATCH_LEN) THEN
0085    	    CALL WC_COPY_STR(SOURCE_STRING(S_WC_START:STR_LEN), DEST_STRING)
0086    	    IF (R_CHAR .EQ. '*') CALL
0087         &amp;			WC_COPY_STR(REP_STRING(R_INDEX+1:REP_LEN), DEST_STRING)
0088    	    GOTO 80000
0089    	ENDIF
0090    	M_CHAR = MATCH_STRING(M_INDEX:M_INDEX)
0091    	IF (M_CHAR .EQ. '*') GOTO 10200
0092    	IF (M_CHAR .NE. '%') GOTO 10400
0093    C
0094    C "State 3" - Last two match chars were "*%".  We treat that as if only the
0095    C "%" had been specified, i.e., we match only the current string char.  OR,
0096    C the last match char was really just a "%".
0097    C
0098    10300	IF (S_INDEX .GT. STR_LEN) GOTO 82000
0099    	CALL WC_COPY_TO_WC(REP_STRING, DEST_STRING)
0100    	IF (R_CHAR .EQ. '%') THEN
0101    	    CALL WC_COPY_STR(SOURCE_STRING(S_INDEX:S_INDEX), DEST_STRING)
0102    	    CALL WC_NEXT_REPCHAR(REP_STRING)
0103    	ENDIF
0104    	GOTO 10100
0105    C
0106    C "State 4" - Last match char was a "*", this match char is not - we want to
0107    C find a char in the string which equals this match char.
0108    C
0109    10400	IF (S_INDEX .GT. STR_LEN) GOTO 82000
0110    	IF (M_CHAR .EQ. SOURCE_STRING(S_INDEX:S_INDEX)) THEN
0111    	    M_TEMP = M_INDEX				! found - save starting
0112    	    S_TEMP = S_INDEX				!  index of string which
0113    	    GOTO 10500					!  may terminate "*" matching
0114    	ENDIF

WCCOPY                         					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   3
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

0115    	S_INDEX = S_INDEX + 1
0116    	GOTO 10400
0117    C
0118    C "State 5" - String char sequence is same as the match sequence after "*".  We
0119    C want to know if we have found a string which will terminate the wildcard match.
0120    C The things which identify such a string are end of both strings or another
0121    C wildcard char.
0122    C
0123    10500	M_INDEX = M_INDEX + 1
0124    	S_INDEX = S_INDEX + 1
0125    	IF (M_INDEX .GT. MATCH_LEN .AND. S_INDEX .GT. STR_LEN) THEN
0126    	    IF (R_CHAR .EQ. '*') THEN
0127    		CALL WC_COPY_STR(SOURCE_STRING(S_WC_START:S_TEMP-1), DEST_STRING)
0128    		CALL WC_NEXT_REPCHAR(REP_STRING)
0129    	    ENDIF
0130    	    CALL WC_COPY_STR(REP_STRING(R_INDEX:REP_LEN), DEST_STRING)
0131    	    GOTO 80000
0132    	ENDIF
0133    	IF (M_INDEX .GT. MATCH_LEN) GOTO 10600
0134    	M_CHAR = MATCH_STRING(M_INDEX:M_INDEX)
0135    	IF (M_CHAR .EQ. '*') THEN
0136    	    IF (R_CHAR .EQ. '*') THEN
0137    		CALL WC_COPY_STR(SOURCE_STRING(S_WC_START:S_TEMP-1), DEST_STRING)
0138    		CALL WC_NEXT_REPCHAR(REP_STRING)
0139    	    ENDIF
0140    	    CALL WC_COPY_TO_WC(REP_STRING, DEST_STRING)
0141    	    GOTO 10200
0142    	ENDIF
0143    	IF (S_INDEX .GT. STR_LEN) GOTO 82000
0144    	IF (M_CHAR .EQ. '%') THEN
0145    	    IF (R_CHAR .EQ. '*') THEN
0146    		CALL WC_COPY_STR(SOURCE_STRING(S_WC_START:S_TEMP-1), DEST_STRING)
0147    		CALL WC_NEXT_REPCHAR(REP_STRING)
0148    	    ENDIF
0149    	    GOTO 10300
0150    	ENDIF
0151    	IF (M_CHAR .EQ. SOURCE_STRING(S_INDEX:S_INDEX)) GOTO 10500
0152    C
0153    C "State 6" - Failed to match string after "*" - restart test one char further
0154    C in the string
0155    C
0156    10600	M_INDEX = M_TEMP
0157    	S_INDEX = S_TEMP + 1
0158    	M_CHAR = MATCH_STRING(M_INDEX:M_INDEX)
0159    	GOTO 10400
0160    C
0161    C SUCCESS
0162    C
0163    80000	WCCOPY = STATUS
0164    	DEST_LENGTH = D_INDEX
0165    	GOTO 89900
0166    C
0167    C FAIL
0168    C
0169    82000	WCCOPY = 0
0170    	DEST_LENGTH = 0
0171    C

WCCOPY                         					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   4
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

0172    89900	RETURN
0173    	END

WCCOPY                         					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   5
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  916   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  2 $LOCAL                                  92   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 WC_COMMON                               13   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                 1021


ENTRY POINTS

    Address  Type  Name          

  0-00000000  I*4  WCCOPY        


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  3-00000002  I*2  DEST_LEN       AP-00000014@ I*2  DEST_LENGTH    AP-00000010@ CHAR DEST_STRING     3-00000000  I*2  D_INDEX       
  2-00000004  I*2  MATCH_LEN      AP-00000004@ CHAR MATCH_STRING    2-00000000  CHAR M_CHAR          2-00000002  I*2  M_INDEX       
  2-00000006  I*2  M_TEMP          3-00000007  I*2  REP_LEN        AP-0000000C@ CHAR REP_STRING      3-00000004  CHAR R_CHAR        
  3-00000005  I*2  R_INDEX        AP-00000008@ CHAR SOURCE_STRING   3-00000009  I*4  STATUS          2-0000000C  I*2  STR_LEN       
  2-00000008  I*2  S_INDEX         2-0000000E  I*2  S_TEMP          2-0000000A  I*2  S_WC_START    


LABELS

    Address   Label       Address   Label       Address   Label       Address   Label       Address   Label       Address   Label   

  0-00000075  10100     0-0000010D  10200     0-0000019F  10300     0-000001E2  10400     0-0000021A  10500     0-00000356  10600   
  0-00000377  80000     0-00000389  82000     0-0000038F  89900   


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name                              Type  Name                              Type  Name                            

        WC_COPY_STR                             WC_COPY_TO_WC                           WC_NEXT_REPCHAR                 

                               					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   6
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

0001    	SUBROUTINE WC_COPY_STR(SOURCE, DESTINATION)
0002    C
0003    	CHARACTER DESTINATION*(*), R_CHAR*1, SOURCE*(*)
0004    	INTEGER*2 D_INDEX, DEST_LEN, R_INDEX, REP_LEN
0005    	INTEGER*4 STATUS
0006    	EXTERNAL STR$_TRU
0007    C
0008    C
0009    	COMMON /WC_COMMON/ D_INDEX, DEST_LEN, R_CHAR, R_INDEX, REP_LEN, STATUS
0010    C
0011    	DO I = 1,LEN(SOURCE)
0012    	    IF (D_INDEX .LT. DEST_LEN) THEN
0013    		D_INDEX = D_INDEX + 1
0014    		DESTINATION(D_INDEX:) = SOURCE(I:I)
0015    	    ELSE
0016    		STATUS = %LOC(STR$_TRU)
0017    		GOTO 89900
0018    	    ENDIF
0019    	ENDDO
0020    89900	RETURN
0021    	END

WC_COPY_STR                    					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   7
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  109   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  2 $LOCAL                                  20   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 WC_COMMON                               13   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                  142


ENTRY POINTS

    Address  Type  Name          

  0-00000000       WC_COPY_STR   


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

 AP-00000008@ CHAR DESTINATION     3-00000002  I*2  DEST_LEN        3-00000000  I*2  D_INDEX         2-00000000  I*4  I             
  3-00000007  I*2  REP_LEN         3-00000004  CHAR R_CHAR          3-00000005  I*2  R_INDEX        AP-00000004@ CHAR SOURCE        
  3-00000009  I*4  STATUS        


LABELS

    Address   Label   

  0-0000006C  89900   


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name          

        STR$_TRU      

                               					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   8
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

0001    	SUBROUTINE WC_COPY_TO_WC(REPLCMNT, DESTINATION)
0002    C
0003    	CHARACTER DESTINATION*(*), R_CHAR*1, REPLCMNT*(*)
0004    	INTEGER*2 D_INDEX, DEST_LEN, R_INDEX, REP_LEN
0005    	INTEGER*4 STATUS
0006    	EXTERNAL STR$_TRU
0007    C
0008    C
0009    	COMMON /WC_COMMON/ D_INDEX, DEST_LEN, R_CHAR, R_INDEX, REP_LEN, STATUS
0010    C
0011    C
0012    	DO R_INDEX = R_INDEX,REP_LEN
0013    	    R_CHAR = REPLCMNT(R_INDEX:R_INDEX)
0014    	    IF (R_CHAR .EQ. '*' .OR. R_CHAR .EQ. '%') GOTO 89900
0015    	    IF (D_INDEX .LT. DEST_LEN) THEN
0016    		D_INDEX = D_INDEX + 1
0017    		DESTINATION(D_INDEX:) = REPLCMNT(R_INDEX:R_INDEX)
0018    	    ELSE
0019    		STATUS = %LOC(STR$_TRU)
0020    		GOTO 89900
0021    	    ENDIF
0022    	ENDDO
0023    89900	RETURN
0024    	END

WC_COPY_TO_WC                  					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page   9
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  134   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  2 $LOCAL                                  16   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 WC_COMMON                               13   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                  163


ENTRY POINTS

    Address  Type  Name          

  0-00000000       WC_COPY_TO_WC 


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

 AP-00000008@ CHAR DESTINATION     3-00000002  I*2  DEST_LEN        3-00000000  I*2  D_INDEX        AP-00000004@ CHAR REPLCMNT      
  3-00000007  I*2  REP_LEN         3-00000004  CHAR R_CHAR          3-00000005  I*2  R_INDEX         3-00000009  I*4  STATUS        


LABELS

    Address   Label   

  0-00000085  89900   


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name          

        STR$_TRU      

                               					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page  10
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

0001    	SUBROUTINE WC_NEXT_REPCHAR(REPLCMNT)
0002    C
0003    	CHARACTER R_CHAR*1, REPLCMNT*(*)
0004    	INTEGER*2 D_INDEX, DEST_LEN, R_INDEX, REP_LEN
0005    	INTEGER*4 STATUS
0006    C
0007    C
0008    	COMMON /WC_COMMON/ D_INDEX, DEST_LEN, R_CHAR, R_INDEX, REP_LEN, STATUS
0009    C
0010    	R_CHAR = ' '
0011    	R_INDEX = R_INDEX + 1
0012    	IF (R_INDEX .LE. REP_LEN) R_CHAR = REPLCMNT(R_INDEX:R_INDEX)
0013    	RETURN
0014    	END




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                   62   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  2 $LOCAL                                   8   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 WC_COMMON                               13   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                   83


ENTRY POINTS

    Address  Type  Name                            

  0-00000000       WC_NEXT_REPCHAR                 


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  3-00000002  I*2  DEST_LEN        3-00000000  I*2  D_INDEX        AP-00000004@ CHAR REPLCMNT        3-00000007  I*2  REP_LEN       
  3-00000004  CHAR R_CHAR          3-00000005  I*2  R_INDEX         3-00000009  I*4  STATUS        


COMMAND QUALIFIERS

  FORTRAN /LIS CTS,CTSASSIGN,CTSDEASGN,CTSMODIFY,CTSSET,CTSSHOW,WCCOPY,WCMATCH

  /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)
  /DEBUG=(NOSYMBOLS,TRACEBACK)
  /STANDARD=(NOSYNTAX,NOSOURCE_FORM)
  /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP)
  /F77  /NOG_FLOATING  /I4  /OPTIMIZE  /WARNINGS  /NOD_LINES  /NOCROSS_REFERENCE  /NOMACHINE_CODE  /CONTINUATIONS=19

WC_NEXT_REPCHAR                					 7-Jan-1983 13:29:08	VAX-11 FORTRAN V3.1-23              Page  11
								17-Dec-1982 15:28:28	SYS$SYSROOT:[CAMAC.CTS]WCCOPY.FOR;15        

COMPILATION STATISTICS

  Run Time:           3.86 seconds
  Elapsed Time:       4.13 seconds
  Page Faults:        0
  Dynamic Memory:     382 pages
</pre></body></html>