From: Wilson P. Snyder II <unknown@perl.org>
Date: Mon, 30 Nov 1998 00:00:00 +0000 (+0000)
Subject: REV2: Binary number support
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4f19785bce4da39a768aa6210f1f97ab4c0600dd;p=p5sagit%2Fp5-mst-13.2.git
REV2: Binary number support
To: perl5-porters@perl.org
Message-ID: <199811301543.KAA15689@vulcan.maker.com>
p4raw-id: //depot/cfgperl@2546
---
diff --git a/pod/perldata.pod b/pod/perldata.pod
index 9e41c2c..7b9a323 100644
--- a/pod/perldata.pod
+++ b/pod/perldata.pod
@@ -245,6 +245,7 @@ integer formats:
.23E-10
0xffff # hex
0377 # octal
+ 0b111000 # binary
4_294_967_296 # underline for legibility
String literals are usually delimited by either single or double
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index aa3539b..bdcb7cf 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -40,6 +40,12 @@ maintenance versions.
=head1 Core Changes
+Binary numbers are now supported as literals, in s?printf formats, and
+C<oct()>:
+
+ $answer = 0b101010;
+ printf "The answer is: %b\n", oct("0b101010");
+
The length argument of C<syswrite()> is now optional.
Better 64-bit support -- but full support still a distant goal. One
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 300379f..c781611 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2237,8 +2237,9 @@ See the L</use> function, which C<no> is the opposite of.
=item oct
Interprets EXPR as an octal string and returns the corresponding
-value. (If EXPR happens to start off with C<0x>, interprets it as
-a hex string instead.) The following will handle decimal, octal, and
+value. (If EXPR happens to start off with C<0x>, interprets it as a
+hex string. If EXPR starts off with C<0b>, it is interpreted as a
+binary string.) The following will handle decimal, binary, octal, and
hex in the standard Perl or C notation:
$val = oct($val) if $val =~ /^0/;
@@ -3644,6 +3645,7 @@ In addition, Perl permits the following widely-supported conversions:
%X like %x, but using upper-case letters
%E like %e, but using an upper-case "E"
%G like %g, but with an upper-case "E" (if applicable)
+ %b an unsigned integer, in binary
%p a pointer (outputs the Perl value's address in hexadecimal)
%n special: *stores* the number of characters output so far
into the next variable in the parameter list
diff --git a/pp.c b/pp.c
index 004ba8c..44114e7 100644
--- a/pp.c
+++ b/pp.c
@@ -1822,6 +1822,8 @@ PP(pp_oct)
tmps++;
if (*tmps == 'x')
value = scan_hex(++tmps, 99, &argtype);
+ else if (*tmps == 'b')
+ value = scan_bin(++tmps, 99, &argtype);
else
value = scan_oct(tmps, 99, &argtype);
XPUSHu(value);
diff --git a/proto.h b/proto.h
index b22451a..333bd23 100644
--- a/proto.h
+++ b/proto.h
@@ -541,6 +541,7 @@ VIRTUAL OP* scalar _((OP* o));
VIRTUAL OP* scalarkids _((OP* o));
VIRTUAL OP* scalarseq _((OP* o));
VIRTUAL OP* scalarvoid _((OP* o));
+VIRTUAL UV scan_bin _((char* start, I32 len, I32* retlen));
VIRTUAL UV scan_hex _((char* start, I32 len, I32* retlen));
VIRTUAL char* scan_num _((char* s));
VIRTUAL UV scan_oct _((char* start, I32 len, I32* retlen));
diff --git a/sv.c b/sv.c
index fdeed68..6d900ce 100644
--- a/sv.c
+++ b/sv.c
@@ -4645,6 +4645,10 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs,
base = 10;
goto uns_integer;
+ case 'b':
+ base = 2;
+ goto uns_integer;
+
case 'O':
intsize = 'l';
/* FALL THROUGH */
@@ -4700,6 +4704,14 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs,
if (alt && *eptr != '0')
*--eptr = '0';
break;
+ case 2:
+ do {
+ dig = uv & 1;
+ *--eptr = '0' + dig;
+ } while (uv >>= 1);
+ if (alt && *eptr != '0')
+ *--eptr = '0';
+ break;
default: /* it had better be ten or less */
do {
dig = uv % base;
diff --git a/t/op/oct.t b/t/op/oct.t
index 6623089..06bf8db 100755
--- a/t/op/oct.t
+++ b/t/op/oct.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..9\n";
+print "1..11\n";
print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
@@ -11,3 +11,5 @@ print +(hex('80000000') == 0x80000000) ? "ok" : "not ok", " 6\n";
print +(oct('1234') == 668) ? "ok" : "not ok", " 7\n";
print +(hex('1234') == 4660) ? "ok" : "not ok", " 8\n";
print +(hex('0x1234') == 0x1234) ? "ok" : "not ok", " 9\n";
+print +(oct('b11100') == 28) ? "ok" : "not ok", " 10\n";
+print +(oct('b101010') == 0b101010) ? "ok" : "not ok", " 11\n";
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index b9b4751..ef5b94c 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -14,8 +14,8 @@ $SIG{__WARN__} = sub {
};
$w = 0;
-$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f","hi",123,0,456,0,ord('A'),3.0999);
-if ($x eq ' hi 123 %foo 456 0A3.1' && $w == 0) {
+$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f %b","hi",123,0,456,0,ord('A'),3.0999,11);
+if ($x eq ' hi 123 %foo 456 0A3.1 1011' && $w == 0) {
print "ok 1\n";
} else {
print "not ok 1 '$x'\n";
diff --git a/t/pragma/warn/util b/t/pragma/warn/util
index 649a292..b63f89e 100644
--- a/t/pragma/warn/util
+++ b/t/pragma/warn/util
@@ -6,6 +6,8 @@
Illegal hex digit ignored
my $a = hex "0xv9" ;
+ Illegal binary digit ignored
+ my $a = oct "0b9" ;
__END__
# util.c
@@ -19,3 +21,9 @@ use warning 'unsafe' ;
*a = hex "0xv9" ;
EXPECT
Illegal hex digit ignored at - line 3.
+########
+# util.c
+use warning 'unsafe' ;
+*a = oct "0b9" ;
+EXPECT
+Illegal binary digit ignored at - line 3.
diff --git a/toke.c b/toke.c
index b9fa540..f91b4cd 100644
--- a/toke.c
+++ b/toke.c
@@ -5899,7 +5899,7 @@ scan_str(char *start)
Read a number in any of the formats that Perl accepts:
- 0(x[0-7A-F]+)|([0-7]+)
+ 0(x[0-7A-F]+)|([0-7]+)|(b[01])
[\d_]+(\.[\d_]*)?[Ee](\d+)
Underbars (_) are allowed in decimal numbers. If -w is on,
@@ -5933,18 +5933,19 @@ scan_num(char *start)
croak("panic: scan_num");
/* if it starts with a 0, it could be an octal number, a decimal in
- 0.13 disguise, or a hexadecimal number.
+ 0.13 disguise, or a hexadecimal number, or a binary number.
*/
case '0':
{
/* variables:
u holds the "number so far"
- shift the power of 2 of the base (hex == 4, octal == 3)
+ shift the power of 2 of the base
+ (hex == 4, octal == 3, binary == 1)
overflowed was the number more than we can hold?
Shift is used when we add a digit. It also serves as an "are
- we in octal or hex?" indicator to disallow hex characters when
- in octal mode.
+ we in octal/hex/binary?" indicator to disallow hex characters
+ when in octal mode.
*/
UV u;
I32 shift;
@@ -5954,6 +5955,9 @@ scan_num(char *start)
if (s[1] == 'x') {
shift = 4;
s += 2;
+ } else if (s[1] == 'b') {
+ shift = 1;
+ s += 2;
}
/* check for a decimal in disguise */
else if (s[1] == '.')
@@ -5963,7 +5967,7 @@ scan_num(char *start)
shift = 3;
u = 0;
- /* read the rest of the octal number */
+ /* read the rest of the number */
for (;;) {
UV n, b; /* n is used in the overflow test, b is the digit we're adding on */
@@ -5980,13 +5984,21 @@ scan_num(char *start)
/* 8 and 9 are not octal */
case '8': case '9':
- if (shift != 4)
+ if (shift == 3)
yyerror("Illegal octal digit");
+ else
+ if (shift == 1)
+ yyerror("Illegal binary digit");
/* FALL THROUGH */
/* octal digits */
- case '0': case '1': case '2': case '3': case '4':
+ case '2': case '3': case '4':
case '5': case '6': case '7':
+ if (shift == 1)
+ yyerror("Illegal binary digit");
+ /* FALL THROUGH */
+
+ case '0': case '1':
b = *s++ & 15; /* ASCII digit -> value of digit */
goto digit;
@@ -6007,7 +6019,8 @@ scan_num(char *start)
if (!overflowed && (n >> shift) != u
&& !(PL_hints & HINT_NEW_BINARY)) {
warn("Integer overflow in %s number",
- (shift == 4) ? "hex" : "octal");
+ (shift == 4) ? "hex"
+ : ((shift == 3) ? "octal" : "binary"));
overflowed = TRUE;
}
u = n | b; /* add the digit to the end */
diff --git a/util.c b/util.c
index cc4591e..4b3d32d 100644
--- a/util.c
+++ b/util.c
@@ -2395,6 +2395,29 @@ same_dirent(char *a, char *b)
#endif /* !HAS_RENAME */
UV
+scan_bin(char *start, I32 len, I32 *retlen)
+{
+ register char *s = start;
+ register UV retval = 0;
+ bool overflowed = FALSE;
+ while (len && *s >= '0' && *s <= '1') {
+ register UV n = retval << 1;
+ if (!overflowed && (n >> 1) != retval) {
+ warn("Integer overflow in binary number");
+ overflowed = TRUE;
+ }
+ retval = n | (*s++ - '0');
+ len--;
+ }
+ if (len && (*s >= '2' || *s <= '9')) {
+ dTHR;
+ if (ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Illegal binary digit ignored");
+ }
+ *retlen = s - start;
+ return retval;
+}
+UV
scan_oct(char *start, I32 len, I32 *retlen)
{
register char *s = start;