diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 1998-11-22 11:12:02 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1998-11-22 11:12:02 +0000 |
commit | c6af7a1aaf1f569eeb51c976b436561fdc569904 (patch) | |
tree | fb7883a1459cd2efcd48e1eae0774e0dec37edce /embed.pl | |
parent | a7092146033201511b749e3a5ff31247e203604d (diff) | |
download | perl-c6af7a1aaf1f569eeb51c976b436561fdc569904.tar.gz |
phase 2 of PERL_OBJECT cleanup; objXSUB.h autogeneration
p4raw-id: //depot/perl@2260
Diffstat (limited to 'embed.pl')
-rwxr-xr-x | embed.pl | 78 |
1 files changed, 72 insertions, 6 deletions
@@ -41,8 +41,8 @@ sub readsyms (\%$) { readsyms %global, 'global.sym'; readsyms %global, 'pp.sym'; -sub readvars(\%$$) { - my ($syms, $file,$pre) = @_; +sub readvars(\%$$@) { + my ($syms, $file,$pre,$keep_pre) = @_; local (*FILE, $_); open(FILE, "< $file") or die "embed.pl: Can't open $file: $!\n"; @@ -50,6 +50,7 @@ sub readvars(\%$$) { s/[ \t]*#.*//; # Delete comments. if (/PERLVARI?C?\($pre(\w+)/) { my $sym = $1; + $sym = $pre . $sym if $keep_pre; warn "duplicate symbol $sym while processing $file\n" if exists $$syms{$sym}; $$syms{$sym} = 1; @@ -64,6 +65,7 @@ my %thread; readvars %intrp, 'intrpvar.h','I'; readvars %thread, 'thrdvar.h','T'; readvars %globvar, 'perlvars.h','G'; +readvars %objvar, 'intrpvar.h','pi', 1; foreach my $sym (sort keys %intrp) { @@ -93,19 +95,39 @@ foreach my $sym (sort keys %thread) } } +sub undefine ($) { + my ($sym) = @_; + "#undef $sym\n"; +} + sub hide ($$) { my ($from, $to) = @_; my $t = int(length($from) / 8); "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n"; } + sub embed ($) { my ($sym) = @_; hide($sym, "Perl_$sym"); } + sub embedobj ($) { my ($sym) = @_; hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym"); } + +sub objxsub_func ($) { + my ($sym) = @_; + undefine($sym) . hide($sym, $sym =~ /^perl_/i + ? "pPerl->$sym" + : "pPerl->Perl_$sym"); +} + +sub objxsub_var ($) { + my ($sym) = @_; + undefine("PL_$sym") . hide("PL_$sym", "pPerl->PL_$sym"); +} + sub embedvar ($) { my ($sym) = @_; # hide($sym, "Perl_$sym"); @@ -128,7 +150,7 @@ open(EM, '> embed.h') print EM <<'END'; /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by embed.pl from global.sym, pp.sym, intrpvar.h, - and thrdvar.h. Any changes made here will be lost! + perlvars.h and thrdvar.h. Any changes made here will be lost! */ /* (Doing namespace management portably in C is really gross.) */ @@ -152,7 +174,7 @@ print EM <<'END'; END # XXX these should be in a *.sym file -my @extras = qw( +my @staticfuncs = qw( perl_init_i18nl10n perl_init_i18nl14n perl_new_collate @@ -365,7 +387,7 @@ my @extras = qw( fprintf ); -for $sym (sort(keys(%global),@extras)) { +for $sym (sort(keys(%global),@staticfuncs)) { print EM embedobj($sym); } @@ -384,7 +406,7 @@ open(EM, '> embedvar.h') print EM <<'END'; /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by embed.pl from global.sym, pp.sym, intrpvar.h, - and thrdvar.h. Any changes made here will be lost! + perlvars.h and thrdvar.h. Any changes made here will be lost! */ /* (Doing namespace management portably in C is really gross.) */ @@ -524,3 +546,47 @@ END close(EM); + +unlink 'objXSUB.h'; +open(OBX, '> objXSUB.h') + or die "Can't create objXSUB.h: $!\n"; + +print OBX <<'EOT'; +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + This file is built by embed.pl from global.sym, pp.sym, intrpvar.h, + perlvars.h and thrdvar.h. Any changes made here will be lost! +*/ + +#ifndef __objXSUB_h__ +#define __objXSUB_h__ + +/* Variables */ + +EOT + +foreach my $sym (sort(keys(%intrp), + keys(%thread), + keys(%globvar), + keys(%objvar))) +{ + print OBX objxsub_var($sym); +} + +print OBX <<'EOT'; + +/* Functions */ + +EOT + + +for $sym (sort(keys(%global),@staticfuncs)) { + print OBX objxsub_func($sym); +} + + +print OBX <<'EOT'; + +#endif /* __objXSUB_h__ */ +EOT + +close(OBX); |