25208BA4.BCKTMPT25208BA4.BCKTMPFBACKUP/GROUP=100/BLOCK=4608/LOG/EXCL=*.BCKTMP *.* 25208BA4.BCKTMP/SAVE OSUDAR G@`Y!wA5.5 _ANLCMT::  _ANLCMT$DUA6: V5.5-2 d$*[B35049.DRIVERS.XTPC]AAAREADME.1ST;1+," ./G@ 4O-p0123KPWO56ծw7 w89GG@HJMThis directory contains a modified version of Brian Nelson's VMSTPC tape copyLprogram. This version (VMSXTPC) has two features not found in the original:Ffirst, it supports tape blocks of up to 64KB; second, it supports data"compression in the container file.LLarge tape block support is accomplished by writing large blocks as multiplecontainer file records.MData compression, which is selected by default but may be turned off with theI/NOCOMPRESS qualifier, is done using my QLZW "quick LZW" record-at-a-timeKcompression routine. Warning -- this routine uses a lot of memory! If youKselect compression, specify 30 buffers, and try to process a tape with 64KBKblocks, your WSEXTENT should be at least 20480. Decompression requires farKless memory. However, with a compressed container file, you can reduce theKdisk space required to store a tape by 50% or more. Given enough memory toMeliminate page faults, TPC appears to be able to compress on the fly and keepOup with a 4mm DDS-DC tape drive when running on VAX CPU's of 6 or 7 VUPs. Yourmileage may vary.MPlease send any questions or comments about the TPC modifications or the QLZW,routine to John Osudar (osudar@cmt.anl.gov). *[B35049.DRIVERS.XTPC]QLZW.MAR;42+,<./G@ 4P0-p0123KPWO56 ߿*7:-o89`űwvGG@HJ, .TITLE QLZW -- Quick LZW record compression;B; Written: 12-Apr-1991 by John Osudar, Argonne National Laboratory;C; These routines implement record-level data compression, using theA; LZW (Lempel-Ziv-Welch) algorithm that is in common use for file/; compression. The major differences here are:;=; (1) This code is designed to compress one record at a time; (maximum 65535 bytes in);<; (2) This code uses a variation on direct table lookup for9; the code (string) table, to achieve better speed than;; typical hash-based implementations while requiring less:; virtual memory than full direct-table implementations.;I; The table lookup technique allocates a page of memory for a table "row"G; the first time a code is to be inserted into that row. An index listH; of row pointers is maintained to track the allocated pages. Two listsF; of locations that have been modified are kept, so that the table mayD; be zeroed for each record without zeroing megabytes of memory at a@; time (the vast majority of which will already be zero anyway).;.; The following two entry points are supplied:;4; STATUS=QLZW_CMP(INBUF,INLEN,OUTBUF,OUTLEN,OUTSIZE);D; Compress record INBUF (length INLEN bytes) into OUTBUF, and returnB; resulting length in OUTLEN. OUTBUF is limited to OUTSIZE bytes.;#; All arguments passed by reference&; INLEN, OUTLEN, OUTSIZE are longwordsI; OUTLEN is set to the number of bytes in the output if status is success;.; returns 1 if record succesMC25208BA4.BCKTMP<p [B35049.DRIVERS.XTPC]QLZW.MAR;42Psfully compressed,0; 2 if compression would produce longer record,2; fatal status code (severity 4) in case of error;4; STATUS=QLZW_DCM(INBUF,INLEN,OUTBUF,OUTLEN,OUTSIZE);F; Decompress record INBUF (length INLEN bytes) into OUTBUF, and returnB; resulting length in OUTLEN. OUTBUF is limited to OUTSIZE bytes.;#; All arguments passed by reference&; INLEN, OUTLEN, OUTSIZE are longwordsI; OUTLEN is set to the number of bytes in the output if status is success;0; returns 1 if record successfully decompressed,5; SS$_ABORT if OUTBUF is too small to contain record;P;===============================================================================;E; Parameters that control the page allocation; AREAPAGES are obtainedH; from the system (via LIB$GET_VM_PAGE) at a time, and are given out viaD; an internal allocation routine one page at a time. Once pages areG; obtained they are not given back (e.g. via LIB$FREE_VM_PAGE), but are,; kept in a list and reused for each record.;AREAPAGES=256 ; Pages in area6AREAMAX=37120/AREAPAGES ; Number of areas we can have;; Pure data PSECT;? .PSECT QLZW_PURE_DATA PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,QUAD; AREASIZE:& .LONG AREAPAGES ; Area size, in pages.ARGLIST: ; Argument list for LIB$GET_VM_PAGE .LONG 2 .ADDRESS AREASIZE .ADDRESS WHERE;D; Impure data, structured as a "COMMON block" to facilitate external; instrumentation;> .PSECT QLZW_COMMON_DATA PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,PAGE;BEGIN_COMMON=.;J; The first two tables provide addresses of location to zero for each call;=TBLLOC: .BLKL 37120 ; Addresses of nonzero entries in ROWADRDREFLOC: .BLKL 37120 ; Addresses of references to codes 256+ in tblsAZRFLOC=REFLOC-1024 ; Label to pretend REFLOC has space for 0-255;B; The next table contains the index of row addresses for each code;@ROWADR: .BLKL 37120 ; Addresses of row tables for codes 0-37119;@; The list of memory areas obtained from LIB$GET_VM_PAGE follows;7AREAS: .BLKL AREAMAX ; List of addresses of page areas;8; Various pointers, limits, counters and bitmasks follow;5; TBLIDX and MAXCOD must occur together in that order;2TBLIDX: .LONG 0 ; Index to last TBLLOC entry used&MAXCOD: .LONG 0 ; Maximum code in use;4; WHERE and NXTIDX must occur together in that order;7WHERE: .BLKL 1 ; Temporary storage for LIB$GET_VM_PAGE=NXTIDX: .LONG 0 ; Index of next area pointer to use in AREAS;5; FREEPG and NOMORE must occur together in that orde r;0FREEPG: .LONG 0 ; Address of next free row page8NOMORE: .LONG 0 ; Address of location after end of area;&FMASK: .BLKL 1 ; Bit field mask value END_COMMON=.;; Executable code PSECT;7 .PSECT QLZW_CODE PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,QUAD;4 .ENTRY QLZW_CMP,^M;< MOVQ #9,R2 ; Initial field size is 9 bits, R3=FPOS is zero6 MOVZWL #^X1FF,FMASK ; Initial field mask is nine bits' CLRL NXTIDX ; Clear next area pointer, CLRQ FREEPG ; Clear free row page pointers# MOVL 4(AP),R6 ; R6 = input pointer' MOVL @8(AP),R7 ; R7 = input bytes left% MOVL 12(AP),R8 ; R8 = output pointer: ASHL #3,@20(AP),R9 ; R9 = length of output buffer in bits;I; Clear the reference locations and corresponding row addrs, if were used;/ MOVZBL #255,R5 ; Initialize max code register@ SUBL3 R5,MAXCOD,R0 ; Get index minus single-character high code2 BLEQ 19$ ; If none longer than single, skip loop MOVAL REFLOC,R1 ; Pointer<1$: CLRW @(R1)+ ; Clear reference location, advance pointer% SOBGTR R0,1$ ; Loop for all of them619$: MOVL TBLIDX,R0 ; Get count of TBLLOC entries used BLEQ 29$ ; If none, skip it MOVAL TBLLOC,R1 ; Pointer52$: CLRL @(R1)+ ; Clear one of them, advance pointer% SOBGTR R0,2$ ; Loop for all of them+29$: CLRL R4 ; Clear TBLLOC index register;G; (1) Initialize string table with single characters (pretend to do it)D; (2) Read the first character into W (the prefix code register R10);- MOVZBL (R6)+,R10 ; Get first a}25208BA4.BCKTMP<p [B35049.DRIVERS.XTPC]QLZW.MAR;42Put code for prefix;,; (3) Read next input character K (into R11)0; (4) If at end of file, output code(W) and exit;3$: DECL R7 ; See if any left% BGTR 4$ ; Yes, some left; go get it7 INSV R10,R3,R2,(R8) ; Output code(W): insert bit field1 ADDL R2,R3 ; Advance bit pointer by field width, MOVL #1,R0 ; Assume successful compression. CMPL R3,R9 ; Reached/exceeded output length? BLSS 37$ ; No, return success9 INCL R0 ; Else set status to 2 (indicating no compress);; Finish up and  return;:37$: MOVQ R4,TBLIDX ; Store TBLLOC index and max code used* ADDL #7,R3 ; Round up to next whole byte9 ASHL #-3,R3,@16(AP) ; Compute and store length of output RET ; Return%39$: MOVL #^X2C,R0 ; Indicate failure BRB 37$ ; Return;#; Get next character (K) from input;)4$: MOVZBL (R6)+,R11 ; Get next character;; (5a) Is W+K in string table?;:; See if W has a row table; if not, W+K can't be in table;+ MOVL ROWADR[R10],R0 ; Row address nonzero? BEQL 6$ ; Nope, no row there;.; W has a row table; check word K for nonzero;' MOVZWL (R0)[R11],R1 ; Get code for W+K' BEQL 7$ ; Zero there, no code for W+K;<; (5b) If W+K is in string table, set W to W+K and go to (3);# MOVL R1,R10 ; W set to W+K's code BRB 3$ ; Loop;G; (6a) W has no row table, so allocate it one and fill in table entries;76$: MOVQ FREEPG,R0 ; Get FREEPG into R0, NOMORE into R1 CMPL R0,R1 ; FREEPG < NOMORE ?* BLSS 63$ ; Yes, allocate a page directly MOVL NXTIDX,R1 ; Get next index% MOVL AREAS[R1],R0 ; Get area address. BNEQ 62$ ; If nonzero, already allocated one? CALLG ARGLIST,G^LIB$GET_VM_PAGE ; Get contiguous area of pages BLBC R0,39$ ; Abort on error( MOVQ WHERE,R0 ; Get address, next index' MOVL R0,AREAS[R1] ; Store area address!62$: INCL NXTIDX ; Advance index5 MOVAB AREAPAGES*512(R0),NOMORE ; Store limit address063$: ADDL3 #512,R0,FREEPG ; Set new FREEPG valueA MOVAL ROWADR[R10],R1 ; Get address of vector entry for row table4 MOVL R0,(R1) ; Store row table address into vector4 MOVL R1,TBLLOC[R4] ; Store address into TBLLOC slot" INCL R4 ; Increment TBLLOC index;7; (6b) W has a row table (address is in R0), so use it;'; W+K is not in table; output code(W),6; put W+K into string table, set W to K and go to (3);:7$: INSV R10,R3,R2,(R8) ; Output code(W): insert bit field1 ADDL R2,R3 ; Advance bit pointer by field width. CMPL R3,R9 ; Reached/exceeded output length? BLSS 73$ ; No, proceed8 MOVL #2,R0 ; Yes, don't go any further; no compression BRW 37$ ; Get out now073$: INCL R5 ; Advance max code to get next one7 CMPL R5,FMASK ; Is max code now larger than max field?$ BLEQ 77$ ; No, don't update FLDSIZ# ADDL R5,FMASK ; Else advance FMASK" INCL R2 ; And advance field size277$: MOVAW (R0)[R11],R1 ; Get address of code word3 MOVW R5,(R1) ; Put the code number into that word: MOVL R1,ZRFLOC[R5] ; Put address of that word into REFLOC MOVL R11,R10 ; Set W to K BRW 3$ ; Go to step 3;> .PSECT QLZW_COMMON_DATA PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,PAGE;C; Redefine beginning parts of common area for decompression routine;.=BEGIN_COMMON5PREFIX: .BLKW 36864 ; Prefix part of codes 256-37120@VALLEN: .BLKW 36864 ; Length of final resulting string for code0SUFFIX: .BLKB 36864 ; Suffix character for code .=END_COMMON;7 .PSECT QLZW_CODE PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,QUAD; .ALIGN QUAD4 .ENTRY QLZW_DCM,^M;G; First, clear the reference locations and corresponding row addrs, if !; were used by last QLZW_CMP call;/ MOVZBL #255,R5 ; Initialize max code register@ SUBL3 R5,MAXCOD,R0 ; Get index minus single-character high code3 BLEQ 111$ ; If none longer than single, skip loop MOVAL REFLOC,R1 ; Pointer>110$: CLRW @(R1)+ ; Clear reference location, advance pointer' SOBGTR R0,110$ ; Loop for all of them1 CLRL MAXCOD ; Zap it so we don't do this again!7111$: MOVL TBLIDX,R0 ; Get count of TBLLOC entries used BLEQ 113$ ; If none, ski25208BA4.BCKTMP<p [B35049.DRIVERS.XTPC]QLZW.MAR;42Pxp it MOVAL TBLLOC,R1 ; Pointer7112$: CLRL @(R1)+ ; Clear one of them, advance pointer' SOBGTR R0,112$ ; Loop for all of them CLRL TBLIDX ; Zap this one too.113$: MOVL 4(AP),R6 ; Get input buffer pointer7 ASHL #3,@8(AP),R7 ; Get length of input buffer in bits: SUBL #7,R7 ; Knock down seven bits in case not full byte+ MOVL 12(AP),R8 ; Get output buffer pointerA ADDL3 @20(AP),R8,R9 ; Compute address of first byte after output< MOVQ #9,R2 ; Initial field size is 9 bits, R3=FPOS is zero6 MOVZWL #^X1FF,FMASK ; Initial field mask is nine bits;>; (1a) Read first input code into CODE (R10) and OLDCODE (R11);) EXTZV R3,R2,(R6),R10 ; Extract bit field# MOVL R10,R11 ; Copy it to OLDCODE1 ADDL R2,R3 ; Advance bit pointer by field width;6; (1b) Output K=uncode(CODE) and set FINCHAR (R4) to K;, CMPL R8,R9 ; Exceeding output buffer size?" BEQL 555$ ; Yes, quit with error& MOVB R10,(R8)+ ; Put byte into buffer MOVL R10,R4 ; Set FINCHAR;=; (2) Read next code to CODE; set INCODE to CODE; exit if EOF;22$: CMPL R7,R3 ; Done? BGTR 3$ ; No, proceed$ MOVL #1,R0 ; Successful completion, SUBL3 12(AP),R8,R9 ; Compute size of output*29$: MOVL R9,@16(AP) ; Store output length RET ; Return!;1; See if we need to increase bit field size first;<3$: CMPL R5,FMASK ; Current highest code equal to max field? BNEQ 33$ ; No, skip ADDL R5,FMASK ; Double FMASK INCL FMASK ; Add one more INCL R2 ; Advance field size-33$: EXTZV R3,R2,(R6),R10 ; Extract bit field! MOVL R10,R1 ; Copy it to INCODE1 ADDL R2,R3 ; Advance bit pointer by field width;:; (3) If code is not in string table (special case), then:$; output (FINCHAR); CODE = OLDCODE;;2 CMPL R10,R5 ; Compare CODE to maximum known code+ BLEQ 7$ ; If less or equal, it's in table% MOVL R11,R10 ; Copy OLDCODE to CODE* CMPL #255,R10 ; Is it a single character? BLSS 6$ ; No, do full code) MOVL #1,R0 ; Else length of prefix is 1 MOVB R4,1(R8) ; Store FINCHAR PUSHL #2 ; Push actual length BRB 8$ ; Jump into loop;F; This code has to go somewhere -- this is a convenient spot for BRB's;"555$: MOVL #^X2C,R0 ; Report abort CLRL R9 ; No data BRB 29$ ;86$: MOVZWL VALLEN-512[R10],R0 ; Get length of result - 1! MOVB R4,(R8)[R0] ; Store FINCHAR' ADDL3 #1,R0,-(SP) ; Push actual length BRB 8$ ; Jump into loop;9; (4a) See if CODE has a prefix string (i.e. >256) or not;,7$: CMPL #255,R10 ; Single character or not? BGEQ 10$ ; Single character;A; (4b) CODE has a prefix string; put its last character at length9; position, change code to prefix code, and repeat until; prefix <256;1 MOVZWL VALLEN-512[R10],R0 ; Get length of result PUSHL R0 ; Save the length. ADDL R8,R0 ; Figure out how far we're going CMPL R0,R9 ; Too far?# BGTR 555$ ; Yes, quit with error MOVL (SP),R0 ; Restore length8$: DECL R0 ; Back it off one0 BEQL 9$ ; When down to single character, done1 MOVB SUFFIX-256[R10],(R8)[R0]; Store into buffer- MOVZWL PREFIX-512[R10],R10 ; Get prefix code BRB 8$ ; Loop*9$: MOVB R10,(R8) ; Store final character MOVL (SP)+,R0 ; Restore length& ADDL R0,R8 ; Advance output pointer/ MOVL R10,R4 ; Set FINCHAR to final character' BRB 11$ ; Skip single-character case;E; (5) Output single character, and (6) empty stack (not needed here!);010$: CMPL R8,R9 ; Exceeding output buffer size?" BEQL 555$ ; Yes, quit with error! MOVB R10,(R8)+ ; Store character# MOVL R10,R4 ; Set FINCHAR to CODE;E; (7) Add (OLDCODE,K) to string table, set OLDCODE = INCODE, goto (2);%11$: INCL R5 ; Advance to next code1 MOVW R11,PREFIX-512[R5] ; Store prefix (OLDCODE)' MOVB R10,SUFFIX-256[R5] ; Store suffix/ CMPL R11,#255 ; Was OLDCODE single character? BGTR 12$ ; No, get its length/ MOVL #1,R0 ; Length of single character is 1 BRB 13$ ; Merge312$: MOVZWL VALLEN-512[R11],R0 ; Get OLDCODE length:13$: ADDW3 #1,R0,VALLEN-512[R5] ; Store length of new code' MOVL R1,R11 ; Copy INCODE025208BA4.BCKTMP<p [B35049.DRIVERS.XTPC]QLZW.MAR;42P> to OLDCODE BRW 22$ ; Go to (2); .END *[B35049.DRIVERS.XTPC]QLZW.OBJ;47+,)<./G@ 4-p0123KPWO56r*7-o89`űwvGG@HJ.QLZW026-OCT-1992 17:58 VAX MACRO V5.4-3 MAC QLZW!-- Quick LZW record compression QLZWLIB$GET_VM_PAGE . ABS .PQLZW_PURE_DATAPL `QLZW_COMMON_DATA9PQDQDQDQDQQ QLZW_CODEP QLZW_CMP&} R<\P|TЬVмWЬ XxYUUHP DQPDP QԑPTZW(ZSRhRSPSYP}TDSxS,PꚆ[JP K`QUaQ@E[Z1`PQ1"Q Q QQ`KPQ PQLZW_DCM&UUHPDQPHDPQԑPDЬVxWWЬ XXY} R<\SRfZZ[RSXYWZZTWS Pì XYYU\U\\RSRfZZQRSZU0[ZяZPT7,PY< 4JPT@hP~яZ:< 4JPPXPPYnPP@4J@h<4JZZhЎPPXZT XYZZTU[4EZ@4E[P< 4KPP 4EQ[1*QLZW_CMPPQLZW_DCMRQLZW_PURE_DATAQLZW_COMMON_DATA` QLZW_CODE *[B35049.DRIVERS.XTPC]VMSXTPC.C;4+,{.D/G@ 4KDBZ-p0123KPWOE56@ o7@إo89`űwvGG@HJ6/* VMSTPC Fast Tape Copy program VMS V4, native mode.KModified by John Osudar, Argonne National Laboratory, to support "extended"HTPC container file format (allowing blocks larger than 32K, and optional container file data compression)= VMSTPC uses multiple ast driven QIO's to get the tape= drive streaming during copy operations. A sample copy of an= ANSI D tape blocked at 8192 with serveral hundred files (a= Columbia U Kermit tape) took 21 CPU seconds with the TU805 streaming about 95% of the time (done on an 11/785).8 22-MAY-1986 09:15 Brian Nelson ( BRIAN@UOFT02.BITNET ) Files: VMSTPC.C VMSTPC.COM VMSTPC.CLD File TC.CLDdefine verb tc$ image "sys$sysroot:[brian.c]vmstpc": parameter P1,label=inputarg,prompt="From",value(REQUIRED)9 parameter P2,label=outputarg,prompt="To",value(REQUIRED) qualifier ANSI qualifier APPEND qualifier BACKUP qualifier REWIND qualifier RT11 qualifier DOS11 qualifier VERIFY2 qualifier DENSITY value(REQUIRED,TYPE=$NUMBER)2 qualifier ALLOCATION value(REQUIRED,TYPE=$NUMBER)2 qualifier EXTENDSIZE value(REQUIRED,TYPE=$NUMBER)2 qualifier BLOCKSIZE value(REQUIRED,TYPE=$NUMBER)2 qualifier BUFFERS value(REQUIRED,TYPE=$NUMBER)& qualifier DIRECTORY, syntax=DIRECTORY qualifier COMPRESS! disallow DENSITY and NEG REWIND! disallow VERIFY and NEG REWIND disallow ANSI and DOS11 disallow BACKUP and DOS11 qualifier JUNK,label=outputargdefine syntax DIRECTORY$ image "sys$sysroot:B25208BA4.BCKTMP{p [B35049.DRIVERS.XTPC]VMSXTPC.C;4KD"[brian.c]vmstpc": parameter P1,label=inputarg,prompt="From",value(REQUIRED); The qualifier /DENSITY=nnnn MAY not work. I can't test it.) Check the function SET_DENS(LUN,DENSITY) Usage:. $ set command vmstpc ! Define the TC command. $ mou msa0:/for ! The drive must be mounted1 $ tc msa0: tape.con ! Copy the tape to TAPE.CON3 $ tc tape.con msa0: ! Copy TAPE.CON to a new tape9 $ tc/ansi msa0: ansi.con ! Allow NULL length ANSI files.9 $ tc/ver msa0: tape.con ! Copy from tape and verify it.7 $ tc/dir container.file ! Get directory of tape image? $ tc/buf=30/blo=512 msa0: t.t ! Optimize for a DOS format tape5 $ tc/dos msa0: t.t ! Optimize for a DOS format tapeH The /ANSI qualifier is used to allow VMSTPC to avoid stopping when itHfinds a NULL length file on an ANSI tape. A null file is simply TWO eofHmarks following the last HDR label. Since VMSTPC normally thinks thatHtwo EOF marks in a row signify the end of the tape, this qualifierHenables special checking for corresponding HDR2/EOF2 marks beforedeciding about EOT. H The /VERIFY qualifier will force VMSTPC to rewind the tape and verifyHthat was was read from (or written to) the tape is identical to theHcopy in the disk container file. The /VERIFY option is SLOW; no attempt=is made during the verification pass to optimize throughput. H The /APPEND qualifier is a bit unusual; if you do NOT speficy any otherHqualifiers it will simply use the MTAACP IO$_SKIPFILE call to find theHend of the tape. Additionally, if the tape happends to be ANSI, theHfiles appended may not show up later because the SEQUENCE fields of allHthe files will be incorrect. This is not a problem for VMSBACKUP, whichHbypassed RMS, but COPY and DIRECTORY will fail. Thus, for ANSI tapes,Heither the /ANSI or /BACKUP qualifier should be used with /APPEND. ThisHwill cause VMSTPC to look for HDR1 and EOF1 records and modify the fourCcharacter SEQUENCE field. As you can imagine, this is a bit risky. H Also note that the /BACKUP qualifier also uses the IO$_SKIPFILE call,Hwhereas the /ANSI qualifier reads records until it gets a correct END ofHTAPE; ie it keeps track of HDR2 and EOF2 counts so it can detect a NULLHlength ANSI file, which is a file composed of HDRn records, followed by=two tape marks and the EOFn records followed by a tape mark. H The /[NO]REWIND qualifier is dangerous when used with /APPEND on ANSIGtapes, as the file sequence fields (described above) will be incorrect.edits:G12-JUN-1986 12:54 BDN Add /DIR, fix status checking for disk file open and creates.F25-JUN-1986 11:52 BDN Add /BUFFERS=nnn/BLOCKSIZE=nnn to optimize when3 reading/writing tapes with small blocks, like RT3 tapes. Also, /RT11 implies /BUF=30/BLOCK=512 if% those qualifiers were not present.*07-JUL-1986 11:55 BDN /APPEND and /BACKUPG17-JUL-1986 13:50 BDN Wait for event flag after start_tape_dump to fix2 getting the VOL1 out of sequence on 8600's (ie, faster CPU'sH11-NOV-1986 11:13 BDN Fix (hopefully) event flag wait bugs that show up" on the faster cpus like 86xx's./02-DEC-1986 09:30 BDN Really fix it this time.*/#include #include #include #include #include #include #include #include #include #define then#define RMS$_EOF 0x1827a union pointer { int *intbuf ; char *charbuf ; } ;struct itmlst {# unsigned short int bufferlength ; unsigned short int item_code ; union pointer addr ; int *retlength ; } ; struct dsc { int len ; char *addr ; } ;struct devdsc { int dev_class ; int dev_type ; int dev_lun ; int dev_char ; char dev_name[NAM$C_DVI] ; char dev_spec[128] ; } in_dev, out_dev ;struct FAB parse_fab ;struct NAM parse_nam ;#define ANSI_NULLFILE 1#define EOF_MARK 0#define ANSI_HDR_SIZE 80#define DOS_HDR_SIZE 14#define BUFFER_SIZE 65535#def\ 25208BA4.BCKTMP{p [B35049.DRIVERS.XTPC]VMSXTPC.C;4KD> ine NBUFFERS 6#define RT_BUFFER_SIZE 512#define RT_NBUFFERS 30#define DOS_BUFFER_SIZE 512#define DOS_NBUFFERS 30 #define MAX_NBUFFERS RT_NBUFFERS#char *buffer_list[MAX_NBUFFERS+1] ;#char *altbuf_list[MAX_NBUFFERS+1] ;0unsigned short int iosblist[MAX_NBUFFERS+1][4] ;'int eventf[MAX_NBUFFERS+1], wakeup_ef ;>int eov, eof_count ,n_files_save, n_files_skipped, rec_count ; (/* Internal tasking dispatch table */struct dispatch { int state ; char *bufaddr ;  char *altaddr ; int (*readproc) () ; int (*writeproc) () ; int iodone ; int iopending ; int efn ; int param ; int endoflist ; } proc_header[MAX_NBUFFERS+1] ;char vol_id[7] ;char *getmsg(), *getcpu() ;0int tape_dump() , read_qio_ast() ,tape_write() ;/extern char *strcpy() , *strcat() , *malloc() ;#define DEF_ANSI 0#define DEF_RT11 0#define DEF_DOS11 0#define DEF_DENSITY 1600#define DEF_ALLOCATION 2000#define DEF_EXTENDSIZE 250#define DEF_VERIFY 0#define DEF_DIR 0#define DEF_BUFFERS NBUFFERS!#define DEF_BLOCKSIZE BUFFER_SIZE;#define DEF_APPEND 0 /* This default should ALWAYS be 0 */;#define DEF_BACKUP 0 /* This default should ALWAYS be 0 */;#define DEF_REWIND 1 /* This default should ALWAYS be 1 */#define DEF_COMPRESS 1int qual_ansi = DEF_ANSI ;int qual_rt11 = DEF_RT11 ; int qual_density = DEF_DENSITY ;&int qual_allocation = DEF_ALLOCATION ;'int qual_extendsize = DEF_EXTENDSIZE ;int qual_verify = DEF_VERIFY ;int qual_dir = DEF_DIR ;int qual_buffers = NBUFFERS ;"int qual_blocksize = BUFFER_SIZE ;int qual_dos11 = DEF_DOS11 ;int qual_append = DEF_APPEND ;int qual_backup = DEF_BACKUP ;int qual_rewind = DEF_REWIND ;"int qual_compress = DEF_COMPRESS ;#define SET_ANSI 1#define SET_RT11 2#define SET_DENSITY 4#define SET_ALLOCATION 8#define SET_EXTENDSIZE 16#define SET_VERIFY 32#define SET_DOS11 64#define SET_DIR 128#define SET_BUFFERS 256#define SET_BLOCKSIZE 512#define SET_APPEND 1024#define SET_BACKUP 2048#define SET_REWIND 4096int set_flags = 0 ;int hdr_count = 0 ; main(){% $DESCRIPTOR(inputarg, "INPUTARG") ;& $DESCRIPTOR(outputarg, "OUTPUTARG") ;$ $DESCRIPTOR(density, "DENSITY") ;' $DESCRIPTOR(allocation,"ALLOCATION") ;' $DESCRIPTOR(extendsize,"EXTENDSIZE") ;! $DESCRIPTOR(ansitape, "ANSI") ;! $DESCRIPTOR(rt11tape, "RT11") ;# $DESCRIPTOR(verify, "VERIFY") ;& $DESCRIPTOR(directory, "DIRECTORY") ;# $DESCRIPTOR(outputfile,"OUTPUT") ;$ $DESCRIPTOR(buffers, "BUFFERS") ;& $DESCRIPTOR(blocksize, "BLOCKSIZE") ;" $DESCRIPTOR(dos11tape, "DOS11") ;# $DESCRIPTOR(append, "APPEND") ;# $DESCRIPTOR(backup, "BACKUP") ;# $DESCRIPTOR(rewind, "REWIND") ;% $DESCRIPTOR(compress, "COMPRESS") ; int retlength , status ,temp ; char inarg[128], outarg[128] ; getparam(inarg,&inputarg) ; getparam(outarg,&outputarg) ;* qual_ansi = setqual(&ansitape,DEF_ANSI) ;. qual_dos11= setqual(&dos11tape, DEF_DOS11 ) ;* qual_rt11 = setqual(&rt11tape,DEF_RT11) ;, qual_append = setqual(&append,DEF_APPEND) ;, qual_backup = setqual(&append,DEF_BACKUP) ;, qual_verify = setqual(&verify,DEF_VERIFY) ;, qual_dir = setqual(&directory,DEF_DIR) ;, qual_rewind = setqual(&rewind,DEF_REWIND) ;2 qual_compress = setqual(&compress,DEF_COMPRESS) ;- if ( status = getqual_value(&allocation) ) { qual_allocation = status ; set_flags |= SET_ALLOCATION ; } ;- if ( status = getqual_value(&extendsize) ) { qual_extendsize = status ; set_flags |= SET_EXTENDSIZE ; } ;* if ( status = getqual_value(&density) ) { qual_density = status ; set_flags |= SET_DENSITY ; } ;* if ( status = getqual_value(&buffers) ) {0 if ( status >= 1 && status <= MAX_NBUFFERS ) { qual_buffers = status ; set_flags |= SET_BUFFERS ; }  else@ printf("/BUFFERS out of range 1 to %d, qualifier ignored\n", MAX_NBUFFERS) ; } ;, if ( status = getqual_value(&blocksize) ) {1 if ( statu25208BA4.BCKTMP{p [B35049.DRIVERS.XTPC]VMSXTPC.C;4KD s >= 512 && status <= BUFFER_SIZE ) { qual_blocksize = status ; set_flags |= SET_BLOCKSIZE ; }  else@ printf("/BLOCK out of range 512 to %d, qualifier ignored\n", BUFFER_SIZE) ; } ;  if ( qual_rt11 )+ if ( ( set_flags & SET_BUFFERS ) == 0 &&. ( set_flags & SET_BLOCKSIZE ) == 0 ) {< printf("RT11 buffer count raised to %d\n",RT_NBUFFERS) ; qual_buffers = RT_NBUFFERS ;% qual_blocksize = RT_BUFFER_SIZE ; } ; if ( qual_dos11 )+ if ( ( set_flags & SET_BUFFERS ) == 0 &&. ( set_flags & SET_BLOCKSIZE ) == 0 ) {> printf("DOS11 buffer count raised to %d\n",DOS_NBUFFERS) ;! qual_buffers = DOS_NBUFFERS ;& qual_blocksize = DOS_BUFFER_SIZE ; } ;  if ( init() == 0 ) exit() ; switch ( qual_density ) { case 800: case 1600: case 6250: break ; default:0 printf("Unknown density %d\n",qual_density) ; exit() ; break ; } ;D if ( qual_rewind == 0 && qual_append && (qual_ansi || qual_backup))B printf("Ansi HDR1 and EOF1 labels may not be accessable\n\n") ;! status = process(inarg,outarg) ; exit(status) ;} process(in,out)char *in,*out ;{ int in_chan,out_chan,status ; if ( qual_dir ) {) if ( *in == 0 ) return( SS$_INSFARG ) ;? if ( ((status=parse(&in_dev,in)) & 1) == 0 ) return(status) ; } else {6 if ( *in == 0 || *out == 0 ) return( SS$_INSFARG ) ;1 if ( ((status=parse(&in_dev,in)) & 1) == 0 ||0 ((status=parse(&out_dev,out)) & 1) == 0 ) then return(status) ; } ; eov = 0 ; eof_count = 0 ;, switch ( in_dev.dev_class ) { /* Case */ case DC$_TAPE: if ( qual_dir ) {9 printf("The /DIR qualifier is only for containers\n"); return(0) ; } ;' if ( out_dev.dev_class == DC$_TAPE &&6 strcmp(out_dev.dev_name,in_dev.dev_name) != 0 )" then status = tape_to_tape() ; else) if ( out_dev.dev_class == DC$_DISK )% then status = tape_to_disk() ;# else status = SS$_IVDEVNAM ; break ; case DC$_DISK:> if ( qual_dir ) then return(container_dir(in_dev.dev_spec));& if ( out_dev.dev_class == DC$_TAPE )" then status = disk_to_tape() ; else status = SS$_IVDEVNAM ; break ; default: status = SS$_IVDEVNAM ; break ; } ; /* end Case */ sys$dassgn( in_dev.dev_lun ) ; sys$dassgn(out_dev.dev_lun ) ; return(status) ;} container_dir(f) char *f ;{3 int block_count = 0,size,status, total_block = 0 ;$ char *cp, dosname[20] , *r50toa() ;% int found_dos = 0 , found_ansi = 0 ;@ if ( (( status = open_disk(f) ) & 1 ) == 0 ) return( status ) ;> if ( ( cp = malloc( qual_blocksize ) ) == 0 ) return( 0 ) ;G if ( (( status = read_disk(cp,&size) ) & 1 ) == 0 ) return( status ) ; F if ( (found_dos = qual_dos11) == 0 && (found_ansi = qual_ansi) == 0 ) switch( size ) { case ANSI_HDR_SIZE:' if ( strncmp(cp,"VOL1",4) == 0 ) {9 printf("Container set appears to be ANSI labeled\n") ; found_ansi++ ; } ; break ; case DOS_HDR_SIZE:< printf("Container set appears to be DOS-11 labeled\n"); found_dos++ ; break ; default:= printf("Container does not seem to be a know format\n"); return(0) ; break ; } ; printf("\n") ; block_count = -1 ; while ( status & 1 ) { switch ( size ) { case ANSI_HDR_SIZE: eof_count = 0 ;3 if ( found_ansi && strncmp(cp,"HDR1",4) == 0 ) { if ( block_count != -1 )( printf(" %d\n",block_count); block_count = 0 ; *(cp+21) = 0 ; printf("%s ",cp+4) ; } ; break ; case DOS_HDR_SIZE: eof_count = 0 ; if ( block_count != -1 )& printf(" %d\n",block_count); r50toa(&dosname[0],cp) ; r50toa(&dosname[3],cp+2) ; dosname[6] = '.' ; r50toa(&dosname[7],cp+4) ; printf("%s ",dosname) ; block_count = 0 ; break ; case EOF_MARK: if ( ++eof_count > 1 ) {& printf(" %d\n",block ڻ\?25208BA4.BCKTMP{p [B35049.DRIVERS.XTPC]VMSXTPC.C;4KD'_count);" total_block += block_count ; } ; break ; case ANSI_NULLFILE: eof_count = 0 ; break ; default: eof_count = 0 ; block_count++ ; break ; } ; status = read_disk(cp,&size) ; } ; close_disk() ;> if ( status == RMS$_EOF ) return(1) ; else return( status ) ;} /* VERIFY( tape_lun )= VERIFY makes absolutly NO attempt to optimize transfer= rates, as it will tend to be cpu bound anyway comparing= data, as well as infrequently used. It is called with the= tape channel number passed; all other needed information is= global already. It can be called from Tape_to_Disk or Disk_to_Tape. */verify(tape_lun,disk_file) int tape_lun;char *disk_file ;{ char *cp, *tp ; unsigned short int iosb[4] ;" int i,r_num,size,status,waiting ;$ if ( qual_verify == 0 ) return(1) ; else { r_num = 0 ;, printf("Starting verification pass\n\n") ; close_disk() ;1 if (((status=open_disk(disk_file)) & 1) == 0) return(status);7 sys$qiow(0,tape_lun,IO$_REWIND,0,0,0,0,0,0,0,0,0) ; cp = malloc(qual_blocksize) ; tp = malloc(qual_blocksize) ; status = read_disk(cp,&size) ; while ( status & 1 ) {8 status = sys$qiow(0,tape_lun,IO$_READLBLK,&iosb,0,0,+ tp,qual_blocksize,0,0,0,0) ;& if ( ( status & 1 ) == 0 ) break ; switch (iosb[0]) { case SS$_ENDOFFILE: if ( size > ANSI_NULLFILE ), printf("End of file mark mismatch\n"); break ; case SS$_NORMAL: r_num++ ; if ( size != iosb[1] ) {2 printf("Block size mismatch #%6d, ",r_num) ;) printf("Expected: %5d, Got: %5d\n", size,iosb[1]) ; }* else if ( strncmp(cp,tp,size) != 0 )( printf("Data compare error\n") ; break ; default: printmsg(iosb[0]) ; break ; } ; 4 if ( status & 1 ) status = read_disk(cp,&size) ; } ;( if ( status == RMS$_EOF ) status = 1 ; } ;@ sys$qiow(0,tape_lun,IO$_REWIND+IO$M_NOWAIT,0,0,0,0,0,0,0,0,0) ; close_disk() ; return(status) ;}tape_to_tape(){H printf("Tape to Tape called %s %s\n",in_dev.dev_name,out_dev.dev_name); inistats() ; return(1) ;} /*& This is the real work of Tape_to_DiskH It functions by setting up a dispatch table for processing to be doneHAFTER I/O completetion. Ie, the AST completion routine simplyH'schedules' a 'task' to be run which will process the result of theHtape read. Thus the copy operation is done basically done via internalHmultitasking. When the ast completion routine is entered it simplyHtakes the ast parameter and uses that to index into the process list toHmake a process eligible for execution. It then sets an event flag toHget the scheduler to wake up and scan the process table for someoneHrunnable. In the interests of generality, the address of the process toHcall is placed into the process table by INIT(), though in reality weHalways call the same routine and pass it the process number, which thus=specifies the buffer, IOSB, and so on that it should access. */tape_to_disk(){ unsigned short int iosb[4] ; int current,i,status ;G if (((status=create_disk(out_dev.dev_spec)) & 1) == 0) return(status);: sys$qiow(0,in_dev.dev_lun,IO$_REWIND,0,0,0,0,0,0,0,0,0) ; inistats() ;8 printf("Tape dump starting to %s\n",out_dev.dev_spec) ; current = 0 ; rec_count = 0 ; eof_count = 0 ; eov = 0 ; sys$clref( wakeup_ef ) ;@ if ( ((status=start_tape_dump()) & 1) == 0 ) return( status ) ; sys$waitfr( wakeup_ef ) ;# while ( !eov && ( status & 1 ) ) {- while ( proc_header[current].state == 0 ) { sys$clref( wakeup_ef ) ; sys$setast(1) ; sys$waitfr(wakeup_ef ) ; } ;7 status = (*proc_header[current].readproc) (current) ;' current = ++current % qual_buffers ; sys$clref( wakeup_ef ) ; sys$setast(1) ; } ; printstats(rec_count) ;. if ( (status & 1 ) == 0 ) )25208BA4.BCKTMP{p [B35049.DRIVERS.XTPC]VMSXTPC.C;4KD$ printmsg(status) ; E if ( status & 1 ) status = verify(in_dev.dev_lun,out_dev.dev_spec) ;F sys$qiow(0,in_dev.dev_lun,IO$_REWIND+IO$M_NOWAIT,0,0,0,0,0,0,0,0,0) ; close_disk() ; return(1) ;} tape_dump(procnum){ int size , status ; char null_buffer[] = "" ; char *cp ;! proc_header[procnum].state = 0 ; size = iosblist[procnum][1] ;" switch ( iosblist[procnum][0] ) { case SS$_ABORT: case SS$_CANCEL: status = 1 ; break ; case SS$_ENDOFFILE: status = 1 ;2 if (hdr_count == 0) eov = ( ++eof_count >= 2 ) ; if ( !eov )F status=sys$qio(eventf[procnum],in_dev.dev_lun,IO$_READLBLK,7 &iosblist[procnum],&read_qio_ast,procnum+1,1 proc_header[procnum].bufaddr,qual_blocksize, 0,0,0,0) ;1 size = ( hdr_count ) ? ANSI_NULLFILE:EOF_MARK ;: if ( status & 1 ) status=write_disk(&null_buffer,size) ; break ; case SS$_ENDOFTAPE: status = 1 ; eov = 1 ; break ; case SS$_NORMAL: eof_count = 0 ; rec_count++ ;% cp = proc_header[procnum].bufaddr ;? proc_header[procnum].bufaddr = proc_header[procnum].altaddr ;% proc_header[procnum].altaddr = cp ;F status = sys$qio(eventf[procnum],in_dev.dev_lun,IO$_READLBLK,7 &iosblist[procnum],&read_qio_ast,procnum+1,1 proc_header[procnum].bufaddr,qual_blocksize, 0,0,0,0) ;2 if ( status & 1 ) status = write_disk(cp,size) ;: if ( qual_rt11 || (qual_ansi && size == ANSI_HDR_SIZE )) then {& if ( strncmp(cp,"HDR2",4) == 0 ) then hdr_count++ ;> else if ( strncmp(cp,"EOF2",4) == 0 && hdr_count > 0 ) then hdr_count-- ;8 else if ( strncmp(cp,"EOV",3) == 0 ) eov = 1 ; } ; break ; default:! status = iosblist[procnum][0] ; eov = 1 ; break ; } ;@ if ( eov ) { sys$setast(0) ; sys$cancel( in_dev.dev_lun ) ; } ; return( status ) ;} start_tape_dump(){ int nqio , status ;0 for ( nqio = 0; nqio < qual_buffers; nqio++ ) {< status = sys$qio(eventf[nqio],in_dev.dev_lun,IO$_READLBLK,1 &iosblist[nqio],&read_qio_ast,nqio+1,. proc_header[nqio].bufaddr,qual_blocksize, 0,0,0,0) ;$ if ( ( status & 1 ) == 0 ) break ; } ; return( status ) ;}/*H AST Completion, used for both tape reads and tape writes. Enter withHthe QIO number (+1) that completed. We disable AST delivery, mark theHtask table STATE entry to flag that we have something to process, andHthen set the event flag to wake up the copy routine. The copy routine=then clears the event flag and enables further ast delivery. */read_qio_ast(param) int param ;{ sys$setast(0) ;% proc_header[param-1].iopending = 0 ;! proc_header[param-1].state = 1 ; sys$setef(wakeup_ef) ;} disk_to_tape(){ char *cp, *tp ; unsigned short int iosb[4] ;) int i,size,save_skipped,status,waiting ;D if (((status=open_disk(in_dev.dev_spec)) & 1) == 0) return(status);' if ( qual_append == 0 || qual_rewind )= sys$qiow(0,out_dev.dev_lun,IO$_REWIND,0,0,0,0,0,0,0,0,0) ;F if (set_flags & SET_DENSITY) set_dens(out_dev.dev_lun,qual_density) ; n_files_skipped = 0 ;" if ( qual_append && qual_rewind )B if ( (n_files_skipped = position_eot(out_dev.dev_lun)) == 0 ) {7 printf("?Failure to position tape to logical EOT\n"); return(0) ; } ;! save_skipped = n_files_skipped ; rec_count = 0 ; eof_count = 0 ; eov = 0 ;8 printf("Tape dump starting to %s\n",out_dev.dev_spec) ; inistats() ;A if ( ((status=start_tape_write()) & 1) == 0 ) return( status ) ;# while ( !eov && ( status & 1 ) ) {$ for ( i=0; i < qual_buffers; i++ ) if ( proc_header[i].state )0 status = (*proc_header[i].writeproc) (i) ;! if ( !eov && ( status & 1 ) ) { sys$waitfr(wakeup_ef) ; sys$clref( wakeup_ef) ; sys$setast(1) ; } ; } ; while (1) { waiting = 0 ;$ for ( i=0; i < qual_buffers; i++ )3 waiting = waiting | proc_header[i].iopending ; if ( wai +r.25208BA4.BCKTMP{p [B35049.DRIVERS.XTPC]VMSXTPC.C;4KD*T ,ting == 0 ) break ; sys$clref( wakeup_ef) ; sys$setast(1) ; sys$waitfr(wakeup_ef) ; } ; if ( save_skipped ) E printf("%d HDR1 and EOF1 label record SEQUENCE fields modified\n"," n_files_skipped-save_skipped) ; printstats(rec_count) ;- if ( (status & 1 ) == 0 ) printmsg(status) ;; sys$qio(0,out_dev.dev_lun,IO$_WRITEOF,0,0,0,0,0,0,0,0,0) ; if ( qual_rewind == 0 )D sys$qiow(0,out_dev.dev_lun,IO$_SKIPFILE,&iosb,0,0,-2,0,0,0,0,0) ; else {G if ( status & 1 ) status = verify(out_dev.dev_lun,in_dev.dev_spec) ;I sys$qiow(0,out_dev.dev_lun,IO$_REWIND+IO$M_NOWAIT,0,0,0,0,0,0,0,0,0) ; } ; close_disk() ; return(status) ;} #define HDR1_SEQ 32-1tape_write(procnum) int procnum ;{ int i, param , size , status ; int eof1, hdr1 ; char *cp ,seq[5] ;! proc_header[procnum].state = 0 ; if ( eov ) return(1) ;C if ( (status=iosblist[procnum][0]) != SS$_NORMAL ) return(status);$ cp = proc_header[procnum].bufaddr ; status = read_disk(cp,&size) ;* if ( rec_count == 0 && qual_append ) then% if ( ansi_check(cp,"VOL1",size) ) # status = read_disk(cp,&size) ; if ( status & 1 ) switch ( size ) { case EOF_MARK: eov = ( ++eof_count >= 2 ) ;? status = sys$qio(eventf[procnum],out_dev.dev_lun,IO$_WRITEOF,& &iosblist[procnum],&read_qio_ast, procnum+1,0,0,0,0,0,0) ; break ; case ANSI_NULLFILE: eof_count = 0 ;? status = sys$qio(eventf[procnum],out_dev.dev_lun,IO$_WRITEOF,& &iosblist[procnum],&read_qio_ast, procnum+1,0,0,0,0,0,0) ; break ; default: eof1 = 0 ; hdr1 = 0 ; eof_count = 0 ; rec_count++ ;$ if ( qual_append && qual_rewind ) / if ( (hdr1 = ansi_check(cp,"HDR1",size)) ||0 (eof1 = ansi_check(cp,"EOF1",size)) ) {. sprintf(seq,"%04d",n_files_skipped+1) ;4 for (i=0; i<4; i++) *(cp+HDR1_SEQ+i)=seq[i] ;& if ( eof1 ) n_files_skipped++ ; } ; A status = sys$qio(eventf[procnum],out_dev.dev_lun,IO$_WRITELBLK,& &iosblist[procnum],&read_qio_ast,, procnum+1,proc_header[procnum].bufaddr, size,0,0,0,0) ; break ; } ;7 if ( status & 1 ) proc_header[procnum].iopending = 1 ; return( status ) ;}start_tape_write(){ int i , status ; sys$setast(0) ;' for ( i = 0; i < qual_buffers; i++ ) { iosblist[i][0] = SS$_NORMAL ; status = tape_write(i) ;+ if ( ( status & 1 ) == 0 || eov ) break ; } ; sys$setast(1) ; return( status ) ;}1 ansi_check(cp,s,n) char *cp,*s ;int n ;{E if ( qual_rt11 || ((qual_ansi || qual_backup) && n==ANSI_HDR_SIZE) )+ return( strncmp(cp,s,strlen(s)) == 0 ) ; else return(0) ;}#define SKIPCOUNT 32766position_eot(lun) int lun ;{ unsigned short int iosb[4] ; int eov, i, n_files, status ; char *cp ; eov = 0 ; n_files = 0 ; hdr_count = 0 ; eof_count = 0 ; cp = malloc(qual_blocksize) ;  vol_id[0] = 0 ;" if ( qual_ansi || qual_backup ) {= sys$qiow(0,lun,IO$_READLBLK,&iosb,0,0,cp,qual_blocksize, 0,0,0,0) ;? if ( iosb[0] == SS$_NORMAL && iosb[1] == ANSI_HDR_SIZE ) {- for (i=0; i<6; i++) vol_id[i] = *(cp+4+i) ; vol_id[6] = 0 ; } ; } ;* if ( qual_ansi == 0 && qual_rt11 == 0 ) { while ( 1 ) {> sys$qiow(0,lun,IO$_SKIPFILE,&iosb,0,0,SKIPCOUNT,0,0,0,0,0) ; switch ( iosb[0] ) { case SS$_NORMAL: case SS$_ENDOFFILE: n_files += iosb[1] ; break ; case SS$_ENDOFVOLUME: n_files += iosb[1] ;) if ( qual_backup ) return(n_files/3) ; else return(n_files) ; break ; default: return(0) ; break ; } ; } ; } else { while ( !eov ) { : sys$qiow(0,lun,IO$_READLBLK,&iosb,0,0,cp,qual_blocksize, 0,0,0,0) ; switch ( iosb[0] ) { case SS$_ENDOFFILE: if (hdr_count == 0) {# eov = ( ++eof_count >= 2 ) ; n_files++ ; } ; break ; case SS$_ENDOFTAPE: eov = 1 ; break ; case SS$_NORMA TBB25208BA4.BCKTMP{p [B35049.DRIVERS.XTPC]VMSXTPC.C;4KDX4L: eof_count = 0 ;5 if ( ansi_check(cp,"HDR2",iosb[1]) ) hdr_count++ ; else9 if ( ansi_check(cp,"EOF2",iosb[1]) ) hdr_count-- ;9 else if (ansi_check(cp,"EOV",iosb[1])) eov = 1 ; break ; default: return(0) ; break ; } ; } ; } ;6 sys$qiow(0,lun,IO$_SKIPFILE,&iosb,0,0,-1,0,0,0,0,0) ; return(n_files-1) ;}  /*? Someone else will have to test this. My TU80 is 1600 only, and? my CDC 92185's density is set via the drive control pan5el. The code should work.*//*< Since SYS$LIBRARY:MTDEF.H does not exist, the following are taken from STARLET.MLB.*/#define MT$M_DENSITY 7936#define MT$K_NRZI_800 3#define MT$K_PE_1600 4#define MT$K_GCR_6250 5#define MT$S_DENSITY 5#define MT$V_DENSITY 8set_dens(lun,density) int lun ;{5 struct char_buffer_type { unsigned short int dummy ; unsigned short int size ;! unsigned long int tchars ; } tape_chars, sense_chars ; unsigned short int iosb[4] ;' int dens,field_pos,field_size,status ;F status = sys$qiow(0,lun,IO$_SENSEMODE,&sense_chars,0,0,0,0,0,0,0,0) ; switch (density) { # case 800: dens = MT$K_NRZI_800 ; break ;" case 1600: dens = MT$K_PE_1600 ; break ;# case 6250: dens = MT$K_GCR_6250 ; break ; default: return(0) ; break ; } ; field_pos = MT$V_DENSITY ; field_size = MT$S_DENSITY ;< lib$insv(&dens,&field_pos,&field_size,&tape_chars.tchars) ; tape_chars.dummy = 0 ;$ tape_chars.size = qual_blocksize ;C status = sys$qiow(0,lun,IO$_SETMODE,0,0,0,&tape_chars,0,0,0,0,0) ;= printf("Status from IO$_SETMODE for density: %x\n",status) ; return( status ) ;} parse(dev,s,def_string)struct devdsc *dev ; char *s ;{ char *cp,*dp ;* int i,status,temp1,temp2,temp3,tempchan ; struct dsc devname ; struct itmlst dvilist[4] ; int devtype, devclass ; parse_fab = cc$rms_fab ; parse_nam = cc$rms_nam ; dp = dev->dev_spec ;# parse_fab.fab$l_nam = &parse_nam ; parse_fab.fab$l_fna = s ;" parse_fab.fab$b_fns = strlen(s) ; parse_nam.nam$l_esa = dp ; parse_nam.nam$b_ess = 127 ;( parse_nam.nam$b_nop = NAM$M_NOCONCEAL ;D if ( ((status=sys$parse(&parse_fab)) & 1) == 0 ) return( status ) ;* *(dp + (parse_nam.nam$b_esl&0377) ) = 0 ; cp = &parse_nam.nam$t_dvi ; devname.len = *cp++ ; devname.addr = cp ;? for (dp=dev->dev_name,i=0; i if ( ((status=sys$assign(&devname,&tempchan,0,0)) & 1) == 0 ) then return( status ) ; dev->dev_lun = tempchan ; dvilist[0].bufferlength = 4 ;' dvilist[0].item_code = DVI$_DEVCLASS ;+ dvilist[0].addr.intbuf = &dev->dev_class ; dvilist[0].retlength = &temp1 ; dvilist[1].bufferlength = 4 ;& dvilist[1].item_code = DVI$_DEVTYPE ;* dvilist[1].addr.intbuf = &dev->dev_type ; dvilist[1].retlength = &temp2 ; dvilist[2].bufferlength = 4 ;& dvilist[2].item_code = DVI$_DEVCHAR ;* dvilist[2].addr.intbuf = &dev->dev_char ; dvilist[2].retlength = &temp3 ; dvilist[3].bufferlength = 0 ; dvilist[3].item_code = 0 ;6 status = sys$getdviw(0,tempchan,0,&dvilist,0,0,0,0) ;4 if ( ( status & 1 ) && dev->dev_class == DC$_TAPE ) then+ if ((dev->dev_char & DEV$M_MNT) == 0 )! then status = SS$_DEVNOTMOUNT ;- else if ((dev->dev_char & DEV$M_FOR) == 0 ) then { status = 0 ;5 printf("%Tape device must be mounted foreign\n") ; } ; return( status ) ;} printmsg(n)int n ;{ printf("%s\n",getmsg(n)) ;}char *getmsg(n)int n ;{ struct dsc msgd ; int mlen ; char junk[4] ; mlen = 0 ; msgd.len = 256 ; msgd.addr = malloc(256) ;$ sys$getmsg(n,&mlen,&msgd,0,&junk) ;! *(msgd.addr + (mlen&0377)) = 0 ; return( msgd.addr ) ;}init(){ int i ; lib$get_ef( &wakeup_ef ) ;! for (i=0; ilen &= 0377 ; strncpy(s,arg->addr,arg->len) ; *(s+arg->len) = 0 ;} printstats(n)int n;{ char s[80] ; int code = 2 ;. lib$show_timer(&handler,&code,&cpuformat,s) ;- printf("Records processed: %d %s\n",n,s) ;} accstats(){ lib$show_timer(&handler) ; lib$init_timer(&handler) ;} /* CLI interfacing */getparam(s,arg)char *s;struct dsc$descriptor_s *arg ;{ struct dsc out ; int retlength ; out.len = 128 ; out.addr = s ; *s = 0 ;! if ( (cli$present( arg ) & 1) &&2 (cli$get_value( arg,&out,&retlength ) & 1 )) then { *(s+(retlength&0377)) = 0 ; return(1) ; }  else return(0) ; }setqual(arg,def)struct dsc$descriptor_s *arg ; int def ;{ int status ; status = cli$present(arg) ;8 if ( status == CLI$_PRESENT || status == CLI$_LOCPRES ) return(1) ; else; if ( status == CLI$_NEGATED || status == CLI$_LOCNEG ) return(0) ; else return(def) ;}getqual_value(arg)struct dsc$descriptor_s *arg ; { char valbuf[128] ;# struct dsc out = { 128,&valbuf } ; int retlength,val ; *valbuf = 0 ;! if ( (cli$present( arg ) & 1) &&2 (cli$get_value( arg,&out,&retlength ) & 1 )) then {" *(valbuf+(retlength&0377)) = 0 ;0 return( (sscanf(valbuf,"%d",&val)) ? val:0 ) ; }  else return(0) ; } /* Disk Input and Output */init_fab(fname) char *fname ;{ return(1);}create_disk(s) char *s ;{ int xtpc_open_w();F return(xtpc_open_w(s,qual_allocation,qual_extendsize,qual_compress));} open_disk(s) char *s ;{ int xtpc_open_r(); return(xtpc_open_r(s));}read_disk(buffer,size)char *buffer ; int *size ;{ int xtpc_read(); return(xtpc_read(buffer,size));}write_disk(buffer,size)char *buffer ; int size ;{ int xtpc_write();! return(xtpc_write(buffer,size));} close_disk(){ int xtpc_close(); return(xtpc_close());} char *r50toa(dst,r50val) char *dst ;unsigned short int *r50val ;{ char *cp ;= char rlist[] = " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789 " ; unsigned short int val ; val = *r50val ; cp = dst ;1 *cp++ = rlist[ val/03100 ] ; val = val % 03100 ; *cp++ = rlist[ val/050 ] ; *cp++ = rlist[ val % 050 ] ; *cp++ = 0 ; return(dst) ;}"*[B35049.DRIVERS.XTPC]VMSXTPC.CLD;4+,%./G@ 4:-p0123KPWO56]v=o7@=o89`űwvGG@HJv25208BA4.BCKTMP%p"[B35049.DRIVERS.XTPC]VMSXTPC.CLD;4:Idefine verb xtpc image "sys_util:vmsxtpc": parameter P1,label=inputarg,prompt="From",value(REQUIRED)9 parameter P2,label=outputarg,prompt="To",value(REQUIRED) qualifier ANSI qualifier APPEND qualifier BACKUP qualifier REWIND qualifier RT11 qualifier DOS11 qualifier VERIFY2 qualifier DENSITY value(REQUIRED,TYPE=$NUMBER)2 qualifier ALLOCATION value(REQUIRED,TYPE=$NUMBER)2 qualifier EXTENDSIZE value(REQUIRED,TYPE=$NUMBER)2 qualifier BLOCKSIZE value(REQUIRED,TYPE=$NUMBER)2 qualifier BUFFERS value(REQUIRED,TYPE=$NUMBER)& qualifier DIRECTORY, syntax=DIRECTORY qualifier COMPRESS! disallow DENSITY and NEG REWIND! disallow VERIFY and NEG REWIND disallow ANSI and DOS11 disallow BACKUP and DOS11 qualifier JUNK,label=outputargdefine syntax DIRECTORY image "sys_util:vmsxtpc": parameter P1,label=inputarg,prompt="From",value(REQUIRED)#*[B35049.DRIVERS.XTPC]VMSXTPC.LINK;3+,)./G@ 402-p0123KPWO56 S60o7T0o89`űwvGG@HJ0$ link vmsxtpc,xtpcsubs,qlzw,sys$share:vaxcrtl/l"*[B35049.DRIVERS.XTPC]VMSXTPC.OBJ;3+, .$/G@ 4$$R -p0123KPWO%56`!#o7 o89`űwvGG@HJ4VMSXTPCV1.022-JAN-1993 15:31VAX C V3.2-044P@PPPP!P"P%PINPUTARG% POUTPUTARG%PDENSITY%PALLOCATION%&PEXTENDSIZE%1PANSI%6PRT11%;PVERIFY%BPDIRECTORY%LPOUTPUT%SPBUFFERS%[PBLOCKSIZE%ePDOS11%kPAPPEND%rPBACKUP%yPREWIND%PCOMPRESS%P/BUFFERS out of range 1 to %d, qualifier ignored %P/BLOCK out of range 512 to %d, qualifier ignored %PRT11 buffer count raised to %d % PDOS11 buffer count raised to %d %.PUnknown density %d %BPAnsi HDR1 and EOF1 labels may not be accessable %tPThe /DIR qualifier is only for containers %PVOL1%PContainer set appears to be ANSI labeled %PContainer set appears to be DOS-11 labeled %PContainer does not seem to be a know format %'P %)PHDR1%.P %d %7P%s %;P %d %DP%s %KP %d %TPStarting verification pass %qPEnd of file mark mismatch %PBlock size mismatch #%6d, %PExpected: %5d, Got: %5d %PData compare error %PTape to Tape called %s %s %PTape dump st CC$RMS_NAM CC$RMS_FAB CC$RMS_RAB CC$RMS_XABALL CC$RMS_XABDAT CC$RMS_XABFHC CC$RMS_XABKEY CC$RMS_XABPRO CC$RMS_XABRDT CC$RMS_XABSUM CC$RMS_XABTRM CPUFORMAT ANSI_CHECK TAPE_WRITE READ_QIO_AST TAPE_DUMPVERIFYMALLOC READ_QIO_ASTGETMSGSPRINTFPRINTFSSCANFPROCESSEXITINIT GETQUAL_VALUESETQUALGETPARAM SYS$DASSGN DISK_TO_TAPE CONTAINER_DIR TAPE_TO_DISK TAPE_TO_TAPESTRCMPPARSE CLOSE_DISKSTRNCMP READ_DISK OPEN_DISKR50TOAPRINTMSGSTRNCMP READ_DISKSYS$QIOW OPEN_DISK CLOSE_DISKINISTATS CLOSE_DISKPRINTMSG PRINTSTATS SYS$SETAST SYS$WAITFRSTART_TAPE_DUMP SYS$CLREFINISTATSSYS$QIOW CREATE_DISK SYS$CANCEL SYS$SETASTSTRNCMP WRITE_DISKSYS$QIOSYS$QIO SYS$SETEF SYS$SETv25208BA4.BCKTMP p"[B35049.DRIVERS.XTPC]VMSXTPC.OBJ;3$AST CLOSE_DISKSYS$QIOPRINTMSG PRINTSTATS SYS$SETAST SYS$CLREF SYS$WAITFRSTART_TAPE_WRITEINISTATS POSITION_EOTSET_DENSSYS$QIOW OPEN_DISKSYS$QIO ANSI_CHECK READ_DISK SYS$SETASTSTRNCMPSTRLENSYS$QIOWLIB$INSVSYS$QIOW SYS$GETDVIW SYS$ASSIGN SYS$PARSESTRLEN SYS$GETMSG LIB$GET_EFLIB$INIT_TIMERSTRNCPYLIB$SHOW_TIMERLIB$INIT_TIMERLIB$SHOW_TIMERarting to %s % PHDR2%PEOF2%PEOV%P?Failure to position tape to logical EOT %BPTape dump starting to %s %\P%d HDR1 and EOF1 label record SEQUENCE fields modified %PVOL1%PHDR1%PEOF1%P%04d%PHDR2%PEOF2%PEOV%PStatus from IO$_SETMODE for density: %x %P%Tape device must be mounted foreign %P%s % PAllocation failure on TAPE buffers from MALLOC() %;PRecords processed: %d %s %WP%d%ZP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789 +Ph^C$MAIN%R#UWXVĐƐbȰ ޢ ޢ ޢ ޢ&ޢ1ޢ6ޢ; ޢB|~ޢLtvwޢSx lnoޢ[pdfgޢeh\^_ޢk`TVWޢrXLNOޢyPDFG€H Į<Ю @ ݮ CLI$PRESENTP&߭<ݮ  CLI$GET_VALUEPˏ\ \l\D4Ю8ݮ CLI$PRESENTP&߭4ݮ CLI$GET_VALUEPˏ\\l\TST CLI$PRESENTP P1\P P0\PS\\dTST CLI$PRESENTP P1\PP P0\PS\\TST CLI$PRESENTP P1\P P0\PS\\\TST CLI$PRESENTP P1\PP P0\PS\\\TST CLI$PRESENTP P1\PP P0\PS\\ TST CLI$PRESENTP P1\P  P0\PS\\TST CLI$PRESENTP P1\P P0\PS\\LTST CLI$PRESENTP P1\PP P0\PS\\!DTST CLI$PRESENTP P1\PP P0\PS\\"➭,ͬ0ͬ\lݮ CLI$PRESENTPL߭,ݮ CLI$GET_VALUEP8ͬPˏ\\P`߭WͬSSCANFPЭPPP\\\P Pe ͤ$ͨ$\lݮ  CLI$PRESENTPM߭ͤݮ CLI$GET_VALUEP9$Pˏ\\P`߭W$SSCANFPЭPPPP\\\P Pe͜ ͜\lݮ CLI$PRESENTPM߭ܟݮ CLI$GET_VALUEP9͜Pˏ\\P`߭W͜SSCANFPЭPPPP\\\PPfet͔͘\lݮ CLI$PRESENTPL߭ԟ͔ݮ  CLI$GET_VALUEP8Pˏ\\P`߭WSSCANFPЭPPP\\\P"PPhȏeP‰PRINTFln ͌͌\ln CLI$PRESENTPN̟߭ ݮ CLI$GET_VALUEP:͌Pˏ\\P`߭W͌SSCANFP ЭPPPP\\\P1PPPgȏeP<~»PRINTFe ePRINTFh<ge e PRINTFh<gINITPEXITf -f@"fjPf.PRINTFEXIT!#  BPRINTFDPROCESSPEXITP|^%UVTSf!<PݬcPARSEPQP printmsg߰Ξ ޭԭ|~|~߭ݭ SYS$GETDVIWPTT"c |T TPRINTFTPP ^%SЬRԭ<<~MALLOCP߭߭R SYS$GETMSGˏPP`PRINTF^ԭ<<~MALLOCP߭߭ݬ SYS$GETMSGˏPP`P^%TWZS Y V U  LIB$GET_EFRj1MALLOCXghPBe ghPBf PRINTFP(R\LcP`LPBe`LPBf`L P TAPE_DUMP`LP TAPE_WRITE`LP`LP`LPR`L PR`L$\lBi LIB$GET_EFRRj1m(j\L$RbP\(25208BA4.BCKTMP p"[B35049.DRIVERS.XTPC]VMSXTPC.OBJ;3$D^LIB$INIT_TIMER^ЬRʏbbݢݬSTRNCPYbR^%R߭ CPUFORMAT߭LIB$SHOW_TIMER߭ݬ;PRINTF^LIB$SHOW_TIMERLIB$INIT_TIMER^ЬRRbݬ CLI$PRESENTP%߭ݬ CLI$GET_VALUEPˏPPRbPPP^ݬ CLI$PRESENTP P1PP P0PPl^%RltptP`ݬ CLI$PRESENTPH߭lݬ CLI$GET_VALUEP4tQˏPPQa߭WtSSCANFPЭPPPPP^2P^" XTPC_OPEN_W^ݬ XTPC_OPEN_R^ݬ XTPC_READ^ݬ XTPC_WRITE^ XTPC_CLOSEP0^%V(*ZҰWЬTTST INTEGER*4 FUNCTION XTPC_OPEN_W(NAME,VALLOC,VEXTEND,VCOMPRESS) IMPLICIT NONE STRUCTURE /BUF/ UNION MAP BYTE B(65535) END MAP MAP CHARACTER*65535 C END MAP END UNION END STRUCTURE RECORD /BUF/ NAME BYTE VALLOC,VEXTEND,VCOMPRESS INTEGER*4 ALLOC,EXTEND INTEGER*4 COMPRESS COMMON /LZW_COM/ COMPRESS INTEGER*4 STAT,STS,STV,L STAT=1 ALLOC=%LOC(VALLOC) EXTEND=%LOC(VEXTEND) COMPRESS=%LOC(VCOMPRESS) L=INDEX(NAME.C,CHAR(0))-16d call lib$put_output('XTPC_OPEN_W for '//NAME.C(1:L))2 OPEN(UNIT=1,NAME='.XTPC',DEFAULTFILE=NAME.C(1:L),0 1 TYPE='NEW',FORM='FORMATTED',RECORDSIZE=32767,- 2 INITIALSIZE=ALLOC,EXTENDSIZE=EXTEND,ERR=8) GOTO98 CALL ERRSNS(,STS,STV,,STAT) IF(STS.GT.1)STAT=STS IF(STV.GT.1)STAT=STV9 XTPC_OPEN_W=STAT*d call output('Return status !8XL',stat,0) RETURN ENDC% INTEGER*4 FUNCTION XTPC_OPEN_R(NAME) IMPLICIT NONE STRUCTURE /BUF/ UNION MAP BYTE B(65535) END MAP MAP CHARACTER*65535 C END MAP END UNION END STRUCTURE RECORD /BUF/ NAME INTEGER*4 STAT,STS,STV,L STAT=1 L=INDEX(NAME.C,CHAR(0))-16d call lib$put_output('XTPC_OPEN_W for '//NAME.C(1:L))2 OPEN(UNIT=1,NAME='.XTPC',DEFAULTFILE=NAME.C(1:L),? 1 TYPE='OLD',READONLY,FORM='FORMATTED',RECORDSIZE=32767,ERR=8) GOTO98 CALL ERRSNS(,STS,STV,,STAT) IF(STS.GT.1)STAT=STS IF(STV.GT.1)STAT=STV9 XTPC_OPEN_R=STAT*d call output('Return status !8XL',stat,0) RETURN ENDC* INTEGER*4 FUNCTION XTPC_READ(BUFFER,SIZE) IMPLICIT NONE INCLUDE '($SSDEF)' INCLUDE '($RMSDEF)' STRUCTURE /BUF/ UNION MAP BYTE B(65535) END MAP MAP CHARACTER*65535 C END MAP END UNION END STRUCTURE RECORD /BUF/ BUFFER,TEMP INTEGER*4 SIZE INTEGER*4 STS,STV,STAT,QLZW_DCM INTEGER*4 L,LL LOGICAL*1 COMPd integer*4 jcomp STAT=1"d call lib$put_output('XTPC_READ')$ READ(1,1,ERR=8)COMP,L,BUFFER.C(1:L)1 FORMAT(A,Q,A) 2 FORMAT(Q,A) d jcomp=comp:d call output('Read segment: comp !XB length !UL',JCOMP,L) IF(L.EQ.32765)THEN. READ(1,2,ERR=8)LL,BUFFER.C(32766:LL+32765).d call output('Read segment: length !UL',LL,0) L=L+LL IF(LL.EQ.32766)THEN1 READ(1,2,ERR=8)LL,BUFFER.C(65532:LL+65531).d call output('Read segment: length !UL',LL,0) L=L+LL ENDIF ENDIF*d call output('Total read length !UL',L,0) IF(COMP)THEN TEMP.C=BUFFER.C9 STAT=QLZW_DCM(%REF(TEMP.C),L,%REF(BUFFER.C),LL,65535) L=LL(d call output('Expanded length !UL',L,0) ENDIF SIZE=L GOTO98 CALL ERRSNS(,STS,STV,,STAT) IF(STS.GT.1)STAT=STS IF(STV.GT.1)STAT=STV9 XTPC_READ=STAT*d call output('Return status !8XL',stat,0) RETURN ENDC, INTEGER*4 FUNCTION XTPC_WRITE(BUFFER,VSIZE) IMPLICIT NONE INCLUDE '($SSDEF)' STRUCTURE /BUF/ UNION MAP BYTE B(65535) END MAP MAP CHARACTER*65535 C END MAP END UNION END STRUCTURE RECORD /BUF/ BUFFER,TEMP BYTE VSIZE,COMP,NOCOMP DATA COMP/1/,NOCOMP/0/ INTEGER*4 SIZE,ASIZE,L INTEGER*4 STS,STV,STAT,QLZW_CMP INTEGER*4 COMPRut25208BA4.BCKTMPp$[B35049.DRIVERS.XTPC]XTPCSUBS.FOR;13A <ESS COMMON /LZW_COM/ COMPRESS STAT=1 SIZE=%LOC(VSIZE)-d call output('XTPC_WRITE length !UL',SIZE,0) IF(SIZE.EQ.0)THEN WRITE(1,2)NOCOMP2 FORMAT(A,A) GOTO9 ENDIF IF(COMPRESS)THEN; STAT=QLZW_CMP(%REF(BUFFER.C),SIZE,%REF(TEMP.C),L,65535) ELSE STAT=2 ENDIF:d call output('Compression status !8XL length !UL',STAT,L) IF(STAT)THEN IF(L.LT.32765)THEN' WRITE(1,2,ERR=8)COMP,TEMP.C(1:L)5d call lib$put_output('Wrote one compressed segment') ELSE IF( L.LT.65531)THEN+ WRITE(1,2,ERR=8)COMP,TEMP.C(1:32765)& WRITE(1,2,ERR=8)TEMP.C(32766:L)6d call lib$put_output('Wrote two compressed segments') ELSE+ WRITE(1,2,ERR=8)COMP,TEMP.C(1:32765)* WRITE(1,2,ERR=8)TEMP.C(32766:65531)& WRITE(1,2,ERR=8)TEMP.C(65532:L)8d call lib$put_output('Wrote three compressed segments') ENDIF ELSE IF(STAT.EQ.2)THEN IF(SIZE.LT.32765)THEN. WRITE(1,2,ERR=8)NOCOMP,BUFFER.C(1:SIZE)7d call lib$put_output('Wrote one uncompressed segment') ELSE IF(SIZE.LT.65531)THEN/ WRITE(1,2,ERR=8)NOCOMP,BUFFER.C(1:32765)+ WRITE(1,2,ERR=8)BUFFER.C(32766:SIZE)8d call lib$put_output('Wrote two uncompressed segments') ELSE/ WRITE(1,2,ERR=8)NOCOMP,BUFFER.C(1:32765), WRITE(1,2,ERR=8)BUFFER.C(32766:65531)+ WRITE(1,2,ERR=8)BUFFER.C(65532:SIZE):d call lib$put_output('Wrote three uncompressed segments') ENDIF STAT=1 ENDIF GOTO98 CALL ERRSNS(,STS,STV,,STAT) IF(STS.GT.1)STAT=STS IF(STV.GT.1)STAT=STV9 XTPC_WRITE=STAT*d call output('Return status !8XL',stat,0) RETURN ENDC INTEGER*4 FUNCTION XTPC_CLOSE() IMPLICIT NONE CLOSE(UNIT=1) XTPC_CLOSE=1=d call lib$put_output('XTPC_CLOSE, returning success status') RETURN END!d subroutine output(format,l1,l2)d implicit noned character*256 line d integer*2 ld character*(*) formatd integer*4 l1,l2/d call sys$fao(format,l,line,%val(l1),%val(l2)) d call lib$put_output(line(1:l))d returnd end$*[B35049.DRIVERS.XTPC]XTPCSUBS.OBJ;14+,. /G@ 4 -p0123KPWO 56'to7`_o89`űwvGG@HJ6 XTPC_OPEN_W0122-Jan-1993 15:3322-Jan-1993 15:33DEC Fortran T6.0-250^P.XTPCP ,4H FOR$OPEN@P   P[Ьk ,8 LIB$INDEXpPRPLbPTFOR$OPENPː FOR$ERRSNSѫ Ы ѫЫЫP  XTPC_OPEN_W LIB$INDEXFOR$OPEN FOR$ERRSNSp$CODE$PDATA$LOCALLZW_COMIPKPZPeP6 XTPC_OPEN_R0122-Jan-1993 15:3322-Jan-1993 15:33DEC Fortran T6.0-2509P.XTPCP $, @ FOR$OPEN@H P[Ьk$0 LIB$INDEXpPQPDaHLFOR$OPENP| FOR$ERRSNSѫЫkѫЫkkPr  XTPC_OPEN_R LIB$INDEXFOR$OPEN FOR$ERRSNS\$CODE$PDATA$LOCAL7P9PIPSP4 XTPC_READ0122-Jan-1993 15:3322-Jan-1993 15:33DEC Fortran T6.0-250P)))QP  P<[Ь FOR$READ_SF FOR$IO_B_R߫  FOR$IO_L_RP (`,( FOR$IO_T_DS FOR$IO_ENDѫ  25208BA4.BCKTMPp$[B35049.DRIVERS.XTPC]XTPCSUBS.OBJ;14 k1 FOR$READ_SF߫ FOR$IO_L_R잻P040 FOR$IO_T_DS FOR$IO_END RR ѫ FOR$READ_SF߫ FOR$IO_L_RꞻP8<8 FOR$IO_T_DS FOR$IO_END (DL@QLZW_DCMPЫ Ы X FOR$ERRSNSkkѫЫЫP < XTPC_READQLZW_DCM FOR$ERRSNSQ$CODE $PDATAx$LOCAL FOR$IO_END FOR$IO_B_R FOR$IO_L_R FOR$IO_T_DS FOR$READ_SFIPbPfPPCPxP),P<PFP5 XTPC_WRITE0122-Jan-1993 15:3322-Jan-1993 15:33DEC Fortran T6.0-250P))QP  Q@P[ЬRPPk FOR$WRITE_SF~ FOR$IO_B_V FOR$IO_END1,4(QLZW_CMPPRRR1ѫ FOR$WRITE_SF~ FOR$IO_B_V@D@ FOR$IO_T_DS FOR$IO_END1ѫ FOR$WRITE_SF~ FOR$IO_B_VLH FOR$IO_T_DS FOR$IO_END FOR$WRITE_SFÏPPPTP FOR$IO_T_DS FOR$IO_END1 FOR$WRITE_SF~ FOR$IO_B_V\X FOR$IO_T_DS FOR$IO_END FOR$WRITE_SFd` FOR$IO_T_DS FOR$IO_END FOR$WRITE_SFÏPPhlh FOR$IO_T_DS FOR$IO_END1R1k FOR$WRITE_SF~W FOR$IO_B_VQkpatp FOR$IO_T_DS FOR$IO_END1k FOR$WRITE_SF~ FOR$IO_B_VP`|x FOR$IO_T_DS FOR$IO_END FOR$WRITE_SFÏkSQSˀ˄ˀ FOR$IO_T_DS FOR$IO_END1 FOR$WRITE_SF~ FOR$IO_B_VTdˌˈ FOR$IO_T_DS FOR$IO_END FOR$WRITE_SFT˔ː FOR$IO_T_DS FOR$IO_END FOR$WRITE_SFÏkSPS˘˜˘ FOR$IO_T_DS FOR$IO_ENDRRˠ FOR$ERRSNSЫRѫЫRѫ Ы RRP  XTPC_WRITEQLZW_CMP FOR$ERRSNSx$CODE$PDATA$LOCALLZW_COM FOR$IO_END FOR$IO_B_V FOR$IO_T_DS FOR$WRITE_SF FOR$WRITE_SFP&;P7FP`PkPcvPAyPP PrPPP2P6PlPPPPP?PgP'(Pw+PaPPPPq PBIP*bPlPrP5 XTPC_CLOSE0122-Jan-1993 15:3322-Jan-1993 15:33DEC Fortran T6.0-2502PP[k FOR$CLOSEPQ  XTPC_CLOSE FOR$CLOSE$CODE$PDATA $LOCAL?on25208BA4.BCKTMP4}mq14 L+/!| 5p"X&?S{+ 0G{0P}6=vL{#S!Hs9t KO yrHNgX:́;^J}t<|oC,T^vsEL5`$e@IA|D +/&0RKXwp0=wR sᢆjI5 >;i /7ڞD's~Ku`.QWU6Jv ץ zRuMӫ]< n9 \',%^GqKy@y8˲2tAE^P2; Zm }A:E|*tGڵeOdusc+/EvҎIzr;ID<)~z7ZbKSW/PiNqytx$[Txk_7e8Wx=R;54*8xKé:0 VYOܓ xeJ.!OwE*;!'~(SG1;b%pS\ b~l֐#ik:8 ƒQ ; V҃0XH##8)`FZLL׿0pPgVl(zbqi||5^!ka>fnX-q#NpLجB\h~W 8o4 $b"Ъj_` LA$Q9g#(|w\V͘wtDRfsGQhH)u!]/}hx9_;AY[_ǢL9yץu!Uo\xE;'J A!^l!V^|roE=ؠQ1#it)aw"5y1wp'ʛ]CƲ$,}Ϋ%Rov|b\C8ފxT+&bA֕ؔXQa$ꖗ7o(ϷN"MF3܉˲Yƍ qHG̣($PNde{|(ċ SIΑ0~w ]~,d(mͿ&5ý/gii*Alkr*C@tl[-}cN\:}V̱2 `m0ʼnCj,d*jDG.Iz;#55ԫ3HNf'Dt[tmU~#:-#dS,ɸbh4:}5q{;sL4k)Zc%SFʀѡJOђ֎.+ t8 qPo CsSz֝?̡˯ckdboXf5F+G$Ѧ"7+RɕSԵt2xXuQhaR}-Bb|:jF{-tF+[f6?_lR#()cq0 MWС.[R 7P&|;gge3 ,|4MOmj*ZJ vr&RAæTې/y}.sY7RA'KC64fYYŔ8zߺ=M@#\d'~.?pMβ&. No4勰`F\aMRO1[nԙ7B>E !.@4kQrHg -0/up )ܱᱸ#N%l,[8Ě';ˤª\Յ.A nGty[9!\ ZpWr(;7_ZnҪ^@7~"s,o;l$)ܙ2'Jw:$P И&Py%ϞS:!ՙeT謠l4كw-՚qv\ׅ D:1̳ڐ]SH$CqRՊ33MzP(J:C 'b<{٘!tE1dGa4` {pd%Z Jhon2{~5&n8KYA~;ك+i 2\;4!DHCQ@LwbQ\ s .4FW." Z[9K7 u@5oДP~k 0"pW^\"g乑9$R[bTc2Vv]U&c `*NsO6 9@L(%-q;V>rlUP 3vT%cx/_XX8yv (eYS$QIO SYS$SETEF SYS$SET