diff options
| -rw-r--r-- | MANIFEST | 2 | ||||
| -rwxr-xr-x | Porting/makerel | 1 | ||||
| -rw-r--r-- | mg_vtable.h | 416 | ||||
| -rw-r--r-- | perl.h | 406 | ||||
| -rw-r--r-- | regen.pl | 1 | ||||
| -rw-r--r-- | regen/mg_vtable.pl | 102 | ||||
| -rw-r--r-- | t/porting/regen.t | 2 | ||||
| -rw-r--r-- | vms/descrip_mms.template | 11 |
8 files changed, 531 insertions, 410 deletions
@@ -4125,6 +4125,7 @@ metaconfig.SH Control file for the metaconfig process META.yml Distribution meta-data in YAML mg.c Magic code mg.h Magic header +mg_vtable.h Generated magic vtable data minimod.pl Writes lib/ExtUtils/Miniperl.pm miniperlmain.c Basic perl w/o dynamic loading or extensions mkppport A script that distributes ppport.h @@ -4573,6 +4574,7 @@ regcomp.h Private declarations for above regcomp.sym Data for regnodes.h regen/embed.pl Produces {embed,embedvar,proto}.h, global.sym regen/keywords.pl Program to write keywords.h +regen/mg_vtable.pl generate mg_vtable.h regen/mk_PL_charclass.pl Populate the PL_charclass table regen/opcode.pl Opcode header generator regen/opcodes Opcode data diff --git a/Porting/makerel b/Porting/makerel index ec4dc5ed9b..1e7ca7ce13 100755 --- a/Porting/makerel +++ b/Porting/makerel @@ -142,6 +142,7 @@ my @writables = qw( global.sym overload.c overload.h + mg_vtable.h perlapi.h perlapi.c cpan/Devel-PPPort/module2.c diff --git a/mg_vtable.h b/mg_vtable.h new file mode 100644 index 0000000000..ebe448a454 --- /dev/null +++ b/mg_vtable.h @@ -0,0 +1,416 @@ +/* -*- buffer-read-only: t -*- + * + * mg_vtable.h + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by regen/mg_vtable.pl. + * Any changes made here will be lost! + */ + +/* These all need to be 0, not NULL, as NULL can be (void*)0, which is a + * pointer to data, whereas we're assigning pointers to functions, which are + * not the same beast. ANSI doesn't allow the assignment from one to the other. + * (although most, but not all, compilers are prepared to do it) + */ + +/* args are: + vtable + get + set + len + clear + free + copy + dup + local +*/ + +MGVTBL_SET( + PL_vtbl_sv, + Perl_magic_get, + Perl_magic_set, + Perl_magic_len, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_env, + 0, + Perl_magic_set_all_env, + 0, + Perl_magic_clear_all_env, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_envelem, + 0, + Perl_magic_setenv, + 0, + Perl_magic_clearenv, + 0, + 0, + 0, + 0 +); + +#ifndef PERL_MICRO +MGVTBL_SET( + PL_vtbl_sigelem, + Perl_magic_getsig, + Perl_magic_setsig, + 0, + Perl_magic_clearsig, + 0, + 0, + 0, + 0 +); +#endif + +MGVTBL_SET( + PL_vtbl_pack, + 0, + 0, + Perl_magic_sizepack, + Perl_magic_wipepack, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_packelem, + Perl_magic_getpack, + Perl_magic_setpack, + 0, + Perl_magic_clearpack, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_dbline, + 0, + Perl_magic_setdbline, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_isa, + 0, + Perl_magic_setisa, + 0, + Perl_magic_clearisa, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_isaelem, + 0, + Perl_magic_setisa, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET_CONST_MAGIC_GET( + PL_vtbl_arylen, + Perl_magic_getarylen, + Perl_magic_setarylen, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_arylen_p, + 0, + 0, + 0, + 0, + Perl_magic_freearylen_p, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_mglob, + 0, + Perl_magic_setmglob, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_nkeys, + Perl_magic_getnkeys, + Perl_magic_setnkeys, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_taint, + Perl_magic_gettaint, + Perl_magic_settaint, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_substr, + Perl_magic_getsubstr, + Perl_magic_setsubstr, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_vec, + Perl_magic_getvec, + Perl_magic_setvec, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_pos, + Perl_magic_getpos, + Perl_magic_setpos, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_bm, + 0, + Perl_magic_setregexp, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_fm, + 0, + Perl_magic_setregexp, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_uvar, + Perl_magic_getuvar, + Perl_magic_setuvar, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_defelem, + Perl_magic_getdefelem, + Perl_magic_setdefelem, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_regexp, + 0, + Perl_magic_setregexp, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_regdata, + 0, + 0, + Perl_magic_regdata_cnt, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_regdatum, + Perl_magic_regdatum_get, + Perl_magic_regdatum_set, + 0, + 0, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_amagic, + 0, + Perl_magic_setamagic, + 0, + 0, + Perl_magic_setamagic, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_amagicelem, + 0, + Perl_magic_setamagic, + 0, + 0, + Perl_magic_setamagic, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_backref, + 0, + 0, + 0, + 0, + Perl_magic_killbackrefs, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_ovrld, + 0, + 0, + 0, + 0, + Perl_magic_freeovrld, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_utf8, + 0, + Perl_magic_setutf8, + 0, + 0, + 0, + 0, + 0, + 0 +); + +#ifdef USE_LOCALE_COLLATE +MGVTBL_SET( + PL_vtbl_collxfrm, + 0, + Perl_magic_setcollxfrm, + 0, + 0, + 0, + 0, + 0, + 0 +); +#endif + +MGVTBL_SET( + PL_vtbl_hintselem, + 0, + Perl_magic_sethint, + 0, + Perl_magic_clearhint, + 0, + 0, + 0, + 0 +); + +MGVTBL_SET( + PL_vtbl_hints, + 0, + 0, + 0, + Perl_magic_clearhints, + 0, + 0, + 0, + 0 +); + + +/* ex: set ro: */ @@ -5118,411 +5118,7 @@ START_EXTERN_C # define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var #endif -/* These all need to be 0, not NULL, as NULL can be (void*)0, which is a - * pointer to data, whereas we're assigning pointers to functions, which are - * not the same beast. ANSI doesn't allow the assignment from one to the other. - * (although most, but not all, compilers are prepared to do it) - */ - -/* args are: - vtable - get - set - len - clear - free - copy - dup - local -*/ - -MGVTBL_SET( - PL_vtbl_sv, - Perl_magic_get, - Perl_magic_set, - Perl_magic_len, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_env, - 0, - Perl_magic_set_all_env, - 0, - Perl_magic_clear_all_env, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_envelem, - 0, - Perl_magic_setenv, - 0, - Perl_magic_clearenv, - 0, - 0, - 0, - 0 -); - -#ifndef PERL_MICRO -MGVTBL_SET( - PL_vtbl_sigelem, - Perl_magic_getsig, - Perl_magic_setsig, - 0, - Perl_magic_clearsig, - 0, - 0, - 0, - 0 -); -#endif - -MGVTBL_SET( - PL_vtbl_pack, - 0, - 0, - Perl_magic_sizepack, - Perl_magic_wipepack, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_packelem, - Perl_magic_getpack, - Perl_magic_setpack, - 0, - Perl_magic_clearpack, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_dbline, - 0, - Perl_magic_setdbline, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_isa, - 0, - Perl_magic_setisa, - 0, - Perl_magic_clearisa, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_isaelem, - 0, - Perl_magic_setisa, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET_CONST_MAGIC_GET( - PL_vtbl_arylen, - Perl_magic_getarylen, - Perl_magic_setarylen, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_arylen_p, - 0, - 0, - 0, - 0, - Perl_magic_freearylen_p, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_mglob, - 0, - Perl_magic_setmglob, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_nkeys, - Perl_magic_getnkeys, - Perl_magic_setnkeys, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_taint, - Perl_magic_gettaint, - Perl_magic_settaint, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_substr, - Perl_magic_getsubstr, - Perl_magic_setsubstr, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_vec, - Perl_magic_getvec, - Perl_magic_setvec, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_pos, - Perl_magic_getpos, - Perl_magic_setpos, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_bm, - 0, - Perl_magic_setregexp, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_fm, - 0, - Perl_magic_setregexp, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_uvar, - Perl_magic_getuvar, - Perl_magic_setuvar, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_defelem, - Perl_magic_getdefelem, - Perl_magic_setdefelem, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regexp, - 0, - Perl_magic_setregexp, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regdata, - 0, - 0, - Perl_magic_regdata_cnt, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regdatum, - Perl_magic_regdatum_get, - Perl_magic_regdatum_set, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_amagic, - 0, - Perl_magic_setamagic, - 0, - 0, - Perl_magic_setamagic, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_amagicelem, - 0, - Perl_magic_setamagic, - 0, - 0, - Perl_magic_setamagic, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_backref, - 0, - 0, - 0, - 0, - Perl_magic_killbackrefs, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_ovrld, - 0, - 0, - 0, - 0, - Perl_magic_freeovrld, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_utf8, - 0, - Perl_magic_setutf8, - 0, - 0, - 0, - 0, - 0, - 0 -); -#ifdef USE_LOCALE_COLLATE -MGVTBL_SET( - PL_vtbl_collxfrm, - 0, - Perl_magic_setcollxfrm, - 0, - 0, - 0, - 0, - 0, - 0 -); -#endif - -MGVTBL_SET( - PL_vtbl_hintselem, - 0, - Perl_magic_sethint, - 0, - Perl_magic_clearhint, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_hints, - 0, - 0, - 0, - Perl_magic_clearhints, - 0, - 0, - 0, - 0 -); - +#include "mg_vtable.h" #include "overload.h" END_EXTERN_C @@ -16,6 +16,7 @@ use strict; # Which scripts to run. my @scripts = qw( +mg_vtable.pl opcode.pl overload.pl reentr.pl diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl new file mode 100644 index 0000000000..d3557ec43b --- /dev/null +++ b/regen/mg_vtable.pl @@ -0,0 +1,102 @@ +#!/usr/bin/perl -w +# +# Regenerate (overwriting only if changed): +# +# mg_vtable.h +# +# from information stored in this file. +# +# Accepts the standard regen_lib -q and -v args. +# +# This script is normally invoked from regen.pl. + +use strict; +require 5.004; + +BEGIN { + # Get function prototypes + require 'regen/regen_lib.pl'; +} + +my @sig = + ( + 'sv' => {get => 'get', set => 'set', len => 'len'}, + 'env' => {set => 'set_all_env', clear => 'clear_all_env'}, + 'envelem' => {set => 'setenv', clear => 'clearenv'}, + 'sigelem' => {get => 'getsig', set => 'setsig', clear => 'clearsig', + cond => '#ifndef PERL_MICRO'}, + 'pack' => {len => 'sizepack', clear => 'wipepack'}, + 'packelem' => {get => 'getpack', set => 'setpack', clear => 'clearpack'}, + 'dbline' => {set => 'setdbline'}, + 'isa' => {set => 'setisa', clear => 'clearisa'}, + 'isaelem' => {set => 'setisa'}, + 'arylen' => {get => 'getarylen', set => 'setarylen', const => 1}, + 'arylen_p' => {free => 'freearylen_p'}, + 'mglob' => {set => 'setmglob'}, + 'nkeys' => {get => 'getnkeys', set => 'setnkeys'}, + 'taint' => {get => 'gettaint', set => 'settaint'}, + 'substr' => {get => 'getsubstr', set => 'setsubstr'}, + 'vec' => {get => 'getvec', set => 'setvec'}, + 'pos' => {get => 'getpos', set => 'setpos'}, + 'bm' => {set => 'setregexp'}, + 'fm' => {set => 'setregexp'}, + 'uvar' => {get => 'getuvar', set => 'setuvar'}, + 'defelem' => {get => 'getdefelem', set => 'setdefelem'}, + 'regexp' => {set => 'setregexp'}, + 'regdata' => {len => 'regdata_cnt'}, + 'regdatum' => {get => 'regdatum_get', set => 'regdatum_set'}, + 'amagic' => {set => 'setamagic', free => 'setamagic'}, + 'amagicelem' => {set => 'setamagic', free => 'setamagic'}, + 'backref' => {free => 'killbackrefs'}, + 'ovrld' => {free => 'freeovrld'}, + 'utf8' => {set => 'setutf8'}, + 'collxfrm' => {set => 'setcollxfrm', + cond => '#ifdef USE_LOCALE_COLLATE'}, + 'hintselem' => {set => 'sethint', clear => 'clearhint'}, + 'hints' => {clear => 'clearhints'}, +); + +my $h = open_new('mg_vtable.h', '>', + { by => 'regen/mg_vtable.pl', file => 'mg_vtable.h', + style => '*' }); + +print $h <<'EOH'; +/* These all need to be 0, not NULL, as NULL can be (void*)0, which is a + * pointer to data, whereas we're assigning pointers to functions, which are + * not the same beast. ANSI doesn't allow the assignment from one to the other. + * (although most, but not all, compilers are prepared to do it) + */ + +/* args are: + vtable + get + set + len + clear + free + copy + dup + local +*/ + +EOH + +while (my ($name, $data) = splice @sig, 0, 2) { + my $funcs = join ",\n ", map { + $data->{$_} ? "Perl_magic_$data->{$_}" : 0; + } qw(get set len clear free copy dup local); + + my $set_macro = $data->{const} ? 'MGVTBL_SET_CONST_MAGIC_GET' : 'MGVTBL_SET'; + + print $h "$data->{cond}\n" if $data->{cond}; + print $h <<"EOT"; +$set_macro( + PL_vtbl_$name, + $funcs +); +EOT + print $h "#endif\n" if $data->{cond}; + print $h "\n"; +} + +read_only_bottom_close_and_rename($h); diff --git a/t/porting/regen.t b/t/porting/regen.t index 78d0599660..0e052dd853 100644 --- a/t/porting/regen.t +++ b/t/porting/regen.t @@ -27,7 +27,7 @@ if ( $^O eq "VMS" ) { skip_all( "- regen.pl needs porting." ); } -my $in_regen_pl = 17; # I can't see a clean way to calculate this automatically. +my $in_regen_pl = 18; # I can't see a clean way to calculate this automatically. my @files = qw(perly.act perly.h perly.tab keywords.c keywords.h uconfig.h); my @progs = qw(Porting/makemeta regen/regcharclass.pl regen/mk_PL_charclass.pl); diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index f0220a72f0..31faefb7ee 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -301,9 +301,9 @@ obj = $(obj0) $(obj1) $(obj2) $(obj3) $(obj4) h0 = av.h config.h cop.h cv.h embed.h embedvar.h h1 = EXTERN.h form.h gv.h handy.h hv.h l1_char_class_tab.h INTERN.h intrpvar.h -h2 = iperlsys.h keywords.h mydtrace.h mg.h nostdio.h op.h op_reg_common.h -h3 = opcode.h opnames.h overload.h pad.h parser.h patchlevel.h perl.h -h4 = perlapi.h perlio.h perlsdio.h perlvars.h perly.h +h2 = iperlsys.h keywords.h mydtrace.h mg.h mg_vtable.h nostdio.h op.h +h3 = op_reg_common.h opcode.h opnames.h overload.h pad.h parser.h patchlevel.h +h4 = perl.h perlapi.h perlio.h perlsdio.h perlvars.h perly.h h5 = pp.h pp_proto.h proto.h regcomp.h regexp.h regnodes.h scope.h h5 = sv.h thread.h utf8.h util.h vmsish.h warnings.h h7 = xsub.h $(SOCKH) $(THREADH) @@ -314,7 +314,7 @@ ac1 = $(ARCHCORE)config.h $(ARCHCORE)cop.h $(ARCHCORE)cv.h $(ARCHCORE)embed.h ac2 = $(ARCHCORE)embedvar.h $(ARCHCORE)EXTERN.h $(ARCHCORE)fakethr.h ac3 = $(ARCHCORE)form.h $(ARCHCORE)git_version.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h ac4 = $(ARCHCORE)l1_char_class_tab.h $(ARCHCORE)INTERN.h $(ARCHCORE)intrpvar.h $(ARCHCORE)iperlsys.h -ac5 = $(ARCHCORE)keywords.h $(ARCHCORE)mydtrace.h $(ARCHCORE)mg.h $(ARCHCORE)nostdio.h +ac5 = $(ARCHCORE)keywords.h $(ARCHCORE)mydtrace.h $(ARCHCORE)mg.h $(ARCHCORE)mg_vtable.h $(ARCHCORE)nostdio.h ac6 = $(ARCHCORE)op_reg_common.h $(ARCHCORE)op.h $(ARCHCORE)opcode.h $(ARCHCORE)opnames.h ac7 = $(ARCHCORE)overload.h $(ARCHCORE)pad.h $(ARCHCORE)parser.h $(ARCHCORE)patchlevel.h ac8 = $(ARCHCORE)perl.h $(ARCHCORE)perlapi.h $(ARCHCORE)perlio.h $(ARCHCORE)perlsdio.h @@ -1624,6 +1624,9 @@ $(ARCHCORE)mydtrace.h : mydtrace.h $(ARCHCORE)mg.h : mg.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/NoConfirm/Log $(MMS$SOURCE) $(ARCHCORE) +$(ARCHCORE)mg_vtable.h : mg_vtable.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/NoConfirm/Log $(MMS$SOURCE) $(ARCHCORE) $(ARCHCORE)nostdio.h : nostdio.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/NoConfirm/Log $(MMS$SOURCE) $(ARCHCORE) |