conservatory
/
femtolisp
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Compare commits

base: conservatory:2abf82a0e86b06a9547f226ca371b62516450ddb
Branches Tags
conservatory:master
..
compare: conservatory:0bf4243ae0c8bfa68d62b67b32bacef3da486364
Branches Tags
conservatory:master

5 Commits
2abf82a0e8 ... 0bf4243ae0

Author SHA1 Message Date
Lassi Kortela 0bf4243ae0 Use intptr_t and uintptr_t 
Thanks @krytarowski
 2020-03-17 11:38:32 +02:00
Lassi Kortela 1006496256 Use uint32_t instead of u_int32_t 2020-03-17 11:38:32 +02:00
Lars Brinkhoff 2bc5c43022 Make GitHub detect lisp files as Scheme. 2020-03-08 02:51:32 +02:00
Kamil Rytarowski 48ff4764a4 Add NetBSD support 
$ make test
cd tests && ../flisp unittest.lsp
all tests pass
 2020-03-08 02:36:54 +02:00
Lassi Kortela 956fd32a06 Use stdint.h instead of sys/types.h 2020-02-26 11:26:50 +02:00
15 changed files with 95 additions and 108 deletions
Show Stats Expand all files Collapse all files

2
.gitattributes vendored Normal file
View File

@ -0,0 +1,2 @@
*.lsp linguist-language=Scheme
flisp.boot linguist-language=Scheme

2
flisp.c
View File

@ -2320,6 +2320,8 @@ static void lisp_init(size_t initial_heapsize)
set(symbol("*os-name*"), symbol("openbsd")); set(symbol("*os-name*"), symbol("openbsd"));
#elif defined(FREEBSD) #elif defined(FREEBSD)
set(symbol("*os-name*"), symbol("freebsd")); set(symbol("*os-name*"), symbol("freebsd"));
#elif defined(NETBSD)
set(symbol("*os-name*"), symbol("netbsd"));
#else #else
set(symbol("*os-name*"), symbol("unknown")); set(symbol("*os-name*"), symbol("unknown"));
#endif #endif

8
llt/dirpath.c
View File

