#!/usr/bin/env perl

# run sbin/build-gcc-builtins-package.sh
# at the end you will have a whitelist.txt.final file
# replace the whitelist hash here with its contents
# don't do anything with the blacklist
# (for a function to be added must exist in whitelist and not exist in blacklist)
# run current script: sbin/build-gcc-builtins-package.pl
#  perl Makefile.PL && make all && make test
# observe expected values and copy them in expected hash here
# re-check the make test
# and that is it.

#########################################################################
#### 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
#########################################################################

use strict;
use warnings;

use LWP::UserAgent;
use HTML5::DOM;
use Inline::C::Parser::RegExp;
use Data::Roundtrip qw/perl2dump no-unicode-escape-permanently/;
use File::Spec;
use FindBin;

my $curdir = $FindBin::Bin;

my $GCC_Builtins_HTML_URL = 'https://gcc.gnu.org/onlinedocs/gcc/Other-Builtins.html';
# if you have the HTML from above URL then declare it here
# it will use this without fetching it (for when trying to debug something and don't want to bother the server all the time)
# or leave undef to fetch
my $GCC_Builtins_HTML_filename = File::Spec->catfile($curdir, '..', 'Other-Builtins.html');
my $PM_outfile = File::Spec->catfile($curdir, '..', 'lib', 'GCC', 'Builtins.pm');
my $XS_outfile = File::Spec->catfile($curdir, '..', 'lib', 'GCC', 'Builtins.xs');
my $TYPEMAP_outfile = File::Spec->catfile($curdir, '..', 'typemap');
my $TDIR = File::Spec->catdir($curdir, '..', 't');

my %function_names_whitelist = map { $_ => 1 } (
	'__builtin_clz',
	'__builtin_bswap16',
	'__builtin_bswap32',
	'__builtin_bswap64',
	'__builtin_clrsb',
	'__builtin_clrsbl',
	'__builtin_clrsbll',
	'__builtin_clz',
	'__builtin_clzl',
	'__builtin_clzll',
	'__builtin_ctz',
	'__builtin_ctzl',
	'__builtin_ctzll',
	'__builtin_ffs',
	'__builtin_ffsl',
	'__builtin_ffsll',
	'__builtin_huge_val',
	'__builtin_huge_valf',
	'__builtin_huge_vall',
	'__builtin_inf',
	'__builtin_infd128',
	'__builtin_infd32',
	'__builtin_infd64',
	'__builtin_inff',
	'__builtin_infl',
	'__builtin_nan',
	'__builtin_nanf',
	'__builtin_nanl',
	'__builtin_parity',
	'__builtin_parityl',
	'__builtin_parityll',
	'__builtin_popcount',
	'__builtin_popcountl',
	'__builtin_popcountll',
	'__builtin_powi',
	'__builtin_powif',
	'__builtin_powil',
);

# these are either unknown or depend on unknown symbols
# don't use them
my %function_names_blacklist = map { $_ => 1 }(
	'__builtin_alloca',
	'__builtin_alloca_with_align',
	'__builtin_alloca_with_align_and_max',
	'__builtin_expect',
	'__builtin_expect_with_probability',
	'__builtin_goacc_parlevel_id',
	'__builtin_goacc_parlevel_size',
	'__builtin_is_constant_evaluated',
	'__builtin_object_size',
	'__builtin_dynamic_object_size',
	'__builtin_nansl',
	'__builtin_nansf',
	'__builtin_nans',
	'__builtin_nand32',
	'__builtin_nand64',
	'__builtin_nand128',
	'__builtin_nansd32',
	'__builtin_nansd64',
	'__builtin_nansd128',
	'__builtin___clear_cache',
	'__builtin_trap',
	'__builtin_unreachable',
	'__builtin_FILE',
	'__builtin_FUNCTION',
	'__builtin_LINE',
	'__builtin_alloca',
	'__trap',
);
my $bs = 'whitelist.txt';
if( -f $bs ){
	%function_names_whitelist = ();
	my $xx;
	open($xx, '<', $bs) or die "failed to open $bs: $!";
	while( my $al = <$xx> ){
		chomp $al;
		$al =~ s/\s+//;
		next if $al =~ /^\s*$/;
		$function_names_whitelist{$al} = 1
	}
	close $xx;
}
$bs = 'blacklist.txt';
if( -f $bs ){
#	%function_names_blacklist = ();
	my $xx;
	open($xx, '<', $bs) or die "failed to open $bs: $!";
	while( my $al = <$xx> ){
		chomp $al;
		$al =~ s/\s+//;
		next if $al =~ /^\s*$/;
		$function_names_blacklist{$al} = 1
	}
	close $xx;
}

