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