@ -191,7 +191,7 @@ char *get_exename(char *buf, size_t size)
return buf; return buf;
} }
#elif defined(FREEBSD) #elif defined(FREEBSD) || defined(NETBSD)
#include <sys/types.h> #include <sys/types.h>
#include <sys/sysctl.h> #include <sys/sysctl.h>
@ -199,9 +199,15 @@ char *get_exename(char *buf, size_t size)
{ {
int mib[4]; int mib[4];
mib[0] = CTL_KERN; mib[0] = CTL_KERN;
#if defined(FREEBSD)
mib[1] = KERN_PROC; mib[1] = KERN_PROC;
mib[2] = KERN_PROC_PATHNAME; mib[2] = KERN_PROC_PATHNAME;
mib[3] = -1; mib[3] = -1;
#else
mib[1] = KERN_PROC_ARGS;
mib[2] = -1;
mib[3] = KERN_PROC_PATHNAME;
#endif
sysctl(mib, 4, buf, &size, NULL, 0); sysctl(mib, 4, buf, &size, NULL, 0);
return buf; return buf;

8
llt/dtypes.h
View File

@ -25,13 +25,15 @@
# define OPENBSD # define OPENBSD
#elif defined(__FreeBSD__) #elif defined(__FreeBSD__)
# define FREEBSD # define FREEBSD
#elif defined(__NetBSD__)
# define NETBSD
#elif defined(_WIN32) #elif defined(_WIN32)
# define WIN32 # define WIN32
#else #else
# error "unknown platform" # error "unknown platform"
#endif #endif
#if defined(OPENBSD) || defined(FREEBSD) #if defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD)
#if defined(__x86_64__) #if defined(__x86_64__)
# define __SIZEOF_POINTER__ 8 # define __SIZEOF_POINTER__ 8
#else #else
@ -72,7 +74,7 @@
# define BIG_ENDIAN __BIG_ENDIAN # define BIG_ENDIAN __BIG_ENDIAN
# define PDP_ENDIAN __PDP_ENDIAN # define PDP_ENDIAN __PDP_ENDIAN
# define BYTE_ORDER __BYTE_ORDER # define BYTE_ORDER __BYTE_ORDER
#elif defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD) #elif defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD)
# include <machine/endian.h> # include <machine/endian.h>
# define __LITTLE_ENDIAN LITTLE_ENDIAN # define __LITTLE_ENDIAN LITTLE_ENDIAN
# define __BIG_ENDIAN BIG_ENDIAN # define __BIG_ENDIAN BIG_ENDIAN
@ -193,10 +195,12 @@ typedef u_ptrint_t uptrint_t;
#define DBL_EPSILON 2.2204460492503131e-16 #define DBL_EPSILON 2.2204460492503131e-16
#define FLT_EPSILON 1.192092896e-7 #define FLT_EPSILON 1.192092896e-7
#if !defined(NETBSD)
#define DBL_MAX 1.7976931348623157e+308 #define DBL_MAX 1.7976931348623157e+308
#define DBL_MIN 2.2250738585072014e-308 #define DBL_MIN 2.2250738585072014e-308
#define FLT_MAX 3.402823466e+38 #define FLT_MAX 3.402823466e+38
#define FLT_MIN 1.175494351e-38 #define FLT_MIN 1.175494351e-38
#endif
#define LOG2_10 3.3219280948873626 #define LOG2_10 3.3219280948873626
#define rel_zero(a, b) (fabs((a)/(b)) < DBL_EPSILON) #define rel_zero(a, b) (fabs((a)/(b)) < DBL_EPSILON)
#define sign_bit(r) ((*(int64_t*)&(r)) & BIT63) #define sign_bit(r) ((*(int64_t*)&(r)) & BIT63)

2
llt/socket.c
View File

@ -7,7 +7,7 @@
#include "dtypes.h" #include "dtypes.h"
#if defined(MACOSX) #if defined(MACOSX) || defined(NETBSD)
#include <sys/time.h> #include <sys/time.h>
#include <sys/select.h> #include <sys/select.h>
#include <sys/types.h> #include <sys/types.h>

4
llt/timefuncs.c
View File

@ -82,7 +82,7 @@ void timestring(double seconds, char *buffer, size_t len)
{ {
time_t tme = (time_t)seconds; time_t tme = (time_t)seconds;
#if defined(LINUX) || defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD) #if defined(LINUX) || defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD)
char *fmt = "%c"; /* needed to suppress GCC warning */ char *fmt = "%c"; /* needed to suppress GCC warning */
struct tm tm; struct tm tm;
@ -106,7 +106,7 @@ void timestring(double seconds, char *buffer, size_t len)
#endif #endif
} }
#if defined(LINUX) || defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD) #if defined(LINUX) || defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD)
extern char *strptime(const char *s, const char *format, struct tm *tm); extern char *strptime(const char *s, const char *format, struct tm *tm);
double parsetime(const char *str) double parsetime(const char *str)
{ {

5
llt/utf8.c
View File

@ -15,6 +15,7 @@
#define _XOPEN_SOURCE 700 #define _XOPEN_SOURCE 700
#include <stdlib.h> #include <stdlib.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h>
#include <string.h> #include <string.h>
#include <stdarg.h> #include <stdarg.h>
#include <wchar.h> #include <wchar.h>
@ -26,9 +27,9 @@
#include <malloc.h> #include <malloc.h>
#define snprintf _snprintf #define snprintf _snprintf
#else #else
#if !defined(__FreeBSD__) && !defined(__OpenBSD__) #if !defined(__FreeBSD__) && !defined(__OpenBSD__) && !defined(__NetBSD__)
#include <alloca.h> #include <alloca.h>
#endif /* __FreeBSD__ && __OpenBSD__ */ #endif /* __FreeBSD__ && __OpenBSD__ && __NetBSD__ */
#endif #endif
#include <assert.h> #include <assert.h>

2
tiny/eval1
View File

@ -4,7 +4,7 @@ value_t eval_sexpr(value_t e, value_t *penv)
value_t *rest; value_t *rest;
cons_t *c; cons_t *c;
symbol_t *sym; symbol_t *sym;
u_int32_t saveSP; uint32_t saveSP;
int i, nargs, noeval=0; int i, nargs, noeval=0;
number_t s, n; number_t s, n;

2
tiny/eval2
View File

@ -4,7 +4,7 @@ value_t eval_sexpr(value_t e, value_t *penv)
value_t *rest; value_t *rest;
cons_t *c; cons_t *c;
symbol_t *sym; symbol_t *sym;
u_int32_t saveSP; uint32_t saveSP;
int i, nargs, noeval=0; int i, nargs, noeval=0;
number_t s, n; number_t s, n;

2
tiny/evalt
View File

@ -4,7 +4,7 @@ value_t eval_sexpr(value_t e, value_t *penv)
value_t *rest; value_t *rest;
cons_t *c; cons_t *c;
symbol_t *sym; symbol_t *sym;
u_int32_t saveSP; uint32_t saveSP;
int i, nargs, noeval=0; int i, nargs, noeval=0;
number_t s, n; number_t s, n;

22
tiny/flutils.c
View File

@ -1,6 +1,6 @@
u_int32_t *bitvector_resize(u_int32_t *b, size_t n) uint32_t *bitvector_resize(uint32_t *b, size_t n)
{ {
u_int32_t *p; uint32_t *p;
size_t sz = ((n+31)>>5) * 4; size_t sz = ((n+31)>>5) * 4;
p = realloc(b, sz); p = realloc(b, sz);
if (p == NULL) return NULL; if (p == NULL) return NULL;
@ -8,12 +8,12 @@ u_int32_t *bitvector_resize(u_int32_t *b, size_t n)
return p; return p;
} }
u_int32_t *mk_bitvector(size_t n) uint32_t *mk_bitvector(size_t n)
{ {
return bitvector_resize(NULL, n); return bitvector_resize(NULL, n);
} }
void bitvector_set(u_int32_t *b, u_int32_t n, u_int32_t c) void bitvector_set(uint32_t *b, uint32_t n, uint32_t c)
{ {
if (c) if (c)
b[n>>5] |= (1<<(n&31)); b[n>>5] |= (1<<(n&31));
@ -21,7 +21,7 @@ void bitvector_set(u_int32_t *b, u_int32_t n, u_int32_t c)
b[n>>5] &= ~(1<<(n&31)); b[n>>5] &= ~(1<<(n&31));
} }
u_int32_t bitvector_get(u_int32_t *b, u_int32_t n) uint32_t bitvector_get(uint32_t *b, uint32_t n)
{ {
return b[n>>5] & (1<<(n&31)); return b[n>>5] & (1<<(n&31));
} }
@ -73,7 +73,7 @@ void ltable_adjoin(ltable_t *t, unsigned long item)
ltable_insert(t, item); ltable_insert(t, item);
} }
static const u_int32_t offsetsFromUTF8[6] = { static const uint32_t offsetsFromUTF8[6] = {
0x00000000UL, 0x00003080UL, 0x000E2080UL, 0x00000000UL, 0x00003080UL, 0x000E2080UL,
0x03C82080UL, 0xFA082080UL, 0x82082080UL 0x03C82080UL, 0xFA082080UL, 0x82082080UL
}; };
@ -94,24 +94,24 @@ int u8_seqlen(const char c)
return trailingBytesForUTF8[(unsigned int)(unsigned char)c] + 1; return trailingBytesForUTF8[(unsigned int)(unsigned char)c] + 1;
} }
#define UEOF ((u_int32_t)EOF) #define UEOF ((uint32_t)EOF)
u_int32_t u8_fgetc(FILE *f) uint32_t u8_fgetc(FILE *f)
{ {
int amt=0, sz, c; int amt=0, sz, c;
u_int32_t ch=0; uint32_t ch=0;
c = fgetc(f); c = fgetc(f);
if (c == EOF) if (c == EOF)
return UEOF; return UEOF;
ch = (u_int32_t)c; ch = (uint32_t)c;
amt = sz = u8_seqlen(ch); amt = sz = u8_seqlen(ch);
while (--amt) { while (--amt) {
ch <<= 6; ch <<= 6;
c = fgetc(f); c = fgetc(f);
if (c == EOF) if (c == EOF)
return UEOF; return UEOF;
ch += (u_int32_t)c; ch += (uint32_t)c;
} }
ch -= offsetsFromUTF8[sz-1]; ch -= offsetsFromUTF8[sz-1];

30
tiny/lisp-nontail.c
View File

@ -18,25 +18,19 @@
Public Domain Public Domain
*/ */
#include <sys/types.h>
#include <ctype.h> #include <ctype.h>
#include <inttypes.h> #include <inttypes.h>
#include <setjmp.h> #include <setjmp.h>
#include <stdarg.h> #include <stdarg.h>
#include <stdint.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#ifdef __LP64__ #define NUM_FORMAT "%" PRIdPTR
#define NUM_FORMAT "%" PRId64
typedef u_int64_t value_t; typedef intptr_t number_t;
typedef int64_t number_t; typedef uintptr_t value_t;
#else
#define NUM_FORMAT "%" PRId32
typedef u_int32_t value_t;
typedef int32_t number_t;
#endif
typedef struct { typedef struct {
value_t car; value_t car;
@ -96,7 +90,7 @@ static char *stack_bottom;
#define PROCESS_STACK_SIZE (2*1024*1024) #define PROCESS_STACK_SIZE (2*1024*1024)
#define N_STACK 49152 #define N_STACK 49152
static value_t Stack[N_STACK]; static value_t Stack[N_STACK];
static u_int32_t SP = 0; static uint32_t SP = 0;
#define PUSH(v) (Stack[SP++] = (v)) #define PUSH(v) (Stack[SP++] = (v))
#define POP() (Stack[--SP]) #define POP() (Stack[--SP])
#define POPN(n) (SP-=(n)) #define POPN(n) (SP-=(n))
@ -188,7 +182,7 @@ static unsigned char *fromspace;
static unsigned char *tospace; static unsigned char *tospace;
static unsigned char *curheap; static unsigned char *curheap;
static unsigned char *lim; static unsigned char *lim;
static u_int32_t heapsize = 64*1024;//bytes static uint32_t heapsize = 64*1024;//bytes
void lisp_init(void) void lisp_init(void)
{ {
@ -271,7 +265,7 @@ void gc(void)
{ {
static int grew = 0; static int grew = 0;
unsigned char *temp; unsigned char *temp;
u_int32_t i; uint32_t i;
curheap = tospace; curheap = tospace;
lim = curheap+heapsize-sizeof(cons_t); lim = curheap+heapsize-sizeof(cons_t);
@ -314,7 +308,7 @@ static int symchar(char c)
return (!isspace(c) && !strchr(special, c)); return (!isspace(c) && !strchr(special, c));
} }
static u_int32_t toktype = TOK_NONE; static uint32_t toktype = TOK_NONE;
static value_t tokval; static value_t tokval;
static char buf[256]; static char buf[256];
@ -385,7 +379,7 @@ static int read_token(FILE *f, char c)
return i; return i;
} }
static u_int32_t peek(FILE *f) static uint32_t peek(FILE *f)
{ {
char c, *end; char c, *end;
number_t x; number_t x;
@ -436,7 +430,7 @@ static u_int32_t peek(FILE *f)
static void read_list(FILE *f, value_t *pval) static void read_list(FILE *f, value_t *pval)
{ {
value_t c, *pc; value_t c, *pc;
u_int32_t t; uint32_t t;
PUSH(NIL); PUSH(NIL);
pc = &Stack[SP-1]; // to keep track of current cons cell pc = &Stack[SP-1]; // to keep track of current cons cell
@ -547,7 +541,7 @@ value_t eval_sexpr(value_t e, value_t *penv)
value_t *rest; value_t *rest;
cons_t *c; cons_t *c;
symbol_t *sym; symbol_t *sym;
u_int32_t saveSP; uint32_t saveSP;
int i, nargs, noeval=0; int i, nargs, noeval=0;
number_t s, n; number_t s, n;

32
tiny/lisp.c
View File

@ -18,25 +18,19 @@
Public Domain Public Domain
*/ */
#include <sys/types.h>
#include <ctype.h> #include <ctype.h>
#include <inttypes.h> #include <inttypes.h>
#include <setjmp.h> #include <setjmp.h>
#include <stdarg.h> #include <stdarg.h>
#include <stdint.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#ifdef __LP64__ #define NUM_FORMAT "%" PRIdPTR
#define NUM_FORMAT "%" PRId64
typedef u_int64_t value_t; typedef intptr_t number_t;
typedef int64_t number_t; typedef uintptr_t value_t;
#else
#define NUM_FORMAT "%" PRId32
typedef u_int32_t value_t;
typedef int32_t number_t;
#endif
typedef struct { typedef struct {
value_t car; value_t car;
@ -96,7 +90,7 @@ static char *stack_bottom;
#define PROCESS_STACK_SIZE (2*1024*1024) #define PROCESS_STACK_SIZE (2*1024*1024)
#define N_STACK 49152 #define N_STACK 49152
static value_t Stack[N_STACK]; static value_t Stack[N_STACK];
static u_int32_t SP = 0; static uint32_t SP = 0;
#define PUSH(v) (Stack[SP++] = (v)) #define PUSH(v) (Stack[SP++] = (v))
#define POP() (Stack[--SP]) #define POP() (Stack[--SP])
#define POPN(n) (SP-=(n)) #define POPN(n) (SP-=(n))
@ -188,7 +182,7 @@ static unsigned char *fromspace;
static unsigned char *tospace; static unsigned char *tospace;
static unsigned char *curheap; static unsigned char *curheap;
static unsigned char *lim; static unsigned char *lim;
static u_int32_t heapsize = 64*1024;//bytes static uint32_t heapsize = 64*1024;//bytes
void lisp_init(void) void lisp_init(void)
{ {
@ -271,7 +265,7 @@ void gc(void)
{ {
static int grew = 0; static int grew = 0;
unsigned char *temp; unsigned char *temp;
u_int32_t i; uint32_t i;
curheap = tospace; curheap = tospace;
lim = curheap+heapsize-sizeof(cons_t); lim = curheap+heapsize-sizeof(cons_t);
@ -314,7 +308,7 @@ static int symchar(char c)
return (!isspace(c) && !strchr(special, c)); return (!isspace(c) && !strchr(special, c));
} }
static u_int32_t toktype = TOK_NONE; static uint32_t toktype = TOK_NONE;
static value_t tokval; static value_t tokval;
static char buf[256]; static char buf[256];
@ -386,7 +380,7 @@ static int read_token(FILE *f, char c)
return (dot && (totread==2)); return (dot && (totread==2));
} }
static u_int32_t peek(FILE *f) static uint32_t peek(FILE *f)
{ {
char c, *end; char c, *end;
number_t x; number_t x;
@ -434,7 +428,7 @@ static u_int32_t peek(FILE *f)
static void read_list(FILE *f, value_t *pval) static void read_list(FILE *f, value_t *pval)
{ {
value_t c, *pc; value_t c, *pc;
u_int32_t t; uint32_t t;
PUSH(NIL); PUSH(NIL);
pc = &Stack[SP-1]; // to keep track of current cons cell pc = &Stack[SP-1]; // to keep track of current cons cell
@ -548,7 +542,7 @@ value_t eval_sexpr(value_t e, value_t *penv)
value_t *rest; value_t *rest;
cons_t *c; cons_t *c;
symbol_t *sym; symbol_t *sym;
u_int32_t saveSP; uint32_t saveSP;
int i, nargs, noeval=0; int i, nargs, noeval=0;
number_t s, n; number_t s, n;
@ -983,7 +977,7 @@ static char *infile = NULL;
value_t toplevel_eval(value_t expr) value_t toplevel_eval(value_t expr)
{ {
value_t v; value_t v;
u_int32_t saveSP = SP; uint32_t saveSP = SP;
PUSH(NIL); PUSH(NIL);
v = eval(expr, &Stack[SP-1]); v = eval(expr, &Stack[SP-1]);
SP = saveSP; SP = saveSP;

48
tiny/lisp2.c
View File

@ -39,25 +39,19 @@
Public Domain Public Domain
*/ */
#include <sys/types.h>
#include <ctype.h> #include <ctype.h>
#include <inttypes.h> #include <inttypes.h>
#include <setjmp.h> #include <setjmp.h>
#include <stdarg.h> #include <stdarg.h>
#include <stdint.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#ifdef __LP64__ #define NUM_FORMAT "%" PRIdPTR
#define NUM_FORMAT "%" PRId64
typedef u_int64_t value_t; typedef intptr_t number_t;
typedef int64_t number_t; typedef uintptr_t value_t;
#else
#define NUM_FORMAT "%" PRId32
typedef u_int32_t value_t;
typedef int32_t number_t;
#endif
typedef struct { typedef struct {
value_t car; value_t car;
@ -120,7 +114,7 @@ static char *stack_bottom;
#define PROCESS_STACK_SIZE (2*1024*1024) #define PROCESS_STACK_SIZE (2*1024*1024)
#define N_STACK 98304 #define N_STACK 98304
static value_t Stack[N_STACK]; static value_t Stack[N_STACK];
static u_int32_t SP = 0; static uint32_t SP = 0;
#define PUSH(v) (Stack[SP++] = (v)) #define PUSH(v) (Stack[SP++] = (v))
#define POP() (Stack[--SP]) #define POP() (Stack[--SP])
#define POPN(n) (SP-=(n)) #define POPN(n) (SP-=(n))
@ -130,7 +124,7 @@ value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT;
value_t read_sexpr(FILE *f); value_t read_sexpr(FILE *f);
void print(FILE *f, value_t v, int princ); void print(FILE *f, value_t v, int princ);
value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend); value_t eval_sexpr(value_t e, value_t *penv, int tail, uint32_t envend);
value_t load_file(char *fname); value_t load_file(char *fname);
value_t toplevel_eval(value_t expr); value_t toplevel_eval(value_t expr);
@ -230,8 +224,8 @@ static unsigned char *fromspace;
static unsigned char *tospace; static unsigned char *tospace;
static unsigned char *curheap; static unsigned char *curheap;
static unsigned char *lim; static unsigned char *lim;
static u_int32_t heapsize = 128*1024;//bytes static uint32_t heapsize = 128*1024;//bytes
static u_int32_t *consflags; static uint32_t *consflags;
static ltable_t printconses; static ltable_t printconses;
void lisp_init(void) void lisp_init(void)
@ -337,7 +331,7 @@ void gc(int mustgrow)
{ {
static int grew = 0; static int grew = 0;
void *temp; void *temp;
u_int32_t i; uint32_t i;
readstate_t *rs; readstate_t *rs;
curheap = tospace; curheap = tospace;
@ -375,7 +369,7 @@ void gc(int mustgrow)
temp = bitvector_resize(consflags, heapsize/sizeof(cons_t)); temp = bitvector_resize(consflags, heapsize/sizeof(cons_t));
if (temp == NULL) if (temp == NULL)
lerror("out of memory\n"); lerror("out of memory\n");
consflags = (u_int32_t*)temp; consflags = (uint32_t*)temp;
} }
grew = !grew; grew = !grew;
} }
@ -400,7 +394,7 @@ static int symchar(char c)
return (!isspace(c) && !strchr(special, c)); return (!isspace(c) && !strchr(special, c));
} }
static u_int32_t toktype = TOK_NONE; static uint32_t toktype = TOK_NONE;
static value_t tokval; static value_t tokval;
static char buf[256]; static char buf[256];
@ -472,7 +466,7 @@ static int read_token(FILE *f, char c, int digits)
return (dot && (totread==2)); return (dot && (totread==2));
} }
static u_int32_t peek(FILE *f) static uint32_t peek(FILE *f)
{ {
char c, *end; char c, *end;
number_t x; number_t x;
@ -505,7 +499,7 @@ static u_int32_t peek(FILE *f)
toktype = TOK_SHARPQUOTE; toktype = TOK_SHARPQUOTE;
} }
else if ((char)ch == '\\') { else if ((char)ch == '\\') {
u_int32_t cval = u8_fgetc(f); uint32_t cval = u8_fgetc(f);
toktype = TOK_NUM; toktype = TOK_NUM;
tokval = number(cval); tokval = number(cval);
} }
@ -569,7 +563,7 @@ static value_t do_read_sexpr(FILE *f, int fixup);
static void read_list(FILE *f, value_t *pval, int fixup) static void read_list(FILE *f, value_t *pval, int fixup)
{ {
value_t c, *pc; value_t c, *pc;
u_int32_t t; uint32_t t;
PUSH(NIL); PUSH(NIL);
pc = &Stack[SP-1]; // to keep track of current cons cell pc = &Stack[SP-1]; // to keep track of current cons cell
@ -610,7 +604,7 @@ static void read_list(FILE *f, value_t *pval, int fixup)
static value_t do_read_sexpr(FILE *f, int fixup) static value_t do_read_sexpr(FILE *f, int fixup)
{ {
value_t v, *head; value_t v, *head;
u_int32_t t, l; uint32_t t, l;
int i; int i;
t = peek(f); t = peek(f);
@ -865,12 +859,12 @@ static value_t assoc(value_t item, value_t v)
environment, otherwise you have to put any new environment on the top environment, otherwise you have to put any new environment on the top
of the stack. of the stack.
*/ */
value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) value_t eval_sexpr(value_t e, value_t *penv, int tail, uint32_t envend)
{ {
value_t f, v, headsym, asym, *pv, *argsyms, *body, *lenv, *argenv; value_t f, v, headsym, asym, *pv, *argsyms, *body, *lenv, *argenv;
cons_t *c; cons_t *c;
symbol_t *sym; symbol_t *sym;
u_int32_t saveSP; uint32_t saveSP;
int i, nargs, noeval=0; int i, nargs, noeval=0;
number_t s, n; number_t s, n;
@ -1209,7 +1203,7 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend)
if (tag(v)<0x2) { SP=saveSP; return v; } if (tag(v)<0x2) { SP=saveSP; return v; }
if (tail) { if (tail) {
*penv = NIL; *penv = NIL;
envend = SP = (u_int32_t)(penv-&Stack[0]) + 1; envend = SP = (uint32_t)(penv-&Stack[0]) + 1;
e=v; goto eval_top; e=v; goto eval_top;
} }
else { else {
@ -1363,7 +1357,7 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend)
nargs = (int)(&Stack[SP] - argenv); nargs = (int)(&Stack[SP] - argenv);
for(i=0; i < nargs; i++) for(i=0; i < nargs; i++)
penv[i] = argenv[i]; penv[i] = argenv[i];
envend = SP = (u_int32_t)((penv+nargs) - &Stack[0]); envend = SP = (uint32_t)((penv+nargs) - &Stack[0]);
goto eval_top; goto eval_top;
} }
else { else {
@ -1385,7 +1379,7 @@ static char *infile = NULL;
value_t toplevel_eval(value_t expr) value_t toplevel_eval(value_t expr)
{ {
value_t v; value_t v;
u_int32_t saveSP = SP; uint32_t saveSP = SP;
PUSH(NIL); PUSH(NIL);
v = topeval(expr, &Stack[SP-1]); v = topeval(expr, &Stack[SP-1]);
SP = saveSP; SP = saveSP;

34
tiny/lispf.c
View File

@ -24,35 +24,25 @@
Public Domain Public Domain
*/ */
#include <sys/types.h>
#include <ctype.h> #include <ctype.h>
#include <inttypes.h> #include <inttypes.h>
#include <setjmp.h> #include <setjmp.h>
#include <stdarg.h> #include <stdarg.h>
#include <stdint.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#ifdef __LP64__
typedef u_int64_t value_t;
#else
typedef u_int32_t value_t;
#endif
#ifdef FLOAT #ifdef FLOAT
#define NUM_FORMAT "%f" #define NUM_FORMAT "%f"
typedef float number_t; typedef float number_t;
#else #else
#ifdef __LP64__ #define NUM_FORMAT "%" PRIdPTR
#define NUM_FORMAT "%" PRId64 typedef intptr_t number_t;
typedef int64_t number_t;
#else
#define NUM_FORMAT "%" PRId32
typedef int32_t number_t;
#endif
#endif #endif
typedef uintptr_t value_t;
typedef struct { typedef struct {
value_t car; value_t car;
value_t cdr; value_t cdr;
@ -119,7 +109,7 @@ static char *stack_bottom;
#define PROCESS_STACK_SIZE (2*1024*1024) #define PROCESS_STACK_SIZE (2*1024*1024)
#define N_STACK 49152 #define N_STACK 49152
static value_t Stack[N_STACK]; static value_t Stack[N_STACK];
static u_int32_t SP = 0; static uint32_t SP = 0;
#define PUSH(v) (Stack[SP++] = (v)) #define PUSH(v) (Stack[SP++] = (v))
#define POP() (Stack[--SP]) #define POP() (Stack[--SP])
#define POPN(n) (SP-=(n)) #define POPN(n) (SP-=(n))
@ -211,7 +201,7 @@ static unsigned char *fromspace;
static unsigned char *tospace; static unsigned char *tospace;
static unsigned char *curheap; static unsigned char *curheap;
static unsigned char *lim; static unsigned char *lim;
static u_int32_t heapsize = 64*1024;//bytes static uint32_t heapsize = 64*1024;//bytes
void lisp_init(void) void lisp_init(void)
{ {
@ -294,7 +284,7 @@ void gc(void)
{ {
static int grew = 0; static int grew = 0;
unsigned char *temp; unsigned char *temp;
u_int32_t i; uint32_t i;
curheap = tospace; curheap = tospace;
lim = curheap+heapsize-sizeof(cons_t); lim = curheap+heapsize-sizeof(cons_t);
@ -337,7 +327,7 @@ static int symchar(char c)
return (!isspace(c) && !strchr(special, c)); return (!isspace(c) && !strchr(special, c));
} }
static u_int32_t toktype = TOK_NONE; static uint32_t toktype = TOK_NONE;
static value_t tokval; static value_t tokval;
static char buf[256]; static char buf[256];
@ -408,7 +398,7 @@ static int read_token(FILE *f, char c)
return i; return i;
} }
static u_int32_t peek(FILE *f) static uint32_t peek(FILE *f)
{ {
char c, *end; char c, *end;
number_t x; number_t x;
@ -459,7 +449,7 @@ static u_int32_t peek(FILE *f)
static void read_list(FILE *f, value_t *pval) static void read_list(FILE *f, value_t *pval)
{ {
value_t c, *pc; value_t c, *pc;
u_int32_t t; uint32_t t;
PUSH(NIL); PUSH(NIL);
pc = &Stack[SP-1]; // to keep track of current cons cell pc = &Stack[SP-1]; // to keep track of current cons cell
@ -573,7 +563,7 @@ value_t eval_sexpr(value_t e, value_t *penv)
value_t *rest; value_t *rest;
cons_t *c; cons_t *c;
symbol_t *sym; symbol_t *sym;
u_int32_t saveSP; uint32_t saveSP;
int i, nargs, noeval=0; int i, nargs, noeval=0;
number_t s, n; number_t s, n;