PROGRAM FLECS 00001 IMPLICIT INTEGER (A-Z) 00002 BYTE COMMND(160),FILE(34),FFILE(34),LFILE(34),OFILE(34) 00003 BYTE TFILE(34),FLECOM(120),FORCOM(120),TKBCOM(120) 00004 BYTE SWITCH(40),FTN(3),FLE(3),FLL(3),LST(3),OBJ(3) 00005 BYTE FOR(3),TAS(3),CMD(3),TKB(12),LPAR,RPAR,ATS,SPL(4) 00006 INTEGER IEXIT(6) 00007 DATA LISQ /1/ 00008 DATA NOLQ /2/ 00009 DATA FTNQ /3/ 00010 DATA NOFQ /4/ 00011 DATA OBJQ /5/ 00012 DATA NOBQ /6/ 00013 DATA KEEQ /7/ 00014 DATA NOKQ /8/ 00015 DATA SWIQ /9/ 00016 DATA NOSQ /10/ 00017 DATA LNKQ /11/ 00018 DATA NLNQ /12/ 00019 DATA RUNQ /13/ 00020 DATA NORQ /14/ 00021 DATA SPL /'/','-','S','P'/ 00022 DATA FTN/'F','T','N'/ 00023 DATA FLE/'F','L','E'/ 00024 DATA FLL/'F','L','L'/ 00025 DATA LST/'L','S','T'/ 00026 DATA OBJ/'O','B','J'/ 00027 DATA FOR/'F','O','R'/ 00028 DATA TAS/'T','S','K'/ 00029 DATA CMD/'C','M','D'/ 00030 DATA TKB/'T','K','B',' ','@','F','L','E','.','T','M','P'/ 00031 DATA LPAR/1H(/ 00032 DATA RPAR/1H)/ 00033 DATA ATS/1H@/ 00034 DATA FILEN/0/ 00035 DATA DOT/0/ 00036 DATA LILEN/0/ 00037 DATA FTLEN/0/ 00038 DATA TABLEN/0/ 00039 DATA OBLEN/0/ 00040 DATA SWLEN/0/ 00041 DATA WARN/0/ 00042 DATA SUCC/1/ 00043 DATA EROR/2/ 00044 DATA SEVR/4/ 00045 ASSIGN 32758 TO I32759 00046 GO TO 32759 00046 32758 CALL GETLIN(COMMND,COMLEN) 00047 LUN=5 00048 CONTU=.TRUE. 00049 GO TO 32756 00050 32757 IF(.NOT.CONTU) GO TO 32755 00050 32756 ASSIGN 32753 TO I32754 00050 GO TO 32754 00050 32753 GO TO 32757 00050 32755 INDIR=.TRUE. 00051 GO TO 32751 00052 32752 IF(.NOT.INDIR) GO TO 32750 00052 32751 ASSIGN 32748 TO I32749 00052 GO TO 32749 00052 32748 GO TO 32752 00052 32750 CALL PARSE(1,COMMND,1,COMLEN,FILE,FILEN,FLE,DOT) 00053 IF(.NOT.(FILEN.EQ.0)) GO TO 32747 00054 WRITE(5,99) 00055 99 FORMAT(' Required parameter not specified',/, 00056 1' Command terminated') 00057 CALL QEXIT 00058 32747 IF(.NOT.((FILEN-DOT).LE.0)) GO TO 32746 00060 WRITE(5,71)(FILE(J),J=1,FILEN) 00061 71 FORMAT(1H ,A1,' -- Illegal file-specification') 00062 CALL QEXIT 00063 32746 CALL SPACE(COMMND,COMLEN) 00065 INDEX=0 00066 GO TO 32744 00067 32745 IF(INDEX.EQ.COMLEN) GO TO 32743 00067 32744 CALL SLASH(COMMND,COMLEN,INDEX) 00068 IF(.NOT.(INDEX.GT.0.AND.INDEX.NE.COMLEN)) GO TO 32742 00069 START=INDEX+1 00070 CALL SLASH(COMMND,COMLEN,INDEX) 00071 IF (INDEX.EQ.0) STOP=COMLEN 00072 IF(.NOT.(INDEX.NE.0)) GO TO 32741 00073 IF (INDEX.EQ.COMLEN) STOP=INDEX 00074 IF (INDEX.NE.COMLEN) STOP=INDEX-1 00075 INDEX=START 00076 32741 XLEN=STOP-START+1 00078 IF(.NOT.(XLEN.LE.0)) GO TO 32740 00079 WRITE(5,98)(COMMND(J),J=1,STOP) 00080 98 FORMAT(1H ,A1,' -- Invalid qualifier') 00081 CALL QEXIT 00082 32740 ASSIGN 32738 TO I32739 00084 GO TO 32739 00084 32738 IF((LISQ).NE.(QUALIF)) GO TO 32736 00086 ASSIGN 32734 TO I32735 00086 GO TO 32735 00086 32734 GO TO 32737 00087 32736 IF((NOLQ).NE.(QUALIF)) GO TO 32733 00087 LIFLAG=.FALSE. 00087 GO TO 32737 00088 32733 IF((FTNQ).NE.(QUALIF)) GO TO 32732 00088 ASSIGN 32730 TO I32731 00088 GO TO 32731 00088 32730 GO TO 32737 00089 32732 IF((NOFQ).NE.(QUALIF)) GO TO 32729 00089 FTFLAG=.FALSE. 00090 OBFLAG=.FALSE. 00091 LNFLAG=.FALSE. 00092 RUFLAG=.FALSE. 00093 LIFLAG=.TRUE. 00094 GO TO 32737 00096 32729 IF((OBJQ).NE.(QUALIF)) GO TO 32728 00096 ASSIGN 32726 TO I32727 00096 GO TO 32727 00096 32726 GO TO 32737 00097 32728 IF((NOBQ).NE.(QUALIF)) GO TO 32725 00097 OBFLAG=.FALSE. 00098 LNFLAG=.FALSE. 00099 RUFLAG=.FALSE. 00100 GO TO 32737 00102 32725 IF((KEEQ).NE.(QUALIF)) GO TO 32724 00102 KEFLAG=.TRUE. 00102 GO TO 32737 00103 32724 IF((NOKQ).NE.(QUALIF)) GO TO 32723 00103 KEFALG=.FALSE. 00103 GO TO 32737 00104 32723 IF((SWIQ).NE.(QUALIF)) GO TO 32722 00104 ASSIGN 32720 TO I32721 00104 GO TO 32721 00104 32720 GO TO 32737 00105 32722 IF((NOSQ).NE.(QUALIF)) GO TO 32719 00105 SWFLAG=.FALSE. 00105 GO TO 32737 00106 32719 IF((LNKQ).NE.(QUALIF)) GO TO 32718 00106 ASSIGN 32716 TO I32717 00106 GO TO 32717 00106 32716 GO TO 32737 00107 32718 IF((NLNQ).NE.(QUALIF)) GO TO 32715 00107 LNFLAG=.FALSE. 00108 RUFLAG=.FALSE. 00109 GO TO 32737 00111 32715 IF((RUNQ).NE.(QUALIF)) GO TO 32714 00111 RUFLAG=.TRUE. 00111 GO TO 32737 00112 32714 IF((NORQ).NE.(QUALIF)) GO TO 32713 00112 RUFLAG=.FALSE. 00112 GO TO 32737 00113 32713 WRITE(5,11)(COMMND(Z),Z=START,STOP) 00114 11 FORMAT(1H ,A1,' -- Unrecognized qualifier ignored') 00115 32737 CONTINUE 00118 32742 GO TO 32745 00119 32743 CALL DECTDB(1,IERR) 00120 IF(.NOT.(IERR.LT.0)) GO TO 32712 00121 ASSIGN 32710 TO I32711 00121 GO TO 32711 00121 32710 CONTINUE 00121 32712 ASSIGN 32708 TO I32709 00122 GO TO 32709 00122 32708 ASSIGN 32706 TO I32707 00123 GO TO 32707 00123 32706 ASSIGN 32704 TO I32705 00124 GO TO 32705 00124 32704 ASSIGN 32702 TO I32703 00125 GO TO 32703 00125 32702 IF(.NOT.(FTFLAG)) GO TO 32701 00126 ASSIGN 32699 TO I32700 00126 GO TO 32700 00126 32699 CONTINUE 00126 32701 IF(.NOT.(OBFLAG.AND.LNFLAG)) GO TO 32698 00127 ASSIGN 32696 TO I32697 00127 GO TO 32697 00127 32696 CONTINUE 00127 32698 IF(.NOT.(RUFLAG)) GO TO 32695 00128 ASSIGN 32693 TO I32694 00128 GO TO 32694 00128 32693 CONTINUE 00128 32695 CALL EXIT(ISTAT) 00129 32739 CONTINUE 00130 QUALIF=0 00131 J=START 00132 IF (COMMND(J).EQ.'L') QUALIF=LISQ 00133 IF (COMMND(J).EQ.'T') QUALIF=LNKQ 00134 IF (COMMND(J).EQ.'F') QUALIF=FTNQ 00135 IF (COMMND(J).EQ.'O') QUALIF=OBJQ 00136 IF (COMMND(J).EQ.'K') QUALIF=KEEQ 00137 IF (COMMND(J).EQ.'S') QUALIF=SWIQ 00138 IF (COMMND(J).EQ.'R') QUALIF=RUNQ 00139 IF(.NOT.(COMMND(J).EQ.'N'.AND.COMMND(J+1).EQ.'O')) GO TO 32692 00140 IF (COMMND(J+2).EQ.'L') QUALIF=NOLQ 00141 IF (COMMND(J+2).EQ.'T') QUALIF=NLNQ 00142 IF (COMMND(J+2).EQ.'F') QUALIF=NOFQ 00143 IF (COMMND(J+2).EQ.'O') QUALIF=NOBQ 00144 IF (COMMND(J+2).EQ.'K') QUALIF=NOKQ 00145 IF (COMMND(J+2).EQ.'S') QUALIF=NOSQ 00146 IF (COMMND(J+2).EQ.'R') QUALIF=NORQ 00147 32692 GO TO I32739 00149 32735 CONTINUE 00150 LIFLAG=.TRUE. 00151 ASSIGN 32690 TO I32691 00152 GO TO 32691 00152 32690 IF(.NOT.(COLON.NE.0)) GO TO 32689 00153 SPOOL=.FALSE. 00154 CALL PARSE(2,COMMND,COLON,STOP,LFILE,LILEN,FLL,DOTL) 00155 IF(.NOT.(LILEN.EQ.0)) GO TO 32688 00156 WRITE(5,98)(COMMND(J),J=1,STOP) 00157 CALL QEXIT 00158 32688 CONTINUE 00160 32689 IF(.NOT.(COLON.EQ.0)) GO TO 32687 00161 ASSIGN 32685 TO I32686 00161 GO TO 32686 00161 32685 CONTINUE 00161 32687 IF(.NOT.((LILEN-DOTL).LE.0)) GO TO 32684 00162 WRITE(5,72)(LFILE(J),J=1,LILEN) 00163 72 FORMAT(1H ,A1,'-- Illegal file-specification') 00164 CALL QEXIT 00165 32684 GO TO I32735 00167 32686 CONTINUE 00168 SPOOL=.TRUE. 00169 LILEN=FILEN 00170 DO 32683 J=1,FILEN 00171 LFILE(J)=FILE(J) 00171 32683 CONTINUE 00171 DO 32682 J=DOT+1,DOT+3 00172 LFILE(J)=FLL(J-DOT) 00172 32682 CONTINUE 00172 LILEN=DOT+3 00173 DOTL=DOT 00174 GO TO I32686 00175 32691 CONTINUE 00176 COLON=0 00177 J=START 00178 GO TO 32680 00179 32681 IF(J.EQ.STOP.OR.COLON.NE.0) GO TO 32679 00179 32680 J=J+1 00180 IF (COMMND(J).EQ.':')COLON=J 00181 GO TO 32681 00182 32679 GO TO I32691 00183 32731 CONTINUE 00184 FTFLAG=.TRUE. 00185 ASSIGN 32678 TO I32691 00186 GO TO 32691 00186 32678 IF(.NOT.(COLON.NE.0)) GO TO 32677 00187 CALL PARSE(2,COMMND,COLON,STOP,FFILE,FTLEN,FTN,DOTF) 00188 IF(.NOT.(FTLEN.EQ.0)) GO TO 32676 00189 WRITE(5,98)(COMMND(J),J=1,STOP) 00190 CALL QEXIT 00191 32676 CONTINUE 00193 32677 IF(.NOT.(COLON.EQ.0)) GO TO 32675 00194 ASSIGN 32673 TO I32674 00194 GO TO 32674 00194 32673 CONTINUE 00194 32675 IF(.NOT.((FTLEN-DOTF).LE.0)) GO TO 32672 00195 WRITE(5,73)(FFILE(J),J=1,FTLEN) 00196 73 FORMAT(1H ,A1,' -- Illegal file-specification') 00197 CALL QEXIT 00198 32672 GO TO I32731 00200 32674 CONTINUE 00201 FTLEN=FILEN 00202 DO 32671 J=1,FILEN 00203 FFILE(J)=FILE(J) 00203 32671 CONTINUE 00203 DO 32670 J=DOT+1,DOT+3 00204 FFILE(J)=FTN(J-DOT) 00204 32670 CONTINUE 00204 FTLEN=DOT+3 00205 GO TO I32674 00206 32717 CONTINUE 00207 LNFLAG=.TRUE. 00208 ASSIGN 32669 TO I32691 00209 GO TO 32691 00209 32669 IF(.NOT.(COLON.NE.0)) GO TO 32668 00210 CALL PARSE(2,COMMND,COLON,STOP,TFILE,TALEN,TAS,DOTT) 00211 IF(.NOT.(TALEN.EQ.0)) GO TO 32667 00212 WRITE(5,98)(COMMND(J),J=1,STOP) 00213 CALL QEXIT 00214 32667 CONTINUE 00216 32668 IF(.NOT.(COLON.EQ.0)) GO TO 32666 00217 ASSIGN 32664 TO I32665 00217 GO TO 32665 00217 32664 CONTINUE 00217 32666 IF(.NOT.((TALEN-DOTT).LE.0)) GO TO 32663 00218 WRITE(5,74)(TFILE(J),J=1,TALEN) 00219 74 FORMAT(1H ,A1,' -- Illegal file-specification') 00220 CALL QEXIT 00221 32663 GO TO I32717 00223 32665 CONTINUE 00224 TALEN=FILEN 00225 DO 32662 J=1,FILEN 00226 TFILE(J)=FILE(J) 00226 32662 CONTINUE 00226 DO 32661 J=DOT+1,DOT+3 00227 TFILE(J)=TAS(J-DOT) 00227 32661 CONTINUE 00227 TALEN=DOT+3 00228 GO TO I32665 00229 32727 CONTINUE 00230 OBFLAG=.TRUE. 00231 ASSIGN 32660 TO I32691 00232 GO TO 32691 00232 32660 IF(.NOT.(COLON.NE.0)) GO TO 32659 00233 CALL PARSE(2,COMMND,COLON,STOP,OFILE,OBLEN,OBJ,DOTO) 00234 IF(.NOT.(OBLEN.EQ.0)) GO TO 32658 00235 WRITE(5,98)(COMMND(J),J=1,STOP) 00236 CALL QEXIT 00237 32658 CONTINUE 00239 32659 IF(.NOT.(COLON.EQ.0)) GO TO 32657 00240 ASSIGN 32655 TO I32656 00240 GO TO 32656 00240 32655 CONTINUE 00240 32657 IF(.NOT.((OBLEN-DOTO).LE.0)) GO TO 32654 00241 WRITE(5,75)(OFILE(J),J=1,OBLEN) 00242 75 FORMAT(1H ,A1,' -- Illegal file-specification') 00243 CALL QEXIT 00244 32654 GO TO I32727 00246 32656 CONTINUE 00247 OBLEN=FILEN 00248 DO 32653 J=1,FILEN 00249 OFILE(J)=FILE(J) 00249 32653 CONTINUE 00249 DO 32652 J=DOT+1,DOT+3 00250 OFILE(J)=OBJ(J-DOT) 00250 32652 CONTINUE 00250 OBLEN=DOT+3 00251 GO TO I32656 00252 32721 CONTINUE 00253 ASSIGN 32651 TO I32691 00254 GO TO 32691 00254 32651 IF(.NOT.(COLON.NE.0)) GO TO 32650 00255 SWFLAG=.TRUE. 00256 J=COLON 00257 X=COLON 00258 GO TO 32648 00259 32649 IF(J.EQ.STOP.OR.X.NE.COLON) GO TO 32647 00259 32648 J=J+1 00260 IF (COMMND(J).EQ.LPAR)X=J+1 00261 GO TO 32649 00262 32647 J=X 00263 Y=X 00264 GO TO 32645 00265 32646 IF(J.EQ.STOP.OR.Y.NE.X) GO TO 32644 00265 32645 J=J+1 00266 IF(.NOT.(COMMND(J).EQ.RPAR)) GO TO 32642 00267 Y=J-1 00267 GO TO 32643 00267 32642 IF (J.EQ.STOP) Y =J 00268 32643 GO TO 32646 00269 32644 SWLEN=Y-X+1 00270 32650 IF(.NOT.(SWLEN.GT.40.OR.SWLEN.LE.0.OR.COLON.EQ.0)) GO TO 32640 00272 WRITE(5,92)(COMMND(J),J=START,STOP) 00273 92 FORMAT(1H ,A1,' -- Invalid qualifier value ignored') 00274 ISTAT=0 00275 SWFLAG=.FALSE. 00276 GO TO 32641 00277 32640 DO 32639 J=1,40 00279 SWITCH(J)=0 00279 32639 CONTINUE 00279 DO 32638 J=X,Y 00280 SWITCH(J-X+1)=COMMND(J) 00280 32638 CONTINUE 00280 32641 GO TO I32721 00282 32703 CONTINUE 00283 DO 32637 J=1,80 00284 COMMND(J)=0 00284 32637 CONTINUE 00284 DO 32636 J=1,FLELEN 00285 COMMND(J)=FLECOM(J) 00285 32636 CONTINUE 00285 ASSIGN 32634 TO I32635 00286 GO TO 32635 00286 32634 IF(.NOT.(SPOOL)) GO TO 32633 00287 OPEN(UNIT=1,NAME=LFILE,TYPE='OLD',DISPOSE='PRINT') 00288 CLOSE(UNIT=1) 00289 32633 IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00291 GO TO I32703 00292 32700 CONTINUE 00293 DO 32632 J=1,80 00294 COMMND(J)=0 00294 32632 CONTINUE 00294 DO 32631 J=1,FORLEN 00295 COMMND(J)=FORCOM(J) 00295 32631 CONTINUE 00295 ASSIGN 32630 TO I32635 00296 GO TO 32635 00296 32630 IF(.NOT.(SPOOL)) GO TO 32629 00297 OPEN(UNIT=1,NAME=LFILE,TYPE='OLD',DISPOSE='PRINT') 00298 CLOSE(UNIT=1) 00299 32629 IF(.NOT.(.NOT.KEFLAG)) GO TO 32628 00301 OPEN(UNIT=1,NAME=FFILE,TYPE='OLD',DISPOSE='DELETE') 00302 CLOSE(UNIT=1) 00303 32628 IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00305 GO TO I32700 00306 32697 CONTINUE 00307 DO 32627 J=1,80 00308 COMMND(J)=0 00308 32627 CONTINUE 00308 DO 32626 J=1,12 00309 COMMND(J)=TKB(J) 00309 32626 CONTINUE 00309 ASSIGN 32625 TO I32635 00310 GO TO 32635 00310 32625 OPEN(UNIT=1,NAME='FLE.TMP',TYPE='OLD',DISPOSE='DELETE') 00311 CLOSE(UNIT=1) 00312 IF(.NOT.(.NOT.KEFLAG)) GO TO 32624 00313 OPEN(UNIT=1,NAME=OFILE,TYPE='OLD',DISPOSE='DELETE') 00314 CLOSE(UNIT=1) 00315 32624 IF (ISTAT.GT.SUCC)CALL EXIT(ISTAT) 00317 GO TO I32697 00318 32694 CONTINUE 00319 DO 32623 J=1,160 00320 COMMND(J)=0 00320 32623 CONTINUE 00320 COMMND(1)=' ' 00321 NEXT=2 00322 DO 32622 J=NEXT,NEXT+TALEN-1 00323 COMMND(J)=TFILE(J-NEXT+1) 00323 32622 CONTINUE 00323 CALL CHAIN(COMMND,1) 00324 GO TO I32694 00325 32711 CONTINUE 00326 WRITE(5,70) 00327 70 FORMAT(' Fatal subtask error') 00328 CALL EXIT(4) 00329 GO TO I32711 00330 32635 CONTINUE 00331 CALL RUNTS(COMMND,1,2,,,IERR) 00332 IF(.NOT.(IERR.LT.0)) GO TO 32621 00333 ASSIGN 32620 TO I32711 00333 GO TO 32711 00333 32620 CONTINUE 00333 32621 CALL CHKEVW(1,IERR) 00334 IF(.NOT.(IERR.LT.0)) GO TO 32619 00335 ASSIGN 32618 TO I32711 00335 GO TO 32711 00335 32618 CONTINUE 00335 32619 CALL RDEVTS(XRAY,1,IERR,IEXIT) 00336 IF(.NOT.(IERR.LT.0.OR.(XRAY.GT.1.AND.XRAY.LT.8))) GO TO 32617 00337 ASSIGN 32616 TO I32711 00337 GO TO 32711 00337 32616 CONTINUE 00337 32617 IF ((IEXIT(4).AND.2).NE.0)ISTAT=4 00338 IF ((IEXIT(4).AND.1).NE.0)ISTAT=IEXIT(6) 00339 GO TO I32635 00340 32749 CONTINUE 00341 INDIR=.FALSE. 00342 IF(COMLEN.LT.4) GO TO 32615 00343 J=0 00344 GO TO 32613 00345 32614 IF(INDIR.OR.J.EQ.COMLEN) GO TO 32612 00345 32613 J=J+1 00346 IF (COMMND(J).EQ.ATS) INDIR=.TRUE. 00347 GO TO 32614 00348 32612 IF(.NOT.(INDIR)) GO TO 32611 00349 CALL PARSE(2,COMMND,J,COMLEN,FILE,FILEN,CMD,DOT) 00350 OPEN(UNIT=1,NAME=FILE,TYPE='OLD',READONLY) 00351 READ(1,50)K,(COMMND(L),L=J,J+K-1) 00352 50 FORMAT(Q,80A1) 00353 WRITE(5,51)(COMMND(L),L=J,J+K-1) 00354 51 FORMAT(1H ,80A1) 00355 FILEN=0 00356 DOT=0 00357 COMLEN=J+K-1 00358 LUN=1 00359 CONTU=.TRUE. 00360 GO TO 32609 00361 32610 IF(.NOT.CONTU) GO TO 32608 00361 32609 ASSIGN 32607 TO I32754 00361 GO TO 32754 00361 32607 GO TO 32610 00361 32608 CLOSE(UNIT=1) 00362 32611 CONTINUE 00364 32615 GO TO I32749 00365 32754 CONTINUE 00366 CONTU=.FALSE. 00367 IF(.NOT.(COMMND(COMLEN).EQ.'-')) GO TO 32606 00368 IF(.NOT.(LUN.EQ.5)) GO TO 32605 00369 WRITE(LUN,60) 00370 60 FORMAT('$>') 00371 32605 J=COMLEN 00373 READ(LUN,50)K,(COMMND(L),L=J,J+K-1) 00374 IF (LUN.EQ.1)WRITE(5,51)(COMMND(L),L=J,J+K-1) 00375 COMLEN=J+K-1 00376 CONTU=.TRUE. 00377 32606 GO TO I32754 00379 32759 CONTINUE 00380 LIFLAG=.FALSE. 00381 FTFLAG=.TRUE. 00382 OBFLAG=.TRUE. 00383 SWFLAG=.FALSE. 00384 KEFLAG=.TRUE. 00385 LNFLAG=.TRUE. 00386 RUFLAG=.TRUE. 00387 ISTAT=SUCC 00388 GO TO I32759 00389 32709 CONTINUE 00390 IF(.NOT.(.NOT.FTFLAG.AND..NOT.LIFLAG)) GO TO 32604 00391 WRITE(5,91)(COMMND(J),J=1,COMLEN) 00392 91 FORMAT(1H ,A1,' -- Conflicting qualifiers') 00393 CALL QEXIT 00394 32604 DO 32603 J=1,120 00396 FLECOM(J)=0 00396 32603 CONTINUE 00396 DO 32602 J=1,3 00397 FLECOM(J)=FLE(J) 00397 32602 CONTINUE 00397 FLECOM(4)=' ' 00398 FLELEN=5 00399 IF(.NOT.(FTFLAG)) GO TO 32601 00400 IF(.NOT.(FTLEN.LE.0)) GO TO 32600 00401 ASSIGN 32599 TO I32674 00401 GO TO 32674 00401 32599 CONTINUE 00401 32600 DO 32598 J=FLELEN,FLELEN+FTLEN-1 00402 FLECOM(J)=FFILE(J-FLELEN+1) 00402 32598 CONTINUE 00402 FLELEN=FLELEN+FTLEN 00403 32601 IF(.NOT.(LIFLAG)) GO TO 32597 00405 FLECOM(FLELEN)=',' 00406 FLELEN=FLELEN+1 00407 IF(.NOT.(LILEN.LE.0)) GO TO 32596 00408 ASSIGN 32595 TO I32686 00408 GO TO 32686 00408 32595 CONTINUE 00408 32596 DO 32594 J=FLELEN,FLELEN+LILEN-1 00409 FLECOM(J)=LFILE(J-FLELEN+1) 00409 32594 CONTINUE 00409 FLELEN=FLELEN+LILEN 00410 32597 FLECOM(FLELEN)='=' 00412 FLELEN=FLELEN+1 00413 DO 32593 J=FLELEN,FLELEN+FILEN-1 00414 FLECOM(J)=FILE(J-FLELEN+1) 00414 32593 CONTINUE 00414 FLELEN=FLELEN+FILEN-1 00415 GO TO I32709 00416 32707 CONTINUE 00417 IF(.NOT.(FTFLAG)) GO TO 32592 00418 DO 32591 J=1,120 00419 FORCOM(J)=0 00419 32591 CONTINUE 00419 DO 32590 J=1,3 00420 FORCOM(J)=FOR(J) 00420 32590 CONTINUE 00420 FORCOM(4)=' ' 00421 FORLEN=5 00422 IF(.NOT.(OBFLAG)) GO TO 32589 00423 IF(.NOT.(OBLEN.LE.0)) GO TO 32588 00424 ASSIGN 32587 TO I32656 00424 GO TO 32656 00424 32587 CONTINUE 00424 32588 DO 32586 J=FORLEN,FORLEN+OBLEN-1 00425 FORCOM(J)=OFILE(J-FORLEN+1) 00425 32586 CONTINUE 00425 FORLEN=FORLEN+OBLEN 00426 32589 IF(.NOT.(LIFLAG)) GO TO 32585 00428 FORCOM(FORLEN)=',' 00429 FORLEN=FORLEN+1 00430 DO 32584 J=DOTL+1,DOTL+3 00431 LFILE(J)=LST(J-DOTL) 00431 32584 CONTINUE 00431 DO 32583 J=FORLEN,FORLEN+LILEN-1 00432 FORCOM(J)=LFILE(J-FORLEN+1) 00432 32583 CONTINUE 00432 FORLEN=FORLEN+LILEN 00433 DO 32582 J=FORLEN,FORLEN+3 00434 FORCOM(J)=SPL(J-FORLEN+1) 00434 32582 CONTINUE 00434 FORLEN=FORLEN+4 00435 32585 FORCOM(FORLEN)='=' 00437 FORLEN=FORLEN+1 00438 DO 32581 J=FORLEN,FORLEN+FTLEN-1 00439 FORCOM(J)=FFILE(J-FORLEN+1) 00439 32581 CONTINUE 00439 FORLEN=FORLEN+FTLEN 00440 IF(.NOT.(SWFLAG)) GO TO 32580 00441 DO 32579 J=FORLEN,FORLEN+SWLEN-1 00442 FORCOM(J)=SWITCH(J-FORLEN+1) 00442 32579 CONTINUE 00442 FORLEN=FORLEN+SWLEN 00443 32580 FORLEN=FORLEN-1 00445 32592 GO TO I32707 00447 32705 CONTINUE 00448 DO 32578 J=1,120 00449 TKBCOM(J)=0 00449 32578 CONTINUE 00449 TKBLEN=1 00450 IF(.NOT.(TALEN.LE.0)) GO TO 32577 00451 ASSIGN 32576 TO I32665 00451 GO TO 32665 00451 32576 CONTINUE 00451 32577 DO 32575 J=TKBLEN,TKBLEN+TALEN-1 00452 TKBCOM(J)=TFILE(J-TKBLEN+1) 00452 32575 CONTINUE 00452 TKBLEN=TKBLEN+TALEN 00453 TKBCOM(TKBLEN)='=' 00454 TKBLEN=TKBLEN+1 00455 DO 32574 J=TKBLEN,TKBLEN+OBLEN-1 00456 TKBCOM(J)=OFILE(J-TKBLEN+1) 00456 32574 CONTINUE 00456 TKBLEN=TKBLEN+OBLEN 00457 OPEN(UNIT=1,NAME='FLE.TMP',TYPE='NEW') 00458 WRITE(1,30)(TKBCOM(J),J=1,TKBLEN-1) 00459 30 FORMAT(A1) 00460 WRITE(1,31) 00461 31 FORMAT('/') 00462 WRITE(1,32) 00463 32 FORMAT('LIBR=SYSRES:RO') 00464 WRITE(1,33) 00465 33 FORMAT('//') 00466 CLOSE(UNIT=1) 00467 IF(.NOT.((TKBLEN-1).GT.80)) GO TO 32573 00468 WRITE(5,35) 00469 35 FORMAT(' Command too long') 00470 CALL QEXIT 00471 32573 GO TO I32705 00473 END 00474 SUBROUTINE PARSE(ITYPE,COMMND,START,LEN,DEFAU,DEFLEN,TYPE,DOTP) 00475 IMPLICIT INTEGER (A-Z) 00476 BYTE TYPE(1) 00477 BYTE COMMND(1),DEFAU(1) 00478 RED=.FALSE. 00479 IF(.NOT.(LEN.NE.0)) GO TO 32759 00480 IF(.NOT.(ITYPE.EQ.1)) GO TO 32758 00481 FOUND=.FALSE. 00482 GO TO 32756 00483 32757 IF(FOUND) GO TO 32755 00483 32756 IF (COMMND(LEN).NE.' '.AND.COMMND(LEN).NE.0)FOUND=.TRUE. 00484 IF (.NOT.FOUND)LEN=LEN-1 00485 GO TO 32757 00486 32755 J=LEN 00487 ISPACE=0 00488 GO TO 32753 00489 32754 IF(J.EQ.0.OR.ISPACE.NE.0) GO TO 32752 00489 32753 IF (COMMND(J).EQ.' ')ISPACE=J 00490 J=J-1 00491 IF (ISPACE.NE.0.AND.COMMND(ISPACE+1).EQ.'/')ISPACE=0 00492 GO TO 32754 00493 32752 IF(.NOT.(ISPACE.EQ.0)) GO TO 32751 00494 WRITE(5,10) 00495 10 FORMAT('$FILE?') 00496 READ(5,11,END=12)DEFLEN,(DEFAU(J),J=1,DEFLEN) 00497 11 FORMAT(Q,A1) 00498 IF(.NOT.(.TRUE.)) GO TO 32749 00499 RED=.TRUE. 00500 GO TO 32750 00501 32749 CONTINUE 00503 12 WRITE(5,13) 00503 13 FORMAT(' Required parameter not specified',/, 00504 1' Command terminated') 00505 CALL QEXIT 00506 32750 CONTINUE 00508 32751 CONTINUE 00509 32758 IF (ITYPE.NE.1) ISPACE=START 00510 IF(.NOT.(.NOT.RED)) GO TO 32748 00511 DEFLEN=0 00512 IF (ITYPE.EQ.1)COMMND(ISPACE)=0 00513 ZEBRA=1 00514 DO 32747 J=ISPACE+1,LEN 00515 DEFLEN=DEFLEN+1 00516 DEFAU(DEFLEN)=COMMND(J) 00517 IF (ITYPE.EQ.1)COMMND(J)=0 00518 ZEBRA=ZEBRA+1 00519 32747 CONTINUE 00520 IF (ITYPE.EQ.1)LEN=LEN-ZEBRA 00521 32748 ASSIGN 32745 TO I32746 00523 GO TO 32746 00523 32745 IF(.NOT.(DOTP.EQ.0)) GO TO 32744 00524 DOTP=DEFLEN+1 00525 DEFAU(DEFLEN+1)='.' 00526 DO 32743 J=1,3 00527 DEFAU(J+DEFLEN+1)=TYPE(J) 00527 32743 CONTINUE 00527 DEFLEN=DEFLEN+4 00528 32744 CONTINUE 00530 32759 RETURN 00531 32746 CONTINUE 00532 DOTP=0 00533 J=0 00534 GO TO 32741 00535 32742 IF(J.EQ.DEFLEN.OR.DOTP.NE.0) GO TO 32740 00535 32741 J=J+1 00536 IF (DEFAU(J).EQ.'.')DOTP=J 00537 GO TO 32742 00538 32740 GO TO I32746 00539 END 00540 SUBROUTINE SLASH(BUFFER,LEN,INDEX) 00541 IMPLICIT INTEGER (A-Z) 00542 BYTE BUFFER(1),LPAR,RPAR 00543 DATA LPAR/1H(/ 00544 DATA RPAR/1H)/ 00545 IF(LEN.LE.0) GO TO 32759 00546 J=INDEX 00547 INDEX=0 00548 GO TO 32757 00549 32758 IF(INDEX.NE.0) GO TO 32756 00549 32757 J=J+1 00550 IF(.NOT.(BUFFER(J).EQ.LPAR)) GO TO 32755 00551 FOUND=.FALSE. 00552 GO TO 32753 00553 32754 IF(J.GE.LEN.OR.FOUND) GO TO 32752 00553 32753 J=J+1 00554 IF (BUFFER(J).EQ.RPAR)FOUND=.TRUE. 00555 GO TO 32754 00556 32752 CONTINUE 00557 32755 IF (BUFFER(J).EQ.'/'.OR.J.GE.LEN)INDEX=J 00558 GO TO 32758 00559 32756 CONTINUE 00560 32759 RETURN 00561 END 00562 SUBROUTINE SPACE(COMMND,COMLEN) 00563 BYTE COMMND(1) 00564 IF(COMLEN.LT.1) GO TO 32759 00565 ZEBRA=0 00566 DO 32758 J=2,COMLEN+1 00567 IF(.NOT.(COMMND(J-1).EQ.' ')) GO TO 32757 00568 DO 32756 K=J,COMLEN 00569 COMMND(J-1)=COMMND(J) 00569 32756 CONTINUE 00569 ZEBRA=ZEBRA+1 00570 32757 CONTINUE 00572 32758 CONTINUE 00572 COMLEN=COMLEN-ZEBRA 00573 COMMND(COMLEN+1)=0 00574 32759 RETURN 00576 END 00577