view release on metacpan or  search on metacpan

lib/C/Blocks/PerlAPI.xs.PL  view on Meta::CPAN

use strict;
use warnings;
use Alien::TinyCCx;
use Capture::Tiny qw(capture_merged);
use Config;
use ExtUtils::CBuilder;
use ExtUtils::Config;
use ExtUtils::Embed;
use File::Basename;
use File::Spec;
use File::Temp ();
use Module::Build;

my $tempdir = File::Temp::tempdir(CLEANUP => 1);
my $xs_counter = 1;
my %prelinking = map { $_ => 1 } qw/MSWin32 VMS aix/;
my @path = File::Spec->path;

# With static libperls, I cannot look up symbol names on the fly.
# In order to work on all Perls, these libperl bindings build a
# cached symbol table for perl.h. They then load all pointers to
# the symbols during the BOOT section. Module::Build knows how to
# build XS modules that have access to these symbols, whether
# libperl is static or shared.

##################################################
# Serialize perl.h and get a list of identifiers #
##################################################
# It turns out that lots of identifiers in the various header files
# are declared but are not actually defined. This command uses TCC
# to get the list of declarations, not definitions. We'll have to
# pare down the results next.

sub serialize_perl_h {
	# Put the cache file in the sharedir
	my $share_file_location = File::Spec->catfile('share', 'perl.h.cache');
	return if -f $share_file_location and -f 'names.txt';

	my($perl_h_fh, $perl_h_file) = File::Temp::tempfile(
		'perl_h_XXXXXXXX', SUFFIX => '.c', UNLINK => 1
	);

	my $header_contents = <<HEADER_CONTENTS;

#ifdef PERL_DARWIN
	typedef unsigned short __uint16_t, uint16_t;
	typedef unsigned int __uint32_t, uint32_t;
	typedef unsigned long __uint64_t, uint64_t;
#elif defined WIN32
	#define __C89_NAMELESS __extension__
	#define __MINGW_EXTENSION __extension__
	typedef long uid_t;
	typedef long gid_t;
#endif

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

int main() {
	return 0;
}

HEADER_CONTENTS

	print $perl_h_fh $header_contents;
	close $perl_h_fh;

	# Construct the compiler arguments
	my $compiler_args = ccopts;
	$compiler_args =~ s/\n+//g;
	# tcc doesn't know how to use quotes in -I paths; remove them if found.
	$compiler_args =~ s/-I"([^"]*)"/-I$1/g if $^O =~ /MSWin/;
	# Scrub all linker (-Wl,...) options
	$compiler_args =~ s/-Wl,[^\s]+//g;
	# tcc does not like the -arch compiler option
	$compiler_args =~ s/-arch\s+\w+//g;
	
	# GCC Statement Expressions (also called brace groups) give tcc
	# trouble. I should be able to turn those off by defining
#	$compiler_args .= ' -DPERL_GCC_BRACE_GROUPS_FORBIDDEN';  # doesn't work... why?
	# but that doesn't work. So instead I just turn off debugging. It's
	# not the greatest solution, but it seems like it gets things to
	# work.
	$compiler_args =~ s/\s*-DDEBUGGING//;
	# System perl on Debian includes the -DDEBIAN, which causes a
	# similar issue:
	$compiler_args =~ s/\s*-DDEBIAN//;

	# Add arguments to produce the identifier list and serialization
	mkdir 'share';
	$compiler_args = join(' ', '-run', $compiler_args,
		'-dump-identifier-names=names.txt',
		'-serialize-symtab='.$share_file_location,
		$perl_h_file
	);

	# Build the files! Only croak on errors that are not due to
	# undefined symbols, as we don't care about linking here.
	my ($output, $exit) = capture_merged { system("tcc $compiler_args") };
	print $output;
	if ($exit != 0) {
		if ($output =~ /undefined symbol/) {
			warn "^^^ Ignoring likely erroneous undefined symbol warning/error\n";
		}
		else {
			die "Unable to serialize the header file\n";
		}
	}
		
	unlink $perl_h_file;
	Module::Build->current->add_to_cleanup($share_file_location);