opcode.pl revision 1
1N/A# Regenerate (overwriting only if changed): 1N/A# from information stored in the DATA section of this file, plus the 1N/A# values hardcoded into this script in @raw_alias. 1N/A# Accepts the standard regen_lib -q and -v args. 1N/A # Get function prototypes 1N/A# Format is "this function" => "does these op names" 1N/A # All the ops with a body of { return NORMAL; } 1N/A *
Copyright (C)
1993,
1994,
1995,
1996,
1997,
1998,
1999,
2000,
1N/A#ifndef PERL_GLOBAL_STRUCT_INIT 1N/A#define Perl_pp_i_preinc Perl_pp_preinc 1N/A#define Perl_pp_i_predec Perl_pp_predec 1N/A#define Perl_pp_i_postinc Perl_pp_postinc 1N/A#define Perl_pp_i_postdec Perl_pp_postdec 1N/A *
Copyright (C)
1999,
2000,
2001,
2002,
2003,
2004,
2005,
2006,
1N/A # print $on "\t", &tab(3,"OP_\U$_,"), "/* ", $i++, " */\n"; 1N/A print $
on "\t", &
tab(
3,
"OP_\U$_"),
" = ", $i++,
",\n";
1N/Aprint $
on "\n#define MAXO ",
scalar @
ops,
"\n";
1N/Aprint $
on "#define OP_phoney_INPUT_ONLY -1\n";
1N/Aprint $
on "#define OP_phoney_OUTPUT_ONLY -2\n\n";
1N/A# Emit op names and descriptions. 1N/A#define OP_NAME(o) ((o)->op_type == OP_CUSTOM ? custom_op_name(o) : \\ 1N/A#define OP_DESC(o) ((o)->op_type == OP_CUSTOM ? custom_op_desc(o) : \\ 1N/A print qq(\t
"$_",\n);
1N/A # Have to escape double quotes and escape characters. 1N/A print qq(\t
"$safe_desc",\n);
1N/A#endif /* !PERL_GLOBAL_STRUCT_INIT */ 1N/A# Emit function declarations. 1N/A#for (sort keys %ckname) { 1N/A# print "OP *\t", &tab(3,$_),"(pTHX_ OP* o);\n"; 1N/A# print "OP *\t", &tab(3, "pp_$_"), "(pTHX);\n"; 1N/A# Emit ppcode switch array. 1N/A#ifdef PERL_GLOBAL_STRUCT_INIT 1N/A# define PERL_PPADDR_INITED 1N/A# ifndef PERL_GLOBAL_STRUCT 1N/A# define PERL_PPADDR_INITED 1N/A#endif /* PERL_GLOBAL_STRUCT */ 1N/A#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT) 1N/A# define PERL_PPADDR_INITED 1N/A print "\tMEMBER_TO_FPTR($name),\t/* Perl_pp_$_ */\n";
1N/A print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n";
1N/A#ifdef PERL_PPADDR_INITED 1N/A# Emit check routines. 1N/A#ifdef PERL_GLOBAL_STRUCT_INIT 1N/A# define PERL_CHECK_INITED 1N/A# ifndef PERL_GLOBAL_STRUCT 1N/A# define PERL_CHECK_INITED 1N/A#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT) 1N/A# define PERL_CHECK_INITED 1N/A print "\t", &
tab(
3,
"MEMBER_TO_FPTR(Perl_$check{$_}),"),
"\t/* $_ */\n";
1N/A#ifdef PERL_CHECK_INITED 1N/A#endif /* #ifdef PERL_CHECK_INITED */ 1N/A# Emit allowed argument types. 1N/A#ifndef PERL_GLOBAL_STRUCT_INIT 1N/A 'A',
3,
# array value 1N/A 'H',
4,
# hash value 1N/A 'C',
5,
# code value 1N/A 'F',
6,
# file value 1N/A 'R',
7,
# scalar reference 1N/A '$',
6,
# svop_or_padop 1N/A '"',
8,
# pvop_or_svop 1N/A '%',
11,
# baseop_or_unop 1N/A '-',
12,
# filestatop 1N/A 'm' =>
1,
# needs stack mark 1N/A 'f' =>
2,
# fold constants 1N/A 's' =>
4,
# always produces scalar 1N/A 't' =>
8,
# needs target scalar 1N/A 'T' =>
8 |
256,
# ... which may be lexical 1N/A 'i' =>
16,
# always produces integer 1N/A 'I' =>
32,
# has corresponding int op 1N/A 'd' =>
64,
# danger, unknown side effects 1N/A 'u' =>
128,
# defaults to $_ 1N/A die "Flag collision for '$op' ($flags{$op}, $flag)\n" 1N/A # record opnums of these opnames 1N/A die "op = $op, arg = $arg\n" 1N/A die "Argument overflow for '$op'\n" 1N/A print "\t", &
tab(
3,
"$argsum,"),
"/* $op */\n";
1N/A#endif /* !PERL_GLOBAL_STRUCT_INIT */ 1N/A# Emit OP_IS_* macros 1N/A # get opnames whose numbers are lowest and highest 1N/A die "Invalid range of ops: $first .. $last\n" unless $
last;
1N/A print $
on "#define $macname(op) \\\n\t(";
1N/A # verify that op-ct matches 1st..last range (and fencepost) 1N/A # (we know there are no dups) 1N/A # contiguous ops -> optimized version 1N/A print $
on join(
" || \\\n\t ",
1N/A map {
"(op) == OP_" .
uc() }
sort keys %$
op_is);
1N/Aprint $
oc "/* ex: set ro: */\n";
1N/Aprint $
on "/* ex: set ro: */\n";
1N/A# -*- buffer-read-only: t -*- 1N/A# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 1N/A# This file is built by opcode.pl from its data. Any changes made here 1N/A print $
pp "PERL_CKDEF(Perl_$_)\n";
1N/A#OP *\t", &tab(3,$_),"(OP* o);\n"; 1N/A print $
pp "PERL_PPDEF(Perl_pp_$_)\n";
1N/Aprint $
pp "\n/* ex: set ro: */\n";
1N/A foreach (
'opcode.h',
'opnames.h',
'pp_proto.h',
'pp.sym') {
1N/A 1 while unlink "$_-old";
1N/A########################################################################### 1N/A $t .=
"\t" x ($l - (
length($t) +
1) /
8);
1N/A########################################################################### 1N/A# Some comments about 'T' opcode classifier: 1N/A# Safe to set if the ppcode uses: 1N/A# tryAMAGICbin, tryAMAGICun, SETn, SETi, SETu, PUSHn, PUSHTARG, SETTARG, 1N/A# SETs(TARG), XPUSHn, XPUSHu, 1N/A# Unsafe to set if the ppcode uses dTARG or [X]RETPUSH[YES|NO|UNDEF] 1N/A# lt and friends do SETs (including ncmp, but not scmp) 1N/A# Additional mode of failure: the opcode can modify TARG before it "used" 1N/A# all the arguments (or may call an external function which does the same). 1N/A# If the target coincides with one of the arguments ==> kaboom. 1N/A# pp.c pos substr each not OK (RETPUSHUNDEF) 1N/A# substr vec also not OK due to LV to target (are they???) 1N/A# ref not OK (RETPUSHNO) 1N/A# trans not OK (dTARG; TARG = sv_newmortal();) 1N/A# ucfirst etc not OK: TMP arg processed inplace 1N/A# quotemeta not OK (unsafe when TARG == arg) 1N/A# each repeat not OK too due to list context 1N/A# pack split - unknown whether they are safe 1N/A# sprintf: is calling do_sprintf(TARG,...) which can act on TARG 1N/A# before other args are processed. 1N/A# Suspicious wrt "additional mode of failure" (and only it): 1N/A# Also suspicious: 4-arg substr, sprintf, uc/lc (POK_only), reverse, pack. 1N/A# readline - unknown whether it is safe 1N/A# match subst not OK (dTARG) 1N/A# grepwhile not OK (not always setting) 1N/A# join not OK (unsafe when TARG == arg) 1N/A# Suspicious wrt "additional mode of failure": concat (dealt with 1N/A# in ck_sassign()), join (same). 1N/A# mapwhile flip caller not OK (not always setting) 1N/A# backtick glob warn die not OK (not always setting) 1N/A# warn not OK (RETPUSHYES) 1N/A# open fileno getc sysread syswrite ioctl accept shutdown 1N/A# ftsize(etc) readlink telldir fork alarm getlogin not OK (RETPUSHUNDEF) 1N/A# umask select not OK (XPUSHs(&PL_sv_undef);) 1N/A# fileno getc sysread syswrite tell not OK (meth("FILENO" "GETC")) 1N/A# sselect shm* sem* msg* syscall - unknown whether they are safe 1N/A# gmtime not OK (list context) 1N/A# Suspicious wrt "additional mode of failure": warn, die, select. 1N/A# New ops always go at the end 1N/A# The restriction on having custom as the last op has been removed 1N/A# A recapitulation of the format of this file: 1N/A# The file consists of five columns: the name of the op, an English 1N/A# description, the name of the "check" routine used to optimize this 1N/A# operation, some flags, and a description of the operands. 1N/A# The flags consist of options followed by a mandatory op class signifier 1N/A# baseop - 0 unop - 1 binop - 2 1N/A# logop - | listop - @ pmop - / 1N/A# needs stack mark - m 1N/A# needs constant folding - f 1N/A# produces a scalar - s 1N/A# produces an integer - i 1N/A# target can be in a pad - T 1N/A# has a corresponding integer version - I 1N/A# has side effects - d 1N/A# uses $_ if no argument given - u 1N/A# Values for the operands are: 1N/A# scalar - S list - L array - A 1N/A# hash - H sub (CV) - C file - F 1N/A# socket - Fs filetest - F- filetest_access - F-+ 1N/A# "?" denotes an optional operand. 1N/A# References and stuff. 1N/A# glob defaults its first arg to $_ 1N/A# Bindable operators. 1N/A# sassign is special-cased for op class 1N/A# Ordinary operators. 1N/A# High falutin' math. 1N/A# Explosives and implosives. 1N/A# truncate really behaves as if it had both "S S" and "F S" 1N/A# Sockets. OP_IS_SOCKET wants them consecutive (so moved 1st 2) 1N/A# Stat calls. OP_IS_FILETEST wants them consecutive. 1N/A# chdir really behaves as if it had both "S?" and "F?" 1N/A# NOTE: MacOS patches the 'i' of time() away later when the interpreter 1N/A# is created because in MacOS time() is already returning times > 2**31-1, 1N/A# that is, non-integers. 1N/A#evalonce eval constant string ck_null d1 S 1N/A# For multi-threading