Move lisp to single-dword value type
diff --git a/.gitignore b/.gitignore
index 77a9e09..b9000ab 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,4 +9,5 @@
*.img
bin/*
!bin/jmk
-**/Makefile
\ No newline at end of file
+**/Makefile
+**/Jmk.options
\ No newline at end of file
diff --git a/share/jmk/jmk.m4 b/share/jmk/jmk.m4
index 4d68477..cbcf3a4 100644
--- a/share/jmk/jmk.m4
+++ b/share/jmk/jmk.m4
@@ -24,6 +24,10 @@
MAKEFILE_DEPTH ?= 1
+ifneq (,$(wildcard ./Jmk.options))
+ include Jmk.options
+endif
+
all: $(jmk_target)')
dnl preset applies a certain configuration preset to the project
@@ -85,6 +89,11 @@
status_log(LD, dollar_at)
@$(LD) $(LDFLAGS) -o dollar_at $^')')
+define(option,
+`$1 ?= $3
+jmk_options += $1
+jmk_option_help_$1 = $2 (default: $3)')
+
dnl finish is required at the end of the Jmk file to generate some
dnl final declarations
diff --git a/src/lisp/.gitignore b/src/lisp/.gitignore
index a21650e..ee89f4f 100644
--- a/src/lisp/.gitignore
+++ b/src/lisp/.gitignore
@@ -1 +1,2 @@
-compiler.c
\ No newline at end of file
+compiler.c
+lisp
\ No newline at end of file
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index 42a0e51..d5d3001 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -1,5 +1,9 @@
+# -*- mode:makefile -*-
+
init(lisp, lisp)
+option(PLAT, "`platform to build for: either linux or bluejay'", linux)
+
preset(optimize)
preset(32)
preset(debug)
@@ -13,6 +17,12 @@
lisp.o \
compiler.o
+ifeq ($(PLAT),linux)
+OBJECTS += plat/linux.o
+else
+$(error linux is the only supported option for PLAT)
+endif
+
LUA = vendor/luajit/src/host/minilua
vendor/luajit/src/host/minilua: vendor/luajit/src/host/minilua.c
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index b6d23e7..2bd10d1 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -1,3 +1,5 @@
+/* -*- mode:c -*- */
+
#include "compiler.h"
#include <dasm_proto.h>
@@ -10,7 +12,7 @@
|.macro setup, nvars;
| push ebp;
| mov ebp, esp;
-| sub esp, value_size *nvars;
+| sub esp, (value_size * nvars);
|.endmacro;
|.macro cleanup;
@@ -51,17 +53,3 @@
dasm_growpc (&d, npc);
}
-
-// First pass populates local
-void firstpass (struct value val, struct environment *env, struct local *local)
-{
-}
-
-// Second pass generates code
-void secondpass (struct value val, struct environment *env, struct local *local)
-{
-}
-
-void toplevel (struct value val, struct environment *env)
-{
-}
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 9342a12..9225c11 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -41,11 +41,5 @@
struct variable *first;
};
-// First pass populates local
-void firstpass (struct value val, struct environment *env, struct local *local);
-// Second pass generates code
-void secondpass (struct value val, struct environment *env,
- struct local *local);
-void toplevel (struct value val, struct environment *env);
void compile (struct istream *is);
struct function *find_function (struct environment *env, char *name);
diff --git a/src/lisp/lisp b/src/lisp/lisp
index 9f20723..2437d14 100755
--- a/src/lisp/lisp
+++ b/src/lisp/lisp
Binary files differ
diff --git a/src/lisp/lisp-notes.org b/src/lisp/lisp-notes.org
index 614ac8f..c4a7be2 100644
--- a/src/lisp/lisp-notes.org
+++ b/src/lisp/lisp-notes.org
@@ -13,24 +13,13 @@
An example assembly is in =scratch.s=.
-** First Pass
+ Values will be encoded as double words, where the lowest few bits
+ indicate the type.
- The first pass will involve finding all the local variables
- (i.e. anything defined with =let=) and all the temporary values
- necessary. Once a variable is out of scope, its stack space becomes
- usable by other variables. Similarly, once a temporary is used, its
- space becomes available. Variables are addressable by name but
- temporaries are not.
+** Closures and lambdas
-** Second Pass
-
- The second pass will actually generate assembly. First enough space
- will be reserved on the stack for the variables and temporaries,
- then the AST will be walked as before to generate all the
- appropriate function calls.
-
- When a function call is generated, first temporaries are allocated
- for all its arguments. Then the sub-expressions are compiled left to
- right given these temporary locations as the outputs. For now we
- will assume that everything is either a variable or a function
- call, there will be no literals yet.
+ Closures will have to be done in two passes, one pass to find the
+ free variables and one to generate the code. Free variables will be
+ accessed as an offset to =edi=, which will point to the location of
+ the lambda on the heap. =[edi]= will evaluate to the address of the
+ lambda, =[edi + 1]= for the first free variable, etc.
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 51a3270..d1ae059 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -1,4 +1,6 @@
#include "lisp.h"
+#include "plat/plat.h"
+
#include <ctype.h>
#include <stdbool.h>
#include <stdio.h>
@@ -9,23 +11,30 @@
struct alloc_list *first_a = NULL, *last_a = NULL;
-struct value nil = {.tag = {.type = T_NIL}};
+value_t nil = 0b00101111; // magic ;)
void err (const char *msg)
{
fprintf (stderr, "ERROR: %s\n", msg);
}
-struct value cons (struct value car, struct value cdr)
+value_t intval (int i)
{
- struct cons *c = malloc (sizeof (struct cons));
+ i <<= 2;
+ i |= INT_TAG;
+ return i;
+}
+
+value_t cons (value_t car, value_t cdr)
+{
+ struct cons *c = malloc_aligned (sizeof (struct cons));
c->car = car;
c->cdr = cdr;
struct alloc_list *item = malloc (sizeof (struct alloc_list));
item->type = T_CONS;
- item->data.cons_val = c;
+ item->cons_val = c;
if ( last_a )
{
@@ -39,9 +48,8 @@
first_a = last_a = item;
}
- struct value v;
- v.tag.type = T_CONS;
- v.value.cons_val = c;
+ value_t v = (value_t) c;
+ v |= CONS_TAG;
return v;
}
@@ -68,7 +76,7 @@
return isalpha (c) || isallowedchar (c) || isdigit (c);
}
-bool readsym (struct istream *is, struct value *val)
+bool readsym (struct istream *is, value_t *val)
{
skipws (is);
@@ -76,7 +84,7 @@
return false;
int size = 8;
- char *s = malloc (size);
+ char *s = malloc_aligned (size);
s[ 0 ] = is->get (is);
@@ -87,7 +95,7 @@
if ( i >= size )
{
size *= 2;
- s = realloc (s, size);
+ s = realloc_aligned (s, size);
}
s[ i ] = is->get (is);
@@ -95,16 +103,15 @@
else
{
s[ i ] = 0;
- val->tag.type = T_SYMBOL;
- val->tag.length = i - 1;
- val->value.symbol_val = s;
+ *val = (value_t) s;
+ *val |= SYMBOL_TAG;
return true;
}
}
}
-bool readstr (struct istream *is, struct value *val)
+bool readstr (struct istream *is, value_t *val)
{
skipws (is);
@@ -113,7 +120,7 @@
bool escape = false;
int size = 8;
- char *s = malloc (size);
+ char *s = malloc_aligned (size);
(void)is->get (is);
@@ -124,7 +131,7 @@
if ( i >= size )
{
size *= 2;
- s = realloc (s, size);
+ s = realloc_aligned (s, size);
}
char c = is->get (is);
@@ -149,34 +156,34 @@
{
is->get (is);
- val->tag.type = T_STRING;
- val->tag.length = i;
- val->value.string_val = s;
+ *val = (value_t) s;
+ *val |= STRING_TAG;
return true;
}
}
}
-void printval (struct value v, int depth)
+void printval (value_t v, int depth)
{
for ( int i = 0; i < depth; i++ )
printf (" ");
- switch ( v.tag.type )
+ if ( symbolp (v) )
{
- case T_SYMBOL:
- printf ("'%s\n", v.value.symbol_val);
- return;
- case T_STRING:
- printf ("\"%s\"\n", v.value.string_val);
- return;
- case T_CONS:
+ printf ("'%s\n", (char *) (v ^ SYMBOL_TAG));
+ }
+ else if ( stringp (v) )
+ {
+ printf ("\"%s\"\n", (char *) (v ^ STRING_TAG));
+ }
+ else if ( consp (v) )
+ {
if ( listp (v) )
{
printf ("list:\n");
- for ( struct value n = v; !nilp (n); n = cdr (n) )
+ for ( value_t n = v; !nilp (n); n = cdr (n) )
{
printval (car (n), depth + 1);
}
@@ -184,19 +191,21 @@
else
{
printf ("cons:\n");
- printval (v.value.cons_val->car, depth + 1);
- printval (v.value.cons_val->cdr, depth + 1);
+ printval (car (v), depth + 1);
+ printval (cdr (v), depth + 1);
}
- break;
- case T_NIL:
+ }
+ else if ( nilp (v) )
+ {
printf ("nil\n");
- break;
- default:
- printf ("<unknown %d>\n", v.tag.type);
+ }
+ else
+ {
+ printf ("<unknown %d>\n", v);
}
}
-bool readlist (struct istream *is, struct value *val)
+bool readlist (struct istream *is, value_t *val)
{
skipws (is);
@@ -218,7 +227,7 @@
return true;
}
-bool read1 (struct istream *is, struct value *val)
+bool read1 (struct istream *is, value_t *val)
{
if ( readsym (is, val) )
return true;
@@ -232,17 +241,17 @@
return false;
}
-struct value readn (struct istream *is)
+value_t readn (struct istream *is)
{
- struct value first = nil;
- struct value *last = &first;
+ value_t first = nil;
+ value_t *last = &first;
- struct value read_val;
+ value_t read_val;
while ( read1 (is, &read_val) )
{
*last = cons (read_val, nil);
- last = &last->value.cons_val->cdr;
+ last = cdrref (*last);
}
return first;
@@ -370,55 +379,97 @@
return res;
}
-struct value strval (char *str)
+value_t strval (char *str)
{
- struct value v;
- v.tag.type = T_STRING;
- v.tag.length = strlen (str);
- v.value.string_val = str;
+ value_t v;
+
+ char *a = malloc_aligned (strlen (str) + 1);
+ v = (value_t) a;
+ v |= STRING_TAG;
return v;
}
-bool listp (struct value v)
+bool integerp (value_t v)
{
- struct value *next = &v;
+ return (v & INT_MASK) == INT_TAG;
+}
- while ( next->tag.type == T_CONS && cdr (*next).tag.type == T_CONS )
+bool symbolp (value_t v)
+{
+ return (v & HEAP_MASK) == SYMBOL_TAG;
+}
+
+bool stringp (value_t v)
+{
+ return (v & HEAP_MASK) == STRING_TAG;
+}
+
+bool consp (value_t v)
+{
+ return (v & HEAP_MASK) == CONS_TAG;
+}
+
+bool listp (value_t v)
+{
+ value_t next = v;
+
+ while ( consp (next) )
{
- next = &next->value.cons_val->cdr;
+ next = cdr (next);
}
- return next->value.cons_val->cdr.tag.type == T_NIL;
+ return nilp (next);
}
-struct value car (struct value v)
+value_t car (value_t v)
{
- if ( v.tag.type != T_CONS )
+ if ( !consp (v) )
return nil;
- return v.value.cons_val->car;
+ return *carref (v);
}
-struct value cdr (struct value v)
+value_t cdr (value_t v)
{
- if ( v.tag.type != T_CONS )
+ if ( !consp (v) )
return nil;
- return v.value.cons_val->cdr;
+ return *cdrref (v);
}
-bool nilp (struct value v)
+value_t *carref (value_t v)
{
- return v.tag.type == T_NIL;
+ if ( !consp (v) )
+ return NULL;
+
+ struct cons *c = (void *) (v ^ CONS_TAG);
+ return &c->car;
}
-int length (struct value v)
+value_t *cdrref (value_t v)
+{
+ if ( !consp (v) )
+ return NULL;
+
+ struct cons *c = (void *) (v ^ CONS_TAG);
+ return &c->cdr;
+}
+
+bool nilp (value_t v)
+{
+ return v == nil;
+}
+
+int length (value_t v)
{
int i = 0;
FOREACH (item, v)
+ {
+ (void) item;
i++;
+ }
return i;
}
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index d8bc0e4..173ae92 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -15,39 +15,41 @@
T_CONS,
};
-struct tag
-{
- unsigned int type : 3;
- unsigned int length : 29;
-} __attribute__ ((packed));
+#define INT_MASK 0b11
+#define INT_TAG 0b00
+
+#define CHAR_MASK 0xff
+#define CHAR_TAG 0b00001111
+
+#define BOOL_MASK 0b1111111
+#define BOOL_TAG 0b0011111
+
+#define HEAP_MASK 0b111
+
+#define CONS_TAG 0b001
+#define VECTOR_TAG 0b010
+#define STRING_TAG 0b100
+#define SYMBOL_TAG 0b101
+#define CLOSURE_TAG 0b110
struct cons;
-union value_type {
- int int_val;
- float float_val;
- struct cons *cons_val;
- char *symbol_val; // interned
- char *string_val;
-};
-
-struct value
-{
- struct tag tag;
- union value_type value;
-} __attribute__ ((packed));
+typedef unsigned int value_t;
struct cons
{
int magic;
int marked; // must be reserved
- struct value car, cdr;
+ value_t car, cdr;
};
struct alloc_list
{
int type;
- union value_type data;
+ union
+ {
+ struct cons *cons_val;
+ };
struct alloc_list *next, *prev;
};
@@ -66,23 +68,31 @@
bool startswith (struct istream *s, char *pattern);
-bool readsym (struct istream *is, struct value *val);
-bool readstr (struct istream *is, struct value *val);
-bool readlist (struct istream *is, struct value *val);
+bool readsym (struct istream *is, value_t *val);
+bool readstr (struct istream *is, value_t *val);
+bool readlist (struct istream *is, value_t *val);
-struct value strval (char *str);
-struct value cons (struct value car, struct value cdr);
-bool read1 (struct istream *is, struct value *val);
-struct value read (struct istream *is);
-struct value readn (struct istream *is);
+value_t intval (int i);
+value_t strval (char *str);
+value_t cons (value_t car, value_t cdr);
+bool read1 (struct istream *is, value_t *val);
+value_t read (struct istream *is);
+value_t readn (struct istream *is);
-struct value car (struct value v);
-struct value cdr (struct value v);
-bool listp (struct value v);
-bool nilp (struct value v);
-int length (struct value v);
+value_t car (value_t v);
+value_t cdr (value_t v);
+value_t *carref (value_t v);
+value_t *cdrref (value_t v);
-void printval (struct value v, int depth);
+bool integerp (value_t v);
+bool symbolp (value_t v);
+bool stringp (value_t v);
+bool consp (value_t v);
+bool listp (value_t v);
+bool nilp (value_t v);
+int length (value_t v);
+
+void printval (value_t v, int depth);
struct istream *new_stristream (char *str, int length);
// same as above but null terminated
@@ -91,11 +101,11 @@
void err (const char *msg);
-extern struct value nil;
+extern value_t nil;
#define FOREACH(item, list) \
for ( ; listp (list); ) \
- for ( struct value item = car (list), _foreach_current = list; \
+ for ( value_t item = car (list), _foreach_current = list; \
!nilp (_foreach_current); \
_foreach_current = cdr (_foreach_current), \
- item = car (_foreach_current) )
+ item = car (_foreach_current) )
diff --git a/src/lisp/main.c b/src/lisp/main.c
index 4ed48ea..a83faab 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -9,7 +9,7 @@
}
struct istream *is = new_stristream_nt (argv[ 1 ]);
- struct value val;
+ value_t val;
while ( read1 (is, &val) )
{
diff --git a/src/lisp/plat/linux.c b/src/lisp/plat/linux.c
new file mode 100644
index 0000000..23f7f82
--- /dev/null
+++ b/src/lisp/plat/linux.c
@@ -0,0 +1,29 @@
+#include "plat.h"
+#include <stdlib.h>
+#include <string.h>
+
+void *malloc_aligned (size_t size)
+{
+ void *mem = malloc (size + 8 + sizeof (void *) * 2);
+ void **aligned_ptr = (void **) ((uintptr_t) (mem + 8 + sizeof (void *)) & ~7);
+ aligned_ptr[ -1 ] = mem;
+ aligned_ptr[ -2 ] = (void *) size;
+ return aligned_ptr;
+}
+
+void *realloc_aligned (void *addr, size_t size)
+{
+ void *mem = malloc (size + 8 + sizeof (void *) * 2);
+ void **aligned_ptr = (void **) ((uintptr_t) (mem + 8 + sizeof (void *)) & ~7);
+ aligned_ptr[ -1 ] = mem;
+
+ memcpy (aligned_ptr, addr, (uintptr_t) aligned_ptr[ -2 ]);
+
+ return aligned_ptr;
+}
+
+void free_aligned (void *addr)
+{
+ void **ptr = (void **)addr;
+ free (ptr[ -1 ]);
+}
diff --git a/src/lisp/plat/plat.h b/src/lisp/plat/plat.h
new file mode 100644
index 0000000..227e0d2
--- /dev/null
+++ b/src/lisp/plat/plat.h
@@ -0,0 +1,11 @@
+#pragma once
+
+#include <stdint.h>
+#include <stddef.h>
+
+/* Platform specific definitions */
+
+// Must return an address aligned to 8 bytes
+void *malloc_aligned (size_t size);
+void *realloc_aligned (void *addr, size_t size);
+void free_aligned (void *addr);