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

Merge commit '0af11fc9828cba7cbd121f40a3c8058a3e534a26'

This commit is contained in:
Benjamin Vedder 2022-02-01 20:40:07 +01:00
parent 66f6c2e2f0 0af11fc982
commit 17a0b66e5b
45 changed files with 762 additions and 452 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lispBM/lispBM/benchmarks/bench_chibi/Makefile
View File

@ -128,7 +128,7 @@ LBMSRC = ../../src/compression.c \
../../src/extensions.c \
../../src/fundamental.c \
../../src/heap.c \
../../src/lispbm_memory.c \
../../src/lbm_memory.c \
../../src/prelude.c \
../../src/print.c \
../../src/qq_expand.c \

3
lispBM/lispBM/chibios-examples/repl-ChibiOS/Makefile
View File

@ -128,7 +128,7 @@ LBMSRC = ../../src/compression.c \
../../src/extensions.c \
../../src/fundamental.c \
../../src/heap.c \
../../src/lispbm_memory.c \
../../src/lbm_memory.c \
../../src/prelude.c \
../../src/print.c \
../../src/qq_expand.c \
@ -137,6 +137,7 @@ LBMSRC = ../../src/compression.c \
../../src/symrepr.c \
../../src/tokpar.c \
../../src/lispbm.c \
../../src/lbm_c_interop.c \
../../platform/chibios/src/platform_mutex.c
CSRC = $(ALLCSRC) \

3
lispBM/lispBM/chibios-examples/xmas_dac/Makefile
View File

@ -128,7 +128,7 @@ LBMSRC = ../../src/env.c \
../../src/extensions.c \
../../src/fundamental.c \
../../src/heap.c \
../../src/lispbm_memory.c \
../../src/lbm_memory.c \
../../src/prelude.c \
../../src/print.c \
../../src/qq_expand.c \
@ -137,6 +137,7 @@ LBMSRC = ../../src/env.c \
../../src/symrepr.c \
../../src/tokpar.c \
../../src/lispbm.c \
../../src/lbm_c_interop.c \
../../platform/chibios/src/platform_mutex.c
CSRC = $(ALLCSRC) \

144
lispBM/lispBM/doc/lbmref.dox
View File

@ -397,11 +397,56 @@ The expression above evaluates to 3 with the side effect that the global environ
has been extended with the binding <code>(apa 1)</code>.
---
\section sec_lists Lists
<a name="car"> <h3>car</h3> </a>
---
<a name="cdr"> <h3>cdr</h3> </a>
---
<a name="cons"> <h3>cons</h3> </a>
---
<a name="list"> <h3>list</h3> </a>
---
<a name="append"> <h3>append</h3> </a>
---
<a name="ix"> <h3>ix</h3> </a>
---
<a name="set-car"> <h3>set-car</h3> </a>
---
<a name="set-cdr"> <h3>set-cdr</h3> </a>
\section sec_arrays Arrays
<a name="array-read"> <h3>array-read</h3> </a>
---
<a name="array-write"> <h3>array-write</h3> </a>
---
\section sec_pattern Pattern-matching
<a name="match"> <h3>match</h3> </a>
<a name="match"> <h3>match</h3> </a>
Pattern-matching is expressed using match. The form of a match expression is
<code>(match expr (pat1 expr1) ... (patN exprN))</code>. Pattern-matching compares
@ -451,7 +496,7 @@ An example that evaluates to 19.
(match '(orange 17)
((green (? n)) (+ n 1))
((orange (? n)) (+ n 2))
((blue (?n)) (+ n 3)))
((blue (? n)) (+ n 3)))
\endcode
---
@ -543,40 +588,6 @@ An example that evaluates to 19.
---
<a name="car"> <h3>car</h3> </a>
---
<a name="cdr"> <h3>cdr</h3> </a>
---
<a name="cons"> <h3>cons</h3> </a>
---
<a name="list"> <h3>list</h3> </a>
---
<a name="append"> <h3>append</h3> </a>
---
<a name="array-read"> <h3>array-read</h3> </a>
---
<a name="array-write"> <h3>array-write</h3> </a>
---
<a name="array-create"> <h3>array-create</h3> </a>
---
<a name="type-of"> <h3>type-of</h3> </a>
---
@ -597,14 +608,6 @@ An example that evaluates to 19.
---
<a name="set-car"> <h3>set-car</h3> </a>
---
<a name="set-cdr"> <h3>set-cdr</h3> </a>
---
<a name="is-fundamental"> <h3>is-fundamental</h3> </a>
---
@ -711,4 +714,55 @@ An example that evaluates to 19.
<a name="sym_nonsense"> <h3>sym_nonsense</h3> </a>
---
*/
\section sec_low_level Low level operations
<a name="encode-i32"> <h3>encode-i32</h3> </a>
---
<a name="encode-u32"> <h3>encode-u32</h3> </a>
---
<a name="encode-float"> <h3>encode-float</h3> </a>
---
<a name="decode"> <h3>decode</h3> </a>
---
*/
<a name="array-create"> <h3>array-create</h3> </a>
---
\section sec_streams Streams
<a name="stream-get"> <h3>stream-get</h3> </a>
---
<a name="stream-more"> <h3>stream-more</h3> </a>
---
<a name="stream-peek"> <h3>stream-peek</h3> </a>
---
<a name="stream-drop"> <h3>stream-drop</h3> </a>
---
<a name="stream-put"> <h3>stream-put</h3> </a>
---

3
lispBM/lispBM/include/compression.h
View File

@ -21,7 +21,8 @@
#include <stdint.h>
#include <stdbool.h>
#include "lispbm_types.h"
#include "lbm_types.h"
typedef struct {
uint32_t compressed_bits;

2
lispBM/lispBM/include/env.h
View File

@ -19,7 +19,7 @@
#ifndef ENV_H_
#define ENV_H_
#include "lispbm_types.h"
#include "lbm_types.h"
//environment interface
/** Initialize the global environment. This sets the global environment to NIL

69
lispBM/lispBM/include/eval_cps.h
View File

@ -18,8 +18,8 @@
#ifndef EVAL_CPS_H_
#define EVAL_CPS_H_
#include "lbm_types.h"
#include "stack.h"
#include "lispbm_types.h"
#define EVAL_CPS_STATE_INIT 0
#define EVAL_CPS_STATE_PAUSED 1
@ -111,6 +111,11 @@ extern void lbm_run_eval(void);
* return value EVAL_CPS_STATE_PAUSED.
*/
extern void lbm_pause_eval(void);
/** Pause the evaluator and perform GC if needed.
*
* \param num_free Perform GC if there are less than this many elements free on the heap.
*/
extern void lbm_pause_eval_with_gc(uint32_t num_free);
/** Perform a single step of evaluation.
* The evaluator should be in EVAL_CPS_STATE_PAUSED before running this function.
* After taking one step of evaluation, the evaluator will return to being in the
@ -131,6 +136,15 @@ extern void lbm_kill_eval(void);
*/
extern uint32_t lbm_get_eval_state(void);
/** Create a context and enqueue it as runnable.
*
* \param program The program to evaluate in the context.
* \param env An initial environment.
* \param stack_size Stack size for the context.
* \return
*/
extern lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, uint32_t stack_size);
/* statistics interface */
/** Iterate over all ready contexts and apply function on each context.
*
@ -176,54 +190,19 @@ 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 */
/** Load and schedule a program for execution.
/** Create a token stream for parsing for code
*
* \param tokenizer The tokenizer to read the program from.
* \return A context id on success or 0 on failure.
* \param str character stream to convert into a token stream.
* \return token stream.
*/
extern lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer);
/** Load and schedule an expression for execution.
*
* \param tokenizer The tokenizer to read the expression from.
* \return A context id on success or 0 on failure.
*/
extern lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer);
/** Load a program and bind it to a symbol in the environment.
*
* \param tokenizer The tokenizer to read the program from.
* \param symbol A string with the name you want the binding to have in the environment.
* \return A context id on success or 0 on failure.
*/
extern lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol);
/** Load an expression and bind it to a symbol in the environment.
*
* \param tokenizer The tokenizer to read the expression from.
* \param symbol A string with the name you want the binding to have in the environment.
* \return A context id on success or 0 on failure.
*/
extern lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol);
extern lbm_value lbm_create_token_stream(lbm_tokenizer_char_stream_t *str);
/* Evaluating a definition in a new context */
/** Create a context for a bound expression and schedule it for execution
/** deliver a message
*
* \param symbol The name of the binding to schedule for execution.
* \return A context if on success or 0 on failure.
* \param cid Process to deliver to.
* \param msg Message to deliver
* \return lbm_enc_sym(SYM_NIL) on failure and lbm_enc_sym(SYM_TRUE) on success.
*/
extern lbm_cid lbm_eval_defined_expression(char *symbol);
/** Create a context for a bound program and schedule it for execution
*
* \param symbol The name of the binding to schedule for execution.
* \return A context if on success or 0 on failure.
*/
extern lbm_cid lbm_eval_defined_program(char *symbol);
lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg);
/* send message from c to LBM process */
/** Send a message to a process running in the evaluator.
*
* \param cid Context id of the process to send a message to.
* \param msg lbm_value that will be sent to the process.
* \return 1 on success or 0 on failure.
*/
extern int lbm_send_message(lbm_cid cid, lbm_value msg);
#endif

