mirror of https://github.com/rusefi/bldc.git
Squashed 'lispBM/lispBM/' changes from c1b12e9d..7ed5cc62
7ed5cc62 simplifying eval_symbol a small bit a378c2e2 cleaning and streamlining with a small performance benefit as bonus f4661119 removed unused statistics fields from heap_state (functionality kind of duplicates profiler). Small reorganization of eval_symbol 96a118e5 tightened up the run_eval loop a small amount 574309a6 Laptop charger just exploded so uploading what I have locally. Additions to profiler and tweaks to GC 0278230b Added arithmetic stress tests b0ad9619 added additional arith stress tests 5cb11cdf update lbmref and lbm_version.h 04d8483b Unified sleep and blocked queue, added profiler. Needs documentation and additional testing (WiP) 4a709753 timeout functionality added and restructuring of queue handling in main loop. Much testing needed e2605f7b flatten value calculates the size of the memory buffer needed to create a flat value. flatten now takes only one argument, the value to flatten. b79455aa added match test for const block df35d9a6 attempt fix of issue showing up in pattern matching from constant code. 0021d4c5 removed left over printf and fix in flatten that could leak memory a7abb204 flat values are now part of the language. lisp values can be flattened and unflattened. Added kill function for termination of threads ea58c616 Added a flat value constructor for symbol as string git-subtree-dir: lispBM/lispBM git-subtree-split: 7ed5cc621360d19577c5b14836c5ecd9fd608a1d
This commit is contained in:
Benjamin Vedder
parent
7bbb5e9f26
commit
bc8abddbc1
|
|
@ -129,7 +129,6 @@ LBMSRC = ../../src/env.c \
|
|||
../../src/heap.c \
|
||||
../../src/lbm_memory.c \
|
||||
../../src/print.c \
|
||||
../../src/qq_expand.c \
|
||||
../../src/stack.c \
|
||||
../../src/symrepr.c \
|
||||
../../src/tokpar.c \
|
||||
|
|
@ -139,6 +138,7 @@ LBMSRC = ../../src/env.c \
|
|||
../../src/lbm_custom_type.c \
|
||||
../../src/lbm_channel.c \
|
||||
../../src/lbm_flags.c \
|
||||
../../src/lbm_flat_value.c \
|
||||
../../platform/chibios/src/platform_mutex.c
|
||||
|
||||
CSRC = $(ALLCSRC) \
|
||||
|
|
|
|||
|
|
@ -371,9 +371,9 @@ int main(void) {
|
|||
lbm_get_heap_state(&heap_state);
|
||||
|
||||
chprintf(chp, "gc invocations: %d\r\n", heap_state.gc_num);
|
||||
chprintf(chp, "gc time avg: %f\r\n", (float)heap_state.gc_time_acc / (float)heap_state.gc_num);
|
||||
chprintf(chp, "gc min time: %u\r\n", heap_state.gc_min_duration);
|
||||
chprintf(chp, "gc max time: %u\r\n", heap_state.gc_max_duration);
|
||||
chprintf(chp, "gc time avg: %f\r\n", 0.0);
|
||||
chprintf(chp, "gc min time: %u\r\n", 0);
|
||||
chprintf(chp, "gc max time: %u\r\n", 0);
|
||||
chprintf(chp, "gc least free: %u\r\n", heap_state.gc_least_free);
|
||||
}
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -1513,10 +1513,8 @@ atomic read-modify-write sequences to global data.
|
|||
### spawn
|
||||
|
||||
Use `spawn` to launch a concurrent process. Spawn takes a closure and
|
||||
and arguments to pass to that closure as its arguments: `(spawn
|
||||
closure arg1 ... argN)`. Optionally you can provide a numerical first
|
||||
argument that specifies stack size that the runtime system should
|
||||
allocate to run the process in: `(spawn stack-size closure args1
|
||||
arguments to pass to that closure as its arguments. The form of a
|
||||
spawn expression is `(spawn opt-name opt-stack-size closure arg1
|
||||
... argN)`.
|
||||
|
||||
Each process has a runtime-stack which is used for the evaluation of
|
||||
|
|
@ -1538,11 +1536,11 @@ fine with a lot less stack. You can find a good size by trial and error.
|
|||
|
||||
Use `spawn-trap` to spawn a child process and enable trapping of exit
|
||||
conditions for that child. The form of a `spawn-trap` expression is
|
||||
`(spawn-trap closure arg1 .. argN)`. If the child process is
|
||||
terminated because of an error, a message is sent to the parent
|
||||
process of the form `(exit-error tid err-val)`. If the child process
|
||||
terminates successfully a message of the form `(exit-ok tid value)` is
|
||||
sent to the parent.
|
||||
`(spawn-trap opt-name opt-stack-size closure arg1 .. argN)`. If the
|
||||
child process is terminated because of an error, a message is sent to
|
||||
the parent process of the form `(exit-error tid err-val)`. If the
|
||||
child process terminates successfully a message of the form `(exit-ok
|
||||
tid value)` is sent to the parent.
|
||||
|
||||
Example:
|
||||
```clj
|
||||
|
|
@ -1631,6 +1629,32 @@ Example where a process waits for an integer `?i`.
|
|||
|
||||
---
|
||||
|
||||
### recv-to
|
||||
|
||||
Like [recv](./lbmref.md#recv), `recv-to` is used to receive
|
||||
messages but `recv-to` takes an extra timeout argument.
|
||||
|
||||
The form of an `recv-to` expression is
|
||||
```
|
||||
(recv-to timeout-secs
|
||||
(pattern1 exp1)
|
||||
...
|
||||
(patternN expN))
|
||||
```
|
||||
|
||||
If no message is received before the timout, the message `timeout` is
|
||||
delivered to the waiting process. This `timeout` message can be handled
|
||||
in one of the receive patterns.
|
||||
|
||||
Example
|
||||
```
|
||||
(recv-to 0.5
|
||||
( timeout (handle-timeout))
|
||||
( _ (do-something-else)))
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
### set-mailbox-size
|
||||
|
||||
Change the size of the mailbox in the current process.
|
||||
|
|
|
|||
|
|
@ -43,6 +43,12 @@ extern "C" {
|
|||
/** The eval_context_t struct represents a lispbm process.
|
||||
*
|
||||
*/
|
||||
#define LBM_THREAD_STATE_READY (uint32_t)0
|
||||
#define LBM_THREAD_STATE_BLOCKED (uint32_t)1
|
||||
#define LBM_THREAD_STATE_TIMEOUT (uint32_t)2
|
||||
#define LBM_THREAD_STATE_SLEEPING (uint32_t)3
|
||||
#define LBM_THREAD_STATE_GC_BIT (uint32_t)(1 << 31)
|
||||
|
||||
typedef struct eval_context_s{
|
||||
lbm_value program;
|
||||
lbm_value curr_exp;
|
||||
|
|
@ -57,6 +63,8 @@ typedef struct eval_context_s{
|
|||
lbm_stack_t K;
|
||||
lbm_uint timestamp;
|
||||
lbm_uint sleep_us;
|
||||
uint32_t state;
|
||||
char *name;
|
||||
lbm_cid id;
|
||||
lbm_cid parent;
|
||||
lbm_uint wait_mask;
|
||||
|
|
@ -233,9 +241,13 @@ lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, lbm_uint stack_size);
|
|||
/** Block a context from an extension
|
||||
*/
|
||||
void lbm_block_ctx_from_extension(void);
|
||||
/** Undo a previous call to lbm_block_ctx_from_extension.
|
||||
*/
|
||||
void lbm_undo_block_ctx_from_extension(void);
|
||||
/** Block a context from an extension with a timeout.
|
||||
* \param s Timeout in seconds.
|
||||
*/
|
||||
void lbm_block_ctx_from_extension_timeout(float s);
|
||||
/** Undo a previous call to lbm_block_ctx_from_extension.
|
||||
*/
|
||||
void lbm_undo_block_ctx_from_extension(void);
|
||||
/** Unblock a context that has been blocked by a C extension
|
||||
* Trying to unblock a context that is waiting on a message
|
||||
* in a mailbox is not encouraged
|
||||
|
|
@ -265,13 +277,6 @@ void lbm_running_iterator(ctx_fun f, void*, void*);
|
|||
* \param arg2 Same as above
|
||||
*/
|
||||
void lbm_blocked_iterator(ctx_fun f, void*, void*);
|
||||
/** Iterate over all done contexts and apply function on each context.
|
||||
*
|
||||
* \param f Function to apply to each context.
|
||||
* \param arg1 Pointer argument that can be used to convey information back to user.
|
||||
* \param arg2 Same as above
|
||||
*/
|
||||
void lbm_sleeping_iterator(ctx_fun f, void *, void *);
|
||||
/** toggle verbosity level of error messages
|
||||
*/
|
||||
void lbm_toggle_verbose(void);
|
||||
|
|
|
|||
|
|
@ -256,10 +256,6 @@ typedef struct {
|
|||
lbm_uint gc_least_free; // The smallest length of the freelist.
|
||||
lbm_uint gc_last_free; // Number of elements on the freelist
|
||||
// after most recent GC.
|
||||
|
||||
lbm_uint gc_time_acc;
|
||||
lbm_uint gc_min_duration;
|
||||
lbm_uint gc_max_duration;
|
||||
} lbm_heap_state_t;
|
||||
|
||||
extern lbm_heap_state_t lbm_heap_state;
|
||||
|
|
@ -560,12 +556,9 @@ void lbm_nil_freelist(void);
|
|||
int lbm_gc_mark_freelist(void);
|
||||
/** Mark heap cells reachable from the lbm_value v.
|
||||
*
|
||||
* \param m Number of Root nodes to start marking from.
|
||||
* \param ... list of root nodes.
|
||||
* \return 1 on success and 0 if the stack used internally is full.
|
||||
*/
|
||||
//int lbm_gc_mark_phase(lbm_value v);
|
||||
int lbm_gc_mark_phase(int num, ... );
|
||||
int lbm_gc_mark_phase(void);
|
||||
/** Performs lbm_gc_mark_phase on all the values of an array.
|
||||
*
|
||||
* \param data Array of roots to traverse from.
|
||||
|
|
@ -598,6 +591,16 @@ int lbm_heap_allocate_array(lbm_value *res, lbm_uint size);
|
|||
* \return 1 for success and 0 for failure.
|
||||
*/
|
||||
int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt);
|
||||
/** Get the size of an array value.
|
||||
* \param arr lbm_value array to get size of.
|
||||
* \return -1 for failure or length of array.
|
||||
*/
|
||||
lbm_int lbm_heap_array_get_size(lbm_value arr);
|
||||
/** Get a pointer to the data of an array.
|
||||
* \param arr lbm_value array to get pointer from.
|
||||
* \return NULL or valid pointer.
|
||||
*/
|
||||
uint8_t *lbm_heap_array_get_data(lbm_value arr);
|
||||
/** Explicitly free an array.
|
||||
* This function needs to be used with care and knowledge.
|
||||
* \param arr Array value.
|
||||
|
|
@ -835,7 +838,7 @@ static inline bool lbm_is_macro(lbm_value exp) {
|
|||
}
|
||||
|
||||
static inline bool lbm_is_match_binder(lbm_value exp) {
|
||||
return ((lbm_type_of(exp) == LBM_TYPE_CONS) &&
|
||||
return (lbm_is_cons(exp) &&
|
||||
(lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL) &&
|
||||
((lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_ANY)));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -37,7 +37,8 @@
|
|||
#define LBM_TYPE_DOUBLE 0x78000000u
|
||||
#define LBM_TYPE_ARRAY 0x80000000u
|
||||
#define LBM_TYPE_CHANNEL 0x90000000u
|
||||
#define LBM_TYPE_CUSTOM 0xA0000000u
|
||||
#define LBM_TYPE_FLATVAL 0xA0000000u
|
||||
#define LBM_TYPE_CUSTOM 0xB0000000u
|
||||
#define LBM_NON_CONS_POINTER_TYPE_LAST 0xBC000000u
|
||||
#define LBM_POINTER_TYPE_LAST 0xBC000000u
|
||||
|
||||
|
|
@ -67,8 +68,9 @@
|
|||
#define LBM_TYPE_ARRAY (lbm_uint)0x5000000000000000
|
||||
#define LBM_TYPE_CHANNEL (lbm_uint)0x7000000000000000
|
||||
#define LBM_TYPE_CUSTOM (lbm_uint)0x8000000000000000
|
||||
#define LBM_NON_CONS_POINTER_TYPE_LAST (lbm_uint)0x8000000000000000
|
||||
#define LBM_POINTER_TYPE_LAST (lbm_uint)0x8000000000000000
|
||||
#define LBM_TYPE_FLATVAL (lbm_uint)0x9000000000000000
|
||||
#define LBM_NON_CONS_POINTER_TYPE_LAST (lbm_uint)0x9000000000000000
|
||||
#define LBM_POINTER_TYPE_LAST (lbm_uint)0x9000000000000000
|
||||
|
||||
#define LBM_CONTINUATION_INTERNAL (lbm_uint)0xF800000000000001
|
||||
#define LBM_CONTINUATION_INTERNAL_TYPE (lbm_uint)0xF800000000000000
|
||||
|
|
@ -98,6 +100,7 @@
|
|||
#define SYM_NIL 0x0
|
||||
#define SYM_TRUE 0x2
|
||||
#define SYM_DONTCARE 0x9
|
||||
#define SYM_TIMEOUT 0xA
|
||||
|
||||
// 0x20 - 0x2F are errors
|
||||
#define SYM_RERROR 0x20 /* READ ERROR */
|
||||
|
|
@ -122,7 +125,8 @@
|
|||
#define SYM_IND_F_TYPE 0x36
|
||||
#define SYM_CHANNEL_TYPE 0x37
|
||||
#define SYM_CUSTOM_TYPE 0x38
|
||||
#define TYPE_CLASSIFIER_ENDS 0x38
|
||||
#define SYM_FLATVAL_TYPE 0x39
|
||||
#define TYPE_CLASSIFIER_ENDS 0x39
|
||||
#define SYM_NONSENSE 0x3A
|
||||
|
||||
#define SYM_NO_MATCH 0x40
|
||||
|
|
@ -143,6 +147,7 @@
|
|||
#define SYM_TYPE_CHAR 0x5B
|
||||
#define SYM_TYPE_BYTE 0x5C
|
||||
#define SYM_TYPE_CHANNEL 0x5E
|
||||
#define SYM_TYPE_FLATVAL 0x5F
|
||||
|
||||
//Relevant for the tokenizer and reader
|
||||
#define TOKENIZER_SYMBOLS_START 0x70
|
||||
|
|
@ -179,39 +184,43 @@
|
|||
#define SYM_OR 0x107
|
||||
#define SYM_MATCH 0x108
|
||||
#define SYM_RECEIVE 0x109
|
||||
#define SYM_CALLCC 0x10A
|
||||
#define SYM_ATOMIC 0x10B
|
||||
#define SYM_MACRO 0x10C
|
||||
#define SYM_CONT 0x10D
|
||||
#define SYM_CLOSURE 0x10E
|
||||
#define SYM_COND 0x10F
|
||||
#define SYM_APP_CONT 0x110
|
||||
#define SYM_PROGN_VAR 0x111
|
||||
#define SYM_SETQ 0x112
|
||||
#define SYM_MOVE_TO_FLASH 0x113
|
||||
#define SPECIAL_FORMS_END 0x113
|
||||
#define SYM_RECEIVE_TIMEOUT 0x10A
|
||||
#define SYM_CALLCC 0x10B
|
||||
#define SYM_ATOMIC 0x10C
|
||||
#define SYM_MACRO 0x10D
|
||||
#define SYM_CONT 0x10E
|
||||
#define SYM_CLOSURE 0x10F
|
||||
#define SYM_COND 0x110
|
||||
#define SYM_APP_CONT 0x111
|
||||
#define SYM_PROGN_VAR 0x112
|
||||
#define SYM_SETQ 0x113
|
||||
#define SYM_MOVE_TO_FLASH 0x114
|
||||
#define SPECIAL_FORMS_END 0x114
|
||||
|
||||
// Apply funs:
|
||||
// Get their arguments in evaluated form.
|
||||
// Consecutive value symbols for lookup-application
|
||||
#define APPLY_FUNS_START 0x150
|
||||
#define SYM_SETVAR 0x150
|
||||
#define SYM_READ 0x151
|
||||
#define SYM_READ_PROGRAM 0x152
|
||||
#define APPLY_FUNS_START 0x150
|
||||
#define SYM_SETVAR 0x150
|
||||
#define SYM_READ 0x151
|
||||
#define SYM_READ_PROGRAM 0x152
|
||||
#define SYM_READ_AND_EVAL_PROGRAM 0x153
|
||||
#define SYM_SPAWN 0x154
|
||||
#define SYM_SPAWN_TRAP 0x155
|
||||
#define SYM_YIELD 0x156
|
||||
#define SYM_WAIT 0x157
|
||||
#define SYM_EVAL 0x158
|
||||
#define SYM_EVAL_PROGRAM 0x159
|
||||
#define SYM_SEND 0x15A
|
||||
#define SYM_EXIT_OK 0x15B
|
||||
#define SYM_EXIT_ERROR 0x15C
|
||||
#define SYM_MAP 0x15D
|
||||
#define SYM_REVERSE 0x15E
|
||||
#define SYM_WAIT_FOR 0x15F
|
||||
#define APPLY_FUNS_END 0x15F
|
||||
#define SYM_SPAWN 0x154
|
||||
#define SYM_SPAWN_TRAP 0x155
|
||||
#define SYM_YIELD 0x156
|
||||
#define SYM_WAIT 0x157
|
||||
#define SYM_EVAL 0x158
|
||||
#define SYM_EVAL_PROGRAM 0x159
|
||||
#define SYM_SEND 0x15A
|
||||
#define SYM_EXIT_OK 0x15B
|
||||
#define SYM_EXIT_ERROR 0x15C
|
||||
#define SYM_MAP 0x15D
|
||||
#define SYM_REVERSE 0x15E
|
||||
#define SYM_WAIT_FOR 0x15F
|
||||
#define SYM_FLATTEN 0x160
|
||||
#define SYM_UNFLATTEN 0x161
|
||||
#define SYM_KILL 0x162
|
||||
#define APPLY_FUNS_END 0x162
|
||||
|
||||
#define FUNDAMENTALS_START 0x20E
|
||||
#define SYM_ADD 0x20E
|
||||
|
|
@ -274,8 +283,6 @@
|
|||
#define SYM_DROP 0x247
|
||||
#define FUNDAMENTALS_END 0x247
|
||||
|
||||
|
||||
|
||||
#define SPECIAL_SYMBOLS_START 0
|
||||
#define SPECIAL_SYMBOLS_END 0xFFFF
|
||||
#define EXTENSION_SYMBOLS_START 0x10000
|
||||
|
|
@ -294,6 +301,7 @@
|
|||
#define ENC_SYM_NIL ENC_SYM(SYM_NIL)
|
||||
#define ENC_SYM_TRUE ENC_SYM(SYM_TRUE)
|
||||
#define ENC_SYM_DONTCARE ENC_SYM(SYM_DONTCARE)
|
||||
#define ENC_SYM_TIMEOUT ENC_SYM(SYM_TIMEOUT)
|
||||
|
||||
#define ENC_SYM_RERROR ENC_SYM(SYM_RERROR)
|
||||
#define ENC_SYM_TERROR ENC_SYM(SYM_TERROR)
|
||||
|
|
@ -315,6 +323,7 @@
|
|||
#define ENC_SYM_IND_F_TYPE ENC_SYM(SYM_IND_F_TYPE)
|
||||
#define ENC_SYM_CHANNEL_TYPE ENC_SYM(SYM_CHANNEL_TYPE)
|
||||
#define ENC_SYM_CUSTOM_TYPE ENC_SYM(SYM_CUSTOM_TYPE)
|
||||
#define ENC_SYM_FLATVAL_TYPE ENC_SYM(SYM_FLATVAL_TYPE)
|
||||
#define ENC_SYM_NONSENSE ENC_SYM(SYM_NONSENSE)
|
||||
|
||||
#define ENC_SYM_NO_MATCH ENC_SYM(SYM_NO_MATCH)
|
||||
|
|
@ -334,6 +343,7 @@
|
|||
#define ENC_SYM_TYPE_CHAR ENC_SYM(SYM_TYPE_CHAR)
|
||||
#define ENC_SYM_TYPE_BYTE ENC_SYM(SYM_TYPE_BYTE)
|
||||
#define ENC_SYM_TYPE_CHANNEL ENC_SYM(SYM_TYPE_CHANNEL)
|
||||
#define ENC_SYM_TYPE_FLATVAL ENC_SYM(SYM_TYPE_FLATVAL)
|
||||
|
||||
#define ENC_SYM_OPENPAR ENC_SYM(SYM_OPENPAR)
|
||||
#define ENC_SYM_CLOSEPAR ENC_SYM(SYM_CLOSEPAR)
|
||||
|
|
@ -361,6 +371,7 @@
|
|||
#define ENC_SYM_OR ENC_SYM(SYM_OR)
|
||||
#define ENC_SYM_MATCH ENC_SYM(SYM_MATCH)
|
||||
#define ENC_SYM_RECEIVE ENC_SYM(SYM_RECEIVE)
|
||||
#define ENC_SYM_RECEIVE_TIMEOUT ENC_SYM(SYM_RECEIVE_TIMEOUT)
|
||||
#define ENC_SYM_CALLCC ENC_SYM(SYM_CALLCC)
|
||||
#define ENC_SYM_ATOMIC ENC_SYM(SYM_ATOMIC)
|
||||
#define ENC_SYM_MACRO ENC_SYM(SYM_MACRO)
|
||||
|
|
@ -373,25 +384,25 @@
|
|||
#define ENC_SYM_MOVE_TO_FLASH ENC_SYM(SYM_MOVE_TO_FLASH)
|
||||
#define ENC_SYM_IN_ENV ENC_SYM(SYM_IN_ENV)
|
||||
|
||||
#define ENC_SYM_SETVAR ENC_SYM(SYM_SETVAR)
|
||||
#define ENC_SYM_READ ENC_SYM(SYM_READ)
|
||||
#define ENC_SYM_READ_PROGRAM ENC_SYM(SYM_READ_PROGRAM)
|
||||
#define ENC_SYM_SETVAR ENC_SYM(SYM_SETVAR)
|
||||
#define ENC_SYM_READ ENC_SYM(SYM_READ)
|
||||
#define ENC_SYM_READ_PROGRAM ENC_SYM(SYM_READ_PROGRAM)
|
||||
#define ENC_SYM_READ_AND_EVAL_PROGRAM ENC_SYM(SYM_READ_AND_EVAL_PROGRAM)
|
||||
#define ENC_SYM_SPAWN ENC_SYM(SYM_SPAWN)
|
||||
#define ENC_SYM_SPAWN_TRAP ENC_SYM(SYM_SPAWN_TRAP)
|
||||
#define ENC_SYM_YIELD ENC_SYM(SYM_YIELD)
|
||||
#define ENC_SYM_WAIT ENC_SYM(SYM_WAIT)
|
||||
#define ENC_SYM_EVAL ENC_SYM(SYM_EVAL)
|
||||
#define ENC_SYM_EVAL_PROGRAM ENC_SYM(SYM_EVAL_PROGRAM)
|
||||
#define ENC_SYM_SEND ENC_SYM(SYM_SEND)
|
||||
#define ENC_SYM_EXIT_OK ENC_SYM(SYM_EXIT_OK)
|
||||
#define ENC_SYM_EXIT_ERROR ENC_SYM(SYM_EXIT_ERROR)
|
||||
#define ENC_SYM_MAP ENC_SYM(SYM_MAP)
|
||||
#define ENC_SYM_REVERSE ENC_SYM(SYM_REVERSE)
|
||||
#define ENC_SYM_WAIT_FOR ENC_SYM(SYM_WAIT_FOR)
|
||||
#define ENC_SYM_GET_ENV ENC_SYM(SYM_GET_ENV)
|
||||
#define ENC_SYM_SET_ENV ENC_SYM(SYM_SET_ENV)
|
||||
|
||||
#define ENC_SYM_SPAWN ENC_SYM(SYM_SPAWN)
|
||||
#define ENC_SYM_SPAWN_TRAP ENC_SYM(SYM_SPAWN_TRAP)
|
||||
#define ENC_SYM_YIELD ENC_SYM(SYM_YIELD)
|
||||
#define ENC_SYM_WAIT ENC_SYM(SYM_WAIT)
|
||||
#define ENC_SYM_EVAL ENC_SYM(SYM_EVAL)
|
||||
#define ENC_SYM_EVAL_PROGRAM ENC_SYM(SYM_EVAL_PROGRAM)
|
||||
#define ENC_SYM_SEND ENC_SYM(SYM_SEND)
|
||||
#define ENC_SYM_EXIT_OK ENC_SYM(SYM_EXIT_OK)
|
||||
#define ENC_SYM_EXIT_ERROR ENC_SYM(SYM_EXIT_ERROR)
|
||||
#define ENC_SYM_MAP ENC_SYM(SYM_MAP)
|
||||
#define ENC_SYM_REVERSE ENC_SYM(SYM_REVERSE)
|
||||
#define ENC_SYM_WAIT_FOR ENC_SYM(SYM_WAIT_FOR)
|
||||
#define ENC_SYM_FLATTEN ENC_SYM(SYM_FLATTEN)
|
||||
#define ENC_SYM_UNFLATTEN ENC_SYM(SYM_UNFLATTEN)
|
||||
#define ENC_SYM_KILL ENC_SYM(SYM_KILL)
|
||||
|
||||
#define ENC_SYM_ADD ENC_SYM(SYM_ADD)
|
||||
#define ENC_SYM_SUB ENC_SYM(SYM_SUB)
|
||||
|
|
|
|||
|
|
@ -27,25 +27,40 @@ typedef struct {
|
|||
lbm_uint buf_size;
|
||||
lbm_uint buf_pos;
|
||||
} lbm_flat_value_t;
|
||||
// Arity
|
||||
// Arity
|
||||
#define S_CONS 0x1 // 2 car, cdr
|
||||
#define S_SYM_VALUE 0x2 // 1 value
|
||||
#define S_BYTE_VALUE 0x3
|
||||
#define S_I_VALUE 0x4
|
||||
#define S_U_VALUE 0x5
|
||||
#define S_I32_VALUE 0x6
|
||||
#define S_U32_VALUE 0x7
|
||||
#define S_FLOAT_VALUE 0x8
|
||||
#define S_I64_VALUE 0x9
|
||||
#define S_U64_VALUE 0xA
|
||||
#define S_DOUBLE_VALUE 0xB
|
||||
#define S_LBM_ARRAY 0xC // 3 size, type, ptr
|
||||
#define S_SYM_STRING 0x3
|
||||
#define S_BYTE_VALUE 0x4
|
||||
#define S_I_VALUE 0x5
|
||||
#define S_U_VALUE 0x6
|
||||
#define S_I32_VALUE 0x7
|
||||
#define S_U32_VALUE 0x8
|
||||
#define S_FLOAT_VALUE 0x9
|
||||
#define S_I64_VALUE 0xA
|
||||
#define S_U64_VALUE 0xB
|
||||
#define S_DOUBLE_VALUE 0xC
|
||||
#define S_LBM_ARRAY 0xD
|
||||
|
||||
// Maximum number of recursive calls
|
||||
#define FLATTEN_VALUE_MAXIMUM_DEPTH 2000
|
||||
|
||||
#define FLATTEN_VALUE_OK 0
|
||||
#define FLATTEN_VALUE_ERROR_CANNOT_BE_FLATTENED -1
|
||||
#define FLATTEN_VALUE_ERROR_BUFFER_TOO_SMALL -2
|
||||
#define FLATTEN_VALUE_ERROR_ARRAY -3
|
||||
#define FLATTEN_VALUE_ERROR_CIRCULAR -4
|
||||
#define FLATTEN_VALUE_ERROR_MAXIMUM_DEPTH -5
|
||||
#define FLATTEN_VALUE_ERROR_NOT_ENOUGH_MEMORY -6
|
||||
#define FLATTEN_VALUE_ERROR_FATAL -7
|
||||
|
||||
bool lbm_start_flatten(lbm_flat_value_t *v, size_t buffer_size);
|
||||
bool lbm_finish_flatten(lbm_flat_value_t *v);
|
||||
bool f_cons(lbm_flat_value_t *v);
|
||||
bool f_sym(lbm_flat_value_t *v, lbm_uint sym);
|
||||
bool f_sym_string(lbm_flat_value_t *v, lbm_uint sym);
|
||||
bool f_i(lbm_flat_value_t *v, lbm_int i);
|
||||
bool f_u(lbm_flat_value_t *v, lbm_uint u);
|
||||
bool f_b(lbm_flat_value_t *v, uint8_t b);
|
||||
bool f_i32(lbm_flat_value_t *v, int32_t w);
|
||||
bool f_u32(lbm_flat_value_t *v, uint32_t w);
|
||||
|
|
@ -53,12 +68,14 @@ bool f_float(lbm_flat_value_t *v, float f);
|
|||
bool f_i64(lbm_flat_value_t *v, int64_t w);
|
||||
bool f_u64(lbm_flat_value_t *v, uint64_t w);
|
||||
bool f_lbm_array(lbm_flat_value_t *v, uint32_t num_bytes, uint8_t *data);
|
||||
lbm_value flatten_value(lbm_value v);
|
||||
void lbm_set_max_flatten_depth(int depth);
|
||||
|
||||
/** Unflatten a flat value stored in an lbm_memory array onto the heap
|
||||
*
|
||||
* \param v Flat value to unflatten.
|
||||
* \param res Pointer to where the result lbm_value should be stored.
|
||||
*
|
||||
* \param v Flat value to unflatten.
|
||||
* \param res Pointer to where the result lbm_value should be stored.
|
||||
* \return True on success and false otherwise.
|
||||
*/
|
||||
*/
|
||||
bool lbm_unflatten_value(lbm_flat_value_t *v, lbm_value *res);
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -0,0 +1,43 @@
|
|||
/*
|
||||
Copyright 2023 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 LBM_PROF_H_
|
||||
#define LBM_PROF_H_
|
||||
|
||||
#include "heap.h"
|
||||
#include "eval_cps.h"
|
||||
|
||||
#define LBM_PROF_MAX_NAME_SIZE 20
|
||||
|
||||
typedef struct {
|
||||
lbm_cid cid;
|
||||
bool has_name;
|
||||
char name[LBM_PROF_MAX_NAME_SIZE];
|
||||
lbm_uint count;
|
||||
lbm_uint gc_count;
|
||||
} lbm_prof_t;
|
||||
|
||||
bool lbm_prof_init(void (*usleep_fptr)(uint32_t),
|
||||
lbm_uint sample_interval,
|
||||
lbm_prof_t *prof_data_buf,
|
||||
lbm_uint prof_data_buf_num);
|
||||
lbm_uint lbm_prof_get_num_samples(void);
|
||||
lbm_uint lbm_prof_get_num_sleep_samples(void);
|
||||
lbm_uint lbm_prof_stop(void);
|
||||
bool lbm_prof_is_running(void);
|
||||
void lbm_prof_run(void);
|
||||
#endif
|
||||
|
|
@ -27,12 +27,24 @@ extern "C" {
|
|||
/** LBM major version */
|
||||
#define LBM_MAJOR_VERSION 0
|
||||
/** LBM minor version */
|
||||
#define LBM_MINOR_VERSION 15
|
||||
#define LBM_MINOR_VERSION 17
|
||||
/** LBM patch revision */
|
||||
#define LBM_PATCH_VERSION 0
|
||||
|
||||
/*! \page changelog Changelog
|
||||
|
||||
JUL 29 2023: Version 0.17.0
|
||||
- Addition of a timeout functionality to blocked contexts.
|
||||
- recv-to special form added for receives with a timeout.
|
||||
- block_context_from_extension_timeout function added.
|
||||
- Unified sleeping and blocked queues.
|
||||
- Added a new optional argument to spawn and spawn-trap that can be used to provide a name for the thread.
|
||||
- Added profiler functionality.
|
||||
|
||||
JUL 16 2023: Version 0.16.0
|
||||
- Addition of flat values as a type in the language.
|
||||
- Addition of kill function for termination of threads.
|
||||
|
||||
JUN 29 2023: version 0.15.0
|
||||
- Bug fix in lift_array_flash.
|
||||
- Bug fix in map.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/*
|
||||
/*
|
||||
Copyright 2018, 2021, 2022 Joel Svensson svenssonjoel@yahoo.se
|
||||
2022 Benjamin Vedder
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ LISPBM_SRC = $(LISPBM)/src/env.c \
|
|||
$(LISPBM)/src/lbm_channel.c \
|
||||
$(LISPBM)/src/lbm_flat_value.c\
|
||||
$(LISPBM)/src/lbm_flags.c\
|
||||
$(LISPBM)/src/lbm_prof.c\
|
||||
$(LISPBM)/src/extensions/array_extensions.c \
|
||||
$(LISPBM)/src/extensions/string_extensions.c \
|
||||
$(LISPBM)/src/extensions/math_extensions.c \
|
||||
|
|
|
|||
57
repl/repl.c
57
repl/repl.c
|
|
@ -28,6 +28,7 @@
|
|||
|
||||
#include "lispbm.h"
|
||||
#include "lbm_flat_value.h"
|
||||
#include "lbm_prof.h"
|
||||
#include "extensions/array_extensions.h"
|
||||
#include "extensions/string_extensions.h"
|
||||
#include "extensions/math_extensions.h"
|
||||
|
|
@ -45,12 +46,14 @@
|
|||
#define WAIT_TIMEOUT 2500
|
||||
#define STR_SIZE 1024
|
||||
#define CONSTANT_MEMORY_SIZE 32*1024
|
||||
#define PROF_DATA_NUM 100
|
||||
|
||||
lbm_uint gc_stack_storage[GC_STACK_SIZE];
|
||||
lbm_uint print_stack_storage[PRINT_STACK_SIZE];
|
||||
extension_fptr extension_storage[EXTENSION_STORAGE_SIZE];
|
||||
lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
|
||||
lbm_uint constants_memory[CONSTANT_MEMORY_SIZE];
|
||||
lbm_prof_t prof_data[100];
|
||||
|
||||
bool const_heap_write(lbm_uint ix, lbm_uint w) {
|
||||
if (ix >= CONSTANT_MEMORY_SIZE) return false;
|
||||
|
|
@ -174,6 +177,11 @@ void *eval_thd_wrapper(void *v) {
|
|||
return NULL;
|
||||
}
|
||||
|
||||
void *prof_thd_wrapper(void *v) {
|
||||
lbm_prof_run();
|
||||
return NULL;
|
||||
}
|
||||
|
||||
void done_callback(eval_context_t *ctx) {
|
||||
|
||||
erase();
|
||||
|
|
@ -490,7 +498,7 @@ int main(int argc, char **argv) {
|
|||
int res = 0;
|
||||
|
||||
pthread_t lispbm_thd;
|
||||
|
||||
|
||||
lbm_heap_state_t heap_state;
|
||||
unsigned int heap_size = 2048;
|
||||
lbm_cons_t *heap_storage = NULL;
|
||||
|
|
@ -589,12 +597,6 @@ int main(int argc, char **argv) {
|
|||
else
|
||||
printf("Error adding extension.\n");
|
||||
|
||||
res = lbm_add_extension("unflatten", ext_unflatten);
|
||||
if (res)
|
||||
printf("Extension added.\n");
|
||||
else
|
||||
printf("Error adding extension.\n");
|
||||
|
||||
res = lbm_add_extension("trigger", ext_trigger);
|
||||
if (res)
|
||||
printf("Extension added.\n");
|
||||
|
|
@ -644,7 +646,44 @@ int main(int argc, char **argv) {
|
|||
printf("Symbol table size FLASH: %"PRI_UINT" Bytes\n", lbm_get_symbol_table_size_flash());
|
||||
printf("Symbol names size FLASH: %"PRI_UINT" Bytes\n", lbm_get_symbol_table_size_names_flash());
|
||||
free(str);
|
||||
} else if (strncmp(str, ":env", 4) == 0) {
|
||||
} else if (strncmp(str, ":prof start", 11) == 0) {
|
||||
lbm_prof_init(sleep_callback,
|
||||
200,
|
||||
prof_data,
|
||||
PROF_DATA_NUM);
|
||||
pthread_t prof_thd; // just forget this id.
|
||||
if (pthread_create(&prof_thd, NULL, prof_thd_wrapper, NULL)) {
|
||||
printf("Error creating profiler thread\n");
|
||||
free(str);
|
||||
continue;
|
||||
}
|
||||
printf("Profiler started\n");
|
||||
free(str);
|
||||
} else if (strncmp(str, ":prof stop", 10) == 0) {
|
||||
printf("Profiler stopped. Issue command ':prof report' for statistics\n.");
|
||||
lbm_prof_stop();
|
||||
free(str);
|
||||
} else if (strncmp(str, ":prof report", 12) == 0) {
|
||||
lbm_uint num_sleep = lbm_prof_get_num_sleep_samples();
|
||||
lbm_uint tot_samples = lbm_prof_get_num_samples();
|
||||
lbm_uint tot_gc = 0;
|
||||
printf("CID\tName\tSamples\t%%Load\t%%GC\n");
|
||||
for (int i = 0; i < PROF_DATA_NUM; i ++) {
|
||||
if (prof_data[i].cid == -1) break;
|
||||
tot_gc += prof_data[i].gc_count;
|
||||
printf("%d\t%s\t%u\t%f\t%f\n",
|
||||
prof_data[i].cid,
|
||||
prof_data[i].name,
|
||||
prof_data[i].count,
|
||||
100.0 * ((float)prof_data[i].count) / (float) tot_samples,
|
||||
100.0 * ((float)prof_data[i].gc_count) / (float)prof_data[i].count);
|
||||
}
|
||||
printf("\n");
|
||||
printf("GC:\t%u\t%f%%\n", tot_gc, 100.0 * (float)tot_gc/(float)tot_samples);
|
||||
printf("sleep:\t%u\t%f%%\n", num_sleep, 100.0 * (float)num_sleep/(float)tot_samples);
|
||||
printf("total:\t%u samples\n", tot_samples);
|
||||
free(str);
|
||||
} else if (strncmp(str, ":env", 4) == 0) {
|
||||
lbm_value curr = *lbm_get_env_ptr();
|
||||
printf("Environment:\r\n");
|
||||
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
|
||||
|
|
@ -701,8 +740,6 @@ int main(int argc, char **argv) {
|
|||
lbm_running_iterator(print_ctx_info, NULL, NULL);
|
||||
printf("****** Blocked contexts ******\n");
|
||||
lbm_blocked_iterator(print_ctx_info, NULL, NULL);
|
||||
printf("****** Sleeping contexts *****\n");
|
||||
lbm_sleeping_iterator(print_ctx_info, NULL, NULL);
|
||||
free(str);
|
||||
} else if (n >= 5 && strncmp(str, ":quit", 5) == 0) {
|
||||
free(str);
|
||||
|
|
|
|||
697
src/eval_cps.c
697
src/eval_cps.c
File diff suppressed because it is too large
Load Diff
|
|
@ -33,9 +33,6 @@ static lbm_uint sym_num_gc_recovered_cells;
|
|||
static lbm_uint sym_num_gc_recovered_arrays;
|
||||
static lbm_uint sym_num_least_free;
|
||||
static lbm_uint sym_num_last_free;
|
||||
static lbm_uint sym_gc_time_acc;
|
||||
static lbm_uint sym_gc_time_min;
|
||||
static lbm_uint sym_gc_time_max;
|
||||
|
||||
lbm_value ext_eval_set_quota(lbm_value *args, lbm_uint argn) {
|
||||
LBM_CHECK_ARGN_NUMBER(1);
|
||||
|
|
@ -111,12 +108,6 @@ lbm_value ext_lbm_heap_state(lbm_value *args, lbm_uint argn) {
|
|||
res = lbm_enc_u(hs.gc_least_free);
|
||||
} else if (s == sym_num_last_free) {
|
||||
res = lbm_enc_u(hs.gc_last_free);
|
||||
} else if (s == sym_gc_time_acc) {
|
||||
res = lbm_enc_u(hs.gc_time_acc);
|
||||
} else if (s == sym_gc_time_min) {
|
||||
res = lbm_enc_u(hs.gc_min_duration);
|
||||
} else if (s == sym_gc_time_max) {
|
||||
res = lbm_enc_u(hs.gc_max_duration);
|
||||
} else {
|
||||
res = ENC_SYM_NIL;
|
||||
}
|
||||
|
|
@ -150,9 +141,6 @@ bool lbm_runtime_extensions_init(bool minimal) {
|
|||
lbm_add_symbol_const("get-gc-num-recovered-arrays", &sym_num_gc_recovered_arrays);
|
||||
lbm_add_symbol_const("get-gc-num-least-free", &sym_num_least_free);
|
||||
lbm_add_symbol_const("get-gc-num-last-free", &sym_num_last_free);
|
||||
lbm_add_symbol_const("get-gc-time-acc", &sym_gc_time_acc);
|
||||
lbm_add_symbol_const("get-gc-min-dur", &sym_gc_time_min);
|
||||
lbm_add_symbol_const("get-gc-max-dur", &sym_gc_time_max);
|
||||
}
|
||||
|
||||
bool res = true;
|
||||
|
|
|
|||
|
|
@ -1128,6 +1128,7 @@ static lbm_value fundamental_type_of(lbm_value *args, lbm_uint nargs, eval_conte
|
|||
case LBM_TYPE_U: return ENC_SYM_TYPE_U;
|
||||
case LBM_TYPE_CHAR: return ENC_SYM_TYPE_CHAR;
|
||||
case LBM_TYPE_SYMBOL: return ENC_SYM_TYPE_SYMBOL;
|
||||
case LBM_TYPE_FLATVAL: return ENC_SYM_TYPE_FLATVAL;
|
||||
}
|
||||
return ENC_SYM_TERROR;
|
||||
}
|
||||
|
|
|
|||
57
src/heap.c
57
src/heap.c
|
|
@ -458,18 +458,6 @@ static void heap_init_state(lbm_cons_t *addr, lbm_uint num_cells,
|
|||
lbm_heap_state.gc_recovered_arrays = 0;
|
||||
lbm_heap_state.gc_least_free = num_cells;
|
||||
lbm_heap_state.gc_last_free = num_cells;
|
||||
|
||||
lbm_heap_state.gc_time_acc = 0;
|
||||
lbm_heap_state.gc_max_duration = 0;
|
||||
lbm_heap_state.gc_min_duration = UINT32_MAX;
|
||||
}
|
||||
|
||||
void lbm_heap_new_gc_time(lbm_uint dur) {
|
||||
lbm_heap_state.gc_time_acc += dur;
|
||||
if (dur > lbm_heap_state.gc_max_duration)
|
||||
lbm_heap_state.gc_max_duration = dur;
|
||||
if (dur < lbm_heap_state.gc_min_duration)
|
||||
lbm_heap_state.gc_min_duration = dur;
|
||||
}
|
||||
|
||||
void lbm_heap_new_freelist_length(void) {
|
||||
|
|
@ -598,20 +586,9 @@ void lbm_get_heap_state(lbm_heap_state_t *res) {
|
|||
*res = lbm_heap_state;
|
||||
}
|
||||
|
||||
int lbm_gc_mark_phase(int num, ... ) { //lbm_value env) {
|
||||
int lbm_gc_mark_phase() {
|
||||
|
||||
lbm_stack_t *s = &lbm_heap_state.gc_stack;
|
||||
|
||||
va_list valist;
|
||||
va_start(valist, num);
|
||||
lbm_value root;
|
||||
for (int i = 0; i < num; i++) {
|
||||
root = va_arg(valist, lbm_value);
|
||||
if (lbm_is_ptr(root)) {
|
||||
lbm_push(s, root);
|
||||
}
|
||||
}
|
||||
va_end(valist);
|
||||
int res = 1;
|
||||
|
||||
while (!lbm_stack_is_empty(s)) {
|
||||
|
|
@ -683,7 +660,8 @@ int lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) {
|
|||
if( pt_t >= LBM_POINTER_TYPE_FIRST &&
|
||||
pt_t <= LBM_POINTER_TYPE_LAST &&
|
||||
pt_v < lbm_heap_state.heap_size) {
|
||||
lbm_gc_mark_phase(1,aux_data[i]);
|
||||
lbm_heap_state.gc_stack.data[lbm_heap_state.gc_stack.sp ++] = aux_data[i];
|
||||
lbm_gc_mark_phase();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -710,7 +688,7 @@ int lbm_gc_sweep_phase(void) {
|
|||
case SYM_IND_F_TYPE:
|
||||
lbm_memory_free((lbm_uint*)heap[i].car);
|
||||
break;
|
||||
|
||||
case SYM_FLATVAL_TYPE:
|
||||
case SYM_ARRAY_TYPE:{
|
||||
lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car;
|
||||
if (lbm_memory_ptr_inside((lbm_uint*)arr->data)) {
|
||||
|
|
@ -1055,6 +1033,32 @@ int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt) {
|
|||
return 1;
|
||||
}
|
||||
|
||||
lbm_int lbm_heap_array_get_size(lbm_value arr) {
|
||||
|
||||
int r = -1;
|
||||
if (lbm_is_array_rw(arr)) {
|
||||
lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
|
||||
if (header == NULL) {
|
||||
return r;
|
||||
}
|
||||
r = (lbm_int)header->size;
|
||||
}
|
||||
return r;
|
||||
}
|
||||
|
||||
uint8_t *lbm_heap_array_get_data(lbm_value arr) {
|
||||
uint8_t *r = NULL;
|
||||
if (lbm_is_array_rw(arr)) {
|
||||
lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
|
||||
if (header == NULL) {
|
||||
return r;
|
||||
}
|
||||
r = (uint8_t*)header->data;
|
||||
}
|
||||
return r;
|
||||
}
|
||||
|
||||
|
||||
/* Explicitly freeing an array.
|
||||
|
||||
This is a highly unsafe operation and can only be safely
|
||||
|
|
@ -1207,4 +1211,3 @@ lbm_flash_status write_const_car(lbm_value cell, lbm_value val) {
|
|||
lbm_uint lbm_flash_memory_usage(void) {
|
||||
return lbm_const_heap_state->next;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -20,6 +20,9 @@
|
|||
#include <eval_cps.h>
|
||||
#include <stack.h>
|
||||
|
||||
#include <setjmp.h>
|
||||
|
||||
static jmp_buf flatten_value_result_jmp_buf;
|
||||
|
||||
// ------------------------------------------------------------
|
||||
// Access to GC from eval_cps
|
||||
|
|
@ -49,6 +52,7 @@ bool lbm_finish_flatten(lbm_flat_value_t *v) {
|
|||
} else {
|
||||
size_words = (v->buf_pos / sizeof(lbm_uint)) + 1;
|
||||
}
|
||||
v->buf_size = size_words * sizeof(lbm_uint);
|
||||
|
||||
return (lbm_memory_shrink((lbm_uint*)v->buf, size_words) >= 0);
|
||||
}
|
||||
|
|
@ -107,6 +111,39 @@ bool f_sym(lbm_flat_value_t *v, lbm_uint sym) {
|
|||
return res;
|
||||
}
|
||||
|
||||
bool f_sym_string(lbm_flat_value_t *v, lbm_uint sym) {
|
||||
bool res = true;
|
||||
char *sym_str;
|
||||
if (lbm_is_symbol(sym)) {
|
||||
lbm_uint s = lbm_dec_sym(sym);
|
||||
sym_str = (char*)lbm_get_name_by_symbol(s);
|
||||
if (sym_str) {
|
||||
lbm_uint sym_bytes = strlen(sym_str) + 1;
|
||||
res = res && write_byte(v, S_SYM_STRING);
|
||||
if (res && v->buf_size >= v->buf_pos + sym_bytes) {
|
||||
for (lbm_uint i = 0; i < sym_bytes; i ++ ) {
|
||||
res = res && write_byte(v, (uint8_t)sym_str[i]);
|
||||
}
|
||||
return res;
|
||||
}
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
int f_sym_string_bytes(lbm_uint sym) {
|
||||
char *sym_str;
|
||||
if (lbm_is_symbol(sym)) {
|
||||
lbm_uint s = lbm_dec_sym(sym);
|
||||
sym_str = (char*)lbm_get_name_by_symbol(s);
|
||||
if (sym_str) {
|
||||
lbm_uint sym_bytes = strlen(sym_str) + 1;
|
||||
return (lbm_int)sym_bytes;
|
||||
}
|
||||
}
|
||||
return FLATTEN_VALUE_ERROR_FATAL;
|
||||
}
|
||||
|
||||
bool f_i(lbm_flat_value_t *v, lbm_int i) {
|
||||
bool res = true;
|
||||
res = res && write_byte(v,S_I_VALUE);
|
||||
|
|
@ -114,6 +151,13 @@ bool f_i(lbm_flat_value_t *v, lbm_int i) {
|
|||
return res;
|
||||
}
|
||||
|
||||
bool f_u(lbm_flat_value_t *v, lbm_uint u) {
|
||||
bool res = true;
|
||||
res = res && write_byte(v,S_U_VALUE);
|
||||
res = res && write_word(v,(uint32_t)u);
|
||||
return res;
|
||||
}
|
||||
|
||||
bool f_b(lbm_flat_value_t *v, uint8_t b) {
|
||||
bool res = true;
|
||||
res = res && write_byte(v,S_BYTE_VALUE);
|
||||
|
|
@ -144,6 +188,15 @@ bool f_float(lbm_flat_value_t *v, float f) {
|
|||
return res;
|
||||
}
|
||||
|
||||
bool f_double(lbm_flat_value_t *v, double d) {
|
||||
bool res = true;
|
||||
res = res && write_byte(v, S_DOUBLE_VALUE);
|
||||
uint64_t u;
|
||||
memcpy(&u, &d, sizeof(uint64_t));
|
||||
res = res && write_dword(v, u);
|
||||
return res;
|
||||
}
|
||||
|
||||
bool f_i64(lbm_flat_value_t *v, int64_t w) {
|
||||
bool res = true;
|
||||
res = res && write_byte(v, S_I64_VALUE);
|
||||
|
|
@ -171,9 +224,228 @@ bool f_lbm_array(lbm_flat_value_t *v, uint32_t num_bytes, uint8_t *data) {
|
|||
return res;
|
||||
}
|
||||
|
||||
static int flatten_value_result = FLATTEN_VALUE_OK;
|
||||
static int flatten_maximum_depth = FLATTEN_VALUE_MAXIMUM_DEPTH;
|
||||
|
||||
void lbm_set_max_flatten_depth(int depth) {
|
||||
flatten_maximum_depth = depth;
|
||||
}
|
||||
|
||||
void flatten_set_result(int val) {
|
||||
flatten_value_result = val;
|
||||
longjmp(flatten_value_result_jmp_buf, 1);
|
||||
}
|
||||
|
||||
int flatten_value_size(lbm_value v, int depth, int n_cons, int max_cons) {
|
||||
if (depth > flatten_maximum_depth) {
|
||||
flatten_set_result(FLATTEN_VALUE_ERROR_MAXIMUM_DEPTH);
|
||||
}
|
||||
if (n_cons > max_cons) {
|
||||
flatten_set_result(FLATTEN_VALUE_ERROR_CIRCULAR);
|
||||
}
|
||||
|
||||
switch (lbm_type_of(v)) {
|
||||
case LBM_TYPE_CONS: /* fall through */
|
||||
case LBM_TYPE_CONS_CONST: {
|
||||
int s2 = 0;
|
||||
int s1 = flatten_value_size(lbm_car(v), depth + 1, n_cons+1, max_cons);
|
||||
if (s1 > 0) {
|
||||
s2 = flatten_value_size(lbm_cdr(v), depth + 1, n_cons+1, max_cons);
|
||||
if (s2 > 0) {
|
||||
return (1 + s1 + s2);
|
||||
}
|
||||
}
|
||||
return 0; // already terminated with error
|
||||
}
|
||||
case LBM_TYPE_BYTE:
|
||||
return 1;
|
||||
case LBM_TYPE_U: /* fall through */
|
||||
case LBM_TYPE_I:
|
||||
#ifndef LBM64
|
||||
return 1 + 4;
|
||||
#else
|
||||
return 1 + 8;
|
||||
#endif
|
||||
case LBM_TYPE_U32: /* fall through */
|
||||
case LBM_TYPE_I32:
|
||||
case LBM_TYPE_FLOAT:
|
||||
return 1 + 4;
|
||||
case LBM_TYPE_U64: /* fall through */
|
||||
case LBM_TYPE_I64:
|
||||
case LBM_TYPE_DOUBLE:
|
||||
return 1 + 8;
|
||||
case LBM_TYPE_SYMBOL: {
|
||||
int s = f_sym_string_bytes(v);
|
||||
if (s > 0) return 1 + s;
|
||||
flatten_set_result(s);
|
||||
} return 0; // already terminated with error
|
||||
case LBM_TYPE_ARRAY: {
|
||||
lbm_int s = lbm_heap_array_get_size(v);
|
||||
if (s > 0)
|
||||
return 1 + 4 + s;
|
||||
flatten_set_result(s);
|
||||
} return 0; // already terminated with error
|
||||
default:
|
||||
return FLATTEN_VALUE_ERROR_CANNOT_BE_FLATTENED;
|
||||
}
|
||||
}
|
||||
|
||||
int flatten_value_internal(lbm_flat_value_t *fv, lbm_value v) {
|
||||
switch (lbm_type_of(v)) {
|
||||
case LBM_TYPE_CONS: /* fall through */
|
||||
case LBM_TYPE_CONS_CONST: {
|
||||
bool res = true;
|
||||
res = res && f_cons(fv);
|
||||
if (res) {
|
||||
int fv_r = flatten_value_internal(fv, lbm_car(v));
|
||||
if (fv_r == FLATTEN_VALUE_OK) {
|
||||
fv_r = flatten_value_internal(fv, lbm_cdr(v));
|
||||
}
|
||||
return fv_r;
|
||||
}
|
||||
}break;
|
||||
case LBM_TYPE_BYTE:
|
||||
if (f_b(fv, (uint8_t)lbm_dec_as_char(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_U:
|
||||
if (f_u(fv, lbm_dec_u(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_I:
|
||||
if (f_i(fv, lbm_dec_i(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_U32:
|
||||
if (f_u32(fv, lbm_dec_as_u32(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_I32:
|
||||
if (f_i32(fv, lbm_dec_as_i32(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_U64:
|
||||
if (f_u64(fv, lbm_dec_as_u64(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_I64:
|
||||
if (f_i64(fv, lbm_dec_as_i64(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_FLOAT:
|
||||
if (f_float(fv, lbm_dec_as_float(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_DOUBLE:
|
||||
if (f_double(fv, lbm_dec_as_double(v))) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_SYMBOL:
|
||||
if (f_sym_string(fv, v)) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
break;
|
||||
case LBM_TYPE_ARRAY: {
|
||||
lbm_int s = lbm_heap_array_get_size(v);
|
||||
uint8_t *d = lbm_heap_array_get_data(v);
|
||||
if (s > 0 && d != NULL) {
|
||||
if (f_lbm_array(fv, (lbm_uint)s, d)) {
|
||||
return FLATTEN_VALUE_OK;
|
||||
}
|
||||
} else {
|
||||
return FLATTEN_VALUE_ERROR_ARRAY;
|
||||
}
|
||||
}break;
|
||||
default:
|
||||
return FLATTEN_VALUE_ERROR_CANNOT_BE_FLATTENED;
|
||||
}
|
||||
return FLATTEN_VALUE_ERROR_BUFFER_TOO_SMALL;
|
||||
}
|
||||
|
||||
lbm_value handle_flatten_error(int err_val) {
|
||||
switch (err_val) {
|
||||
case FLATTEN_VALUE_ERROR_CANNOT_BE_FLATTENED:
|
||||
return ENC_SYM_EERROR;
|
||||
case FLATTEN_VALUE_ERROR_BUFFER_TOO_SMALL: /* fall through */
|
||||
case FLATTEN_VALUE_ERROR_FATAL:
|
||||
return ENC_SYM_FATAL_ERROR;
|
||||
case FLATTEN_VALUE_ERROR_CIRCULAR: /* fall through */
|
||||
case FLATTEN_VALUE_ERROR_MAXIMUM_DEPTH:
|
||||
return ENC_SYM_EERROR;
|
||||
case FLATTEN_VALUE_ERROR_NOT_ENOUGH_MEMORY:
|
||||
return ENC_SYM_MERROR;
|
||||
}
|
||||
return ENC_SYM_NIL;
|
||||
}
|
||||
|
||||
lbm_value flatten_value( lbm_value v) {
|
||||
|
||||
lbm_array_header_t *array = NULL;
|
||||
lbm_value array_cell = lbm_heap_allocate_cell(LBM_TYPE_CONS, ENC_SYM_NIL, ENC_SYM_FLATVAL_TYPE);
|
||||
if (lbm_type_of(array_cell) == LBM_TYPE_SYMBOL) {
|
||||
lbm_set_car_and_cdr(array_cell, ENC_SYM_NIL, ENC_SYM_NIL);
|
||||
return ENC_SYM_MERROR;
|
||||
}
|
||||
|
||||
lbm_flat_value_t fv;
|
||||
if (setjmp(flatten_value_result_jmp_buf) > 0) {
|
||||
lbm_set_car_and_cdr(array_cell, ENC_SYM_NIL, ENC_SYM_NIL);
|
||||
return handle_flatten_error(flatten_value_result);
|
||||
}
|
||||
|
||||
int required_mem = flatten_value_size(v, 0, 0, (int)lbm_heap_size());
|
||||
if (required_mem > 0) {
|
||||
array = (lbm_array_header_t *)lbm_malloc(sizeof(lbm_array_header_t));
|
||||
if (array == NULL) {
|
||||
flatten_set_result(FLATTEN_VALUE_ERROR_NOT_ENOUGH_MEMORY);
|
||||
}
|
||||
|
||||
bool r = lbm_start_flatten(&fv, (lbm_uint)required_mem);
|
||||
if (!r) {
|
||||
lbm_free(array);
|
||||
flatten_set_result(FLATTEN_VALUE_ERROR_NOT_ENOUGH_MEMORY);
|
||||
}
|
||||
|
||||
if (flatten_value_internal(&fv, v) == FLATTEN_VALUE_OK) {
|
||||
r = lbm_finish_flatten(&fv);
|
||||
}
|
||||
|
||||
if (r) {
|
||||
// lift flat_value
|
||||
array->data = (lbm_uint*)fv.buf;
|
||||
array->size = fv.buf_size;
|
||||
lbm_set_car(array_cell, (lbm_uint)array);
|
||||
array_cell = lbm_set_ptr_type(array_cell, LBM_TYPE_FLATVAL);
|
||||
return array_cell;
|
||||
} else {
|
||||
flatten_set_result(FLATTEN_VALUE_ERROR_FATAL);
|
||||
}
|
||||
}
|
||||
|
||||
lbm_set_car_and_cdr(array_cell, ENC_SYM_NIL, ENC_SYM_NIL);
|
||||
lbm_free(array);
|
||||
return handle_flatten_error(required_mem);
|
||||
}
|
||||
|
||||
// ------------------------------------------------------------
|
||||
// Unflattening
|
||||
static bool extract_byte(lbm_flat_value_t *v, uint8_t *r) {
|
||||
if (v->buf_size >= v->buf_pos + 1) {
|
||||
*r = v->buf[v->buf_pos++];
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
static bool extract_word(lbm_flat_value_t *v, uint32_t *r) {
|
||||
if (v->buf_size >= v->buf_pos + 4) {
|
||||
uint32_t tmp = 0;
|
||||
|
|
@ -244,6 +516,15 @@ static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
|
|||
}
|
||||
return UNFLATTEN_MALFORMED;
|
||||
}
|
||||
case S_BYTE_VALUE: {
|
||||
uint8_t tmp;
|
||||
bool b = extract_byte(v, &tmp);
|
||||
if (b) {
|
||||
*res = lbm_enc_char((char)tmp);
|
||||
return UNFLATTEN_OK;
|
||||
}
|
||||
return UNFLATTEN_MALFORMED;
|
||||
}
|
||||
case S_I_VALUE: {
|
||||
lbm_uint tmp;
|
||||
bool b;
|
||||
|
|
@ -292,6 +573,22 @@ static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
|
|||
}
|
||||
return UNFLATTEN_MALFORMED;
|
||||
}
|
||||
case S_DOUBLE_VALUE: {
|
||||
uint64_t tmp;
|
||||
bool b;
|
||||
b = extract_dword(v, &tmp);
|
||||
if (b) {
|
||||
double f;
|
||||
memcpy(&f, &tmp, sizeof(uint64_t));
|
||||
lbm_value im = lbm_enc_double(f);
|
||||
if (lbm_is_symbol_merror(im)) {
|
||||
return UNFLATTEN_GC_RETRY;
|
||||
}
|
||||
*res = im;
|
||||
return UNFLATTEN_OK;
|
||||
}
|
||||
return UNFLATTEN_MALFORMED;
|
||||
}
|
||||
case S_I32_VALUE: {
|
||||
uint32_t tmp;
|
||||
if (extract_word(v, &tmp)) {
|
||||
|
|
@ -355,6 +652,20 @@ static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
|
|||
}
|
||||
return UNFLATTEN_MALFORMED;
|
||||
}
|
||||
case S_SYM_STRING: {
|
||||
lbm_uint sym_id;
|
||||
int r = lbm_get_symbol_by_name((char *)(v->buf + v->buf_pos), &sym_id);
|
||||
if (!r) {
|
||||
r = lbm_add_symbol((char *)(v->buf + v->buf_pos), &sym_id);
|
||||
}
|
||||
if (r) {
|
||||
lbm_uint num_bytes = strlen((char*)(v->buf + v->buf_pos)) + 1;
|
||||
v->buf_pos += num_bytes;
|
||||
*res = lbm_enc_sym(sym_id);
|
||||
return UNFLATTEN_OK;
|
||||
}
|
||||
return UNFLATTEN_MALFORMED;
|
||||
}
|
||||
default:
|
||||
return UNFLATTEN_MALFORMED;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,131 @@
|
|||
/*
|
||||
Copyright 2023 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_prof.h"
|
||||
#include "platform_mutex.h"
|
||||
|
||||
static lbm_uint sample_interval_us = 200;
|
||||
static bool lbm_prof_running = false;
|
||||
static lbm_uint num_samples = 0;
|
||||
static lbm_uint num_sleep_samples = 0;
|
||||
static void (*usleep_callback)(uint32_t) = NULL;
|
||||
extern eval_context_t *ctx_running;
|
||||
extern mutex_t qmutex;
|
||||
extern bool qmutex_initialized;
|
||||
|
||||
static lbm_prof_t *prof_data;
|
||||
static lbm_uint prof_data_num;
|
||||
|
||||
#define TRUNC_SIZE(N) (((N) > LBM_PROF_MAX_NAME_SIZE -1) ? LBM_PROF_MAX_NAME_SIZE-1 : N)
|
||||
|
||||
bool lbm_prof_init(void (*usleep_fptr)(uint32_t),
|
||||
lbm_uint sample_interval,
|
||||
lbm_prof_t *prof_data_buf,
|
||||
lbm_uint prof_data_buf_num) {
|
||||
if (qmutex_initialized && prof_data_buf && prof_data_buf_num > 0) {
|
||||
usleep_callback = usleep_fptr;
|
||||
sample_interval_us = sample_interval;
|
||||
num_samples = 0;
|
||||
num_sleep_samples = 0;
|
||||
prof_data_num = prof_data_buf_num;
|
||||
prof_data = prof_data_buf;
|
||||
for (lbm_uint i = 0; i < prof_data_num; i ++) {
|
||||
prof_data_buf[i].cid = -1;
|
||||
prof_data[i].has_name = false;
|
||||
memset(&prof_data_buf[i].name, 0, LBM_PROF_MAX_NAME_SIZE);
|
||||
prof_data_buf[i].count = 0;
|
||||
}
|
||||
if (usleep_callback != NULL) {
|
||||
lbm_prof_running = true;
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
lbm_uint lbm_prof_get_num_samples(void) {
|
||||
return num_samples;
|
||||
}
|
||||
|
||||
lbm_uint lbm_prof_get_num_sleep_samples(void) {
|
||||
return num_sleep_samples;
|
||||
}
|
||||
|
||||
lbm_uint lbm_prof_stop(void) {
|
||||
lbm_prof_running = false;
|
||||
return num_samples;
|
||||
}
|
||||
|
||||
bool lbm_prof_is_running(void) {
|
||||
return lbm_prof_running;
|
||||
}
|
||||
|
||||
// start in an OS thread.
|
||||
void lbm_prof_run(void) {
|
||||
while (lbm_prof_running) {
|
||||
num_samples ++;
|
||||
|
||||
// Lock mutex so context cannot be destroyed until
|
||||
// we are done storing a sample.
|
||||
mutex_lock(&qmutex);
|
||||
eval_context_t *curr = ctx_running;
|
||||
if (curr != NULL) {
|
||||
lbm_cid id = curr->id;
|
||||
char *name = curr->name;
|
||||
lbm_uint name_len = 0;
|
||||
bool doing_gc = false;
|
||||
if (curr->state & LBM_THREAD_STATE_GC_BIT) {
|
||||
doing_gc = true;
|
||||
}
|
||||
if (name) name_len = strlen(name) + 1;
|
||||
for (lbm_uint i = 0; i < prof_data_num; i ++) {
|
||||
if (prof_data[i].cid == -1) {
|
||||
// add new sample:
|
||||
prof_data[i].cid = id;
|
||||
prof_data[i].count = 1;
|
||||
prof_data[i].gc_count = doing_gc ? 1 : 0;
|
||||
if (name) {
|
||||
memcpy(&prof_data[i].name, name, TRUNC_SIZE(name_len));
|
||||
prof_data[i].name[LBM_PROF_MAX_NAME_SIZE - 1] = 0;
|
||||
prof_data[i].has_name = true;
|
||||
}
|
||||
break;
|
||||
}
|
||||
if (prof_data[i].cid == id &&
|
||||
prof_data[i].has_name &&
|
||||
name != NULL &&
|
||||
strncmp(prof_data[i].name, name, TRUNC_SIZE(name_len)) == 0) {
|
||||
// found a named existing measurement.
|
||||
prof_data[i].count ++;
|
||||
prof_data[i].gc_count += doing_gc ? 1 : 0;
|
||||
break;
|
||||
}
|
||||
if (prof_data[i].cid == id &&
|
||||
!prof_data[i].has_name &&
|
||||
name == NULL) {
|
||||
prof_data[i].count ++;
|
||||
prof_data[i].gc_count += doing_gc ? 1 : 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
num_sleep_samples ++;
|
||||
}
|
||||
mutex_unlock(&qmutex);
|
||||
usleep_callback(sample_interval_us);
|
||||
}
|
||||
}
|
||||
|
|
@ -212,6 +212,11 @@ int print_emit_channel(lbm_char_channel_t *chan, lbm_value v) {
|
|||
return print_emit_string(chan, "~CHANNEL~");
|
||||
}
|
||||
|
||||
int print_emit_flatval(lbm_char_channel_t *chan, lbm_value v) {
|
||||
(void) v;
|
||||
return print_emit_string(chan, "~FLATVAL~");
|
||||
}
|
||||
|
||||
int print_emit_array_data(lbm_char_channel_t *chan, lbm_array_header_t *array) {
|
||||
|
||||
int r = print_emit_char(chan, '[');
|
||||
|
|
@ -397,6 +402,9 @@ int lbm_print_internal(lbm_char_channel_t *chan, lbm_value v) {
|
|||
case LBM_TYPE_CHANNEL:
|
||||
r = print_emit_channel(chan, curr);
|
||||
break;
|
||||
case LBM_TYPE_FLATVAL:
|
||||
r = print_emit_flatval(chan, curr);
|
||||
break;
|
||||
case LBM_TYPE_ARRAY:
|
||||
r = print_emit_array(chan, curr);
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -55,10 +55,12 @@ special_sym const special_symbols[] = {
|
|||
{"_" , SYM_DONTCARE},
|
||||
{"send" , SYM_SEND},
|
||||
{"recv" , SYM_RECEIVE},
|
||||
{"recv-to" , SYM_RECEIVE_TIMEOUT},
|
||||
{"macro" , SYM_MACRO},
|
||||
{"call-cc" , SYM_CALLCC},
|
||||
{"continuation" , SYM_CONT},
|
||||
{"var" , SYM_PROGN_VAR},
|
||||
{"timeout" , SYM_TIMEOUT},
|
||||
|
||||
{"set" , SYM_SETVAR},
|
||||
{"setq" , SYM_SETQ},
|
||||
|
|
@ -68,6 +70,9 @@ special_sym const special_symbols[] = {
|
|||
{"map" , SYM_MAP},
|
||||
{"reverse" , SYM_REVERSE},
|
||||
{"wait-for" , SYM_WAIT_FOR},
|
||||
{"flatten" , SYM_FLATTEN},
|
||||
{"unflatten" , SYM_UNFLATTEN},
|
||||
{"kill" , SYM_KILL},
|
||||
{"gc" , SYM_PERFORM_GC},
|
||||
|
||||
// pattern matching
|
||||
|
|
@ -96,6 +101,7 @@ special_sym const special_symbols[] = {
|
|||
{"$channel" , SYM_CHANNEL_TYPE},
|
||||
{"$recovered" , SYM_RECOVERED},
|
||||
{"$custom" , SYM_CUSTOM_TYPE},
|
||||
{"$flatval" , SYM_FLATVAL_TYPE},
|
||||
{"$nonsense" , SYM_NONSENSE},
|
||||
|
||||
// tokenizer symbols with unparsable names
|
||||
|
|
@ -129,6 +135,8 @@ special_sym const special_symbols[] = {
|
|||
{"type-char" , SYM_TYPE_CHAR},
|
||||
{"type-byte" , SYM_TYPE_BYTE},
|
||||
{"type-channel" , SYM_TYPE_CHANNEL},
|
||||
{"type-flatval" , SYM_TYPE_FLATVAL},
|
||||
|
||||
// Fundamental operations
|
||||
{"+" , SYM_ADD},
|
||||
{"-" , SYM_SUB},
|
||||
|
|
|
|||
|
|
@ -0,0 +1,16 @@
|
|||
|
||||
(defun apply (f args)
|
||||
(eval (cons f args)))
|
||||
|
||||
(defun test-it (n c args res acc)
|
||||
(if (= n 0) acc
|
||||
(progn
|
||||
(define acc (and acc (= (apply c args) res)))
|
||||
(test-it (- n 1) c args res acc))))
|
||||
|
||||
(defun arith (a b c d e f g h i j)
|
||||
(+ a b c d e f g h i j))
|
||||
|
||||
(def res (test-it 10000 arith '(1u64 2u64 3u64 4u64 5u64 6u64 7u64 8u64 9u64 10u64) 55u64 t))
|
||||
|
||||
(check res)
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
|
||||
(defun apply (f args)
|
||||
(eval (cons f args)))
|
||||
|
||||
(defun test-it (n c args res acc)
|
||||
(if (= n 0) acc
|
||||
(progn
|
||||
(define acc (and acc (= (apply c args) res)))
|
||||
(test-it (- n 1) c args res acc))))
|
||||
|
||||
(defun arith (a b c d e f g h i j)
|
||||
(+ a b c d e f g h i j))
|
||||
|
||||
(def res (test-it 10000 arith '(1i64 2i64 3i64 4i64 5i64 6i64 7i64 8i64 9i64 10i64) 55i64 t))
|
||||
|
||||
(check res)
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
|
||||
(defun apply (f args)
|
||||
(eval (cons f args)))
|
||||
|
||||
(defun test-it (n c args res acc)
|
||||
(if (= n 0) acc
|
||||
(progn
|
||||
(define acc (and acc (= (apply c args) res)))
|
||||
(test-it (- n 1) c args res acc))))
|
||||
|
||||
(defun arith (a b c d e f g h i j)
|
||||
(+ a b c d e f g h i j))
|
||||
|
||||
(def res (test-it 10000 arith '(1 2 3 4 5 6 7i64 8 9 10) 55i64 t))
|
||||
|
||||
(check res)
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
|
||||
(defun apply (f args)
|
||||
(eval (cons f args)))
|
||||
|
||||
(defun test-it (n c args res acc)
|
||||
(if (= n 0) acc
|
||||
(progn
|
||||
(define acc (and acc (= (apply c args) res)))
|
||||
(test-it (- n 1) c args res acc))))
|
||||
|
||||
(defun arith (a b c d e f g h i j)
|
||||
(+ a b c d e f g h i j))
|
||||
|
||||
(def res (test-it 10000 arith (list
|
||||
(str-to-i "1")
|
||||
(str-to-i "2")
|
||||
(str-to-i "3")
|
||||
(str-to-i "4")
|
||||
(str-to-i "5")
|
||||
(str-to-i "6")
|
||||
(str-to-i "7")
|
||||
(str-to-i "8")
|
||||
(str-to-i "9")
|
||||
(str-to-i "10"))
|
||||
(str-to-i "55") t))
|
||||
|
||||
(check res)
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
|
||||
(define a (flatten '(1 2u32 3i32 3.0)))
|
||||
|
||||
(check (eq (unflatten a) '(1 2u32 3i32 3.0)))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
|
||||
(define a (flatten 1))
|
||||
|
||||
(check (= (unflatten a) 1))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
|
||||
(define a (flatten "hej"))
|
||||
|
||||
(check (eq (unflatten a) "hej"))
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
|
||||
(define tree '((1 2) (3 4)))
|
||||
|
||||
(define a (flatten tree))
|
||||
|
||||
(check (eq (unflatten a) tree))
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
|
||||
(define tree '(("hello" "kurt") ("russel" "rules")))
|
||||
|
||||
(define a (flatten tree))
|
||||
|
||||
(check (eq (unflatten a) tree))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
|
||||
@const-start
|
||||
(define f (lambda (ls)
|
||||
(match ls
|
||||
( nil 0 )
|
||||
( ( (? c) . (? cd)) (+ c (f c)))
|
||||
( _ 'error-not-a-list))))
|
||||
@const-end
|
||||
|
||||
(check (and (eq (f 'kurt) 'error-not-a-list)
|
||||
(eq (f nil) 0)))
|
||||
Loading…
Reference in New Issue