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