INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Constant.pm
index 4efccfe..024d8cc 100644 (file)
@@ -1,4 +1,6 @@
 package ExtUtils::Constant;
+use vars qw (@ISA $VERSION %XS_Constant %XS_TypeSet @EXPORT_OK %EXPORT_TAGS);
+$VERSION = '0.06';
 
 =head1 NAME
 
@@ -55,6 +57,22 @@ NUL terminated string, length will be determined with C<strlen>
 A fixed length thing, given as a [pointer, length] pair. If you know the
 length of a string at compile time you may use this instead of I<PV>
 
+=item PVN
+
+A B<mortal> SV.
+
+=item YES
+
+Truth.  (C<PL_sv_yes>)  The value is not needed (and ignored).
+
+=item NO
+
+Defined Falsehood.  (C<PL_sv_no>)  The value is not needed (and ignored).
+
+=item UNDEF
+
+C<undef>.  The value of the macro is not needed.
+
 =back
 
 =head1 FUNCTIONS
@@ -69,13 +87,11 @@ use strict;
 use Carp;
 
 use Exporter;
-use vars qw (@ISA $VERSION %XS_Constant %XS_TypeSet @EXPORT_OK %EXPORT_TAGS);
 use Text::Wrap;
 $Text::Wrap::huge = 'overflow';
 $Text::Wrap::columns = 80;
 
 @ISA = 'Exporter';
