FLECS VERSION 860214 15-JUN-87 09:33:40 PAGE 00001 IMAGENAME.FOR,IMAGENAME.FLL/-SP=IMAGENAME.FLX/CO:GLBOPT 00001 00000 C;+ 00002 00000 C.ENTRY IMAGE_NAME 00003 00000 C - I M A G E _ N A M E 00004 00000 C IDENT: /860407/ 00005 00000 C FILE: IMAGENAME.FLX 00006 00000 C SYSTEM: VMS V3.5 00007 00000 C LANGUAGE: FLECS/F77 00008 00000 C AUTHOR: M. Oothoudt 00009 00000 C DATE: 16-Mar-83 00010 00000 C;- 00011 00000 C REFERENCES: 00012 00000 C 00013 00000 C REVISIONS: 00014 00000 C 13-JUN-84 (MAO) Extract this code from MESAGE and made it a 00015 00000 C separate subroutine. 00016 00000 C 860407mao Get JPI$ from include file. Use .IMP NONE. 00017 00000 C;+ 00018 00000 C 00019 00000 C****PURPOSE: Obtain image file name for current image. Eg. 00020 00000 C if file name is DRA1:[A.B]ZIP.EXE;3 this routine 00021 00000 C returns "ZIP". 00022 00000 C 00023 00000 C****RESTRICTIONS: 00024 00000 C 00025 00000 C****CALLING SEQUENCE: CALL IMAGE_NAME (NAME) 00026 00000 C 00027 00000 C INPUT: None 00028 00000 C 00029 00000 C MODIFIED: None 00030 00000 C 00031 00000 C OUTPUT: 00032 00000 C 00033 00000 C NAME =(C*n) Character array to receive the image name. If the 00034 00000 C image name is shorter than the user's character variable, it 00035 00000 C is blank filled on the right. If the image name is longer 00036 00000 C than the user's character variable, it is truncated. 00037 00000 C 00038 00000 C CMN BLOCKS USED: None 00039 00000 C 00040 00000 C****RESOURCES: 00041 00000 C LIBRARIES: None 00042 00000 C OTHER SUBR: None 00043 00000 C DISK FILES: None 00044 00000 C DEVICES: None 00045 00000 C SGAS: None 00046 00000 C EVENT FLAGS: 0 (SYS$GETJPI) 00047 00000 C SYSTEM DIR: SYS$GETJPI:SYS$WAITFR 00048 00000 C 00049 00000 C****NOTES: 00050 00000 C;- 00051 00001 SUBROUTINE IMAGE_NAME (NAME) 00052 00001 00053 00003 .IMPLICIT NONE 00054 00003 00055 00004 INCLUDE '($JPIDEF)/NOLIST' !860407 FLECS VERSION 860214 15-JUN-87 09:33:40 PAGE 00002 IMAGENAME.FOR,IMAGENAME.FLL/-SP=IMAGENAME.FLX/CO:GLBOPT 00056 00004 00057 00005 INTEGER*4 GETJPILST(4) !LOC, R/W, $GETJPI argument list 00058 00006 INTEGER*2 GETJPILST_W(8) !LOC, R/W, EQUIV (GETJPILST,GETJPILST_W) 00059 00007 INTEGER*2 I !LOC, R/W, scratch 00060 00008 INTEGER*2 IMAGE_END !LOC, R/W, last char in file name 00061 00009 INTEGER*2 IMAGE_STRT !LOC, R/W, 1st char in file name 00062 00010 CHARACTER*256 IMAGE_NAM !LOC, R/W, image file name 00063 00011 INTEGER*4 IMAGE_NAM_LEN !LOC, R/W, # characters in IMAGE_NAM 00064 00012 INTEGER*2 J !LOC, R/W, scratch 00065 00012 00066 00013 CHARACTER*(*) NAME !EXT, R/W, output image name 00067 00014 INTEGER*2 NAME_LEN !LOC, R/W, # characters in NAME 00068 00014 00069 00015 EQUIVALENCE (GETJPILST,GETJPILST_W) 00070 00015 00071 00016 GETJPILST_W(1) = LEN(IMAGE_NAM) !Max length 00072 00017 GETJPILST_W(2) = JPI$_IMAGNAME !Action code !860407 00073 00018 GETJPILST(2) = %LOC(IMAGE_NAM) !Addr of output 00074 00019 GETJPILST(3) = %LOC(IMAGE_NAM_LEN) !Addr of output length 00075 00020 GETJPILST(4) = 0 !end of list 00076 00020 00077 00021 CALL SYS$GETJPI(%VAL(0),,,GETJPILST,,,) 00078 00022 CALL SYS$WAITFR(%VAL(0)) 00079 00022 00080 00023 D TYPE*,'IMAGE_NAME: LEN=',IMAGE_NAM_LEN,' IMAGE_NAM=',IMAGE_NAM 00081 00023 00082 00023 C Extract the name 00083 00023 00084 00024 I=IMAGE_NAM_LEN !Find period before extension 00085 00027 WHILE (I.GT.0 .AND. IMAGE_NAM(I:I).NE.'.') I=I-1 00086 00028 IMAGE_END=I-1 00087 00028 00088 00031 WHILE (I.GT.0 .AND. IMAGE_NAM(I:I).NE.']') I=I-1 00089 00032 IMAGE_STRT=I+1 !Just after ] in directory 00090 00032 00091 00033 NAME_LEN = LEN(NAME) 00092 00033 00093 00034 WHEN (IMAGE_STRT.GT.IMAGE_END) 00094 00037 . DO (I=1,NAME_LEN) NAME(I:I)=' ' !Blank fill 00095 00037 ...FIN!when 00096 00038 ELSE 00097 00038 . 00098 00039 . J=1 00099 00040 . I=IMAGE_STRT 00100 00041 . WHILE (I.LE.IMAGE_END .AND. J.LE.NAME_LEN) 00101 00042 . . NAME(J:J)=IMAGE_NAM(I:I) 00102 00043 . . J=J+1 00103 00044 . . I=I+1 00104 00044 . ...FIN!while 00105 00046 . IF (J.LE.NAME_LEN) 00106 00049 . . DO (I=J,NAME_LEN) NAME(I:I)=' ' !Blank fill 00107 00049 . ...FIN!if 00108 00050 ...FIN!else 00109 00051 00110 00052 RETURN FLECS VERSION 860214 15-JUN-87 09:33:40 PAGE 00003 IMAGENAME.FOR,IMAGENAME.FLL/-SP=IMAGENAME.FLX/CO:GLBOPT 00111 00053 END (FLECS VERSION 22.38) IMAGE_NAME 15-Jun-1987 09:33:42 VAX FORTRAN V4.5-219 Page 2 15-Jun-1987 09:33:41 [MP1Q.FLEALECOM.QLIB]IMAGENAME.FOR;1 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 249 PIC CON REL LCL SHR EXE RD NOWRT LONG 2 $LOCAL 328 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 577 ENTRY POINTS Address Type Name 0-00000000 IMAGE_NAME VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*2 I ** I*2 IMAGE_END 2-00000010 CHAR IMAGE_NAM 2-00000114 I*4 IMAGE_NAM_LEN ** I*2 IMAGE_STRT ** I*2 J AP-00000004@ CHAR NAME ** I*2 NAME_LEN ARRAYS Address Type Name Bytes Dimensions 2-00000000 I*4 GETJPILST 16 (4) 2-00000000 I*2 GETJPILST_W 16 (8) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name SYS$GETJPI SYS$WAITFR COMMAND QUALIFIERS FORTRAN/F77/LIST=IMAGENAME.LST/NOI4/F77 IMAGENAME /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /STANDARD=(NOSYNTAX,NOSOURCE_FORM) /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP,NODICTIONARY,SINGLE) /WARNINGS=(GENERAL,NODECLARATIONS,NOULTRIX) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /NOI4 /NOMACHINE_CODE /OPTIMIZE IMAGE_NAME 15-Jun-1987 09:33:42 VAX FORTRAN V4.5-219 Page 3 15-Jun-1987 09:33:41 [MP1Q.FLEALECOM.QLIB]IMAGENAME.FOR;1 COMPILATION STATISTICS Run Time: 0.57 seconds Elapsed Time: 2.16 seconds Page Faults: 707 Dynamic Memory: 683 pages