shithub: femtolisp

Download patch

ref: 952cbd7aae1f071aaced832bb89a8009624b9d75
parent: 0cf8dd45909e50c0480d04c42df6f08dd2b851ed
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Fri Mar 10 10:34:25 EST 2023

use stdint.h more, fix wrong names etc

--- a/cvalues.c
+++ b/cvalues.c
@@ -113,7 +113,7 @@
 
 static void autorelease(cvalue_t *cv)
 {
-    cv->type = (fltype_t*)(((uptrint_t)cv->type) | CV_OWNED_BIT);
+    cv->type = (fltype_t*)(((uintptr_t)cv->type) | CV_OWNED_BIT);
     add_finalizer(cv);
 }
 
@@ -124,7 +124,7 @@
 
 static value_t cprim(fltype_t *type, size_t sz)
 {
-    assert(!ismanaged((uptrint_t)type));
+    assert(!ismanaged((uintptr_t)type));
     assert(sz == type->size);
     cprim_t *pcp = (cprim_t*)alloc_words(CPRIM_NWORDS-1+NWORDS(sz));
     pcp->type = type;
@@ -196,7 +196,7 @@
     pcv->len = sz;
     pcv->type = type;
     if (parent != NIL) {
-        pcv->type = (fltype_t*)(((uptrint_t)pcv->type) | CV_PARENT_BIT);
+        pcv->type = (fltype_t*)(((uintptr_t)pcv->type) | CV_PARENT_BIT);
         pcv->parent = parent;
     }
     cv = tagptr(pcv, TAG_CVALUE);
@@ -689,7 +689,7 @@
         memcpy(ncv->data, cv_data(cv), len);
         autorelease(ncv);
         if (hasparent(cv)) {
-            ncv->type = (fltype_t*)(((uptrint_t)ncv->type) & ~CV_PARENT_BIT);
+            ncv->type = (fltype_t*)(((uintptr_t)ncv->type) & ~CV_PARENT_BIT);
             ncv->parent = NIL;
         }
     }
--- a/equal.c
+++ b/equal.c
@@ -287,7 +287,7 @@
 #endif
 
 // *oob: output argument, means we hit the limit specified by 'bound'
