shithub: femtolisp

--- a/3rd/fn.h

+++ b/3rd/fn.h

@@ -25,7 +25,7 @@

 typedef struct Tbl {

 	Tindex index;

 	void *ptr;

-}Trie;

+}fl_aligned(8) Trie;

 // accessor functions, except for the index word

--- a/3rd/mp/mptod.c

+++ b/3rd/mp/mptod.c

@@ -1,7 +1,6 @@

 #include "platform.h"

 #include "mp.h"

-extern double D_PINF, D_NINF;

+#include "nan.h"

 double

 mptod(mpint *a)

--- a/README.md

+++ b/README.md

@@ -47,9 +47,19 @@

 ### MacOS 4.x-9.x (m68k or PowerPC)

-Install and build [Retro68](https://github.com/autc04/Retro68).

+Install and build [Retro68](https://git.sr.ht/~ft/retro68). This fork grabs the

+necessary patches for more things to work as expected:

-	ln -s path-to-Retro68-build/toolchain cross/macos-toolchain

+	git clone https://git.sr.ht/~ft/retro68

+	mkdir retro68-build

+	cd retro68-build

+	../retro68/build-toolchain.bash --universal --ninja --no-carbon

+	# wait until everything builds, make sure it did not error out

+Now build femtolisp:

+	cd femtolisp

+	ln -s ../retro68-build/toolchain cross/macos-toolchain

 	# for PowerPC:

 	meson setup build . -Dbuildtype=minsize --cross-file cross/powerpc-apple.txt

 	# for m68k:

@@ -56,10 +66,10 @@

 	meson setup build . -Dbuildtype=minsize --cross-file cross/m68k-apple.txt

 	ninja -C build

-`build/flisp.bin` can be then copied to your MacOS, it contains the executable.

+Either `build/flisp.dsk` or `build/flisp.bin` is the file to get on your Mac.

-NOTE: this isn't a full-fledged port and has a rather low priority at the moment. Some things

-are not working.

+NOTE: this isn't a full-fledged port and is going to stay low priority unless somebody

+wants to spend time polishing it.

 ## Characteristics

--- a/builtins.c

+++ b/builtins.c

@@ -8,6 +8,7 @@

 #include "timefuncs.h"

 #include "table.h"

 #include "random.h"

+#include "nan.h"

 #define DBL_MAXINT (1LL<<53)

 #define FLT_MAXINT (1<<24)

--- a/cross/m68-apple.txt

+++ b/cross/m68-apple.txt

@@ -2,10 +2,11 @@

 toolchain = '@DIRNAME@/macos-toolchain/'

 path = toolchain + 'bin/'

 prefix = path + 'm68k-apple-macos-'

+cpuflags = ['-march=68020', '-mtune=68020-40']

 [built-in options]

-c_args = ['-march=68020', '-fdata-sections', '-ffunction-sections', '-D__macos__']

-c_link_args = ['-march=68020', '-Wl,--mac-single', '-Wl,--mac-strip-macsbug']

+c_args = cpuflags + ['-fdata-sections', '-ffunction-sections', '-D__macos__']

+c_link_args = cpuflags + ['-Wl,--mac-single', '-Wl,--mac-strip-macsbug']

 cpp_args = c_args

 cpp_link_args = c_link_args

--- a/equalhash.c

+++ b/equalhash.c

@@ -3,7 +3,7 @@

 #include "equal.h"

 #define HTNAME(suffix) equalhash##suffix

-#define HFUNC hash_lispvalue

+#define HFUNC(v) hash_lispvalue((value_t)(v))

 #define EQFUNC(x, y) equal_lispvalue((value_t)(x), (value_t)(y))

 #include "htable.inc"

--- a/flisp.h

+++ b/flisp.h

@@ -78,7 +78,7 @@

 typedef struct {

 	fltype_t *type;

-	value_t binding;   // global value binding

+	value_t binding;

 	uint32_t id;

 }fl_aligned(8) gensym_t;

@@ -206,11 +206,11 @@

 value_t alloc_vector(size_t n, int init);

 /* safe casts */

-cons_t *tocons(value_t v);

-symbol_t *tosymbol(value_t v);

-fixnum_t tofixnum(value_t v);

-char *tostring(value_t v);

-double todouble(value_t a);

+cons_t *tocons(value_t v) fl_purefn;

+symbol_t *tosymbol(value_t v) fl_purefn;

+fixnum_t tofixnum(value_t v) fl_purefn;

+char *tostring(value_t v) fl_purefn;

+double todouble(value_t a) fl_purefn;

 /* conses */

 value_t mk_cons(void) fl_hotfn;

@@ -448,7 +448,5 @@

 extern value_t FL_int64sym, FL_uint64sym, FL_bignumsym;

 extern value_t FL_bytesym, FL_runesym, FL_floatsym, FL_doublesym;

 extern value_t FL_stringtypesym, FL_runestringtypesym;

-extern double D_PNAN, D_NNAN, D_PINF, D_NINF;

 _Noreturn void flmain(const uint8_t *boot, int bootsz, int argc, char **argv);

--- a/flmain.c

+++ b/flmain.c

@@ -2,12 +2,10 @@

 #include "cvalues.h"

 #include "print.h"

 #include "iostream.h"

-#include "ieee754.h"

 #include "random.h"

 #include "brieflz.h"

+#include "nan.h"

-double D_PNAN, D_NNAN, D_PINF, D_NINF;

 static value_t

 argv_list(int argc, char *argv[])

@@ -26,15 +24,7 @@

 _Noreturn void

 flmain(const uint8_t *boot, int bootsz, int argc, char **argv)

-	D_PNAN = D_NNAN = strtod("+NaN", nil);

-	D_PINF = D_NINF = strtod("+Inf", nil);

-	union ieee754_double *d;

-	d = (union ieee754_double *)&D_NNAN;

-	d->ieee.negative = 1;

-	d = (union ieee754_double *)&D_NINF;

-	d->ieee.negative = 1;

+	nan_init();

 	randomize();

 	ios_init_stdstreams();

 	mpsetminbits(sizeof(fixnum_t)*8);

--- a/htable.h

+++ b/htable.h

@@ -9,7 +9,7 @@

 	// FIXME(sigrid): in a multithreaded environment this isn't enough

 	uint32_t i;

 	void *_space[HT_N_INLINE];

-}htable_t;

+}fl_aligned(8) htable_t;

 // define this to be an invalid key/value

 #define HT_NOTFOUND ((void*)1)

