Support one-parameter unpack(), which unpacks $_.
[perl.git] / regcomp.pl
1 BEGIN {
2     # Get function prototypes
3     require 'regen.pl';
4 }
5 #use Fatal qw(open close rename chmod unlink);
6 open DESC, 'regcomp.sym';
7 $ind = 0;
8
9 while (<DESC>) {
10   next if /^\s*($|\#)/;
11   $ind++;
12   chomp;
13   ($name[$ind], $desc, $rest[$ind]) = split /\t+/, $_, 3;
14   ($type[$ind], $code[$ind], $args[$ind], $longj[$ind]) 
15     = split /[,\s]\s*/, $desc, 4;
16 }
17 close DESC;
18 $tot = $ind;
19
20 $tmp_h = 'tmp_reg.h';
21
22 unlink $tmp_h if -f $tmp_h;
23
24 open OUT, ">$tmp_h";
25
26 print OUT <<EOP;
27 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
28    This file is built by regcomp.pl from regcomp.sym.
29    Any changes made here will be lost!
30 */
31
32 EOP
33
34 $ind = 0;
35 while (++$ind <= $tot) {
36   $oind = $ind - 1;
37   $hind = sprintf "%#4x", $oind;
38   print OUT <<EOP;
39 #define $name[$ind]     $oind   /* $hind $rest[$ind] */
40 EOP
41 }
42
43 print OUT <<EOP;
44
45 #ifndef DOINIT
46 EXTCONST U8 PL_regkind[];
47 #else
48 EXTCONST U8 PL_regkind[] = {
49 EOP
50
51 $ind = 0;
52 while (++$ind <= $tot) {
53   print OUT <<EOP;
54         $type[$ind],            /* $name[$ind] */
55 EOP
56 }
57
58 print OUT <<EOP;
59 };
60 #endif
61
62
63 #ifdef REG_COMP_C
64 static const U8 regarglen[] = {
65 EOP
66
67 $ind = 0;
68 while (++$ind <= $tot) {
69   $size = 0;
70   $size = "EXTRA_SIZE(struct regnode_$args[$ind])" if $args[$ind];
71   
72   print OUT <<EOP;
73         $size,          /* $name[$ind] */
74 EOP
75 }
76
77 print OUT <<EOP;
78 };
79
80 static const char reg_off_by_arg[] = {
81 EOP
82
83 $ind = 0;
84 while (++$ind <= $tot) {
85   $size = $longj[$ind] || 0;
86
87   print OUT <<EOP;
88         $size,          /* $name[$ind] */
89 EOP
90 }
91
92 print OUT <<EOP;
93 };
94
95 #ifdef DEBUGGING
96 static const char * const reg_name[] = {
97 EOP
98
99 $ind = 0;
100 while (++$ind <= $tot) {
101   $hind = sprintf "%#4x", $ind-1;
102   $size = $longj[$ind] || 0;
103
104   print OUT <<EOP;
105         "$name[$ind]",          /* $hind */
106 EOP
107 }
108
109 print OUT <<EOP;
110 };
111
112 static const int reg_num = $tot;
113
114 #endif /* DEBUGGING */
115 #endif /* REG_COMP_C */
116
117 EOP
118
119 close OUT or die "close $tmp_h: $!";
120
121 safer_rename $tmp_h, 'regnodes.h';