nail.1: external-body should not be loaded automatically
[s-mailx.git] / make-okey-map.pl
blob9cfebf91e036ab49ddc82cfb0884d954bbe8126a
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
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 $MAILX = 'LC_ALL=C s-nail -#:/';
14 my $OUT = 'gen-okeys.h';
16 ## -- >8 -- 8< -- ##
18 use diagnostics -verbose;
19 use strict;
20 use warnings;
22 use FileHandle;
23 use IPC::Open2;
25 use sigtrap qw(handler cleanup normal-signals);
27 my ($S, @ENTS, $CTOOL, $CTOOL_EXE) = ($VERB ? ' ' : '');
29 sub main_fun{
30 if(@ARGV) {$VERB = 0; $S = ''}
32 parse_nail_h();
34 create_c_tool();
36 hash_em();
38 dump_map();
40 reverser();
42 cleanup(undef);
43 exit 0
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]
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;
63 # Ignore empty and comment lines
64 /^$/ && next;
65 /^\s*\/\*/ && next;
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
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
102 push @ENTS, \%vals
104 if($init != 2) {die 'nail.h does not have the expected content'}
105 close F
108 sub create_c_tool{
109 $CTOOL = './tmp-okey-tool-' . $$ . '.c';
110 $CTOOL_EXE = $CTOOL . '.exe';
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 __CREATE_OKEY_MAP_PL
117 #include <stdint.h>
118 #include <stdlib.h>
119 #include <stdio.h>
120 #include <string.h>
122 #define n_NELEM(A) (sizeof(A) / sizeof(A[0]))
124 #define ui32_t uint32_t
125 #define ui16_t uint16_t
126 #define ui8_t uint8_t
128 enum a_amv_var_flags{
129 a_AMV_VF_NONE = 0,
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,
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
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 */
165 #define n_CTA(A,S)
166 #include "gen-okeys.h"
168 static ui8_t seen_wraparound;
169 static size_t longest_distance;
171 static size_t
172 next_prime(size_t no){ /* blush (brute force) */
173 jredo:
174 ++no;
175 for(size_t i = 3; i < no; i += 2)
176 if(no % i == 0)
177 goto jredo;
178 return no;
181 static size_t *
182 reversy(size_t size){
183 struct a_amv_var_map const *vmp = a_amv_var_map,
184 *vmaxp = vmp + n_NELEM(a_amv_var_map);
185 size_t ldist = 0, *arr;
187 arr = malloc(sizeof *arr * size);
188 for(size_t i = 0; i < size; ++i)
189 arr[i] = n_NELEM(a_amv_var_map);
191 seen_wraparound = 0;
192 longest_distance = 0;
194 while(vmp < vmaxp){
195 ui32_t hash = vmp->avm_hash, i = hash % size, l;
197 for(l = 0; arr[i] != n_NELEM(a_amv_var_map); ++l)
198 if(++i == size){
199 seen_wraparound = 1;
200 i = 0;
202 if(l > longest_distance)
203 longest_distance = l;
204 arr[i] = (size_t)(vmp++ - a_amv_var_map);
206 return arr;
210 main(int argc, char **argv){
211 size_t *arr, size = n_NELEM(a_amv_var_map);
213 fprintf(stderr, "Starting reversy, okeys=%zu\n", size);
214 for(;;){
215 arr = reversy(size = next_prime(size));
216 fprintf(stderr, " - size=%zu longest_distance=%zu seen_wraparound=%d\n",
217 size, longest_distance, seen_wraparound);
218 if(longest_distance <= MAX_DISTANCE_PENALTY)
219 break;
220 free(arr);
223 printf(
224 "#define a_AMV_VAR_REV_ILL %zuu\n"
225 "#define a_AMV_VAR_REV_PRIME %zuu\n"
226 "#define a_AMV_VAR_REV_LONGEST %zuu\n"
227 "#define a_AMV_VAR_REV_WRAPAROUND %d\n"
228 "static %s const a_amv_var_revmap[a_AMV_VAR_REV_PRIME] = {\n%s",
229 n_NELEM(a_amv_var_map), size, longest_distance, seen_wraparound,
230 argv[1], (argc > 2 ? " " : ""));
231 for(size_t i = 0; i < size; ++i)
232 printf("%s%zuu", (i == 0 ? ""
233 : (i % 10 == 0 ? (argc > 2 ? ",\n " : ",\n")
234 : (argc > 2 ? ", " : ","))),
235 arr[i]);
236 printf("\n};\n");
237 return 0;
239 _EOT
240 # <<<<<<<<<<<<<<<<<<<
241 close F
244 sub hash_em{
245 die "hash_em: open: $^E"
246 unless my $pid = open2 *RFD, *WFD, $MAILX;
247 foreach my $e (@ENTS){
248 print WFD "vexpr hash $e->{name}\n";
249 my $h = <RFD>;
250 chomp $h;
251 $e->{hash} = $h
253 print WFD "x\n";
254 waitpid $pid, 0;
257 sub dump_map{
258 die "$OUT: open: $^E" unless open F, '>', $OUT;
259 print F "/*@ $OUT, generated by $0.\n",
260 " *@ See accmacvar.c for more */\n\n";
262 print F 'static char const a_amv_var_names[] = {', "\n";
263 my ($i, $alen) = (0, 0);
264 my (%virts, %defvals, %i3vals);
265 foreach my $e (@ENTS){
266 $e->{keyoff} = $alen;
267 my $k = $e->{name};
268 my $l = length $k;
269 my $a = join '\',\'', split(//, $k);
270 my (@fa);
271 if($e->{bool}) {push @fa, 'a_AMV_VF_BOOL'}
272 if($e->{virt}){
273 # Virtuals are implicitly rdonly and nodel
274 $e->{rdonly} = $e->{nodel} = 1;
275 $virts{$k} = $e;
276 push @fa, 'a_AMV_VF_VIRT'
278 if($e->{vip}) {push @fa, 'a_AMV_VF_VIP'}
279 if($e->{rdonly}) {push @fa, 'a_AMV_VF_RDONLY'}
280 if($e->{nodel}) {push @fa, 'a_AMV_VF_NODEL'}
281 if(defined $e->{i3val}){
282 $i3vals{$k} = $e;
283 push @fa, 'a_AMV_VF_I3VAL'
285 if($e->{defval}){
286 $defvals{$k} = $e;
287 push @fa, 'a_AMV_VF_DEFVAL'
289 if($e->{import}){
290 $e->{env} = 1;
291 push @fa, 'a_AMV_VF_IMPORT'
293 if($e->{env}) {push @fa, 'a_AMV_VF_ENV'}
294 if($e->{nolopts}) {push @fa, 'a_AMV_VF_NOLOPTS'}
295 if($e->{notempty}) {push @fa, 'a_AMV_VF_NOTEMPTY'}
296 if($e->{nocntrls}) {push @fa, 'a_AMV_VF_NOCNTRLS'}
297 if($e->{num}) {push @fa, 'a_AMV_VF_NUM'}
298 if($e->{posnum}) {push @fa, 'a_AMV_VF_POSNUM'}
299 if($e->{lower}) {push @fa, 'a_AMV_VF_LOWER'}
300 if($e->{chain}) {push @fa, 'a_AMV_VF_CHAIN'}
301 if($e->{obsolete}) {push @fa, 'a_AMV_VF_OBSOLETE'}
302 $e->{flags} = \@fa;
303 my $f = join('|', @fa);
304 $f = ', ' . $f if length $f;
305 print F "${S}/* $i. [$alen]+$l $k$f */\n" if $VERB;
306 print F "${S}'$a','\\0',\n";
307 ++$i;
308 $alen += $l + 1
310 print F '};', "\n\n";
312 print F 'n_CTA(a_AMV_VF_NONE == 0, "Value not 0 as expected");', "\n";
313 print F 'static struct a_amv_var_map const a_amv_var_map[] = {', "\n";
314 foreach my $e (@ENTS){
315 my $f = $VERB ? 'a_AMV_VF_NONE' : '0';
316 my $fa = join '|', @{$e->{flags}};
317 $f .= '|' . $fa if length $fa;
318 print F "${S}{$e->{hash}u, $e->{keyoff}u, $f},";
319 if($VERB) {print F "${S}/* $e->{name} */\n"}
320 else {print F "\n"}
322 print F '};', "\n\n";
324 # We have at least version stuff in here
325 # The problem is that struct var uses a variable sized character buffer
326 # which cannot be initialized in a conforming way :(
327 print F <<_EOT;
328 #ifndef __CREATE_OKEY_MAP_PL
329 # ifdef HAVE_PUTENV
330 # define a_X(X) X
331 # else
332 # define a_X(X)
333 # endif
335 /* Unfortunately init of varsized buffer won't work: define "subclass"es */
336 _EOT
337 my @skeys = sort keys %virts;
339 foreach(@skeys){
340 my $e = $virts{$_};
341 $e->{vname} = $1 if $e->{enum} =~ /ok_._(.*)/;
342 $e->{vstruct} = "var_virt_$e->{vname}";
343 print F "static char const a_amv_$e->{vstruct}_val[] = {$e->{virt}};\n";
344 print F "static struct{\n";
345 print F "${S}struct a_amv_var *av_link;\n";
346 print F "${S}char const *av_value;\n";
347 print F "${S}a_X(char *av_env;)\n";
348 print F "${S}ui32_t av_flags;\n";
349 print F "${S}char const av_name[", length($e->{name}), " +1];\n";
350 my $f = $VERB ? 'a_AMV_VF_NONE' : '0';
351 my $fa = join '|', @{$e->{flags}};
352 $f .= '|' . $fa if length $fa;
353 print F "} const a_amv_$e->{vstruct} = ",
354 "{NULL, a_amv_$e->{vstruct}_val, a_X(0 COMMA) $f, ",
355 "\"$e->{name}\"};\n\n"
357 print F "# undef a_X\n";
359 print F "\n";
360 print F '#define a_AMV_VAR_VIRTS_CNT ', scalar @skeys, "\n";
361 print F 'static struct a_amv_var_virt const a_amv_var_virts[] = {', "\n";
362 foreach(@skeys){
363 my $e = $virts{$_};
364 my $n = $1 if $e->{enum} =~ /ok_._(.*)/;
365 print F "${S}{$e->{enum}, {0,}, (void const*)&a_amv_$e->{vstruct}},\n";
367 print F "};\n";
370 @skeys = sort keys %i3vals;
372 print F "\n";
373 print F '#define a_AMV_VAR_I3VALS_CNT ', scalar @skeys, "\n";
374 print F 'static struct a_amv_var_defval const a_amv_var_i3vals[] = {', "\n";
375 foreach(@skeys){
376 my $e = $i3vals{$_};
377 print F "${S}{", $e->{enum}, ', {0,}, ',
378 (!$e->{bool} ? $e->{i3val} : "NULL"), "},\n"
380 print F "};\n";
383 @skeys = sort keys %defvals;
385 print F "\n";
386 print F '#define a_AMV_VAR_DEFVALS_CNT ', scalar @skeys, "\n";
387 print F 'static struct a_amv_var_defval const a_amv_var_defvals[] = {', "\n";
388 foreach(@skeys){
389 my $e = $defvals{$_};
390 print F "${S}{", $e->{enum}, ', {0,}, ',
391 (!$e->{bool} ? $e->{defval} : "NULL"), "},\n"
393 print F "};\n";
395 print F "#endif /* __CREATE_OKEY_MAP_PL */\n";
397 # Special var backing [#@*?]|[1-9][0-9]*|0
398 $i = 0;
399 print F "\n";
400 foreach my $e (@ENTS){
401 if($e->{name} eq '--special-param'){
402 print F "#define a_AMV_VAR__SPECIAL_PARAM_MAP_IDX ${i}u\n"
404 # The rest are only speedups
405 elsif($e->{name} eq '?'){
406 print F "#define a_AMV_VAR__QM_MAP_IDX ${i}u\n"
407 }elsif($e->{name} eq '!'){
408 print F "#define a_AMV_VAR__EM_MAP_IDX ${i}u\n"
410 ++$i
413 print F "\n";
414 die "$OUT: close: $^E" unless close F
417 sub reverser{
418 my $argv2 = $VERB ? ' verb' : '';
419 system("\$CC -I. -o $CTOOL_EXE $CTOOL");
420 my $t = (@ENTS < 0xFF ? 'ui8_t' : (@ENTS < 0xFFFF ? 'ui16_t' : 'ui32_t'));
421 `$CTOOL_EXE $t$argv2 >> $OUT`
424 {package main; main_fun()}
426 # s-it-mode