FLECS VERSION 860214 15-JUN-87 09:33:30 PAGE 00001 GETMCR.FOR,GETMCR.FLL/-SP=GETMCR.FLX/CO:GLBOPT 00001 00000 C;+ 00002 00000 C.ENTRY GETMCR 00003 00000 C - G E T M C R 00004 00000 C****NAME: SUBROUTINE GETMCR 00005 00000 C IDENT: /860407/ 00006 00000 C FILE: GETMCR.FLX 00007 00000 C 00008 00000 C****PURPOSE: Get command line passed to a process (see note 2) or 00009 00000 C passed to a subprocess (see note 3). 00010 00000 C 00011 00000 C****RESTRICTIONS: 00012 00000 C 00013 00000 C SYSTEM: VAX/VMS 3.1 00014 00000 C LANGUAGE: FLECS/F77 00015 00000 C AUTHOR: M. OOTHOUDT 00016 00000 C DATE: 23-AUG-79 00017 00000 C;- 00018 00000 C REVISIONS: 00019 00000 C 02-Feb-83 (mao) Check if SYS$INPUT goes to concealed device and 00020 00000 C remove extra underscore if so. 00021 00000 C 03/15/83 GTA Use system service LIB$GET_FOREIGN instead of 00022 00000 C undocumented SYS$CLI. Update documentation. 00023 00000 C 09-FEB-84 (MAO) $WAITFR after $GETJPI for V4.0 compatibility. 00024 00000 C 850805mao Use $GETJPIW instead of $GETJPI/$WAITFR. Use .IMP NONE. 00025 00000 C Minor mods to documentation. 00026 00000 C 850822mao Put out warning if input line truncated. 00027 00000 C 851014mao Get rid of embedded blanks in process name. Fix bug 00028 00000 C if getting process name fails. 00029 00000 C 860407mao Use include files to get SS$/JPI$ symbols. 00030 00000 C;+ 00031 00000 C 00032 00000 C****CALLING SEQUENCE: CALL GETMCR(LINE [,IDS]) 00033 00000 C 00034 00000 C INPUT: NONE 00035 00000 C 00036 00000 C OUTPUT: 00037 00000 C 00038 00000 C LINE =(80L*1) Array to receive the command line. The command line is 00039 00000 C prefixed by the first 3 letters of the process name 00040 00000 C and has a appended to the end. 00041 00000 C IDS =(I*2) Status of attempt to get the command line: 00042 00000 C =+NN Number of characters in command line excluding terminating 00043 00000 C carriage control characters. NN will be .GT. zero. 00044 00000 C =-80 No command line found 00045 00000 C 00046 00000 C CMN BLOCK I/O: NONE 00047 00000 C 00048 00000 C RESOURCES: 00049 00000 C LIBRARIES: QLIB:ARGS:CHRTOBYT 00050 00000 C OTHER SUBR: NONE 00051 00000 C DISK FILES: NONE 00052 00000 C DEVICES: NONE 00053 00000 C SGAS: NONE 00054 00000 C EVENT FLAGS: 0 ($GETJPI) 00055 00000 C SYSTEM DIR: LIB$GET_FOREIGN, SYS$GETJPIW FLECS VERSION 860214 15-JUN-87 09:33:30 PAGE 00002 GETMCR.FOR,GETMCR.FLL/-SP=GETMCR.FLX/CO:GLBOPT 00056 00000 C 00057 00000 C****NOTES: 00058 00000 C 1. This is an exact mimic of the PDP11 FORTRAN special subroutin 00059 00000 C GETMCR. The internals are vastly different for the VAX. Note 2 00060 00000 C explains how GETMCR gets the command line. 00061 00000 C 00062 00000 C 2. A command line is passed by making 00063 00000 C the process a "foreign command." A foreign command is produced by 00064 00000 C defining a symbol containing a dollar sign followed by a device 00065 00000 C and a file name (the remainder of the file spec is optional): 00066 00000 C 00067 00000 C $ SYM :=[=] $DBA0:TASK 00068 00000 C 00069 00000 C Then the task may be called with a command line by 00070 00000 C 00071 00000 C $ SYM LINE 00072 00000 C 00073 00000 C The line returned has all multiple blanks and tabs converted to a 00074 00000 C single blank. 00075 00000 C 00076 00000 C 3. See the 00077 00000 C QLIB routine MCRREQ for a method of creating a subprocess and 00078 00000 C passing it a command line that GETMCR can get. 00079 00000 C 00080 00000 C;- 00081 00001 SUBROUTINE GETMCR(LINE,IDS) 00082 00003 .IMPLICIT NONE !850805 00083 00003 C 00084 00003 C GLOBAL DECLARATIONS 00085 00003 C 00086 00004 INCLUDE '($LIBDEF)/NOLIST' !850822 00087 00005 INCLUDE '($SSDEF)/NOLIST' !860407 00088 00006 INCLUDE '($JPIDEF)/NOLIST' !860407 00089 00007 BYTE LINE(80) 00090 00008 INTEGER*2 IDS 00091 00008 C 00092 00008 C LOCAL DECLARATIONS 00093 00008 C 00094 00009 BYTE PRCNAM(15),SPACE,CR 00095 00010 CHARACTER LOG_NAM*63,ESCAPE,TMP*63, FLINE*80 00096 00011 INTEGER*2 MAP,NARGS,LENGTH,LEN_PRNAM,IJPI(8),LEN,I 00097 00012 INTEGER*4 ISTAT,LJPI(4) 00098 00013 INTEGER*4 LIB$GET_FOREIGN, SYS$GETJPIW 00099 00014 LOGICAL*2 BLANK 00100 00014 C 00101 00015 EQUIVALENCE(IJPI(1),LJPI(1)) 00102 00016 DATA SPACE,CR/1H ,"15/, ESCAPE/"33/ 00103 00016 C 00104 00017 CALL ARGS(NARGS,MAP) !GET ARGUMENTS IN CALL TO GETMCR 00105 00018 LENGTH=-80 !ASSUME FAILURE 00106 00019 PRCNAM(1)=0 !PROCESS NAME NOT YET LOOKED UP 00107 00019 C 00108 00021 TRY-TO-GET-KEYBOARD-COMMAND-LINE 00109 00021 C 00110 00026 IF(LENGTH.GE.0)CONVERT-LINE-TO-PDP11-FORMAT FLECS VERSION 860214 15-JUN-87 09:33:30 PAGE 00003 GETMCR.FOR,GETMCR.FLL/-SP=GETMCR.FLX/CO:GLBOPT 00111 00026 C 00112 00027 IF(NARGS.GE.2.AND.((MAP.AND."2).NE.0))IDS=LENGTH 00113 00027 C 00114 00028 D TYPE *,' END OF GETMCR ',LINE,IDS 00115 00029 RETURN ---------------------------------------- 00116 00030 TO TRY-TO-GET-KEYBOARD-COMMAND-LINE 00117 00030 C . 00118 00030 C . ATTEMPT TO GET COMMAND LINE TYPED ON KEYBOARD WITH A FOREIGN 00119 00030 C . COMMAND. NOTE THAT THE CHECK ON THE DIRECTIVE STATUS ALLOWS 00120 00030 C . US TO CATCH SOMEONE JUST RUNNING THE IMAGE, IN WHICH CASE NO 00121 00030 C . SENSIBLE COMMAND LINE CAN BE PASSED FROM THE KEYBOARD. 00122 00030 C . (IF SOMEONE TRIES TO RUN AN IMAGE AND PASS A COMMAND LINE ON 00123 00030 C . THE SAME LINE, YOU GET A DCL ERROR.) 00124 00030 C . 00125 00031 . ISTAT = LIB$GET_FOREIGN(FLINE,,LEN) 00126 00032 . IF (ISTAT.EQ.LIB$_INPSTRTRU) !850822 00127 00033 . . CALL MESAGE(0,0,4, 00128 00034 1. . 'W-Command line truncated to 80 characters') !850822 00129 00034 . ...FIN!if !850822 00130 00035 . 00131 00036 D . CALL RPSTAT('GETMCR--LIB$GET-FOREIGN ',ISTAT) 00132 00037 D . TYPE *,' FLINE ',FLINE, LEN 00133 00037 C . 00134 00037 C Put the character string into the byte output array. 00135 00037 C Note that line has been truncated to 80 characters. 00136 00037 C . 00137 00038 . IF (ISTAT)CALL CHRTOBYT(FLINE,LEN,LINE,LENGTH) 00138 00039 D . TYPE *,' AFTER CHTB ',LINE,LENGTH 00139 00039 ...FIN ---------------------------------------- 00140 00041 TO CONVERT-LINE-TO-PDP11-FORMAT 00141 00041 C . 00142 00041 C . THE PDP11 GETMCR RETURNS THE COMMAND LINE PREFIXED WITH THE 00143 00041 C . THREE LETTER TASK NAME AND A SPACE (ONLY ...TSK FORMS OF TASKS 00144 00041 C . CAN BE GIVEN A COMMAND LINE ON PDP11) AND TERMINATED BY A 00145 00041 C . OR . WE WILL FAKE THIS BY PREFIXING THE COMMAND LINE 00146 00041 C . WITH 3 LETTERS FROM THE PROCESS NAME AND APPENDING A . 00147 00041 C . 00148 00042 . WHEN(LENGTH.EQ.0) 00149 00042 C . . 00150 00042 C . . WE GOT A COMMAND LINE, BUT IT WAS ZERO LENGTH 00151 00042 C . . 00152 00043 . . LENGTH=3 !LINE WILL BE JUST "TSK" 00153 00043 . ...FIN 00154 00044 . ELSE 00155 00044 C . . 00156 00044 C . . WE GOT NONZERO COMMAND LINE. TRUNCATE IT IF NECESSARY AND SHIFT 00157 00044 C . . IT TO RIGHT TO MAKE ROOM FOR PROCESS NAME. 00158 00044 C . . 00159 00045 . . IF (LENGTH.GT.75) FLECS VERSION 860214 15-JUN-87 09:33:30 PAGE 00004 GETMCR.FOR,GETMCR.FLL/-SP=GETMCR.FLX/CO:GLBOPT 00160 00046 . . . LENGTH=75 00161 00047 . . . CALL MESAGE(0,0,4, 00162 00048 1. . . 'W-Command line truncated to 80 characters') !850822 00163 00048 . . ...FIN!if !850822 00164 00052 . . DO (I=LENGTH,1,-1)LINE(I+4)=LINE(I) 00165 00053 . . LENGTH=LENGTH+4 00166 00053 . ...FIN 00167 00054 C . 00168 00055 . LINE(LENGTH+1)=CR !APPEND CARRIAGE RETURN 00169 00055 C . 00170 00060 . IF(PRCNAM(1).EQ.0)GET-PROCESS-NAME 00171 00063 . DO (I=1,3)LINE(I)=PRCNAM(I) 00172 00064 . IF(LENGTH.GT.4)LINE(4)=SPACE !ADD SPACE FOR NONZERO LINE 00173 00064 ...FIN ---------------------------------------- 00174 00066 TO GET-PROCESS-NAME 00175 00066 C . 00176 00066 C . FIND THE NAME OF OUR PROCESS 00177 00066 C . 00178 00067 . IJPI(1)=15 !PROCESS NAME !BUFFER LENGTH 00179 00068 . IJPI(2)=JPI$_PRCNAM !ACTION CODE !860407 00180 00069 . LJPI(2)=%LOC(PRCNAM) !ADDR OUTPUT BUFFER 00181 00070 . LJPI(3)=%LOC(LEN_PRNAM) !ADDR OF ACTUAL LENGTH 00182 00071 . LJPI(4)=0 !END OF LIST 00183 00071 C . 00184 00072 . ISTAT=SYS$GETJPIW(%VAL(0),,,IJPI,,,) !850805 00185 00073 D . CALL RPSTAT('GETMCR--$GETJPI',ISTAT) 00186 00073 C . 00187 00074 . WHEN(ISTAT.NE.SS$_NORMAL) !860407 00188 00074 C . . 00189 00074 C . . FAILED TO GET NAME! FAKE IT 00190 00074 C . . 00191 00077 . . DO (I=1,3)PRCNAM(I)=1HX !851014 00192 00077 . ...FIN 00193 00078 . ELSE 00194 00078 . . 00195 00078 C . . Remove any embedded blanks in the process name. Eg. the 00196 00078 C . . process name could be "m a o" and the caller would 00197 00078 C . . appear to get a command line of "a o" by the normal rules 00198 00078 C . . for parsing the MCR command line. 00199 00078 . . 00200 00079 . . DO (I=1,15) !851014 00201 00080 . . . IF (PRCNAM(I).EQ.(1H )) PRCNAM(I)=1H_ !851014 00202 00080 . . ...FIN!do !851014 00203 00081 C . . 00204 00081 C . . FOR A SUBPROCESS CREATED BY MCRREQ THE PROCESS NAME IS 00205 00081 C . . ...TSK. CLEARLY WE WANT TO SKIP THE ... 00206 00081 C . . 00207 00082 . . IF(PRCNAM(1).EQ.1H.) 00208 00085 . . . DO (I=1,3)PRCNAM(I)=PRCNAM(I+3) 00209 00085 . . ...FIN 00210 00086 . ...FIN 00211 00087 ...FIN FLECS VERSION 860214 15-JUN-87 09:33:30 PAGE 00005 GETMCR.FOR,GETMCR.FLL/-SP=GETMCR.FLX/CO:GLBOPT 00212 00089 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00140 CONVERT-LINE-TO-PDP11-FORMAT 00110 00174 GET-PROCESS-NAME 00170 00116 TRY-TO-GET-KEYBOARD-COMMAND-LINE 00108 (FLECS VERSION 22.38) GETMCR 15-Jun-1987 09:33:33 VAX FORTRAN V4.5-219 Page 3 15-Jun-1987 09:33:31 $1$DUA11:[MP1Q.FLEALECOM.QLIB]GETMCR.FOR;1 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 401 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 50 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 284 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 735 ENTRY POINTS Address Type Name 0-00000000 GETMCR VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** L*2 BLANK 2-00000020 L*1 CR ** CHAR ESCAPE 2-00000021 CHAR FLINE ** I*2 I ** I*2 I32754 2-00000072 I*2 I32756 ** I*2 I32758 AP-00000008@ I*2 IDS ** I*4 ISTAT 2-0000007C I*2 LEN 2-00000078 I*2 LENGTH 2-0000007A I*2 LEN_PRNAM ** CHAR LOG_NAM 2-00000074 I*2 MAP 2-00000076 I*2 NARGS 2-0000001F L*1 SPACE ** CHAR TMP ARRAYS Address Type Name Bytes Dimensions 2-00000000 I*2 IJPI 16 (8) AP-00000004@ L*1 LINE 80 (80) 2-00000000 I*4 LJPI 16 (4) 2-00000010 L*1 PRCNAM 15 (15) LABELS Address Label Address Label Address Label Address Label Address Label Address Label 0-00000072 32753 ** 32754 0-00000078 32755 ** 32756 0-0000007C 32757 ** 32758 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name ARGS CHRTOBYT I*4 LIB$GET_FOREIGN MESAGE I*4 SYS$GETJPIW GETMCR 15-Jun-1987 09:33:33 VAX FORTRAN V4.5-219 Page 4 15-Jun-1987 09:33:31 $1$DUA11:[MP1Q.FLEALECOM.QLIB]GETMCR.FOR;1 COMMAND QUALIFIERS FORTRAN/F77/LIST=GETMCR.LST/NOI4/F77 GETMCR /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 COMPILATION STATISTICS Run Time: 1.23 seconds Elapsed Time: 3.43 seconds Page Faults: 765 Dynamic Memory: 817 pages