my $num_function_names_whitelist = scalar keys %function_names_whitelist;
my $num_function_names_blacklist = scalar keys %function_names_blacklist;

my %CTYPES = map { $_ => 1 } (
		'unsigned char', 'signed char', 'char', 'unsigned int',
		'signed int', 'int', 'unsigned short int', 'signed short int',
		'short int', 'unsigned long int', 'signed long int', 'long int',
		'long double', 'double', 'float', 'long',
		# obtained with
		#   grep '^typedef ' /usr/include/bits/stdint-intn.h | awk '{print $NF}' | sed 's/;//'
		#   grep '^typedef ' /usr/include/bits/stdint-uintn.h | awk '{print $NF}' | sed 's/;//'
		#   grep '^typedef ' /usr/include/stdint.h | awk '{print $NF}' | sed 's/;//'
		'int8_t', 'int16_t', 'int32_t', 'int64_t', 'uint8_t',
		'uint16_t', 'uint32_t', 'uint64_t', 'int_least8_t',
		'int_least16_t', 'int_least32_t', 'int_least64_t', 'uint_least8_t',
		'uint_least16_t', 'uint_least32_t', 'uint_least64_t', 'int_fast8_t',
		'int_fast16_t', 'int_fast32_t', 'int_fast64_t', 'int_fast16_t',
		'int_fast32_t', 'int_fast64_t', 'uint_fast8_t', 'uint_fast16_t',
		'uint_fast32_t', 'uint_fast64_t', 'uint_fast16_t', 'uint_fast32_t',
		'uint_fast64_t', 'intptr_t', 'uintptr_t', 'intptr_t', 'uintptr_t',
		'intmax_t', 'uintmax_t',
		# obtained via https://stackoverflow.com/questions/34588650/uint128-t-does-not-name-a-type
		'int128', 'unsigned int128', 'int128_t', 'uint128_t',
		# some non-standard
		'_Decimal64',
);

my $PM_CONTENTS =<<'EOP';
package GCC::Builtins;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.02';

our @ISA = (qw/Exporter DynaLoader/);
our %EXPORT_TAGS = ( 'all' => [qw( <% list_of_sub_names %>)] );
our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );

require DynaLoader;
__PACKAGE__->bootstrap($VERSION);

#########################################################################
#### 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
#########################################################################

=pod

=encoding UTF-8

=head1 NAME

GCC::Builtins - access GCC compiler builtin functions via XS

=head1 VERSION

Version 0.02

=head1 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);
    # 28

=head1 EXPORT

=over 2

<% list_of_exported_subs %>

=back

Export tag C<:all> imports B<all> exportable functions, like:

  use GCC::Builtins qw/:all/;


=head1 SUBROUTINES

<% exported_subs_descriptions %>

=head1 UPDATING THE LIST OF FUNCTIONS

The list of functions was extracted from L<https://gcc.gnu.org/onlinedocs/gcc/Other-Builtins.html>
using the script C<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 C<FUNCTION()>,
C<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 C<CFLAGS> in C<Makefile.PL>).

If you need another builtin function to be supported please raise
an L<issue|https://rt.cpan.org/NoAuth/ReportBug.html?Queue=GCC-Builtins>.
Please make sure you provide me with a way to include this function.
What C<CFLAGS>, how to C<typemap> its return type and arguments. And
also provide a test script to test it (similar to those found in C<t/> directory).

