Further yak-shaving on Pod::Usage. Now, t/pod/pod2usage2.t tests
[perl.git] / regcomp.pl
1 BEGIN {
2     # Get function prototypes
3     require 'regen_lib.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 binmode OUT;
26
27 print OUT <<EOP;
28 /* -*- buffer-read-only: t -*-
29    !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
30    This file is built by regcomp.pl from regcomp.sym.
31    Any changes made here will be lost!
32 */
33
34 EOP
35
36 $ind = 0;
37 while (++$ind <= $tot) {
38   $oind = $ind - 1;
39   $hind = sprintf "%#4x", $oind;
40   print OUT <<EOP;
41 #define $name[$ind]     $oind   /* $hind $rest[$ind] */
42 EOP
43 }
44
45 print OUT <<EOP;
46
47 #ifndef DOINIT
48 EXTCONST U8 PL_regkind[];
49 #else
50 EXTCONST U8 PL_regkind[] = {
51 EOP
52
53 $ind = 0;
54 while (++$ind <= $tot) {
55   print OUT <<EOP;
56         $type[$ind],            /* $name[$ind] */
57 EOP
58 }
59
60 print OUT <<EOP;
61 };
62 #endif
63
64
65 #ifdef REG_COMP_C
66 static const U8 regarglen[] = {
67 EOP
68
69 $ind = 0;
70 while (++$ind <= $tot) {
71   $size = 0;
72   $size = "EXTRA_SIZE(struct regnode_$args[$ind])" if $args[$ind];
73   
74   print OUT <<EOP;
75         $size,          /* $name[$ind] */
76 EOP
77 }
78
79 print OUT <<EOP;
80 };
81
82 static const char reg_off_by_arg[] = {
83 EOP
84
85 $ind = 0;
86 while (++$ind <= $tot) {
87   $size = $longj[$ind] || 0;
88
89   print OUT <<EOP;
90         $size,          /* $name[$ind] */
91 EOP
92 }
93
94 print OUT <<EOP;
95 };
96
97 #ifdef DEBUGGING
98 static const char * const reg_name[] = {
99 EOP
100
101 $ind = 0;
102 while (++$ind <= $tot) {
103   $hind = sprintf "%#4x", $ind-1;
104   $size = $longj[$ind] || 0;
105
106   print OUT <<EOP;
107         "$name[$ind]",          /* $hind */
108 EOP
109 }
110
111 print OUT <<EOP;
112 };
113
114 static const int reg_num = $tot;
115
116 #endif /* DEBUGGING */
117 #endif /* REG_COMP_C */
118
119 /* ex: set ro: */
120 EOP
121
122 close OUT or die "close $tmp_h: $!";
123
124 safer_rename $tmp_h, 'regnodes.h';