qÃ[VAX-11 Librarian V02.002`ÁîÙˆ¨Û ‰Pjk   ¢ASSTAPERL BYFILEIDLBYNAMEERLBYNUMBERL6CHRTOINTLF CRENEWFIL?FILEIDDER< FILHEADER?¬HOMEBLKINCBAKEOLMOVEREFRMSOPNILE WRITEFILEr$RESTORERMSOPNILE WRITEFILELÿÿLMOVEKÿÿ WRITEFILE ­À±k·ÝˆC.4C ************** SUBROUTINE ASSTAPE ***************CF" SUBROUTINE ASSTAPE(CMDSTR,TAPECH) CHARACTER*40 CMDSTR CHARACTER*6 INTAPEL INTEGER*4 SSRET,SYS$ASSIGN INTEGER*2 TAPECHECRC" IF(INDEX(CMDSTR,'MT').EQ.0) THEN WRITE(6,10)V10 FORMAT(' FROM: ',$)  READ(5,20)INTAPE(2:6)S20 FORMAT(A)K GOTO 45C ENDIF K=INDEX(CMDSTR,'MT')O INTAPE(2:5)=CMDSTR(K:K+3)45 INTAPE(1:1) = '_' INTAPE(6:6) = ':'$ SSRET = SYS$ASSIGN(INTAPE,TAPECH,,) IF( .NOT.SSRET) THENR WRITE(6,30)SSRETI30 FORMAT(' RESTORE -- UNABLE TO ASSIGN CHANNEL TO MAG TAPE; STATUS=',S 1 Z8)  STOP ENDIF RETURNO ENDww FROM RMS THROUGH R0;; NOTE:@; IF A FILE OF THE SAME NAME EXISTS THIS WILL BECOME NEW VERSION;; .MACRO OUT,N,VALUE PUSHL #N PUSHAL VALUE PUSHAL 4(SP) CALLS #2,OUT ADDL2 #4,SP .ENDM4 .PSECT RSTCOM,PIC,OVR,SHR,REL,GBL,NOEXE,RD,WRT,LONG NEWFAB: $FAB 2 .PSECT DATA,PIC,OVR,SHR,REL,GBL,NOEXE,RD,WRT,LONG­À=DõˆC+C **** MAINLINE INCBCK ****DC(C WRITTEN BY:C TED BLANKC 15-SEP-1980CYCLGC INCBCK IS THE MAINLINE OF AN INCREMENTAL BACKUP PACKAGE FOR USE WITHDC ODS-2 DSKS UNDER VAX/VMSACTHC TO RUN YOU MUST HAVE PREVIOUSLY SET UP THE FOREIGN COMMAND "BACKUP".IC FOREIGN COMMANDS ARE DEFINED WITH THE FOLLOWING EQUIVALENCE STATEMENT:M$C BACKUP:=$DEV:[DIRECTORY]IMAGEFILEC06C THEN TO RUN ISSUE A COMMAND OF THE FOLLOWING FORMAT2C BACKUP/AFTER:DD-MMM-YYYY INPUTDISK: OUTPUTTAPE:,C OR: BACKUP/AFTER:01-JAN-1980 DBA0: MTA0:CRGC THIS WILL CAUSE ALL FILES ON DBA0: WITH A CREATION OR REVISION DATE EAC GREATER THAN OR EQUAL TO THE GIVEN DATE TO BE WRITTEN TO MTA0:CAKC ALSO A SUMMARY LISTING FILE IS GENERATED ON THE DEFAULT DEV:[DIRECTORY] MKC WHICH LISTS THE NAME, FLE ID, UIC, SIZE, AND DATE OF ALL FILES WHICH ARELC WRITTEN TO THE TAPE.EC)C-"C GET HOME BLOCK SYMBOLIC OFFSETS INCLUDE 'HOMEBLK.FOR'#C GET FILE HEADER SYMBOLIC OFFSETSN INCLUDE 'FILHEADER.FOR'$C GET FILE ID AREA SYMBOLIC OFFSETS INCLUDE 'FILEID.FOR' PARAMETER SS$_ENDOFTAPE='878'XR PARAMETER SS$_ENDOFFILE='870'X)@ EXTERNAL IO$_READVBLK,SYS$CLI,SYS$CRELOG,SYS$BINTIM,IO$_WRITEOF" EXTERNAL SYS$ASCTIM,IO$_WRITELBLK INTEGER*4 REVDAT(2),BAKDAT(2) INTEGER*4 CMDLIN(7)# LOGICAL*1 DATE(23),DISK(5),TAPE(5) CHARACTER*11 LISTFILE CHARACTER*23 NOW,FILEDATE CHARACTER*10 TAPENUMBER CHARACTER*6 MTAPE CHARACTER*23 ADAT BYTE NAME(19)A& INTEGER*4 ERRSTAT,SYS.$QIOW,SYS$BINTIM INTEGER*4 SYS$ASSIGNA INTEGER*4 STARTBLK,MAXFIL,IFILP BYTE LBUF(512) CHARACTER*70 LABELBUF BYTE OUTBUF(8192)T BYTE OFFSETR BYTE TEMPDAT(11) BYTE IDOFF BYTE FABLOCK(100)U INTEGER*2 IOSB(4) INTEGER*2 MTCHAND INTEGER*2 INBUF(256)( INTEGER*2 ERROR% INTEGER*2 FILEID(3),CLUSTER,BMAPSIZED INTEGER*2 UIC(2)F INTEGER*4 OPNERR  INTEGER*4 CHAN,IDXCHN INTEGER*4 FILECOUNT INTEGER*2 LENGTH_ CHARACTER*20 INDEX  EQUIVALENCE (INBUF,LBUF)C> COMMON /OPNCOM/­€bIZ¿ïˆ;+ .TITLE RMSOPN;I;; THIS ROUTINE IS DESIGNED FOR USE WITH THE BACKUP UTILITY-;; IT HAS 2 ENTRY POINTS, 1) OPEN THE INDEX FILE (IDXFIL:)K); 2) OPEN A FILE ON 'DEV' BY FILE IDE<; IN BOTH CASES A CHANNEL NUMBER AND ERROR CODE IS RETURNED>; FOR THE SECOND ENTRY 'FIDOPN' THE CALLER MUST SUPPLY A FILE; ID.+; ALL PARAMETERS ARE PASSED THROUGH COMMONE;D;C4 .PSECT OPNCOM,PIC,OVR,SHR,REL,GBL,NOEXE,RD,WRT,LONGOPNERR: .BLKL 1 ; RETURN CODEF&FILEID: .BLKW 3 ; ID OF FILE TO OPEN(CHAN: .BLKL 1 ; CHANNEL NUMBER OF FILE-IDXCHN: .BLKL 1 ; INDEX FILE CHANNEL NUMBERI(FILBUF::.BLKW 256. ; BUFFER FOR BLOCKIOBYTCNT::.BLKW 1T,FIDFAB: $FAB FOP=NAM,FAC=,NAM=NAMBK2 .PSECT DATA,PIC,OVR,SHR,REL,GBL,NOEXE,RD,WRT,LONG2IDXFAB: $FAB FNM=,FOP=,NAM=NAMBK NAMBK: $NAMI:FIDRAB: $RAB FAB=FIDFAB,UBF=FILBUF,USZ=512,ROP=BIO,RSZ=512; .PSECT CODE,NOWRT,LONG ;BOPNIDX::.WORD 0C $OPEN FAB=IDXFAB BLBC R0,ERR1D MOVL IDXFAB+FAB$L_STV ',IDXCHN'NOERR:: MOVL #1,OPNERR FINI:: RET;BERR1: MOVL R0,OPNERR RET;FFIDOPN::.WORD 0S MOVC3 #6,FILEID,NAMBK+NAM$W_FID MOVW #0,FIDFAB+FAB$W_IFIO $OPEN FAB=FIDFABI BLBC R0,ERROR MOVL FIDFAB+FAB$L_STV,CHANT $CONNECT RAB=FIDRAB MOVL #1,OPNERRC RETERROR: CMPL #RMS$_FLK,R0 BEQL LOCK CMPL #RMS$_ACT,R0 BEQL LOCK MOVL R0,OPNERRA MOVL FIDFAB+FAB$L_STV,CHAN CMPL #^X8A8,CHAN BEQL LOCK RETLOCK: MOVL #3,OPNERR RET;E CLOSEID::Q .WORD 0 $CLOSE FAB=FIDFAB,E­€t–ç·ÝˆC+:C ************** SUBROUTINE BYNUMBER ******************C SUBROUTINE BYNUMBER(CMDSTR)CE EXTERNAL IO$_READVBLK PARAMETER SS$_ENDOFTAPE='878'XI CHARACTER*(*) CMDSTRC INTEGER*4 SSRET,CHR_INT,NUM INTEGER*4 SYS$QIOWT INTEGER*2 ERROR,TAPECHR LOGICAL*1 HEADER(512) BYTE FABBLK(100) COMMON /RSTCOM/FABBLKCR NUM = 0 K = INDEX(CMDSTR,'=')+1 J = INDEX(CMDSTR,' ')-1/ SSRET = CHR_INT(CMDSTR(K:J),NUM) ! GET THE NUMI IF (SSRET .EQ. -1) THEN1 WRITE(6,10)S&10 FORMAT(' UNABLE TO CONVERT NUM') STOP 'CHR_INT FAILED' ENDIF: CALL ASSTAPE(CMDSTR,TAPECH) ! ASSIGN CHAN FOR INPUT TAPE DO I = 1,NUM' CALL GETHEADER(HEADER,TAPECH,ERROR)6 IF(ERROR .EQ. 3) THEN WRITE(6,20)NUM)(20 FORMAT(' FILE',I6,' NOT FOUND') STOP ENDIFE END DOEC30 SSRET=SYS$QIOW(%VAL(2),%VAL(TAPECH),%VAL(%LOC(IO$_READVBLK)),,,,G 1 FABBLK,%VAL(100),,,,) IF(.NOT. SSRET) THEN% IF(SSRET .EQ. SS$_ENDOFTAPE) THEN, CALL TAPE ND GOTO 30 ELSE WRITE(6,40)SSRETN<40 FORMAT(' UNABLE TO READ FAB FROM TAPE; STATUS=',Z8) STOPR ENDIFM ENDIF% CALL WRITEFILE(CMDSTR,HEADER,TAPECH)H RETURNA ENDww WRITEFILE(CMDSTR,HEADER,TAPECH)E RETURNR ENDwwTIM,IO$_WRITELBLK INTEGER*4 REVDAT(2),BAKDAT(2) INTEGER*4 CMDLIN(7)# LOGICAL*1 DATE(23),DISK(5),TAPE(5)F CHARACTER*11 LISTFILE CHARACTER*23 NOW,FILEDATE CHARACTER*10 TAPENUMBER CHARACTER*6 MTAPE CHARACTER*23 ADAT BYTE NAME(­€Áq-¸ÝˆCKC *********************** SUBROUTINE WRITEFILE *************************CS+ SUBROUTINE WRITEFILE(CMDSTR,HEADER,TAPECH)_CD! PARAMETER SS$_ENDOFFILE = '870'X'! PARAMETER SS$_ENDOFTAPE = '878'XR EXTERNAL IO$_READVBLK CHARACTER*(*) CMDSTRT LOGICAL*1 HEADER(512) CHARACTER*20 DEVDIR INTEGER*4 STATUS INTEGER*4 DATASIZ INTEGER*4 SSRET,SYS$QIOWX INTEGER*2 OSB(4),TAPECH,ISB(4), LOGICAL*1 DATABUF(8192) BYTE FABBLK(100) DATA DATASIZ/8192/S- COMMON /RSTCOM/DATABUF,DATASIZ,STATUS,FABBLKC  K=INDEX(CMDSTR,'DB') J=INDEX(CMDSTR,']') DEVDIR=CMDSTR(K:J)C N=J-K+1) CALL CRE_FILE(HEADER,DEVDIR(1:N),STATUS)I IF(STATUS .NE. 1) THEN WRITE(6,50)STATUSS350 FORMAT(' UNABLE TO CREATE FILE; STATUS= ',Z8)U STOP ENDIF DO I=1,100AG20 SSRET=SYS$QIOW(%VAL(2),%VAL(TAPECH),%VAL(%LOC(IO$_READVBLK)),ISB, % 1 ,,DATABUF,%VAL(8192),,,,) + IF(ISB(1) .EQ. SS$_ENDOFFILE) GOTO 500O. IF(ISB(1) .EQ. SS$_ENDOFTAPE) CALL TAPEND  IF(.NOT. SSRET) THEN, WRITE(6,30)SSRETN630 FORMAT(' ERROR DURING TAPE READ; STATUS=',Z8) STOPG ENDIF  DATASIZ = ISB(2) CALL WRITEBLKF IF(STATUS .NE. 1) THENO WRITE(6,40)STATUS740 FORMAT(' ERROR DURING DISK WRITE; STATUS=',Z8)L STOPM ENDIF ENDDO500 CALL CLOSEFIL IF(STATUS .NE. 1) THEN WRITE(6,80)STATUS*/80 FORMAT(' ERROR CLOSING FILE; STATUS=',Z8)* ENDIF STOPO ENDwwFILE(CMDSTR,HEADER,TAPECH)C! PARAM­€ eç·ÝˆCT8C ************** SUBROUTINE BYNAME ******************CA SUBROUTINE BYNAME(CMDSTR)C( EXTERNAL IO$_READVBLK PARAMETER SS$_ENDOFTAPE='878'X  INCLUDE 'FILEID.FOR' CHARACTER*(*) CMDSTRT INTEGER*4 SSRET,CHR_INT INTEGER*4 SYS$QIOW2 INTEGER*2 ERROR,TAPECHF INTEGER*2 IOSB(4) LOGICAL*1 HEADER(512) CHARACTER*19 NAME,FILNAMG BYTE FABBLK(100) BYTE IDOFF COMMON /RSTCOM/FABBLKCT K = INDEX(CMDSTR,'=')+1 J = INDEX(CMDSTR,' ')-1 L=J-K+1- CALL LMOVE(%DESCR(CMDSTR(K:J)),NAME,%VAL(L))R: CALL ASSTAPE(CMDSTR,TAPECH) ! ASSIGN CHAN FOR INPUT TAPE DO I = 1,35000A' CALL GETHEADER(HEADER,TAPECH,ERROR)D IF(ERROR .EQ. 3) THEN WRITE(6,20)NAME*20 FORMAT(' FILE ',A19,' NOT FOUND') STOPM ENDIFL IDOFF = HEADER(1)*2I5 CALL LMOVE(%DESCR(HEADER(IDOFF)),FILNAM,%VAL(19))1- IF(NAME(1:L) .EQ. FILNAM(2:L+1)) GOTO 100V END DOEH100 SSRET=SYS$QIOW(%VAL(2),%VAL(TAPECH),%VAL(%LOC(IO$_READVBLK)),IOSB,,, 1 FABBLK,%VAL (100),,,,)+ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) CALL TAPEND  IF(.NOT. SSRET) THEN WRITE(6,40)SSRET940 FORMAT(' UNABLE TO READ FAB FROM TAPE; STATUS=',Z8)A STOP ENDIF% CALL WRITEFILE(CMDSTR,HEADER,TAPECH)F RETURNA ENDwwREAD(5,7)TAPENUMBER 7 FORMAT(A) C %C CONVERT DATE STRING TO BINARY TIMEMCL" ERRSTAT = SYS$BINTIM(ADAT,BAKDAT) IF(.NOT.ERRSTAT) THEND WRITE(6,12)ERRSTAT 12 FORMAT(' BINTIM ERROR',Z8) STOP ENDIF IF(BAKDAT(2) .LE. 0) GOTO 999CM<C BUILD!­@AqÄ݈CE:C ************** SUBROUTINE BYFILEID ******************CI SUBROUTINE BYFILEID(CMDSTR)CM EXTERNAL IO$_READVBLK PARAMETER SS$_ENDOFTAPE='878'XI INCLUDE 'FILHEADER.FOR') CHARACTER*(*) CMDSTRR INTEGER*4 SSRET,CHR_INT INTEGER*4 SYS$QIOWT INTEGER*2 ERROR,TAPECHS INTEGER*2 IOSB(4) LOGICAL*1 HEADER(512) INTEGER*2 INTBUF(256) INTEGER*2 FILEID(2),TEMPID(2) BYTE FABBLK(100) BYTE IDOFF EQUIVALENCE (HEADER,INTBUF) COMMON /RSTCOM/FABBLKCR K = IND"EX(CMDSTR,'(')+1 J = INDEX(CMDSTR,',')-1' SSRET = CHR_INT(CMDSTR(K:J),FILEID(1))*5 IF (SSRET .EQ. -1) THEN' TYPE *,' UNABLE TO CONVERT FILEID 'R STOP ENDIF K=J+2 J = INDEX(CMDSTR,')')-1' SSRET = CHR_INT(CMDSTR(K:J),FILEID(2))A IF(SSRET .EQ. -1) GOTO 54: CALL ASSTAPE(CMDSTR,TAPECH) ! ASSIGN CHAN FOR INPUT TAPE DO I = 1,35000I' CALL GETHEADER(HEADER,TAPECH,ERROR)E IF(ERROR .EQ. 3) THEN WRITE(6,20)FILEID220 FORMAT(' FILE (',I5,',',I4,') NOT FOUND') # STOP' ENDIF() TEMPID(1) = INTBUF(((FH2$W_FID)/2)+1)L- TEMPID(2) = INTBUF(((FH2$W_FID_SEQ)/2)+1)H IF(FILEID(1) .EQ. TEMPID(1) .AND. FILEID(2) .EQ. TEMPID(2)) GOTO 100 END DO H100 SSRET=SYS$QIOW(%VAL(2),%VAL(TAPECH),%VAL(%LOC(IO$_READVBLK)),IOSB,,, 1 FABBLK,%VAL(100),,,,)+ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) CALL TAPEND  IF(.NOT. SSRET) THEN WRITE(6,40)SSRET940 FORMAT(' UNABLE TO READ FAB FROM TAPE; STATUS=',Z8)6 STOP ENDIF% CALL WRITEFILE(CMDSTR,HEADER,TAPECH)1 RETURNF ENDwwD ON OR AFTER ',A11,' FROM ',A5,C" 2 ' ON TAPE NUMBER ',A10,//)C  DO 900 I=1,32000E( CALL GETHEADER(TAPEBUF,TAPECH,ERROR) IF(ERROR .EQ. 3) GOTO 901B IDOFF = TAPEBUF(1)*2< CALL LMOVE(%DESCR(TAPEBUF(IDOFF)),%DESCR(NAME),%VAL(19))' FILEID(1)=BUFFER(((FH2$W_FID)/2)+1)E+ FILEID(2)=BUFFER(((FH2$W_FID_SEQ)/2)+1)1) UIC(1)=BUFFER(((FH2$W_UICGROUP)/2)+1)I* UIC(2)=BUFFER(((FH2$W_UICMEMBER)/2)+1) WRITE(2,60)I,NAME,FILEID,UICD60 FORMAT(X,I%­ ?ÓfÇïˆC+<C ******************** MAINLINE RESTORE ******************CEC WRITTEN BY: C TED BLANK C TEKTRONIX INC. C M/S 58-077C P.O. BOX 500C BEAVERTON, OR 97077 C TEL (503)627-6893CI C 15-DEC-1980CCNBC RESTORE IS USED TO RECOVER FILES FROM TAPES WRITTEN BY 'BACKUP'5C IT IS RUN AS A FOREIGN COMMAND PREVIOUSLY DEFINED:T'C RESTORE:=="$DB0:[DIRECTORY]IMAGEFILE".CCCC FILES CAN BE RESTORED FROM THE TAPE BY NAME, FILEID, OR RELATIVEE@C POSITION (NUMBER) ON THE &TAPE. FILES ARE RESTORED TO A GIVEN@C DEV:[DIRECTORY] AND HAVE ALL ORIGINAL ATTRIBUTES. IF FILE OF?C SAME NAME.TYP ALREADY EXISTS, NEW FILE WILL BE NEXT HIGHEST C VERSION.FCFC THE GENERAL COMMAND LINE IS:.CC2C RESTORE/OPTION=VALUE INTAPE: OUTDISK:[DIRECTORY]CF-C OPTION: NUMBER VALUE: n (POSITION ON TAPE):6C NAME FILENAME.TYP (FIRST MATCH USED)2C FILEID (FILE#,SEQ#) (IN DECIMAL)C OR:C RESTORE/LIST=FILE INTAPE: %C TO GET A LIST OF FILES ON TH(E TAPE.'CO4C NOTE: ALL DEVICES MUST BE IN THE FORM XXcn WHERE C XX = DEVICEC c = CONTROLLER C n = UNIT #CNC- EXTERNAL SYS$CLIF INTEGER*4 CMDLIN(7) CHARACTER*40 CMDSTRCS CMDLIN(1) = 1 CALL SYS$CLI(CMDLIN)1- CALL LMOVE(CMDLIN(3),CMDSTR,%VAL(CMDLIN(3)))Q$ IF (INDEX(CMDSTR,'/LI').GT.0) THEN CALL TAPEDIR(CMDSTR)) ELSE IF (INDEX(CMDSTR,'/NA').GT.0) THEN CALL BYNAME(CMDSTR)F) ELSE IF (INDEX(CMDSTR,'/FI').GT.0) THENE CALL BYFILEID(CMDSTR)R) ELSE IF (INDEX(CMDSRR=ERROR MOVL #1,OPNERRL RET;I READBLK::  .WORD 0 $READ RAB=FIDRABE MOVW FIDRAB+RAB$W_RSZ,BYTCNTT BLBC R0,READERR MOVL #1,OPNERRT RET; READERR::O CMPL #RMS$_EOF,R0 BNEQ BADERR MOVL #2,OPNERRI RET;IBADERR:: MOVL R0,OPNERRR RET .ENDFww(3),CLUSTER,BMAPSIZE2 INTEGER*2 UIC(2)R INTEGER*4 OPNERRI INTEGER*4 CHAN,IDXCHN INTEGER*4 FILECOUNT INTEGER*2 LENGTHI CHARACTER*20 INDEX EQUIVALENCE (INBUF,LBUF)G> COMMON /OPNCOM/OPNERR,FILEID,CHAN,IDXCHN,INBUF,LE)TR,'/NU').GT.0) THENG CALL BYNUMBER(CMDSTR)A ELSEK WRITE(6,10)Y+10 FORMAT(' RESTORE -- INVALID COMMAND')L ENDIF STOPE ENDCN4C ************** SUBROUTINE TAPEDIR ***************CN SUBROUTINE TAPEDIR(CMDSTR)T INCLUDE 'FILHEADER.FOR'R INCLUDE 'FILEID.FOR' EXTERNAL IO$_READVBLK CHARACTER LISTFILE*14,INTAPE*6L CHARACTER*40 CMDSTR INTEGER*4 SSRET,SYS$QIOW(. INTEGER*2 TAPECH,BUFFER(256),FILEID(2),UIC(2) INTEGER*2 IOSB(4),ERROR LOGICAL*1 TAPEBUF(512),NAME(19)* CHARACTER*70 LABELBUF BYTE IDOFFC0 EQUIVALENCE (TAPEBUF,BUFFER))CC? LISTFILE = CMDSTR((INDEX(CMDSTR,'=')+1):(INDEX(CMDSTR,' ')-1))E) OPEN (UNIT=2,NAME=LISTFILE,STATUS='NEW'), CALL ASSTAPE(CMDSTR,TAPECH)C SSRET = SYS$QIOW(%VAL(2),%VAL(TAPECH),%VAL(%LOC(IO$_READVBLK)),,,,D. 1 %REF(LABELBUF),%VAL(70),,,,) IF(.NOT.SSRET) THENM WRITE(6,40)SSRETA40 FORMAT(' RESTORE -- UNABLE TO READ TAPE LABEL; STATUS=',Z8)  STOP ENDIF< WRITE(2,50)LABELBUF(14:38),LABELBUF(3+9:50),LABELBUF(51:55), 1 LABELBUF(56:66)250 FORMAT(/,' INCREMENTAL BACKUP TAKEN AT ',A24,/,7 1 ' OF FILES DATED ON OR AFTER ',A11,' FROM ',A5, " 2 ' ON TAPE NUMBER ',A10,//)CF DO 900 I=1,32000L( CALL GETHEADER(TAPEBUF,TAPECH,ERROR) IF(ERROR .EQ. 3) GOTO 901  IDOFF = TAPEBUF(1)*2< CALL LMOVE(%DESCR(TAPEBUF(IDOFF)),%DESCR(NAME),%VAL(19))' FILEID(1)=BUFFER(((FH2$W_FID)/2)+1)N+ FILEID(2)=BUFFER(((FH2$W_FID_SEQ)/2)+1)A) UIC(1)=BUFFER(((FH2$W_UICGROUP,)/2)+1) * UIC(2)=BUFFER(((FH2$W_UICMEMBER)/2)+1) WRITE(2,60)I,NAME,FILEID,UICD60 FORMAT(X,I6,3X,19A1,3X,'(',I5,',',I4,')',3X,'[',O3,',',O3,']') 900 CONTINUE 901 RETURN ENDC,6C *********** SUBROUTINE GETHEADER ****************CB+ SUBROUTINE GETHEADER(TAPEBUF,TAPECH,ERROR)IC # EXTERNAL IO$_SKIPFILE,IO$_READVBLKA INTEGER*4 SYS$QIOW,SSRETA LOGICAL*1 TAPEBUF(512)= INTEGER*2 ERROR,TAPECH: INTEGER*2 IOSB(4) PARAMETER SS$_ENDOFTAPE='878'XS PARAMETER SS$_ENDOFFILE='870'-XKCPE SSRET=SYS$QIOW(%VAL(2),%VAL(TAPECH),%VAL(%LOC(IO$_SKIPFILE)),IOSB,,,  1 %VAL(1),,,,,)A IF(.NOT.SSRET) THEN  WRITE(6,30)SSRET>30 FORMAT(' RESTORE -- UNABLE TO FIND FILE HEADER ON TAPE;' 1 ' STATUS=',Z8) STOP ENDIF( IF(SSRET.EQ.SS$_ENDOFTAPE) CALL TAPENDE SSRET=SYS$QIOW(%VAL(2),%VAL(TAPECH),%VAL(%LOC(IO$_READVBLK)),IOSB,,,T& 1 TAPEBUF,%VAL(512),,,,)7 IF(IOSB(2) .EQ. 0) THEN ! REACHED LOGICAL END OF TAPE ERROR = 3R RETURN  ELSET IF(.NOT. SSRET) THENM WRITE(6,40)SSRETIE40 FORMAT(' RESTORE -- UNABLE TO READ FILE HEADER ON MAG TAPE;' 1 ' STATUS=',Z8) STOPE ENDIF  ENDIF RETURNI ENDwwBLK FILECOUNT = 0)15 DO 900 IFIL = STARTBLK,STARTBLK+MAXFILH ERRSTAT = SYS$QIOW(%VAL(2),%VAL(IDXCHN),%VAL(%LOC(IO$_READVBLK)),,,,2 1 %REF(INBUF),%VAL(512),%VAL(IFIL),,,) IF(.NOT.ERRSTAT) THEN WRITE(6,20)ERRSTAT020 FORMAT(' ERROR READING FILE HEA/OPNERR,FILEID,CHAN,IDXCHN,INBUF,LENGTH,FABLOCKCJC GET COMMAND LINE OF THE FORMAT: BACK/AFTER:DD-MMM-YYYY DBcn: MTcn: ANDEC PASS TO PARSIT WHICH WILL RETURN THE DATE, DISK, AND TAPE STRINGS.)CA CMDLIN(1) = 1 CALL SYS$CLI(CMDLIN)W, CALL PARSIT(CMDLIN(3),DATE,DISK,TAPE,ERROR) IF (ERROR .NE. 0) GOTO 999I MTAPE(1:1) = '_'I, CALL LMOVE(%DESCR(TAPE),MTAPE(2:6),%VAL(5))% ERRSTAT = SYS$ASSIGN(MTAPE,MTCHAN,,)2 IF(.NOT.ERRSTAT) THENE WRITE(6,991)ERRSTATH!991 FORMAT(' ASSIGN ERROR0',I6)O! STOP ' ASSIGN MTCHAN ERROR'I ENDIF6 CALL LMOVE(' 00:00:00.00 ',%DESCR(DATE(12)),%VAL(12))' CALL LMOVE(%DESCR(DATE),ADAT,%VAL(23)) WRITE(6,5),.5 FORMAT(' ENTER SERIAL # OF OUTPUT TAPE: ',$) READ(5,7)TAPENUMBER 7 FORMAT(A),C,%C CONVERT DATE STRING TO BINARY TIME,C" ERRSTAT = SYS$BINTIM(ADAT,BAKDAT) IF(.NOT.ERRSTAT) THEN  WRITE(6,12)ERRSTAT 12 FORMAT(' BINTIM ERROR',Z8) STOP ENDIF IF(BAKDAT(2) .LE. 0) GOTO 999C <C BUILD AN INDEX FILE SPECIFICATION1 AND OPEN THE INDEX FILECE INDEX = 'DISK:[0,0]INDEXF.SYS' / CALL LMOVE(%DESCR(DISK),%DESCR(INDEX),%VAL(4))L" CALL SYS$CRELOG(,'IDXFIL',INDEX,) CALL OPNIDX IF (OPNERR .NE. 1) THEN " STOP ' UNABLE TO OPEN INDEX' ENDIFCI&C WRITE A VOLUME LABEL ON OUTPUT TAPECO CALL SYS$ASCTIM(,NOW,,)! LABELBUF(1:13) = 'VOLUME LABEL 'N LABELBUF(14:38) = NOW LABELBUF(39:50) = ADAT(1:11)L LABELBUF(51:55) = INDEX(1:5)K LABELBUF(56:66) = TAPENUMBEREC ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN)2,%VAL(%LOC(IO$_WRITELBLK)), 2 1 ,,,%REF(LABELBUF),%VAL(70),,,,)3 IF(.NOT. ERRSTAT) STOP ' VOLUME LABEL WRITE ERROR'T) ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN), 4 1 %VAL(%LOC(IO$_WRITEOF)),,,,,,,,,)7 IF(.NOT. ERRSTAT) STOP ' EOF ERROR FOLLOWING LABEL'BCE5C OPEN THE LISTING FILE AND WRITE IN A HEADER RECORD CL LISTFILE(1:2) = ADAT(1:2) LISTFILE(3:5) = ADAT(4:6) LISTFILE(6:7) = ADAT(10:11) LISTFILE(8:11) = '.BAK'' OPEN (UNIT=4,NAME=LISTFILE,TYPE='NEW'3) + WRITE(4,100)NOW,ADAT(1:11),DISK,TAPENUMBER13100 FORMAT(/,' INCREMENTAL BACKUP TAKEN AT ',A23,/,B8 1 ' OF FILES DATED ON OR AFTER ',A11,' FROM ',5A1,$ 2 3X,'ON TAPE NUMBER ',A10,//)CALC READ THE HOME BLOCK ON INPUT DISK AND CALCULATE VBN OF FIRST HEADER BLOCKC B ERRSTAT = SYS$QIOW(%VAL(2),%VAL(IDXCHN),%VAL(%LOC(IO$_READVBLK)),1 1 %REF(IOSB),,,%REF(INBUF),%VAL(512),%VAL(2),,,), IF(.NOT. ERRSTAT) THEN WRITE(6,10)ERRSTAT,10 FORMAT(' ERROR READING HOME BLOCK',Z8) 4STOP ENDIF" CLUSTER = LBUF((HM2$W_CLUSTER)+1)% BMAPSIZE = LBUF((HM2$W_IBMAPSIZE)+1) ' MAXFIL = INBUF(((HM2$L_MAXFILES)/2)+1) ! STARTBLK = CLUSTER*4+BMAPSIZE+10ICR>C NOW READ HEADERS LOOKING FOR A FILE ELIGIBLE FOR BACKING UPC  IFIL = STARTBLK FILECOUNT = 0' DO 900 IFIL = STARTBLK,STARTBLK+MAXFILLE ERRSTAT = SYS$QIOW(%VAL(2),%VAL(IDXCHN),%VAL(%LOC(IO$_READVBLK)),19 1 IOSB,,,%REF(INBUF),%VAL(512),%VAL(IFIL),,,)[+ IF(ERRSTAT .EQ. SS$_ENDOFFILE) GOTO 901, IF(ERRST5AT .NE. 1) THEN  WRITE(6,20)ERRSTAT020 FORMAT(' ERROR READING FILE HEADER',Z8) STOP ' HEADER READ ERROR' ENDIF # CALL GETDATE(LBUF,REVDAT,ISTAT)=5 IF(ISTAT .EQ. -1) GOTO 900 ! NOT A VALID HEADERW IDOFF = LBUF(1)*2(& IF(REVDAT(2) .GE. BAKDAT(2)) THEN< CALL LMOVE(%DESCR(LBUF(IDOFF)),%DESCR(NAME),%VAL(19))+ FILEID(1) = INBUF(((FH2$W_FID)/2)+1)/ FILEID(2) = INBUF(((FH2$W_FID_SEQ)/2)+1)I- UIC(1) = INBUF(((FH2$W_UICGROUP)/2)+1)C.9 UIC(2) = INBUF(((FH2$W_UICMEMBER)/2)+1)7 IF(FILEID(1).LE.0 .OR. FILEID(2).LE.0) GO TO 900CC OIC OPEN THE FILE BY ID, READ BLOCKS INTO THE OUTPUT BUFFER AND, WHEN FULL C WRITE THE BUFFER TO TAPEACY FILEID(3) = 0 CALL FIDOPN IF(OPNERR .EQ. 3) THEN2 WRITE(4,150)NAME,FILEID(1),FILEID(2),UIC@150 FORMAT(/,' LOCKED',3X,19A1,3X,'(',I5,',',I4,')',3X, 1 '[',O3,',',O3,']',/) GOTO 900# ELSE IF(OPNERR .NE. 1) THENF5 7­€'*yQ߈;+ .TITLE CHR_INT.;R8; FUNCTION TO CONVERT CHARACTER STRING TO INTEGER VALUE; A; CALLING SEQUENCE:; #; CODE = CHR_INT(STRING,INT,[LEN])A;T#; CODE - VALUE RETURNED BY FUNCTIONR; 1 = SUCCESSI; -1 = FAILURE;I1; STRING - ADDRESS OF CHARACTER STRING DESCRIPTORT2; INT - ADDRESS OF WORD TO RECIEVE CONVERTED VALUE;I-; LENGTH - NUMBER OF CHARACTERS TO CONVERT IF 5; OTHER THAN LENGTH IN DESCRIPTOR BLOCK. (OPTIONAL)F;R;- LEN: .LONG 0;N CHR_INT:: 8 .WORD 0 CLRL R2 CLRL R3 CLRL R4" MOVAL @4(AP),R5 ; GET DESCRIPTOR+ MOVZWL @4(AP),LEN ; GET LENGTH FROM DESCRR MOVL 4(R5),R1 ; R1 -> STRING$ CMPL #3,(AP) ; THREE ARGUMENTS ?? BGTR 10$ ; NO* MOVAL @12(AP),LEN ; YES - GET PASSED LEN$10$: MOVB (R1)+,R2 ; R2 GETS A CHAR& CMPB #^A/ /,R2 ; SKIP LEADING BLANKS BNEQ 20$S DECL LENP BRB 10$ 20$: INCL R3 ; R3 TO HOLD SIGN CMPB #^A/-/,R2 ; MINUS SIGN ?? BNEQ 40$ ; NO MULL2 #-1,R3 ; SET TO MINUS DECL LENG'30$: MOVB (R1)+,R2 ; R2 GETS NEXT CHARW"40$: CMPB #^A/9/,R2 ; IS IT LEGAL BLSS ERR  CMPB #^A/0/,R2X BGTR ERRN* SUBB2 #48,R2 ; TAKE AWAY CHARACTER BIAS MULL2 #10,R4 ; SHIFT RESULT BCS ERR ; OVERFLOW ERROR ! ADDL2 R2,R4 ; ADD IN NEW DIGITR SOBGTR LEN,30$ ; MORE TO GETC! MULL2 R3,R4 ; MULTIPLY IN SIGN; MOVL R4,@8(AP) ; RETURN RESULT MOVL #1,R0 ; SUCCESSR RET;8ERR: MOVL #-1,R0 ; FAILEDD RET;M .ENDww 4(R2),NEWFAB+FAB$L_DNA ; SET DEFAULT NAME ADDRN' MULB3 #2,(R: WRITE(6,160)FILEID(1),FILEID(2),OPNERR,CHANE;160 FORMAT(' UNABLE TO OPEN FILE (',I8,',',I8,')',(% 1 ' ERROR = ',Z8,' STATUS = ',Z8)E GOTO 900 ENDIFCRC WRITE HEADER AND FAB TO TAPEICPH ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN),%VAL(%LOC(IO$_WRITELBLK))3 1 ,IOSB,,,%REF(INBUF),%VAL(512),,,,)D IF(.NOT.ERRSTAT) THENR$ STOP ' WRITE HEADER ERROR' ENDIF+ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) THENE CALL T;APEND(MTCHAN)' ENDIFH ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN),%VAL(%LOC(IO$_WRITELBLK))5 1 ,IOSB,,,%REF(FABLOCK),%VAL(100),,,,)T IF(.NOT.ERRSTAT) THENR% STOP ' WRITE FABLOCK ERROR'A ENDIF+ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) THENI CALL TAPEND(MTCHAN)T ENDIF IPTR = 1E DO 400 I = 1,32000R CALL READBLKA IF(OPNERR.NE.1 .AND. OPNERR.NE.2) STOP ' READBLK ERROR'O! IF(LENGTH .NE. 0) TCHEN,G CALL LMOVE(%DESCR(LBUF),%DESCR(OUTBUF(IPTR)),%VAL(LENGTH))- ENDIFF IPTR = IPTR+LENGTH" IF(IPTR .GE. 8193) THEN5 ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN),Q< 1 %VAL(%LOC(IO$_WRITELBLK)),IOSB,,,%REF(OUTBUF), 2 %VAL(8192),,,,),@ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) CALL TAPEND(MTCHAN) IPTR = 1N ENDIF. IF(OPNERR.EQ.2) THEN IPTR = IPTR-15 ERRSTAT = S =­à-Ë8ïÙˆ) PARAMETER FH2$B_ACC_MODE = '0000003B'X) PARAMETER FH2$B_ACOFFSET = '00000002'X) PARAMETER FH2$B_EX_FIDNMX = '00000013'X) PARAMETER FH2$B_EX_FIDRVN = '00000012'X) PARAMETER FH2$B_FID_NMX = '0000000D'X) PARAMETER FH2$B_FID_RVN = '0000000C'X) PARAMETER FH2$B_IDOFFSET = '00000000'X) PARAMETER FH2$B_MAP_INUSE = '0000003A'X) PARAMETER FH2$B_MPOFFSET = '00000001'X) PARAMETER FH2$B_RSOFFSET = '00000003'X) PARAMETER FH2$B_STRUCLEV = '00000007'X) P >ARAMETER FH2$B_STRUCVER = '00000006'X) PARAMETER FH2$C_LENGTH = '0000004C'X) PARAMETER FH2$K_LENGTH = '0000004C'X) PARAMETER FH2$L_FILECHAR = '00000034'X) PARAMETER FH2$L_FILEOWNER = '0000003C'X) PARAMETER FH2$L_SEC_LIMIT = '00000048'X) PARAMETER FH2$L_SEC_MASK = '00000044'X) PARAMETER FH2$W_CHECKSUM = '000001FE'X) PARAMETER FH2$W_EXT_FID = '0000000E'X) PARAMETER FH2$W_EX_FIDNUM = '0000000E'X) PARAMETER FH2$W_EX_FIDRVN = '00000012'X) PARAMETER FH2$W_EX_FID ?SEQ = '00000010'X) PARAMETER FH2$W_FID = '00000008'X) PARAMETER FH2$W_FID_NUM = '00000008'X) PARAMETER FH2$W_FID_RVN = '0000000C'X) PARAMETER FH2$W_FID_SEQ = '0000000A'X) PARAMETER FH2$W_FILEPROT = '00000040'X) PARAMETER FH2$W_RECATTR = '00000014'X) PARAMETER FH2$W_RECPROT = '00000042'X) PARAMETER FH2$W_SEG_NUM = '00000004'X) PARAMETER FH2$W_STRUCLEV = '00000006'X) PARAMETER FH2$W_UICGROUP = '0000003E'X) PARAMETER FH2$W_UICMEMBER = '0000003C'Xw@w­9ë8ïÙˆ) PARAMETER FI2$C_LENGTH = '00000036'X) PARAMETER FI2$K_LENGTH = '00000036'X) PARAMETER FI2$Q_BAKDATE = '0000002E'X) PARAMETER FI2$Q_CREDATE = '00000016'X) PARAMETER FI2$Q_EXPDATE = '00000026'X) PARAMETER FI2$Q_REVDATE = '0000001E'X) PARAMETER FI2$T_FILENAME = '00000000'X) PARAMETER FI2$T_USERLABEL = '00000036'X) PARAMETER FI2$W_REVISION = '00000014'Xww­à69ïÙˆ) PARAMETER HM2$B_LRU_LIM = '00000045'X) PARAMETER HM2$B_ST ARUCLEV = '0000000D'X) PARAMETER HM2$B_STRUCVER = '0000000C'X) PARAMETER HM2$B_WINDOW = '00000044'X) PARAMETER HM2$L_ALHOMELBN = '00000004'X) PARAMETER HM2$L_ALTIDXLBN = '00000008'X) PARAMETER HM2$L_HOMELBN = '00000000'X) PARAMETER HM2$L_IBMAPLBN = '00000018'X) PARAMETER HM2$L_MAXFILES = '0000001C'X) PARAMETER HM2$L_SEC_LIMIT = '00000030'X) PARAMETER HM2$L_VOLOWNER = '0000002C'X) PARAMETER HM2$Q_CREDATE = '0000003C'X) PARAMETER HM2$T_FORMAT = '000001F0'X B) PARAMETER HM2$T_OWNERNAME = '000001E4'X) PARAMETER HM2$T_STRUCNAME = '000001CC'X) PARAMETER HM2$T_VOLNAME = '000001D8'X) PARAMETER HM2$W_ALHOMEVBN = '00000012'X) PARAMETER HM2$W_ALTIDXVBN = '00000014'X) PARAMETER HM2$W_CHECKSUM1 = '0000003A'X) PARAMETER HM2$W_CHECKSUM2 = '000001FE'X) PARAMETER HM2$W_CLUSTER = '0000000E'X) PARAMETER HM2$W_DEVTYPE = '00000024'X) PARAMETER HM2$W_EXTEND = '00000046'X) PARAMETER HM2$W_FILEPROT = '00000036'X) PARAMETER HM2$W_HO MEVBN = '00000010'X) PARAMETER HM2$W_IBMAPSIZE = '00000020'X) PARAMETER HM2$W_IBMAPVBN = '00000016'X) PARAMETER HM2$W_PROTECT = '00000034'X) PARAMETER HM2$W_RECPROT = '00000038'X) PARAMETER HM2$W_RESFILES = '00000022'X) PARAMETER HM2$W_RVN = '00000026'X) PARAMETER HM2$W_SETCOUNT = '00000028'X) PARAMETER HM2$W_STRUCLEV = '0000000C'X) PARAMETER HM2$W_VOLCHAR = '0000002A'Xww DYS$QIOW(%VAL(2),%VAL(MTCHAN),N< 1 %VAL(%LOC(IO$_WRITELBLK)),IOSB,,,%REF(OUTBUF), 2 %VAL(IPTR),,,,)N@ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) CALL TAPEND(MTCHAN)5 ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN),4 1 %VAL(%LOC(IO$_WRITEOF)),,,,,,,,,) CALL CLOSEIDNC C WRITE RECORD TO LISTING FILEvCd$ FILECOUNT = FILECOUNT+10 CALL SYS$ASCTIM(,FILEDATE,REVDAT,,)@ WRITE(4,110)FILECOUNT,NAME,FILEIDE(1),FILEID(2),UIC, 1 FILEDATE,IG110 FORMAT(X,I6,3X,19A1,3X,'(',I5,',',I4,')',3X,'[',O3,',', 2 1 O3,']',3X,A23,3X,I6,' BLOCKS') GOTO 401X ENDIFI400 CONTINUE 401 ENDIF 900 CONTINUEC'@C WRITE ANOTHER END-OF-FILE ON THE TAPE: 2 EOF'S = END-OF-TAPECL 901 CONTINUE) ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN),( 1 %VAL(%LOC(IO$_WRITEOF)),,,,,,,,,) IF(.NOT. ERRSTAT) THEN WRITE(6,155)ERRSTATT/155 FORMANT(' CANT WRITE LAST EOF; STAT=',Z8)E ENDIF999 STOP ' STOP BACKUP' ENDCCC+C *** SUBROUTINE GETDATE *** CO>C GETDATE IS USED BY THE INCREMENTAL BACKUP MAINLINE "INCBCK"DC TO EXTRACT THE REVISION DATE FROM A FILE HEADER. IF THE REVISION5C DATE IS EMPTY THEN THE FILE CREATION DATE IS USED.CCO2C THE FILE HEADER IS PASSED IN THE ARRAY 'BUFFER'+C THE DATE IS RETURNED IN THE ARRAY 'DATE'RC C-& SUBROUTINE GETDATE(BUFFER,DATE,ISTAT) INCLUDE 'FILEID.FOR' BYTE BUFFER(51G­¨Û ‰ .TITLE CRE_FILE .LIBRARY /[SYSLIB]LIB/ ;I:; ROUTINE FOR USE WITH 'RESTORE' PROGRAM TO CREATE A FILE;; ON THE OUTPUT DEVICE WITH ALL THE ORIGINAL ATTRIBUTES OFT; THE FILE BEING RESTORED.M;; CALLING SEQUENCE:;V ; INPUTS:;; HEADER - ADDRESS OF A HEADER BLOCK (FROM THE BACKUP TAPE)R=; DEVDIR - DESCRIPTOR POINTING TO DEVICE, DIRECTORY STRING ON:$; WHICH THE FILE IS TO BE RESTORED;O ; OUTPUTS:CC; CHANNEL - ADDRESS OF WORD TO RECEIVE I/O CHANNEL RETURNED BYH RMS :-; WHICH MUST BE USED FOR SUBSEQUENT QIO'S.D; STATUS - STATUS CODE; 1 - SUCCESSL-; FAILURE CODE RETURNED FROM RMS THROUGH R0;G; NOTE:@; IF A FILE OF THE SAME NAME EXISTS THIS WILL BECOME NEW VERSION;U;R4 .PSECT RSTCOM,PIC,OVR,SHR,REL,GBL,NOEXE,RD,WRT,LONGOUTBLK: .BLKW 4096OUTSIZ: .BLKL 1ISTATUS: .BLKL 1 NEWFAB: $FAB E2 .PSECT DATA,PIC,OVR,SHR,REL,GBL,NOEXE,RD,WRT,LONG3FILRAB: $RAB FAB=NEWFAB,RBF=OUTBLK,RSZ=8192,ROP=BIO'DATE: $XABDAT NXT=PROT PROT: $XABPROIFILNAM: .BLKW 10IDOFF: .LONG 0TERM: .ASCID /TT/C CHAN: .WORD 0U;' CRE_FILE:: .WORD 0 $FI2DEF ; ID AREA VALUES $FH2DEF ; HEADER OFFSETS$ $FATDEF ; ATTRIBUTE AREA OFFSETS $ASSIGN_S TERM,CHAN CLRL R0 CLRL R3 MOVL 4(AP),R1 ; R1 -> HEADERD, MOVAL @8(AP),R2 ; R2 -> DEVDIR DESCRIPTOR6 MOVB @8(AP),NEWFAB+FAB$B_DNS ; SET DEFAULT NAME SIZE5 MOVL 4(R2),NEWFAB+FAB$L_DNA ; SET DEFAULT NAME ADDR ' MULB3 #2,(R1),IDOFF ; ID AREA OFFSETT MOVL R1,R3 ; R3 -> HEADER42 ADD JL2 #FH2$W_FILEPROT,R3 ; R3 -> PROTECTION WORD* MOVZWL #PROT+XAB$W_PRO,R5 ; R5 -> XABPRO$ MOVB (R3)+,(R5)+ ; SHIFT IN THE - MOVB (R3)+,(R5) ; PROTECTION 3 ADDL3 #FH2$W_RECATTR,R1,R3 ; R3 -> REC ATTR AREAD: MOVB FAT$B_RTYPE(R3),NEWFAB+FAB$B_ORG ; FILE ORGANIZATION- EXTV #0,#4,NEWFAB+FAB$B_ORG,NEWFAB+FAB$B_RFMT ; RECORD FORMAT; MOVB FAT$B_RATTRIB(R3),NEWFAB+FAB$B_RAT ; RECORD ATTRIBUTEA4 MOVW FAT$W_RSIZE(R3),NEWFAB+FAB$W_MRS ; RECORD SIZE6 MOVZWL FAT$W_HIBLKL(R3),NEWFAB+FAB$L_AL KQ ; ALLOCATION3 ADDL3 #FH2$W_RECATTR,R1,R3 ; R3 -> REC ATTR AREA-6 MOVB FAT$B_BKTSIZE(R3),NEWFAB+FAB$B_BKS ; BUCKET SIZE: MOVB FAT$B_VFCSIZE(R3),NEWFAB+FAB$B_FSZ ; FIXED CTRL SIZE= MOVW FAT$W_DEFEXT(R3),NEWFAB+FAB$W_DEQ ; DEFAULT EXTEND SIZE,$ ADDL3 IDOFF,R1,R3 ; R3 -> ID AREA MOVL R3,R1 ; SAVE POINTER(! MOVL #FILNAM,R5 ; R5 -> FILNAME CLRL R4 ; COUNTER FOR LENGTH/10$: CMPB #59,(R3) ; DONT MOVE ';' (VERS NO.)S BEQL 20$  INCB R4 ; COUNTER,* MOVB (R3)+,(R5)+ ; BUILD FILLNAME STRING BRB 10$-20$: MOVB R4,NEWFAB+FAB$B_FNS ; GET THE SIZE2 CLRL R5 ; COUNTERD) MOVL R1,R3 ; TAKE COPY OF ID AREA PTRT- ADDL2 #FI2$Q_CREDATE,R1 ; R1 -> CREATE DATE,/ ADDL2 #FI2$Q_REVDATE,R3 ; R3 -> REVISION DATET+ MOVL #DATE+XAB$Q_CDT,R2 ; GET POINTERS TOI& MOVL #DATE+XAB$Q_RDT,R4 ; DATE BLOCK&30$: MOVB (R1)+,(R2)+ ; SHIFT IN THE$ MOVB (R3)+,(R4)+ ; ORIGINAL DATES AOBLSS #8,R5,30$ * MOVW #0,NEWFAB+FAB$W_IFI ; CLEAR THE IFI0 MOVL #0,NEWFAB+FAB$L_NAM ; AND NAME BLMOCK ADDR3 MOVL #FILNAM,NEWFAB+FAB$L_FNA ; SET FILE NAME ADDR(3 MOVL #DATE,NEWFAB+FAB$L_XAB ; AND DATE BLOCK ADDR/ BISL2 #,NEWFAB+FAB$L_FOP P ; SET BITS IN FOP', BISB2 #FAB$M_BIO,NEWFAB+FAB$B_FAC ; AND FAC $CREATE FAB=NEWFAB$ BLBC R0,FAILEDL $CONNECT RAB=FILRAB,ERR=NOCONN BLBC R0,FAILED= MOVL #1,STATUS9 RETFAILED:1 MOVL R0,STATUS5 MOVL R0,@12(AP) RET;(NOCONN:T MOVL #-1,STATUS RET;Q WRITEBLK:: .WORD 0 MOVW OUTSIZ,FILRAB+RAB$W_RSZ $WRITE RAB=FILRAB,ERR=WRITERR MOVL #1,STATUS) RET;TWRITERR: MOVL R0,STATUSB RET;E CLOSEFIL:: .WORD $CLOSE FAB=NEWFAB BLBC R0,CLOSERR MOVL #1,STATUS( RET;WCLOSERR: MOVL R0,STATUST RET;) .END wwF ERROR FOLLOWING LABEL'GCA5C OPEN THE LISTING FILE AND WRITE IN A HEADER RECORDNC  LISTFILE(1:2) = ADAT(1:2) LISTFILE(3:5) = ADAT(4:6) LISTFILE(6:7) = ADAT(10:11) LISTFILE(8:11) = '.BAK'' OPEN (UNIT=4,NAME=LISTFILE,TYPE='NEW')+ WRITE(4,100)NOW,ADAT(1:11),DI[2) BYTE DATE(8) INTEGER*4 OFFSET + IF(BUFFER(1).NE.38) THEN ! INVALID HEADERI ISTAT = -1 RETURN ENDIF# OFFSET = BUFFER(1)*2+FI2$Q_REVDATEG@ IF(BUFFER(OFFSET+1) .EQ. 0) OFFSET = BUFFER(1)*2+FI2$Q_CREDATE DATE(1) = BUFFER(OFFSET+1)' DATE(2) = BUFFER(OFFSET+2)M DATE(3) = BUFFER(OFFSET+3)C DATE(4) = BUFFER(OFFSET+4)L DATE(5) = BUFFER(OFFSET+5) DATE(6) = BUFFER(OFFSET+6)L DATE(7) = BUFFER(OFFSET+7)B DATE(8) = BUFFER(OFFSET+8)L ISTAT = 0 RETURNN ENDCEC+C *­“¡¶L߈;+ .TITLE LMOVEC; WD; CALL FROM FORTRAN IN FORMAT: CALL LMOVE(STRING1,STRING2,LENGTH);T6; WILL MOVE LENGTH CHARACTERS FROM STRING1 TO STRING2;S; NOTE:3; STRING1 AND STRING2 ARE PASSED BY DESCRIPTORW; LENGTH IS PASSED BY VALUE;A;-LMOVE::E .WORD 0 MOVAL @4(AP),R1 MOVAL @8(AP),R2 MOVL 4(R1),R1 MOVL 4(R2),R2 MOVAL @12(AP),R0F10$: MOVB (R1)+,(R2)+L SOBGTR R0,10$ RET .ENDSww(6:7) = ADAT(10:11) LISTFILE(8:11) = '.BAK'' OPEN (UNIQ­ ˜™M߈ .TITLE CRE_FILE .LIBRARY /[SYSLIB]LIB/I;T:; ROUTINE FOR USE WITH 'RESTORE' PROGRAM TO CREATE A FILE;; ON THE OUTPUT DEVICE WITH ALL THE ORIGINAL ATTRIBUTES OF,; THE FILE BEING RESTORED.';0; CALLING SEQUENCE:;E ; INPUTS:;; HEADER - ADDRESS OF A HEADER BLOCK (FROM THE BACKUP TAPE)T=; DEVDIR - DESCRIPTOR POINTING TO DEVICE, DIRECTORY STRING ON%$; WHICH THE FILE IS TO BE RESTORED;, ; OUTPUTS:TC; CHANNEL - ADDRESS OF WORD TO RECEIVE I/O CHANNEL RETURNED BYR RMS G-; WHICH MUST BE USED FOR SUBSEQUENT QIO'S.L; STATUS - STATUS CODE; 1 - SUCCESS(-; FAILURE CODE RETURNED FROM RMS THROUGH R0A;L; NOTE:@; IF A FILE OF THE SAME NAME EXISTS THIS WILL BECOME NEW VERSION; ; 4 .PSECT RSTCOM,PIC,OVR,SHR,REL,GBL,NOEXE,RD,WRT,LONGOUTBLK: .BLKW 4096OUTSIZ: .BLKL 1LSTATUS: .BLKL 1( NEWFAB: $FAB 2 .PSECT DATA,PIC,OVR,SHR,REL,GBL,NOEXE,RD,WRT,LONG3FILRAB: $RAB FAB=NEWFAB,RBF=OUTBLK,RSZ=8192,ROP=BIO)DATE: $XABDAT NXT=PROT PROT: $XABPRO SFILNAM: .BLKW 10IDOFF: .LONG 0TERM: .ASCID /TT/ CHAN: .WORD 0); CRE_FILE:: .WORD 0 $FI2DEF ; ID AREA VALUES $FH2DEF ; HEADER OFFSETS $ASSIGN_S TERM,CHAN CLRL R0 CLRL R3 MOVL 4(AP),R1 ; R1 -> HEADERS, MOVAL @8(AP),R2 ; R2 -> DEVDIR DESCRIPTOR6 MOVB @8(AP),NEWFAB+FAB$B_DNS ; SET DEFAULT NAME SIZE5 MOVL 4(R2),NEWFAB+FAB$L_DNA ; SET DEFAULT NAME ADDRQ' MULB3 #2,(R1),IDOFF ; ID AREA OFFSET  MOVL R1,R3 ; R3 -> HEADERP2 ADDL2 #FH2$W_FILEPROT,R3 ; R3 -> PROTECTTION WORD* MOVZWL #PROT+XAB$W_PRO,R5 ; R5 -> XABPRO$ MOVB (R3)+,(R5)+ ; SHIFT IN THE - MOVB (R3)+,(R5) ; PROTECTION,2 ADDL3 #FH2$W_RECATTR,R1,R3 ; R3 -> REC ATTR AREA-; MOVB (R3),NEWFAB+FAB$B_RFM ; RECORD FORMAT51 MOVB (R3)+,NEWFAB+FAB$B_ORG ; FILE ORGANIZATION - EXTV #0,#4,NEWFAB+FAB$B_ORG,NEWFAB+FAB$B_RFM' ; RECORD FORMAT30 MOVB (R3)+,NEWFAB+FAB$B_RAT ; RECORD ATTRIBUTE+ MOVW (R3)+,NEWFAB+FAB$W_MRS ; RECORD SIZEP TSTB (R3)+R* MOVL (R3)+,NEWFAB+FAB$L_ALQ ; ALLOCATION$ AUDDL3 IDOFF,R1,R3 ; R3 -> ID AREA MOVL R3,R1 ; SAVE POINTER(! MOVL #FILNAM,R5 ; R5 -> FILNAM CLRL R4 ; COUNTER FOR LENGTH/10$: CMPB #59,(R3) ; DONT MOVE ';' (VERS NO.)T BEQL 20$H INCB R4 ; COUNTERD* MOVB (R3)+,(R5)+ ; BUILD FILNAME STRING BRB 10$-20$: MOVB R4,NEWFAB+FAB$B_FNS ; GET THE SIZE  CLRL R5 ; COUNTERL) MOVL R1,R3 ; TAKE COPY OF ID AREA PTR- ADDL2 #FI2$Q_CREDATE,R1 ; R1 -> CREATE DATE)/ ADDL2 #FI2$Q_REVDATE,R3 ; R3 -> REVISION DATE + MOVL #DATE+XAVB$Q_CDT,R2 ; GET POINTERS TO & MOVL #DATE+XAB$Q_RDT,R4 ; DATE BLOCK&30$: MOVB (R1)+,(R2)+ ; SHIFT IN THE$ MOVB (R3)+,(R4)+ ; ORIGINAL DATES AOBLSS #8,R5,30$ * MOVW #0,NEWFAB+FAB$W_IFI ; CLEAR THE IFI0 MOVL #0,NEWFAB+FAB$L_NAM ; AND NAME BLOCK ADDR3 MOVL #FILNAM,NEWFAB+FAB$L_FNA ; SET FILE NAME ADDRV3 MOVL #DATE,NEWFAB+FAB$L_XAB ; AND DATE BLOCK ADDR / BISL2 #,NEWFAB+FAB$L_FOP  ; SET BITS IN FOP , BISB2 #FAB$M_BIO,NEWFAB+FAB$B_FAC ; AND FAC $CREATE FABW=NEWFAB,ERR=FAILED $CONNECT RAB=FILRAB,ERR=NOCONNE MOVL #1,STATUS  RETFAILED:9 MOVL R0,STATUS  MOVL R0,@12(AP) RET;DNOCONN:C MOVL #-1,STATUS RET; WRITEBLK:: .WORD 0 MOVW OUTSIZ,FILRAB+RAB$W_RSZ. $WRITE RAB=FILRAB,ERR=WRITERR MOVL #1,STATUS  RET;TWRITERR: MOVL R0,STATUSC RET;1 CLOSEFIL:: .WORD $CLOSE FAB=NEWFAB BLBC R0,CLOSERR MOVL #1,STATUSV RET;,CLOSERR: MOVL R0,STATUS1 RET;$ .ENDAwwCALL TAPEND(MTCHAN)5 ERRSTAT = SYSXSK,TAPENUMBER,3100 FORMAT(/,' INCREMENTAL BACKUP TAKEN AT ',A23,/,E8 1 ' OF FILES DATED ON OR AFTER ',A11,' FROM ',5A1,$ 2 3X,'ON TAPE NUMBER ',A10,//)CFLC READ THE HOME BLOCK ON INPUT DISK AND CALCULATE VBN OF FIRST HEADER BLOCKC B ERRSTAT = SYS$QIOW(%VAL(2),%VAL(IDXCHN),%VAL(%LOC(IO$_READVBLK)),1 1 %REF(IOSB),,,%REF(INBUF),%VAL(512),%VAL(2),,,)X IF(.NOT. ERRSTAT) THEN WRITE(6,10)ERRSTAT,10 FORMAT(' ERROR READING HOME BLOCK',Z8) STOP ENDIF" CLUSTER = LBUF((HM2Y$W_CLUSTER)+1)% BMAPSIZE = LBUF((HM2$W_IBMAPSIZE)+1)' MAXFIL = INBUF(((HM2$L_MAXFILES)/2)+1) ! STARTBLK = CLUSTER*4+BMAPSIZE+10TCS>C NOW READ HEADERS LOOKING FOR A FILE ELIGIBLE FOR BACKING UPC, IFIL = STARTBLK FILECOUNT = 0' DO 900 IFIL = STARTBLK,STARTBLK+MAXFILAH ERRSTAT = SYS$QIOW(%VAL(2),%VAL(IDXCHN),%VAL(%LOC(IO$_READVBLK)),,,,2 1 %REF(INBUF),%VAL(512),%VAL(IFIL),,,) IF(.NOT.ERRSTAT) THEN WRITE(6,20)ERRSTAT"020 FORMAT(' ERROR READING FILE HEADEZR',Z8) STOP ' HEADER READ ERROR' ENDIF  IDOFF = LBUF(1)*2  CALL GETDATE(LBUF,REVDAT) & IF(REVDAT(2) .GE. BAKDAT(2)) THEN< CALL LMOVE(%DESCR(LBUF(IDOFF)),%DESCR(NAME),%VAL(19))+ FILEID(1) = INBUF(((FH2$W_FID)/2)+1) / FILEID(2) = INBUF(((FH2$W_FID_SEQ)/2)+1) 7 IF(FILEID(1).EQ.0 .OR. FILEID(2).EQ.0) GO TO 900 - UIC(1) = INBUF(((FH2$W_UICGROUP)/2)+1) . UIC(2) = INBUF(((FH2$W_UICMEMBER)/2)+1)C IC OPEN THE FILE BY ID, READ BLOCKS IN]TO THE OUTPUT BUFFER AND, WHEN FULL C WRITE THE BUFFER TO TAPEFC  FILEID(3) = 0 CALL FIDOPN IF(OPNERR .EQ. 3) THEN2 WRITE(4,150)NAME,FILEID(1),FILEID(2),UIC@150 FORMAT(/,' LOCKED',3X,19A1,3X,'(',I5,',',I4,')',3X, 1 '[',O3,',',O3,']',/) GOTO 900# ELSE IF(OPNERR .NE. 1) THEN 5 WRITE(6,160)FILEID(1),FILEID(2),OPNERR,CHAN ;160 FORMAT(' UNABLE TO OPEN FILE (',I5,',',I4,')',S% 1 ' ERROR = ',Z8,' STATUS = ',\** SUBROUTINE PARSIT ***C =C PARSIT IS USED BY THE INCREMENTAL BACKUP MAINLINE "INCBCK" C TO PARSE A COMMAND LINE.SCS>C THE COMMAND LINE IS PASSED IN THE CHARACTER STRING "STRING"AC THE DATE, DISK, AND TAPE ARE RETURNED IN LOGICAL ARRAYS OF THE C SAME NAME. CT?C IF THE DISK OR TAPE FIELDS ARE MISSING FROM THE COMMAND LINET/C PARSIT WILL PROMPT THE USER FOR THESE VALUESICTC-/ SUBROUTINE PARSIT(STRING,DATE,DISK,TAPE,ERROR)CT# LOGICAL*1 DATE(23),DISK(5),TAPE(5)H INTEGERh*2 ERROR CHARACTER*80 STRING K = INDEX(STRING,'/') J = INDEX(STRING,':')" IF (J .EQ. 0 .OR. K .EQ. 0) THEN WRITE(6,50)-%50 FORMAT(' Invalid Command Line')R ERROR = -1 RETURN ENDIF; CALL LMOVE(%DESCR(STRING(J+1:J+12)),%DESCR(DATE),%VAL(11)) J = INDEX(STRING,'DB') IF (J .EQ. 0) THEN WRITE(6,10)10 FORMAT(' From: ',$) READ(5,20)DISK20 FORMAT(5A1) ELSE: CALL LMOVE(%DESCR(STRING(J:J+5)),%DESCR(DISK),%VAL(5)) ENDIF J = INDEX(STRING,'MT')^Z8)P GOTO 900 ENDIFCHC WRITE HEADER AND FAB TO TAPE CRH ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN),%VAL(%LOC(IO$_WRITELBLK))3 1 ,IOSB,,,%REF(INBUF),%VAL(512),,,,)( IF(.NOT.ERRSTAT) THEN $ STOP ' WRITE HEADER ERROR' ENDIF+ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) THEN  CALL TAPEND(MTCHAN)D ENDIFH ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN),%VAL(%LOC(IO$_WRITELBLK))5 1 ,IOSB,,,%REF(FABLOCK),%VAL(10_0),,,,)( IF(.NOT.ERRSTAT) THEN % STOP ' WRITE FABLOCK ERROR'D ENDIF+ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) THEN  CALL TAPEND(MTCHAN)D ENDIF IPTR = 1  DO 400 I = 1,32000  CALL READBLKA IF(OPNERR.NE.1 .AND. OPNERR.NE.2) STOP ' READBLK ERROR' ! IF(LENGTH .NE. 0) THEN G CALL LMOVE(%DESCR(LBUF),%DESCR(OUTBUF(IPTR)),%VAL(LENGTH))  ENDIF  IPTR = IPTR+LENGTH" IF(IPTR .GE.` 8193) THEN5 ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN), < 1 %VAL(%LOC(IO$_WRITELBLK)),IOSB,,,%REF(OUTBUF), 2 %VAL(8192),,,,) @ IF(IOSB(1) .EQ. SS$_ENDOFTAPE) CALL TAPEND(MTCHAN) IPTR = 1  ENDIF  IF(OPNERR.EQ.2) THEN IPTR = IPTR-15 ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN), < 1 %VAL(%LOC(IO$_WRITELBLK)),IOSB,,,%REF(OUTBUF), 2 %VAL(IPTR),,,,) @ IF(IOSB(1) a.EQ. SS$_ENDOFTAPE) CALL TAPEND(MTCHAN)5 ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN), 4 1 %VAL(%LOC(IO$_WRITEOF)),,,,,,,,,) CALL CLOSEIDICRC WRITE RECORD TO LISTING FILE C $ FILECOUNT = FILECOUNT+10 CALL SYS$ASCTIM(,FILEDATE,REVDAT,,)@ WRITE(4,110)FILECOUNT,NAME,FILEID(1),FILEID(2),UIC, 1 FILEDATE,IG110 FORMAT(X,I6,3X,19A1,3X,'(',I5,',',I4,')',3X,'[',O3,',', 2 1 O3,'b]',3X,A23,3X,I6,' BLOCKS') GOTO 401  ENDIF 400 CONTINUE 401 ENDIF 900 CONTINUECA@C WRITE ANOTHER END-OF-FILE ON THE TAPE: 2 EOF'S = END-OF-TAPEC=) ERRSTAT = SYS$QIOW(%VAL(2),%VAL(MTCHAN),A( 1 %VAL(%LOC(IO$_WRITEOF)),,,,,,,,,) IF(.NOT. ERRSTAT) THEN WRITE(6,155)ERRSTATR/155 FORMAT(' CANT WRITE LAST EOF; STAT=',Z8)9 ENDIF999 STOP ' STOP BACKUP' ENDC*C+C *** SUBROUTINE GETDATE ***TCE>C GETDATE IS USED BY THE INCREMENTAL cBACKUP MAINLINE "INCBCK"DC TO EXTRACT THE REVISION DATE FROM A FILE HEADER. IF THE REVISION5C DATE IS EMPTY THEN THE FILE CREATION DATE IS USED.ECL2C THE FILE HEADER IS PASSED IN THE ARRAY 'BUFFER'+C THE DATE IS RETURNED IN THE ARRAY 'DATE'SCOC- SUBROUTINE GETDATE(BUFFER,DATE) INCLUDE 'FILEID.FOR' BYTE BUFFER(512) BYTE DATE(8) BYTE OFFSET # OFFSET = BUFFER(1)*2+FI2$Q_REVDATER@ IF(BUFFER(OFFSET+1) .EQ. 0) OFFSET = BUFFER(1)*2+FI2$Q_CREDATE DATE(1) = BUFFER(OFFSET+1)=d DATE(2) = BUFFER(OFFSET+2)= DATE(3) = BUFFER(OFFSET+3)= DATE(4) = BUFFER(OFFSET+4)= DATE(5) = BUFFER(OFFSET+5)= DATE(6) = BUFFER(OFFSET+6)= DATE(7) = BUFFER(OFFSET+7)= DATE(8) = BUFFER(OFFSET+8) RETURN ENDC*C+C *** SUBROUTINE PARSIT ***C =C PARSIT IS USED BY THE INCREMENTAL BACKUP MAINLINE "INCBCK"SC TO PARSE A COMMAND LINE.ECM>C THE COMMAND LINE IS PASSED IN THE CHARACTER STRING "STRING"AC THE DATE, DISK, AND TAPE ARE RETURNED IN LOGICAL ARRAYS OF THEA C SAMeE NAME. C ?C IF THE DISK OR TAPE FIELDS ARE MISSING FROM THE COMMAND LINE /C PARSIT WILL PROMPT THE USER FOR THESE VALUESSCOC-/ SUBROUTINE PARSIT(STRING,DATE,DISK,TAPE,ERROR)CC1# LOGICAL*1 DATE(23),DISK(5),TAPE(5)2 INTEGER*2 ERROR CHARACTER*80 STRING K = INDEX(STRING,'/') J = INDEX(STRING,':')" IF (J .EQ. 0 .OR. K .EQ. 0) THEN WRITE(6,50)M%50 FORMAT(' Invalid Command Line')  ERROR = -1 RETURN ENDIF; CALL LMOVE(%DESCR(STRING(J+1:J+12)),%DESCR(DATE),%VAL(11)f)X J = INDEX(STRING,'DB')Q IF (J .EQ. 0) THEN( WRITE(6,10)M10 FORMAT(' From: ',$)5 READ(5,20)DISK20 FORMAT(5A1)  ELSEL: CALL LMOVE(%DESCR(STRING(J:J+5)),%DESCR(DISK),%VAL(5)) ENDIF J = INDEX(STRING,'MT')Q IF (J .EQ. 0) THEN WRITE(6,30)M30 FORMAT(' To: ',$)5 READ(5,40)TAPE40 FORMAT(5A1)  ELSEL: CALL LMOVE(%DESCR(STRING(J:J+5)),%DESCR(TAPE),%VAL(5)) ENDIF ERROR = 0 RETURN ENDC*C+C *** SUBROUTINE TAPEND ***C >C TAPEND ISg USED BY THE INCREMENTAL BACKUP MAINLINE "INCBCK" &C TO HANDLE END OF TAPE PROCESSING. DC THIS ROUTINE IS CALLED IF AN SS$_ENDOFTAPE STATUS RESULTS FROM A C WRITE TO THE OUTPUT TAPE.FC THE ROUTINE WILL REWIND THE CURRENT TAPE UNLOAD IT AND ASK THE USERAC TO LOAD THE NEXT TAPE. ONCE THE NEXT TAPE IS READY CONTROL ISEC RETURNED TO THE MAINLINE.CAAC THE CHANNEL ASSIGNED TO THE OUTPUT TAPE IS PASSED IN "TAPCHAN"CBC- SUBROUTINE TAPEND(TAPCHAN)RC  EXTERNAL IO$_REWINDOFF2 INTEGER*2 TAPCHAN LOGICAL*1 DUMMYH CALL SYS$QIOW(%VAL(2),%VAL(TAPCHAN),%VAL(%LOC(IO$_REWINDOFF)),,,,,,,,,) WRITE(6,100)TA100 FORMAT(' BACKUP/RESTORE -- MOUNT NEXT REEL AND HIT RETURN',$)1 READ(5,110)DUMMYT110 FORMAT(A1) RETURN ENDwwi IF (J .EQ. 0) THEN WRITE(6,30)30 FORMAT(' To: ',$) READ(5,40)TAPE40 FORMAT(5A1) ELSE: CALL LMOVE(%DESCR(STRING(J:J+5)),%DESCR(TAPE),%VAL(5)) ENDIF ERROR = 0 RETURN ENDCC+C *** SUBROUTINE TAPEND ***C>C TAPEND IS USED BY THE INCREMENTAL BACKUP MAINLINE "INCBCK" &C TO HANDLE END OF TAPE PROCESSING. DC THIS ROUTINE IS CALLED IF AN SS$_ENDOFTAPE STATUS RESULTS FROM A C WRITE TO THE OUTPUT TAPE.FC THE ROUTINE WILL REWIND THE CURRENT TAPE UNjLOAD IT AND ASK THE USERAC TO LOAD THE NEXT TAPE. ONCE THE NEXT TAPE IS READY CONTROL ISC RETURNED TO THE MAINLINE.CAC THE CHANNEL ASSIGNED TO THE OUTPUT TAPE IS PASSED IN "TAPCHAN"CC- SUBROUTINE TAPEND(TAPCHAN)C EXTERNAL IO$_REWINDOFF INTEGER*2 TAPCHAN LOGICAL*1 DUMMYH CALL SYS$QIOW(%VAL(2),%VAL(TAPCHAN),%VAL(%LOC(IO$_REWINDOFF)),,,,,,,,,) WRITE(6,100)A100 FORMAT(' BACKUP/RESTORE -- MOUNT NEXT REEL AND HIT RETURN',$) READ(5,110)DUMMY110 FORMAT(A1) RETURN ENDww