=head1 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.

=head1 BENCHMARKS

Counting leading zeros (clz) will be used to
benchmark the GCC builtin C<__builtin_clz()>
and a pure Perl implementation as suggested
by Perl Monk L<coldr3ality|https://perlmonks.org/?node_id=1232041>
in this L<discussion|https://perlmonks.org/?node_id=11158279>

C<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 C<__builtin_clz()>
which is about twice as fast as the pure Perl implementation.

The benchmarks can be run with C<make benchmarks>
An easy way to let Perl fetch and unpack the distribution
for you is to use C<cpanm> to open a shell

   cpanm --look GCC::Builtins

and then

   perl Makefile.PL && make all && make test && make benchmarks

=head1 CAVEATS

If you observe weird return results or core-dumps it is very likely that
the fault is mine while compiling the C<XS typemap>. The file in the distribution
C<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 C<uint_fast16_t> equivalent to Perl's C<T_UV>? How about
C's C<long double> mapping to Perl's C<T_DOUBLE> and C<unsigned long long>
to C<T_U_LONG>?

Please L<report|https://rt.cpan.org/NoAuth/ReportBug.html?Queue=GCC-Builtins> any corrections.

Also note that most parts (pod of subs, list of exported subs) of
the package file, XS code (e.g. XS functions) and test files
were automatically generated
by the procedure mentioned in L</UPDATING THE LIST OF FUNCTIONS>. It is
possible to contain mistakes.

=head1 AUTHOR

Andreas Hadjiprocopis, C<< <bliako ta cpan.org / andreashad2 ta gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-gcc-builtins at rt.cpan.org>, or through
the web interface at L<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.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc GCC::Builtins


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=GCC-Builtins>


=item * Review this module at PerlMonks

L<https://www.perlmonks.org/?node_id=21144>

=item * Search CPAN

L<https://metacpan.org/release/GCC-Builtins>

=back


=head1 ACKNOWLEDGEMENTS

=over 2

=item * This module started by this discussion at PerlMonks:

L<Most Significant Set Bit|https://perlmonks.org/?node_id=11158279>

=item * Hackers of Free Software.

=item * GNU and the Free Software Foundation, providers of GNU Compiler Collection.

=back

=head1 HUGS

!Almaz!


=head1 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)


=cut

1; # End of GCC::Builtins
EOP

# note: XS comments are ' #' (that is a space followed by #)
# and are allowed after MODULE
# but only at the beginning of the line
my $XS_CONTENTS =<<'EOP';

/*
 #######################################################
 # Warning: this file has been auto-generated
 # DO NOT EDIT if you can resist it.
 # neither edit typemap not GCC/Buildins.pm
 # make your edits in sbin/build-gcc-builtins-package.pl
 #######################################################
*/
#define PERL_NO_GET_CONTEXT // we'll define thread context if necessary (faster)
#include "EXTERN.h"         // globals/constant import locations
#include "perl.h"           // Perl symbols, structures and constants definition
#include "XSUB.h"           // xsubpp functions and macros
#include <stdlib.h>         // rand()

#ifndef __has_builtin
#error "Your compiler does not support builtin functions, note this is a naive and lame test."
#endif

typedef __int128 int128_t;
typedef unsigned __int128 uint128_t;

MODULE = GCC::Builtins  PACKAGE = GCC::Builtins
PROTOTYPES: ENABLE

 # The following XS code has been automatically generated:

EOP

my $T_CONTENTS =<<'EOP';
#!perl
use 5.006;
use strict;
use warnings;
use Test::More;

our $VERSION = '0.02';

use GCC::Builtins qw/:all/;

<% test_func_run %>
<% test_func_is_ok %>

done_testing();
EOP

