1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
#!/usr/bin/perl -w
#
#
# Regenerate (overwriting only if changed):
#
# scope_types.h
#
# from information contained in this file in the
# __DATA_ section below.
#
# To add a new type simply add its name to the list
# below in the correct section (marked by C comments)
# and then regenerate with 'make regen'.
#
# Accepts the standard regen_lib -q and -v args.
#
# This script is normally invoked from regen.pl.
# The style of this file is determined by:
#
# perltidy -w -ple -bbb -bbc -bbs -nolq -l=80 -noll -nola -nwls='=' \
# -isbc -nolc -otr -kis -ci=4 -se -sot -sct -nsbl -pt=2 -fs \
# -fsb='##!' -fse='##.'
BEGIN {
# Get function prototypes
require './regen/regen_lib.pl';
}
use strict;
use warnings;
my %args= (
"zero" => 0,
"one" => 1,
"two" => 2,
"three" => 3,
);
my $nargs= 0;
my @arg_num;
my @types;
my $tlen= 0;
my @lines;
foreach my $line (<DATA>) {
$line =~ s/\s+\z//;
if ($line =~ /(\w+) arg/) {
$nargs= $args{$1} // die "panic: Bad arg number '$1'";
}
if ($line =~ /^SAVEt/) {
my $id= 0 + @arg_num;
$tlen= length($line) if $tlen < length($line);
push @types, $line;
push @arg_num, [ $nargs, $line ];
push @lines, [ $line, $id ];
}
else {
push @lines, $line;
}
}
my $c_code= "";
foreach my $num (0 .. $#lines) {
my $line= $lines[$num];
if (ref $line) {
my ($type, $id)= @$line;
$line= sprintf "#define %*s %*d",
-$tlen, $type, length(0 + @types), $id;
}
$c_code .= $line . "\n";
}
$c_code .= <<EOF_C;
static const U8 leave_scope_arg_counts[] = {
EOF_C
foreach my $tuple (@arg_num) {
my ($nargs, $type)= @$tuple;
$c_code .= sprintf " %d%s /* %*s */\n",
$nargs, $tuple == $arg_num[-1] ? " " : ",",
-$tlen, $type;
}
my $max_savet= $#arg_num;
$c_code .= <<EOF_C;
};
#define MAX_SAVEt $max_savet
EOF_C
my $final= <<'EOF_FINAL';
The defines and contents of the leave_scope_arg_counts[] array
must match. To add a new type modify the __DATA__ section in
regen/scope_types.pl and run `make regen` to rebuild the file.
EOF_FINAL
my $out= open_new(
'scope_types.h',
'>', {
by => 'regen/scope_types.pl',
copyright => [2022],
final => $final,
});
print $out $c_code;
read_only_bottom_close_and_rename($out);
__DATA__
/* zero args */
SAVEt_ALLOC
SAVEt_CLEARPADRANGE
SAVEt_CLEARSV
SAVEt_REGCONTEXT
/* one arg */
SAVEt_TMPSFLOOR
SAVEt_BOOL
SAVEt_COMPILE_WARNINGS
SAVEt_CURCOP_WARNINGS
SAVEt_COMPPAD
SAVEt_FREECOPHH
SAVEt_FREEOP
SAVEt_FREEPV
SAVEt_FREESV
SAVEt_I16
SAVEt_I32_SMALL
SAVEt_I8
SAVEt_INT_SMALL
SAVEt_MORTALIZESV
SAVEt_NSTAB
SAVEt_OP
SAVEt_PARSER
SAVEt_STACK_POS
SAVEt_READONLY_OFF
SAVEt_FREEPADNAME
SAVEt_STRLEN_SMALL
SAVEt_FREERCPV
/* two args */
SAVEt_AV
SAVEt_DESTRUCTOR
SAVEt_DESTRUCTOR_X
SAVEt_GENERIC_PVREF
SAVEt_GENERIC_SVREF
SAVEt_GP
SAVEt_GVSV
SAVEt_HINTS
SAVEt_HPTR
SAVEt_HV
SAVEt_I32
SAVEt_INT
SAVEt_ITEM
SAVEt_IV
SAVEt_LONG
SAVEt_PPTR
SAVEt_SAVESWITCHSTACK
SAVEt_SHARED_PVREF
SAVEt_SPTR
SAVEt_STRLEN
SAVEt_SV
SAVEt_SVREF
SAVEt_VPTR
SAVEt_ADELETE
SAVEt_APTR
SAVEt_RCPV
/* three args */
SAVEt_HELEM
SAVEt_PADSV_AND_MORTALIZE
SAVEt_SET_SVFLAGS
SAVEt_GVSLOT
SAVEt_AELEM
SAVEt_DELETE
SAVEt_HINTS_HH
|
