C PROGRAM PUSH.FT C --------------- C SUBROUTINE PUSH(A,B) C C C C P.F.LEMKIN C NATIONAL INSTITUTES OF HEALTH C BETHESDA,MD 20014 C C APRIL 4, 1972 C REVISED DEC. 5, 1972 C C C C INTRODUCTION C -------- C THE FILE NAME "A" AND EXTENSION "B" ARE PUSHED INTO THE STACK C IN COMMON. THE NUMBER OF BLOCKS AND STARTING BLOCK NUMBER C ARE ALSO PUSHED. A MAXIMUM OF "MAX" FILES CAN BE PUSHED C INTO THE STACK. IF "SAVEF" IS "RES"TORE, THEN THE C LOOKUP IS NOT DONE AND THE NUMBER OF BLOCKS AND STARTING C BLOCK NUMBER ARE NOT MEANINGFUL. C C C C C ARGUMENTS C ========= C 1. A - IS THE FILE NAME. C 2. B - IS THE FILE NAME EXTENSION. C C C COMMON IPNT,STACK,RES,SAV,DIR,HEL,APP,ISTACK,COP,LPTDEV COMMON SAVEF,KDEV,ITIME,IBUF,MAX,T,IDYLM,IBKNMB,ISTBLK,ICREATION DIMENSION FFF(2),III(6),STACK(241,2),IBUF(256),ISTACK(241,6) DIMENSION ITIME(2),JJJ(3),IDYLM(3) EQUIVALENCE (FFF(1),III(1)),(QQQ,JJJ(1)),(RRR,KKKQ) C C 1. COPY THE PACKED FILENAME INTO FFF FFF(1)=A FFF(2)=B C C C C C C C C C 2. TEST IF OVERFLOW THE STACK. 301 IF(IPNT-MAX)303,303,302 C C C C C C 3. FAILED BECAUSE TOO MANY FILES, FATAL. 302 WRITE(KDEV,322) MAX 322 FORMAT(/,' > ',I5,' FILES') C CRASH CALL EXIT C C C C C C 4. CHECK IF THE FILE NAME ALREADY ON THE STACK. C BUT DO IT ONLY FOR "SAV"E AND "APP"END. 303 IF(SAVEF-RES)1304,1303,1304 1304 ICM=IPNT-1 DO 1302 IM=1,ICM QQQ=STACK(IM,1) RRR=STACK(IM,2) DO 1306 IAJ=1,3 IF(JJJ(IAJ)-III(IAJ))1302,1306,1302 1306 CONTINUE IF(KKKQ-III(4))1302,1332,1302 1302 CONTINUE GOTO 1303 C C C C C C 5. THIS FILE IS ALREADY ON THE STACK TELL THEM ABOUT IT. 1332 WRITE(KDEV,1333)FFF(1),FFF(2) 1333 FORMAT(' FILE ',A6,'.',A2,' ALREADY EXISTS') RETURN C C C C C C 6. THE FILE WAS VALID, GO PUSH "FILE NAME"==>STACK. 1303 STACK(IPNT,1)=FFF(1) STACK(IPNT,2)=FFF(2) ISTACK(IPNT,1)=ISTBLK ISTACK(IPNT,2)=IBKNMB ISTACK(IPNT,6)=ICREATION DO 1309 I=1,3 1309 ISTACK(IPNT,I+2)=IDYLM(I) IPNT=IPNT+1 RETURN C C C SPNTR, \FFF END