27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 1 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00001 0001 program chdir 00002 0002 * 00003 0003 * 00004 0004 * Date: 29 November 1983 00005 0005 * Author: Andrew W. Potter 00006 0006 * 00007 0007 * This program remains the property of the author. 00008 0008 * permission is hereby granted to use, modify, copy, distribute 00009 0009 * (but not to sell) this program. 00010 0010 * 00011 0011 * Purpose: 00012 0012 * this program provides some degree of flexibility 00013 0013 * in moving about the VMS file system and was designed 00014 0014 * to replace the many command language routines designed for 00015 0015 * this purpose. 00016 0016 * 00017 0017 * while this program does support the unix conventions 00018 0018 * of "..", "/" and "~" in specifying where to go. 00019 0019 * however if the "/" is to be used the this program 00020 0020 * cannot be defined in a command definition file (CLD) 00021 0021 * 00022 0022 * for examples of the proper syntax type "CD ?" 00023 0023 * 00024 0024 * this program can be defined by one of the following 00025 0025 * methods: 00026 0026 * 00027 0027 * $ CD == "$DISK:[DIRECTORY]CD.EXE" 00028 0028 * 00029 0029 * or this CLD: ( which limits CD's cabilities) 00030 0030 * 00031 0031 * Define Verb CD 00032 0032 * image DISK:[DIRECTORY]CD.EXE 00033 0033 * parameter P1,(optional) 00034 0034 * 00035 0035 * 00036 0036 * to build: 00037 0037 * 00038 0038 * $ FORTRAN/NODEBUG CD 00039 0039 * $ MESSAGE CDMESS 00040 0040 * $ LINK/NODEBUG/NOTRACE CD,CDMESS 00041 0041 * 00042 0042 * 00043 0043 implicit integer(a-z) 00044 0044 logical godown,justup,ok 00045 0045 character*120 str,defstr,checkdir,wrkstr,olddisk,tmpstr 00046 0046 external msg_nodir,msg_badsys,msg_badarg,msg_baddir 00047 0047 00048 0048 call lib$get_foreign(str,,l_str) 00049 0049 * 00050 0050 wrkstr(1:120) = ' ' 00051 0051 call lib$sys_trnlog('SYS$DISK',l_olddisk,olddisk,,,) 00052 0052 * 00053 0053 * Go to login directory 00054 0054 * 00055 0055 if (l_str .le. 0) then 00056 0056 call lib$sys_trnlog('SYS$LOGIN',tmpptr,tmpstr,,,) 00057 0057 locdisk = index(tmpstr(1:tmpptr),':') CHDIR 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 2 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00058 0058 call setdef(tmpstr(1:tmpptr)) 00059 0059 call lib$set_logical('SYS$DISK',tmpstr(1:locdisk)) 00060 0060 goto 50 00061 0061 endif 00062 0062 * 00063 0063 * 00064 0064 * Start at login directory and work from there 00065 0065 * 00066 0066 tmpstr = ' ' 00067 0067 if (str(1:1) .eq. '\'.or.str(1:1).eq.'~') then 00068 0068 call lib$sys_trnlog('SYS$LOGIN',tmpptr,tmpstr,,,) 00069 0069 loccol = index(tmpstr(1:tmpptr),':') 00070 0070 call lib$set_logical('SYS$DISK',tmpstr(1:loccol)) 00071 0071 locusr = index(tmpstr(1:tmpptr),'[') + 1 00072 0072 endusr = index(tmpstr(1:tmpptr),']') - 1 00073 0073 if (l_str .gt.1) then 00074 0074 l_nstr = endusr-locusr+l_str + 2 00075 0075 wrkstr(1:l_nstr) = '%'//tmpstr(locusr:endusr)//'.'// 00076 0076 1 str(2:l_str) 00077 0077 else 00078 0078 l_nstr = endusr - locusr + 2 00079 0079 wrkstr(1:l_nstr) = '%'//tmpstr(locusr:endusr) 00080 0080 endif 00081 0081 l_str = l_nstr 00082 0082 str(1:l_str) = wrkstr(1:l_str) 00083 0083 endif 00084 0084 * 00085 0085 * 00086 0086 * satisfy unix people by allowing '..' 00087 0087 * 00088 0088 call changunix(str,l_str,ok) ! change all "../" to "^" 00089 0089 call changit(str,l_str) ! change all '..' to '^' 00090 0090 call changeslash(str,l_str) ! change all '/' to '.' 00091 0091 * 00092 0092 * 00093 0093 * deal with directory on SYS$SYSDEVICE 00094 0094 * 00095 0095 if (str(1:1).eq.'>') then 00096 0096 call dosys(str(2:2),l_str) 00097 0097 endif 00098 0098 * 00099 0099 if (str(1:1).eq.'<') then 00100 0100 call lib$set_logical('SYS$DISK','LIB$DISK:') 00101 0101 str(1:1) = '%' 00102 0102 endif 00103 0103 00104 0104 if (str(1:1).eq.'#') then 00105 0105 call lib$set_logical('SYS$DISK','SYS$SYSDEVICE:') 00106 0106 str(1:1) = '%' 00107 0107 endif 00108 0108 00109 0109 if (str(1:1).eq.'&') then 00110 0110 call lib$set_logical('SYS$DISK','USER:') 00111 0111 str(1:1) = '%' 00112 0112 endif 00113 0113 00114 0114 * CHDIR 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 3 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00115 0115 * call up quick reference 00116 0116 * 00117 0117 if (str(1:1).eq.'?') then 00118 0118 call typehelp 00119 0119 endif 00120 0120 * 00121 0121 * 00122 0122 * Munge away at the input string 00123 0123 * 00124 0124 defstr(1:1) = '[' 00125 0125 strptr = 1 00126 0126 saveloc = 1 00127 0127 * 00128 0128 godown = .true. 00129 0129 if (str(1:1).eq.'.'.or.str(1:1).eq.'%') then 00130 0130 if (l_str.le.1) then 00131 0131 call setdef('[000000]') 00132 0132 call exit 00133 0133 endif 00134 0134 godown = .false. 00135 0135 saveloc = 2 00136 0136 endif 00137 0137 * 00138 0138 locup = index(str(1:l_str),'^') 00139 0139 * 00140 0140 do while (locup .ne. 0) 00141 0141 strptr = strptr + 1 00142 0142 defstr(strptr:strptr) = '-' 00143 0143 str(locup:locup) = ' ' 00144 0144 newlocup = index(str(1:l_str),'^') 00145 0145 if (newlocup.ne.0) then 00146 0146 if (newlocup .ne. locup+1) then 00147 0147 call lib$stop(msg_badarg) 00148 0148 endif 00149 0149 endif 00150 0150 saveloc = locup + 1 00151 0151 locup = newlocup 00152 0152 end do 00153 0153 * 00154 0154 strptr = strptr + 1 00155 0155 if (saveloc.le.l_str) then 00156 0156 justup = .false. 00157 0157 if (godown) then 00158 0158 defstr(strptr:strptr) = '.' 00159 0159 strptr = strptr + 1 00160 0160 endif 00161 0161 defstr(strptr:(strptr+(l_str-saveloc+1))) = str(saveloc:l_str) 00162 0162 strptr = strptr + (l_str - saveloc+1) 00163 0163 else 00164 0164 justup = .true. 00165 0165 endif 00166 0166 * 00167 0167 defstr(strptr:strptr) = ']' 00168 0168 * 00169 0169 if (.not.justup) then 00170 0170 checkdir = ' ' 00171 0171 if (index(defstr(1:strptr),'.').eq.0) then CHDIR 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 4 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00172 0172 checkdir = '[000000]'//defstr(2:strptr-1)//'.DIR' 00173 0173 call str$trim(checkdir,checkdir,l_check) 00174 0174 call checkit(checkdir(1:l_check),stat,wrkstr,l_wrk) 00175 0175 if (stat.ne.1) then 00176 0176 call lib$set_logical('SYS$DISK',olddisk(1:l_olddisk)) 00177 0177 call str$trim(wrkstr,wrkstr,l_wrk) 00178 0178 if (l_wrk.gt.1) then 00179 0179 call lib$stop(msg_nodir,%val(1),wrkstr(1:l_wrk)) 00180 0180 else 00181 0181 call lib$stop(msg_baddir,%val(1),defstr(1:strptr)) 00182 0182 endif 00183 0183 endif 00184 0184 else 00185 0185 wrkstr = defstr 00186 0186 locptr = index(wrkstr(1:strptr),'.') 00187 0187 do while (locptr.ne.0) 00188 0188 savptr = locptr 00189 0189 wrkstr(locptr:locptr) = ' ' 00190 0190 locptr = index(wrkstr(1:strptr),'.') 00191 0191 end do 00192 0192 checkdir = defstr 00193 0193 checkdir(savptr:savptr) = ']' 00194 0194 checkdir(strptr:strptr+3) = '.DIR' 00195 0195 call str$trim(checkdir,checkdir,l_check) 00196 0196 call checkit(checkdir(1:l_check),stat,wrkstr,l_wrk) 00197 0197 if (stat.ne.1) then 00198 0198 call lib$set_logical('SYS$DISK',olddisk(1:l_olddisk)) 00199 0199 call str$trim(wrkstr,wrkstr,l_wrk) 00200 0200 if (l_wrk.gt.1) then 00201 0201 call lib$stop(msg_nodir,%val(1),wrkstr(1:l_wrk)) 00202 0202 else 00203 0203 call lib$stop(msg_baddir,%val(1),defstr(1:strptr)) 00204 0204 endif 00205 0205 endif 00206 0206 endif 00207 0207 endif 00208 0208 * 00209 0209 call setdef(defstr(1:strptr)) 00210 0210 50 continue 00211 0211 call exit 00212 0212 end CHDIR 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 5 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1366 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 73 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 1340 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 2779 ENTRY POINTS Address Type Name 0-00000000 CHDIR VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-000000F0 CHAR CHECKDIR 2-00000078 CHAR DEFSTR 2-000002F4 I*4 ENDUSR 2-000002D0 L*4 GODOWN 2-000002D4 L*4 JUSTUP 2-000002EC I*4 LOCCOL 2-000002E8 I*4 LOCDISK 2-00000318 I*4 LOCPTR 2-00000304 I*4 LOCUP 2-000002F0 I*4 LOCUSR 2-0000030C I*4 L_CHECK 2-000002F8 I*4 L_NSTR 2-000002E0 I*4 L_OLDDISK 2-000002DC I*4 L_STR 2-00000314 I*4 L_WRK 2-00000308 I*4 NEWLOCUP 2-000002D8 L*4 OK 2-000001E0 CHAR OLDDISK 2-00000300 I*4 SAVELOC 2-0000031C I*4 SAVPTR 2-00000310 I*4 STAT 2-00000000 CHAR STR 2-000002FC I*4 STRPTR 2-000002E4 I*4 TMPPTR 2-00000258 CHAR TMPSTR 2-00000168 CHAR WRKSTR LABELS Address Label 0-0000054B 50 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name CHANGESLASH CHANGIT CHANGUNIX CHECKIT DOSYS FOR$EXIT LIB$GET_FOREIGN I*4 LIB$INDEX LIB$SET_LOGICAL LIB$STOP LIB$SYS_TRNLOG MSG_BADARG MSG_BADDIR MSG_BADSYS MSG_NODIR SETDEF STR$TRIM TYPEHELP 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 6 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00213 0001 * 00214 0002 * 00215 0003 subroutine checkit(checkdir,istat,fullpath,l_full) 00216 0004 character*120 checkdir,fullpath 00217 0005 logical isthere 00218 0006 * 00219 0007 * this routine takes a file specification and 00220 0008 * attempts to access the directory...if it fails 00221 0009 * then CD will assume the directory is inaccessible 00222 0010 * 00223 0011 * if the directory is not accessible this routine will 00224 0012 * take the name information provided by the inquire command 00225 0013 * and format it for an error message 00226 0014 * 00227 0015 fullpath(1:120) = ' ' 00228 0016 inquire (file=checkdir,exist=isthere,name=fullpath) 00229 0017 if (isthere) then 00230 0018 istat = 1 00231 0019 else 00232 0020 call str$trim(fullpath,fullpath,l_full) 00233 0021 loc = index(fullpath(1:l_full),']') 00234 0022 fullpath(loc:loc) = '.' 00235 0023 loc = index(fullpath(1:l_full),'.DIR;') 00236 0024 fullpath(loc:loc) = ']' 00237 0025 fullpath(loc+1:120) = ' ' 00238 0026 l_full = loc 00239 0027 istat = 0 00240 0028 endif 00241 0029 return 00242 0030 end CHECKIT 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 7 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 168 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 8 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 116 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 292 ENTRY POINTS Address Type Name 0-00000000 CHECKIT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000004@ CHAR CHECKDIR AP-0000000C@ CHAR FULLPATH AP-00000008@ I*4 ISTAT 2-00000000 L*4 ISTHERE 2-00000004 I*4 LOC AP-00000010@ I*4 L_FULL FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name FOR$INQUIRE I*4 LIB$INDEX STR$TRIM 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 8 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00243 0001 * 00244 0002 * 00245 0003 * 00246 0004 subroutine dosys(code,l_str) 00247 0005 * 00248 0006 * this routine sets default to special system directories 00249 0007 * 00250 0008 * this routine translates all logical names first and then sets 00251 0009 * default to the specified directory. 00252 0010 * 00253 0011 * Because of the fact that all logical names are translated first 00254 0012 * this routine will work for any vms 3.0 system on any system disk 00255 0013 * 00256 0014 implicit integer(a-z) 00257 0015 external msg_badsys 00258 0016 character*1 code,lognamstr*100,rootpath*100,defdir*120 00259 0017 character*20 sysdisk 00260 0018 * 00261 0019 call lib$sys_trnlog('SYS$SYSDEVICE',l_sysdisk,sysdisk) 00262 0020 * 00263 0021 if (l_str.le.1) then 00264 0022 call setdef('[000000]') 00265 0023 call lib$set_logical('SYS$DISK',sysdisk(3:l_sysdisk)) 00266 0024 defdir = sysdisk(1:l_sysdisk)//'[000000]' 00267 0025 print *,'System directory: ' 00268 0026 1 //defdir(3:(l_sysdisk+8)) 00269 0027 call exit 00270 0028 end if 00271 0029 00272 0030 * 00273 0031 call lib$sys_trnlog('SYS$SYSROOT',l_root,rootpath) 00274 0032 l_root = l_root - 1 00275 0033 if (code.eq.'M') then 00276 0034 call lib$sys_trnlog('SYS$MANAGER',l_log,lognamstr,,,) 00277 0035 locbrak = index(lognamstr(1:l_log),'[') + 1 00278 0036 defdir = rootpath(1:l_root)//lognamstr(locbrak:l_log) 00279 0037 call setdef(defdir(3:l_root+(l_log-locbrak)+1)) 00280 0038 goto 100 00281 0039 endif 00282 0040 if (code.eq.'S') then 00283 0041 call lib$sys_trnlog('SYS$SYSTEM',l_log,lognamstr,,,) 00284 0042 locbrak = index(lognamstr(1:l_log),'[') +1 00285 0043 defdir = rootpath(1:l_root)//lognamstr(locbrak:l_log) 00286 0044 call setdef(defdir(3:l_root+(l_log-locbrak)+1)) 00287 0045 goto 100 00288 0046 endif 00289 0047 if (code.eq.'E') then 00290 0048 call lib$sys_trnlog('SYS$ERRORLOG',l_log,lognamstr,,,) 00291 0049 locbrak = index(lognamstr(1:l_log),'[') +1 00292 0050 defdir = rootpath(1:l_root)//lognamstr(locbrak:l_log) 00293 0051 call setdef(defdir(3:l_root+(l_log-locbrak)+1)) 00294 0052 goto 100 00295 0053 endif 00296 0054 if (code.eq.'U') then 00297 0055 call lib$sys_trnlog('SYS$UPDATE',l_log,lognamstr,,,) 00298 0056 locbrak = index(lognamstr(1:l_log),'[') +1 00299 0057 defdir = rootpath(1:l_root)//lognamstr(locbrak:l_log) DOSYS 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 9 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00300 0058 call setdef(defdir(3:l_root+(l_log-locbrak)+1)) 00301 0059 goto 100 00302 0060 endif 00303 0061 if (code.eq.'F') then 00304 0062 call lib$sys_trnlog('SYS$MAINTENANCE',l_log,lognamstr,,,) 00305 0063 locbrak = index(lognamstr(1:l_log),'[') +1 00306 0064 defdir = rootpath(1:l_root)//lognamstr(locbrak:l_log) 00307 0065 call setdef(defdir(3:l_root+(l_log-locbrak)+1)) 00308 0066 goto 100 00309 0067 endif 00310 0068 if (code.eq.'H') then 00311 0069 call lib$sys_trnlog('SYS$HELP',l_log,lognamstr,,,) 00312 0070 locbrak = index(lognamstr(1:l_log),'[') +1 00313 0071 defdir = rootpath(1:l_root)//lognamstr(locbrak:l_log) 00314 0072 call setdef(defdir(3:l_root+(l_log-locbrak)+1)) 00315 0073 goto 100 00316 0074 endif 00317 0075 if (code.eq.'L') then 00318 0076 call lib$sys_trnlog('SYS$LIBRARY',l_log,lognamstr,,,) 00319 0077 locbrak = index(lognamstr(1:l_log),'[') +1 00320 0078 defdir = rootpath(1:l_root)//lognamstr(locbrak:l_log) 00321 0079 call setdef(defdir(3:l_root+(l_log-locbrak)+1)) 00322 0080 goto 100 00323 0081 endif 00324 0082 call lib$stop(msg_badsys) 00325 0083 call exit 00326 0084 * 00327 0085 100 call lib$set_logical('SYS$DISK',sysdisk(3:l_sysdisk)) 00328 0086 print *,'System directory: ' 00329 0087 1 //defdir(3:l_root+(l_log-locbrak)+1) 00330 0088 call exit 00331 0089 end DOSYS 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 10 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1216 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 148 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 780 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 2144 ENTRY POINTS Address Type Name 0-00000000 DOSYS VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000004@ CHAR CODE 2-000000C8 CHAR DEFDIR 2-00000160 I*4 LOCBRAK 2-00000000 CHAR LOGNAMSTR 2-0000015C I*4 L_LOG 2-00000158 I*4 L_ROOT AP-00000008@ I*4 L_STR 2-00000154 I*4 L_SYSDISK 2-00000064 CHAR ROOTPATH 2-00000140 CHAR SYSDISK LABELS Address Label 0-00000458 100 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name FOR$EXIT I*4 LIB$INDEX LIB$SET_LOGICAL LIB$STOP LIB$SYS_TRNLOG MSG_BADSYS SETDEF 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 11 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00332 0001 * 00333 0002 * 00334 0003 subroutine typehelp 00335 0004 CALL LIB$ERASE_PAGE(1,1) 00336 0005 print *,' CHDIR quick reference' 00337 0006 print *,' ' 00338 0007 print *,'CD ==> SET DEFAULT SYS$LOGIN' 00339 0008 print *,'CD ^ or CD .. ==> SET DEFAULT [-]' 00340 0009 print *,'CD ^^ or CD .... ==> SET DEFAULT [--]' 00341 0010 print *,'CD ^SUB or CD ..SUB ==> SET DEFAULT [-.SUB]' 00342 0011 print *,'CD ^SUB1.SUB2 ==> SET DEFAULT [-.SUB1.SUB2]' 00343 0012 print *,'CD ~SUB or CD \SUB ==> SET DEFAULT [home.SUB]' 00344 0013 print *,'CD SUB ==> SET DEFAULT [.SUB]' 00345 0014 Print *,'CD %USERNAME ==> SET DEFAULT [USERNAME]' 00346 0015 Print *,'CD /USERNAME ==> SET DEFAULT [USERNAME]' 00347 0016 Print *,'CD % or CD / ==> SET DEFAULT [000000]' 00348 0017 Print *,'CD &DIR.SUB ==> SET DEFAULT USER:[DIR.SUB]' 00349 0018 Print *,'CD SET DEFAULT LIB$DISK:[DIR.SUB]' 00350 0019 Print *,'CD #DIR.SUB ==> SET DEFAULT SYS$SYSDEVICE'// 00351 0020 1 ':[DIR.SUB]' 00352 0021 Print *,'CD > ==> SET DEFAULT SYS$SYSDEVICE'// 00353 0022 1 ':[000000]' 00354 0023 Print *,'CD >n ==> SET DEFAULT SYS$XXXXXXX' 00355 0024 print *,' where "n" denotes one of:' 00356 0025 print *,' "S" = SYS$SYSTEM Note:' 00357 0026 print *,' "M" = SYS$MANAGER ("/" and "%"), ("^" and "..")' 00358 0027 print *,' "E" = SYS$ERRORLOG and ("\" and "~") are all' 00359 0028 print *,' "H" = SYS$HELP identical functions to pro-' 00360 0029 print *,' "L" = SYS$LIBRARY vide some UNIX compatibility' 00361 0030 print *,' "U" = SYS$UPDATE' 00362 0031 print *,' "F" = SYS$MAINTENANCE' 00363 0032 call exit 00364 0033 end TYPEHELP 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 12 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 709 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 1113 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 212 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 2034 ENTRY POINTS Address Type Name 0-00000000 TYPEHELP FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name FOR$EXIT LIB$ERASE_PAGE 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 13 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00365 0001 * 00366 0002 subroutine changit(str,l_str) 00367 0003 * 00368 0004 * routine to replace all occurances of '..' with '^' 00369 0005 * so that the main program only has to deal with one type of argument 00370 0006 * 00371 0007 implicit integer(a-z) 00372 0008 character*120 str,wrkstr 00373 0009 * 00374 0010 loc = index(str(1:l_str),'..') 00375 0011 if (loc.eq. 0) return 00376 0012 * 00377 0013 do while (loc.ne.0) 00378 0014 call str$replace(wrkstr,str(1:l_str),loc,loc+1,'^') 00379 0015 l_str = l_str - 1 00380 0016 str(1:l_str) = wrkstr(1:l_str) 00381 0017 loc = index(str(1:l_str),'..') 00382 0018 end do 00383 0019 * 00384 0020 return 00385 0021 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 108 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 5 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 200 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 313 ENTRY POINTS Address Type Name 0-00000000 CHANGIT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000078 I*4 LOC AP-00000008@ I*4 L_STR AP-00000004@ CHAR STR 2-00000000 CHAR WRKSTR FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name I*4 LIB$INDEX STR$REPLACE 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 14 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00386 0001 * 00387 0002 * 00388 0003 subroutine changunix(str,l_str) 00389 0004 * 00390 0005 * routine to replace all occurances of '../' with '^' 00391 0006 * so that the main program only has to deal with one type of argument 00392 0007 * 00393 0008 implicit integer(a-z) 00394 0009 character*120 str,wrkstr 00395 0010 * 00396 0011 loc = index(str(1:l_str),'../') 00397 0012 if (loc.eq. 0) return 00398 0013 * 00399 0014 do while (loc.ne.0) 00400 0015 call str$replace(wrkstr,str(1:l_str),loc,loc+2,'^') 00401 0016 l_str = l_str - 2 00402 0017 str(1:l_str) = wrkstr(1:l_str) 00403 0018 loc = index(str(1:l_str),'../') 00404 0019 end do 00405 0020 * 00406 0021 return 00407 0022 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 109 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 6 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 200 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 315 ENTRY POINTS Address Type Name 0-00000000 CHANGUNIX VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000078 I*4 LOC AP-00000008@ I*4 L_STR AP-00000004@ CHAR STR 2-00000000 CHAR WRKSTR CHANGUNIX 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 15 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name I*4 LIB$INDEX STR$REPLACE 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 16 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00408 0001 * 00409 0002 * 00410 0003 subroutine changeslash(str,l_str) 00411 0004 * 00412 0005 * routine to replace all occurances of '/' with '.' 00413 0006 * so that the main program only has to deal with one type of argument 00414 0007 * 00415 0008 implicit integer(a-z) 00416 0009 character*120 str,wrkstr 00417 0010 * 00418 0011 loc = index(str(1:l_str),'/') 00419 0012 if (loc.eq. 0) return 00420 0013 * 00421 0014 do while (loc.ne.0) 00422 0015 call str$replace(wrkstr,str(1:l_str),loc,loc,'.') 00423 0016 str(1:l_str) = wrkstr(1:l_str) 00424 0017 loc = index(str(1:l_str),'/') 00425 0018 end do 00426 0019 * 00427 0020 return 00428 0021 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 94 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 4 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 200 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 298 ENTRY POINTS Address Type Name 0-00000000 CHANGESLASH VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000078 I*4 LOC AP-00000008@ I*4 L_STR AP-00000004@ CHAR STR 2-00000000 CHAR WRKSTR FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name I*4 LIB$INDEX STR$REPLACE 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 17 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 00429 0001 * 00430 0002 00431 0003 subroutine setdef(defdir) 00432 0004 * 00433 0005 * this routine actually does the set default 00434 0006 * 00435 0007 character*(*) defdir 00436 0008 istat = sys$setddir(defdir,,) 00437 0009 return 00438 0010 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 33 PIC CON REL LCL SHR EXE RD NOWRT LONG 2 $LOCAL 28 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 61 ENTRY POINTS Address Type Name 0-00000000 SETDEF VARIABLES Address Type Name Address Type Name AP-00000004@ CHAR DEFDIR 2-00000000 I*4 ISTAT FUNCTIONS AND SUBROUTINES REFERENCED Type Name R*4 SYS$SETDDIR COMMAND QUALIFIERS FORTRAN /LIS CD/NOOB /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 SETDEF 27-Jun-1984 11:13:25 VAX-11 FORTRAN V3.5-62 Page 18 27-Jun-1984 11:13:17 DRA1:[AWPSYS.DECUS.CD]CD.FOR;2 COMPILATION STATISTICS Run Time: 11.23 seconds Elapsed Time: 18.20 seconds Page Faults: 311 Dynamic Memory: 125 pages