NAME
GCC::Builtins - access GCC compiler builtin functions via XS
VERSION
Version 0.06
SYNOPSIS
This module provides Perl access to GCC C compiler builtin functions.
use GCC::Builtins qw/:all/;
# or use GCC::Builtins qw/ ... clz ... /;
my $leading_zeros = GCC::Builtins::clz(10);
# 28EXPORT
<% list_of_exported_subs %>
Export tag :all imports all exportable functions, like:
use GCC::Builtins qw/:all/;SUBROUTINES
<% exported_subs_descriptions %>
UPDATING THE LIST OF FUNCTIONS
The list of functions was extracted from https://gcc.gnu.org/onlinedocs/gcc/Other-Builtins.html using the script sbin/build-gcc-builtins-package.pl This script is part of the distribution but it is not installed in the host system. This file is HTML documenting these functions. I found it easier to parse this file than to parse GCC header files, mainly because the latter contain macros and typedef which I could not parse without the help of the C pre-processor.
And so the list of provided files may not be perfect. Certainly there are some functions missing. Simply because some functions do not make sense when called from Perl. For example FUNCTION(), LINE() etc. Some others are missing because they have exotic data types for function arguments and/or return which I did not know how to implement that in Perl. Others have reported missing symbols, perhaps they need a higher C standard (adjusted via the CFLAGS in Makefile.PL).
If you need another builtin function to be supported please raise an issue. Please make sure you provide me with a way to include this function. What CFLAGS, how to typemap its return type and arguments. And also provide a test script to test it (similar to those found in t/ directory).
An easy way to experiment is to use cpanm (provided by "App::cpanminus) to fetch and unpack the distribution and then open a shell at the distribution directory:"
cpanm --look GCC::Builtinsand then
sbin/build-gcc-builtins-package.sh
sbin/build-gcc-builtins-package.pl
perl Makefile.PL && make all && make testNote that lib/GCC/Builtins.pm, lib/GCC/Builtins.xs and typemap are auto-generated by above scripts. Do not edit them. Edit sbin/build-gcc-builtins-package.pl instead.
ALTERNATIVES
The BENCHMARKS section below suggests that a 100% performance gain awaits users who prefer to call GCC::Builtins rather than implementing them in pure Perl.
However, you can still harvest those gains by coding critical sections in your Perl code in assembly via Inline::C. Assembly can be run from within a C program with the Gnu C Compiler (GCC) which offers the asm volatile(...)</c functionality.
I have outlined how in this post in this thread, over at the PerlMonks Monastery.
Here is the relevant code:
use Inline C;
use strict;
use warnings;
# Assembly code via Inline::C to return the
# 1. number of leading zeros of the input integer
# 2. a number with only bit set where the MSSB is located
#
# by bliako
# for https://perlmonks.org/?node_id=11158279
# 21/03/2024
my $z = 17;
my $res = mssb($z);
print "Leading zeros for $z : ".$res->[0]."\n";
print "MSSB for $z : ".sprintf("%032b\n", $res->[1])."\n";
# result:
# Leading zeros for 17 : 27
# MSSB for 17 : 00000000000000000000000000010000
__END__
__C__
#include <stdio.h>
AV * mssb(int input){
int num_leading_zeros;
int mssb;
asm volatile(
/* note: lzcnt inp, out
mov src, dst
add what, dst
# set bit of value in dst at zero-based bitposition:
btsl bitposition, dst (it modifies dst)
*/
"lzcnt %[input], %[num_leading_zeros] \n\t\
mov $32, %%eax \n\t\
sub %[num_leading_zeros], %%eax \n\t\
sub $1, %%eax \n\t\
xor %[mssb], %[mssb] \n\t\
bts %%eax, %[mssb] \n\t\
"
/* outputs */
: [num_leading_zeros] "=r" (num_leading_zeros)
, [mssb] "=r" (mssb)
/* inputs */
: [input] "mr" (input)
/* clobbers: we are messing with these registers: */
: "eax"
);
// return an arrayref of the two outputs
AV* ret = newAV();
sv_2mortal((SV*)ret);
av_push(ret, newSViv(num_leading_zeros));
av_push(ret, newSViv(mssb));
return ret;
}You can also inline assembly in your Perl code with Inline::ASM
Be advised that GCC builtins are also calling assembly code. In fact the above assembly code is how GCC implements clz(). So, inline assembly and GCC::Builtins should yield, more-or-less, the same performance gain.
TESTING
For each exported sub there is a corresponding auto-generated test file. The test goes as far as loading the library and calling the function from Perl.
However, there may be errors in the expected results because that was done without verifying with a C test program.
BENCHMARKS
Counting leading zeros (clz) will be used to benchmark the GCC builtin __builtin_clz() and a pure Perl implementation as suggested by Perl Monk coldr3ality in this discussion
clz() operating on the binary representation of a number counts the zeros starting from the most significant end until it finds the first bit set (to 1). Which essentially gives the zero-based index of the MSB set to 1.
The benchmarks favour the GCC builtin __builtin_clz() which is about twice as fast as the pure Perl implementation.
The benchmarks can be run with make benchmarks An easy way to let Perl fetch and unpack the distribution for you is to use cpanm to open a shell
cpanm --look GCC::Builtinsand then
perl Makefile.PL && make all && make test && make benchmarksThe following benchamrk results indicate that the use of GCC::Builtins (clz() in this case) yields more than 100% performance gain over equivalent pure perl code:
Benchmark: timing 50000000 iterations of clz/xs, clz/pp-ugly...
clz/xs: 3.92331 wallclock secs ( 3.92 usr + 0.00 sys = 3.92 CPU) @ 12755102.04/s (n=50000000)
clz/pp-ugly: 8.24574 wallclock secs ( 8.23 usr + 0.00 sys = 8.23 CPU) @ 6075334.14/s (n=50000000)
Rate clz/pp-ugly clz/xs
clz/pp-ugly 6075334/s -- -52%
clz/xs 12755102/s 110% --
KEY:
clz/xs : calling GCC builtin clz() via XS from Perl
clz/pp-ugly : as suggested by coldr3ality (see https://perlmonks.org/?node_id=11158279)
Benchmark: timing 50000000 iterations of clzl/xs, clzl/pp-ugly...
clzl/xs: 3.84597 wallclock secs ( 3.84 usr + 0.00 sys = 3.84 CPU) @ 13020833.33/s (n=50000000)
clzl/pp-ugly: 8.44006 wallclock secs ( 8.43 usr + 0.00 sys = 8.43 CPU) @ 5931198.10/s (n=50000000)
Rate clzl/pp-ugly clzl/xs
clzl/pp-ugly 5931198/s -- -54%
clzl/xs 13020833/s 120% --
KEY:
clzl/xs : calling GCC builtin clzl() via XS from Perl
clzl/pp-ugly : as suggested by coldr3ality (see https://perlmonks.org/?node_id=11158279)So, it pays to use this module if performance is an issue.
CAVEATS
If you observe weird return results or core-dumps it is very likely that the fault is mine while compiling the XS typemap. The file in the distribution typemap was compiled by me to translate C's data types into Perls. And for some of this I am not sure what the right type is. For example, is C's uint_fast16_t equivalent to Perl's T_UV? How about C's long double mapping to Perl's T_DOUBLE and unsigned long long to T_U_LONG?
Please report any corrections.
Note that lib/GCC/Builtins.pm, lib/GCC/Builtins.xs and typemap are auto-generated by above scripts. Do not edit them. Edit sbin/build-gcc-builtins-package.pl instead.
AUTHOR
Andreas Hadjiprocopis, <bliako ta cpan.org / andreashad2 ta gmail.com>
BUGS
Please report any bugs or feature requests to bug-gcc-builtins at rt.cpan.org, or through the web interface at https://rt.cpan.org/NoAuth/ReportBug.html?Queue=GCC-Builtins. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
SUPPORT
You can find documentation for this module with the perldoc command.
perldoc GCC::BuiltinsYou can also look for information at:
RT: CPAN's request tracker (report bugs here)
Review this module at PerlMonks
Search CPAN
ACKNOWLEDGEMENTS
This module started by this discussion at PerlMonks:
Hackers of Free Software.
GNU and the Free Software Foundation, providers of GNU Compiler Collection.
HUGS
!Almaz!
LICENSE AND COPYRIGHT
This software is Copyright (c) 2024 by Andreas Hadjiprocopis.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)$afuncdata-{'xs-signature-without-identifiers'}>
$afuncdata->{'description'}
EOP }
###################################################### ################## Write test files ################## my $tidx = 666; for($tidx..999){ my $tfile = File::Spec->catfile($TDIR, $_.'-*.t'); my @files = glob($tfile); unlink @files; }
for my $afuncname (sort keys %funcs){ my $afuncdata = $funcs{$afuncname}; my $tfile = File::Spec->catfile($TDIR, $tidx++.'-'.$afuncdata->{'xs-name'}.'.t'); if( ! open($FH, '>', $tfile) ){ die "error, failed to open output XS file '$tfile' for writing: $!" } my $tcon = $T_CONTENTS; $tcon =~ s/<%\s*test_func_run\s*%>/$afuncdata->{'test_func_run'}/; $tcon =~ s/<%\s*test_func_is_ok\s*%>/$afuncdata->{'test_func_is_ok'}/; print $FH $tcon; close $FH; print "$0 : done, test file written to '$tfile'.\n"; }
###################################################### ################## Write .pm file #################### $PM_CONTENTS =~ s/^package\s*GCC::Builtins;.+?\n/package GCC::Builtins;\n/s; $PM_CONTENTS =~ s/<%\s*list_of_sub_names\s*%>/${list_of_sub_names}/; $PM_CONTENTS =~ s/<%\s*list_of_exported_subs\s*%>/${list_of_exported_subs}/; $PM_CONTENTS =~ s/<%\s*exported_subs_descriptions\s*%>/${exported_subs_descriptions}/; open($FH, '>', $PM_outfile) or die "error, failed to open output file '$TYPEMAP_outfile' for writing: $!"; print $FH $PM_CONTENTS; close $FH; print "$0 : done, perl module and pod written to '$PM_outfile'.\n";
###################################################### ################## Write XS output ################### if( ! open($FH, '>', $XS_outfile) ){ die "error, failed to open output XS file '$XS_outfile' for writing: $!" } print $FH $XS_CONTENTS; for my $afuncname (sort keys %funcs){ my $afuncdata = $funcs{$afuncname}; print $FH "\n".$afuncdata->{'xs-code'}."\n" } close $FH; print "$0 : done, ".scalar(keys %funcs)." builtin functions written to '$XS_outfile'.\n";
###################################################### ################## Write TYPEMAP file ################ # write the typemap, we assume that uintYYY_t types are not typemap'ed yet open($FH, '>', $TYPEMAP_outfile) or die "error, failed to open output file '$TYPEMAP_outfile' for writing: $!"; print $FH <<'EOT'; ######################################################################### #### WARNING: do not edit GCC/Buildins.pm or GCC/Buildins.xs #### or typemap or t/6*.t files #### they are auto-generated by me and all changes will be lost #### EDIT all these here, they are in string vars #### and then run sbin/build-gcc-builtins-package.pl #### to update these files ######################################################################### EOT print $FH "TYPEMAP\n"; for my $atype (sort keys %TYPEMAP){ my $mapsto = $TYPEMAP{$atype}; print $FH "${atype}\t${mapsto}\n"; } close $FH; print "$0 : done, ".scalar(keys %TYPEMAP)." typemap items written to file '$TYPEMAP_outfile'.\n";
print "$0 : done, success.\n";
###################################################### ################## Assorted subs ##################### sub get_function_return_type { my $parent_tag = shift;
my $cssSelector2 = 'span code.def-type';
my $atag2 = $parent_tag->find($cssSelector2);
if( ! defined($atag2) ){ die 'get_function_return_type()'." : error, failed to find span with CSS selector '$cssSelector2' under tag : ${parent_tag}" }
if( $atag2->length() != 1 ){ die $parent_tag."\n".'get_function_return_type()'." : error, failed to find exactly 1 span with CSS selector '$cssSelector2'. I found ".$atag2->length()." items instead." }
$atag2 = $atag2->[0];
# we will skip all type-generic functions I don't know how to implement them in XS
my $cssSelector3 = 'var.var';
my $atag3 = $atag2->find($cssSelector3);
# if we have <var> it is most likely type of _Floatnx etc.
if( defined($atag3) && ($atag3->length()>0) ){
for my $atag4 ( @{ $atag3->array } ){
my $tx = $atag4->text();
if( $tx =~ /^\s*type\s*$/ ){
print STDERR 'get_function_return_type()'." : skipping function with type-generic return:\n${parent_tag}\n";
return undef # means forget it and next
} else {
print STDERR $parent_tag."\n".'get_function_return_type()'." : found var tag for above node but it is not 'type', it is:\n".$tx;
return undef # means forget it and next
}
}
}
my $rt = $atag2->text();
if( ($rt eq 'Pmode')
|| ($rt eq 'uint128_t')
){
print STDERR $parent_tag."\n$0 : found function with illegal return type in above node. The return type is: $rt\n";
return undef;
}
return $atag2->text()
}sub get_function_name { my $parent_tag = shift;
my $cssSelector2 = 'span strong.def-name';
my $atag2 = $parent_tag->find($cssSelector2);
if( ! defined $atag2 ){ die 'get_function_name()'." : error, failed to find span with CSS selector '$cssSelector2' under tag : ${parent_tag}" }
my $fn = $atag2->text();
$fn =~ s/\s+//g;
if( ($num_function_names_blacklist > 0)
&& (exists $function_names_blacklist{$fn})
){
print STDERR $parent_tag."\n".'get_function_name()'." : function name '$fn' is blacklisted and will not be used.\n";
return undef
}
if( ($num_function_names_whitelist > 0)
&& (! exists $function_names_whitelist{$fn})
){
print STDERR $parent_tag."\n".'get_function_name()'." : function name '$fn' is not in the whitelist and will not be used.\n";
return undef
}
return $fn
}sub get_function_arguments { my $parent_tag = shift;
my $cssSelector2 = 'span code.def-code-arguments';
my $atag2 = $parent_tag->find($cssSelector2);
if( ! defined($atag2) ){ die "error, failed to find span with CSS selector '$cssSelector2' under tag : ${parent_tag}" }
my $text = $atag2->text();
if( $text =~ /\(\s*void\s*\)/ ){ return ''; }
if( ($text =~ /\.\.\./)
|| ($text =~ /\(\s*type\s*\)/)
|| ($text =~ /\(\s*exp\s*\)/)
|| ($text =~ /\(\s*ptr\s*\)/)
|| ($text =~ /,\s*arg\)|\barg[,)]/)
|| ($text =~ /type-or-expression/)
|| ($text =~ /\b(:?type1)\b/)
|| ($text =~ /\b(:?functions)\b/)
|| ($text =~ /\b(:?arguments)\b/)
){
print STDERR $parent_tag."\n$0 : found function with type-generic or variable arguments for above node:\n$text\n";
return undef;
}
$text =~ s/[()]//g;
return $text;
}# returns the type, if pointer (as '*' or '**' etc.) and # identifier if any # all in a hash { 'type', 'pointer', 'identifier', 'as-string-with-identifier', 'as-string-without-identifier'} sub process_function_argument { my ($arg, $nextvarname) = @_; my %ret; if( $arg =~ /^(.+?)\s*([*]+)\s*(.+?)?$/ ){ # we have type, pointer and possibly identifier # so all pointer types are covered here $ret{'type'} = $1; $ret{'pointer'} = $2; $ret{'identifier'} = $3 ? $3 : $$nextvarname++; $ret{'as-string-with-identifier'} = join(' ', $ret{'type'}, $ret{'pointer'}, $ret{'identifier'}); $ret{'as-string-without-identifier'} = join(' ', $ret{'type'}, $ret{'pointer'}); return \%ret; } else { # this is tricky because we have no idea if it has identifier # at the end e.g. 'unsigned int x' or 'unsigned int' # we will break it and then search the last item in CTYPES # if not there then it is an identifier # we know that there are no pointers! my @types = split(/\s+/, $arg); if( exists $CTYPES{$types[-1]} ){ # there is no identifier $ret{'type'} = $arg; $ret{'pointer'} = undef; $ret{'identifier'} = $$nextvarname++; $ret{'as-string-with-identifier'} = join(' ', $ret{'type'}, $ret{'identifier'}); $ret{'as-string-without-identifier'} = $ret{'type'}; return \%ret; } else { # we assume that the last item of the type is an identifier $ret{'identifier'} = pop @types; $ret{'type'} = join ' ', @types; $ret{'pointer'} = undef; $ret{'as-string-with-identifier'} = join(' ', $ret{'type'}, $ret{'identifier'}); $ret{'as-string-without-identifier'} = $ret{'type'}; return \%ret; } } return undef # does not come here }
1 POD Error
The following errors were encountered while parsing the POD:
- Around line 272:
Unterminated L<...> sequence