ref: b10d2c77fe846bec5e7ddaca8138cff44f360ba3
parent: df52f0700401359e68f2c67440c0015af36f25e2
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sun Mar 26 16:55:06 EDT 2023
generate builtin table for C code as well
--- a/Makefile
+++ b/Makefile
@@ -33,7 +33,7 @@
.c.o:
${CC} -o $@ -c $< ${CFLAGS} -Iposix -Illt-flisp.o: flisp.c cvalues.c operators.c types.c flisp.h print.c read.c equal.c maxstack.inc
+flisp.o: flisp.c cvalues.c operators.c types.c flisp.h print.c read.c equal.c maxstack.inc opcodes.h
flmain.o: flmain.c boot.h flisp.h
boot.h: flisp.boot
--- a/flisp.c
+++ b/flisp.c
@@ -31,7 +31,6 @@
#include "llt.h"
#include "flisp.h"
-#include "opcodes.h"
typedef struct Builtin Builtin;
@@ -42,43 +41,7 @@
#define ANYARGS -10000
-static const Builtin builtins[] = {- // predicates
- [OP_EQ] = {"eq?", 2},- [OP_EQV] = {"eqv?", 2},- [OP_EQUAL] = {"equal?", 2},- [OP_ATOMP] = {"atom?", 1},- [OP_NOT] = {"not", 1},- [OP_NULLP] = {"null?", 1},- [OP_BOOLEANP] = {"boolean?", 1},- [OP_SYMBOLP] = {"symbol?", 1},- [OP_NUMBERP] = {"number?", 1},- [OP_BOUNDP] = {"bound?", 1},- [OP_PAIRP] = {"pair?", 1},- [OP_BUILTINP] = {"builtin?", 1},- [OP_VECTORP] = {"vector?", 1},- [OP_FIXNUMP] = {"fixnum?", 1},- [OP_FUNCTIONP] = {"function?", 1},- [OP_CONS] = {"cons", 2},- [OP_LIST] = {"list", ANYARGS},- [OP_CDR] = {"cdr", 1},- [OP_CAR] = {"car", 1},- [OP_CADR] = {"cadr", 1},- [OP_SETCAR] = {"set-car!", 2},- [OP_SETCDR] = {"set-cdr!", 2},- [OP_APPLY] = {"apply", -2},- [OP_ADD] = {"+", ANYARGS},- [OP_SUB] = {"-", -1},- [OP_MUL] = {"*", ANYARGS},- [OP_DIV] = {"/", -1},- [OP_IDIV] = {"div0", 2},- [OP_NUMEQ] = {"=", 2},- [OP_LT] = {"<", 2},- [OP_COMPARE] = {"compare", 2},- [OP_AREF] = {"aref", 2},- [OP_VECTOR] = {"vector", ANYARGS},- [OP_ASET] = {"aset!", 3},-};
+#include "opcodes.h"
int isbuiltin(value_t x)
{--- a/gen.lsp
+++ b/gen.lsp
@@ -1,102 +1,101 @@
(define opcodes '(
; C opcode, lisp compiler opcode, arg count, builtin lambda
- OP_LOADA0 loada0 #f 0
- OP_LOADA1 loada1 #f 0
- OP_LOADV loadv #f 0
- OP_BRF brf #f 0
- OP_POP pop #f 0
- OP_CALL call #f 0
- OP_TCALL tcall #f 0
- OP_LOADG loadg #f 0
- OP_LOADA loada #f 0
- OP_LOADC loadc #f 0
- OP_RET ret #f 0
- OP_DUP dup #f 0
- OP_CAR car 1 (lambda (x) (car x))
- OP_CDR cdr 1 (lambda (x) (cdr x))
- OP_CLOSURE closure #f 0
- OP_SETA seta #f 0
- OP_JMP jmp #f 0
- OP_LOADC00 loadc00 #f 0
- OP_PAIRP pair? 1 (lambda (x) (pair? x))
- OP_BRNE brne #f 0
- OP_LOADT loadt #f 0
- OP_LOAD0 load0 #f 0
- OP_LOADC01 loadc01 #f 0
- OP_AREF aref 2 (lambda (x y) (aref x y))
- OP_ATOMP atom? 1 (lambda (x) (atom? x))
- OP_BRT brt #f 0
- OP_BRNN brnn #f 0
- OP_LOAD1 load1 #f 0
- OP_LT < 2 (lambda (x y) (< x y))
- OP_ADD2 add2 #f 0
- OP_SETCDR set-cdr! 2 (lambda (x y) (set-cdr! x y))
- OP_LOADF loadf #f 0
- OP_CONS cons 2 (lambda (x y) (cons x y))
- OP_EQ eq? 2 (lambda (x y) (eq? x y))
- OP_SYMBOLP symbol? 1 (lambda (x) (symbol? x))
- OP_NOT not 1 (lambda (x) (not x))
-
- OP_CADR cadr 1 (lambda (x) (cadr x))
- OP_NEG neg #f 0
- OP_NULLP null? 1 (lambda (x) (null? x))
- OP_BOOLEANP boolean? 1 (lambda (x) (boolean? x))
- OP_NUMBERP number? 1 (lambda (x) (number? x))
- OP_FIXNUMP fixnum? 1 (lambda (x) (fixnum? x))
- OP_BOUNDP bound? 1 (lambda (x) (bound? x))
- OP_BUILTINP builtin? 1 (lambda (x) (builtin? x))
- OP_FUNCTIONP function? 1 (lambda (x) (function? x))
- OP_VECTORP vector? 1 (lambda (x) (vector? x))
- OP_NOP nop #f 0
- OP_SETCAR set-car! 2 (lambda (x y) (set-car! x y))
- OP_JMPL jmp.l #f 0
- OP_BRFL brf.l #f 0
- OP_BRTL brt.l #f 0
- OP_EQV eqv? 2 (lambda (x y) (eqv? x y))
- OP_EQUAL equal? 2 (lambda (x y) (equal? x y))
- OP_LIST list #f (lambda rest rest)
- OP_APPLY apply #f (lambda rest (apply apply rest))
- OP_ADD + #f (lambda rest (apply + rest))
- OP_SUB - #f (lambda rest (apply - rest))
- OP_MUL * #f (lambda rest (apply * rest))
- OP_DIV / #f (lambda rest (apply / rest))
- OP_IDIV div0 2 (lambda rest (apply div0 rest))
- OP_NUMEQ = 2 (lambda (x y) (= x y))
- OP_COMPARE compare 2 (lambda (x y) (compare x y))
- OP_ARGC argc #f 0
- OP_VECTOR vector #f (lambda rest (apply vector rest))
- OP_ASET aset! 3 (lambda (x y z) (aset! x y z))
- OP_LOADNIL loadnil #f 0
- OP_LOADI8 loadi8 #f 0
- OP_LOADVL loadv.l #f 0
- OP_LOADGL loadg.l #f 0
- OP_LOADAL loada.l #f 0
- OP_LOADCL loadc.l #f 0
- OP_SETG setg #f 0
- OP_SETGL setg.l #f 0
- OP_SETAL seta.l #f 0
- OP_SETC setc #f 0
- OP_SETCL setc.l #f 0
- OP_VARGC vargc #f 0
- OP_TRYCATCH trycatch #f 0
- OP_FOR for #f 0
- OP_TAPPLY tapply #f 0
- OP_SUB2 sub2 #f 0
- OP_LARGC largc #f 0
- OP_LVARGC lvargc #f 0
- OP_CALLL call.l #f 0
- OP_TCALLL tcall.l #f 0
- OP_BRNEL brne.l #f 0
- OP_BRNNL brnn.l #f 0
- OP_BRN brn #f 0
- OP_BRNL brn.l #f 0
- OP_OPTARGS optargs #f 0
- OP_BRBOUND brbound #f 0
- OP_KEYARGS keyargs #f 0
- OP_BOOL_CONST_F dummy_f #f 0
- OP_BOOL_CONST_T dummy_t #f 0
- OP_THE_EMPTY_LIST dummy_nil #f 0
- OP_EOF_OBJECT dummy_eof #f 0
+ OP_LOADA0 loada0 #f 0
+ OP_LOADA1 loada1 #f 0
+ OP_LOADV loadv #f 0
+ OP_BRF brf #f 0
+ OP_POP pop #f 0
+ OP_CALL call #f 0
+ OP_TCALL tcall #f 0
+ OP_LOADG loadg #f 0
+ OP_LOADA loada #f 0
+ OP_LOADC loadc #f 0
+ OP_RET ret #f 0
+ OP_DUP dup #f 0
+ OP_CAR car 1 (lambda (x) (car x))
+ OP_CDR cdr 1 (lambda (x) (cdr x))
+ OP_CLOSURE closure #f 0
+ OP_SETA seta #f 0
+ OP_JMP jmp #f 0
+ OP_LOADC00 loadc00 #f 0
+ OP_PAIRP pair? 1 (lambda (x) (pair? x))
+ OP_BRNE brne #f 0
+ OP_LOADT loadt #f 0
+ OP_LOAD0 load0 #f 0
+ OP_LOADC01 loadc01 #f 0
+ OP_AREF aref 2 (lambda (x y) (aref x y))
+ OP_ATOMP atom? 1 (lambda (x) (atom? x))
+ OP_BRT brt #f 0
+ OP_BRNN brnn #f 0
+ OP_LOAD1 load1 #f 0
+ OP_LT < 2 (lambda (x y) (< x y))
+ OP_ADD2 add2 #f 0
+ OP_SETCDR set-cdr! 2 (lambda (x y) (set-cdr! x y))
+ OP_LOADF loadf #f 0
+ OP_CONS cons 2 (lambda (x y) (cons x y))
+ OP_EQ eq? 2 (lambda (x y) (eq? x y))
+ OP_SYMBOLP symbol? 1 (lambda (x) (symbol? x))
+ OP_NOT not 1 (lambda (x) (not x))
+ OP_CADR cadr 1 (lambda (x) (cadr x))
+ OP_NEG neg #f 0
+ OP_NULLP null? 1 (lambda (x) (null? x))
+ OP_BOOLEANP boolean? 1 (lambda (x) (boolean? x))
+ OP_NUMBERP number? 1 (lambda (x) (number? x))
+ OP_FIXNUMP fixnum? 1 (lambda (x) (fixnum? x))
+ OP_BOUNDP bound? 1 (lambda (x) (bound? x))
+ OP_BUILTINP builtin? 1 (lambda (x) (builtin? x))
+ OP_FUNCTIONP function? 1 (lambda (x) (function? x))
+ OP_VECTORP vector? 1 (lambda (x) (vector? x))
+ OP_NOP nop #f 0
+ OP_SETCAR set-car! 2 (lambda (x y) (set-car! x y))
+ OP_JMPL jmp.l #f 0
+ OP_BRFL brf.l #f 0
+ OP_BRTL brt.l #f 0
+ OP_EQV eqv? 2 (lambda (x y) (eqv? x y))
+ OP_EQUAL equal? 2 (lambda (x y) (equal? x y))
+ OP_LIST list ANYARGS (lambda rest rest)
+ OP_APPLY apply -2 (lambda rest (apply apply rest))
+ OP_ADD + ANYARGS (lambda rest (apply + rest))
+ OP_SUB - -1 (lambda rest (apply - rest))
+ OP_MUL * ANYARGS (lambda rest (apply * rest))
+ OP_DIV / -1 (lambda rest (apply / rest))
+ OP_IDIV div0 2 (lambda rest (apply div0 rest))
+ OP_NUMEQ = 2 (lambda (x y) (= x y))
+ OP_COMPARE compare 2 (lambda (x y) (compare x y))
+ OP_ARGC argc #f 0
+ OP_VECTOR vector ANYARGS (lambda rest (apply vector rest))
+ OP_ASET aset! 3 (lambda (x y z) (aset! x y z))
+ OP_LOADNIL loadnil #f 0
+ OP_LOADI8 loadi8 #f 0
+ OP_LOADVL loadv.l #f 0
+ OP_LOADGL loadg.l #f 0
+ OP_LOADAL loada.l #f 0
+ OP_LOADCL loadc.l #f 0
+ OP_SETG setg #f 0
+ OP_SETGL setg.l #f 0
+ OP_SETAL seta.l #f 0
+ OP_SETC setc #f 0
+ OP_SETCL setc.l #f 0
+ OP_VARGC vargc #f 0
+ OP_TRYCATCH trycatch #f 0
+ OP_FOR for #f 0
+ OP_TAPPLY tapply #f 0
+ OP_SUB2 sub2 #f 0
+ OP_LARGC largc #f 0
+ OP_LVARGC lvargc #f 0
+ OP_CALLL call.l #f 0
+ OP_TCALLL tcall.l #f 0
+ OP_BRNEL brne.l #f 0
+ OP_BRNNL brnn.l #f 0
+ OP_BRN brn #f 0
+ OP_BRNL brn.l #f 0
+ OP_OPTARGS optargs #f 0
+ OP_BRBOUND brbound #f 0
+ OP_KEYARGS keyargs #f 0
+ OP_BOOL_CONST_F dummy_f #f 0
+ OP_BOOL_CONST_T dummy_t #f 0
+ OP_THE_EMPTY_LIST dummy_nil #f 0
+ OP_EOF_OBJECT dummy_eof #f 0
))
(define (drop lst n)
@@ -112,6 +111,7 @@
(instructions (file "instructions.lsp" :write :create :truncate))
(builtins (file "builtins.lsp" :write :create :truncate))
(e (table))
+ (cl (table))
(ac (table))
(lms ())
(i 0))
@@ -125,11 +125,23 @@
(io.write c-header ",\n")
(put! e lop i)
- (if argc (put! ac lop argc))
+ (if argc (put! cl cop (list lop argc)))
+ (if (and (number? argc) (>= argc 0)) (put! ac lop argc))
(set! lms (cons f lms))
(set! i (1+ i))))
opcodes 4)
- (io.write c-header " N_OPCODES\n};\n")
+ (io.write c-header " N_OPCODES\n};\n\n")
+ (io.write c-header "static const Builtin builtins[] = {\n")+ (table.foreach
+ (lambda (c la) (begin (io.write c-header " [")
+ (write c c-header)
+ (io.write c-header "] = {\"")+ (write (car la) c-header)
+ (io.write c-header "\", ")
+ (write (cadr la) c-header)
+ (io.write c-header "},\n")))
+ cl)
+ (io.write c-header "};\n")
(io.close c-header)
(write `(define Instructions ,e) instructions)
--- a/mkfile
+++ b/mkfile
@@ -10,7 +10,6 @@
equal.c\
equalhash.h\
flisp.h\
- opcodes.h\
operators.c\
print.c\
read.c\
@@ -37,7 +36,9 @@
boot.h: flisp.boot
sed 's,\\,\\\\,g;s,",\\",g;s,^,",g;s,$,\\n",g' $prereq >$target
-flmain.$O: boot.h maxstack.inc
+flmain.$O: boot.h
+
+flisp.$O: maxstack.inc opcodes.h
bootstrap:V: $O.out
cp flisp.boot flisp.boot.bak && \
--- a/opcodes.h
+++ b/opcodes.h
@@ -97,3 +97,40 @@
OP_EOF_OBJECT,
N_OPCODES
};
+
+static const Builtin builtins[] = {+ [OP_NUMBERP] = {"number?", 1},+ [OP_NUMEQ] = {"=", 2},+ [OP_BOOLEANP] = {"boolean?", 1},+ [OP_IDIV] = {"div0", 2},+ [OP_DIV] = {"/", -1},+ [OP_PAIRP] = {"pair?", 1},+ [OP_ATOMP] = {"atom?", 1},+ [OP_SYMBOLP] = {"symbol?", 1},+ [OP_APPLY] = {"apply", -2},+ [OP_BOUNDP] = {"bound?", 1},+ [OP_EQV] = {"eqv?", 2},+ [OP_NOT] = {"not", 1},+ [OP_SUB] = {"-", -1},+ [OP_NULLP] = {"null?", 1},+ [OP_CAR] = {"car", 1},+ [OP_VECTOR] = {"vector", ANYARGS},+ [OP_ASET] = {"aset!", 3},+ [OP_FUNCTIONP] = {"function?", 1},+ [OP_EQ] = {"eq?", 2},+ [OP_BUILTINP] = {"builtin?", 1},+ [OP_LIST] = {"list", ANYARGS},+ [OP_AREF] = {"aref", 2},+ [OP_FIXNUMP] = {"fixnum?", 1},+ [OP_VECTORP] = {"vector?", 1},+ [OP_ADD] = {"+", ANYARGS},+ [OP_CONS] = {"cons", 2},+ [OP_SETCDR] = {"set-cdr!", 2},+ [OP_COMPARE] = {"compare", 2},+ [OP_SETCAR] = {"set-car!", 2},+ [OP_LT] = {"<", 2},+ [OP_EQUAL] = {"equal?", 2},+ [OP_MUL] = {"*", ANYARGS},+ [OP_CADR] = {"cadr", 1},+ [OP_CDR] = {"cdr", 1},+};