Repatch (from linux) of OSX IRAF

7 files changed, 874 insertions, 0 deletions

diff --git a/pkg/dataio/reblock/mkpkg b/pkg/dataio/reblock/mkpkg
new file mode 100644
index 00000000..5baf1a30
--- /dev/null
+++ b/pkg/dataio/reblock/mkpkg
@@ -0,0 +1,12 @@
+# Reblock Library
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	t_reblock.x	reblock.com reblock.h <fset.h> <error.h> <ctype.h>\
+			<mach.h>
+	reblock_file.x	reblock.com reblock.h <fset.h> <error.h> <mach.h>
+	;
diff --git a/pkg/dataio/reblock/reblock.com b/pkg/dataio/reblock/reblock.com
new file mode 100644
index 00000000..35bc652d
--- /dev/null
+++ b/pkg/dataio/reblock/reblock.com
@@ -0,0 +1,21 @@
+# input parameters
+int  szb_outblock	# size of output block in bytes
+int  szb_inrecord	# size of input record in bytes
+int  szb_outrecord	# size of output record in bytes
+int  nskip		# number  blocks (tape) or records (disk) to be skipped
+int  ncopy		# number of blocks (tape) or records (disk) to be copied
+int  padvalue		# integer value of padcharacter
+
+# integer switches
+int intape			# input tape device
+int outtape			# output tape device	
+int reblock			# reformat?
+int pad_block			# pad short blocks
+int pad_record			# pad records
+int trim_record			# trim records
+int byteswap			# swap every other byte
+int wordswap			# swap every other word
+
+common /reblock/ szb_outblock, szb_inrecord, szb_outrecord, nskip, ncopy,
+		    padvalue, intape, outtape, reblock, pad_block, pad_record,
+		    trim_record, byteswap, wordswap
diff --git a/pkg/dataio/reblock/reblock.h b/pkg/dataio/reblock/reblock.h
new file mode 100644
index 00000000..c88d38a8
--- /dev/null
+++ b/pkg/dataio/reblock/reblock.h
@@ -0,0 +1,7 @@
+# define the output parameters
+define	BLKS_RD		$1[1]
+define	BLKS_WRT	$1[2]
+define	RECS_RD		$1[3]
+define	RECS_WRT	$1[4]
+define	LEN_OUTPARAM	4
+
diff --git a/pkg/dataio/reblock/reblock.hlp b/pkg/dataio/reblock/reblock.hlp
new file mode 100644
index 00000000..465314be
--- /dev/null
+++ b/pkg/dataio/reblock/reblock.hlp
@@ -0,0 +1,154 @@
+.help reblock Mar84 dataio
+.ih
+NAME
+reblock -- copy a file on tape or disk with optional reblocking
+.ih
+USAGE
+reblock (infiles, outfiles, file_list)
+.ih
+PARAMETERS
+.ls infiles  
+File or device name e.g. "mta1600[2]" or "mta800" or "file1".
+.le
+.ls outfiles  
+If multiple file to disk is requested,  the ouput file names will be generated
+by concatenating the tape file number onto the output file name.
+.le
+.ls file_list
+List of tape file numbers or ranges delimited by whitespace or commas,
+e.g. "1-3, 5_8".
+File_list is requested only if the magtape input device is specified.
+Files will be read in ascending order regardless of the ordering of the list.
+Reading will terminate silently if EOT is reached, thus a list such as
+"1-999" may be used to read all files on the tape.
+.le
+.ls newtape  
+If the output device is magtape, newtape specifies whether the tape is
+blank or contains data.
+Newtape is requested only if no tape file number is specified, e.g. "mta1600".
+.le
+.ls outblock = INDEF
+Size of the output block  bytes.
+In the  default case and for disk output, the output block size is set to the
+file i/o disk default buffer size.
+.le
+.ls inrecord = INDEF, outrecord = INDEF
+The sizes of the input and output logical records in bytes.
+The default input and output record sizes are set equal to
+the input and output block sizes respectively. If inrecord > outrecord,
+records are trimmed; if inrecord < outrecord, records are padded; if
+inrecord = outrecord, records are simply counted. If only one of inrecord or
+outrecord is set, the undefined parameter defaults to the value of the
+other.
+.le
+.ls nskip = 0    
+The number of input blocks (tape input) or records (disk input, size inrecord)
+to be skipped.
+.le
+.ls ncopy = INDEF
+The number of input blocks (tape input) or records
+(disk input, size inrecord) to be copied. Ncopy defaults to a very large number.
+.le
+.ls byteswap = no
+Swap every other byte.
+.le
+.ls wordswap = no
+Swap every other word.
+.le
+.ls pad_block = no
+If pad_block is set, reblock pads trailing blocks until they are outblock
+bytes long, otherwise trailing blocks may be short.
+.le
+.ls padchar  = 0
+Single character used to pad blocks or records.
+Padchar is only requested if pad_record or pad_block
+is set. If padchar equals one of the digits 0 through nine, records and
+blocks are padded with the face value of the character, otherwise the
+ASCII value is used.
+.le
+.ls verbose = yes  
+Print messages about files, blocks copied etc.
+.le
+.ih
+DESCRIPTION
+
+REBLOCK is a procedure to copy disk or tape resident files to
+disk or tape. Multiple tape files or a single disk input file may be specified.
+If multiple files are output to disk the output file names will be
+generated by concatenating the tape file number onto the output file name.
+The user may request magnetic tape output to begin at a specific file on
+tape, e.g. mta1600[5] in which case file five will be overwritten if it
+exists, or at BOT or EOT. If no file number is specified REBLOCK asks
+whether the tape is new or old and begin writing at BOT or EOT as
+appropriate.
+
+Before beginning the copy, the user may request reblock to skip
+n (default 0) blocks (tape input) or logical records (disk input).
+The user can also specify that
+only n (default all) blocks (tape input) or records (disk input)
+are to be copied. Before the copy the data may be optionally word-swapped
+(default no) and/or byte-swapped (default no). If verbose is specified
+(default yes) reblock prints the input and output file names,
+the number of blocks read and written and the number of records read and
+written.
+
+Reblock
+uses the default buffer sizes supplied by mtio and file i/o to determine the 
+maximum number of bytes which can be read in a single read call. For tapes
+this corresponds to the maximum number of bytes per block permitted by the
+device. Mtio will not read more than one block per read call. Therefore the
+actual number of bytes read will be less than or equal to the mtio buffer size.
+For disk files the default buffer size set by IRAF is a multiple of the
+disk block size. If the disk file is smaller than one block
+or the last block is partially full, the number of bytes read
+will be less than the default buffer size. All magtape and disk reads are
+done with the file i/o read procedure and a call to fstati determines the number
+of bytes actually read.
+
+If all the defaults are set, a binary copy is performed.
+In tape to tape copies the block and record sizes are preserved,
+but the density may
+be changed by specifying the appropriate output file name e.g. mta800 or
+mta1600.
+Reblocking occurs in tape to disk transfers, if records, are trimmed,
+padded or counted, or if blocks are padded.
+If a disk to tape transfer is requested
+the output block size will be the default file i/o  buffer size.
+The last block in a file may be short. If uniform sized blocks are
+desired, pad_block must be set, in which case trailing partially filled
+blocks will be padded with padchar.
+
+Logical records are distinguished from blocks (physical records).
+The input and output record sizes default to
+the size of the input and output blocks respectively.
+Logical records may be shorter or longer than the  block sizes.
+.ih
+EXAMPLES
+
+Copy a magnetic tape preserving the record sizes but changing
+the density from 800 bpi to 1600 bpi.
+
+.nf
+	da> reblock mtb800, "mta1600[1]", "1-999"
+.fi
+
+Reblock a magnetic tape changing the block size from 4000 bytes to 8000
+bytes and padding the last block.
+
+.nf
+	da> reblock mtb1600, "mta1600[1]", "1-999", outb=8000, padb+
+.fi
+
+Trim the records of a disk file.
+
+.nf
+	da> reblock input, output, inrec=80, outrec=72
+.fi
+
+Pad the records of a disk file with blanks.
+
+.nf
+	da> reblock input, output, inrec=81, outrec=82, padchar=" "
+.fi
+
+.endhelp
diff --git a/pkg/dataio/reblock/reblock_file.x b/pkg/dataio/reblock/reblock_file.x
new file mode 100644
index 00000000..2801a1b1
--- /dev/null
+++ b/pkg/dataio/reblock/reblock_file.x
@@ -0,0 +1,416 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <fset.h>
+include <mach.h>
+include "reblock.h"
+
+# REB_REBLOCK_FILE -- Copy and optionally reblock files.
+
+procedure reb_reblock_file (in_fname, out_fname, outparam)
+
+char	in_fname[ARB]		# input file name
+char	out_fname[ARB]		# output file name
+int	outparam[ARB]		# output parameters
+
+char	padchar
+int	in, out, sz_charsin, sz_charsout, mov_nbytes, rem_in, rem_out
+int	bytes_read, ip, op, i, first_byte, nchars, rec_count, ntrim
+long	offset
+pointer	inbuf, outbuf
+
+int	mtopen(), reb_roundup(), read(), reb_skipover(), fstati(), open()
+errchk	open, mtopen, read, awriteb, awaitb, close, mfree, malloc, flush
+errchk	reb_write_block, reb_pad_block, reb_pad_record, reb_skipover
+include "reblock.com"
+
+begin
+	# Open input and output files
+	in = mtopen (in_fname, READ_ONLY, 0)
+	out = NULL
+
+	# Allocate space for input buffer.
+	sz_charsin = fstati (in, F_BUFSIZE)
+	call malloc (inbuf, sz_charsin, TY_CHAR)
+	outbuf = NULL
+
+	# Skip over n input blocks (tape) or records (disk).
+	first_byte = 1
+	if (intape == YES) {
+	    for (i=1; i <= nskip; i = i + 1) {
+		nchars = read (in, Memc[inbuf], sz_charsin)
+		if (nchars == EOF)
+		    call error (1,"Skipped past EOF on input.")
+	    }
+	} else {
+    	    first_byte = reb_skipover (in, szb_inrecord, nskip)
+	    if (first_byte == EOF)
+		call error (2, "Skipped past EOF on input.")
+	}
+
+	# Initialize the input and output block and record counters
+	BLKS_RD(outparam) = 0
+	BLKS_WRT(outparam) = 0
+	RECS_RD(outparam) = 0
+	RECS_WRT(outparam) = 0
+
+	# Initalize the record counter.
+	rec_count = 0
+
+	# Set of the offset in output file for asyncrhronous i/o.
+	offset = 1
+
+	# Loop over the input blocks.
+	repeat {
+
+	    # Read a block and update block counter.
+	    nchars = read (in, Memc[inbuf], sz_charsin)
+	    if (nchars == EOF)
+		break
+	    bytes_read = nchars * SZB_CHAR
+	    if (mod (fstati (in, F_SZBBLK), SZB_CHAR) != 0)
+		bytes_read = bytes_read - mod (fstati (in, F_SZBBLK), SZB_CHAR)
+	    BLKS_RD(outparam) = BLKS_RD(outparam) + 1
+
+	    # Align to first byte.
+	    if (rec_count == 0 && first_byte > 1) {
+		bytes_read = bytes_read - first_byte + 1
+		call bytmov (Memc[inbuf],first_byte, Memc[inbuf],1, bytes_read)
+	    }
+
+	    # Open the output file. This has been moved from the beginning 
+	    # of the routine to avoid a magtape problem.
+	    # driver problem.
+	    if (BLKS_RD(outparam) == 1) {
+		if (outtape == NO)
+	    	    out = open (out_fname, NEW_FILE, BINARY_FILE)
+		else
+	    	    out = mtopen (out_fname, WRITE_ONLY, 0)
+	    }
+
+	    # Binary copy.
+	    if (reblock == NO) {
+
+		RECS_RD(outparam) = BLKS_RD(outparam)
+		call reb_write_block  (out, Memc[inbuf], bytes_read, offset,
+		    byteswap, wordswap)
+		BLKS_WRT(outparam) = BLKS_WRT(outparam) + 1
+		RECS_WRT(outparam) = BLKS_WRT(outparam)
+
+	    # Reblock.
+	    } else {
+
+		# Initialize reblocking parameters after first read.
+		if (BLKS_RD(outparam) == 1) {
+
+	            # Initialize block and record sizes
+	            if (IS_INDEFI(szb_inrecord))
+	                szb_inrecord = sz_charsin * SZB_CHAR
+	            if (IS_INDEFI(szb_outblock))
+	                szb_outblock = fstati (out, F_BUFSIZE) * SZB_CHAR
+	            if (IS_INDEFI(szb_outrecord))
+	                szb_outrecord = szb_outblock
+
+	            # Set pad character.
+	            if (pad_record == YES || pad_block == YES) {
+		        padchar = char (padvalue)
+		        call chrpak (padchar, 1, padchar, 1, 1)
+	            }
+
+	            # Allocate space for the output buffer.
+	            sz_charsout = reb_roundup (szb_outblock, SZB_CHAR) /
+		        SZB_CHAR
+	            call malloc (outbuf, sz_charsout, TY_CHAR)
+
+	            # Intialize the record remainder counters
+	            rem_in = szb_inrecord
+	            rem_out = szb_outrecord
+
+	            # Initialize input and output buffer pointers
+	            ip = 1
+	            op = 1
+		}
+
+		# Loop over the input buffer.
+	        repeat {
+
+		    # Calculate the number of bytes to be moved.
+		    mov_nbytes = min (bytes_read - ip + 1,
+			rem_in, rem_out, szb_outblock - op + 1)
+		    call bytmov (Memc[inbuf], ip, Memc[outbuf], op, mov_nbytes)
+
+		    # Update the remainders
+		    rem_in = rem_in - mov_nbytes
+		    if (rem_in == 0)
+		        rem_in = szb_inrecord
+		    rem_out = rem_out - mov_nbytes
+		    if (rem_out == 0)
+		        rem_out = szb_outrecord
+
+		    # Update the input and output buffer pointers.
+		    ip = ip + mov_nbytes
+		    op = op + mov_nbytes
+
+		    # Pad records.
+		    if (pad_record == YES && rem_in == szb_inrecord) {
+
+			# Do the padding.
+			if (mov_nbytes != 0) {
+		            RECS_RD(outparam) = RECS_RD(outparam) + 1
+		            call reb_pad_record (Memc[outbuf], op, rem_out,
+		                szb_outblock, szb_outrecord, padchar)
+			} else if (rem_out < szb_outrecord)
+		            call reb_pad_record (Memc[outbuf], op, rem_out,
+		                szb_outblock, szb_outrecord, padchar)
+
+		        # Increment the output record counter.
+		        if (rem_out ==  szb_outrecord) 
+		            RECS_WRT(outparam) = RECS_WRT(outparam) + 1
+			 else if (rem_out < szb_outrecord)
+			    rem_in = 0
+		    }
+
+		    # If the output buffer is exhausted, output block of data.
+		    if (op > szb_outblock) {
+		        call reb_write_block (out, Memc[outbuf], szb_outblock,
+		            offset, byteswap, wordswap)
+		        BLKS_WRT(outparam) = BLKS_WRT(outparam) + 1
+		        op = 1
+		    }
+
+		    # Trim records.
+		    if (trim_record == YES && rem_out == szb_outrecord) {
+
+			# Do the trimming.
+			if (mov_nbytes != 0)
+			    RECS_WRT(outparam) = RECS_WRT(outparam) + 1
+			ntrim = min (rem_in, bytes_read - ip + 1)
+			ip = ip + ntrim
+			rem_in = rem_in - ntrim
+			if (rem_in == 0)
+			    rem_in = szb_inrecord
+
+			# Increment the record counter.
+			if (rem_in == szb_inrecord)
+			    RECS_RD(outparam) = RECS_RD(outparam) + 1
+			else if (rem_in < szb_inrecord)
+			    rem_out = 0
+		    }
+
+		    # Count the records.
+		    if (pad_record == NO && trim_record == NO) {
+			if (szb_inrecord == sz_charsin * SZB_CHAR)
+			    RECS_RD(outparam) = BLKS_RD(outparam)
+			else if (rem_in == szb_inrecord)
+			    RECS_RD(outparam) = RECS_RD(outparam) + 1
+			if (rem_out == szb_outrecord)
+			    RECS_WRT(outparam) = RECS_WRT(outparam) + 1
+		    }
+
+		    # Quit if ncopy records has been reached.
+		    if (intape == NO && RECS_RD(outparam) == ncopy)
+			break
+
+	        } until (ip > bytes_read)
+
+		# Reset the input buffer pointer
+	        ip = 1
+	    }
+
+	    # Update the record counter.
+	    if (intape == YES)
+		rec_count = BLKS_RD(outparam)
+	    else
+		rec_count = RECS_RD(outparam)
+
+	} until (rec_count >= ncopy)
+
+	# Output remainder of data
+	if (reblock == YES) {
+
+	    # Pad last record if short.
+	    if (pad_record == YES) {
+	        if (rem_in < szb_inrecord)
+		    RECS_RD(outparam) = RECS_RD(outparam) + 1
+		if (rem_out < szb_outrecord)
+		    RECS_WRT(outparam) = RECS_WRT(outparam) + 1
+		while (rem_out < szb_outrecord) {
+		    call reb_pad_record (Memc[outbuf], op, rem_out,
+		        szb_outblock, szb_outrecord, padchar)
+		    if (op > szb_outblock) {
+			call reb_write_block (out, Memc[outbuf], szb_outblock,
+			    offset, byteswap, wordswap)
+			BLKS_WRT(outparam) = BLKS_WRT(outparam) + 1
+			op = 1
+		    }
+		}
+	    }
+
+	    # Pad last block if short.
+	    if (pad_block == YES && op > 1)
+		call reb_pad_block (Memc[outbuf], op, rem_out, outparam,
+		    szb_outblock, szb_outrecord, padchar)
+
+	    # Write last block
+	    if (op > 1) {
+		call reb_write_block (out, Memc[outbuf], op - 1, offset,
+		    byteswap, wordswap)
+	        op = 1
+	        BLKS_WRT(outparam) = BLKS_WRT(outparam) + 1
+		if (pad_record == YES && rem_out < szb_outrecord)
+		    RECS_WRT(outparam) = RECS_WRT(outparam) + 1
+		else if (rem_out < szb_outrecord)
+		    RECS_WRT(outparam) = RECS_WRT(outparam) + 1
+	    }
+
+	}
+
+	call mfree (inbuf, TY_CHAR)
+	if (outbuf != NULL)
+	    call mfree (outbuf, TY_CHAR)
+	call close (in)
+	if (out != NULL)
+	    call close (out)
+end
+
+
+# REB_PAD_RECORD -- Procedure for padding records.
+
+procedure reb_pad_record (buffer, op, rem_out, szb_outblock, szb_outrecord,
+	padchar)
+
+char	buffer[ARB], padchar
+int	szb_outblock, szb_outrecord, op, rem_out
+int	i, junk
+
+begin
+	junk = rem_out
+	for (i = 1; i <= junk && op <= szb_outblock; i = i + 1) {
+	    call bytmov (padchar, 1, buffer, op, 1)
+	    op = op + 1
+	    rem_out = rem_out - 1
+	}
+
+	if (rem_out == 0)
+	    rem_out = szb_outrecord
+end
+
+
+# REB_PAD_BLOCK -- Procedure to pad the last block so that all output blocks
+# will have the same size.
+
+procedure reb_pad_block (buffer, op, rem_out, outparam, szb_outblock,
+	szb_outrecord, padchar)
+
+char	buffer[ARB]	# data to be padded
+int	op		# pointer to first element for padding
+int	rem_out		# number of remaining bytes to be padded in a record
+int	outparam[ARB]	# output parameters, number of records, blocks written
+int	szb_outblock	# size in bytes of output block
+int	szb_outrecord	# size in bytes of an output record
+char	padchar		# character used for padding
+
+int	i, junk
+
+begin
+	junk = szb_outblock - op + 1
+	for (i = 1; i <= junk; i = i + 1) {
+	    call bytmov (padchar, 1, buffer, op, 1)
+	    op = op + 1
+	    rem_out = rem_out - 1
+	    if (rem_out == 0) {
+		rem_out = szb_outrecord
+		RECS_WRT(outparam) = RECS_WRT(outparam) + 1
+	    }
+	}
+end
+
+
+# REB_WRITE_BLOCK -- Procedure to write blocks  using the asynchronous read
+# and write functions in file i/o. Writing must occur on block boundaries.
+
+procedure reb_write_block (fd, buffer, nbytes, offset, byteswap, wordswap)
+
+int	fd		# output file descriptor
+char	buffer[ARB]	# data to be output
+int	nbytes		# number of bytes of data
+long	offset		# offset in chars in output file for writing
+int	byteswap	# swap every other byte before output
+int	wordswap	# swap every other word before output
+
+int	nbread
+int	awaitb()
+errchk	awriteb, awaitb
+
+begin
+	if (byteswap == YES)
+	    call bswap2 (buffer, 1, buffer, 1, nbytes)
+	if (wordswap == YES)
+	    call bswap4 (buffer, 1, buffer, 1, nbytes)
+	call awriteb (fd, buffer, nbytes, offset)
+	nbread = awaitb (fd)
+	if (nbread == ERR)
+	    call error (3, "Error writing block data")
+	else
+	    offset = offset + nbread
+end
+
+
+# REB_SKIPOVER -- Procedure to find the first byte containing data given the
+# input block size and the number of input blocks to be skipped.
+
+int procedure reb_skipover (fd, szb_inblock, nskip)
+
+int	fd		# file descriptor
+int	szb_inblock	# size of an input block
+int	nskip		# number of blocks to skip
+
+int	first_byte
+long	szb_skip, szb_physkip, skip_diff, sz_charoff, loff
+long	fstatl()
+int	reb_roundup()
+errchk	fstatl, seek
+
+begin
+        szb_skip = long (szb_inblock) * long (nskip)
+        szb_physkip = reb_roundup (szb_skip, SZB_CHAR)
+        skip_diff = szb_physkip - szb_skip
+
+        if (skip_diff == 0) {
+	    sz_charoff = (szb_physkip / SZB_CHAR) + 1
+	    first_byte = 1
+	} else {
+	    sz_charoff = (szb_physkip / SZB_CHAR) - 1
+	    first_byte = int (szb_skip - (SZB_CHAR * sz_charoff) + 1)
+	}
+
+	loff = long (sz_charoff)
+
+        if (loff > fstatl (fd, F_FILESIZE)) {
+	    call seek (fd, EOF)
+	    return (EOF)
+	} else {
+            call seek (fd, loff)
+	    return (first_byte)
+	}
+end
+
+
+# REB_ROUNDUP -- Procedure to round a number to the next highest number
+# divisible by  base.
+
+int procedure reb_roundup (number, base)
+
+int	number		# number to be rounded upwards
+int	base		# base for rounding
+
+int	value
+
+begin
+	if (mod(number, base) == 0)
+	    return (number)
+	else {
+	    value = (number/base + 1) * base
+	    return (value)
+	}
+end
diff --git a/pkg/dataio/reblock/structure.hlp b/pkg/dataio/reblock/structure.hlp
new file mode 100644
index 00000000..1a7c5221
--- /dev/null
+++ b/pkg/dataio/reblock/structure.hlp
@@ -0,0 +1,50 @@
+.help gcopy "Program Structure"
+.sh
+Program Structure
+.nf
+t_bincopy()
+# Returns when file list is finished or EOT reached.
+
+    read_file (in_fname, out_fname,  outparam)
+    Returns when an EOF is encountered on read.
+
+	skipover (fd, szb_outblock, nskip)
+	# Returns the offset of the first data byte in the first char
+	# to contain data of interest or EOF
+
+	record_pad (szb_outblock, szb_outrecord, padchar, buffer, op, rem_out)
+
+	block_pad (szb_outblock, szb_outrecord, padchar, buffer, op, rem_out,
+		    outparam)
+.fi
+.sh
+BINCOPY Structure Summary
+.ls t_bincopy
+The main program gets the input and output filenames, creates a list of
+files to be processed and gets the program parameters.
+For each file in the input list READFILE is called,
+and the input and output file names, blocks read and written and records read
+and written are printed.
+The program terminates when the input file list is exhausted or EOT is reached.
+.ls read_file
+READ_FILE opens the input and output devices, allocates space for the input
+and output buffers and copies the data optionally skipping data
+and byteswapping and/or wordswapping the data.
+The routine terminates when an EOF is encountered on a read.
+READ_FILE calls SKIPOVER to find the first data byte of interest and
+RECORD_PAD and BLOCK_PAD to pad records and blocks respectively.
+.ls skipover
+SKIPOVER seeks to the first char containing data of interest and calculates
+the offset in that char of the first byte of interest. Returns the offset
+or EOF if the requested position is past EOF.
+.le
+.ls record_pad
+Record_pad pads input records of szb_inrecord bytes long to output records
+szb_outrecord long.
+.le
+.ls block_pad
+Pads short blocks to size szb_outblock.
+.le
+.le
+.le
+.endhelp
diff --git a/pkg/dataio/reblock/t_reblock.x b/pkg/dataio/reblock/t_reblock.x
new file mode 100644
index 00000000..09c86a9a
--- /dev/null
+++ b/pkg/dataio/reblock/t_reblock.x
@@ -0,0 +1,214 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <fset.h>
+include <error.h>
+include <ctype.h>
+include <mach.h>
+include "reblock.h"
+
+define	MAX_RANGES	100
+define	SZ_PADCHAR	10
+
+# T_REBLOCK -- Procedure to copy binary files optionally changing the blocking
+# factor. Further documentation in reblock.hlp.
+
+procedure t_reblock ()
+
+char	infiles[SZ_FNAME]	# list of input files
+char	file_list[SZ_LINE]	# list of tape file numbers
+char	outfiles[SZ_FNAME]	# list of output files
+char	padchar[SZ_PADCHAR]	# character for padding blocks and records
+bool	verbose			# print messages ?
+
+char	in_fname[SZ_FNAME], out_fname[SZ_FNAME], cval
+int	inlist, outlist, len_inlist, len_outlist, file_number, file_cnt
+int	range[2 * MAX_RANGES + 1]
+int	outparam[LEN_OUTPARAM], offset, ip
+
+bool	clgetb()
+int	fstati(), mtfile(), mtneedfileno(), fntopnb(), fntlenb(), fntgfnb()
+int	decode_ranges(), btoi(), clgeti(), get_next_number(), cctoc()
+include "reblock.com"
+
+begin
+	# Flush on a newline if the output is not redirected.
+	if (fstati (STDOUT, F_REDIR) == NO)
+	    call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Get the input and output file(s).
+	call clgstr ("infiles", infiles, SZ_FNAME)
+	call clgstr ("outfiles", outfiles, SZ_FNAME)
+
+	# Get the input file names.
+	if (mtfile (infiles) == YES) {
+	    inlist = NULL
+	    intape = YES
+	    if (mtneedfileno (infiles) == YES)
+	        call clgstr ("file_list", file_list, SZ_LINE)
+	    else
+		call strcpy ("1", file_list, SZ_LINE)
+	} else {
+	    inlist = fntopnb (infiles, NO)
+	    len_inlist = fntlenb (inlist)
+	    intape = NO
+	    if (len_inlist > 0) {
+		call sprintf (file_list, SZ_LINE, "1-%d")
+		    call pargi (len_inlist)
+	    } else
+	        call strcpy ("0", file_list, SZ_LINE)
+	}
+
+	# Decode the tape file number list.
+	if (decode_ranges (file_list, range, MAX_RANGES, len_inlist) == ERR)
+	    call error (0, "Illegal file number list.")
+	offset = clgeti ("offset")
+
+	# Get the output file names.
+	if (mtfile (outfiles) == YES) {
+	    outlist = NULL
+	    len_outlist = len_inlist
+	    outtape = YES
+	    if (mtneedfileno (outfiles) == YES) {
+	        if (! clgetb ("newtape"))
+		    call mtfname (outfiles, EOT, out_fname, SZ_FNAME)
+		else
+		    call mtfname (outfiles, 1, out_fname, SZ_FNAME)
+	    } else
+		call strcpy (outfiles, out_fname, SZ_FNAME)
+	} else {
+	    outlist = fntopnb (outfiles, NO)
+	    len_outlist = fntlenb (outlist)
+	    outtape = NO
+	}
+	if ((len_inlist > 1) && (len_outlist != 1) &&
+	    (len_outlist != len_inlist))
+	    call error (0,
+	        "The number of input and output files is not equal")
+
+	# Get the block and record sizes.
+        szb_outblock = clgeti ("outblock")
+	if (outtape == NO)
+	    szb_outblock = INDEFI
+	szb_inrecord = clgeti ("inrecord")
+	szb_outrecord = clgeti ("outrecord")
+	if (IS_INDEFI(szb_inrecord) && !IS_INDEFI(szb_outrecord))
+	    szb_inrecord = szb_outrecord
+	if (IS_INDEFI(szb_outrecord) && !IS_INDEFI(szb_inrecord))
+	    szb_outrecord = szb_inrecord
+
+	# Get the pad and trim parameters.
+	pad_block = btoi (clgetb ("pad_block"))
+	if (szb_inrecord < szb_outrecord)
+	    pad_record = YES 
+	else
+	    pad_record = NO
+	if (szb_inrecord > szb_outrecord)
+	    trim_record = YES
+	else
+	    trim_record = NO
+	if (pad_block == YES || pad_record == YES) {
+	    call clgstr ("padchar", padchar, SZ_PADCHAR)
+	    ip = 1
+	    if (cctoc (padchar, ip, cval) <= 0)
+		cval = ' '
+	    if (IS_DIGIT (cval))
+		padvalue = TO_INTEG (cval)
+	    else
+		padvalue = cval
+	}
+
+	# Tape to disk always requires reblocking.
+	if (intape == YES && outtape == NO)
+	    reblock = YES
+	else if (pad_record == YES || pad_block == YES || trim_record == YES)
+	    reblock = YES
+	else if (!IS_INDEFI(szb_outblock) || !IS_INDEFI(szb_inrecord) ||
+	    !IS_INDEFI(szb_outrecord))
+	    reblock = YES
+	else
+	    reblock = NO
+
+	# Get remaining parameters.
+	nskip = max (0, clgeti ("skipn"))
+	ncopy = clgeti ("copyn")
+	if (IS_INDEFI(ncopy))
+	    ncopy = MAX_INT
+	byteswap = btoi (clgetb ("byteswap"))
+	wordswap = btoi (clgetb ("wordswap"))
+	verbose = clgetb ("verbose")
+
+	# Loop through the files
+	file_cnt = 1
+	file_number = 0
+	while (get_next_number (range, file_number) != EOF) {
+
+	    # Construct the input file name.
+	    if (intape == YES) {
+		if (mtneedfileno (infiles) == YES)
+		    call mtfname (infiles, file_number, in_fname, SZ_FNAME)
+		else
+	            call strcpy (infiles, in_fname, SZ_FNAME)
+	    } else if (fntgfnb (inlist, in_fname, SZ_FNAME) != EOF)
+		;
+
+	    # Construct the output file name.
+	    if (outtape == NO) {
+		if (len_inlist > 1 && len_outlist == 1) {
+		    call sprintf (out_fname[1], SZ_FNAME, "%s%03d")
+		        call pargstr (outfiles)
+		    if (intape == YES)
+		        call pargi (file_number + offset)
+		    else
+		        call pargi (file_cnt)
+	        } else if (fntgfnb (outlist, out_fname, SZ_FNAME) != EOF)
+		    ;
+	    } else if (file_cnt == 2)
+		call mtfname (out_fname, EOT, out_fname, SZ_FNAME)
+
+	    iferr {
+
+		if (verbose) {
+		    call printf ("File: %s -> %s: ")
+			call pargstr (in_fname)
+			call pargstr (out_fname)
+		}
+
+		call reb_reblock_file (in_fname, out_fname, outparam)
+
+		if (verbose) {
+		    if (intape == YES)
+			call printf ("[skip %d blks] ")
+		    else
+		        call printf ("[skip %d recs] ")
+		    call pargi (nskip)
+		    call printf ("blks r/w %d/%d ")
+		        call pargi (BLKS_RD(outparam))
+		        call pargi (BLKS_WRT(outparam))
+		    if (reblock == YES) {
+		        call printf ("recs r/w %d/%d\n")
+			    call pargi (RECS_RD(outparam))
+			    call pargi (RECS_WRT(outparam))
+		    } else
+			call printf ("\n")
+		}
+
+	    } then {
+		call flush (STDOUT)
+	        call eprintf ("Cannot read file %s\n")
+		    call pargstr (in_fname)
+	    } else if (BLKS_RD(outparam) == 0) {
+	        if (verbose) {
+		    call printf ("Empty file: %s\n")
+		        call pargstr (in_fname)
+	        }
+		break
+	    } else {
+		file_cnt = file_cnt + 1
+            }
+	}
+
+	if (inlist != NULL)
+	    call fntclsb (inlist)
+	if (outlist != NULL)
+	    call fntclsb (outlist)
+end