my %T_EXPECTED_RESULTS = (
	'FUNCTION' => 'XS_GCC__Builtins_FUNCTION',
	'bswap16' => '512',
	'bswap32' => '33554432',
	'bswap64' => '144115188075855872',
	'clrsb' => '29',
	'clrsbl' => '61',
	'clrsbll' => '61',
	'clz' => '30',
	'clzl' => '62',
	'clzll' => '62',
	'ctz' => '1',
	'ctzl' => '1',
	'ctzll' => '1',
	'ffs' => '2',
	'ffsl' => '2',
	'ffsll' => '2',
	'huge_val' => 'Inf',
	'huge_valf' => 'Inf',
	'huge_vall' => 'Inf',
	'inf' => 'Inf',
	'infd32' => 'Inf',
	'infd64' => 'Inf',
	'infd128' => 'Inf',
	'inff' => 'Inf',
	'infl' => 'Inf',
	'nan' => 'NaN',
	'nanl' => 'NaN',
	'nanf' => 'NaN',
	'parity' => '1',
	'parityl' => '1',
	'parityll' => '1',
	'popcount' => '1',
	'popcountl' => '1',
	'popcountll' => '1',
	'powi' => '6.5536',
	'powil' => '4',
	'powif' => '6.55359983444214',
);

# add some types to the typemap
my %TYPEMAP;
for my $atype (sort keys %CTYPES){
	my $mapsto;
	if( $atype =~ /^int_(.+?)_t/ ){
		$mapsto = 'T_IV';
	} elsif( $atype =~ /^int(\d+)_t/ ){
		$mapsto = 'T_IV';
	} elsif( $atype =~ /^uint(\d+)_t/ ){
		$mapsto = 'T_UV';
	} elsif( $atype =~ /^uint_.+?_t/ ){
		$mapsto = 'T_UV';
	} elsif( $atype =~ /^int(:?max|fast)_t/ ){
		$mapsto = 'T_IV';
	} elsif( $atype =~ /^uint(:?max|fast)_t/ ){
		$mapsto = 'T_UV';
	} elsif( $atype =~ /^int\d+_t/ ){
		$mapsto = 'T_IV';
	} elsif( $atype =~ /^uint\d+_t/ ){
		$mapsto = 'T_UV';
	} elsif( $atype =~ /^int(:?ptr)_t/ ){
		$mapsto = 'T_PTR';
	} else {
		#die "unhandled type '$atype', fix me";
		next;
	}
	$TYPEMAP{$atype} = $mapsto;
}
for my $am ('const'){
	for my $at ('void'){
		my $al = $am.' '.$at.' *'; $al =~ s/^\s+//;
		$TYPEMAP{$al} = 'T_PTR';
	}
}
for my $am ('_Decimal'){
	for my $at ('32', '64', '128'){
		my $al = $am.$at;
		$TYPEMAP{$al} = 'T_DOUBLE';
	}
}
$TYPEMAP{'long double'} = 'T_DOUBLE';
$TYPEMAP{'long long'} = 'T_LONG';
$TYPEMAP{'unsigned long long'} = 'T_U_LONG';

my ($content, $FH);
if( defined($GCC_Builtins_HTML_filename)
 && (-f $GCC_Builtins_HTML_filename)
){
	open($FH, '<', $GCC_Builtins_HTML_filename) or die "error, failed to open input file '$GCC_Builtins_HTML_filename': $!";
	{ local $/ = undef; $content = <$FH> } close $FH;
	print "$0 : read html content FROM LOCAL FILE ($GCC_Builtins_HTML_filename), erase it if you want to fetch it fresh.\n";
} else {
	my $ua = LWP::UserAgent->new();
	my $response = $ua->get($GCC_Builtins_HTML_URL);
	if( ! defined $response ){ die "error, GET($GCC_Builtins_HTML_URL) has failed with undefined response." }
	if( ! $response->is_success ){ die "error, GET($GCC_Builtins_HTML_URL) has failed with this status '".$response->code."' and this message: ".$response->status_line }
	$content = $response->decoded_content;
	open($FH, '>', $GCC_Builtins_HTML_filename) or die "error, failed to open output file '$GCC_Builtins_HTML_filename' for writing: $!";
	print $FH $content;
	close $FH;
	print "$0 : html content was fetched from URL '$GCC_Builtins_HTML_URL' (and saved to local file '$GCC_Builtins_HTML_filename') ...\n";
}

