From b8ae211127736bc82e332359ba25c98eb0099c89 Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Tue, 27 Aug 2019 00:20:50 +0300 Subject: [PATCH] Consolidate the code itself from .h files to scheme.h --- c/argcount.h | 1 - c/bitvector.h | 42 -- c/buf.h | 28 -- c/builtins.h | 17 - c/dtypes.h | 80 ---- c/env.h | 3 - c/error.h | 15 - c/flisp.h | 385 ----------------- c/hashing.h | 11 - c/htable.h | 17 - c/ieee754.h | 62 --- c/ios.h | 193 --------- c/libraries.h | 1 - c/llt.h | 1 - c/os.h | 6 - c/random.h | 9 - c/scheme.h | 1093 ++++++++++++++++++++++++++++++++++++++++++++++- c/socket.h | 11 - c/stringfuncs.h | 3 - c/timefuncs.h | 3 - c/utf8.h | 114 ----- c/utils.h | 3 - 22 files changed, 1070 insertions(+), 1028 deletions(-) delete mode 100644 c/argcount.h delete mode 100644 c/bitvector.h delete mode 100644 c/buf.h delete mode 100644 c/builtins.h delete mode 100644 c/dtypes.h delete mode 100644 c/env.h delete mode 100644 c/error.h delete mode 100644 c/flisp.h delete mode 100644 c/hashing.h delete mode 100644 c/htable.h delete mode 100644 c/ieee754.h delete mode 100644 c/ios.h delete mode 100644 c/libraries.h delete mode 100644 c/llt.h delete mode 100644 c/os.h delete mode 100644 c/random.h delete mode 100644 c/socket.h delete mode 100644 c/stringfuncs.h delete mode 100644 c/timefuncs.h delete mode 100644 c/utf8.h delete mode 100644 c/utils.h diff --git a/c/argcount.h b/c/argcount.h deleted file mode 100644 index 08a3670..0000000 --- a/c/argcount.h +++ /dev/null @@ -1 +0,0 @@ -void argcount(const char *fname, uint32_t nargs, uint32_t c); diff --git a/c/bitvector.h b/c/bitvector.h deleted file mode 100644 index 12daa30..0000000 --- a/c/bitvector.h +++ /dev/null @@ -1,42 +0,0 @@ -// a mask with n set lo or hi bits -#define lomask(n) (uint32_t)((((uint32_t)1) << (n)) - 1) -#define himask(n) (~lomask(32 - n)) -#define ONES32 ((uint32_t)0xffffffff) - -uint32_t bitreverse(uint32_t x); - -uint32_t *bitvector_new(uint64_t n, int initzero); -uint32_t *bitvector_resize(uint32_t *b, uint64_t oldsz, uint64_t newsz, - int initzero); -size_t bitvector_nwords(uint64_t nbits); -void bitvector_set(uint32_t *b, uint64_t n, uint32_t c); -uint32_t bitvector_get(uint32_t *b, uint64_t n); - -uint32_t bitvector_next(uint32_t *b, uint64_t n0, uint64_t n); - -void bitvector_shr(uint32_t *b, size_t n, uint32_t s); -void bitvector_shr_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s); -void bitvector_shl(uint32_t *b, size_t n, uint32_t s); -void bitvector_shl_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s, - bool_t scrap); -void bitvector_fill(uint32_t *b, uint32_t offs, uint32_t c, uint32_t nbits); -void bitvector_copy(uint32_t *dest, uint32_t doffs, uint32_t *a, - uint32_t aoffs, uint32_t nbits); -void bitvector_not(uint32_t *b, uint32_t offs, uint32_t nbits); -void bitvector_not_to(uint32_t *dest, uint32_t doffs, uint32_t *a, - uint32_t aoffs, uint32_t nbits); -void bitvector_reverse(uint32_t *b, uint32_t offs, uint32_t nbits); -void bitvector_reverse_to(uint32_t *dest, uint32_t *src, uint32_t soffs, - uint32_t nbits); -void bitvector_and_to(uint32_t *dest, uint32_t doffs, uint32_t *a, - uint32_t aoffs, uint32_t *b, uint32_t boffs, - uint32_t nbits); -void bitvector_or_to(uint32_t *dest, uint32_t doffs, uint32_t *a, - uint32_t aoffs, uint32_t *b, uint32_t boffs, - uint32_t nbits); -void bitvector_xor_to(uint32_t *dest, uint32_t doffs, uint32_t *a, - uint32_t aoffs, uint32_t *b, uint32_t boffs, - uint32_t nbits); -uint64_t bitvector_count(uint32_t *b, uint32_t offs, uint64_t nbits); -uint32_t bitvector_any0(uint32_t *b, uint32_t offs, uint32_t nbits); -uint32_t bitvector_any1(uint32_t *b, uint32_t offs, uint32_t nbits); diff --git a/c/buf.h b/c/buf.h deleted file mode 100644 index bb89475..0000000 --- a/c/buf.h +++ /dev/null @@ -1,28 +0,0 @@ -// Copyright 2019 Lassi Kortela -// SPDX-License-Identifier: BSD-3-Clause - -struct buf { - size_t cap; - size_t fill; - size_t scan; - size_t mark; - char *bytes; -}; - -struct buf *buf_new(void); -char *buf_resb(struct buf *buf, size_t nbyte); -void buf_put_ios(struct buf *buf, struct ios *ios); -void buf_putc(struct buf *buf, int c); -void buf_putb(struct buf *buf, const void *bytes, size_t nbyte); -void buf_puts(struct buf *buf, const char *s); -void buf_putu(struct buf *buf, uint64_t u); -void buf_free(struct buf *buf); - -int buf_scan_end(struct buf *buf); -int buf_scan_byte(struct buf *buf, int byte); -int buf_scan_bag(struct buf *buf, const char *bag); -int buf_scan_bag_not(struct buf *buf, const char *bag); -int buf_scan_while(struct buf *buf, const char *bag); -int buf_scan_while_not(struct buf *buf, const char *bag); -void buf_scan_mark(struct buf *buf); -int buf_scan_equals(struct buf *buf, const char *s); diff --git a/c/builtins.h b/c/builtins.h deleted file mode 100644 index a22fe93..0000000 --- a/c/builtins.h +++ /dev/null @@ -1,17 +0,0 @@ -value_t builtin_pid(value_t *args, uint32_t nargs); -value_t builtin_parent_pid(value_t *args, uint32_t nargs); -value_t builtin_process_group(value_t *args, uint32_t nargs); - -value_t builtin_user_effective_gid(value_t *args, uint32_t nargs); -value_t builtin_user_effective_uid(value_t *args, uint32_t nargs); -value_t builtin_user_real_gid(value_t *args, uint32_t nargs); -value_t builtin_user_real_uid(value_t *args, uint32_t nargs); - -value_t builtin_term_init(value_t *args, uint32_t nargs); -value_t builtin_term_exit(value_t *args, uint32_t nargs); - -value_t builtin_spawn(value_t *args, uint32_t nargs); - -value_t builtin_read_ini_file(value_t *args, uint32_t nargs); - -value_t builtin_color_name_to_rgb24(value_t *args, uint32_t nargs); diff --git a/c/dtypes.h b/c/dtypes.h deleted file mode 100644 index bf7229f..0000000 --- a/c/dtypes.h +++ /dev/null @@ -1,80 +0,0 @@ -/* - This file defines sane integer types for our target platforms. This - library only runs on machines with the following characteristics: - - - supports integer word sizes of 8, 16, 32, and 64 bits - - uses unsigned and signed 2's complement representations - - all pointer types are the same size - - there is an integer type with the same size as a pointer - - Some features require: - - IEEE 754 single- and double-precision floating point - - We assume the LP64 convention for 64-bit platforms. -*/ - -#undef BITS32 -#undef BITS64 - -#ifdef __WATCOMC__ -typedef float float_t; -typedef double double_t; -#define __ORDER_BIG_ENDIAN__ 4321 -#define __ORDER_LITTLE_ENDIAN__ 1234 -#define __BYTE_ORDER__ __ORDER_LITTLE_ENDIAN__ -#define BITS32 -#endif - -#ifndef __WATCOMC__ -#define BITS64 -#endif - -#define LLT_ALLOC(n) malloc(n) -#define LLT_REALLOC(p, n) realloc((p), (n)) -#define LLT_FREE(x) free(x) - -typedef int bool_t; - -#ifdef BITS64 -#define TOP_BIT 0x8000000000000000 -#define NBITS 64 -#else -#define TOP_BIT 0x80000000 -#define NBITS 32 -#endif - -#define LLT_ALIGN(x, sz) (((x) + (sz - 1)) & (-sz)) - -// branch prediction annotations -#ifdef __GNUC__ -#define __unlikely(x) __builtin_expect(!!(x), 0) -#define __likely(x) __builtin_expect(!!(x), 1) -#else -#define __unlikely(x) (x) -#define __likely(x) (x) -#endif - -#define DBL_MAXINT 9007199254740992LL -#define FLT_MAXINT 16777216 -#define U64_MAX 18446744073709551615ULL -#define S64_MAX 9223372036854775807LL -#define S64_MIN (-S64_MAX - 1LL) -#define BIT63 0x8000000000000000LL -#define BIT31 0x80000000 - -#define LOG2_10 3.3219280948873626 -#define sign_bit(r) ((*(int64_t *)&(r)) & BIT63) -#define LABS(n) (((n) ^ ((n) >> (NBITS - 1))) - ((n) >> (NBITS - 1))) -#define NBABS(n, nb) (((n) ^ ((n) >> ((nb)-1))) - ((n) >> ((nb)-1))) -#define DFINITE(d) \ - (((*(int64_t *)&(d)) & 0x7ff0000000000000LL) != 0x7ff0000000000000LL) -#define DNAN(d) ((d) != (d)) - -extern double D_PNAN; -extern double D_NNAN; -extern double D_PINF; -extern double D_NINF; -extern float F_PNAN; -extern float F_NNAN; -extern float F_PINF; -extern float F_NINF; diff --git a/c/env.h b/c/env.h deleted file mode 100644 index fcd8b7d..0000000 --- a/c/env.h +++ /dev/null @@ -1,3 +0,0 @@ -const char *env_get_os_name(void); - -value_t builtin_environment_stack(value_t *args, uint32_t nargs); diff --git a/c/error.h b/c/error.h deleted file mode 100644 index cddf45a..0000000 --- a/c/error.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifdef __DMC__ -#include "error_dmc.h" -#endif - -#ifdef __GNUC__ -#include "error_gnuc.h" -#endif - -#ifdef _MSC_VER -#include "error_msc.h" -#endif - -#ifdef __WATCOMC__ -#include "error_watcomc.h" -#endif diff --git a/c/flisp.h b/c/flisp.h deleted file mode 100644 index 220cb3d..0000000 --- a/c/flisp.h +++ /dev/null @@ -1,385 +0,0 @@ -typedef uintptr_t value_t; -typedef uintptr_t ufixnum_t; -typedef intptr_t fixnum_t; -#ifdef BITS64 -#define T_FIXNUM T_INT64 -#else -#define T_FIXNUM T_INT32 -#endif - -struct cons { - value_t car; - value_t cdr; -}; - -struct symbol { - uintptr_t flags; - value_t binding; // global value binding - struct fltype *type; - uint32_t hash; - void *dlcache; // dlsym address - // below fields are private - struct symbol *left; - struct symbol *right; - union { - char name[1]; - void *_pad; // ensure field aligned to pointer size - }; -}; - -struct gensym { - value_t isconst; - value_t binding; // global value binding - struct fltype *type; - uint32_t id; -}; - -#define TAG_NUM 0x0 -#define TAG_CPRIM 0x1 -#define TAG_FUNCTION 0x2 -#define TAG_VECTOR 0x3 -#define TAG_NUM1 0x4 -#define TAG_CVALUE 0x5 -#define TAG_SYM 0x6 -#define TAG_CONS 0x7 -#define UNBOUND ((value_t)0x1) // an invalid value -#define TAG_FWD UNBOUND -#define tag(x) ((x)&0x7) -#define ptr(x) ((void *)((x) & (~(value_t)0x7))) -#define tagptr(p, t) (((value_t)(p)) | (t)) -#define fixnum(x) ((value_t)(((ufixnum_t)(fixnum_t)(x)) << 2)) -#define numval(x) (((fixnum_t)(x)) >> 2) -#ifdef BITS64 -#define fits_fixnum(x) (((x) >> 61) == 0 || (~((x) >> 61)) == 0) -#else -#define fits_fixnum(x) (((x) >> 29) == 0 || (~((x) >> 29)) == 0) -#endif -#define fits_bits(x, b) (((x) >> (b - 1)) == 0 || (~((x) >> (b - 1))) == 0) -#define uintval(x) (((unsigned int)(x)) >> 3) -#define builtin(n) tagptr((((int)n) << 3), TAG_FUNCTION) -#define iscons(x) (tag(x) == TAG_CONS) -#define issymbol(x) (tag(x) == TAG_SYM) -#define isfixnum(x) (((x)&3) == TAG_NUM) -#define bothfixnums(x, y) ((((x) | (y)) & 3) == TAG_NUM) -#define isbuiltin(x) ((tag(x) == TAG_FUNCTION) && uintval(x) <= OP_ASET) -#define isvector(x) (tag(x) == TAG_VECTOR) -#define iscvalue(x) (tag(x) == TAG_CVALUE) -#define iscprim(x) (tag(x) == TAG_CPRIM) -#define selfevaluating(x) (tag(x) < 6) -// comparable with == -#define eq_comparable(a, b) (!(((a) | (b)) & 1)) -#define eq_comparablep(a) (!((a)&1)) -// doesn't lead to other values -#define leafp(a) (((a)&3) != 3) - -#define isforwarded(v) (((value_t *)ptr(v))[0] == TAG_FWD) -#define forwardloc(v) (((value_t *)ptr(v))[1]) -#define forward(v, to) \ - do { \ - (((value_t *)ptr(v))[0] = TAG_FWD); \ - (((value_t *)ptr(v))[1] = to); \ - } while (0) - -#define vector_size(v) (((size_t *)ptr(v))[0] >> 2) -#define vector_setsize(v, n) (((size_t *)ptr(v))[0] = ((n) << 2)) -#define vector_elt(v, i) (((value_t *)ptr(v))[1 + (i)]) -#define vector_grow_amt(x) ((x) < 8 ? 5 : 6 * ((x) >> 3)) -// functions ending in _ are unsafe, faster versions -#define car_(v) (((struct cons *)ptr(v))->car) -#define cdr_(v) (((struct cons *)ptr(v))->cdr) -#define car(v) (tocons((v), "car")->car) -#define cdr(v) (tocons((v), "cdr")->cdr) -#define fn_bcode(f) (((value_t *)ptr(f))[0]) -#define fn_vals(f) (((value_t *)ptr(f))[1]) -#define fn_env(f) (((value_t *)ptr(f))[2]) -#define fn_name(f) (((value_t *)ptr(f))[3]) - -#define set(s, v) (((struct symbol *)ptr(s))->binding = (v)) -#define setc(s, v) \ - do { \ - ((struct symbol *)ptr(s))->flags |= 1; \ - ((struct symbol *)ptr(s))->binding = (v); \ - } while (0) -#define isconstant(s) ((s)->flags & 0x1) -#define iskeyword(s) ((s)->flags & 0x2) -#define symbol_value(s) (((struct symbol *)ptr(s))->binding) -#define ismanaged(v) \ - ((((unsigned char *)ptr(v)) >= fromspace) && \ - (((unsigned char *)ptr(v)) < fromspace + heapsize)) -#define isgensym(x) (issymbol(x) && ismanaged(x)) - -#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS << 3)) -#define isclosure(x) isfunction(x) -#define iscbuiltin(x) \ - (iscvalue(x) && (cv_class((struct cvalue *)ptr(x)) == builtintype)) - -void fl_gc_handle(value_t *pv); -void fl_free_gc_handles(uint32_t n); - -// utility for iterating over all arguments in a builtin -// i=index, i0=start index, arg = var for each arg, args = arg array -// assumes "nargs" is the argument count -#define FOR_ARGS(i, i0, arg, args) \ - for (i = i0; ((size_t)i) < nargs && ((arg = args[i]) || 1); i++) - -#define N_BUILTINS ((int)N_OPCODES) - -extern value_t FL_NIL, FL_T, FL_F, FL_EOF; - -#define FL_UNSPECIFIED FL_T - -/* read, eval, print main entry points */ -value_t fl_read_sexpr(value_t f); -void fl_print(struct ios *f, value_t v); -value_t fl_toplevel_eval(value_t expr); -value_t fl_apply(value_t f, value_t l); -value_t fl_applyn(uint32_t n, value_t f, ...); - -extern value_t printprettysym, printreadablysym, printwidthsym; - -/* object model manipulation */ -value_t fl_cons(value_t a, value_t b); -value_t fl_list2(value_t a, value_t b); -value_t fl_listn(size_t n, ...); -value_t symbol(const char *str); -char *symbol_name(value_t v); -int fl_is_keyword_name(const char *str, size_t len); -value_t alloc_vector(size_t n, int init); -size_t llength(value_t v); -value_t fl_compare(value_t a, value_t b); // -1, 0, or 1 -value_t fl_equal(value_t a, value_t b); // T or nil -int equal_lispvalue(value_t a, value_t b); -uintptr_t hash_lispvalue(value_t a); -int isnumtok_base(char *tok, value_t *pval, int base); - -/* safe casts */ -struct cons *tocons(value_t v, char *fname); -struct symbol *tosymbol(value_t v, char *fname); -fixnum_t tofixnum(value_t v, char *fname); -char *tostring(value_t v, char *fname); - -/* error handling */ -struct fl_readstate { - struct htable backrefs; - struct htable gensyms; - value_t source; - struct fl_readstate *prev; -}; - -struct fl_exception_context { - jmp_buf buf; - uint32_t sp; - uint32_t frame; - uint32_t ngchnd; - struct fl_readstate *rdst; - struct fl_exception_context *prev; -}; - -extern struct fl_exception_context *fl_ctx; -extern uint32_t fl_throwing_frame; -extern value_t fl_lasterror; - -#define FL_TRY_EXTERN \ - struct fl_exception_context _ctx; \ - int l__tr, l__ca; \ - fl_savestate(&_ctx); \ - fl_ctx = &_ctx; \ - if (!setjmp(_ctx.buf)) \ - for (l__tr = 1; l__tr; l__tr = 0, (void)(fl_ctx = fl_ctx->prev)) - -#define FL_CATCH_EXTERN \ - else for (l__ca = 1; l__ca; l__ca = 0, fl_restorestate(&_ctx)) - -void fl_savestate(struct fl_exception_context *_ctx); -void fl_restorestate(struct fl_exception_context *_ctx); -extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError; -extern value_t UnboundError; - -struct cvtable { - void (*print)(value_t self, struct ios *f); - void (*relocate)(value_t oldv, value_t newv); - void (*finalize)(value_t self); - void (*print_traverse)(value_t self); -}; - -/* functions needed to implement the value interface (struct cvtable) */ -typedef enum { - T_INT8, - T_UINT8, - T_INT16, - T_UINT16, - T_INT32, - T_UINT32, - T_INT64, - T_UINT64, - T_FLOAT, - T_DOUBLE -} numerictype_t; - -#define N_NUMTYPES ((int)T_DOUBLE + 1) - -#ifdef BITS64 -#define T_LONG T_INT64 -#define T_ULONG T_UINT64 -#else -#define T_LONG T_INT32 -#define T_ULONG T_UINT32 -#endif - -value_t relocate_lispvalue(value_t v); -void print_traverse(value_t v); -void fl_print_chr(char c, struct ios *f); -void fl_print_str(char *s, struct ios *f); -void fl_print_child(struct ios *f, value_t v); - -typedef int (*cvinitfunc_t)(struct fltype *, value_t, void *); - -struct fltype { - value_t type; - numerictype_t numtype; - size_t size; - size_t elsz; - struct cvtable *vtable; - struct fltype *eltype; // for arrays - struct fltype *artype; // (array this) - int marked; - cvinitfunc_t init; -}; - -struct cvalue { - struct fltype *type; - void *data; - size_t len; // length of *data in bytes - union { - value_t parent; // optional - char _space[1]; // variable size - }; -}; - -#define CVALUE_NWORDS 4 - -struct cprim { - struct fltype *type; - char _space[1]; -}; - -struct function { - value_t bcode; - value_t vals; - value_t env; - value_t name; -}; - -#define CPRIM_NWORDS 2 -#define MAX_INL_SIZE 384 - -#define CV_OWNED_BIT 0x1 -#define CV_PARENT_BIT 0x2 -#define owned(cv) ((uintptr_t)(cv)->type & CV_OWNED_BIT) -#define hasparent(cv) ((uintptr_t)(cv)->type & CV_PARENT_BIT) -#define isinlined(cv) ((cv)->data == &(cv)->_space[0]) -#define cv_class(cv) ((struct fltype *)(((uintptr_t)(cv)->type) & ~3)) -#define cv_len(cv) ((cv)->len) -#define cv_type(cv) (cv_class(cv)->type) -#define cv_data(cv) ((cv)->data) -#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype) -#define cv_isPOD(cv) (cv_class(cv)->init != NULL) - -#define cvalue_data(v) cv_data((struct cvalue *)ptr(v)) -#define cvalue_len(v) cv_len((struct cvalue *)ptr(v)) -#define value2c(type, v) ((type)cv_data((struct cvalue *)ptr(v))) - -#define valid_numtype(v) ((v) < N_NUMTYPES) -#define cp_class(cp) ((cp)->type) -#define cp_type(cp) (cp_class(cp)->type) -#define cp_numtype(cp) (cp_class(cp)->numtype) -#define cp_data(cp) (&(cp)->_space[0]) - -// WARNING: multiple evaluation! -#define cptr(v) \ - (iscprim(v) ? cp_data((struct cprim *)ptr(v)) \ - : cv_data((struct cvalue *)ptr(v))) - -typedef value_t (*builtin_t)(value_t *, uint32_t); - -extern value_t QUOTE; -extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym; -extern value_t int64sym, uint64sym; -extern value_t longsym, ulongsym, bytesym, wcharsym; -extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, -pointersym; -extern value_t stringtypesym, wcstringtypesym, emptystringsym; -extern value_t unionsym, floatsym, doublesym; -extern struct fltype *bytetype, *wchartype; -extern struct fltype *stringtype, *wcstringtype; -extern struct fltype *builtintype; - -value_t cvalue(struct fltype *type, size_t sz); -void add_finalizer(struct cvalue *cv); -void cv_autorelease(struct cvalue *cv); -void cv_pin(struct cvalue *cv); -size_t ctype_sizeof(value_t type, int *palign); -value_t cvalue_copy(value_t v); -value_t cvalue_from_data(struct fltype *type, void *data, size_t sz); -value_t cvalue_from_ref(struct fltype *type, void *ptr, size_t sz, - value_t parent); -value_t cbuiltin(char *name, builtin_t f); -size_t cvalue_arraylen(value_t v); -value_t size_wrap(size_t sz); -size_t toulong(value_t n, char *fname); -value_t cvalue_string(size_t sz); -value_t cvalue_static_cstring(const char *str); -value_t string_from_cstr(const char *str); -value_t string_from_cstrn(const char *str, size_t n); -int fl_isstring(value_t v); -int fl_isnumber(value_t v); -int fl_isgensym(value_t v); -int fl_isiostream(value_t v); -struct ios *fl_toiostream(value_t v, const char *fname); -value_t cvalue_compare(value_t a, value_t b); -int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname); - -void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz); - -struct fltype *get_type(value_t t); -struct fltype *get_array_type(value_t eltype); -struct fltype *define_opaque_type(value_t sym, size_t sz, - struct cvtable *vtab, cvinitfunc_t init); - -value_t mk_double(double_t n); -value_t mk_float(float_t n); -value_t mk_uint32(uint32_t n); -value_t mk_uint64(uint64_t n); -value_t mk_wchar(int32_t n); -value_t return_from_uint64(uint64_t Uaccum); -value_t return_from_int64(int64_t Saccum); - -numerictype_t effective_numerictype(double r); -double conv_to_double(void *data, numerictype_t tag); -void conv_from_double(void *data, double d, numerictype_t tag); -int64_t conv_to_int64(void *data, numerictype_t tag); -uint64_t conv_to_uint64(void *data, numerictype_t tag); -int32_t conv_to_int32(void *data, numerictype_t tag); -uint32_t conv_to_uint32(void *data, numerictype_t tag); -#ifdef BITS64 -#define conv_to_long conv_to_int64 -#define conv_to_ulong conv_to_uint64 -#else -#define conv_to_long conv_to_int32 -#define conv_to_ulong conv_to_uint32 -#endif - -struct builtinspec { - char *name; - builtin_t fptr; -}; - -void assign_global_builtins(struct builtinspec *b); - -/* builtins */ -value_t fl_hash(value_t *args, uint32_t nargs); -value_t cvalue_byte(value_t *args, uint32_t nargs); -value_t cvalue_wchar(value_t *args, uint32_t nargs); - -void fl_init(size_t initial_heapsize); -int fl_load_boot_image(void); diff --git a/c/hashing.h b/c/hashing.h deleted file mode 100644 index b974e78..0000000 --- a/c/hashing.h +++ /dev/null @@ -1,11 +0,0 @@ -uintptr_t nextipow2(uintptr_t i); -uint32_t int32hash(uint32_t a); -uint64_t int64hash(uint64_t key); -uint32_t int64to32hash(uint64_t key); -#ifdef BITS64 -#define inthash int64hash -#else -#define inthash int32hash -#endif -uint64_t memhash(const char *buf, size_t n); -uint32_t memhash32(const char *buf, size_t n); diff --git a/c/htable.h b/c/htable.h deleted file mode 100644 index a983d25..0000000 --- a/c/htable.h +++ /dev/null @@ -1,17 +0,0 @@ -#define HT_N_INLINE 32 - -struct htable { - size_t size; - void **table; - void *_space[HT_N_INLINE]; -}; - -// define this to be an invalid key/value -#define HT_NOTFOUND ((void *)1) - -// initialize and free -struct htable *htable_new(struct htable *h, size_t size); -void htable_free(struct htable *h); - -// clear and (possibly) change size -void htable_reset(struct htable *h, size_t sz); diff --git a/c/ieee754.h b/c/ieee754.h deleted file mode 100644 index 67275bb..0000000 --- a/c/ieee754.h +++ /dev/null @@ -1,62 +0,0 @@ -union ieee754_float { - float f; - - struct { -#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ - unsigned int negative : 1; - unsigned int exponent : 8; - unsigned int mantissa : 23; -#endif -#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ - unsigned int mantissa : 23; - unsigned int exponent : 8; - unsigned int negative : 1; -#endif - } ieee; -}; - -#define IEEE754_FLOAT_BIAS 0x7f - -union ieee754_double { - double d; - - struct { -#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ - unsigned int negative : 1; - unsigned int exponent : 11; - unsigned int mantissa0 : 20; - unsigned int mantissa1 : 32; -#endif -#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ - unsigned int mantissa1 : 32; - unsigned int mantissa0 : 20; - unsigned int exponent : 11; - unsigned int negative : 1; -#endif - } ieee; -}; - -#define IEEE754_DOUBLE_BIAS 0x3ff - -union ieee854_long_double { - long double d; - - struct { -#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ - unsigned int negative : 1; - unsigned int exponent : 15; - unsigned int empty : 16; - unsigned int mantissa0 : 32; - unsigned int mantissa1 : 32; -#endif -#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ - unsigned int mantissa1 : 32; - unsigned int mantissa0 : 32; - unsigned int exponent : 15; - unsigned int negative : 1; - unsigned int empty : 16; -#endif - } ieee; -}; - -#define IEEE854_LONG_DOUBLE_BIAS 0x3fff diff --git a/c/ios.h b/c/ios.h deleted file mode 100644 index 16ce65b..0000000 --- a/c/ios.h +++ /dev/null @@ -1,193 +0,0 @@ -// this flag controls when data actually moves out to the underlying I/O -// channel. memory streams are a special case of this where the data -// never moves out. -typedef enum { bm_none, bm_line, bm_block, bm_mem } bufmode_t; - -typedef enum { bst_none, bst_rd, bst_wr } bufstate_t; - -#define IOS_INLSIZE 54 -#define IOS_BUFSIZE 131072 - -struct ios { - bufmode_t bm; - - // the state only indicates where the underlying file position is relative - // to the buffer. reading: at the end. writing: at the beginning. - // in general, you can do any operation in any state. - bufstate_t state; - - int errcode; - - char *buf; // start of buffer - size_t maxsize; // space allocated to buffer - size_t size; // length of valid data in buf, >=ndirty - size_t bpos; // current position in buffer - size_t ndirty; // # bytes at &buf[0] that need to be written - - off_t fpos; // cached file pos - size_t lineno; // current line number - - // pointer-size integer to support platforms where it might have - // to be a pointer - long fd; - - unsigned char readonly : 1; - unsigned char ownbuf : 1; - unsigned char ownfd : 1; - unsigned char _eof : 1; - - // this means you can read, seek back, then read the same data - // again any number of times. usually only true for files and strings. - unsigned char rereadable : 1; - - char local[IOS_INLSIZE]; -}; - -/* low-level interface functions */ -size_t ios_read(struct ios *s, char *dest, size_t n); -size_t ios_readall(struct ios *s, char *dest, size_t n); -size_t ios_write(struct ios *s, char *data, size_t n); -off_t ios_seek(struct ios *s, off_t pos); // absolute seek -off_t ios_seek_end(struct ios *s); -off_t ios_skip(struct ios *s, off_t offs); // relative seek -off_t ios_pos(struct ios *s); // get current position -size_t ios_trunc(struct ios *s, size_t size); -int ios_eof(struct ios *s); -int ios_flush(struct ios *s); -void ios_close(struct ios *s); -char *ios_takebuf(struct ios *s, - size_t *psize); // release buffer to caller -// set buffer space to use -int ios_setbuf(struct ios *s, char *buf, size_t size, int own); -int ios_bufmode(struct ios *s, bufmode_t mode); -void ios_set_readonly(struct ios *s); -size_t ios_copy(struct ios *to, struct ios *from, size_t nbytes); -size_t ios_copyall(struct ios *to, struct ios *from); -size_t ios_copyuntil(struct ios *to, struct ios *from, char delim); -// ensure at least n bytes are buffered if possible. returns # available. -size_t ios_readprep(struct ios *from, size_t n); -// void ios_lock(struct ios *s); -// int struct iosrylock(struct ios *s); -// int ios_unlock(struct ios *s); - -/* stream creation */ -struct ios *ios_file(struct ios *s, char *fname, int rd, int wr, int create, - int trunc); -struct ios *ios_mem(struct ios *s, size_t initsize); -struct ios *ios_str(struct ios *s, char *str); -struct ios *ios_static_buffer(struct ios *s, char *buf, size_t sz); -struct ios *ios_fd(struct ios *s, long fd, int isfile, int own); -// todo: ios_socket -extern struct ios *ios_stdin; -extern struct ios *ios_stdout; -extern struct ios *ios_stderr; -void ios_init_stdstreams(); - -/* high-level functions - output */ -int ios_putnum(struct ios *s, char *data, uint32_t type); -int ios_putint(struct ios *s, int n); -int ios_pututf8(struct ios *s, uint32_t wc); -int ios_putstringz(struct ios *s, char *str, bool_t do_write_nulterm); -int ios_printf(struct ios *s, const char *format, ...); -int ios_vprintf(struct ios *s, const char *format, va_list args); - -void hexdump(struct ios *dest, const char *buffer, size_t len, - size_t startoffs); - -/* high-level stream functions - input */ -int ios_getnum(struct ios *s, char *data, uint32_t type); -int ios_getutf8(struct ios *s, uint32_t *pwc); -int ios_peekutf8(struct ios *s, uint32_t *pwc); -int ios_ungetutf8(struct ios *s, uint32_t wc); -int ios_getstringz(struct ios *dest, struct ios *src); -int ios_getstringn(struct ios *dest, struct ios *src, size_t nchars); -int ios_getline(struct ios *s, char **pbuf, size_t *psz); -char *ios_readline(struct ios *s); - -// discard data buffered for reading -void ios_purge(struct ios *s); - -// seek by utf8 sequence increments -int ios_nextutf8(struct ios *s); -int ios_prevutf8(struct ios *s); - -/* stdio-style functions */ -#define IOS_EOF (-1) -int ios_putc(int c, struct ios *s); -// wint_t ios_putwc(struct ios *s, wchar_t wc); -int ios_getc(struct ios *s); -int ios_peekc(struct ios *s); -// wint_t ios_getwc(struct ios *s); -int ios_ungetc(int c, struct ios *s); -// wint_t ios_ungetwc(struct ios *s, wint_t wc); -#define ios_puts(str, s) ios_write(s, str, strlen(str)) - -/* - With memory streams, mixed reads and writes are equivalent to performing - sequences of *p++, as either an lvalue or rvalue. File streams behave - similarly, but other streams might not support this. Using unbuffered - mode makes this more predictable. - - Note on "unget" functions: - There are two kinds of functions here: those that operate on sized - blocks of bytes and those that operate on logical units like "character" - or "integer". The "unget" functions only work on logical units. There - is no "unget n bytes". You can only do an unget after a matching get. - However, data pushed back by an unget is available to all read operations. - The reason for this is that unget is defined in terms of its effect on - the underlying buffer (namely, it rebuffers data as if it had been - buffered but not read yet). IOS reserves the right to perform large block - operations directly, bypassing the buffer. In such a case data was - never buffered, so "rebuffering" has no meaning (i.e. there is no - correspondence between the buffer and the physical stream). - - Single-bit I/O is able to write partial bytes ONLY IF the stream supports - seeking. Also, line buffering is not well-defined in the context of - single-bit I/O, so it might not do what you expect. - - implementation notes: - in order to know where we are in a file, we must ensure the buffer - is only populated from the underlying stream starting with p==buf. - - to switch from writing to reading: flush, set p=buf, cnt=0 - to switch from reading to writing: seek backwards cnt bytes, p=buf, cnt=0 - - when writing: buf starts at curr. physical stream pos, p - buf is how - many bytes we've written logically. cnt==0 - - dirty == (bitpos>0 && state==iost_wr), EXCEPT right after switching from - reading to writing, where we might be in the middle of a byte without - having changed it. - - to write a bit: if !dirty, read up to maxsize-(p-buf) into buffer, then - seek back by the same amount (undo it). write onto those bits. now set - the dirty bit. in this state, we can bit-read up to the end of the byte, - then formally switch to the read state using flush. - - design points: - - data-source independence, including memory streams - - expose buffer to user, allow user-owned buffers - - allow direct I/O, don't always go through buffer - - buffer-internal seeking. makes seeking back 1-2 bytes very fast, - and makes it possible for sockets where it otherwise wouldn't be - - tries to allow switching between reading and writing - - support 64-bit and large files - - efficient, low-latency buffering - - special support for utf8 - - type-aware functions with byte-order swapping service - - position counter for meaningful data offsets with sockets - - theory of operation: - - the buffer is a view of part of a file/stream. you can seek, read, and - write around in it as much as you like, as if it were just a string. - - we keep track of the part of the buffer that's invalid (written to). - we remember whether the position of the underlying stream is aligned - with the end of the buffer (reading mode) or the beginning (writing mode). - - based on this info, we might have to seek back before doing a flush. - - as optimizations, we do no writing if the buffer isn't "dirty", and we - do no reading if the data will only be overwritten. -*/ diff --git a/c/libraries.h b/c/libraries.h deleted file mode 100644 index 12d4d99..0000000 --- a/c/libraries.h +++ /dev/null @@ -1 +0,0 @@ -value_t builtin_import(value_t *args, uint32_t nargs); diff --git a/c/llt.h b/c/llt.h deleted file mode 100644 index 5bd03bb..0000000 --- a/c/llt.h +++ /dev/null @@ -1 +0,0 @@ -void llt_init(); diff --git a/c/os.h b/c/os.h deleted file mode 100644 index 128e949..0000000 --- a/c/os.h +++ /dev/null @@ -1,6 +0,0 @@ -void path_to_dirname(char *path); -void get_cwd(char *buf, size_t size); -int set_cwd(char *buf); -char *get_exename(char *buf, size_t size); -int os_path_exists(const char *path); -void os_setenv(const char *name, const char *value); diff --git a/c/random.h b/c/random.h deleted file mode 100644 index 383fa67..0000000 --- a/c/random.h +++ /dev/null @@ -1,9 +0,0 @@ -#define random() genrand_int32() -#define srandom(n) init_genrand(n) -double rand_double(); -float rand_float(); -double randn(); -void randomize(); -uint32_t genrand_int32(); -void init_genrand(uint32_t s); -uint64_t i64time(); diff --git a/c/scheme.h b/c/scheme.h index 3bfa244..3917cec 100644 --- a/c/scheme.h +++ b/c/scheme.h @@ -1,25 +1,1072 @@ -#include "dtypes.h" -#include "utils.h" -#include "utf8.h" -#include "ios.h" -#include "socket.h" -#include "timefuncs.h" -#include "hashing.h" -#include "htable.h" -#include "bitvector.h" -#include "os.h" -#include "random.h" -#include "llt.h" -#include "ieee754.h" -#include "flisp.h" -#include "error.h" -#include "buf.h" -#include "argcount.h" -#include "env.h" +// Copyright 2008 Jeff Bezanson +// Copyright 2019 Lassi Kortela +// SPDX-License-Identifier: BSD-3-Clause + +//// #include "dtypes.h" + +/* + This file defines sane integer types for our target platforms. This + library only runs on machines with the following characteristics: + + - supports integer word sizes of 8, 16, 32, and 64 bits + - uses unsigned and signed 2's complement representations + - all pointer types are the same size + - there is an integer type with the same size as a pointer + + Some features require: + - IEEE 754 single- and double-precision floating point + + We assume the LP64 convention for 64-bit platforms. +*/ + +#undef BITS32 +#undef BITS64 + +#ifdef __WATCOMC__ +typedef float float_t; +typedef double double_t; +#define __ORDER_BIG_ENDIAN__ 4321 +#define __ORDER_LITTLE_ENDIAN__ 1234 +#define __BYTE_ORDER__ __ORDER_LITTLE_ENDIAN__ +#define BITS32 +#endif + +#ifndef __WATCOMC__ +#define BITS64 +#endif + +#define LLT_ALLOC(n) malloc(n) +#define LLT_REALLOC(p, n) realloc((p), (n)) +#define LLT_FREE(x) free(x) + +typedef int bool_t; + +#ifdef BITS64 +#define TOP_BIT 0x8000000000000000 +#define NBITS 64 +#else +#define TOP_BIT 0x80000000 +#define NBITS 32 +#endif + +#define LLT_ALIGN(x, sz) (((x) + (sz - 1)) & (-sz)) + +// branch prediction annotations +#ifdef __GNUC__ +#define __unlikely(x) __builtin_expect(!!(x), 0) +#define __likely(x) __builtin_expect(!!(x), 1) +#else +#define __unlikely(x) (x) +#define __likely(x) (x) +#endif + +#define DBL_MAXINT 9007199254740992LL +#define FLT_MAXINT 16777216 +#define U64_MAX 18446744073709551615ULL +#define S64_MAX 9223372036854775807LL +#define S64_MIN (-S64_MAX - 1LL) +#define BIT63 0x8000000000000000LL +#define BIT31 0x80000000 + +#define LOG2_10 3.3219280948873626 +#define sign_bit(r) ((*(int64_t *)&(r)) & BIT63) +#define LABS(n) (((n) ^ ((n) >> (NBITS - 1))) - ((n) >> (NBITS - 1))) +#define NBABS(n, nb) (((n) ^ ((n) >> ((nb)-1))) - ((n) >> ((nb)-1))) +#define DFINITE(d) \ + (((*(int64_t *)&(d)) & 0x7ff0000000000000LL) != 0x7ff0000000000000LL) +#define DNAN(d) ((d) != (d)) + +extern double D_PNAN; +extern double D_NNAN; +extern double D_PINF; +extern double D_NINF; +extern float F_PNAN; +extern float F_NNAN; +extern float F_PINF; +extern float F_NINF; + +//// #include "utils.h" + +char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base); +int str2int(char *str, size_t len, int64_t *res, uint32_t base); +int isdigit_base(char c, int base); + +//// #include "utf8.h" + +extern int locale_is_utf8; + +#ifdef _WIN32 +extern int wcwidth(uint32_t); +#endif + +/* is c the start of a utf8 sequence? */ +#define isutf(c) (((c)&0xC0) != 0x80) + +#define UEOF ((uint32_t)-1) + +/* convert UTF-8 data to wide character */ +size_t u8_toucs(uint32_t *dest, size_t sz, const char *src, size_t srcsz); + +/* the opposite conversion */ +size_t u8_toutf8(char *dest, size_t sz, const uint32_t *src, size_t srcsz); + +/* single character to UTF-8, returns # bytes written */ +size_t u8_wc_toutf8(char *dest, uint32_t ch); + +/* character number to byte offset */ +size_t u8_offset(const char *str, size_t charnum); + +/* byte offset to character number */ +size_t u8_charnum(const char *s, size_t offset); + +/* return next character, updating an index variable */ +uint32_t u8_nextchar(const char *s, size_t *i); + +/* next character without NUL character terminator */ +uint32_t u8_nextmemchar(const char *s, size_t *i); + +/* move to next character */ +void u8_inc(const char *s, size_t *i); + +/* move to previous character */ +void u8_dec(const char *s, size_t *i); + +/* returns length of next utf-8 sequence */ +size_t u8_seqlen(const char *s); + +/* returns the # of bytes needed to encode a certain character */ +size_t u8_charlen(uint32_t ch); + +/* computes the # of bytes needed to encode a WC string as UTF-8 */ +size_t u8_codingsize(uint32_t *wcstr, size_t n); + +char read_escape_control_char(char c); + +/* assuming src points to the character after a backslash, read an + escape sequence, storing the result in dest and returning the number of + input characters processed */ +size_t u8_read_escape_sequence(const char *src, size_t ssz, uint32_t *dest); + +/* given a wide character, convert it to an ASCII escape sequence stored in + buf, where buf is "sz" bytes. returns the number of characters output. + sz must be at least 3. */ +int u8_escape_wchar(char *buf, size_t sz, uint32_t ch); + +/* convert a string "src" containing escape sequences to UTF-8 */ +size_t u8_unescape(char *buf, size_t sz, const char *src); + +/* convert UTF-8 "src" to escape sequences. + + sz is buf size in bytes. must be at least 12. + + if escape_quotes is nonzero, quote characters will be escaped. + + if ascii is nonzero, the output is 7-bit ASCII, no UTF-8 survives. + + starts at src[*pi], updates *pi to point to the first unprocessed + byte of the input. + + end is one more than the last allowable value of *pi. + + returns number of bytes placed in buf, including a NUL terminator. +*/ +size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi, + size_t end, int escape_quotes, int ascii); + +/* utility predicates used by the above */ +int octal_digit(char c); +int hex_digit(char c); + +/* return a pointer to the first occurrence of ch in s, or NULL if not + found. character index of found character returned in *charn. */ +char *u8_strchr(const char *s, uint32_t ch, size_t *charn); + +/* same as the above, but searches a buffer of a given size instead of + a NUL-terminated string. */ +char *u8_memchr(const char *s, uint32_t ch, size_t sz, size_t *charn); + +char *u8_memrchr(const char *s, uint32_t ch, size_t sz); + +/* count the number of characters in a UTF-8 string */ +size_t u8_strlen(const char *s); + +/* number of columns occupied by a string */ +size_t u8_strwidth(const char *s); + +int u8_is_locale_utf8(const char *locale); + +/* printf where the format string and arguments may be in UTF-8. + you can avoid this function and just use ordinary printf() if the current + locale is UTF-8. */ +size_t u8_vprintf(const char *fmt, va_list ap); +size_t u8_printf(const char *fmt, ...); + +/* determine whether a sequence of bytes is valid UTF-8. length is in bytes */ +int u8_isvalid(const char *str, int length); + +/* reverse a UTF-8 string. len is length in bytes. dest and src must both + be allocated to at least len+1 bytes. returns 1 for error, 0 otherwise */ +int u8_reverse(char *dest, char *src, size_t len); + +//// #include "ios.h" + +// this flag controls when data actually moves out to the underlying I/O +// channel. memory streams are a special case of this where the data +// never moves out. +typedef enum { bm_none, bm_line, bm_block, bm_mem } bufmode_t; + +typedef enum { bst_none, bst_rd, bst_wr } bufstate_t; + +#define IOS_INLSIZE 54 +#define IOS_BUFSIZE 131072 + +struct ios { + bufmode_t bm; + + // the state only indicates where the underlying file position is relative + // to the buffer. reading: at the end. writing: at the beginning. + // in general, you can do any operation in any state. + bufstate_t state; + + int errcode; + + char *buf; // start of buffer + size_t maxsize; // space allocated to buffer + size_t size; // length of valid data in buf, >=ndirty + size_t bpos; // current position in buffer + size_t ndirty; // # bytes at &buf[0] that need to be written + + off_t fpos; // cached file pos + size_t lineno; // current line number + + // pointer-size integer to support platforms where it might have + // to be a pointer + long fd; + + unsigned char readonly : 1; + unsigned char ownbuf : 1; + unsigned char ownfd : 1; + unsigned char _eof : 1; + + // this means you can read, seek back, then read the same data + // again any number of times. usually only true for files and strings. + unsigned char rereadable : 1; + + char local[IOS_INLSIZE]; +}; + +/* low-level interface functions */ +size_t ios_read(struct ios *s, char *dest, size_t n); +size_t ios_readall(struct ios *s, char *dest, size_t n); +size_t ios_write(struct ios *s, char *data, size_t n); +off_t ios_seek(struct ios *s, off_t pos); // absolute seek +off_t ios_seek_end(struct ios *s); +off_t ios_skip(struct ios *s, off_t offs); // relative seek +off_t ios_pos(struct ios *s); // get current position +size_t ios_trunc(struct ios *s, size_t size); +int ios_eof(struct ios *s); +int ios_flush(struct ios *s); +void ios_close(struct ios *s); +char *ios_takebuf(struct ios *s, + size_t *psize); // release buffer to caller +// set buffer space to use +int ios_setbuf(struct ios *s, char *buf, size_t size, int own); +int ios_bufmode(struct ios *s, bufmode_t mode); +void ios_set_readonly(struct ios *s); +size_t ios_copy(struct ios *to, struct ios *from, size_t nbytes); +size_t ios_copyall(struct ios *to, struct ios *from); +size_t ios_copyuntil(struct ios *to, struct ios *from, char delim); +// ensure at least n bytes are buffered if possible. returns # available. +size_t ios_readprep(struct ios *from, size_t n); +// void ios_lock(struct ios *s); +// int struct iosrylock(struct ios *s); +// int ios_unlock(struct ios *s); + +/* stream creation */ +struct ios *ios_file(struct ios *s, char *fname, int rd, int wr, int create, + int trunc); +struct ios *ios_mem(struct ios *s, size_t initsize); +struct ios *ios_str(struct ios *s, char *str); +struct ios *ios_static_buffer(struct ios *s, char *buf, size_t sz); +struct ios *ios_fd(struct ios *s, long fd, int isfile, int own); +// todo: ios_socket +extern struct ios *ios_stdin; +extern struct ios *ios_stdout; +extern struct ios *ios_stderr; +void ios_init_stdstreams(); + +/* high-level functions - output */ +int ios_putnum(struct ios *s, char *data, uint32_t type); +int ios_putint(struct ios *s, int n); +int ios_pututf8(struct ios *s, uint32_t wc); +int ios_putstringz(struct ios *s, char *str, bool_t do_write_nulterm); +int ios_printf(struct ios *s, const char *format, ...); +int ios_vprintf(struct ios *s, const char *format, va_list args); + +void hexdump(struct ios *dest, const char *buffer, size_t len, + size_t startoffs); + +/* high-level stream functions - input */ +int ios_getnum(struct ios *s, char *data, uint32_t type); +int ios_getutf8(struct ios *s, uint32_t *pwc); +int ios_peekutf8(struct ios *s, uint32_t *pwc); +int ios_ungetutf8(struct ios *s, uint32_t wc); +int ios_getstringz(struct ios *dest, struct ios *src); +int ios_getstringn(struct ios *dest, struct ios *src, size_t nchars); +int ios_getline(struct ios *s, char **pbuf, size_t *psz); +char *ios_readline(struct ios *s); + +// discard data buffered for reading +void ios_purge(struct ios *s); + +// seek by utf8 sequence increments +int ios_nextutf8(struct ios *s); +int ios_prevutf8(struct ios *s); + +/* stdio-style functions */ +#define IOS_EOF (-1) +int ios_putc(int c, struct ios *s); +// wint_t ios_putwc(struct ios *s, wchar_t wc); +int ios_getc(struct ios *s); +int ios_peekc(struct ios *s); +// wint_t ios_getwc(struct ios *s); +int ios_ungetc(int c, struct ios *s); +// wint_t ios_ungetwc(struct ios *s, wint_t wc); +#define ios_puts(str, s) ios_write(s, str, strlen(str)) + +/* + With memory streams, mixed reads and writes are equivalent to performing + sequences of *p++, as either an lvalue or rvalue. File streams behave + similarly, but other streams might not support this. Using unbuffered + mode makes this more predictable. + + Note on "unget" functions: + There are two kinds of functions here: those that operate on sized + blocks of bytes and those that operate on logical units like "character" + or "integer". The "unget" functions only work on logical units. There + is no "unget n bytes". You can only do an unget after a matching get. + However, data pushed back by an unget is available to all read operations. + The reason for this is that unget is defined in terms of its effect on + the underlying buffer (namely, it rebuffers data as if it had been + buffered but not read yet). IOS reserves the right to perform large block + operations directly, bypassing the buffer. In such a case data was + never buffered, so "rebuffering" has no meaning (i.e. there is no + correspondence between the buffer and the physical stream). + + Single-bit I/O is able to write partial bytes ONLY IF the stream supports + seeking. Also, line buffering is not well-defined in the context of + single-bit I/O, so it might not do what you expect. + + implementation notes: + in order to know where we are in a file, we must ensure the buffer + is only populated from the underlying stream starting with p==buf. + + to switch from writing to reading: flush, set p=buf, cnt=0 + to switch from reading to writing: seek backwards cnt bytes, p=buf, cnt=0 + + when writing: buf starts at curr. physical stream pos, p - buf is how + many bytes we've written logically. cnt==0 + + dirty == (bitpos>0 && state==iost_wr), EXCEPT right after switching from + reading to writing, where we might be in the middle of a byte without + having changed it. + + to write a bit: if !dirty, read up to maxsize-(p-buf) into buffer, then + seek back by the same amount (undo it). write onto those bits. now set + the dirty bit. in this state, we can bit-read up to the end of the byte, + then formally switch to the read state using flush. + + design points: + - data-source independence, including memory streams + - expose buffer to user, allow user-owned buffers + - allow direct I/O, don't always go through buffer + - buffer-internal seeking. makes seeking back 1-2 bytes very fast, + and makes it possible for sockets where it otherwise wouldn't be + - tries to allow switching between reading and writing + - support 64-bit and large files + - efficient, low-latency buffering + - special support for utf8 + - type-aware functions with byte-order swapping service + - position counter for meaningful data offsets with sockets + + theory of operation: + + the buffer is a view of part of a file/stream. you can seek, read, and + write around in it as much as you like, as if it were just a string. + + we keep track of the part of the buffer that's invalid (written to). + we remember whether the position of the underlying stream is aligned + with the end of the buffer (reading mode) or the beginning (writing mode). + + based on this info, we might have to seek back before doing a flush. + + as optimizations, we do no writing if the buffer isn't "dirty", and we + do no reading if the data will only be overwritten. +*/ + +//// #include "socket.h" + +#ifndef _WIN32 +void closesocket(int fd); +#endif + +int open_tcp_port(short portno); +int open_any_tcp_port(short *portno); +int open_any_udp_port(short *portno); +int connect_to_host(char *hostname, short portno); +int sendall(int sockfd, char *buffer, int bufLen, int flags); +int readall(int sockfd, char *buffer, int bufLen, int flags); +int socket_ready(int sock); + +//// #include "timefuncs.h" + +uint64_t i64time(); +void sleep_ms(int ms); +void timeparts(int32_t *buf, double t); + +//// #include "hashing.h" + +uintptr_t nextipow2(uintptr_t i); +uint32_t int32hash(uint32_t a); +uint64_t int64hash(uint64_t key); +uint32_t int64to32hash(uint64_t key); +#ifdef BITS64 +#define inthash int64hash +#else +#define inthash int32hash +#endif +uint64_t memhash(const char *buf, size_t n); +uint32_t memhash32(const char *buf, size_t n); + +//// #include "htable.h" + +#define HT_N_INLINE 32 + +struct htable { + size_t size; + void **table; + void *_space[HT_N_INLINE]; +}; + +// define this to be an invalid key/value +#define HT_NOTFOUND ((void *)1) + +// initialize and free +struct htable *htable_new(struct htable *h, size_t size); +void htable_free(struct htable *h); + +// clear and (possibly) change size +void htable_reset(struct htable *h, size_t sz); + +//// #include "bitvector.h" + +// a mask with n set lo or hi bits +#define lomask(n) (uint32_t)((((uint32_t)1) << (n)) - 1) +#define himask(n) (~lomask(32 - n)) +#define ONES32 ((uint32_t)0xffffffff) + +uint32_t bitreverse(uint32_t x); + +uint32_t *bitvector_new(uint64_t n, int initzero); +uint32_t *bitvector_resize(uint32_t *b, uint64_t oldsz, uint64_t newsz, + int initzero); +size_t bitvector_nwords(uint64_t nbits); +void bitvector_set(uint32_t *b, uint64_t n, uint32_t c); +uint32_t bitvector_get(uint32_t *b, uint64_t n); + +uint32_t bitvector_next(uint32_t *b, uint64_t n0, uint64_t n); + +void bitvector_shr(uint32_t *b, size_t n, uint32_t s); +void bitvector_shr_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s); +void bitvector_shl(uint32_t *b, size_t n, uint32_t s); +void bitvector_shl_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s, + bool_t scrap); +void bitvector_fill(uint32_t *b, uint32_t offs, uint32_t c, uint32_t nbits); +void bitvector_copy(uint32_t *dest, uint32_t doffs, uint32_t *a, + uint32_t aoffs, uint32_t nbits); +void bitvector_not(uint32_t *b, uint32_t offs, uint32_t nbits); +void bitvector_not_to(uint32_t *dest, uint32_t doffs, uint32_t *a, + uint32_t aoffs, uint32_t nbits); +void bitvector_reverse(uint32_t *b, uint32_t offs, uint32_t nbits); +void bitvector_reverse_to(uint32_t *dest, uint32_t *src, uint32_t soffs, + uint32_t nbits); +void bitvector_and_to(uint32_t *dest, uint32_t doffs, uint32_t *a, + uint32_t aoffs, uint32_t *b, uint32_t boffs, + uint32_t nbits); +void bitvector_or_to(uint32_t *dest, uint32_t doffs, uint32_t *a, + uint32_t aoffs, uint32_t *b, uint32_t boffs, + uint32_t nbits); +void bitvector_xor_to(uint32_t *dest, uint32_t doffs, uint32_t *a, + uint32_t aoffs, uint32_t *b, uint32_t boffs, + uint32_t nbits); +uint64_t bitvector_count(uint32_t *b, uint32_t offs, uint64_t nbits); +uint32_t bitvector_any0(uint32_t *b, uint32_t offs, uint32_t nbits); +uint32_t bitvector_any1(uint32_t *b, uint32_t offs, uint32_t nbits); + +//// #include "os.h" + +void path_to_dirname(char *path); +void get_cwd(char *buf, size_t size); +int set_cwd(char *buf); +char *get_exename(char *buf, size_t size); +int os_path_exists(const char *path); +void os_setenv(const char *name, const char *value); + +//// #include "random.h" + +#define random() genrand_int32() +#define srandom(n) init_genrand(n) +double rand_double(); +float rand_float(); +double randn(); +void randomize(); +uint32_t genrand_int32(); +void init_genrand(uint32_t s); +uint64_t i64time(); + +//// #include "llt.h" + +void llt_init(); + +//// #include "ieee754.h" + +union ieee754_float { + float f; + + struct { +#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ + unsigned int negative : 1; + unsigned int exponent : 8; + unsigned int mantissa : 23; +#endif +#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ + unsigned int mantissa : 23; + unsigned int exponent : 8; + unsigned int negative : 1; +#endif + } ieee; +}; + +#define IEEE754_FLOAT_BIAS 0x7f + +union ieee754_double { + double d; + + struct { +#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ + unsigned int negative : 1; + unsigned int exponent : 11; + unsigned int mantissa0 : 20; + unsigned int mantissa1 : 32; +#endif +#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ + unsigned int mantissa1 : 32; + unsigned int mantissa0 : 20; + unsigned int exponent : 11; + unsigned int negative : 1; +#endif + } ieee; +}; + +#define IEEE754_DOUBLE_BIAS 0x3ff + +union ieee854_long_double { + long double d; + + struct { +#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ + unsigned int negative : 1; + unsigned int exponent : 15; + unsigned int empty : 16; + unsigned int mantissa0 : 32; + unsigned int mantissa1 : 32; +#endif +#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ + unsigned int mantissa1 : 32; + unsigned int mantissa0 : 32; + unsigned int exponent : 15; + unsigned int negative : 1; + unsigned int empty : 16; +#endif + } ieee; +}; + +#define IEEE854_LONG_DOUBLE_BIAS 0x3fff + +//// #include "flisp.h" + +typedef uintptr_t value_t; +typedef uintptr_t ufixnum_t; +typedef intptr_t fixnum_t; +#ifdef BITS64 +#define T_FIXNUM T_INT64 +#else +#define T_FIXNUM T_INT32 +#endif + +struct cons { + value_t car; + value_t cdr; +}; + +struct symbol { + uintptr_t flags; + value_t binding; // global value binding + struct fltype *type; + uint32_t hash; + void *dlcache; // dlsym address + // below fields are private + struct symbol *left; + struct symbol *right; + union { + char name[1]; + void *_pad; // ensure field aligned to pointer size + }; +}; + +struct gensym { + value_t isconst; + value_t binding; // global value binding + struct fltype *type; + uint32_t id; +}; + +#define TAG_NUM 0x0 +#define TAG_CPRIM 0x1 +#define TAG_FUNCTION 0x2 +#define TAG_VECTOR 0x3 +#define TAG_NUM1 0x4 +#define TAG_CVALUE 0x5 +#define TAG_SYM 0x6 +#define TAG_CONS 0x7 +#define UNBOUND ((value_t)0x1) // an invalid value +#define TAG_FWD UNBOUND +#define tag(x) ((x)&0x7) +#define ptr(x) ((void *)((x) & (~(value_t)0x7))) +#define tagptr(p, t) (((value_t)(p)) | (t)) +#define fixnum(x) ((value_t)(((ufixnum_t)(fixnum_t)(x)) << 2)) +#define numval(x) (((fixnum_t)(x)) >> 2) +#ifdef BITS64 +#define fits_fixnum(x) (((x) >> 61) == 0 || (~((x) >> 61)) == 0) +#else +#define fits_fixnum(x) (((x) >> 29) == 0 || (~((x) >> 29)) == 0) +#endif +#define fits_bits(x, b) (((x) >> (b - 1)) == 0 || (~((x) >> (b - 1))) == 0) +#define uintval(x) (((unsigned int)(x)) >> 3) +#define builtin(n) tagptr((((int)n) << 3), TAG_FUNCTION) +#define iscons(x) (tag(x) == TAG_CONS) +#define issymbol(x) (tag(x) == TAG_SYM) +#define isfixnum(x) (((x)&3) == TAG_NUM) +#define bothfixnums(x, y) ((((x) | (y)) & 3) == TAG_NUM) +#define isbuiltin(x) ((tag(x) == TAG_FUNCTION) && uintval(x) <= OP_ASET) +#define isvector(x) (tag(x) == TAG_VECTOR) +#define iscvalue(x) (tag(x) == TAG_CVALUE) +#define iscprim(x) (tag(x) == TAG_CPRIM) +#define selfevaluating(x) (tag(x) < 6) +// comparable with == +#define eq_comparable(a, b) (!(((a) | (b)) & 1)) +#define eq_comparablep(a) (!((a)&1)) +// doesn't lead to other values +#define leafp(a) (((a)&3) != 3) + +#define isforwarded(v) (((value_t *)ptr(v))[0] == TAG_FWD) +#define forwardloc(v) (((value_t *)ptr(v))[1]) +#define forward(v, to) \ + do { \ + (((value_t *)ptr(v))[0] = TAG_FWD); \ + (((value_t *)ptr(v))[1] = to); \ + } while (0) + +#define vector_size(v) (((size_t *)ptr(v))[0] >> 2) +#define vector_setsize(v, n) (((size_t *)ptr(v))[0] = ((n) << 2)) +#define vector_elt(v, i) (((value_t *)ptr(v))[1 + (i)]) +#define vector_grow_amt(x) ((x) < 8 ? 5 : 6 * ((x) >> 3)) +// functions ending in _ are unsafe, faster versions +#define car_(v) (((struct cons *)ptr(v))->car) +#define cdr_(v) (((struct cons *)ptr(v))->cdr) +#define car(v) (tocons((v), "car")->car) +#define cdr(v) (tocons((v), "cdr")->cdr) +#define fn_bcode(f) (((value_t *)ptr(f))[0]) +#define fn_vals(f) (((value_t *)ptr(f))[1]) +#define fn_env(f) (((value_t *)ptr(f))[2]) +#define fn_name(f) (((value_t *)ptr(f))[3]) + +#define set(s, v) (((struct symbol *)ptr(s))->binding = (v)) +#define setc(s, v) \ + do { \ + ((struct symbol *)ptr(s))->flags |= 1; \ + ((struct symbol *)ptr(s))->binding = (v); \ + } while (0) +#define isconstant(s) ((s)->flags & 0x1) +#define iskeyword(s) ((s)->flags & 0x2) +#define symbol_value(s) (((struct symbol *)ptr(s))->binding) +#define ismanaged(v) \ + ((((unsigned char *)ptr(v)) >= fromspace) && \ + (((unsigned char *)ptr(v)) < fromspace + heapsize)) +#define isgensym(x) (issymbol(x) && ismanaged(x)) + +#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS << 3)) +#define isclosure(x) isfunction(x) +#define iscbuiltin(x) \ + (iscvalue(x) && (cv_class((struct cvalue *)ptr(x)) == builtintype)) + +void fl_gc_handle(value_t *pv); +void fl_free_gc_handles(uint32_t n); + +// utility for iterating over all arguments in a builtin +// i=index, i0=start index, arg = var for each arg, args = arg array +// assumes "nargs" is the argument count +#define FOR_ARGS(i, i0, arg, args) \ + for (i = i0; ((size_t)i) < nargs && ((arg = args[i]) || 1); i++) + +#define N_BUILTINS ((int)N_OPCODES) + +extern value_t FL_NIL, FL_T, FL_F, FL_EOF; + +#define FL_UNSPECIFIED FL_T + +/* read, eval, print main entry points */ +value_t fl_read_sexpr(value_t f); +void fl_print(struct ios *f, value_t v); +value_t fl_toplevel_eval(value_t expr); +value_t fl_apply(value_t f, value_t l); +value_t fl_applyn(uint32_t n, value_t f, ...); + +extern value_t printprettysym, printreadablysym, printwidthsym; + +/* object model manipulation */ +value_t fl_cons(value_t a, value_t b); +value_t fl_list2(value_t a, value_t b); +value_t fl_listn(size_t n, ...); +value_t symbol(const char *str); +char *symbol_name(value_t v); +int fl_is_keyword_name(const char *str, size_t len); +value_t alloc_vector(size_t n, int init); +size_t llength(value_t v); +value_t fl_compare(value_t a, value_t b); // -1, 0, or 1 +value_t fl_equal(value_t a, value_t b); // T or nil +int equal_lispvalue(value_t a, value_t b); +uintptr_t hash_lispvalue(value_t a); +int isnumtok_base(char *tok, value_t *pval, int base); + +/* safe casts */ +struct cons *tocons(value_t v, char *fname); +struct symbol *tosymbol(value_t v, char *fname); +fixnum_t tofixnum(value_t v, char *fname); +char *tostring(value_t v, char *fname); + +/* error handling */ +struct fl_readstate { + struct htable backrefs; + struct htable gensyms; + value_t source; + struct fl_readstate *prev; +}; + +struct fl_exception_context { + jmp_buf buf; + uint32_t sp; + uint32_t frame; + uint32_t ngchnd; + struct fl_readstate *rdst; + struct fl_exception_context *prev; +}; + +extern struct fl_exception_context *fl_ctx; +extern uint32_t fl_throwing_frame; +extern value_t fl_lasterror; + +#define FL_TRY_EXTERN \ + struct fl_exception_context _ctx; \ + int l__tr, l__ca; \ + fl_savestate(&_ctx); \ + fl_ctx = &_ctx; \ + if (!setjmp(_ctx.buf)) \ + for (l__tr = 1; l__tr; l__tr = 0, (void)(fl_ctx = fl_ctx->prev)) + +#define FL_CATCH_EXTERN \ + else for (l__ca = 1; l__ca; l__ca = 0, fl_restorestate(&_ctx)) + +void fl_savestate(struct fl_exception_context *_ctx); +void fl_restorestate(struct fl_exception_context *_ctx); +extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError; +extern value_t UnboundError; + +struct cvtable { + void (*print)(value_t self, struct ios *f); + void (*relocate)(value_t oldv, value_t newv); + void (*finalize)(value_t self); + void (*print_traverse)(value_t self); +}; + +/* functions needed to implement the value interface (struct cvtable) */ +typedef enum { + T_INT8, + T_UINT8, + T_INT16, + T_UINT16, + T_INT32, + T_UINT32, + T_INT64, + T_UINT64, + T_FLOAT, + T_DOUBLE +} numerictype_t; + +#define N_NUMTYPES ((int)T_DOUBLE + 1) + +#ifdef BITS64 +#define T_LONG T_INT64 +#define T_ULONG T_UINT64 +#else +#define T_LONG T_INT32 +#define T_ULONG T_UINT32 +#endif + +value_t relocate_lispvalue(value_t v); +void print_traverse(value_t v); +void fl_print_chr(char c, struct ios *f); +void fl_print_str(char *s, struct ios *f); +void fl_print_child(struct ios *f, value_t v); + +typedef int (*cvinitfunc_t)(struct fltype *, value_t, void *); + +struct fltype { + value_t type; + numerictype_t numtype; + size_t size; + size_t elsz; + struct cvtable *vtable; + struct fltype *eltype; // for arrays + struct fltype *artype; // (array this) + int marked; + cvinitfunc_t init; +}; + +struct cvalue { + struct fltype *type; + void *data; + size_t len; // length of *data in bytes + union { + value_t parent; // optional + char _space[1]; // variable size + }; +}; + +#define CVALUE_NWORDS 4 + +struct cprim { + struct fltype *type; + char _space[1]; +}; + +struct function { + value_t bcode; + value_t vals; + value_t env; + value_t name; +}; + +#define CPRIM_NWORDS 2 +#define MAX_INL_SIZE 384 + +#define CV_OWNED_BIT 0x1 +#define CV_PARENT_BIT 0x2 +#define owned(cv) ((uintptr_t)(cv)->type & CV_OWNED_BIT) +#define hasparent(cv) ((uintptr_t)(cv)->type & CV_PARENT_BIT) +#define isinlined(cv) ((cv)->data == &(cv)->_space[0]) +#define cv_class(cv) ((struct fltype *)(((uintptr_t)(cv)->type) & ~3)) +#define cv_len(cv) ((cv)->len) +#define cv_type(cv) (cv_class(cv)->type) +#define cv_data(cv) ((cv)->data) +#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype) +#define cv_isPOD(cv) (cv_class(cv)->init != NULL) + +#define cvalue_data(v) cv_data((struct cvalue *)ptr(v)) +#define cvalue_len(v) cv_len((struct cvalue *)ptr(v)) +#define value2c(type, v) ((type)cv_data((struct cvalue *)ptr(v))) + +#define valid_numtype(v) ((v) < N_NUMTYPES) +#define cp_class(cp) ((cp)->type) +#define cp_type(cp) (cp_class(cp)->type) +#define cp_numtype(cp) (cp_class(cp)->numtype) +#define cp_data(cp) (&(cp)->_space[0]) + +// WARNING: multiple evaluation! +#define cptr(v) \ + (iscprim(v) ? cp_data((struct cprim *)ptr(v)) \ + : cv_data((struct cvalue *)ptr(v))) + +typedef value_t (*builtin_t)(value_t *, uint32_t); + +extern value_t QUOTE; +extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym; +extern value_t int64sym, uint64sym; +extern value_t longsym, ulongsym, bytesym, wcharsym; +extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, +pointersym; +extern value_t stringtypesym, wcstringtypesym, emptystringsym; +extern value_t unionsym, floatsym, doublesym; +extern struct fltype *bytetype, *wchartype; +extern struct fltype *stringtype, *wcstringtype; +extern struct fltype *builtintype; + +value_t cvalue(struct fltype *type, size_t sz); +void add_finalizer(struct cvalue *cv); +void cv_autorelease(struct cvalue *cv); +void cv_pin(struct cvalue *cv); +size_t ctype_sizeof(value_t type, int *palign); +value_t cvalue_copy(value_t v); +value_t cvalue_from_data(struct fltype *type, void *data, size_t sz); +value_t cvalue_from_ref(struct fltype *type, void *ptr, size_t sz, + value_t parent); +value_t cbuiltin(char *name, builtin_t f); +size_t cvalue_arraylen(value_t v); +value_t size_wrap(size_t sz); +size_t toulong(value_t n, char *fname); +value_t cvalue_string(size_t sz); +value_t cvalue_static_cstring(const char *str); +value_t string_from_cstr(const char *str); +value_t string_from_cstrn(const char *str, size_t n); +int fl_isstring(value_t v); +int fl_isnumber(value_t v); +int fl_isgensym(value_t v); +int fl_isiostream(value_t v); +struct ios *fl_toiostream(value_t v, const char *fname); +value_t cvalue_compare(value_t a, value_t b); +int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname); + +void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz); + +struct fltype *get_type(value_t t); +struct fltype *get_array_type(value_t eltype); +struct fltype *define_opaque_type(value_t sym, size_t sz, + struct cvtable *vtab, cvinitfunc_t init); + +value_t mk_double(double_t n); +value_t mk_float(float_t n); +value_t mk_uint32(uint32_t n); +value_t mk_uint64(uint64_t n); +value_t mk_wchar(int32_t n); +value_t return_from_uint64(uint64_t Uaccum); +value_t return_from_int64(int64_t Saccum); + +numerictype_t effective_numerictype(double r); +double conv_to_double(void *data, numerictype_t tag); +void conv_from_double(void *data, double d, numerictype_t tag); +int64_t conv_to_int64(void *data, numerictype_t tag); +uint64_t conv_to_uint64(void *data, numerictype_t tag); +int32_t conv_to_int32(void *data, numerictype_t tag); +uint32_t conv_to_uint32(void *data, numerictype_t tag); +#ifdef BITS64 +#define conv_to_long conv_to_int64 +#define conv_to_ulong conv_to_uint64 +#else +#define conv_to_long conv_to_int32 +#define conv_to_ulong conv_to_uint32 +#endif + +struct builtinspec { + char *name; + builtin_t fptr; +}; + +void assign_global_builtins(struct builtinspec *b); + +/* builtins */ +value_t fl_hash(value_t *args, uint32_t nargs); +value_t cvalue_byte(value_t *args, uint32_t nargs); +value_t cvalue_wchar(value_t *args, uint32_t nargs); + +void fl_init(size_t initial_heapsize); +int fl_load_boot_image(void); + +//// #include "error.h" + +#ifdef __DMC__ +#include "error_dmc.h" +#endif + +#ifdef __GNUC__ +#include "error_gnuc.h" +#endif + +#ifdef _MSC_VER +#include "error_msc.h" +#endif + +#ifdef __WATCOMC__ +#include "error_watcomc.h" +#endif + +//// #include "buf.h" + +struct buf { + size_t cap; + size_t fill; + size_t scan; + size_t mark; + char *bytes; +}; + +struct buf *buf_new(void); +char *buf_resb(struct buf *buf, size_t nbyte); +void buf_put_ios(struct buf *buf, struct ios *ios); +void buf_putc(struct buf *buf, int c); +void buf_putb(struct buf *buf, const void *bytes, size_t nbyte); +void buf_puts(struct buf *buf, const char *s); +void buf_putu(struct buf *buf, uint64_t u); +void buf_free(struct buf *buf); + +int buf_scan_end(struct buf *buf); +int buf_scan_byte(struct buf *buf, int byte); +int buf_scan_bag(struct buf *buf, const char *bag); +int buf_scan_bag_not(struct buf *buf, const char *bag); +int buf_scan_while(struct buf *buf, const char *bag); +int buf_scan_while_not(struct buf *buf, const char *bag); +void buf_scan_mark(struct buf *buf); +int buf_scan_equals(struct buf *buf, const char *s); + +//// #include "argcount.h" + +void argcount(const char *fname, uint32_t nargs, uint32_t c); + +//// #include "env.h" + +const char *env_get_os_name(void); + +value_t builtin_environment_stack(value_t *args, uint32_t nargs); + #include "opcodes.h" + #include "htableh_inc.h" -#include "libraries.h" -#include "os.h" -#include "builtins.h" -#include "libraries.h" -#include "stringfuncs.h" + +//// #include "libraries.h" + +value_t builtin_import(value_t *args, uint32_t nargs); + +//// #include "builtins.h" + +value_t builtin_pid(value_t *args, uint32_t nargs); +value_t builtin_parent_pid(value_t *args, uint32_t nargs); +value_t builtin_process_group(value_t *args, uint32_t nargs); + +value_t builtin_user_effective_gid(value_t *args, uint32_t nargs); +value_t builtin_user_effective_uid(value_t *args, uint32_t nargs); +value_t builtin_user_real_gid(value_t *args, uint32_t nargs); +value_t builtin_user_real_uid(value_t *args, uint32_t nargs); + +value_t builtin_term_init(value_t *args, uint32_t nargs); +value_t builtin_term_exit(value_t *args, uint32_t nargs); + +value_t builtin_spawn(value_t *args, uint32_t nargs); + +value_t builtin_read_ini_file(value_t *args, uint32_t nargs); + +value_t builtin_color_name_to_rgb24(value_t *args, uint32_t nargs); + +//// #include "stringfuncs.h" + +value_t fl_stringp(value_t *args, uint32_t nargs); +value_t fl_string_reverse(value_t *args, uint32_t nargs); +value_t fl_string_sub(value_t *args, uint32_t nargs); diff --git a/c/socket.h b/c/socket.h deleted file mode 100644 index 8f4118c..0000000 --- a/c/socket.h +++ /dev/null @@ -1,11 +0,0 @@ -#ifndef _WIN32 -void closesocket(int fd); -#endif - -int open_tcp_port(short portno); -int open_any_tcp_port(short *portno); -int open_any_udp_port(short *portno); -int connect_to_host(char *hostname, short portno); -int sendall(int sockfd, char *buffer, int bufLen, int flags); -int readall(int sockfd, char *buffer, int bufLen, int flags); -int socket_ready(int sock); diff --git a/c/stringfuncs.h b/c/stringfuncs.h deleted file mode 100644 index 7014ff8..0000000 --- a/c/stringfuncs.h +++ /dev/null @@ -1,3 +0,0 @@ -value_t fl_stringp(value_t *args, uint32_t nargs); -value_t fl_string_reverse(value_t *args, uint32_t nargs); -value_t fl_string_sub(value_t *args, uint32_t nargs); diff --git a/c/timefuncs.h b/c/timefuncs.h deleted file mode 100644 index 8142a25..0000000 --- a/c/timefuncs.h +++ /dev/null @@ -1,3 +0,0 @@ -uint64_t i64time(); -void sleep_ms(int ms); -void timeparts(int32_t *buf, double t); diff --git a/c/utf8.h b/c/utf8.h deleted file mode 100644 index f1c852b..0000000 --- a/c/utf8.h +++ /dev/null @@ -1,114 +0,0 @@ -extern int locale_is_utf8; - -#ifdef _WIN32 -extern int wcwidth(uint32_t); -#endif - -/* is c the start of a utf8 sequence? */ -#define isutf(c) (((c)&0xC0) != 0x80) - -#define UEOF ((uint32_t)-1) - -/* convert UTF-8 data to wide character */ -size_t u8_toucs(uint32_t *dest, size_t sz, const char *src, size_t srcsz); - -/* the opposite conversion */ -size_t u8_toutf8(char *dest, size_t sz, const uint32_t *src, size_t srcsz); - -/* single character to UTF-8, returns # bytes written */ -size_t u8_wc_toutf8(char *dest, uint32_t ch); - -/* character number to byte offset */ -size_t u8_offset(const char *str, size_t charnum); - -/* byte offset to character number */ -size_t u8_charnum(const char *s, size_t offset); - -/* return next character, updating an index variable */ -uint32_t u8_nextchar(const char *s, size_t *i); - -/* next character without NUL character terminator */ -uint32_t u8_nextmemchar(const char *s, size_t *i); - -/* move to next character */ -void u8_inc(const char *s, size_t *i); - -/* move to previous character */ -void u8_dec(const char *s, size_t *i); - -/* returns length of next utf-8 sequence */ -size_t u8_seqlen(const char *s); - -/* returns the # of bytes needed to encode a certain character */ -size_t u8_charlen(uint32_t ch); - -/* computes the # of bytes needed to encode a WC string as UTF-8 */ -size_t u8_codingsize(uint32_t *wcstr, size_t n); - -char read_escape_control_char(char c); - -/* assuming src points to the character after a backslash, read an - escape sequence, storing the result in dest and returning the number of - input characters processed */ -size_t u8_read_escape_sequence(const char *src, size_t ssz, uint32_t *dest); - -/* given a wide character, convert it to an ASCII escape sequence stored in - buf, where buf is "sz" bytes. returns the number of characters output. - sz must be at least 3. */ -int u8_escape_wchar(char *buf, size_t sz, uint32_t ch); - -/* convert a string "src" containing escape sequences to UTF-8 */ -size_t u8_unescape(char *buf, size_t sz, const char *src); - -/* convert UTF-8 "src" to escape sequences. - - sz is buf size in bytes. must be at least 12. - - if escape_quotes is nonzero, quote characters will be escaped. - - if ascii is nonzero, the output is 7-bit ASCII, no UTF-8 survives. - - starts at src[*pi], updates *pi to point to the first unprocessed - byte of the input. - - end is one more than the last allowable value of *pi. - - returns number of bytes placed in buf, including a NUL terminator. -*/ -size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi, - size_t end, int escape_quotes, int ascii); - -/* utility predicates used by the above */ -int octal_digit(char c); -int hex_digit(char c); - -/* return a pointer to the first occurrence of ch in s, or NULL if not - found. character index of found character returned in *charn. */ -char *u8_strchr(const char *s, uint32_t ch, size_t *charn); - -/* same as the above, but searches a buffer of a given size instead of - a NUL-terminated string. */ -char *u8_memchr(const char *s, uint32_t ch, size_t sz, size_t *charn); - -char *u8_memrchr(const char *s, uint32_t ch, size_t sz); - -/* count the number of characters in a UTF-8 string */ -size_t u8_strlen(const char *s); - -/* number of columns occupied by a string */ -size_t u8_strwidth(const char *s); - -int u8_is_locale_utf8(const char *locale); - -/* printf where the format string and arguments may be in UTF-8. - you can avoid this function and just use ordinary printf() if the current - locale is UTF-8. */ -size_t u8_vprintf(const char *fmt, va_list ap); -size_t u8_printf(const char *fmt, ...); - -/* determine whether a sequence of bytes is valid UTF-8. length is in bytes */ -int u8_isvalid(const char *str, int length); - -/* reverse a UTF-8 string. len is length in bytes. dest and src must both - be allocated to at least len+1 bytes. returns 1 for error, 0 otherwise */ -int u8_reverse(char *dest, char *src, size_t len); diff --git a/c/utils.h b/c/utils.h deleted file mode 100644 index df7ded2..0000000 --- a/c/utils.h +++ /dev/null @@ -1,3 +0,0 @@ -char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base); -int str2int(char *str, size_t len, int64_t *res, uint32_t base); -int isdigit_base(char c, int base);