[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / parts / ppptools.pl

################################################################################
#
#  ppptools.pl -- various utility functions
#
################################################################################
#
#  $Revision: 16 $
#  $Author: mhx $
#  $Date: 2006/01/14 18:07:58 +0100 $
#
################################################################################
#
#  Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
#  Version 2.x, Copyright (C) 2001, Paul Marquess.
#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.
#
################################################################################

sub parse_todo
{
  my $dir = shift || 'parts/todo';
  local *TODO;
  my %todo;
  my $todo;

  for $todo (glob "$dir/*") {
    open TODO, $todo or die "cannot open $todo: $!\n";
    my $perl = <TODO>;
    chomp $perl;
    while (<TODO>) {
      chomp;
      s/#.*//;
      s/^\s+//; s/\s+$//;
      /^\s*$/ and next;
      /^\w+$/ or die "invalid identifier: $_\n";
      exists $todo{$_} and die "duplicate identifier: $_ ($todo{$_} <=> $perl)\n";
      $todo{$_} = $perl;
    }
    close TODO;
  }

  return \%todo;
}

sub expand_version
{
  my($op, $ver) = @_;
  my($r, $v, $s) = parse_version($ver);
  $r == 5 or die "only Perl revision 5 is supported\n";
  $op eq '=='     and return "((PERL_VERSION == $v) && (PERL_SUBVERSION == $s))";
  $op eq '!='     and return "((PERL_VERSION != $v) || (PERL_SUBVERSION != $s))";
  $op =~ /([<>])/ and return "((PERL_VERSION $1 $v) || ((PERL_VERSION == $v) && (PERL_SUBVERSION $op $s)))";
  die "cannot expand version expression ($op $ver)\n";
}

sub parse_partspec
{
  my $file = shift;
  my $section = 'implementation';
  my $vsec = join '|', qw( provides dontwarn implementation
                           xsubs xsinit xsmisc xshead xsboot tests );
  my(%data, %options);
  local *F;

  open F, $file or die "$file: $!\n";
  while (<F>) {
    /^##/ and next;
    if (/^=($vsec)(?:\s+(.*))?/) {
      $section = $1;
      if (defined $2) {
        my $opt = $2;
        $options{$section} = eval "{ $opt }";
        $@ and die "Invalid options ($opt) in section $section of $file: $@\n";
      }
      next;
    }
    push @{$data{$section}}, $_;
  }
  close F;

  for (keys %data) {
    my @v = @{$data{$_}};
    shift @v while @v && $v[0]  =~ /^\s*$/;
    pop   @v while @v && $v[-1] =~ /^\s*$/;
    $data{$_} = join '', @v;
  }

  unless (exists $data{provides}) {
    $data{provides} = ($file =~ /(\w+)$/)[0];
  }
  $data{provides} = [$data{provides} =~ /(\S+)/g];

  if (exists $data{dontwarn}) {
    $data{dontwarn} = [$data{dontwarn} =~ /(\S+)/g];
  }

  my @prov;
  my %proto;

  if (exists $data{tests} && (!exists $data{implementation} || $data{implementation} !~ /\S/)) {
    $data{implementation} = '';
  }
  else {
    $data{implementation} =~ /\S/ or die "Empty implementation in $file\n";

    my $p;

    for $p (@{$data{provides}}) {
      if ($p =~ m#^/.*/\w*$#) {
        my @tmp = eval "\$data{implementation} =~ ${p}gm";
        $@ and die "invalid regex $p in $file\n";
        @tmp or warn "no matches for regex $p in $file\n";
        push @prov, do { my %h; grep !$h{$_}++, @tmp };
      }
      elsif ($p eq '__UNDEFINED__') {
        my @tmp = $data{implementation} =~ /^\s*__UNDEFINED__[^\r\n\S]+(\w+)/gm;
        @tmp or warn "no __UNDEFINED__ macros in $file\n";
        push @prov, @tmp;
      }
      else {
        push @prov, $p;
      }
    }

    for (@prov) {
      if ($data{implementation} !~ /\b\Q$_\E\b/) {
        warn "$file claims to provide $_, but doesn't seem to do so\n";
        next;
      }

      # scan for prototypes
      my($proto) = $data{implementation} =~ /
                   ( ^ (?:[\w*]|[^\S\r\n])+
                       [\r\n]*?
                     ^ \b$_\b \s*
                       \( [^{]* \)
                   )
                       \s* \{
                   /xm or next;

      $proto =~ s/^\s+//;
      $proto =~ s/\s+$//;
      $proto =~ s/\s+/ /g;

      exists $proto{$_} and warn "$file: duplicate prototype for $_\n";
      $proto{$_} = $proto;
    }
  }

  for $section (qw( implementation xsubs xsinit xsmisc xshead xsboot )) {
    if (exists $data{$section}) {
      $data{$section} =~ s/\{\s*version\s*(<|>|==|!=|>=|<=)\s*([\d._]+)\s*\}/expand_version($1, $2)/gei;
    }
  }

  $data{provides}   = \@prov;
  $data{prototypes} = \%proto;
  $data{OPTIONS}    = \%options;

  my %prov     = map { ($_ => 1) } @prov;
  my %dontwarn = exists $data{dontwarn} ? map { ($_ => 1) } @{$data{dontwarn}} : ();
  my @maybeprov = do { my %h;
                       grep {
                         my($nop) = /^Perl_(.*)/;
                         not exists $prov{$_}                         ||
                             exists $dontwarn{$_}                     ||
                             (defined $nop && exists $prov{$nop}    ) ||
                             (defined $nop && exists $dontwarn{$nop}) ||
                             $h{$_}++;
                       }
                       $data{implementation} =~ /^\s*#\s*define\s+(\w+)/g };

  if (@maybeprov) {
    warn "$file seems to provide these macros, but doesn't list them:\n  "
         . join("\n  ", @maybeprov) . "\n";
  }

  return \%data;
}

sub compare_prototypes
{
  my($p1, $p2) = @_;
  for ($p1, $p2) {
    s/^\s+//;
    s/\s+$//;
    s/\s+/ /g;
    s/(\w)\s(\W)/$1$2/g;
    s/(\W)\s(\w)/$1$2/g;
  }
  return $p1 cmp $p2;
}

sub ppcond
{
  my $s = shift;
  my @c;
  my $p;

  for $p (@$s) {
    push @c, map "!($_)", @{$p->{pre}};
    defined $p->{cur} and push @c, "($p->{cur})";
  }

  join " && ", @c;
}

sub trim_arg
{
  my $in = shift;
  my $remove = join '|', qw( NN NULLOK );

  $in eq '...' and return ($in);

  local $_ = $in;
  my $id;

  s/[*()]/ /g;
  s/\[[^\]]*\]/ /g;
  s/\b(?:auto|const|extern|inline|register|static|volatile|restrict)\b//g;
  s/\b(?:$remove)\b//;
  s/^\s*//; s/\s*$//;

  if( /^\b(?:struct|union|enum)\s+\w+(?:\s+(\w+))?$/ ) {
    defined $1 and $id = $1;
  }
  else {
    if( s/\b(?:char|double|float|int|long|short|signed|unsigned|void)\b//g ) {
      /^\s*(\w+)\s*$/ and $id = $1;
    }
    else {
      /^\s*\w+\s+(\w+)\s*$/ and $id = $1;
    }
  }

  $_ = $in;

  defined $id and s/\b$id\b//;

  # these don't matter at all
  s/\b(?:auto|extern|inline|register|static|volatile|restrict)\b//g;
  s/\b(?:$remove)\b//;

  s/(?=<\*)\s+(?=\*)//g;
  s/\s*(\*+)\s*/ $1 /g;
  s/^\s*//; s/\s*$//;
  s/\s+/ /g;

  return ($_, $id);
}

sub parse_embed
{
  my @files = @_;
  my @func;
  my @pps;
  my $file;
  local *FILE;

  for $file (@files) {
    open FILE, $file or die "$file: $!\n";
    my($line, $l);

    while (defined($line = <FILE>)) {
      while ($line =~ /\\$/ && defined($l = <FILE>)) {
        $line =~ s/\\\s*//;
        $line .= $l;
      }
      next if $line =~ /^\s*:/;
      $line =~ s/^\s+|\s+$//gs;
      my($dir, $args) = ($line =~ /^\s*#\s*(\w+)(?:\s*(.*?)\s*)?$/);
      if (defined $dir and defined $args) {
        for ($dir) {
          /^ifdef$/   and do { push @pps, { pre => [], cur => "defined($args)"  }         ; last };
          /^ifndef$/  and do { push @pps, { pre => [], cur => "!defined($args)" }         ; last };
          /^if$/      and do { push @pps, { pre => [], cur => $args             }         ; last };
          /^elif$/    and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = $args; last };
          /^else$/    and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = undef; last };
          /^endif$/   and do { pop @pps                                                   ; last };
          /^include$/ and last;
          /^define$/  and last;
          /^undef$/   and last;
          warn "unhandled preprocessor directive: $dir\n";
        }
      }
      else {
        my @e = split /\s*\|\s*/, $line;
        if( @e >= 3 ) {
          my($flags, $ret, $name, @args) = @e;
          for (@args) {
            $_ = [trim_arg($_)];
          }
          ($ret) = trim_arg($ret);
          push @func, {
            name  => $name,
            flags => { map { $_, 1 } $flags =~ /./g },
            ret   => $ret,
            args  => \@args,
            cond  => ppcond(\@pps),
          };
        }
      }
    }

    close FILE;
  }

  return @func;
}

sub make_prototype
{
  my $f = shift;
  my @args = map { "@$_" } @{$f->{args}};
  my $proto;
  my $pTHX_ = exists $f->{flags}{n} ? "" : "pTHX_ ";
  $proto = "$f->{ret} $f->{name}" . "($pTHX_" . join(', ', @args) . ')';
  return $proto;
}

sub format_version
{
  my $ver = shift;

  $ver =~ s/$/000000/;
  my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;

  $v = int $v;
  $s = int $s;

  if ($r < 5 || ($r == 5 && $v < 6)) {
    if ($s % 10) {
      die "invalid version '$ver'\n";
    }
    $s /= 10;

    $ver = sprintf "%d.%03d", $r, $v;
    $s > 0 and $ver .= sprintf "_%02d", $s;

    return $ver;
  }

  return sprintf "%d.%d.%d", $r, $v, $s;
}

sub parse_version
{
  my $ver = shift;

  if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
    return ($1, $2, $3);
  }
  elsif ($ver !~ /^\d+\.[\d_]+$/) {
    die "cannot parse version '$ver'\n";
  }

  $ver =~ s/_//g;
  $ver =~ s/$/000000/;

  my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;

  $v = int $v;
  $s = int $s;

  if ($r < 5 || ($r == 5 && $v < 6)) {
    if ($s % 10) {
      die "cannot parse version '$ver'\n";
    }
    $s /= 10;
  }

  return ($r, $v, $s);
}

1;
Commit	Line	Data
adfe19db	1	################################################################################
	2	#
	3	# ppptools.pl -- various utility functions
	4	#
	5	################################################################################
	6	#
0d0f8426	7	# $Revision: 16 $
adfe19db	8	# $Author: mhx $
0d0f8426	9	# $Date: 2006/01/14 18:07:58 +0100 $
adfe19db	10	#
	11	################################################################################
	12	#
0d0f8426	13	# Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
adfe19db	14	# Version 2.x, Copyright (C) 2001, Paul Marquess.
	15	# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	16	#
	17	# This program is free software; you can redistribute it and/or
	18	# modify it under the same terms as Perl itself.
	19	#
	20	################################################################################
	21
	22	sub parse_todo
	23	{
	24	my $dir = shift \|\| 'parts/todo';
	25	local *TODO;
	26	my %todo;
	27	my $todo;
	28
	29	for $todo (glob "$dir/*") {
	30	open TODO, $todo or die "cannot open $todo: $!\n";
	31	my $perl = <TODO>;
	32	chomp $perl;
	33	while (<TODO>) {
	34	chomp;
	35	s/#.*//;
	36	s/^\s+//; s/\s+$//;
	37	/^\s*$/ and next;
	38	/^\w+$/ or die "invalid identifier: $_\n";
	39	exists $todo{$_} and die "duplicate identifier: $_ ($todo{$_} <=> $perl)\n";
	40	$todo{$_} = $perl;
	41	}
	42	close TODO;
	43	}
	44
	45	return \%todo;
	46	}
	47
96ad942f	48	sub expand_version
	49	{
	50	my($op, $ver) = @_;
	51	my($r, $v, $s) = parse_version($ver);
	52	$r == 5 or die "only Perl revision 5 is supported\n";
	53	$op eq '==' and return "((PERL_VERSION == $v) && (PERL_SUBVERSION == $s))";
	54	$op eq '!=' and return "((PERL_VERSION != $v) \|\| (PERL_SUBVERSION != $s))";
	55	$op =~ /([<>])/ and return "((PERL_VERSION $1 $v) \|\| ((PERL_VERSION == $v) && (PERL_SUBVERSION $op $s)))";
	56	die "cannot expand version expression ($op $ver)\n";
	57	}
	58
adfe19db	59	sub parse_partspec
	60	{
	61	my $file = shift;
	62	my $section = 'implementation';
	63	my $vsec = join '\|', qw( provides dontwarn implementation
	64	xsubs xsinit xsmisc xshead xsboot tests );
	65	my(%data, %options);
	66	local *F;
	67
	68	open F, $file or die "$file: $!\n";
	69	while (<F>) {
	70	/^##/ and next;
	71	if (/^=($vsec)(?:\s+(.*))?/) {
	72	$section = $1;
	73	if (defined $2) {
	74	my $opt = $2;
	75	$options{$section} = eval "{ $opt }";
	76	$@ and die "Invalid options ($opt) in section $section of $file: $@\n";
	77	}
	78	next;
	79	}
	80	push @{$data{$section}}, $_;
	81	}
	82	close F;
	83
	84	for (keys %data) {
	85	my @v = @{$data{$_}};
	86	shift @v while @v && $v[0] =~ /^\s*$/;
	87	pop @v while @v && $v[-1] =~ /^\s*$/;
	88	$data{$_} = join '', @v;
	89	}
	90
	91	unless (exists $data{provides}) {
	92	$data{provides} = ($file =~ /(\w+)$/)[0];
	93	}
	94	$data{provides} = [$data{provides} =~ /(\S+)/g];
	95
	96	if (exists $data{dontwarn}) {
	97	$data{dontwarn} = [$data{dontwarn} =~ /(\S+)/g];
	98	}
	99
	100	my @prov;
	101	my %proto;
	102
	103	if (exists $data{tests} && (!exists $data{implementation} \|\| $data{implementation} !~ /\S/)) {
	104	$data{implementation} = '';
	105	}
	106	else {
	107	$data{implementation} =~ /\S/ or die "Empty implementation in $file\n";
	108
	109	my $p;
	110
	111	for $p (@{$data{provides}}) {
	112	if ($p =~ m#^/./\w$#) {
	113	my @tmp = eval "\$data{implementation} =~ ${p}gm";
	114	$@ and die "invalid regex $p in $file\n";
	115	@tmp or warn "no matches for regex $p in $file\n";
	116	push @prov, do { my %h; grep !$h{$_}++, @tmp };
	117	}
	118	elsif ($p eq '__UNDEFINED__') {
	119	my @tmp = $data{implementation} =~ /^\s*__UNDEFINED__[^\r\n\S]+(\w+)/gm;
	120	@tmp or warn "no __UNDEFINED__ macros in $file\n";
	121	push @prov, @tmp;
	122	}
123	else {
124	push @prov, $p;
125	}
126	}
127
128	for (@prov) {
129	if ($data{implementation} !~ /\b\Q$_\E\b/) {
130	warn "$file claims to provide $_, but doesn't seem to do so\n";
131	next;
132	}
133
134	# scan for prototypes
135	my($proto) = $data{implementation} =~ /
136	( ^ (?:[\w*]\|[^\S\r\n])+
137	[\r\n]*?
138	^ \b$_\b \s*
139	\( [^{]* \)
140	)
141	\s* \{
142	/xm or next;
143
144	$proto =~ s/^\s+//;
145	$proto =~ s/\s+$//;
146	$proto =~ s/\s+/ /g;
147
148	exists $proto{$_} and warn "$file: duplicate prototype for $_\n";
149	$proto{$_} = $proto;
150	}
151	}
152
96ad942f	153	for $section (qw( implementation xsubs xsinit xsmisc xshead xsboot )) {
	154	if (exists $data{$section}) {
	155	$data{$section} =~ s/\{\sversion\s(<\|>\|==\|!=\|>=\|<=)\s([\d._]+)\s\}/expand_version($1, $2)/gei;
	156	}
	157	}
	158
adfe19db	159	$data{provides} = \@prov;
	160	$data{prototypes} = \%proto;
	161	$data{OPTIONS} = \%options;
	162
	163	my %prov = map { ($_ => 1) } @prov;
	164	my %dontwarn = exists $data{dontwarn} ? map { ($_ => 1) } @{$data{dontwarn}} : ();
	165	my @maybeprov = do { my %h;
	166	grep {
	167	my($nop) = /^Perl_(.*)/;
	168	not exists $prov{$_} \|\|
	169	exists $dontwarn{$_} \|\|
	170	(defined $nop && exists $prov{$nop} ) \|\|
	171	(defined $nop && exists $dontwarn{$nop}) \|\|
	172	$h{$_}++;
	173	}
	174	$data{implementation} =~ /^\s#\sdefine\s+(\w+)/g };
	175
	176	if (@maybeprov) {
	177	warn "$file seems to provide these macros, but doesn't list them:\n "
	178	. join("\n ", @maybeprov) . "\n";
	179	}
	180
	181	return \%data;
	182	}
	183
	184	sub compare_prototypes
	185	{
	186	my($p1, $p2) = @_;
	187	for ($p1, $p2) {
	188	s/^\s+//;
	189	s/\s+$//;
	190	s/\s+/ /g;
	191	s/(\w)\s(\W)/$1$2/g;
	192	s/(\W)\s(\w)/$1$2/g;
	193	}
	194	return $p1 cmp $p2;
	195	}
	196
	197	sub ppcond
	198	{
	199	my $s = shift;
	200	my @c;
	201	my $p;
	202
	203	for $p (@$s) {
	204	push @c, map "!($_)", @{$p->{pre}};
	205	defined $p->{cur} and push @c, "($p->{cur})";
	206	}
	207
	208	join " && ", @c;
	209	}
	210
	211	sub trim_arg
	212	{
	213	my $in = shift;
4a582685	214	my $remove = join '\|', qw( NN NULLOK );
adfe19db	215
	216	$in eq '...' and return ($in);
	217
	218	local $_ = $in;
	219	my $id;
4a582685	220
adfe19db	221	s/[*()]/ /g;
	222	s/\[[^\]]*\]/ /g;
	223	s/\b(?:auto\|const\|extern\|inline\|register\|static\|volatile\|restrict)\b//g;
4a582685	224	s/\b(?:$remove)\b//;
adfe19db	225	s/^\s//; s/\s$//;
	226
	227	if( /^\b(?:struct\|union\|enum)\s+\w+(?:\s+(\w+))?$/ ) {
	228	defined $1 and $id = $1;
	229	}
	230	else {
	231	if( s/\b(?:char\|double\|float\|int\|long\|short\|signed\|unsigned\|void)\b//g ) {
	232	/^\s(\w+)\s$/ and $id = $1;
	233	}
	234	else {
	235	/^\s\w+\s+(\w+)\s$/ and $id = $1;
	236	}
	237	}
	238
	239	$_ = $in;
	240
	241	defined $id and s/\b$id\b//;
	242
	243	# these don't matter at all
	244	s/\b(?:auto\|extern\|inline\|register\|static\|volatile\|restrict)\b//g;
4a582685	245	s/\b(?:$remove)\b//;
adfe19db	246
	247	s/(?=<\)\s+(?=\)//g;
	248	s/\s(\+)\s*/ $1 /g;
	249	s/^\s//; s/\s$//;
	250	s/\s+/ /g;
	251
	252	return ($_, $id);
	253	}
	254
	255	sub parse_embed
	256	{
	257	my @files = @_;
	258	my @func;
	259	my @pps;
	260	my $file;
	261	local *FILE;
	262
	263	for $file (@files) {
	264	open FILE, $file or die "$file: $!\n";
	265	my($line, $l);
	266
	267	while (defined($line = <FILE>)) {
	268	while ($line =~ /\\$/ && defined($l = <FILE>)) {
	269	$line =~ s/\\\s*//;
	270	$line .= $l;
	271	}
	272	next if $line =~ /^\s*:/;
	273	$line =~ s/^\s+\|\s+$//gs;
	274	my($dir, $args) = ($line =~ /^\s#\s(\w+)(?:\s(.?)\s*)?$/);
	275	if (defined $dir and defined $args) {
	276	for ($dir) {
	277	/^ifdef$/ and do { push @pps, { pre => [], cur => "defined($args)" } ; last };
	278	/^ifndef$/ and do { push @pps, { pre => [], cur => "!defined($args)" } ; last };
	279	/^if$/ and do { push @pps, { pre => [], cur => $args } ; last };
	280	/^elif$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = $args; last };
	281	/^else$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = undef; last };
	282	/^endif$/ and do { pop @pps ; last };
	283	/^include$/ and last;
	284	/^define$/ and last;
	285	/^undef$/ and last;
	286	warn "unhandled preprocessor directive: $dir\n";
	287	}
	288	}
	289	else {
	290	my @e = split /\s\\|\s/, $line;
	291	if( @e >= 3 ) {
	292	my($flags, $ret, $name, @args) = @e;
	293	for (@args) {
	294	$_ = [trim_arg($_)];
	295	}
	296	($ret) = trim_arg($ret);
	297	push @func, {
	298	name => $name,
	299	flags => { map { $_, 1 } $flags =~ /./g },
	300	ret => $ret,
	301	args => \@args,
	302	cond => ppcond(\@pps),
	303	};
	304	}
	305	}
	306	}
	307
	308	close FILE;
	309	}
310
311	return @func;
312	}
313
314	sub make_prototype
315	{
316	my $f = shift;
317	my @args = map { "@$_" } @{$f->{args}};
318	my $proto;
319	my $pTHX_ = exists $f->{flags}{n} ? "" : "pTHX_ ";
320	$proto = "$f->{ret} $f->{name}" . "($pTHX_" . join(', ', @args) . ')';
321	return $proto;
322	}
323
324	sub format_version
325	{
326	my $ver = shift;
327
328	$ver =~ s/$/000000/;
329	my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
330
331	$v = int $v;
332	$s = int $s;
333
334	if ($r < 5 \|\| ($r == 5 && $v < 6)) {
335	if ($s % 10) {
336	die "invalid version '$ver'\n";
337	}
338	$s /= 10;
339
340	$ver = sprintf "%d.%03d", $r, $v;
341	$s > 0 and $ver .= sprintf "_%02d", $s;
342
343	return $ver;
344	}
345
346	return sprintf "%d.%d.%d", $r, $v, $s;
347	}
348
349	sub parse_version
350	{
351	my $ver = shift;
352
353	if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
354	return ($1, $2, $3);
355	}
356	elsif ($ver !~ /^\d+\.[\d_]+$/) {
357	die "cannot parse version '$ver'\n";
358	}
359
360	$ver =~ s/_//g;
361	$ver =~ s/$/000000/;
362
363	my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
364
365	$v = int $v;
366	$s = int $s;
367
368	if ($r < 5 \|\| ($r == 5 && $v < 6)) {
369	if ($s % 10) {
370	die "cannot parse version '$ver'\n";
371	}
372	$s /= 10;
373	}
374
375	return ($r, $v, $s);
376	}
377
378	1;