-$VERSION = '0.03';
 
 %EXPORT_TAGS = ( 'all' => [ qw(
        XS_constant constant_types return_clause memEQ_clause C_stringify
@@ -85,19 +101,27 @@ $VERSION = '0.03';
 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
 %XS_Constant = (
-                IV => 'PUSHi(iv)',
-                UV => 'PUSHu((UV)iv)',
-                NV => 'PUSHn(nv)',
-                PV => 'PUSHp(pv, strlen(pv))',
-                PVN => 'PUSHp(pv, iv)'
+               IV    => 'PUSHi(iv)',
+               UV    => 'PUSHu((UV)iv)',
+               NV    => 'PUSHn(nv)',
+               PV    => 'PUSHp(pv, strlen(pv))',
+               PVN   => 'PUSHp(pv, iv)',
+               SV    => 'PUSHs(sv)',
+               YES   => 'PUSHs(&PL_sv_yes)',
+               NO    => 'PUSHs(&PL_sv_no)',
+               UNDEF => '',    # implicit undef
 );
 
 %XS_TypeSet = (
-                IV => '*iv_return =',
-                UV => '*iv_return = (IV)',
-                NV => '*nv_return =',
-                PV => '*pv_return =',
-                PVN => ['*pv_return =', '*iv_return = (IV)']
+               IV    => '*iv_return =',
+               UV    => '*iv_return = (IV)',
+               NV    => '*nv_return =',
+               PV    => '*pv_return =',
+               PVN   => ['*pv_return =', '*iv_return = (IV)'],
+               SV    => '*sv_return = ',
+               YES   => undef,
+               NO    => undef,
+               UNDEF => undef,
 );
 
 
@@ -116,6 +140,9 @@ sub C_stringify {
   s/([\"\'])/\\$1/g;   # Grr. fix perl mode.
   s/\n/\\n/g;          # Ensure newlines don't end up in octal
   s/\r/\\r/g;
+  s/\t/\\t/g;
+  s/\f/\\f/g;
+  s/\a/\\a/g;
   s/([[:cntrl:]])/sprintf "\\%03o", ord $1/ge;
   s/\177/\\177/g;      # DEL doesn't seem to be a [:cntrl:]
   $_;
@@ -188,11 +215,13 @@ sub memEQ_clause {
   return $body;
 }
 
-=item assign INDENT, TYPE, VALUE...
+=item assign INDENT, TYPE, PRE, POST, VALUE...
 
 A function to return a suitable assignment clause. If I<TYPE> is aggregate
 (eg I<PVN> expects both pointer and length) then there should be multiple
-I<VALUE>s for the components.
+I<VALUE>s for the components. I<PRE> and I<POST> if defined give snippets
+of C code to preceed and follow the assignment. I<PRE> will be at the start
+of a block, so variables may be defined in it.
 
 =cut
 
@@ -201,25 +230,43 @@ I<VALUE>s for the components.
 sub assign {
   my $indent = shift;
   my $type = shift;
-  my $typeset = $XS_TypeSet{$type};
+  my $pre = shift;
+  my $post = shift || '';
   my $clause;
-  die "Can't generate code for type $type" unless defined $typeset;
+  my $close;
+  if ($pre) {
+    chomp $pre;
+    $clause = $indent . "{\n$pre";
+    $clause .= ";" unless $pre =~ /;$/;
+    $clause .= "\n";
+    $close = "$indent}\n";
+    $indent .= "  ";
+  }
+  die "Can't generate code for type $type" unless exists $XS_TypeSet{$type};
+  my $typeset = $XS_TypeSet{$type};
   if (ref $typeset) {
     die "Type $type is aggregate, but only single value given"
       if @_ == 1;
     foreach (0 .. $#$typeset) {
       $clause .= $indent . "$typeset->[$_] $_[$_];\n";
     }
-  } else {
+  } elsif (defined $typeset) {
     die "Aggregate value given for type $type"
       if @_ > 1;
     $clause .= $indent . "$typeset $_[0];\n";
   }
+  chomp $post;
+  if (length $post) {
+    $clause .= "$post";
+    $clause .= ";" unless $post =~ /;$/;
+    $clause .= "\n";
+  }    
   $clause .= "${indent}return PERL_constant_IS$type;\n";
+  $clause .= $close if $close;
   return $clause;
 }
 
-=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT
+=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT, PRE, POST, PRE, POST
 
 A function to return a suitable C<#ifdef> clause. I<MACRO> defaults to
 I<VALUE> when not defined.  If I<TYPE> is aggregate (eg I<PVN> expects both
@@ -228,17 +275,20 @@ values in the order expected by the type.  C<C_constant> will always call
 this function with I<MACRO> defined, defaulting to the constant's name.
 I<DEFAULT> if defined is an array reference giving default type and and
 value(s) if the clause generated by I<MACRO> doesn't evaluate to true.
+The two pairs I<PRE> and I<POST> if defined give C code snippets to proceed
+and follow the value, and the default value.
 
 =cut
 
-sub return_clause ($$$$$) {
+sub return_clause ($$$$$$$$$) {
 ##ifdef thingy
 #      *iv_return = thingy;
 #      return PERL_constant_ISIV;
 ##else
 #      return PERL_constant_NOTDEF;
 ##endif
-  my ($value, $type, $indent, $macro, $default) = @_;
+  my ($value, $type, $indent, $macro, $default, $pre, $post,
+      $def_pre, $def_post) = @_;
   $macro = $value unless defined $macro;
   $indent = ' ' x ($indent || 6);
 
@@ -253,7 +303,8 @@ sub return_clause ($$$$$) {
 
   #      *iv_return = thingy;
   #      return PERL_constant_ISIV;
-  $clause .= assign ($indent, $type, ref $value ? @$value : $value);
+  $clause .= assign ($indent, $type, $pre, $post,
+                     ref $value ? @$value : $value);
 
   ##else
   $clause .= "#else\n";
@@ -262,7 +313,9 @@ sub return_clause ($$$$$) {
   if (!defined $default) {
     $clause .= "${indent}return PERL_constant_NOTDEF;\n";
   } else {
-    $clause .= assign ($indent, ref $default ? @$default : $default);
+    my @default = ref $default ? @$default : $default;
+    $type = shift @default;
+    $clause .= assign ($indent, $type, $def_pre, $def_post, @default);
   }
 
   ##endif
@@ -274,6 +327,92 @@ sub return_clause ($$$$$) {
   return $clause
 }
 
+=item switch_clause INDENT, NAMELEN, ITEMHASH, ITEM...
+
+An internal function to generate a suitable C<switch> clause, called by
+C<C_constant> I<ITEM>s are in the hash ref format as given in the description
+of C<C_constant>, and must all have the names of the same length, given by
+I<NAMELEN> (This is not checked).  I<ITEMHASH> is a reference to a hash,
+keyed by name, values being the hashrefs in the I<ITEM> list.
+(No parameters are modified, and there can be keys in the I<ITEMHASH> that
+are not in the list of I<ITEM>s without causing problems).
+
+=cut
+
+sub switch_clause {
+  my ($indent, $comment, $namelen, $items, @items) = @_;
+  $indent = ' ' x ($indent || 2);
+  
+  my @names = sort map {$_->{name}} @items;
+  my $leader = $indent . '/* ';
+  my $follower = ' ' x length $leader;
+  my $body = $indent . "/* Names all of length $namelen.  */\n";
+  if ($comment) {
+    $body = wrap ($leader, $follower, $comment) . "\n";
+    $leader = $follower;
+  }
+  $body .= wrap ($leader, $follower, join (" ", @names) . " */") . "\n";
+  # Figure out what to switch on.
+  # (RMS, Spread of jump table, Position, Hashref)
+  my @best = (1e38, ~0);
+  foreach my $i (0 .. ($namelen - 1)) {
+    my ($min, $max) = (~0, 0);
+    my %spread;
+    foreach (@names) {
+      my $char = substr $_, $i, 1;
+      my $ord = ord $char;
+      $max = $ord if $ord > $max; 
+      $min = $ord if $ord < $min;
+      push @{$spread{$char}}, $_;
+      # warn "$_ $char";
+    }
+    # I'm going to pick the character to split on that minimises the root
+    # mean square of the number of names in each case. Normally this should
+    # be the one with the most keys, but it may pick a 7 where the 8 has
+    # one long linear search. I'm not sure if RMS or just sum of squares is
+    # actually better.
+    # $max and $min are for the tie-breaker if the root mean squares match.
+    # Assuming that the compiler may be building a jump table for the
+    # switch() then try to minimise the size of that jump table.
+    # Finally use < not <= so that if it still ties the earliest part of
+    # the string wins. Because if that passes but the memEQ fails, it may
+    # only need the start of the string to bin the choice.
+    # I think. But I'm micro-optimising. :-)
+    my $ss;
+    $ss += @$_ * @$_ foreach values %spread;
+    my $rms = sqrt ($ss / keys %spread);
+    if ($rms < $best[0] || ($rms == $best[0] && ($max - $min) < $best[1])) {
+      @best = ($rms, $max - $min, $i, \%spread);
+    }
+  }
+  die "Internal error. Failed to pick a switch point for @names"
+    unless defined $best[2];
+  # use Data::Dumper; print Dumper (@best);
+  my ($offset, $best) = @best[2,3];
+  $body .= $indent . "/* Offset $offset gives the best switch position.  */\n";
+  $body .= $indent . "switch (name[$offset]) {\n";
+  foreach my $char (sort keys %$best) {
+    $body .= $indent . "case '" . C_stringify ($char) . "':\n";
+    foreach my $name (sort @{$best->{$char}}) {
+      my $thisone = $items->{$name};
+      my ($value, $macro, $default, $pre, $post, $def_pre, $def_post)
+        = @$thisone{qw (value macro default pre post def_pre def_post)};
+      $value = $name unless defined $value;
+      $macro = $name unless defined $macro;
+
+      # We have checked this offset.
+      $body .= memEQ_clause ($name, $offset, 2 + length $indent);
+      $body .= return_clause ($value, $thisone->{type},  4 + length $indent,
+                              $macro, $default, $pre, $post,
+                              $def_pre, $def_post);
+      $body .= $indent . "  }\n";
+    }
+    $body .= $indent . "  break;\n";
+  }
+  $body .= $indent . "}\n";
+  return $body;
+}
+
 =item params WHAT
 
 An internal function. I<WHAT> should be a hashref of types the constant
@@ -291,27 +430,30 @@ sub params {
   my $use_iv = $what->{IV} || $what->{UV} || $what->{PVN};
   my $use_nv = $what->{NV};
   my $use_pv = $what->{PV} || $what->{PVN};
-  return ($use_iv, $use_nv, $use_pv);
+  my $use_sv = $what->{SV};
+  return ($use_iv, $use_nv, $use_pv, $use_sv);
 }
 
 =item dump_names  
 
-dump_names  PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, ITEM...
+dump_names  PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, BREAKOUT, ITEM...
 
 An internal function to generate the embedded perl code that will regenerate
-the constant subroutines.  Parameters are the same as for C_constant, except
-that there is no NAMELEN.
+the constant subroutines.  Parameters are the same as for C_constant.
 
 =cut
 
 sub dump_names {
-  my ($package, $subname, $default_type, $what, $indent, @items) = @_;
+  my ($package, $subname, $default_type, $what, $indent, $breakout, @items)
+    = @_;
   my (@simple, @complex);
   foreach (@items) {
     my $type = $_->{type} || $default_type;
     if ($type eq $default_type and 0 == ($_->{name} =~ tr/A-Za-z0-9_//c)
         and !defined ($_->{macro}) and !defined ($_->{value})
-        and !defined ($_->{default})) {
+        and !defined ($_->{default}) and !defined ($_->{pre})
+        and !defined ($_->{post}) and !defined ($_->{def_pre})
+        and !defined ($_->{def_post})) {
       # It's the default type, and the name consists only of A-Za-z0-9_
       push @simple, $_->{name};
     } else {
@@ -333,45 +475,32 @@ sub dump_names {
 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
 
 EOT
-  $result .= 'my $types = {' . join (", ", map "$_ => 1", sort keys %$what)
- . "};\n";
+  $result .= 'my $types = {map {($_, 1)} qw(' . join (" ", sort keys %$what)
+    . ")};\n";
   $result .= wrap ("my \@names = (qw(",
                   "               ", join (" ", sort @simple) . ")");
   if (@complex) {
     foreach my $item (sort {$a->{name} cmp $b->{name}} @complex) {
       my $name = C_stringify $item->{name};
-      my ($macro, $value, $default) = @$item{qw (macro value default)};
       my $line = ",\n            {name=>\"$name\"";
       $line .= ", type=>\"$item->{type}\"" if defined $item->{type};
-      if (defined $macro) {
-        if (ref $macro) {
-          $line .= ', macro=>["'. join ('", "', map {C_stringify $_} @$macro)
-            . '"]';
-        } else {
-          $line .= ", macro=>\"" . C_stringify($macro) . "\"";
-        }
-      }
-      if (defined $value) {
-        if (ref $value) {
-          $line .= ', value=>["'. join ('", "', map {C_stringify $_} @$value)
-            . '"]';
-        } else {
-          $line .= ", value=>\"" . C_stringify($value) . "\"";
-        }
-      }
-      if (defined $default) {
-        if (ref $default) {
-          $line .= ', default=>["'. join ('", "', map {C_stringify $_}
-                                          @$default)
-            . '"]';
-        } else {
-          $line .= ", default=>\"" . C_stringify($default) . "\"";
+      foreach my $thing (qw (macro value default pre post def_pre def_post)) {
+        my $value = $item->{$thing};
+        if (defined $value) {
+          if (ref $value) {
+            $line .= ", $thing=>[\""
+              . join ('", "', map {C_stringify $_} @$value) . '"]';
+          } else {
+            $line .= ", $thing=>\"" . C_stringify($value) . "\"";
+          }
         }
       }
       $line .= "}";
       # Ensure that the enclosing C comment doesn't end
       # by turning */  into *" . "/
       $line =~ s!\*\/!\*" . "/!gs;
+      # gcc -Wall doesn't like finding /* inside a comment
+      $line =~ s!\/\*!/" . "\*!gs;
       $result .= $line;
     }
   }
@@ -388,12 +517,13 @@ EOT
   if (defined $indent) {
     require Data::Dumper;
     $Data::Dumper::Terse=1;
+    $Data::Dumper::Terse=1; # Not used once. :-)
     chomp ($indent = Data::Dumper::Dumper ($indent));
     $result .= $indent;
   } else {
     $result .= 'undef';
   }
-  $result .= ', undef, @names) ) {
+  $result .= ", $breakout" . ', @names) ) {
     print $_, "\n"; # C constant subs
 }
 print "#### XS Section:\n";
@@ -408,7 +538,7 @@ __END__
 
 =item C_constant 
 
-C_constant PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, NAMELEN, ITEM...
+C_constant PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, BREAKOUT, ITEM...
 
 A function that returns a B<list> of C subroutine definitions that return
 the value and type of constants when passed the name by the XS wrapper.
@@ -453,6 +583,24 @@ Default value to use (instead of C<croak>ing with "your vendor has not
 defined...") to return if the macro isn't defined. Specify a reference to
 an array with type followed by value(s).
 
+=item pre
+
+C code to use before the assignment of the value of the constant. This allows
+you to use temporary variables to extract a value from part of a C<struct>
+and return this as I<value>. This C code is places at the start of a block,
+so you can declare variables in it.
+
+=item post
+
+C code to place between the assignment of value (to a temporary) and the
+return from the function. This allows you to clear up anything in I<pre>.
+Rarely needed.
+
+=item def_pre
+=item def_post
+
+Equivalents of I<pre> and I<post> for the default value.
+
 =back
 
 I<PACKAGE> is the name of the package, and is only used in comments inside the
@@ -473,16 +621,34 @@ be used to pass in information used to change the C indentation style used.]
 The best way to maintain consistency is to pass in a hash reference and let
 this function update it.
 
-I<NAMELEN> if defined signals that all the I<name>s of the I<ITEM>s are of
-this length, and that the constant name passed in by perl is checked and
-also of this length. It is used during recursion, and should be C<undef>
-unless the caller has checked all the lengths during code generation, and
-the generated subroutine is only to be called with a name of this length.
+I<BREAKOUT> governs when child functions of I<SUBNAME> are generated.  If there
+are I<BREAKOUT> or more I<ITEM>s with the same length of name, then the code
+to switch between them is placed into a function named I<SUBNAME>_I<LEN>, for
+example C<constant_5> for names 5 characters long.  The default I<BREAKOUT> is
+3.  A single C<ITEM> is always inlined.
 
 =cut
 
+# The parameter now BREAKOUT was previously documented as:
+#
+# I<NAMELEN> if defined signals that all the I<name>s of the I<ITEM>s are of
+# this length, and that the constant name passed in by perl is checked and
+# also of this length. It is used during recursion, and should be C<undef>
+# unless the caller has checked all the lengths during code generation, and
+# the generated subroutine is only to be called with a name of this length.
+#
+# As you can see it now performs this function during recursion by being a
+# scalar reference.
+
 sub C_constant {
-  my ($package, $subname, $default_type, $what, $indent, $namelen, @items) = @_;
+  my ($package, $subname, $default_type, $what, $indent, $breakout, @items)
+    = @_;
+  my $namelen;
+  if (ref $breakout) {
+    $namelen = $$breakout;
+  } else {
+    $breakout ||= 3;
+  }
   $package ||= 'Foo';
   $subname ||= 'constant';
   # I'm not using this. But a hashref could be used for full formatting without
@@ -499,9 +665,10 @@ sub C_constant {
   foreach (@items) {
     my $name;
     if (ref $_) {
+      my $orig = $_;
       # Make a copy which is a normalised version of the ref passed in.
       $name = $_->{name};
-      my ($type, $macro, $value, $default) = @$_{qw (type macro value default)};
+      my ($type, $macro, $value) = @$_{qw (type macro value)};
       $type ||= $default_type;
       $what->{$type} = 1;
       $_ = {name=>$name, type=>$type};
@@ -510,7 +677,11 @@ sub C_constant {
       $_->{macro} = $macro if defined $macro;
       undef $value if defined $value and $value eq $name;
       $_->{value} = $value if defined $value;
-      $_->{default} = $default if defined $default;
+      foreach my $key (qw(default pre post def_pre def_post)) {
+        my $value = $orig->{$key};
+        $_->{$key} = $value if defined $value;
+        # warn "$key $value";
+      }
     } else {
       $name = $_;
       $_ = {name=>$_, type=>$default_type};
@@ -522,85 +693,27 @@ sub C_constant {
     }
     $items{$name} = $_;
   }
-  my ($use_iv, $use_nv, $use_pv) = params ($what);
+  my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what);
 
   my ($body, @subs) = "static int\n$subname (const char *name";
   $body .= ", STRLEN len" unless defined $namelen;
   $body .= ", IV *iv_return" if $use_iv;
   $body .= ", NV *nv_return" if $use_nv;
   $body .= ", const char **pv_return" if $use_pv;
+  $body .= ", SV **sv_return" if $use_sv;
   $body .= ") {\n";
 
   if (defined $namelen) {
     # We are a child subroutine. Print the simple description
-    my @names = sort map {$_->{name}} @items;
-    my $names = << 'EOT'
-  /* When generated this function returned values for the list of names given
-     here.  However, subsequent manual editing may have added or removed some.
-EOT
-     . wrap ("     ", "     ", join (" ", @names) . " */") . "\n";
-    # Figure out what to switch on.
-    # (RMS, Spread of jump table, Position, Hashref)
-    my @best = (1e38, ~0);
-    foreach my $i (0 .. ($namelen - 1)) {
-      my ($min, $max) = (~0, 0);
-      my %spread;
-      foreach (@names) {
-        my $char = substr $_, $i, 1;
-        my $ord = ord $char;
-        $max = $ord if $ord > $max; 
-        $min = $ord if $ord < $min;
-        push @{$spread{$char}}, $_;
-        # warn "$_ $char";
-      }
-      # I'm going to pick the character to split on that minimises the root
-      # mean square of the number of names in each case. Normally this should
-      # be the one with the most keys, but it may pick a 7 where the 8 has
-      # one long linear search. I'm not sure if RMS or just sum of squares is
-      # actually better.
-      # $max and $min are for the tie-breaker if the root mean squares match.
-      # Assuming that the compiler may be building a jump table for the
-      # switch() then try to minimise the size of that jump table.
-      # Finally use < not <= so that if it still ties the earliest part of
-      # the string wins. Because if that passes but the memEQ fails, it may
-      # only need the start of the string to bin the choice.
-      # I think. But I'm micro-optimising. :-)
-      my $ss;
-      $ss += @$_ * @$_ foreach values %spread;
-      my $rms = sqrt ($ss / keys %spread);
-      if ($rms < $best[0] || ($rms == $best[0] && ($max - $min) < $best[1])) {
-        @best = ($rms, $max - $min, $i, \%spread);
-      }
-    }
-    die "Internal error. Failed to pick a switch point for @names"
-      unless defined $best[2];
-    # use Data::Dumper; print Dumper (@best);
-    my ($offset, $best) = @best[2,3];
-    $body .= "  /* Names all of length $namelen.  */\n";
-    $body .= $names;
-    $body .= "  /* Offset $offset gives the best switch position.  */\n";
-    $body .= "  switch (name[$offset]) {\n";
-    foreach my $char (sort keys %$best) {
-      $body .= "  case '" . C_stringify ($char) . "':\n";
-      foreach my $name (sort @{$best->{$char}}) {
-        my $thisone = $items{$name};
-        my ($value, $macro, $default) = @$thisone{qw (value macro default)};
-        $value = $name unless defined $value;
-        $macro = $name unless defined $macro;
-
-        $body .= memEQ_clause ($name, $offset); # We have checked this offset.
-        $body .= return_clause ($value, $thisone->{type}, undef, $macro,
-                                $default);
-        $body .= "    }\n";
-      }
-      $body .= "    break;\n";
-    }
-    $body .= "  }\n";
+    my $comment = 'When generated this function returned values for the list'
+      . ' of names given here.  However, subsequent manual editing may have'
+        . ' added or removed some.';
+    $body .= switch_clause (2, $comment, $namelen, \%items, @items);
   } else {
     # We are the top level.
     $body .= "  /* Initially switch on the length of the name.  */\n";
     $body .= dump_names ($package, $subname, $default_type, $what, $indent,
-                         @items);
+                         $breakout, @items);
     $body .= "  switch (len) {\n";
     # Need to group names of the same length
     my @by_length;
@@ -612,22 +725,25 @@ EOT
       $body .= "  case $i:\n";
       if (@{$by_length[$i]} == 1) {
         my $thisone = $by_length[$i]->[0];
-        my ($name, $value, $macro, $default)
-          = @$thisone{qw (name value macro default)};
+        my ($name, $value, $macro, $default, $pre, $post, $def_pre, $def_post)
+          = @$thisone{qw (name value macro default pre post def_pre def_post)};
         $value = $name unless defined $value;
         $macro = $name unless defined $macro;
 
         $body .= memEQ_clause ($name);
         $body .= return_clause ($value, $thisone->{type}, undef, $macro,
-                                $default);
+                                $default, $pre, $post, $def_pre, $def_post);
         $body .= "    }\n";
+      } elsif (@{$by_length[$i]} < $breakout) {
+        $body .= switch_clause (4, '', $i, \%items, @{$by_length[$i]});
       } else {
         push @subs, C_constant ($package, "${subname}_$i", $default_type,
-                                $what, $indent, $i, @{$by_length[$i]});
+                                $what, $indent, \$i, @{$by_length[$i]});
         $body .= "    return ${subname}_$i (name";
         $body .= ", iv_return" if $use_iv;
         $body .= ", nv_return" if $use_nv;
         $body .= ", pv_return" if $use_pv;
+        $body .= ", sv_return" if $use_sv;
         $body .= ");\n";
       }
       $body .= "    break;\n";
@@ -670,7 +786,7 @@ sub XS_constant {
     # Convert line of the form IV,UV,NV to hash
     $what = {map {$_ => 1} split /,\s*/, ($what)};
   }
-  my ($use_iv, $use_nv, $use_pv) = params ($what);
+  my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what);
   my $type;
 
   my $xs = <<"EOT";
@@ -720,6 +836,7 @@ EOT
   $xs .= ', &iv' if $use_iv;
   $xs .= ', &nv' if $use_nv;
   $xs .= ', &pv' if $use_pv;
+  $xs .= ', &sv' if $use_sv;
   $xs .= ");\n";
 
   $xs .= << "EOT";
@@ -732,7 +849,7 @@ EOT
           break;
         case PERL_constant_NOTDEF:
           sv = sv_2mortal(newSVpvf(
-           "Your vendor has not defined $package macro %s used", s));
+           "Your vendor has not defined $package macro %s, used", s));
           PUSHs(sv);
           break;
 EOT
@@ -740,13 +857,18 @@ EOT
   foreach $type (sort keys %XS_Constant) {
     $xs .= "\t/* Uncomment this if you need to return ${type}s\n"
       unless $what->{$type};
-    $xs .= << "EOT";
-        case PERL_constant_IS$type:
+    $xs .= "        case PERL_constant_IS$type:\n";
+    if (length $XS_Constant{$type}) {
+      $xs .= << "EOT";
           EXTEND(SP, 1);
           PUSHs(&PL_sv_undef);
           $XS_Constant{$type};
-          break;
 EOT
+    } else {
+      # Do nothing. return (), which will be correctly interpreted as
+      # (undef, undef)
+    }
+    $xs .= "          break;\n";
     unless ($what->{$type}) {
       chop $xs; # Yes, another need for chop not chomp.
       $xs .= " */\n";
@@ -755,7 +877,7 @@ EOT
   $xs .= << "EOT";
         default:
           sv = sv_2mortal(newSVpvf(
-           "Unexpected return type %d while processing $package macro %s used",
+           "Unexpected return type %d while processing $package macro %s, used",
                type, s));
           PUSHs(sv);
         }