regen/scope_types.pl

   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
  25 BEGIN {
  26     # Get function prototypes
  27     require './regen/regen_lib.pl';
  28 }
  29
  30 use strict;
  31 use warnings;
  32
  33 my %args= (
  34     "zero"  => 0,
  35     "one"   => 1,
  36     "two"   => 2,
  37     "three" => 3,
  38 );
  39 my $nargs= 0;
  40 my @arg_num;
  41 my @types;
  42 my $tlen= 0;
  43 my @lines;
  44
  45 foreach 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
  62 my $c_code= "";
  63 foreach 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
  75 static const U8 leave_scope_arg_counts[] = {
  76 EOF_C
  77
  78 foreach 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 }
  84 my $max_savet= $#arg_num;
  85
  86 $c_code .= <<EOF_C;
  87 };
  88
  89 #define MAX_SAVEt $max_savet
  90 EOF_C
  91
  92 my $final= <<'EOF_FINAL';
  93 The defines and contents of the leave_scope_arg_counts[] array
  94 must match. To add a new type modify the __DATA__ section in
  95 regen/scope_types.pl and run `make regen` to rebuild the file.
  96 EOF_FINAL
  97
  98 my $out= open_new(
  99     'scope_types.h',
 100     '>', {
 101         by        => 'regen/scope_types.pl',
 102         copyright => [2022],
 103         final     => $final,
 104     });
 105 print $out $c_code;
 106 read_only_bottom_close_and_rename($out);
 107
 108 __DATA__
 109 /* zero args */
 110
 111 SAVEt_ALLOC
 112 SAVEt_CLEARPADRANGE
 113 SAVEt_CLEARSV
 114 SAVEt_REGCONTEXT
 115
 116 /* one arg */
 117
 118 SAVEt_TMPSFLOOR
 119 SAVEt_BOOL
 120 SAVEt_COMPILE_WARNINGS
 121 SAVEt_CURCOP_WARNINGS
 122 SAVEt_COMPPAD
 123 SAVEt_FREECOPHH
 124 SAVEt_FREEOP
 125 SAVEt_FREEPV
 126 SAVEt_FREESV
 127 SAVEt_I16
 128 SAVEt_I32_SMALL
 129 SAVEt_I8
 130 SAVEt_INT_SMALL
 131 SAVEt_MORTALIZESV
 132 SAVEt_NSTAB
 133 SAVEt_OP
 134 SAVEt_PARSER
 135 SAVEt_STACK_POS
 136 SAVEt_READONLY_OFF
 137 SAVEt_FREEPADNAME
 138 SAVEt_STRLEN_SMALL
 139
 140 /* two args */
 141
 142 SAVEt_AV
 143 SAVEt_DESTRUCTOR
 144 SAVEt_DESTRUCTOR_X
 145 SAVEt_GENERIC_PVREF
 146 SAVEt_GENERIC_SVREF
 147 SAVEt_GP
 148 SAVEt_GVSV
 149 SAVEt_HINTS
 150 SAVEt_HPTR
 151 SAVEt_HV
 152 SAVEt_I32
 153 SAVEt_INT
 154 SAVEt_ITEM
 155 SAVEt_IV
 156 SAVEt_LONG
 157 SAVEt_PPTR
 158 SAVEt_SAVESWITCHSTACK
 159 SAVEt_SHARED_PVREF
 160 SAVEt_SPTR
 161 SAVEt_STRLEN
 162 SAVEt_SV
 163 SAVEt_SVREF
 164 SAVEt_VPTR
 165 SAVEt_ADELETE
 166 SAVEt_APTR
 167 SAVEt_RCPV_FREE
 168
 169 /* three args */
 170
 171 SAVEt_HELEM
 172 SAVEt_PADSV_AND_MORTALIZE
 173 SAVEt_SET_SVFLAGS
 174 SAVEt_GVSLOT
 175 SAVEt_AELEM
 176 SAVEt_DELETE
 177 SAVEt_HINTS_HH