diff options
Diffstat (limited to 'noao/mtlocal/cyber/rrcopy')
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/README | 2 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/Revisions | 15 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/mkpkg | 15 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/rcrbits.x | 279 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/rcrheader.x | 119 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/rcrimage.x | 173 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/rrcopy.h | 41 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/rrcopy.x | 212 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/semicode.doc | 310 | ||||
| -rw-r--r-- | noao/mtlocal/cyber/rrcopy/t_rrcopy.x | 147 |
10 files changed, 1313 insertions, 0 deletions
diff --git a/noao/mtlocal/cyber/rrcopy/README b/noao/mtlocal/cyber/rrcopy/README new file mode 100644 index 00000000..ec7e7c70 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/README @@ -0,0 +1,2 @@ +This directory contains source code for rrcopy, the Cyber RCOPY tape +reader. diff --git a/noao/mtlocal/cyber/rrcopy/Revisions b/noao/mtlocal/cyber/rrcopy/Revisions new file mode 100644 index 00000000..09bf9e12 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/Revisions @@ -0,0 +1,15 @@ +.help revisions Jun88 noao.mtlocal.cyber.rrcopy +.nf +noao$mtlocal/cyber/rrcopy/t_rrcopy.x, rcrheader.x + Fixed two places in t_rrcopy where the procedure was returning + without closing the mt file. Procedure rc_read_header was + not returning the value (OK) when NOT at EOF. These two errors, + while present all along, had not been seen until rrcopy was modified + to read tapes with more then one datafile; see below. (4-AUG-88 ShJ) + +noao$mtlocal/cyber/rrcopy/t_rrcopy.x + Added a hidden parameter "datafile" to the rrcopy task. This + allows more than one file of rcopy format data per tape. With + this "extension" to the rcopy format, many rcopy files can be + archived on a single tape. (26-JULY-88 ShJ) +.endhelp diff --git a/noao/mtlocal/cyber/rrcopy/mkpkg b/noao/mtlocal/cyber/rrcopy/mkpkg new file mode 100644 index 00000000..6d2d99d3 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/mkpkg @@ -0,0 +1,15 @@ +# The Cyber rcopy format reader RRCOPY makes the following contributions +# to the dataio package library: + +$checkout libpkg.a ../../ +$update libpkg.a +$checkin libpkg.a ../../ +$exit + +libpkg.a: + rcrbits.x ../pow.inc <error.h> <imhdr.h> <mach.h> rrcopy.h + rcrheader.x <error.h> <imhdr.h> <mach.h> rrcopy.h + rcrimage.x rrcopy.h <error.h> <imhdr.h> <mach.h> + rrcopy.x <mach.h> rrcopy.h + t_rrcopy.x rrcopy.h <error.h> <imhdr.h> <mach.h> + ; diff --git a/noao/mtlocal/cyber/rrcopy/rcrbits.x b/noao/mtlocal/cyber/rrcopy/rcrbits.x new file mode 100644 index 00000000..c6525787 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rcrbits.x @@ -0,0 +1,279 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "rrcopy.h" + +# RC_UP_12 -- Unpack 12-bit unsigned integers from a stream of bits. +# Each output integer word contains successive 12-bit increments +# of the input bit stream in the least significant bit positions. +# It is assummed that the initial_bit_offset is the first bit of a +# Cyber 60-bit word containing 5 packed 12-bit pixels, the first pixel +# in the highest 12 bits. + +procedure rc_up_12 (input, initial_bit_offset, output, npix_unpk) + +char input[ARB] +int output[npix_unpk], npix_unpk +int initial_bit_offset, nbits, n, nn, bit_offset +int npix_word, ncyb_words, index +int bitupk() + +begin + nbits = 12 + npix_word = 5 + if (mod (npix_unpk, npix_word) == 0) + ncyb_words = (npix_unpk) / npix_word + else + call error (0, "Incorrect number of pixels to be unpacked") + index = 1 + + do n = 1, ncyb_words { + bit_offset = initial_bit_offset + (n * 60) + do nn = 1, npix_word { + bit_offset = bit_offset - nbits + output[index] = bitupk (input, bit_offset, nbits) + if (output[index] == 7777B) + output[index] = BLANK + index = index + 1 + } + } +end + + +# RC_UP_20 -- Unpack 20-bit signed integers from a stream of bits. +# Each output integer word contains sucessive 20-bit increments of the input. +# Conversion from one's complement to two's complement is performed. +# It is assummed that initial_bit_offset is the first bit of a Cyber +# 60-bit word containing 3 packed 20-bit pixels, the first pixel in the +# highest 20 bits. + +procedure rc_up_20 (input, initial_bit_offset, output, npix_unpk) + +char input[ARB] +int output[npix_unpk], npix_unpk +int nbits, n, index, bit_offset, initial_bit_offset +int npix_word, ncyb_words, nn, pix_val +int bitupk() + +begin + nbits = 20 + npix_word = 3 + if (mod (npix_unpk, npix_word) == 0) + ncyb_words = npix_unpk / npix_word + else + call error (0, "Incorrect number of pixels to be unpacked") + index = 1 + + do n = 1, ncyb_words { + bit_offset = initial_bit_offset + (n * 60) + do nn = 1, npix_word { + bit_offset = bit_offset - nbits + pix_val = bitupk (input, bit_offset, nbits) + if (pix_val == 3777777B) + pix_val = BLANK + else if (and (pix_val, 2000000B) != 0) + # negative pixel + pix_val = -and (3777777B, not(pix_val)) + output[index] = pix_val + index = index + 1 + } + } +end + + +# RC_UP_30 -- unpack Cyber 30-bit floating point numbers from a stream of +# bits. The input bit stream is unpacked in 30-bit increments into +# an integer array. Procedure REPACK_FP is called to reconstruct the +# floating point numbers from this array. It is assumed initial_bit_offset +# is the first bit of a Cyber 60-bit word containing 2 30-bit pixels, the +# first pixel in the higher 30 bits. + +procedure rc_up_30 (input, initial_bit_offset, fp_value, npix) + +char input[ARB] +real fp_value[npix] +pointer int_buf, sp +int initial_bit_offset, npix, bit_offset +int nbits, n +int bitupk() + +begin + # Allocate buffer space, allowing for maximum of 1 extraneous pixel + call smark (sp) + call salloc (int_buf, npix + 1, TY_INT) + + nbits = 30 + bit_offset = initial_bit_offset - 60 + + do n = 1, npix, 2 { + bit_offset = bit_offset + 90 + Memi[int_buf + n - 1] = bitupk (input, bit_offset, 30) + bit_offset = bit_offset - nbits + Memi[int_buf + n] = bitupk (input, bit_offset, 30) + } + + call rc_repack_fp (Memi[int_buf], fp_value, npix) + call sfree (sp) +end + + +# RC_UP_60R -- Unpack Cyber 60-bit floating point numbers from a stream +# of bits. The 30 most significant bits from each 60-bit word are +# unpacked into an integer array. Procedure REPACK_FP is called to +# reconstruct the floating point numbers from this array. +# An 18-bit mantissa, 11-bit exponent and a sign bit are unpacked into +# the lower 30 bits of each output word. + +procedure rc_up_60r (input, initial_bit_offset, fp_value, nwords) + +char input[ARB] +real fp_value[nwords] +int initial_bit_offset, nwords, bit_offset +pointer int_buf, sp +int n, nbits_unpk, nbits +int bitupk() + +begin + # Allocate space on stack + call smark (sp) + call salloc (int_buf, nwords, TY_INT) + + nbits = 60 + nbits_unpk = 30 + bit_offset = initial_bit_offset + 30 + + do n = 1, nwords { + Memi[int_buf + n - 1] = bitupk (input, bit_offset, nbits_unpk) + bit_offset = bit_offset + 60 + } + + call rc_repack_fp (Memi[int_buf], fp_value, nwords) + call sfree (sp) +end + + +# RC_UP_60I -- Unpack 60-bit integers from a stream of bits. Each element +# of output contains only the lower 32 bits of each input word, as this +# procedure is called only for getting NROWS, NCOLS and a few other small +# positive integer values. (A 60-bit intger is not a valid IPPS pixel type.) + +procedure rc_up_60i (input, initial_bit_offset, output, nwords) + +char input[ARB] +int output[nwords] +int initial_bit_offset, nwords, bit_offset +int n, nbits_unpk, nbits +int bitupk() + +begin + nbits_unpk = NBITS_INT + nbits = 60 + bit_offset = initial_bit_offset + + do n = 1, nwords { + output[n] = bitupk (input, bit_offset, nbits_unpk) + bit_offset = bit_offset + 60 + } +end + + +# RC_UP_ID -- Unpacks ID string from input bit stream. The IPPS ID string is +# written in 7-bit ASCII, with eight characters per Cyber word. The lowest +# 4 bits of each 60-bit word is unused. The highest 7 bits of the first Cyber +# word in the bit stream contains the character count. + +procedure rc_up_id (input, output) + +char input[SZ_HEADER] +char output[SZ_HEADER] +int nbits, nchar_offset, id_offset, nchars, n +int nchars_word, ncyb_words, nn, index +int bitupk() + +begin + nbits = 7 + nchar_offset = NBITS_CYBER_WORD - 6 + nchars = bitupk (input, nchar_offset, nbits) + ncyb_words = (nchars + 7) / 8 + index = 1 + + do n = 1, ncyb_words { + if (n == 1) { + nchars_word = 7 + id_offset = nchar_offset - 7 + } else { + nchars_word = 8 + id_offset = (n * NBITS_CYBER_WORD) - 6 + } + do nn = 1, nchars_word { + output[index] = bitupk (input, id_offset, nbits) + index = index + 1 + id_offset = id_offset - 7 + } + } + output[nchars+1] = EOS +end + + +# RC_REPACK_FP -- returns a floating point number as the function value. +# The input to REPACK_FP is an integer containing a 30-bit Cyber floating +# point number in the least significant bits. The exponent, mantissa +# and two bits indicating the sign are extracted and used to reassemble +# the floating point value. Cyber blanks and overflows are returned as BLANK. + +procedure rc_repack_fp (int_value, float_value, nvalues) + +int int_value[ARB], nvalues +real float_value[nvalues] + +int i, pixel +int exp, mantissa +real tbl[255] +int bitupk(), and(), not() +include "../pow.inc" + +begin + do i=1, nvalues { + pixel = int_value[i] + # Check for blanks + if (pixel == 1777000000B) { + float_value[i] = BLANK + next + } + + # Check "bit59" and complement all bits if it is set + if (and (pixel, 4000000000B) != 0) { + pixel = not (pixel) + mantissa = -and (pixel, 777777B) + } else + mantissa = and (pixel, 777777B) + + # Extract and interpret exponent: remove Cyber bias of 2000B + # and convert to two's complement if negative number + exp = bitupk (pixel, 19, 11) + if (exp > 1777B) + # "bit58" is set, positive exponent + exp = exp - 2000B + else + # negative exponent + exp = exp - 1777B + + # Reconstruct the floating point value: 30 is added to the + # exponent because only the top 18 bits of the 48-bit mantissa + # were extracted; the 129 is to register the data array index. + # float_value[i] = real(mantissa) * 2 ** (exp + 30) + # (tbl[1] = 2 ** -128) ==> (2 ** n = tbl[n + 129]). + + exp = exp + 30 + 129 + if (exp <= 0) { + #call eprintf ( + #"RRCOPY_RPACK_FP: Exponent underflow in following record\n") + float_value[i] = 0.0 + } else if (exp > 255) { + #call eprintf ( + #"RRCOPY_REPACK_FP: Exponent overflow in following record\n") + float_value[i] = MAX_REAL + } else if (exp > 0 && exp <= 255) + float_value[i] = double (mantissa) * tbl[exp] + } +end diff --git a/noao/mtlocal/cyber/rrcopy/rcrheader.x b/noao/mtlocal/cyber/rrcopy/rcrheader.x new file mode 100644 index 00000000..2187c6a1 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rcrheader.x @@ -0,0 +1,119 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "rrcopy.h" + +# RC_READ_HEADER -- reads the IPPS header (64 60-bit words) as +# a bit stream into consecutive elements of char array header. +# Any extraneous information between the header and data is skipped; +# the tape is left positioned at the first data record. + +int procedure rc_header_read (rd, rp) + +int rd +pointer rp +char raw_header[SZ_HEADER], header[SZ_HEADER] +int nchars_to_skip, first_word +int rc_read_cyber() +errchk rc_header_unpk, rc_skip_chars, rc_read_cyber, rc_order_cyber_bits + +begin + if (rc_read_cyber (rd, raw_header, SZ_HEADER) == EOF) + return (EOF) + + first_word = 1 + call rc_order_cyber_bits (raw_header, first_word, header, LEN_PRU) + + # Unpack bit stream and fill structure rp + iferr { + call rc_header_unpk (header, rp) + nchars_to_skip = (PRU_ROW_ONE(rp) - 1) * NBITS_PRU / NBITS_CHAR + } then { + call erract (EA_WARN) + # Position to first row of raster before posting error + if (nchars_to_skip > 0) + call rc_skip_chars (rd, nchars_to_skip) + call error (1, "Bad header, attempting to skip raster") + } + + # Position to first row of IPPS raster + if (nchars_to_skip > 0) + call rc_skip_chars (rd, nchars_to_skip) + + return (OK) +end + + +# RC_LIST_HEADER -- prints the RCOPY header information. + +procedure rc_list_header (rp, raster_num) + +pointer rp +int raster_num + +begin + # Print header information from rcopy tape + call printf ("[%d]%7t IPPS_ID: %s\n") + call pargi (raster_num) + call pargstr (IPPS_ID(rp)) + call printf ("%7t NCOLS=%d, NROWS=%d, MIN=%g, MAX=%g, NBPP=%d\n") + call pargi (NCOLS(rp)) + call pargi (NROWS(rp)) + call pargr (DATA_MIN(rp)) + call pargr (DATA_MAX(rp)) + call pargi (BITS_PIXEL(rp)) +end + + +# RC_UNPACK_HEADER -- unpacks header words from the char array header +# and fills the RCOPY data structure. A few values are checked to +# make sure a valid IPPS raster is being read. Offsets to various +# header words have been defined previously. + +procedure rc_header_unpk (header, rp) + +char header[SZ_HEADER] +pointer rp + +begin + # From the reordered array, first the ID is unpacked + call rc_up_id (header, IPPS_ID(rp)) + + # An EOR marker terminates each raster + call rc_up_60i (header, EOR_OFFSET, PRU_EOR(rp), 1) + + # The PRU containing the first data row + call rc_up_60i (header, FIRST_PRU_OFFSET, PRU_ROW_ONE(rp), 1) + + # Most significant 30 bits of the data min are used + call rc_up_60r (header, MIN_OFFSET, DATA_MIN(rp), 1) + + # Most significant 30 bits of the data max are used + call rc_up_60r (header, MAX_OFFSET, DATA_MAX(rp), 1) + + # Bits per pixel is unpacked and tested + call rc_up_60i (header, DATA_TYPE_OFFSET, BITS_PIXEL(rp), 1) + + switch (BITS_PIXEL(rp)) { + case 12,20,30,60: + ; + default: + call error (2, "Incorrect IPPS BITS_PIXEL") + } + + # Number of columns is unpacked and tested + call rc_up_60i (header, NCOLS_OFFSET, NCOLS(rp), 1) + if (NCOLS(rp) <= 0) + call error (2, "IPPS ncols <= 0") + + # Number of Cyber words per row must be integral # of PRU's + call rc_up_60i (header, NWORDS_OFFSET, WRDS_PER_ROW(rp), 1) + + if (mod (WRDS_PER_ROW(rp), LEN_PRU) != 0) + call error (2, "Invalid IPPS NWPR") + + # Number of rows is unpacked and tested + call rc_up_60i (header, NROWS_OFFSET, NROWS(rp), 1) + if (NROWS(rp) <= 0) + call error (2, "IPPS nrows <= 0") +end diff --git a/noao/mtlocal/cyber/rrcopy/rcrimage.x b/noao/mtlocal/cyber/rrcopy/rcrimage.x new file mode 100644 index 00000000..dc7ebcfb --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rcrimage.x @@ -0,0 +1,173 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "rrcopy.h" + +# RC_READ_IMAGE -- reads the rcopy image row by row from the tape and writes +# the output image. At the completion of READ_IMAGE, the tape is positioned +# to the header record of the next tape raster. + +procedure rc_read_image (rd, out_fname, data_type, rp) + +int rd, data_type +char out_fname[SZ_FNAME] +pointer rp + +pointer sp, im, cyber_buf, spp_buf +int nchars_per_row, nbits_skip, nchars_to_skip, i +long clktime() + +int rc_read_cyber() +pointer immap(), impl2r() +errchk rc_skip_chars, immap, rc_ipps_to_iraf + +begin + # Allocate buffer for rcopy image pixels + call smark (sp) + nchars_per_row = WRDS_PER_ROW(rp) * NBITS_CYBER_WORD / NBITS_CHAR + call salloc (cyber_buf, nchars_per_row, TY_CHAR) + call salloc (spp_buf, nchars_per_row, TY_CHAR) + + # Map new iraf image and set up image header + im = immap (out_fname, NEW_IMAGE, 0) + IM_LEN(im, 1) = NCOLS(rp) + IM_LEN(im, 2) = NROWS(rp) + call strcpy (IPPS_ID(rp), IM_TITLE(im), SZ_IMTITLE) + IM_MIN(im) = DATA_MIN(rp) + IM_MAX(im) = DATA_MAX(rp) + + # Set optimum image pixel type + if (data_type == NOT_SET) { + switch (BITS_PIXEL(rp)) { + case 12: + IM_PIXTYPE(im) = TY_SHORT + case 20: + IM_PIXTYPE(im) = TY_REAL + case 30: + IM_PIXTYPE(im) = TY_REAL + case 60: + IM_PIXTYPE(im) = TY_REAL + default: + call error (3, "IPPS BITS_PIXEL is incorrect") + } + } else + IM_PIXTYPE(im) = data_type + IM_LIMTIME(im) = clktime (long(0)) + + # Loop over rows to read, reorder and convert pixels. + for (i=1; i <= NROWS(rp); i=i+1) { + if (rc_read_cyber (rd, Memc[cyber_buf], nchars_per_row) == EOF) + call error (4, "Unexpected EOT when reading image") + call rc_order_cyber_bits (Memc[cyber_buf], 1, Memc[spp_buf], + WRDS_PER_ROW(rp)) + call rc_ipps_to_iraf (Memc[spp_buf], Memr[impl2r(im,i)], NCOLS(rp), + BITS_PIXEL(rp)) + } + + # Skip from present position to end of rcopy raster + nbits_skip = ((PRU_EOR(rp) - PRU_ROW_ONE(rp)) * LEN_PRU - + (WRDS_PER_ROW(rp) * NROWS(rp))) * NBITS_CYBER_WORD + NBITS_EOR_MARK + + nchars_to_skip = nbits_skip / NBITS_CHAR + call rc_skip_chars (rd, nchars_to_skip) + + call imunmap (im) + call sfree (sp) +end + + +# RC_IPPS_TO_IRAF -- performs the conversion from Cyber pixels to IRAF pixels. +# Each row of the rcopy image is required to occupy an integral of Cyber +# PRU's, so the input buffer contains pixels plus filler. The entire +# buffer is converted and npix pixels are written to the output image. + +procedure rc_ipps_to_iraf (in_buf, iraf_real, npix, nbits_pixel) + +char in_buf[ARB] +real iraf_real[npix] +pointer iraf_int, sp +int nbits_pixel, npix, bit_offset, npix_unpk, npix_cyber_wrd +errchk rc_up_12, rc_up_20 + +begin + # Calculate and allocate (maximum) space needed on the stack. The + # number of pixels unpacked will always fill an integral number + # of Cyber words. A maximum of 4 extraneous pixels will be unpacked. + call smark (sp) + call salloc (iraf_int, npix + 4, TY_INT) + bit_offset = 1 + + switch (nbits_pixel) { + case 12: + npix_cyber_wrd = 5 + npix_unpk = ((npix + 4) / npix_cyber_wrd) * npix_cyber_wrd + call rc_up_12 (in_buf, bit_offset, Memi[iraf_int], npix_unpk) + call achtir (Memi[iraf_int], iraf_real, npix) + + case 20: + npix_cyber_wrd = 3 + npix_unpk = ((npix + 2) / npix_cyber_wrd) * npix_cyber_wrd + call rc_up_20 (in_buf, bit_offset, Memi[iraf_int], npix_unpk) + call achtir (Memi[iraf_int], iraf_real, npix) + + case 30: + call rc_up_30 (in_buf, bit_offset, iraf_real, npix) + + case 60: + call rc_up_60r (in_buf, bit_offset, iraf_real, npix) + + default: + call error (5, "Illegal IPPS #B/P") + } + + call sfree (sp) +end + + +# RC_SKIP_IMAGE -- skips over an RCOPY raster once the header has been +# read. When SKIP_IMAGE returns, the tape is positioned to the first +# record of the next tape image. + +procedure rc_skip_image (rd, rp) + +int rd +pointer rp +int nchars_to_skip +errchk rc_skip_chars + +begin + # Calculate number of chars in image + nchars_to_skip = ((PRU_EOR(rp) - PRU_ROW_ONE(rp)) * + LEN_PRU * NBITS_CYBER_WORD + NBITS_EOR_MARK ) / NBITS_CHAR + call rc_skip_chars (rd, nchars_to_skip) +end + +# RC_SKIP_CHARS -- positions the tape by skipping the requested number of chars. + +procedure rc_skip_chars (rd, nchars_to_skip) + +int rd, nchars_to_skip +pointer sp, dummy +int nblks_read, nchars_remaining, i +int rc_read_cyber() + +begin + call smark (sp) + call salloc (dummy, SZ_TAPE_BLK, TY_CHAR) + + # Calculate the number of full blocks to skip + nblks_read = nchars_to_skip / SZ_TAPE_BLK + nchars_remaining = mod (nchars_to_skip, SZ_TAPE_BLK) + + # Read from tape, a block at a time + for (i=1; i <= nblks_read; i=i+1) { + if (rc_read_cyber (rd, Memc[dummy], SZ_TAPE_BLK) == EOF) + call error (6, "Unexpected EOT when skipping image") + } + + # Read partial block from tape + if (rc_read_cyber (rd, Memc[dummy], nchars_remaining) == EOF) + call error (7, "Unexpected EOT when skipping image") + + call sfree (sp) +end diff --git a/noao/mtlocal/cyber/rrcopy/rrcopy.h b/noao/mtlocal/cyber/rrcopy/rrcopy.h new file mode 100644 index 00000000..9579b623 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rrcopy.h @@ -0,0 +1,41 @@ + +# Definitions for the Cyber RCOPY tape reader + +define NBITS_CHAR (NBITS_BYTE * SZB_CHAR) # Number of bits per char +define NBITS_CYBER_WORD 60 # Number of bits per Cyber word +define LEN_PRU 64 # Number of words per Cyber pru +define NBITS_PRU 3840 # Number of bits per Cyber pru +define NCHARS_NOISE (48 / NBITS_CHAR) # Nchars in a Cyber noise record +define NBITS_EOR_MARK 48 # Number of bits per eor marker +define SZ_HEADER ((64 * 60) / NBITS_CHAR) # Size in chars of IPPS header +define SZ_TAPE_BLK ((512 * 60) / NBITS_CHAR) # Size in chars of tape block +define SZ_BUFFER (SZ_TAPE_BLK + 100) # Size of tape buffer for read +define SZ_IPPS_ID 127 # Max number of characters in ID +define MAX_RANGES 100 +define NOT_SET 0 # Flag for data_type not set +define BLANK 0.0 # Temporary value for blanks + +# Bit-offsets to IPPS header words + +define DATA_TYPE_OFFSET (16 * 60 + 1) # Offset to data_type (nbpp) +define NCOLS_OFFSET (17 * 60 + 1) # Offset to ncols (nppr) +define NWORDS_OFFSET (18 * 60 + 1) # Offet to nwords_per_row +define NROWS_OFFSET (20 * 60 + 1) # Offset to nrows +define FIRST_PRU_OFFSET (21 * 60 + 1) # Offset to 1st pru of raster +define MIN_OFFSET (31 * 60 + 1) # Offset to data min +define MAX_OFFSET (32 * 60 + 1) # Offset to data max +define EOR_OFFSET (44 * 60 + 1) # Offset to terminating pru + +# The IPPS raster descriptor structure RP: + +define LEN_RP 10 + SZ_IPPS_ID + 1 + +define BITS_PIXEL Memi[$1] +define PRU_EOR Memi[$1+1] +define WRDS_PER_ROW Memi[$1+2] +define PRU_ROW_ONE Memi[$1+3] +define NCOLS Memi[$1+4] +define NROWS Memi[$1+5] +define DATA_MIN Memr[P2R($1+6)] +define DATA_MAX Memr[P2R($1+7)] +define IPPS_ID Memc[P2C($1+10)] diff --git a/noao/mtlocal/cyber/rrcopy/rrcopy.x b/noao/mtlocal/cyber/rrcopy/rrcopy.x new file mode 100644 index 00000000..0a6b5de7 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rrcopy.x @@ -0,0 +1,212 @@ +include <mach.h> +include "rrcopy.h" + +.help rc_read_cyber +.nf ________________________________________________________________________ +RC_READ_CYBER -- Read binary chars from a file, ignoring short "noise" records. +Data is read in chunks from the file buffer passed as a bit stream into the +output buffer. (See also: read_dumpf and get_cyber_words.) The +file buffer is refilled as necessary by calling READ; the output buffer is +supplied by the calling procedure. Cyber noise records (48 bits) +are not transferred to the output buffer and so are ignored. READ_CYBER_INIT +must be called to initialize variables for CYBER_READ. Variables marking the +current position and top of the buffer are initialized. +.endhelp ___________________________________________________________________ + +int procedure rc_read_cyber (rd, out_buffer, maxch) + +int buf_pos, buf_top +int rd, maxch +char out_buffer[ARB] +char block_buf[SZ_BUFFER] +int nchars, chunk_size, nchars_read +int read(), rc_read_cyber_init() + +begin + for (nchars = 0; nchars < maxch; nchars = nchars + chunk_size) { + # See if it is necessary to transfer more data from the binary file + # to the file buffer. This will be necessary when all data from the + # file buffer has been moved to the output buffer. + + if (buf_pos >= buf_top) { + # Read the next non-noise record into block_buf; reset buf_pos + repeat { + nchars_read = read (rd, block_buf, SZ_BUFFER) + } until (nchars_read >= NCHARS_NOISE || nchars_read == EOF) + buf_pos = 1 + buf_top = nchars_read + } + + # The number of chars to output is the smaller of the number of + # characters requested or the number of characters left in the + # buffer + + if (nchars_read == EOF) + break + else + chunk_size = min (maxch - nchars, buf_top - buf_pos + 1) + + # Move data to output array, increment buffer offset + call amovc (block_buf[buf_pos], out_buffer[nchars+1], chunk_size) + buf_pos = buf_pos + chunk_size + } + + if (nchars == 0) + return (EOF) + else + return (nchars) + +entry rc_read_cyber_init () + + buf_pos = 1 + buf_top = 0 + return (OK) +end + + +.help rc_order_cyber_bits +.nf __________________________________________________________________________ +RC_ORDER_CYBER_BITS -- Convert raw data array from a 60-bit Cyber computer into +an SPP bit-array. The output SPP bit-array is a bit-packed array of 60-bit +Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on. +The least significant Cyber bit is bit 1 in each output word and the most +significant bit is bit 60. [MACHDEP]. + +When the Cyber outputs an array of 60 bit Cyber words it moves a stream of +bits into output bytes, filling however many bytes as necessary to output a +given number of Cyber words. The most significant bits are output first, +i.e., bit 60 of the first word is moved to bit 8 of the first output byte, +bit 59 is moved to bit 7 of the first output byte, and so on. If effect the +Cyber byte flips each 60-bit word. + +To deal with Cyber words as an ordered bit stream we must reorder the bytes +and bits so that the least significant bits are first. This function is +performed by the primitives CYBOOW and CYBOEW (order odd/even Cyber word) +for individual 60-bit Cyber words. A portable (and less efficient) version +of order_cyber_bits is available which does not use these primitives. +.endhelp _____________________________________________________________________ + + +procedure rc_order_cyber_bits (raw_cyber, first_cyber_word, bit_array, + ncyber_words) + +char raw_cyber[ARB] # raw Cyber array (e.g. from tape) +int first_cyber_word # first 60-bit Cyber word to be unpacked +char bit_array[ARB] # output bit-array +int ncyber_words # number of Cyber words to unpack + +bool odd_word +int word, inbit, outbit + +begin + odd_word = (mod (first_cyber_word, 2) == 1) + inbit = (first_cyber_word - 1) * NBITS_CYBER_WORD + 1 + outbit = 1 + + do word = 1, ncyber_words { + # Call odd or even primitive to reorder bits and move 60-bit + # ordered Cyber word to the output array. + + if (odd_word) { + call cyboow (raw_cyber, inbit, bit_array, outbit) + odd_word = false + } else { + call cyboew (raw_cyber, inbit, bit_array, outbit) + odd_word = true + } + + inbit = inbit + NBITS_CYBER_WORD + outbit = outbit + NBITS_CYBER_WORD + } +end + + +# The portable version of order_cyber_bits follows. +#.help order_cyber_bits +#.nf __________________________________________________________________________ +#ORDER_CYBER_BITS -- Convert a raw data array from a 60-bit Cyber computer into +#an SPP bit-array. The output SPP bit-array is a bit-packed array of 60-bit +#Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on. +#The least significant Cyber bit is bit 1 in each output word and the most +#significant bit is bit 60. [MACHDEP]. +# +#The byte stream from the Cyber contains bits 53-60 of the first word in the +#first byte, bits 45-52 in the second byte, and so on (most significant bytes +#first). In essence we swap the order of the 7 8-bit bytes and the 4-bit half +#byte in each 60 bit word. The bits in each byte are in the correct order. +# +#Each successive pair of Cyber words fits into 15 bytes. Byte 8 contains the +#last 4 bits of word 1 in the most signficant half of the byte and the first +#4 bits of word 2 in the first half of the byte. In each 60 bit word we must +#move bit segments (bytes or half bytes) as follows (for the VAX): +# +#Odd words (from N*60 bit-offset): +# [from] [to] [nbits] +# 1 53 8 +# 9 45 8 +# 17 37 8 +# 25 29 8 +# 33 21 8 +# 41 13 8 +# 49 5 8 +# 61 1 4 +# +#Even words (from N*60 bit-offset): +# [from] [to] [nbits] +# -3 57 4 +# 5 49 8 +# 13 41 8 +# 21 33 8 +# 29 25 8 +# 37 17 8 +# 45 9 8 +# 53 1 8 +#.endhelp _____________________________________________________________________ +# +#define NBITS_PER_WORD 60 +#define NSEGMENTS 8 +# +# +#procedure order_cyber_bits (raw_cyber, first_cyber_word, bit_array, +# ncyber_words) +# +#char raw_cyber[ARB] # raw Cyber array (e.g. from tape) +#int first_cyber_word # first 60-bit Cyber word to be unpacked +#char bit_array[ARB] # output bit-array +#int ncyber_words # number of Cyber words to unpack +# +#int word, inword, inbit, outbit, temp, i +#int o_from[NSEGMENTS], o_to[NSEGMENTS], o_nbits[NSEGMENTS] +#int e_from[NSEGMENTS], e_to[NSEGMENTS], e_nbits[NSEGMENTS] +#int bitupk() +# +#data o_from / 1, 9,17,25,33,41,49,61/ # odd words +#data o_to /53,45,37,29,21,13, 5, 1/ +#data o_nbits / 8, 8, 8, 8, 8, 8, 8, 4/ +#data e_from /-3, 5,13,21,29,37,45,53/ # even words +#data e_to /57,49,41,33,25,17, 9, 1/ +#data e_nbits / 4, 8, 8, 8, 8, 8, 8, 8/ +# +#begin +# do word = 1, ncyber_words { +# inword = first_cyber_word + word - 1 +# inbit = (inword - 1) * NBITS_PER_WORD +# outbit = ( word - 1) * NBITS_PER_WORD +# +# # Move bits to the output bit array. Segment list used depends +# # on whether the word is an odd or even word. This code will work +# # even if the caller only wishes to order a single word. +# +# if (mod (inword,2) == 1) { +# do i = 1, NSEGMENTS { +# temp = bitupk (raw_cyber, inbit + o_from[i], o_nbits[i]) +# call bitpak (temp, bit_array, outbit + o_to[i], o_nbits[i]) +# } +# } else { +# do i = 1, NSEGMENTS { +# temp = bitupk (raw_cyber, inbit + e_from[i], e_nbits[i]) +# call bitpak (temp, bit_array, outbit + e_to[i], e_nbits[i]) +# } +# } +# } +#end diff --git a/noao/mtlocal/cyber/rrcopy/semicode.doc b/noao/mtlocal/cyber/rrcopy/semicode.doc new file mode 100644 index 00000000..a7ad514c --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/semicode.doc @@ -0,0 +1,310 @@ +Semicode for Cyber RCOPY Reader; Frozen at "detailed semicode" stage, Jan 84. + + +# rcopy tape descriptor + +struct rcopy { + + real data_min # minimum data value + real data_max # maximum data value + int nrows # number of rows in ipps raster + int ncols # number of columns in ipps raster + int data_type # number of bits per pixel in the ipps raster + int pru_eor # pru position of level zero eor + int wrds_per_row # number of 60-bit words per row; each row + # occupies an integral number of 64word pru's. + int pru_row_one # relative pru ordinal of the first row of raster. + char ipps_id # id string of the ipps raster +} + +procedure t_rrcopy (rcopy_file, raster_list, iraf_file) + + +begin + # get input filename and open tape drive + rcopy_fd = open (rcopy_file) + + # get output filename if it will be needed + if (make_image = yes) + outfile = fetch root name of output file + + # expand list of rasters to be read from tape + if (decode_ranges (raster_list, range, MAX_RANGES, nfiles) == ERR) + call error (0, "Illegal raster number list") + + raster_number = 0 + tape_pos = 1 + while (get_next_number (range, raster_number, != EOF) { + # position tape to first record of raster_number + if (tape_pos != raster_number) { + iferr { + stat = position_rcopy (rcopy_fd, tape_pos ,raster_number) + if (stat = EOF) + return + } then + call ERRACT (EA_FATAL) + } + iraffile = generate output filename from root + iferr { + (stat = read_rcopy(rcopy_fd, iraffile, tape_pos)) + if (stat = EOF) + return + } then { + call ERRACT (EA_WARN) + skip over rcopy raster + } + } + +end + +int procedure position_rcopy (rcopy_fd, tape_pos, raster_number) + +begin + + nrasters_skip = raster_number - tape_pos + for (i=1; i<=nrasters_skip; i=i+1) { + stat = read_header (rcopy_fd, rcopy) + if (stat = EOF) + return (EOF) + call read_header (rcopy_fd, rcopy) + call skip_image (rcopy_fd, rcopy) + } +end + +int procedure read_rcopy (rcopy_fd, iraffile, tape_pos) + +begin + + # Read ipps raster header from rcopy tape + stat = read_header (rcopy_fd, rcopy) + if (stat = EOF) + return (EOF) + + # Print header information from rcopy tape + if (print_header) + call print_header (rcopy) + + # read image data if desired + if (make_image) + call read_image(rcopy_fd, iraffile, rcopy) + + # skip image if not to be read + else + call skip_image (rcopy_fd, rcopy) + + # increment tape position marker + tape_pos = tape_pos + 1 + + +end + +int procedure read_header(rcopy_fd, rcopy) + +begin + # structure rcopy contains decoded header + # Read ipps header (64 60-bit words = 240 chars) as a + # bit stream into temp. + NBITS_CHAR = SZB_CHAR * NBITS_BYTE + NBITS_CYBER_WORD = 60 + NWORDS_CYBER_PRU = 64 + SZ_HEADER = 240 + stat = read_tape (rcopy_fd, raw_header, SZ_HEADER) + if (stat = EOF)) + return (EOF) + + # Unpack bit stream and fill structure rcopy + call unpack_header (raw_header, rcopy) + + # skip to first row of raster + if (rcopy.pru_row_one not equal to 1) { + nchars_to_skip = (rcopy.pru_row_one - 1) * NWORDS_CYBER_PRU + * NBITS_CYBER_WORD / NBITS_CHAR + call skip_chars (rcopy_fd, nchars_to_skip) + } +end + +procedure read_image (rcopy_fd, iraffile, rcopy) + +begin + + # map new iraf image and set up image header + im = immap (iraffile, NEW_IMAGE) + im.im_len[1] = rcopy.ncols + im.im_len[2] = rcopy.nrows + im.im_title = rcopy.ipps_id + im.im_min = rcopy.data_min + im.im_max = rcopy.data_max + + if (user hasn's supplied data type) { + switch (rcopy.data_type) { + case 12 : + im.im_pixtype = short + case 20 : + im.im_pixtype = real + case 30 : + im.im_pixtype = real + default: + call error (0, "error in data_type") + } + } + + # Calculate number of chars per row; this will always be an + # integral number of chars because rcopy.words_per_row + # is always divisible by 64. + NBITS_CHAR = SZB_CHAR * NBITS_BYTE + NBITS_CYBER_WORD = 60 + NWORDS_CYBER_PRU = 64 + num_chars_per_row = rcopy.wrds_per_row * NBITS_CYBER_WORD / NBITS_CHAR + + # Loop to read rcopy raster line by line into buf1, then + # convert ipps pixels to iraf pixels. + for(i=1; i<=rcopy.nrows; i=i+1) { + stat = read a single row from the internal buffer + if (stat = EOF) { + close imagefile already accumulated + call error (0, "unexpected EOF at row# ") + } + call ipps_to_iraf (buf1, Memr[impl2r(im,i)], rcopy) + } + + # Read until header of next raster into dummy buffer. + # Calculate offset in chars from present position to eor + nchars_to_skip = (((rcopy.eor - rcopy.pru_row_one) * NWORDS_CYBER_PRU + + (rcopy.words_per_row * rcopy.nrows)) * NBITS_CYBER_WORD + 48) + / NBITS_CHAR + + call skip_chars (rcopy_fd, nchars_to_skip) +end + +procedure ipps_to_iraf (buf1, buf2, rcopy) + +begin + + # convert (rcopy.ncols * rcopy.data_type ) bits from buf1. + # This is the number of bits per row that actually represent + # pixels. buf1 contains pixels plus filler. + + switch (rcopy.data_type) { + case 12: + call unpack12 (buf1, bit_offset, buf2, npix) + case 20: + call unpack20 (buf1, bit_offset, buf2, npix) + case 30: + call unpack30 (buf1, bit_offset, buf2, npix) + default: + call error (0, "illegal ipps #b/p") + } +end + +procedure skip_image(rcopy_fd, rcopy) + +begin + + # Calculate number of chars in image + nchars_to_skip = ((rcopy.eor - rcopy.pru_row_one ) * NWORDS_CYBER_PRU * + NBITS_CYBER_WORD + 48 ) / NBITS_CHAR + call skip_chars (rcopy_fd, nchars_to_skip) + +end + +procedure print_header (rcopy) + +begin + # print header information from rcopy tape + print, rcopy.ipps_id, rcopy.ncols, rcopy.nrows, rcopy.data_min, + rcopy.data_max, rcopy.ipps_data_type +end + +procedure unpack_header (raw_header, rcopy) + +begin + + get from raw_header: nrows, ncols, data_type, ipps_id, pru_eor, + wrds_per_row, pru_row_one, data_min, data_max + + if (rcopy.data_type != 12, 20, or 30) + call error (0, "invalid ipps #b/p") + if (nrows or ncols or pru_row_one !> 0) + call error (0, "invalid ipps raster") + if (wrds_per_row not divisible by 64) + call error (0, "invalid ipps raster") + +end + +procedure skip_chars (rcopy_fd, nchars_to_skip) + +begin + + # calculate the number of chars in a tape block = (512 * 60) / 16 + # This is the number of chars to be read at one time. + SZ_TAPE_BLK = 1920 + + # calculate number of blocks to skip (type int) + nblks_read = nchars_to_skip / SZ_TAPE_BLK + nchars_remaining = mod (nchars_to_skip, SZ_TAPE_BLK) + + # read chars into dummy buffer + for (i=1; i<=nblks_read; i=i+1) + stat = read_tape (rcopy_fd, dummy, SZ_TAPE_BLK) + + stat = read_tape (rcopy_fd, dummy, nchars_remaining) + + # confirm reaching eor + if (searching for eor) { + reread last 3 chars and compare with level zero eor marker + if (eor not confirmed) + call error (0, "attempted skip to eor unsuccessful") + } + +end + + +.help rrcopy 2 "Program Structure" +.sh +RCOPY Structure Chart + +.nf +procedure t_rrcopy () +# Returns when file list is satisfied or if EOT is encountered + + int procedure read_header (rcopy_fd, rcopy) + #returns EOF, ERR or OK + + int procedure read (rcopy_fd, raw_header, SZ_HEADER) + #returns EOF or OK + + int procedure unpack_header (raw_header, rcopy) + #returns ERR or OK + + int procedure skip_image (rcopy_fd, rcopy) + #returns ERR, EOF or OK + + int procedure skip_chars (rcopy_fd, nchars_to_skip) + #returns EOF, ERR or OK + + procedure read_rcopy (rcopy_fd, iraffile) + #aborts if output filename exists and noclobber is set + + int procedure read_header (rcopy_fd, rcopy) + #returns EOF, ERR or OK + + int procedure read (rcopy_fd, raw_header, SZ_HEADER) + #returns EOF or OK + + int procedure unpack_header (raw_header, rcopy) + #returns ERR or OK + + procedure print_header (rcopy) + + procedure read_image (rcopy_rd, iraffile, rcopy) + #returns EOF, or OK + + int procedure read (rcopy_rd, buf1, num_chars_per_row) + #returns EOF or OK + + int procedure ipps_to_iraf + #returns ERR or OK + + int procedure skip_image (rcopy_rd, rcopy) + #returns EOF, ERR or OK +.endhelp diff --git a/noao/mtlocal/cyber/rrcopy/t_rrcopy.x b/noao/mtlocal/cyber/rrcopy/t_rrcopy.x new file mode 100644 index 00000000..9bb83885 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/t_rrcopy.x @@ -0,0 +1,147 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "rrcopy.h" + +# T_RRCOPY -- The main procedure for the RCOPY reader. The RCOPY reader +# converts IPPS rasters written in RCOPY format to IRAF images. All IPPS +# rasters on an RCOPY tape are in a single file. Each raster header must +# be read before the image can be either skipped or read. T_RRCOPY gets +# parameters from the cl and decodes the string of rasters to be read. It +# then calls READ_HEADER for each raster on the tape. The header information +# is printed if print_header=true. If make_image = true, the image is +# converted to an IRAF image by READ_IMAGE. Otherwise, the image is skipped +# with SKIP_IMAGE. T_RRCOPY terminates when the raster list is depleted or +# the tape is at EOT. +# +# Modified 26-JULY-88 to allow for multiple rcopy files on a single tape. +# This allows for rcopy format data to be archived in multiple files on +# one tape. The task is still run once per input file. The user is queried +# (hidden parameter) for the data file to be read. The tape file is actually +# datafile + 1 because of the ANSI label on each rrcopy tape. (ShJ) + +procedure t_rrcopy () + +pointer sp, rp +bool make_image, print_header, bad_header +char rcopy_file[SZ_FNAME], iraf_file[SZ_FNAME] +char out_fname[SZ_FNAME], raster_list[SZ_LINE] +int rd, ras_number, current_ras, nras, stat, tapefile +int ranges[3, MAX_RANGES], data_type, init + +bool clgetb() +char clgetc() +int get_data_type(), position_rcopy(), rc_read_cyber_init(), clgeti() +int mtopen(), decode_ranges(), get_next_number(), rc_header_read(), strlen() +int mtfile() + +begin + # Allocate space on stack for program data structure + call smark (sp) + call salloc (rp, LEN_RP, TY_STRUCT) + + # Get input filename and open tape drive to second file, skipping label + call clgstr ("rcopy_file", rcopy_file, SZ_FNAME) + if (mtfile (rcopy_file) == YES) { + tapefile = clgeti ("datafile") + 1 + call mtfname (rcopy_file, tapefile, rcopy_file, SZ_FNAME) + } + rd = mtopen (rcopy_file, READ_ONLY, SZ_BUFFER) + init = rc_read_cyber_init() + + # Get output root filename if it will be needed + make_image = clgetb ("make_image") + if (make_image) { + call clgstr ("iraf_file", iraf_file, SZ_FNAME) + data_type = get_data_type (clgetc ("data_type")) + if (data_type == ERR) + data_type = NOT_SET + } + + # Set options + print_header = clgetb ("print_header") + + # Expand list of rasters to be read from tape + call clgstr ("raster_list", raster_list, SZ_LINE) + if (decode_ranges (raster_list, ranges, MAX_RANGES, nras) == ERR) + call error (0, "Illegal raster number list") + + ras_number = 0 + current_ras = 1 + while (get_next_number (ranges, ras_number) != EOF) { + # Position tape to first record of ras_number + if (current_ras != ras_number) { + iferr (stat = position_rcopy (rd, current_ras, ras_number, rp)) + call erract (EA_FATAL) + if (stat == EOF) + break + } + + # Assume header is good + bad_header = false + iferr { + stat = rc_header_read (rd, rp) + } then { + # Error reading header; will attempt to skip raster + bad_header = true + call erract (EA_WARN) + } + + if (stat == EOF) { + call printf ("\nRCOPY tape at End of Tape\n") + break + } + + if (print_header) + call rc_list_header (rp, ras_number) + call flush (STDOUT) + + if (make_image && ! bad_header) { + # Generate output filename + call strcpy (iraf_file, out_fname, SZ_FNAME) + if (nras > 1) { + call sprintf (out_fname[strlen(out_fname)+1], SZ_FNAME, + "%03d") + call pargi (ras_number) + } + iferr (call rc_read_image (rd, out_fname, data_type, rp)) + call erract (EA_FATAL) + } else + iferr (call rc_skip_image (rd, rp)) + call erract (EA_FATAL) + + # Increment tape position + current_ras = current_ras + 1 + } + + # Return space allocated for rp, close tape unit + call close (rd) + call sfree (sp) +end + + +# POSITION_RCOPY -- Position the tape to the first +# record of the next raster to be read. Each raster header must +# be read; each image can then be skipped. + +int procedure position_rcopy (rd, current_ras, ras_number, rp) + +int rd, current_ras, ras_number +pointer rp +int nras_skip, i, stat +int rc_header_read() +errchk rc_skip_image + +begin + nras_skip = ras_number - current_ras + for (i=1; i <= nras_skip; i=i+1) { + stat = rc_header_read (rd, rp) + if (stat == EOF) { + call printf ("Cannot position RCOPY tape beyond EOF\n") + return (EOF) + } + call rc_skip_image (rd, rp) + current_ras = current_ras + 1 + } + return (OK) +end |