my $parser = HTML5::DOM->new;

my $tree = $parser->parse($content);

my $cssSelector = 'dl.first-deftypefn dt';
my $tags = $tree->find($cssSelector);
if( ! defined $tags ){ die "error, failed to get tags back via CSS selector: ${cssSelector}" }
if( $tags->length() == 0 ){ die "error, got zero tags back via CSS selector: ${cssSelector}" }
my ($atag, $cssSelector2, $span_category_def, $return_type);
my %funcs;
for $atag (@$tags){
	$cssSelector2 = 'span.category-def';
	$span_category_def = $atag->find($cssSelector2);
	if( ! defined($span_category_def) ){ die "error, failed to find span with CSS selector '$cssSelector2' under tag : $atag" }
	if( $span_category_def->text() !~ /^\s*Built-in Function\s*\:\s*$/ ){
		print STDERR "${atag}\n$0 : skipping above tag because span gotten by CSS selector '$cssSelector2' has yielded a span with unexpected text:\n  ".$span_category_def->text()."\n";
		next
	}

	$return_type = get_function_return_type($atag);
	if( ! defined $return_type ){ print "skipping because of get_function_return_type() ...\n"; next }

	my %func = (
		'return-type' => $return_type
	);

	my $func_name = get_function_name($atag);
	if( ! defined $func_name ){ print "skipping because of get_function_name() ...\n"; next }
	$func{'name'} = $func_name;
	$func{'xs-name'} = $func_name; $func{'xs-name'} =~ s/^__builtin_//;

	my $func_arguments = get_function_arguments($atag);
	if( ! defined $func_arguments ){ print "skipping because of get_function_arguments() ...\n"; next }
	$func{'arguments'} = $func_arguments;
	# extract the variable names from their types
	my $notype_args = "";
	my $varname = 'aaa'; # auto-incremented var names in case none is specified
	my (@thevars, $at);
	for my $anarg ( split(/\s*,\s*/, $func{'arguments'}) ){
		my $retvart = process_function_argument($anarg, \$varname);
		if( ! defined $retvart ){ die "error, call to ".'process_function_argument()'." has failed for argument '$anarg'." }
		# this returns: { 'type', 'pointer', 'identifier', 'as-string-with-identifier', 'as-string-without-identifier'}
		push @thevars, $retvart;
	}
	$func{'arguments-processed'} = \@thevars;
	for $at (qw/identifier type/){
		$func{'arguments-processed-'.$at.'s'} = [ map { $_->{$at} } @thevars ];
	}
	$func{'arguments-processed-identifiers-string'} = join(',', @{ $func{'arguments-processed-identifiers'} });
	$func{'arguments-processed-types-string'} = join(',', @{ $func{'arguments-processed-types'} });

	$func{'arguments-processed-type-and-identifier-string'} = "";
	for (@thevars){
		$func{'arguments-processed-type-and-identifier-string'} .= $_->{'as-string-with-identifier'}.',';
	}
	$func{'arguments-processed-type-and-identifier-string'} =~ s/,$//;

	$func{'xs-signature'} = $func{'return-type'}.' '.$func{'xs-name'}.'('.$func{'arguments-processed-type-and-identifier-string'}.')';
	$func{'xs-signature-without-identifiers'} = $func{'return-type'}.' '.$func{'xs-name'}.'('.$func{'arguments-processed-types-string'}.')';
	$func{'signature'} = $func{'return-type'}.' '.$func{'name'}.'('.$func{'arguments-processed-type-and-identifier-string'}.')';

#if( $func{'name'} eq '__builtin_parityl' ){ die perl2dump(\%func) }
	$func{'xs-code'} =<<EOX;
$func{'return-type'}
$func{'xs-name'}($func{'arguments-processed-type-and-identifier-string'})
  CODE:
EOX
	# void "returning" functions  do not need an OUTPUT section
	if( ! ($func{'return-type'} eq 'void') ){
		$func{'xs-code'} .=<<EOX
    RETVAL = $func{'name'}($func{'arguments-processed-identifiers-string'});
  OUTPUT:
    RETVAL
EOX
	} else {
		$func{'xs-code'} .=<<EOX
    $func{'name'}($func{'arguments-processed-identifiers-string'});
EOX
	}

	# now go to the parent node (which is the dl)
	# and contains a dd with a p with the description
	my $p = $atag->parent->at('dd p');
	$func{'description'} = $p->text();

	my $testargs = "";
	ARGLOOP:
	for my $argus (@{ $func{'arguments-processed'} }){
		if( $argus->{'type'} =~ /int|long|short|size_t/ ){
			if( exists($argus->{'pointer'}) && defined($argus->{'pointer'}) ){
				print STDERR "$0 : I don't know how to call this function '".$func{'xs-signature'}."' from Perl.\n";
				last ARGLOOP;
			} else {
				$testargs .= "2,";
			}
		} elsif( $argus->{'type'} =~ /double|float/ ){
			if( exists($argus->{'pointer'}) && defined($argus->{'pointer'}) ){
				print STDERR "$0 : I don't know how to call this function '".$func{'xs-signature'}."' from Perl.\n";
				last ARGLOOP;
			} else {
				$testargs .= "2.56,";
			}
		} elsif( $argus->{'type'} =~ /char/ ){
			if( exists($argus->{'pointer'}) && defined($argus->{'pointer'}) ){
				$testargs .= "'some string',";
			} else {
				$testargs .= "'c',";
			}
		} else {
			die "error, input parameters for '".$func{'xs-signature'}."' need to be implemented."
		}
	}
	$testargs =~ s/,$//;

	if( $func{'return-type'} eq 'void' ){
		$func{'test_func_run'} = $func{'xs-name'}.'('.$testargs.');';
		$func{'test_func_is_ok'} = "";
	} else {
		$func{'test_func_run'} = 'my $res = '.$func{'xs-name'}.'('.$testargs.');';
		my $expected;
		if( ! exists($T_EXPECTED_RESULTS{$func{'xs-name'}}) || ! defined($expected=$T_EXPECTED_RESULTS{$func{'xs-name'}}) ){
			print STDERR "$0 : warning, there is no expected value for testing ".$func{'xs-name'}."(). I will use a dummy and you need to fix it when the test fails.\n";
			$expected = 'dummy_expected';
		}
		$func{'test_func_is_ok'} = 'my $expected = "'.$expected.'";'
					   ."\n".'is($res, $expected, "called '
					   .$func{'xs-name'}
					   .'('.$testargs.') and got result ($res), expected ($expected).");'
					   ."\n".'diag("copy-this-expected-value \''.$func{'xs-name'}.'\' => \'$res\',");'
		;
	}

	# and done
	$funcs{ $func{'name'} } = \%func;
}

# Inside the .pm output we have 2 lists to add: exported subs
# and pod of each of this exported sub
my $list_of_sub_names = "";
my $list_of_exported_subs = "";
my $exported_subs_descriptions = "";
# you can use $afuncdata->{'xs-signature-without-identifiers'} to have identifiers included
for my $afuncname (sort keys %funcs){
	my $afuncdata = $funcs{$afuncname};
	$list_of_sub_names .= $afuncdata->{'xs-name'}.' ';
	$list_of_exported_subs .= '=item * C<'.$afuncdata->{'xs-signature-without-identifiers'}.">\n\n";
	$exported_subs_descriptions .=<<EOP;
=head2 C<$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/<%\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:\n$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
}
