PROGRAM PIPCCL 00001 BYTE LI(80),LO(79) 00002 LOGICAL*1 FLAG,FSLASH,FVIRG,FNUIC 00003 EQUIVALENCE (LI(1),CMCR) 00004 DATA XMCR/6RMCR.../ 00005 DO 32758 I=1,80 00006 LI(I)=' ' 00006 32758 CONTINUE 00006 FLAG=.FALSE. 00009 ID=5 ! MONO-LIGNE: LA COMMANDE DEBUTE EN 5 00010 NTCAR=6 ! MONO-LIGNE: NTCAR-3=3 => MULTI-LIGNE 00011 CALL GETMCR(LI,NCHAR) 00012 IF (NCHAR.EQ.3) LI(4)=' ' 00013 SMCR=CMCR 00015 100 LO(1)='P' 00016 LO(2)='I' 00017 LO(3)='P' 00018 LO(4)=' ' 00019 DO 32757 I=5,79 00020 LO(I)=0 00020 32757 CONTINUE 00020 IF(.NOT.(SMCR.EQ.'FRE')) GO TO 32755 00023 DO 32754 I=4,NCHAR 00025 LO(I)=LI(I) 00026 32754 CONTINUE 00027 LO(NCHAR+2)='/' ! SI ">FRE",NCHAR=3 :IL FAUT 00028 LO(NCHAR+3)='F' ! MENAGER UN INTERVALLE 00029 LO(NCHAR+4)='R' 00030 GO TO 32756 00031 32755 IF(.NOT.(SMCR.EQ.'DIR')) GO TO 32753 00031 IF(NCHAR.EQ.3) GO TO 32752 00034 DO 32751 I=4,NCHAR 00036 LO(I)=LI(I) 00036 32751 CONTINUE 00036 32752 LO(NCHAR+2)='/' ! SI ">DIR",NCHAR=3 :IL FAUT 00039 LO(NCHAR+3)='L' ! MENAGER UN INTERVALLE 00040 LO(NCHAR+4)='I' 00041 GO TO 32756 00042 32753 IF(.NOT.(NCHAR.EQ.NTCAR-3)) GO TO 32750 00042 10 TYPE 1,SMCR,'>' 00045 1 FORMAT('$',A3,A1) 00046 FLAG=.TRUE. 00047 READ(5,2,END=110)NCHAR,LI 00048 2 FORMAT(Q,80A1) 00049 DO 32749 IB=1,NCHAR 00050 IF(.NOT.(LI(IB).NE.' ')) GO TO 32748 00051 ID=1 ! MULTI-LIGNE: TOUT EST UTIL 00053 NTCAR=3 ! MULTI-LIGNE: NTCAR-3=0 => MULTI-LIGNE 00054 GO TO 100 00055 32748 CONTINUE 00056 32749 CONTINUE 00056 GO TO 10 00058 GO TO 32756 00059 32750 IF(.NOT.(SMCR.EQ.'TYP')) GO TO 32747 00059 LO(5)='T' 00062 LO(6)='I' 00063 LO(7)=':' 00064 LO(8)='=' 00065 DO 32746 I=ID,NCHAR 00066 LO(I-ID+9)=LI(I) 00066 32746 CONTINUE 00066 GO TO 32756 00069 32747 IF(.NOT.(SMCR.EQ.'COP')) GO TO 32745 00069 DO 32744 I=ID,NCHAR 00072 LO(I-ID+5)=LI(I) 00073 32744 CONTINUE 00074 GO TO 32756 00075 32745 IF(.NOT.(SMCR.EQ.'DEL')) GO TO 32743 00075 FNUIC=.TRUE. 00078 FVIRG=.TRUE. 00079 NV=5 00080 DO 32742 I=ID,NCHAR 00081 IF (LI(I).EQ.'[') FNUIC=.FALSE. 00082 IF (LI(I).EQ.']') FNUIC=.TRUE. 00084 IF(.NOT.(LI(I).EQ.',' .AND. FNUIC)) GO TO 32741 00086 IF(.NOT.(FVIRG)) GO TO 32740 00088 INST=I-ID+5 00090 LO(INST)='/' 00091 LO(INST+1)='L' 00092 LO(INST+2)='D' 00093 FVIRG=.FALSE. 00094 NV=NV+3 00095 32740 CONTINUE 00096 32741 LO(I-ID+NV)=LI(I) 00097 32742 CONTINUE 00098 INST=NCHAR-ID+NV+1 00099 LO(INST)='/' 00100 LO(INST+1)='D' 00101 LO(INST+2)='E' 00102 IF(.NOT.(FVIRG)) GO TO 32739 00103 INST=INST+3 00105 LO(INST)='/' 00106 LO(INST+1)='L' 00107 LO(INST+2)='D' 00108 32739 GO TO 32756 00109 32743 IF(.NOT.(SMCR.EQ.'SDL')) GO TO 32738 00109 DO 32737 I=ID,NCHAR 00112 LO(I-ID+5)=LI(I) 00113 32737 CONTINUE 00114 NV=1 00115 IF (ID.EQ.1) NV=5 00116 LO(NCHAR+NV)='/' ! FORME MONO-LIGNE :ID=5 ON PLACE "/" 00118 LO(NCHAR+NV+1)='S' ! EN "NCHAR+1" - MULTILIGNE : ID=1 00119 LO(NCHAR+NV+2)='D' ! LE "/" EN "NCHAR+5" (4 CAR. "PIP ") 00120 GO TO 32756 00121 32738 IF(.NOT.(SMCR.EQ.'REN')) GO TO 32736 00121 DO 32735 I=ID,NCHAR 00124 LO(I-ID+5)=LI(I) 00125 32735 CONTINUE 00126 NV=1 00127 IF (ID.EQ.1) NV=5 00128 LO(NCHAR+NV)='/' 00130 LO(NCHAR+NV+1)='R' 00131 LO(NCHAR+NV+2)='E' 00132 GO TO 32756 00133 32736 IF(.NOT.(SMCR.EQ.'DLK')) GO TO 32734 00133 DO 32733 I=ID,NCHAR 00136 LO(I-ID+5)=LI(I) 00137 32733 CONTINUE 00138 NV=1 00139 IF (ID.EQ.1) NV=5 00140 LO(NCHAR+NV)='/' 00142 LO(NCHAR+NV+1)='U' 00143 LO(NCHAR+NV+2)='N' 00144 GO TO 32756 00145 32734 IF(.NOT.(SMCR.EQ.'EOF')) GO TO 32732 00145 DO 32731 I=ID,NCHAR 00148 LO(I-ID+5)=LI(I) 00149 32731 CONTINUE 00150 NV=1 00151 IF (ID.EQ.1) NV=5 00152 LO(NCHAR+NV)='/' 00154 LO(NCHAR+NV+1)='E' 00155 LO(NCHAR+NV+2)='O' 00156 LO(NCHAR+NV+3)='F' 00157 GO TO 32756 00158 32732 IF(.NOT.(SMCR.EQ.'PUR')) GO TO 32730 00158 ISLH=0 ! INDICE DE POSITION DU 1 "/" 00161 ILD=0 ! " " 1 "," 00162 IVRG=0 ! " " DERN. "," 00163 FNUIC=.TRUE. 00164 N=5-ID 00165 DO 32729 IAN=ID,NCHAR 00166 IF(.NOT.(ISLH.EQ.0 .AND. LI(IAN).EQ.'/')) GO TO 32727 00167 ISLH=IAN 00167 GO TO 32728 00170 32727 IF(.NOT.(LI(IAN).EQ.'[')) GO TO 32726 00170 FNUIC=.FALSE. 00170 GO TO 32728 00174 32726 IF(.NOT.(LI(IAN).EQ.']')) GO TO 32725 00174 FNUIC=.TRUE. 00174 GO TO 32728 00178 32725 IF(.NOT.(ILD.EQ.0 .AND. LI(IAN).EQ.',' .AND. FNUIC)) GO TO 32724 00178 ILD =IAN 00178 GO TO 32728 00182 32724 IF(.NOT.(LI(IAN).EQ.',' .AND. FNUIC)) GO TO 32723 00182 IVRG =IAN 00182 32723 CONTINUE 00186 32728 CONTINUE 00187 32729 CONTINUE 00187 IF(.NOT.(ISLH.EQ.ID.OR.IVRG.EQ.ID.OR.ILD.EQ.ID)) GO TO 32721 00189 TYPE *,'===>> Mauvaise ligne de commande CCL <<===' 00191 GO TO 32722 00192 32721 IF(.NOT.(ISLH.NE.0 .AND. IVRG.GT.ISLH)) GO TO 32719 00193 DO 32718 I=ID,NCHAR 00195 IF(.NOT.(LI(I).EQ.'/')) GO TO 32716 00196 LO(I+N)=LI(I) 00198 LO(I+N+1)='P' 00199 LO(I+N+2)='U' 00200 LO(I+N+3)=':' 00201 N=N+3 00202 GO TO 32717 00203 32716 IF(.NOT.(I.EQ.ILD)) GO TO 32715 00203 LO(I+N)='/' 00206 LO(I+N+1)='L' 00207 LO(I+N+2)='D' 00208 LO(I+N+3)=LI(I) 00209 N=N+3 00210 GO TO 32717 00211 32715 LO(I+N)=LI(I) 00211 32717 CONTINUE 00213 32718 CONTINUE 00213 GO TO 32720 00215 32719 IF(.NOT.(ISLH.EQ.0)) GO TO 32713 00216 NFIN=NCHAR 00216 GO TO 32714 00216 32713 NFIN=ISLH-1 00220 32714 IF(.NOT.(ILD.EQ.0)) GO TO 32711 00221 NSTOP=NFIN 00221 GO TO 32712 00221 32711 NSTOP=ILD-1 00225 32712 DO 32710 I=ID,NSTOP 00226 LO(I+N)=LI(I) 00226 32710 CONTINUE 00226 I=NSTOP 00229 LO(I+N+1)='/' 00230 LO(I+N+2)='L' 00231 LO(I+N+3)='D' 00232 LO(I+N+4)='/' 00233 LO(I+N+5)='P' 00234 LO(I+N+6)='U' 00235 I=I+N+6 00236 IF(ISLH.EQ.0) GO TO 32709 00237 I=I+1 00239 LO(I)=':' 00240 DO 32708 J=ISLH+1,NCHAR 00241 I=I+1 00242 LO(I)=LI(J) 00243 32708 CONTINUE 00244 32709 IF(ILD.EQ.0) GO TO 32707 00245 DO 32706 J=ILD,NFIN 00247 I=I+1 00248 LO(I)=LI(J) 00249 32706 CONTINUE 00250 32707 CONTINUE 00251 32720 CONTINUE 00252 32722 GO TO 32756 00253 32730 TYPE *,'===>> Commande incorrecte (4 lettres?) <<===' 00254 CALL EXIT 00255 32756 IEFN=50 00256 GO TO 32704 00257 32705 IF(.NOT.(IDS.EQ.-7)) GO TO 32703 00257 32704 CALL CLREF(IEFN) 00260 CALL SPAWN(XMCR,,,IEFN,,,,LO,79,,,IDS) 00261 IF(.NOT.(IDS.EQ.-7)) GO TO 32701 00262 TYPE *,'===>> Patience, la tache est ACTIVE <<===' 00262 GO TO 32702 00265 32701 IF(.NOT.(IDS.LT.0)) GO TO 32700 00265 TYPE*,'===>> ERREUR FATALE <<===' 00268 CALL EXIT 00269 32700 CONTINUE 00270 32702 CALL WAITFR(IEFN) 00271 GO TO 32705 00272 32703 IF(.NOT.(FLAG)) GO TO 32699 00273 90 TYPE 1,SMCR,'>' 00275 READ(5,2,END=110)NCHAR,LI 00276 DO 32698 IB=1,NCHAR 00277 IF (LI(IB).NE.' ') GO TO 100 00278 32698 CONTINUE 00280 GO TO 90 00281 32699 CONTINUE 00282 110 CALL EXIT 00282 END 00284