2
lispBM/lispBM/include/extensions.h
View File

@ -22,7 +22,7 @@
#include "symrepr.h"
#include "heap.h"
#include "lispbm_types.h"
#include "lbm_types.h"
/** Type representing an extension function.
* \param Pointer to array of lbm_values.

21
lispBM/lispBM/include/heap.h
View File

@ -20,7 +20,8 @@
#define HEAP_H_
#include <string.h>
#include "lispbm_types.h"
#include "lbm_types.h"
#include "symrepr.h"
#include "streams.h"
@ -205,11 +206,12 @@ Aux bits could be used for storing vector size. Up to 30bits should be available
#define LBM_VAL_MASK 0xFFFFFFF0u
#define LBM_VAL_TYPE_MASK 0x0000000Cu
// gc ptr
// gc ptr
#define LBM_VAL_TYPE_SYMBOL 0x00000000u // 00 0 0
/// Character or byte.
#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
#define LBM_VAL_TYPE_U 0x00000008u // 10 0 0
#define LBM_VAL_TYPE_I 0x0000000Cu // 11 0 0
/** Struct representing a heap cons-cell.
*
@ -247,8 +249,9 @@ typedef struct {
* The header portion of an array stored in array and symbol memory.
*/
typedef struct {
lbm_type elt_type; // Type of elements: VAL_TYPE_FLOAT, U, I or CHAR
uint32_t size; // Number of elements
lbm_type elt_type; /// Type of elements: VAL_TYPE_FLOAT, U, I or CHAR
uint32_t size; /// Number of elements
uint32_t *data; /// pointer to lbm_memory array or C array.
} lbm_array_header_t;
/** Initialize heap storage.
@ -557,11 +560,17 @@ 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_VAL_TYPE_CHAR) ||
(t == LBM_PTR_TYPE_BOXED_I) ||
(t == LBM_PTR_TYPE_BOXED_U) ||
(t == LBM_PTR_TYPE_BOXED_F));
}
static inline bool lbm_is_char(lbm_value x) {
lbm_uint t = lbm_type_of(x);
return (t == LBM_VAL_TYPE_CHAR);
}
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));

93
lispBM/lispBM/include/lbm_c_interop.h Normal file
View File

@ -0,0 +1,93 @@
/*
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
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/>.
*/
/** \file lbm_c_interop.h */
#ifndef LBM_C_INTEROP_H_
#define LBM_C_INTEROP_H_
#include "env.h"
#include "symrepr.h"
#include "eval_cps.h"
#include "heap.h"
#include "streams.h"
#include "tokpar.h"
#include "lbm_memory.h"
#include "heap.h"
#include "lbm_types.h"
/** Load and schedule a program for execution.
*
* \param tokenizer The tokenizer to read the program from.
* \return A context id on success or 0 on failure.
*/
extern lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer);
/** Load and schedule an expression for execution.
*
* \param tokenizer The tokenizer to read the expression from.
* \return A context id on success or 0 on failure.
*/
extern lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer);
/** Load a program and bind it to a symbol in the environment.
*
* \param tokenizer The tokenizer to read the program from.
* \param symbol A string with the name you want the binding to have in the environment.
* \return A context id on success or 0 on failure.
*/
extern lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol);
/** Load an expression and bind it to a symbol in the environment.
*
* \param tokenizer The tokenizer to read the expression from.
* \param symbol A string with the name you want the binding to have in the environment.
* \return A context id on success or 0 on failure.
*/
extern lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol);
/* Evaluating a definition in a new context */
/** Create a context for a bound expression and schedule it for execution
*
* \param symbol The name of the binding to schedule for execution.
* \return A context if on success or 0 on failure.
*/
extern lbm_cid lbm_eval_defined_expression(char *symbol);
/** Create a context for a bound program and schedule it for execution
*
* \param symbol The name of the binding to schedule for execution.
* \return A context if on success or 0 on failure.
*/
extern lbm_cid lbm_eval_defined_program(char *symbol);
/** Send a message to a process running in the evaluator.
*
* \param cid Context id of the process to send a message to.
* \param msg lbm_value that will be sent to the process.
* \return 1 on success or 0 on failure.
*/
extern int lbm_send_message(lbm_cid cid, lbm_value msg);
/** Add a definition to the global environment
*
* \param symbol Name to bind the data to.
* \param value The data.
* \return 1 on success and 0 on failure.
*/
extern int lbm_define(char *symbol, lbm_value value);
#endif

9
lispBM/lispBM/include/lispbm_memory.h → lispBM/lispBM/include/lbm_memory.h
View File

@ -1,4 +1,4 @@
/** \file lispbm_memory.h */
/** \file lbm_memory.h */
/*
Copyright 2020, 2022 Joel Svensson svenssonjoel@yahoo.se
@ -133,4 +133,11 @@ extern uint32_t *lbm_memory_allocate(uint32_t num_words);
*/
extern int lbm_memory_free(uint32_t *ptr);
/** Check if a pointer points into the lbm_memory
*
* \param ptr
* \return 1 for yes and 0 for no.
*/
extern int lbm_memory_ptr_inside(uint32_t *ptr);
#endif

2
lispBM/lispBM/include/lispbm_types.h → lispBM/lispBM/include/lbm_types.h
View File

@ -1,4 +1,4 @@
/** \file lispbm_types.h */
/** \file lbm_types.h */
/*
Copyright 2019 Joel Svensson svenssonjoel@yahoo.se

5
lispBM/lispBM/include/lispbm.h
View File

@ -27,10 +27,11 @@
#include "print.h"
#include "tokpar.h"
#include "prelude.h"
#include "lispbm_types.h"
#include "lispbm_memory.h"
#include "env.h"
#include "compression.h"
#include "lbm_memory.h"
#include "lbm_types.h"
#include "lbm_c_interop.h"
/** Initialize lispBM. This function initials all subsystems by calling:
* - \ref lbm_memory_init

2
lispBM/lispBM/include/prelude.h
View File

@ -19,7 +19,7 @@
#ifndef _PRELUDE_H_
#define _PRELUDE_H_
#include "lispbm_types.h"
#include "lbm_types.h"
/** Creates the tokenizer state needed to load the prelude library into the heap.
*

3
lispBM/lispBM/include/print.h
View File

@ -21,7 +21,8 @@
#define PRINT_H_
#include <stdint.h>
#include "lispbm_types.h"
#include "lbm_types.h"
/** Print an lbm_value into a buffer provided by the user.
* If printing fails, the buffer may contain an error message.

2
lispBM/lispBM/include/stack.h
View File

@ -24,7 +24,7 @@
#include <stdbool.h>
#include <stdio.h>
#include "lispbm_types.h"
#include "lbm_types.h"
typedef struct {
lbm_uint* data;

2
lispBM/lispBM/include/streams.h
View File

@ -24,7 +24,7 @@
#ifndef STREAMS_H_
#define STREAMS_H_
#include "lispbm_types.h"
#include "lbm_types.h"
typedef struct lbm_stream_s{
void *state; /* stream implementation dependent state */

