X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=opcode.pl;h=995ed4f2f0de52749ac8a2fbe5a620f712e9430d;hb=29469fa673ae2b707c0e65eb6190f2fab11938b1;hp=4582b9be09e81a5a3d4ac4db6623faacda5fcf60;hpb=62726f235154035f7133dd6a159de4ffbbfb0cdb;p=p5sagit%2Fp5-mst-13.2.git diff --git a/opcode.pl b/opcode.pl index 4582b9b..995ed4f 100755 --- a/opcode.pl +++ b/opcode.pl @@ -1,11 +1,13 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w +use strict; + BEGIN { # Get function prototypes require 'regen_lib.pl'; } -$opcode_new = 'opcode.h-new'; -$opname_new = 'opnames.h-new'; +my $opcode_new = 'opcode.h-new'; +my $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"; @@ -14,11 +16,15 @@ select OC; # Read data. +my %seen; +my (@ops, %desc, %check, %ckname, %flags, %args); + while () { chop; next unless $_; next if /^#/; - ($key, $desc, $check, $flags, $args) = split(/\t+/, $_, 5); + my ($key, $desc, $check, $flags, $args) = split(/\t+/, $_, 5); + $args = '' unless defined $args; warn qq[Description "$desc" duplicates $seen{$desc}\n] if $seen{$desc}; die qq[Opcode "$key" duplicates $seen{$key}\n] if $seen{$key}; @@ -40,7 +46,7 @@ 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)], + Perl_unimplemented_op => [qw(padany mapstart)], # All the ops with a body of { return NORMAL; } Perl_pp_null => [qw(scalar regcmaybe lineseq scope)], @@ -76,6 +82,15 @@ my @raw_alias = ( Perl_pp_defined => [qw(dor dorassign)], Perl_pp_and => ['andassign'], Perl_pp_or => ['orassign'], + Perl_pp_ucfirst => ['lcfirst'], + Perl_pp_sle => [qw(slt sgt sge)], + Perl_pp_print => ['say'], + Perl_pp_index => ['rindex'], + Perl_pp_oct => ['hex'], + Perl_pp_shift => ['pop'], + Perl_pp_sin => [qw(cos exp log sqrt)], + Perl_pp_bit_or => ['bit_xor'], + Perl_pp_rv2av => ['rv2hv'], ); while (my ($func, $names) = splice @raw_alias, 0, 2) { @@ -84,14 +99,13 @@ while (my ($func, $names) = splice @raw_alias, 0, 2) { # Emit defines. -$i = 0; print <<"END"; /* -*- 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 + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, + * 2001, 2002, 2003, 2004, 2005, 2006, 2007 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. @@ -117,7 +131,8 @@ print ON <<"END"; * * opnames.h * - * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, by Larry Wall and others + * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, + * 2007 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. @@ -131,6 +146,7 @@ print ON <<"END"; typedef enum opcode { END +my $i = 0; for (@ops) { print ON "\t", &tab(3,"OP_\U$_,"), "/* ", $i++, " */\n"; } @@ -210,13 +226,16 @@ print <$pp_proto_new" or die "Error creating $pp_proto_new: $!"; binmode PP; @@ -432,7 +459,7 @@ END { ########################################################################### sub tab { - local($l, $t) = @_; + my ($l, $t) = @_; $t .= "\t" x ($l - (length($t) + 1) / 8); $t; } @@ -567,7 +594,7 @@ bless bless ck_fun s@ S S? # Pushy I/O. -backtick quoted execution (``, qx) ck_open t% +backtick quoted execution (``, qx) ck_open t% S # glob defaults its first arg to $_ glob glob ck_glob t@ S? readline ck_null t% F? @@ -689,7 +716,7 @@ vec vec ck_fun ist@ S S S index index ck_index isT@ S S S? rindex rindex ck_index isT@ S S S? -sprintf sprintf ck_fun mfst@ S L +sprintf sprintf ck_fun mst@ S L formline formline ck_fun ms@ S L ord ord ck_fun ifsTu% S? chr chr ck_fun fsTu% S? @@ -866,30 +893,31 @@ 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- -ftzero -z ck_ftst isu- F- ftsize -s ck_ftst istu- F- ftmtime -M ck_ftst stu- F- ftatime -A ck_ftst stu- F- ftctime -C ck_ftst stu- F- +ftrowned -O ck_ftst isu- F- +fteowned -o ck_ftst isu- F- +ftzero -z ck_ftst isu- F- ftsock -S ck_ftst isu- F- ftchr -c ck_ftst isu- F- ftblk -b ck_ftst isu- F- ftfile -f ck_ftst isu- F- ftdir -d ck_ftst isu- F- ftpipe -p ck_ftst isu- F- -ftlink -l ck_ftst isu- F- ftsuid -u ck_ftst isu- F- ftsgid -g ck_ftst isu- F- ftsvtx -k ck_ftst isu- F- +ftlink -l ck_ftst isu- F- fttty -t ck_ftst is- F- fttext -T ck_ftst isu- F- ftbinary -B ck_ftst isu- F- # File calls. -chdir chdir ck_fun isT% S? +# chdir really behaves as if it had both "S?" and "F?" +chdir chdir ck_chdir isT% S? chown chown ck_fun imsT@ L chroot chroot ck_fun isTu% S? unlink unlink ck_fun imsTu@ L @@ -954,9 +982,9 @@ msgrcv msgrcv ck_fun imst@ S S S S S # Semaphores. +semop semop ck_fun imst@ S S semget semget ck_fun imst@ S S S semctl semctl ck_fun imst@ S S S S -semop semop ck_fun imst@ S S # Eval. @@ -1008,7 +1036,6 @@ syscall syscall ck_fun imst@ S L # For multi-threading lock lock ck_rfun s% R -threadsv per-thread value ck_null ds0 # Control (contd.) setstate set statement info ck_null s; @@ -1017,6 +1044,16 @@ method_named method with known name ck_null d$ dor defined or (//) ck_null | dorassign defined or assignment (//=) ck_null s| +entergiven given() ck_null d| +leavegiven leave given block ck_null 1 +enterwhen when() ck_null d| +leavewhen leave when block ck_null 1 +break break ck_null 0 +continue continue ck_null 0 +smartmatch smart match ck_smartmatch s2 + +say say ck_listiob ims@ F? L + # Add new ops before this, the custom operator. custom unknown custom operator ck_null 0