Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-09 14:07:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2019-02-28 09:43:58 -05:00
parent d9f63a85b4
commit f64d429ab8
5 changed files with 67 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
include/cyclone/runtime.h
View file

@ -400,6 +400,9 @@ object Cyc_fast_div(void *data, object ptr, object x, object y);
object Cyc_fast_list_2(object ptr, object x, object y);
object Cyc_fast_list_3(object ptr, object a1, object a2, object a3);
object Cyc_fast_list_4(object ptr, object a1, object a2, object a3, object a4);
object Cyc_fast_vector_2(object ptr, object a1, object a2);
object Cyc_fast_vector_3(object ptr, object a1, object a2, object a3);
object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3, object a4);
object Cyc_bit_unset(void *data, object n1, object n2);
object Cyc_bit_set(void *data, object n1, object n2);
object Cyc_num_op_va_list(void *data, int argc,

4
include/cyclone/types.h
View file

@ -1049,6 +1049,10 @@ typedef struct {
} vector_type;
typedef vector_type *vector;
typedef struct { vector_type v; object arr[2]; } vector_2_type;
typedef struct { vector_type v; object arr[3]; } vector_3_type;
typedef struct { vector_type v; object arr[4]; } vector_4_type;
/** Create a new vector in the nursery */
#define make_empty_vector(v) \
vector_type v; \

42
runtime.c
View file

@ -1319,6 +1319,48 @@ object Cyc_fast_list_4(object ptr, object a1, object a2, object a3, object a4)
return ptr;
}
object Cyc_fast_vector_2(object ptr, object a1, object a2)
{
vector_2_type *v = (vector_2_type *)ptr;
v->v.hdr.mark = gc_color_red;
v->v.hdr.grayed = 0;
v->v.tag = vector_tag;
v->v.num_elements = 2;
v->v.elements = v->arr;
v->v.elements[0] = a1;
v->v.elements[1] = a2;
return ptr;
}
object Cyc_fast_vector_3(object ptr, object a1, object a2, object a3)
{
vector_3_type *v = (vector_3_type *)ptr;
v->v.hdr.mark = gc_color_red;
v->v.hdr.grayed = 0;
v->v.tag = vector_tag;
v->v.num_elements = 3;
v->v.elements = v->arr;
v->v.elements[0] = a1;
v->v.elements[1] = a2;
v->v.elements[2] = a3;
return ptr;
}
object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3, object a4)
{
vector_4_type *v = (vector_4_type *)ptr;
v->v.hdr.mark = gc_color_red;
v->v.hdr.grayed = 0;
v->v.tag = vector_tag;
v->v.num_elements = 4;
v->v.elements = v->arr;
v->v.elements[0] = a1;
v->v.elements[1] = a2;
v->v.elements[2] = a3;
v->v.elements[3] = a4;
return ptr;
}
// Internal function, do not use this anywhere outside the runtime
object Cyc_heap_alloc_port(void *data, port_type *stack_p)
{

12
scheme/cyclone/primitives.sld
View file

@ -122,6 +122,9 @@
Cyc-default-exception-handler
Cyc-current-exception-handler
cons
Cyc-fast-vector-2
Cyc-fast-vector-3
Cyc-fast-vector-4
Cyc-fast-list-1
Cyc-fast-list-2
Cyc-fast-list-3
@ -262,6 +265,9 @@
(Cyc-default-exception-handler 1 1)
(Cyc-current-exception-handler 0 0)
(cons 2 2)
(Cyc-fast-vector-2 2 2)
(Cyc-fast-vector-3 3 3)
(Cyc-fast-vector-4 4 4)
(Cyc-fast-list-1 1 1)
(Cyc-fast-list-2 2 2)
(Cyc-fast-list-3 3 3)
@ -648,6 +654,9 @@
((eq? p 'eof-object?) "Cyc_is_eof_object")
((eq? p 'symbol?) "Cyc_is_symbol")
((eq? p 'cons) "set_pair_as_expr")
((eq? p 'Cyc-fast-vector-2) "Cyc_fast_vector_2")
((eq? p 'Cyc-fast-vector-3) "Cyc_fast_vector_3")
((eq? p 'Cyc-fast-vector-4) "Cyc_fast_vector_4")
((eq? p 'Cyc-fast-list-1) "set_cell_as_expr")
((eq? p 'Cyc-fast-list-2) "Cyc_fast_list_2")
((eq? p 'Cyc-fast-list-3) "Cyc_fast_list_3")
@ -761,6 +770,9 @@
(cond
((eq? p 'cons) "pair_type")
((eq? p 'cell) "pair_type")
((eq? p 'Cyc-fast-vector-2) "vector_2_type")
((eq? p 'Cyc-fast-vector-3) "vector_3_type")
((eq? p 'Cyc-fast-vector-4) "vector_4_type")
((eq? p 'Cyc-fast-list-1) "pair_type")
((eq? p 'Cyc-fast-list-2) "list_2_type")
((eq? p 'Cyc-fast-list-3) "list_3_type")

6
scheme/cyclone/transforms.sld
View file

@ -1097,6 +1097,12 @@ if (acc) {
(cons 'Cyc-fast-member (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'assoc) (= (length ast) 3))
(cons 'Cyc-fast-assoc (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'vector) (= (length ast) 3))
(cons 'Cyc-fast-vector-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'vector) (= (length ast) 4))
(cons 'Cyc-fast-vector-3 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'vector) (= (length ast) 5))
(cons 'Cyc-fast-vector-4 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'list) (= (length ast) 2))
(cons 'Cyc-fast-list-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'list) (= (length ast) 3))