FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00001 FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00001 00000 C;+ 00002 00000 C - F I L E 00003 00000 C****NAME: File handling subroutines for FLECS/ALECS 00004 00000 C FILE: FILE.FLX 00005 00000 C 00006 00000 C****PURPOSE: Perform file handling for FLECS/ALECS. 00007 00000 C 00008 00000 C****RESTRICTIONS: 00009 00000 C 00010 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00011 00000 C LANGUAGE: FLECS/F77 00012 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00013 00000 C DATE: 25-OCT-74 00014 00000 C REVISIONS: 00015 00000 C 1980 (GTA) CONVERT MACRO IN FLERSX TO FORTRAN. 00016 00000 C;- 00017 00000 .PASSUNLESS VAX 00018 00000 .PASSUNLESS PDP 00020 00000 .PASSEND 00021 00000 .PASSEND 00022 00000 00023 00000 .PASSUNLESS FLECS 00024 00000 .PASSUNLESS ALECS 00026 00000 .PASSEND 00027 00000 .PASSEND 00028 00000 FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00002 CLOSEF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00029 00000 .NAME CLOSEF 00030 00000 C;+ 00031 00000 C - C L O S E F 00032 00000 C****NAME: SUBROUTINE CLOSEF 00033 00000 C FILE: FILE.FLX 00034 00000 C 00035 00000 C****PURPOSE: CLOSE OPEN FILES FOR FLECS/ALECS 00036 00000 C 00037 00000 C****RESTRICTIONS: 00038 00000 C 00039 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00040 00000 C LANGUAGE: FLECS/F77 00041 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00042 00000 C DATE: 25-OCT-74 00043 00000 C REVISIONS: 00044 00000 C 1980GTA Convert macro to fortran. 00045 00000 C 850227mao Rewritten to use FCLOSE, /ERRS/; do not put cmd line at end 00046 00000 C of listing (since its at top of every page). 00047 00000 C 00048 00000 C****CALLING SEQUENCE: CALL CLOSEF(MINCNT,MAJCNT) 00049 00000 C 00050 00000 C INPUT: 00051 00000 C 00052 00000 C MINCNT=(I*2) COUNT OF MINOR ERRORS (WARNINGS) ENCOUNTERED 00053 00000 C MAJCNT=(I*2) COUNT OF MAJOR ERRORS ENCOUNTERED. IF MAJCNT=-1, A 00054 00000 C SYMBOL TABLE OVERFLOW HAS OCCURRED. 00055 00000 C 00056 00000 C OUTPUT: NONE 00057 00000 C 00058 00000 C CMN BLOCK I/O: NONE 00059 00000 C 00060 00000 C RESOURCES: 00061 00000 C LIBRARIES: QLIB:MSGOUT 00062 00000 C OTHER SUBR: FCLOSE, EXFLE, PUT, PUTNUM 00063 00000 C DISK FILES: FLX, FTN AND FLL FILES 00064 00000 C DEVICES: DISK 00065 00000 C SGAS: NONE 00066 00000 C EVENT FLAGS: None 00067 00000 C SYSTEM DIR: None 00068 00000 C 00069 00000 C****NOTES: 00070 00000 C 1. THIS ROUTINE NOW DOES THE FOLLOWING: 00071 00000 C 00072 00000 C 1. IF THERE ARE ANY ERRORS, OUTPUTS ERROR COUNT TO BOTH THE 00073 00000 C LISTING AND THE TERMINAL. 00074 00000 C 2. IF 'ERROR' IS NEGATIVE (INDICATING AN ABORT) OUTPUTS AN ABORT 00075 00000 C MESSAGE TO THE TERMINAL. 00076 00000 C 3. CLOSES FILES. 00077 00000 C 4. IF 'ERROR' IS NEGATIVE, EXITS; OTHERWISE, RETURNS. 00078 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00003 CLOSEF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00079 00000 .PAGE 00080 00001 SUBROUTINE CLOSEF(IWARN,IERR) 00081 00001 00082 00001 .PASSIF VAX 00083 00001 .INCLUDE [MP1Q.FLEALECOM]FILDAT.INC *00084 00001 C FILDAT.INC 850226 Define stuff for FILE.FLX subr *00085 00001 *00086 00002 BYTE DAT(9) !date in ASCII *00087 00003 LOGICAL*2 FLLON !.T. if output to FLL file on *00088 00004 LOGICAL*2 FORT !.T. if fort output desired *00089 00005 BYTE FVER(21) !ASCII FLECS version ident *00090 00006 INTEGER*2 LINCNT !# lines left for current page *00091 00007 BYTE LINE(106) !task command line *00092 00008 LOGICAL*2 LIST !.T. if listing output desired *00093 00009 BYTE NAMEHD(6) !ASCII char from .NAME directive *00094 00010 INTEGER*2 P1(33) !Page header string, line 1 *00095 00011 INTEGER*2 P2(59) !Page header string, line 2 *00096 00012 INTEGER*2 PAGENO !current FLL page # *00097 00013 LOGICAL*2 SPON !state of /SP switch *00098 00014 BYTE TIM(8) !time in ASCII *00099 00014 *00100 00015 COMMON /FILES/ PAGENO,LINCNT,FORT,LIST, *00101 00016 1 SPON,FLLON,P1,P2 *00102 00016 *00103 00017 EQUIVALENCE (P1(3),FVER(1)),(P1(16),DAT(1)),(P1(22),TIM(1)) *00104 00018 EQUIVALENCE (P2(3),NAMEHD(1)),(P2(7),LINE(1)) *00105 00018 C END-OF-FILE FILDAT.INC 00106 00018 .PASSEND 00107 00018 .PASSIF PDP 00109 00018 .PASSEND 00110 00018 00111 00019 INTEGER*2 SEVFLG,ERRFLG,WRNFLG 00112 00020 COMMON/ERRS/SEVFLG,ERRFLG,WRNFLG 00113 00020 00114 00020 C Local declarations 00115 00020 00116 00021 INTEGER*2 BLANK(2) !LOC, R/W, blank line 00117 00022 INTEGER*2 ERRMS(23) !LOC, R/W, error message string 00118 00023 INTEGER*2 IERR !EXT, R, # of errors generated 00119 00024 INTEGER*2 IWARN !EXT, R, # of warnings 00120 00024 00121 00025 DATA BLANK /2,' '/ 00122 00025 00123 00026 DATA ERRMS /42,3*' ',3*' ','ER','RO','RS',5*' ',3*' ', 00124 00027 1 'WA','RN','IN','GS',0/ FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00004 CLOSEF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00125 00027 .PAGE 00126 00027 00127 00027 CONDITIONAL 00128 00028 . (IERR.LT.0) 00129 00029 . . CALL MSGOUT('F-Aborted due to table overflow.') 00130 00030 . . SEVFLG=SEVFLG+1 00131 00030 . ...FIN 00132 00031 . ((IWARN.NE.0).OR.(IERR.NE.0)) 00133 00032 . . IF (IWARN.NE.0) WRNFLG=WRNFLG+1 00134 00033 . . IF (IERR.NE.0) ERRFLG=ERRFLG+1 00135 00033 . . 00136 00034 . . CALL PUTNUM (ERRMS(4),IERR) !insert # of errors 00137 00035 . . CALL PUTNUM (ERRMS(15),IWARN) !insert # of warnings 00138 00035 . . 00139 00036 . . CALL MSGOUT (ERRMS(5)) !output to TI: 00140 00037 . . IF (LIST) 00141 00038 . . . CALL PUT (0,BLANK,2) !output blank line 00142 00039 . . . CALL PUT (0,ERRMS,2) !output to listing file 00143 00039 . . ...FIN!if 00144 00040 . ...FIN 00145 00041 ...FIN!conditional 00146 00041 00147 00042 CALL FCLOSE 00148 00042 00149 00043 IF (IERR.LT.0) CALL EXFLE !things are hopeless 00150 00043 00151 00044 RETURN 00152 00045 END (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00005 EXFLE FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00153 00000 .NAME EXFLE 00154 00000 C;+ 00155 00000 C - E X F L E 00156 00000 C****NAME: SUBROUTINE EXFLE 00157 00000 C FILE: FILE.FLX 00158 00000 C 00159 00000 C****PURPOSE: EXIT ROUTINE FOR FLECS TO RETURN EXIT STATUS TO CALLER 00160 00000 C 00161 00000 C****RESTRICTIONS: 00162 00000 C 00163 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00164 00000 C LANGUAGE: FLECS/F77 00165 00000 C AUTHOR: M. OOTHOUDT 00166 00000 C DATE: 02-MAY-80 00167 00000 C REVISIONS: 00168 00000 C 850211mao Complete rewrite to convert macro to fortran. 00169 00000 C 00170 00000 C****CALLING SEQUENCE: CALL EXFLE 00171 00000 C 00172 00000 C INPUT: NONE 00173 00000 C 00174 00000 C OUTPUT: NONE 00175 00000 C 00176 00000 C CMN BLOCK I/O: /ERRS/ 00177 00000 C 00178 00000 C RESOURCES: 00179 00000 C LIBRARIES: NONE 00180 00000 C OTHER SUBR: NONE 00181 00000 C DISK FILES: NONE 00182 00000 C DEVICES: NONE 00183 00000 C SGAS: NONE 00184 00000 C EVENT FLAGS: NONE 00185 00000 C SYSTEM DIR: EXIT 00186 00000 C 00187 00000 C****NOTES: 00188 00000 C 1. THIS ROUTINE USES THE VALUE OF VARIABLES SEVFLG, ERRFLG, 00189 00000 C AND WRNFLG TO DETERMINE IF IT SHOULD EXIT WITH A SEVERE ERROR, AN 00190 00000 C ERROR, A WARNING OR SUCCESS. THE PURPOSE OF EXIT-WITH-STATUS IS TO 00191 00000 C ALLOW A TASK THAT RUNS FLECS (EG. INDIRECT MCR OR SPAWN) TO DETERMINE 00192 00000 C IF FLECS WAS SUCCESSFUL. EG. THE CALLER MIGHT SPAWN FORTRAN IF AND 00193 00000 C ONLY IF FLECS IS SUCCESSFUL. 00194 00000 C 00195 00000 C 2. THE STATUS VALUES RETURNED ARE 00196 00000 C SEVERE - FLECS ABORTED EXTERNALLY (EXEC FUNCTION), 00197 00000 C FLECS SELF-ABORTED DUE TO TABLE OVERFLOW, OR 00198 00000 C INPUT ERROR IN COMMAND LINE. 00199 00000 C ERROR - TRANSLATION ERROR IN PROCESSING SOURCE FILE. 00200 00000 C WARNING- TRANSLATION WARNING IN SOURCE FILE. 00201 00000 C SUCCESS- NONE OF THE ABOVE. 00202 00000 C 00203 00000 C 3. BECAUSE "FLE @FILE" IS LEGAL, IT IS NECESSARY FOR FLECS TO 00204 00000 C KEEP A SUM OF ALL ERRORS AND WARNINGS SO THAT WHEN IT FINALLY 00205 00000 C EXITS, IT WILL KNOW IF SUCH PROBLEMS OCCURRED ON ANY TRANSLATION, 00206 00000 C NOT JUST THE LAST ONE DONE. 00207 00000 C FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00006 EXFLE FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00208 00000 C 4. AN INPUT ERROR IS TREATED AS A SEVERE ERROR MAINLY TO 00209 00000 C DISTINGUISH IT FROM A TRANSLATION PROBLEM. ALSO THIS USAGE IS FAIRLY 00210 00000 C COMMON AND MAKES REASONABLE SENSE IN INDIRECT MCR OR SPAWN MODES. 00211 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00007 EXFLE FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00212 00000 .PAGE 00213 00001 SUBROUTINE EXFLE 00214 00001 00215 00002 INTEGER*2 SEVFLG,ERRFLG,WRNFLG 00216 00003 INTEGER*2 STATUS,EXSUC,EXSEV,EXERR,EXWAR 00217 00003 00218 00004 COMMON/ERRS/SEVFLG,ERRFLG,WRNFLG 00219 00004 00220 00005 PARAMETER (EXSUC=1) !success 00221 00006 PARAMETER (EXWAR=3) !warning 00222 00007 PARAMETER (EXERR=2) !error 00223 00008 PARAMETER (EXSEV=4) !severe error 00224 00008 00225 00008 CONDITIONAL 00226 00010 . (SEVFLG.NE.0) STATUS=EXSEV 00227 00012 . (ERRFLG.NE.0) STATUS=EXERR 00228 00014 . (WRNFLG.NE.0) STATUS=EXWAR 00229 00016 . (OTHERWISE) STATUS=EXSUC 00230 00017 ...FIN!conditional 00231 00017 00232 00018 CALL EXIT (STATUS) 00233 00019 END (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00008 GET FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00234 00000 .NAME GET 00235 00000 C;+ 00236 00000 C - G E T 00237 00000 C****NAME: SUBROUTINE GET 00238 00000 C FILE: FILE.FLX 00239 00000 C 00240 00000 C****PURPOSE: READ A LINE FROM THE FLX/ALX FILE 00241 00000 C 00242 00000 C****RESTRICTIONS: 00243 00000 C 00244 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00245 00000 C LANGUAGE: FLECS/F77 00246 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00247 00000 C DATE: 25-OCT-74 00248 00000 C REVISIONS: 00249 00000 C 1980GTA Convert macro to fortran. 00250 00000 C 850211mao Update to agree with latest version of FLERSX.MAC. 00251 00000 C 00252 00000 C****CALLING SEQUENCE: CALL GET(LINENO,STRING,ENDFIL,ERR1,ERR2) 00253 00000 C 00254 00000 C INPUT: 00255 00000 C 00256 00000 C LINENO=(I*2) NUMBER OF LAST LINE READ FROM FLX FILE 00257 00000 C 00258 00000 C OUTPUT: 00259 00000 C 00260 00000 C LINENO=(I*2) INCREMENTED BY ONE FOR EACH LINE READ FROM FLX FILE 00261 00000 C STRING=STRING OF UP TO 72 CHARACTERS READ FROM FLX FILE 00262 00000 C (to guard against some "line-too-long" errors, this 00263 00000 C array should be at least 83 bytes long!) 00264 00000 C ENDFIL=(L*2) SET TO .TRUE. IF READ EOF, .FALSE. OTHERWISE 00265 00000 C ERR1 =(I*2) .NE.0==>NON-EOF READ ERROR (F.ERR) 00266 00000 C ERR2 =(I*2) DEFINDED ONLY IF ERR1.NE.0 00267 00000 C =0==>I/O ERROR, <0==>DSW ERROR (F.ERR+1), 00268 00000 C >0==>EXPANDING TABS GAVE TOO LONG A LINE. 00269 00000 C 00270 00000 C CMN BLOCK I/O: NONE 00271 00000 C 00272 00000 C RESOURCES: 00273 00000 C LIBRARIES: NONE 00274 00000 C OTHER SUBR: FGET, ROPN 00275 00000 C DISK FILES: FLX READ 00276 00000 C DEVICES: DISK 00277 00000 C SGAS: NONE 00278 00000 C EVENT FLAGS: NONE 00279 00000 C SYSTEM DIR: NONE 00280 00000 C 00281 00000 C****NOTES: 00282 00000 C 1. REWRITTEN JUNE 28, 1977 BY RICHARD KITTELL, LASL MP-1 TO 00283 00000 C HANDLE TAB CHARACTERS PROPERLY: (1) A TAB IN THE STATEMENT 00284 00000 C NUMBER FIELD FOLLOWED BY A BLANK OR A DIGIT 0-9 MOVES THE DIGIT 00285 00000 C TO THE CONTINUATION FIELDC (2) A TAB IN THE STATEMENT NUMBER 00286 00000 C FIELD FOLLOWED BY ANY OTHER CHARACTER MOVES THAT CHARACTER TO THE 00287 00000 C STATEMENT FIELDC (3) A TAB ANYWHERE ELSE IS REPLACED BY ENOUGH 00288 00000 C BLANKS TO BRING THE COLUMN NUMBER TO A MULTIPLE OF 8C (4) ALL FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00009 GET FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00289 00000 C TABS IN COMMENT LINES ARE HANDLED AS IN -3-, ABOVE. 00290 00000 C 00291 00000 C 2. THE ABOVE FIX FOR TABS DOES NOT WORK COMPLETELY. 00292 00000 C THERE IS NO GENERAL FIX SINCE THE INDENTATION 00293 00000 C IN THE FLL FILE IS NOT THE SAME NUMBER OF COLUMNS AS A TAB. AS 00294 00000 C AN EXAMPLE CONSIDER THE FOLLOWING INPUT AND THE RESULTING FLL 00295 00000 C LISTING. (LOCATION OF TAB COLUMNS SHOWN BY V AND TABS BY *.) 00296 00000 C 00297 00000 C V V V V 00298 00000 C WHEN (I.GT.J) !INPUT AS TYPED BY PROGRAMMER 00299 00000 C IJKL=1* !A 00300 00000 C M=2* !B 00301 00000 C 00302 00000 C WHEN (I.GT.J) !FLL LISTING FILE 00303 00000 C . IJKL=1* !A 00304 00000 C . M=2* !B 00305 00000 C 00306 00000 C NOTE THERE IS NO (SIMPLE) WAY TO GET THIS EXAMPLE TO WORK OUT RIGHT 00307 00000 C (AND EVEN IF YOU COULD, THINGS WOULDN'T WORK FOR MULTIPLE INDENTATIONS 00308 00000 C 00309 00000 C 3. IF ERR1 IS NONZERO, INPUT MAY STILL BE RETURNED TO CALLER. 00310 00000 C EG. FOR A "LINE-TOO-LONG" ERROR, THE TRUNCATED INPUT IS RETURNED. 00311 00000 C NOTE THAT ERR2 MAY HAVE ANY RANDOM VALUE IF ERR1=0. 00312 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00010 GET FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00313 00000 .PAGE 00314 00001 SUBROUTINE GET(LINENO,STRING,ENDFIL,ERR1,ERR2) !850211mao 00315 00001 00316 00001 .PASSIF VAX 00317 00001 .INCLUDE [MP1Q.FLEALECOM]FILDAT.INC !850213mao *00318 00001 C FILDAT.INC 850226 Define stuff for FILE.FLX subr *00319 00001 *00320 00002 BYTE DAT(9) !date in ASCII *00321 00003 LOGICAL*2 FLLON !.T. if output to FLL file on *00322 00004 LOGICAL*2 FORT !.T. if fort output desired *00323 00005 BYTE FVER(21) !ASCII FLECS version ident *00324 00006 INTEGER*2 LINCNT !# lines left for current page *00325 00007 BYTE LINE(106) !task command line *00326 00008 LOGICAL*2 LIST !.T. if listing output desired *00327 00009 BYTE NAMEHD(6) !ASCII char from .NAME directive *00328 00010 INTEGER*2 P1(33) !Page header string, line 1 *00329 00011 INTEGER*2 P2(59) !Page header string, line 2 *00330 00012 INTEGER*2 PAGENO !current FLL page # *00331 00013 LOGICAL*2 SPON !state of /SP switch *00332 00014 BYTE TIM(8) !time in ASCII *00333 00014 *00334 00015 COMMON /FILES/ PAGENO,LINCNT,FORT,LIST, *00335 00016 1 SPON,FLLON,P1,P2 *00336 00016 *00337 00017 EQUIVALENCE (P1(3),FVER(1)),(P1(16),DAT(1)),(P1(22),TIM(1)) *00338 00018 EQUIVALENCE (P2(3),NAMEHD(1)),(P2(7),LINE(1)) *00339 00018 C END-OF-FILE FILDAT.INC 00340 00018 .INCLUDE [MP1Q.FLEALECOM]INCDAT.INC !850213mao *00341 00018 C INCDAT.INC 850213 Define stuff for include files *00342 00018 *00343 00019 INTEGER*2 NUMINC !max depth include files *00344 00019 *00345 00020 PARAMETER (NUMINC=3) *00346 00020 *00347 00021 LOGICAL*2 FLLONS(0:NUMINC) !saved values of FLLON *00348 00022 INTEGER*2 INCLVL !.INCLUDE level now at (0-->main) *00349 00023 LOGICAL*2 INCSTR !.T. if just read .inc from main level *00350 00024 !(prevents * on that line) *00351 00025 LOGICAL*2 LICHNG !.T. if should ignore FLLON *00352 00025 *00353 00026 COMMON /INCDAT/ FLLONS,INCLVL,INCSTR,LICHNG *00354 00026 *00355 00026 C END-OF-FILE INCDAT.INC 00356 00026 .PASSEND 00357 00026 .PASSIF PDP 00360 00026 .PASSEND 00361 00026 00362 00027 LOGICAL*2 ALECS,LSTFUL 00363 00028 INTEGER*2 TYPIN,TYPLST,TYPOUT,CHCMNT 00364 00029 COMMON/MACVAL/ALECS,TYPIN,TYPLST,TYPOUT,CHCMNT,LSTFUL!850211mao 00365 00029 00366 00029 C Local variables 00367 00029 00368 00030 INTEGER*2 LINENO,STNO,INPNO,NB,ERR1,ERR2,LEN !850211mao 00369 00031 INTEGER*2 NCHAR,I,N FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00011 GET FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00370 00032 BYTE INPUT(80),STRING(82),TEST,TAB 00371 00033 LOGICAL*2 ENDFIL,GOTLIN,EOF !850213mao 00372 00034 BYTE LENB(2) !850213mao 00373 00034 00374 00035 EQUIVALENCE (LEN,LENB(1)) !850213mao 00375 00035 00376 00036 DATA TAB/"11/ FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00012 GET FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00377 00036 .PAGE 00378 00036 00379 00037 LINENO = LINENO + 1 00380 00038 ENDFIL=.FALSE. !850213mao 00381 00039 LEN=0 !850213mao 00382 00040 ERR1=0 !850213mao 00383 00040 00384 00042 GET-INPUT-LINE !850213mao 00385 00043 IF (.NOT.ENDFIL) !850213mao 00386 00043 . 00387 00044 . IF (NCHAR.GT.0) !850213mao 00388 00044 . . 00389 00044 C IF INPUT IS A COMMENT, PROCESS 80 CHARS; IF NOT, PROCESS 72. 00390 00044 C (Note FORTRAN throws away characters beyond 73 without warning but 00391 00044 C prints them on listing! For noncomment lines, FLECS throws them away 00392 00044 C and does NOT print them to warn the user that something is lost.) 00393 00044 . . 00394 00045 . . IF ((NCHAR.GT.72).AND.(INPUT(1).NE.CHCMNT)) NCHAR = 72 00395 00046 . . STNO = 3 00396 00047 . . INPNO = 1 00397 00050 . . REPEAT UNTIL ((STNO.GT.74).OR.(INPNO.GT.NCHAR)) !850213mao 00398 00050 . . . 00399 00050 C . . . Test on STNO>74 is right! STNO is pointer into STRING array & 00400 00050 C . . . 1st 2 bytes of STRING are a character count. Thus max # allowed 00401 00050 C . . . characters is 72--see comment a few lines above. 00402 00050 . . . 00403 00053 . . . WHEN (INPUT(INPNO).EQ.TAB) PROCESS-TAB 00404 00055 . . . ELSE 00405 00056 . . . . STRING(STNO) = INPUT(INPNO) 00406 00057 . . . . STNO = STNO + 1 00407 00057 . . . ...FIN 00408 00059 . . . INPNO = INPNO + 1 00409 00059 . . ...FIN 00410 00060 C SAVE # OF CHARACTERS 00411 00061 . . IF (STNO.GT.75) !850213mao 00412 00062 . . . STNO = 75 !truncate to allowed # !850213mao 00413 00063 . . . ERR1 = "177730 !IE.RBG as in FLERSX.MAC !850213mao 00414 00064 . . . ERR2 = 1 !850213mao 00415 00064 . . ...FIN!if 00416 00065 . . 00417 00066 . . LEN=STNO-3 !850213mao 00418 00066 C . . 00419 00066 C . . CHECK FOR BLANK LINE; STRIP OFF TRAILING BLANKS 00420 00066 C . . 00421 00067 . . I = LEN+2 !850213mao 00422 00070 . . WHILE (STRING(I).EQ.(1H )) I = I-1 00423 00071 . . LEN = I-2 !850213mao 00424 00071 . . 00425 00071 . ...FIN!if !850213mao 00426 00072 ...FIN!if !850213mao 00427 00073 00428 00074 STRING(1) = LENB(1) !850213mao 00429 00075 STRING(2) = LENB(2) !850213mao 00430 00075 00431 00076 RETURN FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00013 GET FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00432 00076 .PAGE ---------------------------------------- 00433 00077 TO GET-INPUT-LINE !850213mao 00434 00077 . 00435 00080 . REPEAT UNTIL (GOTLIN .OR. ENDFIL) !850213mao 00436 00080 . . 00437 00081 . . GOTLIN = .TRUE. 00438 00082 . . CALL FGET (NCHAR,INPUT,EOF,ERR1,ERR2) !850213mao 00439 00082 . . 00440 00083 . . IF (EOF) !eof on input processing 00441 00083 . . . 00442 00085 . . . WHEN (INCLVL.EQ.0) ENDFIL=.TRUE. 00443 00086 . . . ELSE 00444 00087 . . . . CALL ROPN (.TRUE.) !go to previous level, close cur file 00445 00088 . . . . GOTLIN=.FALSE. !try again 00446 00088 . . . ...FIN!else 00447 00089 . . ...FIN!if 00448 00090 . . 00449 00090 . ...FIN!repeat until 00450 00091 ...FIN!to get-input-line FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00014 GET FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00451 00092 .PAGE ---------------------------------------- 00452 00093 TO PROCESS-NORMAL-TAB 00453 00093 . 00454 00093 C . Note this routine might generate characters beyond col 72 00455 00093 C . (by one tab's worth). 00456 00093 . 00457 00093 C N IS NEXT COLUMN THAT IS MULTIPLE OF 8+1 00458 00093 . 00459 00094 . N = ((STNO-2+8-1)/8)*8+1 00460 00095 . NB = N - (STNO-2) 00461 00096 . IF (NB.LT.1) NB = 1 00462 00096 . 00463 00096 C PUT NB BLANKS IN STRING. 00464 00096 . 00465 00097 . DO (I = 1,NB) 00466 00098 . . STRING(STNO) = (1H ) 00467 00099 . . STNO = STNO + 1 00468 00099 . ...FIN!do 00469 00100 ...FIN!to process-normal-tab FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00015 GET FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00470 00101 .PAGE ---------------------------------------- 00471 00102 TO PROCESS-TAB 00472 00102 . 00473 00102 C . Note this routine might generate characters beyond col 72 00474 00102 C . (by one tab's worth). 00475 00102 . 00476 00102 . CONDITIONAL 00477 00102 . . 00478 00102 C . . TAB IS LAST CHARACTER IN INPUT 00479 00103 . . (INPNO.EQ.NCHAR) CONTINUE 00480 00103 . . 00481 00103 C . . LINE BEING PROCESSED IS A COMMENT 00482 00106 . . (INPUT(1).EQ.CHCMNT) PROCESS-NORMAL-TAB 00483 00106 . . 00484 00106 C . . Are we past label & continuation field? 00485 00110 . . ((STNO-3).GE.6) PROCESS-NORMAL-TAB !850213mao 00486 00110 . . 00487 00112 . . (OTHERWISE) 00488 00112 C . . . TAB IS IN FIRST 5 COLUMNS OF LINE 00489 00112 C . . . NB = # OF BLANKS TO INSERT 00490 00113 . . . TEST = INPUT(INPNO + 1) 00491 00113 . . . CONDITIONAL 00492 00115 . . . . (TEST.EQ.(1H )) NB = 5 00493 00117 . . . . ((TEST.GE.1H0).AND.(TEST.LE.1H9)) NB = 5 00494 00119 . . . . (OTHERWISE) NB = 6 00495 00120 . . . ...FIN 00496 00121 . . . NB = NB - (STNO-3) 00497 00121 C PUT NB BLANKS IN STRING 00498 00122 . . . DO (I = 1,NB) 00499 00123 . . . . STRING(STNO) = (1H ) 00500 00124 . . . . STNO = STNO + 1 00501 00124 . . . ...FIN!do 00502 00125 . . ...FIN 00503 00126 . ...FIN 00504 00126 ...FIN!to process-tab 00505 00128 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00433 GET-INPUT-LINE 00384 00452 PROCESS-NORMAL-TAB 00482 00485 00471 PROCESS-TAB 00403 (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00016 NEWNAM FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00506 00000 .NAME NEWNAM 00507 00000 C;+ 00508 00000 C - N E W N A M 00509 00000 C****NAME: SUBROUTINE NEWNAM 00510 00000 C FILE: FILE.FLX 00511 00000 C 00512 00000 C****PURPOSE: CHANGE THE NAME IN HEADER LINE 2 DUE TO .NAME DIRECTIVE 00513 00000 C 00514 00000 C****RESTRICTIONS: 00515 00000 C 00516 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00517 00000 C LANGUAGE: FLECS/FORTRAN 00518 00000 C AUTHOR: M. OOTHOUDT 00519 00000 C DATE: 30-JUN-81 00520 00000 C REVISIONS: 00521 00000 C 850214mao Convert macro to fortran 00522 00000 C 850305mao Force a new page for this directive. 00523 00000 C 00524 00000 C****CALLING SEQUENCE: CALL NEWNAM(LEN,NAME) 00525 00000 C 00526 00000 C INPUT: 00527 00000 C 00528 00000 C LEN =(I*2) NUMBER OF CHARACTERS IN NAME; IF =0, THE CURRENT 00529 00000 C NAME IN THE PAGE HEADER IS BLANKED OUT. 00530 00000 C NAME =(ASCII ARRAY) THE NAME TO PUT IN THE HEADER 00531 00000 C 00532 00000 C OUTPUT: NONE 00533 00000 C 00534 00000 C CMN BLOCK I/O: /FILES/ 00535 00000 C 00536 00000 C RESOURCES: 00537 00000 C LIBRARIES: NONE 00538 00000 C OTHER SUBR: NONE 00539 00000 C DISK FILES: NONE 00540 00000 C DEVICES: NONE 00541 00000 C SGAS: NONE 00542 00000 C EVENT FLAGS: NONE 00543 00000 C SYSTEM DIR: NONE 00544 00000 C 00545 00000 C****NOTES: 00546 00000 C 1. This directive forces a new page. Thus the new value for 00547 00000 C "name" will appear immediately on a new page without the need for a 00548 00000 C .PAGE directive. The ".NAME name" line will appear on the new page. 00549 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00017 NEWNAM FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00550 00000 .PAGE 00551 00000 00552 00001 SUBROUTINE NEWNAM (LEN,NAME) 00553 00001 00554 00001 .PASSIF VAX 00555 00001 .INCLUDE [MP1Q.FLEALECOM]FILDAT.INC *00556 00001 C FILDAT.INC 850226 Define stuff for FILE.FLX subr *00557 00001 *00558 00002 BYTE DAT(9) !date in ASCII *00559 00003 LOGICAL*2 FLLON !.T. if output to FLL file on *00560 00004 LOGICAL*2 FORT !.T. if fort output desired *00561 00005 BYTE FVER(21) !ASCII FLECS version ident *00562 00006 INTEGER*2 LINCNT !# lines left for current page *00563 00007 BYTE LINE(106) !task command line *00564 00008 LOGICAL*2 LIST !.T. if listing output desired *00565 00009 BYTE NAMEHD(6) !ASCII char from .NAME directive *00566 00010 INTEGER*2 P1(33) !Page header string, line 1 *00567 00011 INTEGER*2 P2(59) !Page header string, line 2 *00568 00012 INTEGER*2 PAGENO !current FLL page # *00569 00013 LOGICAL*2 SPON !state of /SP switch *00570 00014 BYTE TIM(8) !time in ASCII *00571 00014 *00572 00015 COMMON /FILES/ PAGENO,LINCNT,FORT,LIST, *00573 00016 1 SPON,FLLON,P1,P2 *00574 00016 *00575 00017 EQUIVALENCE (P1(3),FVER(1)),(P1(16),DAT(1)),(P1(22),TIM(1)) *00576 00018 EQUIVALENCE (P2(3),NAMEHD(1)),(P2(7),LINE(1)) *00577 00018 C END-OF-FILE FILDAT.INC 00578 00018 .PASSEND 00579 00018 .PASSIF PDP 00581 00018 .PASSEND 00582 00018 00583 00018 C Local Variables 00584 00018 00585 00019 INTEGER*2 I !scratch 00586 00020 INTEGER*2 LEN !EXT, R, # characters in name 00587 00021 INTEGER*2 LENU !# characters used from NAME 00588 00022 BYTE NAME(6) !EXT, R, characters input with .NAME 00589 00022 00590 00023 LENU = MIN (6,LEN) 00591 00023 00592 00024 IF (LENU.GT.0) 00593 00027 . DO (I=1,LENU) NAMEHD(I) = NAME(I) 00594 00027 ...FIN!if 00595 00028 00596 00029 IF (LENU.LT.6) 00597 00032 . DO (I=LENU+1,6) NAMEHD(I) = (1H ) 00598 00032 ...FIN!if 00599 00033 00600 00034 CALL NEWPG !force new page !850305mao 00601 00035 RETURN 00602 00036 END (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00018 NEWPG FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00603 00000 .NAME NEWPG 00604 00000 C;+ 00605 00000 C - N E W P G 00606 00000 C****NAME: SUBROUTINE NEWPG 00607 00000 C FILE: FILE.FLX 00608 00000 C 00609 00000 C****PURPOSE: PUT OUT A NEW PAGE 00610 00000 C 00611 00000 C****RESTRICTIONS: 00612 00000 C 00613 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00614 00000 C LANGUAGE: FLECS/FORTRAN 00615 00000 C AUTHOR: M. OOTHOUDT 00616 00000 C DATE: 22-JUN-81 00617 00000 C REVISIONS: 00618 00000 C 850214mao Convert from macro to fortran. 00619 00000 C 00620 00000 C****CALLING SEQUENCE: CALL NEWPG 00621 00000 C 00622 00000 C INPUT: NONE 00623 00000 C 00624 00000 C OUTPUT: NONE 00625 00000 C 00626 00000 C CMN BLOCK I/O: /FILES/ 00627 00000 C 00628 00000 C RESOURCES: 00629 00000 C LIBRARIES: NONE 00630 00000 C OTHER SUBR: NONE 00631 00000 C DISK FILES: NONE 00632 00000 C DEVICES: NONE 00633 00000 C SGAS: NONE 00634 00000 C EVENT FLAGS: NONE 00635 00000 C SYSTEM DIR: NONE 00636 00000 C 00637 00000 C****NOTES: 00638 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00019 NEWPG FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00639 00000 .PAGE 00640 00000 00641 00001 SUBROUTINE NEWPG 00642 00001 00643 00001 .PASSIF VAX 00644 00001 .INCLUDE [MP1Q.FLEALECOM]FILDAT.INC *00645 00001 C FILDAT.INC 850226 Define stuff for FILE.FLX subr *00646 00001 *00647 00002 BYTE DAT(9) !date in ASCII *00648 00003 LOGICAL*2 FLLON !.T. if output to FLL file on *00649 00004 LOGICAL*2 FORT !.T. if fort output desired *00650 00005 BYTE FVER(21) !ASCII FLECS version ident *00651 00006 INTEGER*2 LINCNT !# lines left for current page *00652 00007 BYTE LINE(106) !task command line *00653 00008 LOGICAL*2 LIST !.T. if listing output desired *00654 00009 BYTE NAMEHD(6) !ASCII char from .NAME directive *00655 00010 INTEGER*2 P1(33) !Page header string, line 1 *00656 00011 INTEGER*2 P2(59) !Page header string, line 2 *00657 00012 INTEGER*2 PAGENO !current FLL page # *00658 00013 LOGICAL*2 SPON !state of /SP switch *00659 00014 BYTE TIM(8) !time in ASCII *00660 00014 *00661 00015 COMMON /FILES/ PAGENO,LINCNT,FORT,LIST, *00662 00016 1 SPON,FLLON,P1,P2 *00663 00016 *00664 00017 EQUIVALENCE (P1(3),FVER(1)),(P1(16),DAT(1)),(P1(22),TIM(1)) *00665 00018 EQUIVALENCE (P2(3),NAMEHD(1)),(P2(7),LINE(1)) *00666 00018 C END-OF-FILE FILDAT.INC 00667 00018 .PASSEND 00668 00018 .PASSIF PDP 00670 00018 .PASSEND 00671 00018 00672 00019 LINCNT = 0 !# lines left on current page 00673 00019 00674 00020 RETURN 00675 00021 END (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00020 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00676 00000 .NAME OPENF 00677 00000 C;+ 00678 00000 C - O P E N F 00679 00000 C****NAME: SUBROUTINE OPENF 00680 00000 C FILE: FILE.FLX 00681 00000 C 00682 00000 C****PURPOSE: GET COMMAND LINE FOR FLECS, OPEN INPUT AND OUTPUT FILES 00683 00000 C 00684 00000 C****RESTRICTIONS: 00685 00000 C 00686 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00687 00000 C LANGUAGE: FLECS/F77 00688 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00689 00000 C DATE: 25-OCT-74 00690 00000 C REVISIONS: 00691 00000 C 1980 (GTA) CONVERT MACRO TO FORTRAN. 00692 00000 C 850227mao Rewrite to use FOPN, add /CO, etc. 00693 00000 C 850327mao Put CSI variables into /CSIVR1/. 00694 00000 C 00695 00000 C****CALLING SEQUENCE: CALL OPENF(CALLNO,DONE,SVER) 00696 00000 C 00697 00000 C INPUT: 00698 00000 C 00699 00000 C CALLNO=(I*2)NUMBER OF TIMES OPENF HAS BEEN CALLED BEFORE THIS 00700 00000 C SVER =STRING TO HEAD FLL PAGES 00701 00000 C 00702 00000 C OUTPUT: 00703 00000 C 00704 00000 C DONE =(L*2) .TRUE. IF NO MORE INPUT PRESENT, .FALSE. OTHERWISE 00705 00000 C 00706 00000 C CMN BLOCK I/O: /CSIVR1/ 00707 00000 C 00708 00000 C RESOURCES: 00709 00000 C LIBRARIES: SYSLIB:DATE:TIME 00710 00000 C QLIB:CSI:CSIGO:CSISW:CSIVAL:GETCML:MSGOUT 00711 00000 C OTHER SUBR: EXFLE, FOPN 00712 00000 C DISK FILES: FLX, FTN AND FLL FILES 00713 00000 C DEVICES: DISK FILES 00714 00000 C SGAS: NONE 00715 00000 C EVENT FLAGS: NONE 00716 00000 C SYSTEM DIR: NONE 00717 00000 C 00718 00000 C****NOTES: 00719 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00021 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00720 00000 .PAGE 00721 00001 SUBROUTINE OPENF (CALLNO,DONE,SVER) 00722 00001 00723 00001 .PASSIF VAX 00724 00001 .INCLUDE [MP1Q.FLEALECOM]FILDAT.INC *00725 00001 C FILDAT.INC 850226 Define stuff for FILE.FLX subr *00726 00001 *00727 00002 BYTE DAT(9) !date in ASCII *00728 00003 LOGICAL*2 FLLON !.T. if output to FLL file on *00729 00004 LOGICAL*2 FORT !.T. if fort output desired *00730 00005 BYTE FVER(21) !ASCII FLECS version ident *00731 00006 INTEGER*2 LINCNT !# lines left for current page *00732 00007 BYTE LINE(106) !task command line *00733 00008 LOGICAL*2 LIST !.T. if listing output desired *00734 00009 BYTE NAMEHD(6) !ASCII char from .NAME directive *00735 00010 INTEGER*2 P1(33) !Page header string, line 1 *00736 00011 INTEGER*2 P2(59) !Page header string, line 2 *00737 00012 INTEGER*2 PAGENO !current FLL page # *00738 00013 LOGICAL*2 SPON !state of /SP switch *00739 00014 BYTE TIM(8) !time in ASCII *00740 00014 *00741 00015 COMMON /FILES/ PAGENO,LINCNT,FORT,LIST, *00742 00016 1 SPON,FLLON,P1,P2 *00743 00016 *00744 00017 EQUIVALENCE (P1(3),FVER(1)),(P1(16),DAT(1)),(P1(22),TIM(1)) *00745 00018 EQUIVALENCE (P2(3),NAMEHD(1)),(P2(7),LINE(1)) *00746 00018 C END-OF-FILE FILDAT.INC 00747 00018 .INCLUDE [MP1Q.FLEALECOM]INCDAT.INC *00748 00018 C INCDAT.INC 850213 Define stuff for include files *00749 00018 *00750 00019 INTEGER*2 NUMINC !max depth include files *00751 00019 *00752 00020 PARAMETER (NUMINC=3) *00753 00020 *00754 00021 LOGICAL*2 FLLONS(0:NUMINC) !saved values of FLLON *00755 00022 INTEGER*2 INCLVL !.INCLUDE level now at (0-->main) *00756 00023 LOGICAL*2 INCSTR !.T. if just read .inc from main level *00757 00024 !(prevents * on that line) *00758 00025 LOGICAL*2 LICHNG !.T. if should ignore FLLON *00759 00025 *00760 00026 COMMON /INCDAT/ FLLONS,INCLVL,INCSTR,LICHNG *00761 00026 *00762 00026 C END-OF-FILE INCDAT.INC 00763 00026 .PASSEND 00764 00026 .PASSIF PDP 00767 00026 .PASSEND 00768 00026 00769 00027 INTEGER*2 SEVFLG,ERRFLG,WRNFLG 00770 00028 COMMON/ERRS/SEVFLG,ERRFLG,WRNFLG 00771 00028 00772 00029 LOGICAL*2 ALECS,LSTFUL 00773 00030 INTEGER*2 TYPIN,TYPLST,TYPOUT,CHCMNT 00774 00031 COMMON/MACVAL/ALECS,TYPIN,TYPLST,TYPOUT,CHCMNT,LSTFUL 00775 00031 00776 00032 INTEGER*2 CNTALL,NUMLIN FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00022 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00777 00033 COMMON/FLINE/CNTALL,NUMLIN 00778 00033 00779 00034 BYTE CNDVLB(8,10) 00780 00035 LOGICAL*2 PASFLG 00781 00036 INTEGER*2 CNDLVL,OFFLVL,COND,CNDVAL(4,10) 00782 00037 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL 00783 00038 EQUIVALENCE (CNDVLB(1,1),CNDVAL(1,1)) 00784 00038 00785 00038 C Local Variables 00786 00038 00787 00039 INTEGER*2 CALLNO 00788 00040 LOGICAL*2 COON 00789 00041 INTEGER*2 DEVIND(2) 00790 00042 LOGICAL*2 DONE 00791 00043 LOGICAL*2 EOF 00792 00044 LOGICAL*2 EQUAL 00793 00045 INTEGER*2 ERR 00794 00046 INTEGER*2 ERRNUM 00795 00047 LOGICAL*2 ERROR 00796 00048 INTEGER*2 FILIND(2) 00797 00049 BYTE FLLDEF(4) 00798 00050 BYTE FLXDEF(4) 00799 00051 INTEGER*2 FLXDSC(2,4) 00800 00052 BYTE FTNDEF(4) 00801 00053 INTEGER*2 FTNDSC(2,4) 00802 00054 INTEGER*2 FUON 00803 00055 INTEGER*2 I 00804 00056 INTEGER*2 J 00805 00057 INTEGER*2 K 00806 00058 INTEGER*2 LENG 00807 00059 BYTE LENGB(2) 00808 00060 INTEGER*2 LENGTH 00809 00061 INTEGER*2 LSTDSC(2,4) 00810 00062 LOGICAL*2 MORE 00811 00063 BYTE SVER(23) 00812 00064 INTEGER*2 UICIND(2) 00813 00065 LOGICAL*2 WILD 00814 00065 00815 00066 COMMON/CSIVR1/DEVIND,UICIND,FILIND,MORE,WILD,EQUAL, !850327mao 00816 00067 1 FUON,COON !850327mao 00817 00067 00818 00068 EQUIVALENCE (LENG,LENGB(1)) 00819 00068 00820 00068 .PASSIF FLECS 00821 00069 DATA FLLDEF /'.','F','L','L'/ 00822 00070 DATA FLXDEF /'.','F','L','X'/ 00823 00071 DATA FTNDEF /'.','F','T','N'/ 00824 00071 .PASSEND 00825 00071 .PASSIF ALECS 00829 00071 .PASSEND 00830 00071 FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00023 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00831 00071 .PAGE 00832 00073 INITIALIZE-VARIABLES 00833 00073 00834 00076 REPEAT WHILE(ERROR) 00835 00076 . 00836 00077 . ERROR = .FALSE. 00837 00077 . 00838 00079 . GET-CMD-LINE-AND-SETUP-FOR-CSIGO-CALLS 00839 00079 . 00840 00081 . PARSE-FORT-FILENAME 00841 00081 . 00842 00082 . WHEN ((MORE).AND.(.NOT.ERROR)) 00843 00084 . . PARSE-LISTING-FILENAME 00844 00084 . ...FIN!when 00845 00088 . ELSE LIST = .FALSE. 00846 00088 . 00847 00093 . IF (.NOT.ERROR) PARSE-INPUT-FILENAME 00848 00093 . 00849 00098 . IF (.NOT.ERROR) OPEN-FILES 00850 00098 . 00851 00098 ...FIN!repeat while 00852 00099 00853 00100 DONE = .FALSE. 00854 00101 FLLON = LIST 00855 00101 00856 00102 RETURN FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00024 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00857 00102 .PAGE ---------------------------------------- 00858 00103 TO GET-CMD-LINE-AND-SETUP-FOR-CSIGO-CALLS 00859 00103 . 00860 00103 . .PASSIF ALECS 00862 00103 . .PASSEND 00863 00103 . .PASSIF FLECS 00864 00104 . CALL GETCML(LINE,'FLE',LENGTH,106,EOF,1) 00865 00104 . .PASSEND 00866 00105 . IF (EOF) CALL EXFLE !task exit with status 00867 00105 . 00868 00106 . LINE(LENGTH+1) = "15 !append 00869 00107 . LINE(LENGTH+2) = "12 00870 00108 . P2(1) = LENGTH+12 !fill in string length 00871 00108 . 00872 00109 . CALL CSI(DEVIND,UICIND,FILIND,MORE,WILD,EQUAL) 00873 00110 . CALL CSISW('FU',FUON,2) 00874 00111 . CALL CSISW('SP',SPON,2) 00875 00112 . CALL CSISW('CO',COON,2) 00876 00113 . CALL CSIVAL('CO',CNDVAL(2,1),6) 00877 00114 . CALL CSIVAL('CO',CNDVAL(2,2),6) 00878 00115 . CALL CSIVAL('CO',CNDVAL(2,3),6) 00879 00116 . CALL CSIVAL('CO',CNDVAL(2,4),6) 00880 00117 . CALL CSIVAL('CO',CNDVAL(2,5),6) 00881 00118 . CALL CSIVAL('CO',CNDVAL(2,6),6) 00882 00119 . CALL CSIVAL('CO',CNDVAL(2,7),6) 00883 00120 . CALL CSIVAL('CO',CNDVAL(2,8),6) 00884 00121 . CALL CSIVAL('CO',CNDVAL(2,9),6) 00885 00122 . CALL CSIVAL('CO',CNDVAL(2,10),6) 00886 00122 . 00887 00122 ...FIN!to get-cmd-line-and-setup-for-csigo-calls FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00025 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00888 00123 .PAGE ---------------------------------------- 00889 00124 TO INITIALIZE-VARIABLES 00890 00125 . IF (CALLNO.EQ.1) 00891 00125 . . 00892 00126 . . P1(1) = 64 !initialize page header, line 1 00893 00129 . . DO (I=2,33) P1(I) = ' ' 00894 00130 . . P1(27) = 'PA' 00895 00131 . . P1(28) = 'GE' 00896 00131 . . 00897 00132 . . LENGB(1) = SVER(1) !get string length for FLECS version 00898 00133 . . LENGB(2) = SVER(2) 00899 00134 . . IF (LENG.GT.21) LENG=21 00900 00137 . . DO (I = 1,LENG) FVER(I) = SVER(I+2) 00901 00137 . . 00902 00138 . . P2(1) = 116 !initialize page header, line 2 00903 00141 . . DO (I=2,59) P2(I) = ' ' 00904 00141 . ...FIN!if 00905 00142 . 00906 00143 . CALL DATE(DAT(1)) !put date & time into page hdr, line 1 00907 00144 . CALL TIME(TIM(1)) 00908 00144 . 00909 00145 . PAGENO = 0 00910 00146 . LINCNT = 0 00911 00147 . INCLVL=0 00912 00148 . INCSTR=.FALSE. 00913 00149 . COND=0 00914 00150 . FORT=.FALSE. 00915 00151 . LIST=.FALSE. 00916 00151 . 00917 00151 ...FIN!to initialize-variables FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00026 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00918 00152 .PAGE ---------------------------------------- 00919 00153 TO OPEN-FILES 00920 00153 . 00921 00154 . CALL FOPN (LINE,FLXDEF,FLXDSC,FORT,FTNDEF,FTNDSC, 00922 00155 1. LIST,FLLDEF,LSTDSC,ERRNUM) 00923 00156 . ERROR = ERRNUM.NE.0 00924 00157 . IF (ERROR) 00925 00158 . . SEVFLG=SEVFLG+1 00926 00158 . . SELECT (ERRNUM) 00927 00159 . . . (1) 00928 00160 . . . . CALL MSGOUT ('F-Open error on input file') 00929 00160 . . . ...FIN 00930 00161 . . . (2) 00931 00162 . . . . CALL MSGOUT ('F-Open error on output FORT/MAC file') 00932 00162 . . . ...FIN 00933 00164 . . . (3) CALL MSGOUT('F-Open error on output FLL/ALL file') 00934 00165 . . ...FIN!select 00935 00165 . ...FIN!if 00936 00166 ...FIN!to open-files FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00027 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00937 00167 .PAGE ---------------------------------------- 00938 00168 TO PARSE-FORT-FILENAME 00939 00168 . 00940 00169 . CALL CSIGO(LINE,LENGTH,'O',ERR) 00941 00169 . 00942 00170 . IF (WILD) 00943 00171 . . ERROR = .TRUE. 00944 00172 . . CALL MSGOUT 00945 00173 1. . ('F-Wild cards are not allowed in FLE/ALE command line') 00946 00173 . ...FIN 00947 00175 . IF (.NOT.EQUAL) 00948 00176 . . ERROR = .TRUE. 00949 00177 . . CALL MSGOUT ( 00950 00178 1. . 'F-Must have an input file & at least one output file') 00951 00178 . ...FIN!if 00952 00180 . IF (ERR) 00953 00181 . . ERROR = .TRUE. 00954 00182 . . CALL MSGOUT ( 00955 00183 1. . 'F-Syntax error or illegal switch in FORT/MAC file spec') 00956 00183 . ...FIN!if 00957 00185 . WHEN (SPON.NE.2 .OR. COON.NE.2) 00958 00186 . . ERROR=.TRUE. 00959 00187 . . CALL MSGOUT ('F-/SP & /CO illegal on FORT/MAC file') 00960 00187 . ...FIN!when 00961 00190 . ELSE LSTFUL = FUON.NE.2 .AND. FUON 00962 00190 . 00963 00190 . 00964 00191 . FORT = .NOT.ERROR .AND. 00965 00192 1. (DEVIND(1).NE.0 .OR. FILIND(1).NE.0) 00966 00192 . 00967 00193 . IF (FORT) 00968 00193 . . 00969 00194 . . DO (I=1,4) 00970 00197 . . . DO (J=1,2) FTNDSC(J,I) = 0 !assume no filename 00971 00197 . . ...FIN!do 00972 00198 . . 00973 00199 . . I=0 !pointer to end of spec 00974 00199 . . 00975 00200 . . IF (DEVIND(1).NE.0) 00976 00201 . . . FTNDSC(1,1) = DEVIND(2)-DEVIND(1)+2 !length, including : 00977 00202 . . . FTNDSC(2,1) = DEVIND(1) !index 00978 00203 . . . FTNDSC(2,4) = DEVIND(1) 00979 00204 . . . I=DEVIND(2)+1 00980 00204 . . ...FIN!if 00981 00205 . . 00982 00206 . . IF (UICIND(1).NE.0) 00983 00207 . . . FTNDSC(1,2) = UICIND(2)-UICIND(1)+1 !length, including [] 00984 00208 . . . FTNDSC(2,2) = UICIND(1) !index 00985 00209 . . . IF (FTNDSC(2,4).EQ.0) FTNDSC(2,4) = UICIND(1) 00986 00210 . . . I=UICIND(2) 00987 00210 . . ...FIN!if 00988 00211 . . FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00028 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00989 00212 . . IF (FILIND(1).NE.0) 00990 00213 . . . FTNDSC(1,3) = FILIND(2)-FILIND(1)+1 !length 00991 00214 . . . FTNDSC(2,3) = FILIND(1) !index 00992 00215 . . . IF (FTNDSC(2,4).EQ.0) FTNDSC(2,4) = FILIND(1) 00993 00216 . . . I=FILIND(2) 00994 00216 . . ...FIN!if 00995 00217 . . 00996 00218 . . IF (FTNDSC(2,4).NE.0) FTNDSC(1,4) = I-FTNDSC(2,4)+1 00997 00218 . ...FIN!if 00998 00219 ...FIN!to parse-fort-filename FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00029 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 00999 00220 .PAGE ---------------------------------------- 01000 00221 TO PARSE-INPUT-FILENAME 01001 00221 . 01002 00222 . CALL CSIGO(LINE,LENGTH,'I',ERR) 01003 00222 . 01004 00224 . TEST-FOR-ERRORS-IN-INPUT-FILE-SPEC-AND-PARSE-CO-SW 01005 00224 . 01006 00225 . IF (.NOT.ERROR) 01007 00225 . . 01008 00226 . . DO (I=1,4) 01009 00229 . . . DO (J=1,2) FLXDSC(J,I) = 0 !assume no filename 01010 00229 . . ...FIN!do 01011 00230 . . 01012 00231 . . I=0 !pointer to end of spec 01013 00231 . . 01014 00232 . . IF (DEVIND(1).NE.0) 01015 00233 . . . FLXDSC(1,1) = DEVIND(2)-DEVIND(1)+2 !length, including : 01016 00234 . . . FLXDSC(2,1) = DEVIND(1) !index 01017 00235 . . . FLXDSC(2,4) = DEVIND(1) 01018 00236 . . . I=DEVIND(2)+1 01019 00236 . . ...FIN!if 01020 00237 . . 01021 00238 . . IF (UICIND(1).NE.0) 01022 00239 . . . FLXDSC(1,2) = UICIND(2)-UICIND(1)+1 !length, including [] 01023 00240 . . . FLXDSC(2,2) = UICIND(1) !index 01024 00241 . . . IF (FLXDSC(2,4).EQ.0) FLXDSC(2,4) = UICIND(1) 01025 00242 . . . I=UICIND(2) 01026 00242 . . ...FIN!if 01027 00243 . . 01028 00244 . . IF (FILIND(1).NE.0) 01029 00245 . . . FLXDSC(1,3) = FILIND(2)-FILIND(1)+1 !length 01030 00246 . . . FLXDSC(2,3) = FILIND(1) !index 01031 00247 . . . IF (FLXDSC(2,4).EQ.0) FLXDSC(2,4) = FILIND(1) 01032 00248 . . . I=FILIND(2) 01033 00248 . . ...FIN!if 01034 00249 . . 01035 00250 . . IF (FLXDSC(2,4).NE.0) FLXDSC(1,4) = I-FLXDSC(2,4)+1 01036 00250 . . 01037 00250 . ...FIN!if 01038 00251 ...FIN!to parse-input-filename FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00030 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01039 00252 .PAGE ---------------------------------------- 01040 00253 TO PARSE-LISTING-FILENAME 01041 00253 . 01042 00254 . CALL CSIGO(LINE,LENGTH,'O',ERR) 01043 00255 . IF (ERR) 01044 00256 . . ERROR = .TRUE. 01045 00257 . . CALL MSGOUT ('F-Syntax error or illegal sw in listing file') 01046 00257 . ...FIN!if 01047 00259 . IF (WILD) 01048 00260 . . ERROR = .TRUE. 01049 00261 . . CALL MSGOUT ( 01050 00262 1. . 'F-Wild cards are not allowed in FLE/ALE command line') 01051 00262 . ...FIN!if 01052 00264 . IF (MORE) 01053 00265 . . ERROR=.TRUE. 01054 00266 . . CALL MSGOUT ('F-Only 2 output specs allowed') 01055 00266 . ...FIN!if 01056 00268 . IF (FUON.NE.2 .OR. COON.NE.2) 01057 00269 . . CALL MSGOUT ('F-/FU & /CO illegal on listing file') 01058 00270 . . ERROR = .TRUE. 01059 00270 . ...FIN!if 01060 00271 . 01061 00271 C . /SP ignored, but allowed for compatility 01062 00271 . 01063 00272 . LIST = .NOT.ERROR .AND. 01064 00273 1. (DEVIND(1).NE.0 .OR. FILIND(1).NE.0) 01065 00274 . IF (LIST) 01066 00274 . . 01067 00275 . . DO (I=1,4) 01068 00278 . . . DO (J=1,2) LSTDSC(J,I) = 0 !assume no filename 01069 00278 . . ...FIN!do 01070 00279 . . 01071 00280 . . I=0 !pointer to end of spec 01072 00280 . . 01073 00281 . . IF (DEVIND(1).NE.0) 01074 00282 . . . LSTDSC(1,1) = DEVIND(2)-DEVIND(1)+2 !length, including : 01075 00283 . . . LSTDSC(2,1) = DEVIND(1) !index 01076 00284 . . . LSTDSC(2,4) = DEVIND(1) 01077 00285 . . . I=DEVIND(2)+1 01078 00285 . . ...FIN!if 01079 00286 . . 01080 00287 . . IF (UICIND(1).NE.0) 01081 00288 . . . LSTDSC(1,2) = UICIND(2)-UICIND(1)+1 !length, including [] 01082 00289 . . . LSTDSC(2,2) = UICIND(1) !index 01083 00290 . . . IF (LSTDSC(2,4).EQ.0) LSTDSC(2,4) = UICIND(1) 01084 00291 . . . I=UICIND(2) 01085 00291 . . ...FIN!if 01086 00292 . . 01087 00293 . . IF (FILIND(1).NE.0) 01088 00294 . . . LSTDSC(1,3) = FILIND(2)-FILIND(1)+1 !length 01089 00295 . . . LSTDSC(2,3) = FILIND(1) !index 01090 00296 . . . IF (LSTDSC(2,4).EQ.0) LSTDSC(2,4) = FILIND(1) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00031 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01091 00297 . . . I=FILIND(2) 01092 00297 . . ...FIN!if 01093 00298 . . 01094 00299 . . IF (LSTDSC(2,4).NE.0) LSTDSC(1,4) = I-LSTDSC(2,4)+1 01095 00299 . ...FIN!if 01096 00300 . 01097 00300 ...FIN!to parse-listing-filename-and-open FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00032 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01098 00301 .PAGE ---------------------------------------- 01099 00302 TO TEST-FOR-ERRORS-IN-INPUT-FILE-SPEC-AND-PARSE-CO-SW 01100 00302 . 01101 00303 . IF (ERR) 01102 00304 . . ERROR = .TRUE. 01103 00305 . . CALL MSGOUT ('F-Switch or syntax error in input file spec') 01104 00305 . ...FIN!if 01105 00307 . IF (WILD) 01106 00308 . . ERROR = .TRUE. 01107 00309 . . CALL MSGOUT ( 01108 00310 1. . ' Wild cards are not allowed in FLE/ALE command line') 01109 00310 . ...FIN 01110 00312 . IF (FILIND(1).EQ.0) 01111 00313 . . ERROR = .TRUE. 01112 00314 . . CALL MSGOUT ('F-Must give file name for input FLE/ALE file') 01113 00314 . ...FIN!if 01114 00315 . 01115 00316 . WHEN (SPON.NE.2 .OR. FUON.NE.2) 01116 00317 . . ERROR=.TRUE. 01117 00318 . . CALL MSGOUT (' /SP & /FU illegal on input file spec') 01118 00318 . ...FIN!when 01119 00319 . ELSE 01120 00319 . . 01121 00321 . . WHEN (COON.EQ.2) COND=0 01122 00322 . . ELSE 01123 00322 . . . 01124 00322 C . . . Ignore /-CO ie. treat it as if /CO 01125 00322 C . . . Find # of last value given 01126 00322 . . . 01127 00323 . . . COND=10 01128 00324 . . . WHILE (COND.GT.0 .AND. CNDVAL(2,COND).EQ.0) 01129 00325 . . . . COND=COND-1 01130 00325 . . . ...FIN!while 01131 00326 . . . 01132 00327 . . . IF (COND.GT.0) !any values given? 01133 00327 . . . . 01134 00327 C . . . . Yes, find last nonnull character in each string. 01135 00327 C . . . . (Ignore possibility of embedded null.) Note /CO:A::B 01136 00327 C . . . . is possible and allowed. 01137 00327 . . . . 01138 00328 . . . . DO (I=1,COND) 01139 00329 . . . . . J=6 01140 00332 . . . . . WHILE (J.GT.0 .AND. CNDVLB(J+2,I).EQ.0) J=J-1 01141 00333 . . . . . CNDVAL(1,I) = J 01142 00333 . . . . ...FIN!do 01143 00334 . . . ...FIN!if 01144 00335 . . ...FIN!else 01145 00336 . ...FIN!else 01146 00337 ...FIN!to test-for-errors-in-input-file-spec-and-parse-co-sw 01147 00339 END ---------------------------------------- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00033 OPENF FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX PROCEDURE CROSS-REFERENCE TABLE 00858 GET-CMD-LINE-AND-SETUP-FOR-CSIGO-CALLS 00838 00889 INITIALIZE-VARIABLES 00832 00919 OPEN-FILES 00849 00938 PARSE-FORT-FILENAME 00840 01000 PARSE-INPUT-FILENAME 00847 01040 PARSE-LISTING-FILENAME 00843 01099 TEST-FOR-ERRORS-IN-INPUT-FILE-SPEC-AND-PARSE-CO-SW 01004 (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00034 OPNINC FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01148 00000 .NAME OPNINC 01149 00000 C;+ 01150 00000 C - O P N I N C 01151 00000 C****NAME: SUBROUTINE OPNINC 01152 00000 C FILE: FILE.FLX 01153 00000 C 01154 00000 C****PURPOSE: OPEN AN .INCLUDE FILE 01155 00000 C 01156 00000 C****RESTRICTIONS: 01157 00000 C 01158 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 01159 00000 C LANGUAGE: FLECS/F77 01160 00000 C AUTHOR: M. OOTHOUDT 01161 00000 C DATE: 29-JUN-81 01162 00000 C REVISIONS: 01163 00000 C 850213MAO CONVERT MACRO TO FLECS 01164 00000 C 850304mao New calling sequence to FOPNIN for RSX/VMS compatibility 01165 00000 C 850327mao Put CSI variables into /CSIVR2/. 01166 00000 C 01167 00000 C****CALLING SEQUENCE: CALL OPNINC (NCHAR,NAME,IERR) 01168 00000 C 01169 00000 C INPUT: 01170 00000 C 01171 00000 C NCHAR =(I*2) NUMBER OF CHARACTERS IN FILE NAME 01172 00000 C NAME =(ARRAY) ASCII ARRAY CONTAINING THE FILE NAME 01173 00000 C 01174 00000 C OUTPUT: 01175 00000 C 01176 00000 C IERR =(I*2) ERROR RETURN CODE 01177 00000 C =0, ALL OK 01178 00000 C =1, ALREADY AT MAXIMUM INCLUDE FILE NESTING DEPTH 01179 00000 C =2, ERROR IN PARSING GIVEN FILE NAME 01180 00000 C =3, OPEN ERROR ON INCLUDE FILE 01181 00000 C 01182 00000 C CMN BLOCK I/O: /INCDAT/ 01183 00000 C 01184 00000 C RESOURCES: 01185 00000 C LIBRARIES: QLIB:CSI:CSIGO:CSISW 01186 00000 C OTHER SUBR: FOPNIN, ROPN 01187 00000 C DISK FILES: INCLUDE FILE 01188 00000 C DEVICES: DISK FILES 01189 00000 C SGAS: NONE 01190 00000 C EVENT FLAGS: NONE 01191 00000 C SYSTEM DIR: NONE 01192 00000 C 01193 00000 C****NOTES: 01194 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00035 OPNINC FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01195 00000 .PAGE 01196 00001 SUBROUTINE OPNINC (NCHAR,NAME,IERR) 01197 00001 01198 00001 .PASSIF VAX 01199 00001 .INCLUDE [MP1Q.FLEALECOM]FILDAT.INC *01200 00001 C FILDAT.INC 850226 Define stuff for FILE.FLX subr *01201 00001 *01202 00002 BYTE DAT(9) !date in ASCII *01203 00003 LOGICAL*2 FLLON !.T. if output to FLL file on *01204 00004 LOGICAL*2 FORT !.T. if fort output desired *01205 00005 BYTE FVER(21) !ASCII FLECS version ident *01206 00006 INTEGER*2 LINCNT !# lines left for current page *01207 00007 BYTE LINE(106) !task command line *01208 00008 LOGICAL*2 LIST !.T. if listing output desired *01209 00009 BYTE NAMEHD(6) !ASCII char from .NAME directive *01210 00010 INTEGER*2 P1(33) !Page header string, line 1 *01211 00011 INTEGER*2 P2(59) !Page header string, line 2 *01212 00012 INTEGER*2 PAGENO !current FLL page # *01213 00013 LOGICAL*2 SPON !state of /SP switch *01214 00014 BYTE TIM(8) !time in ASCII *01215 00014 *01216 00015 COMMON /FILES/ PAGENO,LINCNT,FORT,LIST, *01217 00016 1 SPON,FLLON,P1,P2 *01218 00016 *01219 00017 EQUIVALENCE (P1(3),FVER(1)),(P1(16),DAT(1)),(P1(22),TIM(1)) *01220 00018 EQUIVALENCE (P2(3),NAMEHD(1)),(P2(7),LINE(1)) *01221 00018 C END-OF-FILE FILDAT.INC 01222 00018 .INCLUDE [MP1Q.FLEALECOM]INCDAT.INC *01223 00018 C INCDAT.INC 850213 Define stuff for include files *01224 00018 *01225 00019 INTEGER*2 NUMINC !max depth include files *01226 00019 *01227 00020 PARAMETER (NUMINC=3) *01228 00020 *01229 00021 LOGICAL*2 FLLONS(0:NUMINC) !saved values of FLLON *01230 00022 INTEGER*2 INCLVL !.INCLUDE level now at (0-->main) *01231 00023 LOGICAL*2 INCSTR !.T. if just read .inc from main level *01232 00024 !(prevents * on that line) *01233 00025 LOGICAL*2 LICHNG !.T. if should ignore FLLON *01234 00025 *01235 00026 COMMON /INCDAT/ FLLONS,INCLVL,INCSTR,LICHNG *01236 00026 *01237 00026 C END-OF-FILE INCDAT.INC 01238 00026 .PASSEND 01239 00026 .PASSIF PDP 01242 00026 .PASSEND 01243 00026 01244 00026 C Local variables 01245 00026 01246 00027 INTEGER*2 DEVIND(2) !pointer to device !850304mao 01247 00028 LOGICAL*2 ERR !.T. if CSI error 01248 00029 INTEGER*2 FILDSC(2,4)!file descriptor array !850304mao 01249 00030 INTEGER*2 FILIND(2) !pointer to filename !850304mao 01250 00031 INTEGER*2 I !scratch 01251 00032 INTEGER*2 IERR !EXT, R/W, error return FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00036 OPNINC FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01252 00033 INTEGER*2 IPNT !last good char in NAME 01253 00034 INTEGER*2 J !scratch 01254 00035 LOGICAL*2 LISET !.T. if /LI; .F. if /-LI 01255 00036 BYTE NAME(80) !EXT, R, file name of include file 01256 00037 INTEGER*2 NCHAR !EXT, R, # characters in file name 01257 00038 INTEGER*2 UICIND(2) !pointer to directory !850304mao 01258 00038 01259 00039 COMMON /CSIVR2/ DEVIND,UICIND,FILIND,LISET !850327mao 01260 00039 01261 00041 WHEN (INCLVL.EQ.NUMINC) IERR=1 !at max depth 01262 00042 ELSE 01263 00042 . 01264 00043 . CALL CSI(DEVIND,UICIND,FILIND) !parse file name!850304mao 01265 00044 . CALL CSISW ('LI',LISET,.TRUE.) 01266 00045 . CALL CSIGO(NAME,NCHAR,'O',ERR) 01267 00045 . 01268 00047 . WHEN (ERR) IERR=2 !bad filename 01269 00048 . ELSE 01270 00048 . . 01271 00049 . . FLLONS(INCLVL) = FLLON !save FLL listing status 01272 00050 . . INCLVL = INCLVL + 1 !next level 01273 00050 . . 01274 00052 . . PARSE-FILENAME !850304mao 01275 00053 . . CALL FOPNIN (INCLVL,NAME,FILDSC,IERR) !850304mao 01276 00053 . . 01277 00054 . . WHEN (IERR.NE.0) !OPEN error recovery 01278 00054 . . . 01279 00055 100 . . . IERR=3 01280 00056 . . . CALL ROPN(.FALSE.) !go back to previous level 01281 00056 . . ...FIN!when 01282 00057 . . ELSE 01283 00057 . . . 01284 00058 . . . INCSTR = INCLVL.EQ.1 !set "no star" flag 01285 00058 . . . 01286 00058 C . . . Problem: If output is currently on, but /-LI is in current 01287 00058 C . . . line, the .INCLUDE line will not be listed. Therefore use 01288 00058 C . . . LICHNG flag to tell PUT to ignore FLLON flag for this line. 01289 00058 . . . 01290 00059 . . . LICHNG = FLLON .AND. .NOT.LISET 01291 00059 . . . 01292 00060 . . . FLLON = LISET 01293 00060 . . . 01294 00060 . . ...FIN!else 01295 00061 . ...FIN!else 01296 00062 ...FIN!else 01297 00063 01298 00064 RETURN FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00037 OPNINC FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01299 00064 .PAGE ---------------------------------------- 01300 00065 TO PARSE-FILENAME 01301 00065 . 01302 00066 . DO (I=1,4) 01303 00069 . . DO (J=1,2) FILDSC(J,I) = 0 !assume no filename 01304 00069 . ...FIN!do 01305 00070 . 01306 00071 . I=0 !pointer to end of spec 01307 00071 . 01308 00072 . IF (DEVIND(1).NE.0) 01309 00073 . . FILDSC(1,1) = DEVIND(2)-DEVIND(1)+2 !length, including : 01310 00074 . . FILDSC(2,1) = DEVIND(1) !index 01311 00075 . . FILDSC(2,4) = DEVIND(1) 01312 00076 . . I=DEVIND(2)+1 01313 00076 . ...FIN!if 01314 00077 . 01315 00078 . IF (UICIND(1).NE.0) 01316 00079 . . FILDSC(1,2) = UICIND(2)-UICIND(1)+1 !length, including [] 01317 00080 . . FILDSC(2,2) = UICIND(1) !index 01318 00081 . . IF (FILDSC(2,4).EQ.0) FILDSC(2,4) = UICIND(1) 01319 00082 . . I=UICIND(2) 01320 00082 . ...FIN!if 01321 00083 . 01322 00084 . IF (FILIND(1).NE.0) 01323 00085 . . FILDSC(1,3) = FILIND(2)-FILIND(1)+1 !length 01324 00086 . . FILDSC(2,3) = FILIND(1) !index 01325 00087 . . IF (FILDSC(2,4).EQ.0) FILDSC(2,4) = FILIND(1) 01326 00088 . . I=FILIND(2) 01327 00088 . ...FIN!if 01328 00089 . 01329 00090 . IF (FILDSC(2,4).NE.0) FILDSC(1,4) = I-FILDSC(2,4)+1 01330 00090 ...FIN!to parse-filename 01331 00092 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 01300 PARSE-FILENAME 01274 (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00038 PUT FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01332 00000 .NAME PUT 01333 00000 C;+ 01334 00000 C - P U T 01335 00000 C****NAME: SUBROUTINE PUT 01336 00000 C FILE: FILE.FLX 01337 00000 C 01338 00000 C****PURPOSE: OUTPUT TO FORTRAN, LISTING OR ERROR STREAMS 01339 00000 C 01340 00000 C****RESTRICTIONS: 01341 00000 C 01342 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 01343 00000 C LANGUAGE: FLECS/FORTRAN 01344 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 01345 00000 C DATE: 25-OCT-74 01346 00000 C REVISIONS: 01347 00000 C 1980gta Convert from macro to fortran 01348 00000 C 850227mao Rewrite to use FPUT. 01349 00000 C 01350 00000 C****CALLING SEQUENCE: CALL PUT(LINENO,STRING,IOCLAS) 01351 00000 C 01352 00000 C INPUT: 01353 00000 C 01354 00000 C LINENO=(I*2) CONTROL 01355 00000 C =0, COL 1-5 SHOULD BE LEFT BLANK 01356 00000 C >0, PUT LINENO IN COL 1-5 01357 00000 C <0, PUT ABS(LINENO) IN COL 1-5, BUT PREFIX WITH "E" 01358 00000 C STRING= STRING TO BE PUT OUT 01359 00000 C IOCLAS=(I*2) WHICH OUTPUT CLASS IS TO BE USED: 01360 00000 C =1, FTN (NOTE LINENO CAN ONLY BE POSITIVE) 01361 00000 C =2, LIST 01362 00000 C =3, ERROR 01363 00000 C 01364 00000 C OUTPUT: NONE 01365 00000 C 01366 00000 C CMN BLOCK I/O: /FILE/, /INCDAT/, /FILE/, /COND/ 01367 00000 C 01368 00000 C RESOURCES: 01369 00000 C LIBRARIES: NONE 01370 00000 C OTHER SUBR: FPUT, PUTNUM 01371 00000 C DISK FILES: FTN, FLL FILES 01372 00000 C DEVICES: DISK 01373 00000 C SGAS: NONE 01374 00000 C EVENT FLAGS: NONE 01375 00000 C SYSTEM DIR: None 01376 00000 C 01377 00000 C****NOTES: 01378 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00039 PUT FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01379 00000 .PAGE 01380 00001 SUBROUTINE PUT(LINENO,STRING,IOCLAS) 01381 00001 01382 00001 .PASSIF VAX 01383 00001 .INCLUDE [MP1Q.FLEALECOM]FILDAT.INC *01384 00001 C FILDAT.INC 850226 Define stuff for FILE.FLX subr *01385 00001 *01386 00002 BYTE DAT(9) !date in ASCII *01387 00003 LOGICAL*2 FLLON !.T. if output to FLL file on *01388 00004 LOGICAL*2 FORT !.T. if fort output desired *01389 00005 BYTE FVER(21) !ASCII FLECS version ident *01390 00006 INTEGER*2 LINCNT !# lines left for current page *01391 00007 BYTE LINE(106) !task command line *01392 00008 LOGICAL*2 LIST !.T. if listing output desired *01393 00009 BYTE NAMEHD(6) !ASCII char from .NAME directive *01394 00010 INTEGER*2 P1(33) !Page header string, line 1 *01395 00011 INTEGER*2 P2(59) !Page header string, line 2 *01396 00012 INTEGER*2 PAGENO !current FLL page # *01397 00013 LOGICAL*2 SPON !state of /SP switch *01398 00014 BYTE TIM(8) !time in ASCII *01399 00014 *01400 00015 COMMON /FILES/ PAGENO,LINCNT,FORT,LIST, *01401 00016 1 SPON,FLLON,P1,P2 *01402 00016 *01403 00017 EQUIVALENCE (P1(3),FVER(1)),(P1(16),DAT(1)),(P1(22),TIM(1)) *01404 00018 EQUIVALENCE (P2(3),NAMEHD(1)),(P2(7),LINE(1)) *01405 00018 C END-OF-FILE FILDAT.INC 01406 00018 .INCLUDE [MP1Q.FLEALECOM]INCDAT.INC *01407 00018 C INCDAT.INC 850213 Define stuff for include files *01408 00018 *01409 00019 INTEGER*2 NUMINC !max depth include files *01410 00019 *01411 00020 PARAMETER (NUMINC=3) *01412 00020 *01413 00021 LOGICAL*2 FLLONS(0:NUMINC) !saved values of FLLON *01414 00022 INTEGER*2 INCLVL !.INCLUDE level now at (0-->main) *01415 00023 LOGICAL*2 INCSTR !.T. if just read .inc from main level *01416 00024 !(prevents * on that line) *01417 00025 LOGICAL*2 LICHNG !.T. if should ignore FLLON *01418 00025 *01419 00026 COMMON /INCDAT/ FLLONS,INCLVL,INCSTR,LICHNG *01420 00026 *01421 00026 C END-OF-FILE INCDAT.INC 01422 00026 .PASSEND 01423 00026 .PASSIF PDP 01426 00026 .PASSEND 01427 00026 01428 00027 INTEGER*2 CNTALL,NUMLIN 01429 00028 COMMON/FLINE/CNTALL,NUMLIN 01430 00028 01431 00029 LOGICAL*2 PASFLG 01432 00030 INTEGER*2 CNDLVL,OFFLVL,COND,CNDVAL(4,10) 01433 00031 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL 01434 00031 01435 00031 C Local variables FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00040 PUT FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01436 00031 01437 00032 BYTE STRING(82),OUTPUT(132),OUTF(80),LENB(2),NPB(2) 01438 00033 INTEGER*2 LINENO, IOCLAS, LEN, I, K, NP 01439 00033 01440 00034 EQUIVALENCE (LEN,LENB(1)) 01441 00035 EQUIVALENCE (OUTPUT(1),OUTF(1)) !optimize fort IO 01442 00036 EQUIVALENCE (NP,NPB(1)) 01443 00036 01444 00037 DATA NPB /"14,"40/ !forces new page FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00041 PUT FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01445 00037 .PAGE 01446 00037 01447 00038 LENB(1) = STRING(1) 01448 00039 LENB(2) = STRING(2) 01449 00039 01450 00040 WHEN (IOCLAS.EQ.1) 01451 00045 . IF (FORT.AND.PASFLG) OUTPUT-FORT 01452 00045 ...FIN 01453 00046 ELSE 01454 00047 . IF (LIST) 01455 00047 . . CONDITIONAL 01456 00050 . . . (FLLON) OUTPUT-LIST 01457 00052 . . . (LICHNG) 01458 00053 . . . . LICHNG=.FALSE. 01459 00055 . . . . OUTPUT-LIST 01460 00055 . . . ...FIN 01461 00057 . . ...FIN!conditional 01462 00057 . ...FIN!if 01463 00058 ...FIN 01464 00060 RETURN FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00042 PUT FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01465 00060 .PAGE ---------------------------------------- 01466 00061 TO OUTPUT-FORT 01467 00061 . 01468 00062 . NUMLIN=NUMLIN+1 !one more FORT line output 01469 00062 . 01470 00065 . DO (I = 3,LEN+2) OUTF(I-2) = STRING(I) !Get the string 01471 00066 . IF (LEN.LT.72) !blank fill if necessary 01472 00069 . . DO (I = LEN+1,72) OUTF(I) = ' ' 01473 00069 . ...FIN 01474 00070 . 01475 00070 . .PASSIF ALECS 01477 00070 . .PASSEND 01478 00070 . 01479 00070 C . For compatibility with the old version of FLECS, 01480 00070 C . we put out 80 bytes even though only 78 are used (last 01481 00070 C . two bytes are nulls). 01482 00070 . 01483 00071 . CALL PUTNUM (OUTF(73-2),LINENO) !append input line # 01484 00071 . 01485 00072 . OUTF(78) = ' ' 01486 00073 . OUTF(79)=0 01487 00074 . OUTF(80)=0 01488 00074 . 01489 00075 . CALL FPUT (IOCLAS,OUTF,80) !write to file 01490 00075 ...FIN FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00043 PUT FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01491 00076 .PAGE ---------------------------------------- 01492 00077 TO OUTPUT-LIST 01493 00077 . 01494 00078 . IF (STRING(3).EQ."14) !FF? 01495 00079 . . LINCNT=0 !yes, new page 01496 00080 . . STRING(3) = (1H ) !overwrite it 01497 00080 . ...FIN!if 01498 00081 . 01499 00082 . IF (LINCNT.EQ.0) 01500 00083 . . PAGENO = PAGENO + 1 01501 00085 . . WHEN (PAGENO.EQ.1) P1(2) = ' ' 01502 00088 . . ELSE P1(2) = NP 01503 00088 . . 01504 00089 . . CALL PUTNUM (P1(29),PAGENO) 01505 00090 . . CALL FPUT (IOCLAS,P1(2),P1(1)) 01506 00091 . . CALL FPUT (IOCLAS,P2(2),P2(1)) 01507 00092 . . LINCNT = -55 01508 00092 . ...FIN 01509 00093 . 01510 00096 . DO (I = 1,18) OUTPUT(I) = ' ' 01511 00096 . 01512 00097 . IF (INCLVL.GT.0) 01513 00099 . . WHEN (INCSTR) INCSTR=.FALSE. 01514 00102 . . ELSE OUTPUT(2) = '*' 01515 00102 . ...FIN!if 01516 00103 . 01517 00104 . IF(LINENO.NE.0) 01518 00105 . . IF(LINENO.LT.0) OUTPUT(2) = 'E' 01519 00106 . . CALL PUTNUM (OUTPUT(1),IABS(LINENO)) 01520 00107 . . CALL PUTNUM (OUTPUT(9),NUMLIN) 01521 00107 . ...FIN!if 01522 00108 . 01523 00111 . DO (I = 3,LEN+2) OUTPUT(I+16) = STRING(I) 01524 00112 . CALL FPUT (IOCLAS,OUTPUT,LEN+18) 01525 00113 . LINCNT = LINCNT + 1 01526 00113 ...FIN 01527 00115 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 01466 OUTPUT-FORT 01451 01492 OUTPUT-LIST 01456 01459 (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00044 ROPN FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01528 00000 .NAME ROPN 01529 00000 C;+ 01530 00000 C - R O P N 01531 00000 C****NAME: SUBROUTINE ROPN 01532 00000 C FILE: FILE.FLX 01533 00000 C 01534 00000 C****PURPOSE: Open previous level .INCLUDE file 01535 00000 C 01536 00000 C****RESTRICTIONS: 01537 00000 C 01538 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 01539 00000 C LANGUAGE: FLECS/F77 01540 00000 C AUTHOR: M. OOTHOUDT 01541 00000 C DATE: 29-JUN-81 01542 00000 C REVISIONS: 01543 00000 C 850213MAO CONVERT MACRO TO FLECS 01544 00000 C 01545 00000 C****CALLING SEQUENCE: CALL ROPN (CLS) 01546 00000 C 01547 00000 C INPUT: 01548 00000 C 01549 00000 C CLS = (L*2) .T. if should close current include level. 01550 00000 C 01551 00000 C OUTPUT: None 01552 00000 C 01553 00000 C CMN BLOCK I/O: /INCDAT/, /FILDAT/ 01554 00000 C 01555 00000 C RESOURCES: 01556 00000 C LIBRARIES: None 01557 00000 C OTHER SUBR: FROPN 01558 00000 C DISK FILES: INCLUDE FILE 01559 00000 C DEVICES: DISK FILES 01560 00000 C SGAS: NONE 01561 00000 C EVENT FLAGS: NONE 01562 00000 C SYSTEM DIR: NONE 01563 00000 C 01564 00000 C****NOTES: 01565 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00045 ROPN FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01566 00000 .PAGE 01567 00001 SUBROUTINE ROPN (CLS) 01568 00001 01569 00001 .PASSIF VAX 01570 00001 .INCLUDE [MP1Q.FLEALECOM]FILDAT.INC *01571 00001 C FILDAT.INC 850226 Define stuff for FILE.FLX subr *01572 00001 *01573 00002 BYTE DAT(9) !date in ASCII *01574 00003 LOGICAL*2 FLLON !.T. if output to FLL file on *01575 00004 LOGICAL*2 FORT !.T. if fort output desired *01576 00005 BYTE FVER(21) !ASCII FLECS version ident *01577 00006 INTEGER*2 LINCNT !# lines left for current page *01578 00007 BYTE LINE(106) !task command line *01579 00008 LOGICAL*2 LIST !.T. if listing output desired *01580 00009 BYTE NAMEHD(6) !ASCII char from .NAME directive *01581 00010 INTEGER*2 P1(33) !Page header string, line 1 *01582 00011 INTEGER*2 P2(59) !Page header string, line 2 *01583 00012 INTEGER*2 PAGENO !current FLL page # *01584 00013 LOGICAL*2 SPON !state of /SP switch *01585 00014 BYTE TIM(8) !time in ASCII *01586 00014 *01587 00015 COMMON /FILES/ PAGENO,LINCNT,FORT,LIST, *01588 00016 1 SPON,FLLON,P1,P2 *01589 00016 *01590 00017 EQUIVALENCE (P1(3),FVER(1)),(P1(16),DAT(1)),(P1(22),TIM(1)) *01591 00018 EQUIVALENCE (P2(3),NAMEHD(1)),(P2(7),LINE(1)) *01592 00018 C END-OF-FILE FILDAT.INC 01593 00018 .INCLUDE [MP1Q.FLEALECOM]INCDAT.INC *01594 00018 C INCDAT.INC 850213 Define stuff for include files *01595 00018 *01596 00019 INTEGER*2 NUMINC !max depth include files *01597 00019 *01598 00020 PARAMETER (NUMINC=3) *01599 00020 *01600 00021 LOGICAL*2 FLLONS(0:NUMINC) !saved values of FLLON *01601 00022 INTEGER*2 INCLVL !.INCLUDE level now at (0-->main) *01602 00023 LOGICAL*2 INCSTR !.T. if just read .inc from main level *01603 00024 !(prevents * on that line) *01604 00025 LOGICAL*2 LICHNG !.T. if should ignore FLLON *01605 00025 *01606 00026 COMMON /INCDAT/ FLLONS,INCLVL,INCSTR,LICHNG *01607 00026 *01608 00026 C END-OF-FILE INCDAT.INC 01609 00026 .PASSEND 01610 00026 .PASSIF PDP 01613 00026 .PASSEND 01614 00026 01615 00026 C Local variables 01616 00026 01617 00027 LOGICAL*2 CLS 01618 00027 01619 00028 INCLVL = INCLVL - 1 !back to previous level 01620 00028 01621 00029 FLLON = FLLONS(INCLVL) !/LI setting for that level 01622 00029 FLECS VERSION 860214 27-MAR-87 11:27:27 PAGE 00046 ROPN FILE,FILE/-SP=[MP1Q.FLEALECOM]FILE/CO:FLECS:VAX 01623 00030 CALL FROPN (INCLVL,CLS) !tell macro code what level 01624 00031 !to read from 01625 00032 RETURN 01626 00033 END (FLECS VERSION 22.38)