(FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00001 ---------------------------------------- 00001 PROGRAM FLECS 00002 C 00003 C MARK F. LEWIS 00004 C 11-JAN-79 00005 C 00006 C THIS PROGRAM IMPLEMENTS THE FLECS PROGRAM AS A PDS-TYPE 00007 C COMMAND WITH THE FOLLOWING FORMAT: 00008 C 00009 C FLEcs/qualifiers filespec 00010 C /FORTRAN[:fortranfile] (default) 00011 C /NOFORTRAN 00012 C /KEEP (default) 00013 C /NOKEEP Do not keep intermediate files 00014 C /LIST[:listfile] 00015 C /NOLIST (default) 00016 C /OBJECT[:objectfile] (default) 00017 C /NOOBJECT 00018 C /RUN (default) 00019 C /NORUN 00020 C /SWITCHES:(/switchlist) 00021 C /TASK[:taskfile] (default) 00022 C /NOTASK 00023 C 00024 C switches -- /CK/CO:n/DE/ID/I4/LA/LI:n/TR:xxx 00025 C 00026 C THE PROGRAM IS INSTALLED AS SYSTEM TASK $$$FLE AND EXPECTS TO FIND 00027 C THE FLECS PROCESSOR INSTALLED AS TASK ...FLE. THE LATTER HAS BEEN 00028 C MODIFIED TO EXIT WITH STATUS. OTHER TASKS EXPECTED TO BE FOUND 00029 C ARE ...FOR (EITHER FORTRAN) AND ...TKB. 00030 C 00031 IMPLICIT INTEGER (A-Z) 00032 BYTE COMMND(160),FILE(34),FFILE(34),LFILE(34),OFILE(34) 00033 BYTE TFILE(34),FLECOM(120),FORCOM(120),TKBCOM(120) 00034 BYTE SWITCH(40),FTN(3),FLE(3),FLL(3),LST(3),OBJ(3) 00035 BYTE FOR(3),TAS(3),CMD(3),TKB(12),LPAR,RPAR,ATS,SPL(4) 00036 INTEGER IEXIT(6) 00037 DATA LISQ /1/ 00038 DATA NOLQ /2/ 00039 DATA FTNQ /3/ 00040 DATA NOFQ /4/ 00041 DATA OBJQ /5/ 00042 DATA NOBQ /6/ 00043 DATA KEEQ /7/ 00044 DATA NOKQ /8/ 00045 DATA SWIQ /9/ 00046 DATA NOSQ /10/ 00047 DATA LNKQ /11/ 00048 DATA NLNQ /12/ 00049 DATA RUNQ /13/ 00050 DATA NORQ /14/ 00051 DATA SPL /'/','-','S','P'/ 00052 DATA FTN/'F','T','N'/ 00053 DATA FLE/'F','L','E'/ (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00002 00054 DATA FLL/'F','L','L'/ 00055 DATA LST/'L','S','T'/ 00056 DATA OBJ/'O','B','J'/ 00057 DATA FOR/'F','O','R'/ 00058 DATA TAS/'T','S','K'/ 00059 DATA CMD/'C','M','D'/ 00060 DATA TKB/'T','K','B',' ','@','F','L','E','.','T','M','P'/ 00061 DATA LPAR/1H(/ 00062 DATA RPAR/1H)/ 00063 DATA ATS/1H@/ 00064 DATA FILEN/0/ 00065 DATA DOT/0/ 00066 DATA LILEN/0/ 00067 DATA FTLEN/0/ 00068 DATA TABLEN/0/ 00069 DATA OBLEN/0/ 00070 DATA SWLEN/0/ 00071 DATA WARN/0/ 00072 DATA SUCC/1/ 00073 DATA EROR/2/ 00074 DATA SEVR/4/ 00075 C 00076 C FIRST WE GET A COMMAND LINE. 00077 C NOTE: WE CANNOT USE GCML BECAUSE WE DO NOT WANT THIS PROGRAM TO 00078 C PROMPT THE USER. WE ONLY WANT A COMMAND LINE FROM PDS. 00079 C THE PROVIDED GETMCR SUBROUTINE IS A DOG, SO WE'LL USE OUR 00080 C OWN TO DO THE SAME THING 00081 C 00082 SET-DEFAULTS 00083 CALL GETLIN(COMMND,COMLEN) 00084 C 00085 C HAVING OBTAINED A COMMAND LINE WE FIRST HAVE TO MAKE SURE IT 00086 C IS COMPLETE. THIS MEANS PROCESSING CONTINUATION INDICATORS ('-' AS 00087 C LAST CHARACTER IN LINE) AND INDIRECT INDICATORS ('@' ANYWHERE IN THE 00088 C LINE). WE WILL ASSEMBLE ONE COMMAND LINE, WHICH MIGHT BE QUITE 00089 C LONG. FOR NOW, WE ALLOW 160 CHARACTERS FOR THE LINE. 00090 C N.B.: WE COULD HAVE SIMPLY CHECKED THE LINE FOR THE 00091 C PRESENCE OF AN EQUALS SIGN, AN ILLEGAL CHARACTER IN PDS-TYPE 00092 C COMMANDS, AND IF PRESENT, ASSUMED THE LINE WAS IN MCR SYNTAX 00093 C AND SIMPLY PASSED IT TO ...FLE. THIS WOULD LET OLD USERS 00094 C CONTINUE TO USE EXISTING COMMAND FILES WITHOUT RE-EDITING. 00095 C 00096 LUN=5 00097 CONTU=.TRUE. 00098 REPEAT UNTIL (.NOT.CONTU) CHECK-FOR-CONTINUATION 00099 INDIR=.TRUE. 00100 REPEAT UNTIL (.NOT.INDIR) CHECK-FOR-INDIRECT 00101 C 00102 C THE LINE IS AS COMPLETE AS IT WILL GET. WE NOW CALL SUBROUTINE PARSE 00103 C WITH MODE=1 TO OBTAIN THE SOURCE FILE NAME. 00104 CALL PARSE(1,COMMND,1,COMLEN,FILE,FILEN,FLE,DOT) 00105 IF (FILEN.EQ.0) 00106 . WRITE(5,99) 00107 99 . FORMAT(' Required parameter not specified',/, 00108 1. ' Command terminated') 00109 . CALL QEXIT (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00003 00110 ...FIN 00111 IF ((FILEN-DOT).LE.0) 00112 . WRITE(5,71)(FILE(J),J=1,FILEN) 00113 71 . FORMAT(1H ,A1,' -- Illegal file-specification') 00114 . CALL QEXIT 00115 ...FIN 00116 C NOW DELETE ALL SPACES FROM THE LINE 00117 CALL SPACE(COMMND,COMLEN) 00118 INDEX=0 00119 REPEAT UNTIL (INDEX.EQ.COMLEN) 00120 . CALL SLASH(COMMND,COMLEN,INDEX) 00121 . IF (INDEX.GT.0.AND.INDEX.NE.COMLEN) 00122 . . START=INDEX+1 00123 . . CALL SLASH(COMMND,COMLEN,INDEX) 00124 . . IF (INDEX.EQ.0) STOP=COMLEN 00125 . . IF (INDEX.NE.0) 00126 . . . IF (INDEX.EQ.COMLEN) STOP=INDEX 00127 . . . IF (INDEX.NE.COMLEN) STOP=INDEX-1 00128 . . . INDEX=START 00129 . . ...FIN 00130 . . XLEN=STOP-START+1 00131 . . IF (XLEN.LE.0) 00132 . . . WRITE(5,98)(COMMND(J),J=1,STOP) 00133 98 . . . FORMAT(1H ,A1,' -- Invalid qualifier') 00134 . . . CALL QEXIT 00135 . . ...FIN 00136 C WE HAVE A QUALIFER DELIMITED BY START AND STOP 00137 C WHAT IS IT? 00138 . . DECODE-QUALIFIER 00139 . . SELECT (QUALIF) 00140 . . . (LISQ) LIST-FLAG 00141 . . . (NOLQ) LIFLAG=.FALSE. 00142 . . . (FTNQ) FTN-FLAG 00143 . . . (NOFQ) 00144 . . . . FTFLAG=.FALSE. 00145 . . . . OBFLAG=.FALSE. 00146 . . . . LNFLAG=.FALSE. 00147 . . . . RUFLAG=.FALSE. 00148 . . . . LIFLAG=.TRUE. 00149 . . . ...FIN 00150 . . . (OBJQ) OBJ-FLAG 00151 . . . (NOBQ) 00152 . . . . OBFLAG=.FALSE. 00153 . . . . LNFLAG=.FALSE. 00154 . . . . RUFLAG=.FALSE. 00155 . . . ...FIN 00156 . . . (KEEQ) KEFLAG=.TRUE. 00157 . . . (NOKQ) KEFALG=.FALSE. 00158 . . . (SWIQ) SWITCH-FLAG 00159 . . . (NOSQ) SWFLAG=.FALSE. 00160 . . . (LNKQ) LINK-FLAG 00161 . . . (NLNQ) 00162 . . . . LNFLAG=.FALSE. 00163 . . . . RUFLAG=.FALSE. 00164 . . . ...FIN 00165 . . . (RUNQ) RUFLAG=.TRUE. (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00004 00166 . . . (NORQ) RUFLAG=.FALSE. 00167 . . . (OTHERWISE) 00168 . . . . WRITE(5,11)(COMMND(Z),Z=START,STOP) 00169 11 . . . . FORMAT(1H ,A1,' -- Unrecognized qualifier ignored') 00170 . . . ...FIN 00171 . . ...FIN 00172 . ...FIN 00173 ...FIN 00174 CALL DECTDB(1,IERR) 00175 IF (IERR.LT.0)SUBTASK-ERROR 00176 PRODUCE-FLECS-LINE 00177 PRODUCE-FORTRAN-LINE 00178 PRODUCE-TKB-LINE 00179 RUN-FLECS 00180 IF (FTFLAG)RUN-FORTRAN 00181 IF (OBFLAG.AND.LNFLAG) RUN-LINK 00182 IF (RUFLAG)RUN-TASK 00183 CALL EXIT(ISTAT) 00184 C 00185 C ---------------------------------------- 00186 TO DECODE-QUALIFIER 00187 C . 00188 C NOTE: AT THIS TIME WE SIMPLY TEST THE FIRST CHARACTER (OR FIRST 3 00189 C . CHARS IF FIRST 2 ARE 'NO') TO DETERMINE WHAT THE QUALIFIER IS. 00190 C . FOR A PERFECT MACTH TO THE BEHAVIOR OF PDS, WE SHOULD MAKE SURE 00191 C . ALL THE CHARACTERS SUPPLIED MATCH A QUALIFIER AND REPORT 00192 C "-- Invalid qualifier" IF ANYTHING IS MISSPELLED. 00193 C . THAT KIND OF PERFECTION SEEMS UNREASONABLE AND A GREAT WASTE OF 00194 C . SPACE AND TIME. 00195 C . 00196 . QUALIF=0 00197 . J=START 00198 . IF (COMMND(J).EQ.'L') QUALIF=LISQ 00199 . IF (COMMND(J).EQ.'T') QUALIF=LNKQ 00200 . IF (COMMND(J).EQ.'F') QUALIF=FTNQ 00201 . IF (COMMND(J).EQ.'O') QUALIF=OBJQ 00202 . IF (COMMND(J).EQ.'K') QUALIF=KEEQ 00203 . IF (COMMND(J).EQ.'S') QUALIF=SWIQ 00204 . IF (COMMND(J).EQ.'R') QUALIF=RUNQ 00205 . IF (COMMND(J).EQ.'N'.AND.COMMND(J+1).EQ.'O') 00206 . . IF (COMMND(J+2).EQ.'L') QUALIF=NOLQ 00207 . . IF (COMMND(J+2).EQ.'T') QUALIF=NLNQ 00208 . . IF (COMMND(J+2).EQ.'F') QUALIF=NOFQ 00209 . . IF (COMMND(J+2).EQ.'O') QUALIF=NOBQ 00210 . . IF (COMMND(J+2).EQ.'K') QUALIF=NOKQ 00211 . . IF (COMMND(J+2).EQ.'S') QUALIF=NOSQ 00212 . . IF (COMMND(J+2).EQ.'R') QUALIF=NORQ 00213 . ...FIN 00214 ...FIN 00215 C 00216 C ---------------------------------------- (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00005 00217 TO LIST-FLAG 00218 . LIFLAG=.TRUE. 00219 . FIND-COLON 00220 . IF (COLON.NE.0) 00221 . . SPOOL=.FALSE. 00222 . . CALL PARSE(2,COMMND,COLON,STOP,LFILE,LILEN,FLL,DOTL) 00223 . . IF (LILEN.EQ.0) 00224 . . . WRITE(5,98)(COMMND(J),J=1,STOP) 00225 . . . CALL QEXIT 00226 . . ...FIN 00227 . ...FIN 00228 . IF (COLON.EQ.0)DEFAULT-LIST 00229 . IF ((LILEN-DOTL).LE.0) 00230 . . WRITE(5,72)(LFILE(J),J=1,LILEN) 00231 72 . . FORMAT(1H ,A1,'-- Illegal file-specification') 00232 . . CALL QEXIT 00233 . ...FIN 00234 ...FIN 00235 C 00236 C ---------------------------------------- 00237 TO DEFAULT-LIST 00238 . SPOOL=.TRUE. 00239 . LILEN=FILEN 00240 . DO (J=1,FILEN)LFILE(J)=FILE(J) 00241 . DO (J=DOT+1,DOT+3)LFILE(J)=FLL(J-DOT) 00242 . LILEN=DOT+3 00243 . DOTL=DOT 00244 ...FIN 00245 C 00246 C ---------------------------------------- 00247 TO FIND-COLON 00248 . COLON=0 00249 . J=START 00250 . REPEAT UNTIL (J.EQ.STOP.OR.COLON.NE.0) 00251 . . J=J+1 00252 . . IF (COMMND(J).EQ.':')COLON=J 00253 . ...FIN 00254 ...FIN 00255 C 00256 C ---------------------------------------- 00257 TO FTN-FLAG 00258 . FTFLAG=.TRUE. 00259 . FIND-COLON 00260 . IF (COLON.NE.0) 00261 . . CALL PARSE(2,COMMND,COLON,STOP,FFILE,FTLEN,FTN,DOTF) 00262 . . IF (FTLEN.EQ.0) (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00006 00263 . . . WRITE(5,98)(COMMND(J),J=1,STOP) 00264 . . . CALL QEXIT 00265 . . ...FIN 00266 . ...FIN 00267 . IF (COLON.EQ.0)DEFAULT-FTN 00268 . IF ((FTLEN-DOTF).LE.0) 00269 . . WRITE(5,73)(FFILE(J),J=1,FTLEN) 00270 73 . . FORMAT(1H ,A1,' -- Illegal file-specification') 00271 . . CALL QEXIT 00272 . ...FIN 00273 ...FIN 00274 C 00275 C ---------------------------------------- 00276 TO DEFAULT-FTN 00277 . FTLEN=FILEN 00278 . DO (J=1,FILEN)FFILE(J)=FILE(J) 00279 . DO (J=DOT+1,DOT+3)FFILE(J)=FTN(J-DOT) 00280 . FTLEN=DOT+3 00281 ...FIN 00282 C 00283 C ---------------------------------------- 00284 TO LINK-FLAG 00285 . LNFLAG=.TRUE. 00286 . FIND-COLON 00287 . IF (COLON.NE.0) 00288 . . CALL PARSE(2,COMMND,COLON,STOP,TFILE,TALEN,TAS,DOTT) 00289 . . IF (TALEN.EQ.0) 00290 . . . WRITE(5,98)(COMMND(J),J=1,STOP) 00291 . . . CALL QEXIT 00292 . . ...FIN 00293 . ...FIN 00294 . IF (COLON.EQ.0)DEFAULT-LINK 00295 . IF ((TALEN-DOTT).LE.0) 00296 . . WRITE(5,74)(TFILE(J),J=1,TALEN) 00297 74 . . FORMAT(1H ,A1,' -- Illegal file-specification') 00298 . . CALL QEXIT 00299 . ...FIN 00300 ...FIN 00301 C 00302 C ---------------------------------------- 00303 TO DEFAULT-LINK 00304 . TALEN=FILEN 00305 . DO (J=1,FILEN)TFILE(J)=FILE(J) 00306 . DO (J=DOT+1,DOT+3)TFILE(J)=TAS(J-DOT) 00307 . TALEN=DOT+3 00308 ...FIN 00309 C (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00007 00310 C ---------------------------------------- 00311 TO OBJ-FLAG 00312 . OBFLAG=.TRUE. 00313 . FIND-COLON 00314 . IF (COLON.NE.0) 00315 . . CALL PARSE(2,COMMND,COLON,STOP,OFILE,OBLEN,OBJ,DOTO) 00316 . . IF (OBLEN.EQ.0) 00317 . . . WRITE(5,98)(COMMND(J),J=1,STOP) 00318 . . . CALL QEXIT 00319 . . ...FIN 00320 . ...FIN 00321 . IF (COLON.EQ.0)DEFAULT-OBJ 00322 . IF ((OBLEN-DOTO).LE.0) 00323 . . WRITE(5,75)(OFILE(J),J=1,OBLEN) 00324 75 . . FORMAT(1H ,A1,' -- Illegal file-specification') 00325 . . CALL QEXIT 00326 . ...FIN 00327 ...FIN 00328 C 00329 C ---------------------------------------- 00330 TO DEFAULT-OBJ 00331 . OBLEN=FILEN 00332 . DO (J=1,FILEN)OFILE(J)=FILE(J) 00333 . DO (J=DOT+1,DOT+3)OFILE(J)=OBJ(J-DOT) 00334 . OBLEN=DOT+3 00335 ...FIN 00336 C 00337 C ---------------------------------------- 00338 TO SWITCH-FLAG 00339 . FIND-COLON 00340 . IF (COLON.NE.0) 00341 . . SWFLAG=.TRUE. 00342 . . J=COLON 00343 . . X=COLON 00344 . . REPEAT UNTIL (J.EQ.STOP.OR.X.NE.COLON) 00345 . . . J=J+1 00346 . . . IF (COMMND(J).EQ.LPAR)X=J+1 00347 . . ...FIN 00348 . . J=X 00349 . . Y=X 00350 . . REPEAT UNTIL (J.EQ.STOP.OR.Y.NE.X) 00351 . . . J=J+1 00352 . . . WHEN (COMMND(J).EQ.RPAR)Y=J-1 00353 . . . ELSE IF (J.EQ.STOP) Y =J 00354 . . ...FIN 00355 . . SWLEN=Y-X+1 00356 . ...FIN (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00008 00357 . WHEN (SWLEN.GT.40.OR.SWLEN.LE.0.OR.COLON.EQ.0) 00358 . . WRITE(5,92)(COMMND(J),J=START,STOP) 00359 92 . . FORMAT(1H ,A1,' -- Invalid qualifier value ignored') 00360 . . ISTAT=0 00361 . . SWFLAG=.FALSE. 00362 . ...FIN 00363 . ELSE 00364 . . DO (J=1,40)SWITCH(J)=0 00365 . . DO (J=X,Y)SWITCH(J-X+1)=COMMND(J) 00366 . ...FIN 00367 ...FIN 00368 C 00369 C ---------------------------------------- 00370 TO RUN-FLECS 00371 . DO (J=1,80)COMMND(J)=0 00372 . DO (J=1,FLELEN)COMMND(J)=FLECOM(J) 00373 . RUN-SUBTASK 00374 . IF (SPOOL) 00375 . . OPEN(UNIT=1,NAME=LFILE,TYPE='OLD',DISPOSE='PRINT') 00376 . . CLOSE(UNIT=1) 00377 . ...FIN 00378 . IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00379 ...FIN 00380 C 00381 C ---------------------------------------- 00382 TO RUN-FORTRAN 00383 . DO (J=1,80)COMMND(J)=0 00384 . DO (J=1,FORLEN)COMMND(J)=FORCOM(J) 00385 . RUN-SUBTASK 00386 . IF (SPOOL) 00387 . . OPEN(UNIT=1,NAME=LFILE,TYPE='OLD',DISPOSE='PRINT') 00388 . . CLOSE(UNIT=1) 00389 . ...FIN 00390 . IF (.NOT.KEFLAG) 00391 . . OPEN(UNIT=1,NAME=FFILE,TYPE='OLD',DISPOSE='DELETE') 00392 . . CLOSE(UNIT=1) 00393 . ...FIN 00394 . IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00395 ...FIN 00396 C 00397 C ---------------------------------------- 00398 TO RUN-LINK 00399 . DO (J=1,80)COMMND(J)=0 00400 . DO (J=1,12)COMMND(J)=TKB(J) 00401 . RUN-SUBTASK 00402 . OPEN(UNIT=1,NAME='FLE.TMP',TYPE='OLD',DISPOSE='DELETE') 00403 . CLOSE(UNIT=1) (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00009 00404 . IF (.NOT.KEFLAG) 00405 . . OPEN(UNIT=1,NAME=OFILE,TYPE='OLD',DISPOSE='DELETE') 00406 . . CLOSE(UNIT=1) 00407 . ...FIN 00408 . IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00409 ...FIN 00410 C 00411 C ---------------------------------------- 00412 TO RUN-TASK 00413 . DO (J=1,160)COMMND(J)=0 00414 . COMMND(1)=' ' 00415 . NEXT=2 00416 . DO (J=NEXT,NEXT+TALEN-1)COMMND(J)=TFILE(J-NEXT+1) 00417 . CALL CHAIN(COMMND,1) 00418 ...FIN 00419 C 00420 C ---------------------------------------- 00421 TO SUBTASK-ERROR 00422 . WRITE(5,70) 00423 70 . FORMAT(' Fatal subtask error') 00424 . CALL EXIT(4) 00425 ...FIN 00426 C 00427 C ---------------------------------------- 00428 TO RUN-SUBTASK 00429 . CALL RUNTS(COMMND,1,2,,,IERR) 00430 . IF (IERR.LT.0)SUBTASK-ERROR 00431 . CALL CHKEVW(1,IERR) 00432 . IF (IERR.LT.0)SUBTASK-ERROR 00433 . CALL RDEVTS(XRAY,1,IERR,IEXIT) 00434 . IF (IERR.LT.0.OR.(XRAY.GT.1.AND.XRAY.LT.8))SUBTASK-ERROR 00435 . IF ((IEXIT(4).AND.2).NE.0)ISTAT=4 00436 . IF ((IEXIT(4).AND.1).NE.0)ISTAT=IEXIT(6) 00437 ...FIN 00438 C 00439 C ---------------------------------------- 00440 TO CHECK-FOR-INDIRECT 00441 . INDIR=.FALSE. 00442 . UNLESS (COMLEN.LT.4) 00443 . . J=0 00444 . . REPEAT UNTIL (INDIR.OR.J.EQ.COMLEN) 00445 . . . J=J+1 00446 . . . IF (COMMND(J).EQ.ATS) INDIR=.TRUE. 00447 . . ...FIN (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00010 00448 . . IF (INDIR) 00449 . . . CALL PARSE(2,COMMND,J,COMLEN,FILE,FILEN,CMD,DOT) 00450 . . . OPEN(UNIT=1,NAME=FILE,TYPE='OLD',READONLY) 00451 . . . READ(1,50)K,(COMMND(L),L=J,J+K-1) 00452 50 . . . FORMAT(Q,80A1) 00453 . . . WRITE(5,51)(COMMND(L),L=J,J+K-1) 00454 51 . . . FORMAT(1H ,80A1) 00455 . . . FILEN=0 00456 . . . DOT=0 00457 . . . COMLEN=J+K-1 00458 . . . LUN=1 00459 . . . CONTU=.TRUE. 00460 . . . REPEAT UNTIL (.NOT.CONTU) CHECK-FOR-CONTINUATION 00461 . . . CLOSE(UNIT=1) 00462 . . ...FIN 00463 . ...FIN 00464 ...FIN 00465 C 00466 C ---------------------------------------- 00467 TO CHECK-FOR-CONTINUATION 00468 . CONTU=.FALSE. 00469 . IF (COMMND(COMLEN).EQ.'-') 00470 . . IF (LUN.EQ.5) 00471 . . . WRITE(LUN,60) 00472 60 . . . FORMAT('$>') 00473 . . ...FIN 00474 . . J=COMLEN 00475 . . READ(LUN,50)K,(COMMND(L),L=J,J+K-1) 00476 . . IF (LUN.EQ.1)WRITE(5,51)(COMMND(L),L=J,J+K-1) 00477 . . COMLEN=J+K-1 00478 . . CONTU=.TRUE. 00479 . ...FIN 00480 ...FIN 00481 C 00482 C ---------------------------------------- 00483 TO SET-DEFAULTS 00484 . LIFLAG=.FALSE. 00485 . FTFLAG=.TRUE. 00486 . OBFLAG=.TRUE. 00487 . SWFLAG=.FALSE. 00488 . KEFLAG=.TRUE. 00489 . LNFLAG=.TRUE. 00490 . RUFLAG=.TRUE. 00491 . ISTAT=SUCC 00492 ...FIN 00493 C 00494 C ---------------------------------------- (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00011 00495 TO PRODUCE-FLECS-LINE 00496 . IF (.NOT.FTFLAG.AND..NOT.LIFLAG) 00497 . . WRITE(5,91)(COMMND(J),J=1,COMLEN) 00498 91 . . FORMAT(1H ,A1,' -- Conflicting qualifiers') 00499 . . CALL QEXIT 00500 . ...FIN 00501 . DO (J=1,120)FLECOM(J)=0 00502 . DO (J=1,3)FLECOM(J)=FLE(J) 00503 . FLECOM(4)=' ' 00504 . FLELEN=5 00505 . IF (FTFLAG) 00506 . . IF (FTLEN.LE.0)DEFAULT-FTN 00507 . . DO (J=FLELEN,FLELEN+FTLEN-1)FLECOM(J)=FFILE(J-FLELEN+1) 00508 . . FLELEN=FLELEN+FTLEN 00509 . ...FIN 00510 . IF (LIFLAG) 00511 . . FLECOM(FLELEN)=',' 00512 . . FLELEN=FLELEN+1 00513 . . IF (LILEN.LE.0)DEFAULT-LIST 00514 . . DO (J=FLELEN,FLELEN+LILEN-1)FLECOM(J)=LFILE(J-FLELEN+1) 00515 . . FLELEN=FLELEN+LILEN 00516 . ...FIN 00517 . FLECOM(FLELEN)='=' 00518 . FLELEN=FLELEN+1 00519 . DO (J=FLELEN,FLELEN+FILEN-1)FLECOM(J)=FILE(J-FLELEN+1) 00520 . FLELEN=FLELEN+FILEN-1 00521 ...FIN 00522 C 00523 C ---------------------------------------- 00524 TO PRODUCE-FORTRAN-LINE 00525 . IF (FTFLAG) 00526 . . DO (J=1,120)FORCOM(J)=0 00527 . . DO (J=1,3) FORCOM(J)=FOR(J) 00528 . . FORCOM(4)=' ' 00529 . . FORLEN=5 00530 . . IF (OBFLAG) 00531 . . . IF (OBLEN.LE.0)DEFAULT-OBJ 00532 . . . DO (J=FORLEN,FORLEN+OBLEN-1)FORCOM(J)=OFILE(J-FORLEN+1) 00533 . . . FORLEN=FORLEN+OBLEN 00534 . . ...FIN 00535 . . IF (LIFLAG) 00536 . . . FORCOM(FORLEN)=',' 00537 . . . FORLEN=FORLEN+1 00538 . . . DO (J=DOTL+1,DOTL+3)LFILE(J)=LST(J-DOTL) 00539 . . . DO (J=FORLEN,FORLEN+LILEN-1)FORCOM(J)=LFILE(J-FORLEN+1) 00540 . . . FORLEN=FORLEN+LILEN 00541 . . . DO (J=FORLEN,FORLEN+3)FORCOM(J)=SPL(J-FORLEN+1) 00542 . . . FORLEN=FORLEN+4 00543 . . ...FIN 00544 . . FORCOM(FORLEN)='=' 00545 . . FORLEN=FORLEN+1 00546 . . DO (J=FORLEN,FORLEN+FTLEN-1)FORCOM(J)=FFILE(J-FORLEN+1) 00547 . . FORLEN=FORLEN+FTLEN (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00012 00548 . . IF (SWFLAG) 00549 . . . DO (J=FORLEN,FORLEN+SWLEN-1)FORCOM(J)=SWITCH(J-FORLEN+1) 00550 . . . FORLEN=FORLEN+SWLEN 00551 . . ...FIN 00552 . . FORLEN=FORLEN-1 00553 . ...FIN 00554 ...FIN 00555 C 00556 C ---------------------------------------- 00557 TO PRODUCE-TKB-LINE 00558 . DO (J=1,120)TKBCOM(J)=0 00559 . TKBLEN=1 00560 . IF (TALEN.LE.0)DEFAULT-LINK 00561 . DO (J=TKBLEN,TKBLEN+TALEN-1)TKBCOM(J)=TFILE(J-TKBLEN+1) 00562 . TKBLEN=TKBLEN+TALEN 00563 . TKBCOM(TKBLEN)='=' 00564 . TKBLEN=TKBLEN+1 00565 . DO (J=TKBLEN,TKBLEN+OBLEN-1)TKBCOM(J)=OFILE(J-TKBLEN+1) 00566 . TKBLEN=TKBLEN+OBLEN 00567 . OPEN(UNIT=1,NAME='FLE.TMP',TYPE='NEW') 00568 . WRITE(1,30)(TKBCOM(J),J=1,TKBLEN-1) 00569 30 . FORMAT(A1) 00570 . WRITE(1,31) 00571 31 . FORMAT('/') 00572 . WRITE(1,32) 00573 32 . FORMAT('LIBR=SYSRES:RO') 00574 . WRITE(1,33) 00575 33 . FORMAT('//') 00576 . CLOSE(UNIT=1) 00577 . IF ((TKBLEN-1).GT.80) 00578 . . WRITE(5,35) 00579 35 . . FORMAT(' Command too long') 00580 . . CALL QEXIT 00581 . ...FIN 00582 ...FIN 00583 C 00584 C 00585 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00467 CHECK-FOR-CONTINUATION 00098 00460 00440 CHECK-FOR-INDIRECT 00100 00186 DECODE-QUALIFIER 00138 00276 DEFAULT-FTN (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00013 00267 00506 00303 DEFAULT-LINK 00294 00560 00237 DEFAULT-LIST 00228 00513 00330 DEFAULT-OBJ 00321 00531 00247 FIND-COLON 00219 00259 00286 00313 00339 00257 FTN-FLAG 00142 00284 LINK-FLAG 00160 00217 LIST-FLAG 00140 00311 OBJ-FLAG 00150 00495 PRODUCE-FLECS-LINE 00176 00524 PRODUCE-FORTRAN-LINE 00177 00557 PRODUCE-TKB-LINE 00178 00370 RUN-FLECS 00179 00382 RUN-FORTRAN 00180 00398 RUN-LINK 00181 00428 RUN-SUBTASK 00373 00385 00401 00412 RUN-TASK 00182 00483 SET-DEFAULTS 00082 00421 SUBTASK-ERROR 00175 00430 00432 00434 (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00014 00338 SWITCH-FLAG 00158 (FLECS VERSION 22.54) ---------------------------------------- 00586 SUBROUTINE PARSE(ITYPE,COMMND,START,LEN,DEFAU,DEFLEN,TYPE,DOTP) 00587 IMPLICIT INTEGER (A-Z) 00588 BYTE TYPE(1) 00589 BYTE COMMND(1),DEFAU(1) 00590 RED=.FALSE. 00591 IF (LEN.NE.0) 00592 . IF (ITYPE.EQ.1) 00593 C GET RID OF TRAILING BLANKS 00594 . . FOUND=.FALSE. 00595 . . REPEAT UNTIL (FOUND) 00596 . . . IF (COMMND(LEN).NE.' '.AND.COMMND(LEN).NE.0)FOUND=.TRUE. 00597 . . . IF (.NOT.FOUND)LEN=LEN-1 00598 . . ...FIN 00599 . . J=LEN 00600 . . ISPACE=0 00601 . . REPEAT UNTIL (J.EQ.0.OR.ISPACE.NE.0) 00602 . . . IF (COMMND(J).EQ.' ')ISPACE=J 00603 . . . J=J-1 00604 . . . IF (ISPACE.NE.0.AND.COMMND(ISPACE+1).EQ.'/')ISPACE=0 00605 . . ...FIN 00606 . . IF (ISPACE.EQ.0) 00607 . . . WRITE(5,10) 00608 10 . . . FORMAT('$FILE?') 00609 . . . READ(5,11,END=12)DEFLEN,(DEFAU(J),J=1,DEFLEN) 00610 11 . . . FORMAT(Q,A1) 00611 . . . WHEN (.TRUE.) 00612 . . . . RED=.TRUE. 00613 . . . ...FIN 00614 . . . ELSE 00615 12 . . . . WRITE(5,13) 00616 13 . . . . FORMAT(' Required parameter not specified',/, 00617 1. . . . ' Command terminated') 00618 . . . . CALL QEXIT 00619 . . . ...FIN 00620 . . ...FIN 00621 . ...FIN 00622 . IF (ITYPE.NE.1) ISPACE=START 00623 . IF (.NOT.RED) 00624 . . DEFLEN=0 00625 . . IF (ITYPE.EQ.1)COMMND(ISPACE)=0 00626 . . ZEBRA=1 00627 . . DO (J=ISPACE+1,LEN) 00628 . . . DEFLEN=DEFLEN+1 00629 . . . DEFAU(DEFLEN)=COMMND(J) 00630 . . . IF (ITYPE.EQ.1)COMMND(J)=0 00631 . . . ZEBRA=ZEBRA+1 00632 . . ...FIN 00633 . . IF (ITYPE.EQ.1)LEN=LEN-ZEBRA (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00015 00634 . ...FIN 00635 . FIND-DOT 00636 . IF (DOTP.EQ.0) 00637 . . DOTP=DEFLEN+1 00638 . . DEFAU(DEFLEN+1)='.' 00639 . . DO (J=1,3) DEFAU(J+DEFLEN+1)=TYPE(J) 00640 . . DEFLEN=DEFLEN+4 00641 . ...FIN 00642 ...FIN 00643 RETURN 00644 C 00645 C ---------------------------------------- 00646 TO FIND-DOT 00647 . DOTP=0 00648 . J=0 00649 . REPEAT UNTIL (J.EQ.DEFLEN.OR.DOTP.NE.0) 00650 . . J=J+1 00651 . . IF (DEFAU(J).EQ.'.')DOTP=J 00652 . ...FIN 00653 ...FIN 00654 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00646 FIND-DOT 00635 (FLECS VERSION 22.54) ---------------------------------------- 00655 SUBROUTINE SLASH(BUFFER,LEN,INDEX) 00656 IMPLICIT INTEGER (A-Z) 00657 BYTE BUFFER(1),LPAR,RPAR 00658 DATA LPAR/1H(/ 00659 DATA RPAR/1H)/ 00660 UNLESS (LEN.LE.0) 00661 . J=INDEX 00662 . INDEX=0 00663 . REPEAT UNTIL (INDEX.NE.0) 00664 . . J=J+1 00665 . . IF (BUFFER(J).EQ.LPAR) 00666 . . . FOUND=.FALSE. 00667 . . . REPEAT UNTIL (J.GE.LEN.OR.FOUND) 00668 . . . . J=J+1 00669 . . . . IF (BUFFER(J).EQ.RPAR)FOUND=.TRUE. 00670 . . . ...FIN 00671 . . ...FIN 00672 . . IF (BUFFER(J).EQ.'/'.OR.J.GE.LEN)INDEX=J 00673 . ...FIN (FLECS VERSION 22.54) 08-DEC-80 16:06:24 PAGE 00016 00674 ...FIN 00675 RETURN 00676 END (FLECS VERSION 22.54) ---------------------------------------- 00677 SUBROUTINE SPACE(COMMND,COMLEN) 00678 BYTE COMMND(1) 00679 UNLESS (COMLEN.LT.1) 00680 . ZEBRA=0 00681 . DO (J=2,COMLEN+1) 00682 . . IF (COMMND(J-1).EQ.' ') 00683 . . . DO (K=J,COMLEN) COMMND(J-1)=COMMND(J) 00684 . . . ZEBRA=ZEBRA+1 00685 . . ...FIN 00686 . ...FIN 00687 . COMLEN=COMLEN-ZEBRA 00688 . COMMND(COMLEN+1)=0 00689 ...FIN 00690 RETURN 00691 END (FLECS VERSION 22.54) ----------------------------------------