summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--altoslib/AltosTelemetryMegaData.java4
-rw-r--r--src/scheme/Makefile4
-rw-r--r--src/scheme/Makefile-inc3
-rw-r--r--src/scheme/README2
-rw-r--r--src/scheme/ao_scheme.h54
-rw-r--r--src/scheme/ao_scheme_builtin.c67
-rw-r--r--src/scheme/ao_scheme_builtin.txt7
-rw-r--r--src/scheme/ao_scheme_cons.c2
-rw-r--r--src/scheme/ao_scheme_const.scheme (renamed from src/scheme/ao_scheme_const.lisp)2
-rw-r--r--src/scheme/ao_scheme_eval.c8
-rw-r--r--src/scheme/ao_scheme_float.c6
-rw-r--r--src/scheme/ao_scheme_mem.c1
-rw-r--r--src/scheme/ao_scheme_poly.c4
-rw-r--r--src/scheme/ao_scheme_read.c54
-rw-r--r--src/scheme/ao_scheme_read.h1
-rw-r--r--src/scheme/test/ao_scheme_test.c2
16 files changed, 178 insertions, 43 deletions
diff --git a/altoslib/AltosTelemetryMegaData.java b/altoslib/AltosTelemetryMegaData.java
index 7ef9c637..f5961c8c 100644
--- a/altoslib/AltosTelemetryMegaData.java
+++ b/altoslib/AltosTelemetryMegaData.java
@@ -24,7 +24,9 @@ public class AltosTelemetryMegaData extends AltosTelemetryStandard {
int v_batt() { return int16(6); }
int v_pyro() { return int16(8); }
- int sense(int i) { int v = uint8(10+i); return v << 4 | v >> 8; }
+
+ /* pyro sense values are sent in 8 bits, expand to 12 bits */
+ int sense(int i) { int v = uint8(10+i); return (v << 4) | (v >> 4); }
int ground_pres() { return int32(16); }
int ground_accel() { return int16(20); }
diff --git a/src/scheme/Makefile b/src/scheme/Makefile
index ea94c1c0..dc36dde1 100644
--- a/src/scheme/Makefile
+++ b/src/scheme/Makefile
@@ -5,8 +5,8 @@ clean:
+cd test && make clean
rm -f ao_scheme_const.h ao_scheme_builtin.h
-ao_scheme_const.h: ao_scheme_const.lisp make-const/ao_scheme_make_const
- make-const/ao_scheme_make_const -o $@ ao_scheme_const.lisp
+ao_scheme_const.h: ao_scheme_const.scheme make-const/ao_scheme_make_const
+ make-const/ao_scheme_make_const -o $@ ao_scheme_const.scheme
ao_scheme_builtin.h: ao_scheme_make_builtin ao_scheme_builtin.txt
nickle ao_scheme_make_builtin ao_scheme_builtin.txt > $@
diff --git a/src/scheme/Makefile-inc b/src/scheme/Makefile-inc
index d23ee3d7..1a080a4e 100644
--- a/src/scheme/Makefile-inc
+++ b/src/scheme/Makefile-inc
@@ -15,7 +15,8 @@ SCHEME_SRCS=\
ao_scheme_rep.c \
ao_scheme_save.c \
ao_scheme_stack.c \
- ao_scheme_error.c
+ ao_scheme_error.c \
+ ao_scheme_vector.c
SCHEME_HDRS=\
ao_scheme.h \
diff --git a/src/scheme/README b/src/scheme/README
index 98932b44..a18457fd 100644
--- a/src/scheme/README
+++ b/src/scheme/README
@@ -5,6 +5,6 @@ This follows the R7RS with the following known exceptions:
* No dynamic-wind or exceptions
* No environments
* No ports
-* No syntax-rules; (have classic macros)
+* No syntax-rules
* No record types
* No libraries
diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h
index 4589f8a5..89616617 100644
--- a/src/scheme/ao_scheme.h
+++ b/src/scheme/ao_scheme.h
@@ -31,7 +31,7 @@
typedef uint16_t ao_poly;
typedef int16_t ao_signed_poly;
-#ifdef AO_SCHEME_SAVE
+#if AO_SCHEME_SAVE
struct ao_scheme_os_save {
ao_poly atoms;
@@ -77,6 +77,9 @@ extern uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4)))
#ifndef AO_SCHEME_POOL
#define AO_SCHEME_POOL 3072
#endif
+#ifndef AO_SCHEME_POOL_EXTRA
+#define AO_SCHEME_POOL_EXTRA 0
+#endif
extern uint8_t ao_scheme_pool[AO_SCHEME_POOL + AO_SCHEME_POOL_EXTRA] __attribute__((aligned(4)));
#endif
@@ -101,7 +104,8 @@ extern uint8_t ao_scheme_pool[AO_SCHEME_POOL + AO_SCHEME_POOL_EXTRA] __attribut
#define AO_SCHEME_BOOL 10
#define AO_SCHEME_BIGINT 11
#define AO_SCHEME_FLOAT 12
-#define AO_SCHEME_NUM_TYPE 13
+#define AO_SCHEME_VECTOR 13
+#define AO_SCHEME_NUM_TYPE 14
/* Leave two bits for types to use as they please */
#define AO_SCHEME_OTHER_TYPE_MASK 0x3f
@@ -189,6 +193,13 @@ struct ao_scheme_float {
float value;
};
+struct ao_scheme_vector {
+ uint8_t type;
+ uint8_t pad1;
+ uint16_t length;
+ ao_poly vals[];
+};
+
#if __BYTE_ORDER == __LITTLE_ENDIAN
static inline uint32_t
ao_scheme_int_bigint(int32_t i) {
@@ -497,6 +508,18 @@ ao_scheme_poly_float(ao_poly poly)
float
ao_scheme_poly_number(ao_poly p);
+static inline ao_poly
+ao_scheme_vector_poly(struct ao_scheme_vector *v)
+{
+ return ao_scheme_poly(v, AO_SCHEME_OTHER);
+}
+
+static inline struct ao_scheme_vector *
+ao_scheme_poly_vector(ao_poly poly)
+{
+ return ao_scheme_ref(poly);
+}
+
/* memory functions */
extern int ao_scheme_collects[2];
@@ -677,6 +700,32 @@ void
ao_scheme_bigint_write(ao_poly i);
extern const struct ao_scheme_type ao_scheme_bigint_type;
+
+/* vector */
+
+void
+ao_scheme_vector_write(ao_poly v);
+
+void
+ao_scheme_vector_display(ao_poly v);
+
+struct ao_scheme_vector *
+ao_scheme_vector_alloc(uint16_t length, ao_poly fill);
+
+ao_poly
+ao_scheme_vector_get(ao_poly v, ao_poly i);
+
+ao_poly
+ao_scheme_vector_set(ao_poly v, ao_poly i, ao_poly p);
+
+struct ao_scheme_vector *
+ao_scheme_list_to_vector(struct ao_scheme_cons *cons);
+
+struct ao_scheme_cons *
+ao_scheme_vector_to_list(struct ao_scheme_vector *vector);
+
+extern const struct ao_scheme_type ao_scheme_vector_type;
+
/* prim */
void
ao_scheme_poly_write(ao_poly p);
@@ -745,6 +794,7 @@ char *
ao_scheme_args_name(uint8_t args);
/* read */
+extern int ao_scheme_read_list;
extern struct ao_scheme_cons *ao_scheme_read_cons;
extern struct ao_scheme_cons *ao_scheme_read_cons_tail;
extern struct ao_scheme_cons *ao_scheme_read_stack;
diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c
index 49f218f6..ae96df7f 100644
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -267,7 +267,6 @@ ao_scheme_do_write(struct ao_scheme_cons *cons)
if (cons)
printf(" ");
}
- printf("\n");
return _ao_scheme_bool_true;
}
@@ -636,7 +635,7 @@ ao_scheme_do_collect(struct ao_scheme_cons *cons)
int free;
(void) cons;
free = ao_scheme_collect(AO_SCHEME_COLLECT_FULL);
- return ao_scheme_int_poly(free);
+ return ao_scheme_integer_poly(free);
}
ao_poly
@@ -751,7 +750,7 @@ ao_poly
ao_scheme_do_listp(struct ao_scheme_cons *cons)
{
ao_poly v;
- if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
+ if (!ao_scheme_check_argc(_ao_scheme_atom_list3f, cons, 1, 1))
return AO_SCHEME_NIL;
v = ao_scheme_arg(cons, 0);
for (;;) {
@@ -864,5 +863,67 @@ ao_scheme_do_jiffies_per_second(struct ao_scheme_cons *cons)
return (ao_scheme_int_poly(AO_SCHEME_JIFFIES_PER_SECOND));
}
+ao_poly
+ao_scheme_do_vector(struct ao_scheme_cons *cons)
+{
+ return ao_scheme_vector_poly(ao_scheme_list_to_vector(cons));
+}
+
+ao_poly
+ao_scheme_do_vector_ref(struct ao_scheme_cons *cons)
+{
+ if (!ao_scheme_check_argc(_ao_scheme_atom_vector2dref, cons, 2, 2))
+ return AO_SCHEME_NIL;
+ if (!ao_scheme_check_argt(_ao_scheme_atom_vector2dref, cons, 0, AO_SCHEME_VECTOR, 0))
+ return AO_SCHEME_NIL;
+ return ao_scheme_vector_get(ao_scheme_arg(cons, 0), ao_scheme_arg(cons, 1));
+}
+
+ao_poly
+ao_scheme_do_vector_set(struct ao_scheme_cons *cons)
+{
+ if (!ao_scheme_check_argc(_ao_scheme_atom_vector2dset21, cons, 3, 3))
+ return AO_SCHEME_NIL;
+ if (!ao_scheme_check_argt(_ao_scheme_atom_vector2dset21, cons, 0, AO_SCHEME_VECTOR, 0))
+ return AO_SCHEME_NIL;
+ return ao_scheme_vector_set(ao_scheme_arg(cons, 0), ao_scheme_arg(cons, 1), ao_scheme_arg(cons, 2));
+}
+
+ao_poly
+ao_scheme_do_list_to_vector(struct ao_scheme_cons *cons)
+{
+ if (!ao_scheme_check_argc(_ao_scheme_atom_list2d3evector, cons, 1, 1))
+ return AO_SCHEME_NIL;
+ if (!ao_scheme_check_argt(_ao_scheme_atom_list2d3evector, cons, 0, AO_SCHEME_CONS, 0))
+ return AO_SCHEME_NIL;
+ return ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(ao_scheme_arg(cons, 0))));
+}
+
+ao_poly
+ao_scheme_do_vector_to_list(struct ao_scheme_cons *cons)
+{
+ if (!ao_scheme_check_argc(_ao_scheme_atom_vector2d3elist, cons, 1, 1))
+ return AO_SCHEME_NIL;
+ if (!ao_scheme_check_argt(_ao_scheme_atom_vector2d3elist, cons, 0, AO_SCHEME_VECTOR, 0))
+ return AO_SCHEME_NIL;
+ return ao_scheme_cons_poly(ao_scheme_vector_to_list(ao_scheme_poly_vector(ao_scheme_arg(cons, 0))));
+}
+
+ao_poly
+ao_scheme_do_vector_length(struct ao_scheme_cons *cons)
+{
+ if (!ao_scheme_check_argc(_ao_scheme_atom_vector2d3elist, cons, 1, 1))
+ return AO_SCHEME_NIL;
+ if (!ao_scheme_check_argt(_ao_scheme_atom_vector2d3elist, cons, 0, AO_SCHEME_VECTOR, 0))
+ return AO_SCHEME_NIL;
+ return ao_scheme_integer_poly(ao_scheme_poly_vector(ao_scheme_arg(cons, 0))->length);
+}
+
+ao_poly
+ao_scheme_do_vectorp(struct ao_scheme_cons *cons)
+{
+ return ao_scheme_do_typep(AO_SCHEME_VECTOR, cons);
+}
+
#define AO_SCHEME_BUILTIN_FUNCS
#include "ao_scheme_builtin.h"
diff --git a/src/scheme/ao_scheme_builtin.txt b/src/scheme/ao_scheme_builtin.txt
index cb65e252..e7b3d75c 100644
--- a/src/scheme/ao_scheme_builtin.txt
+++ b/src/scheme/ao_scheme_builtin.txt
@@ -66,3 +66,10 @@ f_lambda finitep finite?
f_lambda infinitep infinite?
f_lambda inexactp inexact?
f_lambda sqrt
+f_lambda vector_ref vector-ref
+f_lambda vector_set vector-set!
+f_lambda vector
+f_lambda list_to_vector list->vector
+f_lambda vector_to_list vector->list
+f_lambda vector_length vector-length
+f_lambda vectorp vector?
diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c
index 03dad956..21ee10cc 100644
--- a/src/scheme/ao_scheme_cons.c
+++ b/src/scheme/ao_scheme_cons.c
@@ -195,7 +195,7 @@ ao_scheme_cons_length(struct ao_scheme_cons *cons)
int len = 0;
while (cons) {
len++;
- cons = ao_scheme_poly_cons(cons->cdr);
+ cons = ao_scheme_cons_cdr(cons);
}
return len;
}
diff --git a/src/scheme/ao_scheme_const.lisp b/src/scheme/ao_scheme_const.scheme
index 422bdd63..ab6a309a 100644
--- a/src/scheme/ao_scheme_const.lisp
+++ b/src/scheme/ao_scheme_const.scheme
@@ -641,7 +641,7 @@
(char-whitespace? #\space)
(define (char->integer c) c)
-(define (integer->char c) char-integer)
+(define integer->char char->integer)
(define (char-upcase c) (if (char-lower-case? c) (+ c (- #\A #\a)) c))
diff --git a/src/scheme/ao_scheme_eval.c b/src/scheme/ao_scheme_eval.c
index 9b3cf63e..907ecf0b 100644
--- a/src/scheme/ao_scheme_eval.c
+++ b/src/scheme/ao_scheme_eval.c
@@ -108,13 +108,7 @@ ao_scheme_eval_sexpr(void)
DBGI("..frame "); DBG_POLY(ao_scheme_frame_poly(ao_scheme_frame_current)); DBG("\n");
ao_scheme_v = ao_scheme_atom_get(ao_scheme_v);
/* fall through */
- case AO_SCHEME_BOOL:
- case AO_SCHEME_INT:
- case AO_SCHEME_BIGINT:
- case AO_SCHEME_FLOAT:
- case AO_SCHEME_STRING:
- case AO_SCHEME_BUILTIN:
- case AO_SCHEME_LAMBDA:
+ default:
ao_scheme_stack->state = eval_val;
break;
}
diff --git a/src/scheme/ao_scheme_float.c b/src/scheme/ao_scheme_float.c
index 541f0264..99249030 100644
--- a/src/scheme/ao_scheme_float.c
+++ b/src/scheme/ao_scheme_float.c
@@ -39,6 +39,10 @@ const struct ao_scheme_type ao_scheme_float_type = {
.name = "float",
};
+#ifndef FLOAT_FORMAT
+#define FLOAT_FORMAT "%g"
+#endif
+
void
ao_scheme_float_write(ao_poly p)
{
@@ -54,7 +58,7 @@ ao_scheme_float_write(ao_poly p)
printf("+");
printf("inf.0");
} else
- printf ("%g", f->value);
+ printf (FLOAT_FORMAT, v);
}
float
diff --git a/src/scheme/ao_scheme_mem.c b/src/scheme/ao_scheme_mem.c
index acc726c8..fe4bc4f5 100644
--- a/src/scheme/ao_scheme_mem.c
+++ b/src/scheme/ao_scheme_mem.c
@@ -467,6 +467,7 @@ static const struct ao_scheme_type * const ao_scheme_types[AO_SCHEME_NUM_TYPE] =
[AO_SCHEME_BOOL] = &ao_scheme_bool_type,
[AO_SCHEME_BIGINT] = &ao_scheme_bigint_type,
[AO_SCHEME_FLOAT] = &ao_scheme_float_type,
+ [AO_SCHEME_VECTOR] = &ao_scheme_vector_type,
};
static int
diff --git a/src/scheme/ao_scheme_poly.c b/src/scheme/ao_scheme_poly.c
index d726321c..553585db 100644
--- a/src/scheme/ao_scheme_poly.c
+++ b/src/scheme/ao_scheme_poly.c
@@ -68,6 +68,10 @@ static const struct ao_scheme_funcs ao_scheme_funcs[AO_SCHEME_NUM_TYPE] = {
.write = ao_scheme_float_write,
.display = ao_scheme_float_write,
},
+ [AO_SCHEME_VECTOR] = {
+ .write = ao_scheme_vector_write,
+ .display = ao_scheme_vector_display
+ },
};
static const struct ao_scheme_funcs *
diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c
index 6b1e9d66..9ed54b9f 100644
--- a/src/scheme/ao_scheme_read.c
+++ b/src/scheme/ao_scheme_read.c
@@ -151,7 +151,7 @@ static const uint16_t lex_classes[128] = {
static int lex_unget_c;
static inline int
-lex_get()
+lex_get(void)
{
int c;
if (lex_unget_c) {
@@ -244,7 +244,7 @@ lex_quoted(void)
}
}
-#define AO_SCHEME_TOKEN_MAX 32
+#define AO_SCHEME_TOKEN_MAX 128
static char token_string[AO_SCHEME_TOKEN_MAX];
static int32_t token_int;
@@ -340,6 +340,8 @@ _lex(void)
add_token(c);
end_token();
return BOOL;
+ case '(':
+ return OPEN_VECTOR;
case '\\':
for (;;) {
int alphabetic;
@@ -470,36 +472,40 @@ static inline int lex(void)
static int parse_token;
+int ao_scheme_read_list;
struct ao_scheme_cons *ao_scheme_read_cons;
struct ao_scheme_cons *ao_scheme_read_cons_tail;
struct ao_scheme_cons *ao_scheme_read_stack;
+static int ao_scheme_read_state;
#define READ_IN_QUOTE 0x01
#define READ_SAW_DOT 0x02
#define READ_DONE_DOT 0x04
+#define READ_SAW_VECTOR 0x08
static int
-push_read_stack(int cons, int read_state)
+push_read_stack(int read_state)
{
RDBGI("push read stack %p 0x%x\n", ao_scheme_read_cons, read_state);
RDBG_IN();
- if (cons) {
+ if (ao_scheme_read_list) {
ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons),
ao_scheme__cons(ao_scheme_int_poly(read_state),
ao_scheme_cons_poly(ao_scheme_read_stack)));
if (!ao_scheme_read_stack)
return 0;
- }
+ } else
+ ao_scheme_read_state = read_state;
ao_scheme_read_cons = NULL;
ao_scheme_read_cons_tail = NULL;
return 1;
}
static int
-pop_read_stack(int cons)
+pop_read_stack(void)
{
int read_state = 0;
- if (cons) {
+ if (ao_scheme_read_list) {
ao_scheme_read_cons = ao_scheme_poly_cons(ao_scheme_read_stack->car);
ao_scheme_read_stack = ao_scheme_poly_cons(ao_scheme_read_stack->cdr);
read_state = ao_scheme_poly_int(ao_scheme_read_stack->car);
@@ -512,6 +518,7 @@ pop_read_stack(int cons)
ao_scheme_read_cons = 0;
ao_scheme_read_cons_tail = 0;
ao_scheme_read_stack = 0;
+ read_state = ao_scheme_read_state;
}
RDBG_OUT();
RDBGI("pop read stack %p %d\n", ao_scheme_read_cons, read_state);
@@ -523,19 +530,20 @@ ao_scheme_read(void)
{
struct ao_scheme_atom *atom;
char *string;
- int cons;
int read_state;
ao_poly v = AO_SCHEME_NIL;
- cons = 0;
+ ao_scheme_read_list = 0;
read_state = 0;
ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = 0;
for (;;) {
parse_token = lex();
- while (parse_token == OPEN) {
- if (!push_read_stack(cons, read_state))
+ while (parse_token == OPEN || parse_token == OPEN_VECTOR) {
+ if (parse_token == OPEN_VECTOR)
+ read_state |= READ_SAW_VECTOR;
+ if (!push_read_stack(read_state))
return AO_SCHEME_NIL;
- cons++;
+ ao_scheme_read_list++;
read_state = 0;
parse_token = lex();
}
@@ -543,7 +551,7 @@ ao_scheme_read(void)
switch (parse_token) {
case END:
default:
- if (cons)
+ if (ao_scheme_read_list)
ao_scheme_error(AO_SCHEME_EOF, "unexpected end of file");
return _ao_scheme_atom_eof;
break;
@@ -577,9 +585,9 @@ ao_scheme_read(void)
case QUASIQUOTE:
case UNQUOTE:
case UNQUOTE_SPLICING:
- if (!push_read_stack(cons, read_state))
+ if (!push_read_stack(read_state))
return AO_SCHEME_NIL;
- cons++;
+ ao_scheme_read_list++;
read_state = READ_IN_QUOTE;
switch (parse_token) {
case QUOTE:
@@ -597,16 +605,18 @@ ao_scheme_read(void)
}
break;
case CLOSE:
- if (!cons) {
+ if (!ao_scheme_read_list) {
v = AO_SCHEME_NIL;
break;
}
v = ao_scheme_cons_poly(ao_scheme_read_cons);
- --cons;
- read_state = pop_read_stack(cons);
+ --ao_scheme_read_list;
+ read_state = pop_read_stack();
+ if (read_state & READ_SAW_VECTOR)
+ v = ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(v)));
break;
case DOT:
- if (!cons) {
+ if (!ao_scheme_read_list) {
ao_scheme_error(AO_SCHEME_INVALID, ". outside of cons");
return AO_SCHEME_NIL;
}
@@ -620,7 +630,7 @@ ao_scheme_read(void)
/* loop over QUOTE ends */
for (;;) {
- if (!cons)
+ if (!ao_scheme_read_list)
return v;
if (read_state & READ_DONE_DOT) {
@@ -647,8 +657,8 @@ ao_scheme_read(void)
break;
v = ao_scheme_cons_poly(ao_scheme_read_cons);
- --cons;
- read_state = pop_read_stack(cons);
+ --ao_scheme_read_list;
+ read_state = pop_read_stack();
}
}
return v;
diff --git a/src/scheme/ao_scheme_read.h b/src/scheme/ao_scheme_read.h
index e9508835..e10a7d05 100644
--- a/src/scheme/ao_scheme_read.h
+++ b/src/scheme/ao_scheme_read.h
@@ -32,6 +32,7 @@
# define FLOAT 10
# define DOT 11
# define BOOL 12
+# define OPEN_VECTOR 13
/*
* character classes
diff --git a/src/scheme/test/ao_scheme_test.c b/src/scheme/test/ao_scheme_test.c
index 15c71203..686e7169 100644
--- a/src/scheme/test/ao_scheme_test.c
+++ b/src/scheme/test/ao_scheme_test.c
@@ -78,7 +78,7 @@ ao_scheme_getc(void)
return getc(ao_scheme_file);
if (newline) {
- if (ao_scheme_read_stack)
+ if (ao_scheme_read_list)
printf("+ ");
else
printf("> ");
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 17:00:55 +0000