lustre/utils/Pack.pm

   1 package Pack;
   2 use Carp;
   3 use Exporter;
   4 @EXPORT = qw(LOGL, UNLOGL, LOGU32, UNLOGU32, LLOGU32, LUNLOGU32, LOGU64, UNLOGU64, LLOGU64, LUNLOGU64);
   5
   6 sub round_len {
   7     return ($_[0] + 3) & ~0x3;
   8 }
   9
  10 sub roundq_len {
  11     return ($_[0] + 3) & ~0x7;
  12 }
  13
  14 # pack a string $_[2]
  15 #  at $offset ($_[1])
  16 #  in $buf ($_[0])
  17 #  padd to 32bit alignment move $_[1] forward
  18
  19 sub LOGL{
  20     my $len = length($_[2]);
  21     my $rlen = round_len($len);
  22     my $padd = $rlen + $off - length($_[0]);
  23
  24     if ($padd > 0) {
  25         $_[0] .= pack "x$padd";
  26     }
  27     substr $_[0], $_[1], $len, $_[2];
  28     $_[1] += $rlen;
  29 }
  30
  31 # pack $_[2], a u32, into $_[0] at offset $_[1]
  32 sub LOGU32 {
  33     if ($_[1] != round_len($_[1])) {
  34         confess "packing I on non-word boundary";
  35     }
  36     my $padd = 4 + $off - length($_[0]);
  37
  38     if ($padd > 0) {
  39         $_[0] .= pack "L", $_[2];
  40     } else {
  41         substr $_[0], $_[1], $len, pack "L", $_[2];
  42     }
  43     $_[1] += 4;
  44 }
  45
  46 # pack $_[2], a u32, into $_[0] at offset $_[1]
  47 # use little endian
  48 sub LLOGU32 {
  49     if ($_[1] != round_len($_[1])) {
  50         confess "packing V on non-word boundary";
  51     }
  52     my $padd = 4 + $off - length($_[0]);
  53
  54     if ($padd > 0) {
  55         $_[0] .= pack "V", $_[2];
  56     } else {
  57         substr $_[0], $_[1], $len, pack "V", $_[2];
  58     }
  59     $_[1] += 4;
  60 }
  61
  62 sub LLOGU64 {
  63     if ($_[1] != roundq_len($_[1])) {
  64         confess "packing Q on non-word boundary";
  65     }
  66     my $padd = 8 + $off - length($_[0]);
  67
  68     if ($padd > 0) {
  69         $_[0] .= pack "VV", $_[3], $_[2];
  70     } else {
  71         substr $_[0], $_[1], $len, pack "VV", $_[3], $_[2];
  72     }
  73     $_[1] += 8;
  74 }
  75
  76 sub LLOGU64 {
  77     if ($_[1] != roundq_len($_[1])) {
  78         confess "packing Q on non-word boundary";
  79     }
  80     my $padd = 8 + $off - length($_[0]);
  81
  82     if ($padd > 0) {
  83         $_[0] .= pack "LL", $_[3], $_[2];
  84     } else {
  85         substr $_[0], $_[1], $len, pack "LL", $_[3], $_[2];
  86     }
  87     $_[1] += 8;
  88 }
  89
  90 sub UNLOGL {
  91     if (length($_[0]) < $_[1] + round_len($_[2]) ) {
  92         confess "unpacking buf beyond string length";
  93     }
  94
  95     $_[3] = unpack "x$_[1]a$_[2]", $_[0];
  96     $_[1] += round_len($_[2]);
  97     return $_[3];
  98 }
  99
 100 sub UNLOGU32 {
 101     if (length($_[0]) < $_[1] + 4) {
 102         confess "unpacking u32 beyond string length";
 103     }
 104
 105     $_[2] = unpack "x$_[1]L", $_[0];
 106     $_[1] += 4;
 107     return $_[2];
 108 }
 109
 110 sub LUNLOGU32 {
 111     if (length($_[0]) < $_[1] + 4) {
 112         confess "lunpacking u32 beyond string length";
 113     }
 114     $_[2] = unpack "x$_[1]V", $_[0];
 115     $_[1] += 4;
 116     return $_[2];
 117 }
 118
 119 sub UNLOGU64 {
 120     if (length($_[0]) < $_[1] + 8) {
 121         confess "unpacking u64 beyond string length";
 122     }
 123
 124     ($_[3], $_[2]) = unpack "x$_[1]LL", $_[0];
 125     $_[1] += 8;
 126     return ($_[2], $_[3]);
 127 }
 128
 129 sub LUNLOGU64 {
 130     if (length($_[0]) < $_[1] + 8) {
 131         confess "lunpacking u64 beyond string length";
 132     }
 133
 134     ($_[3], $_[2]) = unpack "x$_[1]VV", $_[0];
 135     $_[1] += 8;
 136     return ($_[2], $_[3]);
 137 }
 138
 139 sub test {
 140     $buf = "";
 141     $off = 0;
 142
 143     LOGL($buf, $off, "moose");
 144     print "off $off\n";
 145     printf "len %d\n", length($buf);
 146     LLOGU64($buf, $off, 0x01020304, 0x05060708);
 147     print "off $off\n";
 148     printf "len %d\n", length($buf);
 149     LLOGU32($buf, $off, 0x01020304);
 150     print "off $off\n";
 151     printf "len %d\n", length($buf);
 152     $off = 0;
 153     UNLOGL($buf, $off, length("moose"), $str);
 154     print "off $off $str\n";
 155     LUNLOGU64($buf, $off, $high, $low);
 156     printf "off $off high %x low %x\n", $high, $low;
 157     LUNLOGU32($buf, $off, $low);
 158     printf "off $off long %x\n", $low;
 159
 160     $off = 0;
 161     $str = UNLOGL($buf, $off, length("moose"));
 162     print "assigned off $off $str\n";
 163     ($high, $low) = LUNLOGU64($buf, $off);
 164     printf "assigned off $off high %x low %x\n", $high, $low;
 165     $low = LUNLOGU32($buf, $off, $low);
 166     printf "assigned off $off long %x\n", $low;
 167
 168     sysopen F, "/tmp/out", 2;
 169     syswrite F, $buf, length($buf);
 170 }
 171
 172 # test();