16
lispBM/lispBM/include/symrepr.h
View File

@ -31,7 +31,7 @@
#include <stdint.h>
#include <stdbool.h>
#include "lispbm_types.h"
#include "lbm_types.h"
// Default and fixed symbol ids
#define SYM_NIL 0x0
@ -125,7 +125,7 @@
#define SYM_ARRAY_READ 0x130
#define SYM_ARRAY_WRITE 0x131
#define SYM_ARRAY_CREATE 0x132
//#define SYM_ARRAY_CREATE 0x132
#define SYM_SYMBOL_TO_STRING 0x140
#define SYM_STRING_TO_SYMBOL 0x141
@ -136,6 +136,18 @@
#define SYM_IS_FUNDAMENTAL 0x150
#define SYM_IX 0x151
#define SYM_ENCODE_I32 0x152
#define SYM_ENCODE_U32 0x153
#define SYM_ENCODE_FLOAT 0x154
#define SYM_DECODE 0x155
//#define SYM_STREAM_GET 0x160
//#define SYM_STREAM_MORE 0x161
//#define SYM_STREAM_PEEK 0x162
//#define SYM_STREAM_DROP 0x163
//#define SYM_STREAM_PUT 0x164
#define SYM_TYPE_OF 0x200
#define FUNDAMENTALS_END 0x200

2
lispBM/lispBM/include/tokpar.h
View File