--- a/htable.inc

+++ b/htable.inc

@@ -17,7 +17,7 @@

 	void **tab = h->table;

 	void **ol;

-	hv = HFUNC((uintptr_t)key);

+	hv = HFUNC(key);

 retry_bp:

 	iter = 0;

 	index = (hv & (sz-1)) * 2;

@@ -89,7 +89,7 @@

     size_t sz = hash_size(h);

     size_t maxprobe = max_probe(sz);

     void **tab = h->table;

-    size_t index = (HFUNC((uintptr_t)key) & (sz-1)) * 2;

+    size_t index = (HFUNC(key) & (sz-1)) * 2;

     sz *= 2;

     size_t orig = index;

     size_t iter = 0;

--- a/htableh.inc

+++ b/htableh.inc

@@ -3,10 +3,10 @@

 #include "htable.h"

 #define HTPROT(HTNAME) \

-void *HTNAME##_get(htable_t *h, void *key); \

+void *HTNAME##_get(htable_t *h, void *key) fl_purefn; \

 void HTNAME##_put(htable_t *h, void *key, void *val); \

 void HTNAME##_adjoin(htable_t *h, void *key, void *val); \

-int HTNAME##_has(htable_t *h, void *key); \

+int HTNAME##_has(htable_t *h, void *key) fl_purefn; \

 int HTNAME##_remove(htable_t *h, void *key); \

 void **HTNAME##_bp(htable_t *h, void *key);

--- a/ios.h

+++ b/ios.h

@@ -64,7 +64,7 @@

 	uint8_t local[IOS_INLSIZE];

 }ios_t;

-void *llt_memrchr(const void *s, int c, size_t n);

+void *llt_memrchr(const void *s, int c, size_t n) fl_purefn;

 /* low-level interface functions */

 size_t ios_read(ios_t *s, void *dest, size_t n);

