1. my class X::Buf::AsStr { ... }
  2. my class X::Buf::Pack { ... }
  3. my class X::Buf::Pack::NonASCII { ... }
  4. my class X::Cannot::Empty { ... }
  5. my class X::Cannot::Lazy { ... }
  6. my class X::Experimental { ... }
  7. my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is array_type(T) {
  8. X::NYI.new(
  9. feature => "{$?CLASS.^name.comb(/^ \w+ /)}s with native {T.^name}"
  10. ).throw unless nqp::istype(T,Int);
  11. # other then *8 not supported yet
  12. my int $bpe = try {
  13. (T.^nativesize / 8).Int
  14. } // 1;
  15. multi method WHICH(Blob:D:) {
  16. nqp::box_s(
  17. nqp::concat(
  18. nqp::if(
  19. nqp::eqaddr(self.WHAT,Blob),
  20. 'Blob|',
  21. nqp::concat(nqp::unbox_s(self.^name), '|')
  22. ),
  23. nqp::sha1(self.decode("latin-1"))
  24. ),
  25. ObjAt
  26. )
  27. }
  28. multi method new(Blob:) { nqp::create(self) }
  29. multi method new(Blob: Blob:D $blob) {
  30. nqp::splice(nqp::create(self),$blob,0,0)
  31. }
  32. multi method new(Blob: int @values) {
  33. nqp::splice(nqp::create(self),@values,0,0)
  34. }
  35. multi method new(Blob: @values) {
  36. @values.is-lazy
  37. ?? Failure.new(X::Cannot::Lazy.new(:action<new>,:what(self.^name)))
  38. !! self!push-list("initializ",nqp::create(self),@values)
  39. }
  40. multi method new(Blob: *@values) { self.new(@values) }
  41. proto method allocate(|) { * }
  42. multi method allocate(Blob:U: Int $elements) {
  43. nqp::setelems(nqp::create(self),$elements)
  44. }
  45. multi method allocate(Blob:U: Int $elements, int $value) {
  46. my int $elems = $elements;
  47. my $blob := nqp::setelems(nqp::create(self),$elems);
  48. my int $i = -1;
  49. nqp::bindpos_i($blob,$i,$value) while nqp::islt_i(++$i,$elems);
  50. $blob;
  51. }
  52. multi method allocate(Blob:U: Int $elements, Int \value) {
  53. my int $value = value;
  54. self.allocate($elements,$value)
  55. }
  56. multi method allocate(Blob:U: Int $elements, Mu $got) {
  57. self!fail-typecheck('allocate',$got)
  58. }
  59. multi method allocate(Blob:U: Int $elements, int @values) {
  60. self!spread(nqp::setelems(nqp::create(self),$elements),@values)
  61. }
  62. multi method allocate(Blob:U: Int $elements, Blob:D $blob) {
  63. self!spread(nqp::setelems(nqp::create(self),$elements),$blob)
  64. }
  65. multi method allocate(Blob:U: Int $elements, @values) {
  66. self!spread(nqp::setelems(nqp::create(self),$elements),Blob.new(@values))
  67. }
  68. multi method EXISTS-POS(Blob:D: int \pos) {
  69. nqp::p6bool(
  70. nqp::islt_i(pos,nqp::elems(self)) && nqp::isge_i(pos,0)
  71. );
  72. }
  73. multi method EXISTS-POS(Blob:D: Int:D \pos) {
  74. nqp::p6bool(
  75. nqp::islt_i(pos,nqp::elems(self)) && nqp::isge_i(pos,0)
  76. );
  77. }
  78. multi method AT-POS(Blob:D: int \pos) {
  79. nqp::if(
  80. (nqp::isge_i(pos,nqp::elems(self)) || nqp::islt_i(pos,0)),
  81. self!fail-range(pos),
  82. nqp::atpos_i(self,pos)
  83. )
  84. }
  85. multi method AT-POS(Blob:D: Int:D \pos) {
  86. nqp::if(
  87. (nqp::isge_i(pos,nqp::elems(self)) || nqp::islt_i(pos,0)),
  88. self!fail-range(pos),
  89. nqp::atpos_i(self,pos)
  90. )
  91. }
  92. multi method Bool(Blob:D:) { nqp::p6bool(nqp::elems(self)) }
  93. multi method elems(Blob:D:) { nqp::p6box_i(nqp::elems(self)) }
  94. multi method elems(Blob:U: --> 1) { }
  95. method Numeric(Blob:D:) { nqp::p6box_i(nqp::elems(self)) }
  96. method Int(Blob:D:) { nqp::p6box_i(nqp::elems(self)) }
  97. method bytes(Blob:D:) { nqp::mul_i(nqp::elems(self),$bpe) }
  98. method chars(Blob:D:) { X::Buf::AsStr.new(method => 'chars').throw }
  99. multi method Str(Blob:D:) { X::Buf::AsStr.new(method => 'Str' ).throw }
  100. multi method Stringy(Blob:D:) { X::Buf::AsStr.new(method => 'Stringy' ).throw }
  101. method decode(Blob:D: $encoding = 'utf-8') {
  102. nqp::p6box_s(
  103. nqp::decode(self, Rakudo::Internals.NORMALIZE_ENCODING($encoding)))
  104. }
  105. multi method list(Blob:D:) {
  106. Seq.new(class :: does Rakudo::Iterator::Blobby {
  107. method pull-one() is raw {
  108. nqp::if(
  109. nqp::islt_i(($!i = nqp::add_i($!i,1)),nqp::elems($!blob)),
  110. nqp::atpos_i($!blob,$!i),
  111. IterationEnd
  112. )
  113. }
  114. }.new(self))
  115. }
  116. multi method gist(Blob:D:) {
  117. self.^name ~ ':0x<' ~ self.list.fmt('%02x', ' ') ~ '>'
  118. }
  119. multi method perl(Blob:D:) {
  120. self.^name ~ '.new(' ~ self.join(',') ~ ')';
  121. }
  122. method subbuf(Blob:D: $from, $length?) {
  123. my int $elems = nqp::elems(self);
  124. X::OutOfRange.new(
  125. what => "Len element to subbuf",
  126. got => $length,
  127. range => "0..$elems",
  128. ).fail if $length.DEFINITE && $length < 0;
  129. my int $pos;
  130. my int $todo;
  131. if nqp::istype($from,Range) {
  132. $from.int-bounds($pos, my int $max);
  133. $todo = $max - $pos + 1;
  134. }
  135. else {
  136. $pos = nqp::istype($from, Callable) ?? $from($elems) !! $from.Int;
  137. $todo = $length.DEFINITE
  138. ?? $length.Int min $elems - $pos
  139. !! $elems - $pos;
  140. }
  141. X::OutOfRange.new(
  142. what => 'From argument to subbuf',
  143. got => $from.gist,
  144. range => "0..$elems",
  145. comment => "use *-{abs $pos} if you want to index relative to the end",
  146. ).fail if $pos < 0;
  147. X::OutOfRange.new(
  148. what => 'From argument to subbuf',
  149. got => $from.gist,
  150. range => "0..$elems",
  151. ).fail if $pos > $elems;
  152. my $subbuf := nqp::create(self);
  153. if $todo {
  154. nqp::setelems($subbuf, $todo);
  155. my int $i = -1;
  156. --$pos;
  157. nqp::bindpos_i($subbuf,$i,nqp::atpos_i(self,++$pos))
  158. while nqp::islt_i(++$i,$todo);
  159. }
  160. $subbuf
  161. }
  162. method reverse(Blob:D:) {
  163. my int $elems = nqp::elems(self);
  164. my int $last = nqp::sub_i($elems,1);
  165. my $reversed := nqp::setelems(nqp::create(self),$elems);
  166. my int $i = -1;
  167. nqp::while(
  168. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  169. nqp::bindpos_i($reversed,nqp::sub_i($last,$i),
  170. nqp::atpos_i(self,$i))
  171. );
  172. $reversed
  173. }
  174. method COMPARE(Blob:D: Blob:D \other) {
  175. my $other := nqp::decont(other);
  176. my int $elems = nqp::elems(self);
  177. if nqp::cmp_i($elems,nqp::elems($other)) -> $diff {
  178. $diff
  179. }
  180. else {
  181. my int $i = -1;
  182. return nqp::cmp_i(nqp::atpos_i(self,$i),nqp::atpos_i($other,$i))
  183. if nqp::cmp_i(nqp::atpos_i(self,$i),nqp::atpos_i($other,$i))
  184. while nqp::islt_i(++$i,$elems);
  185. 0
  186. }
  187. }
  188. method SAME(Blob:D: Blob:D \other) {
  189. my $other := nqp::decont(other);
  190. my int $elems = nqp::elems(self);
  191. return False unless nqp::iseq_i($elems,nqp::elems($other));
  192. my int $i = -1;
  193. return False
  194. unless nqp::iseq_i(nqp::atpos_i(self,$i),nqp::atpos_i($other,$i))
  195. while nqp::islt_i(++$i,$elems);
  196. True
  197. }
  198. method join(Blob:D: $delim = '') {
  199. my int $elems = nqp::elems(self);
  200. my $list := nqp::setelems(nqp::list_s,$elems);
  201. my int $i = -1;
  202. nqp::bindpos_s($list,$i,
  203. nqp::tostr_I(nqp::p6box_i(nqp::atpos_i(self,$i))))
  204. while nqp::islt_i(++$i,$elems);
  205. nqp::join($delim.Str,$list)
  206. }
  207. proto method unpack(|) { * }
  208. multi method unpack(Blob:D: Str:D $template) {
  209. nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-PACK')) and X::Experimental.new(
  210. feature => "the 'unpack' method",
  211. use => "pack"
  212. ).throw;
  213. self.unpack($template.comb(/<[a..zA..Z]>[\d+|'*']?/))
  214. }
  215. multi method unpack(Blob:D: @template) {
  216. nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-PACK')) and X::Experimental.new(
  217. feature => "the 'unpack' method",
  218. use => "pack"
  219. ).throw;
  220. my @bytes = self.list;
  221. my @fields;
  222. for @template -> $unit {
  223. my $directive = substr($unit,0,1);
  224. my $amount = substr($unit,1);
  225. my $pa = $amount eq '' ?? 1 !!
  226. $amount eq '*' ?? @bytes.elems !! +$amount;
  227. given $directive {
  228. when 'a' | 'A' | 'Z' {
  229. @fields.push: @bytes.splice(0, $pa).map(&chr).join;
  230. }
  231. when 'H' {
  232. my str $hexstring = '';
  233. for ^$pa {
  234. my $byte = shift @bytes;
  235. $hexstring ~= ($byte +> 4).fmt('%x')
  236. ~ ($byte % 16).fmt('%x');
  237. }
  238. @fields.push($hexstring);
  239. }
  240. when 'x' {
  241. splice @bytes, 0, $pa;
  242. }
  243. when 'C' {
  244. @fields.append: @bytes.splice(0, $pa);
  245. }
  246. when 'S' | 'v' {
  247. for ^$pa {
  248. last if @bytes.elems < 2;
  249. @fields.append: shift(@bytes)
  250. + (shift(@bytes) +< 0x08);
  251. }
  252. }
  253. when 'L' | 'V' {
  254. for ^$pa {
  255. last if @bytes.elems < 4;
  256. @fields.append: shift(@bytes)
  257. + (shift(@bytes) +< 0x08)
  258. + (shift(@bytes) +< 0x10)
  259. + (shift(@bytes) +< 0x18);
  260. }
  261. }
  262. when 'n' {
  263. for ^$pa {
  264. last if @bytes.elems < 2;
  265. @fields.append: (shift(@bytes) +< 0x08)
  266. + shift(@bytes);
  267. }
  268. }
  269. when 'N' {
  270. for ^$pa {
  271. last if @bytes.elems < 4;
  272. @fields.append: (shift(@bytes) +< 0x18)
  273. + (shift(@bytes) +< 0x10)
  274. + (shift(@bytes) +< 0x08)
  275. + shift(@bytes);
  276. }
  277. }
  278. X::Buf::Pack.new(:$directive).throw;
  279. }
  280. }
  281. return |@fields;
  282. }
  283. # XXX: the pack.t spectest file seems to require this method
  284. # not sure if it should be changed to list there...
  285. method contents(Blob:D:) { self.list }
  286. method encoding() { Any }
  287. method !push-list(\action,\to,\from) {
  288. if nqp::istype(from,List) {
  289. my Mu $from := nqp::getattr(from,List,'$!reified');
  290. if nqp::defined($from) {
  291. my int $elems = nqp::elems($from);
  292. my int $j = nqp::elems(to);
  293. nqp::setelems(to, $j + $elems); # presize for efficiency
  294. my int $i = -1;
  295. my $got;
  296. nqp::istype(($got := nqp::atpos($from,$i)),Int)
  297. ?? nqp::bindpos_i(to,$j++,$got)
  298. !! self!fail-typecheck-element(action,$i,$got).throw
  299. while nqp::islt_i(++$i,$elems);
  300. }
  301. }
  302. else {
  303. my $iter := from.iterator;
  304. my int $i = 0;
  305. my $got;
  306. until ($got := $iter.pull-one) =:= IterationEnd {
  307. nqp::istype($got,Int)
  308. ?? nqp::push_i(to,$got)
  309. !! self!fail-typecheck-element(action,$i,$got).throw;
  310. ++$i;
  311. }
  312. }
  313. to
  314. }
  315. method !unshift-list(\action,\to,\from) {
  316. if nqp::istype(from,List) {
  317. my Mu $from := nqp::getattr(from,List,'$!reified');
  318. if nqp::defined($from) {
  319. my int $i = nqp::elems($from);
  320. nqp::istype((my $got := nqp::atpos($from,$i)),Int)
  321. ?? nqp::unshift_i(to,$got)
  322. !! self!fail-typecheck-element(action,$i,$got).throw
  323. while nqp::isge_i(--$i,0);
  324. }
  325. to
  326. }
  327. else {
  328. nqp::splice(to,self!push-list(action,nqp::create(self),from),0,0)
  329. }
  330. }
  331. method !spread(\to,\from) {
  332. if nqp::elems(from) -> int $values { # something to init with
  333. my int $elems = nqp::elems(to) - $values;
  334. my int $i = -$values;
  335. nqp::splice(to,from,$i,$values)
  336. while nqp::isle_i($i = $i + $values,$elems);
  337. if nqp::isgt_i($i,$elems) { # something left to init
  338. --$i; # went one too far
  339. $elems = $elems + $values;
  340. my int $j = -1;
  341. nqp::bindpos_i(to,$i,nqp::atpos_i(from,$j = ($j + 1) % $values))
  342. while nqp::islt_i(++$i,$elems);
  343. }
  344. }
  345. to
  346. }
  347. method !fail-range($got) {
  348. Failure.new(X::OutOfRange.new(
  349. :what($*INDEX // 'Index'),
  350. :$got,
  351. :range("0..{nqp::elems(self)-1}")
  352. ))
  353. }
  354. method !fail-typecheck-element(\action,\i,\got) {
  355. self!fail-typecheck(action ~ "ing element #" ~ i,got);
  356. }
  357. method !fail-typecheck($action,$got) {
  358. Failure.new(X::TypeCheck.new(
  359. operation => $action ~ " to " ~ self.^name,
  360. got => $got,
  361. expected => T,
  362. ))
  363. }
  364. }
  365. constant blob8 = Blob[uint8];
  366. constant blob16 = Blob[uint16];
  367. constant blob32 = Blob[uint32];
  368. constant blob64 = Blob[uint64];
  369. my class utf8 does Blob[uint8] is repr('VMArray') {
  370. method decode(utf8:D: $encoding = 'utf-8') {
  371. my $enc = Rakudo::Internals.NORMALIZE_ENCODING($encoding);
  372. die "Can not decode a utf-8 buffer as if it were $encoding"
  373. unless $enc eq 'utf8';
  374. nqp::p6box_s(nqp::decode(self, 'utf8'))
  375. }
  376. method encoding() { 'utf-8' }
  377. multi method Str(utf8:D:) { self.decode }
  378. multi method Stringy(utf8:D:) { self.decode }
  379. }
  380. my class utf16 does Blob[uint16] is repr('VMArray') {
  381. method decode(utf16:D: $encoding = 'utf-16') {
  382. my $enc = Rakudo::Internals.NORMALIZE_ENCODING($encoding);
  383. die "Can not decode a utf-16 buffer as if it were $encoding"
  384. unless $enc eq 'utf16';
  385. nqp::p6box_s(nqp::decode(self, 'utf16'))
  386. }
  387. method encoding() { 'utf-16' }
  388. multi method Str(utf16:D:) { self.decode }
  389. multi method Stringy(utf16:D:) { self.decode }
  390. }
  391. my class utf32 does Blob[uint32] is repr('VMArray') {
  392. method decode(utf32:D: $encoding = 'utf-32') {
  393. my $enc = Rakudo::Internals.NORMALIZE_ENCODING($encoding);
  394. die "Can not decode a utf-32 buffer as if it were $encoding"
  395. unless $enc eq 'utf32';
  396. nqp::p6box_s(nqp::decode(self, 'utf32'))
  397. }
  398. method encoding() { 'utf-32' }
  399. multi method Str(utf32:D:) { self.decode }
  400. multi method Stringy(utf32:D:) { self.decode }
  401. }
  402. my role Buf[::T = uint8] does Blob[T] is repr('VMArray') is array_type(T) {
  403. multi method WHICH(Buf:D:) { self.Mu::WHICH }
  404. multi method AT-POS(Buf:D: int \pos) is raw {
  405. nqp::islt_i(pos,0)
  406. ?? Failure.new(X::OutOfRange.new(
  407. :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>))
  408. !! nqp::atposref_i(self, pos)
  409. }
  410. multi method AT-POS(Buf:D: Int:D \pos) is raw {
  411. my int $pos = nqp::unbox_i(pos);
  412. nqp::islt_i($pos,0)
  413. ?? Failure.new(X::OutOfRange.new(
  414. :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>))
  415. !! nqp::atposref_i(self,$pos)
  416. }
  417. multi method ASSIGN-POS(Buf:D: int \pos, Mu \assignee) {
  418. nqp::islt_i(pos,0)
  419. ?? Failure.new(X::OutOfRange.new(
  420. :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>))
  421. !! nqp::bindpos_i(self,\pos,assignee)
  422. }
  423. multi method ASSIGN-POS(Buf:D: Int:D \pos, Mu \assignee) {
  424. my int $pos = nqp::unbox_i(pos);
  425. nqp::islt_i($pos,0)
  426. ?? Failure.new(X::OutOfRange.new(
  427. :what($*INDEX // 'Index'),:got(pos),:range<0..^Inf>))
  428. !! nqp::bindpos_i(self,$pos,assignee)
  429. }
  430. multi method list(Buf:D:) {
  431. Seq.new(class :: does Rakudo::Iterator::Blobby {
  432. method pull-one() is raw {
  433. nqp::if(
  434. nqp::islt_i(($!i = nqp::add_i($!i,1)),nqp::elems($!blob)),
  435. nqp::atposref_i($!blob,$!i),
  436. IterationEnd
  437. )
  438. }
  439. }.new(self))
  440. }
  441. multi method pop(Buf:D:) {
  442. nqp::elems(self)
  443. ?? nqp::pop_i(self)
  444. !! Failure.new(X::Cannot::Empty.new(:action<pop>,:what(self.^name)))
  445. }
  446. multi method shift(Buf:D:) {
  447. nqp::elems(self)
  448. ?? nqp::shift_i(self)
  449. !! Failure.new(X::Cannot::Empty.new(:action<shift>,:what(self.^name)))
  450. }
  451. method reallocate(Buf:D: Int $elements) { nqp::setelems(self,$elements) }
  452. my $empty := nqp::list_i;
  453. multi method splice(Buf:D \SELF:) { my $buf = SELF; SELF = Buf.new; $buf }
  454. multi method splice(Buf:D: Int $offset, $size = Whatever) {
  455. my int $remove = self!remove($offset,$size);
  456. my $result := $remove
  457. ?? self.subbuf($offset,$remove) # until something smarter
  458. !! nqp::create(self);
  459. nqp::splice(self,$empty,$offset,$remove);
  460. $result
  461. }
  462. multi method splice(Buf:D: Int $offset, $size, int $got) {
  463. self!splice-native($offset,$size,$got)
  464. }
  465. multi method splice(Buf:D: Int $offset, $size, Int $got) {
  466. self!splice-native($offset,$size,$got)
  467. }
  468. multi method splice(Buf:D: Int $offset, $size, Mu $got) {
  469. self!fail-typecheck('splice',$got)
  470. }
  471. multi method splice(Buf:D: Int $offset, $size, Buf:D $buf) {
  472. self!splice-native($offset,$size,$buf)
  473. }
  474. multi method splice(Buf:D: Int $offset, $size, int @values) {
  475. self!splice-native($offset,$size,@values)
  476. }
  477. multi method splice(Buf:D: Int $offset, $size, @values) {
  478. self!splice-native($offset,$size,
  479. self!push-list("splic",nqp::create(self),@values))
  480. }
  481. method !remove(\offset,\size) {
  482. nqp::istype(size,Whatever)
  483. ?? nqp::elems(self) - offset
  484. !! nqp::istype(size,Int)
  485. ?? size
  486. !! size.Int
  487. }
  488. method !splice-native(Buf:D: Int $offset, $size, \x) {
  489. my int $remove = self!remove($offset,$size);
  490. my $result := $remove
  491. ?? self.subbuf($offset,$remove) # until something smarter
  492. !! nqp::create(self);
  493. nqp::splice(
  494. self,nqp::islist(x) ?? x !! nqp::list_i(x),$offset,$remove);
  495. $result
  496. }
  497. multi method push(Buf:D: int $got) { nqp::push_i(self,$got); self }
  498. multi method push(Buf:D: Int $got) { nqp::push_i(self,$got); self }
  499. multi method push(Buf:D: Mu $got) { self!fail-typecheck('push',$got) }
  500. multi method push(Buf:D: Blob:D $buf) {
  501. nqp::splice(self,$buf,nqp::elems(self),0)
  502. }
  503. multi method push(Buf:D: **@values) { self!pend(@values,'push') }
  504. multi method append(Buf:D: int $got) { nqp::push_i(self,$got); self }
  505. multi method append(Buf:D: Int $got) { nqp::push_i(self,$got); self }
  506. multi method append(Buf:D: Mu $got) { self!fail-typecheck('append',$got) }
  507. multi method append(Buf:D: Blob:D $buf) {
  508. nqp::splice(self,$buf,nqp::elems(self),0)
  509. }
  510. multi method append(Buf:D: int @values) {
  511. nqp::splice(self,@values,nqp::elems(self),0)
  512. }
  513. multi method append(Buf:D: @values) { self!pend(@values,'append') }
  514. multi method append(Buf:D: *@values) { self!pend(@values,'append') }
  515. multi method unshift(Buf:D: int $got) { nqp::unshift_i(self,$got); self }
  516. multi method unshift(Buf:D: Int $got) { nqp::unshift_i(self,$got); self }
  517. multi method unshift(Buf:D: Mu $got) { self!fail-typecheck('unshift',$got) }
  518. multi method unshift(Buf:D: Blob:D $buf) { nqp::splice(self,$buf,0,0) }
  519. multi method unshift(Buf:D: **@values) { self!pend(@values,'unshift') }
  520. multi method prepend(Buf:D: int $got) { nqp::unshift_i(self,$got); self }
  521. multi method prepend(Buf:D: Int $got) { nqp::unshift_i(self,$got); self }
  522. multi method prepend(Buf:D: Mu $got) { self!fail-typecheck('prepend',$got) }
  523. multi method prepend(Buf:D: Blob:D $buf) { nqp::splice(self,$buf,0,0) }
  524. multi method prepend(Buf:D: int @values) { nqp::splice(self,@values,0,0) }
  525. multi method prepend(Buf:D: @values) { self!pend(@values,'prepend') }
  526. multi method prepend(Buf:D: *@values) { self!pend(@values,'prepend') }
  527. method !pend(Buf:D: @values, $action) {
  528. @values.is-lazy
  529. ?? Failure.new(X::Cannot::Lazy.new(:$action,:what(self.^name)))
  530. !! $action eq 'push' || $action eq 'append'
  531. ?? self!push-list($action,self,@values)
  532. !! self!unshift-list($action,self,@values)
  533. }
  534. }
  535. constant buf8 = Buf[uint8];
  536. constant buf16 = Buf[uint16];
  537. constant buf32 = Buf[uint32];
  538. constant buf64 = Buf[uint64];
  539. proto sub pack(|) { * }
  540. multi sub pack(Str $template, *@items) {
  541. nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-PACK')) and X::Experimental.new(
  542. feature => "the 'pack' function",
  543. use => "pack"
  544. ).throw;
  545. pack($template.comb(/<[a..zA..Z]>[\d+|'*']?/), @items)
  546. }
  547. multi sub pack(@template, *@items) {
  548. nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-PACK')) and X::Experimental.new(
  549. feature => "the 'pack' function",
  550. use => "pack"
  551. ).throw;
  552. my @bytes;
  553. for @template -> $unit {
  554. my $directive = substr($unit,0,1);
  555. my $amount = substr($unit,1);
  556. given $directive {
  557. when 'A' {
  558. my $ascii = shift @items // '';
  559. my $data = $ascii.ords.cache;
  560. if $amount eq '*' {
  561. $amount = $data.elems;
  562. }
  563. if $amount eq '' {
  564. $amount = 1;
  565. }
  566. for (@$data, 0x20 xx *).flat[^$amount] -> $byte {
  567. X::Buf::Pack::NonASCII.new(:char($byte.chr)).throw if $byte > 0x7f;
  568. @bytes.push: $byte;
  569. }
  570. }
  571. when 'a' {
  572. my $data = shift @items // Buf.new;
  573. $data.=encode if nqp::istype($data,Str);
  574. if $amount eq '*' {
  575. $amount = $data.elems;
  576. }
  577. if $amount eq '' {
  578. $amount = 1;
  579. }
  580. for (@$data, 0 xx *).flat[^$amount] -> $byte {
  581. @bytes.push: $byte;
  582. }
  583. }
  584. when 'H' {
  585. my $hexstring = shift @items // '';
  586. if $hexstring.chars % 2 {
  587. $hexstring ~= '0';
  588. }
  589. @bytes.append: map { :16($_) }, $hexstring.comb(/../);
  590. }
  591. when 'x' {
  592. if $amount eq '*' {
  593. $amount = 0;
  594. }
  595. elsif $amount eq '' {
  596. $amount = 1;
  597. }
  598. @bytes.append: 0x00 xx $amount;
  599. }
  600. when 'C' {
  601. my $number = shift(@items);
  602. @bytes.push: $number % 0x100;
  603. }
  604. when 'S' | 'v' {
  605. my $number = shift(@items);
  606. @bytes.append: ($number, $number +> 0x08) >>%>> 0x100;
  607. }
  608. when 'L' | 'V' {
  609. my $number = shift(@items);
  610. @bytes.append: ($number, $number +> 0x08,
  611. $number +> 0x10, $number +> 0x18) >>%>> 0x100;
  612. }
  613. when 'n' {
  614. my $number = shift(@items);
  615. @bytes.append: ($number +> 0x08, $number) >>%>> 0x100;
  616. }
  617. when 'N' {
  618. my $number = shift(@items);
  619. @bytes.append: ($number +> 0x18, $number +> 0x10,
  620. $number +> 0x08, $number) >>%>> 0x100;
  621. }
  622. X::Buf::Pack.new(:$directive).throw;
  623. }
  624. }
  625. return Buf.new(@bytes);
  626. }
  627. multi sub infix:<~>(Blob:D \a) { a }
  628. multi sub infix:<~>(Blob:D $a, Blob:D $b) {
  629. my $res := ($a.WHAT === $b.WHAT ?? $a !! Buf).new;
  630. my $adc := nqp::decont($a);
  631. my $bdc := nqp::decont($b);
  632. my int $alen = nqp::elems($adc);
  633. my int $blen = nqp::elems($bdc);
  634. nqp::setelems($res, $alen + $blen);
  635. nqp::splice($res, $adc, 0, $alen);
  636. nqp::splice($res, $bdc, $alen, $blen);
  637. }
  638. multi sub prefix:<~^>(Blob:D \a) {
  639. my $a := nqp::decont(a);
  640. my int $elems = nqp::elems($a);
  641. my $r := nqp::create($a);
  642. nqp::setelems($a,$elems);
  643. my int $i = -1;
  644. my uint64 $mask = 0xFFFFFFFFFFFFFFFF;
  645. nqp::bindpos_i($r,$i,nqp::bitxor_i(nqp::atpos_i($a,$i),$mask))
  646. while nqp::islt_i(++$i,$elems);
  647. $r
  648. }
  649. multi sub infix:<~&>(Blob:D \a, Blob:D \b) {
  650. my $a := nqp::decont(a);
  651. my $b := nqp::decont(b);
  652. my int $elemsa = nqp::elems($a);
  653. my int $elemsb = nqp::elems($b);
  654. my int $do = $elemsa > $elemsb ?? $elemsb !! $elemsa;
  655. my int $max = $elemsa > $elemsb ?? $elemsa !! $elemsb;
  656. my $r := nqp::create($a);
  657. nqp::setelems($r,$max);
  658. my int $i = -1;
  659. nqp::bindpos_i($r,$i,
  660. nqp::bitand_i(nqp::atpos_i($a,$i),nqp::atpos_i($b,$i)))
  661. while nqp::islt_i(++$i,$do);
  662. --$i; # went one too far
  663. nqp::bindpos_i($r,$i,0) while nqp::islt_i(++$i,$max);
  664. $r
  665. }
  666. multi sub infix:<~|>(Blob:D \a, Blob:D \b) {
  667. my $a := nqp::decont(a);
  668. my $b := nqp::decont(b);
  669. my int $elemsa = nqp::elems($a);
  670. my int $elemsb = nqp::elems($b);
  671. my int $do = $elemsa > $elemsb ?? $elemsb !! $elemsa;
  672. my int $max = $elemsa > $elemsb ?? $elemsa !! $elemsb;
  673. my $from := $elemsa > $elemsb ?? $a !! $b;
  674. my $r := nqp::create($a);
  675. nqp::setelems($r,$max);
  676. my int $i = -1;
  677. nqp::bindpos_i($r,$i,
  678. nqp::bitor_i(nqp::atpos_i($a,$i),nqp::atpos_i($b,$i)))
  679. while nqp::islt_i(++$i,$do);
  680. $i = $i - 1; # went one too far
  681. nqp::bindpos_i($r,$i,nqp::atpos_i($from,$i))
  682. while nqp::islt_i(++$i,$max);
  683. $r
  684. }
  685. multi sub infix:<~^>(Blob:D \a, Blob:D \b) {
  686. my $a := nqp::decont(a);
  687. my $b := nqp::decont(b);
  688. my int $elemsa = nqp::elems($a);
  689. my int $elemsb = nqp::elems($b);
  690. my int $do = $elemsa > $elemsb ?? $elemsb !! $elemsa;
  691. my int $max = $elemsa > $elemsb ?? $elemsa !! $elemsb;
  692. my $from := $elemsa > $elemsb ?? $a !! $b;
  693. my $r := nqp::create($a);
  694. nqp::setelems($r,$max);
  695. my int $i = -1;
  696. nqp::bindpos_i($r,$i,
  697. nqp::bitxor_i(nqp::atpos_i($a,$i),nqp::atpos_i($b,$i)))
  698. while nqp::islt_i(++$i,$do);
  699. --$i; # went one too far
  700. nqp::bindpos_i($r,$i,nqp::atpos_i($from,$i))
  701. while nqp::islt_i(++$i,$max);
  702. $r
  703. }
  704. multi sub infix:<eqv>(Blob:D \a, Blob:D \b) {
  705. nqp::p6bool(nqp::eqaddr(a,b) || (nqp::eqaddr(a.WHAT,b.WHAT) && a.SAME(b)))
  706. }
  707. multi sub infix:<cmp>(Blob:D \a, Blob:D \b) { ORDER(a.COMPARE(b)) }
  708. multi sub infix:<eq> (Blob:D \a, Blob:D \b) { a =:= b || a.SAME(b) }
  709. multi sub infix:<ne> (Blob:D \a, Blob:D \b) { !(a =:= b || a.SAME(b)) }
  710. multi sub infix:<lt> (Blob:D \a, Blob:D \b) { a.COMPARE(b) == -1 }
  711. multi sub infix:<gt> (Blob:D \a, Blob:D \b) { a.COMPARE(b) == 1 }
  712. multi sub infix:<le> (Blob:D \a, Blob:D \b) { a.COMPARE(b) != 1 }
  713. multi sub infix:<ge> (Blob:D \a, Blob:D \b) { a.COMPARE(b) != -1 }
  714. sub subbuf-rw(Buf:D \b, $from = 0, $elems = b.elems - $from) is rw {
  715. my Blob $subbuf = b.subbuf($from, $elems);
  716. Proxy.new(
  717. FETCH => sub ($) { $subbuf },
  718. STORE => sub ($, Blob:D $new) {
  719. nqp::splice(nqp::decont(b),nqp::decont($new),$from,$elems)
  720. }
  721. );
  722. }