Commit | Line | Data |
---|---|---|
36bb303b NC |
1 | BEGIN { |
2 | # Get function prototypes | |
9ad884cb | 3 | require 'regen_lib.pl'; |
36bb303b | 4 | } |
d09b2d29 | 5 | #use Fatal qw(open close rename chmod unlink); |
03363afd YO |
6 | use strict; |
7 | use warnings; | |
8 | ||
d09b2d29 | 9 | open DESC, 'regcomp.sym'; |
d09b2d29 | 10 | |
03363afd YO |
11 | my $ind = 0; |
12 | my (@name,@rest,@type,@code,@args,@longj); | |
13 | my ($desc,$lastregop); | |
d09b2d29 | 14 | while (<DESC>) { |
03363afd YO |
15 | s/#.*$//; |
16 | next if /^\s*$/; | |
17 | s/\s*\z//; | |
18 | if (/^-+\s*$/) { | |
19 | $lastregop= $ind; | |
20 | next; | |
21 | } | |
22 | unless ($lastregop) { | |
23 | $ind++; | |
24 | ($name[$ind], $desc, $rest[$ind]) = split /\t+/, $_, 3; | |
25 | ($type[$ind], $code[$ind], $args[$ind], $longj[$ind]) | |
26 | = split /[,\s]\s*/, $desc, 4; | |
27 | } else { | |
28 | my ($type,@lists)=split /\s*\t+\s*/, $_; | |
29 | die "No list? $type" if !@lists; | |
30 | foreach my $list (@lists) { | |
31 | my ($names,$special)=split /:/, $list , 2; | |
32 | $special ||= ""; | |
33 | foreach my $name (split /,/,$names) { | |
34 | my $real= $name eq 'resume' | |
35 | ? "resume_$type" | |
36 | : "${type}_$name"; | |
37 | my @suffix; | |
38 | if (!$special) { | |
39 | @suffix=(""); | |
40 | } elsif ($special=~/\d/) { | |
41 | @suffix=(1..$special); | |
42 | } elsif ($special eq 'FAIL') { | |
43 | @suffix=("","_fail"); | |
44 | } else { | |
45 | die "unknown :type ':$special'"; | |
46 | } | |
47 | foreach my $suffix (@suffix) { | |
48 | $ind++; | |
49 | $name[$ind]="$real$suffix"; | |
50 | $type[$ind]=$type; | |
24b23f37 | 51 | $rest[$ind]="state for $type"; |
03363afd YO |
52 | } |
53 | } | |
54 | } | |
55 | ||
56 | } | |
57 | } | |
5d458dd8 YO |
58 | # use fixed width to keep the diffs between regcomp.pl recompiles |
59 | # as small as possible. | |
60 | my ($width,$rwidth,$twidth)=(22,12,9); | |
03363afd YO |
61 | $lastregop ||= $ind; |
62 | my $tot = $ind; | |
d09b2d29 | 63 | close DESC; |
03363afd YO |
64 | die "Too many regexp/state opcodes! Maximum is 256, but there are $lastregop in file!" |
65 | if $lastregop>256; | |
d09b2d29 | 66 | |
03363afd | 67 | my $tmp_h = 'tmp_reg.h'; |
d09b2d29 IZ |
68 | |
69 | unlink $tmp_h if -f $tmp_h; | |
70 | ||
424a4936 | 71 | my $out = safer_open($tmp_h); |
d09b2d29 | 72 | |
424a4936 | 73 | printf $out <<EOP, |
37442d52 RGS |
74 | /* -*- buffer-read-only: t -*- |
75 | !!!!!!! DO NOT EDIT THIS FILE !!!!!!! | |
9b155405 | 76 | This file is built by regcomp.pl from regcomp.sym. |
d09b2d29 IZ |
77 | Any changes made here will be lost! |
78 | */ | |
79 | ||
6bda09f9 YO |
80 | /* Regops and State definitions */ |
81 | ||
03363afd YO |
82 | #define %*s\t%d |
83 | #define %*s\t%d | |
84 | ||
d09b2d29 | 85 | EOP |
f9f4320a YO |
86 | -$width, REGNODE_MAX => $lastregop - 1, |
87 | -$width, REGMATCH_STATE_MAX => $tot - 1 | |
88 | ; | |
d09b2d29 | 89 | |
24b23f37 YO |
90 | |
91 | for ($ind=1; $ind <= $lastregop ; $ind++) { | |
03363afd | 92 | my $oind = $ind - 1; |
424a4936 | 93 | printf $out "#define\t%*s\t%d\t/* %#04x %s */\n", |
03363afd | 94 | -$width, $name[$ind], $ind-1, $ind-1, $rest[$ind]; |
24b23f37 | 95 | } |
424a4936 | 96 | print $out "\t/* ------------ States ------------- */\n"; |
24b23f37 | 97 | for ( ; $ind <= $tot ; $ind++) { |
424a4936 | 98 | printf $out "#define\t%*s\t(REGNODE_MAX + %d)\t/* %s */\n", |
24b23f37 | 99 | -$width, $name[$ind], $ind - $lastregop, $rest[$ind]; |
d09b2d29 IZ |
100 | } |
101 | ||
424a4936 | 102 | print $out <<EOP; |
03363afd | 103 | |
6bda09f9 | 104 | /* PL_regkind[] What type of regop or state is this. */ |
d09b2d29 IZ |
105 | |
106 | #ifndef DOINIT | |
22c35a8c | 107 | EXTCONST U8 PL_regkind[]; |
d09b2d29 | 108 | #else |
22c35a8c | 109 | EXTCONST U8 PL_regkind[] = { |
d09b2d29 IZ |
110 | EOP |
111 | ||
112 | $ind = 0; | |
113 | while (++$ind <= $tot) { | |
424a4936 | 114 | printf $out "\t%*s\t/* %*s */\n", |
03363afd | 115 | -1-$twidth, "$type[$ind],", -$width, $name[$ind]; |
424a4936 | 116 | print $out "\t/* ------------ States ------------- */\n" |
03363afd | 117 | if $ind == $lastregop and $lastregop != $tot; |
d09b2d29 IZ |
118 | } |
119 | ||
424a4936 | 120 | print $out <<EOP; |
d09b2d29 IZ |
121 | }; |
122 | #endif | |
123 | ||
6bda09f9 | 124 | /* regarglen[] - How large is the argument part of the node (in regnodes) */ |
d09b2d29 IZ |
125 | |
126 | #ifdef REG_COMP_C | |
29de9391 | 127 | static const U8 regarglen[] = { |
d09b2d29 IZ |
128 | EOP |
129 | ||
130 | $ind = 0; | |
03363afd YO |
131 | while (++$ind <= $lastregop) { |
132 | my $size = 0; | |
d09b2d29 IZ |
133 | $size = "EXTRA_SIZE(struct regnode_$args[$ind])" if $args[$ind]; |
134 | ||
424a4936 | 135 | printf $out "\t%*s\t/* %*s */\n", |
03363afd | 136 | -37, "$size,",-$rwidth,$name[$ind]; |
d09b2d29 IZ |
137 | } |
138 | ||
424a4936 | 139 | print $out <<EOP; |
d09b2d29 IZ |
140 | }; |
141 | ||
6bda09f9 YO |
142 | /* reg_off_by_arg[] - Which argument holds the offset to the next node */ |
143 | ||
29de9391 | 144 | static const char reg_off_by_arg[] = { |
d09b2d29 IZ |
145 | EOP |
146 | ||
147 | $ind = 0; | |
03363afd YO |
148 | while (++$ind <= $lastregop) { |
149 | my $size = $longj[$ind] || 0; | |
9b155405 | 150 | |
424a4936 | 151 | printf $out "\t%d,\t/* %*s */\n", |
03363afd | 152 | $size, -$rwidth, $name[$ind] |
d09b2d29 IZ |
153 | } |
154 | ||
424a4936 | 155 | print $out <<EOP; |
d09b2d29 | 156 | }; |
9b155405 | 157 | |
13d6edb4 NC |
158 | #endif /* REG_COMP_C */ |
159 | ||
6bda09f9 YO |
160 | /* reg_name[] - Opcode/state names in string form, for debugging */ |
161 | ||
22429478 | 162 | #ifndef DOINIT |
13d6edb4 | 163 | EXTCONST char * PL_reg_name[]; |
22429478 | 164 | #else |
4764e399 | 165 | EXTCONST char * const PL_reg_name[] = { |
9b155405 IZ |
166 | EOP |
167 | ||
168 | $ind = 0; | |
24b23f37 YO |
169 | my $ofs = 1; |
170 | my $sym = ""; | |
9b155405 | 171 | while (++$ind <= $tot) { |
03363afd | 172 | my $size = $longj[$ind] || 0; |
9b155405 | 173 | |
424a4936 | 174 | printf $out "\t%*s\t/* $sym%#04x */\n", |
24b23f37 YO |
175 | -3-$width,qq("$name[$ind]",), $ind - $ofs; |
176 | if ($ind == $lastregop and $lastregop != $tot) { | |
424a4936 | 177 | print $out "\t/* ------------ States ------------- */\n"; |
24b23f37 YO |
178 | $ofs = $lastregop; |
179 | $sym = 'REGNODE_MAX +'; | |
180 | } | |
181 | ||
9b155405 IZ |
182 | } |
183 | ||
424a4936 | 184 | print $out <<EOP; |
9b155405 | 185 | }; |
22429478 | 186 | #endif /* DOINIT */ |
d09b2d29 | 187 | |
f7819f85 A |
188 | /* PL_reg_extflags_name[] - Opcode/state names in string form, for debugging */ |
189 | ||
190 | #ifndef DOINIT | |
191 | EXTCONST char * PL_reg_extflags_name[]; | |
192 | #else | |
193 | EXTCONST char * const PL_reg_extflags_name[] = { | |
d09b2d29 IZ |
194 | EOP |
195 | ||
f7819f85 A |
196 | open my $fh,"<","regexp.h" or die "Can't read regexp.h: $!"; |
197 | my %rxfv; | |
c8e4cf8b NC |
198 | my $val = 0; |
199 | my %reverse; | |
f7819f85 A |
200 | while (<$fh>) { |
201 | if (/#define\s+(RXf_\w+)\s+(0x[A-F\d]+)/i) { | |
c8e4cf8b NC |
202 | my $newval = eval $2; |
203 | if($val & $newval) { | |
204 | die sprintf "Both $1 and $reverse{$newval} use %08X", $newval; | |
205 | } | |
206 | $val|=$newval; | |
207 | $rxfv{$1}= $newval; | |
208 | $reverse{$newval} = $1; | |
f7819f85 A |
209 | } |
210 | } | |
211 | my %vrxf=reverse %rxfv; | |
424a4936 | 212 | printf $out "\t/* Bits in extflags defined: %032b */\n",$val; |
f7819f85 A |
213 | for (0..31) { |
214 | my $n=$vrxf{2**$_}||"UNUSED_BIT_$_"; | |
215 | $n=~s/^RXf_(PMf_)?//; | |
424a4936 | 216 | printf $out qq(\t%-20s/* 0x%08x */\n), |
f7819f85 A |
217 | qq("$n",),2**$_; |
218 | } | |
219 | ||
424a4936 | 220 | print $out <<EOP; |
f7819f85 A |
221 | }; |
222 | #endif /* DOINIT */ | |
223 | ||
224 | /* ex: set ro: */ | |
225 | EOP | |
08858ed2 | 226 | safer_close($out); |
d09b2d29 | 227 | |
424a4936 | 228 | rename_if_different $tmp_h, 'regnodes.h'; |