ref: 624a74abece109871a1780bb58f45ae61cef5ae5
parent: 8b59a493d6b5e51811321339450bddbe2aa56c24
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Mar 13 15:24:37 EDT 2023
clean up
--- a/Makefile
+++ b/Makefile
@@ -32,13 +32,13 @@
.SUFFIXES: .c .o
.c.o:
- ${CC} -o $@ -c $< ${CFLAGS} -Illt -DUSE_COMPUTED_GOTO+ ${CC} -o $@ -c $< ${CFLAGS} -Iposix -Illt -DUSE_COMPUTED_GOTOflisp.o: flisp.c cvalues.c operators.c types.c flisp.h print.c read.c equal.c
flmain.o: flmain.c flisp.h
${LLT}:- ${MAKE} -C llt CFLAGS="${CFLAGS}" CC="${CC}"+ ${MAKE} -C llt CFLAGS="${CFLAGS} -I../posix" CC="${CC}"clean:
rm -f *.o ${TARG}--- a/ascii-mona-lisa
+++ /dev/null
@@ -1,47 +1,0 @@
-iIYVVVVXVVVVVVVVVYVYVYYVYYYYIIIIYYYIYVVVYYYYYYYYYVVYVVVVXVVVVVYI+.
-tYVXXXXXXVXXXXVVVYVVVVVVVVVVVVYVVVVVVVVVVVVVVVVVXXXXXVXXXXXXXVVYi.
-iYXRXRRRXXXXXXXXXXXVVXVXVVVVVVVVXXXVXVVXXXXXXXXXXXXXXRRRRRRRRRXVi.
-tVRRRRRRRRRRRRRRRXRXXXXXXXXXXXXXXRRXXXXRRRRXXXXXXXRRRRRRRRRRRRXV+.
-tVRRBBBRMBRRRRRRRRRXXRRRRRXt=+;;;;;==iVXRRRRXXXXRRRRRRRRMMBRRRRXi,
-tVRRBMBBMMBBBBBMBBRBBBRBX++=++;;;;;;:;;;IRRRRXXRRRBBBBBBMMBBBRRXi,
-iVRMMMMMMMMMMMMMMBRBBMMV==iIVYIi=;;;;:::;;XRRRRRRBBMMMMMMMMBBRRXi.
-iVRMMMMMMMMMMMMMMMMMMMY;IBWWWWMMXYi=;:::::;RBBBMMMMMMMMMMMMMMBBXi,
-+VRMMRBMMMMMMMMMMMMMMY+;VMMMMMMMRXIi=;:::::=VVXXXRRRMMMMMMMMBBMXi;
-=tYYVVVXRRRXXRBMMMMMV+;=RBBMMMXVXXVYt;::::::ttYYVYVVRMMMMMMBXXVI+=
-;=tIYYVYYYYYYVVVMMMBt=;;+i=IBi+t==;;i;::::::+iitIIttYRMMMMMRXVVI=;
-;=IIIIYYYIIIIttIYItIt;;=VVYXBIVRXVVXI;::::::;+iitttttVMMBRRRVVVI+,
-;+++tttIttttiiii+i++==;;RMMMBXXMMMXI+;::::::;+ittttitYVXVYYIYVIi;;
-;===iiittiiIitiii++;;;;:IVRVi=iBXVIi;::::::::;==+++++iiittii+++=;;
-;;==+iiiiiiiiii+++=;;;;;;VYVIiiiVVt+;::::::::;++++++++++iti++++=;;
-;;=++iiii+i+++++iii==;;;::tXYIIYIi+=;:::::,::;+++++++++++++++++=;;
-;;;+==+ii+++++iiiiit=;;:::::=====;;;::::::::::+++i+++++++++i+++;;;
-;;;==+=+iiiiitttIIII+;;;:,::,;;;;:;=;;;::,::::=++++++++==++++++;;;
-:;====+tittiiittttti+;;::::,:=Ytiiiiti=;:::::,:;;==ii+ittItii+==;;
-;;+iiittIti+ii;;===;;:;::::;+IVXVVVVVVt;;;;;::::;;===;+IIiiti=;;;;
-;=++++iIti+ii+=;;;=;:::;;+VXBMMBBBBBBXY=;=;;:::::;=iYVIIttii++;;;;
-;;++iiiItttIi+++=;;:::;=iBMMMMMMMMMMMXI==;;,::;;:;;=+itIttIIti+;;;
-;=+++++i+tYIIiii;:,::;itXMMMMMMMMMMMBXti==;:;++=;:::::;=+iittti+;;
-;;+ii+ii+iitiIi;::::;iXBMMMMMWWWWWMMBXti+ii=;::::,,,,:::=;==+tI+;;
-;;iiiitItttti;:::;::=+itYXXMWWWWWWMBYt+;;::,,,,,,,,,,,,,:==;==;;;;
-:;=iIIIttIt+:;:::;;;==;+=+iiittttti+;;:,:,,,,::,,,,,,,,:::;=;==::;
-;::=+ittiii=;:::::;;;:;:;=++==;;==;:,,,,,,:;::::,,,,,,,,::;==;;::;
-:::;+iiiii=;::::,:;:::::;;:;;::;:::,,,,,,,:::;=;;;:,,,,,:::;;::::;
-:;;iIIIIII=;:::,:::::::,::::,:::,,,,,,,,,,,:;;=;:,,,,,,::::;=;:::;
-:;==++ii+;;;:::::::::::,,,,,,::,,,,,,,,,,,::::,,,,,,,,,,:,:::::::;
-::;;=+=;;;:::;;::,,,,,,,,,,,,,,,,,,,,,,,,,:,,,,,,,,,,,,,,,,,:::::;
-::;=;;;:;:::;;;;::,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,::,,::::;
-:;;:;::::::,::,,:,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:::;
-:::::::::::;;;:,,,,,,,,,,,,,...,...,,,.,,,,,,,,,,,,.,,,,,,,,,,,,:;
-::::::::;=;;;;;::,,,,,,,,,,,.......,...,,,,,,,,,,,,.,,,,,,,,,,,,,;
-:::::,,:;=;;;;;;;iVXXXVt+:,,....,,,,....,.,,,,,,,.,.....,,,,,,,,:;
-:,,::,,:::;;;;;;=IVVVXXXXVXVt:,,,,,..,..,,,,.,,,,,..,.,,,,,,,,,,,;
-::,::,,,:,:::::,::;=iIYVXVVVVIYIi;,,.,.,,,::,,,,,,,,,,,,,,,,,,,,,.
-:,,,,,,,,,,,,,,,,::;+itIIIIIIi:;;i++=;;;;;;;;;::,,,...,,..,,,,,,,.
-:,,,,,,,,,,,,,,=iitVYi++iitt==it;;:;;;;::;;::::,,,......,,,,,,,::.
-::,,,,,,,,,,,,,++iiIVIi=;;=;+i;:;+:::,,,,,,,,,,,,,.....,,,,,,,,::,
-,,,,,,,,,,,,,,,;=+it=:::,,,,,,,,,,.,......,,.,..........,,,,,,,,::
-:,,,,,,,,,,,,,,,,:=:,,,,,,,,,,,,,,......................,.,,.,.,,:
-:,,,,,,,,,,,,,,,,,:,,,,,,,,,,..,........................,..,...,,:
-,,,,,,,,,,,,,,,,,,,.....................................,.......,,
-,,,,,,,,,.,,,,,,,...............................................,,
-itittiiiii+=++=;;=iiiiiiittiiiiii+iii===;++iiitiiiiiii+=====+ii=+i
--- a/ascii-mona-lisa-2
+++ /dev/null
@@ -1,71 +1,0 @@
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>''''''<!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!'''''` ``'!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!''` ..... `'!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!'` . :::::' `'!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!' . ' .::::' `!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!' : ````` `!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!! .,cchcccccc,,. `!!!!!!!!!!!!
-!!!!!!!!!!!!!!! .-"?$$$$$$$$$$$$$$c, `!!!!!!!!!!!
-!!!!!!!!!!!!!! ,ccc$$$$$$$$$$$$$$$$$$$, `!!!!!!!!!!
-!!!!!!!!!!!!! z$$$$$$$$$$$$$$$$$$$$$$$$;. `!!!!!!!!!
-!!!!!!!!!!!! <$$$$$$$$$$$$$$$$$$$$$$$$$$:. `!!!!!!!!
-!!!!!!!!!!! $$$$$$$$$$$$$$$$$$$$$$$$$$$h;:. !!!!!!!!
-!!!!!!!!!!' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$h;. !!!!!!!
-!!!!!!!!!' <$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ !!!!!!!
-!!!!!!!!' `$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F `!!!!!!
-!!!!!!!! c$$$$???$$$$$$$P"" """??????" !!!!!!
-!!!!!!! `"" .,.. "$$$$F .,zcr !!!!!!
-!!!!!!! . dL .?$$$ .,cc, .,z$h. !!!!!!
-!!!!!!!! <. $$c= <$d$$$ <$$$$=-=+"$$$$$$$ !!!!!!
-!!!!!!! d$$$hcccd$$$$$ d$$$hcccd$$$$$$$F `!!!!!
-!!!!!! ,$$$$$$$$$$$$$$h d$$$$$$$$$$$$$$$$ `!!!!!
-!!!!! `$$$$$$$$$$$$$$$<$$$$$$$$$$$$$$$$' !!!!!
-!!!!! `$$$$$$$$$$$$$$$$"$$$$$$$$$$$$$P> !!!!!
-!!!!! ?$$$$$$$$$$$$??$c`$$$$$$$$$$$?>' `!!!!
-!!!!! `?$$$$$$I7?"" ,$$$$$$$$$?>>' !!!!
-!!!!!. <<?$$$$$$c. ,d$$?$$$$$F>>'' `!!!
-!!!!!! <i?$P"??$$r--"?"" ,$$$$h;>'' `!!!
-!!!!!! $$$hccccccccc= cc$$$$$$$>>' !!!
-!!!!! `?$$$$$$F"""" `"$$$$$>>>'' `!!
-!!!!! "?$$$$$cccccc$$$$??>>>>' !!
-!!!!> "$$$$$$$$$$$$$F>>>>'' `!
-!!!!! "$$$$$$$$???>''' !
-!!!!!> `""""" `
-!!!!!!; . `
-!!!!!!! ?h.
-!!!!!!!! $$c,
-!!!!!!!!> ?$$$h. .,c
-!!!!!!!!! $$$$$$$$$hc,.,,cc$$$$$
-!!!!!!!!! .,zcc$$$$$$$$$$$$$$$$$$$$$$
-!!!!!!!!! .z$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ .
-!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ !!
-!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ,!'
-!!!!!!!!> c$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$. !'
-!!!!!!'' ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> '
-!!!'' z$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$>
-!' ,$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> ..
- z$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' ;!!!!''`
- $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F ,;;!'`' .''
- <$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> ,;'`' ,;
- `$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F -' ,;!!'
- "?$$$$$$$$$$?$$$$$$$$$$$$$$$$$$$$$$$$$$F .<!!!''' <!
- !> ""??$$$?C3$$$$$$$$$$$$$$$$$$$$$$$$"" ;!''' !!!
- ;!!!!;, `"''""????$$$$$$$$$$$$$$$$"" ,;-'' ',!
- ;!!!!<!!!; . `""""""""""" `' ' '
- !!!! ;!!! ;!!!!>;,;, .. ' . ' '
- !!' ,;!!! ;'`!!!!!!!!;!!!!!; . >' .'' ;
- !!' ;!!'!';! !! !!!!!!!!!!!!! ' -'
- <!! !! `!;! `!' !!!!!!!!!!<! .
- `! ;! ;!!! <' <!!!! `!!! < /
- `; !> <!! ;' !!!!' !!';! ;'
- ! ! !!! ! `!!! ;!! ! ' '
- ; `! `!! ,' !' ;!'
- ' /`! ! < !! < '
- / ;! >;! ;>
- !' ; !! '
- ' ;! > ! '
- '
-by Allen Mullen
--- a/bootstrap.sh
+++ b/bootstrap.sh
@@ -3,7 +3,6 @@
cp flisp.boot flisp.boot.bak
echo "Creating stage 0 boot file..."
-#../../branches/interpreter/femtolisp/flisp mkboot0.lsp system.lsp compiler.lsp > flisp.boot.new
./flisp mkboot0.lsp system.lsp compiler.lsp > flisp.boot.new
mv flisp.boot.new flisp.boot
--- a/builtins.c
+++ b/builtins.c
@@ -2,37 +2,8 @@
Extra femtoLisp builtin functions
*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#define exit(x) exits(x ? "error" : nil)
-#define sqrtf sqrt
-#define expf exp
-#define logf log
-#define sinf sin
-#define cosf cos
-#define tanf tan
-#define asinf asin
-#define acosf acos
-#define atanf atan
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <setjmp.h>
-#include <stdarg.h>
-#include <assert.h>
-#include <ctype.h>
-#include <sys/types.h>
-#include <sys/time.h>
-#include <sys/stat.h>
-#include <errno.h>
-#include <math.h>
-#endif
-
#include "llt.h"
#include "flisp.h"
-#include "random.h"
size_t llength(value_t v)
{@@ -287,11 +258,11 @@
return args[0];
if (d > 0) {- if (d > (double)S64_MAX)
+ if (d > (double)INT64_MAX)
return args[0];
return return_from_uint64((uint64_t)d);
}
- if (d > (double)S64_MAX || d < (double)S64_MIN)
+ if (d > (double)INT64_MAX || d < (double)INT64_MIN)
return args[0];
return return_from_int64((int64_t)d);
}
@@ -377,16 +348,8 @@
static value_t fl_path_exists(value_t *args, uint32_t nargs)
{ argcount("path.exists?", nargs, 1);- char *str = tostring(args[0], "path.exists?");
-#ifdef PLAN9
- if (access(str, 0) != 0)
- return FL_F;
-#else
- struct stat sbuf;
- if (stat(str, &sbuf) == -1)
- return FL_F;
-#endif
- return FL_T;
+ char *path = tostring(args[0], "path.exists?");
+ return access(path, F_OK) == 0 ? FL_T : FL_F;
}
static value_t fl_os_getenv(value_t *args, uint32_t nargs)
@@ -406,22 +369,11 @@
char *name = tostring(args[0], "os.setenv");
int result;
if (args[1] == FL_F) {-#ifdef LINUX
result = unsetenv(name);
-#elif defined(PLAN9)
- result = putenv(name, "");
-#else
- (void)unsetenv(name);
- result = 0;
-#endif
}
else {char *val = tostring(args[1], "os.setenv");
-#ifdef PLAN9
- result = putenv(name, val);
-#else
result = setenv(name, val, 1);
-#endif
}
if (result != 0)
lerror(ArgError, "os.setenv: invalid environment variable");
--- a/cvalues.c
+++ b/cvalues.c
@@ -81,9 +81,7 @@
t->vtable->finalize(tagptr(tmp, TAG_CVALUE));
}
if (!isinlined(tmp) && owned(tmp)) {-#ifndef NDEBUG
memset(cv_data(tmp), 0xbb, cv_len(tmp));
-#endif
free(cv_data(tmp));
}
ndel++;
@@ -1015,7 +1013,7 @@
if (fits_fixnum(Uaccum)) {return fixnum((fixnum_t)Uaccum);
}
- if (Uaccum > (uint64_t)S64_MAX) {+ if (Uaccum > (uint64_t)INT64_MAX) {RETURN_NUM_AS(Uaccum, uint64);
}
else if (Uaccum > (uint64_t)UINT_MAX) {--- a/equal.c
+++ b/equal.c
@@ -1,6 +1,12 @@
#define BOUNDED_COMPARE_BOUND 128
#define BOUNDED_HASH_BOUND 16384
+#ifdef BITS64
+#define inthash int64hash
+#else
+#define inthash int32hash
+#endif
+
// comparable tag
#define cmptag(v) (isfixnum(v) ? TAG_NUM : tag(v))
--- a/equalhash.c
+++ b/equalhash.c
@@ -1,19 +1,6 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <assert.h>
-#include <limits.h>
-#include <setjmp.h>
-#endif
-
#include "llt.h"
#include "flisp.h"
#include "equalhash.h"
-
#include "htable.inc"
#define _equal_lispvalue_(x,y) equal_lispvalue((value_t)(x),(value_t)(y))
--- a/equalhash.h
+++ b/equalhash.h
@@ -1,8 +1,2 @@
-#ifndef EQUALHASH_H
-#define EQUALHASH_H
-
#include "htableh.inc"
-
HTPROT(equalhash)
-
-#endif
--- a/flisp.c
+++ b/flisp.c
@@ -29,30 +29,6 @@
Distributed under the BSD License
*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#define vsnprintf vsnprint
-#define INT_MAX 0x7fffffff
-#define UINT_MAX 0xffffffffU
-#define INT_MIN (-INT_MAX-1)
-#pragma lib "./llt/libllt.$O.a"
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <setjmp.h>
-#include <stdint.h>
-#include <stdarg.h>
-#include <assert.h>
-#include <ctype.h>
-#include <wctype.h>
-#include <sys/types.h>
-#include <locale.h>
-#include <limits.h>
-#include <errno.h>
-#include <math.h>
-#endif
#include "llt.h"
#include "flisp.h"
#include "opcodes.h"
@@ -2262,9 +2238,7 @@
int i;
llt_init();
-#ifndef PLAN9
setlocale(LC_NUMERIC, "C");
-#endif
heapsize = initial_heapsize;
@@ -2323,15 +2297,15 @@
setc(symbol("procedure?"), builtin(OP_FUNCTIONP)); setc(symbol("top-level-bound?"), builtin(OP_BOUNDP));-#ifdef LINUX
+#if defined(__linux__)
set(symbol("*os-name*"), symbol("linux"));-#elif defined(OPENBSD)
+#elif defined(__OpenBSD__)
set(symbol("*os-name*"), symbol("openbsd"));-#elif defined(FREEBSD)
+#elif defined(__FreeBSD__)
set(symbol("*os-name*"), symbol("freebsd"));-#elif defined(NETBSD)
+#elif defined(__NetBSD__)
set(symbol("*os-name*"), symbol("netbsd"));-#elif defined(PLAN9)
+#elif defined(__plan9__)
set(symbol("*os-name*"), symbol("plan9"));#else
set(symbol("*os-name*"), symbol("unknown"));@@ -2342,7 +2316,7 @@
cvalues_init();
-#ifdef PLAN9
+#if defined(__plan9__)
char *s, *e;
if ((s = strstr(argv0, ".out")) != nil && s[4] == 0){if((e = strrchr(argv0, '/')) != nil)
--- a/flisp.h
+++ b/flisp.h
@@ -1,11 +1,6 @@
#ifndef FLISP_H
#define FLISP_H
-#ifndef PLAN9
-#include <setjmp.h>
-#include <stdint.h>
-#endif
-
typedef uintptr_t value_t;
typedef int_t fixnum_t;
#ifdef BITS64
--- a/flmain.c
+++ b/flmain.c
@@ -1,13 +1,3 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#define snprintf snprint
-#else
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <assert.h>
-#endif
#include "llt.h"
#include "flisp.h"
@@ -27,11 +17,14 @@
extern value_t fl_file(value_t *args, uint32_t nargs);
-int main(int argc, char **argv)
+int
+main(int argc, char **argv)
{char fname_buf[1024];
+ value_t args[2];
+ int r;
-#ifdef PLAN9
+#if defined(__plan9__)
argv0 = argv[0];
setfcr(FPPDBL|FPRNR|FPOVFL);
tmfmtinstall();
@@ -39,7 +32,7 @@
fl_init(512*1024);
-#ifdef INITFILE
+#if defined(INITFILE)
snprintf(fname_buf, sizeof(fname_buf), "%s", INITFILE);
#else
value_t str = symbol_value(symbol("*install-dir*"));@@ -49,26 +42,26 @@
exedir ? PATHSEPSTRING : "");
#endif
- value_t args[2];
fl_gc_handle(&args[0]);
fl_gc_handle(&args[1]);
+ r = 1;
FL_TRY_EXTERN {args[0] = cvalue_static_cstring(fname_buf);
args[1] = symbol(":read");value_t f = fl_file(&args[0], 2);
fl_free_gc_handles(2);
-
- if (fl_load_system_image(f))
- return 1;
-
- fl_applyn(1, symbol_value(symbol("__start")),- argv_list(argc, argv));
+ if (fl_load_system_image(f) == 0){+ fl_applyn(1, symbol_value(symbol("__start")),+ argv_list(argc, argv));
+ r = 0;
+ }
}
FL_CATCH_EXTERN_NO_RESTORE { ios_puts("fatal error:\n", ios_stderr);fl_print(ios_stderr, fl_lasterror);
ios_putc('\n', ios_stderr);- return 1;
+ break;
}
- return 0;
+ exit(r);
+ return r;
}
--- a/iostream.c
+++ b/iostream.c
@@ -1,15 +1,3 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <string.h>
-#include <assert.h>
-#include <sys/types.h>
-#include <setjmp.h>
-#endif
#include "llt.h"
#include "flisp.h"
--- a/llt/Makefile
+++ b/llt/Makefile
@@ -2,20 +2,21 @@
TARG=libllt.a
OBJS=\
+ bitvector-ops.o\
bitvector.o\
- hashing.o\
- socket.o\
- timefuncs.o\
- ptrhash.o\
- utf8.o\
- ios.o\
dirpath.o\
+ dump.o\
+ hashing.o\
htable.o\
- bitvector-ops.o\
int2str.o\
- dump.o\
- random.o\
+ ios.o\
lltinit.o\
+ ptrhash.o\
+ random.o\
+ socket.o\
+ timefuncs.o\
+ utf8.o\
+ wcwidth.o\
.PHONY: all default clean
--- a/llt/bitvector-ops.c
+++ b/llt/bitvector-ops.c
@@ -1,15 +1,16 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <assert.h>
-#include <string.h>
-#endif
+#include "llt.h"
-#include "dtypes.h"
-#include "bitvector.h"
+#define ONES32 ((uint32_t)0xffffffffUL)
+static inline uint32_t count_bits(uint32_t b)
+{+ b = b - ((b>>1)&0x55555555);
+ b = ((b>>2)&0x33333333) + (b&0x33333333);
+ b = ((b>>4)+b)&0x0f0f0f0f;
+ b += (b>>8);
+ b += (b>>16);
+ return b & 0x3f;
+}
// greater than this # of words we use malloc instead of alloca
#define MALLOC_CUTOFF 2000
@@ -99,7 +100,7 @@
// if dest has more space than source, set scrap to true to keep the
// top bits that would otherwise be shifted out
void bitvector_shl_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s,
- bool_t scrap)
+ int scrap)
{uint32_t i, j, sc=0;
if (n == 0) return;
@@ -126,9 +127,7 @@
// assumes offs < 32
void bitvector_fill(uint32_t *b, uint32_t offs, uint32_t c, uint32_t nbits)
{- index_t i;
- uint32_t nw, tail;
- uint32_t mask;
+ uint32_t i, nw, tail, mask;
if (nbits == 0) return;
nw = (offs+nbits+31)>>5;
@@ -158,9 +157,7 @@
void bitvector_not(uint32_t *b, uint32_t offs, uint32_t nbits)
{- index_t i;
- uint32_t nw, tail;
- uint32_t mask;
+ uint32_t i, nw, tail, mask;
if (nbits == 0) return;
nw = (offs+nbits+31)>>5;
@@ -190,12 +187,10 @@
// constant-space bit vector copy in a single pass, with arbitrary
// offsets and lengths. to get this right, there are 16 cases to handle!
#define BITVECTOR_COPY_OP(name, OP) \
-void bitvector_##name(uint32_t *dest, uint32_t doffs, \
- uint32_t *src, uint32_t soffs, uint32_t nbits) \
+void bitvector_##name(uint32_t *dest, uint32_t doffs, \
+ uint32_t *src, uint32_t soffs, uint32_t nbits) \
{ \- index_t i; \
- uint32_t s, nw, tail, snw; \
- uint32_t mask, scrap; \
+ uint32_t i, s, nw, tail, snw, mask, scrap; \
\
if (nbits == 0) return; \
nw = (doffs+nbits+31)>>5; \
@@ -299,8 +294,7 @@
void bitvector_reverse_to(uint32_t *dest, uint32_t *src, uint32_t soffs,
uint32_t nbits)
{- index_t i;
- uint32_t nw, tail;
+ uint32_t i, nw, tail;
if (nbits == 0) return;
@@ -320,10 +314,7 @@
void bitvector_reverse(uint32_t *b, uint32_t offs, uint32_t nbits)
{- index_t i;
- uint32_t nw, tail;
- uint32_t *temp;
- uint32_t a[MALLOC_CUTOFF];
+ uint32_t i, nw, tail, *temp, a[MALLOC_CUTOFF];
if (nbits == 0) return;
@@ -378,9 +369,7 @@
uint32_t bitvector_any0(uint32_t *b, uint32_t offs, uint32_t nbits)
{- index_t i;
- uint32_t nw, tail;
- uint32_t mask;
+ uint32_t i, nw, tail, mask;
if (nbits == 0) return 0;
nw = (offs+nbits+31)>>5;
@@ -411,9 +400,7 @@
uint32_t bitvector_any1(uint32_t *b, uint32_t offs, uint32_t nbits)
{- index_t i;
- uint32_t nw, tail;
- uint32_t mask;
+ uint32_t i, nw, tail, mask;
if (nbits == 0) return 0;
nw = (offs+nbits+31)>>5;
--- a/llt/bitvector.c
+++ b/llt/bitvector.c
@@ -29,17 +29,7 @@
and_to, or_to, and xor_to allow overlap.
*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <assert.h>
-#include <string.h>
-#endif
-
-#include "dtypes.h"
-#include "bitvector.h"
+#include "llt.h"
uint32_t *bitvector_resize(uint32_t *b, uint64_t oldsz, uint64_t newsz,
int initzero)
--- a/llt/bitvector.h
+++ b/llt/bitvector.h
@@ -1,70 +1,23 @@
-#ifndef __BITVECTOR_H_
-#define __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)
-
-#ifdef __INTEL_COMPILER
-#define count_bits(b) _popcnt32(b)
-#else
-static inline uint32_t count_bits(uint32_t b)
-{- b = b - ((b>>1)&0x55555555);
- b = ((b>>2)&0x33333333) + (b&0x33333333);
- b = ((b>>4)+b)&0x0f0f0f0f;
- b += (b>>8);
- b += (b>>16);
- return b & 0x3f;
- // here is the non-optimized version, for clarity:
- /*
- b = ((b>> 1)&0x55555555) + (b&0x55555555);
- b = ((b>> 2)&0x33333333) + (b&0x33333333);
- b = ((b>> 4)&0x0f0f0f0f) + (b&0x0f0f0f0f);
- b = ((b>> 8)&0x00ff00ff) + (b&0x00ff00ff);
- b = ((b>>16)&0x0000ffff) + (b&0x0000ffff);
- return b & 0x3f;
- */
-}
-#endif
-
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);
+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_shl_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s, int 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_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_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);
+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);
-
-#endif
--- a/llt/dirpath.c
+++ b/llt/dirpath.c
@@ -1,25 +1,5 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#define getcwd getwd
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <time.h>
-#include <assert.h>
-#include <errno.h>
-#include <limits.h>
-#include <sys/stat.h>
-#include <sys/types.h>
-#include <sys/time.h>
-#include <sys/poll.h>
-#include <unistd.h>
-#endif
+#include "platform.h"
-#include "dtypes.h"
-#include "dirpath.h"
-
void get_cwd(char *buf, size_t size)
{getcwd(buf, size);
@@ -42,13 +22,13 @@
}
}
-#ifdef PLAN9
+#ifdef __plan9__
char *get_exename(char *buf, size_t size)
{snprint(buf, size, argv0);
return buf;
}
-#elif defined(LINUX)
+#elif defined(__linux__)
char *get_exename(char *buf, size_t size)
{char linkname[64]; /* /proc/<pid>/exe */
@@ -77,7 +57,7 @@
return buf;
}
-#elif defined(OPENBSD)
+#elif defined(__OpenBSD__)
#include <sys/param.h>
#include <sys/sysctl.h>
@@ -180,7 +160,7 @@
return buf;
}
-#elif defined(FREEBSD) || defined(NETBSD)
+#elif defined(__FreeBSD__) || defined(__NetBSD__)
#include <sys/types.h>
#include <sys/sysctl.h>
@@ -188,7 +168,7 @@
{int mib[4];
mib[0] = CTL_KERN;
-#if defined(FREEBSD)
+#if defined(__FreeBSD__)
mib[1] = KERN_PROC;
mib[2] = KERN_PROC_PATHNAME;
mib[3] = -1;
--- a/llt/dirpath.h
+++ /dev/null
@@ -1,15 +1,0 @@
-#ifndef __DIRPATH_H_
-#define __DIRPATH_H_
-
-#define PATHSEP '/'
-#define PATHSEPSTRING "/"
-#define PATHLISTSEP ':'
-#define PATHLISTSEPSTRING ":"
-#define ISPATHSEP(c) ((c)=='/')
-
-void get_cwd(char *buf, size_t size);
-int set_cwd(char *buf);
-char *get_exename(char *buf, size_t size);
-void path_to_dirname(char *path);
-
-#endif
--- a/llt/dtypes.h
+++ /dev/null
@@ -1,193 +1,0 @@
-#ifndef __DTYPES_H_
-#define __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.
-*/
-
-
-#if defined(__gnu_linux__)
-# define LINUX
-#elif defined(__OpenBSD__)
-# define OPENBSD
-#elif defined(__FreeBSD__)
-# define FREEBSD
-#elif defined(__NetBSD__)
-# define NETBSD
-#elif !defined(PLAN9)
-# error "unknown platform"
-#endif
-
-#if defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD) || defined(PLAN9)
-#if defined(__x86_64__) || defined(__amd64__) || defined(__arm64__)
-# define __SIZEOF_POINTER__ 8
-#else
-# define __SIZEOF_POINTER__ 4
-#endif
-#endif
-
-#if !defined (BITS32) && !defined (BITS64)
-#ifndef __SIZEOF_POINTER__
-# error "__SIZEOF_POINTER__ undefined"
-#endif
-#if( 8 == __SIZEOF_POINTER__ )
-# define BITS64
-#elif( 4 == __SIZEOF_POINTER__ )
-# define BITS32
-#else
-# error "this is one weird machine"
-#endif
-#endif
-
-
-#if defined(PLAN9)
-#define STDCALL
-#define DLLEXPORT
-#else
-# define STDCALL
-# define DLLEXPORT __attribute__ ((visibility("default")))-#endif
-
-#if defined(PLAN9)
-# define __LITTLE_ENDIAN 1234
-# define __BIG_ENDIAN 4321
-# define __BYTE_ORDER __LITTLE_ENDIAN
-#else
-# include <endian.h>
-#endif
-
-#ifndef BYTE_ORDER
-# define LITTLE_ENDIAN __LITTLE_ENDIAN
-# define BIG_ENDIAN __BIG_ENDIAN
-# define BYTE_ORDER __BYTE_ORDER
-#endif
-
-#ifdef PLAN9
-#define __attribute__(...)
-#else
-#define USED(x) (void)(x)
-#endif
-
-#ifdef BOEHM_GC
-// boehm GC allocator
-#include <gc.h>
-#define LLT_ALLOC(n) GC_MALLOC(n)
-#define LLT_REALLOC(p,n) GC_REALLOC((p),(n))
-#define LLT_FREE(x) ((void)(x))
-#else
-// standard allocator
-#define LLT_ALLOC(n) malloc(n)
-#define LLT_REALLOC(p,n) realloc((p),(n))
-#define LLT_FREE(x) free(x)
-#endif
-
-typedef int bool_t;
-
-#if defined(BITS64)
-#define ULONG64
-#endif
-
-#ifdef PLAN9
-typedef usize size_t;
-#ifdef BITS64
-typedef long long ssize_t;
-#else
-typedef long ssize_t;
-#endif
-#define STATIC_INLINE static
-#define INLINE
-#ifndef NULL
-#define NULL nil
-#endif
-#else
-# define STATIC_INLINE static inline
-# define INLINE inline
-#endif
-
-#if defined(PLAN9)
-typedef s8int int8_t;
-typedef s16int int16_t;
-typedef s32int int32_t;
-typedef s64int int64_t;
-typedef u8int uint8_t;
-typedef u16int uint16_t;
-typedef u32int uint32_t;
-typedef u64int uint64_t;
-typedef vlong off_t;
-typedef intptr intptr_t;
-typedef uintptr uintptr_t;
-#else
-#include <sys/types.h>
-#include <stdint.h>
-#endif
-
-#ifdef BITS64
-#define TOP_BIT 0x8000000000000000ULL
-#define NBITS 64
-typedef uint64_t uint_t; // preferred int type on platform
-typedef int64_t int_t;
-typedef int64_t offset_t;
-typedef uint64_t index_t;
-#else
-#define TOP_BIT 0x80000000UL
-#define NBITS 32
-typedef uint32_t uint_t;
-typedef int32_t int_t;
-typedef int32_t offset_t;
-typedef uint32_t index_t;
-#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
-
-#ifndef PLAN9
-#include <float.h>
-#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 0x8000000000000000ULL
-#define U32_MAX 4294967295UL
-#define S32_MAX 2147483647L
-#define S32_MIN (-S32_MAX - 1L)
-#define BIT31 0x80000000UL
-
-#define LOG2_10 3.3219280948873626
-#define rel_zero(a, b) (fabs((a)/(b)) < DBL_EPSILON)
-#define sign_bit(r) ((*(uint64_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) (((*(uint64_t*)&(d))&0x7ff0000000000000ULL)!=0x7ff0000000000000ULL)
-
-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;
-
-#endif
--- a/llt/dump.c
+++ b/llt/dump.c
@@ -1,12 +1,4 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#endif
-#include "dtypes.h"
-#include "ios.h"
-#include "utils.h"
+#include "llt.h"
static char hexdig[] = "0123456789abcdef";
--- a/llt/hashing.c
+++ b/llt/hashing.c
@@ -1,20 +1,4 @@
-/*
- Hashing
-*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#endif
-#include "dtypes.h"
-#include "utils.h"
-#include "hashing.h"
-#include "timefuncs.h"
-#include "ios.h"
-#include "random.h"
+#include "llt.h"
uint_t nextipow2(uint_t i)
{--- a/llt/hashing.h
+++ /dev/null
@@ -1,16 +1,0 @@
-#ifndef __HASHING_H_
-#define __HASHING_H_
-
-uint_t nextipow2(uint_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);
-
-#endif
--- a/llt/htable.c
+++ b/llt/htable.c
@@ -2,20 +2,8 @@
functions common to all hash table instantiations
*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <assert.h>
-#include <limits.h>
-#endif
-
-#include "dtypes.h"
+#include "llt.h"
#include "htable.h"
-#include "hashing.h"
htable_t *htable_new(htable_t *h, size_t size)
{--- a/llt/htable.inc
+++ b/llt/htable.inc
@@ -22,7 +22,7 @@
hv = HFUNC((uintptr_t)key); \
retry_bp: \
iter = 0; \
- index = (index_t)(hv & (sz-1)) * 2; \
+ index = (hv & (sz-1)) * 2; \
sz *= 2; \
orig = index; \
\
@@ -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((uintptr_t)key) & (sz-1)) * 2; \
+ size_t index = (HFUNC((uintptr_t)key) & (sz-1)) * 2; \
sz *= 2; \
size_t orig = index; \
size_t iter = 0; \
--- a/llt/ieee754.h
+++ b/llt/ieee754.h
@@ -9,11 +9,12 @@
unsigned int negative:1;
unsigned int exponent:8;
unsigned int mantissa:23;
-#endif
-#if BYTE_ORDER == LITTLE_ENDIAN
+#elif BYTE_ORDER == LITTLE_ENDIAN
unsigned int mantissa:23;
unsigned int exponent:8;
unsigned int negative:1;
+#else
+#error which endian?
#endif
} ieee;
};
@@ -29,8 +30,7 @@
unsigned int exponent:11;
unsigned int mantissa0:20;
unsigned int mantissa1:32;
-#endif
-#if BYTE_ORDER == LITTLE_ENDIAN
+#elif BYTE_ORDER == LITTLE_ENDIAN
unsigned int mantissa1:32;
unsigned int mantissa0:20;
unsigned int exponent:11;
@@ -51,13 +51,14 @@
unsigned int empty:16;
unsigned int mantissa0:32;
unsigned int mantissa1:32;
-#endif
-#if BYTE_ORDER == LITTLE_ENDIAN
+#elif BYTE_ORDER == LITTLE_ENDIAN
unsigned int mantissa1:32;
unsigned int mantissa0:32;
unsigned int exponent:15;
unsigned int negative:1;
unsigned int empty:16;
+#else
+#error which endian?
#endif
} ieee;
};
--- a/llt/int2str.c
+++ b/llt/int2str.c
@@ -1,11 +1,4 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#endif
-#include "dtypes.h"
-#include "utils.h"
+#include "llt.h"
char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base)
{--- a/llt/ios.c
+++ b/llt/ios.c
@@ -1,49 +1,10 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-static int errno;
-enum {- SEEK_SET,
- SEEK_CUR,
- SEEK_END,
+#include "llt.h"
- STDIN_FILENO = 0,
- STDOUT_FILENO,
- STDERR_FILENO,
-};
-#define lseek seek
-#define O_RDWR ORDWR
-#define O_WRONLY OWRITE
-#define O_RDONLY OREAD
-#define O_TRUNC OTRUNC
-#else
-#include <stdlib.h>
-#include <stdarg.h>
-#include <string.h>
-#include <assert.h>
-#include <limits.h>
-#include <errno.h>
-#include <wchar.h>
-#include <stdio.h> // for printf
-#include <unistd.h>
-#include <sys/time.h>
-#include <sys/select.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-#endif
-
-#include "dtypes.h"
-#include "utils.h"
-#include "utf8.h"
-#include "ios.h"
-#include "timefuncs.h"
-
#define MOST_OF(x) ((x) - ((x)>>4))
/* OS-level primitive wrappers */
-#if defined(PLAN9)
-void *memrchr(const void *s, int c, size_t n)
+void *llt_memrchr(const void *s, int c, size_t n)
{const uint8_t *src = (const uint8_t*)s + n;
uint8_t uc = c;
@@ -52,11 +13,8 @@
return (void *) src;
return NULL;
}
-#else
-extern void *memrchr(const void *s, int c, size_t n);
-#endif
-#ifndef PLAN9
+#if !defined(__plan9__)
static int _enonfatal(int err)
{return (err == EAGAIN || err == EINPROGRESS || err == EINTR ||
@@ -77,7 +35,7 @@
*nread = (size_t)r;
break;
}
-#ifdef PLAN9
+#if defined(__plan9__)
return r;
#else
if (!_enonfatal(errno)) {@@ -117,7 +75,7 @@
*nwritten = (size_t)r;
break;
}
-#ifdef PLAN9
+#if defined(__plan9__)
return r;
#else
if (!_enonfatal(errno)) {@@ -365,7 +323,7 @@
else if (n <= space) { if (s->bm == bm_line) {char *nl;
- if ((nl=(char*)memrchr(data, '\n', n)) != NULL) {+ if ((nl=llt_memrchr(data, '\n', n)) != NULL) {size_t linesz = nl-data+1;
s->bm = bm_block;
wrote += ios_write(s, data, linesz);
@@ -650,7 +608,7 @@
s->readonly = 1;
}
-static size_t ios_copy_(ios_t *to, ios_t *from, size_t nbytes, bool_t all)
+static size_t ios_copy_(ios_t *to, ios_t *from, size_t nbytes, int all)
{size_t total = 0, avail;
if (!ios_eof(from)) {@@ -752,11 +710,8 @@
goto open_file_err;
int flags = wr ? (rd ? O_RDWR : O_WRONLY) : O_RDONLY;
if (trunc) flags |= O_TRUNC;
-#ifdef PLAN9
- if (creat)
- fd = create(fname, flags, 0644);
- else
- fd = open(fname, flags);
+#if defined(__plan9__)
+ fd = creat ? create(fname, flags, 0644) : open(fname, flags);
#else
if (creat) flags |= O_CREAT;
fd = open(fname, flags, 0644);
@@ -970,7 +925,17 @@
{char *str;
int c;
-#ifndef PLAN9
+
+#if defined(__plan9__)
+ // FIXME: this is wrong
+ str = vsmprint(format, args);
+ c = strlen(str);
+ if (c >= 0) {+ ios_write(s, str, c);
+ free(str);
+ }
+ va_end(args);
+#else
va_list al;
va_copy(al, args);
@@ -986,7 +951,7 @@
s->bpos += (size_t)c;
_write_update_pos(s);
// TODO: only works right if newline is at end
- if (s->bm == bm_line && memrchr(start, '\n', (size_t)c))
+ if (s->bm == bm_line && llt_memrchr(start, '\n', (size_t)c))
ios_flush(s);
va_end(al);
return c;
@@ -993,20 +958,11 @@
}
}
c = vasprintf(&str, format, al);
-#else
- str = vsmprint(format, args);
- c = strlen(str);
-#endif
-
if (c >= 0) {ios_write(s, str, c);
-
LLT_FREE(str);
}
-#ifndef PLAN9
va_end(al);
-#else
- va_end(args);
#endif
return c;
}
--- a/llt/ios.h
+++ b/llt/ios.h
@@ -1,10 +1,3 @@
-#ifndef __IOS_H_
-#define __IOS_H_
-
-#ifndef PLAN9
-#include <stdarg.h>
-#endif
-
// 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.
@@ -100,7 +93,7 @@
int ios_putnum(ios_t *s, char *data, uint32_t type);
int ios_putint(ios_t *s, int n);
int ios_pututf8(ios_t *s, uint32_t wc);
-int ios_putstringz(ios_t *s, char *str, bool_t do_write_nulterm);
+int ios_putstringz(ios_t *s, char *str, int do_write_nulterm);
int ios_printf(ios_t *s, const char *format, ...);
int ios_vprintf(ios_t *s, const char *format, va_list args);
@@ -203,5 +196,3 @@
as optimizations, we do no writing if the buffer isn't "dirty", and we
do no reading if the data will only be overwritten.
*/
-
-#endif
--- a/llt/llt.h
+++ b/llt/llt.h
@@ -1,20 +1,111 @@
#ifndef __LLT_H_
#define __LLT_H_
-#ifndef PLAN9
-#include <stdarg.h>
-#endif
-#include "dtypes.h"
-#include "utils.h"
+#include "platform.h"
#include "utf8.h"
#include "ios.h"
-#include "socket.h"
-#include "timefuncs.h"
-#include "hashing.h"
-#include "ptrhash.h"
#include "bitvector.h"
-#include "dirpath.h"
-#include "random.h"
+
+#include "htableh.inc"
+HTPROT(ptrhash)
+
+#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
+
+#ifdef BOEHM_GC /* boehm GC allocator */
+#include <gc.h>
+#define LLT_ALLOC(n) GC_MALLOC(n)
+#define LLT_REALLOC(p,n) GC_REALLOC((p),(n))
+#define LLT_FREE(x) USED(x)
+#else /* standard allocator */
+#define LLT_ALLOC(n) malloc(n)
+#define LLT_REALLOC(p,n) realloc((p),(n))
+#define LLT_FREE(x) free(x)
+#endif
+
+#define bswap_16(x) (((x) & 0x00ff) << 8 | ((x) & 0xff00) >> 8)
+#define bswap_32(x) \
+ ((((x) & 0xff000000) >> 24) | (((x) & 0x00ff0000) >> 8) | \
+ (((x) & 0x0000ff00) << 8) | (((x) & 0x000000ff) << 24))
+#define bswap_64(x) \
+ (uint64_t)bswap_32((x) & 0xffffffffULL)<<32 | \
+ (uint64_t)bswap_32(((x)>>32) & 0xffffffffULL)
+
+#define DBL_MAXINT 9007199254740992LL
+#define FLT_MAXINT 16777216
+#define BIT63 0x8000000000000000ULL
+#define BIT31 0x80000000UL
+
+#ifdef BITS64
+#define NBITS 64
+#define TOP_BIT BIT63
+typedef uint64_t uint_t;
+typedef int64_t int_t;
+#else
+#define NBITS 32
+#define TOP_BIT BIT31
+typedef uint32_t uint_t;
+typedef int32_t int_t;
+#endif
+
+#define LOG2_10 3.3219280948873626
+#define rel_zero(a, b) (fabs((a)/(b)) < DBL_EPSILON)
+#define sign_bit(r) ((*(uint64_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) (((*(uint64_t*)&(d))&0x7ff0000000000000ULL)!=0x7ff0000000000000ULL)
+#define LLT_ALIGN(x, sz) (((x) + (sz-1)) & (-sz))
+
+// a mask with n set lo or hi bits
+#define lomask(n) (uint32_t)((((uint32_t)1)<<(n))-1)
+
+extern double D_PNAN, D_NNAN, D_PINF, D_NINF;
+extern float F_PNAN, F_NNAN, F_PINF, F_NINF;
+
+/* timefuncs.c */
+uint64_t i64time(void);
+double clock_now(void);
+void timestring(double seconds, char *buffer, size_t len);
+double parsetime(const char *str);
+void sleep_ms(int ms);
+
+/* hashing.c */
+uint_t nextipow2(uint_t i);
+uint32_t int32hash(uint32_t a);
+uint64_t int64hash(uint64_t key);
+uint32_t int64to32hash(uint64_t key);
+uint64_t memhash(const char* buf, size_t n);
+uint32_t memhash32(const char* buf, size_t n);
+
+/* dirpath.c */
+void get_cwd(char *buf, size_t size);
+int set_cwd(char *buf);
+char *get_exename(char *buf, size_t size);
+void path_to_dirname(char *path);
+
+/* random.c */
+#define random() genrand_int32()
+#define srandom(n) init_genrand(n)
+double rand_double(void);
+float rand_float(void);
+double randn(void);
+void randomize(void);
+uint32_t genrand_int32(void);
+void init_genrand(uint32_t s);
+uint64_t i64time(void);
+
+/* utils.c */
+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);
+
+/* wcwidth.c */
+int llt_wcwidth(uint32_t ucs);
void llt_init(void);
--- a/llt/lltinit.c
+++ b/llt/lltinit.c
@@ -1,18 +1,4 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <math.h>
-#include <locale.h>
-#endif
-#include "dtypes.h"
-#include "timefuncs.h"
-#include "ios.h"
-#include "random.h"
-#include "utf8.h"
+#include "llt.h"
double D_PNAN;
double D_NNAN;
@@ -33,7 +19,7 @@
D_NNAN = strtod("-NaN",NULL); D_PINF = strtod("+Inf",NULL); D_NINF = strtod("-Inf",NULL);-#ifdef PLAN9
+#if defined(__plan9__)
u32int x;
x = 0x7fc00000; memcpy(&F_PNAN, &x, 4);
x = 0xffc00000; memcpy(&F_NNAN, &x, 4);
--- a/llt/lookup3.c
+++ b/llt/lookup3.c
@@ -35,13 +35,6 @@
*/
//#define SELF_TEST 1
-#ifndef PLAN9
-#include <stdio.h> /* defines printf for tests */
-#include <stdint.h> /* defines uint32_t etc */
-#include <sys/param.h> /* attempt to define endianness */
-#include <endian.h> /* attempt to define endianness */
-#endif
-
/*
* My best guess at if you are big-endian or little-endian. This may
* need adjustment.
--- a/llt/mkfile
+++ b/llt/mkfile
@@ -1,7 +1,7 @@
</$objtype/mkfile
LIB=libllt.$O.a
-CFLAGS=$CFLAGS -p -DPLAN9 -DNDEBUG -D__${objtype}__+CFLAGS=$CFLAGS -p -I../plan9 -D__plan9__ -D__${objtype}__OFILES=\
bitvector-ops.$O\
@@ -18,21 +18,15 @@
socketp9.$O\
timefuncs.$O\
utf8.$O\
+ wcwidth.$O\
HFILES=\
- bitvector.h\
- dirpath.h\
- dtypes.h\
- hashing.h\
- htable.h\
- ieee754.h\
- ios.h\
- llt.h\
- ptrhash.h\
- random.h\
- socket.h\
- timefuncs.h\
- utf8.h\
- utils.h\
+ ../plan9/platform.h\
+ bitvector.h\
+ htable.h\
+ ieee754.h\
+ ios.h\
+ llt.h\
+ utf8.h\
</sys/src/cmd/mklib
--- a/llt/mt19937ar.c
+++ b/llt/mt19937ar.c
@@ -41,12 +41,6 @@
email: m-mat @ math.sci.hiroshima-u.ac.jp (remove space)
*/
-#ifndef PLAN9
-#include <stdio.h>
-#endif
-
-#include "dtypes.h"
-
/* Period parameters */
#define mtN 624
#define mtM 397
--- a/llt/ptrhash.c
+++ b/llt/ptrhash.c
@@ -3,19 +3,7 @@
optimized for storing info about particular values
*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <assert.h>
-#include <limits.h>
-#endif
-
-#include "dtypes.h"
-#include "ptrhash.h"
+#include "llt.h"
#define OP_EQ(x,y) ((x)==(y))
--- a/llt/ptrhash.h
+++ /dev/null
@@ -1,8 +1,0 @@
-#ifndef __PTRHASH_H_
-#define __PTRHASH_H_
-
-#include "htableh.inc"
-
-HTPROT(ptrhash)
-
-#endif
--- a/llt/random.c
+++ b/llt/random.c
@@ -1,19 +1,8 @@
/*
random numbers
*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#endif
-#include "dtypes.h"
+#include "llt.h"
#include "ieee754.h"
-#include "utils.h"
-#include "random.h"
-#include "timefuncs.h"
#include "mt19937ar.c"
--- a/llt/random.h
+++ /dev/null
@@ -1,14 +1,0 @@
-#ifndef __LLTRANDOM_H_
-#define __LLTRANDOM_H_
-
-#define random() genrand_int32()
-#define srandom(n) init_genrand(n)
-double rand_double(void);
-float rand_float(void);
-double randn(void);
-void randomize(void);
-uint32_t genrand_int32(void);
-void init_genrand(uint32_t s);
-uint64_t i64time(void);
-
-#endif
--- a/llt/socket.c
+++ b/llt/socket.c
@@ -1,15 +1,12 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
+#include "platform.h"
#include <unistd.h>
-#include <assert.h>
-#include <errno.h>
+#include <fcntl.h>
#include <sys/time.h>
#include <sys/select.h>
#include <sys/types.h>
-
-#include "dtypes.h"
-#include "socket.h"
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
int mysocket(int domain, int type, int protocol)
{--- a/llt/socket.h
+++ /dev/null
@@ -1,23 +1,0 @@
-#ifndef __LLTSOCKET_H_
-#define __LLTSOCKET_H_
-
-#ifndef PLAN9
-#include <netinet/in.h>
-#include <netdb.h>
-#include <sys/types.h>
-#include <sys/socket.h>
-#include <fcntl.h>
-#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 connect_to_addr(struct sockaddr_in *host_addr);
-int sendall(int sockfd, char *buffer, int bufLen, int flags);
-int readall(int sockfd, char *buffer, int bufLen, int flags);
-int addr_eq(struct sockaddr_in *a, struct sockaddr_in *b);
-int socket_ready(int sock);
-void closesocket(int fd);
-
-#endif
--- a/llt/timefuncs.c
+++ b/llt/timefuncs.c
@@ -1,25 +1,6 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <time.h>
-#include <assert.h>
-#include <errno.h>
-#include <limits.h>
-#include <sys/stat.h>
-#include <sys/types.h>
-#include <sys/time.h>
-#include <sys/poll.h>
-#include <unistd.h>
-#endif
+#include "platform.h"
-#include "dtypes.h"
-#include "timefuncs.h"
-
-#if defined(PLAN9)
+#if defined(__plan9__)
double floattime(void)
{return (double)nsec() / 1.0e9;
@@ -40,7 +21,7 @@
uint64_t i64time(void)
{uint64_t a;
-#if defined(PLAN9)
+#if defined(__plan9__)
a = nsec();
#else
struct timeval now;
@@ -53,7 +34,7 @@
double clock_now(void)
{-#if defined(PLAN9)
+#if defined(__plan9__)
return floattime();
#else
struct timeval now;
@@ -65,10 +46,10 @@
void timestring(double seconds, char *buffer, size_t len)
{-#ifdef PLAN9
+#if defined(__plan9__)
Tm tm;
snprint(buffer, len, "%τ", tmfmt(tmtime(&tm, seconds, tzload("local")), nil));-#elif defined(LINUX) || defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD)
+#else
time_t tme = (time_t)seconds;
char *fmt = "%c"; /* needed to suppress GCC warning */
@@ -76,30 +57,22 @@
localtime_r(&tme, &tm);
strftime(buffer, len, fmt, &tm);
-#else
- time_t tme = (time_t)seconds;
-
- static char *wdaystr[] = {"Sun","Mon","Tue","Wed","Thu","Fri","Sat"};- static char *monthstr[] = {"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug",- "Sep","Oct","Nov","Dec"};
- struct tm *tm;
- int hr;
-
- tm = localtime(&tme);
- hr = tm->tm_hour;
- if (hr > 12) hr -= 12;
- if (hr == 0) hr = 12;
- snprintf(buffer, len, "%s %02d %s %d %02d:%02d:%02d %s %s",
- wdaystr[tm->tm_wday], tm->tm_mday, monthstr[tm->tm_mon],
- tm->tm_year+1900, hr, tm->tm_min, tm->tm_sec,
- tm->tm_hour>11 ? "PM" : "AM", "");
#endif
}
-#if defined(LINUX) || defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD)
-extern char *strptime(const char *s, const char *format, struct tm *tm);
+#if defined(__plan9__)
double parsetime(const char *str)
{+ Tm tm;
+
+ if (tmparse(&tm, "?WWW, ?MM ?DD hh:mm:ss ?Z YYYY", str, tzload("local"), nil) == nil)+ return -1;
+
+ return tmnorm(&tm);
+}
+#else
+double parsetime(const char *str)
+{char *fmt = "%c"; /* needed to suppress GCC warning */
char *res;
time_t t;
@@ -116,18 +89,6 @@
}
return -1;
}
-#elif defined(PLAN9)
-double parsetime(const char *str)
-{- Tm tm;
-
- if (tmparse(&tm, "?WWW, ?MM ?DD hh:mm:ss ?Z YYYY", str, tzload("local"), nil) == nil)- return -1;
-
- return tmnorm(&tm);
-}
-#else
-// TODO
#endif
void sleep_ms(int ms)
@@ -135,7 +96,7 @@
if (ms == 0)
return;
-#if defined(PLAN9)
+#if defined(__plan9__)
sleep(ms);
#else
struct timeval timeout;
--- a/llt/timefuncs.h
+++ /dev/null
@@ -1,10 +1,0 @@
-#ifndef __TIMEFUNCS_H_
-#define __TIMEFUNCS_H_
-
-uint64_t i64time(void);
-double clock_now(void);
-void timestring(double seconds, char *buffer, size_t len);
-double parsetime(const char *str);
-void sleep_ms(int ms);
-
-#endif
--- a/llt/utf8.c
+++ b/llt/utf8.c
@@ -12,35 +12,8 @@
valid.
A UTF-8 validation routine is included.
*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#define snprintf snprint
-#define vsnprintf vsnprint
-// iswprint straight from musl
-int
-iswprint(u32int c)
-{- if(c < 0xff)
- return (c+1 & 0x7f) >= 0x21;
- if(c < 0x2028 || c-0x202a < 0xd800-0x202a || c-0xe000 < 0xfff9-0xe000)
- return 1;
- return !(c-0xfffc > 0x10ffff-0xfffc || (c&0xfffe) == 0xfffe);
-}
-#else
-#define _XOPEN_SOURCE 700
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <stdarg.h>
-#include <wchar.h>
-#include <wctype.h>
-#include <assert.h>
-#endif
-#include "dtypes.h"
-#include "utf8.h"
+#include "llt.h"
static const uint32_t offsetsFromUTF8[6] = {0x00000000UL, 0x00003080UL, 0x000E2080UL,
@@ -58,6 +31,17 @@
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5
};
+// straight from musl
+int
+u8_iswprint(uint32_t c)
+{+ if(c < 0xff)
+ return (c+1 & 0x7f) >= 0x21;
+ if(c < 0x2028 || c-0x202a < 0xd800-0x202a || c-0xe000 < 0xfff9-0xe000)
+ return 1;
+ return !(c-0xfffc > 0x10ffff-0xfffc || (c&0xfffe) == 0xfffe);
+}
+
/* returns length of next utf-8 sequence */
size_t u8_seqlen(const char *s)
{@@ -250,10 +234,6 @@
return count;
}
-#if defined(PLAN9)
-#include "wcwidth.c"
-#endif
-
size_t u8_strwidth(const char *s)
{uint32_t ch;
@@ -279,7 +259,7 @@
case 0: ch += (uint8_t)*s++;
}
ch -= offsetsFromUTF8[nb];
- w = wcwidth(ch); // might return -1
+ w = llt_wcwidth(ch); // might return -1
if (w > 0) tot += w;
}
}
@@ -484,7 +464,7 @@
else {i0 = i;
ch = u8_nextmemchar(src, &i);
- if (ascii || !iswprint(ch)) {+ if (ascii || !u8_iswprint(ch)) {buf += u8_escape_wchar(buf, sz - (buf-start), ch);
}
else {@@ -587,7 +567,7 @@
wcs = (uint32_t*)malloc((cnt+1) * sizeof(uint32_t));
nc = u8_toucs(wcs, cnt+1, buf, cnt);
wcs[nc] = 0;
-#ifdef PLAN9
+#if defined(__plan9__)
print("%S", (Rune*)wcs);#else
printf("%ls", (wchar_t*)wcs);--- a/llt/utf8.h
+++ b/llt/utf8.h
@@ -4,7 +4,7 @@
/* is c the start of a utf8 sequence? */
#define isutf(c) (((c)&0xC0)!=0x80)
-#define UEOF ((uint32_t)-1)
+int u8_iswprint(uint32_t c);
/* convert UTF-8 data to wide character */
size_t u8_toucs(uint32_t *dest, size_t sz, const char *src, size_t srcsz);
--- a/llt/utils.h
+++ /dev/null
@@ -1,116 +1,0 @@
-#ifndef __UTILS_H_
-#define __UTILS_H_
-
-
-#if defined( __amd64__ ) || defined( _M_AMD64 )
-# define ARCH_X86_64
-# define __CPU__ 686
-#elif defined( _M_IX86 )//msvs, intel, digital mars, watcom
-# if ! defined( __386__ )
-# error "unsupported target: 16-bit x86"
-# endif
-# define ARCH_X86
-# define __CPU__ ( _M_IX86 + 86 )
-#elif defined( __i686__ )//gnu c
-# define ARCH_X86
-# define __CPU__ 686
-#elif defined( __i586__ )//gnu c
-# define ARCH_X86
-# define __CPU__ 586
-#elif defined( __i486__ )//gnu c
-# define ARCH_X86
-# define __CPU__ 486
-#elif defined( __i386__ )//gnu c
-# define ARCH_X86
-# define __CPU__ 386
-#elif defined( __arm64__ )
-# define ARCH_ARM64
-# define __CPU__ arm64
-#else
-# error "unknown architecture"
-#endif
-
-
-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);
-
-#if defined(ARCH_X86_64) || defined(ARCH_ARM64)
-# define LEGACY_REGS "=Q"
-#else
-# define LEGACY_REGS "=q"
-#endif
-
-#if !defined(PLAN9) && !defined(__INTEL_COMPILER) && (defined(ARCH_X86) || defined(ARCH_X86_64))
-STATIC_INLINE uint16_t ByteSwap16(uint16_t x)
-{- __asm("xchgb %b0,%h0" :- LEGACY_REGS (x) :
- "0" (x));
- return x;
-}
-#define bswap_16(x) ByteSwap16(x)
-
-STATIC_INLINE uint32_t ByteSwap32(uint32_t x)
-{-#if __CPU__ > 386
- __asm("bswap %0":- "=r" (x) :
-#else
- __asm("xchgb %b0,%h0\n"\- " rorl $16,%0\n"
- " xchgb %b0,%h0":
- LEGACY_REGS (x) :
-#endif
- "0" (x));
- return x;
-}
-
-#define bswap_32(x) ByteSwap32(x)
-
-STATIC_INLINE uint64_t ByteSwap64(uint64_t x)
-{-#ifdef ARCH_X86_64
- __asm("bswap %0":- "=r" (x) :
- "0" (x));
- return x;
-#else
- register union { __extension__ uint64_t __ll;- uint32_t __l[2]; } __x;
- asm("xchgl %0,%1":- "=r"(__x.__l[0]),"=r"(__x.__l[1]):
- "0"(bswap_32((unsigned long)x)),"1"(bswap_32((unsigned long)(x>>32))));
- return __x.__ll;
-#endif
-}
-#define bswap_64(x) ByteSwap64(x)
-
-#else
-
-#define bswap_16(x) (((x) & 0x00ff) << 8 | ((x) & 0xff00) >> 8)
-
-#ifdef __INTEL_COMPILER
-#define bswap_32(x) _bswap(x)
-#else
-#define bswap_32(x) \
- ((((x) & 0xff000000) >> 24) | (((x) & 0x00ff0000) >> 8) | \
- (((x) & 0x0000ff00) << 8) | (((x) & 0x000000ff) << 24))
-#endif
-
-STATIC_INLINE uint64_t ByteSwap64(uint64_t x)
-{- union { - uint64_t ll;
- uint32_t l[2];
- } w, r;
- w.ll = x;
- r.l[0] = bswap_32 (w.l[1]);
- r.l[1] = bswap_32 (w.l[0]);
- return r.ll;
-}
-#define bswap_64(x) ByteSwap64(x)
-
-#endif
-
-#endif
--- a/llt/wcwidth.c
+++ b/llt/wcwidth.c
@@ -61,11 +61,7 @@
* MODIFIED TO USE uint32_t
*/
-#ifndef PLAN9
-#include <stdint.h>
-#include <stddef.h>
-#include "dtypes.h" //for DLLEXPORT
-#endif
+#include "llt.h"
struct interval {int first;
@@ -77,13 +73,13 @@
int min = 0;
int mid;
- if (ucs < table[0].first || ucs > table[max].last)
+ if (ucs < (uint32_t)table[0].first || ucs > (uint32_t)table[max].last)
return 0;
while (max >= min) {mid = (min + max) / 2;
- if (ucs > table[mid].last)
+ if (ucs > (uint32_t)table[mid].last)
min = mid + 1;
- else if (ucs < table[mid].first)
+ else if (ucs < (uint32_t)table[mid].first)
max = mid - 1;
else
return 1;
@@ -124,7 +120,7 @@
* in ISO 10646.
*/
-DLLEXPORT int wcwidth(uint32_t ucs)
+int llt_wcwidth(uint32_t ucs)
{/* sorted list of non-overlapping intervals of non-spacing characters */
/* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */
@@ -206,109 +202,4 @@
(ucs >= 0xffe0 && ucs <= 0xffe6) ||
(ucs >= 0x20000 && ucs <= 0x2fffd) ||
(ucs >= 0x30000 && ucs <= 0x3fffd)));
-}
-
-
-int wcswidth(const uint32_t *pwcs, size_t n)
-{- int w, width = 0;
-
- for (;*pwcs && n-- > 0; pwcs++)
- if ((w = wcwidth(*pwcs)) < 0)
- return -1;
- else
- width += w;
-
- return width;
-}
-
-
-/*
- * The following functions are the same as wcwidth() and
- * wcswidth(), except that spacing characters in the East Asian
- * Ambiguous (A) category as defined in Unicode Technical Report #11
- * have a column width of 2. This variant might be useful for users of
- * CJK legacy encodings who want to migrate to UCS without changing
- * the traditional terminal character-width behaviour. It is not
- * otherwise recommended for general use.
- */
-int wcwidth_cjk(uint32_t ucs)
-{- /* sorted list of non-overlapping intervals of East Asian Ambiguous
- * characters, generated by "uniset +WIDTH-A -cat=Me -cat=Mn -cat=Cf c" */
- static const struct interval ambiguous[] = {- { 0x00A1, 0x00A1 }, { 0x00A4, 0x00A4 }, { 0x00A7, 0x00A8 },- { 0x00AA, 0x00AA }, { 0x00AE, 0x00AE }, { 0x00B0, 0x00B4 },- { 0x00B6, 0x00BA }, { 0x00BC, 0x00BF }, { 0x00C6, 0x00C6 },- { 0x00D0, 0x00D0 }, { 0x00D7, 0x00D8 }, { 0x00DE, 0x00E1 },- { 0x00E6, 0x00E6 }, { 0x00E8, 0x00EA }, { 0x00EC, 0x00ED },- { 0x00F0, 0x00F0 }, { 0x00F2, 0x00F3 }, { 0x00F7, 0x00FA },- { 0x00FC, 0x00FC }, { 0x00FE, 0x00FE }, { 0x0101, 0x0101 },- { 0x0111, 0x0111 }, { 0x0113, 0x0113 }, { 0x011B, 0x011B },- { 0x0126, 0x0127 }, { 0x012B, 0x012B }, { 0x0131, 0x0133 },- { 0x0138, 0x0138 }, { 0x013F, 0x0142 }, { 0x0144, 0x0144 },- { 0x0148, 0x014B }, { 0x014D, 0x014D }, { 0x0152, 0x0153 },- { 0x0166, 0x0167 }, { 0x016B, 0x016B }, { 0x01CE, 0x01CE },- { 0x01D0, 0x01D0 }, { 0x01D2, 0x01D2 }, { 0x01D4, 0x01D4 },- { 0x01D6, 0x01D6 }, { 0x01D8, 0x01D8 }, { 0x01DA, 0x01DA },- { 0x01DC, 0x01DC }, { 0x0251, 0x0251 }, { 0x0261, 0x0261 },- { 0x02C4, 0x02C4 }, { 0x02C7, 0x02C7 }, { 0x02C9, 0x02CB },- { 0x02CD, 0x02CD }, { 0x02D0, 0x02D0 }, { 0x02D8, 0x02DB },- { 0x02DD, 0x02DD }, { 0x02DF, 0x02DF }, { 0x0391, 0x03A1 },- { 0x03A3, 0x03A9 }, { 0x03B1, 0x03C1 }, { 0x03C3, 0x03C9 },- { 0x0401, 0x0401 }, { 0x0410, 0x044F }, { 0x0451, 0x0451 },- { 0x2010, 0x2010 }, { 0x2013, 0x2016 }, { 0x2018, 0x2019 },- { 0x201C, 0x201D }, { 0x2020, 0x2022 }, { 0x2024, 0x2027 },- { 0x2030, 0x2030 }, { 0x2032, 0x2033 }, { 0x2035, 0x2035 },- { 0x203B, 0x203B }, { 0x203E, 0x203E }, { 0x2074, 0x2074 },- { 0x207F, 0x207F }, { 0x2081, 0x2084 }, { 0x20AC, 0x20AC },- { 0x2103, 0x2103 }, { 0x2105, 0x2105 }, { 0x2109, 0x2109 },- { 0x2113, 0x2113 }, { 0x2116, 0x2116 }, { 0x2121, 0x2122 },- { 0x2126, 0x2126 }, { 0x212B, 0x212B }, { 0x2153, 0x2154 },- { 0x215B, 0x215E }, { 0x2160, 0x216B }, { 0x2170, 0x2179 },- { 0x2190, 0x2199 }, { 0x21B8, 0x21B9 }, { 0x21D2, 0x21D2 },- { 0x21D4, 0x21D4 }, { 0x21E7, 0x21E7 }, { 0x2200, 0x2200 },- { 0x2202, 0x2203 }, { 0x2207, 0x2208 }, { 0x220B, 0x220B },- { 0x220F, 0x220F }, { 0x2211, 0x2211 }, { 0x2215, 0x2215 },- { 0x221A, 0x221A }, { 0x221D, 0x2220 }, { 0x2223, 0x2223 },- { 0x2225, 0x2225 }, { 0x2227, 0x222C }, { 0x222E, 0x222E },- { 0x2234, 0x2237 }, { 0x223C, 0x223D }, { 0x2248, 0x2248 },- { 0x224C, 0x224C }, { 0x2252, 0x2252 }, { 0x2260, 0x2261 },- { 0x2264, 0x2267 }, { 0x226A, 0x226B }, { 0x226E, 0x226F },- { 0x2282, 0x2283 }, { 0x2286, 0x2287 }, { 0x2295, 0x2295 },- { 0x2299, 0x2299 }, { 0x22A5, 0x22A5 }, { 0x22BF, 0x22BF },- { 0x2312, 0x2312 }, { 0x2460, 0x24E9 }, { 0x24EB, 0x254B },- { 0x2550, 0x2573 }, { 0x2580, 0x258F }, { 0x2592, 0x2595 },- { 0x25A0, 0x25A1 }, { 0x25A3, 0x25A9 }, { 0x25B2, 0x25B3 },- { 0x25B6, 0x25B7 }, { 0x25BC, 0x25BD }, { 0x25C0, 0x25C1 },- { 0x25C6, 0x25C8 }, { 0x25CB, 0x25CB }, { 0x25CE, 0x25D1 },- { 0x25E2, 0x25E5 }, { 0x25EF, 0x25EF }, { 0x2605, 0x2606 },- { 0x2609, 0x2609 }, { 0x260E, 0x260F }, { 0x2614, 0x2615 },- { 0x261C, 0x261C }, { 0x261E, 0x261E }, { 0x2640, 0x2640 },- { 0x2642, 0x2642 }, { 0x2660, 0x2661 }, { 0x2663, 0x2665 },- { 0x2667, 0x266A }, { 0x266C, 0x266D }, { 0x266F, 0x266F },- { 0x273D, 0x273D }, { 0x2776, 0x277F }, { 0xE000, 0xF8FF },- { 0xFFFD, 0xFFFD }, { 0xF0000, 0xFFFFD }, { 0x100000, 0x10FFFD }- };
-
- /* binary search in table of non-spacing characters */
- if (bisearch(ucs, ambiguous,
- sizeof(ambiguous) / sizeof(struct interval) - 1))
- return 2;
-
- return wcwidth(ucs);
-}
-
-
-int wcswidth_cjk(const uint32_t *pwcs, size_t n)
-{- int w, width = 0;
-
- for (;*pwcs && n-- > 0; pwcs++)
- if ((w = wcwidth_cjk(*pwcs)) < 0)
- return -1;
- else
- width += w;
-
- return width;
}
--- a/mkfile
+++ b/mkfile
@@ -2,7 +2,7 @@
BIN=/$objtype/bin
TARG=flisp
-CFLAGS=$CFLAGS -p -DPLAN9 -DNDEBUG -D__${objtype}__ -Illt+CFLAGS=$CFLAGS -p -D__plan9__ -D__${objtype}__ -Iplan9 -IlltHFILES=\
cvalues.c\
--- a/opaque_type_template.c
+++ b/opaque_type_template.c
@@ -1,14 +1,3 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <string.h>
-#include <assert.h>
-#include <sys/types.h>
-#endif
#include "llt.h"
#include "flisp.h"
--- a/operators.c
+++ b/operators.c
@@ -1,24 +1,15 @@
-#include "dtypes.h"
-#include "utils.h"
+#include "llt.h"
#include "ieee754.h"
-#ifdef PLAN9
+#if defined(__plan9__)
double trunc(double x)
{modf(x, &x);
return x;
}
-STATIC_INLINE double fpart(double arg)
-{- return modf(arg, NULL);
-}
-#define isnan(x) isNaN(x)
+#define fpart(x) modf(x, nil)
#else
-extern double trunc(double x);
-STATIC_INLINE double fpart(double arg)
-{- return arg - trunc(arg);
-}
+#define fpart(x) ((x) - trunc(x))
#endif
// given a number, determine an appropriate type for storing it
@@ -28,7 +19,7 @@
double fp;
fp = fpart(r);
- if (fp != 0 || r > U64_MAX || r < S64_MIN) {+ if (fp != 0 || r > UINT64_MAX || r < INT64_MIN) { if (r > FLT_MAX || r < -FLT_MAX || (fabs(r) < FLT_MIN)) {return T_DOUBLE;
}
@@ -45,7 +36,7 @@
else if (r >= INT_MIN && r <= INT_MAX) {return T_INT32;
}
- else if (r <= S64_MAX) {+ else if (r <= INT64_MAX) {return T_INT64;
}
return T_UINT64;
@@ -57,13 +48,13 @@
double fp;
fp = fpart(r);
- if (fp != 0 || r > (double)S64_MAX || r < S64_MIN) {+ if (fp != 0 || r > (double)INT64_MAX || r < INT64_MIN) {return T_DOUBLE;
}
else if (r >= INT_MIN && r <= INT_MAX) {return T_INT32;
}
- else if (r <= (double)S64_MAX) {+ else if (r <= (double)INT64_MAX) {return T_INT64;
}
return T_UINT64;
@@ -104,7 +95,7 @@
case T_INT64:
*(int64_t*)dest = d;
if (d > 0 && *(int64_t*)dest < 0) // 0x8000000000000000 is a bitch
- *(int64_t*)dest = S64_MAX;
+ *(int64_t*)dest = INT64_MAX;
break;
case T_UINT64: *(uint64_t*)dest = (int64_t)d; break;
case T_FLOAT: *(float*)dest = d; break;
@@ -273,7 +264,7 @@
return 0;
if (atag == T_UINT64) {- // this is safe because if a had been bigger than S64_MAX,
+ // this is safe because if a had been bigger than INT64_MAX,
// we would already have concluded that it's bigger than b.
if (btag == T_INT64) {return ((int64_t)*(uint64_t*)a == *(int64_t*)b);
--- /dev/null
+++ b/plan9/platform.h
@@ -1,0 +1,93 @@
+#include <u.h>
+#include <libc.h>
+#include <ctype.h>
+
+#if defined(__amd64__) || \
+ defined(__arm64__) || \
+ defined(__mips64__) || \
+ defined(__power64__) || \
+ defined(__sparc64__)
+#define BITS64
+#endif
+
+#define unsetenv(name) putenv(name, "")
+#define setenv(name, val, overwrite) putenv(name, val)
+#define exit(x) exits(x ? "error" : nil)
+#define isnan(x) isNaN(x)
+
+#define getcwd getwd
+#define vsnprintf vsnprint
+#define snprintf snprint
+#define strcasecmp cistrcmp
+#define lseek seek
+#define towupper toupperrune
+#define towlower tolowerrune
+#define iswalpha isalpharune
+#define sqrtf sqrt
+#define expf exp
+#define logf log
+#define sinf sin
+#define cosf cos
+#define tanf tan
+#define asinf asin
+#define acosf acos
+#define atanf atan
+
+#define __attribute__(...)
+#define LC_NUMERIC 0
+#define setlocale(x,y)
+
+#define NULL nil
+#define INT_MAX 0x7fffffff
+#define UINT_MAX 0xffffffffU
+#define INT_MIN (-INT_MAX-1)
+#define INT64_MIN ((int64_t)0x8000000000000000LL)
+#define INT64_MAX 0x7fffffffffffffffLL
+#define UINT64_MAX 0xffffffffffffffffULL
+
+#define PATHSEP '/'
+#define PATHSEPSTRING "/"
+#define PATHLISTSEP ':'
+#define PATHLISTSEPSTRING ":"
+#define ISPATHSEP(c) ((c)=='/')
+
+enum {+ SEEK_SET,
+ SEEK_CUR,
+ SEEK_END,
+
+ STDIN_FILENO = 0,
+ STDOUT_FILENO,
+ STDERR_FILENO,
+};
+
+#define O_RDWR ORDWR
+#define O_WRONLY OWRITE
+#define O_RDONLY OREAD
+#define O_TRUNC OTRUNC
+#define F_OK 0
+
+#define LITTLE_ENDIAN 1234
+#define BIG_ENDIAN 4321
+
+#if defined(__mips__) || \
+ defined(__power__) || defined(__power64__) || \
+ defined(__sparc__) || defined(__sparc64__)
+#define BYTE_ORDER BIG_ENDIAN
+#else
+#define BYTE_ORDER LITTLE_ENDIAN
+#endif
+
+typedef s8int int8_t;
+typedef s16int int16_t;
+typedef s32int int32_t;
+typedef s64int int64_t;
+typedef u8int uint8_t;
+typedef u16int uint16_t;
+typedef u32int uint32_t;
+typedef u64int uint64_t;
+typedef vlong off_t;
+typedef intptr intptr_t;
+typedef uintptr uintptr_t;
+typedef intptr ssize_t;
+typedef uintptr size_t;
--- /dev/null
+++ b/posix/platform.h
@@ -1,0 +1,41 @@
+#include <assert.h>
+#include <ctype.h>
+#include <endian.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <float.h>
+#include <limits.h>
+#include <locale.h>
+#include <math.h>
+#include <setjmp.h>
+#include <stdarg.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <time.h>
+#include <unistd.h>
+#include <wctype.h>
+
+#ifndef __SIZEOF_POINTER__
+#error pointer size unknown
+#elif __SIZEOF_POINTER__ == 8
+#define BITS64 1
+#define ULONG64 1
+#endif
+
+#define USED(x) ((void)(x))
+
+#define PATHSEP '/'
+#define PATHSEPSTRING "/"
+#define PATHLISTSEP ':'
+#define PATHLISTSEPSTRING ":"
+#define ISPATHSEP(c) ((c)=='/')
+
+#ifndef BYTE_ORDER
+#define LITTLE_ENDIAN __LITTLE_ENDIAN
+#define BIG_ENDIAN __BIG_ENDIAN
+#define BYTE_ORDER __BYTE_ORDER
+#endif
--- a/print.c
+++ b/print.c
@@ -1,7 +1,3 @@
-#ifdef PLAN9
-#define snprintf snprint
-int iswprint(u32int c);
-#endif
#include "ieee754.h"
extern void *memrchr(const void *s, int c, size_t n);
@@ -659,7 +655,7 @@
else if (wc == 0x1B) outsn("esc", f, 3); else if (wc == 's') outsn("space", f, 5); else if (wc == 0x7F) outsn("delete", f, 6);- else if (iswprint(wc)) outs(seq, f);
+ else if (u8_iswprint(wc)) outs(seq, f);
else HPOS+=ios_printf(f, "x%04x", (int)wc);
}
}
--- a/read.c
+++ b/read.c
@@ -1,10 +1,3 @@
-#ifdef PLAN9
-#define strcasecmp cistrcmp
-#define ERANGE (-999)
-static int errno;
-#include <ctype.h>
-#endif
-
enum {TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,
TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT,
@@ -67,17 +60,27 @@
if (pval) *pval = mk_double(D_NINF);
return 1;
}
+#if defined(__plan9__)
+ // FIXME use libmp?
+ i64 = strtoll(tok, &end, base);
+#else
errno = 0;
i64 = strtoll(tok, &end, base);
if (errno)
return 0;
+#endif
if (pval) *pval = return_from_int64(i64);
return (*end == '\0');
}
+#if defined(__plan9__)
+ // FIXME use libmp?
+ ui64 = strtoull(tok, &end, base);
+#else
errno = 0;
ui64 = strtoull(tok, &end, base);
if (errno)
return 0;
+#endif
if (pval) *pval = return_from_uint64(ui64);
return (*end == '\0');
}
@@ -90,10 +93,15 @@
static int read_numtok(char *tok, value_t *pval, int base)
{int result;
+#if defined(__plan9__)
+ // FIXME figure out what to do here
+ result = isnumtok_base(tok, pval, base);
+#else
errno = 0;
result = isnumtok_base(tok, pval, base);
if (errno == ERANGE)
lerrorf(ParseError, "read: overflow in numeric constant %s", tok);
+#endif
return result;
}
@@ -273,10 +281,17 @@
toktype = TOK_LABEL;
else
lerror(ParseError, "read: invalid label");
+#if defined(__plan9__)
+ // FIXME :(
+ x = strtoll(buf, &end, 10);
+ if (*end != '\0')
+ lerror(ParseError, "read: invalid label");
+#else
errno = 0;
x = strtoll(buf, &end, 10);
if (*end != '\0' || errno)
lerror(ParseError, "read: invalid label");
+#endif
tokval = fixnum(x);
}
else if (c == '!') {@@ -327,10 +342,17 @@
if ((char)ch == 'g')
ch = ios_getc(F);
read_token((char)ch, 0);
+#if defined(__plan9__)
+ // FIXME :(
+ x = strtol(buf, &end, 10);
+ if (*end != '\0' || buf[0] == '\0')
+ lerror(ParseError, "read: invalid gensym label");
+#else
errno = 0;
x = strtol(buf, &end, 10);
if (*end != '\0' || buf[0] == '\0' || errno)
lerror(ParseError, "read: invalid gensym label");
+#endif
toktype = TOK_GENSYM;
tokval = fixnum(x);
}
--- a/string.c
+++ b/string.c
@@ -1,26 +1,6 @@
/*
string functions
*/
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#define towupper toupperrune
-#define towlower tolowerrune
-#define iswalpha isalpharune
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <setjmp.h>
-#include <stdarg.h>
-#include <assert.h>
-#include <ctype.h>
-#include <wchar.h>
-#include <wctype.h>
-#include <sys/types.h>
-#include <sys/time.h>
-#include <errno.h>
-#endif
#include "llt.h"
#include "flisp.h"
@@ -61,12 +41,7 @@
if (iscprim(args[0])) {cprim_t *cp = (cprim_t*)ptr(args[0]);
if (cp_class(cp) == wchartype) {- // FIXME plan9
-#ifdef PLAN9
- int w = -1;
-#else
- int w = wcwidth(*(uint32_t*)cp_data(cp));
-#endif
+ int w = llt_wcwidth(*(uint32_t*)cp_data(cp));
if (w < 0)
return FL_F;
return fixnum(w);
--- a/table.c
+++ b/table.c
@@ -1,15 +1,3 @@
-#ifdef PLAN9
-#include <u.h>
-#include <libc.h>
-#else
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <string.h>
-#include <assert.h>
-#include <sys/types.h>
-#include <setjmp.h>
-#endif
#include "llt.h"
#include "flisp.h"
#include "equalhash.h"
--- a/todo
+++ /dev/null
@@ -1,1199 +1,0 @@
-* setf
-* plists
-* backquote
-* symbol< (make < generic), generic compare function
-? (cdr nil) should be nil
-* multiple-argument mapcar
-? multi-argument apply. for builtins, just push them. for lambdas, must
- cons together the evaluated arguments.
-? option *print-shared*. if nil, it still handles circular references
- but does not specially print non-circular shared structure
-? option *print-circle*
-* read support for #' for compatibility
-* #\c read character as code (including UTF-8 support!)
-* #| |# block comments
-? here-data for binary serialization. proposed syntax:
- #>size:data, e.g. #>6:000000
-? better read syntax for packed arrays, e.g. #double[3 1 4]
-* use syntax environment concept for user-defined macros to plug
- that hole in the semantics
-* make more builtins generic. if typecheck fails, call out to the
- generic version to try supporting more types.
- compare/equal
- +-*/< for all numeric types
- length for all sequences
- ? aref/aset for all sequences (vector, list, c-array)
- ? copy
-* fixnump, all numeric types should pass numberp
-- make sure all uses of symbols don't assume symbols are unmovable without
- checking ismanaged()
-* eliminate compiler warnings
-* fix printing nan and inf
-* move to "2.5-bit" type tags
-? builtin abs()
-* try adding optional arguments, (lambda (x (opt 0)) ...), see if performance
- is acceptable
-* (syntax-environment) to return it as an assoc list
-* (environment) for variables, constantp
-* prettier printing
-
-* readable gensyms and #:
- . #:n reads similar to #n=#.(gensym) the first time, and #n# after
-* circular equal
-* integer/truncate function
-? car-circularp, cdr-circularp, circularp
-- hashtable. plan as equal-hash, over three stages:
- 1. first support symbol and fixnum keys, use ptrhash. only values get
- relocated on GC.
- 2. create a version of ptrhash that uses equal() and hash(). if a key is
- inserted requiring this, switch vtable pointer to use these functions.
- both keys and values get relocated on GC.
- 3. write hash() for pairs and vectors. now everything works.
-- expose eq-hashtable to user
-- other backquote optimizations:
- * (nconc x) => x for any x
- . (copy-list (list|append|nconc ...)) => (list|append|nconc ...)
- * (apply vector (list ...)) => (vector ...)
- * (nconc (cons x nil) y) => (cons x y)
-* let form without initializers (let (a b) ...), defaults to nil
-* print (quote a) as 'a, same for ` etc.
-
-- template keyword arguments. you write
-(template (:test eq) (:key caar)
- (defun assoc (item lst)
- (cond ((atom lst) ())
- ((:test (:key lst) item) (car lst))
- (t (assoc item (cdr lst))))))
-
-This writes assoc as a macro that produces a call to a pre-specialized
-version of the function. For example
- (assoc x l :test equal)
-first tries to look up the variant '(equal caar) in the dictionary for assoc.
-If it doesn't exist it gets generated and stored. The result is a lambda
-expression.
-The macro returns ((lambda (item lst) <code for assoc>) x l).
-We might have to require different syntax for template invocations inside
-template definitions, such as
- ((t-instance assoc eq :key) item lst)
-which passes along the same key but always uses eq.
-Alternatively, we could use the keysyms without colons to name the values
-of the template arguments, so the keysyms are always used as markers and
-never appear to have values:
-(template (:test eq) (:key caar)
- (defun assoc? (item lst)
- (cond ((atom lst) ())
- ((test (key lst) item) ...
- ...
- (assoc x y :test test :key key)
-This would be even easier if the keyword syntax were something like
- (: test eq)
-
-
-possible optimizations:
-* delay environment creation. represent environment on the stack as
- alternating symbols/values, or if cons instead of symbol then traverse
- as assoc list. only explicitly cons the whole thing when making a closure
-* cons_reserve(n) interface, guarantees n conses available without gc.
- it could even link them together for you more efficiently
-* assoc builtin
-* special check for constant symbol when evaluating head since that's likely
-* remove the loop from cons_reserve. move all initialization to the loops
- that follow calls to cons_reserve.
-- case of lambda expression in head (as produced by let), can just modify
- env in-place in tail position
-- allocate memory by mmap'ing a large uncommitted block that we cut
- in half. then each half heap can be grown without moving addresses.
-* try making (list ...) a builtin by moving the list-building code to
- a static function, see if vararg call performance is affected.
-- try making foldl a builtin, implement table iterator as table.foldl
- . not great, since then it can't be CPS converted
-* represent lambda environment as a vector (in lispv)
-x setq builtin (didn't help)
-* list builtin, to use cons_reserve
-unconventional interpreter builtins that can be used as a compilation
-target without moving away from s-expressions:
-- (*global* . a) ; special form, don't look in local env first
-- (*local* . 2) ; direct stackframe access
-for internal use:
-* a special version of apply that takes arguments on the stack, to avoid
- consing when implementing "call-with" style primitives like trycatch,
- hashtable-foreach, or the fl_apply API
-- partial_apply, reapply interface so other iterators can use the same
- fast mechanism as for
-* try this environment representation:
- for all kinds of functions (except maybe builtin special forms) push
- all arguments on the stack, either evaluated or not.
- for lambdas, push the lambda list and next-env pointers.
- to capture, save the n+2 pointers to a vector
- . this uses n+2 heap or stack words per environment instead of 2n+1 words
- . argument handling is more uniform which could lead to simplifications,
- and a more efficient apply() entry point
- . disadvantage is looking through the lambda list on every lookup. maybe
- improve by making lambda lists vectors somehow?
-* fast builtin bounded iteration construct (for lo hi (lambda (x) ...))
-* represent guest function as a tagged function pointer; allocate nothing
-- when an instance of (array type n) is requested, use (array type)
- instead, unless the value is part of an aggregate (e.g. struct).
- . this avoids allocating a new type for every size.
- . and/or add function array.alloc
-x preallocate all byte,int8,uint8 values, and some wchars (up to 0x31B7?)
- . this made no difference in a string.map microbenchmark
-- use faster hash/compare in tables where the keys are eq-comparable
-- a way to do open-input-string without copying
-
-bugs:
-* with the fully recursive (simpler) relocate(), the size of cons chains
- is limited by the process stack size. with the iterative version we can
- have unlimited cdr-deep structures.
-* in #n='e, the case that makes the cons for 'e needs to use label fixup
-* symbol token |.| does not work
-* ltable realloc not multiplying by sizeof(unsigned long)
-* not relocating final cdr in iterative version if it is a vector
-- (setf (car x) y) doesn't return y
-* reader needs to check errno in isnumtok
-* prettyprint size measuring is not utf-8 correct
-* stack is too limited.
- . add extra heap-allocated stack segments as needed.
-* argument list length is too limited.
- need to fix it for: +,-,*,/,&,|,$,list,vector,apply,string,array
- . for builtins, make Nth argument list of rest args
- . write a function to evaluate directly from list to list, use it for
- Nth arg and for user function rest args
- . modify vararg builtins accordingly
-* filter should be stable. right now it reverses.
-
-
-femtoLisp3...with symbolic C interface
-
-c values are builtins with value > N_BUILTINS
-((u_int32_t*)cvalue)[0] & 0x3 must always be 2 to distinguish from vectors
-
-typedef struct _cvtable_t {- void (*relocate)(struct _cvalue_t *);
- void (*free)(struct _cvalue_t *);
- void (*print)(struct _cvalue_t *, FILE *);
-} cvtable_t;
-
-c type representations:
-symbols void, [u]int[8,16,32,64], float, double, [u]char, [u]short,
-[u]int, [u]long, lispvalue
-(c-function ret-type (argtype ...))
-(array type[ N])
-(struct ((name type) (name type) ...))
-(union ((name type) (name type) ...))
-(mlayout ((name type offset) (name type offset) ...))
-(enum (name1 name2 ...))
-(pointer type)
-
-constructors:
-([u]int[8,16] n)
-([u]int32 hi lo)
-([u]int64 b3 b2 b1 b0)
-(float hi lo) or (float "3.14")
-(double b3 b2 b1 b0) or (double "3.14")
-(array ctype val ...)
-(struct ((name type) ...) val ...)
-(pointer ctype) ; null pointer
-(pointer cvalue) ; constructs pointer to the given value
- ; same as (pointer (typeof x) x)
-(pointer ctype cvalue) ; pointer of given type, to given value
-(pointer ctype cvalue addr) ; (ctype*)((char*)cvalue + addr)
-(c-function ret-type (argtype ...) ld-symbol-name)
-
-? struct/enum tag:
- (struct 'tag <initializer>) or (pointer (struct tag))
- where tag is a global var with a value ((name type) ...)
-
-
-representing c data from lisp is the tricky part to make really elegant and
-efficient. the most elegant but too inefficient option is not to have opaque
-C values at all and always marshal to/from native lisp values like #int16[10].
-the next option is to have opaque values "sometimes", for example returning
-them from C functions but printing them using their lisp representations.
-the next option is to relax the idea that C values of a certain type have a
-specific lisp structure, and use a coercion system that "tries" to translate
-a lisp value to a specified C type. for example [0 1 2], (0 1 2),
-#string[0 1 2], etc. might all be accepted by a C function taking int8_t*.
-you could say (c-coerce <lispvalue> <typedesc>) and get a cvalue back or
-an error if the conversion fails.
-
-the final option is to have cvalues be the only officially-sanctioned
-representation of c data, and make them via constructors, like
-(int32 hi lo) returns an int32 cvalue
-(struct '((name type) (name type) ...) a b ...) makes a struct
-there is a constructor function for each primitive C type.
-you can print these by brute force as e.g. #.(int32 hi lo)
-then all checking just looks like functions checking their arguments
-
-this option seems almost ideal. what's wrong with it?
-. to construct cvalues from lisp you have to build code instead of data
-. it seems like it should take more explicit advantage of tagged vectors
-. should you accept multiple forms? for example
- (array 'int8 0 1 2) or (array 'int8 [0 1 2])
- if you're going to be that permissive, why not allow [0 1 2] to be passed
- directly to a function that expects int8_t* and do the conversion
- implicitly?
- . even if these c-primitive-constructor functions exist, you can still
- write things like c-coerce (in lisp, even) and hack in implicit
- conversion attempts when something other than a cvalue is passed.
-. the printing code is annoying, because it's not enough to print readably,
- you have to print evaluably.
- . solution: constructor notation, #int32(hi lo)
-
-in any case, "opaque" cvalues will not really be opaque because we want to
-know their types and be able to take them apart on the byte level from lisp.
-C code can get references to lisp values and manipulate them using lisp
-operations like car, so to be fair it should work vice-versa; give
-c references to lisp code and let it use c operations like * on them.
-you can write lisp in c and c in lisp, though of course you don't usually
-want to. however, c written in lisp can be generated by a macro, printed,
-and fed to TCC for compilation.
-
-
-for a struct the names and types are parameters of the type, not the
-constructor, so it seems more correct to do
-
-((struct (name type) (name type) ...) (val val ...))
-
-where struct returns a constructor. but this isn't practical because it
-can't be printed in constructor notation and the type is a lambda rather
-than a more sensible expression.
-
-
-notice constructor calls and type representations are "similar". they
-should be related formally:
-
-(define (new type)
- (if (symbolp type) (apply (eval type) ())
- (apply (eval (car type)) (cdr type))))
-
-NOTE: this relationship is no longer true. we don't want to have to
-construct 1 cvalue from 1 lisp value every time, since that could
-require allocating a totally redundant list or vector. it should be
-possible to make a cvalue from a series of lisp arguments. for
-example there are now 2 different ways to make an array:
-
-1) from series of arguments: (array type val0 val1 ...)
-2) from 1 (optional) value: (c-value '(array int8[ size])[ V])
-
-constructors will internally use the second form to initialize elements
-of aggregates. e.g. 'array' in the first case will conceptually call
- (c-value type val0)
- (c-value type val1)
- ...
-
-
-for aggregate types, you can keep a variable referring to the relevant
-piece:
-
-(setq point '((x int) (y int)))
-(struct point 2 3) ; looks like c declaration 'struct point x;'
-
-a type is a function, so something similar to typedef is achieved by:
-
-(define (point_t vals) (struct point vals))
-
-design points:
-. type constructors will all be able to take 1 or 0 arguments, so i could say
- (new (typeof val)) ; construct similar
- (define (new type)
- (if (symbolp type) (apply (eval type) ())
- (apply (eval (car type)) (cdr type))))
-. values can be marked as autorelease (1) if user says so, (2) if we can
- prove that it's ok (e.g. we only allocated the value using malloc because
- it is too large to move on every GC).
- in the future you should be able to specify an arbitrary finalization
- function, not just free().
-. when calling a C function, a value of type_t can be passed to something
- expecting a type_t* by taking the address of the representation. BUT
- this is dangerous if the C function might save a reference.
- a type_t* can be passed as a type_t by copying the representation.
-. you can use (pointer v) to switch v to "malloc'd representation", in
- which case the value is no longer autoreleased, but you can do whatever
- you want with the pointer. (other option is to COPY v when making a
- pointer to it, but this still doesn't prevent C from holding a reference
- too long)
-
-
-add a cfunction binding to symbols. you register in C simply by setting
-this binding to a function pointer, then
-
-(defun open (path flags)
- ; could insert type checks here
- (ccall 'int32 'open path flags))
-
-(setq fd (open "path" 0))
-
-using libdl you could even omit the registration step and extra binding
-
-this is possible:
-(defun malloc (size)
- (ccall `(array int8 ,size) 'malloc size))
- ;ret type ;f name ; . args
-
-
-vtable:
-we'd like to be able to define new lisp "types", like vectors
-and hash tables, using this. there needs to be a standard value interface
-you can implement in C and attach a vtable to some c values.
-interface: relocate, finalize, print(, copy)
-
-implementation plan:
-- write cvalue constructors
-- if a head evaluates to a cvalue, call the pointer directly with the arg array
- . this is the "guest function" interface, a C function written specifically
- to the femtolisp API. its type must be
- '(c-function lispvalue ((pointer lispvalue) uint32))
- which corresponds to
- value_t func(value_t *args, u_int32_t nargs);
- . this interface is useful for writing additional builtins, types,
- interpreter extensions, etc. more efficient.
- . one of these functions could also be called with
- (defun func args
- (ccall 'func 'lispvalue (array 'lispvalue args) (length args)))
- - these functions are effectively builtins and should have names so they
- can be printed as such.
- . have a registration function
- void guest_function(value_t (*f)(value_t*,u_int32_t), const char *name);
- so at least the function type can be checked from C
- . set a flags bit for functions registered this way so we can identify
- them quickly
-
-- ccall lisp builtin, (ccall rettype name . args). if name has no cfunc
- binding, looks it up lazily with dlsym and stores the result.
- this is a guest function that handles type checking, translation, and
- invocation of foreign c functions.
-
-- you could register builtins from lisp like this:
- (defun dlopen (name flags) (ccall '(pointer void) 'dlopen name flags))
- (defun dlsym (handle name type) (ccall type 'dlsym handle name))
- (define lisp-process (dlopen nil 0))
- (define vector-sym
- (dlsym lisp-process 'int_vector
- '(function lispvalue (pointer lispvalue) uint32)))
- (ccall 'void 'guest_function vector-sym 'vector)
-
-- write c extensions cref, cset, typeof, sizeof, cvaluep
-* read, print, vectorp methods for vectors
-- quoted string "" reading, produces #(c c c c ...)
-* get rid of primitive builtins read,print,princ,load,exit,
- implement using ccall
-
-
-other possible design:
-- just add two builtins, call and ccall.
- (call 'name arg arg arg) lisp guest function interface
- we can say e.g.
- (defmacro vector args `(call 'vector ,.args))
-- basically the question is whether to introduce a new kind of callable
- object or to do everything through the existing builtin mechanism
- . macros cannot be applied, so without a new kind of callable 'vector'
- would have to be a lisp function, entailing argument consing...
- (defun builtin (name)
- (guest-function name
- (dlsym lisp-process name '(function value (pointer value) uint32))))
- then you can print a guest function as e.g.
- #.(builtin 'vector)
-
-#name(x y z) reads as a tagged vector
-#(x y z) is the same as #vector(x y z)
-should be internally the same as well, so non-taggedness does not formally
-exist.
-
-
-then we can write the vector clause in backquote as e.g.
-
-(if (vectorp x)
- (let ((body (bq-process (vector-to-list x))))
- (if (eq (tag x) 'vector)
- (list 'list-to-vector body)
- (list 'apply 'tagged-vector
- (list cons (list quote (tag x)) body))))
- (list quote x))
-
-
-setup plan:
-* create source directory and svn repository, move llt sources into it
-* write femtolisp.h, definitions for extensions to #include
-- add fl_ prefix to all exported functions
-* port read and print to llt iostreams
-* get rid of flutils; use ptrhash instead
-* builtinp needs to be a builtin ;) to distinguish lisp builtins from cvalues
-* allocation and gc for cvalues
-- interface functions fl_list(...), fl_apply
- e.g. fl_apply(fl_eval(fl_symbol("+")), fl_list(fl_number(2),fl_number(3)))- and fl_symval("+"), fl_cons, etc.-
------------------------------------------------------------------------------
-
-vector todo:
-* compare for vectors
-- (aref v i j k) does (reduce aref v '(i j k)); therefore (aref v) => v
-- (aref v ... [1 2 3] ...) vectorized indexing
-- make (setf (aref v i j k) x) expand to (aset (aref v i j) k x)
-these should be done using the ccall interface:
-- concatenate
-- copy-vec
-- (range i j step) to make integer ranges
-- (rref v start stop), plus make it settable! (rset v start stop rhs)
-lower priority:
-- find (strstr)
-
-functions to be generic over vec/list:
-* compare, equal, length
-
-constructor notation:
-
-#func(a b c) does (apply func '(a b c))
-
------------------------------------------------------------------------------
-
-how we will allocate cvalues
-
-a vector's size will be a lisp-value number. we will set bit 0x2 to indicate
-a resize request, and bit 0x1 to indicate that it's actually a cvalue.
-
-every cvalue will have the following fields, followed by some number of
-words according to how much space is needed:
-
- value_t size; // | 0x2
- cvtable_t *vtable;
- struct {-#ifdef BITS64
- unsigned pad:32;
-#endif
- unsigned whatever:27;
- unsigned mark:1;
- unsigned hasparent:1;
- unsigned islispfunction:1;
- unsigned autorelease:1;
- unsigned inlined:1;
- } flags;
- value_t type;
- size_t len; // length of *data in bytes
- //void *data; // present if !inlined
- //value_t parent; // present if hasparent
-
-size/vtable have the same meaning as vector size/elt[0] for relocation
-obviously we only relocate parent and type. if vtable->relocate is present,
-we call it at the end of the relocate process, and it must touch every
-lisp value reachable from it.
-
-when a cvalue is created with a finalizer, its address is added to a special
-list. before GC, everything in that list has its mark bit set. when
-we relocate a cvalue, clear the bit. then go through the list to call
-finalizers on dead values. this is O(n+m) where n is amt of live data and m
-is # of values needing finalization. we expect m << heapsize.
-
------------------------------------------------------------------------------
-
-Goal: bootstrap a lisp system where we can do "anything" purely in lisp
-starting with the minimal builtins needed for successive levels of
-completeness:
-
-1. Turing completeness
-quote, if, lambda, eq, atom, cons, car, cdr
-
-2. Naming
-set
-
-3. Control flow
-progn, prog1, apply, eval
-call/cc needed for true completeness, but we'll have attempt, raise
-
-4. Predicate completeness
-symbolp, numberp, builtinp
-
-5. Syntax
-macro
-
-6. I/O completeness
-read, print
-
-7. Mutable state
-rplaca, rplacd
-
-8. Arithmetic completeness
-+, -, *, /, <
-
-9. The missing data structure(s): vector
-alloc, aref, aset, vectorp, length
-
-10. Real-world completeness (escape hatch)
-ccall
-
----
-11. Misc unnecessary
-while, label, cond, and, or, not, boundp, vector
-
------------------------------------------------------------------------------
-
-exception todo:
-
-* silence 'in file' errors when user frame active
-* add more useful data to builtin exception types:
- (UnboundError x)
- (BoundsError vec index)
- (TypeError fname expected got)
- (Error v1 v2 v3 ...)
-* attempt/raise, rewrite (error) in lisp
-* more intelligent exception printers in toplevel handler
-
------------------------------------------------------------------------------
-
-lisp variant ideas
-
-- get rid of separate predicates and give every value the same structure
- ala mathematica
- . (tag 'a) => symbol
- (tag '(a b)) => a
- (tag 'symbol 'a) => a
- (tag 'blah 3) => (blah 3)
-- have only vectors, not cons cells (sort of like julia)
- . could have a separate tag field as above
-
-- easiest way to add vectors:
- . allocate in same heap with conses, have a tag, size, then elements
- (each elt must be touched on GC for relocation anyway, so might as well
- copy collect it)
- . tag pointers as builtins, we identify them as builtins with big values
- . write (vector) in C, use it from read and eval
-
-8889314663 comcast net #
-
------------------------------------------------------------------------------
-
-cvalues reserves the following global symbols:
-
-int8, uint8, int16, uint16, int32, uint32, int64, uint64
-char, uchar, wchar, short, ushort, int, uint, long, ulong
-float, double
-struct, array, enum, union, function, void, pointer, lispvalue
-
-it defines (but doesn't reserve) the following:
-
-typeof, sizeof, autorelease, guestfunction, ccall
-
-
-user-defined types and typedefs:
-
-the rule is that a type should be viewed as a self-evaluating constant
-like a number. if i define a complex_t type of two doubles, then
-'complex_t is not a type any more than the symbol 'x could be added to
-something just because it happened to have the value 2.
-
-; typedefs from lisp
-(define wchar_t 'uint32)
-(define complex_t '(struct ((re double) (im double))))
-
-; use them
-(new complex_t)
-(new `(array ,complex_t 10))
-(array complex_t 10)
-
-BUT
-
-(array 'int32 10)
-
-because the primitive types *are* symbols. the fact that they have values is
-just a convenient coincidence that lets you do e.g. (int32 0)
-
-
-; size-annotate a pointer
-(setq p (ccall #c-function((pointer void) (ulong) malloc) n)
-(setq a (deref p `(array int8 ,n)))
-
-cvalues todo:
-
-* use uint32_t instead of wchar_t in C code
-- make sure empty arrays and 0-byte types really work
-* allow int constructors to accept other int cvalues
-* array constructor should accept any cvalue of the right size
-* make sure cvalues participate well in circular printing
-* float, double
-- struct, union (may want to start with more general layout type)
-- pointer type, function type
-* finalizers
-- functions autorelease, guestfunction
-- cref/cset/byteref/byteset
-* wchar type, wide character strings as (array wchar)
-* printing and reading strings
-- ccall
-- anonymous unions
-* fix princ for cvalues
-* make header size for primitives <= 8 bytes, even on 64-bit arch
-- more efficient read for #array(), so it doesn't need to build a pairlist
-? lispvalue type
- . keep track of whether a cvalue leads to any lispvalues, so they can
- be automatically relocated (?)
-
-* string constructor/concatenator:
-(string 'sym #char(65) #wchar(945) "blah" 23)
- ; gives "symA\u03B1blah23"
-"ccc" reads to (array char)
-
-low-level functions:
-; these are type/bounds-checked accesses
-- (cref cvalue key) ; key is field name or index. access by reference.
-- (aref cvalue key) ; access by value, returns fixnums where possible
-- (cset cvalue key value) ; key is field name, index, or struct offset
- . write&use conv_from_long to put fixnums into typed locations
- . aset is the same
-* (copy cv)
-- (offset type|cvalue field [field ...])
-- (eltype type field [field ...])
-- (memcpy dest-cv src-cv)
-- (memcpy dest doffs src soffs nbytes)
-- (bswap cvalue)
-- (c2lisp cvalue) ; convert to sexpr form
-* (typeof cvalue)
-* (sizeof cvalue|type)
-- (autorelease cvalue) ; mark cvalue as free-on-gc
-- (deref pointer[, type]) ; convert an arbitrary pointer to a cvalue
- ; this is the unsafe operation
-
-; (sizeof '(pointer type)) == sizeof(void*)
-; (sizeof '(array type N)) == N * sizeof(type)
-
-(define (reinterpret-cast cv type)
- (if (= (sizeof cv) (sizeof type))
- (deref (pointer 'void cv) type)
- (error "Invalid cast")))
-
-a[n].x looks like (cref (cref a n) 'x), (reduce cref head subs)
-
-things you can do with cvalues:
-
-. call native C functions from lisp code without wrappers
-. wrap C functions in pure lisp, automatically inheriting some degree
- of type safety
-. use lisp functions as callbacks from C code
-. use the lisp garbage collector to reclaim malloc'd storage
-. annotate C pointers with size information for bounds checking
-. attach symbolic type information to a C data structure, allowing it to
- inherit lisp services such as printing a readable representation
-. add datatypes like strings to lisp
-. use more efficient represenations for your lisp programs' data
-
-
-family of cvalue representations.
-relevant attributes:
- . large -- needs full size_t to represent size
- . inline -- allocated along with metadata
- . prim -- no stored type; uses primtype bits in flags
- . hasdeps -- depends on other values to stay alive
-
-these attributes have the following dependencies:
- . large -> !inline
- . prim -> !hasdeps && !large
-
-so we have the following possibilities:
-
-large inline prim hasdeps rep#
- 0 0 0 0 0
- 0 0 0 1 1
-
- 0 0 1 0 2
- 0 1 0 0 3
- 0 1 0 1 4
- 0 1 1 0 5
-
- 1 0 0 0 6
- 1 0 0 1 7
-
-we need to be able to un-inline data, so we need:
-change 3 -> 0 (easy; write pointer over data)
-change 4 -> 1
-change 5 -> 2 (also easy)
-
-
-rep#0&1: (!large && !inline && !prim)
-typedef struct {- cvflags_t flags;
- value_t type;
- value_t deps;
- void *data; /* points to malloc'd buffer */
-} cvalue_t;
-
-rep#3&4: (!large && inline && !prim)
-typedef struct {- cvflags_t flags;
- value_t type;
- value_t deps;
- /* data goes here inlined */
-} cvalue_t;
-
-
-rep#2: (prim && !inline)
-typedef struct {- cvflags_t flags;
- void *data; /* points to (tiny!) malloc'd buffer */
-} cvalue_t;
-
-rep#5: (prim && inline)
-typedef struct {- cvflags_t flags;
- /* data goes here inlined */
-} cvalue_t;
-
-
-rep#6&7: (large)
-typedef struct {- cvflags_t flags;
- value_t type;
- value_t deps;
- void *data; /* points to malloc'd buffer */
- size_t len;
-} cvalue_t;
-
------------------------------------------------------------------------------
-
-times for lispv:
-
-color 2.286s
-sort 0.181s
-fib34 5.205s
-mexpa 0.329s
-
------------------------------------------------------------------------------
-
-finalization algorithm that allows finalizers written in lisp:
-
-right after GC, go through finalization list (a weak list) and find objects
-that didn't move. relocate them (bring them back to life) and push them
-all onto the stack. remove all from finalization list.
-
-call finalizer for each value.
-
-optional: after calling a finalizer, make sure the object didn't get put
-back on the finalization list, remove if it did.
-if you don't do this, you can make an unkillable object by registering a
-finalizer that re-registers itself. this could be considered a feature though.
-
-pop dead values off stack.
-
-
------------------------------------------------------------------------------
-
-femtolisp semantics
-
-eval* is an internal procedure of 2 arguments, expr and env, invoked
-implicitly on input.
-The user-visible procedure eval performs eval* e Env ()
-
-eval* Symbol s E => lookup* s E
-eval* Atom a E => a
-... special forms ... quote arg, if a b c, other symbols from syntax env.
-eval* Cons f args E =>
-
-First the head expression, f, is evaluated, yielding f-.
-Then control is passed to #.apply f- args
- #.apply is the user-visible apply procedure.
- (here we imagine there is a user-invisible environment where f- is
- bound to the value of the car and args is bound to the cdr of the input)
-
-
-Now (apply b lst) where b is a procedure (i.e. satisfies functionp) is
-identical to
-(eval (map (lambda (e) `',e) (cons b lst)))
-
------------------------------------------------------------------------------
-
-design of new toplevel
-
-system.lsp contains definitions of (load) and (toplevel) and is loaded
-from *install-dir* by a bootstrap loader in C. at the end of system.lsp,
-we check whether (load) is builtin. if it is, we redefine it and reload
-system.lsp with the new loader. the C code then invokes (toplevel).
-
-(toplevel) either runs a script or a repl using (while T (trycatch ...))
-
-(load) reads and evaluates every form, keeping track of defined functions
-and macros (at the top level), and grabs a (main ...) form if it sees
-one. it applies optimizations to every definition, then invokes main.
-
-an error E during load should rethrow `(load-error ,filename ,E)
-such exceptions can be printed recursively
-
-lerror() should make a lisp string S from the result of sprintf, then
-raise `(,e ,S). first argument e should be a symbol.
-
-
-new expansion process:
-
-get rid of macroexpanding versions of define and define-macro
-macroexpand doesn't expand (define ...)
- macroexpand implements let-syntax
-add lambda-expand which applies f-body to the bodies of lambdas, then
- converts defines to set!
-call expand on every form before evaluating
- (define (expand x) (lambda-expand (macroexpand x)))
-(define (eval x) (%eval (expand x)))
-reload system.lsp with the new eval
-
------------------------------------------------------------------------------
-
-String API
-
-*string - append/construct
-*string.inc - (string.inc s i [nchars])
-*string.dec
-*string.count - # of chars between 2 byte offsets
-*string.char - char at byte offset
-*string.sub - substring between 2 byte offsets
-*string.split - (string.split s sep-chars)
-*string.trim - (string.trim s chars-at-start chars-at-end)
-*string.reverse
-*string.find - (string.find s str|char [offs]), or nil if not found
- string.rfind
-*string.encode - to utf8
-*string.decode - from utf8 to UCS
-*string.width - # columns
-*string.map - (string.map f s)
-
-
-IOStream API
-
-*read - (read[ stream]) ; get next sexpr from stream
-*princ
-*file
- iostream - (stream[ cvalue-as-bytestream])
-*buffer
- fifo
- socket
-*io.eof?
-*io.flush
-*io.close
-*io.discardbuffer
-*io.write - (io.write s cvalue [start [count]])
-*io.read - (io.read s ctype [len])
-*io.getc - get utf8 character
-*io.putc
- io.peekc
-*io.readline
-*io.readuntil
-*io.copy - (io.copy to from [nbytes])
-*io.copyuntil - (io.copy to from byte)
- io.pos - (io.pos s [set-pos])
- io.seek - (io.seek s offset)
- io.seekend - move to end of stream
- io.trunc
- io.read! - destructively take data
-*io.tostring!
-*io.readlines
-*io.readall
-*print-to-string
-*princ-to-string
-
-
-*path.exists?
- path.dir?
- path.combine
- path.parts
- path.absolute
- path.simplify
- path.tempdir
- path.tempname
- path.homedir
-*path.cwd
-
-
-*time.now
- time.parts
- time.fromparts
-*time.string
-*time.fromstring
-
-
-*os.name
-*os.getenv
-*os.setenv
- os.execv
-
-
-*rand
-*randn
-*rand.uint32
-*rand.uint64
-*rand.double
-*rand.float
-
------------------------------------------------------------------------------
-
- * new print algorithm
- 1. traverse & tag all conses to be printed. when you encounter a cons
- that is already tagged, add it to a table to give it a #n# index
- 2. untag a cons when printing it. if cons is in the table, print
- "#n=" before it in the car, " . #n=" in the cdr. if cons is in the
- table but already untagged, print #n# in car or " . #n#" in the cdr.
- * read macros for #n# and #n= using the same kind of table
- * also need a table of read labels to translate from input indexes to
- normalized indexes (0 for first label, 1 for next, etc.)
- * read macro #. for eval-when-read. use for printing builtins, e.g. "#.eq"
-
------------------------------------------------------------------------------
-
-prettyprint notes
-
-* if head of list causes VPOS to increase and HPOS is a bit large, then
-switch to miser mode, otherwise default is ok, for example:
-
-> '((lambda (x y) (if (< x y) x y)) (a b c) (d e f) 2 3 (r t y))
-((lambda (x y)
- (if (< x y) x y)) (a b c)
- (d e f) 2 3
- (r t y))
-
-* (if a b c) should always put newlines before b and c
-
-* write try_predict_len that gives a length for easy cases like
- symbols, else -1. use it to avoid wrapping symbols around lines
-
-* print defun, defmacro, label, for more like lambda (2 spaces)
-
-* *print-pretty* to control it
-
-* if indent gets too large, dedent back to left edge
-
------------------------------------------------------------------------------
-
-consolidated todo list as of 7/8:
-* new cvalues, types representation
-* use the unused tag for TAG_PRIM, add smaller prim representation
-* finalizers in gc
-* hashtable
-* generic aref/aset
-* expose io stream object
-* new toplevel
-
-* make raising a memory error non-consing
-* eliminate string copy in lerror() when possible
-* fix printing lists of short strings
-
-* evaluator improvements, perf & debugging (below)
-* fix make-system-image to save aliases of builtins
-* reading named characters, e.g. #\newline etc.
-- #+, #- reader macros
-- printing improvements: *print-length*, keep track of horiz. position
- per-stream so indenting works across print calls
-- remaining c types
-- remaining cvalues functions
-- finish ios
-* optional arguments
-* keyword arguments
-- some kind of record, struct, or object system
-- improve test coverage
-
-expansion process bugs:
-* expand default expressions for opt/keyword args (as if lexically in body)
-* make bound identifiers (lambda and toplevel) shadow macro keywords
-* to expand a body:
- 1. splice begins
- 2. add defined vars to env
- 3. expand nondefinitions in the new env
- . if one expands to a definition, add the var to the env
- 4. expand RHSes of definitions
-- add different spellings for builtin versions of core forms, like
- $begin, $define, and $set!. they can be replaced when found during expansion,
- and used when the compiler needs to generate them with known meanings.
-
-- special efficient reader for #array
-- reimplement vectors as (array lispvalue)
-- implement fast subvectors and subarrays
-
------------------------------------------------------------------------------
-
-cvalues redesign
-
-goals:
-. allow custom types with vtables
-. use less space, share types more
-. simplify access to important metadata like length
-. unify vectors and arrays
-
-typedef struct {- fltype_t *type;
- void *data;
- size_t len; // length of *data in bytes
- union {- value_t parent; // optional
- char _space[1]; // variable size
- };
-} cvalue_t;
-
-#define owned(cv) ((cv)->type & 0x1)
-#define hasparent(cv) ((cv)->type & 0x2)
-#define isinlined(cv) ((cv)->data == &(cv)->_space[0])
-#define cv_class(cv) ((fltype_t*)(((uptrint_t)(cv)->type)&~3))
-#define cv_type(cv) (cv_class(cv)->type)
-#define cv_len(cv) ((cv)->len)
-#define cv_data(cv) ((cv)->data)
-#define cv_numtype(cv) (cv_class(cv)->numtype)
-
-typedef struct _fltype_t {- value_t type;
- int numtype;
- size_t sz;
- size_t elsz;
- cvtable_t *vtable;
- struct _fltype_t *eltype; // for arrays
- struct _fltype_t *artype; // (array this)
- int marked;
-} fltype_t;
-
------------------------------------------------------------------------------
-
-new evaluator todo:
-
-* need builtin = to handle nans properly, fix equal? on nans
-* builtin quasi-opaque function type
- fields: signature, maxstack, bcode, vals, cloenv
- function->vector
-* make (for ...) a special form
-* trycatch should require 2nd arg to be a lambda expression
-* immediate load int8 instruction
-* unlimited lambda lists
- . need 32-bit argument versions of loada, seta, loadc, setc
- . largs instruction to move args after MAX_ARGS from list to stack
-* maxstack calculation, make Stack growable
- * stack traces and better debugging support
-* improve internal define
-* try removing MAX_ARGS trickery
-? apply optimization, avoid redundant list copying calling vararg fns
-- let eversion
-- variable analysis - avoid holding references to values in frames
- captured by closures but not used inside them
-* lambda lifting
-* let optimization
-* fix equal? on functions
-* store function name
-* have macroexpand use its own global syntax table
-* be able to create/load an image file
-* fix trace and untrace
-* opcodes LOADA0, LOADA1, LOADC00, LOADC01
-- opcodes CAAR, CADR, CDAR, CDDR
-- EQTO N, compare directly to stored datum N
-- peephole opt
- done:
- not brf => brt
- eq brf => brne
- null brf => brnn
- null brt => brn
- null not brf => brn
- cdr car => cadr
-
- not yet:
- not brt => brf
- constant+pop => nothing, e.g. 2-arg 'if' in statement position
- loadt+brf => nothing
- loadf+brt => nothing
- loadt+brt => jmp
- loadf+brf => jmp
-
------------------------------------------------------------------------------
-
-new stack organization:
-
-func
-arg1
-...
-argn
-cloenv |
-prev |
-nargs |
-ip |
-captured |
-
-to call:
-push func and arguments
-args[nargs+3] = ip // save my state in my frame
-assign nargs
-goto top
-
-on entry:
-push cloenv
-push curr_frame (a global initialized to 0)
-push nargs
-SP += 1
-curr_frame = SP
-
-to return:
-v = POP();
-SP = curr_frame
-curr_frame = Stack[SP-4]
-if (args == top_args) return v;
-SP -= (5+nargs);
-move Stack[curr_frame-...] back into locals
-Stack[SP-1] = v
-goto next_op
-
-to relocate stack:
-for each segment {- curr_top = SP
- f = curr_frame
- while (1) {- for i=f, i<curr_top, i++
- relocate stack[i]
- if (f == 0) break;
- curr_top = f - 4
- f = stack[f - 4]
- }
-}
-
-typedef struct {- value_t *Stack;
- uint32_t size;
- uint32_t SP;
- uint32_t curr_frame;
-} stackseg_t;
-
------------------------------------------------------------------------------
-
-optional and keyword args:
-
-check nargs >= #required
-grow frame by ntotal-nargs ; ntotal = #req+#opt+#kw
-(sort keyword args into their places)
-branch if arg bound around initializer for each opt arg
-
-example: (lambda (a (b 0) (c b)))
-
-minargs 1
-framesize 3
-brbound 1 L1
-load0
-seta 0
-L1:
-brbound 2 L2
-loada 1
-seta 2
-L2:
-
------------------------------------------------------------------------------
-
-what needs more test coverage:
-
-- more error cases, lerrorf() cases
-- printing gensyms
-- gensyms with bindings
-- listn(), isnumber(), list*, boolean?, function?, add2+ovf, >2arg add,div
-- large functions, requiring long versions of branch opcodes
-- setal, loadvl, (long arglist and lots of vals cases)
-- aref/aset on c array
-- printing everything
-- reading floats, escaped symbols, multiline comment, octal chars in strs
-- equal? on functions
-- all cvalue ctors, string_from_cstrn()
-- typeof, copy, podp, builtin()
-- bitwise and logical ops
-- making a closure in a default value expression for an optional arg
-- gc during a catch block, then get stack trace
-
------------------------------------------------------------------------------
-
-5/4/10 todo:
-
-- flush and close open files on exit
-* make function versions of opcode builtins by wrapping in a lambda,
- stored in a table indexed by opcode. use in _applyn
--- a/todo-scrap
+++ /dev/null
@@ -1,41 +1,0 @@
-- readable gensyms. have uninterned symbols, but have all same-named
- gensyms read to the same (eq) symbol within an expression.
-- fat pointers, i.e. 64 bits on 32-bit platforms. we could have full 32-bit
- integers too. the mind boggles at the possibilities.
- (it would be great if everybody decided that pointer types should forever
- be wider than address spaces, with some bits reserved for application use)
-- any way at all to provide O(1) computed lookups (i.e. indexing).
- CL uses vectors for this. once you have it, it's sufficient to get
- efficient hash tables and everything else.
- - could be done just by generalizing cons cells to have more than
- car, cdr: c2r, c3r, etc. maybe (1 . 2 . 3 . 4 . ...)
- all you need is a tag+size on the front of the object so the collector
- knows how to deal with it.
- (car x) == (ref x 0), etc.
- (rplaca x v) == (rplac x 0 v), etc.
- (size (cons 1 2)) == 2, etc.
- - one possibility: if we see a cons whose CAR is tagptr(0x10,TAG_SYM),
- then the CDR is the size and the following words are the elements.
- . this approach is especially good if vectors are separate types from
- conses
- - another: add u_int32_t size to cons_t, making them all 50% bigger.
- access is simpler and more uniform, without fully doubling the size like
- we'd get with fat pointers.
-
-Notice that the size is one byte more than the number of characters in
-the string. This is because femtoLisp adds a NUL terminator to make its
-strings compatible with C. No effort is made to hide this fact.
-But since femtoLisp tracks the sizes of cvalues, it doesn't need the
-terminator itself. Therefore it treats zero bytes specially as rarely
-as possible. In particular, zeros are only special in values whose type
-is exactly <tt>(array char)</tt>, and are only interpreted in the
-following cases:
-<ul>
-<li>When printing strings, a final NUL is never printed. NULs in the
-middle of a string are printed though.
-<li>String constructors NUL-terminate their output.
-<li>Explicit string functions (like <tt>strlen</tt>) treat NULs the same
-way equivalent C functions would.
-</ul>
-Arrays of uchar, int8, etc. are treated as raw data and zero bytes are
-never special.