C PROGRAM TO DUMP OR RESTORE A TABLE FOR STORAGE OR TRANSFER C C PDP11/IAS VERSION. C C Submitted by: C C R. N. Stillwell C Institute for Lipid Research C Baylor College of Medicine C Houston, Texas 77030 C C (who would be glad to receive comments, suggestions, bug fixes, etc., but C who promises no support whatever). C C Literature reference: C C R. N. Stillwell. A low-overhead laboratory data management system C for the PDP11. Comput. Biomed. Res., 15, 29-38(1982). C C Acknowledgement: C C This software was developed under National Institutes of Health grants C GM-13901 and GM-26611. C C General permission is hereby granted to copy, modify, or distribute this C program, but not for profit. Copyright to this software is and shall C remain in the public domain. C C ARRAY FOR THE TABLE DATA BYTE DATA(1000) C COLUMN POINTERS INTEGER IPTRD(41) C SCRATCH INTEGERS INTEGER ISCR(500) EQUIVALENCE (ISCR,DATA) C CHAR NAMES OF FILES BYTE DMPNAM(20),TAINAM(20),TABNAM(20) C C INTEGER VARIABLES AND FUNCTIONS C LOGICAL UNIT NUMBERS INTEGER TERMIN,TERMOT,DMPLUN,TAILUN,TABLUN C CHAR LOCAL CHARACTER VARIABLES C MUST BE INTEGER SO CHARACTER IS FOLLOWED BY NULL INTEGER CR,SPACE,ISLASH C C LOGICAL VARIABLES AND FUNCTIONS LOGICAL*1 EQUAL,RESTOR C C DATA INITIALIZATION DATA TERMIN,TERMOT,DMPLUN,TAILUN,TABLUN /5,5,3,1,2/ DATA SPACE,CR,ISLASH /"40,"15,"47/ C GET-TABLE-NAME-AND-DESTINATION WHEN (RESTOR) RESTORE-TABLE ELSE DUMP-TABLE STOP C TO GET-TABLE-NAME-AND-DESTINATION CALL GETMCR(DATA) LBUF = INDEX(DATA,CR) D WRITE (5,9910) LBUF D9910 FORMAT (' LBUF: ',I4) DATA(LBUF) = 0 LSP = INDEX(DATA,SPACE) IF (LSP.EQ.0) REPORT-BAD-COMMAND-LINE C C RSX NOTE: C PDS PUTS A BLANK AHEAD OF THE / IN A COMMAND LINE; C MCR DOES NOT. REMOVING "CRSX" BELOW MAY FIX THIS. CRSX LSL = INDEX (DATA,ISLASH) CRSX IF (LSL.GT.0) LSP = LSL-1 CALL MVSTR(DATA,DATA(LSP+1)) RESTOR = EQUAL(DATA,'/RE',3) IF (RESTOR) LSP = INDEX(DATA,SPACE) IF (LSP.EQ.0) REPORT-BAD-COMMAND-LINE CALL MVSTR(DATA,DATA(LSP+1)) FIN LSP = INDEX(DATA,SPACE) IF (LSP.EQ.0) LSP = LENGTH(DATA) CALL MVSTR(TAINAM,DATA,LSP) CALL MVSTR(TABNAM,TAINAM) WHEN (DATA(LSP).EQ.SPACE) CALL MVSTR(DMPNAM,DATA(LSP+1)) ELSE CALL MVSTR(DMPNAM,TAINAM) CALL MVSTR(TAINAM(LENGTH(TAINAM)),'.TAI') CALL MVSTR(TABNAM(LENGTH(TABNAM)),'.TAB') IF (INDEX(DMPNAM,'.').EQ.0) CALL MVSTR(DMPNAM(LENGTH(DMPNAM)),'.DMP') FIN D WRITE (TERMOT,9902) TAINAM,TABNAM,DMPNAM D9902 FORMAT (' TAI, TAB, DMP FILE NAMES:'/(1X,20A1)) C FIN C TO REPORT-BAD-COMMAND-LINE D L = LENGTH(DATA)-1 D WRITE (TERMOT,9905) LSP,L,(DATA(I),I=1,L) D9905 FORMAT (' LSP =',I5,' L =',I5,' DATA ='/(1X,60A1)) WRITE (TERMOT,61) 61 FORMAT (' Command format is:'// 1 ' DMT[/RE] tablename [dumpfilename]') CALL EXIT FIN C TO DUMP-TABLE C OPEN DUMP FILE OPEN (UNIT=DMPLUN, NAME=DMPNAM, FORM='FORMATTED', 1 ACCESS='SEQUENTIAL', TYPE='NEW', ERR=51) C OPEN INDEX FILE OPEN (UNIT=TAILUN, NAME=TAINAM, READONLY, FORM='UNFORMATTED', 1 ACCESS='SEQUENTIAL', TYPE='OLD', ERR=52) C ERROR TRAP IF (.FALSE.) 51 WRITE (TERMOT,9) (DMPNAM(I),I=1,LENGTH(DMPNAM)-1) 9 FORMAT (' Error opening file ',20a1) CALL EXIT 52 WRITE (TERMOT,9) (TABNAM(I),I=1,LENGTH(TABNAM)-1) CALL EXIT 53 WRITE (TERMOT,9) (TAINAM(I),I=1,LENGTH(TAINAM)-1) CALL EXIT FIN C C COPY INDEX FILE C READ (TAILUN) LENREC,NCOLS WRITE (DMPLUN,201) LENREC,NCOLS NCOL1 = NCOLS+1 C COPY IPTRH1,IPTRH2 READ (TAILUN) (ISCR(I),I=1,82) WRITE (DMPLUN,201) (ISCR(I),I=1,82) C COPY HEAD1 READ (TAILUN) L1TOT,(DATA(I),I=1,L1TOT) WRITE (DMPLUN,203) L1TOT,(DATA(I),I=1,L1TOT) C COPY HEAD2 READ (TAILUN) L2TOT,(DATA(I),I=1,L2TOT) WRITE (DMPLUN,203) L2TOT,(DATA(I),I=1,L2TOT) C COPY TITLE READ (TAILUN) LENTL,(DATA(I),I=1,LENTL) WRITE (DMPLUN,203) LENTL,(DATA(I),I=1,LENTL) C COPY SUBTITLE READ (TAILUN) LENSTL,(DATA(I),I=1,LENSTL) WRITE (DMPLUN,203) LENSTL,(DATA(I),I=1,LENSTL) C COPY LEN,IPTRD READ (TAILUN) (ISCR(I),I=1,40),IPTRD WRITE (DMPLUN,201) (ISCR(I),I=1,40),IPTRD C COPY OFFSET,PREF READ (TAILUN) IOFSET,(DATA(I),I=1,6) WRITE (DMPLUN,203) IOFSET,(DATA(I),I=1,6) C COPY ZERO1,ZERO2 READ (TAILUN) (DATA(I),I=1,20) WRITE (DMPLUN,204) (DATA(I),I=1,20) C COPY NREC READ (TAILUN) NREC WRITE (DMPLUN,201) NREC 201 FORMAT (10I8) 203 FORMAT (I4/(80A1)) 204 FORMAT (10A1) 205 FORMAT (255A1) C C OPEN TABLE FILE AND COPY DATA C CLOSE (UNIT=TAILUN) OPEN (UNIT=TABLUN,NAME=TABNAM, ACCESS='DIRECT', READONLY, 1 TYPE='OLD', ERR=52) DO (IREC = 1,NREC) READ (TABLUN'IREC) (DATA(I),I=1,LENREC) DO (ICOL = 1,NCOLS) WRITE (DMPLUN,205) (DATA(I),I=IPTRD(ICOL),IPTRD(ICOL+1)-1) FIN FIN FIN C TO RESTORE-TABLE C OPEN DUMP FILE OPEN (UNIT=DMPLUN, NAME=DMPNAM, READONLY, FORM='FORMATTED', 1 ACCESS='SEQUENTIAL', TYPE='OLD', ERR=51) C OPEN INDEX FILE OPEN (UNIT=TAILUN, NAME=TAINAM, FORM='UNFORMATTED', 1 ACCESS='SEQUENTIAL', TYPE='NEW', ERR=52) C C COPY INDEX FILE C READ (DMPLUN,201) LENREC,NCOLS WRITE (TAILUN) LENREC,NCOLS NCOL1 = NCOLS+1 C COPY IPTRH1,IPTRH2 READ (DMPLUN,201) (ISCR(I),I=1,82) WRITE (TAILUN) (ISCR(I),I=1,82) C COPY HEAD1 READ (DMPLUN,203) L1TOT,(DATA(I),I=1,L1TOT) WRITE (TAILUN) L1TOT,(DATA(I),I=1,L1TOT) C COPY HEAD2 READ (DMPLUN,203) L2TOT,(DATA(I),I=1,L2TOT) WRITE (TAILUN) L2TOT,(DATA(I),I=1,L2TOT) C COPY TITLE READ (DMPLUN,203) LENTL,(DATA(I),I=1,LENTL) WRITE (TAILUN) LENTL,(DATA(I),I=1,LENTL) C COPY SUBTITLE READ (DMPLUN,203) LENSTL,(DATA(I),I=1,LENSTL) WRITE (TAILUN) LENSTL,(DATA(I),I=1,LENSTL) C COPY LEN,IPTRD READ (DMPLUN,201) (ISCR(I),I=1,40),IPTRD WRITE (TAILUN) (ISCR(I),I=1,40),IPTRD C COPY OFFSET,PREF READ (DMPLUN,203) IOFSET,(DATA(I),I=1,6) WRITE (TAILUN) IOFSET,(DATA(I),I=1,6) C COPY ZERO1,ZERO2 READ (DMPLUN,204) (DATA(I),I=1,20) WRITE (TAILUN) (DATA(I),I=1,20) C COPY NREC READ (DMPLUN,201) NREC WRITE (TAILUN) NREC C C OPEN TABLE FILE AND COPY DATA C CLOSE (UNIT=TAILUN) C C USE ASSIGN AND DEFINEFILE TO SPECIFY RECORD LENGTH IN WORDS C CALL ASSIGN(TABLUN,TABNAM) LENWDS = (LENREC+1)/2 DEFINEFILE TABLUN (32767,LENWDS,U,IVAR) DO (IREC = 1,NREC) DO (ICOL = 1,NCOLS) READ (DMPLUN,205) (DATA(I),I=IPTRD(ICOL),IPTRD(ICOL+1)-1) FIN WRITE (TABLUN'IREC) (DATA(I),I=1,LENREC) FIN FIN END