From 65507b89d0602b92732c75d7f573515531fe8bd1 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 15 Feb 2022 00:15:49 +0100 Subject: [PATCH] Generate the SignedBuf/UnsignedBuf roles So that we only need to maintain one set of code --- src/core.c/Buf.pm6 | 86 ++++++++------- tools/build/makeNATIVE_BLOB.raku | 178 +++++++++++++++++++++++++++++++ 2 files changed, 226 insertions(+), 38 deletions(-) create mode 100755 tools/build/makeNATIVE_BLOB.raku diff --git a/src/core.c/Buf.pm6 b/src/core.c/Buf.pm6 index 6c525ac83a2..d14e9b60026 100644 --- a/src/core.c/Buf.pm6 +++ b/src/core.c/Buf.pm6 @@ -880,37 +880,40 @@ my class utf32 does Blob[uint32] is repr('VMArray') { my role Buf[::T = uint8] does Blob[T] is repr('VMArray') is array_type(T) { +#- start of generated part of Buf Signed role -------------------------------- +#- Generated on 2022-02-14T22:51:31+01:00 by ./tools/build/makeNATIVE_BLOB.raku +#- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE + my role SignedBuf[::T] is repr('VMArray') is array_type(T) is implementation-detail { - multi method AT-POS(::?ROLE:D: int \pos) is raw { - nqp::islt_i(pos,0) - ?? Failure.new(X::OutOfRange.new( - :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>)) - !! nqp::atposref_i(self, pos) + sub OOR(int $got) { + Failure.new(X::OutOfRange.new( + :what($*INDEX // 'Index'), :$got, :range<0..^Inf> + )) + } + multi method AT-POS(::?ROLE:D: int $pos) is raw is default { + nqp::islt_i($pos,0) + ?? OOR($pos) + !! nqp::atposref_i(self,$pos) } - multi method AT-POS(::?ROLE:D: Int:D \pos) is raw { - my int $pos = nqp::unbox_i(pos); + multi method AT-POS(::?ROLE:D: Int:D $pos) is raw is default { nqp::islt_i($pos,0) - ?? Failure.new(X::OutOfRange.new( - :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>)) + ?? OOR($pos) !! nqp::atposref_i(self,$pos) } - multi method ASSIGN-POS(::?CLASS:D: int \pos, Mu \assignee) { - nqp::islt_i(pos,0) - ?? Failure.new(X::OutOfRange.new( - :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>)) - !! nqp::bindpos_i(self,pos,assignee) + multi method ASSIGN-POS(::?ROLE:D: int $pos, Mu \assignee) { + nqp::islt_i($pos,0) + ?? OOR($pos) + !! nqp::bindpos_i(self,$pos,assignee) } - multi method ASSIGN-POS(::?CLASS:D: Int:D \pos, Mu \assignee) { - my int $pos = nqp::unbox_i(pos); + multi method ASSIGN-POS(::?ROLE:D: Int:D $pos, Mu \assignee) { nqp::islt_i($pos,0) - ?? Failure.new(X::OutOfRange.new( - :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>)) + ?? OOR($pos) !! nqp::bindpos_i(self,$pos,assignee) } multi method list(::?ROLE:D:) is default { - my int $elems = nqp::elems(self); + my uint $elems = nqp::elems(self); # presize memory, but keep it empty, so we can just push my $buffer := nqp::setelems( @@ -991,38 +994,43 @@ my role Buf[::T = uint8] does Blob[T] is repr('VMArray') is array_type(T) { $self } } +#- PLEASE DON'T CHANGE ANYTHING ABOVE THIS LINE +#- end of generated part of Buf Signed role ---------------------------------- + +#- start of generated part of Buf Unsigned role -------------------------------- +#- Generated on 2022-02-14T22:51:31+01:00 by ./tools/build/makeNATIVE_BLOB.raku +#- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE my role UnsignedBuf[::T] is repr('VMArray') is array_type(T) is implementation-detail { - multi method AT-POS(::?ROLE:D: int \pos) is raw is default { - nqp::islt_i(pos,0) - ?? Failure.new(X::OutOfRange.new( - :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>)) - !! nqp::atposref_u(self, pos) + sub OOR(int $got) { + Failure.new(X::OutOfRange.new( + :what($*INDEX // 'Index'), :$got, :range<0..^Inf> + )) + } + multi method AT-POS(::?ROLE:D: int $pos) is raw is default { + nqp::islt_i($pos,0) + ?? OOR($pos) + !! nqp::atposref_u(self,$pos) } - multi method AT-POS(::?ROLE:D: Int:D \pos) is raw is default { - my int $pos = nqp::unbox_i(pos); + multi method AT-POS(::?ROLE:D: Int:D $pos) is raw is default { nqp::islt_i($pos,0) - ?? Failure.new(X::OutOfRange.new( - :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>)) + ?? OOR($pos) !! nqp::atposref_u(self,$pos) } - multi method ASSIGN-POS(::?CLASS:D: int \pos, Mu \assignee) { - nqp::islt_i(pos,0) - ?? Failure.new(X::OutOfRange.new( - :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>)) - !! nqp::bindpos_u(self,pos,assignee) + multi method ASSIGN-POS(::?ROLE:D: int $pos, Mu \assignee) { + nqp::islt_i($pos,0) + ?? OOR($pos) + !! nqp::bindpos_u(self,$pos,assignee) } - multi method ASSIGN-POS(::?CLASS:D: Int:D \pos, Mu \assignee) { - my int $pos = nqp::unbox_i(pos); + multi method ASSIGN-POS(::?ROLE:D: Int:D $pos, Mu \assignee) { nqp::islt_i($pos,0) - ?? Failure.new(X::OutOfRange.new( - :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>)) + ?? OOR($pos) !! nqp::bindpos_u(self,$pos,assignee) } multi method list(::?ROLE:D:) is default { - my int $elems = nqp::elems(self); + my uint $elems = nqp::elems(self); # presize memory, but keep it empty, so we can just push my $buffer := nqp::setelems( @@ -1103,6 +1111,8 @@ my role Buf[::T = uint8] does Blob[T] is repr('VMArray') is array_type(T) { $self } } +#- PLEASE DON'T CHANGE ANYTHING ABOVE THIS LINE +#- end of generated part of Buf Unsigned role ---------------------------------- $?CLASS.^add_role(T.^unsigned ?? UnsignedBuf[T] !! SignedBuf[T]); diff --git a/tools/build/makeNATIVE_BLOB.raku b/tools/build/makeNATIVE_BLOB.raku new file mode 100755 index 00000000000..579308c33df --- /dev/null +++ b/tools/build/makeNATIVE_BLOB.raku @@ -0,0 +1,178 @@ +#!/usr/bin/env raku + +# This script reads the native_array.pm6 file, and generates the intarray, +# numarray and strarray roles in it, and writes it back to the file. + +# always use highest version of Raku +use v6.*; + +my $generator = $*PROGRAM-NAME; +my $generated = DateTime.now.gist.subst(/\.\d+/,''); +my $start = '#- start of generated part of Buf '; +my $idpos = $start.chars; +my $idchars = 3; +my $end = '#- end of generated part of Buf '; + +# slurp the whole file and set up writing to it +my $filename = "src/core.c/Buf.pm6"; +my @lines = $filename.IO.lines; +$*OUT = $filename.IO.open(:w); + +my %type_mapper = ( + Signed => ( :name, + :postfix, + ).Map, + Unsigned => ( :name, + :postfix, + ).Map, +); + + +# for all the lines in the source that don't need special handling +while @lines { + my $line := @lines.shift; + + # nothing to do yet + unless $line.starts-with($start) { + say $line; + next; + } + + my $type = $line.substr($idpos).words.head; + + # found header, check validity and set up mapper + die "Don't know how to handle $type" + unless my %mapper := %type_mapper{$type}; + + say $start ~ $type ~ " role --------------------------------"; + say "#- Generated on $generated by $generator"; + say "#- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE"; + + # skip the old version of the code + while @lines { + last if @lines.shift.starts-with($end); + } + # spurt the role + say Q:to/SOURCE/.subst(/ '#' (\w+) '#' /, -> $/ { %mapper{$0} }, :g).chomp; + + my role #name#[::T] is repr('VMArray') is array_type(T) is implementation-detail { + sub OOR(int $got) { + Failure.new(X::OutOfRange.new( + :what($*INDEX // 'Index'), :$got, :range<0..^Inf> + )) + } + multi method AT-POS(::?ROLE:D: int $pos) is raw is default { + nqp::islt_i($pos,0) + ?? OOR($pos) + !! nqp::atposref_#postfix#(self,$pos) + } + multi method AT-POS(::?ROLE:D: Int:D $pos) is raw is default { + nqp::islt_i($pos,0) + ?? OOR($pos) + !! nqp::atposref_#postfix#(self,$pos) + } + + multi method ASSIGN-POS(::?ROLE:D: int $pos, Mu \assignee) { + nqp::islt_i($pos,0) + ?? OOR($pos) + !! nqp::bindpos_#postfix#(self,$pos,assignee) + } + multi method ASSIGN-POS(::?ROLE:D: Int:D $pos, Mu \assignee) { + nqp::islt_i($pos,0) + ?? OOR($pos) + !! nqp::bindpos_#postfix#(self,$pos,assignee) + } + + multi method list(::?ROLE:D:) is default { + my uint $elems = nqp::elems(self); + + # presize memory, but keep it empty, so we can just push + my $buffer := nqp::setelems( + nqp::setelems(nqp::create(IterationBuffer),$elems), + 0 + ); + + my int $i = -1; + nqp::while( + nqp::islt_i(++$i,$elems), + nqp::push($buffer,nqp::atposref_#postfix#(self,$i)) + ); + $buffer.List + } + + method write-ubits(::?ROLE \SELF: + int $pos, Int:D $bits, UInt:D \value + ) is raw { + + # sanity check + POS-OOR(SELF, $pos) if $pos < 0; + my $self := nqp::isconcrete(self) ?? self !! nqp::create(self); + + # set up basic info + my int $first-bit = $pos +& 7; + my int $last-bit = ($pos + $bits) +& 7; + my int $first-byte = $pos +> 3; + my int $last-byte = ($pos + $bits - 1) +> 3; + + my $value := value +& (1 +< $bits - 1); # mask valid part + $value := $value +< (8 - $last-bit) if $last-bit; # move into position + + my int $lmask = nqp::sub_i(1 +< $first-bit,1) +< (8 - $first-bit) + if $first-bit; + my int $rmask = 1 +< nqp::sub_i(8 - $last-bit,1) + if $last-bit; + + # all done in a single byte + if $first-byte == $last-byte { + nqp::bindpos_#postfix#($self,$first-byte, + $value +| (nqp::atpos_#postfix#($self,$first-byte) +& ($lmask +| $rmask)) + ); + } + + # spread over multiple bytes + else { + my int $i = $last-byte; + + # process last byte first if it is a partial + if $last-bit { + nqp::bindpos_#postfix#($self,$i, + ($value +& 255) +| (nqp::atpos_#postfix#($self,$i) +& $rmask) + ); + $value := $value +> 8; + } + + # not a partial, so make sure we process last byte later + else { + ++$i; + } + + # walk from right to left, exclude left-most is partial + my int $last = $first-byte + nqp::isgt_i($first-bit,0); + nqp::while( + nqp::isge_i(--$i,$last), + nqp::stmts( + nqp::bindpos_#postfix#($self,$i,($value +& 255)), + ($value := $value +> 8) + ) + ); + + # process last byte if it was a partial + nqp::bindpos_#postfix#($self,$i,($value +& 255) + +| (nqp::atpos_#postfix#($self,$i) +& $lmask)) + if $first-bit; + } + + $self + } + } +SOURCE + + # we're done for this role + say "#- PLEASE DON'T CHANGE ANYTHING ABOVE THIS LINE"; + say $end ~ $type ~ " role ----------------------------------"; +} + +# close the file properly +$*OUT.close; + +# vim: expandtab sw=4