This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: \Q doesn't work in interpolated regular expressions
[perl5.git] / regcomp.pl
1 #use Fatal qw(open close rename chmod unlink);
2 open DESC, 'regcomp.sym';
3 $ind = 0;
4
5 while (<DESC>) {
6   next if /^\s*($|\#)/;
7   $ind++;
8   chomp;
9   ($name[$ind], $desc, $rest[$ind]) = split /\t+/, $_, 3;
10   ($type[$ind], $code[$ind], $args[$ind], $longj[$ind]) 
11     = split /[,\s]\s*/, $desc, 4;
12 }
13 close DESC;
14 $tot = $ind;
15
16 $tmp_h = 'tmp_reg.h';
17
18 unlink $tmp_h if -f $tmp_h;
19
20 open OUT, ">$tmp_h";
21
22 print OUT <<EOP;
23 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
24    This file is built by regcomp.pl from regcomp.sym.  
25    Any changes made here will be lost!
26 */
27
28 EOP
29
30 $ind = 0;
31 while (++$ind <= $tot) {
32   $oind = $ind - 1;
33   $hind = sprintf "%#4x", $oind;
34   print OUT <<EOP;
35 #define $name[$ind]     $oind   /* $hind $rest[$ind] */
36 EOP
37 }
38
39 print OUT <<EOP;
40
41 #ifndef DOINIT
42 EXTCONST U8 regkind[];
43 #else
44 EXTCONST U8 regkind[] = {
45 EOP
46
47 $ind = 0;
48 while (++$ind <= $tot) {
49   print OUT <<EOP;
50         $type[$ind],            /* $name[$ind] */
51 EOP
52 }
53
54 print OUT <<EOP;
55 };
56 #endif
57
58
59 #ifdef REG_COMP_C
60 const static U8 regarglen[] = {
61 EOP
62
63 $ind = 0;
64 while (++$ind <= $tot) {
65   $size = 0;
66   $size = "EXTRA_SIZE(struct regnode_$args[$ind])" if $args[$ind];
67   
68   print OUT <<EOP;
69         $size,          /* $name[$ind] */
70 EOP
71 }
72
73 print OUT <<EOP;
74 };
75
76 const static char reg_off_by_arg[] = {
77 EOP
78
79 $ind = 0;
80 while (++$ind <= $tot) {
81   $size = $longj[$ind] || 0;
82   
83   print OUT <<EOP;
84         $size,          /* $name[$ind] */
85 EOP
86 }
87
88 print OUT <<EOP;
89 };
90 #endif /* REG_COMP_C */
91
92 EOP
93
94 close OUT;
95
96 chmod 0666, 'regnodes.h';
97 unlink 'regnodes.h';
98 rename $tmp_h, 'regnodes.h';