@ -19,7 +19,7 @@
#ifndef TOKPAR_H_
#define TOKPAR_H_
#include "lispbm_types.h"
#include "lbm_types.h"
/**
* State struct for the string tokenizer.

5
lispBM/lispBM/lispbm.mk
View File

@ -3,7 +3,7 @@ first_rule: all
LISPBM_SRC = $(LISPBM)/src/env.c \
$(LISPBM)/src/fundamental.c \
$(LISPBM)/src/heap.c \
$(LISPBM)/src/lispbm_memory.c \
$(LISPBM)/src/lbm_memory.c \
$(LISPBM)/src/print.c \
$(LISPBM)/src/qq_expand.c \
$(LISPBM)/src/stack.c \
@ -14,7 +14,8 @@ LISPBM_SRC = $(LISPBM)/src/env.c \
$(LISPBM)/src/extensions.c \
$(LISPBM)/src/lispbm.c \
$(LISPBM)/src/eval_cps.c \
$(LISPBM)/src/streams.c
$(LISPBM)/src/streams.c \
$(LISPBM)/src/lbm_c_interop.c
LISPBM_INC = -I$(LISPBM)/include \
-I$(LISPBM)/src

2
lispBM/lispBM/src/compression.c
View File

@ -17,12 +17,12 @@
#include <stdlib.h>
#include <ctype.h>
#include <lbm_types.h>
#include <string.h>
#include <stdint.h>
#include <stdbool.h>
#include "compression.h"
#include "lispbm_types.h"
#include "tokpar.h"
#define KEY 0

2
lispBM/lispBM/src/env.c
View File

@ -15,12 +15,12 @@
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <lbm_types.h>
#include <stdio.h>
#include "symrepr.h"
#include "heap.h"
#include "print.h"
#include "lispbm_types.h"
lbm_value env_global;

218
lispBM/lispBM/src/eval_cps.c
View File

@ -15,6 +15,8 @@
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <lbm_memory.h>
#include <lbm_types.h>
#include "symrepr.h"
#include "heap.h"
#include "env.h"
@ -22,10 +24,8 @@
#include "stack.h"
#include "fundamental.h"
#include "extensions.h"
#include "lispbm_types.h"
#include "exp_kind.h"
#include "streams.h"
#include "lispbm_memory.h"
#include "tokpar.h"
#include "qq_expand.h"
@ -113,6 +113,7 @@ static lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember
static uint32_t eval_cps_run_state = EVAL_CPS_STATE_INIT;
volatile uint32_t eval_cps_next_state = EVAL_CPS_STATE_INIT;
volatile uint32_t eval_cps_next_state_arg = 0;
/*
On ChibiOs the CH_CFG_ST_FREQUENCY setting in chconf.h sets the
@ -195,7 +196,7 @@ static lbm_value token_stream_put(lbm_stream_t *str, lbm_value v){
return lbm_enc_sym(SYM_NIL);
}
lbm_value eval_cps_create_token_stream(lbm_tokenizer_char_stream_t *str) {
lbm_value lbm_create_token_stream(lbm_tokenizer_char_stream_t *str) {
lbm_stream_t *stream;
@ -244,8 +245,8 @@ lbm_value token_stream_from_string_value(lbm_value s) {
}
lbm_create_char_stream_from_string(tok_stream_state,
tok_stream,
str);
tok_stream,
str);
stream->state = (void*)tok_stream;
stream->more = token_stream_more;
@ -488,7 +489,7 @@ static void yield_ctx(uint32_t sleep_us) {
ctx_running = NULL;
}
static lbm_cid create_ctx(lbm_value program, lbm_value env, uint32_t stack_size) {
lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, uint32_t stack_size) {
if (next_ctx_id == 0) return 0; // overflow of CIDs
@ -546,7 +547,7 @@ static void advance_ctx(void) {
}
}
static lbm_value find_receiver_and_send(lbm_cid cid, lbm_value msg) {
lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg) {
eval_context_t *found = NULL;
found = lookup_ctx(&blocked, cid);
@ -818,7 +819,7 @@ static inline void eval_symbol(eval_context_t *ctx) {
if (lbm_is_special(ctx->curr_exp) ||
(lbm_get_extension(lbm_dec_sym(ctx->curr_exp)) != NULL)) {
// Special symbols and extension symbols evaluate to themself
// Special symbols and extension symbols evaluate to themselves
value = ctx->curr_exp;
} else {
// If not special, check if there is a binding in the environments
@ -1008,7 +1009,7 @@ static inline void eval_match(eval_context_t *ctx) {
rest == NIL) {
/* Someone wrote the program (match) */
ctx->app_cont = true;
ctx->r = lbm_enc_sym(SYM_NIL); /* make up new specific symbol? */
ctx->r = lbm_enc_sym(SYM_NIL);
return;
} else {
CHECK_STACK(lbm_push_u32_2(&ctx->K, lbm_cdr(rest), lbm_enc_u(MATCH)));
@ -1064,12 +1065,6 @@ static inline void eval_receive(eval_context_t *ctx) {
ctx_running = NULL;
ctx->r = lbm_enc_sym(SYM_NO_MATCH);
}
/* Match messages on mailbox against the patterns */
/* FATAL_ON_FAIL(ctx->done, push_u32_4(&ctx->K, ctx->curr_exp, car(cdr(pats)), cdr(msgs), enc_u(MATCH_MANY))); */
/* FATAL_ON_FAIL(ctx->done, push_u32_2(&ctx->K, car(cdr(pats)), enc_u(MATCH))); */
/* ctx->r = car(msgs); */
/* ctx->app_cont = true; */
}
}
return;
@ -1135,7 +1130,7 @@ static inline void cont_spawn_all(eval_context_t *ctx) {
lbm_value cid_list;
WITH_GC(cid_list, lbm_cons(cid_val, ctx->r), rest, env);
lbm_cid cid = create_ctx(lbm_car(rest),
lbm_cid cid = lbm_create_ctx(lbm_car(rest),
env,
EVAL_CPS_DEFAULT_STACK_SIZE);
if (!cid) {
@ -1299,7 +1294,7 @@ static inline void cont_application(eval_context_t *ctx) {
lbm_cid cid = (lbm_cid)lbm_dec_u(fun_args[1]);
lbm_value msg = fun_args[2];
WITH_GC(status, find_receiver_and_send(cid, msg), NIL, NIL);
WITH_GC(status, lbm_find_receiver_and_send(cid, msg), NIL, NIL);
}
}
/* return the status */
@ -1889,10 +1884,17 @@ static void evaluation_step(void){
return;
}
void lbm_pause_eval(void) {
void lbm_pause_eval(void ) {
eval_cps_next_state_arg = 0;
eval_cps_next_state = EVAL_CPS_STATE_PAUSED;
}
void lbm_pause_eval_with_gc(uint32_t num_free) {
eval_cps_next_state_arg = num_free;
eval_cps_next_state = EVAL_CPS_STATE_PAUSED;
}
void lbm_step_eval(void) {
eval_cps_next_state = EVAL_CPS_STATE_STEP;
}
@ -1917,6 +1919,7 @@ void lbm_run_eval(void){
while (eval_running) {
uint32_t prev_state = eval_cps_run_state;
eval_cps_run_state = eval_cps_next_state;
switch (eval_cps_run_state) {
@ -1927,6 +1930,12 @@ void lbm_run_eval(void){
eval_cps_next_state = EVAL_CPS_STATE_PAUSED;
break;
case EVAL_CPS_STATE_PAUSED:
if (prev_state != EVAL_CPS_STATE_PAUSED) {
if (lbm_heap_num_free() < eval_cps_next_state_arg) {
gc(NIL, NIL);
}
eval_cps_next_state_arg = 0;
}
eval_cps_next_state = EVAL_CPS_STATE_PAUSED;
usleep_callback(EVAL_CPS_MIN_SLEEP);
continue; /* jump back to start of eval_running loop */
@ -1977,11 +1986,11 @@ lbm_value evaluate_non_concurrent(void) {
}
lbm_cid lbm_eval_program(lbm_value lisp) {
return create_ctx(lisp, NIL, 256);
return lbm_create_ctx(lisp, NIL, 256);
}
lbm_cid lbm_eval_program_ext(lbm_value lisp, unsigned int stack_size) {
return create_ctx(lisp, NIL, stack_size);
return lbm_create_ctx(lisp, NIL, stack_size);
}
int lbm_eval_init() {
@ -2014,172 +2023,3 @@ int lbm_eval_init() {
return res;
}
/****************************************************/
/* Interface for loading and running programs and */
/* expressions */
static lbm_cid eval_cps_load_and_eval(lbm_tokenizer_char_stream_t *tokenizer, bool program) {
lbm_stream_t *stream = NULL;
stream = (lbm_stream_t*)lbm_memory_allocate(sizeof(lbm_stream_t) / 4);
if (stream == NULL) {
return 0; // No valid CID is 0
}
stream->state = (void*)tokenizer;
stream->more = token_stream_more;
stream->get = token_stream_get;
stream->peek = token_stream_peek;
stream->drop = token_stream_drop;
stream->put = token_stream_put;
lbm_value lisp_stream = lbm_stream_create(stream);
if (lbm_type_of(lisp_stream) == LBM_VAL_TYPE_SYMBOL) {
lbm_memory_free((uint32_t*)stream);
return 0;
}
/* LISP ZONE */
lbm_value launcher = lbm_cons(lisp_stream, NIL);
launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher);
lbm_value evaluator = lbm_cons(launcher, NIL);
evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator);
lbm_value start_prg = lbm_cons(evaluator, NIL);
/* LISP ZONE ENDS */
if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS ||
lbm_type_of(evaluator) != LBM_PTR_TYPE_CONS ||
lbm_type_of(start_prg) != LBM_PTR_TYPE_CONS ) {
lbm_memory_free((uint32_t*)stream);
return 0;
}
return create_ctx(start_prg, NIL, 256);
}
lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer) {
return eval_cps_load_and_eval(tokenizer, false);
}
static lbm_cid eval_cps_load_and_define(lbm_tokenizer_char_stream_t *tokenizer, char *symbol, bool program) {
lbm_stream_t *stream = NULL;
stream = (lbm_stream_t*)lbm_memory_allocate(sizeof(lbm_stream_t) / 4);
if (stream == NULL) {
return 0; // No valid CID is 0
}
stream->state = (void*)tokenizer;
stream->more = token_stream_more;
stream->get = token_stream_get;
stream->peek = token_stream_peek;
stream->drop = token_stream_drop;
stream->put = token_stream_put;
lbm_value lisp_stream = lbm_stream_create(stream);
if (lbm_type_of(lisp_stream) == LBM_VAL_TYPE_SYMBOL) {
lbm_memory_free((uint32_t*)stream);
return 0;
}
lbm_uint sym_id;
if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
if (!lbm_add_symbol(symbol, &sym_id)) {
lbm_memory_free((uint32_t*)stream);
return 0;
}
}
/* LISP ZONE */
lbm_value launcher = lbm_cons(lisp_stream, NIL);
launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher);
lbm_value binding = lbm_cons(launcher, NIL);
binding = lbm_cons(lbm_enc_sym(sym_id), binding);
lbm_value definer = lbm_cons(lbm_enc_sym(SYM_DEFINE), binding);
definer = lbm_cons(definer, NIL);
/* LISP ZONE ENDS */
if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS ||
lbm_type_of(binding) != LBM_PTR_TYPE_CONS ||
lbm_type_of(definer) != LBM_PTR_TYPE_CONS ) {
lbm_memory_free((uint32_t*)stream);
return 0;
}
return create_ctx(definer, NIL, 256);
}
lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol) {
return eval_cps_load_and_define(tokenizer, symbol, true);
}
lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol) {
return eval_cps_load_and_define(tokenizer, symbol, false);
}
lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer) {
return eval_cps_load_and_eval(tokenizer, true);
}
static lbm_cid lbm_eval_defined(char *symbol, bool program) {
lbm_uint sym_id;
if(!lbm_get_symbol_by_name(symbol, &sym_id)) {
// The symbol does not exist, so it cannot be defined
return 0;
}
lbm_value binding = lbm_env_lookup(lbm_enc_sym(sym_id), *lbm_get_env_ptr());
if (lbm_type_of(binding) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(binding) == SYM_NOT_FOUND) {
return 0;
}
/* LISP ZONE */
lbm_value launcher = lbm_cons(lbm_enc_sym(sym_id), NIL);
lbm_value evaluator = launcher;
evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator);
lbm_value start_prg = lbm_cons(evaluator, NIL);
/* LISP ZONE ENDS */
if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS ||
lbm_type_of(evaluator) != LBM_PTR_TYPE_CONS ||
lbm_type_of(start_prg) != LBM_PTR_TYPE_CONS ) {
return 0;
}
return create_ctx(start_prg, NIL, 256);
}
lbm_cid lbm_eval_defined_expression(char *symbol) {
return lbm_eval_defined(symbol, false);
}
lbm_cid lbm_eval_defined_program(char *symbol) {
return lbm_eval_defined(symbol, true);
}
int lbm_send_message(lbm_cid cid, lbm_value msg) {
int res = 0;
if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
lbm_value v = find_receiver_and_send(cid, msg);
if (lbm_type_of(v) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(v) == SYM_TRUE) {
res = 1;
}
}
return res;
}

2
lispBM/lispBM/src/extensions.c
View File

@ -16,12 +16,12 @@
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <lbm_memory.h>
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <string.h>
#include "lispbm_memory.h"
#include "extensions.h"
#define SYM 0

324
lispBM/lispBM/src/fundamental.c
View File

