PROGRAM FLECS 00001 IMPLICIT INTEGER (A-Z) 00031 BYTE COMMND(160),FILE(34),FFILE(34),LFILE(34),OFILE(34) 00032 BYTE TFILE(34),FLECOM(120),FORCOM(120),TKBCOM(120) 00033 BYTE SWITCH(40),FTN(3),FLE(3),FLL(3),LST(3),OBJ(3) 00034 BYTE FOR(3),TAS(3),CMD(3),TKB(12),LPAR,RPAR,ATS,SPL(4) 00035 INTEGER IEXIT(6) 00036 DATA LISQ /1/ 00037 DATA NOLQ /2/ 00038 DATA FTNQ /3/ 00039 DATA NOFQ /4/ 00040 DATA OBJQ /5/ 00041 DATA NOBQ /6/ 00042 DATA KEEQ /7/ 00043 DATA NOKQ /8/ 00044 DATA SWIQ /9/ 00045 DATA NOSQ /10/ 00046 DATA LNKQ /11/ 00047 DATA NLNQ /12/ 00048 DATA RUNQ /13/ 00049 DATA NORQ /14/ 00050 DATA SPL /'/','-','S','P'/ 00051 DATA FTN/'F','T','N'/ 00052 DATA FLE/'F','L','E'/ 00053 DATA FLL/'F','L','L'/ 00054 DATA LST/'L','S','T'/ 00055 DATA OBJ/'O','B','J'/ 00056 DATA FOR/'F','O','R'/ 00057 DATA TAS/'T','S','K'/ 00058 DATA CMD/'C','M','D'/ 00059 DATA TKB/'T','K','B',' ','@','F','L','E','.','T','M','P'/ 00060 DATA LPAR/1H(/ 00061 DATA RPAR/1H)/ 00062 DATA ATS/1H@/ 00063 DATA FILEN/0/ 00064 DATA DOT/0/ 00065 DATA LILEN/0/ 00066 DATA FTLEN/0/ 00067 DATA TABLEN/0/ 00068 DATA OBLEN/0/ 00069 DATA SWLEN/0/ 00070 DATA WARN/0/ 00071 DATA SUCC/1/ 00072 DATA EROR/2/ 00073 DATA SEVR/4/ 00074 ASSIGN 32757 TO I32758 00082 GO TO 32758 00082 32757 CALL GETLIN(COMMND,COMLEN) 00083 LUN=5 00096 CONTU=.TRUE. 00097 GO TO 32755 00098 32756 IF(.NOT.CONTU) GO TO 32754 00098 32755 ASSIGN 32752 TO I32753 00098 GO TO 32753 00098 32752 GO TO 32756 00098 32754 INDIR=.TRUE. 00099 GO TO 32750 00100 32751 IF(.NOT.INDIR) GO TO 32749 00100 32750 ASSIGN 32747 TO I32748 00100 GO TO 32748 00100 32747 GO TO 32751 00100 32749 CALL PARSE(1,COMMND,1,COMLEN,FILE,FILEN,FLE,DOT) 00104 IF(.NOT.(FILEN.EQ.0)) GO TO 32746 00105 WRITE(5,99) 00106 99 FORMAT(' Required parameter not specified',/, 00107 1' Command terminated') 00108 CALL QEXIT 00109 32746 IF(.NOT.((FILEN-DOT).LE.0)) GO TO 32745 00111 WRITE(5,71)(FILE(J),J=1,FILEN) 00112 71 FORMAT(1H ,A1,' -- Illegal file-specification') 00113 CALL QEXIT 00114 32745 CALL SPACE(COMMND,COMLEN) 00117 INDEX=0 00118 GO TO 32743 00119 32744 IF(INDEX.EQ.COMLEN) GO TO 32742 00119 32743 CALL SLASH(COMMND,COMLEN,INDEX) 00120 IF(.NOT.(INDEX.GT.0.AND.INDEX.NE.COMLEN)) GO TO 32741 00121 START=INDEX+1 00122 CALL SLASH(COMMND,COMLEN,INDEX) 00123 IF (INDEX.EQ.0) STOP=COMLEN 00124 IF(.NOT.(INDEX.NE.0)) GO TO 32740 00125 IF (INDEX.EQ.COMLEN) STOP=INDEX 00126 IF (INDEX.NE.COMLEN) STOP=INDEX-1 00127 INDEX=START 00128 32740 XLEN=STOP-START+1 00130 IF(.NOT.(XLEN.LE.0)) GO TO 32739 00131 WRITE(5,98)(COMMND(J),J=1,STOP) 00132 98 FORMAT(1H ,A1,' -- Invalid qualifier') 00133 CALL QEXIT 00134 32739 ASSIGN 32737 TO I32738 00138 GO TO 32738 00138 32737 IF((LISQ).NE.(QUALIF)) GO TO 32735 00140 ASSIGN 32733 TO I32734 00140 GO TO 32734 00140 32733 GO TO 32736 00141 32735 IF((NOLQ).NE.(QUALIF)) GO TO 32732 00141 LIFLAG=.FALSE. 00141 GO TO 32736 00142 32732 IF((FTNQ).NE.(QUALIF)) GO TO 32731 00142 ASSIGN 32729 TO I32730 00142 GO TO 32730 00142 32729 GO TO 32736 00143 32731 IF((NOFQ).NE.(QUALIF)) GO TO 32728 00143 FTFLAG=.FALSE. 00144 OBFLAG=.FALSE. 00145 LNFLAG=.FALSE. 00146 RUFLAG=.FALSE. 00147 LIFLAG=.TRUE. 00148 GO TO 32736 00150 32728 IF((OBJQ).NE.(QUALIF)) GO TO 32727 00150 ASSIGN 32725 TO I32726 00150 GO TO 32726 00150 32725 GO TO 32736 00151 32727 IF((NOBQ).NE.(QUALIF)) GO TO 32724 00151 OBFLAG=.FALSE. 00152 LNFLAG=.FALSE. 00153 RUFLAG=.FALSE. 00154 GO TO 32736 00156 32724 IF((KEEQ).NE.(QUALIF)) GO TO 32723 00156 KEFLAG=.TRUE. 00156 GO TO 32736 00157 32723 IF((NOKQ).NE.(QUALIF)) GO TO 32722 00157 KEFALG=.FALSE. 00157 GO TO 32736 00158 32722 IF((SWIQ).NE.(QUALIF)) GO TO 32721 00158 ASSIGN 32719 TO I32720 00158 GO TO 32720 00158 32719 GO TO 32736 00159 32721 IF((NOSQ).NE.(QUALIF)) GO TO 32718 00159 SWFLAG=.FALSE. 00159 GO TO 32736 00160 32718 IF((LNKQ).NE.(QUALIF)) GO TO 32717 00160 ASSIGN 32715 TO I32716 00160 GO TO 32716 00160 32715 GO TO 32736 00161 32717 IF((NLNQ).NE.(QUALIF)) GO TO 32714 00161 LNFLAG=.FALSE. 00162 RUFLAG=.FALSE. 00163 GO TO 32736 00165 32714 IF((RUNQ).NE.(QUALIF)) GO TO 32713 00165 RUFLAG=.TRUE. 00165 GO TO 32736 00166 32713 IF((NORQ).NE.(QUALIF)) GO TO 32712 00166 RUFLAG=.FALSE. 00166 GO TO 32736 00167 32712 WRITE(5,11)(COMMND(Z),Z=START,STOP) 00168 11 FORMAT(1H ,A1,' -- Unrecognized qualifier ignored') 00169 32736 CONTINUE 00172 32741 GO TO 32744 00173 32742 CALL DECTDB(1,IERR) 00174 IF(.NOT.(IERR.LT.0)) GO TO 32711 00175 ASSIGN 32709 TO I32710 00175 GO TO 32710 00175 32709 CONTINUE 00175 32711 ASSIGN 32707 TO I32708 00176 GO TO 32708 00176 32707 ASSIGN 32705 TO I32706 00177 GO TO 32706 00177 32705 ASSIGN 32703 TO I32704 00178 GO TO 32704 00178 32703 ASSIGN 32701 TO I32702 00179 GO TO 32702 00179 32701 IF(.NOT.(FTFLAG)) GO TO 32700 00180 ASSIGN 32698 TO I32699 00180 GO TO 32699 00180 32698 CONTINUE 00180 32700 IF(.NOT.(OBFLAG.AND.LNFLAG)) GO TO 32697 00181 ASSIGN 32695 TO I32696 00181 GO TO 32696 00181 32695 CONTINUE 00181 32697 IF(.NOT.(RUFLAG)) GO TO 32694 00182 ASSIGN 32692 TO I32693 00182 GO TO 32693 00182 32692 CONTINUE 00182 32694 CALL EXIT(ISTAT) 00183 32738 CONTINUE 00186 QUALIF=0 00196 J=START 00197 IF (COMMND(J).EQ.'L') QUALIF=LISQ 00198 IF (COMMND(J).EQ.'T') QUALIF=LNKQ 00199 IF (COMMND(J).EQ.'F') QUALIF=FTNQ 00200 IF (COMMND(J).EQ.'O') QUALIF=OBJQ 00201 IF (COMMND(J).EQ.'K') QUALIF=KEEQ 00202 IF (COMMND(J).EQ.'S') QUALIF=SWIQ 00203 IF (COMMND(J).EQ.'R') QUALIF=RUNQ 00204 IF(.NOT.(COMMND(J).EQ.'N'.AND.COMMND(J+1).EQ.'O')) GO TO 32691 00205 IF (COMMND(J+2).EQ.'L') QUALIF=NOLQ 00206 IF (COMMND(J+2).EQ.'T') QUALIF=NLNQ 00207 IF (COMMND(J+2).EQ.'F') QUALIF=NOFQ 00208 IF (COMMND(J+2).EQ.'O') QUALIF=NOBQ 00209 IF (COMMND(J+2).EQ.'K') QUALIF=NOKQ 00210 IF (COMMND(J+2).EQ.'S') QUALIF=NOSQ 00211 IF (COMMND(J+2).EQ.'R') QUALIF=NORQ 00212 32691 GO TO I32738 00214 32734 CONTINUE 00217 LIFLAG=.TRUE. 00218 ASSIGN 32689 TO I32690 00219 GO TO 32690 00219 32689 IF(.NOT.(COLON.NE.0)) GO TO 32688 00220 SPOOL=.FALSE. 00221 CALL PARSE(2,COMMND,COLON,STOP,LFILE,LILEN,FLL,DOTL) 00222 IF(.NOT.(LILEN.EQ.0)) GO TO 32687 00223 WRITE(5,98)(COMMND(J),J=1,STOP) 00224 CALL QEXIT 00225 32687 CONTINUE 00227 32688 IF(.NOT.(COLON.EQ.0)) GO TO 32686 00228 ASSIGN 32684 TO I32685 00228 GO TO 32685 00228 32684 CONTINUE 00228 32686 IF(.NOT.((LILEN-DOTL).LE.0)) GO TO 32683 00229 WRITE(5,72)(LFILE(J),J=1,LILEN) 00230 72 FORMAT(1H ,A1,'-- Illegal file-specification') 00231 CALL QEXIT 00232 32683 GO TO I32734 00234 32685 CONTINUE 00237 SPOOL=.TRUE. 00238 LILEN=FILEN 00239 DO 32682 J=1,FILEN 00240 LFILE(J)=FILE(J) 00240 32682 CONTINUE 00240 DO 32681 J=DOT+1,DOT+3 00241 LFILE(J)=FLL(J-DOT) 00241 32681 CONTINUE 00241 LILEN=DOT+3 00242 DOTL=DOT 00243 GO TO I32685 00244 32690 CONTINUE 00247 COLON=0 00248 J=START 00249 GO TO 32679 00250 32680 IF(J.EQ.STOP.OR.COLON.NE.0) GO TO 32678 00250 32679 J=J+1 00251 IF (COMMND(J).EQ.':')COLON=J 00252 GO TO 32680 00253 32678 GO TO I32690 00254 32730 CONTINUE 00257 FTFLAG=.TRUE. 00258 ASSIGN 32677 TO I32690 00259 GO TO 32690 00259 32677 IF(.NOT.(COLON.NE.0)) GO TO 32676 00260 CALL PARSE(2,COMMND,COLON,STOP,FFILE,FTLEN,FTN,DOTF) 00261 IF(.NOT.(FTLEN.EQ.0)) GO TO 32675 00262 WRITE(5,98)(COMMND(J),J=1,STOP) 00263 CALL QEXIT 00264 32675 CONTINUE 00266 32676 IF(.NOT.(COLON.EQ.0)) GO TO 32674 00267 ASSIGN 32672 TO I32673 00267 GO TO 32673 00267 32672 CONTINUE 00267 32674 IF(.NOT.((FTLEN-DOTF).LE.0)) GO TO 32671 00268 WRITE(5,73)(FFILE(J),J=1,FTLEN) 00269 73 FORMAT(1H ,A1,' -- Illegal file-specification') 00270 CALL QEXIT 00271 32671 GO TO I32730 00273 32673 CONTINUE 00276 FTLEN=FILEN 00277 DO 32670 J=1,FILEN 00278 FFILE(J)=FILE(J) 00278 32670 CONTINUE 00278 DO 32669 J=DOT+1,DOT+3 00279 FFILE(J)=FTN(J-DOT) 00279 32669 CONTINUE 00279 FTLEN=DOT+3 00280 GO TO I32673 00281 32716 CONTINUE 00284 LNFLAG=.TRUE. 00285 ASSIGN 32668 TO I32690 00286 GO TO 32690 00286 32668 IF(.NOT.(COLON.NE.0)) GO TO 32667 00287 CALL PARSE(2,COMMND,COLON,STOP,TFILE,TALEN,TAS,DOTT) 00288 IF(.NOT.(TALEN.EQ.0)) GO TO 32666 00289 WRITE(5,98)(COMMND(J),J=1,STOP) 00290 CALL QEXIT 00291 32666 CONTINUE 00293 32667 IF(.NOT.(COLON.EQ.0)) GO TO 32665 00294 ASSIGN 32663 TO I32664 00294 GO TO 32664 00294 32663 CONTINUE 00294 32665 IF(.NOT.((TALEN-DOTT).LE.0)) GO TO 32662 00295 WRITE(5,74)(TFILE(J),J=1,TALEN) 00296 74 FORMAT(1H ,A1,' -- Illegal file-specification') 00297 CALL QEXIT 00298 32662 GO TO I32716 00300 32664 CONTINUE 00303 TALEN=FILEN 00304 DO 32661 J=1,FILEN 00305 TFILE(J)=FILE(J) 00305 32661 CONTINUE 00305 DO 32660 J=DOT+1,DOT+3 00306 TFILE(J)=TAS(J-DOT) 00306 32660 CONTINUE 00306 TALEN=DOT+3 00307 GO TO I32664 00308 32726 CONTINUE 00311 OBFLAG=.TRUE. 00312 ASSIGN 32659 TO I32690 00313 GO TO 32690 00313 32659 IF(.NOT.(COLON.NE.0)) GO TO 32658 00314 CALL PARSE(2,COMMND,COLON,STOP,OFILE,OBLEN,OBJ,DOTO) 00315 IF(.NOT.(OBLEN.EQ.0)) GO TO 32657 00316 WRITE(5,98)(COMMND(J),J=1,STOP) 00317 CALL QEXIT 00318 32657 CONTINUE 00320 32658 IF(.NOT.(COLON.EQ.0)) GO TO 32656 00321 ASSIGN 32654 TO I32655 00321 GO TO 32655 00321 32654 CONTINUE 00321 32656 IF(.NOT.((OBLEN-DOTO).LE.0)) GO TO 32653 00322 WRITE(5,75)(OFILE(J),J=1,OBLEN) 00323 75 FORMAT(1H ,A1,' -- Illegal file-specification') 00324 CALL QEXIT 00325 32653 GO TO I32726 00327 32655 CONTINUE 00330 OBLEN=FILEN 00331 DO 32652 J=1,FILEN 00332 OFILE(J)=FILE(J) 00332 32652 CONTINUE 00332 DO 32651 J=DOT+1,DOT+3 00333 OFILE(J)=OBJ(J-DOT) 00333 32651 CONTINUE 00333 OBLEN=DOT+3 00334 GO TO I32655 00335 32720 CONTINUE 00338 ASSIGN 32650 TO I32690 00339 GO TO 32690 00339 32650 IF(.NOT.(COLON.NE.0)) GO TO 32649 00340 SWFLAG=.TRUE. 00341 J=COLON 00342 X=COLON 00343 GO TO 32647 00344 32648 IF(J.EQ.STOP.OR.X.NE.COLON) GO TO 32646 00344 32647 J=J+1 00345 IF (COMMND(J).EQ.LPAR)X=J+1 00346 GO TO 32648 00347 32646 J=X 00348 Y=X 00349 GO TO 32644 00350 32645 IF(J.EQ.STOP.OR.Y.NE.X) GO TO 32643 00350 32644 J=J+1 00351 IF(.NOT.(COMMND(J).EQ.RPAR)) GO TO 32641 00352 Y=J-1 00352 GO TO 32642 00352 32641 IF (J.EQ.STOP) Y =J 00353 32642 GO TO 32645 00354 32643 SWLEN=Y-X+1 00355 32649 IF(.NOT.(SWLEN.GT.40.OR.SWLEN.LE.0.OR.COLON.EQ.0)) GO TO 32639 00357 WRITE(5,92)(COMMND(J),J=START,STOP) 00358 92 FORMAT(1H ,A1,' -- Invalid qualifier value ignored') 00359 ISTAT=0 00360 SWFLAG=.FALSE. 00361 GO TO 32640 00362 32639 DO 32638 J=1,40 00364 SWITCH(J)=0 00364 32638 CONTINUE 00364 DO 32637 J=X,Y 00365 SWITCH(J-X+1)=COMMND(J) 00365 32637 CONTINUE 00365 32640 GO TO I32720 00367 32702 CONTINUE 00370 DO 32636 J=1,80 00371 COMMND(J)=0 00371 32636 CONTINUE 00371 DO 32635 J=1,FLELEN 00372 COMMND(J)=FLECOM(J) 00372 32635 CONTINUE 00372 ASSIGN 32633 TO I32634 00373 GO TO 32634 00373 32633 IF(.NOT.(SPOOL)) GO TO 32632 00374 OPEN(UNIT=1,NAME=LFILE,TYPE='OLD',DISPOSE='PRINT') 00375 CLOSE(UNIT=1) 00376 32632 IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00378 GO TO I32702 00379 32699 CONTINUE 00382 DO 32631 J=1,80 00383 COMMND(J)=0 00383 32631 CONTINUE 00383 DO 32630 J=1,FORLEN 00384 COMMND(J)=FORCOM(J) 00384 32630 CONTINUE 00384 ASSIGN 32629 TO I32634 00385 GO TO 32634 00385 32629 IF(.NOT.(SPOOL)) GO TO 32628 00386 OPEN(UNIT=1,NAME=LFILE,TYPE='OLD',DISPOSE='PRINT') 00387 CLOSE(UNIT=1) 00388 32628 IF(.NOT.(.NOT.KEFLAG)) GO TO 32627 00390 OPEN(UNIT=1,NAME=FFILE,TYPE='OLD',DISPOSE='DELETE') 00391 CLOSE(UNIT=1) 00392 32627 IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00394 GO TO I32699 00395 32696 CONTINUE 00398 DO 32626 J=1,80 00399 COMMND(J)=0 00399 32626 CONTINUE 00399 DO 32625 J=1,12 00400 COMMND(J)=TKB(J) 00400 32625 CONTINUE 00400 ASSIGN 32624 TO I32634 00401 GO TO 32634 00401 32624 OPEN(UNIT=1,NAME='FLE.TMP',TYPE='OLD',DISPOSE='DELETE') 00402 CLOSE(UNIT=1) 00403 IF(.NOT.(.NOT.KEFLAG)) GO TO 32623 00404 OPEN(UNIT=1,NAME=OFILE,TYPE='OLD',DISPOSE='DELETE') 00405 CLOSE(UNIT=1) 00406 32623 IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00408 GO TO I32696 00409 32693 CONTINUE 00412 DO 32622 J=1,160 00413 COMMND(J)=0 00413 32622 CONTINUE 00413 COMMND(1)=' ' 00414 NEXT=2 00415 DO 32621 J=NEXT,NEXT+TALEN-1 00416 COMMND(J)=TFILE(J-NEXT+1) 00416 32621 CONTINUE 00416 CALL CHAIN(COMMND,1) 00417 GO TO I32693 00418 32710 CONTINUE 00421 WRITE(5,70) 00422 70 FORMAT(' Fatal subtask error') 00423 CALL EXIT(4) 00424 GO TO I32710 00425 32634 CONTINUE 00428 CALL RUNTS(COMMND,1,2,,,IERR) 00429 IF(.NOT.(IERR.LT.0)) GO TO 32620 00430 ASSIGN 32619 TO I32710 00430 GO TO 32710 00430 32619 CONTINUE 00430 32620 CALL CHKEVW(1,IERR) 00431 IF(.NOT.(IERR.LT.0)) GO TO 32618 00432 ASSIGN 32617 TO I32710 00432 GO TO 32710 00432 32617 CONTINUE 00432 32618 CALL RDEVTS(XRAY,1,IERR,IEXIT) 00433 IF(.NOT.(IERR.LT.0.OR.(XRAY.GT.1.AND.XRAY.LT.8))) GO TO 32616 00434 ASSIGN 32615 TO I32710 00434 GO TO 32710 00434 32615 CONTINUE 00434 32616 IF ((IEXIT(4).AND.2).NE.0)ISTAT=4 00435 IF ((IEXIT(4).AND.1).NE.0)ISTAT=IEXIT(6) 00436 GO TO I32634 00437 32748 CONTINUE 00440 INDIR=.FALSE. 00441 IF(COMLEN.LT.4) GO TO 32614 00442 J=0 00443 GO TO 32612 00444 32613 IF(INDIR.OR.J.EQ.COMLEN) GO TO 32611 00444 32612 J=J+1 00445 IF (COMMND(J).EQ.ATS) INDIR=.TRUE. 00446 GO TO 32613 00447 32611 IF(.NOT.(INDIR)) GO TO 32610 00448 CALL PARSE(2,COMMND,J,COMLEN,FILE,FILEN,CMD,DOT) 00449 OPEN(UNIT=1,NAME=FILE,TYPE='OLD',READONLY) 00450 READ(1,50)K,(COMMND(L),L=J,J+K-1) 00451 50 FORMAT(Q,80A1) 00452 WRITE(5,51)(COMMND(L),L=J,J+K-1) 00453 51 FORMAT(1H ,80A1) 00454 FILEN=0 00455 DOT=0 00456 COMLEN=J+K-1 00457 LUN=1 00458 CONTU=.TRUE. 00459 GO TO 32608 00460 32609 IF(.NOT.CONTU) GO TO 32607 00460 32608 ASSIGN 32606 TO I32753 00460 GO TO 32753 00460 32606 GO TO 32609 00460 32607 CLOSE(UNIT=1) 00461 32610 CONTINUE 00463 32614 GO TO I32748 00464 32753 CONTINUE 00467 CONTU=.FALSE. 00468 IF(.NOT.(COMMND(COMLEN).EQ.'-')) GO TO 32605 00469 IF(.NOT.(LUN.EQ.5)) GO TO 32604 00470 WRITE(LUN,60) 00471 60 FORMAT('$>') 00472 32604 J=COMLEN 00474 READ(LUN,50)K,(COMMND(L),L=J,J+K-1) 00475 IF (LUN.EQ.1)WRITE(5,51)(COMMND(L),L=J,J+K-1) 00476 COMLEN=J+K-1 00477 CONTU=.TRUE. 00478 32605 GO TO I32753 00480 32758 CONTINUE 00483 LIFLAG=.FALSE. 00484 FTFLAG=.TRUE. 00485 OBFLAG=.TRUE. 00486 SWFLAG=.FALSE. 00487 KEFLAG=.TRUE. 00488 LNFLAG=.TRUE. 00489 RUFLAG=.TRUE. 00490 ISTAT=SUCC 00491 GO TO I32758 00492 32708 CONTINUE 00495 IF(.NOT.(.NOT.FTFLAG.AND..NOT.LIFLAG)) GO TO 32603 00496 WRITE(5,91)(COMMND(J),J=1,COMLEN) 00497 91 FORMAT(1H ,A1,' -- Conflicting qualifiers') 00498 CALL QEXIT 00499 32603 DO 32602 J=1,120 00501 FLECOM(J)=0 00501 32602 CONTINUE 00501 DO 32601 J=1,3 00502 FLECOM(J)=FLE(J) 00502 32601 CONTINUE 00502 FLECOM(4)=' ' 00503 FLELEN=5 00504 IF(.NOT.(FTFLAG)) GO TO 32600 00505 IF(.NOT.(FTLEN.LE.0)) GO TO 32599 00506 ASSIGN 32598 TO I32673 00506 GO TO 32673 00506 32598 CONTINUE 00506 32599 DO 32597 J=FLELEN,FLELEN+FTLEN-1 00507 FLECOM(J)=FFILE(J-FLELEN+1) 00507 32597 CONTINUE 00507 FLELEN=FLELEN+FTLEN 00508 32600 IF(.NOT.(LIFLAG)) GO TO 32596 00510 FLECOM(FLELEN)=',' 00511 FLELEN=FLELEN+1 00512 IF(.NOT.(LILEN.LE.0)) GO TO 32595 00513 ASSIGN 32594 TO I32685 00513 GO TO 32685 00513 32594 CONTINUE 00513 32595 DO 32593 J=FLELEN,FLELEN+LILEN-1 00514 FLECOM(J)=LFILE(J-FLELEN+1) 00514 32593 CONTINUE 00514 FLELEN=FLELEN+LILEN 00515 32596 FLECOM(FLELEN)='=' 00517 FLELEN=FLELEN+1 00518 DO 32592 J=FLELEN,FLELEN+FILEN-1 00519 FLECOM(J)=FILE(J-FLELEN+1) 00519 32592 CONTINUE 00519 FLELEN=FLELEN+FILEN-1 00520 GO TO I32708 00521 32706 CONTINUE 00524 IF(.NOT.(FTFLAG)) GO TO 32591 00525 DO 32590 J=1,120 00526 FORCOM(J)=0 00526 32590 CONTINUE 00526 DO 32589 J=1,3 00527 FORCOM(J)=FOR(J) 00527 32589 CONTINUE 00527 FORCOM(4)=' ' 00528 FORLEN=5 00529 IF(.NOT.(OBFLAG)) GO TO 32588 00530 IF(.NOT.(OBLEN.LE.0)) GO TO 32587 00531 ASSIGN 32586 TO I32655 00531 GO TO 32655 00531 32586 CONTINUE 00531 32587 DO 32585 J=FORLEN,FORLEN+OBLEN-1 00532 FORCOM(J)=OFILE(J-FORLEN+1) 00532 32585 CONTINUE 00532 FORLEN=FORLEN+OBLEN 00533 32588 IF(.NOT.(LIFLAG)) GO TO 32584 00535 FORCOM(FORLEN)=',' 00536 FORLEN=FORLEN+1 00537 DO 32583 J=DOTL+1,DOTL+3 00538 LFILE(J)=LST(J-DOTL) 00538 32583 CONTINUE 00538 DO 32582 J=FORLEN,FORLEN+LILEN-1 00539 FORCOM(J)=LFILE(J-FORLEN+1) 00539 32582 CONTINUE 00539 FORLEN=FORLEN+LILEN 00540 DO 32581 J=FORLEN,FORLEN+3 00541 FORCOM(J)=SPL(J-FORLEN+1) 00541 32581 CONTINUE 00541 FORLEN=FORLEN+4 00542 32584 FORCOM(FORLEN)='=' 00544 FORLEN=FORLEN+1 00545 DO 32580 J=FORLEN,FORLEN+FTLEN-1 00546 FORCOM(J)=FFILE(J-FORLEN+1) 00546 32580 CONTINUE 00546 FORLEN=FORLEN+FTLEN 00547 IF(.NOT.(SWFLAG)) GO TO 32579 00548 DO 32578 J=FORLEN,FORLEN+SWLEN-1 00549 FORCOM(J)=SWITCH(J-FORLEN+1) 00549 32578 CONTINUE 00549 FORLEN=FORLEN+SWLEN 00550 32579 FORLEN=FORLEN-1 00552 32591 GO TO I32706 00554 32704 CONTINUE 00557 DO 32577 J=1,120 00558 TKBCOM(J)=0 00558 32577 CONTINUE 00558 TKBLEN=1 00559 IF(.NOT.(TALEN.LE.0)) GO TO 32576 00560 ASSIGN 32575 TO I32664 00560 GO TO 32664 00560 32575 CONTINUE 00560 32576 DO 32574 J=TKBLEN,TKBLEN+TALEN-1 00561 TKBCOM(J)=TFILE(J-TKBLEN+1) 00561 32574 CONTINUE 00561 TKBLEN=TKBLEN+TALEN 00562 TKBCOM(TKBLEN)='=' 00563 TKBLEN=TKBLEN+1 00564 DO 32573 J=TKBLEN,TKBLEN+OBLEN-1 00565 TKBCOM(J)=OFILE(J-TKBLEN+1) 00565 32573 CONTINUE 00565 TKBLEN=TKBLEN+OBLEN 00566 OPEN(UNIT=1,NAME='FLE.TMP',TYPE='NEW') 00567 WRITE(1,30)(TKBCOM(J),J=1,TKBLEN-1) 00568 30 FORMAT(A1) 00569 WRITE(1,31) 00570 31 FORMAT('/') 00571 WRITE(1,32) 00572 32 FORMAT('LIBR=SYSRES:RO') 00573 WRITE(1,33) 00574 33 FORMAT('//') 00575 CLOSE(UNIT=1) 00576 IF(.NOT.((TKBLEN-1).GT.80)) GO TO 32572 00577 WRITE(5,35) 00578 35 FORMAT(' Command too long') 00579 CALL QEXIT 00580 32572 GO TO I32704 00582 END 00585 SUBROUTINE PARSE(ITYPE,COMMND,START,LEN,DEFAU,DEFLEN,TYPE,DOTP) 00586 IMPLICIT INTEGER (A-Z) 00587 BYTE TYPE(1) 00588 BYTE COMMND(1),DEFAU(1) 00589 RED=.FALSE. 00590 IF(.NOT.(LEN.NE.0)) GO TO 32758 00591 IF(.NOT.(ITYPE.EQ.1)) GO TO 32757 00592 FOUND=.FALSE. 00594 GO TO 32755 00595 32756 IF(FOUND) GO TO 32754 00595 32755 IF (COMMND(LEN).NE.' '.AND.COMMND(LEN).NE.0)FOUND=.TRUE. 00596 IF (.NOT.FOUND)LEN=LEN-1 00597 GO TO 32756 00598 32754 J=LEN 00599 ISPACE=0 00600 GO TO 32752 00601 32753 IF(J.EQ.0.OR.ISPACE.NE.0) GO TO 32751 00601 32752 IF (COMMND(J).EQ.' ')ISPACE=J 00602 J=J-1 00603 IF (ISPACE.NE.0.AND.COMMND(ISPACE+1).EQ.'/')ISPACE=0 00604 GO TO 32753 00605 32751 IF(.NOT.(ISPACE.EQ.0)) GO TO 32750 00606 WRITE(5,10) 00607 10 FORMAT('$FILE?') 00608 READ(5,11,END=12)DEFLEN,(DEFAU(J),J=1,DEFLEN) 00609 11 FORMAT(Q,A1) 00610 IF(.NOT.(.TRUE.)) GO TO 32748 00611 RED=.TRUE. 00612 GO TO 32749 00613 32748 CONTINUE 00615 12 WRITE(5,13) 00615 13 FORMAT(' Required parameter not specified',/, 00616 1' Command terminated') 00617 CALL QEXIT 00618 32749 CONTINUE 00620 32750 CONTINUE 00621 32757 IF (ITYPE.NE.1) ISPACE=START 00622 IF(.NOT.(.NOT.RED)) GO TO 32747 00623 DEFLEN=0 00624 IF (ITYPE.EQ.1)COMMND(ISPACE)=0 00625 ZEBRA=1 00626 DO 32746 J=ISPACE+1,LEN 00627 DEFLEN=DEFLEN+1 00628 DEFAU(DEFLEN)=COMMND(J) 00629 IF (ITYPE.EQ.1)COMMND(J)=0 00630 ZEBRA=ZEBRA+1 00631 32746 CONTINUE 00632 IF (ITYPE.EQ.1)LEN=LEN-ZEBRA 00633 32747 ASSIGN 32744 TO I32745 00635 GO TO 32745 00635 32744 IF(.NOT.(DOTP.EQ.0)) GO TO 32743 00636 DOTP=DEFLEN+1 00637 DEFAU(DEFLEN+1)='.' 00638 DO 32742 J=1,3 00639 DEFAU(J+DEFLEN+1)=TYPE(J) 00639 32742 CONTINUE 00639 DEFLEN=DEFLEN+4 00640 32743 CONTINUE 00642 32758 RETURN 00643 32745 CONTINUE 00646 DOTP=0 00647 J=0 00648 GO TO 32740 00649 32741 IF(J.EQ.DEFLEN.OR.DOTP.NE.0) GO TO 32739 00649 32740 J=J+1 00650 IF (DEFAU(J).EQ.'.')DOTP=J 00651 GO TO 32741 00652 32739 GO TO I32745 00653 END 00654 SUBROUTINE SLASH(BUFFER,LEN,INDEX) 00655 IMPLICIT INTEGER (A-Z) 00656 BYTE BUFFER(1),LPAR,RPAR 00657 DATA LPAR/1H(/ 00658 DATA RPAR/1H)/ 00659 IF(LEN.LE.0) GO TO 32758 00660 J=INDEX 00661 INDEX=0 00662 GO TO 32756 00663 32757 IF(INDEX.NE.0) GO TO 32755 00663 32756 J=J+1 00664 IF(.NOT.(BUFFER(J).EQ.LPAR)) GO TO 32754 00665 FOUND=.FALSE. 00666 GO TO 32752 00667 32753 IF(J.GE.LEN.OR.FOUND) GO TO 32751 00667 32752 J=J+1 00668 IF (BUFFER(J).EQ.RPAR)FOUND=.TRUE. 00669 GO TO 32753 00670 32751 CONTINUE 00671 32754 IF (BUFFER(J).EQ.'/'.OR.J.GE.LEN)INDEX=J 00672 GO TO 32757 00673 32755 CONTINUE 00674 32758 RETURN 00675 END 00676 SUBROUTINE SPACE(COMMND,COMLEN) 00677 BYTE COMMND(1) 00678 IF(COMLEN.LT.1) GO TO 32758 00679 ZEBRA=0 00680 DO 32757 J=2,COMLEN+1 00681 IF(.NOT.(COMMND(J-1).EQ.' ')) GO TO 32756 00682 DO 32755 K=J,COMLEN 00683 COMMND(J-1)=COMMND(J) 00683 32755 CONTINUE 00683 ZEBRA=ZEBRA+1 00684 32756 CONTINUE 00686 32757 CONTINUE 00686 COMLEN=COMLEN-ZEBRA 00687 COMMND(COMLEN+1)=0 00688 32758 RETURN 00690 END 00691