PROGRAM RSXCCL 00001 BYTE LI(80),LO(79),PROTEC(8) 00002 REAL*8 SECURT 00003 LOGICAL*1 FLAG,FSLASH,FVIRG,FNUIC,FSEC 00004 EQUIVALENCE (LI(1),CMCR),(PROTEC,SECURT) 00005 DATA XMCR/6RMCR.../ 00006 DO 32758 I=1,80 00007 LI(I)=' ' 00007 32758 CONTINUE 00007 FLAG=.FALSE. 00010 ID=5 ! MONO-LIGNE: LA COMMANDE DEBUTE EN 5 00011 NTCAR=6 ! MONO-LIGNE: NTCAR-3=3 => MULTI-LIGNE 00012 CALL GETMCR(LI,NCHAR) 00013 IF (NCHAR.EQ.3) LI(4)=' ' 00014 SMCR=CMCR 00016 100 LO(1)='P' 00017 LO(2)='I' 00018 LO(3)='P' 00019 LO(4)=' ' 00020 DO 32757 I=5,79 00021 LO(I)=0 00021 32757 CONTINUE 00021 IF(.NOT.(SMCR.EQ.'FRE')) GO TO 32755 00024 DO 32754 I=4,NCHAR 00026 LO(I)=LI(I) 00027 32754 CONTINUE 00028 LO(NCHAR+2)='/' ! SI ">FRE",NCHAR=3 :IL FAUT 00029 LO(NCHAR+3)='F' ! MENAGER UN INTERVALLE 00030 LO(NCHAR+4)='R' 00031 GO TO 32756 00032 32755 IF(.NOT.(SMCR.EQ.'DIR')) GO TO 32753 00032 IF(NCHAR.EQ.3) GO TO 32752 00035 DO 32751 I=4,NCHAR 00037 LO(I)=LI(I) 00037 32751 CONTINUE 00037 32752 LO(NCHAR+2)='/' ! SI ">DIR",NCHAR=3 :IL FAUT 00040 LO(NCHAR+3)='L' ! MENAGER UN INTERVALLE 00041 LO(NCHAR+4)='I' 00042 GO TO 32756 00043 32753 IF(.NOT.(SMCR.EQ.'ALF' .OR. SMCR.EQ.'SER' .OR. SMCR.EQ.'EXP')) GO 00043 1TO 32750 00043 LO(1)='S' 00046 LO(2)='R' 00047 LO(3)='D' 00048 LO(4)='' 00049 IAN=4 00050 I=4 00051 FNUIC=.TRUE. 00052 32749 IF(.NOT.(IAN.LE.NCHAR .AND. FNUIC)) GO TO 32748 00053 IAN=IAN+1 00055 IF(.NOT.(LI(IAN).EQ.'[')) GO TO 32747 00056 32746 IF(.NOT.(IAN.LE.NCHAR .AND. FNUIC)) GO TO 32745 00058 I=I+1 00060 LO(I)=LI(IAN) 00061 IF (LI(IAN).EQ.']') FNUIC=.FALSE. 00062 IAN=IAN+1 00064 GO TO 32746 00065 32745 CONTINUE 00066 32747 GO TO 32749 00067 32748 IF (FNUIC) IAN=5 00068 LO(I+1)='/' 00070 LO(I+2)='S' 00071 LO(I+3)='E' 00072 I=I+4 00073 IF(.NOT.(IAN.LE.NCHAR)) GO TO 32744 00074 LO(I)=':' 00076 DO 32743 K=IAN,NCHAR 00077 I=I+1 00078 LO(I)=LI(K) 00079 32743 CONTINUE 00080 32744 IF(.NOT.(SMCR.EQ.'ALF')) GO TO 32742 00081 LO(I+1)='/' 00083 LO(I+2)='N' 00084 LO(I+3)='A' 00085 32742 IF(.NOT.(SMCR.EQ.'EXP')) GO TO 32741 00086 LO(I+1)='/' 00088 LO(I+2)='N' 00089 LO(I+3)='E' 00090 32741 GO TO 32756 00091 32750 IF(.NOT.(SMCR.EQ.'DAT')) GO TO 32740 00091 LO(1)='S' 00094 LO(2)='R' 00095 LO(3)='D' 00096 LO(4)='' 00097 IAN=4 00098 I=4 00099 FNUIC=.TRUE. 00100 32739 IF(.NOT.(IAN.LE.NCHAR .AND. FNUIC)) GO TO 32738 00101 IAN=IAN+1 00103 IF(.NOT.(LI(IAN).EQ.'[')) GO TO 32737 00104 32736 IF(.NOT.(IAN.LE.NCHAR .AND. FNUIC)) GO TO 32735 00106 I=I+1 00108 LO(I)=LI(IAN) 00109 IF (LI(IAN).EQ.']') FNUIC=.FALSE. 00110 IAN=IAN+1 00112 GO TO 32736 00113 32735 CONTINUE 00114 32737 GO TO 32739 00115 32738 LO(I+1)='/' 00116 LO(I+2)='D' 00117 LO(I+3)='A' 00118 LO(I+4)='/' 00119 LO(I+5)='N' 00120 LO(I+6)='A' 00121 LO(I+7)='/' 00122 LO(I+8)='M' 00123 LO(I+9)='I' 00124 GO TO 32756 00125 32740 IF(.NOT.(NCHAR.EQ.NTCAR-3)) GO TO 32734 00125 10 TYPE 1,SMCR,'>' 00128 1 FORMAT('$',A3,A1) 00129 FLAG=.TRUE. 00130 READ(5,2,END=110)NCHAR,LI 00131 2 FORMAT(Q,80A1) 00132 DO 32733 IB=1,NCHAR 00133 IF(.NOT.(LI(IB).NE.' ')) GO TO 32732 00134 ID=1 ! MULTI-LIGNE: TOUT EST UTIL 00136 NTCAR=3 ! MULTI-LIGNE: NTCAR-3=0 => MULTI-LIGNE 00137 GO TO 100 00138 32732 CONTINUE 00139 32733 CONTINUE 00139 GO TO 10 00141 GO TO 32756 00142 32734 IF(.NOT.(SMCR.EQ.'TYP')) GO TO 32731 00142 LO(5)='T' 00145 LO(6)='I' 00146 LO(7)=':' 00147 LO(8)='=' 00148 DO 32730 I=ID,NCHAR 00149 LO(I-ID+9)=LI(I) 00149 32730 CONTINUE 00149 GO TO 32756 00152 32731 IF(.NOT.(SMCR.EQ.'COP')) GO TO 32729 00152 DO 32728 I=ID,NCHAR 00155 LO(I-ID+5)=LI(I) 00156 32728 CONTINUE 00157 GO TO 32756 00158 32729 IF(.NOT.(SMCR.EQ.'DEL')) GO TO 32727 00158 FSEC=.TRUE. 00161 SECURT='' 00162 J=1 00163 DO 32726 I=ID,NCHAR 00164 IF(LI(I).EQ.'') GO TO 32725 00165 IF(.NOT.(LI(I).EQ.','.OR.LI(I).EQ.':'.OR.LI(I).EQ.']')) GO TO 3272 00167 13 00167 SECURT='' 00169 J=1 00170 GO TO 32724 00171 32723 IF(.NOT.(J.LT.8)) GO TO 32722 00172 PROTEC (J)=LI(I) 00174 J=J+1 00175 32722 CONTINUE 00176 32724 IF(('*.*;*').NE.(SECURT)) GO TO 32720 00177 TYPE *,'===> ETES-VOUS FOU ! ? !' 00179 TYPE *,'===> Vous voulez detruire TOUS vos programmes ?' 00180 TYPE *,'===> Ne comptez pas sur moi pour cette folie' 00181 FSEC=.FALSE. 00182 GO TO 32721 00183 32720 IF(('*.FLX;*').NE.(SECURT)) GO TO 32719 00183 TYPE *,'===> HELP ! ! ! ' 00186 TYPE *,'===> Vous allez detruire TOUS vos FLEXs !' 00187 TYPE *,'===> Je tiens a la vie, je ne marche pas' 00188 FSEC=.FALSE. 00189 GO TO 32721 00190 32719 IF(('*.FTN;*').NE.(SECURT)) GO TO 32718 00190 TYPE *,'===> HE OH !!!' 00193 TYPE *,'===> Vous allez detruire TOUS vos FORTRANs !' 00194 TYPE *,'===> Je n''ais pas l''ame d''un boureau' 00195 FSEC=.FALSE. 00196 GO TO 32721 00197 32718 IF(('*.TSK;*').NE.(SECURT)) GO TO 32717 00197 TYPE *,'===> HE ! STOP !!' 00200 TYPE *,'===> Vous allez ecraser TOUTES vos TACHES ' 00201 TYPE *,'===> Apres qui devra RE-TKB ? C''est moi ...' 00202 FSEC=.FALSE. 00203 32717 CONTINUE 00204 32721 CONTINUE 00205 32725 CONTINUE 00206 32726 CONTINUE 00206 IF(.NOT.(FSEC)) CALL EXIT 00208 FNUIC=.TRUE. 00210 FVIRG=.TRUE. 00211 NV=5 00212 DO 32716 I=ID,NCHAR 00213 IF (LI(I).EQ.'[') FNUIC=.FALSE. 00214 IF (LI(I).EQ.']') FNUIC=.TRUE. 00216 IF(.NOT.(LI(I).EQ.',' .AND. FNUIC)) GO TO 32715 00218 IF(.NOT.(FVIRG)) GO TO 32714 00220 INST=I-ID+5 00222 LO(INST)='/' 00223 LO(INST+1)='L' 00224 LO(INST+2)='D' 00225 FVIRG=.FALSE. 00226 NV=NV+3 00227 32714 CONTINUE 00228 32715 LO(I-ID+NV)=LI(I) 00229 32716 CONTINUE 00230 INST=NCHAR-ID+NV+1 00231 LO(INST)='/' 00232 LO(INST+1)='D' 00233 LO(INST+2)='E' 00234 IF(.NOT.(FVIRG)) GO TO 32713 00235 INST=INST+3 00237 LO(INST)='/' 00238 LO(INST+1)='L' 00239 LO(INST+2)='D' 00240 32713 GO TO 32756 00241 32727 IF(.NOT.(SMCR.EQ.'SDL')) GO TO 32712 00241 DO 32711 I=ID,NCHAR 00244 LO(I-ID+5)=LI(I) 00245 32711 CONTINUE 00246 NV=1 00247 IF (ID.EQ.1) NV=5 00248 LO(NCHAR+NV)='/' ! FORME MONO-LIGNE :ID=5 ON PLACE "/" 00250 LO(NCHAR+NV+1)='S' ! EN "NCHAR+1" - MULTILIGNE : ID=1 00251 LO(NCHAR+NV+2)='D' ! LE "/" EN "NCHAR+5" (4 CAR. "PIP ") 00252 GO TO 32756 00253 32712 IF(.NOT.(SMCR.EQ.'SDX')) GO TO 32710 00253 LO(1)='S' 00256 LO(2)='R' 00257 LO(3)='D' 00258 LO(4)='' 00259 LO(5)='/' 00260 LO(6)='S' 00261 LO(7)='E' 00262 LO(8)=':' 00263 FVIRG=.TRUE. 00264 I=8 00265 IAN=ID 00266 32709 IF(.NOT.(IAN.LE.NCHAR .AND. FVIRG)) GO TO 32708 00267 IF(LI(IAN).EQ.'') GO TO 32707 00269 I=I+1 00271 IF(.NOT.(LI(IAN).EQ.',')) GO TO 32705 00272 FVIRG=.FALSE. 00272 GO TO 32706 00272 32705 LO(I)=LI(IAN) 00276 32706 CONTINUE 00277 32707 IAN=IAN+1 00278 GO TO 32709 00279 32708 LO(I+1)='/' 00280 LO(I+2)='S' 00281 LO(I+3)='D' 00282 LO(I+4)='/' 00283 LO(I+5)='M' 00284 LO(I+6)='I' 00285 LO(I+7)='/' 00286 LO(I+8)='N' 00287 LO(I+9)='A' 00288 GO TO 32756 00289 32710 IF(.NOT.(SMCR.EQ.'REN')) GO TO 32704 00289 DO 32703 I=ID,NCHAR 00292 LO(I-ID+5)=LI(I) 00293 32703 CONTINUE 00294 NV=1 00295 IF (ID.EQ.1) NV=5 00296 LO(NCHAR+NV)='/' 00298 LO(NCHAR+NV+1)='R' 00299 LO(NCHAR+NV+2)='E' 00300 GO TO 32756 00301 32704 IF(.NOT.(SMCR.EQ.'DLK')) GO TO 32702 00301 DO 32701 I=ID,NCHAR 00304 LO(I-ID+5)=LI(I) 00305 32701 CONTINUE 00306 NV=1 00307 IF (ID.EQ.1) NV=5 00308 LO(NCHAR+NV)='/' 00310 LO(NCHAR+NV+1)='U' 00311 LO(NCHAR+NV+2)='N' 00312 GO TO 32756 00313 32702 IF(.NOT.(SMCR.EQ.'EOF')) GO TO 32700 00313 DO 32699 I=ID,NCHAR 00316 LO(I-ID+5)=LI(I) 00317 32699 CONTINUE 00318 NV=1 00319 IF (ID.EQ.1) NV=5 00320 LO(NCHAR+NV)='/' 00322 LO(NCHAR+NV+1)='E' 00323 LO(NCHAR+NV+2)='O' 00324 LO(NCHAR+NV+3)='F' 00325 GO TO 32756 00326 32700 IF(.NOT.(SMCR.EQ.'PUR')) GO TO 32698 00326 ISLH=0 ! INDICE DE POSITION DU 1 "/" 00329 ILD=0 ! " " 1 "," 00330 IVRG=0 ! " " DERN. "," 00331 FNUIC=.TRUE. 00332 N=5-ID 00333 DO 32697 IAN=ID,NCHAR 00334 IF(.NOT.(ISLH.EQ.0 .AND. LI(IAN).EQ.'/')) GO TO 32695 00335 ISLH=IAN 00335 GO TO 32696 00338 32695 IF(.NOT.(LI(IAN).EQ.'[')) GO TO 32694 00338 FNUIC=.FALSE. 00338 GO TO 32696 00342 32694 IF(.NOT.(LI(IAN).EQ.']')) GO TO 32693 00342 FNUIC=.TRUE. 00342 GO TO 32696 00346 32693 IF(.NOT.(ILD.EQ.0 .AND. LI(IAN).EQ.',' .AND. FNUIC)) GO TO 32692 00346 ILD =IAN 00346 GO TO 32696 00350 32692 IF(.NOT.(LI(IAN).EQ.',' .AND. FNUIC)) GO TO 32691 00350 IVRG =IAN 00350 32691 CONTINUE 00354 32696 CONTINUE 00355 32697 CONTINUE 00355 IF(.NOT.(ISLH.EQ.ID.OR.IVRG.EQ.ID.OR.ILD.EQ.ID)) GO TO 32689 00357 TYPE *,'===>> Mauvaise ligne de commande CCL <<===' 00359 GO TO 32690 00360 32689 IF(.NOT.(ISLH.NE.0 .AND. IVRG.GT.ISLH)) GO TO 32687 00361 DO 32686 I=ID,NCHAR 00363 IF(.NOT.(LI(I).EQ.'/')) GO TO 32684 00364 LO(I+N)=LI(I) 00366 LO(I+N+1)='P' 00367 LO(I+N+2)='U' 00368 LO(I+N+3)=':' 00369 N=N+3 00370 GO TO 32685 00371 32684 IF(.NOT.(I.EQ.ILD)) GO TO 32683 00371 LO(I+N)='/' 00374 LO(I+N+1)='L' 00375 LO(I+N+2)='D' 00376 LO(I+N+3)=LI(I) 00377 N=N+3 00378 GO TO 32685 00379 32683 LO(I+N)=LI(I) 00379 32685 CONTINUE 00381 32686 CONTINUE 00381 GO TO 32688 00383 32687 IF(.NOT.(ISLH.EQ.0)) GO TO 32681 00384 NFIN=NCHAR 00384 GO TO 32682 00384 32681 NFIN=ISLH-1 00388 32682 IF(.NOT.(ILD.EQ.0)) GO TO 32679 00389 NSTOP=NFIN 00389 GO TO 32680 00389 32679 NSTOP=ILD-1 00393 32680 DO 32678 I=ID,NSTOP 00394 LO(I+N)=LI(I) 00394 32678 CONTINUE 00394 I=NSTOP 00397 LO(I+N+1)='/' 00398 LO(I+N+2)='L' 00399 LO(I+N+3)='D' 00400 LO(I+N+4)='/' 00401 LO(I+N+5)='P' 00402 LO(I+N+6)='U' 00403 I=I+N+6 00404 IF(ISLH.EQ.0) GO TO 32677 00405 I=I+1 00407 LO(I)=':' 00408 DO 32676 J=ISLH+1,NCHAR 00409 I=I+1 00410 LO(I)=LI(J) 00411 32676 CONTINUE 00412 32677 IF(ILD.EQ.0) GO TO 32675 00413 DO 32674 J=ILD,NFIN 00415 I=I+1 00416 LO(I)=LI(J) 00417 32674 CONTINUE 00418 32675 CONTINUE 00419 32688 CONTINUE 00420 32690 GO TO 32756 00421 32698 TYPE *,'===>> Commande incorrecte (4 lettres?) <<===' 00422 CALL EXIT 00423 32756 IEFN=50 00424 GO TO 32672 00425 32673 IF(.NOT.(IDS.EQ.-7)) GO TO 32671 00425 32672 CALL CLREF(IEFN) 00428 CALL SPAWN(XMCR,,,IEFN,,,,LO,79,,,IDS) 00429 IF(.NOT.(IDS.EQ.-7)) GO TO 32669 00430 TYPE *,'===>> Patience, la tache est ACTIVE <<===' 00430 GO TO 32670 00433 32669 IF(.NOT.(IDS.LT.0)) GO TO 32668 00433 TYPE*,'===>> ERREUR FATALE <<===' 00436 TYPE 99,LO 00437 99 FORMAT(' LO = '/1X ,79A1) 00438 TYPE *,' IDS ',IDS 00439 TYPE 199,LO 00440 199 FORMAT(' LO = '/4(1X,20 O4)/) 00441 CALL EXIT 00442 32668 CONTINUE 00443 32670 CALL WAITFR(IEFN) 00444 GO TO 32673 00445 32671 IF(.NOT.(SMCR.EQ.'SDX'.AND. .NOT.FVIRG)) GO TO 32667 00446 DO 32666 IAN=ID,NCHAR 00448 IF(.NOT.(LI(IAN).EQ.',')) GO TO 32664 00449 LI(IAN)='' 00451 GO TO 100 00452 GO TO 32665 00453 32664 LI(IAN)='' 00454 32665 CONTINUE 00455 32666 CONTINUE 00455 32667 IF(.NOT.(FLAG)) GO TO 32663 00457 90 TYPE 1,SMCR,'>' 00459 READ(5,2,END=110)NCHAR,LI 00460 DO 32662 IB=1,NCHAR 00461 IF (LI(IB).NE.' ') GO TO 100 00462 32662 CONTINUE 00464 GO TO 90 00465 32663 CONTINUE 00466 110 CALL EXIT 00466 END 00468