@ -16,12 +16,12 @@
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <lbm_types.h>
#include "symrepr.h"
#include "stack.h"
#include "heap.h"
#include "eval_cps.h"
#include "print.h"
#include <stdio.h>
#include <math.h>
@ -167,17 +167,17 @@ static bool array_equality(lbm_value a, lbm_value b) {
switch(a_->elt_type) {
case LBM_VAL_TYPE_U:
case LBM_PTR_TYPE_BOXED_U:
if (memcmp((char*)a_+8, (char*)b_+8, a_->size * sizeof(lbm_uint)) == 0) return true;
if (memcmp((char*)a_->data, (char*)b_->data, a_->size * sizeof(lbm_uint)) == 0) return true;
break;
case LBM_VAL_TYPE_I:
case LBM_PTR_TYPE_BOXED_I:
if (memcmp((char*)a_+8, (char*)b_+8, a_->size * sizeof(lbm_int)) == 0) return true;
if (memcmp((char*)a_->data, (char*)b_->data, a_->size * sizeof(lbm_int)) == 0) return true;
break;
case LBM_VAL_TYPE_CHAR:
if (memcmp((char*)a_+8, (char*)b_+8, a_->size) == 0) return true;
if (memcmp((char*)a_->data, (char*)b_->data, a_->size) == 0) return true;
break;
case LBM_PTR_TYPE_BOXED_F:
if (memcmp((char*)a_+8, (char*)b_+8, a_->size * sizeof(lbm_float)) == 0) return true;
if (memcmp((char*)a_->data, (char*)b_->data, a_->size * sizeof(lbm_float)) == 0) return true;
break;
default:
break;
@ -270,83 +270,89 @@ static int compare(lbm_uint a, lbm_uint b) {
void array_read(lbm_value *args, lbm_uint nargs, lbm_uint *result) {
(void) nargs;
if (nargs < 2) return;
// Args are: array, index
lbm_value arr = args[0];
lbm_value index = args[1];
lbm_value index_end = index;
lbm_value acc = lbm_enc_sym(SYM_NIL);
lbm_value curr = lbm_enc_sym(SYM_EERROR);
bool read_many = false;
if (nargs > 2) {
index_end = args[2];
read_many = true;
}
// Get array index
lbm_uint ix;
lbm_int tmp;
lbm_uint ix_end;
*result = lbm_enc_sym(SYM_EERROR);
switch (lbm_type_of(index)) {
case LBM_VAL_TYPE_U:
ix = lbm_dec_u(index);
break;
case LBM_VAL_TYPE_I:
tmp = (lbm_int)lbm_dec_i(index);
if (tmp < 0) {
*result = lbm_enc_sym(SYM_EERROR);
return;
}
ix = (lbm_uint)tmp;
break;
case LBM_PTR_TYPE_BOXED_U:
ix = lbm_dec_U(index);
break;
case LBM_PTR_TYPE_BOXED_I:
tmp = lbm_dec_I(index);
if (tmp < 0) {
*result = lbm_enc_sym(SYM_EERROR);
return;
}
ix = (lbm_uint) tmp;
break;
default:
*result = lbm_enc_sym(SYM_NIL);
if (lbm_is_number(index) && lbm_is_number(index_end)) {
ix = lbm_dec_as_u(index);
ix_end = lbm_dec_as_u(index_end);
} else {
return;
}
if (ix > ix_end) {
lbm_uint tmp = ix;
ix = ix_end;
ix_end = tmp;
}
if (lbm_type_of(arr) == LBM_PTR_TYPE_ARRAY) {
lbm_array_header_t *array = (lbm_array_header_t*)lbm_car(arr);
uint32_t* data = array->data;
if (ix >= array->size){
*result = lbm_enc_sym(SYM_NIL);
return;
}
printf("ix: %d, ix_end: %d\n", ix, ix_end);
for (lbm_int i = (lbm_int)ix_end; i >= (lbm_int)ix; i--) {
printf("%d\n", i);
if ((lbm_uint)i >= array->size){
printf("hmm %d %d\n", i, array->size);
*result = lbm_enc_sym(SYM_NIL);
return;
}
switch(array->elt_type) {
case LBM_VAL_TYPE_CHAR:
*result = lbm_enc_char((lbm_uint) ((char*)array+8)[ix]);
break;
case LBM_VAL_TYPE_U:
*result = lbm_enc_u(((lbm_uint*)array + 2)[ix]);
break;
case LBM_VAL_TYPE_I:
*result = lbm_enc_i(((lbm_int*)array + 2)[ix]);
break;
case LBM_PTR_TYPE_BOXED_U:
*result = lbm_cons(((lbm_uint*)array + 2)[ix], lbm_enc_sym(SYM_BOXED_U_TYPE));
if (lbm_type_of(*result) == LBM_VAL_TYPE_SYMBOL) return;
*result = lbm_set_ptr_type(*result, LBM_PTR_TYPE_BOXED_U);
break;
case LBM_PTR_TYPE_BOXED_I:
*result = lbm_cons(((lbm_uint*)array + 2)[ix], lbm_enc_sym(SYM_BOXED_I_TYPE));
if (lbm_type_of(*result) == LBM_VAL_TYPE_SYMBOL) return;
*result = lbm_set_ptr_type(*result, LBM_PTR_TYPE_BOXED_I);
break;
case LBM_PTR_TYPE_BOXED_F:
*result = lbm_cons(((lbm_uint*)array+2)[ix], lbm_enc_sym(SYM_BOXED_F_TYPE));
if (lbm_type_of(*result) == LBM_VAL_TYPE_SYMBOL) return;
*result = lbm_set_ptr_type(*result, LBM_PTR_TYPE_BOXED_F);
break;
default:
*result = lbm_enc_sym(SYM_EERROR);
return;
}
return;
switch(array->elt_type) {
case LBM_VAL_TYPE_CHAR:
curr = lbm_enc_char((lbm_uint) ((char*)data)[i]);
break;
case LBM_VAL_TYPE_U:
curr = lbm_enc_u(((lbm_uint*)data)[i]);
break;
case LBM_VAL_TYPE_I:
curr = lbm_enc_i(((lbm_int*)data)[i]);
break;
case LBM_PTR_TYPE_BOXED_U:
curr = lbm_cons(((lbm_uint*)data)[i], lbm_enc_sym(SYM_BOXED_U_TYPE));
if (lbm_type_of(curr) == LBM_VAL_TYPE_SYMBOL) return;
curr = lbm_set_ptr_type(curr, LBM_PTR_TYPE_BOXED_U);
break;
case LBM_PTR_TYPE_BOXED_I:
curr = lbm_cons(((lbm_uint*)data)[i], lbm_enc_sym(SYM_BOXED_I_TYPE));
if (lbm_type_of(curr) == LBM_VAL_TYPE_SYMBOL) return;
curr = lbm_set_ptr_type(curr, LBM_PTR_TYPE_BOXED_I);
break;
case LBM_PTR_TYPE_BOXED_F:
curr = lbm_cons(((lbm_uint*)data)[i], lbm_enc_sym(SYM_BOXED_F_TYPE));
if (lbm_type_of(*result) == LBM_VAL_TYPE_SYMBOL) return;
curr = lbm_set_ptr_type(curr, LBM_PTR_TYPE_BOXED_F);
break;
default:
curr = lbm_enc_sym(SYM_EERROR);
break;
}
if (read_many) {
acc = lbm_cons(curr, acc);
}
} /* for i */
}
if (read_many) {
*result = acc;
} else {
*result = curr;
}
*result = lbm_enc_sym(SYM_EERROR);
}
void array_write(lbm_value *args, lbm_uint nargs, lbm_uint *result) {
@ -355,38 +361,19 @@ void array_write(lbm_value *args, lbm_uint nargs, lbm_uint *result) {
lbm_value index = args[1];
lbm_value val = args[2];
lbm_uint ix;
lbm_int tmp;
switch (lbm_type_of(index)) {
case LBM_VAL_TYPE_U:
ix = lbm_dec_u(index);
break;
case LBM_VAL_TYPE_I:
tmp = (lbm_int)lbm_dec_i(index);
if (tmp < 0) {
*result = lbm_enc_sym(SYM_EERROR);
return;
}
ix = (lbm_uint) tmp;
break;
case LBM_PTR_TYPE_BOXED_U:
ix = lbm_car(index);
break;
case LBM_PTR_TYPE_BOXED_I:
tmp = (lbm_int)lbm_car(index);
if (tmp < 0) {
*result = lbm_enc_sym(SYM_EERROR);
return;
}
ix = (lbm_uint) tmp;
break;
default:
*result = lbm_enc_sym(SYM_NIL);
*result = lbm_enc_sym(SYM_EERROR);
if (lbm_is_number(index)) {
ix = lbm_dec_as_u(index);
} else {
return;
}
if (lbm_type_of(arr) == LBM_PTR_TYPE_ARRAY) {
lbm_array_header_t *array = (lbm_array_header_t*)lbm_car(arr);
if (lbm_type_of(val) != array->elt_type ||
ix >= array->size) {
*result = lbm_enc_sym(SYM_NIL);
@ -395,65 +382,67 @@ void array_write(lbm_value *args, lbm_uint nargs, lbm_uint *result) {
switch(array->elt_type) {
case LBM_VAL_TYPE_CHAR: {
char * data = (char *)array + 8;
char * data = (char *)array->data;
data[ix] = lbm_dec_char(val);
break;
}
case LBM_VAL_TYPE_U: {
lbm_uint* data = (lbm_uint*)array + 2;
lbm_uint* data = (lbm_uint*)array->data;
data[ix] = lbm_dec_u(val);
break;
}
case LBM_VAL_TYPE_I: {
lbm_int *data = (lbm_int*)array + 2;
lbm_int *data = (lbm_int*)array->data;
data[ix] = lbm_dec_i(val);
break;
}
case LBM_PTR_TYPE_BOXED_U: {
lbm_uint *data = (lbm_uint*)array + 2;
lbm_uint *data = (lbm_uint*)array->data;
data[ix] = lbm_dec_U(val);
break;
}
case LBM_PTR_TYPE_BOXED_I: {
lbm_int *data = (lbm_int*)array + 2;
lbm_int *data = (lbm_int*)array->data;
data[ix] = lbm_dec_I(val);
break;
}
case LBM_PTR_TYPE_BOXED_F: {
//uv = car(val);
//memcpy(&v, &uv, sizeof(FLOAT));
lbm_uint *data = (lbm_uint*)array + 2;
lbm_uint *data = (lbm_uint*)array->data;
data[ix] = lbm_car(val);
break;
}
default:
*result = lbm_enc_sym(SYM_EERROR);
return;
// Maybe result should be something else than arr here.
break;
}
*result = lbm_enc_sym(SYM_TRUE);
*result = arr;
return;
}
*result = lbm_enc_sym(SYM_NIL);
}
void array_create(lbm_value *args, lbm_uint nargs, lbm_uint *result) {
(void) args;
(void) nargs;
(void) result;
}
//void array_create(lbm_value *args, lbm_uint nargs, lbm_uint *result) {
// (void) args;
// (void) nargs;
// (void) result;
//
//}
lbm_value index_list(lbm_value l, int n) {
/* TODO: error checking */
lbm_value index_list(lbm_value l, unsigned int n) {
lbm_value curr = l;
while ( lbm_type_of(curr) == LBM_PTR_TYPE_CONS &&
n > 0) {
curr = lbm_cdr(curr);
n --;
}
return lbm_car(curr);
if (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) {
return lbm_car(curr);
} else {
return lbm_enc_sym(SYM_NIL);
}
}
lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) {
@ -462,6 +451,108 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) {
int cmp_res = -1;
switch (lbm_dec_sym(op)) {
case SYM_IX:
if (nargs == 2 && lbm_is_number(args[0])) {
result = index_list(args[1], lbm_dec_as_u(args[0]));
}
break;
case SYM_DECODE:
if (nargs == 1 && (lbm_is_number(args[0]) ||
lbm_is_char(args[0]))) {
switch (lbm_type_of(args[0])) {
case LBM_VAL_TYPE_CHAR:
/*fall through*/
case LBM_VAL_TYPE_I:
/* fall through */
case LBM_VAL_TYPE_U: {
lbm_uint v = lbm_dec_as_u(args[0]);
result = lbm_cons(lbm_enc_u(v & 0xFF), lbm_enc_sym(SYM_NIL));
result = lbm_cons(lbm_enc_u(v >> 8 & 0xFF), result);
result = lbm_cons(lbm_enc_u(v >> 16 & 0xFF), result);
result = lbm_cons(lbm_enc_u(v >> 24 & 0xF), result);
} break;
case LBM_PTR_TYPE_BOXED_F: {
lbm_float tmp = lbm_dec_F(args[0]);
lbm_uint v;
memcpy(&v, &tmp, sizeof(lbm_uint));
result = lbm_cons(lbm_enc_u(v & 0xFF), lbm_enc_sym(SYM_NIL));
result = lbm_cons(lbm_enc_u(v >> 8 & 0xFF), result);
result = lbm_cons(lbm_enc_u(v >> 16 & 0xFF), result);
result = lbm_cons(lbm_enc_u(v >> 24 & 0xFF), result);
} break;
case LBM_PTR_TYPE_BOXED_I:
/* fall through */
case LBM_PTR_TYPE_BOXED_U: {
lbm_uint v = lbm_dec_as_u(args[0]);
result = lbm_cons(lbm_enc_u(v & 0xFF), lbm_enc_sym(SYM_NIL));
result = lbm_cons(lbm_enc_u(v >> 8 & 0xFF), result);
result = lbm_cons(lbm_enc_u(v >> 16 & 0xFF), result);
result = lbm_cons(lbm_enc_u(v >> 24 & 0xFF), result);
} break;
} // close if
}break;
/// Encode a list of up to 4 bytes as an i32
case SYM_ENCODE_I32:
if (nargs == 1 && lbm_type_of(args[0]) == LBM_PTR_TYPE_CONS) {
lbm_value curr = args[0];
lbm_uint r = 0;
int n = 4;
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS && n > 0) {
if (n < 4) r = r << 8;
if (lbm_is_number(lbm_car(curr))) {
uint32_t v = lbm_dec_as_u(lbm_car(curr));
r |= v;
n --;
curr = lbm_cdr(curr);
} else {
break;
}
}
result = lbm_enc_I((lbm_int)r);
}
break;
/// Encode a list of up to 4 bytes as an U32
case SYM_ENCODE_U32:
if (nargs == 1 && lbm_type_of(args[0]) == LBM_PTR_TYPE_CONS) {
lbm_value curr = args[0];
lbm_uint r = 0;
int n = 4;
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS && n > 0) {
if (n < 4) r = r << 8;
if (lbm_is_number(lbm_car(curr))) {
uint32_t v = lbm_dec_as_u(lbm_car(curr));
r |= v;
n --;
curr = lbm_cdr(curr);
} else {
break;
}
}
result = lbm_enc_U(r);
}
break;
/// Encode a list of up to 4 bytes as an U32
case SYM_ENCODE_FLOAT:
if (nargs == 1 && lbm_type_of(args[0]) == LBM_PTR_TYPE_CONS) {
lbm_value curr = args[0];
lbm_uint r = 0;
lbm_float f;
int n = 4;
while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS && n > 0) {
if (n < 4) r = r << 8;
if (lbm_is_number(lbm_car(curr))) {
uint32_t v = lbm_dec_as_u(lbm_car(curr));
r |= v;
n --;
curr = lbm_cdr(curr);
} else {
break;
}
}
memcpy(&f,&r, sizeof(lbm_uint));
result = lbm_enc_F(f);
}
break;
case SYM_IS_FUNDAMENTAL:
if (nargs < 1 ||
lbm_type_of(args[0]) != LBM_VAL_TYPE_SYMBOL)
@ -583,7 +674,7 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) {
}
for (int i = n-1; i >= 0; i --) {
result = lbm_cons(index_list(a,i), result);
result = lbm_cons(index_list(a,(unsigned int)i), result);
if (lbm_type_of(result) == LBM_VAL_TYPE_SYMBOL)
break;
}
@ -723,10 +814,9 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) {
case SYM_ARRAY_WRITE:
array_write(args, nargs, &result);
break;
case SYM_ARRAY_CREATE:
array_create(args, nargs, &result);
break;
// case SYM_ARRAY_CREATE:
// array_create(args, nargs, &result);
// break;
case SYM_TYPE_OF:
if (nargs != 1) return lbm_enc_sym(SYM_NIL);
lbm_value val = args[0];

20
lispBM/lispBM/src/heap.c
View File

@ -20,11 +20,11 @@
#include <stdlib.h>
#include <stdint.h>
#include <inttypes.h>
#include <lbm_memory.h>
#include "heap.h"
#include "symrepr.h"
#include "stack.h"
#include "lispbm_memory.h"
#ifdef VISUALIZE_HEAP
#include "heap_vis.h"
#endif
@ -41,7 +41,7 @@ char *lbm_dec_str(lbm_value val) {
lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
if (array->elt_type == LBM_VAL_TYPE_CHAR) {
res = (char *)array + 8;
res = (char *)array->data;
}
}
return res;
@ -62,6 +62,8 @@ lbm_uint lbm_dec_as_u(lbm_value a) {
lbm_float f_tmp;
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_CHAR:
return (lbm_uint) lbm_dec_char(a);
case LBM_VAL_TYPE_I:
return (lbm_uint) lbm_dec_i(a);
case LBM_VAL_TYPE_U:
@ -83,6 +85,8 @@ lbm_int lbm_dec_as_i(lbm_value a) {
lbm_float f_tmp;
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_CHAR:
return (lbm_int) lbm_dec_char(a);
case LBM_VAL_TYPE_I:
return lbm_dec_i(a);
case LBM_VAL_TYPE_U:
@ -104,6 +108,8 @@ lbm_float lbm_dec_as_f(lbm_value a) {
lbm_float f_tmp;
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_CHAR:
return (lbm_float) lbm_dec_char(a);
case LBM_VAL_TYPE_I:
return (lbm_float) lbm_dec_i(a);
case LBM_VAL_TYPE_U:
@ -429,8 +435,10 @@ int lbm_gc_sweep_phase(void) {
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++;
if (lbm_memory_ptr_inside((uint32_t*)arr)) {
lbm_memory_free((uint32_t *)arr);
heap_state.gc_recovered_arrays++;
}
}
// create pointer to use as new freelist
@ -609,10 +617,12 @@ int lbm_heap_allocate_array(lbm_value *res, unsigned int size, lbm_type type){
allocate_size = size;
}
array = (lbm_array_header_t*)lbm_memory_allocate(2 + allocate_size);
array = (lbm_array_header_t*)lbm_memory_allocate(sizeof(lbm_array_header_t) / 4);
if (array == NULL) return 0;
array->data = (uint32_t*)lbm_memory_allocate(allocate_size);
array->elt_type = type;
array->size = size;

178
lispBM/lispBM/src/lbm_c_interop.c Normal file
View File

@ -0,0 +1,178 @@
/*
Copyright 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
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/>.
*/
#include "lbm_c_interop.h"
/****************************************************/
/* Interface for loading and running programs and */
/* expressions */
lbm_cid eval_cps_load_and_eval(lbm_tokenizer_char_stream_t *tokenizer, bool program) {
lbm_value stream = lbm_create_token_stream(tokenizer);
if (lbm_type_of(stream) == LBM_VAL_TYPE_SYMBOL) {
// TODO: Check what should be done.
return 0;
}
/* LISP ZONE */
lbm_value launcher = lbm_cons(stream, lbm_enc_sym(SYM_NIL));
launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher);
lbm_value evaluator = lbm_cons(launcher, lbm_enc_sym(SYM_NIL));
evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator);
lbm_value start_prg = lbm_cons(evaluator, lbm_enc_sym(SYM_NIL));
/* LISP ZONE ENDS */
if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS ||
lbm_type_of(evaluator) != LBM_PTR_TYPE_CONS ||
lbm_type_of(start_prg) != LBM_PTR_TYPE_CONS ) {
lbm_memory_free((uint32_t*)stream);
return 0;
}
return lbm_create_ctx(start_prg, lbm_enc_sym(SYM_NIL), 256);
}
lbm_cid eval_cps_load_and_define(lbm_tokenizer_char_stream_t *tokenizer, char *symbol, bool program) {
lbm_value stream = lbm_create_token_stream(tokenizer);
if (lbm_type_of(stream) == LBM_VAL_TYPE_SYMBOL) {
return 0;
}
lbm_uint sym_id;
if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
if (!lbm_add_symbol(symbol, &sym_id)) {
lbm_memory_free((uint32_t*)stream);
return 0;
}
}
/* LISP ZONE */
lbm_value launcher = lbm_cons(stream, lbm_enc_sym(SYM_NIL));
launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher);
lbm_value binding = lbm_cons(launcher, lbm_enc_sym(SYM_NIL));
binding = lbm_cons(lbm_enc_sym(sym_id), binding);
lbm_value definer = lbm_cons(lbm_enc_sym(SYM_DEFINE), binding);
definer = lbm_cons(definer, lbm_enc_sym(SYM_NIL));
/* LISP ZONE ENDS */
if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS ||
lbm_type_of(binding) != LBM_PTR_TYPE_CONS ||
lbm_type_of(definer) != LBM_PTR_TYPE_CONS ) {
lbm_memory_free((uint32_t*)stream);
return 0;
}
return lbm_create_ctx(definer, lbm_enc_sym(SYM_NIL), 256);
}
lbm_cid lbm_eval_defined(char *symbol, bool program) {
lbm_uint sym_id;
if(!lbm_get_symbol_by_name(symbol, &sym_id)) {
// The symbol does not exist, so it cannot be defined
return 0;
}
lbm_value binding = lbm_env_lookup(lbm_enc_sym(sym_id), *lbm_get_env_ptr());
if (lbm_type_of(binding) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(binding) == SYM_NOT_FOUND) {
return 0;
}
/* LISP ZONE */
lbm_value launcher = lbm_cons(lbm_enc_sym(sym_id), lbm_enc_sym(SYM_NIL));
lbm_value evaluator = launcher;
evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator);
lbm_value start_prg = lbm_cons(evaluator, lbm_enc_sym(SYM_NIL));
/* LISP ZONE ENDS */
if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS ||
lbm_type_of(evaluator) != LBM_PTR_TYPE_CONS ||
lbm_type_of(start_prg) != LBM_PTR_TYPE_CONS ) {
return 0;
}
return lbm_create_ctx(start_prg, lbm_enc_sym(SYM_NIL), 256);
}
lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer) {
return eval_cps_load_and_eval(tokenizer, false);
}
lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol) {
return eval_cps_load_and_define(tokenizer, symbol, false);
}
lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer) {
return eval_cps_load_and_eval(tokenizer, true);
}
lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol) {
return eval_cps_load_and_define(tokenizer, symbol, true);
}
lbm_cid lbm_eval_defined_expression(char *symbol) {
return lbm_eval_defined(symbol, false);
}
lbm_cid lbm_eval_defined_program(char *symbol) {
return lbm_eval_defined(symbol, true);
}
int lbm_send_message(lbm_cid cid, lbm_value msg) {
int res = 0;
if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
lbm_value v = lbm_find_receiver_and_send(cid, msg);
if (lbm_type_of(v) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(v) == SYM_TRUE) {
res = 1;
}
}
return res;
}
int lbm_define(char *symbol, lbm_value value) {
int res = 0;
lbm_uint sym_id;
if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
if (!lbm_add_symbol(symbol, &sym_id)) {
return 0;
}
}
lbm_env_set(lbm_get_env(), lbm_enc_sym(sym_id), value);
}
return res;
}

