Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-12-25 21:58:54 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

initial support for bytevectors

Browse source
This commit is contained in:
ESL 2023-03-26 13:20:33 -04:00
parent 833a6261b9
commit 46b9640ba6
5 changed files with 2261 additions and 2014 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

90
i.c
View file

@ -177,6 +177,7 @@ static void _sck(obj *s) {
#define fixnum_obj(x) obj_from_fixnum(x)
#define flonum_obj(x) hp_pushptr(dupflonum(x), FLONUM_NTAG)
#define string_obj(s) hp_pushptr((s), STRING_NTAG)
#define bytevector_obj(s) hp_pushptr((s), BYTEVECTOR_NTAG)
#define iport_file_obj(fp) hp_pushptr((fp), IPORT_FILE_NTAG)
#define oport_file_obj(fp) hp_pushptr((fp), OPORT_FILE_NTAG)
#define iport_string_obj(fp) hp_pushptr((fp), IPORT_STRING_NTAG)
@ -438,12 +439,16 @@ define_instrhelper(cxi_failactype) {
{ ac = _x; spush((obj)"pair"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckl(x) do { obj _x = (x); if (unlikely(!islist(_x))) \
{ ac = _x; spush((obj)"list"); musttail return cxi_failactype(IARGS); } } while (0)
#define cku(x) do { obj _x = (x); if (unlikely(!isnull(_x))) \
{ ac = _x; spush((obj)"proper list"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckv(x) do { obj _x = (x); if (unlikely(!isvector(_x))) \
{ ac = _x; spush((obj)"vector"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckc(x) do { obj _x = (x); if (unlikely(!is_char_obj(_x))) \
{ ac = _x; spush((obj)"char"); musttail return cxi_failactype(IARGS); } } while (0)
#define cks(x) do { obj _x = (x); if (unlikely(!isstring(_x))) \
{ ac = _x; spush((obj)"string"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckb(x) do { obj _x = (x); if (unlikely(!isbytevector(_x))) \
{ ac = _x; spush((obj)"bytevector"); musttail return cxi_failactype(IARGS); } } while (0)
#define cki(x) do { obj _x = (x); if (unlikely(!is_fixnum_obj(_x))) \
{ ac = _x; spush((obj)"fixnum"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckj(x) do { obj _x = (x); if (unlikely(!is_flonum_obj(_x))) \
@ -452,6 +457,8 @@ define_instrhelper(cxi_failactype) {
{ ac = _x; spush((obj)"number"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckk(x) do { obj _x = (x); if (unlikely(!is_fixnum_obj(_x) || fixnum_from_obj(_x) < 0)) \
{ ac = _x; spush((obj)"nonnegative fixnum"); musttail return cxi_failactype(IARGS); } } while (0)
#define ck8(x) do { obj _x = (x); if (unlikely(!is_byte_obj(_x))) \
{ ac = _x; spush((obj)"byte"); musttail return cxi_failactype(IARGS); } } while (0)
#define cky(x) do { obj _x = (x); if (unlikely(!issymbol(_x))) \
{ ac = _x; spush((obj)"symbol"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckr(x) do { obj _x = (x); if (unlikely(!isiport(_x))) \
@ -1136,6 +1143,56 @@ define_instruction(ssub) {
gonexti();
}
define_instruction(bvecp) {
ac = bool_obj(isbytevector(ac));
gonexti();
}
define_instruction(bvec) {
int i, n = fixnum_from_obj(*ip++);
obj o = bytevector_obj(allocbytevector(n, 0));
unsigned char *s = (unsigned char *)bytevectorbytes(o);
for (i = 0; i < n; ++i) {
obj x = sref(i); ck8(x); s[i] = byte_from_obj(x);
}
sdrop(n); ac = o;
gonexti();
}
define_instruction(bmk) {
int n, b; obj x = spop();
ckk(ac); ck8(x);
n = fixnum_from_obj(ac), b = byte_from_obj(x);
ac = bytevector_obj(allocbytevector(n, b));
gonexti();
}
define_instruction(blen) {
ckb(ac);
ac = fixnum_obj(bytevectorlen(ac));
gonexti();
}
define_instruction(bget) {
obj x = spop(); int i;
ckb(ac); ckk(x);
i = fixnum_from_obj(x);
if (i >= bytevectorlen(ac)) failtype(x, "valid bytevector index");
ac = fixnum_obj(*bytevectorref(ac, i));
gonexti();
}
define_instruction(bput) {
obj x = spop(), y = spop(); int i;
ckb(ac); ckk(x); ck8(y);
i = fixnum_from_obj(x);
if (i >= bytevectorlen(ac)) failtype(x, "valid bytevector index");
*bytevectorref(ac, i) = byte_from_obj(y);
gonexti();
}
define_instruction(vecp) {
ac = bool_obj(isvector(ac));
gonexti();
@ -1212,13 +1269,26 @@ define_instruction(vtol) {
define_instruction(ltov) {
obj l = ac; int n = 0, i;
while (ispair(l)) { l = cdr(l); ++n; }
while (ispair(l)) { l = cdr(l); ++n; } cku(l);
hp_reserve(vecbsz(n));
for (l = ac, i = 0, hp -= n; i < n; ++i, l = cdr(l)) hp[i] = car(l);
ac = hend_vec(n);
gonexti();
}
define_instruction(ltob) {
obj l = ac, o; int n = 0, i; unsigned char *s;
while (ispair(l)) { l = cdr(l); ++n; } cku(l);
o = bytevector_obj(allocbytevector(n, 0));
s = bytevectorbytes(o);
for (i = 0, l = ac; i < n; ++i, l = cdr(l)) {
obj x = car(l); ck8(x);
s[i] = byte_from_obj(x);
}
ac = o;
gonexti();
}
define_instruction(stol) {
obj l = null_obj(); int n;
cks(ac); n = stringlen(ac);
@ -3366,6 +3436,14 @@ static int rds_char(obj port)
return c;
}
static int rds_byte(obj port)
{
char buf[3]; int b;
buf[0] = iportgetc(port); buf[1] = iportgetc(port); buf[2] = 0;
b = (int)strtoul(buf, NULL, 16);
return b;
}
static int rds_int(obj port)
{
char buf[60], *p = buf, *e = p+59;
@ -3484,6 +3562,16 @@ static obj *rds_sexp(obj *r, obj *sp, obj *hp)
if (c == 's') ra = hpushstr(sp-r, newstring(cbdata(pcb)));
else ra = mksymbol(internsym(cbdata(pcb)));
freecb(pcb);
} break;
case 'b': {
cbuf_t *pcb = newcb();
size_t n = rds_size(port), i;
for (i = 0; i < n; ++i) {
int x = rds_byte(port);
cbputc(x, pcb);
}
ra = hpushu8v(sp-r, newbytevector((unsigned char *)cbdata(pcb), (int)cblen(pcb)));
freecb(pcb);
}
}
return hp;

7
i.h
View file

@ -420,6 +420,12 @@ declare_instruction(vlen, "V3", 0, "vector-length", '1',
declare_instruction(vget, "V4", 0, "vector-ref", '2', AUTOGL)
declare_instruction(vput, "V5", 0, "vector-set!", '3', AUTOGL)
declare_instruction(vcat, "V6", 0, "vector-cat", '2', AUTOGL)
declare_instruction(bvecp, "B0", 0, "bytevector?", '1', AUTOGL)
declare_instruction(bvec, "B1", 1, "bytevector", '#', "%!0.0E1]1")
declare_instruction(bmk, "B2\0'0", 0, "make-bytevector", 'b', AUTOGL)
declare_instruction(blen, "B3", 0, "bytevector-length", '1', AUTOGL)
declare_instruction(bget, "B4", 0, "bytevector-u8-ref", '2', AUTOGL)
declare_instruction(bput, "B5", 0, "bytevector-u8-set!", '3', AUTOGL)
declare_instruction(vtol, "X0", 0, "%vector->list1", '1', AUTOGL)
declare_instruction(ltov, "X1", 0, "list->vector", '1', AUTOGL)
declare_instruction(stol, "X2", 0, "%string->list1", '1', AUTOGL)
@ -430,6 +436,7 @@ declare_instruction(itos, "X6\0'(i10)", 0, "fixnum->string", 'b',
declare_instruction(stoi, "X7\0'(i10)", 0, "string->fixnum", 'b', AUTOGL)
declare_instruction(ctoi, "X8", 0, "char->integer", '1', AUTOGL)
declare_instruction(itoc, "X9", 0, "integer->char", '1', AUTOGL)
declare_instruction(ltob, "E1", 0, "list->bytevector", '1', AUTOGL)
declare_instruction(jtos, "E6", 0, "flonum->string", '1', AUTOGL)
declare_instruction(stoj, "E7", 0, "string->flonum", '1', AUTOGL)
declare_instruction(ntos, "E8\0'(i10)", 0, "number->string", 'b', AUTOGL)

4149
k.c
View file

File diff suppressed because it is too large Load diff

10
src/k.sf
View file

@ -731,6 +731,11 @@
(write-string s port))]
[else (write-char x port)]))
(define (write-serialized-byte x port)
(let ([s (fixnum->string x 16)])
(if (fx=? (string-length s) 1) (write-char #\0 port))
(write-string s port)))
(define (write-serialized-size n port)
(write-string (fixnum->string n 10) port)
(write-char #\: port))
@ -771,6 +776,11 @@
(write-serialized-size (string-length x) port)
(do ([i 0 (fx+ i 1)]) [(fx=? i (string-length x))]
(write-serialized-char (string-ref x i) port))]
[(bytevector? x)
(write-char #\b port)
(write-serialized-size (bytevector-length x) port)
(do ([i 0 (fx+ i 1)]) [(fx=? i (bytevector-length x))]
(write-serialized-byte (bytevector-u8-ref x i) port))]
[(symbol? x)
(write-char #\y port)
(let ([x (symbol->string x)])

19
src/s.scm
View file

@ -826,7 +826,18 @@
; Bytevectors
;---------------------------------------------------------------------------------------------
;TBD
; (bytevector? x)
; (make-bytevector n (u8 0))
; (bytevector u8 ...)
; (bytevector-length b)
; (bytevector-u8-ref b i)
; (bytevector-u8-set! b i u8)
;bytevector-copy
;bytevector-copy!
;bytevector-append
;utf8->string
;string->utf8
;---------------------------------------------------------------------------------------------
@ -962,7 +973,11 @@
;read-error?
;file-error?
(define (error msg . args) (%panic msg args)) ; should work for now
(define (error msg . args)
(%panic msg args)) ; should work for now
(define (read-error msg . args)
(%panic msg args)) ; should work for now
;---------------------------------------------------------------------------------------------