url_parse(): better take better care for path parts (Stephen Isard)..
[s-mailx.git] / create-okey-map.pl
blobbd66ff010c08eac7835484ca9460bb8187b5a4ec
1 #!/usr/bin/env perl
2 require 5.008_001;
3 use utf8;
4 #@ Parse 'enum okeys' from nail.h and create okeys.h. And see accmacvar.c.
5 # Public Domain
7 # Acceptable "longest distance" from hash-modulo-index to key
8 my $MAXDISTANCE_PENALTY = 5;
10 my $OUT = 'okeys.h';
12 ## -- >8 -- 8< -- ##
14 use diagnostics -verbose;
15 use strict;
16 use warnings;
18 use sigtrap qw(handler cleanup normal-signals);
20 my (@ENTS, $CTOOL, $CTOOL_EXE);
22 sub main_fun {
23 parse_nail_h();
25 create_c_tool();
27 hash_em();
28 dump_keydat_varmap();
30 reverser();
32 cleanup(undef);
33 exit 0
36 sub cleanup {
37 die "$CTOOL_EXE: couldn't unlink: $^E"
38 if $CTOOL_EXE && -f $CTOOL_EXE && 1 != unlink $CTOOL_EXE;
39 die "$CTOOL: couldn't unlink: $^E"
40 if $CTOOL && -f $CTOOL && 1 != unlink $CTOOL;
41 die "Terminating due to signal $_[0]" if $_[0]
44 sub parse_nail_h {
45 die "nail.h: open: $^E" unless open F, '<', 'nail.h';
46 my ($init) = (0);
47 while (<F>) {
48 # Only want the enum okeys content
49 if (/^enum okeys/) {$init = 1; next}
50 if (/^};/) {if ($init) {$init = 2; last}; next}
51 $init || next;
53 # Ignore empty and comment lines
54 /^$/ && next;
55 /^\s*\/\*/ && next;
57 # An entry may have a comment with special directives
58 /^\s*(\w+),?\s*(?:\/\*\s*(?:{(.*)})\s*\*\/\s*)?$/;
59 next unless $1;
60 my ($k, $x) = ($1, $2);
61 my %vals;
62 $vals{enum} = $k;
63 $vals{binary} = ($k =~ /^ok_b/ ? 1 : 0);
64 $k = $1 if $k =~ /^ok_[bv]_(.+)$/;
65 $k =~ s/_/-/g;
66 $vals{name} = $k;
67 if ($x) {
68 while ($x && $x =~ /^([^,]+?)(?:,(.*))?$/) {
69 $x = $2;
70 $1 =~ /([^=]+)=(.+)/;
71 die "Unsupported special directive: $1"
72 if ($1 ne 'name' && $1 ne 'rdonly' &&
73 $1 ne 'special' && $1 ne 'virtual');
74 $vals{$1} = $2
77 push @ENTS, \%vals
79 if ($init != 2) {die 'nail.h does not have the expected content'}
80 close F
83 sub create_c_tool {
84 $CTOOL = './tmp-okey-tool-' . $$ . '.c';
85 $CTOOL_EXE = $CTOOL . '.exe';
87 die "$CTOOL: open: $^E" unless open F, '>', $CTOOL;
88 # xxx optimize: could read lines and write lines in HASH_MODE..
89 print F '#define MAX_DISTANCE_PENALTY ', $MAXDISTANCE_PENALTY, "\n";
90 # >>>>>>>>>>>>>>>>>>>
91 print F <<'__EOT';
92 #define __CREATE_OKEY_MAP_PL
93 #include <stdint.h>
94 #include <stdlib.h>
95 #include <stdio.h>
96 #include <string.h>
98 #ifndef NELEM
99 # define NELEM(A) (sizeof(A) / sizeof(A[0]))
100 #endif
102 #define ui32_t uint32_t
103 #define ui16_t uint16_t
104 #define ui8_t uint8_t
106 enum var_map_flags {
107 VM_NONE = 0,
108 VM_BINARY = 1<<0, /* ok_b_* */
109 VM_RDONLY = 1<<1, /* May not be set by user */
110 VM_SPECIAL = 1<<2, /* Wants _var_check_specials() evaluation */
111 VM_VIRTUAL = 1<<3 /* "Stateless": no var* -- implies VM_RDONLY */
114 /* Binary compatible with struct var! (xxx make it superclass?) */
115 struct var_vx {
116 struct var *v_link;
117 char *v_value;
120 struct var_virtual {
121 ui32_t vv_okey;
122 struct var_vx vv_var;
125 struct var_map {
126 ui32_t vm_hash;
127 ui16_t vm_keyoff;
128 ui16_t vm_flags; /* var_map_flags bits */
131 #ifdef HASH_MODE
132 /* NOTE: copied over verbatim from auxlily.c */
133 static ui32_t
134 torek_hash(char const *name)
136 /* Chris Torek's hash.
137 * NOTE: need to change *at least* create-okey-map.pl when changing the
138 * algorithm!! */
139 ui32_t h = 0;
141 while (*name != '\0') {
142 h *= 33;
143 h += *name++;
145 return h;
148 #else
149 /* Include what has been written in HASH_MODE */
150 # include "okeys.h"
152 static ui8_t seen_wraparound;
153 static size_t longest_distance;
155 static size_t
156 next_prime(size_t no) /* blush (brute force) */
158 jredo:
159 ++no;
160 for (size_t i = 3; i < no; i += 2)
161 if (no % i == 0)
162 goto jredo;
163 return no;
166 static size_t *
167 reversy(size_t size)
169 struct var_map const *vmp = _var_map, *vmaxp = vmp + NELEM(_var_map);
170 size_t ldist = 0, *arr;
172 arr = malloc(sizeof *arr * size);
173 for (size_t i = 0; i < size; ++i)
174 arr[i] = NELEM(_var_map);
176 seen_wraparound = 0;
177 longest_distance = 0;
179 while (vmp < vmaxp) {
180 ui32_t hash = vmp->vm_hash, i = hash % size, l;
182 for (l = 0; arr[i] != NELEM(_var_map); ++l)
183 if (++i == size) {
184 seen_wraparound = 1;
185 i = 0;
187 if (l > longest_distance)
188 longest_distance = l;
189 arr[i] = (size_t)(vmp++ - _var_map);
191 return arr;
193 #endif /* !HASH_MODE */
196 main(int argc, char **argv)
198 #ifdef HASH_MODE
199 size_t h = torek_hash(argv[1]);
201 printf("%lu\n", (unsigned long)h);
203 #else
204 size_t *arr, size = NELEM(_var_map);
206 fprintf(stderr, "Starting reversy, okeys=%zu\n", size);
207 for (;;) {
208 arr = reversy(size = next_prime(size));
209 fprintf(stderr, " - size=%zu longest_distance=%zu seen_wraparound=%d\n",
210 size, longest_distance, seen_wraparound);
211 if (longest_distance <= MAX_DISTANCE_PENALTY)
212 break;
213 free(arr);
216 printf(
217 "#define _VAR_REV_ILL %zuu\n"
218 "#define _VAR_REV_PRIME %zuu\n"
219 "#define _VAR_REV_LONGEST %zuu\n"
220 "#define _VAR_REV_WRAPAROUND %d\n"
221 "static %s const _var_revmap[_VAR_REV_PRIME] = {\n ",
222 NELEM(_var_map), size, longest_distance, seen_wraparound, argv[1]);
223 for (size_t i = 0; i < size; ++i)
224 printf("%s%zuu", (i == 0 ? "" : (i % 10 == 0 ? ",\n " : ", ")), arr[i]);
225 printf("\n};\n");
226 #endif
227 return 0;
229 __EOT
230 # <<<<<<<<<<<<<<<<<<<
231 close F
234 sub hash_em {
235 system("c99 -DHASH_MODE -I. -o $CTOOL_EXE $CTOOL");
237 foreach my $e (@ENTS) {
238 my $h = `$CTOOL_EXE $e->{name}`;
239 chomp $h;
240 $e->{hash} = $h
244 sub dump_keydat_varmap {
245 die "$OUT: open: $^E" unless open F, '>', $OUT;
246 print F "/*@ $OUT, generated by $0 on ", scalar gmtime(), ".\n",
247 " *@ See accmacvar.c for more */\n\n";
249 print F 'static char const _var_keydat[] = {', "\n";
250 my ($i, $alen) = (0, 0);
251 my %virts;
252 foreach my $e (@ENTS) {
253 $e->{keyoff} = $alen;
254 my $k = $e->{name};
255 my $l = length $k;
256 my $a = join '\',\'', split(//, $k);
257 my ($f, $s) = ('', ', ');
258 if ($e->{binary}) {$f .= $s . 'VM_BINARY'; $s = ' | '}
259 if ($e->{rdonly}) {$f .= $s . 'VM_RDONLY'; $s = ' | '}
260 if ($e->{special}) {$f .= $s . 'VM_SPECIAL'; $s = ' | '}
261 if ($e->{virtual}) {
262 die("*$k*: virtual MUST be rdonly, too!") unless $e->{rdonly};
263 $f .= $s . 'VM_VIRTUAL'; $s = ' | ';
264 $virts{$k} = $e;
266 print F " /* $i. [$alen]+$l $k$f */\n", " '$a','\\0',\n";
267 ++$i;
268 $alen += $l + 1
270 print F '};', "\n\n";
272 print F 'static struct var_map const _var_map[] = {', "\n";
273 foreach my $e (@ENTS) {
274 my $f = 'VM_NONE';
275 $f .= ' | VM_BINARY' if $e->{binary};
276 $f .= ' | VM_RDONLY' if $e->{rdonly};
277 $f .= ' | VM_SPECIAL' if $e->{special};
278 $f .= ' | VM_VIRTUAL' if $e->{virtual};
279 my $n = $1 if $e->{enum} =~ /ok_._(.*)/;
280 print F " {$e->{hash}u, $e->{keyoff}u, $f}, /* $n */\n"
282 print F '};', "\n\n";
284 # We have at least version stuff in here
285 # The problem is that struct var uses a variable sized character buffer
286 # which cannot be initialized in a conforming way :(
287 print F "#ifndef __CREATE_OKEY_MAP_PL\n";
288 print F " /* Unfortunately init of varsized buffer won't work */\n";
289 foreach my $k (keys %virts) {
290 my $e = $virts{$k};
291 $e->{vname} = $1 if $e->{enum} =~ /ok_._(.*)/;
292 $e->{vstruct} = "var_virt_$e->{vname}";
293 print F "static struct {\n";
294 print F " struct var *v_link;\n";
295 print F " char const *v_value;\n";
296 print F " char const v_name[", length($e->{name}), " +1];\n";
297 print F "} const _$e->{vstruct} = ",
298 "{NULL, $e->{virtual}, \"$e->{name}\"};\n\n";
301 print F 'static struct var_virtual const _var_virtuals[] = {', "\n";
302 foreach my $k (keys %virts) {
303 my $e = $virts{$k};
304 my $n = $1 if $e->{enum} =~ /ok_._(.*)/;
305 print F " {$e->{enum}, (void const*)&_$e->{vstruct}},\n";
307 print F "};\n#endif /* __CREATE_OKEY_MAP_PL */\n\n";
309 die "$OUT: close: $^E" unless close F
312 sub reverser {
313 system("c99 -I. -o $CTOOL_EXE $CTOOL");
314 my $t = (@ENTS < 0xFF ? 'ui8_t' : (@ENTS < 0xFFFF ? 'ui16_t' : 'ui32_t'));
315 `$CTOOL_EXE $t >> $OUT`
318 {package main; main_fun()}
320 # s-it-mode