"Fossies" - the Fresh Open Source Software Archive

Member "s-nail-14.9.11/make-okey-map.pl" (8 Aug 2018, 14780 Bytes) of package /linux/misc/s-nail-14.9.11.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "make-okey-map.pl" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 14.9.10_vs_14.9.11.

    1 #!/usr/bin/env perl
    2 require 5.008_001;
    3 use utf8;
    4 #@ Parse 'enum okeys' from nail.h and create gen-okeys.h.  And see accmacvar.c.
    5 # Public Domain
    6 
    7 # Acceptable "longest distance" from hash-modulo-index to key
    8 my $MAXDISTANCE_PENALTY = 6;
    9 
   10 # Generate a more verbose output.  Not for shipout versions.
   11 my $VERB = 1;
   12 
   13 my $MAILX = 'LC_ALL=C s-nail -#:/';
   14 my $OUT = 'gen-okeys.h';
   15 
   16 ##  --  >8  --  8<  --  ##
   17 
   18 use diagnostics -verbose;
   19 use strict;
   20 use warnings;
   21 
   22 use FileHandle;
   23 use IPC::Open2;
   24 
   25 use sigtrap qw(handler cleanup normal-signals);
   26 
   27 my ($S, @ENTS, $CTOOL, $CTOOL_EXE) = ($VERB ? '   ' : '');
   28 
   29 sub main_fun{
   30    if(@ARGV) {$VERB = 0; $S = ''}
   31 
   32    parse_nail_h();
   33 
   34    create_c_tool();
   35 
   36    hash_em();
   37 
   38    dump_map();
   39 
   40    reverser();
   41 
   42    cleanup(undef);
   43    exit 0
   44 }
   45 
   46 sub cleanup{
   47    die "$CTOOL_EXE: couldn't unlink: $^E"
   48       if $CTOOL_EXE && -f $CTOOL_EXE && 1 != unlink $CTOOL_EXE;
   49    die "$CTOOL: couldn't unlink: $^E"
   50       if $CTOOL && -f $CTOOL && 1 != unlink $CTOOL;
   51    die "Terminating due to signal $_[0]" if $_[0]
   52 };
   53 
   54 sub parse_nail_h{
   55    die "nail.h: open: $^E" unless open F, '<', 'nail.h';
   56    my ($init) = (0);
   57    while(<F>){
   58       # Only want the enum okeys content
   59       if(/^enum okeys/) {$init = 1; next}
   60       if(/^};/) {if($init) {$init = 2; last}; next}
   61       $init || next;
   62 
   63       # Ignore empty and comment lines
   64       /^$/ && next;
   65       /^\s*\/\*/ && next;
   66 
   67       # An entry may have a comment with special directives
   68       /^\s*(\w+),?\s*(?:\/\*\s*(?:{(.*)})\s*\*\/\s*)?$/;
   69       next unless $1;
   70       my ($k, $x) = ($1, $2);
   71       my %vals;
   72       $vals{enum} = $k;
   73       $vals{bool} = ($k =~ /^ok_b/ ? 1 : 0);
   74       $k = $1 if $k =~ /^ok_[bv]_(.+)$/;
   75       $k =~ s/_/-/g;
   76       $vals{name} = $k;
   77       if($x){
   78          # {\}: overlong entry, placed on follow line
   79          if($x =~ /\s*\\\s*$/){
   80             $_ = <F>;
   81             die 'nail.h: missing continuation line' unless $_;
   82             /^\s*\/\*\s*{(.*)}\s*\*\/\s*$/;
   83             $x = $1;
   84             die 'nail.h: invalid continuation line' unless $x
   85          }
   86 
   87          while($x && $x =~ /^([^,]+?)(?:,(.*))?$/){
   88             $x = $2;
   89             $1 =~ /([^=]+)=(.+)/;
   90             die "Unsupported special directive: $1"
   91                if($1 ne 'name' &&
   92                   $1 ne 'virt' && $1 ne 'vip' &&
   93                   $1 ne 'rdonly' && $1 ne 'nodel' &&
   94                   $1 ne 'i3val' && $1 ne 'defval' &&
   95                   $1 ne 'import' && $1 ne 'env' && $1 ne 'nolopts' &&
   96                   $1 ne 'notempty' && $1 ne 'nocntrls' &&
   97                      $1 ne 'num' && $1 ne 'posnum' && $1 ne 'lower' &&
   98                   $1 ne 'chain' && $1 ne 'obsolete');
   99             $vals{$1} = $2
  100          }
  101       }
  102       push @ENTS, \%vals
  103    }
  104    if($init != 2) {die 'nail.h does not have the expected content'}
  105    close F
  106 }
  107 
  108 sub create_c_tool{
  109    $CTOOL = './tmp-okey-tool-' . $$ . '.c';
  110    $CTOOL_EXE = $CTOOL . '.exe';
  111 
  112    die "$CTOOL: open: $^E" unless open F, '>', $CTOOL;
  113    print F '#define MAX_DISTANCE_PENALTY ', $MAXDISTANCE_PENALTY, "\n";
  114 # >>>>>>>>>>>>>>>>>>>
  115    print F <<'_EOT';
  116 #define a__CREATE_OKEY_MAP_PL
  117 #include <stdint.h>
  118 #include <stdlib.h>
  119 #include <stdio.h>
  120 #include <string.h>
  121 
  122 #define n_NELEM(A) (sizeof(A) / sizeof(A[0]))
  123 
  124 #define ui32_t uint32_t
  125 #define ui16_t uint16_t
  126 #define ui8_t uint8_t
  127 
  128 enum a_amv_var_flags{
  129    a_AMV_VF_NONE = 0,
  130 
  131    /* The basic set of flags, also present in struct a_amv_var_map.avm_flags */
  132    a_AMV_VF_BOOL = 1u<<0,     /* ok_b_* */
  133    a_AMV_VF_CHAIN = 1u<<1,    /* Is variable chain (-USER{,@HOST} variants) */
  134    a_AMV_VF_VIRT = 1u<<2,     /* "Stateless" automatic variable */
  135    a_AMV_VF_VIP = 1u<<3,      /* Wants _var_check_vips() evaluation */
  136    a_AMV_VF_RDONLY = 1u<<4,   /* May not be set by user */
  137    a_AMV_VF_NODEL = 1u<<5,    /* May not be deleted */
  138    a_AMV_VF_I3VAL = 1u<<6,    /* Has an initial value */
  139    a_AMV_VF_DEFVAL = 1u<<7,   /* Has a default value */
  140    a_AMV_VF_IMPORT = 1u<<8,   /* Import ONLY from env (pre n_PSO_STARTED) */
  141    a_AMV_VF_ENV = 1u<<9,      /* Update environment on change */
  142    a_AMV_VF_NOLOPTS = 1u<<10, /* May not be tracked by `localopts' */
  143    a_AMV_VF_NOTEMPTY = 1u<<11, /* May not be assigned an empty value */
  144    a_AMV_VF_NUM = 1u<<12,     /* Value must be a 32-bit number */
  145    a_AMV_VF_POSNUM = 1u<<13,  /* Value must be positive 32-bit number */
  146    a_AMV_VF_LOWER = 1u<<14,   /* Values will be stored in lowercase version */
  147    a_AMV_VF_OBSOLETE = 1u<<15, /* Is obsolete? */
  148    a_AMV_VF__MASK = (1u<<(15+1)) - 1,
  149 
  150    /* Extended flags, not part of struct a_amv_var_map.avm_flags */
  151    a_AMV_VF_EXT_LOCAL = 1u<<23,        /* `local' */
  152    a_AMV_VF_EXT_LINKED = 1u<<24,       /* `environ' link'ed */
  153    a_AMV_VF_EXT_FROZEN = 1u<<25,       /* Has been set by -S,.. */
  154    a_AMV_VF_EXT_FROZEN_UNSET = 1u<<26, /* ..and was used to unset a variable */
  155    a_AMV_VF_EXT__FROZEN_MASK = a_AMV_VF_EXT_FROZEN | a_AMV_VF_EXT_FROZEN_UNSET,
  156    a_AMV_VF_EXT__MASK = (1u<<(26+1)) - 1
  157 };
  158 
  159 struct a_amv_var_map{
  160    ui32_t avm_hash;
  161    ui16_t avm_keyoff;
  162    ui16_t avm_flags;    /* enum a_amv_var_flags */
  163 };
  164 
  165 struct a_amv_var_chain_map_bsrch{
  166    char avcmb_prefix[4];
  167    ui16_t avcmb_chain_map_off;
  168    ui16_t avcmb_chain_map_eokey; /* This is an enum okey */
  169 };
  170 
  171 struct a_amv_var_chain_map{
  172    ui16_t avcm_keyoff;
  173    ui16_t avcm_okey;
  174 };
  175 
  176 #define n_CTA(A,S)
  177 #include "gen-okeys.h"
  178 
  179 static ui8_t seen_wraparound;
  180 static size_t longest_distance;
  181 
  182 static size_t
  183 next_prime(size_t no){ /* blush (brute force) */
  184 jredo:
  185    ++no;
  186    for(size_t i = 3; i < no; i += 2)
  187       if(no % i == 0)
  188          goto jredo;
  189    return no;
  190 }
  191 
  192 static size_t *
  193 reversy(size_t size){
  194    struct a_amv_var_map const *vmp = a_amv_var_map,
  195       *vmaxp = vmp + n_NELEM(a_amv_var_map);
  196    size_t ldist = 0, *arr;
  197 
  198    arr = malloc(sizeof *arr * size);
  199    for(size_t i = 0; i < size; ++i)
  200       arr[i] = n_NELEM(a_amv_var_map);
  201 
  202    seen_wraparound = 0;
  203    longest_distance = 0;
  204 
  205    while(vmp < vmaxp){
  206       ui32_t hash = vmp->avm_hash, i = hash % size, l;
  207 
  208       for(l = 0; arr[i] != n_NELEM(a_amv_var_map); ++l)
  209          if(++i == size){
  210             seen_wraparound = 1;
  211             i = 0;
  212          }
  213       if(l > longest_distance)
  214          longest_distance = l;
  215       arr[i] = (size_t)(vmp++ - a_amv_var_map);
  216    }
  217    return arr;
  218 }
  219 
  220 int
  221 main(int argc, char **argv){
  222    size_t *arr, size = n_NELEM(a_amv_var_map);
  223 
  224    fprintf(stderr, "Starting reversy, okeys=%zu\n", size);
  225    for(;;){
  226       arr = reversy(size = next_prime(size));
  227       fprintf(stderr, " - size=%zu longest_distance=%zu seen_wraparound=%d\n",
  228          size, longest_distance, seen_wraparound);
  229       if(longest_distance <= MAX_DISTANCE_PENALTY)
  230          break;
  231       free(arr);
  232    }
  233 
  234    printf(
  235       "#define a_AMV_VAR_REV_ILL %zuu\n"
  236       "#define a_AMV_VAR_REV_PRIME %zuu\n"
  237       "#define a_AMV_VAR_REV_LONGEST %zuu\n"
  238       "#define a_AMV_VAR_REV_WRAPAROUND %d\n"
  239       "static %s const a_amv_var_revmap[a_AMV_VAR_REV_PRIME] = {\n%s",
  240       n_NELEM(a_amv_var_map), size, longest_distance, seen_wraparound,
  241       argv[1], (argc > 2 ? "  " : ""));
  242    for(size_t i = 0; i < size; ++i)
  243       printf("%s%zuu", (i == 0 ? ""
  244          : (i % 10 == 0 ? (argc > 2 ? ",\n  " : ",\n")
  245             : (argc > 2 ? ", " : ","))),
  246          arr[i]);
  247    printf("\n};\n");
  248    return 0;
  249 }
  250 _EOT
  251 # <<<<<<<<<<<<<<<<<<<
  252    close F
  253 }
  254 
  255 sub hash_em{
  256    die "hash_em: open: $^E"
  257       unless my $pid = open2 *RFD, *WFD, $MAILX;
  258    foreach my $e (@ENTS){
  259       print WFD "vexpr hash $e->{name}\n";
  260       my $h = <RFD>;
  261       chomp $h;
  262       $e->{hash} = $h
  263    }
  264    print WFD "x\n";
  265    waitpid $pid, 0;
  266 }
  267 
  268 sub dump_map{
  269    die "$OUT: open: $^E" unless open F, '>', $OUT;
  270    print F "/*@ $OUT, generated by $0.\n",
  271       " *@ See accmacvar.c for more */\n\n";
  272 
  273    # Dump the names sequentially (in nail.h order), create our map entry along
  274    print F 'static char const a_amv_var_names[] = {', "\n";
  275    my ($i, $alen) = (0, 0);
  276    my (%virts, %defvals, %i3vals, %chains);
  277    foreach my $e (@ENTS){
  278       $e->{keyoff} = $alen;
  279       my $k = $e->{name};
  280       my $l = length $k;
  281       my $a = join '\',\'', split(//, $k);
  282       my (@fa);
  283       if($e->{bool}) {push @fa, 'a_AMV_VF_BOOL'}
  284       if($e->{virt}){
  285          # Virtuals are implicitly rdonly and nodel
  286          $e->{rdonly} = $e->{nodel} = 1;
  287          $virts{$k} = $e;
  288          push @fa, 'a_AMV_VF_VIRT'
  289       }
  290       if($e->{vip}) {push @fa, 'a_AMV_VF_VIP'}
  291       if($e->{rdonly}) {push @fa, 'a_AMV_VF_RDONLY'}
  292       if($e->{nodel}) {push @fa, 'a_AMV_VF_NODEL'}
  293       if(defined $e->{i3val}){
  294          $i3vals{$k} = $e;
  295          push @fa, 'a_AMV_VF_I3VAL'
  296       }
  297       if($e->{defval}){
  298          $defvals{$k} = $e;
  299          push @fa, 'a_AMV_VF_DEFVAL'
  300       }
  301       if($e->{import}){
  302          $e->{env} = 1;
  303          push @fa, 'a_AMV_VF_IMPORT'
  304       }
  305       if($e->{env}) {push @fa, 'a_AMV_VF_ENV'}
  306       if($e->{nolopts}) {push @fa, 'a_AMV_VF_NOLOPTS'}
  307       if($e->{notempty}) {push @fa, 'a_AMV_VF_NOTEMPTY'}
  308       if($e->{nocntrls}) {push @fa, 'a_AMV_VF_NOCNTRLS'}
  309       if($e->{num}) {push @fa, 'a_AMV_VF_NUM'}
  310       if($e->{posnum}) {push @fa, 'a_AMV_VF_POSNUM'}
  311       if($e->{lower}) {push @fa, 'a_AMV_VF_LOWER'}
  312       if($e->{chain}){
  313          $chains{$k} = $e;
  314          push @fa, 'a_AMV_VF_CHAIN'
  315       }
  316       if($e->{obsolete}) {push @fa, 'a_AMV_VF_OBSOLETE'}
  317       $e->{flags} = \@fa;
  318       my $f = join('|', @fa);
  319       $f = ', ' . $f if length $f;
  320       print F "${S}/* $i. [$alen]+$l $k$f */\n" if $VERB;
  321       print F "${S}'$a','\\0',\n";
  322       ++$i;
  323       $alen += $l + 1
  324    }
  325    print F '};', "\n#define a_AMV_VAR_NAME_KEY_MAXOFF ${alen}U\n\n";
  326 
  327    # Create the management map
  328    print F 'n_CTA(a_AMV_VF_NONE == 0, "Value not 0 as expected");', "\n";
  329    print F 'static struct a_amv_var_map const a_amv_var_map[] = {', "\n";
  330    foreach my $e (@ENTS){
  331       my $f = $VERB ? 'a_AMV_VF_NONE' : '0';
  332       my $fa = join '|', @{$e->{flags}};
  333       $f .= '|' . $fa if length $fa;
  334       print F "${S}{$e->{hash}u, $e->{keyoff}u, $f},";
  335       if($VERB) {print F "${S}/* $e->{name} */\n"}
  336       else {print F "\n"}
  337    }
  338    print F '};', "\n\n";
  339 
  340    # The rest not to be injected for this generator script
  341    print F <<_EOT;
  342 #ifndef a__CREATE_OKEY_MAP_PL
  343 # ifdef HAVE_PUTENV
  344 #  define a_X(X) X
  345 # else
  346 #  define a_X(X)
  347 # endif
  348 
  349 _EOT
  350 
  351    #
  352    if(%chains){
  353       my (@prefixes,$last_pstr,$last_pbeg,$last_pend,$i);
  354       print F 'n_CTAV(4 == ',
  355          'n_SIZEOF_FIELD(struct a_amv_var_chain_map_bsrch, avcmb_prefix));',
  356          "\n";
  357       print F 'static struct a_amv_var_chain_map const ',
  358          'a_amv_var_chain_map[] = {', "\n";
  359       $last_pstr = "";
  360       $last_pend = "n_OKEYS_MAX";
  361       $last_pbeg = $i = 0;
  362       foreach my $e (sort keys %chains){
  363          $e = $chains{$e};
  364          print F "${S}{$e->{keyoff}, $e->{enum}},\n";
  365          die "Chains need length of at least 4 bytes: $e->{name}"
  366             if length $e->{name} < 4;
  367          my $p = substr $e->{name}, 0, 4;
  368          if($p ne $last_pstr){
  369             push @prefixes, [$last_pstr, $last_pbeg, $last_pend] if $i > 0;
  370             $last_pstr = $p;
  371             $last_pbeg = $i
  372          }
  373          $last_pend = $e->{enum};
  374          ++$i
  375       }
  376       push @prefixes, [$last_pstr, $last_pbeg, $last_pend] if $last_pstr ne "";
  377       print F '};', "\n";
  378       print F '#define a_AMV_VAR_CHAIN_MAP_CNT ', scalar %chains, "\n\n";
  379 
  380       print F 'static struct a_amv_var_chain_map_bsrch const ',
  381          'a_amv_var_chain_map_bsrch[] = {', "\n";
  382       foreach my $e (@prefixes){
  383          print F "${S}{\"$e->[0]\", $e->[1], $e->[2]},\n"
  384       }
  385       print F '};', "\n";
  386       print F '#define a_AMV_VAR_CHAIN_MAP_BSRCH_CNT ',
  387          scalar @prefixes, "\n\n"
  388    }
  389 
  390    # Virtuals are _at least_ the versioning variables
  391    # The problem is that struct var uses a variable sized character buffer
  392    # which cannot be initialized in a conforming way :(
  393    print F '/* Unfortunately init of varsized buffer impossible: ' .
  394       'define "subclass"es */' . "\n";
  395    my @skeys = sort keys %virts;
  396 
  397    foreach(@skeys){
  398       my $e = $virts{$_};
  399       $e->{vname} = $1 if $e->{enum} =~ /ok_._(.*)/;
  400       $e->{vstruct} = "var_virt_$e->{vname}";
  401       print F "static char const a_amv_$e->{vstruct}_val[] = {$e->{virt}};\n";
  402       print F "static struct{\n";
  403       print F "${S}struct a_amv_var *av_link;\n";
  404       print F "${S}char const *av_value;\n";
  405       print F "${S}a_X(char *av_env;)\n";
  406       print F "${S}ui32_t av_flags;\n";
  407       print F "${S}char const av_name[", length($e->{name}), " +1];\n";
  408       my $f = $VERB ? 'a_AMV_VF_NONE' : '0';
  409       my $fa = join '|', @{$e->{flags}};
  410       $f .= '|' . $fa if length $fa;
  411       print F "} const a_amv_$e->{vstruct} = ",
  412          "{NULL, a_amv_$e->{vstruct}_val, a_X(0 COMMA) $f, ",
  413          "\"$e->{name}\"};\n\n"
  414    }
  415 
  416    print F "\n";
  417    print F 'static struct a_amv_var_virt const a_amv_var_virts[] = {', "\n";
  418    foreach(@skeys){
  419       my $e = $virts{$_};
  420       my $n = $1 if $e->{enum} =~ /ok_._(.*)/;
  421       print F "${S}{$e->{enum}, {0,}, (void const*)&a_amv_$e->{vstruct}},\n";
  422    }
  423    print F "};\n";
  424    print F '#define a_AMV_VAR_VIRTS_CNT ', scalar @skeys, "\n";
  425 
  426    # First-time-init values
  427    @skeys = sort keys %i3vals;
  428 
  429    print F "\n";
  430    print F 'static struct a_amv_var_defval const a_amv_var_i3vals[] = {', "\n";
  431    foreach(@skeys){
  432       my $e = $i3vals{$_};
  433       print F "${S}{", $e->{enum}, ', {0,}, ',
  434          (!$e->{bool} ? $e->{i3val} : "NULL"), "},\n"
  435    }
  436    print F "};\n";
  437    print F '#define a_AMV_VAR_I3VALS_CNT ', scalar @skeys, "\n";
  438 
  439    # Default values
  440    @skeys = sort keys %defvals;
  441 
  442    print F "\n";
  443    print F 'static struct a_amv_var_defval const a_amv_var_defvals[] = {', "\n";
  444    foreach(@skeys){
  445       my $e = $defvals{$_};
  446       print F "${S}{", $e->{enum}, ', {0,}, ',
  447          (!$e->{bool} ? $e->{defval} : "NULL"), "},\n"
  448    }
  449    print F "};\n";
  450    print F '#define a_AMV_VAR_DEFVALS_CNT ', scalar @skeys, "\n";
  451 
  452    # Special var backing [#@*?]|[1-9][0-9]*|0
  453    $i = 0;
  454    print F "\n";
  455    foreach my $e (@ENTS){
  456       if($e->{name} eq '--special-param'){
  457          print F "#define a_AMV_VAR__SPECIAL_PARAM_MAP_IDX ${i}u\n"
  458       }
  459       # The rest are only speedups
  460       elsif($e->{name} eq '?'){
  461          print F "#define a_AMV_VAR__QM_MAP_IDX ${i}u\n"
  462       }elsif($e->{name} eq '!'){
  463          print F "#define a_AMV_VAR__EM_MAP_IDX ${i}u\n"
  464       }
  465       ++$i
  466    }
  467 
  468    print F "\n";
  469    print F "# undef a_X\n";
  470    print F "#endif /* !a__CREATE_OKEY_MAP_PL */\n";
  471    die "$OUT: close: $^E" unless close F
  472 }
  473 
  474 sub reverser{
  475    my $argv2 = $VERB ? ' verb' : '';
  476    system("\$CC -I. -o $CTOOL_EXE $CTOOL");
  477    my $t = (@ENTS < 0xFF ? 'ui8_t' : (@ENTS < 0xFFFF ? 'ui16_t' : 'ui32_t'));
  478    `$CTOOL_EXE $t$argv2 >> $OUT`
  479 }
  480 
  481 {package main; main_fun()}
  482 
  483 # s-it-mode