mirror of https://github.com/rusefi/bldc.git
Lisp
This commit is contained in:
parent
1b802ebe8f
commit
2d28ccbb05
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
#include "lispbm_memory.h"
|
||||
#include "env.h"
|
||||
|
||||
extern int lispbm_init(cons_t *heap_storage, uint32_t heap_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);
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 \
|
||||
|
|
|
@ -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(" ");
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
|
@ -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
120
lispBM/src/env.c
|
@ -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;
|
||||
}
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -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;
|
||||
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -1,6 +0,0 @@
|
|||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -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:
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -35,33 +35,34 @@
|
|||
#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) {
|
||||
|
||||
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;
|
||||
unsigned int offset = 0;
|
||||
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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
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 */
|
||||
}
|
||||
|
||||
static int tok_I(INT *res) {
|
||||
INT acc = 0;
|
||||
unsigned int n = 0;
|
||||
|
||||
while ( peek(n) >= '0' && peek(n) <= '9' ) {
|
||||
acc = (acc*10) + (peek(n) - '0');
|
||||
n++;
|
||||
return 0;
|
||||
}
|
||||
|
||||
if (peek(n) == 'i' &&
|
||||
peek(n+1) == '3' &&
|
||||
peek(n+2) == '2') {
|
||||
*res = acc;
|
||||
drop(n+3);
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
if(valid_num) {
|
||||
unsigned int i;
|
||||
char fbuf[m + 1];
|
||||
for (i = 0; i < m; i ++) {
|
||||
fbuf[i] = get();
|
||||
fbuf[i] = get(str);
|
||||
}
|
||||
|
||||
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) {
|
||||
|
||||
lbm_uint symbol_id;
|
||||
|
||||
if (lbm_get_symbol_by_name(sym_str, &symbol_id)) {
|
||||
res = lbm_enc_sym(symbol_id);
|
||||
}
|
||||
|
||||
static VALUE tokpar_parse_program(void);
|
||||
static VALUE parse_sexp(void);
|
||||
static VALUE parse_sexp_list(void);
|
||||
|
||||
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);
|
||||
}
|
||||
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;
|
||||
}
|
||||
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;
|
||||
}
|
||||
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;
|
||||
} else if (n < 0) {
|
||||
// Symbol string is too long error
|
||||
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);
|
||||
if (tok_char(str, &c_val)) {
|
||||
return lbm_enc_char(c_val);
|
||||
}
|
||||
|
||||
} else {
|
||||
tail = parse_sexp_list();
|
||||
return res;
|
||||
}
|
||||
|
||||
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); */
|
||||
/* } */
|
||||
|
||||
|
|
|
@ -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];
|
||||
|
|
|
@ -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)) {
|
||||
|
|
|
@ -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)
|
||||
)))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue