From: Wilson P. Snyder II 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: + + $answer = 0b101010; + printf "The answer is: %b\n", oct("0b101010"); + The length argument of C 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 function, which C 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;