C PROGRAM MAGEX.FT C ================ C C C C P. LEMKIN C NATIONAL INSTITUTES OF HEALTH C BETHESDA, MD 20014 C C APRIL 4, 1972 C REVISED DECEMBER 7, 1972 C C C C C C C C INTRODUCTION C ------------- C EXECUTE THE MAGDMP COMMAND TO SAVE, RESTORE, APPEND, COPY C OR LIST THE DIRECTORY OF THE MAGTAPE. THE STACK "STACK" C CONTAINS THE NAME OF FILES TO SAVE OR RESTORE. IDYLM C CONTAINS THE DATE RESTRICTIONS (IF NON-ZERO) ON THE STORAGE C AND RETRIEVAL. (**AT THIS TIME THE IDYLM INFORMATION IS C NOT USED IN MAGEX, VERSION 1.3, ALTHOUGH THE DECODED INFORMATION C IS PRESENT.**) C C C C C C COMPILE AS: C =========== C .R FORT C *MAGEX.RL<--MAGEX.FT C C C C LOADING SEQUENCE: C ================ C .R LOADER C *MAGEX.RL,MAGTAP.RL,DATE.RL C *UTIL2.RL C *LIB8.RL/L$ C .SAVE DSK:MAGEX.SV 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),ISF(3),ISE(3),IDYLM(3) EQUIVALENCE (FFF(1),III(1)),(SF,ISF(1)),(SE,ISE(1)) C C C ..................PHASE II.......................... C 16. DONE WITH INPUT GO POP AND SAVE, RESTORE, APPEND, C COPY OR LIST THE DIRECTORY OF THE EXISTING MAGTAPE. WRITE(LPTDEV,16)SAVEF,IPNT 16 FORMAT(/////,'OPERATION: ',A3,', LIST LENGTH=',I5) C TEST IF HELP, THEN HELP THEM AND EXIT. IF(SAVEF-HEL)304,161,304 161 WRITE(KDEV,162) 162 FORMAT(/,'TYPE',/,'"SAVE" TO SAVE SYS FILES ON MTA0:',/,'"APPEND 1" TO APPEND SYS: FILES ONTO END OF LAST SAVE OR APPEND ON MTA0:',/ 2,'"RESTORE" TO RESTORE FILES FROM MTA0: TO SYS:',/,'"COPY" TO 3 COPY FILES FROM MTA0: TO MTA1:') WRITE(KDEV,163) 163 FORMAT('"DIRECTORY" TO LIST THE DIRECTORY OF MTA0:',/,'NOTE 1 THAT "*" CONVENTIONS IS USED FOR FILE NAMES.') C C C C 16.0.1 INITIAL THE SYSTEM. 304 JCOUNT=1 C INTITIAL THE FILE COUNTER. C REWIND THE MAGTAPE. CALL MAGTAP(0,0,1,IFLAG,-1,0) S TAD (5200 /"*@" S DCA \JT /SAVE SPECIAL PONTER. ICOPY=-1 C C C C 16.1 TEST IF COPY MTA0 TO MTA1. IF SO, THEN REWIND MTA1 TOO. IF(SAVEF-COP)305,303,305 303 CALL MAGTAP(0,0,1,IFLAG,-1,1) C C C C C C C C C 17. LOOP HERE TO POP THE STACK AND TEST IF DONE. 305 IF(SAVEF-DIR)1304,186,1304 1304 IF(SAVEF-APP)1303,180,1303 1303 IF(SAVEF-RES)1307,186,1307 1307 IF(SAVEF-COP)1305,186,1305 1305 IF(JCOUNT-IPNT)306,306,350 306 FFF(1)=STACK(JCOUNT,1) FFF(2)=STACK(JCOUNT,2) ISTBLK=ISTACK(JCOUNT,1) IBKNMB=ISTACK(JCOUNT,2) ICREATION=ISTACK(JCOUNT,6) DO 1306 I=1,3 1306 IDYLM(I)=ISTACK(JCOUNT,I+2) JCOUNT=JCOUNT+1 C C C C C C C 18.0 TEST IF SAVE THE FILES. 180 IF(SAVEF-SAV)186,181,186 C C C C C C 18.1.1 YES, SAVE IT. WRITE THE HEADER FIRST C FIRST COPY THE FILE NAME INTO THE FIRST 12 CHARCTERS. 181 DO 1812 LKJ=1,6 1812 IBUF(LKJ)=III(LKJ) C C C C C C 18.1.2 THEN WRITE THE DATE WORD CALL DATE(IBUF(7),IBUF(8),IBUF(9)) C C C C C C 18.1.3 THEN WRITE THE TIME IF ENTERED IBUF(10)=ITIME(1) IBUF(11)=ITIME(2) C C C C C C 18.1.4 ENTER THE # BLOCKS /FILES... IBUF(12)=IBKNMB C C C C C 18.1.5 UNPACK THE CREATION DATE S TAD I IDY /GET THE OLD DATE S DCA \IDYSAVE S TAD \ICREATION S DCA TEMP S TAD TEMP S AND (7 S DCA \IB15 /SAVE THE YEAR S TAD TEMP S RAR;RTR S AND (37 S DCA \IB14 /SAVE THE DAY S TAD TEMP S CLL RAL;RTL;RTL S AND (17 S DCA \IB13 /SAVE THE MONTH IBUF(13)=IB13 IBUF(14)=IB14 IBUF(15)=IB15 C C C C 18.1.6.1 SSAVE THE FILES MARK AS RESTORABLE=0 IBUF(16)=0 C C C C C 18.1.6.2 COPY THE OS/8 PACKED CURRENT DATE WORD IBUF(17)=IDYSAVE C C C C C 18.1.7 COPY THE FILE PACKED CREATION DATE WORD. IBUF(18)=ICREATION C C C C C C C C C C 18.1.8 NOW WRITE OUT THE FILE HEADER AND LIST ON LPT DEVICE. CALL MAGTAP(256,IBUF(1),4,IFLAG,-1,0) WRITE(LPTDEV,1684) (IBUF(N),N=1,4),(IBUF(N),N=7,16) C C C C 18.2 START MOVING DATA FROM THE SYS: TO THE OUTPUT BUFFER. ISTBLK=ISTBLK-1 DO 1831 IJKL=1,IBKNMB C C C C C C 18.3 MOVE ONE RECORD AT A TIME UNTIL MOVED ALL BLOCKS. ISTBLK=ISTBLK+1 S TAD \ISTBLK S DCA ZIT /SAVE THE STARTING BLOCK # IN THE CALL S CPAGE 2 /RESET THE CURRENT DATA FIELD WITH A CDFSKP S JMS 45 /CDFSKP S NOP S CLA S CPAGE 12 S 6202 /CIF 00 S JMS 7607 /CALL TO SYSTEM DEVICE HANDLER S 0210 /READ 2 PAGES INTO FIELD 1 S \IBUF /BUFFER TO PUT IT IN. SZIT, 0 /STARTING BLOCK # GOTO 183 GOTO 1835 183 WRITE(KDEV,1832) FFF(1),FFF(2) 1832 FORMAT('READ SYS: ERR=',A6,'.',A2) CALL EXIT C C C C C C 18.3.1 WRITE IT ON MAGTAP. 1835 CALL MAGTAP(256,IBUF(1),4,IFLAG,-1,0) C C C C C 18.3.1.2 CHECK FOR A WRITE PARITY ERROR. CALL MAGTAP(0,0,9,IFLAG,-1,0) IF(IFLAG)1831,1833,1833 C C C C C C 18.3.1.3 YES, TELL THEM ABOUT IT, BACKSPACE AND TRY AGAIN... 1833 WRITE(KDEV,1834)SAVEF,(FFF(IZ),IZ=1,2) 1834 FORMAT(A6,' PARITY ERROR AT FILE ',A6,'.',A2) CALL MAGTAP(1,0,7,IFLAG,-1,0) GOTO 1835 1831 CONTINUE C C C C C C 18.4 DONE. GO WRITE AN EOF 184 CALL MAGTAP(0,0,5,IFLAG,-1,0) GOTO 305 C C C C **PAGE C 18.6 RESTORE IT FROM MAGTAP. READ THE HEADER RECORD 186 CALL MAGTAP(256,IBUF(1),2,IFLAG,-1,0) C C C C C 18.6.0.1 TEST IF IT IS A DIRECTORY FIRST. IF SO, THEN LIST THE C HEADER AND THEN GO LOOK FOR AN EOF TO FINISH OUT THE FILE. C FIRST COPY THE FILE NAME IN CASE YOU NEED IT LATER... 1860 DO 1861 JKL=1,6 1861 III(JKL)=IBUF(JKL) IF(SAVEF-DIR)1681,1683,1681 C C C C C 18.6.0.2 PRINT THE INFORMATION IN THE FILE RECORD HEADER. 1683 WRITE(LPTDEV,1684)(IBUF(N),N=1,4),(IBUF(N),N=7,16) 1684 FORMAT(3A2,'.',A2,', ACC. ',I2,'/',I2,'/7',I1,', ',A2,':', 1 A2,', #BLKS ',I4,', CREAT. ',I2,'/',I2,'/7',I1,', MARK=',I1) GOTO 1863 C C C C C 18.6.1. GO OPEN THE DISK FILE OR COPY IF THE NAME ON STACK. C SEE IF THE NAME IS ON THE STACK. C UNLESS.... IT IS AN APPEND, IN WHICH CASE C MARK IT AS UNRESTORABLE AND GO WAIT FOR AN EOF. 1681 IF(SAVEF-APP)1682,1966,1682 1966 ICOPY=0 1682 DO 1862 JI=1,IPNT SF=STACK(JI,1) SE=STACK(JI,2) IFMATCH=-1 IEMATCH=-1 C C C C C 18.6.1.1 TEST FOR FILE='*' IF(JT-ISF)802,801,802 801 IFMATCH=0 C C C C C 18.6.1.2 (FILE.NE.'*'), TEST IF EXT='*' 802 IF(JT-ISE)804,803,804 803 IEMATCH=0 C C C C C 18.6.1.3 TEST IF (*.*), THEN MATCH EVERYTHING... 804 IF(IFMATCH+IEMATCH)805,1869,805 C C C C C 18.6.1.4 NOT '*.*', TEST THE FILENAME... C IF NOT THE FILE NAME THEN GET OUT OF CURRENT TEST. 805 IF(IFMATCH)806,807,806 806 DO 1806 JILL=1,3 IF(III(JILL)-ISF(JILL))1862,1806,1862 1806 CONTINUE C C C C C 18.6.1.5 (MATCHED THE FILE NAME ONE WAY OR ANOTHER), TES C THE EXTENSION EXT FOR A MATCH... 807 IF(IEMATCH)808,1869,808 808 IF(III(4)-ISE)1862,1869,1862 1862 CONTINUE C C C C C 18.6.2.1 SPACE FORWARD TO EOF. 1863 CALL MAGTAP(1,IBUF(1),2,IFLAG,-1,0) CALL MAGTAP(0,0,11,IFLAG,-1,0) IF(IFLAG)1863,1864,1863 C C C C C 18.6.2.2 TEST FOR 1 MORE EOF. C READ IT INTO THE BUFFER FOR POSSIBLE LATER USE... 1864 CALL MAGTAP(256,IBUF(1),2,IFLAG,-1,0) CALL MAGTAP(0,0,11,IFLAG,-1,0) IF(IFLAG)1860,1865,1860 C C C C C 18.6.2.3 TEST FOR AN APPEND IF FOUND THE 2ND EOF. C THEN GO DO A SAVE. 1865 IF(SAVEF-APP)353,1866,353 C C C C C 18.6.2.4 FOUND AN APPEND AT 2ND EOF BACKSPACE OVER IT. 1866 CALL MAGTAP(1,0,7,IFLAG,-1,0) SAVEF=SAV GOTO 305 C C C 18.6.3 IF AN APPEND, THEN MARK IT AS NON-RESTORABLE. C TEST IF COPY OR RESTORE. IF A COPY, THEN COPY C THE HEADER ONTO UNIT 1. 1869 IF(SAVEF-APP)1969,1968,1969 1968 IBUF(16)=1 C BACKSPACE AND REWRITE THIS RECORD CALL MAGTAP(1,0,7,IFLAG,-1,0) CALL MAGTAP(256,IBUF(1),4,IFLAG,-1,0) C GO SPACE FORWARD TO EOF GOTO 1863 C C C 18.6.3.0.1 TEST IF THE FILE IS MARKED AS NON-RESTORABLE. 1969 IF(IBUF(16))1863,1987,1863 C IT IS OK, GO RESTORE OR COPY IT... 1987 WRITE(LPTDEV,1684)(IBUF(N),N=1,4),(IBUF(N),N=7,16) IF(SAVEF-RES)1872,1871,1872 1872 CALL MAGTAP(256,IBUF(1),4,IFLAG,-1,1) GOTO 1877 C C C C C C C C 18.6.3.1 OPEN THE DISK FILE FOUND IF A RESTORE. 1871 IBKNMB=0 C SAVE THE CURRENT DATE AND PUT IN THE CREATION DATE OF THIS FILE. IDYSAVE=IDY IDY=IBUF(18) S TAD PNTR /SET UP FILENAME POINTER S DCA ENT1 S JMS 45 /CDFSKP RESET CURRENT DATA FIELD S CLA S CLA CLL IAC /SYS: C CPAGE 13 S 6212 /CIF 10 S JMS 7700 /USR IN FIELD 1 S 3 /ENTER IS A CODE 3 SENT1, 0 /POINTER TO FILE NAME. SENT2, 0 /- FILE LENGTH GOTO 1868 S CLA CMA /LOAD STARTING BLOCK # -1 BECAUSE INCREMENT FIRST. S TAD ENT1 S DCA \ISTBLK /SAVE THE STARTING BLOCK# GOTO 1877 C C C C C C 18.6.3.2 FATAL ENTER ERROR 1868 WRITE(KDEV,1867)FFF(1),FFF(2) 1867 FORMAT('ENTER ERR=',A6,'.',A2) CALL EXIT C C C C C C 18.7 GO INTO A READ/WRITE LOOP UNTIL TAPE EOF 1877 CALL MAGTAP(256,IBUF(1),2,IFLAG,-1,0) C C C C C 18.7.0.1 CHECK FOR PARITY ERROR ON READ, TRY AGAIN. CALL MAGTAP(0,0,9,IFLAG,-1,0) C ***DEBUG*** DON'T CHECK THE PARITY AT THIS TIME... GOTO 1878 C ************ IF(IFLAG)1879,1878,1878 C C C C C 18.7.0.2 YES, PARITY ERROR, NOTIFY THEM ABOUT IT AND C BACKUP AND TRY AGAIN. 1879 WRITE(KDEV,1834)SAVEF,(FFF(IZ),IZ=1,2) CALL MAGTAP(1,0,7,IFLAG,-1,0) GOTO 1877 C C C C C C C 18.7.1 TEST FOR MAGTAPE EOF., 1878 CALL MAGTAP(0,0,11,IFLAG,-1,0) IF(IFLAG)188,189,188 C C C C C **PAGE C C 18.8 WRITE IT ONTO THE DISK IF A RESTORE. 188 IBKNMB=IBKNMB+1 ISTBLK=ISTBLK+1 C TEST IF A RESTORE OR COPY IF(SAVEF-COP)1876,1875,1876 C COPY THE BUFFER ONTO UNIT 1 1875 CALL MAGTAP(256,IBUF(1),4,IFLAG,-1,1) GOTO 1877 S\1876, TAD \ISTBLK S DCA WRT1 S CPAGE 2 S JMS 45 /CDFSKP RESET CURRENT FIELD S NOP S CLA S CPAGE 10 S 6202 /CIF 00 S JMS 7607 /SYSTEM DEVICE HANDLER. S 4210 /WRITE 2 PAGES FROM FIELD 1 S \IBUF /BUFFER ADDRESS SWRT1, 0 /BLOCK # GOTO 1881 GOTO 1877 C C C C C C 18.8.1 FATAL DSK WRITE ERROR 1881 WRITE(KDEV,1882)FFF(1),FFF(2) 1882 FORMAT('SYS: WRITE ERR=',A6,'.',A2) CALL EXIT C C C C C C 18.9 TERMINATE THE OUTPUT FILE. C CLOSE IT IF IT IS A RESTORE, WRITE AN EOF ON MTA1: IF COPY. 189 IF(SAVEF-COP)1890,1893,1890 C WRITE THE EOF ON MTA1: 1893 CALL MAGTAP(0,0,5,IFLAG,-1,1) GOTO 305 S\1890, TAD PNTR /SET UP THE FILE NAME POINTER S DCA CLS1 S TAD \IBKNMB /SET UP THE # BLOCKS/FILE. S DCA CLS2 S JMS 45 /CDFSKP RESET CURRENT DATA FIELD S CLA S CLA CLL IAC /DEVICE SYS: S CPAGE 11 S 6212 /CIF 10 S JMS 7700 /USR IN FIELD 1 S 4 /IS A CLOSE FUNCTION SCLS1, 0 /POINTER TO FILE NAME SCLS2, 0 /# BLOCKS/FILE. GOTO 1891 C RESTORE THE CURRENT DATE IDY=IDYSAVE GOTO 305 C C C C C C 18.9.1 ERROR ON RESTORE -CLOSE 1891 WRITE(KDEV,1892)FFF(1),FFF(2) 1892 FORMAT('CLOSE ERR=',A6,'.',A2) CALL EXIT C C C C C 19.1 ALL DONE, IF SAV WRITE 10 EXTRA EOFS 350 IF(SAVEF-SAV)354,351,354 C IF IT IS A COPY, WRITE THE EXTRA EOF ON MTA1: 354 IF(ICOPY)353,355,353 355 DO 1355 I=1,10 1355 CALL MAGTAP(0,0,5,IFLAG,-1,1) C REWIND MTA1: CALL MAGTAP(0,0,1,IFLAG,-1,1) 351 DO 1351 I=1,10 1351 CALL MAGTAP(0,0,5,IFLAG,-1,0) C C C C C C 19.2 ALL DONE, REWIND THE MAGTAPE AND GO EXIT TO OS/8. 353 CALL MAGTAP(0,0,1,IFLAG,-1,0) CALL EXIT C SPNTR,\FFF S DUMMY IDY SIDY, 6211 /THE OS/8 DATE WORD S 7666 STEMP, 0 C C C END