Commit | Line | Data |
bab3dc31 |
1 | #!/usr/bin/perl -w |
2 | |
3 | # |
4 | # Generate overload.h |
8c798f87 |
5 | # This allows the order of overloading constants to be changed. |
bab3dc31 |
6 | # |
7 | |
8 | BEGIN { |
9 | # Get function prototypes |
10 | require 'regen_lib.pl'; |
11 | } |
12 | |
13 | use strict; |
14 | |
15 | my (@enums, @names); |
16 | while (<DATA>) { |
17 | next if /^#/; |
18 | next if /^$/; |
19 | my ($enum, $name) = /^(\S+)\s+(\S+)/ or die "Can't parse $_"; |
20 | push @enums, $enum; |
21 | push @names, $name; |
22 | } |
23 | |
8261f8eb |
24 | safer_unlink ('overload.h', 'overload.c'); |
08858ed2 |
25 | my $c = safer_open("overload.c"); |
26 | my $h = safer_open("overload.h"); |
8261f8eb |
27 | |
28 | sub print_header { |
29 | my $file = shift; |
30 | print <<"EOF"; |
bab3dc31 |
31 | /* -*- buffer-read-only: t -*- |
32 | * |
8261f8eb |
33 | * $file |
bab3dc31 |
34 | * |
38f14693 |
35 | * Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall |
36 | * and others |
bab3dc31 |
37 | * |
38 | * You may distribute under the terms of either the GNU General Public |
39 | * License or the Artistic License, as specified in the README file. |
40 | * |
41 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
42 | * This file is built by overload.pl |
43 | */ |
8261f8eb |
44 | EOF |
45 | } |
46 | |
08858ed2 |
47 | select $c; |
8261f8eb |
48 | print_header('overload.c'); |
49 | |
08858ed2 |
50 | select $h; |
8261f8eb |
51 | print_header('overload.h'); |
52 | print <<'EOF'; |
bab3dc31 |
53 | |
54 | enum { |
55 | EOF |
56 | |
57 | print " ${_}_amg,\n", foreach @enums; |
58 | |
59 | print <<'EOF'; |
60 | max_amg_code |
61 | /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */ |
62 | }; |
63 | |
bab3dc31 |
64 | #define NofAMmeth max_amg_code |
8261f8eb |
65 | |
66 | EOF |
67 | |
08858ed2 |
68 | print $c <<'EOF'; |
8261f8eb |
69 | |
bab3dc31 |
70 | #define AMG_id2name(id) (PL_AMG_names[id]+1) |
82af6593 |
71 | #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1) |
bab3dc31 |
72 | |
2e1c5ef0 |
73 | static const U8 PL_AMG_namelens[NofAMmeth] = { |
d279ab82 |
74 | EOF |
75 | |
76 | my $last = pop @names; |
77 | |
08858ed2 |
78 | print $c " $_,\n" foreach map { length $_ } @names; |
d279ab82 |
79 | |
80 | my $lastlen = length $last; |
08858ed2 |
81 | print $c <<"EOT"; |
d279ab82 |
82 | $lastlen |
83 | }; |
84 | |
2e1c5ef0 |
85 | static const char * const PL_AMG_names[NofAMmeth] = { |
bab3dc31 |
86 | /* Names kept in the symbol table. fallback => "()", the rest has |
87 | "(" prepended. The only other place in perl which knows about |
88 | this convention is AMG_id2name (used for debugging output and |
89 | 'nomethod' only), the only other place which has it hardwired is |
90 | overload.pm. */ |
d279ab82 |
91 | EOT |
bab3dc31 |
92 | |
08858ed2 |
93 | print $c " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names; |
bab3dc31 |
94 | |
08858ed2 |
95 | print $c <<"EOT"; |
bab3dc31 |
96 | "$last" |
97 | }; |
bab3dc31 |
98 | EOT |
99 | |
08858ed2 |
100 | safer_close($h); |
101 | safer_close($c); |
8c798f87 |
102 | |
bab3dc31 |
103 | __DATA__ |
104 | # Fallback should be the first |
105 | fallback () |
106 | |
107 | # These 5 are the most common in the fallback switch statement in amagic_call |
108 | to_sv (${} |
109 | to_av (@{} |
110 | to_hv (%{} |
111 | to_gv (*{} |
112 | to_cv (&{} |
113 | |
114 | # These have non-default cases in that switch statement |
115 | inc (++ |
116 | dec (-- |
117 | bool_ (bool |
118 | numer (0+ |
119 | string ("" |
120 | not (! |
121 | copy (= |
122 | abs (abs |
123 | neg (neg |
124 | iter (<> |
125 | int (int |
126 | |
127 | # These 12 feature in the next switch statement |
128 | lt (< |
129 | le (<= |
130 | gt (> |
131 | ge (>= |
132 | eq (== |
133 | ne (!= |
134 | slt (lt |
135 | sle (le |
136 | sgt (gt |
137 | sge (ge |
138 | seq (eq |
139 | sne (ne |
140 | |
141 | nomethod (nomethod |
142 | add (+ |
143 | add_ass (+= |
144 | subtr (- |
145 | subtr_ass (-= |
146 | mult (* |
147 | mult_ass (*= |
148 | div (/ |
149 | div_ass (/= |
150 | modulo (% |
151 | modulo_ass (%= |
152 | pow (** |
153 | pow_ass (**= |
154 | lshift (<< |
155 | lshift_ass (<<= |
156 | rshift (>> |
157 | rshift_ass (>>= |
158 | band (& |
159 | band_ass (&= |
160 | bor (| |
161 | bor_ass (|= |
162 | bxor (^ |
163 | bxor_ass (^= |
164 | ncmp (<=> |
165 | scmp (cmp |
166 | compl (~ |
167 | atan2 (atan2 |
168 | cos (cos |
169 | sin (sin |
170 | exp (exp |
171 | log (log |
172 | sqrt (sqrt |
173 | repeat (x |
174 | repeat_ass (x= |
175 | concat (. |
176 | concat_ass (.= |
177 | smart (~~ |
178 | # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry |
179 | DESTROY DESTROY |