rusefi
/
bldc
mirror of https://github.com/rusefi/bldc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Lisp

This commit is contained in:
Benjamin Vedder 2022-01-21 10:52:56 +01:00
parent 1b802ebe8f
commit 2d28ccbb05
44 changed files with 2833 additions and 2393 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
commands.c
View File

@ -58,11 +58,7 @@
// Threads
static THD_FUNCTION(blocking_thread, arg);
#ifdef USE_LISPBM
static THD_WORKING_AREA(blocking_thread_wa, 6000);
#else
static THD_WORKING_AREA(blocking_thread_wa, 2048);
#endif
static THD_WORKING_AREA(blocking_thread_wa, 3000);
static thread_t *blocking_tp;
// Private variables

34
lispBM/include/bytecode.h
View File

@ -1,34 +0,0 @@
/*
Copyright 2020 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef BYTECODE_H_
#define BYTECODE_H_
typedef struct {
char* symbol_str;
VALUE symbol_indirection;
} symbol_indirection_t;
typedef struct {
unsigned int code_size;
uint8_t *code;
unsigned int num_indirections;
symbol_indirection_t *indirections;
} bytecode_t;
#endif

22
lispBM/include/compression.h
View File

@ -1,5 +1,5 @@
/*
Copyright 2019 Joel Svensson svenssonjoel@yahoo.se
Copyright 2019, 2022 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -30,8 +30,16 @@ typedef struct {
char *src;
} decomp_state;
#define DECOMP_BUFF_SIZE 32
extern void compression_init_state(decomp_state *s, char *src);
typedef struct {
decomp_state ds;
char decomp_buff[DECOMP_BUFF_SIZE];
int decomp_bytes;
int buff_pos;
} tokenizer_compressed_state_t;
extern void lbm_init_compression_state(decomp_state *s, char *src);
/*
Compress performs destructive changes to
@ -40,11 +48,13 @@ extern void compression_init_state(decomp_state *s, char *src);
Compress returns an array that caller must free
*/
extern char *compression_compress(char *string, uint32_t *res_size);
extern int compression_decompress_incremental(decomp_state *s, char *dest_buff, uint32_t dest_n);
extern bool compression_decompress(char *dest, uint32_t dest_n, char *src);
extern char *lbm_compress(char *string, uint32_t *res_size);
extern int lbm_decompress_incremental(decomp_state *s, char *dest_buff, uint32_t dest_n);
extern bool lbm_decompress(char *dest, uint32_t dest_n, char *src);
/* parse compressed code */
extern VALUE compression_parse(char *bytes);
extern void lbm_create_char_stream_from_compressed(tokenizer_compressed_state_t *ts,
lbm_tokenizer_char_stream_t *str,
char *bytes);
#endif

24
lispBM/include/ec_eval.h
View File

@ -1,24 +0,0 @@
/*
Copyright 2020 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef _EC_EVAL_H_
#define _EC_EVAL_H_
extern VALUE ec_eval_program(VALUE prg);
extern VALUE ec_eval_get_env(void);
#endif

21
lispBM/include/env.h
View File

@ -20,14 +20,17 @@
#include "lispbm_types.h"
extern int env_init(void);
extern VALUE *env_get_global_ptr(void);
extern VALUE env_copy_shallow(VALUE env);
extern VALUE env_lookup(VALUE sym, VALUE env);
extern VALUE env_set(VALUE env, VALUE key, VALUE val);
extern VALUE env_modify_binding(VALUE env, VALUE key, VALUE val);
extern VALUE env_build_params_args(VALUE params,
VALUE args,
VALUE env0);
//environment interface
extern int lbm_init_env(void);
extern lbm_value *lbm_get_env_ptr(void);
extern lbm_value lbm_env_copy_shallow(lbm_value env);
extern lbm_value lbm_env_lookup(lbm_value sym, lbm_value env);
extern lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val);
extern lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val);
// Internal use
extern lbm_value lbm_env_build_params_args(lbm_value params,
lbm_value args,
lbm_value env0);
#endif

62
lispBM/include/eval_cps.h
View File

@ -1,5 +1,5 @@
/*
Copyright 2018, 2020, 2021 Joel Svensson svenssonjoel@yahoo.se
Copyright 2018, 2020, 2021, 2022 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -28,18 +28,18 @@
typedef struct eval_context_s{
VALUE program;
VALUE curr_exp;
VALUE curr_env;
VALUE mailbox; /*massage passing mailbox */
VALUE r;
lbm_value program;
lbm_value curr_exp;
lbm_value curr_env;
lbm_value mailbox; /*massage passing mailbox */
lbm_value r;
bool done;
bool app_cont;
stack K;
lbm_stack_t K;
/* Process control */
uint32_t timestamp;
uint32_t sleep_us;
CID id;
lbm_cid id;
/* List structure */
struct eval_context_s *prev;
struct eval_context_s *next;
@ -48,38 +48,40 @@ typedef struct eval_context_s{
typedef void (*ctx_fun)(eval_context_t *, void*, void*);
/* Common interface */
extern VALUE eval_cps_get_env(void);
extern lbm_value eval_cps_get_env(void);
/* Concurrent interface */
extern int eval_cps_init(void);
extern bool eval_cps_remove_done_ctx(CID cid, VALUE *v);
extern VALUE eval_cps_wait_ctx(CID cid);
extern CID eval_cps_program(VALUE lisp);
extern CID eval_cps_program_ext(VALUE lisp, unsigned int stack_size);
extern void eval_cps_run_eval(void);
extern int lbm_eval_init(void);
extern bool lbm_remove_done_ctx(lbm_cid cid, lbm_value *v);
extern lbm_value lbm_wait_ctx(lbm_cid cid);
extern lbm_cid lbm_eval_program(lbm_value lisp);
extern lbm_cid lbm_eval_program_ext(lbm_value lisp, unsigned int stack_size);
extern void lbm_run_eval(void);
extern void eval_cps_pause_eval(void);
extern void eval_cps_step_eval(void);
extern void eval_cps_continue_eval(void);
extern void eval_cps_kill_eval(void);
extern uint32_t eval_cps_current_state(void);
extern void lbm_pause_eval(void);
extern void lbm_step_eval(void);
extern void lbm_continue_eval(void);
extern void lbm_kill_eval(void);
extern uint32_t lbm_get_eval_state(void);
/* statistics interface */
extern void eval_cps_running_iterator(ctx_fun f, void*, void*);
extern void eval_cps_blocked_iterator(ctx_fun f, void*, void*);
extern void eval_cps_done_iterator(ctx_fun f, void*, void*);
extern void lbm_running_iterator(ctx_fun f, void*, void*);
extern void lbm_blocked_iterator(ctx_fun f, void*, void*);
extern void lbm_done_iterator(ctx_fun f, void*, void*);
/*
Callback routines for sleeping and timestamp generation.
Depending on target platform these will be implemented in different ways.
Todo: It may become necessary to also add a mutex callback.
*/
extern void eval_cps_set_usleep_callback(void (*fptr)(uint32_t));
extern void eval_cps_set_timestamp_us_callback(uint32_t (*fptr)(void));
extern void eval_cps_set_ctx_done_callback(void (*fptr)(eval_context_t *));
extern void lbm_set_usleep_callback(void (*fptr)(uint32_t));
extern void lbm_set_timestamp_us_callback(uint32_t (*fptr)(void));
extern void lbm_set_ctx_done_callback(void (*fptr)(eval_context_t *));
/* loading of programs interface */
extern lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer);
extern lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer);
extern lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol);
extern lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol);
/* Non concurrent interface: */
extern int eval_cps_init_nc(unsigned int stack_size);
extern void eval_cps_del_nc(void);
extern VALUE eval_cps_program_nc(VALUE lisp);
#endif

36
lispBM/include/exp_kind.h
View File

