http://t3x.org/s9fes/s9core.h.html (light|dark)
544 Lines
/* * S9core Toolkit, Mk IVd * By Nils M Holm, 2007-2019 * In the public domain * * Under jurisdictions without a public domain, the CC0 applies: * https://creativecommons.org/publicdomain/zero/1.0/ */ #define S9_VERSION "20190402" /* * Ugly prelude to deal with some system-dependent stuff. */ #ifdef __NetBSD__ #ifndef unix #define unix #endif #endif #ifdef __unix #ifndef unix #define unix #endif #endif #ifdef __linux #ifndef unix #define unix #endif #endif #ifdef __GNUC__ #ifndef unix #define unix #endif #endif #ifdef __clang__ #ifndef unix #define unix #endif #endif #ifndef unix #ifndef plan9 #error "Either 'unix' or 'plan9' must be #defined." #endif #endif #ifdef _MSC_VER #if _MSC_VER > 1200 #ifndef _CRT_SECURE_NO_DEPRECATE #define _CRT_SECURE_NO_DEPRECATE #endif #endif #ifndef _POSIX_ #define _POSIX_ #endif #endif #ifdef plan9 #include <u.h> #include <libc.h> #include <stdio.h> #include <ctype.h> #include <ape/limits.h> #define size_t uvlong #define bye(x) exits((x)? "error": NULL) #define ptrdiff_t vlong #endif #ifdef unix #include <stdlib.h> #include <stddef.h> #include <stdio.h> #include <string.h> #include <ctype.h> #include <limits.h> #define bye(x) exit((x)? EXIT_FAILURE: EXIT_SUCCESS) #endif /* * Tunable parameters */ /* Default memory limits in K nodes and K cells; 0 = none */ #define S9_NODE_LIMIT 14013 #define S9_VECTOR_LIMIT 14013 /* Initial memory pool sizes */ #define S9_INITIAL_SEGMENT_SIZE 32768 /* Primitive segment size (slots) */ #define S9_PRIM_SEG_SIZE 256 /* Maximum number of open I/O ports */ #define S9_MAX_PORTS 32 /* Use 64-bit cells (don't do this!) */ /* #define S9_BITS_PER_WORD_64 */ /* * Non-tunable parameters */ /* A cell must be large enough to hold an integer segment; * see S9_INT_SEG_LIMIT, below */ #ifdef S9_BITS_PER_WORD_64 #define s9_cell ptrdiff_t #else #define s9_cell int #endif #ifdef S9_BITS_PER_WORD_64 #define S9_DIGITS_PER_CELL 18 #define S9_INT_SEG_LIMIT 1000000000000000000LL #define S9_MANTISSA_SEGMENTS 1 #else #define S9_DIGITS_PER_CELL 9 #define S9_INT_SEG_LIMIT 1000000000L #define S9_MANTISSA_SEGMENTS 2 #endif #define S9_MANTISSA_SIZE (S9_MANTISSA_SEGMENTS * S9_DIGITS_PER_CELL) /* * Node tags */ #define S9_ATOM_TAG 0x01 /* Atom, car = type, cdr = next */ #define S9_MARK_TAG 0x02 /* Mark */ #define S9_STATE_TAG 0x04 /* State */ #define S9_VECTOR_TAG 0x08 /* Vector, car = type, cdr = content */ #define S9_PORT_TAG 0x10 /* Atom is an I/O port (with ATOM_TAG) */ #define S9_USED_TAG 0x20 /* Port: in use */ #define S9_LOCK_TAG 0x40 /* Port: locked (do not finalize) */ #define S9_CONST_TAG 0x80 /* Node is immutable */ /* * Special objects */ #define s9_special_p(x) ((x) < 0) #define S9_NIL (-1) #define S9_TRUE (-2) #define S9_FALSE (-3) #define S9_END_OF_FILE (-4) #define S9_UNDEFINED (-5) #define S9_UNSPECIFIC (-6) #define S9_VOID (-7) /* * Type tags */ #define S9_T_ANY (-10) #define S9_T_BOOLEAN (-11) #define S9_T_CHAR (-12) #define S9_T_INPUT_PORT (-13) #define S9_T_INTEGER (-14) #define S9_T_LIST (-17) #define S9_T_OUTPUT_PORT (-15) #define S9_T_PAIR (-16) #define S9_T_PRIMITIVE (-18) #define S9_T_FUNCTION (-19) #define S9_T_REAL (-20) #define S9_T_STRING (-21) #define S9_T_SYMBOL (-22) #define S9_T_SYNTAX (-23) #define S9_T_VECTOR (-24) #define S9_T_CONTINUATION (-25) #define S9_T_FIXNUM (-26) #define S9_T_NONE (-99) #define S9_USER_SPECIALS (-100) /* * Structures */ struct S9_counter { int n, n1k, n1m, n1g, n1t; }; #define s9_counter struct S9_counter struct S9_primitive { char *name; s9_cell (*handler)(void); int min_args; int max_args; /* -1 = variadic */ int arg_types[3]; }; #define S9_PRIM struct S9_primitive /* * I/O */ #define s9_nl() s9_prints("\n") /* * Nested lists */ #define s9_car(x) (S9_car[x]) #define s9_cdr(x) (S9_cdr[x]) #define s9_caar(x) (S9_car[S9_car[x]]) #define s9_cadr(x) (S9_car[S9_cdr[x]]) #define s9_cdar(x) (S9_cdr[S9_car[x]]) #define s9_cddr(x) (S9_cdr[S9_cdr[x]]) #define s9_caaar(x) (S9_car[S9_car[S9_car[x]]]) #define s9_caadr(x) (S9_car[S9_car[S9_cdr[x]]]) #define s9_cadar(x) (S9_car[S9_cdr[S9_car[x]]]) #define s9_caddr(x) (S9_car[S9_cdr[S9_cdr[x]]]) #define s9_cdaar(x) (S9_cdr[S9_car[S9_car[x]]]) #define s9_cdadr(x) (S9_cdr[S9_car[S9_cdr[x]]]) #define s9_cddar(x) (S9_cdr[S9_cdr[S9_car[x]]]) #define s9_cdddr(x) (S9_cdr[S9_cdr[S9_cdr[x]]]) #define s9_caaaar(x) (S9_car[S9_car[S9_car[S9_car[x]]]]) #define s9_caaadr(x) (S9_car[S9_car[S9_car[S9_cdr[x]]]]) #define s9_caadar(x) (S9_car[S9_car[S9_cdr[S9_car[x]]]]) #define s9_caaddr(x) (S9_car[S9_car[S9_cdr[S9_cdr[x]]]]) #define s9_cadaar(x) (S9_car[S9_cdr[S9_car[S9_car[x]]]]) #define s9_cadadr(x) (S9_car[S9_cdr[S9_car[S9_cdr[x]]]]) #define s9_caddar(x) (S9_car[S9_cdr[S9_cdr[S9_car[x]]]]) #define s9_cadddr(x) (S9_car[S9_cdr[S9_cdr[S9_cdr[x]]]]) #define s9_cdaaar(x) (S9_cdr[S9_car[S9_car[S9_car[x]]]]) #define s9_cdaadr(x) (S9_cdr[S9_car[S9_car[S9_cdr[x]]]]) #define s9_cdadar(x) (S9_cdr[S9_car[S9_cdr[S9_car[x]]]]) #define s9_cdaddr(x) (S9_cdr[S9_car[S9_cdr[S9_cdr[x]]]]) #define s9_cddaar(x) (S9_cdr[S9_cdr[S9_car[S9_car[x]]]]) #define s9_cddadr(x) (S9_cdr[S9_cdr[S9_car[S9_cdr[x]]]]) #define s9_cdddar(x) (S9_cdr[S9_cdr[S9_cdr[S9_car[x]]]]) #define s9_cddddr(x) (S9_cdr[S9_cdr[S9_cdr[S9_cdr[x]]]]) /* * Access to fields of atoms */ #define s9_tag(n) (S9_tag[n]) #define s9_string(n) ((char *) &Vectors[S9_cdr[n]]) #define s9_string_len(n) (Vectors[S9_cdr[n] - 1]) #define s9_symbol_name(n) (string(n)) #define s9_symbol_len(n) (string_len(n)) #define s9_vector(n) (&Vectors[S9_cdr[n]]) #define s9_vector_link(n) (Vectors[S9_cdr[n] - 3]) #define s9_vector_index(n) (Vectors[S9_cdr[n] - 2]) #define s9_vector_size(k) (((k)+sizeof(s9_cell)-1) / \ sizeof(s9_cell) + 3) #define s9_vector_len(n) (vector_size(string_len(n)) - 3) #define s9_fixval(x) cadr(x) #define s9_small_int_value(x) cadr(x) #define s9_port_no(n) (cadr(n)) #define s9_char_value(n) (cadr(n)) #define s9_prim_slot(n) (cadr(n)) #define s9_prim_info(n) (&Primitives[prim_slot(n)]) /* * Type predicates */ #define s9_eof_p(n) ((n) == S9_END_OF_FILE) #define s9_undefined_p(n) ((n) == S9_UNDEFINED) #define s9_unspecific_p(n) ((n) == S9_UNSPECIFIC) #define s9_boolean_p(n) \ ((n) == S9_TRUE || (n) == S9_FALSE) #define s9_integer_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && car(n) == S9_T_INTEGER) #define s9_real_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && car(n) == S9_T_REAL) #define s9_fix_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && T_FIXNUM == car(n)) #define s9_number_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && \ (car(n) == S9_T_REAL || car(n) == S9_T_INTEGER)) #define s9_primitive_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && \ car(n) == S9_T_PRIMITIVE) #define s9_function_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && \ car(n) == S9_T_FUNCTION) #define s9_continuation_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && \ car(n) == S9_T_CONTINUATION) #define s9_char_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && car(n) == S9_T_CHAR) #define s9_syntax_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && car(n) == S9_T_SYNTAX) #define s9_input_port_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && \ (tag(n) & S9_PORT_TAG) && car(n) == S9_T_INPUT_PORT) #define s9_output_port_p(n) \ (!s9_special_p(n) && (tag(n) & S9_ATOM_TAG) && \ (tag(n) & S9_PORT_TAG) && car(n) == S9_T_OUTPUT_PORT) #define s9_symbol_p(n) \ (!s9_special_p(n) && (tag(n) & S9_VECTOR_TAG) && car(n) == S9_T_SYMBOL) #define s9_vector_p(n) \ (!s9_special_p(n) && (tag(n) & S9_VECTOR_TAG) && car(n) == S9_T_VECTOR) #define s9_string_p(n) \ (!s9_special_p(n) && (tag(n) & S9_VECTOR_TAG) && car(n) == S9_T_STRING) #define s9_constant_p(n) \ (!s9_special_p(n) && (tag(n) & S9_CONST_TAG)) #define s9_atom_p(n) \ (s9_special_p(n) || (tag(n) & S9_ATOM_TAG) || (tag(n) & S9_VECTOR_TAG)) #define s9_pair_p(x) (!s9_atom_p(x)) #define s9_small_int_p(n) (NIL == cddr(n)) #define s9_type_tag(n) \ (S9_TRUE == (n)? S9_T_BOOLEAN: \ S9_FALSE == (n)? S9_T_BOOLEAN: \ (!s9_special_p(n) && (tag(n) & (S9_ATOM_TAG|S9_VECTOR_TAG))? car(n): \ S9_T_NONE)) /* * Allocators */ #define s9_cons(pa, pd) s9_cons3((pa), (pd), 0) #define s9_new_atom(pa, pd) s9_cons3((pa), (pd), S9_ATOM_TAG) #define s9_save(n) (Stack = s9_cons((n), Stack)) /* * Bignum arithmetics */ #define s9_bignum_negative_p(a) ((cadr(a)) < 0) #define s9_bignum_zero_p(a) ((cadr(a)) == 0) #define s9_bignum_positive_p(a) ((cadr(a)) > 0) /* * Real number structure */ #define S9_real_flags(x) (cadr(x)) #define S9_real_exponent(x) (caddr(x)) #define S9_real_mantissa(x) (cdddr(x)) #define S9_REAL_NEGATIVE 0x01 #define S9_real_negative_flag(x) (S9_real_flags(x) & S9_REAL_NEGATIVE) /* * Real-number arithmetics */ #define S9_real_zero_p(x) \ (car(S9_real_mantissa(x)) == 0 && cdr(S9_real_mantissa(x)) == S9_NIL) #define S9_real_negative_p(x) \ (S9_real_negative_flag(x) && !S9_real_zero_p(x)) #define S9_real_positive_p(x) \ (!S9_real_negative_flag(x) && !S9_real_zero_p(x)) #define S9_real_negate(a) \ S9_make_quick_real(S9_real_flags(a) & S9_REAL_NEGATIVE? \ S9_real_flags(a) & ~S9_REAL_NEGATIVE: \ S9_real_flags(a) | S9_REAL_NEGATIVE, \ S9_real_exponent(a), S9_real_mantissa(a)) /* * Globals */ extern s9_cell *S9_car, *S9_cdr; extern char *S9_tag; extern s9_cell *S9_vectors; extern s9_cell S9_stack; extern s9_cell *S9_gc_stack; extern int *S9_gc_stkptr; extern S9_PRIM *S9_primitives; extern s9_cell S9_zero, S9_one, S9_two, S9_ten; extern s9_cell S9_epsilon; extern FILE *S9_ports[]; extern int S9_input_port, S9_output_port, S9_error_port; /* * Prototypes */ #ifdef plan9 int system(char *s); #endif void s9_abort(void); int s9_aborted(void); void s9_add_image_vars(s9_cell **v); s9_cell s9_apply_prim(s9_cell f); s9_cell s9_argv_to_list(char **argv); long s9_asctol(char *s); s9_cell s9_bignum_abs(s9_cell a); s9_cell s9_bignum_add(s9_cell a, s9_cell b); s9_cell s9_bignum_divide(s9_cell a, s9_cell b); int s9_bignum_equal_p(s9_cell a, s9_cell b); int s9_bignum_even_p(s9_cell a); int s9_bignum_less_p(s9_cell a, s9_cell b); s9_cell s9_bignum_multiply(s9_cell a, s9_cell b); s9_cell s9_bignum_negate(s9_cell a); s9_cell s9_bignum_shift_left(s9_cell a, int fill); s9_cell s9_bignum_shift_right(s9_cell a); s9_cell s9_bignum_subtract(s9_cell a, s9_cell b); s9_cell s9_bignum_to_int(s9_cell x, int *of); s9_cell s9_bignum_to_real(s9_cell a); s9_cell s9_bignum_to_string(s9_cell x); int s9_blockread(char *s, int k); void s9_blockwrite(char *s, int k); void s9_close_port(int port); void s9_close_input_string(void); s9_cell s9_cons3(s9_cell pcar, s9_cell pcdr, int ptag); int s9_conses(s9_cell a); void s9_cons_stats(int x); s9_cell s9_copy_string(s9_cell x); void s9_count(s9_counter *c); void s9_countn(s9_counter *c, int n); char *s9_dump_image(char *path, char *magic); int s9_error_port(void); void s9_exponent_chars(char *s); void s9_fatal(char *msg); s9_cell s9_find_symbol(char *s); s9_cell s9_flat_copy(s9_cell n, s9_cell *lastp); void s9_flush(void); int s9_gc(void); int s9_gcv(void); void s9_gc_verbosity(int n); void s9_get_counters(s9_counter **nc, s9_counter **cc, s9_counter **vc, s9_counter **gc); void s9_mem_error_handler(void (*h)(int src)); void s9_image_vars(s9_cell **v); int s9_input_port(void); int s9_inport_open_p(void); int s9_integer_string_p(char *s); s9_cell s9_intern_symbol(s9_cell y); s9_cell s9_int_to_bignum(int v); int s9_io_status(void); void s9_io_reset(void); int s9_length(s9_cell n); char *s9_load_image(char *path, char *magic); int s9_lock_port(int port); s9_cell s9_make_char(int c); s9_cell s9_make_integer(s9_cell i); s9_cell s9_make_norm_real(int flags, s9_cell exp, s9_cell mant); s9_cell s9_make_port(int portno, s9_cell type); s9_cell s9_make_primitive(S9_PRIM *p); s9_cell S9_make_real(int flags, s9_cell exp, s9_cell mant); s9_cell s9_make_real(int sign, s9_cell exp, s9_cell mant); s9_cell s9_make_string(char *s, int k); s9_cell s9_make_symbol(char *s, int k); s9_cell s9_make_vector(int k); s9_cell s9_mkfix(int i); int s9_new_port(void); s9_cell s9_new_vec(s9_cell type, int size); int s9_open_input_port(char *path); char *s9_open_input_string(char *s); int s9_open_output_port(char *path, int append); int s9_output_port(void); int s9_outport_open_p(void); int s9_port_eof(int p); void s9_prints(char *s); int s9_printer_limit(void); void s9_print_bignum(s9_cell n); void s9_print_expanded_real(s9_cell n); void s9_print_real(s9_cell n); void s9_print_sci_real(s9_cell n); int s9_readc(void); s9_cell s9_read_counter(s9_counter *c); s9_cell s9_real_abs(s9_cell a); s9_cell s9_real_add(s9_cell a, s9_cell b); int s9_real_approx_p(s9_cell a, s9_cell b); s9_cell s9_real_ceil(s9_cell x); s9_cell s9_real_divide(s9_cell a, s9_cell b); int s9_real_equal_p(s9_cell a, s9_cell b); s9_cell s9_real_exponent(s9_cell x); s9_cell s9_real_floor(s9_cell x); s9_cell s9_real_integer_p(s9_cell x); int s9_real_less_p(s9_cell a, s9_cell b); s9_cell s9_real_mantissa(s9_cell x); s9_cell s9_real_multiply(s9_cell a, s9_cell b); s9_cell s9_real_negate(s9_cell a); s9_cell s9_real_negative_p(s9_cell a); s9_cell s9_real_positive_p(s9_cell a); s9_cell s9_real_power(s9_cell x, s9_cell y); s9_cell s9_real_round(s9_cell x); s9_cell s9_real_sqrt(s9_cell x); s9_cell s9_real_subtract(s9_cell a, s9_cell b); s9_cell s9_real_to_bignum(s9_cell r); s9_cell s9_real_to_string(s9_cell r, int mode); s9_cell s9_real_trunc(s9_cell x); s9_cell s9_real_zero_p(s9_cell a); void s9_rejectc(int c); void s9_reset(void); void s9_reset_counter(s9_counter *c); void s9_reset_std_ports(void); void s9_run_stats(int x); void s9_fini(void); void s9_init(s9_cell **extroots, s9_cell *stack, int *stkptr); s9_cell s9_set_input_port(s9_cell port); void s9_set_node_limit(int k); s9_cell s9_set_output_port(s9_cell port); void s9_set_printer_limit(int k); void s9_set_vector_limit(int k); int s9_string_numeric_p(char *s); s9_cell s9_string_to_bignum(char *s); s9_cell s9_string_to_number(char *s); s9_cell s9_string_to_real(char *s); s9_cell s9_string_to_symbol(s9_cell x); s9_cell s9_symbol_ref(char *s); s9_cell s9_symbol_table(void); s9_cell s9_symbol_to_string(s9_cell x); char *s9_typecheck(s9_cell f); int s9_unlock_port(int port); s9_cell s9_unsave(int k); void s9_writec(int c);