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