@@ -74,7 +74,7 @@

 off_t ios_skip(ios_t *s, off_t offs);  // relative seek

 off_t ios_pos(ios_t *s);  // get current position

 int ios_trunc(ios_t *s, off_t size);

-bool ios_eof(ios_t *s);

+bool ios_eof(ios_t *s) fl_purefn;

 int ios_flush(ios_t *s);

 void ios_close(ios_t *s);

 void ios_free(ios_t *s);

--- a/macos/platform.h

+++ b/macos/platform.h

@@ -27,7 +27,7 @@

 #include <wchar.h>

 #define __os_name__ "macos"

-extern char os_version[10];

+extern char os_version[];

 #define __os_version__ os_version

 #define nil NULL

--- a/meson.build

+++ b/meson.build

@@ -42,7 +42,6 @@

 	'-Wunused-parameter',

 	'-Wwrite-strings',

 	'-D_DEFAULT_SOURCE',

-	'-DBLZ_NO_LUT=1', # breaks on m68k - disable for everything

 	'-DCOMPUTED_GOTO',

 	language: 'c',

@@ -91,6 +90,7 @@

 	endif

 	extras = [

 		cpp.find_library('RetroConsole', required: true),

+		cpp.find_library('retrocrt', required: true),

 else

 	flisp_exe_name = 'flisp'

@@ -102,7 +102,12 @@

 	extras = []

 endif

-src = [

+src_common = [

+	'mem.c',

+	'nan.c',

+]

+src_flisp = [

 	'3rd/fn.c',

 	'3rd/mt19937-64.c',

 	'3rd/spooky.c',

@@ -152,7 +157,7 @@

 	'builtins',

 	capture: true,

 	input: [

-		src,

+		src_flisp,

],

 	output: [

 		'builtin_fns.h',

@@ -162,89 +167,62 @@

],

-brieflz = static_library(

-	'brieflz',

-	[

-		'3rd/brieflz/brieflz.c',

-		'3rd/brieflz/depacks.c',

-	],

-	include_directories: include_directories(

-		'3rd/brieflz',

-		platform,

-	),

-)

+src_brieflz = [

+	'3rd/brieflz/brieflz.c',

+	'3rd/brieflz/depacks.c',

+]

-common = static_library(

-	'common',

-	[

-		'mem.c',

-	],

-	include_directories: include_directories(

-		platform,

-	),

-)

+src_mp = [

+	'3rd/mp/mpadd.c',

+	'3rd/mp/mpaux.c',

+	'3rd/mp/mpcmp.c',

+	'3rd/mp/mpdigdiv.c',

+	'3rd/mp/mpdiv.c',

+	'3rd/mp/mpexp.c',

+	'3rd/mp/mpextendedgcd.c',

+	'3rd/mp/mpfmt.c',

+	'3rd/mp/mpinvert.c',

+	'3rd/mp/mpleft.c',

+	'3rd/mp/mplogic.c',

+	'3rd/mp/mpmod.c',

+	'3rd/mp/mpmodop.c',

+	'3rd/mp/mpmul.c',

+	'3rd/mp/mprand.c',

+	'3rd/mp/mpright.c',

+	'3rd/mp/mpsub.c',

+	'3rd/mp/mptobe.c',

+	'3rd/mp/mptober.c',

+	'3rd/mp/mptod.c',

+	'3rd/mp/mptoi.c',

+	'3rd/mp/mptoui.c',

+	'3rd/mp/mptouv.c',

+	'3rd/mp/mptov.c',

+	'3rd/mp/mpvecadd.c',

+	'3rd/mp/mpveccmp.c',

+	'3rd/mp/mpvecdigmuladd.c',

+	'3rd/mp/mpvecsub.c',

+	'3rd/mp/mpvectscmp.c',

+	'3rd/mp/strtomp.c',

+	'3rd/mp/u16.c',

+]

-mp = static_library(

-	'mp',

-	[

-		'3rd/mp/mpadd.c',

-		'3rd/mp/mpaux.c',

-		'3rd/mp/mpcmp.c',

-		'3rd/mp/mpdigdiv.c',

-		'3rd/mp/mpdiv.c',

-		'3rd/mp/mpexp.c',

-		'3rd/mp/mpextendedgcd.c',

-		'3rd/mp/mpfmt.c',

-		'3rd/mp/mpinvert.c',

-		'3rd/mp/mpleft.c',

-		'3rd/mp/mplogic.c',

-		'3rd/mp/mpmod.c',

-		'3rd/mp/mpmodop.c',

-		'3rd/mp/mpmul.c',

-		'3rd/mp/mprand.c',

-		'3rd/mp/mpright.c',

-		'3rd/mp/mpsub.c',

-		'3rd/mp/mptobe.c',

-		'3rd/mp/mptober.c',

-		'3rd/mp/mptod.c',

-		'3rd/mp/mptoi.c',

-		'3rd/mp/mptoui.c',

-		'3rd/mp/mptouv.c',

-		'3rd/mp/mptov.c',

-		'3rd/mp/mpvecadd.c',

-		'3rd/mp/mpveccmp.c',

-		'3rd/mp/mpvecdigmuladd.c',

-		'3rd/mp/mpvecsub.c',

-		'3rd/mp/mpvectscmp.c',

-		'3rd/mp/strtomp.c',

-		'3rd/mp/u16.c',

-	],

-	include_directories: include_directories(

-		'3rd/mp',

-		platform,

-	),

-)

+src_utf = [

+	'3rd/utf/rune.c',

+	'3rd/utf/runeistype.c',

+	'3rd/utf/runetotype.c',

+	'3rd/utf/utfnlen.c',

+]

-utf = static_library(

-	'utf',

-	[

-		'3rd/utf/rune.c',

-		'3rd/utf/runeistype.c',

-		'3rd/utf/runetotype.c',

-		'3rd/utf/utfnlen.c',

-	],

-	include_directories: include_directories(

-		'3rd/utf',

-		platform,

-	),

-)

 flisp = executable(

 	flisp_exe_name,

 	sources: [

-		src,

 		boot,

 		builtins,

+		src_brieflz,

+		src_common,

+		src_flisp,

+		src_mp,

+		src_utf,

],

 	dependencies: [

 		math,

@@ -256,12 +234,6 @@

 		'3rd/utf',

 		platform,

),

-	link_with: [

-		brieflz,

-		common,

-		mp,

-		utf,

-	],

 if platform == 'macos'

@@ -324,14 +296,12 @@

 		'mptest',

 		sources: [

 			'3rd/mp/test.c',

+			src_common,

+			src_mp,

],

 		include_directories: include_directories(

 			platform,

),

-		link_with: [

-			common,

-			mp,

-		],

 	test('mp', mptest)

 	mptest2 = executable(

@@ -341,6 +311,8 @@

 			'3rd/mp/test/gen.tab.c',

 			'3rd/mp/test/ld.c',

 			'3rd/mp/test/main.c',

+			src_common,

+			src_mp,

],

 		include_directories: include_directories(

 			'3rd/mp',

@@ -347,10 +319,6 @@

 			'3rd/mp/test',

 			platform,

),

-		link_with: [

-			common,

-			mp,

-		],

 	test('mp2', mptest2, timeout: -1)

 endif

--- a/mkfile

+++ b/mkfile

@@ -38,6 +38,7 @@

 	htable.$O\

 	ios.$O\

 	iostream.$O\

+	nan.$O\

 	opcodes.$O\

 	operators.$O\

 	print.$O\

--- /dev/null

+++ b/nan.c

@@ -1,0 +1,18 @@

+#include "platform.h"

+#include "nan.h"

+#include "ieee754.h"

+double D_PNAN, D_NNAN, D_PINF, D_NINF;

+void

+nan_init(void)

+{

+	D_PNAN = D_NNAN = strtod("+NaN", nil);

+	D_PINF = D_NINF = strtod("+Inf", nil);

+	union ieee754_double *d;

+	d = (union ieee754_double *)&D_NNAN;

+	d->ieee.negative = 1;

+	d = (union ieee754_double *)&D_NINF;

+	d->ieee.negative = 1;

+}

--- /dev/null

+++ b/nan.h

@@ -1,0 +1,3 @@

+extern double D_PNAN, D_NNAN, D_PINF, D_NINF;

+void nan_init(void);

--- a/plan9/platform.h

+++ b/plan9/platform.h

@@ -41,8 +41,10 @@

     defined(__sparc64__)

 #define BITS64

 #define PRIdPTR PRId64

+#define PRIuPTR PRIu64

 #else

 #define PRIdPTR "ld"

+#define PRIuPTR "lud"

 #endif

 #define unsetenv(name) putenv(name, "")

--- a/ptrhash.c

+++ b/ptrhash.c

@@ -33,7 +33,7 @@

 #endif

 #define HTNAME(suffix) ptrhash##suffix

-#define HFUNC _pinthash

+#define HFUNC(v) _pinthash((value_t)(v))

 #define EQFUNC(x, y) ((x) == (y))

 #include "htable.inc"

--- a/read.c

+++ b/read.c

@@ -1,6 +1,7 @@

 #include "flisp.h"

 #include "cvalues.h"

 #include "read.h"

+#include "nan.h"

 enum {

 	TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,

@@ -31,6 +32,7 @@

 	char *end;

 	int64_t i64;

 	double d;

 	if(*tok == '\0')

 		return false;

 	if(!((tok[0] == '0' && tok[1] == 'x') || (base >= 15)) && strpbrk(tok, ".eEpP")){

@@ -76,8 +78,15 @@

 	i64 = strtoll(tok, &end, base);

 	if(*end != '\0')

 		return false;

-	if(pval != nil)

-		*pval = fits_fixnum(i64) ? fixnum(i64) : mk_mpint(strtomp(tok, &end, base, nil));

+	if(pval != nil){

+		mpint *m;

+		if(fits_fixnum(i64))

+			*pval = fixnum(i64);

+		else if((m = strtomp(tok, &end, base, nil)) != nil)

+			*pval = mk_mpint(m);

+		else

+			return false;

+	}

 	return true;

--- a/sys_macos.c

+++ b/sys_macos.c

@@ -80,7 +80,7 @@

int

 main(int argc, char **argv)

-	SysEnvRec r;

+	static SysEnvRec r;

 	memset(&r, 0, sizeof(r));

 	SysEnvirons(2, &r);

 	snprintf(

--- a/table.c

+++ b/table.c

@@ -5,6 +5,8 @@

 #include "print.h"

 #include "table.h"

+#define inline_space sizeof(((htable_t*)nil)->_space)

 static void

 print_htable(value_t v, ios_t *f)

@@ -50,11 +52,12 @@

 	htable_t *oldh = cvalue_data(oldv);

 	htable_t *h = cvalue_data(newv);

-	h->table = oldh->table == &oldh->_space[0] ? &h->_space[0] : oldh->table;

+	if(oldh->table == &oldh->_space[0])

+		h->table = &h->_space[0];

 	h->i = oldh->i;

 	for(size_t i = 0; i < h->size; i++){

-		if(oldh->table[i] != HT_NOTFOUND)

-			h->table[i] = (void*)relocate((value_t)oldh->table[i]);

+		if(h->table[i] != HT_NOTFOUND)

+			h->table[i] = (void*)relocate((value_t)h->table[i]);

@@ -95,7 +98,7 @@

 	if(cnt <= HT_N_INLINE)

 		nt = cvalue_nofinalizer(FL(tabletype), sizeof(htable_t));

 	else

-		nt = cvalue(FL(tabletype), 2*sizeof(void*));

+		nt = cvalue(FL(tabletype), sizeof(htable_t)-inline_space);

 	htable_t *h = cvalue_data(nt);

 	htable_new(h, cnt/2);

 	size_t i;

@@ -106,10 +109,10 @@

 		else

 			k = arg;

-	if(cnt <= HT_N_INLINE && h->table != &h->_space[0]){

+	if(h->table != &h->_space[0] && cnt <= HT_N_INLINE){

 		cvalue_t *cv = ptr(nt);

 		add_finalizer(cv);

-		cv->len = 2*sizeof(void*);

+		cv->len = sizeof(htable_t) - inline_space;

 	return nt;

@@ -125,7 +128,7 @@

 	if(table0 == &h->_space[0] && h->table != &h->_space[0]){

 		cvalue_t *cv = ptr(args[0]);

 		add_finalizer(cv);

-		cv->len = 2*sizeof(void*);

+		cv->len = sizeof(htable_t) - inline_space;

 	return args[0];