-static uptrint_t bounded_hash(value_t a, int bound, int *oob)
+static uintptr_t bounded_hash(value_t a, int bound, int *oob)
 {
     *oob = 0;
     union {
@@ -299,7 +299,7 @@
     cvalue_t *cv;
     cprim_t *cp;
     void *data;
-    uptrint_t h = 0;
+    uintptr_t h = 0;
     int oob2, tg = tag(a);
     switch(tg) {
     case TAG_NUM :
@@ -371,10 +371,10 @@
     return (numval(compare_(a,b,1))==0);
 }
 
-uptrint_t hash_lispvalue(value_t a)
+uintptr_t hash_lispvalue(value_t a)
 {
     int oob=0;
-    uptrint_t n = bounded_hash(a, BOUNDED_HASH_BOUND, &oob);
+    uintptr_t n = bounded_hash(a, BOUNDED_HASH_BOUND, &oob);
     return n;
 }
 
--- a/flisp.c
+++ b/flisp.c
@@ -263,8 +263,8 @@
     symbol_t *sym;
     size_t len = strlen(str);
 
-    sym = (symbol_t*)malloc(sizeof(symbol_t)-sizeof(void*) + len + 1);
-    assert(((uptrint_t)sym & 0x7) == 0); // make sure malloc aligns 8
+    sym = malloc(sizeof(*sym)-sizeof(void*) + len + 1);
+    assert(((uintptr_t)sym & 0x7) == 0); // make sure malloc aligns 8
     sym->left = sym->right = NULL;
     sym->flags = 0;
     if (fl_is_keyword_name(str, len)) {
@@ -277,7 +277,7 @@
     }
     sym->type = sym->dlcache = NULL;
     sym->hash = memhash32(str, len)^0xAAAAAAAA;
-    strcpy(&sym->name[0], str);
+    memcpy(sym->name, str, len+1);
     return sym;
 }
 
@@ -433,7 +433,7 @@
 static value_t relocate(value_t v)
 {
     value_t a, d, nc, first, *pcdr;
-    uptrint_t t = tag(v);
+    uintptr_t t = tag(v);
 
     if (t == TAG_CONS) {
         // iterative implementation allows arbitrarily long cons chains
@@ -866,7 +866,7 @@
     }
     if (i >= nargs) goto no_kw;
     // now process keywords
-    uptrint_t n = vector_size(kwtable)/2;
+    uintptr_t n = vector_size(kwtable)/2;
     do {
         i++;
         if (i >= nargs)
@@ -873,9 +873,9 @@
             lerrorf(ArgError, "keyword %s requires an argument",
                     symbol_name(v));
         value_t hv = fixnum(((symbol_t*)ptr(v))->hash);
-        uptrint_t x = 2*(labs(numval(hv)) % n);
+        uintptr_t x = 2*(labs(numval(hv)) % n);
         if (vector_elt(kwtable, x) == v) {
-            uptrint_t idx = numval(vector_elt(kwtable, x+1));
+            uintptr_t idx = numval(vector_elt(kwtable, x+1));
             assert(idx < nkw);
             idx += nopt;
             if (args[idx] == UNBOUND) {
@@ -976,7 +976,7 @@
     captured = 0;
     func = Stack[SP-nargs-1];
     ip = cv_data((cvalue_t*)ptr(fn_bcode(func)));
-    assert(!ismanaged((uptrint_t)ip));
+    assert(!ismanaged((uintptr_t)ip));
     while (SP+GET_INT32(ip) > N_STACK) {
         grow_stack();
     }
@@ -1118,7 +1118,7 @@
             func = Stack[SP-n-1];
             if (tag(func) == TAG_FUNCTION) {
                 if (func > (N_BUILTINS<<3)) {
-                    Stack[curr_frame-2] = (uptrint_t)ip;
+                    Stack[curr_frame-2] = (uintptr_t)ip;
                     nargs = n;
                     goto apply_cl_top;
                 }
--- a/flisp.h
+++ b/flisp.h
@@ -9,7 +9,7 @@
 #define USED(x) (void)(x)
 #endif
 
-typedef uptrint_t value_t;
+typedef uintptr_t value_t;
 typedef int_t fixnum_t;
 #ifdef BITS64
 #define T_FIXNUM T_INT64
@@ -23,7 +23,7 @@
 } cons_t;
 
 typedef struct _symbol_t {
-    uptrint_t flags;
+    uintptr_t flags;
     value_t binding;   // global value binding
     struct _fltype_t *type;
     uint32_t hash;
@@ -153,7 +153,7 @@
 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);
-uptrint_t hash_lispvalue(value_t a);
+uintptr_t hash_lispvalue(value_t a);
 int isnumtok_base(char *tok, value_t *pval, int base);
 
 /* safe casts */
@@ -282,10 +282,10 @@
 
 #define CV_OWNED_BIT  0x1
 #define CV_PARENT_BIT 0x2
-#define owned(cv)      ((uptrint_t)(cv)->type & CV_OWNED_BIT)
-#define hasparent(cv)  ((uptrint_t)(cv)->type & CV_PARENT_BIT)
+#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)   ((fltype_t*)(((uptrint_t)(cv)->type)&~3))
+#define cv_class(cv)   ((fltype_t*)(((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)
--- a/flmain.c
+++ b/flmain.c
@@ -2,6 +2,7 @@
 #include <u.h>
 #include <libc.h>
 #else
+#include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
 #include <assert.h>
@@ -37,17 +38,14 @@
 
     fl_init(512*1024);
 
-    fname_buf[0] = '\0';
 #ifdef INITFILE
-    strcat(fname_buf, INITFILE);
+    snprintf(fname_buf, sizeof(fname_buf), "%s", INITFILE);
 #else
     value_t str = symbol_value(symbol("*install-dir*"));
     char *exedir = (str == UNBOUND ? NULL : cvalue_data(str));
-    if (exedir != NULL) {
-        strcat(fname_buf, exedir);
-        strcat(fname_buf, PATHSEPSTRING);
-    }
-    strcat(fname_buf, "flisp.boot");
+    snprintf(fname_buf, sizeof(fname_buf), "%s%sflisp.boot",
+        exedir ? exedir : "",
+        exedir ? PATHSEPSTRING : "");
 #endif
 
     value_t args[2];
--- a/llt/dtypes.h
+++ b/llt/dtypes.h
@@ -170,6 +170,7 @@
 #endif
 #else
 #include <sys/types.h>
+#include <stdint.h>
 #endif
 typedef u_int8_t  byte_t;   /* 1 byte */
 
@@ -192,12 +193,6 @@
 typedef int32_t ptrint_t;
 typedef u_int32_t u_ptrint_t;
 #endif
-
-typedef u_int8_t  uint8_t;
-typedef u_int16_t uint16_t;
-typedef u_int32_t uint32_t;
-typedef u_int64_t uint64_t;
-typedef u_ptrint_t uptrint_t;
 
 #define LLT_ALIGN(x, sz) (((x) + (sz-1)) & (-sz))
 
--- a/llt/htable.inc
+++ b/llt/htable.inc
@@ -19,7 +19,7 @@
     void **tab = h->table;                                              \
     void **ol;                                                          \
                                                                         \
-    hv = HFUNC((uptrint_t)key);                                         \
+    hv = HFUNC((uintptr_t)key);                                         \
  retry_bp:                                                              \
     iter = 0;                                                           \
     index = (index_t)(hv & (sz-1)) * 2;                                 \
@@ -95,7 +95,7 @@
     size_t sz = hash_size(h);                                           \
     size_t maxprobe = max_probe(sz);                                    \
     void **tab = h->table;                                              \
-    size_t index = (index_t)(HFUNC((uptrint_t)key) & (sz-1)) * 2;       \
+    size_t index = (index_t)(HFUNC((uintptr_t)key) & (sz-1)) * 2;       \
     sz *= 2;                                                            \
     size_t orig = index;                                                \
     size_t iter = 0;                                                    \
--- a/llt/socket.c
+++ b/llt/socket.c
@@ -7,7 +7,7 @@
 
 #include "dtypes.h"
 
-#if defined(MACOSX) || defined(NETBSD)
+#if !defined(WIN32) && !defined(PLAN9)
 #include <sys/time.h>
 #include <sys/select.h>
 #include <sys/types.h>
--- a/operators.c
+++ b/operators.c
@@ -56,13 +56,13 @@
     double fp;
 
     fp = fpart(r);
-    if (fp != 0 || r > S64_MAX || r < S64_MIN) {
+    if (fp != 0 || r > (double)S64_MAX || r < S64_MIN) {
         return T_DOUBLE;
     }
     else if (r >= INT_MIN && r <= INT_MAX) {
         return T_INT32;
     }
-    else if (r <= S64_MAX) {
+    else if (r <= (double)S64_MAX) {
         return T_INT64;
     }
     return T_UINT64;
@@ -181,7 +181,7 @@
     case T_FLOAT:  return *(float*)a < *(float*)b;
     case T_DOUBLE: return *(double*)a < *(double*)b
 #ifdef PLAN9
-    && !isNaN(*(double*)a) && !isNaN(*(double*)b)
+    && !isnan(*(double*)a) && !isnan(*(double*)b)
 #endif
     ;
     }
@@ -202,7 +202,7 @@
     case T_FLOAT:  return *(float*)a == *(float*)b;
     case T_DOUBLE: return *(double*)a == *(double*)b
 #ifdef PLAN9
-    && !isNaN(*(double*)a)
+    && !isnan(*(double*)a)
 #endif
     ;
     }
@@ -218,13 +218,13 @@
     double db = conv_to_double(b, btag);
 
 #ifdef PLAN9
-    if (isNaN(da) || isNaN(db))
+    if (isnan(da) || isnan(db))
         return 0;
 #endif
 
     // casting to double will only get the wrong answer for big int64s
     // that differ in low bits
-    if (da < db && !isNaN(da) && !isNaN(db))
+    if (da < db && !isnan(da) && !isnan(db))
         return 1;
     if (db < da)
         return 0;