11
lispBM/lispBM/src/lispbm_memory.c → lispBM/lispBM/src/lbm_memory.c
View File

@ -15,11 +15,11 @@
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <lbm_memory.h>
#include <stdint.h>
#include <stdlib.h>
#include <stdio.h>
#include "lispbm_memory.h"
/* Status bit patterns */
#define FREE_OR_USED 0 //00b
@ -227,3 +227,12 @@ int lbm_memory_free(uint32_t *ptr) {
return 0;
}
int lbm_memory_ptr_inside(uint32_t *ptr) {
int r = 0;
if ((uint32_t)ptr >= (uint32_t)memory &&
(uint32_t)ptr < (uint32_t)memory + (memory_size * 4))
r = 1;
return r;
}

4
lispBM/lispBM/src/print.c
View File

@ -19,11 +19,11 @@
#include <stdio.h>
#include <string.h>
#include <inttypes.h>
#include <lbm_types.h>
#include "print.h"
#include "heap.h"
#include "symrepr.h"
#include "lispbm_types.h"
#include "stack.h"
#define PRINT_STACK_SIZE 128 /* 1 KB */
@ -246,7 +246,7 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(curr);
switch (array->elt_type){
case LBM_VAL_TYPE_CHAR:
r = snprintf(buf + offset, len - offset, "\"%s\"", (char *)(array)+8);
r = snprintf(buf + offset, len - offset, "\"%s\"", (char *)array->data);
if ( r > 0) {
n = (unsigned int) r;
} else {

2
lispBM/lispBM/src/qq_expand.c
View File

@ -24,8 +24,8 @@
*/
#include <lbm_types.h>
#include "heap.h"
#include "lispbm_types.h"
#include "symrepr.h"
#include "stack.h"
#include "qq_expand.h"

4
lispBM/lispBM/src/stack.c
View File

@ -15,12 +15,12 @@
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <lbm_memory.h>
#include <lbm_types.h>
#include <string.h>
#include "stack.h"
#include "lispbm_types.h"
#include "print.h"
#include "lispbm_memory.h"
int lbm_stack_allocate(lbm_stack_t *s, unsigned int stack_size) {
s->data = lbm_memory_allocate(stack_size);

23
lispBM/lispBM/src/symrepr.c
View File

@ -20,11 +20,11 @@
#include <string.h>
#include <stdlib.h>
#include <inttypes.h>
#include <lbm_memory.h>
#include "symrepr.h"
#include "lispbm_memory.h"
#define NUM_SPECIAL_SYMBOLS 88
#define NUM_SPECIAL_SYMBOLS 92
#define NAME 0
#define ID 1
@ -124,7 +124,7 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"append" , SYM_APPEND},
{"array-read" , SYM_ARRAY_READ},
{"array-write" , SYM_ARRAY_WRITE},
{"array-create" , SYM_ARRAY_CREATE},
// {"array-create" , SYM_ARRAY_CREATE},
{"type-of" , SYM_TYPE_OF},
{"sym-to-str" , SYM_SYMBOL_TO_STRING},
{"str-to-sym" , SYM_STRING_TO_SYMBOL},
@ -132,6 +132,23 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"u-to-sym" , SYM_UINT_TO_SYMBOL},
{"set-car" , SYM_SET_CAR},
{"set-cdr" , SYM_SET_CDR},
// Streams
// {"stream-get" , SYM_STREAM_GET},
// {"stream-more" , SYM_STREAM_MORE},
// {"stream-peek" , SYM_STREAM_PEEK},
// {"stream-drop" , SYM_STREAM_DROP},
// {"stream-put" , SYM_STREAM_PUT},
// fast access in list
{"ix" , SYM_IX},
// Low-level
{"encode-i32" , SYM_ENCODE_I32},
{"encode-u32" , SYM_ENCODE_U32},
{"encode-float" , SYM_ENCODE_FLOAT},
{"decode" , SYM_DECODE},
{"is-fundamental" , SYM_IS_FUNDAMENTAL}
};

