Fix is_asccaseprefix()/asccasestr()
[s-mailx.git] / mk-okey-map.pl
blob61312f9ab03d75a6910315f01109200897295e71
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 # Generate a more verbose output. Not for shipout versions.
11 my $VERB = 1;
13 my $OUT = 'okeys.h';
15 ## -- >8 -- 8< -- ##
17 use diagnostics -verbose;
18 use strict;
19 use warnings;
21 use sigtrap qw(handler cleanup normal-signals);
23 my ($S, @ENTS, $CTOOL, $CTOOL_EXE) = ($VERB ? ' ' : '');
25 sub main_fun{
26 if(@ARGV) {$VERB = 0; $S = ''}
28 parse_nail_h();
30 create_c_tool();
32 hash_em();
33 dump_map();
35 reverser();
37 cleanup(undef);
38 exit 0
41 sub cleanup{
42 die "$CTOOL_EXE: couldn't unlink: $^E"
43 if $CTOOL_EXE && -f $CTOOL_EXE && 1 != unlink $CTOOL_EXE;
44 die "$CTOOL: couldn't unlink: $^E"
45 if $CTOOL && -f $CTOOL && 1 != unlink $CTOOL;
46 die "Terminating due to signal $_[0]" if $_[0]
49 sub parse_nail_h{
50 die "nail.h: open: $^E" unless open F, '<', 'nail.h';
51 my ($init) = (0);
52 while(<F>){
53 # Only want the enum okeys content
54 if(/^enum okeys/) {$init = 1; next}
55 if(/^};/) {if($init) {$init = 2; last}; next}
56 $init || next;
58 # Ignore empty and comment lines
59 /^$/ && next;
60 /^\s*\/\*/ && next;
62 # An entry may have a comment with special directives
63 /^\s*(\w+),?\s*(?:\/\*\s*(?:{(.*)})\s*\*\/\s*)?$/;
64 next unless $1;
65 my ($k, $x) = ($1, $2);
66 my %vals;
67 $vals{enum} = $k;
68 $vals{bool} = ($k =~ /^ok_b/ ? 1 : 0);
69 $k = $1 if $k =~ /^ok_[bv]_(.+)$/;
70 $k =~ s/_/-/g;
71 $vals{name} = $k;
72 if($x){
73 while($x && $x =~ /^([^,]+?)(?:,(.*))?$/){
74 $x = $2;
75 $1 =~ /([^=]+)=(.+)/;
76 die "Unsupported special directive: $1"
77 if($1 ne 'name' &&
78 $1 ne 'virt' && $1 ne 'nolopts' &&
79 $1 ne 'rdonly' && $1 ne 'nodel' && $1 ne 'notempty' &&
80 $1 ne 'nocntrls' &&
81 $1 ne 'num' && $1 ne 'posnum' && $1 ne 'lower' &&
82 $1 ne 'vip' && $1 ne 'import' && $1 ne 'env' &&
83 $1 ne 'i3val' && $1 ne 'defval');
84 $vals{$1} = $2
87 push @ENTS, \%vals
89 if($init != 2) {die 'nail.h does not have the expected content'}
90 close F
93 sub create_c_tool{
94 $CTOOL = './tmp-okey-tool-' . $$ . '.c';
95 $CTOOL_EXE = $CTOOL . '.exe';
97 die "$CTOOL: open: $^E" unless open F, '>', $CTOOL;
98 # xxx optimize: could read lines and write lines in HASH_MODE..
99 print F '#define MAX_DISTANCE_PENALTY ', $MAXDISTANCE_PENALTY, "\n";
100 # >>>>>>>>>>>>>>>>>>>
101 print F <<'_EOT';
102 #define __CREATE_OKEY_MAP_PL
103 #include <stdint.h>
104 #include <stdlib.h>
105 #include <stdio.h>
106 #include <string.h>
108 #define n_NELEM(A) (sizeof(A) / sizeof(A[0]))
110 #define ui32_t uint32_t
111 #define ui16_t uint16_t
112 #define ui8_t uint8_t
114 enum a_amv_var_flags{
115 a_AMV_VF_NONE = 0,
116 a_AMV_VF_BOOL = 1<<0, /* ok_b_* */
117 a_AMV_VF_VIRT = 1<<1, /* "Stateless" automatic variable */
118 a_AMV_VF_NOLOPTS = 1<<2, /* May not be tracked by `localopts' */
119 a_AMV_VF_RDONLY = 1<<3, /* May not be set by user */
120 a_AMV_VF_NODEL = 1<<4, /* May not be deleted */
121 a_AMV_VF_NOTEMPTY = 1<<5, /* May not be assigned an empty value */
122 a_AMV_VF_NOCNTRLS = 1<<6, /* Value may not contain control characters */
123 a_AMV_VF_NUM = 1<<7, /* Value must be a 32-bit number */
124 a_AMV_VF_POSNUM = 1<<8, /* Value must be positive 32-bit number */
125 a_AMV_VF_LOWER = 1<<9, /* Values will be stored in a lowercase version */
126 a_AMV_VF_VIP = 1<<10, /* Wants _var_check_vips() evaluation */
127 a_AMV_VF_IMPORT = 1<<11, /* Import ONLY from environ (before PS_STARTED) */
128 a_AMV_VF_ENV = 1<<12, /* Update environment on change */
129 a_AMV_VF_I3VAL = 1<<13, /* Has an initial value */
130 a_AMV_VF_DEFVAL = 1<<14, /* Has a default value */
131 a_AMV_VF_LINKED = 1<<15, /* `environ' linked */
132 a_AMV_VF__MASK = (1<<(15+1)) - 1
135 struct a_amv_var_map{
136 ui32_t avm_hash;
137 ui16_t avm_keyoff;
138 ui16_t avm_flags; /* enum a_amv_var_flags */
141 #ifdef HASH_MODE
142 /* NOTE: copied over verbatim from auxlily.c */
143 static ui32_t
144 torek_hash(char const *name){
145 /* Chris Torek's hash.
146 * NOTE: need to change *at least* mk-okey-map.pl when changing the
147 * algorithm!! */
148 ui32_t h = 0;
150 while(*name != '\0'){
151 h *= 33;
152 h += *name++;
154 return h;
157 #else
158 /* Include what has been written in HASH_MODE */
159 # define n_CTA(A,S)
160 # include "okeys.h"
162 static ui8_t seen_wraparound;
163 static size_t longest_distance;
165 static size_t
166 next_prime(size_t no){ /* blush (brute force) */
167 jredo:
168 ++no;
169 for(size_t i = 3; i < no; i += 2)
170 if(no % i == 0)
171 goto jredo;
172 return no;
175 static size_t *
176 reversy(size_t size){
177 struct a_amv_var_map const *vmp = a_amv_var_map,
178 *vmaxp = vmp + n_NELEM(a_amv_var_map);
179 size_t ldist = 0, *arr;
181 arr = malloc(sizeof *arr * size);
182 for(size_t i = 0; i < size; ++i)
183 arr[i] = n_NELEM(a_amv_var_map);
185 seen_wraparound = 0;
186 longest_distance = 0;
188 while(vmp < vmaxp){
189 ui32_t hash = vmp->avm_hash, i = hash % size, l;
191 for(l = 0; arr[i] != n_NELEM(a_amv_var_map); ++l)
192 if(++i == size){
193 seen_wraparound = 1;
194 i = 0;
196 if(l > longest_distance)
197 longest_distance = l;
198 arr[i] = (size_t)(vmp++ - a_amv_var_map);
200 return arr;
202 #endif /* !HASH_MODE */
205 main(int argc, char **argv){
206 #ifdef HASH_MODE
207 size_t h = torek_hash(argv[1]);
209 printf("%lu\n", (unsigned long)h);
211 #else
212 size_t *arr, size = n_NELEM(a_amv_var_map);
214 fprintf(stderr, "Starting reversy, okeys=%zu\n", size);
215 for(;;){
216 arr = reversy(size = next_prime(size));
217 fprintf(stderr, " - size=%zu longest_distance=%zu seen_wraparound=%d\n",
218 size, longest_distance, seen_wraparound);
219 if(longest_distance <= MAX_DISTANCE_PENALTY)
220 break;
221 free(arr);
224 printf(
225 "#define a_AMV_VAR_REV_ILL %zuu\n"
226 "#define a_AMV_VAR_REV_PRIME %zuu\n"
227 "#define a_AMV_VAR_REV_LONGEST %zuu\n"
228 "#define a_AMV_VAR_REV_WRAPAROUND %d\n"
229 "static %s const a_amv_var_revmap[a_AMV_VAR_REV_PRIME] = {\n%s",
230 n_NELEM(a_amv_var_map), size, longest_distance, seen_wraparound,
231 argv[1], (argc > 2 ? " " : ""));
232 for(size_t i = 0; i < size; ++i)
233 printf("%s%zuu", (i == 0 ? ""
234 : (i % 10 == 0 ? (argc > 2 ? ",\n " : ",\n")
235 : (argc > 2 ? ", " : ","))),
236 arr[i]);
237 printf("\n};\n");
238 #endif
239 return 0;
241 _EOT
242 # <<<<<<<<<<<<<<<<<<<
243 close F
246 sub hash_em{
247 system("c99 -DHASH_MODE -I. -o $CTOOL_EXE $CTOOL");
249 foreach my $e (@ENTS){
250 my $h = `$CTOOL_EXE $e->{name}`;
251 chomp $h;
252 $e->{hash} = $h
256 sub dump_map{
257 die "$OUT: open: $^E" unless open F, '>', $OUT;
258 print F "/*@ $OUT, generated by $0 on ", scalar gmtime(), ".\n",
259 " *@ See accmacvar.c for more */\n\n";
261 print F 'static char const a_amv_var_names[] = {', "\n";
262 my ($i, $alen) = (0, 0);
263 my (%virts, %defvals, %i3vals);
264 foreach my $e (@ENTS){
265 $e->{keyoff} = $alen;
266 my $k = $e->{name};
267 my $l = length $k;
268 my $a = join '\',\'', split(//, $k);
269 my (@fa);
270 if($e->{bool}) {push @fa, 'a_AMV_VF_BOOL'}
271 if($e->{virt}){
272 # Virtuals are implicitly rdonly and nodel
273 $e->{rdonly} = $e->{nodel} = 1;
274 $virts{$k} = $e;
275 push @fa, 'a_AMV_VF_VIRT'
277 if($e->{i3val}){
278 $i3vals{$k} = $e;
279 push @fa, 'a_AMV_VF_I3VAL'
281 if($e->{defval}){
282 $e->{notempty} = 1;
283 $defvals{$k} = $e;
284 push @fa, 'a_AMV_VF_DEFVAL'
286 if($e->{import}){
287 $e->{env} = 1;
288 push @fa, 'a_AMV_VF_IMPORT'
290 if($e->{nolopts}) {push @fa, 'a_AMV_VF_NOLOPTS'}
291 if($e->{rdonly}) {push @fa, 'a_AMV_VF_RDONLY'}
292 if($e->{nodel}) {push @fa, 'a_AMV_VF_NODEL'}
293 if($e->{notempty}) {push @fa, 'a_AMV_VF_NOTEMPTY'}
294 if($e->{nocntrls}) {push @fa, 'a_AMV_VF_NOCNTRLS'}
295 if($e->{num}) {push @fa, 'a_AMV_VF_NUM'}
296 if($e->{posnum}) {push @fa, 'a_AMV_VF_POSNUM'}
297 if($e->{lower}) {push @fa, 'a_AMV_VF_LOWER'}
298 if($e->{vip}) {push @fa, 'a_AMV_VF_VIP'}
299 if($e->{env}) {push @fa, 'a_AMV_VF_ENV'}
300 $e->{flags} = \@fa;
301 my $f = join('|', @fa);
302 $f = ', ' . $f if length $f;
303 print F "${S}/* $i. [$alen]+$l $k$f */\n" if $VERB;
304 print F "${S}'$a','\\0',\n";
305 ++$i;
306 $alen += $l + 1
308 print F '};', "\n\n";
310 print F 'n_CTA(a_AMV_VF_NONE == 0, "Value not 0 as expected");', "\n";
311 print F 'static struct a_amv_var_map const a_amv_var_map[] = {', "\n";
312 foreach my $e (@ENTS){
313 my $f = $VERB ? 'a_AMV_VF_NONE' : '0';
314 my $fa = join '|', @{$e->{flags}};
315 $f .= '|' . $fa if length $fa;
316 print F "${S}{$e->{hash}u, $e->{keyoff}u, $f},";
317 if($VERB) {print F "${S}/* $e->{name} */\n"}
318 else {print F "\n"}
320 print F '};', "\n\n";
322 # We have at least version stuff in here
323 # The problem is that struct var uses a variable sized character buffer
324 # which cannot be initialized in a conforming way :(
325 print F <<_EOT;
326 #ifndef __CREATE_OKEY_MAP_PL
327 # ifdef HAVE_PUTENV
328 # define a_X(X) X
329 # else
330 # define a_X(X)
331 # endif
333 /* Unfortunately init of varsized buffer won't work: define "subclass"es */
334 _EOT
335 my @skeys = sort keys %virts;
337 foreach(@skeys){
338 my $e = $virts{$_};
339 $e->{vname} = $1 if $e->{enum} =~ /ok_._(.*)/;
340 $e->{vstruct} = "var_virt_$e->{vname}";
341 print F "static char const a_amv_$e->{vstruct}_val[] = {$e->{virt}};\n";
342 print F "static struct{\n";
343 print F "${S}struct a_amv_var *av_link;\n";
344 print F "${S}char const *av_value;\n";
345 print F "${S}a_X(char *av_env;)\n";
346 print F "${S}ui16_t av_flags;\n";
347 print F "${S}char const av_name[", length($e->{name}), " +1];\n";
348 my $f = $VERB ? 'a_AMV_VF_NONE' : '0';
349 my $fa = join '|', @{$e->{flags}};
350 $f .= '|' . $fa if length $fa;
351 print F "} const a_amv_$e->{vstruct} = ",
352 "{NULL, a_amv_$e->{vstruct}_val, a_X(0 COMMA) $f, ",
353 "\"$e->{name}\"};\n\n"
355 print F "# undef a_X\n";
357 print F "\n";
358 print F '#define a_AMV_VAR_VIRTS_CNT ', scalar @skeys, "\n";
359 print F 'static struct a_amv_var_virt const a_amv_var_virts[] = {', "\n";
360 foreach(@skeys){
361 my $e = $virts{$_};
362 my $n = $1 if $e->{enum} =~ /ok_._(.*)/;
363 print F "${S}{$e->{enum}, {0,}, (void const*)&a_amv_$e->{vstruct}},\n";
365 print F "};\n";
368 @skeys = sort keys %i3vals;
370 print F "\n";
371 print F '#define a_AMV_VAR_I3VALS_CNT ', scalar @skeys, "\n";
372 print F 'static struct a_amv_var_defval const a_amv_var_i3vals[] = {', "\n";
373 foreach(@skeys){
374 my $e = $i3vals{$_};
375 print F "${S}{", $e->{enum}, ', {0,}, ',
376 (!$e->{bool} ? $e->{i3val} : "NULL"), "},\n"
378 print F "};\n";
381 @skeys = sort keys %defvals;
383 print F "\n";
384 print F '#define a_AMV_VAR_DEFVALS_CNT ', scalar @skeys, "\n";
385 print F 'static struct a_amv_var_defval const a_amv_var_defvals[] = {', "\n";
386 foreach(@skeys){
387 my $e = $defvals{$_};
388 print F "${S}{", $e->{enum}, ', {0,}, ',
389 (!$e->{bool} ? $e->{defval} : "NULL"), "},\n"
391 print F "};\n";
393 print F "#endif /* __CREATE_OKEY_MAP_PL */\n\n";
395 die "$OUT: close: $^E" unless close F
398 sub reverser{
399 my $argv2 = $VERB ? ' verb' : '';
400 system("c99 -I. -o $CTOOL_EXE $CTOOL");
401 my $t = (@ENTS < 0xFF ? 'ui8_t' : (@ENTS < 0xFFFF ? 'ui16_t' : 'ui32_t'));
402 `$CTOOL_EXE $t$argv2 >> $OUT`
405 {package main; main_fun()}
407 # s-it-mode