14-Jul-1988 13:37:53 VAX FORTRAN T5.0-60 Page 1 14-Jul-1988 13:18:44 KMS$SYSUTLUSR2:[SETDEF]CHECK_DIR_SPEC.FOR;27 0001 SUBROUTINE CHECK_DIR_SPEC ( trans, size, curdir, cdlen ) 0002 C 0003 C The following code is based upon and at least partially lifted 0004 C from the IN foreign command program. 0005 C 0006 C (c) Copywrite 1985, M. Edward Nieland, Ames Laboratory USDOE 0007 C (c) Copywrite 1986, Robert L. Hays, KMS Fusion, Inc. 0008 C 0009 C Do not remove copywrite notices. 0010 C 0011 IMPLICIT NONE 0012 C 0013 CHARACTER*(*) trans, curdir 0014 CHARACTER*1 lft_brace, rt_brace, period, hyphen 0015 CHARACTER*1 blnk 0016 C 0017 LOGICAL*1 more_dots 0018 C 0019 INTEGER*4 size, cdlen 0020 INTEGER*4 offset1, oldsize 0021 INTEGER*4 itmp 0022 INTEGER*4 loc_dots(7), i, num_dots, istart 0023 INTEGER*4 number_of_hyphens 0024 C 0025 DATA lft_brace/'['/, rt_brace/']'/ 0026 DATA period/'.'/, hyphen/'-'/, blnk/' '/ 0027 C 0028 C Executable begins here. 0029 C 0030 C D TYPE 661, trans(1:size) 0031 C D661 FORMAT ( ' Trans: ',A ) 0032 offset1 = INDEX ( trans(1:size), lft_brace ) 0033 IF ( trans(offset1+1:offset1+1) .EQ. period ) THEN 0034 oldsize = size 0035 size = size + cdlen - 2 0036 trans(offset1+1:size) = 0037 + curdir(2:cdlen-1)//trans(offset1+1:oldsize) 0038 C D TYPE 662, trans(1:size) 0039 C D662 FORMAT ( ' Trans: ',A/' Period after [' ) 0040 ELSE IF ( trans(offset1+1:offset1+1) .EQ. hyphen ) THEN 0041 oldsize = size 0042 size = size + cdlen - 1 0043 trans(offset1+1:size) = 0044 + curdir(2:cdlen-1)//period//trans(offset1+1:oldsize) 0045 C D TYPE 663, trans(1:size) 0046 C D663 FORMAT ( ' Trans: ',A/' Hyphen after [' ) 0047 ELSE 0048 IF ( INDEX( trans(1:size), rt_brace ) .EQ. 0 ) THEN 0049 oldsize = size 0050 size = size + cdlen 0051 trans(oldsize+1:size) = curdir(1:cdlen) 0052 END IF 0053 C D TYPE 664, trans(1:size) 0054 C D664 FORMAT ( ' Trans: ',A/' All others' ) 0055 END IF 0056 IF ( trans(size-1:size) .EQ. '-]' ) THEN CHECK_DIR_SPEC 14-Jul-1988 13:37:53 VAX FORTRAN T5.0-60 Page 2 14-Jul-1988 13:18:44 KMS$SYSUTLUSR2:[SETDEF]CHECK_DIR_SPEC.FOR;27 0057 more_dots = .TRUE. 0058 num_dots = 1 0059 istart = 1 0060 number_of_hyphens = 0 0061 DO WHILE ( more_dots ) ! For each dot. 0062 IF ( INDEX ( trans(istart:size), '.' ) .GT. 0 ) THEN ! Got a dot. 0063 IF ( num_dots .LE. 7 ) THEN 0064 loc_dots(num_dots) = istart - 1 ! Save last dot location. 0065 END IF 0066 num_dots = num_dots + 1 ! Add to the count. 0067 istart = INDEX ( trans(istart:size), '.' ) + istart ! Update new starting location. 0068 ELSE ! No more dots in string. 0069 more_dots = .FALSE. ! Mark and exit loop. 0070 END IF ! 0071 END DO ! 0072 i = size-1 0073 DO WHILE ( trans(i:i) .EQ. '-' .OR. ! Now, count the hyphens. 0074 + trans(i:1) .EQ. '.' ) 0075 IF ( trans(i:i) .EQ. '-' ) number_of_hyphens = number_of_hyphens + 1 0076 i = i - 1 0077 END DO 0078 IF ( num_dots .GE. 8 ) THEN ! Asked for too deep a directory tree. 0079 num_dots = 7 - number_of_hyphens + 2 ! Point to correct spot in LOC_DOTS. 0080 IF ( num_dots .LE. 0 ) THEN ! Go ahead and allow error message in this 0081 ! case. 0082 ELSE ! Okay, we can go back that far in dir string. 0083 trans(loc_dots(num_dots):loc_dots(num_dots)) = ']' ! Overwrite the earlier dir point with 0084 DO i = loc_dots(num_dots)+1, size ! and end of dir value. Then, clear 0085 trans(i:i) = ' ' ! out the remaining stuff. 0086 END DO ! 0087 size = loc_dots(num_dots) ! 0088 END IF ! 0089 END IF ! 0090 END IF ! 0091 C offset1 = INDEX ( trans(1:size), period ) ! Check for .[ or .. 0092 C itmp = 0 0093 C DO WHILE ( offset1 .GT. 0 ) 0094 C IF ( trans(itmp+offset1+1:itmp+offset1+1) 0095 C + .EQ. period .OR. 0096 C + trans(itmp+offset1+1:itmp+offset1+1) 0097 C + .EQ. lft_brace ) THEN 0098 C trans(itmp+offset1+1:size-1) = trans(itmp+offset1+2:size) 0099 C trans(size:size) = blnk ! 0100 C size = size - 1 ! 0101 CD TYPE 665, trans(1:size), offset1 0102 CD665 FORMAT ( ' Trans: ',A/ 0103 CD + ' Location of period: ',I6 ) 0104 C ELSE ! 0105 C itmp = itmp + offset1 + 1 0106 C offset1 = INDEX ( trans(itmp:size), period ) 0107 CD TYPE 666, itmp, offset1 0108 CD666 FORMAT ( ' New start: ',I6,' New offset: ',I6 ) 0109 C END IF ! 0110 C END DO ! 0111 RETURN 0112 END CHECK_DIR_SPEC 14-Jul-1988 13:37:53 VAX FORTRAN T5.0-60 Page 3 01 14-Jul-1988 13:18:44 KMS$SYSUTLUSR2:[SETDEF]CHECK_DIR_SPEC.FOR;27 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 504 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 4 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 164 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 672 ENTRY POINTS Address Type Name 0-00000000 CHECK_DIR_SPEC VARIABLES Address Type Name Address Type Name ** CHAR BLNK AP-00000010@ I*4 CDLEN AP-0000000C@ CHAR CURDIR 2-0000001F CHAR HYPHEN ** I*4 I ** I*4 ISTART ** I*4 ITMP 2-0000001C CHAR LFT_BRACE ** L*1 MORE_DOTS ** I*4 NUMBER_OF_HYPHENS ** I*4 NUM_DOTS ** I*4 OFFSET1 ** I*4 OLDSIZE 2-0000001E CHAR PERIOD 2-0000001D CHAR RT_BRACE AP-00000008@ I*4 SIZE AP-00000004@ CHAR TRANS ARRAYS Address Type Name Bytes Dimensions 2-00000000 I*4 LOC_DOTS 28 (7) FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 LIB$INDEX CHECK_DIR_SPEC 14-Jul-1988 13:37:53 VAX FORTRAN T5.0-60 Page 4 01 14-Jul-1988 13:18:44 KMS$SYSUTLUSR2:[SETDEF]CHECK_DIR_SPEC.FOR;27 COMMAND QUALIFIERS FOR/NOOBJ/LIST CHECK_DIR_SPEC /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=KMS$SYSUTLUSR2:[SETDEF]CHECK_DIR_SPEC.LIS;1 /NOOBJECT COMPILATION STATISTICS Run Time: 0.47 seconds Elapsed Time: 1.06 seconds Page Faults: 616 Dynamic Memory: 402 pages