@@ -475,6 +475,240 @@ VAL idris_strRev(VM* vm, VAL str) {
475475 return cl;
476476}
477477
478+VAL MKBUFFERc(VM* vm, Buffer* buf) {
479+ Closure* cl = allocate(vm, sizeof(Closure) + sizeof *buf + buf->cap, 1);
480+ SETTY(cl, BUFFER);
481+ cl->info.buf = (Buffer*)((void*)cl + sizeof(Closure));
482+ memmove(cl->info.buf, buf, sizeof *buf + buf->fill);
483+ return cl;
484+}
485+
486+static VAL internal_allocate(VM *vm, size_t hint) {
487+ size_t size = hint + sizeof(Closure) + sizeof(Buffer);
488+
489+ // Round up to a power of 2
490+ --size;
491+ size_t i;
492+ for (i = 0; i <= sizeof size; ++i)
493+ size |= size >> (1 << i);
494+ ++size;
495+
496+ Closure* cl = allocate(vm, size, 0);
497+ SETTY(cl, BUFFER);
498+ cl->info.buf = (Buffer*)((void*)cl + sizeof(Closure));
499+ cl->info.buf->cap = size - (sizeof(Closure) + sizeof(Buffer));
500+ return cl;
501+}
502+
503+// Following functions cast uint64_t to size_t, which may narrow!
504+VAL idris_allocate(VM* vm, VAL hint) {
505+ Closure* cl = internal_allocate(vm, hint->info.bits64);
506+ cl->info.buf->fill = 0;
507+ return cl;
508+}
509+
510+static void internal_memset(void *dest, const void *src, size_t size, size_t num) {
511+ while (num--) {
512+ memmove(dest, src, size);
513+ dest += size;
514+ }
515+}
516+
517+static VAL internal_prepare_append(VM* vm, VAL buf, size_t bufLen, size_t appLen) {
518+ size_t totalLen = bufLen + appLen;
519+ Closure* cl;
520+ if (bufLen != buf->info.buf->fill ||
521+ totalLen > buf->info.buf->cap) {
522+ // We're not at the fill or are over cap, so need a new buffer
523+ cl = internal_allocate(vm, totalLen);
524+ memmove(cl->info.buf->store,
525+ buf->info.buf->store,
526+ bufLen);
527+ cl->info.buf->fill = totalLen;
528+ } else {
529+ // Hooray, can just bump the fill
530+ cl = buf;
531+ cl->info.buf->fill += appLen;
532+ }
533+ return cl;
534+}
535+
536+VAL idris_appendBuffer(VM* vm, VAL fst, VAL fstLen, VAL cnt, VAL sndLen, VAL sndOff, VAL snd) {
537+ size_t firstLength = fstLen->info.bits64;
538+ size_t secondLength = sndLen->info.bits64;
539+ size_t count = cnt->info.bits64;
540+ size_t offset = sndOff->info.bits64;
541+ Closure* cl = internal_prepare_append(vm, fst, firstLength, count * secondLength);
542+ internal_memset(cl->info.buf->store + firstLength, snd->info.buf->store + offset, secondLength, count);
543+ return cl;
544+}
545+
546+// Special cased because we can use memset
547+VAL idris_appendB8Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
548+ size_t bufLen = len->info.bits64;
549+ size_t count = cnt->info.bits64;
550+ Closure* cl = internal_prepare_append(vm, buf, bufLen, count);
551+ memset(cl->info.buf->store + bufLen, val->info.bits8, count);
552+ return cl;
553+}
554+
555+static VAL internal_append_bits(VM* vm, VAL buf, VAL bufLen, VAL cnt, const void* val, size_t val_len) {
556+ size_t len = bufLen->info.bits64;
557+ size_t count = cnt->info.bits64;
558+ Closure* cl = internal_prepare_append(vm, buf, len, count * val_len);
559+ internal_memset(cl->info.buf->store + len, val, val_len, count);
560+ return cl;
561+}
562+
563+VAL idris_appendB16Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
564+ return internal_append_bits(vm, buf, len, cnt, &val->info.bits16, sizeof val->info.bits16);
565+}
566+
567+VAL idris_appendB16LE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
568+ // On gcc 4.8 -O3 compiling for x86_64, using leVal like this is
569+ // optimized away. Presumably the same holds for other sizes and
570+ // conversly on BE systems
571+ unsigned char leVal[sizeof val] = { val->info.bits16
572+ , (val->info.bits16 >> 8)
573+ };
574+ return internal_append_bits(vm, buf, len, cnt, leVal, sizeof leVal);
575+}
576+
577+VAL idris_appendB16BE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
578+ unsigned char beVal[sizeof val] = { (val->info.bits16 >> 8)
579+ , val->info.bits16
580+ };
581+ return internal_append_bits(vm, buf, len, cnt, beVal, sizeof beVal);
582+}
583+
584+VAL idris_appendB32Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
585+ return internal_append_bits(vm, buf, len, cnt, &val->info.bits32, sizeof val->info.bits32);
586+}
587+
588+VAL idris_appendB32LE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
589+ unsigned char leVal[sizeof val] = { val->info.bits32
590+ , (val->info.bits32 >> 8)
591+ , (val->info.bits32 >> 16)
592+ , (val->info.bits32 >> 24)
593+ };
594+ return internal_append_bits(vm, buf, len, cnt, leVal, sizeof leVal);
595+}
596+
597+VAL idris_appendB32BE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
598+ unsigned char beVal[sizeof val] = { (val->info.bits32 >> 24)
599+ , (val->info.bits32 >> 16)
600+ , (val->info.bits32 >> 8)
601+ , val->info.bits32
602+ };
603+ return internal_append_bits(vm, buf, len, cnt, beVal, sizeof beVal);
604+}
605+
606+VAL idris_appendB64Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
607+ return internal_append_bits(vm, buf, len, cnt, &val->info.bits64, sizeof val->info.bits64);
608+}
609+
610+VAL idris_appendB64LE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
611+ unsigned char leVal[sizeof val] = { val->info.bits64
612+ , (val->info.bits64 >> 8)
613+ , (val->info.bits64 >> 16)
614+ , (val->info.bits64 >> 24)
615+ , (val->info.bits64 >> 32)
616+ , (val->info.bits64 >> 40)
617+ , (val->info.bits64 >> 48)
618+ , (val->info.bits64 >> 56)
619+ };
620+ return internal_append_bits(vm, buf, len, cnt, leVal, sizeof leVal);
621+}
622+
623+VAL idris_appendB64BE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {
624+ unsigned char beVal[sizeof val] = { (val->info.bits64 >> 56)
625+ , (val->info.bits64 >> 48)
626+ , (val->info.bits64 >> 40)
627+ , (val->info.bits64 >> 32)
628+ , (val->info.bits64 >> 24)
629+ , (val->info.bits64 >> 16)
630+ , (val->info.bits64 >> 8)
631+ , val->info.bits64
632+ };
633+ return internal_append_bits(vm, buf, len, cnt, beVal, sizeof beVal);
634+}
635+
636+VAL idris_peekB8Native(VM* vm, VAL buf, VAL off) {
637+ size_t offset = off->info.bits64;
638+ uint8_t *val = buf->info.buf->store + offset;
639+ return MKB8(vm, *val);
640+}
641+
642+VAL idris_peekB16Native(VM* vm, VAL buf, VAL off) {
643+ size_t offset = off->info.bits64;
644+ uint16_t *val = (uint16_t *) (buf->info.buf->store + offset);
645+ return MKB16(vm, *val);
646+}
647+
648+VAL idris_peekB16LE(VM* vm, VAL buf, VAL off) {
649+ size_t offset = off->info.bits64;
650+ return MKB16(vm, ((uint16_t) buf->info.buf->store[offset]) +
651+ (((uint16_t) buf->info.buf->store[offset + 1]) << 8));
652+}
653+
654+VAL idris_peekB16BE(VM* vm, VAL buf, VAL off) {
655+ size_t offset = off->info.bits64;
656+ return MKB16(vm, ((uint16_t) buf->info.buf->store[offset + 1]) +
657+ (((uint16_t) buf->info.buf->store[offset]) << 8));
658+}
659+
660+VAL idris_peekB32Native(VM* vm, VAL buf, VAL off) {
661+ size_t offset = off->info.bits64;
662+ uint32_t *val = (uint32_t *) (buf->info.buf->store + offset);
663+ return MKB32(vm, *val);
664+}
665+
666+VAL idris_peekB32LE(VM* vm, VAL buf, VAL off) {
667+ size_t offset = off->info.bits64;
668+ return MKB32(vm, ((uint32_t) buf->info.buf->store[offset]) +
669+ (((uint32_t) buf->info.buf->store[offset + 1]) << 8) +
670+ (((uint32_t) buf->info.buf->store[offset + 2]) << 16) +
671+ (((uint32_t) buf->info.buf->store[offset + 3]) << 24));
672+}
673+
674+VAL idris_peekB32BE(VM* vm, VAL buf, VAL off) {
675+ size_t offset = off->info.bits64;
676+ return MKB32(vm, ((uint32_t) buf->info.buf->store[offset + 3]) +
677+ (((uint32_t) buf->info.buf->store[offset + 2]) << 8) +
678+ (((uint32_t) buf->info.buf->store[offset + 1]) << 16) +
679+ (((uint32_t) buf->info.buf->store[offset]) << 24));
680+}
681+
682+VAL idris_peekB64Native(VM* vm, VAL buf, VAL off) {
683+ size_t offset = off->info.bits64;
684+ uint64_t *val = (uint64_t *) (buf->info.buf->store + offset);
685+ return MKB64(vm, *val);
686+}
687+
688+VAL idris_peekB64LE(VM* vm, VAL buf, VAL off) {
689+ size_t offset = off->info.bits64;
690+ return MKB64(vm, ((uint64_t) buf->info.buf->store[offset]) +
691+ (((uint64_t) buf->info.buf->store[offset + 1]) << 8) +
692+ (((uint64_t) buf->info.buf->store[offset + 2]) << 16) +
693+ (((uint64_t) buf->info.buf->store[offset + 3]) << 24) +
694+ (((uint64_t) buf->info.buf->store[offset + 4]) << 32) +
695+ (((uint64_t) buf->info.buf->store[offset + 5]) << 40) +
696+ (((uint64_t) buf->info.buf->store[offset + 6]) << 48) +
697+ (((uint64_t) buf->info.buf->store[offset + 7]) << 56));
698+}
699+
700+VAL idris_peekB64BE(VM* vm, VAL buf, VAL off) {
701+ size_t offset = off->info.bits64;
702+ return MKB64(vm, ((uint64_t) buf->info.buf->store[offset + 7]) +
703+ (((uint64_t) buf->info.buf->store[offset + 6]) << 8) +
704+ (((uint64_t) buf->info.buf->store[offset + 5]) << 16) +
705+ (((uint64_t) buf->info.buf->store[offset + 4]) << 24) +
706+ (((uint64_t) buf->info.buf->store[offset + 3]) << 32) +
707+ (((uint64_t) buf->info.buf->store[offset + 2]) << 40) +
708+ (((uint64_t) buf->info.buf->store[offset + 1]) << 48) +
709+ (((uint64_t) buf->info.buf->store[offset]) << 56));
710+}
711+
478712typedef struct {
479713 VM* vm; // thread's VM
480714 VM* callvm; // calling thread's VM
@@ -552,6 +786,9 @@ VAL copyTo(VM* vm, VAL x) {
552786 case STRING:
553787 cl = MKSTRc(vm, x->info.str);
554788 break;
789+ case BUFFER:
790+ cl = MKBUFFERc(vm, x->info.buf);
791+ break;
555792 case BIGINT:
556793 cl = MKBIGMc(vm, x->info.ptr);
557794 break;