#!/usr/bin/perl

use strict;
use 5.6.0;
use warnings;

# This perl script generates a C program which generates a perl
# script. It's gonna get ugly.

my @types = ('char', 'signed char', 'unsigned char', 'short',
             'unsigned short', 'int', 'unsigned', 'long', 'unsigned long',
             'long long', 'unsigned long long', 'float', 'double', 'long double',
             '_Bool', 'void *', 'enum null_enum');

sub mangle_typename
  {
    my $name = shift;
    $name =~ s/\*/ptr/g;
    $name =~ s/[^\w]/_/g;
    return $name;
  }

sub print_align_struct
  {
    my $type = shift;
    my $name = mangle_typename($type);
    print <<"END";
struct align_$name
{
  char pad;
  $type object;
};

END
  }

print <<END;
enum null_enum {enumerator};

END

print_align_struct($_) foreach @types;

print <<END;
#include <stddef.h>
#include <limits.h>
#include <stdio.h>

int
main(void)
{
  printf("package CType::Native;\\n");
  printf("\\n");
  printf("use 5.6.0;\\n");
  printf("use strict;\\n");
  printf("use warnings;\\n");
  printf("\\n");
  printf("use bigint;\\n");
  printf("use CType::Fundamental qw/register_type_attrs/;\\n");
  printf("\\n");
END

# We can't use gcc's __alignof__ function because it's
# broken. __alignof__(double) returns 8 on i686-linux-gnu, but the
# correct value is 4. Instead we'll examine how a struct is laid out,
# to deduce the alignment actually used.

sub alignof
  {
    my $type = shift;
    my $name = mangle_typename($type);
    return "offsetof(struct align_$name, object) * 8";
  }

sub signof
  {
    my $type = shift;
    return "((($type) -1) < 0)";
  }

sub sizeof
  {
    my $type = shift;
    return "sizeof($type) * 8";
  }

my %printf_limit_values = ('long' => '%ld',
                           'unsigned long' => '%lu',
                           'long long' => '%lld',
                           'unsigned long long' => '%llu',
                          );

my %limit_values = ('char' => 'CHAR',
                    'signed char' => 'SCHAR',
                    'unsigned char' => 'UCHAR',
                    'short' => 'SHRT',
                    'unsigned short' => 'USHRT',
                    'int' => 'INT',
                    'unsigned' => 'UINT',
                    'long' => 'LONG',
                    'unsigned long' => 'ULONG',
                    'long long' => 'LLONG',
                    'unsigned long long' => 'ULLONG'
                   );

sub printf_limit_min
  {
    my $type = shift;
    return '\%d' unless $printf_limit_values{$type};
    return '\%d' if $type =~ /unsigned/;
    return $printf_limit_values{$type};
  }

sub printf_limit_max
  {
    my $type = shift;
    return '\%d' unless $printf_limit_values{$type};
    return $printf_limit_values{$type};
  }

sub minof
  {
    my $type = shift;
    return '0' unless $limit_values{$type};
    return '0' if $type =~ /unsigned/;
    return $limit_values{$type} . '_MIN';
  }

sub maxof
  {
    my $type = shift;
    return '0' unless $limit_values{$type};
    return $limit_values{$type} . '_MAX';
  }

sub print_register_attrs
  {
    my $type = shift;
    my $ln = printf_limit_min($type);
    my $lx = printf_limit_max($type);
    print "  printf(\"register_type_attrs('$type', \%d, \%d, \%d, $ln, $lx);\\n\",\n";
    print "         " . sizeof($type) . ", " . alignof($type) . ", " . signof($type) . ",\n";
    print "         " . minof($type) . ", " . maxof($type) . ");\n";
  }

print_register_attrs($_) foreach @types;

print <<END;
  printf("\\n");
  printf("1;\\n");
  return 0;
}
END
