FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00001 GETCML,GETCML=GETCML 00001 00000 C;+ 00002 00000 C.ENTRY GETCML 00003 00000 C - G E T C M L 00004 00000 C****NAME: SUBROUTINE GETCML 00005 00000 C IDENT: /871029/ 00006 00000 C FILE: GETCML.FLX 00007 00000 C 00008 00000 C****PURPOSE: Get a command line for an image from TI: or indirect 00009 00000 C command file. 00010 00000 C 00011 00000 C****RESTRICTIONS: Indirect input files may not be nested more than 3 00012 00000 C levels deep. 00013 00000 C The calling image must be called as a DCL 00014 00000 C foreign command if command line information 00015 00000 C is to be retrieved by GETCML. See note 3. 00016 00000 C 00017 00000 C SYSTEM: VAX/VMS 00018 00000 C LANGUAGE: FLECS/F77 00019 00000 C AUTHOR: M. OOTHOUDT 00020 00000 C DATE: 16-JUL-79 00021 00000 C;- 00022 00000 C REVISIONS: 00023 00000 C 14-AUG-79 (MAO) FOR INDIRECT COMMAND FILES MAKE DEFAULT 00024 00000 C EXTENSION .CMD IF NOT GIVEN IN INPUT. 00025 00000 C 23-AUG-79 (MAO) USE GETMCR TO GET COMMAND LINE ON 1ST PASS. 00026 00000 C 06-SEP-79 (MAO) ECHO INPUT LINE IF IN INDIRECT COMMAND FILE. 00027 00000 C 23-OCT-80 (MAO) CHECK MAXCHAR FOR GETMCR CMD LINE TOO 00028 00000 C 01-NOV-82 (MAO) CORRECT BUG ON READING EOF AT LEVEL 0. 00029 00000 C 23-MAR-83 (GTA) Translate lower case input to upper case. Update 00030 00000 C documentation. Added variable INPUT_FROM_TI. 00031 00000 C See Note 4. 00032 00000 C 17-JAN-84 (MAO) Make more like PDP-11 GETCML: 160 char lines max; 00033 00000 C allow continuation lines; strip in-line comments; 00034 00000 C assume .COM, then .CMD for indirect files; do 00035 00000 C input upcasing more efficiently; put in data dict. 00036 00000 C 19-JAN-84 (MAO) Remove fix of 06-SEP-79, since calling program 00037 00000 C can now decide if it wants to echo indirect cmd file 00038 00000 C input. 00039 00000 C 850410mao Re write code so don't get access violations when checking 00040 00000 C optional arguments (FOR V4.x evaluates compound IF 00041 00000 C statements differently than previous versions.) 00042 00000 C 850805mao Allow full VMS file specs for @filespec up to 160 char long. 00043 00000 C Determine default extension better. Get rid of 00044 00000 C COMMON/GCML/ since it serves no purpose. Use .IMP NONE. 00045 00000 C 860424mao Set INPUT_FROM_TI for zero length lines. 00046 00000 C 860424mao Ignore LUN and NOCLOS args; get LUNs internally and 00047 00000 C leave files open until eof. 00048 00000 C 860424mao Get TI input from SYS$INPUT instead of FOR$ACCEPT since 00049 00000 C external users usually don't define FOR$ACCEPT. 00050 00000 C 871029mao Use unformatted IO to speed up subr by factor of 4-5. 00051 00000 C;+ 00052 00000 C 00053 00000 C****CALLING SEQUENCE: 00054 00000 C 00055 00000 C CALL GETCML(BUFFER,[PROMPT],LENGTH,[MAXLEN],[EOF],[LUN],[NOCLOS], FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00002 GETCML,GETCML=GETCML 00056 00000 C 1 [COMNTS]) 00057 00000 C 00058 00000 C EG. CALL GETCML(BUF,'PIP',LENGTH) 00059 00000 C CALL GETCML(BUF,,LEN,,,,1) 00060 00000 C 00061 00000 C INPUT: 00062 00000 C 00063 00000 C PROMPT=(BYTE ARRAY) ASCII bytes defining desired prompt string. When 00064 00000 C this string is written to the terminal, it is prefixed 00065 00000 C by a LF and CR, and suffixed by a '>' symbol. A zero 00066 00000 C byte should terminate the string. If the prompt string 00067 00000 C is not 3 characters long, it is assumed to contain its 00068 00000 C own suffix and may be of any length. 00069 00000 C DEFAULT: 3 blanks ( >). 00070 00000 C 00071 00000 C MAXLEN=(I*2) Maximum number of characters to return. If user inputs 00072 00000 C more than this number, an error message will be written 00073 00000 C and another try will be made. If MAXLEN<0, return of 00074 00000 C zero-length lines is enabled, and MAXLEN=IABS(MAXLEN). 00075 00000 C ABS(MAXLEN) must not be greater than 160. Continuation 00076 00000 C lines are allowed and are denoted by ending a line 00077 00000 C with a hyphen. 00078 00000 C DEFAULT: 80. 00079 00000 C 00080 00000 C LUN =(I*2) Ignored under VMS. Uses LIB$GETLUN to allocate LUNs. 00081 00000 C 00082 00000 C NOCLOS=(I*2) Ignored under VMS. Files left open until EOF hit. 00083 00000 C 00084 00000 C COMNTS=(I*2) If present and non-zero, causes lines containing a 00085 00000 C leading semicolon (comment lines) to be returned. 00086 00000 C On other lines, in-line comments (text starting with 00087 00000 C a "!") will be returned. 00088 00000 C DEFAULT: Throw out comments and read again. On other 00089 00000 C lines, strip off in-line comments. 00090 00000 C 00091 00000 C OUTPUT: 00092 00000 C 00093 00000 C BUFFER=(BYTE ARRAY) This array is filled with the command line. It 00094 00000 C must be at least MAXLEN bytes long. Note that the line 00095 00000 C terminator is not included in this buffer. 00096 00000 C 00097 00000 C LENGTH=(I*2) The number of bytes placed in BUFFER. A 00098 00000 C zero length line is not normally returned (see MAXLEN). 00099 00000 C 00100 00000 C EOF =(L*2) Set to .TRUE. if ctrl/z is entered. If EOF is not 00101 00000 C included in the subroutine call, an EXIT is executed 00102 00000 C when ctrl/z is read. 00103 00000 C 00104 00000 C CMN BLOCK I/O: /DVGCML/ 00105 00000 C 00106 00000 C RESOURCES: 00107 00000 C LIBRARIES: QLIB:ARGS:GETMCR 00108 00000 C RTL:FOR$CLOSE:FOR$INQUIRE:FOR$OPEN:LIB$GET_LUN 00109 00000 C OTHER SUBR: None 00110 00000 C DISK FILES: Indirect input files FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00003 GETCML,GETCML=GETCML 00111 00000 C DEVICES: FOR$TYPE (for output), SYS$INPUT (for TI: input) 00112 00000 C DISK (for input) 00113 00000 C SGAS: None 00114 00000 C EVENT FLAGS: None 00115 00000 C SYSTEM DIR: EXIT 00116 00000 C 00117 00000 C****NOTES: 00118 00000 C 1. This routine is a mimic of the QLIB routine GETCML. It 00119 00000 C operates just as the QLIB routine except 00120 00000 C prefixes all prompts. 00121 00000 C 00122 00000 C 2. There are many places in this subroutine where strange 00123 00000 C things are done. Eg. all the "CALL EXIT" calls. They are done to 00124 00000 C maintain compatibility with the PDP11 version of GETCML. 00125 00000 C 00126 00000 C 3. To produce a foreign command, at DCL level type 00127 00000 C 00128 00000 C $ SYM :=[=] $DBA0:TASK 00129 00000 C 00130 00000 C Here the assignment must contain the dollar sign and device. Other 00131 00000 C parts of the file specifier may be given if needed. Then the image 00132 00000 C is called by 00133 00000 C 00134 00000 C $ SYM LINE 00135 00000 C 00136 00000 C 4. Variable INPUT_FROM_TI has been added and put in COMMON 00137 00000 C /DVGCML/. This value may then be used by QLIB subroutine GCMLDV 00138 00000 C to find out whether input was from the terminal or a disk file. 00139 00000 C INPUT_FROM_TI = 2 : input is interactive; 00140 00000 C = 1 : input is from disk. 00141 00000 C These values are used so that if INPUT_FROM_TI = 0, the calling 00142 00000 C routine knows that GETCML has not been called. 00143 00000 C 00144 00000 C 5. If an indirect command file is specified as input 00145 00000 C (eg. @file) and the file extension is not given in the file name, 00146 00000 C this subroutine first assumes the extension is .COM. If no 00147 00000 C such file exists, GETCML tries .CMD for the extension. 00148 00000 C;- FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00004 GETCML,GETCML=GETCML 00149 00000 .PAGE 00150 00001 SUBROUTINE GETCML(BUFFER,PROMPT,LENGTH,MAXLEN,EOF,LUN,NOCLOS, 00151 00002 1 COMNTS) 00152 00002 00153 00002 C Data Dictionary 00154 00002 00155 00004 .IMPLICIT NONE !850805 00156 00004 00157 00005 INCLUDE '($FORIOSDEF)/NOLIST' !871029 00158 00005 00159 00006 BYTE BUFFER(1) !EXT, 00160 00007 INTEGER*2 COMNTS !EXT, 00161 00008 CHARACTER*4 DEF_EXT(2) !LOC, '.COM', '.CMD' !850805 00162 00009 LOGICAL*1 DFLT_PROMPT !LOC, 00163 00010 LOGICAL*2 EOF !EXT, 00164 00011 LOGICAL*1 EOF_ON_FILE !LOC, 00165 00012 LOGICAL*1 FST_PASS !LOC, 00166 00013 INTEGER*2 I !LOC, 00167 00014 BYTE IBUFF(161) !LOC, 00168 00015 INTEGER*2 INLVL !LOC, level of cmd file; 0==>TI: 00169 00016 INTEGER*2 INPUT_FROM_TI !/DVGCML/, see note 4 00170 00017 INTEGER*4 IOST !LOC, F77 IO status !871029 00171 00018 INTEGER*2 J !LOC, scratch 00172 00019 INTEGER*2 LENGTH !EXT, 00173 00020 INTEGER*2 LUN !EXT, ignored !860424 00174 00021 INTEGER*4 LUNDSK(3) !LOC, LUN for disk input files !860424 00175 00022 INTEGER*4 LUNTI !LOC, LUN for TI: input !860424 00176 00023 INTEGER*2 MAP !LOC, 00177 00024 INTEGER*2 MAXCHAR !LOC, 00178 00025 INTEGER*2 MAXLEN !EXT, 00179 00026 INTEGER*2 NARGS !LOC, 00180 00027 INTEGER*2 NOCLOS !EXT, ignored !860424 00181 00028 LOGICAL*1 NOINPUT !LOC, 00182 00029 INTEGER*2 NPRMPT !LOC, 00183 00030 LOGICAL*1 NRML_PROMPT !LOC, 00184 00031 LOGICAL*1 NULL_INPUT_OK !LOC, 00185 00032 BYTE PROMPT(1) !EXT, 00186 00033 LOGICAL*1 RTN_CMNT !LOC, 00187 00034 BYTE SPACE !LOC, 00188 00035 LOGICAL*1 TEST !LOC, scratch 00189 00036 LOGICAL*1 TI_CTRLZ !LOC, 00190 00037 LOGICAL*1 WAS_CMD_LN !LOC, 00191 00037 00192 00038 COMMON /DVGCML/ INPUT_FROM_TI 00193 00038 C 00194 00039 DATA INLVL/0/,TI_CTRLZ/.FALSE./ 00195 00040 DATA FST_PASS/.TRUE./,SPACE/1H / 00196 00040 00197 00041 DATA DEF_EXT/'.COM','.CMD'/ !850805 00198 00041 00199 00042 DATA LUNTI/0/, LUNDSK/3*0/ !860424 FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00005 GETCML,GETCML=GETCML 00200 00042 .PAGE 00201 00042 C PROCESS CALLING PARAMETERS 00202 00042 C 00203 00044 GET-CALL-PARAMETERS 00204 00044 C 00205 00044 C IF INPUT WAS GIVEN IN COMMAND LINE (EG. $ MAO IN=OUT/EF) 00206 00044 C MUST EXIT ON 2ND PASS. 00207 00044 C 00208 00045 IF(.NOT.FST_PASS.AND.WAS_CMD_LN.AND.INLVL.EQ.0) 00209 00047 . HANDLE-FINAL-EOF 00210 00047 ...FIN 00211 00049 00212 00050 NOINPUT=.TRUE. 00213 00053 REPEAT WHILE(NOINPUT) 00214 00054 . EOF_ON_FILE=.FALSE. 00215 00054 C . 00216 00054 C . GET INPUT LINE 00217 00054 C . 00218 00055 . WHEN(INLVL.EQ.0) 00219 00058 . . WHEN(FST_PASS)GET-COMMAND-LINE 00220 00060 . . ELSE 00221 00062 . . . WRITE-PROMPT 00222 00064 . . . READ-TI-INPUT 00223 00064 . . ...FIN 00224 00066 . ...FIN 00225 00071 . ELSE READ-LINE-FROM-INDIRECT-INPUT-FILE !860424 00226 00071 . 00227 00076 . IF (LENGTH.GT.0 .AND. .NOT.RTN_CMNT) REMOVE-COMMENTS 00228 00076 C . 00229 00076 C . CHECK FOR SPECIAL CASES 00230 00076 C . 00231 00076 . CONDITIONAL 00232 00077 . . (FST_PASS) 00233 00078 . . . FST_PASS=.FALSE. 00234 00079 . . . IF(WAS_CMD_LN) 00235 00082 . . . . WHEN(IBUFF(1).EQ.1H@)HANDLE-NEW-INDIRECT-FILE 00236 00086 . . . . ELSE NOINPUT=.FALSE. 00237 00086 . . . ...FIN 00238 00087 . . ...FIN 00239 00089 . . (TI_CTRLZ)NOINPUT=.FALSE. 00240 00092 . . (EOF_ON_FILE)HANDLE-EOF-ON-INDIRECT-FILE 00241 00094 . . (LENGTH.EQ.0.AND..NOT.NULL_INPUT_OK)CONTINUE 00242 00097 . . (LENGTH.GT.MAXCHAR)HANDLE-LONG-LINE 00243 00099 . . (IBUFF(1).EQ.1H;.AND..NOT.RTN_CMNT)CONTINUE 00244 00102 . . (IBUFF(1).EQ.1H@)HANDLE-NEW-INDIRECT-FILE 00245 00105 . . (OTHERWISE)NOINPUT=.FALSE. 00246 00106 . ...FIN 00247 00106 ...FIN 00248 00107 00249 00108 IF(LENGTH.GT.0) 00250 00111 . DO (I=1,LENGTH)BUFFER(I)=IBUFF(I) 00251 00111 . 00252 00112 . DO (I=1,LENGTH) !make all lower case alphas upper case 00253 00113 . . IF (BUFFER(I).GE.'a' .AND. BUFFER(I).LE.'z') 00254 00114 . . . BUFFER(I) = BUFFER(I)-'20'X FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00006 GETCML,GETCML=GETCML 00255 00114 . . ...FIN!if 00256 00115 . ...FIN!do 00257 00116 . 00258 00116 ...FIN 00259 00118 RETURN FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00007 GETCML,GETCML=GETCML 00260 00118 .PAGE ---------------------------------------- 00261 00119 TO GET-CALL-PARAMETERS 00262 00119 C . 00263 00119 C . GET PARAMETERS FROM CALL TO GETCML OR DEFAULTS 00264 00119 C . 00265 00120 . CALL ARGS(NARGS,MAP) 00266 00121 . IF(NARGS.LT.3) 00267 00122 . . TYPE 1 00268 00123 1 . . FORMAT(' GETCML CALL MUST HAVE AT LEAST 3 ARGUMENTS') 00269 00124 . . CALL EXIT 00270 00124 . ...FIN 00271 00125 C . 00272 00126 . IF(((MAP.AND."1).EQ.0).OR.((MAP.AND."4).EQ.0)) 00273 00127 . . TYPE 2 00274 00128 2 . . FORMAT(' GETCML CALL MUST GIVE 1ST AND 3RD ARGUMENTS') 00275 00129 . . CALL EXIT 00276 00129 . ...FIN 00277 00130 C . 00278 00131 . WHEN((MAP.AND."2).NE.0) 00279 00132 . . DFLT_PROMPT=.FALSE. 00280 00133 . . NPRMPT=1 00281 00136 . . UNTIL(PROMPT(NPRMPT).EQ.0)NPRMPT=NPRMPT+1 00282 00137 . . NPRMPT=NPRMPT-1 00283 00139 . . WHEN(NPRMPT.EQ.0)DFLT_PROMPT=.TRUE. 00284 00140 . . ELSE 00285 00142 . . . WHEN (NPRMPT.EQ.3)NRML_PROMPT=.TRUE. 00286 00145 . . . ELSE NRML_PROMPT=.FALSE. 00287 00145 . . ...FIN 00288 00146 . ...FIN 00289 00149 . ELSE DFLT_PROMPT=.TRUE. 00290 00149 C . 00291 00150 . NULL_INPUT_OK=.FALSE. 00292 00151 . WHEN(NARGS.GE.4.AND.((MAP.AND."10).NE.0)) 00293 00151 . . CONDITIONAL 00294 00153 . . . (MAXLEN.GT.0)MAXCHAR=MAXLEN 00295 00155 . . . (MAXLEN.EQ.0)MAXCHAR=80 00296 00156 . . . (OTHERWISE) 00297 00157 . . . . NULL_INPUT_OK=.TRUE. 00298 00158 . . . . MAXCHAR=-MAXLEN 00299 00158 . . . ...FIN 00300 00159 . . ...FIN 00301 00159 . ...FIN 00302 00162 . ELSE MAXCHAR=80 00303 00163 . IF (MAXCHAR.GT.160) 00304 00164 . . TYPE*,'GETCML called with |MAXLEN|>160' 00305 00165 . . CALL EXIT 00306 00165 . ...FIN!if 00307 00166 C . 00308 00167 . IF(NARGS.GE.5.AND.((MAP.AND."20).NE.0))EOF=.FALSE. 00309 00167 C . 00310 00167 C . Ignore arg 6, input LUN. 00311 00167 C . FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00008 GETCML,GETCML=GETCML 00312 00167 C . Ignore arg 7, no close file. 00313 00167 C . 00314 00168 . TEST = ((MAP.AND."200).NE.0) .AND. (NARGS.GE.8) !850410 00315 00169 . WHEN ((TEST) .AND. (COMNTS.NE.0)) !850410 00316 00170 . . RTN_CMNT=.TRUE. 00317 00170 . ...FIN 00318 00173 . ELSE RTN_CMNT=.FALSE. 00319 00173 ...FIN FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00009 GETCML,GETCML=GETCML 00320 00174 .PAGE ---------------------------------------- 00321 00175 TO GET-COMMAND-LINE 00322 00175 C . 00323 00175 C . TRY TO GET INPUT GIVEN ON COMMAND LINE 00324 00175 C . 00325 00176 . CALL GETMCR(IBUFF,LENGTH) 00326 00177 D . TYPE *,' GETCML ',IBUFF,LENGTH 00327 00178 . IF(LENGTH.GT.0) 00328 00178 C . . 00329 00178 C . . FIND SPACE AFTER TASKNAME PREFIX, EG. $ TSK HI 00330 00178 C . . 00331 00179 . . I=1 00332 00182 . . UNTIL(IBUFF(I).EQ.SPACE.OR.I.EQ.LENGTH)I=I+1 00333 00182 . ...FIN 00334 00183 . CONDITIONAL 00335 00184 . . (LENGTH.LT.0.OR.I.EQ.LENGTH) 00336 00184 C . . . 00337 00184 C . . . NO COMMAND IN LINE, EG. $ TSK 00338 00184 C . . . 00339 00185 . . . LENGTH=0 00340 00186 . . . WAS_CMD_LN=.FALSE. 00341 00186 . . ...FIN 00342 00187 . . (LENGTH-I.GT.MAXCHAR) 00343 00189 . . . HANDLE-LONG-LINE 00344 00190 . . . WAS_CMD_LN=.FALSE. 00345 00190 . . ...FIN 00346 00191 . . (OTHERWISE) 00347 00192 . . . LENGTH=LENGTH-I 00348 00195 . . . DO (J=1,LENGTH)IBUFF(J)=IBUFF(J+I) 00349 00196 . . . IBUFF(LENGTH+1) = 0 !860424 00350 00197 . . . WAS_CMD_LN=.TRUE. 00351 00198 . . . INPUT_FROM_TI = 2 00352 00198 . . ...FIN 00353 00199 . ...FIN 00354 00199 ...FIN FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00010 GETCML,GETCML=GETCML 00355 00200 .PAGE ---------------------------------------- 00356 00201 TO HANDLE-EOF-ON-INDIRECT-FILE 00357 00201 C . 00358 00201 C . CLOSE OUT INFO ON THAT FILE (FILE ITSELF ALREADY CLOSED!) 00359 00201 C . 00360 00202 . INLVL=INLVL-1 00361 00202 C . 00362 00202 C . CASE OF $ TSK @FILE 00363 00202 C . 00364 00203 . IF(.NOT.FST_PASS.AND.WAS_CMD_LN.AND.INLVL.EQ.0) 00365 00205 . . HANDLE-FINAL-EOF 00366 00205 . ...FIN 00367 00207 ...FIN FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00011 GETCML,GETCML=GETCML 00368 00208 .PAGE ---------------------------------------- 00369 00209 TO HANDLE-FINAL-EOF 00370 00209 C . 00371 00209 C . PDP-11 GETCML EXITS WHEN GET EOF AT LEVEL ZERO IF EOF 00372 00209 C . ARGUMENT IS NOT CODED; IF ARGUMENT IS PRESENT, RETURN INDICATION 00373 00209 C . 00374 00210 . WHEN((NARGS.GE.5).AND.((MAP.AND."20).NE.0)) 00375 00211 . . LENGTH=0 00376 00212 . . EOF=.TRUE. 00377 00213 . . RETURN 00378 00214 4000 . . CONTINUE !GET RID OF FORTRAN "NO PATH TO STATEMENT MSG" 00379 00214 . ...FIN 00380 00215 . ELSE 00381 00216 . . CALL EXIT 00382 00216 . ...FIN 00383 00217 ...FIN FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00012 GETCML,GETCML=GETCML 00384 00218 .PAGE ---------------------------------------- 00385 00219 TO HANDLE-LONG-LINE 00386 00220 . TYPE 10,(IBUFF(I),I=1,MAXCHAR) 00387 00221 10 . FORMAT(' GETCML--INPUT LINE TOO LONG; LINE IGNORED',/,(1X,70A1)) 00388 00221 ...FIN FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00013 GETCML,GETCML=GETCML 00389 00222 .PAGE ---------------------------------------- 00390 00223 TO HANDLE-NEW-INDIRECT-FILE 00391 00224 . WHEN(INLVL.EQ.3) 00392 00225 . . TYPE 11 00393 00226 11 . . FORMAT(' GETCML--TOO MANY LEVELS OF INDIRECT INPUT FILES') 00394 00227 . . CALL EXIT 00395 00227 . ...FIN!when 00396 00228 . ELSE 00397 00229 . . INLVL=INLVL+1 00398 00229 . . 00399 00229 C . . Check if default extension of .COM will work 00400 00229 . . 00401 00230 . . J = 1 !860424 00402 00231 . . INQUIRE (FILE=IBUFF(2),EXIST=TEST, !850805 00403 00232 1. . DEFAULTFILE=DEF_EXT(J)) !860424 00404 00232 . . 00405 00233 . . IF (.NOT.TEST) J=2 !Try .CMD !860424 00406 00233 C . . 00407 00233 C . . Open the new file 00408 00233 C . . 00409 00234 . . IF (LUNDSK(INLVL).EQ.0) THEN !860424 00410 00235 . . . CALL LIB$GET_LUN (LUNDSK(INLVL)) !860424 00411 00236 . . . IF (LUNDSK(INLVL).LT.1) THEN !860424 00412 00237 . . . . TYPE*,'GETCML--No luns available for level',INLVL, !860424 00413 00238 1. . . . ' Indirect input file' !860424 00414 00239 . . . . CALL EXIT !860424 00415 00240 . . . ENDIF !860424 00416 00241 . . ENDIF !860424 00417 00241 . . 00418 00242 . . OPEN (UNIT=LUNDSK(INLVL),NAME=IBUFF(2),READONLY, !860424 00419 00243 1. . RECORDTYPE='VARIABLE',FORM='UNFORMATTED', !871029 00420 00244 1. . DEFAULTFILE=DEF_EXT(J),ACCESS='SEQUENTIAL', !860424 00421 00245 2. . ERR=2000,TYPE='OLD') !860424 00422 00245 . . 00423 00246 . . INPUT_FROM_TI = 1 00424 00246 . . 00425 00247 . . IF (.FALSE.) THEN !860424 00426 00248 2000 . . . TYPE 8,(IBUFF(I),I=2,LENGTH) !860424 00427 00249 8 . . . FORMAT(' GETCML CANNOT OPEN INDIRECT INPUT FILE ', !860424 00428 00250 1. . . /,(1X,70A1)) !860424 00429 00251 . . . EOF_ON_FILE=.TRUE. !860424 00430 00252 . . ENDIF !860424 00431 00252 . ...FIN!else 00432 00253 ...FIN!to handle-new-indirect-file FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00014 GETCML,GETCML=GETCML 00433 00254 .PAGE ---------------------------------------- 00434 00255 TO READ-LINE-FROM-INDIRECT-INPUT-FILE 00435 00255 . 00436 00256 . READ (LUNDSK(INLVL),IOSTAT=IOST) IBUFF !871029 00437 00257 . IF (IOST.EQ.-1) THEN !871029 00438 00258 . . EOF_ON_FILE=.TRUE. !871029 00439 00259 . . CLOSE(UNIT=LUNDSK(INLVL)) !871029 00440 00260 . ELSEIF (IOST.EQ.0 .OR. IOST.EQ.FOR$IOS_INPSTAREQ) THEN !871029 00441 00261 . . IOST = 0 !"Data underrun" is ok !871029 00442 00262 . . CALL RDLEN(LUNDSK(INLVL),LENGTH) !871029 00443 00263 . . INPUT_FROM_TI = 1 00444 00264 . ELSE !871029 00445 00265 . . TYPE*,'GETCML--Command file F77 read error=',IOST !871029 00446 00266 . . CALL EXIT !871029 00447 00267 . ENDIF 00448 00267 . 00449 00268 . WHILE (IBUFF(LENGTH).EQ.1H- .AND. LENGTH.LT.161 .AND. IOST.EQ.0) 00450 00268 . . 00451 00268 C . . Do continuation lines 00452 00268 . . 00453 00269 . . READ(LUNDSK(INLVL),IOSTAT=IOST)(IBUFF(I),I=LENGTH,161) !871029 00454 00270 . . IF (IOST.EQ.-1) THEN !871029 00455 00271 . . . EOF_ON_FILE=.TRUE. !871029 00456 00272 . . . CLOSE(UNIT=LUNDSK(INLVL)) !871029 00457 00273 . . ELSEIF (IOST.EQ.0 .OR. IOST.EQ.FOR$IOS_INPSTAREQ) THEN !871029 00458 00274 . . . IOST = 0 !"Data underrun" is ok !871029 00459 00275 . . . CALL RDLEN(LUNDSK(INLVL),J) !871029 00460 00276 . . . LENGTH=LENGTH-1+J !Dont count the - 00461 00277 . . ELSE !871029 00462 00278 . . . TYPE*,'GETCML--Command file F77 read error=',IOST !871029 00463 00279 . . . CALL EXIT !871029 00464 00280 . . ENDIF 00465 00280 . . 00466 00280 . ...FIN!while 00467 00281 . 00468 00281 ...FIN FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00015 GETCML,GETCML=GETCML 00469 00282 .PAGE ---------------------------------------- 00470 00283 TO READ-TI-INPUT 00471 00283 C . 00472 00283 C . READ INPUT FROM TI:. 00473 00283 C . 00474 00284 . IF (LUNTI.EQ.0) THEN !860424 00475 00284 . . 00476 00285 . . CALL LIB$GET_LUN(LUNTI) !860424 00477 00286 . . IF (LUNTI.LT.1) THEN !860424 00478 00287 . . . TYPE*,'GETCML--No LUNs available for TI: input' !860424 00479 00288 . . . CALL EXIT !860424 00480 00289 . . ENDIF !860424 00481 00289 . . 00482 00290 . . OPEN (UNIT=LUNTI,NAME='SYS$INPUT',STATUS='UNKNOWN', !860424 00483 00291 1. . FORM='UNFORMATTED',RECORDTYPE='VARIABLE') !871029 00484 00292 . ENDIF !860424 00485 00292 . 00486 00293 . READ (LUNTI,IOSTAT=IOST)IBUFF !871029 00487 00294 . IF (IOST.EQ.-1) THEN !871029 00488 00294 C . . 00489 00294 C . . CTRL/Z ON TI INPUT 00490 00294 C . . 00491 00296 . . HANDLE-FINAL-EOF !871029 00492 00298 . ELSEIF (IOST.EQ.0 .OR. IOST.EQ.FOR$IOS_INPSTAREQ) THEN !871029 00493 00299 . . IOST = 0 !"Data underrun" is ok !871029 00494 00300 . . CALL RDLEN(LUNTI,LENGTH) !871029 00495 00301 . . INPUT_FROM_TI = 2 !860424 00496 00302 . ELSE !871029 00497 00303 . . TYPE*,'GETCML--TI: F77 read error=',IOST !871029 00498 00304 . . CALL EXIT !871029 00499 00305 . ENDIF !871029 00500 00305 . 00501 00306 . WHILE (IBUFF(LENGTH).EQ.1H- .AND. LENGTH.LT.161 .AND. IOST.EQ.0) 00502 00306 . . 00503 00306 C . . handle continuation line 00504 00306 . . 00505 00308 . . WRITE-PROMPT 00506 00309 . . READ (LUNTI,IOSTAT=IOST) (IBUFF(I),I=LENGTH,161) !871029 00507 00310 . . IF (IOST.EQ.-1) THEN !871029 00508 00310 C . . . 00509 00310 C . . . CTRL/Z ON TI INPUT 00510 00310 C . . . 00511 00312 . . . HANDLE-FINAL-EOF !871029 00512 00314 . . ELSEIF (IOST.EQ.0 .OR. IOST.EQ.FOR$IOS_INPSTAREQ) THEN !871029 00513 00315 . . . IOST = 0 !"Data underrun" is ok !871029 00514 00316 . . . CALL RDLEN(LUNTI,J) !871029 00515 00317 . . . LENGTH = LENGTH-1+J !dont count the - 00516 00318 . . ELSE !871029 00517 00319 . . . TYPE*,'GETCML--TI: F77 read error=',IOST !871029 00518 00320 . . . CALL EXIT !871029 00519 00321 . . ENDIF !871029 00520 00321 . . FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00016 GETCML,GETCML=GETCML 00521 00321 . ...FIN!while 00522 00322 . 00523 00322 ...FIN!to read-ti-input FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00017 GETCML,GETCML=GETCML 00524 00323 .PAGE ---------------------------------------- 00525 00324 TO REMOVE-COMMENTS 00526 00324 . 00527 00324 C . Backscan to "!" and truncate line there 00528 00324 . 00529 00325 . I = LENGTH 00530 00325 . 00531 00328 . WHILE (I.GT.0 .AND. IBUFF(I).NE.1H!) I=I-1 00532 00328 . 00533 00329 . IF (I.GT.0) LENGTH=I-1 00534 00329 ...FIN!to remove-comments FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00018 GETCML,GETCML=GETCML 00535 00330 .PAGE ---------------------------------------- 00536 00331 TO WRITE-PROMPT 00537 00331 . CONDITIONAL 00538 00332 . . (DFLT_PROMPT) 00539 00333 . . . TYPE 3 00540 00334 3 . . . FORMAT('$ >') 00541 00334 . . ...FIN 00542 00335 . . (NRML_PROMPT) 00543 00336 . . . TYPE 4,(PROMPT(I),I=1,3) 00544 00337 4 . . . FORMAT('$',3A1,'>') 00545 00337 . . ...FIN 00546 00338 . . (OTHERWISE) 00547 00339 . . . TYPE 5,(PROMPT(I),I=1,NPRMPT) 00548 00340 5 . . . FORMAT('$',80A1) 00549 00340 . . ...FIN 00550 00341 . ...FIN 00551 00341 ...FIN 00552 00343 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00261 GET-CALL-PARAMETERS 00203 00321 GET-COMMAND-LINE 00219 00356 HANDLE-EOF-ON-INDIRECT-FILE 00240 00369 HANDLE-FINAL-EOF 00209 00365 00491 00511 00385 HANDLE-LONG-LINE 00242 00343 00390 HANDLE-NEW-INDIRECT-FILE 00235 00244 00434 READ-LINE-FROM-INDIRECT-INPUT-FILE 00225 00470 READ-TI-INPUT 00222 00525 REMOVE-COMMENTS 00227 00536 WRITE-PROMPT 00221 00505 FLECS VERSION 860214 2-DEC-87 06:37:18 PAGE 00019 GETCML,GETCML=GETCML (FLECS VERSION 22.38)