# ## Copyright (c) 1995-2020 University Corporation for Atmospheric Research ## All rights reserved # my $pkgdoc = <<'EOD'; #/**---------------------------------------------------------------------- # @file BJTools.pm # Tools for unpacking BlackJack receiver files. # # @author Doug Hunt # @since 10/07/2003 # @cdaacTask no # @version $URL: svn://ursa.cosmic.ucar.edu/trunk/src/BJutils/BJTools.pm $ $Id: BJTools.pm 13339 2010-11-03 17:34:37Z jasonlin $ # -----------------------------------------------------------------------*/ EOD package BJTools; use strict; use warnings; use PDL; #/**---------------------------------------------------------------------- # @sub sortNav # # Sort GRACE navigation data files, getting rid of duplicate records. # # @parameter $infile Input file in opnGps format, but out of order and # @ with no headers/trailers. # @ $outfile Output sorted file. # @return none # @exception Will toss an exception in case of real trouble. # ----------------------------------------------------------------------*/ sub sortNav { my $infile = shift; my $outfile = shift; my %data = (); # ## Read in data and stash in a hash by PRN and time # open my $infh, '<', $infile or die "Cannot open $infile"; while (<$infh>) { my ($time) = /^(\d+)/; $data{$time} = $_; } close $infh; # ## Print data to output file sorted by time. # open my $outfh, '>', $outfile or die "Cannot open $outfile for writing"; foreach my $time (sort { $a <=> $b } keys %data) { print {$outfh} $data{$time}; } close $outfh; return; } #/**---------------------------------------------------------------------- # @sub sortOpnGps # # Sort high rate data into the correct order after BJfmtl_cosmic # is called. Add headers and trailers. # # # @parameter $infile Input file in opnGps format, but out of order and # @ with no headers/trailers. # @ $outfile Output sorted file. # @return none # @exception Will toss an exception in case of real trouble. # ----------------------------------------------------------------------*/ sub sortOpnGps { my $infile = shift; my $outfile = shift; my $opt = shift || {}; my $version = defined($opt->{VERSION}) ? $opt->{VERSION} : 1; # default to open loop format my $accept_odd_rates = $opt->{ODD_RATES}; open (IN, $infile) || die "Cannot open $infile"; my %data = (); # ## Read in data and stash in a hash by PRN and time # my $hrlen = ($version == 1) ? 36 # open loop : ($version == 2) ? 24 # closed loop : ($version == 3) ? 48 # l2c open loop : 0; die "bad version number: $version" if ($hrlen == 0); my $hdrlen = ($version == 3) ? 28 # l2c open loop : 20; while (1) { read (IN, my $hdr = '', $hdrlen) or last; my ($rate, $prn, $t) = unpack ('SSL', $hdr); my $nok = $accept_odd_rates ? ($prn < 1 || $prn > 32 || $t < 1) : ($rate < 46 || $rate > 52 || $prn < 1 || $prn > 32 || $t < 1); die "Bad rate, prn or time: $rate, $prn, $t" if ($nok); read (IN, my $hr = '', $rate * $hrlen) or last; $data{$prn}{$t} = $hdr . $hr; } close (IN); # ## Print data to output file sorted by PRN and time. ## Keep track of byte offsets of beginning of each PRN section # my @offsets = (-1) x 33; my $byteCount = 0; open (OUT, ">$outfile") || die "Cannot open $outfile for writing"; foreach my $prn (1..32) { $offsets[$prn] = (exists $data{$prn}) ? $byteCount : 0; foreach my $time (sort { $a <=> $b } keys %{$data{$prn}}) { print OUT $data{$prn}{$time}; $byteCount += length($data{$prn}{$time}); } } # Append PRN index block to end of opnGps file print OUT pack ("l" x 32, @offsets[1..32]); # Append Trailer block describing version and column layout # Version 1, high rate data in "fddSSdf" format, one second data in "SSLdCCCC" format # (see perldoc -f pack) if ($version == 1) { print OUT pack ("Ca31a32", 1, "fddSSdf", "SSLdCCCC"); # 64 bytes of trailer } elsif ($version == 2) { # closed loop data (no CAmodel or dfaz information) print OUT pack ("Ca31a32", 2, "fddSS", "SSLdCCCC"); # 64 bytes of trailer } elsif ($version == 3) { # L2C open loop data (P2 range, P2 phase model and P2 delta phase included) print OUT pack ("Ca31a32", 3, "fddSSdfdf", "SSLdCCCCd"); # 64 bytes of trailer } close OUT; return; } #/**---------------------------------------------------------------------- # @sub splitLRdata_merge # # Split one ASCII low rate data file from BJfmtl into separate files based # on the 4th column in the file, the antenna index. # # This routine attempts to merge tracks of all kinds (all different sorts of # 'trkstatus' indicators) into one track with a minimum of jumps. This # is necessary for COSMIC when operating with only one POD antenna. # # @parameter $infile Input low rate file # @return @lrfiles A list of the low rate files created # @ (in the current working directory) # @exception Will toss an exception in case of real trouble. # ----------------------------------------------------------------------*/ sub splitLRdata_merge { my $infile = shift; open (IN, $infile) || die "Cannot open $infile for reading!"; my @outFiles = (); my %data = (); # ## Store all lines in a hash by $antidx, $time, $prn and $trkstatus. ## This will get rid of normal 'double dump' duplicates # while () { next unless (/OBSD/); my ($time, $prn, $antidx, $trkstatus) = (split(' '))[0,2,3,-2]; $antidx = hex($antidx); # this is output as a hex string in BJfmtl*.c. D. Hunt 10.22.2005 next unless ($antidx =~ /^\d+$/); $prn = substr($prn, 3, 2); $data{$antidx}{$time}{$prn}{$trkstatus} = $_; } close IN; # ## Split the data into separate files by antenna index, sorted by time and prn. # my %last_trkstatus = (); # $last_trkstatus{$antidx}{$prn} foreach my $antidx (sort keys %data) { my $fn = sprintf("$infile%02d", $antidx); push (@outFiles, $fn); my @times = sort keys %{$data{$antidx}}; open my $fh, '>', $fn || die "Cannot open $fn for writing"; foreach my $time (@times) { foreach my $prn (sort keys %{$data{$antidx}{$time}}) { # Sometimes there are more than one entry for a given $antidx, $prn and $time # This is the case when the default POD has been switched to the fore antenna # Decide which to use: # --If there is just one entry (the usual case) then use that # --If there is a recorded 'last status' entry for that prn and antidx, and # if that trkstatus is available for the current epoch, use it # --Otherwise, use the lowest track status (generally, we might see: # trkstatus = 1: POD track (low rate) # 2: Forward POD antenna track # 21: Reference Sat highrate data rising occ # 22: Reference Sat highrate data rising occ # D. Hunt 2/27/2009 my @trkstatus = sort keys %{$data{$antidx}{$time}{$prn}}; my $last_status = $last_trkstatus{$antidx}{$prn}; if (@trkstatus == 1) { print {$fh} $data{$antidx}{$time}{$prn}{$trkstatus[0]}; $last_trkstatus{$antidx}{$prn} = $trkstatus[0]; } elsif (defined($last_status) && defined($data{$antidx}{$time}{$prn}{$last_status})) { print {$fh} $data{$antidx}{$time}{$prn}{$last_status}; $last_trkstatus{$antidx}{$prn} = $last_status; } else { print {$fh} $data{$antidx}{$time}{$prn}{$trkstatus[0]}; $last_trkstatus{$antidx}{$prn} = $trkstatus[0]; } } } close $fh; } return (@outFiles); } #/**---------------------------------------------------------------------- # @sub logData # # Fetch LOG data from a BJfmtl ASCII output file # # @parameter $infile Input ASCII file. # @return $string Scalar variable containing all log messages # @exception Will toss an exception in case of real trouble. # ----------------------------------------------------------------------*/ sub logData { my $infile = shift; my $string = ''; open my $fh, '<', $infile or die "Cannot open input file $infile"; while (<$fh>) { $string .= $_ if (/log\>/); # Check for SOH packet types, include in log file $string .= $_ if (/cmdr\>/); $string .= $_ if (/fdir\>/); $string .= $_ if (/trkd\>/); $string .= $_ if (/opar\>/); $string .= $_ if (/antc\>/); # Now include full navigation solution in goxSOH files record D. Hunt 5/2/2006 $string .= $_ if (/NAVG/); } close $fh; return $string; } #/**---------------------------------------------------------------------- # @sub scinData # # Pull scintillation data from the BJfmtl_cosmic output file. # These are the SCIN records: # # gpsseconds SCIN prn antenna_index_hex ca_snr scin # # @parameter $infile Input ASCII file. # @return %scindata hash by antenna id: # @ $scindata{antid}{time}{prn}[CAsnr, SCIN] # @exception Should handle all exceptions and return an empty hash # ----------------------------------------------------------------------*/ sub scinData { my $infile = shift; my %scindata = (); open (my $IN, '<', $infile) or return %scindata; while (<$IN>) { next unless (/SCIN/); my ($time, $prn, $antid, $casnr, $scin) = (split)[0,2,3,4,5]; next unless (defined($scin) && defined($antid) && ($antid =~ /^0[0123]$/)); $antid += 0; # canonicalize $scindata{$antid}{$time}{$prn} = [$casnr, $scin]; } close $IN; return %scindata; } #/**---------------------------------------------------------------------- # @sub un_escape_packet # # Perform Turbo Rogue un-escaping on the input packet. # The user might also pass in an offset of a bad byte into the # packet. Return the offset of the same byte after un-escaping. # # @parameter $packet -- Binary packet, not including the 0x02 delimiter # @ $bad_byte_offset -- The offset to the first bad byte (which # @ should be a NULL. Will be undef if no offset # @ computation is required. # @see BlackJack_Data_Link_Protocol_Interface_and_Implementation_Description_JPL-D-20675.pdf # @return $un_escaped, $new_offset # @exception Will toss an exception in case of real trouble. # ----------------------------------------------------------------------*/ sub un_escape_packet { my $packet = shift; my $bad_offset = shift; # Find positions of 0x10,0x4F and 0x10,0x45 my $twoEsc = pack ("CC", 0x10,0x4F); my $two = pack ("C", 0x02); my $tenEsc = pack ("CC", 0x10,0x45); my $ten = pack ("C", 0x10); if (defined($bad_offset)) { my $before_bad = substr ($packet, 0, $bad_offset); my $after_bad = substr ($packet, $bad_offset); $before_bad =~ s/$twoEsc/$two/gsm; $before_bad =~ s/$tenEsc/$ten/gsm; $bad_offset = length($before_bad); $after_bad =~ s/$twoEsc/$two/gsm; $after_bad =~ s/$tenEsc/$ten/gsm; $packet = $before_bad . $after_bad; } else { $packet =~ s/$twoEsc/$two/gsm; $packet =~ s/$tenEsc/$ten/gsm; } return wantarray ? ($packet, $bad_offset) : $packet; } #/**---------------------------------------------------------------------- # @sub escape_packet # # Perform Turbo Rogue escaping on the input packet. # # @parameter $packet -- Binary packet, not including the 0x02 delimiter # @see BlackJack_Data_Link_Protocol_Interface_and_Implementation_Description_JPL-D-20675.pdf # @return $escaped # @exception Will toss an exception in case of real trouble. # ----------------------------------------------------------------------*/ sub escape_packet { my $packet = shift; # Find positions of 0x10,0x4F and 0x10,0x45 my $twoEsc = pack ("CC", 0x10,0x4F); my $two = pack ("C", 0x02); my $tenEsc = pack ("CC", 0x10,0x45); my $ten = pack ("C", 0x10); $packet =~ s/$ten/$tenEsc/gsm; $packet =~ s/$two/$twoEsc/gsm; return $packet; } #/**---------------------------------------------------------------------- # @sub unwrap_headers # # Remove ground station and spacecraft headers from the COSMIC-2 input data file. # Return the instrument data in a perl scalar. # # @parameter $infile Input wrapped VC file # @opt @opt Options hash: default = (CORTEX => 1, SPACECRAFT => 1) # @return $unwrapped Unwrapped instrument data # @exception If there is a problem... # ----------------------------------------------------------------------*/ sub unwrap_headers { my $infile = shift; # Default to unpacking both CORTEX (ground station) and spacecraft headers my %opt = (CORTEX => 1, SPACECRAFT => 1, IP_UDP => 0, VERBOSE => 0, STATS => 0, NULLFILL => 0, @_); my %statistics; # place to keep output file statistics $statistics{RSFAIL} = 0; $statistics{MIU_GAP} = 0; # for compatibility with COSMIC-1 $statistics{SSR_GAP} = 0; # for compatibility with COSMIC-1 my $framelen = 1105; # VC data my $pri_hdr_len = 6; # spacecraft hdr my $ops_cntl_len = 4; # spacecraft trailer (unknown content) my $rs_len = 160; # Reed-Solomon check data len my $asm = pack ("N", 0x1ACFFC1D); # ASM bytes my $asm_len = 4; my $cortex_sync = pack ("N", 1234567890); # sync pattern at start of cortex header my $cortex_len = 64; # length of cortex header my $cortex_tlen = 4; # length of cortex trailer my $cortex_trail = pack ("l>", -1234567890); # cortex trailer # Size of one spacecraft frame, less the ground station (CORTEX) wrapper my $sc_frame_len = $asm_len + $pri_hdr_len + $framelen + $ops_cntl_len + $rs_len; # The spacecraft frame must be padded to be an even multiple of 4 if CORTEX wrappers are used my $padlen = $opt{CORTEX} ? 4*(ceil($sc_frame_len/4) - $sc_frame_len/4)->sclr : 0; $sc_frame_len += $padlen; my $filetext; if (ref($infile) eq 'SCALAR') { $filetext = $infile; # caller passed in a reference to file contents } elsif ($infile =~ /\.gz$/) { # If infile is gzipped, unzip it here my $buf = `gunzip -c $infile`; $filetext = \$buf; } else { # Otherwise use the fast perl slurper. my $buf; File::Slurp::read_file( $infile, buf_ref => \$buf ); $filetext = \$buf; # need to pass out $filetext as a reference to a scalar, not a scalar. D. Hunt 2/19/2014 } my $unwrapped; # data to pass back # The data are now in $$filetext... my $pkt_cnt = 0; my ($leoid, $vcid, $mcfc, $vcfc); my $last_vcfc; FRAME: while (1) { # suspicious Jun last if (length($$filetext) <= $sc_frame_len); eval { if ($opt{CORTEX}) { # search for CORTEX header my $found = ($$filetext =~ m{ $cortex_sync # sync word }msgx); last FRAME if (!$found); my $current_position = pos($$filetext); substr($$filetext, 0, $current_position-4, ''); my $cortex_hdr = substr($$filetext, 0, $cortex_len, ''); die "Bad cortex header, no sync word found" if (substr ($cortex_hdr, 0, 4) ne $cortex_sync); } # search for ASM word my $found = ($$filetext =~ m{ $asm # sync word }msgx); last FRAME if (!$found); my $current_position = pos($$filetext); substr($$filetext, 0, $current_position-4, ''); my $asm_read = substr($$filetext, 0, $asm_len, ''); die "Bad ASM word" if ($asm_read ne $asm); # Convert 48 bit primary header to string of ASCII 0s and 1s, then pull out the 10 bit spacecraft ID and # the 3 bit virtual channel ID. my $pri_hdr = substr($$filetext, 0, $pri_hdr_len, ''); ($leoid, $vcid, $mcfc, $vcfc) = map { oct "0b$_" } unpack ("x2 a10 a3 x a8 a8", unpack ("B*", $pri_hdr)); $leoid -= 0x370; # now should be 1-6 die "LEO ID incorrect: $leoid. Should be 1-6" if ($leoid < 1 || $leoid > 6); die "VC ID incorrect: $vcid. Should be 0-5" if ($vcid < 0 || $vcid > 5); $statistics{FM}{"FM$leoid"}++; $statistics{UNIQUE_FRAMES}{$vcid}++; print "LEO ID = $leoid, VC ID = $vcid, Master channel frame cnt = $mcfc, Virt. chan. frame cnt = $vcfc\n" if ($opt{VERBOSE}); # If requested (opt = NULLFILL) then attempt to fill in missing frames with the correct # number of NULLs. The frame length computation is not correct for the end of an IP/UDP # file, but should work for most dropped frames. if ($opt{NULLFILL} && defined($last_vcfc) && ($vcfc != ($last_vcfc+1) % 256)) { # Compute difference between this counter and the last one, taking # into account the possibility of a wrap-around my $del = pdl($vcfc - $last_vcfc, $vcfc - $last_vcfc + 255)->min; $del = 1 if ($del < 1 || $del > 127); # be careful not to add too many null frames print "Frame missing before FM$leoid, VC$vcid, MCFC$mcfc, VCFC$vcfc. Last frame = $last_vcfc. Filling in ",$del-1, " null frame(s).\n"; # This is the nominal frame size with IP/UDP headers removed. # This will not work if the dropped frame is at the end of an IP/UDP file. $unwrapped .= "\0" x (1059 * ($del-1)); } $last_vcfc = $vcfc; my $frame = substr ($$filetext, 0, $framelen, ''); my $ops_cntl = substr ($$filetext, 0, $ops_cntl_len, ''); my $rs = substr ($$filetext, 0, $rs_len, ''); # Compute Reed-Solomon check data for this primary header, frame, and ops_cntl bytes my $computed_rs = "\x00" x $rs_len; RSTools::encode_interleaved($pri_hdr . $frame . $ops_cntl, $computed_rs); if ($rs ne $computed_rs) { $statistics{RSFAIL}++; # For applications that must be kept in rigorous sync, such as IVM (VC3) and S/C SOH (VC5) # we leave the bad frame in place to minimize implact on parsing later on. D. Hunt 8/1/2019 if ($opt{NULLFILL}) { print "Bad Reed-Solomon check word for FM$leoid, VC$vcid, MCFC$mcfc, VCFC$vcfc, continuing...\n"; } else { die "Bad Reed-Solomon check word for FM$leoid, VC$vcid, MCFC$mcfc, VCFC$vcfc, skipping..."; } } substr($$filetext, 0, $padlen, ''); # skip the pad! if ($opt{CORTEX}) { my $cortex_trail_read = substr ($$filetext, 0, $cortex_tlen, ''); die "Bad cortex trailer" if ($cortex_trail_read ne $cortex_trail); } # If requested, get rid of the new IP and UDP headers that NSPO is adding unwrap_IP_UDP (\$frame, $opt{VERBOSE}, \$statistics{TIMES}) if ($opt{IP_UDP}); $unwrapped .= $frame; $pkt_cnt++; }; if ($@) { chomp($@); print "Could not parse frame $pkt_cnt, $leoid, $vcid, $mcfc, $vcfc: $@, skipping\n"; my $found = ($$filetext =~ /$cortex_sync/msg); last FRAME unless ($found); substr ($$filetext, 0, pos($$filetext)-4, ''); # get rid of un-matching portion, resync. } } $statistics{TOTAL_FRAMES} = $pkt_cnt; if ($opt{STATS}) { return \$unwrapped, \%statistics; } else { return \$unwrapped; } } #/**---------------------------------------------------------------------- # @sub unwrap_IP_UDP # # Remove the new IP and UDP headers that NSPO is now putting on all C-2 # VC data # # @parameter \$frame -- Reference to a frame containing IP and UDP headers to be unwrapped # @ $verbose -- 1, 0 or undef # @return \$frame unwrapped in place # @see FS7-RPT-0052 0100.docx (document from NSPO) # @exception If there is a problem... # ----------------------------------------------------------------------*/ sub unwrap_IP_UDP { my $frameref = shift; my $verbose = shift; my $times = shift; my $packet_hdr_len = 6; my $ip_hdr_len = 20; my $udp_hdr_len = 8; my $udp_data_hdr = 12; # bytes at start of UDP data packet my $udp_metadata_hdr = 22; # bytes in UDP metadata header (plus file name at end) # Unpack and get rid of packet primary header (note that this is different from the 'primary header'!) my $bits = unpack ("B*", substr ($$frameref, 0, $packet_hdr_len, '')); my ($PH_apid, $PH_pl) = map { bin2dec($_) } unpack ("x5 a11 x16 a16", $bits); my $ip_hdr = substr ($$frameref, 0, $ip_hdr_len, ''); my $IP_pktlen = unpack ("n", substr ($ip_hdr, 2, 2)); my $udp_hdr = substr ($$frameref, 0, $udp_hdr_len, ''); # ignore this print "APID = $PH_apid, PH length = $PH_pl, IP length = $IP_pktlen\n" if ($verbose); if ($PH_apid == 0x722) { # metadata packet my ($UDP_sessid, $UDP_filesize, $UDP_filemodtime, $UDP_filecreationtime) = unpack ("x4 N x2 N N N", substr($$frameref, 0, $udp_metadata_hdr, '')); my ($UDP_filename) = ($$frameref =~ /([\w\.]*)\0/); my ($unix_time) = ($UDP_filename =~ /\_(\d+)\.bin/); # Pass out file name time stamp in GPS seconds. Turn off leap second conversion first. my $sav = $TimeClass::ignore_leapsec; $TimeClass::ignore_leapsec = 1; push (@$$times, TimeClass->new->set_unix($unix_time)->get_gps); $TimeClass::ignore_leapsec = $sav; print "UDP sessid = $UDP_sessid, UDP filesize = $UDP_filesize, UDP modtime = $UDP_filemodtime, UDP creation time = $UDP_filecreationtime, UDP filename = $UDP_filename\n" if ($verbose); $$frameref = ''; # return null frame } elsif ($PH_apid == 0x723) { # data packet my ($UDP_sessid, $UDP_offset) = unpack ("x4 N N", substr ($$frameref, 0, $udp_data_hdr, '')); print "UDP sessid = $UDP_sessid, UDP offset = $UDP_offset\n" if ($verbose); my $data_len = $IP_pktlen - $ip_hdr_len - $udp_hdr_len - $udp_data_hdr; # nominally 1059 bytes $$frameref = substr ($$frameref, 0, $data_len) if (length($$frameref) != $data_len); # return data only } else { die "Unrecognized APID = $PH_apid"; } } #/**---------------------------------------------------------------------- # @sub make_IPUDP_hdr # # Create IP and UDP headers for the input frame # # @parameter $$frame -- Frame reference: Add headers on to this # @ $firstlast -- 'F' if this is the first frame, 'L' if the last frame, '' if an intermediate frame # @ $hdr_info -- Reference to hash of info and counters to for IP and UDP headers # @ $opt -- Options hash: Currently defined: {IPHDR_TIME => [first, last] times in gps seconds for IP header} # @return None. # @see FS7-RPT-0052 0100.docx (document from NSPO) # @exception If there is a problem... # ----------------------------------------------------------------------*/ sub make_IPUDP_hdr { my $frameref = shift; my $firstlast = shift; my $hdr_info = shift; my $opt = shift // {}; my $packet_hdr_len = 6; my $ip_hdr_len = 20; my $udp_hdr_len = 8; my $udp_data_hdr = 12; # bytes at start of UDP data packet my $udp_metadata_hdr = 22; # bytes in UDP metadata header (plus file name at end) my $nominal_data_len = 1059; # normal length of data to frame (may be shorter for last packet) my $nominal_frame_len = 1105; # length of frame returned $hdr_info->{SESS_ID} //= int(rand(2**32-1)); # random session ID # On the first or last packet, write a metadata packet with extra info. These are not filled with # real data, but with a fill character ('U') if ($firstlast) { my $filetime = (defined($opt->{IPHDR_TIME}) && ($firstlast eq 'F')) ? TimeClass->new->set_gps($opt->{IPHDR_TIME}[0])->get_unix : (defined($opt->{IPHDR_TIME}) && ($firstlast eq 'L')) ? TimeClass->new->set_gps($opt->{IPHDR_TIME}[1])->get_unix : TimeClass->new->now->get_unix; my $file_name = $hdr_info->{FILE_PREFIX} . '_' . $filetime . '.bin'; my $apid = 0x722; # The pph_len includes $ip_hdr_len + $udp_hdr_len + $udp_metadata_hdr (50 bytes) # plus the length of the file name (no null included) -- 19 bytes my $pph_len = $ip_hdr_len + $udp_hdr_len + $udp_metadata_hdr + length($file_name); my $pkt_pri_hdr = pack "(SCCS)>", $apid, 0, 0, $pph_len; my $ip_hdr = pack ("(SS)>", 0, $pph_len+1) . "\x0" x 16; # add one to length for trailing null my $udp_hdr = "\x0" x $udp_hdr_len; # We ignore this my $udp_metadata_hdr = pack ("(LLSLLL)>", 0, $hdr_info->{SESS_ID}, 0, $hdr_info->{FILE_SIZE}, $filetime, $filetime) . $file_name . "\x0"; my $hdr_len = $packet_hdr_len + $ip_hdr_len + $udp_hdr_len + length($udp_metadata_hdr); # Add headers $$frameref = $pkt_pri_hdr . $ip_hdr . $udp_hdr . $udp_metadata_hdr . $$frameref; # Truncate to normal full frame length substr ($$frameref, $nominal_frame_len-1, -1, ''); } else { # Write a normal packet my $apid = 0x723; my $ip_len = length($$frameref) + $ip_hdr_len + $udp_hdr_len + $udp_data_hdr; my $pph_len = $ip_len - 1; # Not sure why -1 my $pkt_pri_hdr = pack "(SCCS)>", $apid, 0, 0, $pph_len; my $ip_hdr = pack ("(SS)>", 0, $ip_len) . "\x0" x 16; my $udp_hdr = "\x0" x 8; # We ignore this my $udp_offset = $hdr_info->{UDP_OFFSET} // 0; # Use existing offset or zero if first data pkt my $udp_data_hdr = pack ("(CCCCLL)>", 0x23, 0, 0, 0, $hdr_info->{SESS_ID}, $udp_offset); $hdr_info->{UDP_OFFSET} += length($$frameref); # Update offset # Add padding to get the frame up to 1059 bytes (for last packet) my $padlen = $nominal_data_len - length($$frameref); $$frameref .= ('U' x $padlen) if ($padlen); # Add headers to frame $$frameref = $pkt_pri_hdr . $ip_hdr . $udp_hdr . $udp_data_hdr . $$frameref; } return; } #/**---------------------------------------------------------------------- # @sub bin2dec # # Convert an arbitrary length (<= 32 bits long) binary number to a normal # perl value. # Input: '100110' # Output: 38 # # @parameter $bits ASCII string of 0s and 1s <= 32 characters in length # @return decimal value of $bits # @exception Will toss an exception in case of real trouble. # ----------------------------------------------------------------------*/ sub bin2dec { return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); } # Use for debug, causes a re-compile each time, and sets -g for debugging #use Inline 'Info', 'Force', 'Noclean'; #use Inline 'C' => Config => INC => '-I/ops/tools/include', OPTIMIZE => '-g'; use Inline 'C' => Config => INC => '-I.'; use Inline 'C' => <<'END_C'; /* Table for checksum arithmetic */ /* CRC-16 constant array... from Usenet contribution by Mark G. Mendel, Network Systems Corp. (ihnp4!umn-cs!hyper!mark) */ unsigned short Table[] = { 0x0000, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7, 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef, 0x1231, 0x0210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6, 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de, 0x2462, 0x3443, 0x0420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485, 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d, 0x3653, 0x2672, 0x1611, 0x0630, 0x76d7, 0x66f6, 0x5695, 0x46b4, 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc, 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x0840, 0x1861, 0x2802, 0x3823, 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b, 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0x0a50, 0x3a33, 0x2a12, 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a, 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0x0c60, 0x1c41, 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49, 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0x0e70, 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78, 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f, 0x1080, 0x00a1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067, 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e, 0x02b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256, 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d, 0x34e2, 0x24c3, 0x14a0, 0x0481, 0x7466, 0x6447, 0x5424, 0x4405, 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c, 0x26d3, 0x36f2, 0x0691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634, 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab, 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x08e1, 0x3882, 0x28a3, 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a, 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0x0af1, 0x1ad0, 0x2ab3, 0x3a92, 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9, 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0x0cc1, 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8, 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0x0ed1, 0x1ef0 }; /**---------------------------------------------------------------------- * @sub checkCRC * * A small C program to handle the CRC check for Turbo Rogue packets. * * @parameter char *packet One Turbo Rogue packet, not including the 0x02 * @ delimiter, but including the CRC as the last two bytes * @ int pkt_len The number of bytes in the above packet * @return 1 => CRC checks, 0 = CRC fails * ----------------------------------------------------------------------*/ // Compute the CRC of the packet (up to the last two bytes) // and compare that with the CRC in the packet (the last two bytes) int checkCRC (char *packet, int pkt_size) { unsigned short *pTable = Table; unsigned short chksum = 0; unsigned short chk; int i; unsigned char b; for (i=0;i> 8) ^ ((unsigned short)(b))]; } // Put CRC (last two bytes of packet) in chk // Note this is done out of order! This only works on little-endian machines! *((char*)(&chk)) = packet[i+1]; *((char*)(&chk) + 1) = packet[i]; // printf ("CRC: computed = %x, in packet = %x\n", chksum, chk); return (chksum == chk); } END_C #use Inline 'Info', 'Force', 'Noclean'; #use Inline 'Pdlpp' => Config => # INC => "-I/ops/tools/include", # OPTIMIZE => '-g'; use Inline 'Pdlpp' => Config => INC => '-I.'; use Inline 'Pdlpp' => <<'END_PDL'; pp_addhdr(<<'EOH'); /*---------------------------------------------------------------------- * @sub fixwrap * * Try to fix 'wrapping' in P2 phase residuals. These residuals * fit in a signed short, are in units of L2 cycles and are scaled by 8192. * So the dynamic range is -4 to +4 L2 cycles. * * The residuals in the center (dt closest to 0) should be small. * * The algorithm is to start in the center, and work both left and right. * If at any point the distance between two neighbors would be decreased by either * adding 64K or subtracting 64K, then make this fix. * * @parameter dt array of time deltas, either evenly spaced (closed loop) or irregular (open loop) * @ Rrate data rate in Hz (generally 50) * @ Res P2 phase structure * @ outRes Array of doubles--fixed P2 phase residuals * @return rc 0 for no wrap detected, 1 to 4 for wrap detected + ?fixed * @ if non-zero, this shows maximum wrap number found * ----------------------------------------------------------------------*/ int fixwrap (double *dt, short *inRes, int Rrate, double *outRes) { int i, jwrap, minidx, minjwrap; double mindel; double mindt = 9999.0; int wrap_fixed = 0; int nwrap = 10; // fix plus or minus 10 multiples of 2**16 (65536) double del; // printf ("dt[0] = %lf, inRes[0] = %d, Rrate = %d, outRes[0] = %lf\n", dt[0], inRes[0], Rrate, outRes[0]); // Copy residuals into output array as doubles for (i=0; i0; i--) { minjwrap = 0; mindel = 99e99; for (jwrap=-nwrap; jwrap<=nwrap; jwrap++) { del = fabs(outRes[i] - (outRes[i-1] + (jwrap * 65536))); if (del < mindel) { minjwrap = jwrap; mindel = del; } } outRes[i-1] += (minjwrap * 65536); } // Return largest multiple wrap applied // printf ("minjwrap = %d\n", minjwrap); return abs(minjwrap) > wrap_fixed ? abs(minjwrap) : wrap_fixed; } EOH pp_def('fixwrap', Pars => 'double dt(n); short inRes(n); double [o]outRes(n)', Code => 'fixwrap ($P(dt), $P(inRes), $SIZE(n), $P(outRes));'); END_PDL 1;