1#!/usr/bin/perl 2# Copyright (c) 2006,2010 Sampo Kellomaki (sampo@iki.fi), All Rights Reserved. 3# This is confidential unpublished proprietary source code of the author. 4# NO WARRANTY, not even implied warranties. Contains trade secrets. 5# Distribution prohibited unless authorized in writing. See file COPYING. 6# $Id: gen-consts-from-gperf-output.pl,v 1.5 2009-08-30 15:09:26 sampo Exp $ 7# 28.5.2006, created --Sampo 8# 19.11.2010, adapted to single elem hash --Sampo 9# 10# Digest gperf generated hash tables and generate corresponding constants 11# Usage: ./gen-consts-from-gperf-output.pl zx_ c/zx-ns.c c/zx-attrs.c c/zx-elems.c >c/zx-const.h 12 13$prefix = shift; 14$ns_tab = shift; 15$at_tab = shift; 16$el_tab = shift; 17 18sub readall { 19 my ($f) = @_; 20 my ($pkg, $srcfile, $line) = caller; 21 local $/ = undef ; # Read all in, without breaking on lines 22 open F, "<$f" or die "$srcfile:$line: Cant read($f): $!"; 23 binmode F; 24 #flock F, 1; 25 my $x = <F>; 26 #flock F, 8; 27 close F; 28 return $x; 29} 30 31sub process_ns_tab { 32 my ($x) = @_; 33 print "/* namespaces */\n"; 34 my ($y) = $x =~ /struct zx_ns_s zx_ns_tab\[\] =\s+\{\s+(.*?)\s+\};/s; 35 #warn "$i: $ARGV[$i] tab($y)"; # Output can be rather sizeable 36 $y =~ s/\#line \d+ ".*?"\n//gs; 37 $y =~ s/^\s*\{//s; 38 $y =~ s/\}$//s; 39 #warn "$i: ($ARGV[$i]) got($y)"; 40 my @a = split /\},\s+\{/s, $y; 41 die "Danger of exhaustation of NS space" if $#a >250; 42 for ($j = 0; $j <= $#a; ++$j) { 43 # {"urn:x-demo:me:2006-01", sizeof("urn:x-demo:me:2006-01")-1, sizeof("demomed")-1, "demomed", 0,0,0,0,0,0,0}, 44 # N.B. split already stripped the curlies and comma 45 # URI sizeof sizeof 1 nsprefix 1 46 my ($nsprefix) = $a[$j] =~ /^".*?",\s*[^,]+,\s*[^,]+,\s*"(.*?)",/; 47 next if !$nsprefix; # Do not gen consts for padding to make hash right 48 die "Duplicate nsprefix($nsprefix) prev=$ns_const{$nsprefix}" if $ns_const{$nsprefix}; 49 $ns_const{$nsprefix} = $j << 16; 50 printf "#define $prefix${nsprefix}_NS\t0x%08x\n", $ns_const{$nsprefix}; 51 } 52 print "#define ${prefix}_NS_MAX\t$j\n"; 53} 54 55sub process_at_tab { 56 my ($x) = @_; 57 print "/* attributes */\n"; 58 my ($y) = $x =~ /struct zx_at_tok zx_at_tab\[\] =\s+\{\s+(.*?)\s+\};/s; 59 #warn "$i: $ARGV[$i] tab($y)"; # Output can be rather sizeable 60 $y =~ s/\#line \d+ ".*?"\n//gs; 61 $y =~ s/^\s*\{//s; 62 $y =~ s/\}$//s; 63 #warn "$i: ($ARGV[$i]) got($y)"; 64 my @a = split /\},\s+\{/s, $y; 65 die "Danger of exhaustation of ATTR space" if $#a >= 0x0000ff00; 66 for ($j = 0; $j <= $#a; ++$j) { 67 my ($name) = $a[$j] =~ /^"(.*?)"/; 68 next if !$name; # Do not gen consts for padding to make hash right 69 $name = "$prefix${name}_ATTR"; 70 die "Duplicate attr name($name)" if $name_used{$name}++; 71 printf "#define $name\t0x%06x\n", $j; 72 } 73 print "#define ${prefix}_ATTR_MAX\t$j\n"; 74} 75 76sub process_el_tab { 77 my ($x) = @_; 78 print "/* elems */\n"; 79 # Extract from comments in union declarations the lists of namespace 80 # qualified elements that the hash key corresponds 81 #while ($x =~ /union zx_(\w+)_u \{(.*?)\};/gs) { 82 #$name = $1; 83 #$lines = $2; 84 ##warn "name($name) lines($lines)"; 85 #for $line (split /\n/, $lines) { 86 # ($els) = $line =~ m%; /\* (.*?) \*/%; 87 # for $el (split / /, $els) { 88 # ++$els{$name}{$el}; 89 # #warn "$name: $el"; 90 # } 91 #} 92 #} 93 94 # Extract from comments the lists of namespace 95 # qualified elements that the hash key corresponds 96 while ($x =~ m%/\*TAG\((\w+)\): (.*?) \*/%gs) { 97 $name = $1; 98 $els = $2; 99 #warn "name($name) els($els)"; 100 for $el (split / /, $els) { 101 ++$els{$name}{$el}; 102 #warn "$name: $el"; 103 } 104 } 105 106 my ($y) = $x =~ /struct zx_el_tok zx_el_tab\[\] =\s+\{\s+(.*?)\s+\};/s; 107 #warn "$i: $ARGV[$i] tab($y)"; # Output can be rather sizeable 108 $y =~ s/\#line \d+ ".*?"\n//gs; 109 $y =~ s/^\s*\{//s; 110 $y =~ s/\}$//s; 111 #warn "$i: ($ARGV[$i]) got($y)"; 112 my @a = split /\},\s+\{/s, $y; 113 die "Danger of exhaustation of ELEM space" if $#a >= 0x0000ff00; 114 for ($j = 0; $j <= $#a; ++$j) { 115 ($name) = $a[$j] =~ /^"(.*?)"/; 116 next if !$name; # Do not gen consts for padding to make hash right 117 # Generate namespace qualified element constants that correspond to the key 118 for $el (sort keys %{$els{$name}}) { 119 ($nsprefix) = split /_/, $el; 120 die "Duplicate elem name($el)" if $name_used{$el}++; 121 printf "#define $prefix${el}_ELEM\t0x%06x\n", $ns_const{$nsprefix}|$j; 122 } 123 } 124 print "#define ${prefix}_ELEM_MAX\t$j\n"; 125} 126 127print "/* generated file, do not edit! $prefix\n * \$Id\$ */\n"; 128print "#ifndef _${prefix}consts\n"; 129print "#define _${prefix}consts\n"; 130 131process_ns_tab(readall($ns_tab)); 132process_at_tab(readall($at_tab)); 133process_el_tab(readall($el_tab)); 134 135print "#endif\n"; 136#EOF 137