X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=opcode.pl;h=27cf87b5392c4d6e1517cb06fe38c37e0e6a80ed;hb=3fb41248088529e4dffd3e393588e067e2934fc0;hp=ffdc93de5f318c82e57979360516a2e21f3a1ff5;hpb=2d31dd6aa775ba3ae596182dab64c54df2e34ba1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/opcode.pl b/opcode.pl index ffdc93d..27cf87b 100755 --- a/opcode.pl +++ b/opcode.pl @@ -1,8 +1,15 @@ #!/usr/bin/perl +BEGIN { + # Get function prototypes + require 'regen_lib.pl'; +} -unlink "opcode.h", "opnames.h"; -open(OC, ">opcode.h") || die "Can't create opcode.h: $!\n"; -open(ON, ">opnames.h") || die "Can't create opnames.h: $!\n"; +$opcode_new = 'opcode.h-new'; +$opname_new = 'opnames.h-new'; +open(OC, ">$opcode_new") || die "Can't create $opcode_new: $!\n"; +binmode OC; +open(ON, ">$opname_new") || die "Can't create $opname_new: $!\n"; +binmode ON; select OC; # Read data. @@ -26,27 +33,94 @@ while () { $args{$key} = $args; } +# Set up aliases + +my %alias; + +# Format is "this function" => "does these op names" +my @raw_alias = ( + Perl_do_kv => [qw( keys values )], + Perl_unimplemented_op => [qw(padany threadsv mapstart)], + # All the ops with a body of { return NORMAL; } + Perl_pp_null => [qw(scalar regcmaybe lineseq scope)], + + Perl_pp_goto => ['dump'], + Perl_pp_require => ['dofile'], + Perl_pp_untie => ['dbmclose'], + Perl_pp_sysread => [qw(read recv)], + Perl_pp_sysseek => ['seek'], + Perl_pp_ioctl => ['fcntl'], + Perl_pp_ssockopt => ['gsockopt'], + Perl_pp_getpeername => ['getsockname'], + Perl_pp_stat => ['lstat'], + Perl_pp_ftrowned => [qw(fteowned ftzero ftsock ftchr ftblk + ftfile ftdir ftpipe ftsuid ftsgid + ftsvtx)], + Perl_pp_fttext => ['ftbinary'], + Perl_pp_gmtime => ['localtime'], + Perl_pp_semget => [qw(shmget msgget)], + Perl_pp_semctl => [qw(shmctl msgctl)], + Perl_pp_shmwrite => ['shmread'], + Perl_pp_ghostent => [qw(ghbyname ghbyaddr)], + Perl_pp_gnetent => [qw(gnbyname gnbyaddr)], + Perl_pp_gprotoent => [qw(gpbyname gpbynumber)], + Perl_pp_gservent => [qw(gsbyname gsbyport)], + Perl_pp_gpwent => [qw(gpwnam gpwuid)], + Perl_pp_ggrent => [qw(ggrnam ggrgid)], + Perl_pp_ftis => [qw(ftsize ftmtime ftatime ftctime)], + Perl_pp_chown => [qw(unlink chmod utime kill)], + Perl_pp_link => ['symlink'], + ); + +while (my ($func, $names) = splice @raw_alias, 0, 2) { + $alias{$_} = $func for @$names; +} + # Emit defines. $i = 0; print <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by opcode.pl from its data. Any changes made here - will be lost! -*/ +/* -*- buffer-read-only: t -*- + * + * opcode.h + * + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by opcode.pl from its data. Any changes made here + * will be lost! + */ + +#ifndef PERL_GLOBAL_STRUCT_INIT #define Perl_pp_i_preinc Perl_pp_preinc #define Perl_pp_i_predec Perl_pp_predec #define Perl_pp_i_postinc Perl_pp_postinc #define Perl_pp_i_postdec Perl_pp_postdec +PERL_PPDEF(Perl_unimplemented_op) + END print ON <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by opcode.pl from its data. Any changes made here - will be lost! -*/ +/* -*- buffer-read-only: t -*- + * + * opnames.h + * + * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, by Larry Wall and others + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + * + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by opcode.pl from its data. Any changes made here + * will be lost! + */ typedef enum opcode { END @@ -63,13 +137,17 @@ print ON "#define OP_phoney_OUTPUT_ONLY -2\n\n"; # Emit op names and descriptions. print <op_type == OP_CUSTOM ? custom_op_name(o) : \\ + PL_op_name[(o)->op_type]) +#define OP_DESC(o) ((o)->op_type == OP_CUSTOM ? custom_op_desc(o) : \\ + PL_op_desc[(o)->op_type]) + #ifndef DOINIT -EXT char *PL_op_name[]; +EXTCONST char* const PL_op_name[]; #else -EXT char *PL_op_name[] = { +EXTCONST char* const PL_op_name[] = { END for (@ops) { @@ -84,9 +162,9 @@ END print <pp_proto.h' or die "Error creating pp_proto.h: $!"; -open PPSYM, '>pp.sym' or die "Error creating pp.sym: $!"; +foreach ('opcode.h', 'opnames.h') { + safer_rename_silent $_, "$_-old"; +} +safer_rename $opcode_new, 'opcode.h'; +safer_rename $opname_new, 'opnames.h'; + +$pp_proto_new = 'pp_proto.h-new'; +$pp_sym_new = 'pp.sym-new'; + +open PP, ">$pp_proto_new" or die "Error creating $pp_proto_new: $!"; +binmode PP; +open PPSYM, ">$pp_sym_new" or die "Error creating $pp_sym_new: $!"; +binmode PPSYM; print PP <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +/* -*- buffer-read-only: t -*- + !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by opcode.pl from its data. Any changes made here will be lost! */ @@ -269,6 +382,7 @@ print PP <<"END"; END print PPSYM <<"END"; +# -*- buffer-read-only: t -*- # # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file is built by opcode.pl from its data. Any changes made here @@ -288,13 +402,28 @@ print PP "\n\n"; for (@ops) { next if /^i_(pre|post)(inc|dec)$/; + next if /^custom$/; print PP "PERL_PPDEF(Perl_pp_$_)\n"; print PPSYM "Perl_pp_$_\n"; } +print PP "\n/* ex: set ro: */\n"; +print PPSYM "\n# ex: set ro:\n"; close PP or die "Error closing pp_proto.h: $!"; close PPSYM or die "Error closing pp.sym: $!"; +foreach ('pp_proto.h', 'pp.sym') { + safer_rename_silent $_, "$_-old"; +} +safer_rename $pp_proto_new, 'pp_proto.h'; +safer_rename $pp_sym_new, 'pp.sym'; + +END { + foreach ('opcode.h', 'opnames.h', 'pp_proto.h', 'pp.sym') { + 1 while unlink "$_-old"; + } +} + ########################################################################### sub tab { local($l, $t) = @_; @@ -361,7 +490,7 @@ sub tab { __END__ -# New ops always go at the very end +# New ops always go at the end, just before 'custom' # A recapitulation of the format of this file: # The file consists of five columns: the name of the op, an English @@ -375,7 +504,7 @@ __END__ # logop - | listop - @ pmop - / # padop/svop - $ padop - # (unused) loop - { # baseop/unop - % loopexop - } filestatop - - -# pvop/svop - " +# pvop/svop - " cop - ; # Other options are: # needs stack mark - m @@ -435,8 +564,8 @@ bless bless ck_fun s@ S S? backtick quoted execution (``, qx) ck_open t% # glob defaults its first arg to $_ glob glob ck_glob t@ S? -readline ck_null t% -rcatline append I/O operator ck_null t% +readline ck_null t% F? +rcatline append I/O operator ck_null t$ # Bindable operators. @@ -445,9 +574,9 @@ regcreset regexp internal reset ck_fun s1 S regcomp regexp compilation ck_null s| S match pattern match (m//) ck_match d/ qr pattern quote (qr//) ck_match s/ -subst substitution (s///) ck_null dis/ S +subst substitution (s///) ck_match dis/ S substcont substitution iterator ck_null dis| -trans transliteration (tr///) ck_null is" S +trans transliteration (tr///) ck_match is" S # Lvalue operators. # sassign is special-cased for op class @@ -585,7 +714,7 @@ hslice hash slice ck_null m@ H L # Explosives and implosives. -unpack unpack ck_fun @ S S +unpack unpack ck_unpack @ S S? pack pack ck_fun mst@ S L split split ck_split t@ S S S join join or string ck_join mst@ S L @@ -599,10 +728,10 @@ anonhash anonymous hash ({}) ck_fun ms@ L splice splice ck_fun m@ A S? S? L push push ck_fun imsT@ A L -pop pop ck_shift s% A -shift shift ck_shift s% A +pop pop ck_shift s% A? +shift shift ck_shift s% A? unshift unshift ck_fun imsT@ A L -sort sort ck_sort m@ C? L +sort sort ck_sort dm@ C? L reverse reverse ck_fun mt@ L grepstart grep ck_grep dm@ C L @@ -632,7 +761,7 @@ leavesub subroutine exit ck_null 1 leavesublv lvalue subroutine return ck_null 1 caller caller ck_fun t% S? warn warn ck_fun imst@ L -die die ck_fun dimst@ L +die die ck_die dimst@ L reset symbol reset ck_fun is% S? lineseq line sequence ck_null @ @@ -731,8 +860,8 @@ fteread -r ck_ftst isu- F- ftewrite -w ck_ftst isu- F- fteexec -x ck_ftst isu- F- ftis -e ck_ftst isu- F- -fteowned -O ck_ftst isu- F- -ftrowned -o ck_ftst isu- F- +fteowned -o ck_ftst isu- F- +ftrowned -O ck_ftst isu- F- ftzero -z ck_ftst isu- F- ftsize -s ck_ftst istu- F- ftmtime -M ck_ftst stu- F- @@ -764,7 +893,7 @@ rename rename ck_fun isT@ S S link link ck_fun isT@ S S symlink symlink ck_fun isT@ S S readlink readlink ck_fun stu% S? -mkdir mkdir ck_fun isT@ S S? +mkdir mkdir ck_fun isTu@ S? S? rmdir rmdir ck_fun isTu% S? # Directory calls. @@ -872,9 +1001,16 @@ getlogin getlogin ck_null st0 syscall syscall ck_fun imst@ S L # For multi-threading -lock lock ck_rfun s% S +lock lock ck_rfun s% R threadsv per-thread value ck_null ds0 # Control (contd.) setstate set statement info ck_null s; method_named method with known name ck_null d$ + +dor defined or (//) ck_null | +dorassign defined or assignment (//=) ck_null s| + +# Add new ops before this, the custom operator. + +custom unknown custom operator ck_null 0