@ -35,27 +35,27 @@ typedef enum {
EXP_LET,
EXP_AND,
EXP_OR
} exp_kind;
} lbm_exp_kind;
static inline exp_kind exp_kind_of(VALUE exp) {
static inline lbm_exp_kind lbm_exp_kind_of(lbm_value exp) {
switch (type_of(exp)) {
case VAL_TYPE_SYMBOL:
if (!is_special(exp))
switch (lbm_type_of(exp)) {
case LBM_VAL_TYPE_SYMBOL:
if (!lbm_is_special(exp))
return EXP_VARIABLE;
// fall through
case PTR_TYPE_BOXED_F:
case PTR_TYPE_BOXED_U:
case PTR_TYPE_BOXED_I:
case VAL_TYPE_I:
case VAL_TYPE_U:
case VAL_TYPE_CHAR:
case PTR_TYPE_ARRAY:
case LBM_PTR_TYPE_BOXED_F:
case LBM_PTR_TYPE_BOXED_U:
case LBM_PTR_TYPE_BOXED_I:
case LBM_VAL_TYPE_I:
case LBM_VAL_TYPE_U:
case LBM_VAL_TYPE_CHAR:
case LBM_PTR_TYPE_ARRAY:
return EXP_SELF_EVALUATING;
case PTR_TYPE_CONS: {
VALUE head = car(exp);
if (type_of(head) == VAL_TYPE_SYMBOL) {
UINT sym_id = dec_sym(head);
case LBM_PTR_TYPE_CONS: {
lbm_value head = lbm_car(exp);
if (lbm_type_of(head) == LBM_VAL_TYPE_SYMBOL) {
lbm_uint sym_id = lbm_dec_sym(head);
switch(sym_id){
case SYM_AND: return EXP_AND;
case SYM_OR: return EXP_OR;
@ -69,8 +69,8 @@ static inline exp_kind exp_kind_of(VALUE exp) {
}
} // end if symbol
if (type_of(cdr(exp)) == VAL_TYPE_SYMBOL &&
dec_sym(cdr(exp)) == SYM_NIL) {
if (lbm_type_of(lbm_cdr(exp)) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(lbm_cdr(exp)) == SYM_NIL) {
return EXP_NO_ARGS;
} else {
return EXP_APPLICATION;

14
lispBM/include/extensions.h
View File

@ -23,14 +23,14 @@
#include "heap.h"
#include "lispbm_types.h"
typedef VALUE (*extension_fptr)(VALUE*,UINT);
typedef lbm_value (*extension_fptr)(lbm_value*,lbm_uint);
extern int extensions_init(void);
extern extension_fptr extensions_lookup(UINT sym);
extern bool extensions_add(char *sym_str, extension_fptr ext);
extern int lbm_extensions_init(void);
extern extension_fptr lbm_get_extension(lbm_uint sym);
extern bool lbm_add_extension(char *sym_str, extension_fptr ext);
static inline bool is_extension(VALUE exp) {
return ((type_of(exp) == VAL_TYPE_SYMBOL) &&
(extensions_lookup(dec_sym(exp)) != NULL));
static inline bool lbm_is_extension(lbm_value exp) {
return ((lbm_type_of(exp) == LBM_VAL_TYPE_SYMBOL) &&
(lbm_get_extension(lbm_dec_sym(exp)) != NULL));
}
#endif

2
lispBM/include/fundamental.h
View File

@ -18,7 +18,7 @@
#ifndef _FUNDAMENTAL_H_
#define _FUNDAMENTAL_H_
extern VALUE fundamental_exec(VALUE* args, UINT nargs, VALUE op);
extern lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op);
#endif

320
lispBM/include/heap.h
View File

@ -1,5 +1,5 @@
/*
Copyright 2018 Joel Svensson svenssonjoel@yahoo.se
Copyright 2018 , 2022 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -21,6 +21,7 @@
#include <string.h>
#include "lispbm_types.h"
#include "symrepr.h"
#include "streams.h"
/*
Planning for a more space efficient heap representation.
@ -180,48 +181,44 @@ Aux bits could be used for storing vector size. Up to 30bits should be available
1111 AA00 0000 0000 0000 0000 0000 0000 : 0xFC00 0000 (AA bits left unused for now, future heap growth?)
*/
#define CONS_CELL_SIZE 8
#define ADDRESS_SHIFT 3
#define VAL_SHIFT 4
#define LBM_CONS_CELL_SIZE 8
#define LBM_ADDRESS_SHIFT 3
#define LBM_VAL_SHIFT 4
#define PTR_MASK 0x00000001u
#define PTR_BIT 0x00000001u
#define PTR_VAL_MASK 0x03FFFFF8u
#define PTR_TYPE_MASK 0xFC000000u
#define LBM_PTR_MASK 0x00000001u
#define LBM_PTR_BIT 0x00000001u
#define LBM_PTR_VAL_MASK 0x03FFFFF8u
#define LBM_PTR_TYPE_MASK 0xFC000000u
#define PTR_TYPE_CONS 0x10000000u
#define PTR_TYPE_BOXED_U 0x20000000u
#define PTR_TYPE_BOXED_I 0x30000000u
#define PTR_TYPE_BOXED_F 0x40000000u
#define PTR_TYPE_SYMBOL_INDIRECTION 0x50000000u
#define LBM_PTR_TYPE_CONS 0x10000000u
#define LBM_PTR_TYPE_BOXED_U 0x20000000u
#define LBM_PTR_TYPE_BOXED_I 0x30000000u
#define LBM_PTR_TYPE_BOXED_F 0x40000000u
#define PTR_TYPE_BYTECODE 0xC0000000u
#define PTR_TYPE_ARRAY 0xD0000000u
#define PTR_TYPE_REF 0xE0000000u
#define PTR_TYPE_STREAM 0xF0000000u
#define LBM_PTR_TYPE_ARRAY 0xD0000000u
#define LBM_PTR_TYPE_REF 0xE0000000u
#define LBM_PTR_TYPE_STREAM 0xF0000000u
#define GC_MASK 0x00000002u
#define GC_MARKED 0x00000002u
#define LBM_GC_MASK 0x00000002u
#define LBM_GC_MARKED 0x00000002u
#define VAL_MASK 0xFFFFFFF0u
#define VAL_TYPE_MASK 0x0000000Cu
#define LBM_VAL_MASK 0xFFFFFFF0u
#define LBM_VAL_TYPE_MASK 0x0000000Cu
// gc ptr
#define VAL_TYPE_SYMBOL 0x00000000u // 00 0 0
#define VAL_TYPE_CHAR 0x00000004u // 01 0 0
#define VAL_TYPE_U 0x00000008u // 11 0 0
#define VAL_TYPE_I 0x0000000Cu // 10 0 0
#define MAX_CONSTANTS 256
#define LBM_VAL_TYPE_SYMBOL 0x00000000u // 00 0 0
#define LBM_VAL_TYPE_CHAR 0x00000004u // 01 0 0
#define LBM_VAL_TYPE_U 0x00000008u // 11 0 0
#define LBM_VAL_TYPE_I 0x0000000Cu // 10 0 0
typedef struct {
VALUE car;
VALUE cdr;
} cons_t;
lbm_value car;
lbm_value cdr;
} lbm_cons_t;
typedef struct {
cons_t *heap;
lbm_cons_t *heap;
bool malloced; // allocated by heap_init
VALUE freelist; // list of free cons cells.
lbm_value freelist; // list of free cons cells.
unsigned int heap_size; // In number of cells.
unsigned int heap_bytes; // In bytes.
@ -233,218 +230,203 @@ typedef struct {
unsigned int gc_marked; // Number of cells marked by mark phase.
unsigned int gc_recovered; // Number of cells recovered by sweep phase.
unsigned int gc_recovered_arrays;// Number of arrays recovered by sweep.
} heap_state_t;
} lbm_heap_state_t;
typedef struct {
TYPE elt_type; // Type of elements: VAL_TYPE_FLOAT, U, I or CHAR
lbm_type elt_type; // Type of elements: VAL_TYPE_FLOAT, U, I or CHAR
uint32_t size; // Number of elements
} array_header_t;
} lbm_array_header_t;
extern int heap_init(cons_t *addr, unsigned int num_cells);
extern unsigned int heap_num_free(void);
extern unsigned int heap_num_allocated(void);
extern unsigned int heap_size(void);
extern VALUE heap_allocate_cell(TYPE type);
extern unsigned int heap_size_bytes(void);
extern int lbm_heap_init(lbm_cons_t *addr, unsigned int num_cells);
extern unsigned int lbm_heap_num_free(void);
extern unsigned int lbm_heap_num_allocated(void);
extern unsigned int lbm_heap_size(void);
extern lbm_value lbm_heap_allocate_cell(lbm_type type);
extern unsigned int lbm_heap_size_bytes(void);
extern char *dec_str(VALUE);
extern UINT dec_as_u(VALUE);
extern INT dec_as_i(VALUE);
extern FLOAT dec_as_f(VALUE);
extern char *lbm_dec_str(lbm_value);
extern lbm_stream_t *lbm_dec_stream(lbm_value val);
extern lbm_uint lbm_dec_as_u(lbm_value);
extern lbm_int lbm_dec_as_i(lbm_value);
extern lbm_float lbm_dec_as_f(lbm_value);
extern lbm_value lbm_cons(lbm_value car, lbm_value cdr);
extern lbm_value lbm_car(lbm_value cons);
extern lbm_value lbm_cdr(lbm_value cons);
extern bool lbm_set_car(lbm_value c, lbm_value v);
extern bool lbm_set_cdr(lbm_value c, lbm_value v);
// List functions
extern unsigned int lbm_list_length(lbm_value c);
extern lbm_value lbm_list_reverse(lbm_value list);
extern lbm_value lbm_list_copy(lbm_value list);
extern lbm_value lbm_list_append(lbm_value list1, lbm_value list2);
extern VALUE cons(VALUE car, VALUE cdr);
extern VALUE car(VALUE cons);
extern VALUE cdr(VALUE cons);
extern bool set_car(VALUE c, VALUE v);
extern bool set_cdr(VALUE c, VALUE v);
extern unsigned int length(VALUE c);
extern VALUE reverse(VALUE list);
extern VALUE copy(VALUE list);
// State and statistics
extern void heap_get_state(heap_state_t *);
extern void lbm_get_heap_state(lbm_heap_state_t *);
// Garbage collection
extern int heap_perform_gc(VALUE env);
extern int heap_perform_gc_aux(VALUE env, VALUE env2, VALUE exp, VALUE exp2, VALUE exp3, UINT *aux_data, unsigned int aux_size);
extern void gc_state_inc(void);
extern int gc_mark_freelist(void);
extern int gc_mark_phase(VALUE v);
extern int gc_mark_aux(UINT *data, unsigned int n);
extern int gc_sweep_phase(void);
extern int lbm_perform_gc(lbm_value env);
extern int lbm_perform_gc_aux(lbm_value env, lbm_value env2, lbm_value exp, lbm_value exp2, lbm_value exp3, lbm_uint *aux_data, unsigned int aux_size);
extern void lbm_gc_state_inc(void);
extern int lbm_gc_mark_freelist(void);
extern int lbm_gc_mark_phase(lbm_value v);
extern int lbm_gc_mark_aux(lbm_uint *data, unsigned int n);
extern int lbm_gc_sweep_phase(void);
// Array functionality
extern int heap_allocate_array(VALUE *res, unsigned int size, TYPE type);
extern int lbm_heap_allocate_array(lbm_value *res, unsigned int size, lbm_type type);
static inline TYPE val_type(VALUE x) {
return (x & VAL_TYPE_MASK);
static inline lbm_type lbm_type_of(lbm_value x) {
return (x & LBM_PTR_MASK) ? (x & LBM_PTR_TYPE_MASK) : (x & LBM_VAL_TYPE_MASK);
}
static inline TYPE ptr_type(VALUE p) {
return (p & PTR_TYPE_MASK);
static inline bool lbm_is_ptr(lbm_value x) {
return (x & LBM_PTR_MASK);
}
static inline TYPE type_of(VALUE x) {
return (x & PTR_MASK) ? (x & PTR_TYPE_MASK) : (x & VAL_TYPE_MASK);
static inline lbm_value lbm_enc_cons_ptr(lbm_uint x) {
return ((x << LBM_ADDRESS_SHIFT) | LBM_PTR_TYPE_CONS | LBM_PTR_BIT);
}
static inline bool is_ptr(VALUE x) {
return (x & PTR_MASK);
static inline lbm_uint lbm_dec_ptr(lbm_value p) {
return ((LBM_PTR_VAL_MASK & p) >> LBM_ADDRESS_SHIFT);
}
static inline VALUE enc_cons_ptr(UINT x) {
return ((x << ADDRESS_SHIFT) | PTR_TYPE_CONS | PTR_BIT);
static inline lbm_value lbm_set_ptr_type(lbm_value p, lbm_type t) {
return (LBM_PTR_VAL_MASK & p) | t | LBM_PTR_BIT;
}
static inline VALUE enc_symbol_indirection(UINT x) {
return ((x << ADDRESS_SHIFT) | PTR_TYPE_SYMBOL_INDIRECTION | PTR_BIT);
static inline lbm_value lbm_enc_sym(uint32_t s) {
return (s << LBM_VAL_SHIFT) | LBM_VAL_TYPE_SYMBOL;
}
static inline UINT dec_symbol_indirection(VALUE p) {
return ((PTR_VAL_MASK & p) >> ADDRESS_SHIFT);
static inline lbm_value lbm_enc_i(lbm_int x) {
return ((lbm_uint)x << LBM_VAL_SHIFT) | LBM_VAL_TYPE_I;
}
static inline UINT dec_ptr(VALUE p) {
return ((PTR_VAL_MASK & p) >> ADDRESS_SHIFT);
static inline lbm_value lbm_enc_u(lbm_uint x) {
return (x << LBM_VAL_SHIFT) | LBM_VAL_TYPE_U;
}
static inline VALUE set_ptr_type(VALUE p, TYPE t) {
return (PTR_VAL_MASK & p) | t | PTR_BIT;
static inline lbm_value lbm_enc_I(lbm_int x) {
lbm_value i = lbm_cons((lbm_uint)x, lbm_enc_sym(SYM_BOXED_I_TYPE));
if (lbm_type_of(i) == LBM_VAL_TYPE_SYMBOL) return i;
return lbm_set_ptr_type(i, LBM_PTR_TYPE_BOXED_I);
}
static inline VALUE enc_sym(uint32_t s) {
return (s << VAL_SHIFT) | VAL_TYPE_SYMBOL;
static inline lbm_value lbm_enc_U(lbm_uint x) {
lbm_value u = lbm_cons(x, lbm_enc_sym(SYM_BOXED_U_TYPE));
if (lbm_type_of(u) == LBM_VAL_TYPE_SYMBOL) return u;
return lbm_set_ptr_type(u, LBM_PTR_TYPE_BOXED_U);
}
static inline VALUE enc_i(INT x) {
return ((UINT)x << VAL_SHIFT) | VAL_TYPE_I;
}
static inline VALUE enc_u(UINT x) {
return (x << VAL_SHIFT) | VAL_TYPE_U;
}
static inline VALUE enc_I(INT x) {
VALUE i = cons((UINT)x, enc_sym(SYM_BOXED_I_TYPE));
if (type_of(i) == VAL_TYPE_SYMBOL) return i;
return set_ptr_type(i, PTR_TYPE_BOXED_I);
}
static inline VALUE enc_U(UINT x) {
VALUE u = cons(x, enc_sym(SYM_BOXED_U_TYPE));
if (type_of(u) == VAL_TYPE_SYMBOL) return u;
return set_ptr_type(u, PTR_TYPE_BOXED_U);
}
static inline VALUE enc_F(FLOAT x) {
UINT t;
static inline lbm_value lbm_enc_F(lbm_float x) {
lbm_uint t;
memcpy(&t, &x, sizeof(float));
VALUE f = cons(t, enc_sym(SYM_BOXED_F_TYPE));
if (type_of(f) == VAL_TYPE_SYMBOL) return f;
return set_ptr_type(f, PTR_TYPE_BOXED_F);
lbm_value f = lbm_cons(t, lbm_enc_sym(SYM_BOXED_F_TYPE));
if (lbm_type_of(f) == LBM_VAL_TYPE_SYMBOL) return f;
return lbm_set_ptr_type(f, LBM_PTR_TYPE_BOXED_F);
}
static inline VALUE enc_char(char x) {
return ((UINT)x << VAL_SHIFT) | VAL_TYPE_CHAR;
static inline lbm_value lbm_enc_char(char x) {
return ((lbm_uint)x << LBM_VAL_SHIFT) | LBM_VAL_TYPE_CHAR;
}
static inline INT dec_i(VALUE x) {
return (INT)x >> VAL_SHIFT;
static inline lbm_int lbm_dec_i(lbm_value x) {
return (lbm_int)x >> LBM_VAL_SHIFT;
}
static inline UINT dec_u(VALUE x) {
return x >> VAL_SHIFT;
static inline lbm_uint lbm_dec_u(lbm_value x) {
return x >> LBM_VAL_SHIFT;
}
static inline char dec_char(VALUE x) {
return (char)(x >> VAL_SHIFT);
static inline char lbm_dec_char(lbm_value x) {
return (char)(x >> LBM_VAL_SHIFT);
}
static inline UINT dec_sym(VALUE x) {
return x >> VAL_SHIFT;
static inline lbm_uint lbm_dec_sym(lbm_value x) {
return x >> LBM_VAL_SHIFT;
}
static inline FLOAT dec_F(VALUE x) { // Use only when knowing that x is a VAL_TYPE_F
FLOAT f_tmp;
UINT tmp = car(x);
memcpy(&f_tmp, &tmp, sizeof(FLOAT));
static inline lbm_float lbm_dec_F(lbm_value x) { // Use only when knowing that x is a VAL_TYPE_F
lbm_float f_tmp;
lbm_uint tmp = lbm_car(x);
memcpy(&f_tmp, &tmp, sizeof(lbm_float));
return f_tmp;
}
static inline UINT dec_U(VALUE x) {
return car(x);
static inline lbm_uint lbm_dec_U(lbm_value x) {
return lbm_car(x);
}
static inline INT dec_I(VALUE x) {
return (INT)car(x);
static inline lbm_int lbm_dec_I(lbm_value x) {
return (lbm_int)lbm_car(x);
}
static inline VALUE val_set_gc_mark(VALUE x) {
return x | GC_MARKED;
static inline lbm_value lbm_set_gc_mark(lbm_value x) {
return x | LBM_GC_MARKED;
}
static inline VALUE val_clr_gc_mark(VALUE x) {
return x & ~GC_MASK;
static inline lbm_value lbm_clr_gc_mark(lbm_value x) {
return x & ~LBM_GC_MASK;
}
static inline bool val_get_gc_mark(VALUE x) {
return x & GC_MASK;
static inline bool lbm_get_gc_mark(lbm_value x) {
return x & LBM_GC_MASK;
}
static inline bool is_number(VALUE x) {
UINT t = type_of(x);
return ((t == VAL_TYPE_I) ||
(t == VAL_TYPE_U) ||
(t == PTR_TYPE_BOXED_I) ||
(t == PTR_TYPE_BOXED_U) ||
(t == PTR_TYPE_BOXED_F));
static inline bool lbm_is_number(lbm_value x) {
lbm_uint t = lbm_type_of(x);
return ((t == LBM_VAL_TYPE_I) ||
(t == LBM_VAL_TYPE_U) ||
(t == LBM_PTR_TYPE_BOXED_I) ||
(t == LBM_PTR_TYPE_BOXED_U) ||
(t == LBM_PTR_TYPE_BOXED_F));
}
static inline bool is_special(VALUE symrep) {
return ((type_of(symrep) == VAL_TYPE_SYMBOL) &&
(dec_sym(symrep) < MAX_SPECIAL_SYMBOLS));
static inline bool lbm_is_special(lbm_value symrep) {
return ((lbm_type_of(symrep) == LBM_VAL_TYPE_SYMBOL) &&
(lbm_dec_sym(symrep) < MAX_SPECIAL_SYMBOLS));
}
static inline bool is_fundamental(VALUE symrep) {
return ((type_of(symrep) == VAL_TYPE_SYMBOL) &&
(dec_sym(symrep) >= FUNDAMENTALS_START) &&
(dec_sym(symrep) <= FUNDAMENTALS_END));
static inline bool lbm_is_fundamental(lbm_value symrep) {
return ((lbm_type_of(symrep) == LBM_VAL_TYPE_SYMBOL) &&
(lbm_dec_sym(symrep) >= FUNDAMENTALS_START) &&
(lbm_dec_sym(symrep) <= FUNDAMENTALS_END));
}
static inline bool is_closure(VALUE exp) {
return ((type_of(exp) == PTR_TYPE_CONS) &&
(type_of(car(exp)) == VAL_TYPE_SYMBOL) &&
(dec_sym(car(exp)) == SYM_CLOSURE));
static inline bool lbm_is_closure(lbm_value exp) {
return ((lbm_type_of(exp) == LBM_PTR_TYPE_CONS) &&
(lbm_type_of(lbm_car(exp)) == LBM_VAL_TYPE_SYMBOL) &&
(lbm_dec_sym(lbm_car(exp)) == SYM_CLOSURE));
}
static inline bool is_match_binder(VALUE exp) {
return ((type_of(exp) == PTR_TYPE_CONS) &&
(type_of(car(exp)) == VAL_TYPE_SYMBOL) &&
((dec_sym(car(exp)) == SYM_MATCH_ANY) ||
(dec_sym(car(exp)) == SYM_MATCH_I28) ||
(dec_sym(car(exp)) == SYM_MATCH_U28) ||
(dec_sym(car(exp)) == SYM_MATCH_FLOAT) ||
(dec_sym(car(exp)) == SYM_MATCH_CONS)));
static inline bool lbm_is_match_binder(lbm_value exp) {
return ((lbm_type_of(exp) == LBM_PTR_TYPE_CONS) &&
(lbm_type_of(lbm_car(exp)) == LBM_VAL_TYPE_SYMBOL) &&
((lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_ANY) ||
(lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_I28) ||
(lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_U28) ||
(lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_FLOAT) ||
(lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_CONS)));
}
static inline bool is_symbol(VALUE exp) {
return (type_of(exp) == VAL_TYPE_SYMBOL);
static inline bool lbm_is_symbol(lbm_value exp) {
return (lbm_type_of(exp) == LBM_VAL_TYPE_SYMBOL);
}
static inline bool is_symbol_indirection(VALUE exp) {
return (type_of(exp) == PTR_TYPE_SYMBOL_INDIRECTION);
static inline bool lbm_is_symbol_nil(lbm_value exp) {
return (lbm_is_symbol(exp) && lbm_dec_sym(exp) == SYM_NIL);
}
static inline bool is_symbol_nil(VALUE exp) {
return (is_symbol(exp) && dec_sym(exp) == SYM_NIL);
static inline bool lbm_is_symbol_eval(lbm_value exp) {
return (lbm_is_symbol(exp) && lbm_dec_sym(exp) == SYM_EVAL);
}
static inline bool is_symbol_eval(VALUE exp) {
return (is_symbol(exp) && dec_sym(exp) == SYM_EVAL);
}
static inline bool is_symbol_merror(VALUE exp) {
return (is_symbol(exp) && dec_sym(exp) == SYM_MERROR);
static inline bool lbm_is_symbol_merror(lbm_value exp) {
return (lbm_is_symbol(exp) && lbm_dec_sym(exp) == SYM_MERROR);
}
#endif

6
lispBM/include/lispbm.h
View File

@ -30,8 +30,8 @@
#include "lispbm_memory.h"
#include "env.h"
extern int lispbm_init(cons_t *heap_storage, uint32_t heap_size,
uint32_t *memory, uint32_t memory_size,
uint32_t *memory_bitmap, uint32_t bitmap_size);
extern int lbm_init(lbm_cons_t *heap_storage, uint32_t heap_size,
uint32_t *memory, uint32_t memory_size,
uint32_t *memory_bitmap, uint32_t bitmap_size);
#endif

47
lispBM/include/lispbm_memory.h
View File

@ -23,6 +23,7 @@
doing within the guts of lispBM as I want it to be possible on
running on the bare metal.
** This is already done!
Later perhaps things such as the symbol table with symbol mappings
should also be located on this managed memory area. Symbols,
however, are never freed after being created in lispBM. Currently I
@ -76,33 +77,33 @@
//#define MEMORY_SIZE_64BYTES_TIMES_X(X) (64*(X))
//#define MEMORY_BITMAP_SIZE(X) (4*(X))
#define MEMORY_SIZE_64BYTES_TIMES_X(X) (16*(X))
#define MEMORY_BITMAP_SIZE(X) (X)
#define LBM_MEMORY_SIZE_64BYTES_TIMES_X(X) (16*(X))
#define LBM_MEMORY_BITMAP_SIZE(X) (X)
#define MEMORY_SIZE_512 MEMORY_SIZE_64BYTES_TIMES_X(8)
#define MEMORY_SIZE_1K MEMORY_SIZE_64BYTES_TIMES_X(16)
#define MEMORY_SIZE_2K MEMORY_SIZE_64BYTES_TIMES_X(32)
#define MEMORY_SIZE_4K MEMORY_SIZE_64BYTES_TIMES_X(64)
#define MEMORY_SIZE_8K MEMORY_SIZE_64BYTES_TIMES_X(128)
#define MEMORY_SIZE_16K MEMORY_SIZE_64BYTES_TIMES_X(256)
#define MEMORY_SIZE_32K MEMORY_SIZE_64BYTES_TIMES_X(512)
#define MEMORY_SIZE_1M MEMORY_SIZE_64BYTES_TIMES_X(16384)
#define LBM_MEMORY_SIZE_512 LBM_MEMORY_SIZE_64BYTES_TIMES_X(8)
#define LBM_MEMORY_SIZE_1K LBM_MEMORY_SIZE_64BYTES_TIMES_X(16)
#define LBM_MEMORY_SIZE_2K LBM_MEMORY_SIZE_64BYTES_TIMES_X(32)
#define LBM_MEMORY_SIZE_4K LBM_MEMORY_SIZE_64BYTES_TIMES_X(64)
#define LBM_MEMORY_SIZE_8K LBM_MEMORY_SIZE_64BYTES_TIMES_X(128)
#define LBM_MEMORY_SIZE_16K LBM_MEMORY_SIZE_64BYTES_TIMES_X(256)
#define LBM_MEMORY_SIZE_32K LBM_MEMORY_SIZE_64BYTES_TIMES_X(512)
#define LBM_MEMORY_SIZE_1M LBM_MEMORY_SIZE_64BYTES_TIMES_X(16384)
#define MEMORY_BITMAP_SIZE_512 MEMORY_BITMAP_SIZE(8)
#define MEMORY_BITMAP_SIZE_1K MEMORY_BITMAP_SIZE(16)
#define MEMORY_BITMAP_SIZE_2K MEMORY_BITMAP_SIZE(32)
#define MEMORY_BITMAP_SIZE_4K MEMORY_BITMAP_SIZE(64)
#define MEMORY_BITMAP_SIZE_8K MEMORY_BITMAP_SIZE(128)
#define MEMORY_BITMAP_SIZE_16K MEMORY_BITMAP_SIZE(256)
#define MEMORY_BITMAP_SIZE_32K MEMORY_BITMAP_SIZE(512)
#define MEMORY_BITMAP_SIZE_1M MEMORY_BITMAP_SIZE(16384)
#define LBM_MEMORY_BITMAP_SIZE_512 LBM_MEMORY_BITMAP_SIZE(8)
#define LBM_MEMORY_BITMAP_SIZE_1K LBM_MEMORY_BITMAP_SIZE(16)
#define LBM_MEMORY_BITMAP_SIZE_2K LBM_MEMORY_BITMAP_SIZE(32)
#define LBM_MEMORY_BITMAP_SIZE_4K LBM_MEMORY_BITMAP_SIZE(64)
#define LBM_MEMORY_BITMAP_SIZE_8K LBM_MEMORY_BITMAP_SIZE(128)
#define LBM_MEMORY_BITMAP_SIZE_16K LBM_MEMORY_BITMAP_SIZE(256)
#define LBM_MEMORY_BITMAP_SIZE_32K LBM_MEMORY_BITMAP_SIZE(512)
#define LBM_MEMORY_BITMAP_SIZE_1M LBM_MEMORY_BITMAP_SIZE(16384)
extern int memory_init(uint32_t *data, uint32_t data_size,
extern int lbm_memory_init(uint32_t *data, uint32_t data_size,
uint32_t *bitmap, uint32_t bitmap_size);
extern uint32_t memory_num_words(void);
extern uint32_t memory_num_free(void);
extern uint32_t *memory_allocate(uint32_t num_words);
extern int memory_free(uint32_t *ptr);
extern uint32_t lbm_memory_num_words(void);
extern uint32_t lbm_memory_num_free(void);
extern uint32_t *lbm_memory_allocate(uint32_t num_words);
extern int lbm_memory_free(uint32_t *ptr);
#endif

24
lispBM/include/lispbm_types.h
View File

@ -22,12 +22,12 @@
#include <stdbool.h>
#include <inttypes.h>
typedef uint32_t VALUE; // A Lisp value.
typedef uint32_t TYPE; // Representation of a type.
typedef uint32_t lbm_value; // A Lisp value.
typedef uint32_t lbm_type; // Representation of a type.
typedef uint32_t UINT;
typedef int32_t INT;
typedef float FLOAT;
typedef uint32_t lbm_uint;
typedef int32_t lbm_int;
typedef float lbm_float;
#define PRI_VALUE PRIu32
#define PRI_TYPE PRIu32
@ -35,7 +35,19 @@ typedef float FLOAT;
#define PRI_INT PRId32
#define PRI_FLOAT "f"
typedef uint16_t CID;
typedef uint16_t lbm_cid;
#define CID_MAX 65535
/* tokenizer */
typedef struct lbm_tcs{
void *state;
bool (*more)(struct lbm_tcs*);
char (*get)(struct lbm_tcs*);
char (*peek)(struct lbm_tcs*, unsigned int);
void (*drop)(struct lbm_tcs*, unsigned int);
} lbm_tokenizer_char_stream_t;
#endif

6
lispBM/include/prelude.h
View File

@ -1,5 +1,5 @@
/*
Copyright 2019 Joel Svensson svenssonjoel@yahoo.se
Copyright 2019, 2022 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -20,8 +20,8 @@
#include "lispbm_types.h"
extern VALUE prelude_load(void);
extern void prelude_load(lbm_tokenizer_string_state_t *,
lbm_tokenizer_char_stream_t *);
#endif

2
lispBM/include/print.h
View File

@ -22,6 +22,6 @@
#include <stdint.h>
#include "lispbm_types.h"
extern int print_value(char *buf,unsigned int len, VALUE t);
extern int lbm_print_value(char *buf,unsigned int len, lbm_value t);
#endif

2
lispBM/include/qq_expand.h
View File

@ -18,6 +18,6 @@
#ifndef _QQ_EXPAND_H
#define _QQ_EXPAND_H
extern VALUE qq_expand(VALUE);
extern lbm_value lbm_qq_expand(lbm_value);
#endif

106
lispBM/include/stack.h
View File

@ -24,99 +24,97 @@
#include "lispbm_types.h"
typedef struct {
UINT* data;
lbm_uint* data;
unsigned int sp;
unsigned int size;
unsigned int max_sp;
} stack;
} lbm_stack_t;
extern int stack_allocate(stack *s, unsigned int stack_size);
extern int stack_create(stack *s, UINT* data, unsigned int size);
extern void stack_free(stack *s);
extern int stack_clear(stack *s);
extern UINT *stack_ptr(stack *s, unsigned int n);
extern int stack_drop(stack *s, unsigned int n);
extern int push_u32(stack *s, UINT val);
extern int push_k(stack *s, VALUE (*k)(VALUE));
extern int pop_u32(stack *s, UINT *val);
extern int pop_k(stack *s, VALUE (**k)(VALUE));
extern int lbm_stack_allocate(lbm_stack_t *s, unsigned int stack_size);
extern int lbm_stack_create(lbm_stack_t *s, lbm_uint* data, unsigned int size);
extern void lbm_stack_free(lbm_stack_t *s);
extern int lbm_stack_clear(lbm_stack_t *s);
extern lbm_uint *lbm_get_stack_ptr(lbm_stack_t *s, unsigned int n);
extern int lbm_stack_drop(lbm_stack_t *s, unsigned int n);
extern int lbm_push_u32(lbm_stack_t *s, lbm_uint val);
extern int lbm_pop_u32(lbm_stack_t *s, lbm_uint *val);
static inline int stack_is_empty(stack *s) {
static inline int lbm_stack_is_empty(lbm_stack_t *s) {
if (s->sp == 0) return 1;
return 0;
}
static inline int stack_arg_ix(stack *s, unsigned int ix, UINT *res) {
if (ix > s->sp-1) return 0;
*res = s->data[s->sp-(ix+1)];
return 1;
}
//static inline int stack_arg_ix(lbm_stack_t *s, unsigned int ix, lbm_uint *res) {
// if (ix > s->sp-1) return 0;
// *res = s->data[s->sp-(ix+1)];
// return 1;
//}
static inline int push_u32_2(stack *s, UINT val0, UINT val1) {
static inline int lbm_push_u32_2(lbm_stack_t *s, lbm_uint val0, lbm_uint val1) {
int res = 1;
res &= push_u32(s,val0);
res &= push_u32(s,val1);
res &= lbm_push_u32(s,val0);
res &= lbm_push_u32(s,val1);
return res;
}
static inline int push_u32_3(stack *s, UINT val0, UINT val1, UINT val2) {
static inline int lbm_push_u32_3(lbm_stack_t *s, lbm_uint val0, lbm_uint val1, lbm_uint val2) {
int res = 1;
res &= push_u32(s,val0);
res &= push_u32(s,val1);
res &= push_u32(s,val2);
res &= lbm_push_u32(s,val0);
res &= lbm_push_u32(s,val1);
res &= lbm_push_u32(s,val2);
return res;
}
static inline int push_u32_4(stack *s, UINT val0, UINT val1, UINT val2, UINT val3) {
static inline int lbm_push_u32_4(lbm_stack_t *s, lbm_uint val0, lbm_uint val1, lbm_uint val2, lbm_uint val3) {
int res = 1;
res &= push_u32(s,val0);
res &= push_u32(s,val1);
res &= push_u32(s,val2);
res &= push_u32(s,val3);
res &= lbm_push_u32(s,val0);
res &= lbm_push_u32(s,val1);
res &= lbm_push_u32(s,val2);
res &= lbm_push_u32(s,val3);
return res;
}
static inline int push_u32_5(stack *s, UINT val0, UINT val1, UINT val2, UINT val3, UINT val4) {
static inline int lbm_push_u32_5(lbm_stack_t *s, lbm_uint val0, lbm_uint val1, lbm_uint val2, lbm_uint val3, lbm_uint val4) {
int res = 1;
res &= push_u32(s,val0);
res &= push_u32(s,val1);
res &= push_u32(s,val2);
res &= push_u32(s,val3);
res &= push_u32(s,val4);
res &= lbm_push_u32(s,val0);
res &= lbm_push_u32(s,val1);
res &= lbm_push_u32(s,val2);
res &= lbm_push_u32(s,val3);
res &= lbm_push_u32(s,val4);
return res;
}
static inline int pop_u32_2(stack *s, UINT *r0, UINT *r1) {
static inline int lbm_pop_u32_2(lbm_stack_t *s, lbm_uint *r0, lbm_uint *r1) {
int res = 1;
res &= pop_u32(s, r0);
res &= pop_u32(s, r1);
res &= lbm_pop_u32(s, r0);
res &= lbm_pop_u32(s, r1);
return res;
}
static inline int pop_u32_3(stack *s, UINT *r0, UINT *r1, UINT *r2) {
static inline int lbm_pop_u32_3(lbm_stack_t *s, lbm_uint *r0, lbm_uint *r1, lbm_uint *r2) {
int res = 1;
res &= pop_u32(s, r0);
res &= pop_u32(s, r1);
res &= pop_u32(s, r2);
res &= lbm_pop_u32(s, r0);
res &= lbm_pop_u32(s, r1);
res &= lbm_pop_u32(s, r2);
return res;
}
static inline int pop_u32_4(stack *s, UINT *r0, UINT *r1, UINT *r2, UINT *r3) {
static inline int lbm_pop_u32_4(lbm_stack_t *s, lbm_uint *r0, lbm_uint *r1, lbm_uint *r2, lbm_uint *r3) {
int res = 1;
res &= pop_u32(s, r0);
res &= pop_u32(s, r1);
res &= pop_u32(s, r2);
res &= pop_u32(s, r3);
res &= lbm_pop_u32(s, r0);
res &= lbm_pop_u32(s, r1);
res &= lbm_pop_u32(s, r2);
res &= lbm_pop_u32(s, r3);
return res;
}
static inline int pop_u32_5(stack *s, UINT *r0, UINT *r1, UINT *r2, UINT *r3, UINT *r4) {
static inline int lbm_pop_u32_5(lbm_stack_t *s, lbm_uint *r0, lbm_uint *r1, lbm_uint *r2, lbm_uint *r3, lbm_uint *r4) {
int res = 1;
res &= pop_u32(s, r0);
res &= pop_u32(s, r1);
res &= pop_u32(s, r2);
res &= pop_u32(s, r3);
res &= pop_u32(s, r4);
res &= lbm_pop_u32(s, r0);
res &= lbm_pop_u32(s, r1);
res &= lbm_pop_u32(s, r2);
res &= lbm_pop_u32(s, r3);
res &= lbm_pop_u32(s, r4);
return res;
}

26
lispBM/include/streams.h
View File

@ -20,22 +20,22 @@
#include "lispbm_types.h"
typedef struct stream_s{
typedef struct lbm_stream_s{
void *state; /* stream implementation dependent state */
VALUE (*more)(struct stream_s*);
VALUE (*get)(struct stream_s*);
VALUE (*peek)(struct stream_s*, VALUE);
VALUE (*drop)(struct stream_s*, VALUE);
VALUE (*put)(struct stream_s*, VALUE);
} stream_t;
lbm_value (*more)(struct lbm_stream_s*);
lbm_value (*get)(struct lbm_stream_s*);
lbm_value (*peek)(struct lbm_stream_s*, lbm_value);
lbm_value (*drop)(struct lbm_stream_s*, lbm_value);
lbm_value (*put)(struct lbm_stream_s*, lbm_value);
} lbm_stream_t;
extern VALUE stream_get(stream_t *str);
extern VALUE stream_more(stream_t *str);
extern VALUE stream_peek(stream_t *str, VALUE n);
extern VALUE stream_drop(stream_t *str, VALUE n);
extern VALUE stream_put(stream_t *str, VALUE v);
extern lbm_value lbm_stream_get(lbm_stream_t *str);
extern lbm_value lbm_stream_more(lbm_stream_t *str);
extern lbm_value lbm_stream_peek(lbm_stream_t *str, lbm_value n);
extern lbm_value lbm_stream_drop(lbm_stream_t *str, lbm_value n);
extern lbm_value lbm_stream_put(lbm_stream_t *str, lbm_value v);
extern VALUE stream_create(stream_t *str);
extern lbm_value lbm_stream_create(lbm_stream_t *str);
#endif

29
lispBM/include/symrepr.h
View File

@ -41,8 +41,8 @@
#define SYM_STACK_ERROR 0xD
#define SYM_DEFINE 0xE
#define SYM_PROGN 0xF
#define SYM_COMMA 0x10
#define SYM_COMMAAT 0x11
#define SYM_READ 0x10
#define SYM_READ_PROGRAM 0x11
#define SYM_DONTCARE 0x12
#define SYM_MATCH 0x13
#define SYM_SEND 0x14
@ -53,7 +53,6 @@
#define SYM_BOXED_U_TYPE 0x22
#define SYM_BOXED_F_TYPE 0x23
#define SYM_REF_TYPE 0x24
#define SYM_STREAM_TYPE 0x25
#define SYM_RECOVERED 0x26
#define SYM_BYTECODE_TYPE 0x27
#define SYM_NONSENSE 0x28
@ -78,6 +77,15 @@
#define SYM_TYPE_REF 0x59
#define SYM_TYPE_STREAM 0x5A
//Relevant for the tokenizer
#define SYM_OPENPAR 0x70
#define SYM_CLOSEPAR 0x71
#define SYM_BACKQUOTE 0x72
#define SYM_COMMA 0x73
#define SYM_COMMAAT 0x74
#define SYM_TOKENIZER_DONE 0x75
#define SYM_DOT 0x76
// Fundamental Operations
#define FUNDAMENTALS_START 0x100
#define SYM_ADD 0x100
@ -90,6 +98,7 @@
#define SYM_LT 0x107
#define SYM_GT 0x108
#define SYM_EVAL 0x109
#define SYM_EVAL_PROGRAM 0x10A
#define SYM_AND 0x110
#define SYM_OR 0x111
@ -124,15 +133,15 @@
#define MAX_SPECIAL_SYMBOLS 4096 // 12bits (highest id allowed is 0xFFFF)
extern int symrepr_addsym(char *, UINT*);
extern int symrepr_addsym_const(char *, UINT*);
extern bool symrepr_init(void);
extern int symrepr_lookup(char *, UINT*);
extern const char* symrepr_lookup_name(UINT);
extern int lbm_add_symbol(char *, lbm_uint*);
extern int lbm_add_symbol_const(char *, lbm_uint*);
extern bool lbm_symrepr_init(void);
extern int lbm_get_symbol_by_name(char *, lbm_uint*);
extern const char* lbm_get_name_by_symbol(lbm_uint);
extern unsigned int symrepr_size(void);
extern unsigned int lbm_get_symbol_table_size(void);
static inline bool symrepr_is_error(UINT symrep){
static inline bool lbm_is_error(lbm_uint symrep){
return (symrep == SYM_RERROR ||
symrep == SYM_TERROR ||
symrep == SYM_RERROR ||

19
lispBM/include/tokpar.h
View File

@ -1,5 +1,5 @@
/*
Copyright 2019 Joel Svensson svenssonjoel@yahoo.se
Copyright 2019, 2022 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -20,15 +20,14 @@
#include "lispbm_types.h"
// TODO: Include the following two lines in some platform header, which then is included here
#include "utils.h"
#define TOKPAR_CHECK_STACK() (utils_stack_left_now() > 350)
typedef struct {
char *str;
unsigned int pos;
} lbm_tokenizer_string_state_t;
VALUE tokpar_parse(char *str);
VALUE tokpar_parse_stream(
bool (*more)(void),
char (*get)(void),
char (*peek)(unsigned int n),
void (*drop)(unsigned int n));
extern void lbm_create_char_stream_from_string(lbm_tokenizer_string_state_t *,
lbm_tokenizer_char_stream_t *,
char *);
extern lbm_value lbm_get_next_token(lbm_tokenizer_char_stream_t *str);
#endif

1
lispBM/lispbm.mk
View File

@ -14,6 +14,7 @@ LISPBMSRC = $(LISPBM)/src/env.c \
$(LISPBM)/src/eval_cps.c \
$(LISPBM)/platform/chibios/src/platform_mutex.c \
$(LISPBM)/lispif.c \
$(LISPBM)/streams.c \
$(LISPBM)/lispif_vesc_extensions.c
LISPBMINC = lispBM \

95
lispBM/lispif.c
View File

@ -33,12 +33,14 @@
#include "lispbm.h"
#define HEAP_SIZE 1024
#define LISP_MEM_SIZE MEMORY_SIZE_8K
#define LISP_MEM_BITMAP_SIZE MEMORY_BITMAP_SIZE_8K
#define LISP_MEM_SIZE LBM_MEMORY_SIZE_8K
#define LISP_MEM_BITMAP_SIZE LBM_MEMORY_BITMAP_SIZE_8K
__attribute__((section(".ram4"))) static cons_t heap[HEAP_SIZE] __attribute__ ((aligned (8)));
__attribute__((section(".ram4"))) static lbm_cons_t heap[HEAP_SIZE] __attribute__ ((aligned (8)));
static uint32_t memory_array[LISP_MEM_SIZE];
static uint32_t bitmap_array[LISP_MEM_BITMAP_SIZE];
static lbm_tokenizer_string_state_t string_tok_state;
static lbm_tokenizer_char_stream_t string_tok;
static thread_t *eval_tp = 0;
static THD_WORKING_AREA(eval_thread_wa, 2048);
@ -57,7 +59,7 @@ static THD_FUNCTION(eval_thread, arg) {
(void)arg;
eval_tp = chThdGetSelfX();
chRegSetThreadName("Lisp Eval");
eval_cps_run_eval();
lbm_run_eval();
}
static void terminal_start(int argc, const char **argv) {
@ -67,23 +69,23 @@ static void terminal_start(int argc, const char **argv) {
char *code = (char*)(0x080A0000);
if (!lisp_thd_running) {
lispbm_init(heap, HEAP_SIZE, memory_array, LISP_MEM_SIZE, bitmap_array, LISP_MEM_BITMAP_SIZE);
lbm_init(heap, HEAP_SIZE, memory_array, LISP_MEM_SIZE, bitmap_array, LISP_MEM_BITMAP_SIZE);
eval_cps_set_timestamp_us_callback(timestamp_callback);
eval_cps_set_usleep_callback(sleep_callback);
lbm_set_timestamp_us_callback(timestamp_callback);
lbm_set_usleep_callback(sleep_callback);
chThdCreateStatic(eval_thread_wa, sizeof(eval_thread_wa), NORMALPRIO, eval_thread, NULL);
lisp_thd_running = true;
} else {
eval_cps_pause_eval();
while (eval_cps_current_state() != EVAL_CPS_STATE_PAUSED) {
lbm_pause_eval();
while (lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
chThdSleepMilliseconds(100);
}
lispbm_init(heap, HEAP_SIZE, memory_array, LISP_MEM_SIZE, bitmap_array, LISP_MEM_BITMAP_SIZE);
lbm_init(heap, HEAP_SIZE, memory_array, LISP_MEM_SIZE, bitmap_array, LISP_MEM_BITMAP_SIZE);
eval_cps_pause_eval();
while (eval_cps_current_state() != EVAL_CPS_STATE_PAUSED) {
lbm_pause_eval();
while (lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
chThdSleepMilliseconds(100);
}
}
@ -92,26 +94,29 @@ static void terminal_start(int argc, const char **argv) {
commands_printf("Parsing %d characters", strlen(code));
VALUE t = tokpar_parse(code);
if (dec_sym(t) == SYM_STACK_ERROR) {
commands_printf("Lisp parser ran out of stack");
} else if (dec_sym(t) == SYM_RERROR) {
commands_printf("Lisp parser error");
} else {
eval_cps_program(t);
eval_cps_continue_eval();
commands_printf("Lisp started");
}
lbm_create_char_stream_from_string(&string_tok_state, &string_tok, code);
lbm_load_and_eval_program(&string_tok);
lbm_continue_eval();
// VALUE t = tokpar_parse(code);
//
// if (dec_sym(t) == SYM_STACK_ERROR) {
// commands_printf("Lisp parser ran out of stack");
// } else if (dec_sym(t) == SYM_RERROR) {
// commands_printf("Lisp parser error");
// } else {
// eval_cps_program(t);
// eval_cps_continue_eval();
// commands_printf("Lisp started");
// }
}
static void terminal_stop(int argc, const char **argv) {
(void)argc;
(void)argv;
eval_cps_pause_eval();
while (eval_cps_current_state() != EVAL_CPS_STATE_PAUSED) {
lbm_pause_eval();
while (lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
chThdSleepMilliseconds(100);
}
}
@ -119,7 +124,7 @@ static void terminal_stop(int argc, const char **argv) {
void print_ctx_info(eval_context_t *ctx, void *arg1, void *arg2) {
(void)arg2;
char outbuf[256];
print_value(outbuf, 256, ctx->r);
lbm_print_value(outbuf, 256, ctx->r);
commands_printf("%s %x %u %u %s", (char*)arg1, (uint32_t)ctx, ctx->id, ctx->K.sp, outbuf );
commands_printf("Stack SP max: %u (Limit: 256)\n", ctx->K.max_sp);
}
@ -131,7 +136,7 @@ static void terminal_stats(int argc, const char **argv) {
char outbuf[256];
heap_state_t heap_state;
lbm_heap_state_t heap_state;
static systime_t time_last = 0;
if (eval_tp) {
@ -144,33 +149,43 @@ static void terminal_stats(int argc, const char **argv) {
}
commands_printf("------------------------------------------------------------\r\n");
commands_printf("Used cons cells: %lu", HEAP_SIZE - heap_num_free());
commands_printf("Free cons cells: %lu", heap_num_free());
heap_get_state(&heap_state);
commands_printf("Used cons cells: %lu", HEAP_SIZE - lbm_heap_num_free());
commands_printf("Free cons cells: %lu", lbm_heap_num_free());
lbm_get_heap_state(&heap_state);
commands_printf("GC counter: %lu", heap_state.gc_num);
commands_printf("Recovered: %lu", heap_state.gc_recovered);
commands_printf("Marked: %lu", heap_state.gc_marked);
commands_printf("Array and symbol string memory:");
commands_printf(" Size: %u 32Bit words", memory_num_words());
commands_printf(" Free: %u 32Bit words", memory_num_free());
commands_printf(" Size: %u 32Bit words", lbm_memory_num_words());
commands_printf(" Free: %u 32Bit words", lbm_memory_num_free());
commands_printf("------------------------------------------------------------");
VALUE curr = *env_get_global_ptr();
lbm_value curr = *lbm_get_env_ptr();
commands_printf("Environment:");
while (type_of(curr) == PTR_TYPE_CONS) {
print_value(outbuf, 256, car(curr));
curr = cdr(curr);
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
lbm_print_value(outbuf, 256, lbm_car(curr));
curr = lbm_cdr(curr);
commands_printf(" %s", outbuf);
}
curr = *lbm_get_env_ptr();
commands_printf("\"Number bindings\":");
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
lbm_value key_val = lbm_car(curr);
if (lbm_type_of(lbm_car(key_val)) == LBM_VAL_TYPE_SYMBOL && lbm_is_number(lbm_cdr(key_val))) {
const char *name = lbm_get_name_by_symbol(lbm_dec_sym(lbm_car(key_val)));
commands_printf(" Name: %s Val: %f", name, (double)lbm_dec_as_f(lbm_cdr(key_val)));
}
curr = lbm_cdr(curr);
}
commands_printf("Runnable:");
eval_cps_running_iterator(print_ctx_info, "RUNNABLE", NULL);
lbm_running_iterator(print_ctx_info, "RUNNABLE", NULL);
commands_printf("Blocked:");
eval_cps_blocked_iterator(print_ctx_info, "BLOCKED", NULL);
lbm_blocked_iterator(print_ctx_info, "BLOCKED", NULL);
commands_printf("Done:");
eval_cps_done_iterator(print_ctx_info, "DONE", NULL);
lbm_done_iterator(print_ctx_info, "DONE", NULL);
commands_printf(" ");
}

443
lispBM/lispif_vesc_extensions.c
View File

@ -37,462 +37,485 @@
// Helpers
static bool is_number_all(VALUE *args, UINT argn) {
for (UINT i = 0;i < argn;i++) {
if (!is_number(args[i])) {
static bool is_number_all(lbm_value *args, lbm_uint argn) {
for (lbm_uint i = 0;i < argn;i++) {
if (!lbm_is_number(args[i])) {
return false;
}
}
return true;
}
#define CHECK_NUMBER_ALL() if (!is_number_all(args, argn)) {return enc_sym(SYM_EERROR);}
#define CHECK_NUMBER_ALL() if (!is_number_all(args, argn)) {return lbm_enc_sym(SYM_EERROR);}
#define CHECK_ARGN(n) if (argn != n) {return enc_sym(SYM_EERROR);}
#define CHECK_ARGN_NUMBER(n) if (argn != n || !is_number_all(args, argn)) {return enc_sym(SYM_EERROR);}
#define CHECK_ARGN_NUMBER(n) if (argn != n || !is_number_all(args, argn)) {return lbm_enc_sym(SYM_EERROR);}
// Various commands
static VALUE ext_print(VALUE *args, UINT argn) {
static lbm_value ext_print(lbm_value *args, lbm_uint argn) {
static char output[256];
for (UINT i = 0; i < argn; i ++) {
VALUE t = args[i];
for (lbm_uint i = 0; i < argn; i ++) {
lbm_value t = args[i];
if (is_ptr(t) && ptr_type(t) == PTR_TYPE_ARRAY) {
array_header_t *array = (array_header_t *)car(t);
if (lbm_is_ptr(t) && lbm_type_of(t) == LBM_PTR_TYPE_ARRAY) {
lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(t);
switch (array->elt_type){
case VAL_TYPE_CHAR:
case LBM_VAL_TYPE_CHAR:
commands_printf("%s", (char*)array + 8);
break;
default:
return enc_sym(SYM_NIL);
return lbm_enc_sym(SYM_NIL);
break;
}
} else if (val_type(t) == VAL_TYPE_CHAR) {
if (dec_char(t) =='\n') {
} else if (lbm_type_of(t) == LBM_VAL_TYPE_CHAR) {
if (lbm_dec_char(t) =='\n') {
commands_printf(" ");
} else {
commands_printf("%c", dec_char(t));
commands_printf("%c", lbm_dec_char(t));
}
} else {
print_value(output, 256, t);
lbm_print_value(output, 256, t);
commands_printf("%s", output);
}
}
return enc_sym(SYM_TRUE);
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_servo(VALUE *args, UINT argn) {
static lbm_value ext_set_servo(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
servo_simple_set_output(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
servo_simple_set_output(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_reset_timeout(VALUE *args, UINT argn) {
static lbm_value ext_reset_timeout(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
timeout_reset();
return enc_sym(SYM_TRUE);
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_get_ppm(VALUE *args, UINT argn) {
static lbm_value ext_get_ppm(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(servodec_get_servo(0));
return lbm_enc_F(servodec_get_servo(0));
}
static VALUE ext_get_encoder(VALUE *args, UINT argn) {
static lbm_value ext_get_encoder(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(encoder_read_deg());
return lbm_enc_F(encoder_read_deg());
}
static VALUE ext_get_vin(VALUE *args, UINT argn) {
static lbm_value ext_get_vin(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_input_voltage_filtered());
return lbm_enc_F(mc_interface_get_input_voltage_filtered());
}
static VALUE ext_select_motor(VALUE *args, UINT argn) {
static lbm_value ext_select_motor(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
int i = dec_as_i(args[0]);
int i = lbm_dec_as_i(args[0]);
if (i != 0 && i != 1 && i != 2) {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
mc_interface_select_motor_thread(i);
return enc_sym(SYM_TRUE);
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_get_selected_motor(VALUE *args, UINT argn) {
static lbm_value ext_get_selected_motor(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_i(mc_interface_motor_now());
return lbm_enc_i(mc_interface_motor_now());
}
static VALUE ext_get_bms_val(VALUE *args, UINT argn) {
VALUE res = enc_sym(SYM_EERROR);
static lbm_value ext_get_bms_val(lbm_value *args, lbm_uint argn) {
lbm_value res = lbm_enc_sym(SYM_EERROR);
if (argn != 1 && argn != 2) {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
char *name = dec_str(args[0]);
char *name = lbm_dec_str(args[0]);
if (!name) {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
bms_values *val = bms_get_values();
if (strcmp(name, "v_tot") == 0) {
res = enc_F(val->v_tot);
res = lbm_enc_F(val->v_tot);
} else if (strcmp(name, "v_charge") == 0) {
res = enc_F(val->v_charge);
res = lbm_enc_F(val->v_charge);
} else if (strcmp(name, "i_in") == 0) {
res = enc_F(val->i_in);
res = lbm_enc_F(val->i_in);
} else if (strcmp(name, "i_in_ic") == 0) {
res = enc_F(val->i_in_ic);
res = lbm_enc_F(val->i_in_ic);
} else if (strcmp(name, "ah_cnt") == 0) {
res = enc_F(val->ah_cnt);
res = lbm_enc_F(val->ah_cnt);
} else if (strcmp(name, "wh_cnt") == 0) {
res = enc_F(val->wh_cnt);
res = lbm_enc_F(val->wh_cnt);
} else if (strcmp(name, "cell_num") == 0) {
res = enc_i(val->cell_num);
res = lbm_enc_i(val->cell_num);
} else if (strcmp(name, "v_cell") == 0) {
if (argn != 2 || !is_number(args[1])) {
return enc_sym(SYM_EERROR);
if (argn != 2 || !lbm_is_number(args[1])) {
return lbm_enc_sym(SYM_EERROR);
}
int c = dec_as_i(args[1]);
int c = lbm_dec_as_i(args[1]);
if (c < 0 || c >= val->cell_num) {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
res = enc_F(val->v_cell[c]);
res = lbm_enc_F(val->v_cell[c]);
} else if (strcmp(name, "bal_state") == 0) {
if (argn != 2 || !is_number(args[1])) {
return enc_sym(SYM_EERROR);
if (argn != 2 || !lbm_is_number(args[1])) {
return lbm_enc_sym(SYM_EERROR);
}
int c = dec_as_i(args[1]);
int c = lbm_dec_as_i(args[1]);
if (c < 0 || c >= val->cell_num) {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
res = enc_i(val->bal_state[c]);
res = lbm_enc_i(val->bal_state[c]);
} else if (strcmp(name, "temp_adc_num") == 0) {
res = enc_i(val->temp_adc_num);
res = lbm_enc_i(val->temp_adc_num);
} else if (strcmp(name, "temps_adc") == 0) {
if (argn != 2 || !is_number(args[1])) {
return enc_sym(SYM_EERROR);
if (argn != 2 || !lbm_is_number(args[1])) {
return lbm_enc_sym(SYM_EERROR);
}
int c = dec_as_i(args[1]);
int c = lbm_dec_as_i(args[1]);
if (c < 0 || c >= val->temp_adc_num) {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
res = enc_F(val->temps_adc[c]);
res = lbm_enc_F(val->temps_adc[c]);
} else if (strcmp(name, "temp_ic") == 0) {
res = enc_F(val->temp_ic);
res = lbm_enc_F(val->temp_ic);
} else if (strcmp(name, "temp_hum") == 0) {
res = enc_F(val->temp_hum);
res = lbm_enc_F(val->temp_hum);
} else if (strcmp(name, "hum") == 0) {
res = enc_F(val->hum);
res = lbm_enc_F(val->hum);
} else if (strcmp(name, "temp_max_cell") == 0) {
res = enc_F(val->temp_max_cell);
res = lbm_enc_F(val->temp_max_cell);
} else if (strcmp(name, "soc") == 0) {
res = enc_F(val->soc);
res = lbm_enc_F(val->soc);
} else if (strcmp(name, "soh") == 0) {
res = enc_F(val->soh);
res = lbm_enc_F(val->soh);
} else if (strcmp(name, "can_id") == 0) {
res = enc_i(val->can_id);
res = lbm_enc_i(val->can_id);
} else if (strcmp(name, "ah_cnt_chg_total") == 0) {
res = enc_F(val->ah_cnt_chg_total);
res = lbm_enc_F(val->ah_cnt_chg_total);
} else if (strcmp(name, "wh_cnt_chg_total") == 0) {
res = enc_F(val->wh_cnt_chg_total);
res = lbm_enc_F(val->wh_cnt_chg_total);
} else if (strcmp(name, "ah_cnt_dis_total") == 0) {
res = enc_F(val->ah_cnt_dis_total);
res = lbm_enc_F(val->ah_cnt_dis_total);
} else if (strcmp(name, "wh_cnt_dis_total") == 0) {
res = enc_F(val->wh_cnt_dis_total);
res = lbm_enc_F(val->wh_cnt_dis_total);
} else if (strcmp(name, "msg_age") == 0) {
res = enc_F(UTILS_AGE_S(val->update_time));
res = lbm_enc_F(UTILS_AGE_S(val->update_time));
}
return res;
}
static VALUE ext_get_adc(VALUE *args, UINT argn) {
static lbm_value ext_get_adc(lbm_value *args, lbm_uint argn) {
CHECK_NUMBER_ALL();
if (argn == 0) {
return enc_F(ADC_VOLTS(ADC_IND_EXT));
return lbm_enc_F(ADC_VOLTS(ADC_IND_EXT));
} else if (argn == 1) {
INT channel = dec_as_i(args[0]);
lbm_int channel = lbm_dec_as_i(args[0]);
if (channel == 0) {
return enc_F(ADC_VOLTS(ADC_IND_EXT));
return lbm_enc_F(ADC_VOLTS(ADC_IND_EXT));
} else if (channel == 1) {
return enc_F(ADC_VOLTS(ADC_IND_EXT2));
return lbm_enc_F(ADC_VOLTS(ADC_IND_EXT2));
} else {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
} else {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
}
static VALUE ext_systime(VALUE *args, UINT argn) {
static lbm_value ext_systime(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_I(chVTGetSystemTimeX());
return lbm_enc_I(chVTGetSystemTimeX());
}
static VALUE ext_secs_since(VALUE *args, UINT argn) {
static lbm_value ext_secs_since(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
return enc_F(UTILS_AGE_S(dec_as_u(args[0])));
return lbm_enc_F(UTILS_AGE_S(lbm_dec_as_u(args[0])));
}
// Motor set commands
static VALUE ext_set_current(VALUE *args, UINT argn) {
static lbm_value ext_set_current(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_current(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_current(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_current_rel(VALUE *args, UINT argn) {
static lbm_value ext_set_current_rel(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_current_rel(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_current_rel(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_duty(VALUE *args, UINT argn) {
static lbm_value ext_set_duty(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_duty(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_duty(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_brake(VALUE *args, UINT argn) {
static lbm_value ext_set_brake(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_brake_current(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_brake_current(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_brake_rel(VALUE *args, UINT argn) {
static lbm_value ext_set_brake_rel(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_brake_current_rel(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_brake_current_rel(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_handbrake(VALUE *args, UINT argn) {
static lbm_value ext_set_handbrake(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_handbrake(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_handbrake(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_handbrake_rel(VALUE *args, UINT argn) {
static lbm_value ext_set_handbrake_rel(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_handbrake_rel(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_handbrake_rel(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_rpm(VALUE *args, UINT argn) {
static lbm_value ext_set_rpm(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_pid_speed(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_pid_speed(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_set_pos(VALUE *args, UINT argn) {
static lbm_value ext_set_pos(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
mc_interface_set_pid_pos(dec_as_f(args[0]));
return enc_sym(SYM_TRUE);
mc_interface_set_pid_pos(lbm_dec_as_f(args[0]));
return lbm_enc_sym(SYM_TRUE);
}
// Motor get commands
static VALUE ext_get_current(VALUE *args, UINT argn) {
static lbm_value ext_get_current(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_tot_current_filtered());
return lbm_enc_F(mc_interface_get_tot_current_filtered());
}
static VALUE ext_get_current_dir(VALUE *args, UINT argn) {
static lbm_value ext_get_current_dir(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_tot_current_directional_filtered());
return lbm_enc_F(mc_interface_get_tot_current_directional_filtered());
}
static VALUE ext_get_current_in(VALUE *args, UINT argn) {
static lbm_value ext_get_current_in(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_tot_current_in_filtered());
return lbm_enc_F(mc_interface_get_tot_current_in_filtered());
}
static VALUE ext_get_duty(VALUE *args, UINT argn) {
static lbm_value ext_get_duty(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_duty_cycle_now());
return lbm_enc_F(mc_interface_get_duty_cycle_now());
}
static VALUE ext_get_rpm(VALUE *args, UINT argn) {
static lbm_value ext_get_rpm(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_rpm());
return lbm_enc_F(mc_interface_get_rpm());
}
static VALUE ext_get_temp_fet(VALUE *args, UINT argn) {
static lbm_value ext_get_temp_fet(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_temp_fet_filtered());
return lbm_enc_F(mc_interface_temp_fet_filtered());
}
static VALUE ext_get_temp_mot(VALUE *args, UINT argn) {
static lbm_value ext_get_temp_mot(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_temp_motor_filtered());
return lbm_enc_F(mc_interface_temp_motor_filtered());
}
static VALUE ext_get_speed(VALUE *args, UINT argn) {
static lbm_value ext_get_speed(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_speed());
return lbm_enc_F(mc_interface_get_speed());
}
static VALUE ext_get_dist(VALUE *args, UINT argn) {
static lbm_value ext_get_dist(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_distance_abs());
return lbm_enc_F(mc_interface_get_distance_abs());
}
static VALUE ext_get_batt(VALUE *args, UINT argn) {
static lbm_value ext_get_batt(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_F(mc_interface_get_battery_level(0));
return lbm_enc_F(mc_interface_get_battery_level(0));
}
static VALUE ext_get_fault(VALUE *args, UINT argn) {
static lbm_value ext_get_fault(lbm_value *args, lbm_uint argn) {
(void)args; (void)argn;
return enc_i(mc_interface_get_fault());
return lbm_enc_i(mc_interface_get_fault());
}
// CAN-commands
static VALUE ext_can_current(VALUE *args, UINT argn) {
static lbm_value ext_can_current(lbm_value *args, lbm_uint argn) {
CHECK_NUMBER_ALL();
if (argn == 2) {
comm_can_set_current(dec_as_i(args[0]), dec_as_f(args[1]));
comm_can_set_current(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]));
} else if (argn == 3) {
comm_can_set_current_off_delay(dec_as_i(args[0]), dec_as_f(args[1]), dec_as_f(args[2]));
comm_can_set_current_off_delay(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]), lbm_dec_as_f(args[2]));
} else {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
return enc_sym(SYM_TRUE);
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_can_current_rel(VALUE *args, UINT argn) {
static lbm_value ext_can_current_rel(lbm_value *args, lbm_uint argn) {
CHECK_NUMBER_ALL();
if (argn == 2) {
comm_can_set_current_rel(dec_as_i(args[0]), dec_as_f(args[1]));
comm_can_set_current_rel(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]));
} else if (argn == 3) {
comm_can_set_current_rel_off_delay(dec_as_i(args[0]), dec_as_f(args[1]), dec_as_f(args[2]));
comm_can_set_current_rel_off_delay(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]), lbm_dec_as_f(args[2]));
} else {
return enc_sym(SYM_EERROR);
return lbm_enc_sym(SYM_EERROR);
}
return enc_sym(SYM_TRUE);
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_can_duty(VALUE *args, UINT argn) {
static lbm_value ext_can_duty(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(2);
comm_can_set_duty(dec_as_i(args[0]), dec_as_f(args[1]));
return enc_sym(SYM_TRUE);
comm_can_set_duty(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_can_brake(VALUE *args, UINT argn) {
static lbm_value ext_can_brake(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(2);
comm_can_set_current_brake(dec_as_i(args[0]), dec_as_f(args[1]));
return enc_sym(SYM_TRUE);
comm_can_set_current_brake(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_can_brake_rel(VALUE *args, UINT argn) {
static lbm_value ext_can_brake_rel(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(2);
comm_can_set_current_brake_rel(dec_as_i(args[0]), dec_as_f(args[1]));
return enc_sym(SYM_TRUE);
comm_can_set_current_brake_rel(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_can_rpm(VALUE *args, UINT argn) {
static lbm_value ext_can_rpm(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(2);
comm_can_set_rpm(dec_as_i(args[0]), dec_as_f(args[1]));
return enc_sym(SYM_TRUE);
comm_can_set_rpm(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]));
return lbm_enc_sym(SYM_TRUE);
}
static VALUE ext_can_pos(VALUE *args, UINT argn) {
static lbm_value ext_can_pos(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(2);
comm_can_set_pos(dec_as_i(args[0]), dec_as_f(args[1]));
return enc_sym(SYM_TRUE);
comm_can_set_pos(lbm_dec_as_i(args[0]), lbm_dec_as_f(args[1]));
return lbm_enc_sym(SYM_TRUE);
}
static lbm_value ext_can_get_current(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
can_status_msg *stat0 = comm_can_get_status_msg_id(lbm_dec_as_i(args[0]));
if (stat0) {
return lbm_enc_F(stat0->current);
} else {
return lbm_enc_sym(SYM_EERROR);
}
}
static lbm_value ext_can_get_current_dir(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1);
can_status_msg *stat0 = comm_can_get_status_msg_id(lbm_dec_as_i(args[0]));
if (stat0) {
return lbm_enc_F(stat0->current * SIGN(stat0->duty));
} else {
return lbm_enc_sym(SYM_EERROR);
}
}
// Math
static VALUE ext_sin(VALUE *args, UINT argn) {
static lbm_value ext_sin(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1)
return enc_F(sinf(dec_as_f(args[0])));
return lbm_enc_F(sinf(lbm_dec_as_f(args[0])));
}
static VALUE ext_cos(VALUE *args, UINT argn) {
static lbm_value ext_cos(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1)
return enc_F(cosf(dec_as_f(args[0])));
return lbm_enc_F(cosf(lbm_dec_as_f(args[0])));
}
static VALUE ext_atan(VALUE *args, UINT argn) {
static lbm_value ext_atan(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(1)
return enc_F(atanf(dec_as_f(args[0])));
return lbm_enc_F(atanf(lbm_dec_as_f(args[0])));
}
static VALUE ext_pow(VALUE *args, UINT argn) {
static lbm_value ext_pow(lbm_value *args, lbm_uint argn) {
CHECK_ARGN_NUMBER(2)
return enc_F(powf(dec_as_f(args[0]), dec_as_f(args[1])));
return lbm_enc_F(powf(lbm_dec_as_f(args[0]), lbm_dec_as_f(args[1])));
}
void lispif_load_vesc_extensions(void) {
// Various commands
extensions_add("print", ext_print);
extensions_add("timeout-reset", ext_reset_timeout);
extensions_add("get-ppm", ext_get_ppm);
extensions_add("get-encoder", ext_get_encoder);
extensions_add("set-servo", ext_set_servo);
extensions_add("get-vin", ext_get_vin);
extensions_add("select-motor", ext_select_motor);
extensions_add("get-selected-motor", ext_get_selected_motor);
extensions_add("get-bms-val", ext_get_bms_val);
extensions_add("get-adc", ext_get_adc);
extensions_add("systime", ext_systime);
extensions_add("secs-since", ext_secs_since);
lbm_add_extension("print", ext_print);
lbm_add_extension("timeout-reset", ext_reset_timeout);
lbm_add_extension("get-ppm", ext_get_ppm);
lbm_add_extension("get-encoder", ext_get_encoder);
lbm_add_extension("set-servo", ext_set_servo);
lbm_add_extension("get-vin", ext_get_vin);
lbm_add_extension("select-motor", ext_select_motor);
lbm_add_extension("get-selected-motor", ext_get_selected_motor);
lbm_add_extension("get-bms-val", ext_get_bms_val);
lbm_add_extension("get-adc", ext_get_adc);
lbm_add_extension("systime", ext_systime);
lbm_add_extension("secs-since", ext_secs_since);
// Motor set commands
extensions_add("set-current", ext_set_current);
extensions_add("set-current-rel", ext_set_current_rel);
extensions_add("set-duty", ext_set_duty);
extensions_add("set-brake", ext_set_brake);
extensions_add("set-brake-rel", ext_set_brake_rel);
extensions_add("set-handbrake", ext_set_handbrake);
extensions_add("set-handbrake-rel", ext_set_handbrake_rel);
extensions_add("set-rpm", ext_set_rpm);
extensions_add("set-pos", ext_set_pos);
lbm_add_extension("set-current", ext_set_current);
lbm_add_extension("set-current-rel", ext_set_current_rel);
lbm_add_extension("set-duty", ext_set_duty);
lbm_add_extension("set-brake", ext_set_brake);
lbm_add_extension("set-brake-rel", ext_set_brake_rel);
lbm_add_extension("set-handbrake", ext_set_handbrake);
lbm_add_extension("set-handbrake-rel", ext_set_handbrake_rel);
lbm_add_extension("set-rpm", ext_set_rpm);
lbm_add_extension("set-pos", ext_set_pos);
// Motor get commands
extensions_add("get-current", ext_get_current);
extensions_add("get-current-dir", ext_get_current_dir);
extensions_add("get-current-in", ext_get_current_in);
extensions_add("get-duty", ext_get_duty);
extensions_add("get-rpm", ext_get_rpm);
extensions_add("get-temp-fet", ext_get_temp_fet);
extensions_add("get-temp-mot", ext_get_temp_mot);
extensions_add("get-speed", ext_get_speed);
extensions_add("get-dist", ext_get_dist);
extensions_add("get-batt", ext_get_batt);
extensions_add("get-fault", ext_get_fault);
lbm_add_extension("get-current", ext_get_current);
lbm_add_extension("get-current-dir", ext_get_current_dir);
lbm_add_extension("get-current-in", ext_get_current_in);
lbm_add_extension("get-duty", ext_get_duty);
lbm_add_extension("get-rpm", ext_get_rpm);
lbm_add_extension("get-temp-fet", ext_get_temp_fet);
lbm_add_extension("get-temp-mot", ext_get_temp_mot);
lbm_add_extension("get-speed", ext_get_speed);
lbm_add_extension("get-dist", ext_get_dist);
lbm_add_extension("get-batt", ext_get_batt);
lbm_add_extension("get-fault", ext_get_fault);
// CAN-comands
extensions_add("canset-current", ext_can_current);
extensions_add("canset-current-rel", ext_can_current_rel);
extensions_add("canset-duty", ext_can_duty);
extensions_add("canset-brake", ext_can_brake);
extensions_add("canset-brake-rel", ext_can_brake_rel);
extensions_add("canset-rpm", ext_can_rpm);
extensions_add("canset-pos", ext_can_pos);
lbm_add_extension("canset-current", ext_can_current);
lbm_add_extension("canset-current-rel", ext_can_current_rel);
lbm_add_extension("canset-duty", ext_can_duty);
lbm_add_extension("canset-brake", ext_can_brake);
lbm_add_extension("canset-brake-rel", ext_can_brake_rel);
lbm_add_extension("canset-rpm", ext_can_rpm);
lbm_add_extension("canset-pos", ext_can_pos);
lbm_add_extension("canget-current", ext_can_get_current);
lbm_add_extension("canget-current-dir", ext_can_get_current_dir);
// Math
extensions_add("sin", ext_sin);
extensions_add("cos", ext_cos);
extensions_add("atan", ext_atan);
extensions_add("pow", ext_pow);
lbm_add_extension("sin", ext_sin);
lbm_add_extension("cos", ext_cos);
lbm_add_extension("atan", ext_atan);
lbm_add_extension("pow", ext_pow);
}

76
lispBM/src/compression.c
View File

@ -1,5 +1,5 @@
/*
Copyright 2019, 2021 Joel Svensson svenssonjoel@yahoo.se
Copyright 2019, 2021, 2022 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -278,7 +278,7 @@ char read_character(char *src, uint32_t *bit_pos) {
return c;
}
char *compression_compress(char *string, uint32_t *res_size) {
char *lbm_compress(char *string, uint32_t *res_size) {
int c_size_bits_i = compressed_length(string);
uint32_t c_size_bits = 0;
@ -290,7 +290,7 @@ char *compression_compress(char *string, uint32_t *res_size) {
if (c_size_bits % 8 > 0) {
c_size_bytes += 1;
}
uint32_t header_value = c_size_bits;
if (header_value == 0) return NULL;
@ -371,7 +371,7 @@ char *compression_compress(char *string, uint32_t *res_size) {
}
void compression_init_state(decomp_state *s, char *src) {
void lbm_init_compression_state(decomp_state *s, char *src) {
memcpy(&s->compressed_bits, src, 4);
s->i = 32;
s->string_mode = false;
@ -379,7 +379,7 @@ void compression_init_state(decomp_state *s, char *src) {
s->src = src;
}
int compression_decompress_incremental(decomp_state *s, char *dest_buff, uint32_t dest_n) {
int lbm_decompress_incremental(decomp_state *s, char *dest_buff, uint32_t dest_n) {
memset(dest_buff, 0, dest_n);
uint32_t char_pos = 0;
@ -420,7 +420,7 @@ int compression_decompress_incremental(decomp_state *s, char *dest_buff, uint32_
}
bool compression_decompress(char *dest, uint32_t dest_n, char *src) {
bool lbm_decompress(char *dest, uint32_t dest_n, char *src) {
uint32_t char_pos = 0;
@ -430,11 +430,11 @@ bool compression_decompress(char *dest, uint32_t dest_n, char *src) {
memset(dest, 0, dest_n);
compression_init_state(&s, src);
lbm_init_compression_state(&s, src);
while (true) {
num_chars = compression_decompress_incremental(&s, dest_buff, 32);
num_chars = lbm_decompress_incremental(&s, dest_buff, 32);
if (num_chars == 0) break;
if (num_chars == -1) return false;
@ -446,25 +446,16 @@ bool compression_decompress(char *dest, uint32_t dest_n, char *src) {
}
/* Implementation of the parsing interface */
#define DECOMP_BUFF_SIZE 32
typedef struct {
decomp_state ds;
char decomp_buff[DECOMP_BUFF_SIZE];
int decomp_bytes;
int buff_pos;
} tokenizer_compressed_state;
bool more_compressed(tokenizer_char_stream str) {
tokenizer_compressed_state *s = (tokenizer_compressed_state*)str.state;
bool more_compressed(lbm_tokenizer_char_stream_t *str) {
tokenizer_compressed_state_t *s = (tokenizer_compressed_state_t*)str->state;
bool more =
(s->ds.i < s->ds.compressed_bits + 32) ||
(s->buff_pos < s->decomp_bytes);
return more;
}
char get_compressed(tokenizer_char_stream str) {
tokenizer_compressed_state *s = (tokenizer_compressed_state*)str.state;
char get_compressed(lbm_tokenizer_char_stream_t *str) {
tokenizer_compressed_state_t *s = (tokenizer_compressed_state_t*)str->state;
if (s->ds.i >= s->ds.compressed_bits + 32 &&
(s->buff_pos >= s->decomp_bytes)) {
@ -472,7 +463,7 @@ char get_compressed(tokenizer_char_stream str) {
}
if (s->buff_pos >= s->decomp_bytes) {
int n = compression_decompress_incremental(&s->ds, s->decomp_buff,DECOMP_BUFF_SIZE);
int n = lbm_decompress_incremental(&s->ds, s->decomp_buff,DECOMP_BUFF_SIZE);
if (n == 0) {
return 0;
}
@ -484,46 +475,41 @@ char get_compressed(tokenizer_char_stream str) {
return c;
}
char peek_compressed(tokenizer_char_stream str, unsigned int n) {
tokenizer_compressed_state *s = (tokenizer_compressed_state*)str.state;
char peek_compressed(lbm_tokenizer_char_stream_t *str, unsigned int n) {
tokenizer_compressed_state_t *s = (tokenizer_compressed_state_t *)str->state;
tokenizer_compressed_state old;
tokenizer_compressed_state_t old;
memcpy(&old, s, sizeof(tokenizer_compressed_state));
memcpy(&old, s, sizeof(tokenizer_compressed_state_t));
char c = get_compressed(str);;
for (unsigned int i = 1; i <= n; i ++) {
c = get_compressed(str);
}
memcpy(str.state, &old, sizeof(tokenizer_compressed_state));
memcpy(str->state, &old, sizeof(tokenizer_compressed_state_t));
return c;
}
void drop_compressed(tokenizer_char_stream str, unsigned int n) {
void drop_compressed(lbm_tokenizer_char_stream_t *str, unsigned int n) {
for (unsigned int i = 0; i < n; i ++) {
get_compressed(str);
}
}
VALUE compression_parse(char *bytes) {
void lbm_create_char_stream_from_compressed(tokenizer_compressed_state_t *ts,
lbm_tokenizer_char_stream_t *str,
char *bytes) {
ts->decomp_bytes = 0;
memset(ts->decomp_buff, 0, 32);
ts->buff_pos = 0;
tokenizer_compressed_state ts;
lbm_init_compression_state(&ts->ds, bytes);
ts.decomp_bytes = 0;
memset(ts.decomp_buff, 0, 32);
ts.buff_pos = 0;
compression_init_state(&ts.ds, bytes);
tokenizer_char_stream str;
str.state = &ts;
str.more = more_compressed;
str.get = get_compressed;
str.peek = peek_compressed;
str.drop = drop_compressed;
return tokpar_parse_program(str);
str->state = ts;
str->more = more_compressed;
str->get = get_compressed;
str->peek = peek_compressed;
str->drop = drop_compressed;
}

120
lispBM/src/env.c
View File

@ -22,77 +22,77 @@
#include "print.h"
#include "lispbm_types.h"
VALUE env_global;
lbm_value env_global;
int env_init(void) {
env_global = enc_sym(SYM_NIL);
int lbm_init_env(void) {
env_global = lbm_enc_sym(SYM_NIL);
return 1;
}
VALUE *env_get_global_ptr(void) {
lbm_value *lbm_get_env_ptr(void) {
return &env_global;
}
// Copies just the skeleton structure of an environment
// The new "copy" will have pointers to the original key-val bindings.
VALUE env_copy_shallow(VALUE env) {
lbm_value lbm_env_copy_shallow(lbm_value env) {
VALUE res = enc_sym(SYM_NIL);
VALUE curr = env;
lbm_value res = lbm_enc_sym(SYM_NIL);
lbm_value curr = env;
while (type_of(curr) == PTR_TYPE_CONS) {
VALUE key = car(car(curr));
if (dec_sym(key) != SYM_NIL) {
res = cons(car(curr), res);
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
lbm_value key = lbm_car(lbm_car(curr));
if (lbm_dec_sym(key) != SYM_NIL) {
res = lbm_cons(lbm_car(curr), res);
// Check for "out of memory"
if (type_of(res) == VAL_TYPE_SYMBOL &&
dec_sym(res) == SYM_MERROR) {
if (lbm_type_of(res) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(res) == SYM_MERROR) {
return res;
}
}
curr = cdr(curr);
curr = lbm_cdr(curr);
}
return res;
}
VALUE env_lookup(VALUE sym, VALUE env) {
VALUE curr = env;
lbm_value lbm_env_lookup(lbm_value sym, lbm_value env) {
lbm_value curr = env;
if(dec_sym(sym) == SYM_NIL) {
if(lbm_dec_sym(sym) == SYM_NIL) {
return sym;
}
while (type_of(curr) == PTR_TYPE_CONS) {
if (car(car(curr)) == sym) {
return cdr(car(curr));
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
if (lbm_car(lbm_car(curr)) == sym) {
return lbm_cdr(lbm_car(curr));
}
curr = cdr(curr);
curr = lbm_cdr(curr);
}
return enc_sym(SYM_NOT_FOUND);
return lbm_enc_sym(SYM_NOT_FOUND);
}
VALUE env_set(VALUE env, VALUE key, VALUE val) {
lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val) {
VALUE curr = env;
VALUE new_env;
VALUE keyval;
lbm_value curr = env;
lbm_value new_env;
lbm_value keyval;
while(type_of(curr) == PTR_TYPE_CONS) {
if (car(car(curr)) == key) {
set_cdr(car(curr),val);
while(lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
if (lbm_car(lbm_car(curr)) == key) {
lbm_set_cdr(lbm_car(curr),val);
return env;
}
curr = cdr(curr);
curr = lbm_cdr(curr);
}
keyval = cons(key,val);
if (type_of(keyval) == VAL_TYPE_SYMBOL) {
keyval = lbm_cons(key,val);
if (lbm_type_of(keyval) == LBM_VAL_TYPE_SYMBOL) {
return keyval;
}
new_env = cons(keyval, env);
if (type_of(new_env) == VAL_TYPE_SYMBOL) {
new_env = lbm_cons(keyval, env);
if (lbm_type_of(new_env) == LBM_VAL_TYPE_SYMBOL) {
return keyval;
}
@ -100,50 +100,50 @@ VALUE env_set(VALUE env, VALUE key, VALUE val) {
}
VALUE env_modify_binding(VALUE env, VALUE key, VALUE val) {
lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val) {
VALUE curr = env;
lbm_value curr = env;
while (type_of(curr) == PTR_TYPE_CONS) {
if (car(car(curr)) == key) {
set_cdr(car(curr), val);
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
if (lbm_car(lbm_car(curr)) == key) {
lbm_set_cdr(lbm_car(curr), val);
return env;
}
curr = cdr(curr);
curr = lbm_cdr(curr);
}
return enc_sym(SYM_NOT_FOUND);
return lbm_enc_sym(SYM_NOT_FOUND);
}
VALUE env_build_params_args(VALUE params,
VALUE args,
VALUE env0) {
VALUE curr_param = params;
VALUE curr_arg = args;
lbm_value lbm_env_build_params_args(lbm_value params,
lbm_value args,
lbm_value env0) {
lbm_value curr_param = params;
lbm_value curr_arg = args;
// TODO: This should be checked outside of this function.
//
if (length(params) != length(args)) { // programmer error
return enc_sym(SYM_FATAL_ERROR);
if (lbm_list_length(params) != lbm_list_length(args)) { // programmer error
return lbm_enc_sym(SYM_FATAL_ERROR);
}
VALUE env = env0;
while (type_of(curr_param) == PTR_TYPE_CONS) {
lbm_value env = env0;
while (lbm_type_of(curr_param) == LBM_PTR_TYPE_CONS) {
VALUE entry = cons(car(curr_param), car(curr_arg));
if (type_of(entry) == VAL_TYPE_SYMBOL &&
dec_sym(entry) == SYM_MERROR)
return enc_sym(SYM_MERROR);
lbm_value entry = lbm_cons(lbm_car(curr_param), lbm_car(curr_arg));
if (lbm_type_of(entry) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(entry) == SYM_MERROR)
return lbm_enc_sym(SYM_MERROR);
env = cons(entry,env);
env = lbm_cons(entry,env);
if (type_of(env) == VAL_TYPE_SYMBOL &&
dec_sym(env) == SYM_MERROR)
return enc_sym(SYM_MERROR);
if (lbm_type_of(env) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(env) == SYM_MERROR)
return lbm_enc_sym(SYM_MERROR);
curr_param = cdr(curr_param);
curr_arg = cdr(curr_arg);
curr_param = lbm_cdr(curr_param);
curr_arg = lbm_cdr(curr_arg);
}
return env;
}

1403
lispBM/src/eval_cps.c
View File

File diff suppressed because it is too large Load Diff

12
lispBM/src/extensions.c
View File

@ -36,12 +36,12 @@
uint32_t* extensions = NULL;
int extensions_init(void) {
int lbm_extensions_init(void) {
extensions = NULL;
return 1;
}
extension_fptr extensions_lookup(UINT sym) {
extension_fptr lbm_get_extension(lbm_uint sym) {
uint32_t *t = extensions;
while (t != NULL) {
if (t[SYM] == sym) {
@ -52,13 +52,13 @@ extension_fptr extensions_lookup(UINT sym) {
return NULL;
}
bool extensions_add(char *sym_str, extension_fptr ext) {
VALUE symbol;
int res = symrepr_addsym_const(sym_str, &symbol);
bool lbm_add_extension(char *sym_str, extension_fptr ext) {
lbm_value symbol;
int res = lbm_add_symbol_const(sym_str, &symbol);
if (!res) return false;
uint32_t *m = memory_allocate(3); /* 3 words */
uint32_t *m = lbm_memory_allocate(3); /* 3 words */
if (!m) return false;

667
lispBM/src/fundamental.c
View File

File diff suppressed because it is too large Load Diff

451
lispBM/src/heap.c
View File

@ -29,82 +29,91 @@
#include "heap_vis.h"
#endif
static heap_state_t heap_state;
static lbm_heap_state_t heap_state;
static VALUE NIL;
static VALUE RECOVERED;
static lbm_value NIL;
static lbm_value RECOVERED;
char *dec_str(VALUE val) {
char *lbm_dec_str(lbm_value val) {
char *res = 0;
if (type_of(val) == PTR_TYPE_ARRAY) {
array_header_t *array = (array_header_t *)car(val);
if (lbm_type_of(val) == LBM_PTR_TYPE_ARRAY) {
lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
if (array->elt_type == VAL_TYPE_CHAR) {
if (array->elt_type == LBM_VAL_TYPE_CHAR) {
res = (char *)array + 8;
}
}
return res;
}
lbm_stream_t *lbm_dec_stream(lbm_value val) {
lbm_stream_t *res = 0;
UINT dec_as_u(VALUE a) {
UINT tmp;
FLOAT f_tmp;
if (lbm_type_of(val) == LBM_PTR_TYPE_STREAM) {
res = (lbm_stream_t *)lbm_car(val);
}
return res;
}
switch (type_of(a)) {
case VAL_TYPE_I:
return (UINT) dec_i(a);
case VAL_TYPE_U:
return dec_u(a);
case PTR_TYPE_BOXED_I: /* fall through */
case PTR_TYPE_BOXED_U:
return (UINT)car(a);
case PTR_TYPE_BOXED_F:
tmp = car(a);
memcpy(&f_tmp, &tmp, sizeof(FLOAT));
return (UINT)f_tmp;
lbm_uint lbm_dec_as_u(lbm_value a) {
lbm_uint tmp;
lbm_float f_tmp;
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I:
return (lbm_uint) lbm_dec_i(a);
case LBM_VAL_TYPE_U:
return lbm_dec_u(a);
case LBM_PTR_TYPE_BOXED_I: /* fall through */
case LBM_PTR_TYPE_BOXED_U:
return (lbm_uint)lbm_car(a);
case LBM_PTR_TYPE_BOXED_F:
tmp = lbm_car(a);
memcpy(&f_tmp, &tmp, sizeof(lbm_float));
return (lbm_uint)f_tmp;
}
return 0;
}
INT dec_as_i(VALUE a) {
lbm_int lbm_dec_as_i(lbm_value a) {
UINT tmp;
FLOAT f_tmp;
lbm_uint tmp;
lbm_float f_tmp;
switch (type_of(a)) {
case VAL_TYPE_I:
return dec_i(a);
case VAL_TYPE_U:
return (INT) dec_u(a);
case PTR_TYPE_BOXED_I:
case PTR_TYPE_BOXED_U:
return (INT)car(a);
case PTR_TYPE_BOXED_F:
tmp = car(a);
memcpy(&f_tmp, &tmp, sizeof(FLOAT));
return (INT)f_tmp;
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I:
return lbm_dec_i(a);
case LBM_VAL_TYPE_U:
return (lbm_int) lbm_dec_u(a);
case LBM_PTR_TYPE_BOXED_I:
case LBM_PTR_TYPE_BOXED_U:
return (lbm_int)lbm_car(a);
case LBM_PTR_TYPE_BOXED_F:
tmp = lbm_car(a);
memcpy(&f_tmp, &tmp, sizeof(lbm_float));
return (lbm_int)f_tmp;
}
return 0;
}
FLOAT dec_as_f(VALUE a) {
lbm_float lbm_dec_as_f(lbm_value a) {
UINT tmp;
FLOAT f_tmp;
lbm_uint tmp;
lbm_float f_tmp;
switch (type_of(a)) {
case VAL_TYPE_I:
return (FLOAT) dec_i(a);
case VAL_TYPE_U:
return (FLOAT)dec_u(a);
case PTR_TYPE_BOXED_I:
case PTR_TYPE_BOXED_U:
return (FLOAT)car(a);
case PTR_TYPE_BOXED_F:
tmp = car(a);
memcpy(&f_tmp, &tmp, sizeof(FLOAT));
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I:
return (lbm_float) lbm_dec_i(a);
case LBM_VAL_TYPE_U:
return (lbm_float)lbm_dec_u(a);
case LBM_PTR_TYPE_BOXED_I:
case LBM_PTR_TYPE_BOXED_U:
return (lbm_float)lbm_car(a);
case LBM_PTR_TYPE_BOXED_F:
tmp = lbm_car(a);
memcpy(&f_tmp, &tmp, sizeof(lbm_float));
return f_tmp;
}
return 0;
@ -113,40 +122,40 @@ FLOAT dec_as_f(VALUE a) {
// ref_cell: returns a reference to the cell addressed by bits 3 - 26
// Assumes user has checked that is_ptr was set
static inline cons_t* ref_cell(VALUE addr) {
return &heap_state.heap[dec_ptr(addr)];
static inline lbm_cons_t* ref_cell(lbm_value addr) {
return &heap_state.heap[lbm_dec_ptr(addr)];
// return (cons_t*)(heap_base + (addr & PTR_VAL_MASK));
}
static inline VALUE read_car(cons_t *cell) {
static inline lbm_value read_car(lbm_cons_t *cell) {
return cell->car;
}
static inline VALUE read_cdr(cons_t *cell) {
static inline lbm_value read_cdr(lbm_cons_t *cell) {
return cell->cdr;
}
static inline void set_car_(cons_t *cell, VALUE v) {
static inline void set_car_(lbm_cons_t *cell, lbm_value v) {
cell->car = v;
}
static inline void set_cdr_(cons_t *cell, VALUE v) {
static inline void set_cdr_(lbm_cons_t *cell, lbm_value v) {
cell->cdr = v;
}
static inline void set_gc_mark(cons_t *cell) {
VALUE cdr = read_cdr(cell);
set_cdr_(cell, val_set_gc_mark(cdr));
static inline void set_gc_mark(lbm_cons_t *cell) {
lbm_value cdr = read_cdr(cell);
set_cdr_(cell, lbm_set_gc_mark(cdr));
}
static inline void clr_gc_mark(cons_t *cell) {
VALUE cdr = read_cdr(cell);
set_cdr_(cell, val_clr_gc_mark(cdr));
static inline void clr_gc_mark(lbm_cons_t *cell) {
lbm_value cdr = read_cdr(cell);
set_cdr_(cell, lbm_clr_gc_mark(cdr));
}
static inline bool get_gc_mark(cons_t* cell) {
VALUE cdr = read_cdr(cell);
return val_get_gc_mark(cdr);
static inline bool get_gc_mark(lbm_cons_t* cell) {
lbm_value cdr = read_cdr(cell);
return lbm_get_gc_mark(cdr);
}
static int generate_freelist(size_t num_cells) {
@ -154,27 +163,27 @@ static int generate_freelist(size_t num_cells) {
if (!heap_state.heap) return 0;
heap_state.freelist = enc_cons_ptr(0);
heap_state.freelist = lbm_enc_cons_ptr(0);
cons_t *t;
lbm_cons_t *t;
// Add all cells to free list
for (i = 1; i < num_cells; i ++) {
t = ref_cell(enc_cons_ptr(i-1));
t = ref_cell(lbm_enc_cons_ptr(i-1));
set_car_(t, RECOVERED); // all cars in free list are "RECOVERED"
set_cdr_(t, enc_cons_ptr(i));
set_cdr_(t, lbm_enc_cons_ptr(i));
}
// Replace the incorrect pointer at the last cell.
t = ref_cell(enc_cons_ptr(num_cells-1));
t = ref_cell(lbm_enc_cons_ptr(num_cells-1));
set_cdr_(t, NIL);
return 1;
}
static void heap_init_state(cons_t *addr, unsigned int num_cells, bool malloced) {
static void heap_init_state(lbm_cons_t *addr, unsigned int num_cells, bool malloced) {
heap_state.heap = addr;
heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(cons_t));
heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(lbm_cons_t));
heap_state.heap_size = num_cells;
heap_state.malloced = malloced;
@ -186,31 +195,31 @@ static void heap_init_state(cons_t *addr, unsigned int num_cells, bool malloced)
heap_state.gc_recovered_arrays = 0;
}
int heap_init(cons_t *addr, unsigned int num_cells) {
int lbm_heap_init(lbm_cons_t *addr, unsigned int num_cells) {
NIL = enc_sym(SYM_NIL);
RECOVERED = enc_sym(SYM_RECOVERED);
NIL = lbm_enc_sym(SYM_NIL);
RECOVERED = lbm_enc_sym(SYM_RECOVERED);
if (((uintptr_t)addr % 8) != 0) return 0;
memset(addr,0, sizeof(cons_t) * num_cells);
memset(addr,0, sizeof(lbm_cons_t) * num_cells);
heap_init_state(addr, num_cells, false);
return generate_freelist(num_cells);
}
unsigned int heap_num_free(void) {
unsigned int lbm_heap_num_free(void) {
unsigned int count = 0;
VALUE curr = heap_state.freelist;
lbm_value curr = heap_state.freelist;
while (type_of(curr) == PTR_TYPE_CONS) {
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
curr = read_cdr(ref_cell(curr));
count++;
}
// Prudence.
if (!(type_of(curr) == VAL_TYPE_SYMBOL) &&
if (!(lbm_type_of(curr) == LBM_VAL_TYPE_SYMBOL) &&
curr == NIL){
return 0;
}
@ -218,30 +227,30 @@ unsigned int heap_num_free(void) {
}
VALUE heap_allocate_cell(TYPE ptr_type) {
lbm_value lbm_heap_allocate_cell(lbm_type ptr_type) {
VALUE res;
lbm_value res;
if (!is_ptr(heap_state.freelist)) {
if (!lbm_is_ptr(heap_state.freelist)) {
// Free list not a ptr (should be Symbol NIL)
if ((type_of(heap_state.freelist) == VAL_TYPE_SYMBOL) &&
if ((lbm_type_of(heap_state.freelist) == LBM_VAL_TYPE_SYMBOL) &&
(heap_state.freelist == NIL)) {
// all is as it should be (but no free cells)
return enc_sym(SYM_MERROR);
return lbm_enc_sym(SYM_MERROR);
} else {
// something is most likely very wrong
return enc_sym(SYM_FATAL_ERROR);
return lbm_enc_sym(SYM_FATAL_ERROR);
}
}
// it is a ptr replace freelist with cdr of freelist;
res = heap_state.freelist;
if (type_of(res) != PTR_TYPE_CONS) {
return enc_sym(SYM_FATAL_ERROR);
if (lbm_type_of(res) != LBM_PTR_TYPE_CONS) {
return lbm_enc_sym(SYM_FATAL_ERROR);
}
heap_state.freelist = cdr(heap_state.freelist);
heap_state.freelist = lbm_cdr(heap_state.freelist);
heap_state.num_alloc++;
@ -256,18 +265,18 @@ VALUE heap_allocate_cell(TYPE ptr_type) {
return res;
}
unsigned int heap_num_allocated(void) {
unsigned int lbm_heap_num_allocated(void) {
return heap_state.num_alloc;
}
unsigned int heap_size(void) {
unsigned int lbm_heap_size(void) {
return heap_state.heap_size;
}
unsigned int heap_size_bytes(void) {
unsigned int lbm_heap_size_bytes(void) {
return heap_state.heap_bytes;
}
void heap_get_state(heap_state_t *res) {
void lbm_get_heap_state(lbm_heap_state_t *res) {
res->heap = heap_state.heap;
res->malloced = heap_state.malloced;
res->freelist = heap_state.freelist;
@ -281,25 +290,25 @@ void heap_get_state(heap_state_t *res) {
res->gc_recovered_arrays = heap_state.gc_recovered_arrays;
}
static VALUE stack_storage[1024];
static lbm_value stack_storage[1024];
int gc_mark_phase(VALUE env) {
int lbm_gc_mark_phase(lbm_value env) {
stack s;
stack_create(&s, stack_storage, 1024);
lbm_stack_t s;
lbm_stack_create(&s, stack_storage, 1024);
if (!is_ptr(env)) {
if (!lbm_is_ptr(env)) {
return 1; // Nothing to mark here
}
push_u32(&s, env);
lbm_push_u32(&s, env);
while (!stack_is_empty(&s)) {
VALUE curr;
while (!lbm_stack_is_empty(&s)) {
lbm_value curr;
int res = 1;
pop_u32(&s, &curr);
lbm_pop_u32(&s, &curr);
if (!is_ptr(curr)) {
if (!lbm_is_ptr(curr)) {
continue;
}
@ -313,16 +322,17 @@ int gc_mark_phase(VALUE env) {
set_gc_mark(ref_cell(curr));
VALUE t_ptr = type_of(curr);
lbm_value t_ptr = lbm_type_of(curr);
if (t_ptr == PTR_TYPE_BOXED_I ||
t_ptr == PTR_TYPE_BOXED_U ||
t_ptr == PTR_TYPE_BOXED_F ||
t_ptr == PTR_TYPE_ARRAY) {
if (t_ptr == LBM_PTR_TYPE_BOXED_I ||
t_ptr == LBM_PTR_TYPE_BOXED_U ||
t_ptr == LBM_PTR_TYPE_BOXED_F ||
t_ptr == LBM_PTR_TYPE_ARRAY ||
t_ptr == LBM_PTR_TYPE_STREAM) {
continue;
}
res &= push_u32(&s, cdr(curr));
res &= push_u32(&s, car(curr));
res &= lbm_push_u32(&s, lbm_cdr(curr));
res &= lbm_push_u32(&s, lbm_car(curr));
if (!res) return 0;
}
@ -332,14 +342,14 @@ int gc_mark_phase(VALUE env) {
// The free list should be a "proper list"
// Using a while loop to traverse over the cdrs
int gc_mark_freelist() {
int lbm_gc_mark_freelist() {
VALUE curr;
cons_t *t;
VALUE fl = heap_state.freelist;
lbm_value curr;
lbm_cons_t *t;
lbm_value fl = heap_state.freelist;
if (!is_ptr(fl)) {
if (val_type(fl) == VAL_TYPE_SYMBOL &&
if (!lbm_is_ptr(fl)) {
if (lbm_type_of(fl) == LBM_VAL_TYPE_SYMBOL &&
fl == NIL){
return 1; // Nothing to mark here
} else {
@ -348,7 +358,7 @@ int gc_mark_freelist() {
}
curr = fl;
while (is_ptr(curr)){
while (lbm_is_ptr(curr)){
t = ref_cell(curr);
set_gc_mark(t);
curr = read_cdr(t);
@ -359,24 +369,24 @@ int gc_mark_freelist() {
return 1;
}
int gc_mark_aux(UINT *aux_data, unsigned int aux_size) {
int lbm_gc_mark_aux(lbm_uint *aux_data, unsigned int aux_size) {
for (unsigned int i = 0; i < aux_size; i ++) {
if (is_ptr(aux_data[i])) {
if (lbm_is_ptr(aux_data[i])) {
TYPE pt_t = ptr_type(aux_data[i]);
UINT pt_v = dec_ptr(aux_data[i]);
lbm_type pt_t = lbm_type_of(aux_data[i]);
lbm_uint pt_v = lbm_dec_ptr(aux_data[i]);
if ( (pt_t == PTR_TYPE_CONS ||
pt_t == PTR_TYPE_BOXED_I ||
pt_t == PTR_TYPE_BOXED_U ||
pt_t == PTR_TYPE_BOXED_F ||
pt_t == PTR_TYPE_ARRAY ||
pt_t == PTR_TYPE_REF ||
pt_t == PTR_TYPE_STREAM) &&
if ( (pt_t == LBM_PTR_TYPE_CONS ||
pt_t == LBM_PTR_TYPE_BOXED_I ||
pt_t == LBM_PTR_TYPE_BOXED_U ||
pt_t == LBM_PTR_TYPE_BOXED_F ||
pt_t == LBM_PTR_TYPE_ARRAY ||
pt_t == LBM_PTR_TYPE_REF ||
pt_t == LBM_PTR_TYPE_STREAM) &&
pt_v < heap_state.heap_size) {
gc_mark_phase(aux_data[i]);
lbm_gc_mark_phase(aux_data[i]);
}
}
}
@ -386,25 +396,25 @@ int gc_mark_aux(UINT *aux_data, unsigned int aux_size) {
// Sweep moves non-marked heap objects to the free list.
int gc_sweep_phase(void) {
int lbm_gc_sweep_phase(void) {
unsigned int i = 0;
cons_t *heap = (cons_t *)heap_state.heap;
lbm_cons_t *heap = (lbm_cons_t *)heap_state.heap;
for (i = 0; i < heap_state.heap_size; i ++) {
if ( !get_gc_mark(&heap[i])){
// Check if this cell is a pointer to an array
// and free it.
if (type_of(heap[i].cdr) == VAL_TYPE_SYMBOL &&
dec_sym(heap[i].cdr) == SYM_ARRAY_TYPE) {
array_header_t *arr = (array_header_t*)heap[i].car;
memory_free((uint32_t *)arr);
if (lbm_type_of(heap[i].cdr) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(heap[i].cdr) == SYM_ARRAY_TYPE) {
lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car;
lbm_memory_free((uint32_t *)arr);
heap_state.gc_recovered_arrays++;
}
// create pointer to use as new freelist
UINT addr = enc_cons_ptr(i);
lbm_uint addr = lbm_enc_cons_ptr(i);
// Clear the "freed" cell.
heap[i].car = RECOVERED;
@ -419,60 +429,60 @@ int gc_sweep_phase(void) {
return 1;
}
void gc_state_inc(void) {
void lbm_gc_state_inc(void) {
heap_state.gc_num ++;
heap_state.gc_recovered = 0;
heap_state.gc_marked = 0;
}
int heap_perform_gc(VALUE env) {
gc_state_inc();
int lbm_perform_gc(lbm_value env) {
lbm_gc_state_inc();
gc_mark_freelist();
gc_mark_phase(env);
return gc_sweep_phase();
lbm_gc_mark_freelist();
lbm_gc_mark_phase(env);
return lbm_gc_sweep_phase();
}
int heap_perform_gc_extra(VALUE env, VALUE env2, VALUE exp, VALUE exp2, VALUE list) {
gc_state_inc();
int heap_perform_gc_extra(lbm_value env, lbm_value env2, lbm_value exp, lbm_value exp2, lbm_value list) {
lbm_gc_state_inc();
gc_mark_freelist();
gc_mark_phase(exp);
gc_mark_phase(exp2);
gc_mark_phase(env);
gc_mark_phase(env2);
gc_mark_phase(list);
lbm_gc_mark_freelist();
lbm_gc_mark_phase(exp);
lbm_gc_mark_phase(exp2);
lbm_gc_mark_phase(env);
lbm_gc_mark_phase(env2);
lbm_gc_mark_phase(list);
#ifdef VISUALIZE_HEAP
heap_vis_gen_image();
#endif
return gc_sweep_phase();
return lbm_gc_sweep_phase();
}
int heap_perform_gc_aux(VALUE env, VALUE env2, VALUE exp, VALUE exp2, VALUE exp3, UINT *aux_data, unsigned int aux_size) {
gc_state_inc();
int lbm_perform_gc_aux(lbm_value env, lbm_value env2, lbm_value exp, lbm_value exp2, lbm_value exp3, lbm_uint *aux_data, unsigned int aux_size) {
lbm_gc_state_inc();
gc_mark_freelist();
gc_mark_phase(exp);
gc_mark_phase(exp2);
gc_mark_phase(exp3);
gc_mark_phase(env);
gc_mark_phase(env2);
gc_mark_aux(aux_data, aux_size);
lbm_gc_mark_freelist();
lbm_gc_mark_phase(exp);
lbm_gc_mark_phase(exp2);
lbm_gc_mark_phase(exp3);
lbm_gc_mark_phase(env);
lbm_gc_mark_phase(env2);
lbm_gc_mark_aux(aux_data, aux_size);
#ifdef VISUALIZE_HEAP
heap_vis_gen_image();
#endif
return gc_sweep_phase();
return lbm_gc_sweep_phase();
}
// construct, alter and break apart
VALUE cons(VALUE car, VALUE cdr) {
VALUE addr = heap_allocate_cell(PTR_TYPE_CONS);
if ( is_ptr(addr)) {
lbm_value lbm_cons(lbm_value car, lbm_value cdr) {
lbm_value addr = lbm_heap_allocate_cell(LBM_PTR_TYPE_CONS);
if ( lbm_is_ptr(addr)) {
set_car_(ref_cell(addr), car);
set_cdr_(ref_cell(addr), cdr);
}
@ -481,49 +491,49 @@ VALUE cons(VALUE car, VALUE cdr) {
return addr;
}
VALUE car(VALUE c){
lbm_value lbm_car(lbm_value c){
if (type_of(c) == VAL_TYPE_SYMBOL &&
if (lbm_type_of(c) == LBM_VAL_TYPE_SYMBOL &&
c == NIL) {
return c; // if nil, return nil.
}
if (is_ptr(c) ){
cons_t *cell = ref_cell(c);
if (lbm_is_ptr(c) ){
lbm_cons_t *cell = ref_cell(c);
return read_car(cell);
}
return enc_sym(SYM_TERROR);
return lbm_enc_sym(SYM_TERROR);
}
VALUE cdr(VALUE c){
lbm_value lbm_cdr(lbm_value c){
if (type_of(c) == VAL_TYPE_SYMBOL &&
if (lbm_type_of(c) == LBM_VAL_TYPE_SYMBOL &&
c == NIL) {
return c; // if nil, return nil.
}
if (type_of(c) == PTR_TYPE_CONS) {
cons_t *cell = ref_cell(c);
if (lbm_type_of(c) == LBM_PTR_TYPE_CONS) {
lbm_cons_t *cell = ref_cell(c);
return read_cdr(cell);
}
return enc_sym(SYM_TERROR);
return lbm_enc_sym(SYM_TERROR);
}
bool set_car(VALUE c, VALUE v) { // Todo: Where are these used?
bool lbm_set_car(lbm_value c, lbm_value v) { // Todo: Where are these used?
// Can then return VALUE instead?
bool r = false;
if (is_ptr(c) && ptr_type(c) == PTR_TYPE_CONS) {
cons_t *cell = ref_cell(c);
if (lbm_is_ptr(c) && lbm_type_of(c) == LBM_PTR_TYPE_CONS) {
lbm_cons_t *cell = ref_cell(c);
set_car_(cell,v);
r = true;
}
return r;
}
bool set_cdr(VALUE c, VALUE v) {
bool lbm_set_cdr(lbm_value c, lbm_value v) {
bool r = false;
if (type_of(c) == PTR_TYPE_CONS){
cons_t *cell = ref_cell(c);
if (lbm_type_of(c) == LBM_PTR_TYPE_CONS){
lbm_cons_t *cell = ref_cell(c);
set_cdr_(cell,v);
r = true;
}
@ -531,71 +541,90 @@ bool set_cdr(VALUE c, VALUE v) {
}
/* calculate length of a proper list */
unsigned int length(VALUE c) {
unsigned int lbm_list_length(lbm_value c) {
unsigned int len = 0;
while (type_of(c) == PTR_TYPE_CONS){
while (lbm_type_of(c) == LBM_PTR_TYPE_CONS){
len ++;
c = cdr(c);
c = lbm_cdr(c);
}
return len;
}
/* reverse a proper list */
VALUE reverse(VALUE list) {
if (type_of(list) == VAL_TYPE_SYMBOL &&
lbm_value lbm_list_reverse(lbm_value list) {
if (lbm_type_of(list) == LBM_VAL_TYPE_SYMBOL &&
list == NIL) {
return list;
}
VALUE curr = list;
lbm_value curr = list;
VALUE new_list = NIL;
while (type_of(curr) == PTR_TYPE_CONS) {
lbm_value new_list = NIL;
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
new_list = cons(car(curr), new_list);
if (type_of(new_list) == VAL_TYPE_SYMBOL) {
return enc_sym(SYM_MERROR);
new_list = lbm_cons(lbm_car(curr), new_list);
if (lbm_type_of(new_list) == LBM_VAL_TYPE_SYMBOL) {
return lbm_enc_sym(SYM_MERROR);
}
curr = cdr(curr);
curr = lbm_cdr(curr);
}
return new_list;
}
VALUE copy(VALUE list) {
lbm_value lbm_list_copy(lbm_value list) {
// TODO: a more efficient approach
VALUE res = NIL;
lbm_value res = NIL;
VALUE curr = list;
lbm_value curr = list;
while (type_of(curr) == PTR_TYPE_CONS) {
VALUE c = cons (car(curr), res);
if (type_of(c) == VAL_TYPE_SYMBOL) {
return enc_sym(SYM_MERROR);
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
lbm_value c = lbm_cons (lbm_car(curr), res);
if (lbm_type_of(c) == LBM_VAL_TYPE_SYMBOL) {
return lbm_enc_sym(SYM_MERROR);
}
res = c;
curr = cdr(curr);
curr = lbm_cdr(curr);
}
return reverse(res);
return lbm_list_reverse(res);
}
// Append for proper lists only
// Destructive update of list1.
lbm_value lbm_list_append(lbm_value list1, lbm_value list2) {
if (lbm_type_of(list1) != LBM_PTR_TYPE_CONS) {
return list2;
}
if (lbm_type_of(list1) != LBM_PTR_TYPE_CONS) {
return list1;
}
lbm_value curr = list1;
while(lbm_type_of(lbm_cdr(curr)) == LBM_PTR_TYPE_CONS) {
curr = lbm_cdr(curr);
}
lbm_set_cdr(curr, list2);
return list1;
}
// Arrays are part of the heap module because their lifespan is managed
// by the garbage collector. The data in the array is not stored
// in the "heap of cons cells".
int heap_allocate_array(VALUE *res, unsigned int size, TYPE type){
int lbm_heap_allocate_array(lbm_value *res, unsigned int size, lbm_type type){
array_header_t *array = NULL;
lbm_array_header_t *array = NULL;
// allocating a cell that will, to start with, be a cons cell.
VALUE cell = heap_allocate_cell(PTR_TYPE_CONS);
lbm_value cell = lbm_heap_allocate_cell(LBM_PTR_TYPE_CONS);
if (type_of(cell) == VAL_TYPE_SYMBOL) { // Out of heap memory
if (lbm_type_of(cell) == LBM_VAL_TYPE_SYMBOL) { // Out of heap memory
*res = cell;
return 0;
}
unsigned int allocate_size = 0;
if (type == VAL_TYPE_CHAR) {
if (type == LBM_VAL_TYPE_CHAR) {
if ( size % 4 == 0) {
allocate_size = size >> 2;
} else {
@ -605,17 +634,17 @@ int heap_allocate_array(VALUE *res, unsigned int size, TYPE type){
allocate_size = size;
}
array = (array_header_t*)memory_allocate(2 + allocate_size);
array = (lbm_array_header_t*)lbm_memory_allocate(2 + allocate_size);
if (array == NULL) return 0;
array->elt_type = type;
array->size = size;
set_car(cell, (UINT)array);
set_cdr(cell, enc_sym(SYM_ARRAY_TYPE));
lbm_set_car(cell, (lbm_uint)array);
lbm_set_cdr(cell, lbm_enc_sym(SYM_ARRAY_TYPE));
cell = cell | PTR_TYPE_ARRAY;
cell = cell | LBM_PTR_TYPE_ARRAY;
*res = cell;

14
lispBM/src/lispbm.c
View File

@ -17,28 +17,28 @@
#include "lispbm.h"
int lispbm_init(cons_t *heap_storage, uint32_t heap_size,
int lbm_init(lbm_cons_t *heap_storage, uint32_t heap_size,
uint32_t *memory, uint32_t memory_size,
uint32_t *memory_bitmap, uint32_t bitmap_size) {
if (memory_init(memory, memory_size,
if (lbm_memory_init(memory, memory_size,
memory_bitmap, bitmap_size) == 0)
return 0;
if (symrepr_init() == 0)
if (lbm_symrepr_init() == 0)
return 0;
if (heap_init(heap_storage, heap_size) == 0)
if (lbm_heap_init(heap_storage, heap_size) == 0)
return 0;
if (env_init() == 0)
if (lbm_init_env() == 0)
return 0;
if (eval_cps_init() == 0)
if (lbm_eval_init() == 0)
return 0;
if (extensions_init() == 0)
if (lbm_extensions_init() == 0)
return 0;
return 1;

6
lispBM/src/lispbm.mk
View File

@ -1,6 +0,0 @@

10
lispBM/src/lispbm_memory.c
View File

@ -40,7 +40,7 @@ static uint32_t memory_size; // in 4 byte words
static uint32_t bitmap_size; // in 4 byte words
static unsigned int memory_base_address = 0;
int memory_init(uint32_t *data, uint32_t data_size,
int lbm_memory_init(uint32_t *data, uint32_t data_size,
uint32_t *bits, uint32_t bits_size) {
if (data == NULL || bits == NULL) return 0;
@ -95,11 +95,11 @@ static inline void set_status(unsigned int i, uint32_t status) {
bitmap[word_ix] |= mask;
}
uint32_t memory_num_words(void) {
uint32_t lbm_memory_num_words(void) {
return memory_size;
}
uint32_t memory_num_free(void) {
uint32_t lbm_memory_num_free(void) {
if (memory == NULL || bitmap == NULL) {
return 0;
}
@ -141,7 +141,7 @@ uint32_t memory_num_free(void) {
return sum_length;
}
uint32_t *memory_allocate(uint32_t num_words) {
uint32_t *lbm_memory_allocate(uint32_t num_words) {
if (memory == NULL || bitmap == NULL) {
return NULL;
@ -208,7 +208,7 @@ uint32_t *memory_allocate(uint32_t num_words) {
return NULL;
}
int memory_free(uint32_t *ptr) {
int lbm_memory_free(uint32_t *ptr) {
unsigned int ix = address_to_bitmap_ix(ptr);
switch(status(ix)) {
case START:

10
lispBM/src/prelude.c
View File

@ -1,5 +1,5 @@
/*
Copyright 2019 Joel Svensson svenssonjoel@yahoo.se
Copyright 2019, 2022 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -25,6 +25,10 @@ char prelude[] = {
};
VALUE prelude_load(void) {
return tokpar_parse(prelude);
void prelude_load(lbm_tokenizer_string_state_t *state,
lbm_tokenizer_char_stream_t *stream) {
lbm_create_char_stream_from_string(state,
stream,
prelude);
}

142
lispBM/src/print.c
View File

@ -35,13 +35,14 @@
#define END_LIST 5
#define PRINT_DOT 6
static VALUE stack_storage[PRINT_STACK_SIZE];
static lbm_value stack_storage[PRINT_STACK_SIZE];
int print_value(char *buf,unsigned int len, VALUE t) {
const char *failed_str = "Error: print failed\n";
stack s;
stack_create(&s, stack_storage, PRINT_STACK_SIZE);
const char *failed_str = "Error: print failed\n";
int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
lbm_stack_t s;
lbm_stack_create(&s, stack_storage, PRINT_STACK_SIZE);
int r = 0;
unsigned int n = 0;
@ -49,19 +50,19 @@ int print_value(char *buf,unsigned int len, VALUE t) {
const char *str_ptr;
int res;
push_u32_2(&s, t, PRINT);
lbm_push_u32_2(&s, t, PRINT);
while (!stack_is_empty(&s) && offset <= len - 5) {
while (!lbm_stack_is_empty(&s) && offset <= len - 5) {
VALUE curr;
UINT instr;
pop_u32(&s, &instr);
lbm_value curr;
lbm_uint instr;
lbm_pop_u32(&s, &instr);
switch(instr) {
case START_LIST: {
res = 1;
pop_u32(&s, &curr);
lbm_pop_u32(&s, &curr);
r = snprintf(buf + offset, len - offset, "(");
if ( r >= 0 ) {
@ -72,23 +73,23 @@ int print_value(char *buf,unsigned int len, VALUE t) {
}
offset += n;
VALUE car_val = car(curr);
VALUE cdr_val = cdr(curr);
lbm_value car_val = lbm_car(curr);
lbm_value cdr_val = lbm_cdr(curr);
if (type_of(cdr_val) == PTR_TYPE_CONS) {
res &= push_u32(&s, cdr_val);
res &= push_u32(&s, CONTINUE_LIST);
} else if (type_of(cdr_val) == VAL_TYPE_SYMBOL &&
dec_sym(cdr_val) == SYM_NIL) {
res &= push_u32(&s, END_LIST);
if (lbm_type_of(cdr_val) == LBM_PTR_TYPE_CONS) {
res &= lbm_push_u32(&s, cdr_val);
res &= lbm_push_u32(&s, CONTINUE_LIST);
} else if (lbm_type_of(cdr_val) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(cdr_val) == SYM_NIL) {
res &= lbm_push_u32(&s, END_LIST);
} else {
res &= push_u32(&s, END_LIST);
res &= push_u32(&s, cdr_val);
res &= push_u32(&s, PRINT);
res &= push_u32(&s, PRINT_DOT);
res &= lbm_push_u32(&s, END_LIST);
res &= lbm_push_u32(&s, cdr_val);
res &= lbm_push_u32(&s, PRINT);
res &= lbm_push_u32(&s, PRINT_DOT);
}
res &= push_u32(&s, car_val);
res &= push_u32(&s, PRINT);
res &= lbm_push_u32(&s, car_val);
res &= lbm_push_u32(&s, PRINT);
if (!res) {
snprintf(buf, len, "Error: Out of print stack\n");
@ -100,15 +101,15 @@ int print_value(char *buf,unsigned int len, VALUE t) {
case CONTINUE_LIST: {
res = 1;
pop_u32(&s, &curr);
lbm_pop_u32(&s, &curr);
if (type_of(curr) == VAL_TYPE_SYMBOL &&
dec_sym(curr) == SYM_NIL) {
if (lbm_type_of(curr) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(curr) == SYM_NIL) {
break;
}
VALUE car_val = car(curr);
VALUE cdr_val = cdr(curr);
lbm_value car_val = lbm_car(curr);
lbm_value cdr_val = lbm_cdr(curr);
r = snprintf(buf + offset, len - offset, " ");
if ( r > 0) {
@ -119,20 +120,20 @@ int print_value(char *buf,unsigned int len, VALUE t) {
}
offset += n;
if (type_of(cdr_val) == PTR_TYPE_CONS) {
res &= push_u32(&s, cdr_val);
res &= push_u32(&s, CONTINUE_LIST);
} else if (type_of(cdr_val) == VAL_TYPE_SYMBOL &&
dec_sym(cdr_val) == SYM_NIL) {
res &= push_u32(&s, END_LIST);
if (lbm_type_of(cdr_val) == LBM_PTR_TYPE_CONS) {
res &= lbm_push_u32(&s, cdr_val);
res &= lbm_push_u32(&s, CONTINUE_LIST);
} else if (lbm_type_of(cdr_val) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(cdr_val) == SYM_NIL) {
res &= lbm_push_u32(&s, END_LIST);
} else {
res &= push_u32(&s, END_LIST);
res &= push_u32(&s, cdr_val);
res &= push_u32(&s, PRINT);
res &= push_u32(&s, PRINT_DOT);
res &= lbm_push_u32(&s, END_LIST);
res &= lbm_push_u32(&s, cdr_val);
res &= lbm_push_u32(&s, PRINT);
res &= lbm_push_u32(&s, PRINT_DOT);
}
res &= push_u32(&s, car_val);
res &= push_u32(&s, PRINT);
res &= lbm_push_u32(&s, car_val);
res &= lbm_push_u32(&s, PRINT);
if (!res) {
snprintf(buf, len, "Error: Out of print stack\n");
return -1;
@ -174,14 +175,14 @@ int print_value(char *buf,unsigned int len, VALUE t) {
case PRINT:
pop_u32(&s, &curr);
lbm_pop_u32(&s, &curr);
switch(type_of(curr)) {
switch(lbm_type_of(curr)) {
case PTR_TYPE_CONS:{
case LBM_PTR_TYPE_CONS:{
res = 1;
res &= push_u32(&s, curr);
res &= push_u32(&s, START_LIST);
res &= lbm_push_u32(&s, curr);
res &= lbm_push_u32(&s, START_LIST);
if (!res) {
snprintf(buf, len, "Error: Out of print stack\n");
return -1;
@ -189,7 +190,7 @@ int print_value(char *buf,unsigned int len, VALUE t) {
break;
}
case PTR_TYPE_REF:
case LBM_PTR_TYPE_REF:
r = snprintf(buf + offset, len - offset, "_ref_");
if ( r > 0) {
n = (unsigned int) r;
@ -200,8 +201,8 @@ int print_value(char *buf,unsigned int len, VALUE t) {
offset += n;
break;
case PTR_TYPE_BOXED_F: {
VALUE uv = car(curr);
case LBM_PTR_TYPE_BOXED_F: {
lbm_value uv = lbm_car(curr);
float v;
memcpy(&v, &uv, sizeof(float)); // = *(float*)(&uv);
r = snprintf(buf + offset, len - offset, "{%"PRI_FLOAT"}", (double)v);
@ -215,8 +216,8 @@ int print_value(char *buf,unsigned int len, VALUE t) {
break;
}
case PTR_TYPE_BOXED_U: {
VALUE v = car(curr);
case LBM_PTR_TYPE_BOXED_U: {
lbm_value v = lbm_car(curr);
r = snprintf(buf + offset, len - offset, "{%"PRI_UINT"}", v);
if ( r > 0) {
n = (unsigned int) r;
@ -228,8 +229,8 @@ int print_value(char *buf,unsigned int len, VALUE t) {
break;
}
case PTR_TYPE_BOXED_I: {
int32_t v = (int32_t)car(curr);
case LBM_PTR_TYPE_BOXED_I: {
int32_t v = (int32_t)lbm_car(curr);
r = snprintf(buf + offset, len - offset, "{%"PRI_INT"}", v);
if ( r > 0) {
n = (unsigned int) r;
@ -241,10 +242,10 @@ int print_value(char *buf,unsigned int len, VALUE t) {
break;
}
case PTR_TYPE_ARRAY: {
array_header_t *array = (array_header_t *)car(curr);
case LBM_PTR_TYPE_ARRAY: {
lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(curr);
switch (array->elt_type){
case VAL_TYPE_CHAR:
case LBM_VAL_TYPE_CHAR:
r = snprintf(buf + offset, len - offset, "\"%s\"", (char *)(array)+8);
if ( r > 0) {
n = (unsigned int) r;
@ -261,9 +262,9 @@ int print_value(char *buf,unsigned int len, VALUE t) {
}
break;
}
case PTR_TYPE_SYMBOL_INDIRECTION: {
UINT v = dec_symbol_indirection(curr);
r = snprintf(buf + offset, len - offset, "*%"PRI_UINT"*", v);
case LBM_PTR_TYPE_STREAM: {
r = snprintf(buf + offset, len - offset, "~STREAM~");
if ( r > 0) {
n = (unsigned int) r;
} else {
@ -273,12 +274,11 @@ int print_value(char *buf,unsigned int len, VALUE t) {
offset += n;
break;
}
case VAL_TYPE_SYMBOL:
str_ptr = symrepr_lookup_name(dec_sym(curr));
case LBM_VAL_TYPE_SYMBOL:
str_ptr = lbm_get_name_by_symbol(lbm_dec_sym(curr));
if (str_ptr == NULL) {
snprintf(buf, len, "Error: Symbol not in table %"PRI_UINT"", dec_sym(curr));
snprintf(buf, len, "Error: Symbol not in table %"PRI_UINT"", lbm_dec_sym(curr));
return -1;
}
r = snprintf(buf + offset, len - offset, "%s", str_ptr);
@ -291,8 +291,8 @@ int print_value(char *buf,unsigned int len, VALUE t) {
offset += n;
break; //Break VAL_TYPE_SYMBOL
case VAL_TYPE_I:
r = snprintf(buf + offset, len - offset, "%"PRI_INT"", dec_i(curr));
case LBM_VAL_TYPE_I:
r = snprintf(buf + offset, len - offset, "%"PRI_INT"", lbm_dec_i(curr));
if ( r > 0) {
n = (unsigned int) r;
} else {
@ -302,8 +302,8 @@ int print_value(char *buf,unsigned int len, VALUE t) {
offset += n;
break;
case VAL_TYPE_U:
r = snprintf(buf + offset, len - offset, "%"PRI_UINT"", dec_u(curr));
case LBM_VAL_TYPE_U:
r = snprintf(buf + offset, len - offset, "%"PRI_UINT"", lbm_dec_u(curr));
if ( r > 0) {
n = (unsigned int) r;
} else {
@ -313,8 +313,8 @@ int print_value(char *buf,unsigned int len, VALUE t) {
offset += n;
break;
case VAL_TYPE_CHAR:
r = snprintf(buf + offset, len - offset, "\\#%c", dec_char(curr));
case LBM_VAL_TYPE_CHAR:
r = snprintf(buf + offset, len - offset, "\\#%c", lbm_dec_char(curr));
if ( r > 0) {
n = (unsigned int) r;
} else {
@ -338,7 +338,7 @@ int print_value(char *buf,unsigned int len, VALUE t) {
}//While not empty stack
if (!stack_is_empty(&s)) {
if (!lbm_stack_is_empty(&s)) {
snprintf(buf + (len - 5), 4, "...");
buf[len-1] = 0;
return (int)len;

92
lispBM/src/qq_expand.c
View File

@ -31,17 +31,17 @@
#include "qq_expand.h"
VALUE gen_cons(VALUE a, VALUE b) {
return cons(enc_sym(SYM_CONS),
cons(a,
cons(b, enc_sym(SYM_NIL))));
lbm_value gen_cons(lbm_value a, lbm_value b) {
return lbm_cons(lbm_enc_sym(SYM_CONS),
lbm_cons(a,
lbm_cons(b, lbm_enc_sym(SYM_NIL))));
}
VALUE append(VALUE front, VALUE back) {
return cons (enc_sym(SYM_APPEND),
cons(front,
cons(back, enc_sym(SYM_NIL))));
lbm_value append(lbm_value front, lbm_value back) {
return lbm_cons (lbm_enc_sym(SYM_APPEND),
lbm_cons(front,
lbm_cons(back, lbm_enc_sym(SYM_NIL))));
}
/* Bawden's qq-expand-list implementation
@ -61,33 +61,33 @@ VALUE append(VALUE front, VALUE back) {
(else `'(,x))))
*/
VALUE qq_expand_list(VALUE l) {
VALUE res = enc_sym(SYM_NIL);
VALUE car_val;
VALUE cdr_val;
lbm_value qq_expand_list(lbm_value l) {
lbm_value res = lbm_enc_sym(SYM_NIL);
lbm_value car_val;
lbm_value cdr_val;
switch (type_of(l)) {
case PTR_TYPE_CONS:
car_val = car(l);
cdr_val = cdr(l);
if (type_of(car_val) == VAL_TYPE_SYMBOL &&
dec_sym(car_val) == SYM_COMMA) {
res = cons(enc_sym(SYM_LIST),
cons(car(cdr_val), res));
} else if (type_of(car_val) == VAL_TYPE_SYMBOL &&
dec_sym(car_val) == SYM_COMMAAT) {
res = car(cdr_val);
switch (lbm_type_of(l)) {
case LBM_PTR_TYPE_CONS:
car_val = lbm_car(l);
cdr_val = lbm_cdr(l);
if (lbm_type_of(car_val) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(car_val) == SYM_COMMA) {
res = lbm_cons(lbm_enc_sym(SYM_LIST),
lbm_cons(lbm_car(cdr_val), res));
} else if (lbm_type_of(car_val) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(car_val) == SYM_COMMAAT) {
res = lbm_car(cdr_val);
} else {
VALUE expand_car = qq_expand_list(car_val);
VALUE expand_cdr = qq_expand(cdr_val);
res = cons(enc_sym(SYM_LIST),
cons(append(expand_car, expand_cdr), enc_sym(SYM_NIL)));
lbm_value expand_car = qq_expand_list(car_val);
lbm_value expand_cdr = lbm_qq_expand(cdr_val);
res = lbm_cons(lbm_enc_sym(SYM_LIST),
lbm_cons(append(expand_car, expand_cdr), lbm_enc_sym(SYM_NIL)));
}
break;
default: {
VALUE a_list = cons(l, enc_sym(SYM_NIL));
lbm_value a_list = lbm_cons(l, lbm_enc_sym(SYM_NIL));
res =
cons(enc_sym(SYM_QUOTE), cons (a_list, enc_sym(SYM_NIL)));
lbm_cons(lbm_enc_sym(SYM_QUOTE), lbm_cons (a_list, lbm_enc_sym(SYM_NIL)));
}
}
return res;
@ -109,30 +109,30 @@ VALUE qq_expand_list(VALUE l) {
(else `',x)))
*/
VALUE qq_expand(VALUE qquoted) {
lbm_value lbm_qq_expand(lbm_value qquoted) {
VALUE res;
VALUE car_val;
VALUE cdr_val;
lbm_value res;
lbm_value car_val;
lbm_value cdr_val;
switch (type_of(qquoted)) {
case PTR_TYPE_CONS:
car_val = car(qquoted);
cdr_val = cdr(qquoted);
if (type_of(car_val) == VAL_TYPE_SYMBOL &&
dec_sym(car_val) == SYM_COMMA) {
res = car(cdr_val);
} else if (type_of(car_val) == VAL_TYPE_SYMBOL &&
dec_sym(car_val) == SYM_COMMAAT) {
res = enc_sym(SYM_RERROR); // should have a more specific error here.
switch (lbm_type_of(qquoted)) {
case LBM_PTR_TYPE_CONS:
car_val = lbm_car(qquoted);
cdr_val = lbm_cdr(qquoted);
if (lbm_type_of(car_val) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(car_val) == SYM_COMMA) {
res = lbm_car(cdr_val);
} else if (lbm_type_of(car_val) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(car_val) == SYM_COMMAAT) {
res = lbm_enc_sym(SYM_RERROR); // should have a more specific error here.
} else {
VALUE expand_car = qq_expand_list(car_val);
VALUE expand_cdr = qq_expand(cdr_val);
lbm_value expand_car = qq_expand_list(car_val);
lbm_value expand_cdr = lbm_qq_expand(cdr_val);
res = append(expand_car, expand_cdr);
}
break;
default:
res = cons(enc_sym(SYM_QUOTE), cons(qquoted, enc_sym(SYM_NIL)));
res = lbm_cons(lbm_enc_sym(SYM_QUOTE), lbm_cons(qquoted, lbm_enc_sym(SYM_NIL)));
break;
}
return res;

44
lispBM/src/stack.c
View File

@ -22,8 +22,8 @@
#include "print.h"
#include "lispbm_memory.h"
int stack_allocate(stack *s, unsigned int stack_size) {
s->data = memory_allocate(stack_size);
int lbm_stack_allocate(lbm_stack_t *s, unsigned int stack_size) {
s->data = lbm_memory_allocate(stack_size);
s->sp = 0;
s->size = stack_size;
s->max_sp = 0;
@ -32,7 +32,7 @@ int stack_allocate(stack *s, unsigned int stack_size) {
return 0;
}
int stack_create(stack *s, UINT* data, unsigned int size) {
int lbm_stack_create(lbm_stack_t *s, lbm_uint* data, unsigned int size) {
s->data = data;
s->sp = 0;
s->size = size;
@ -40,24 +40,24 @@ int stack_create(stack *s, UINT* data, unsigned int size) {
return 1;
}
void stack_free(stack *s) {
void lbm_stack_free(lbm_stack_t *s) {
if (s->data) {
memory_free(s->data);
lbm_memory_free(s->data);
}
}
int stack_clear(stack *s) {
int lbm_stack_clear(lbm_stack_t *s) {
s->sp = 0;
return 1;
}
UINT *stack_ptr(stack *s, unsigned int n) {
lbm_uint *lbm_get_stack_ptr(lbm_stack_t *s, unsigned int n) {
if (n > s->sp) return NULL;
unsigned int index = s->sp - n;
return &s->data[index];
}
int stack_drop(stack *s, unsigned int n) {
int lbm_stack_drop(lbm_stack_t *s, unsigned int n) {
if (n > s->sp) return 0;
@ -65,7 +65,7 @@ int stack_drop(stack *s, unsigned int n) {
return 1;
}
int push_u32(stack *s, UINT val) {
int lbm_push_u32(lbm_stack_t *s, lbm_uint val) {
int res = 1;
if (s->sp == s->size) {
return 0;
@ -81,32 +81,10 @@ int push_u32(stack *s, UINT val) {
return res;
}
int push_k(stack *s, VALUE (*k)(VALUE)) {
int res = 1;
if ( s->sp == s->size) {
return 0;
}
if (!res) return res;
s->data[s->sp] = (UINT)k;
s->sp++;
if (s->sp > s->max_sp) s->max_sp = s->sp;
return res;
}
int pop_u32(stack *s, UINT *val) {
int lbm_pop_u32(lbm_stack_t *s, lbm_uint *val) {
s->sp--;
*val = s->data[s->sp];
return 1;
}
int pop_k(stack *s, VALUE (**k)(VALUE)) {
s->sp--;
*k = (VALUE (*)(VALUE))s->data[s->sp];
s->data[s->sp] = 0;
return 1;
}

20
lispBM/src/streams.c
View File

@ -1,5 +1,5 @@
/*
Copyright 2021 Joel Svensson svenssonjoel@yahoo.se
Copyright 2021, 2022 Joel Svensson svenssonjoel@yahoo.se
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@ -18,30 +18,30 @@
#include "streams.h"
#include "heap.h"
VALUE stream_get(stream_t *str) {
lbm_value lbm_stream_get(lbm_stream_t *str) {
return str->get(str);
}
VALUE stream_more(stream_t *str) {
lbm_value lbm_stream_more(lbm_stream_t *str) {
return str->more(str);
}
VALUE stream_peek(stream_t *str, VALUE n) {
lbm_value lbm_stream_peek(lbm_stream_t *str, lbm_value n) {
return str->peek(str,n);
}
VALUE stream_drop(stream_t *str, VALUE n) {
lbm_value lbm_stream_drop(lbm_stream_t *str, lbm_value n) {
return str->drop(str,n);
}
VALUE stream_put(stream_t *str, VALUE v) {
lbm_value lbm_stream_put(lbm_stream_t *str, lbm_value v) {
return str->put(str,v);
}
VALUE stream_create(stream_t *str) {
VALUE s = cons((VALUE)str, enc_sym(SYM_STREAM_TYPE));
if (type_of(s) == PTR_TYPE_CONS) {
set_ptr_type(s, SYM_TYPE_STREAM);
lbm_value lbm_stream_create(lbm_stream_t *str) {
lbm_value s = lbm_cons((lbm_value)str, lbm_enc_sym(SYM_TYPE_STREAM));
if (lbm_type_of(s) == LBM_PTR_TYPE_CONS) {
s = s | LBM_PTR_TYPE_STREAM;
}
return s;
}

54
lispBM/src/symrepr.c
View File

@ -24,7 +24,7 @@
#include "symrepr.h"
#include "lispbm_memory.h"
#define NUM_SPECIAL_SYMBOLS 80
#define NUM_SPECIAL_SYMBOLS 89
#define NAME 0
#define ID 1
@ -32,7 +32,7 @@
typedef struct {
const char *name;
const UINT id;
const lbm_uint id;
} special_sym;
special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
@ -45,8 +45,10 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"let" , SYM_LET},
{"define" , SYM_DEFINE},
{"progn" , SYM_PROGN},
{"comma" , SYM_COMMA},
{"splice" , SYM_COMMAAT},
{"read" , SYM_READ},
{"read-program" , SYM_READ_PROGRAM},
//{"comma" , SYM_COMMA}, // should not be accessible to programmer
//{"splice" , SYM_COMMAAT},
{"match" , SYM_MATCH},
{"_" , SYM_DONTCARE},
{"send" , SYM_SEND},
@ -57,7 +59,7 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"?float" , SYM_MATCH_FLOAT},
{"?cons" , SYM_MATCH_CONS},
// Special symbols with unparseable names
// Special symbols with unparsable names
{"no_match" , SYM_NO_MATCH},
{"read_error" , SYM_RERROR},
{"type_error" , SYM_TERROR},
@ -76,6 +78,15 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"sym_nonsense" , SYM_NONSENSE},
{"variable_not_bound" , SYM_NOT_FOUND},
// tokenizer symbols with unparsable names
{"sym_openpar" , SYM_OPENPAR},
{"sym_closepar" , SYM_CLOSEPAR},
{"sym_backquote" , SYM_BACKQUOTE},
{"sym_comma" , SYM_COMMA},
{"sym_commaat" , SYM_COMMAAT},
{"sym_dot" , SYM_DOT},
{"sym_tok_done" , SYM_TOKENIZER_DONE},
// special symbols with parseable names
{"type-list" , SYM_TYPE_LIST},
{"type-i28" , SYM_TYPE_I28},
@ -87,7 +98,7 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"type-symbol" , SYM_TYPE_SYMBOL},
{"type-char" , SYM_TYPE_CHAR},
{"type-ref" , SYM_TYPE_REF},
{"type-stream" , SYM_TYPE_STREAM},
// Fundamental operations
{"+" , SYM_ADD},
{"-" , SYM_SUB},
@ -98,6 +109,7 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"<" , SYM_LT},
{">" , SYM_GT},
{"eval" , SYM_EVAL},
{"eval-program" , SYM_EVAL_PROGRAM},
{"and" , SYM_AND},
{"or" , SYM_OR},
{"not" , SYM_NOT},
@ -126,9 +138,9 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
static uint32_t *symlist = NULL;
static UINT next_symbol_id = 0;
static lbm_uint next_symbol_id = 0;
bool symrepr_init(void) {
bool lbm_symrepr_init(void) {
symlist = NULL;
next_symbol_id = 0;
return true;
@ -140,12 +152,12 @@ void symrepr_del(void) {
while (curr) {
uint32_t *tmp = curr;
curr = (uint32_t*)curr[NEXT];
memory_free((uint32_t*)tmp[NAME]);
memory_free(tmp);
lbm_memory_free((uint32_t*)tmp[NAME]);
lbm_memory_free(tmp);
}
}
const char *lookup_symrepr_name_memory(UINT id) {
const char *lookup_symrepr_name_memory(lbm_uint id) {
uint32_t *curr = symlist;
while (curr) {
@ -158,7 +170,7 @@ const char *lookup_symrepr_name_memory(UINT id) {
}
// Lookup symbol name given a symbol id
const char *symrepr_lookup_name(UINT id) {
const char *lbm_get_name_by_symbol(lbm_uint id) {
if (id < MAX_SPECIAL_SYMBOLS) {
for (int i = 0; i < NUM_SPECIAL_SYMBOLS; i ++) {
if (id == special_symbols[i].id) {
@ -170,7 +182,7 @@ const char *symrepr_lookup_name(UINT id) {
}
// Lookup symbol id given symbol name
int symrepr_lookup(char *name, UINT* id) {
int lbm_get_symbol_by_name(char *name, lbm_uint* id) {
// loop through special symbols
for (int i = 0; i < NUM_SPECIAL_SYMBOLS; i ++) {
@ -192,13 +204,13 @@ int symrepr_lookup(char *name, UINT* id) {
return 0;
}
int symrepr_addsym(char *name, UINT* id) {
int lbm_add_symbol(char *name, lbm_uint* id) {
size_t n = 0;
n = strlen(name) + 1;
if (n == 1) return 0; // failure if empty symbol
uint32_t *m = memory_allocate(3);
uint32_t *m = lbm_memory_allocate(3);
if (m == NULL) {
return 0;
@ -206,13 +218,13 @@ int symrepr_addsym(char *name, UINT* id) {
char *symbol_name_storage = NULL;;
if (n % 4 == 0) {
symbol_name_storage = (char *)memory_allocate(n/4);
symbol_name_storage = (char *)lbm_memory_allocate(n/4);
} else {
symbol_name_storage = (char *)memory_allocate((n/4) + 1);
symbol_name_storage = (char *)lbm_memory_allocate((n/4) + 1);
}
if (symbol_name_storage == NULL) {
memory_free(m);
lbm_memory_free(m);
return 0;
}
@ -232,10 +244,10 @@ int symrepr_addsym(char *name, UINT* id) {
return 1;
}
int symrepr_addsym_const(char *name, UINT* id) {
int lbm_add_symbol_const(char *name, lbm_uint* id) {
if (strlen(name) == 0) return 0; // failure if empty symbol
uint32_t *m = memory_allocate(3);
uint32_t *m = lbm_memory_allocate(3);
if (m == NULL) {
return 0;
@ -255,7 +267,7 @@ int symrepr_addsym_const(char *name, UINT* id) {
return 1;
}
unsigned int symrepr_size(void) {
unsigned int lbm_get_symbol_table_size(void) {
unsigned int n = 0;
uint32_t *curr = symlist;

713
lispBM/src/tokpar.c
View File

@ -66,13 +66,19 @@ static void clear_sym_str(void) {
memset(sym_str,0,TOKENIZER_MAX_SYMBOL_AND_STRING_LENGTH);
}
static bool stack_ok = true;
typedef struct {
#ifdef TOKPAR_CHECK_STACK
#define CHECK_STACK() if (!TOKPAR_CHECK_STACK()) {stack_ok = false;} if (!stack_ok) {return enc_sym(SYM_STACK_ERROR);}
#else
#define CHECK_STACK()
#endif
unsigned int type;
unsigned int text_len;
union {
char c;
char *text;
lbm_int i;
lbm_uint u;
lbm_float f;
}data;
} token;
typedef struct {
const char *str;
@ -80,28 +86,6 @@ typedef struct {
uint32_t len;
} matcher;
typedef struct {
unsigned int type;
unsigned int text_len;
union {
char c;
char *text;
INT i;
UINT u;
FLOAT f;
} data;
} token;
typedef struct {
token tok;
char *str;
unsigned int pos;
bool (*more)(void);
char (*get)(void);
char (*peek)(unsigned int n);
void (*drop)(unsigned int n);
} parser_state;
#define NUM_FIXED_SIZE_TOKENS 13
const matcher match_table[NUM_FIXED_SIZE_TOKENS] = {
{"(", TOKOPENPAR, 1},
@ -119,30 +103,25 @@ const matcher match_table[NUM_FIXED_SIZE_TOKENS] = {
{"?", TOKMATCHANY, 1}
};
static parser_state ts;
bool more_local(void) {
return ts.str[ts.pos] != 0;
bool more(lbm_tokenizer_char_stream_t *str) {
return str->more(str);
}
char get_local(void) {
return ts.str[ts.pos++];
char get(lbm_tokenizer_char_stream_t *str) {
return str->get(str);
}
char peek_local(unsigned int n) {
return ts.str[ts.pos + n];
char peek(lbm_tokenizer_char_stream_t *str, unsigned int n) {
return str->peek(str,n);
}
void drop_local(unsigned int n) {
ts.pos = ts.pos + n;
void drop(lbm_tokenizer_char_stream_t *str, unsigned int n) {
str->drop(str,n);
}
#define more() ts.more()
#define get() ts.get()
#define peek(n) ts.peek(n)
#define drop(n) ts.drop(n)
static uint32_t tok_match_fixed_size_tokens(void) {
uint32_t tok_match_fixed_size_tokens(lbm_tokenizer_char_stream_t *str) {
for (int i = 0; i < NUM_FIXED_SIZE_TOKENS; i ++) {
uint32_t tok_len = match_table[i].len;
const char *match_str = match_table[i].str;
@ -150,17 +129,17 @@ static uint32_t tok_match_fixed_size_tokens(void) {
uint32_t char_pos;
for (char_pos = 0; char_pos < tok_len; char_pos ++) {
if (peek(char_pos) != match_str[char_pos]) break;
if (peek(str,char_pos) != match_str[char_pos]) break;
}
if (char_pos == tok_len) { //match
drop(tok_len);
drop(str,tok_len);
return tok;
}
}
return NOTOKEN;
}
static bool symchar0(char c) {
bool symchar0(char c) {
const char *allowed = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/=<>";
int i = 0;
@ -170,7 +149,7 @@ static bool symchar0(char c) {
return false;
}
static bool symchar(char c) {
bool symchar(char c) {
const char *allowed = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-*/=<>";
int i = 0;
@ -180,14 +159,15 @@ static bool symchar(char c) {
return false;
}
static int tok_symbol(void) {
if (!symchar0(peek(0))) return 0;
int tok_symbol(lbm_tokenizer_char_stream_t *str) {
if (!symchar0(peek(str,0))) return 0;
unsigned int i = 0;
unsigned int len = 1;
int n = 0;
while (symchar((peek(len)))) {
while (symchar((peek(str,len)))) {
len++;
}
@ -199,7 +179,7 @@ static int tok_symbol(void) {
int c = 0;
for (i = 0; i < len; i ++) {
c = tolower(get());
c = tolower(get(str));
if (c >= 0 && c <= 255) {
sym_str[i] = (char)c;
n++;
@ -210,18 +190,19 @@ static int tok_symbol(void) {
return (int)n;
}
static int tok_string(void) {
int tok_string(lbm_tokenizer_char_stream_t *str) {
unsigned int i = 0;
int n = 0;
unsigned int len = 0;
if (!(peek(0) == '\"')) return 0;
if (!(peek(str,0) == '\"')) return 0;
get(); // remove the " char
get(str); // remove the " char
n++;
// compute length of string
while (peek(len) != 0 &&
peek(len) != '\"') {
while (peek(str,len) != 0 &&
peek(str,len) != '\"') {
len++;
}
@ -229,456 +210,422 @@ static int tok_string(void) {
return -1; /* TODO: specific error code that can be presented to user */
// str ends before tokenized string is closed.
if ((peek(len)) != '\"') {
if ((peek(str,len)) != '\"') {
return 0;
}
clear_sym_str();
for (i = 0; i < len; i ++) {
sym_str[i] = get();
sym_str[i] = get(str);
n++;
}
get(); // throw away the "
get(str); // throw away the "
return (int)(n+1);
}
static int tok_char(char *res) {
int tok_char(lbm_tokenizer_char_stream_t *str, char *res) {
int count = 0;
if (peek(0) == '\\' &&
peek(1) == '#' &&
peek(2) == 'n' &&
peek(3) == 'e' &&
peek(4) == 'w' &&
peek(5) == 'l' &&
peek(6) == 'i' &&
peek(7) == 'n' &&
peek(8) == 'e') {
if (peek(str,0) == '\\' &&
peek(str,1) == '#' &&
peek(str,2) == 'n' &&
peek(str,3) == 'e' &&
peek(str,4) == 'w' &&
peek(str,5) == 'l' &&
peek(str,6) == 'i' &&
peek(str,7) == 'n' &&
peek(str,8) == 'e') {
*res = '\n';
drop(9);
drop(str,9);
count = 9;
} else if (peek(0) == '\\' &&
peek(1) == '#' &&
isgraph(peek(2))) {
*res = peek(2);
drop(3);
} else if (peek(str,0) == '\\' &&
peek(str,1) == '#' &&
isgraph(peek(str,2))) {
*res = peek(str,2);
drop(str,3);
count = 3;
}
return count;
}
static int tok_i(INT *res) {
INT acc = 0;
unsigned int n = 0;
int tok_i(lbm_tokenizer_char_stream_t *str, lbm_int *res) {
while ( peek(n) >= '0' && peek(n) <= '9' ) {
acc = (acc*10) + (peek(n) - '0');
lbm_int acc = 0;
unsigned int n = 0;
bool negative = false;
bool valid_num = false;
if (peek(str, 0) == '-') {
n = 1;
negative = true;
}
while ( peek(str,n) >= '0' && peek(str,n) <= '9' ){
acc = (acc*10) + (peek(str,n) - '0');
n++;
}
if ((negative && n > 1) ||
(!negative && n > 0)) valid_num = true;
// Not needed if strict adherence to ordering of calls to tokenizers.
if (peek(n) == 'U' ||
peek(n) == 'u' ||
peek(n) == '.' ||
peek(n) == 'I') return 0;
if (peek(str,n) == 'U' ||
peek(str,n) == 'u' ||
peek(str,n) == '.' ||
peek(str,n) == 'I') return 0;
drop(n);
*res = acc;
return (int)n; /*check that isnt so high that it becomes a negative number when casted */
if (valid_num) {
drop(str,n);
*res = negative ? -acc : acc;
return (int)n; /*check that isnt so high that it becomes a negative number when casted */
}
return 0;
}
static int tok_I(INT *res) {
INT acc = 0;
int tok_I(lbm_tokenizer_char_stream_t *str, lbm_int *res) {
lbm_int acc = 0;
unsigned int n = 0;
bool negative = false;
bool valid_num = false;
while ( peek(n) >= '0' && peek(n) <= '9' ) {
acc = (acc*10) + (peek(n) - '0');
n++;
if (peek(str, 0) == '-') {
n = 1;
negative = true;
}
if (peek(n) == 'i' &&
peek(n+1) == '3' &&
peek(n+2) == '2') {
*res = acc;
drop(n+3);
while ( peek(str,n) >= '0' && peek(str,n) <= '9' ){
acc = (acc*10) + (peek(str,n) - '0');
n++;
}
if ((negative && n > 1) ||
(!negative && n > 0)) valid_num = true;
if (peek(str,n) == 'i' &&
peek(str,n+1) == '3' &&
peek(str,n+2) == '2' &&
valid_num) {
*res = negative ? -acc : acc;
drop(str,n+3);
return (int)(n+3);
}
return 0;
}
static int tok_u(UINT *res) {
UINT acc = 0;
int tok_u(lbm_tokenizer_char_stream_t *str, lbm_uint *res) {
lbm_uint acc = 0;
unsigned int n = 0;
bool negative = false;
bool valid_num = false;
while ( peek(n) >= '0' && peek(n) <= '9' ){
acc = (acc*10) + (UINT)(peek(n) - '0');
n++;
if (peek(str, 0) == '-') {
n = 1;
negative = true;
}
if (peek(n) == 'u' &&
peek(n+1) == '2' &&
peek(n+2) == '8' ) {
*res = acc;
drop(n+3);
while ( peek(str,n) >= '0' && peek(str,n) <= '9' ){
acc = (acc*10) + (lbm_uint)(peek(str,n) - '0');
n++;
}
if ((negative && n > 1) ||
(!negative && n > 0)) valid_num = true;
if (peek(str,n) == 'u' &&
peek(str,n+1) == '2' &&
peek(str,n+2) == '8' &&
valid_num) {
*res = negative ? -acc : acc;
drop(str,n+3);
return (int)(n+3);
}
return 0;
}
static int tok_U(UINT *res) {
UINT acc = 0;
int tok_U(lbm_tokenizer_char_stream_t *str, lbm_uint *res) {
lbm_uint acc = 0;
unsigned int n = 0;
bool negative = false;
bool valid_num = false;
if (peek(str, 0) == '-') {
n = 1;
negative = true;
}
// Check if hex notation is used
if (peek(0) == '0' &&
(peek(1) == 'x' || peek(1) == 'X')) {
if (peek(str,0) == '0' &&
(peek(str,1) == 'x' || peek(str,1) == 'X')) {
n+= 2;
while ( (peek(n) >= '0' && peek(n) <= '9') ||
(peek(n) >= 'a' && peek(n) <= 'f') ||
(peek(n) >= 'A' && peek(n) <= 'F')){
UINT val;
if (peek(n) >= 'a' && peek(n) <= 'f') {
val = 10 + (UINT)(peek(n) - 'a');
} else if (peek(n) >= 'A' && peek(n) <= 'F') {
val = 10 + (UINT)(peek(n) - 'A');
while ( (peek(str,n) >= '0' && peek(str,n) <= '9') ||
(peek(str,n) >= 'a' && peek(str,n) <= 'f') ||
(peek(str,n) >= 'A' && peek(str,n) <= 'F')){
lbm_uint val;
if (peek(str,n) >= 'a' && peek(str,n) <= 'f') {
val = 10 + (lbm_uint)(peek(str,n) - 'a');
} else if (peek(str,n) >= 'A' && peek(str,n) <= 'F') {
val = 10 + (lbm_uint)(peek(str,n) - 'A');
} else {
val = (UINT)peek(n) - '0';
val = (lbm_uint)peek(str,n) - '0';
}
acc = (acc * 0x10) + val;
n++;
}
*res = acc;
drop(n);
return (int)n;
if ((negative && n > 1) ||
(!negative && n > 0)) valid_num = true;
if (valid_num) {
drop(str,n);
*res = negative ? -acc : acc;
return (int)n; /*check that isnt so high that it becomes a negative number when casted */
}
}
// check if nonhex
while ( peek(n) >= '0' && peek(n) <= '9' ){
acc = (acc*10) + (UINT)(peek(n) - '0');
while ( peek(str,n) >= '0' && peek(str,n) <= '9' ){
acc = (acc*10) + (lbm_uint)(peek(str,n) - '0');
n++;
}
if ((negative && n > 1) ||
(!negative && n > 0)) valid_num = true;
if (peek(n) == 'u' &&
peek(n+1) == '3' &&
peek(n+2) == '2') {
*res = acc;
drop(n+3);
if (peek(str,n) == 'u' &&
peek(str,n+1) == '3' &&
peek(str,n+2) == '2' &&
valid_num) {
*res = negative ? -acc : acc;
drop(str,n+3);
return (int)(n+3);
}
return 0;
}
static int tok_F(FLOAT *res) {
int tok_F(lbm_tokenizer_char_stream_t *str, lbm_float *res) {
unsigned int n = 0;
unsigned int m = 0;
char fbuf[128];
bool negative = false;
bool valid_num = false;
while ( peek(n) >= '0' && peek(n) <= '9') n++;
if (peek(str, 0) == '-') {
n = 1;
negative = true;
}
if ( peek(n) == '.') n++;
while ( peek(str,n) >= '0' && peek(str,n) <= '9') n++;
if ( peek(str,n) == '.') n++;
else return 0;
if ( !(peek(n) >= '0' && peek(n) <= '9')) return 0;
while ( peek(n) >= '0' && peek(n) <= '9') n++;
if ( !(peek(str,n) >= '0' && peek(str,n) <= '9')) return 0;
while ( peek(str,n) >= '0' && peek(str,n) <= '9') n++;
if ((negative && n > 1) ||
(!negative && n > 0)) valid_num = true;
if (n > 127) m = 127;
else m = n;
unsigned int i;
char fbuf[m + 1];
for (i = 0; i < m; i ++) {
fbuf[i] = get();
if(valid_num) {
unsigned int i;
for (i = 0; i < m; i ++) {
fbuf[i] = get(str);
}
fbuf[i] = 0;
*res = (float)strtod(fbuf, NULL);
return (int)n;
}
fbuf[i] = 0;
*res = (float)strtod(fbuf, NULL);
return (int)n;
return 0;
}
static token next_token(void) {
token t;
lbm_value lbm_get_next_token(lbm_tokenizer_char_stream_t *str) {
if (!more()) {
t.type = TOKENIZER_END;
return t;
lbm_int i_val;
lbm_uint u_val;
char c_val;
lbm_float f_val;
int n = 0;
if (!more(str)) {
return lbm_enc_sym(SYM_TOKENIZER_DONE);
}
// Eat whitespace and comments.
bool clean_whitespace = true;
while ( clean_whitespace ){
if ( peek(0) == ';' ) {
while ( more() && peek( 0) != '\n') {
drop(1);
if ( peek(str,0) == ';' ) {
while ( more(str) && peek(str, 0) != '\n') {
drop(str,1);
}
} else if ( isspace(peek(0))) {
drop(1);
} else if ( isspace(peek(str,0))) {
drop(str,1);
} else {
clean_whitespace = false;
}
}
// Check for end of string again
if (!more()) {
t.type = TOKENIZER_END;
return t;
if (!more(str)) {
return lbm_enc_sym(SYM_TOKENIZER_DONE);
}
uint32_t match;;
match = tok_match_fixed_size_tokens();
lbm_value res = lbm_enc_sym(SYM_RERROR);
uint32_t match;
match = tok_match_fixed_size_tokens(str);
if (match > 0) {
t.type = match;
return t;
switch (match) {
case TOKOPENPAR:
res = lbm_enc_sym(SYM_OPENPAR);
break;
case TOKCLOSEPAR:
res = lbm_enc_sym(SYM_CLOSEPAR);
break;
case TOKDOT:
res = lbm_enc_sym(SYM_DOT);
break;
case TOKDONTCARE:
res = lbm_enc_sym(SYM_DONTCARE);
break;
case TOKQUOTE:
res = lbm_enc_sym(SYM_QUOTE);
break;
case TOKBACKQUOTE:
res = lbm_enc_sym(SYM_BACKQUOTE);
break;
case TOKCOMMAAT:
res = lbm_enc_sym(SYM_COMMAAT);
break;
case TOKCOMMA:
res = lbm_enc_sym(SYM_COMMA);
break;
case TOKMATCHI28:
res = lbm_enc_sym(SYM_MATCH_I28);
break;
case TOKMATCHU28:
res = lbm_enc_sym(SYM_MATCH_U28);
break;
case TOKMATCHFLOAT:
res = lbm_enc_sym(SYM_MATCH_FLOAT);
break;
case TOKMATCHCONS:
res = lbm_enc_sym(SYM_MATCH_CONS);
break;
case TOKMATCHANY:
res = lbm_enc_sym(SYM_MATCH_ANY);
break;
default:
break;
}
return res;
}
int n = tok_symbol();
if (n > 0) {
t.text_len = (unsigned int)n;
t.type = TOKSYMBOL;
return t;
} else if (n < 0) {
t.type = TOKENIZER_ERROR;
return t;
}
char c_val;
if (tok_char(&c_val)) {
t.data.c = c_val;
t.type = TOKCHAR;
return t;
}
n = tok_string();
n = tok_string(str);
if (n >= 2) {
t.text_len = (unsigned int)n - 2;
t.type = TOKSTRING;
return t;
// TODO: Proper error checking here!
lbm_heap_allocate_array(&res, (unsigned int)(n-2)+1, LBM_VAL_TYPE_CHAR);
lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res);
char *data = (char *)arr + 8;
memset(data, 0, (unsigned int)((n-2)+1) * sizeof(char));
memcpy(data, sym_str, (unsigned int)(n - 2) * sizeof(char));
return res;
} else if (n < 0) {
t.type = TOKENIZER_ERROR;
return t;
// The string is too long error
return res;
}
FLOAT f_val;
if (tok_F(&f_val)) {
t.data.f = f_val;
t.type = TOKBOXEDFLOAT;
return t;
if (tok_F(str, &f_val)) {
// Will be SYM_MERROR in case of full heap
return lbm_enc_F(f_val);
}
UINT u_val;
if (tok_U(&u_val)) {
t.data.u = u_val;
t.type = TOKBOXEDUINT;
return t;
if (tok_U(str, &u_val)) {
// Will be SYM_MERROR in case of full heap
return lbm_enc_U(u_val);
}
if (tok_u(&u_val)) {
t.data.u = u_val;
t.type = TOKUINT;
return t;
if (tok_u(str, &u_val)) {
return lbm_enc_u(u_val);
}
INT i_val;
if (tok_I(&i_val)) {
t.data.i = i_val;
t.type = TOKBOXEDINT;
return t;
if (tok_I(str, &i_val)) {
return lbm_enc_I(i_val);
}
// Shortest form of integer match. Move to last in chain of numerical tokens.
if (tok_i(&i_val)) {
t.data.i = i_val;
t.type = TOKINT;
return t;
if (tok_i(str, &i_val)) {
return lbm_enc_i(i_val);
}
t.type = TOKENIZER_ERROR;
return t;
}
n = tok_symbol(str);
if (n > 0) {
static VALUE tokpar_parse_program(void);
static VALUE parse_sexp(void);
static VALUE parse_sexp_list(void);
lbm_uint symbol_id;
static VALUE tokpar_parse_program(void) {
CHECK_STACK();
ts.tok = next_token();
if (ts.tok.type == TOKENIZER_ERROR) {
return enc_sym(SYM_RERROR);
}
if (ts.tok.type == TOKENIZER_END) {
return enc_sym(SYM_NIL);
}
return cons(parse_sexp(), tokpar_parse_program());
}
static VALUE parse_sexp(void) {
CHECK_STACK();
switch (ts.tok.type) {
case TOKENIZER_END:
return enc_sym(SYM_RERROR);
case TOKENIZER_ERROR:
return enc_sym(SYM_RERROR);
case TOKOPENPAR: {
ts.tok = next_token();
return parse_sexp_list();
}
case TOKDONTCARE:
return enc_sym(SYM_DONTCARE);
case TOKMATCHANY:
return enc_sym(SYM_MATCH_ANY);
case TOKMATCHI28:
return enc_sym(SYM_MATCH_I28);
case TOKMATCHU28:
return enc_sym(SYM_MATCH_U28);
case TOKMATCHFLOAT:
return enc_sym(SYM_MATCH_FLOAT);
case TOKMATCHCONS:
return enc_sym(SYM_MATCH_CONS);
case TOKSYMBOL: {
UINT symbol_id;
VALUE v;
if (symrepr_lookup(sym_str, &symbol_id)) {
v = enc_sym(symbol_id);
if (lbm_get_symbol_by_name(sym_str, &symbol_id)) {
res = lbm_enc_sym(symbol_id);
}
else if (symrepr_addsym(sym_str, &symbol_id)) {
v = enc_sym(symbol_id);
else if (lbm_add_symbol(sym_str, &symbol_id)) {
res = lbm_enc_sym(symbol_id);
} else {
v = enc_sym(SYM_RERROR);
res = lbm_enc_sym(SYM_RERROR);
}
return v;
return res;
} else if (n < 0) {
// Symbol string is too long error
return res;
}
case TOKSTRING: {
VALUE v;
heap_allocate_array(&v, ts.tok.text_len+1, VAL_TYPE_CHAR);
array_header_t *arr = (array_header_t*)car(v);
char *data = (char *)arr + 8;
memset(data, 0, (ts.tok.text_len+1) * sizeof(char));
memcpy(data, sym_str, ts.tok.text_len * sizeof(char));
return v;
if (tok_char(str, &c_val)) {
return lbm_enc_char(c_val);
}
case TOKINT:
return enc_i(ts.tok.data.i);
case TOKUINT:
return enc_u(ts.tok.data.u);
case TOKCHAR:
return enc_char(ts.tok.data.c);
case TOKBOXEDINT:
return set_ptr_type(cons((VALUE)ts.tok.data.i, enc_sym(SYM_BOXED_I_TYPE)), PTR_TYPE_BOXED_I);
case TOKBOXEDUINT:
return set_ptr_type(cons(ts.tok.data.u, enc_sym(SYM_BOXED_U_TYPE)), PTR_TYPE_BOXED_U);
case TOKBOXEDFLOAT:
return set_ptr_type(cons(ts.tok.data.u, enc_sym(SYM_BOXED_F_TYPE)), PTR_TYPE_BOXED_F);
case TOKQUOTE: {
ts.tok = next_token();
VALUE quoted = parse_sexp();
if (type_of(quoted) == VAL_TYPE_SYMBOL &&
dec_sym(quoted) == SYM_RERROR) return quoted;
return cons(enc_sym(SYM_QUOTE), cons (quoted, enc_sym(SYM_NIL)));
}
case TOKBACKQUOTE: {
ts.tok = next_token();
VALUE quoted = parse_sexp();
if (type_of(quoted) == VAL_TYPE_SYMBOL &&
dec_sym(quoted) == SYM_RERROR) return quoted;
VALUE expanded = qq_expand(quoted);
if (type_of(expanded) == VAL_TYPE_SYMBOL &&
symrepr_is_error(dec_sym(expanded))) return expanded;
return expanded;
}
case TOKCOMMAAT: {
ts.tok = next_token();
VALUE splice = parse_sexp();
if (type_of(splice) == VAL_TYPE_SYMBOL &&
dec_sym(splice) == SYM_RERROR) return splice;
return cons(enc_sym(SYM_COMMAAT), cons (splice, enc_sym(SYM_NIL)));
}
case TOKCOMMA: {
ts.tok = next_token();
VALUE unquoted = parse_sexp();
if (type_of(unquoted) == VAL_TYPE_SYMBOL &&
dec_sym(unquoted) == SYM_RERROR) return unquoted;
return cons(enc_sym(SYM_COMMA), cons (unquoted, enc_sym(SYM_NIL)));
}
}
return enc_sym(SYM_RERROR);
return res;
}
static VALUE parse_sexp_list(void) {
CHECK_STACK();
switch (ts.tok.type) {
case TOKENIZER_END:
return enc_sym(SYM_RERROR);
case TOKENIZER_ERROR:
return enc_sym(SYM_RERROR);
case TOKCLOSEPAR:
return enc_sym(SYM_NIL);
default: {
VALUE head = parse_sexp();
ts.tok = next_token();
VALUE tail;
if (ts.tok.type == TOKDOT) {
ts.tok = next_token();
tail = parse_sexp();
ts.tok = next_token();
if (ts.tok.type != TOKCLOSEPAR) {
return enc_sym(SYM_RERROR);
}
} else {
tail = parse_sexp_list();
}
if ((type_of(head) == VAL_TYPE_SYMBOL &&
dec_sym(head) == SYM_RERROR ) ||
(type_of(tail) == VAL_TYPE_SYMBOL &&
dec_sym(tail) == SYM_RERROR )) return enc_sym(SYM_RERROR);
return cons(head, tail);
}
}
return enc_sym(SYM_RERROR);
bool more_string(lbm_tokenizer_char_stream_t *str) {
lbm_tokenizer_string_state_t *s =
(lbm_tokenizer_string_state_t *)str->state;
return s->str[s->pos] != 0;
}
VALUE tokpar_parse(char *string) {
stack_ok = true;
ts.str = string;
ts.pos = 0;
ts.more = more_local;
ts.get = get_local;
ts.peek = peek_local;
ts.drop = drop_local;
VALUE v = tokpar_parse_program();
CHECK_STACK();
return v;
char get_string(lbm_tokenizer_char_stream_t *str) {
lbm_tokenizer_string_state_t *s =
(lbm_tokenizer_string_state_t *)str->state;
char c = s->str[s->pos];
s->pos = s->pos + 1;
return c;
}
VALUE tokpar_parse_stream(
bool (*more)(void),
char (*get)(void),
char (*peek)(unsigned int n),
void (*drop)(unsigned int n)) {
stack_ok = true;
ts.str = 0;
ts.pos = 0;
ts.more = more;
ts.get = get;
ts.peek = peek;
ts.drop = drop;
VALUE v = tokpar_parse_program();
CHECK_STACK();
return v;
char peek_string(lbm_tokenizer_char_stream_t *str, unsigned int n) {
lbm_tokenizer_string_state_t *s =
(lbm_tokenizer_string_state_t *)str->state;
// TODO error checking ?? how ?
char c = s->str[s->pos + n];
return c;
}
void drop_string(lbm_tokenizer_char_stream_t *str, unsigned int n) {
lbm_tokenizer_string_state_t *s =
(lbm_tokenizer_string_state_t *)str->state;
s->pos = s->pos + n;
}
void lbm_create_char_stream_from_string(lbm_tokenizer_string_state_t *state,
lbm_tokenizer_char_stream_t *char_stream,
char *string){
state->str = string;
state->pos = 0;
char_stream->state = state;
char_stream->more = more_string;
char_stream->peek = peek_string;
char_stream->drop = drop_string;
char_stream->get = get_string;
}
/* VALUE tokpar_parse(tokenizer_char_stream_t *char_stream) { */
/* return tokpar_parse_program(char_stream); */
/* } */

12
lispBM/src/visual/heap_vis.c
View File

@ -34,8 +34,8 @@ int heap_vis_init(void) {
void heap_vis_gen_image(void) {
heap_state_t hs;
heap_get_state(&hs);
lbm_heap_state_t hs;
lbm_get_heap_state(&hs);
uint32_t num_pix = hs.heap_size;
uint32_t i;
@ -58,7 +58,7 @@ void heap_vis_gen_image(void) {
if ((cdr & GC_MASK) == GC_MARKED) {
if ((cdr & LBM_GC_MASK) == LBM_GC_MARKED) {
col = marked_color;
}
@ -67,10 +67,10 @@ void heap_vis_gen_image(void) {
uint32_t fl = hs.freelist;
while (type_of(fl) == PTR_TYPE_CONS) {
uint32_t index = dec_ptr(fl);
while (lbm_type_of(fl) == LBM_PTR_TYPE_CONS) {
uint32_t index = lbm_dec_ptr(fl);
pix_data[index] = free_color;
fl = cdr(fl);
fl = lbm_cdr(fl);
}
char fn[256];

6
lispBM/tests/LispLoader.qml
View File

@ -51,9 +51,9 @@ Item {
// mLogReader.openLogFile("example_control_servo_from_duty.lisp")
// mLogReader.openLogFile("example_print_bms_data.lisp")
// mLogReader.openLogFile("example_can_pos_follow.lisp")
// mLogReader.openLogFile("example_speed_test.lisp")
mLogReader.openLogFile("test_math.lisp")
mLogReader.openLogFile("example_speed_test.lisp")
//
// mLogReader.openLogFile("test_math.lisp")
mCommands.qmlUiErase()
if (Utility.waitSignal(mCommands, "2eraseQmluiResReceived(bool)", 4000)) {

3
lispBM/tests/example_can_pos_follow.lisp
View File

@ -4,6 +4,9 @@
(progn
(define itcnt (+ itcnt 1))
(canset-pos 124 (get-encoder))
(define canc (canget-current-dir 124))
(set-servo (- 0.5 (* 0.02 canc)))
(timeout-reset)
(yield 2000)
(f)
)))

2
lispBM/tests/example_duty.lisp
View File

@ -15,7 +15,7 @@
(yield (/ 1000000 rate))
(if (> x 1.0) (define upcnt (- rampstep) nil))
(if (< x (- 1.0)) (define upcnt rampstep) nil)
(if (< x -1.0) (define upcnt rampstep) nil)
(f (+ x upcnt))
)))) (f 0))

22
lispBM/tests/example_speed_test.lisp
View File

@ -18,11 +18,31 @@
(if (> x 0) (dec-cnt3 (- (- (- (- (- (- (- x 1) 1) 1) 1) 1) 1) 1)) 0)
))
(define tak (lambda (x y z)
(if (not (< y x))
z
(tak
(tak (- x 1) y z)
(tak (- y 1) z x)
(tak (- z 1) x y)))))
(define fib (lambda (n)
(if (< n 3) 1
(+ (fib (- n 1)) (fib (- n 2))))))
(define q2 (lambda (x y)
(if (or (< x 1) (< y 1)) 1
(+ (q2 (- x (q2 (- x 1) y)) y)
(q2 x (- y (q2 x (- y 1))))))))
(define f (lambda ()
(progn
(define start (systime))
(dec-cnt2 100000)
;(dec-cnt3 100000)
(define takres (tak 18 12 6))
;(define fibres (fib 23))
;(define q2res (q2 7 8))
(print (list "Seconds elapsed: " (secs-since start)))
(yield 2000000)