kerneltest/e32utils/hcrscripts/hcrrec.pm
branchanywhere
changeset 20 d63d727ee0a6
parent 19 f6d3d9676ee4
parent 16 6d8ad5bee44b
child 21 af091391d962
equal deleted inserted replaced
19:f6d3d9676ee4 20:d63d727ee0a6
     1 #!perl -w
       
     2 #
       
     3 # Copyright (c) 2009 Nokia Corporation and/or its subsidiary(-ies).
       
     4 # All rights reserved.
       
     5 # This component and the accompanying materials are made available
       
     6 # under the terms of the License "Eclipse Public License v1.0"
       
     7 # which accompanies this distribution, and is available
       
     8 # at the URL "http://www.eclipse.org/legal/epl-v10.html".
       
     9 #
       
    10 # Initial Contributors:
       
    11 # Nokia Corporation - initial contribution.
       
    12 #
       
    13 # Contributors:
       
    14 #
       
    15 # Description:
       
    16 #
       
    17 use strict;
       
    18 
       
    19 #
       
    20 # A simple class to manage feature flags for a feature set data file.
       
    21 #
       
    22 package HCRrec;
       
    23 
       
    24 my %typemap = (
       
    25     Int32 =>       0x00000001,
       
    26     Int16 =>       0x00000002,    
       
    27     Int8 =>        0x00000004,
       
    28     Bool =>        0x00000008,    
       
    29     UInt32 =>      0x00000010,
       
    30     UInt16 =>      0x00000020,    
       
    31     UInt8 =>       0x00000040,
       
    32     LinAddr =>     0x00000100,
       
    33     BinData =>     0x00010000,
       
    34     Text8 =>       0x00020000,    
       
    35 	ArrayInt32 =>  0x00040000,
       
    36 	ArrayUInt32 => 0x00080000,
       
    37     Int64 =>       0x01000000,
       
    38     UInt64 =>      0x02000000,    
       
    39 );
       
    40 my %maptype = reverse %typemap;
       
    41 my %lsdtype2packmap = (
       
    42     0x00010000 => "C",
       
    43     0x00020000 => "a",    
       
    44     0x01000000 => "C",
       
    45     0x02000000 => "C",    
       
    46 );
       
    47 
       
    48 # Create a feature flag object.
       
    49 sub new
       
    50 {
       
    51 	my $arg = shift;
       
    52 	my $class = ref($arg) || $arg;
       
    53 
       
    54 	my $self = {
       
    55 			     cuid => 0,              # 4 bytes
       
    56 			     eid => 0,               # 4 bytes
       
    57 			     type => 0,              # 4 bytes
       
    58 			     flagword => 0x0000,     # 2 bytes 
       
    59                  valueset => 0,
       
    60                            
       
    61 			     intvalue => 0,           # 4 bytes
       
    62 			     strvalue => "",          # array of chars
       
    63 			     binvalue => [],          # array of bytes
       
    64 			     arrvalue => [],		  # array of 4 byte integers
       
    65 			     
       
    66    				 endian => "LE",
       
    67 			   };
       
    68  
       
    69 	bless $self, $class;
       
    70 	return $self;
       
    71 }
       
    72 
       
    73 sub Endian
       
    74 {
       
    75 	my $self = shift;
       
    76 	return undef unless(ref($self));
       
    77 	my $arg = shift;
       
    78 	return $self->{endian} unless(defined($arg) and $arg =~ m/(^BE$|^LE$)/i);
       
    79 	$self->{endian} = lc($1);
       
    80 	return $self->{endian};
       
    81 }
       
    82 
       
    83 # Return a twelve byte string 'feature flag' information.
       
    84 sub GetRecHdrBinary
       
    85 {
       
    86 	my $self = shift;
       
    87 	return undef unless(ref($self));
       
    88 	
       
    89 	my $lsd_size = shift;
       
    90 	
       
    91 	my $stype = $self->Type(); 
       
    92 	my @hdrarr = ( $self->CUID(), $self->EID(), $stype, $self->Flags(),
       
    93                 $self->SizeInBytes() );
       
    94     
       
    95 	# Decide whether we want big or little endian output.
       
    96 	# According to the documentation, 'V', 'N' are GUARANTEED to be 32-bit.
       
    97 	my $packstring;
       
    98 	if($self->Endian() eq "BE") {
       
    99 	    $packstring = "N3n2N";
       
   100         }
       
   101     else {
       
   102         $packstring = "V3v2V"; # Little endian.
       
   103         }
       
   104         
       
   105     #
       
   106     # Could add range checks here for 8-bit and 16-bit types.
       
   107     # However would stop negative test cases from being generated.
       
   108     # Do it later.
       
   109     #
       
   110     
       
   111     if ($stype & 0xffff) {
       
   112         print "Writing integer\n" if ($mhd::otrace);
       
   113         push @hdrarr, $self->IntValue();
       
   114         }
       
   115     
       
   116     if ($stype & 0xffff0000) {
       
   117         if ($self->Length() > 0) {
       
   118             print "Writing offset: " . $lsd_size . "\n" if ($mhd::otrace);
       
   119             push @hdrarr, $lsd_size;
       
   120             }
       
   121         else {
       
   122             print "Writing null offset: 0\n" if ($mhd::otrace);
       
   123             push @hdrarr, 0;            
       
   124             }
       
   125         }
       
   126 
       
   127 	my $hdr_string = pack $packstring, @hdrarr;
       
   128 	
       
   129 	return $hdr_string;
       
   130 }
       
   131 
       
   132 # Return a twelve byte string 'feature flag' information.
       
   133 # Assumes Little Endian output!
       
   134 sub GetRecLsdBinary
       
   135 {
       
   136 	my $self = shift;
       
   137 	return undef unless(ref($self));
       
   138 	
       
   139     my $value = "";
       
   140     my $valuelen = $self->Length();
       
   141     my $vallen = $valuelen;
       
   142     #print "vallen before:" . $vallen . "\n";
       
   143     $vallen = ($valuelen+3)&0xfffc if ($valuelen%4) ;
       
   144     #print "vallen after:" . $vallen . "\n";
       
   145 	my $valtype = $self->{type};
       
   146 
       
   147     # String
       
   148     if ($valtype & 0x00020000) {
       
   149 	    my $packstr = $lsdtype2packmap{$valtype} . $vallen;
       
   150 	    printf ("packstr:%s\n", $packstr) if($mhd::otrace);
       
   151         printf ("strvalue:%s\n", $self->{strvalue}) if($mhd::otrace);
       
   152         $value = pack $packstr,  $self->{strvalue} ;
       
   153         }
       
   154     # Binary Data
       
   155     elsif ($valtype & 0x00010000) {
       
   156         for (my $c=0;  $c < $valuelen; $c++) {
       
   157             my $byte = $self->{binvalue}[$c];
       
   158             $value .= pack $lsdtype2packmap{$valtype}, $byte;
       
   159             $vallen--;     
       
   160         }
       
   161         while ($vallen > 0) {
       
   162             $value .= pack "C", ( 0x00 );
       
   163             $vallen--;
       
   164             }
       
   165     }
       
   166     # 64bit quantity
       
   167     elsif ($valtype & 0x03000000) {
       
   168         die "error: 64 bit integer missing hex binvalues\n" if (! exists $self->{binvalue}[7]);
       
   169         $value  = pack $lsdtype2packmap{$valtype}, $self->{binvalue}[0];
       
   170         $value  .= pack $lsdtype2packmap{$valtype}, $self->{binvalue}[1];
       
   171         $value  .= pack $lsdtype2packmap{$valtype}, $self->{binvalue}[2];
       
   172         $value  .= pack $lsdtype2packmap{$valtype}, $self->{binvalue}[3];
       
   173         $value  .= pack $lsdtype2packmap{$valtype}, $self->{binvalue}[4];
       
   174         $value  .= pack $lsdtype2packmap{$valtype}, $self->{binvalue}[5];
       
   175         $value  .= pack $lsdtype2packmap{$valtype}, $self->{binvalue}[6];
       
   176         $value  .= pack $lsdtype2packmap{$valtype}, $self->{binvalue}[7];
       
   177         }
       
   178     # array of 32bit quantity
       
   179     elsif ($valtype & 0x000C0000) {
       
   180         for (my $c=0;  $c < $valuelen; $c++) {
       
   181             my $int = $self->{arrvalue}[$c];
       
   182             $value .= pack "V", $int;
       
   183             $vallen--;     
       
   184             }
       
   185 	}    
       
   186     else {
       
   187         die "panic: proramming error!!";
       
   188     }
       
   189     
       
   190 	return $value;
       
   191 	}
       
   192 
       
   193 # A single 32-bit number.
       
   194 sub CUID
       
   195 {
       
   196 	my $self = shift;
       
   197 	return undef unless(ref($self));
       
   198 	my $uid = shift;
       
   199 	return $self->{cuid} unless(defined($uid));
       
   200 	my $uidv = hex($uid);
       
   201 	$self->{cuid} = $uidv;
       
   202 	return $uidv;
       
   203 }
       
   204 
       
   205 # A single 32-bit number.
       
   206 sub EID
       
   207 {
       
   208 	my $self = shift;
       
   209 	return undef unless(ref($self));
       
   210 	my $id = shift;
       
   211 	return $self->{eid} unless(defined($id));
       
   212 	my $idv = int($id);
       
   213 	$self->{eid} = $idv;
       
   214 	return $idv;
       
   215 }
       
   216 
       
   217 sub Type
       
   218 {
       
   219 	my $self = shift;
       
   220 	return undef unless(ref($self));
       
   221 	my $type = shift;
       
   222 	return $self->{type} unless(defined($type));
       
   223 	my $enum = $typemap{$type};
       
   224 	#print "--->Defined\n" if (defined $enum);
       
   225 	#print "--->NOT Defined\n" if (! defined $enum);
       
   226 	die "error: unknown setting type found in input file\n" if (! defined $enum);
       
   227    	$self->{type} = $enum;
       
   228 	return $enum;
       
   229 }
       
   230 
       
   231 sub TypeName
       
   232 {
       
   233 	my $self = shift;
       
   234 	return undef unless(ref($self));
       
   235 	return "Undefined Type" if (! exists $maptype{$self->{type}});
       
   236 	return $maptype{$self->{type}};
       
   237 }
       
   238 
       
   239 sub Flags
       
   240 {
       
   241 	my $self = shift;
       
   242 	return undef unless(ref($self));
       
   243 	my $flags = shift;
       
   244 	return $self->{flagword} unless(defined($flags));
       
   245 	my $vf = hex($flags);
       
   246 	$self->{flagword} = $vf;
       
   247 	return $vf;
       
   248 }
       
   249 
       
   250 sub Length
       
   251 {
       
   252 	my $self = shift;
       
   253 	return undef unless(ref($self));
       
   254 	my $len = shift;
       
   255 	die "panic: Length() does not take an argument!\n" if (defined($len));
       
   256 	
       
   257 	my $length = 0;
       
   258 	if ($self->{type} & 0x00020000) {
       
   259         $length = length ($self->{strvalue});
       
   260         }
       
   261     elsif ($self->{type} & 0x03010000) {
       
   262 	    my $array_ref = $self->{binvalue};
       
   263 	    my @array = @$array_ref;
       
   264 	    $length = $#array+1;
       
   265 	    }
       
   266     elsif ($self->{type} & 0x000C0000) {
       
   267 	    my $array_ref = $self->{arrvalue};
       
   268 	    my @array = @$array_ref;
       
   269 	    $length = $#array+1;
       
   270 	    #printf ("arrval length %d %d\n",  length ($self->{arrval}), $length);
       
   271 	    }
       
   272 	else {
       
   273 	    $length = 0;
       
   274         }
       
   275 	return $length;	
       
   276 }
       
   277 
       
   278 sub SizeInBytes
       
   279 {
       
   280 	my $self = shift;
       
   281 	return undef unless(ref($self));
       
   282 	my $len = shift;
       
   283 	die "panic: Length() does not take an argument!\n" if (defined($len));
       
   284 	
       
   285 	my $size = 0;
       
   286 	if ($self->{type} & 0x00020000) {
       
   287         $size = length ($self->{strvalue});
       
   288         }
       
   289     elsif ($self->{type} & 0x03010000) {
       
   290 	    my $array_ref = $self->{binvalue};
       
   291 	    my @array = @$array_ref;
       
   292 	    $size = $#array+1;
       
   293 	    }
       
   294     elsif ($self->{type} & 0x000C0000) {
       
   295 	    my $array_ref = $self->{arrvalue};
       
   296 	    my @array = @$array_ref;
       
   297 	    $size = ($#array+1)*4;
       
   298 	    #printf ("arrval length %d %d\n",  length ($self->{arrval}), $length);
       
   299 	    }
       
   300 	else {
       
   301 	    $size = 0;
       
   302         }
       
   303 	return $size;	
       
   304 }
       
   305 
       
   306 sub IsValid
       
   307 {
       
   308 	my $self = shift;
       
   309 	return undef unless(ref($self));
       
   310 
       
   311     if (($self->{cuid} == 0) || ($self->{eid} == 0) ||
       
   312         ($self->{type} == 0) || ($self->{flagword} != 0) ||
       
   313         ($self->IsValueSet() == 0)) {
       
   314         return 0;
       
   315         }    
       
   316     
       
   317     #Record valid if we reach here
       
   318     return 1;    
       
   319 }
       
   320 
       
   321 sub IsValueSet
       
   322 {
       
   323 	my $self = shift;
       
   324 	return undef unless(ref($self));
       
   325 	return $self->{valueset};
       
   326 }
       
   327 
       
   328 sub MarkValueSet
       
   329 {
       
   330 	my $self = shift;
       
   331 	return undef unless(ref($self));
       
   332 	$self->{valueset} = 1;
       
   333 }
       
   334 
       
   335 sub IntValue
       
   336 {
       
   337 	my $self = shift;
       
   338 	return undef unless(ref($self));
       
   339 	my $value = shift;
       
   340 	if (defined($value)) {
       
   341         my $int = int($value);
       
   342         $self->{intvalue} = $int;
       
   343         $self->MarkValueSet();
       
   344         }
       
   345 	return $self->{intvalue};
       
   346 }
       
   347 
       
   348 sub HexValue
       
   349 {
       
   350 	my $self = shift;
       
   351 	return undef unless(ref($self));
       
   352 	my $value = shift;
       
   353 	return $self->{intvalue} unless(defined($value));
       
   354 	my $int = hex($value);
       
   355 	$self->{intvalue} = $int;
       
   356 	$self->MarkValueSet();
       
   357     return $int;
       
   358 }
       
   359 
       
   360 sub StrValue
       
   361 {
       
   362 	my $self = shift;
       
   363 	return undef unless(ref($self));
       
   364 	my $value = shift;
       
   365 	return $self->{strvalue} unless(defined($value));
       
   366 	#printf ("strlen before %d\n", length ($self->{strvalue}));	
       
   367     $self->{strvalue} .= $value;
       
   368 	#printf ("strlen after %d\n",  length ($self->{strvalue}));
       
   369 	$self->MarkValueSet();
       
   370     return $value;
       
   371 }
       
   372 
       
   373 sub ArrValue
       
   374 {
       
   375 	my $self = shift;
       
   376 	return undef unless(ref($self));
       
   377 	my $value = shift;
       
   378 
       
   379 	return $self->{arrvalue} unless(defined($value));
       
   380 
       
   381     my $int = int($value);
       
   382 	my $index = $self->Length();
       
   383 
       
   384 	$self->{arrvalue}[$index] = $int; # Increments the array size as well as appending item
       
   385 	$index*=4; 
       
   386 
       
   387 	printf ("warning: array value larger than HCR maximum (512 bytes): %d\n", $index) if ($index > 512);    
       
   388 	$self->MarkValueSet();
       
   389 
       
   390     return $self->{arrvalue};
       
   391 }
       
   392 
       
   393 sub BinValue
       
   394 {
       
   395 	my $self = shift;
       
   396 	return undef unless(ref($self));
       
   397 	my $value = shift;
       
   398 	
       
   399 	return $self->{binvalue} unless(defined($value));
       
   400 
       
   401     my @hwords = split(/\s/,$value);
       
   402     shift @hwords if ($hwords[0] eq "");
       
   403     my $hwordslen = scalar(@hwords);  
       
   404 
       
   405     #printf("(len:%d)(0:%04x 1:%04x last:%04x)\n", $hwordslen, hex($hwords[0]), hex($hwords[1]), hex($hwords[$hwordslen-1])) if ($mhd::trace);
       
   406     
       
   407     my $index = $self->Length();
       
   408 	#printf ("binlen before %d\n", $index);
       
   409          
       
   410     #print "Index: " . $index . "\n";
       
   411     foreach my $word (@hwords) {
       
   412         if (length ($word) == 2) {
       
   413 	        $self->{binvalue}[$index] = hex($word);
       
   414             }
       
   415         else {
       
   416             die "error: hexadecimal value '$word' too short/large for 8-bit integer\n";
       
   417             }
       
   418 
       
   419 
       
   420 	   #$self->{binvalue}[$index] = $mint;
       
   421 	   #printf("%d: %04x\n", $count, $self->{binvalue}[$count]);
       
   422        $index++;	  
       
   423 	   }
       
   424 	  
       
   425 
       
   426 	#printf ("binlen after %d\n", $index);
       
   427             
       
   428     printf ("warning: binary value larger than HCR maximum (512 bytes): %d\n", $index) if ($index > 512);
       
   429     $self->MarkValueSet();            
       
   430 	return $self->{binvalue};
       
   431 }
       
   432 
       
   433 
       
   434 # ###########################################################################
       
   435 
       
   436 1;
       
   437