shithub: femtolisp

Download patch

ref: b10d2c77fe846bec5e7ddaca8138cff44f360ba3
parent: df52f0700401359e68f2c67440c0015af36f25e2
author: Sigrid Solveig Haflínudóttir <[email protected]>
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},
+};