6
lispBM/lispBM/src/tokpar.c
View File

@ -18,16 +18,16 @@
#include <stdbool.h>
#include <stdio.h>
#include <ctype.h>
#include <lbm_memory.h>
#include <lbm_types.h>
#include <string.h>
#include <stdlib.h>
#include "tokpar.h"
#include "symrepr.h"
#include "heap.h"
#include "lispbm_types.h"
#include "compression.h"
#include "qq_expand.h"
#include "lispbm_memory.h"
#include "env.h"
#define NOTOKEN 0u
@ -531,7 +531,7 @@ lbm_value lbm_get_next_token(lbm_tokenizer_char_stream_t *str) {
// 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;
char *data = (char *)arr->data;
memset(data, 0, (unsigned int)((n-2)+1) * sizeof(char));
memcpy(data, sym_str, (unsigned int)(n - 2) * sizeof(char));
return res;

2
lispBM/lispBM/tests/test_decode_0.lisp Normal file
View File

@ -0,0 +1,2 @@
(= '(0u28 0u28 255u28 255u28) (decode (- 65536 1)))

1
lispBM/lispBM/tests/test_encode_0.lisp Normal file
View File

@ -0,0 +1 @@
(= 12345678i32 (encode-i32 (decode 12345678i32)))

1
lispBM/lispBM/tests/test_encode_1.lisp Normal file
View File

@ -0,0 +1 @@
(= 3.14 (encode-float (decode 3.14)))

1
lispBM/lispBM/tests/test_encode_2.lisp Normal file
View File

@ -0,0 +1 @@
(= 999999u32 (encode-u32 (decode 999999u32)))

1
lispBM/lispBM/tests/test_ix_0.lisp Normal file
View File

@ -0,0 +1 @@
(= 7 (ix 3 '(1 2 0 7 3 2 1)))

1
lispBM/lispBM/tests/test_ix_1.lisp Normal file
View File

@ -0,0 +1 @@
(= nil (ix 100000 '(1 2)))

2
lispBM/lispBM/tests/test_ix_2.lisp Normal file
View File

@ -0,0 +1,2 @@
(= 45 (ix 45 (iota 100)))

11
lispBM/lispBM/tests/test_lisp_code_cps.c
View File

@ -25,16 +25,7 @@
#include <sys/time.h>
#include <unistd.h>
#include "heap.h"
#include "symrepr.h"
#include "eval_cps.h"
#include "print.h"
#include "tokpar.h"
#include "prelude.h"
#include "compression.h"
#include "lispbm_memory.h"
#include "env.h"
#include "extensions.h"
#include "lispbm.h"
#define EVAL_CPS_STACK_SIZE 256

2
lispBM/lispBM/tests/test_match_2.lisp
View File

@ -2,7 +2,7 @@
(define f (lambda (ls)
(match ls
( nil 0 )
( (?cons c) (+ (car c) (f (cdr c))))
( ((? x) . (? xs)) (+ x (f xs)))
( _ 'error-not-a-list))))
(= (f '(1 2 3 4)) 10)

1
lispBM/lispBM/tests/test_read_0.lisp Normal file
View File

@ -0,0 +1 @@
(= (read "1") 1)

1
lispBM/lispBM/tests/test_read_1.lisp Normal file
View File

@ -0,0 +1 @@
(= (eval (read "(+ 1 2)")) 3)

4
lispBM/lispBM/tests/test_read_2.lisp Normal file
View File

@ -0,0 +1,4 @@
(define prg "(define a 10) (+ a 10)")
(= (eval-program (read-program prg)) 20)