Zander671/simple-lisp
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A lot more work

Browse Source
This commit is contained in:
Alexander Rosenberg 2024-09-27 04:50:47 -07:00
parent 7c642a5475
commit 7079d8925b
Signed by: Zander671
GPG Key ID: 5FD0394ADBD72730
9 changed files with 984 additions and 384 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

244
BYTECODE.md
View File

@ -24,6 +24,7 @@ The argument types are as follows:
| double | Equivilant to the C type "double" |
| reg | register (format: type:u8,which:u32) |
| str | string (format: length:u64,data:[i8]) |
| bool | boolean (format: u8) |
### Registers
Most instructions take register numbers instead of direct arguments. Registers
@ -62,12 +63,18 @@ lexenv register or "arg0" is the first argument register.
- VECTOR dest:reg, count:u64
Create a vector from the first COUNT "arg" registers and store it into DEST.
- LENGTH dest:reg, thing:reg
Place the length of the THING, a string, vector, or list, into DEST.
- INTERN\_LIT reg:reg, name:str
INTERN\_DYN reg:reg, name:reg
These instructions convert the string literal or register containing a string
NAME into a symbol and store the symbol into REG.
- TYPE_OF dest:reg, thing:reg
Place a symbol representing the type of THING into DEST.
- SYMBOL\_NAME dest:reg, sym:reg
Store the name of SYM into DEST.
@ -89,17 +96,16 @@ lexenv register or "arg0" is the first argument register.
- GET\_RETVAL\_COUNT dest:reg
Place the count last set with RETVAL\_COUNT into DEST.
- ENTER\_LEXENV
ENTER\_INHERITED\_LEXENV
LEAVE\_LEXENV
Push or restore the current lexical environment. An inherited lexenv does not
save or restore the "saved" registers.
- ENTER\_LEXENV count:u64
Enter a new lexical environment. COUNT is the number of instructions that this
environment lasts.
- ENTER\_BLOCK sym:reg, count:u64
LEAVE\_BLOCK sym:reg
Enter a new named block which is identified by the symbol in SYM. The block is
COUNT instructions long. LEAVE\_BLOCK leaved the block identified by
SYM.
- ENTER\_BLOCK name:str, count:u64
LEAVE\_BLOCK name:str
Enter a new named block which is identified by the symbol named NAME. The
block is COUNT instructions long. LEAVE\_BLOCK leaves the block identified by
NAME. LEAVE\_BLOCK will jump to the end of the block, and is not necessary
unless you want to exit the block early.
- SET\_VALUE sym:reg, value:reg
Set the value as a variable of SYM to VALUE.
@ -114,12 +120,29 @@ lexenv register or "arg0" is the first argument register.
- GET\_FUNCTION dest:reg, sym:reg
Store the value as a function of the symbol SYM into DEST.
- NEWFUNCTION\_LIT dest:reg, count:u64
NEWFUNCTION\_DYN dest:reg, src:reg
- BOUNDP dest:reg, sym:reg
If SYM has a value as a variable, place t in DEST, otherwise, place nil in DEST.
- FUNCTIONP dest:reg, sym:reg
If SYM has a value as a function, place t in DEST, otherwise, place nil in DEST.
- NEWFUNCTION\_LIT dest:reg, nreq:u32, nopt:u32, nkey:u32,
aok:bool, rest:bool, count:u64
NEWFUNCTION\_DYN dest:reg, nreq:u32, nopt:u32, nkey:u32,
aok:bool, rest:bool, src:reg
Create a new function object and store it into DEST. If the first case the
next COUNT instructions are considered to be the function and are skipped. In
the second case SRC should be a list or vector containing the bytecode for the
function.
function. NREQ, NOPT, and NKEY are the number of required, optional, and key
arguments required for this function. The names of the keyword arguments are
passed in the "arg" registers. The runtime will handle normalizing these for
you. AOK is allow other keys, REST is wether to allow more positional
arguments. Arguments are passed by the runtime in "arg" registers. The first
required argument is passed in the "arg0" register. After required are
optional arguments. These are passed in two registers. The first is either nil
or t weather or not he argument was actually passed. The second is its value,
or nil if it was not passed. The same is true for key arguments. Finally if
rest is passed, any extra arguments are passed as a list as the final element.
- PUT sym:reg, key:reg, value:reg
Associate KEY with VALUE in the plist of SYM.
@ -127,21 +150,32 @@ lexenv register or "arg0" is the first argument register.
- GET dest:reg, sym:reg, key:reg
Store the value associated with KEY in the plist of SYM into DEST.
- AND dest:reg, count:u64, values:[reg]
OR dest:reg, count:u64, values:[reg]
XOR dest:reg, count:u64, values:[reg]
NOT dest:reg, value:reg
Perform a logical operation on each of VALUES. For example, the XOR
instruction will exclusively or each of VALUES with the next value, and store
the overall result into DEST. NOT is special as it can only take one value,
of which it will take the logical negation and store it into DEST.
- AND2 dest:reg, val1:reg, val2:reg
ANDN dest:reg, count:u64
Logical and VAL1 and VAL2, or the first COUNT "arg" registers, and place the
result in DEST.
- OR2 dest:reg, val1:reg, val2:reg
ORN dest:reg, count:u64
Logical or VAL1 and VAL2, or the first COUNT "arg" registers, and place the
result in DEST.
- XOR2 dest:reg, val1:reg, val2:reg
XORN dest:reg, count:u64
Logical xor VAL1 and VAL2, or the first COUNT "arg" registers, and place the
result in DEST.
- NOT dest:reg, value:reg
Take the logical negation of VALUE and place it in DEST.
- CJMP cond:reg, offset:i64
- JMP offset:i64
CJMP cond:reg, offset:i64
If the value in COND is truthy (not nil), skip the next OFFSET
instructions. If OFFSET is negative, instead go back abs(OFFSET)
instructions. CJMP is NOT counted as an instruction for the purposes of
counting offsets. Therefore an OFFSET of -2 means restart execute at the
instruction above the instruction above this CJMP.
instruction above the instruction above this CJMP. JMP is like CJMP, but takes
no condition and always jumps.
- CAR dest:reg, cons:reg
CDR dest:reg, cons:reg
@ -151,21 +185,17 @@ lexenv register or "arg0" is the first argument register.
SETCDR cons:reg, value:reg
Store VALUE into the car or cdr of CONS.
- GETELT\_LIT dest:reg, seq:reg, index:u64
GETELT\_DYN dest:reg, seq:reg, index:reg
Store the value at INDEX in SEQ (a list or vector) into DEST.
Store the value at INDEX in SEQ (a list, string, or vector) into DEST.
- SETELT\_LIT seq:reg, index:u64, value:reg
SETELT\_DYN seq:reg, index:reg, value:reg
Store VALUE into the index numbered INDEX of SEQ (a list or vector).
Store VALUE into the index numbered INDEX of SEQ (a list, string, or vector).
- EQ\_TWO dest:reg, val1:reg, val2:reg
EQ\_N dest:reg, count:u64
- EQ dest:reg, val1:reg, val2:reg
Compare VAL1 and VAL2, if they are the same object (or symbols with the same
name) store T into DEST, otherwise, store NIL. In the case of EQ\_N, if the
first COUNT "arg" registers are the same object (or symbols with the same
name), store T into DEST, otherwise, store NIL.
name) store T into DEST, otherwise, store NIL.
- NUM\_GT dest:reg, val1:reg, val2:reg
NUM\_GE dest:reg, val1:reg, val2:reg
@ -175,99 +205,63 @@ lexenv register or "arg0" is the first argument register.
Compare VAL1 and VAL2, which must be numbers, and compare their values. If
they pass, store T into DEST, otherwise store NIL.
## Mnemonic Conversion Table
- ADD dest:reg, count:u64
Add the first COUNT "arg" registers and place the result into DEST.
- SUB dest:reg, val1:reg, val2:reg
Subtract the sum of the first COUNT - 1 "arg" registers starting from "arg1",
that is "arg1", "arg2", "arg3", etc., from "arg0". Store the result in DEST.
- MUL dest:reg, count:u64
Multiply the first COUNT "arg" registers and place the result in DEST.
| Mnemonic | Number |
|:-----------------|:------:|
| STRING\_LIT | 0 |
| STRING\_DYN | 1 |
| INT | 2 |
| FLOAT | 3 |
| CONS | 4 |
| LSIT\_LIT | 5 |
| LSIT\_DYN | 6 |
| VECTOR\_LIT | 7 |
| VECTOR\_DYN | 8 |
| INTERN\_LIT | 9 |
| INTERN\_DYN | 10 |
| SYMBOL\_NAME | 11 |
| MOV | 12 |
| FUNCALL | 13 |
| RETVAL\_COUNT | 14 |
| ENTER\_LEXENV | 15 |
| LEAVE\_ELEXENV | 16 |
| ENTER\_BLOCK | 17 |
| LEAVE\_BLOCK | 18 |
| SET\_VALUE | 19 |
| SET\_FUNCTION | 20 |
| GET\_VALUE | 21 |
| GET\_FUNCTION | 22 |
| NEWFUNCTION\_LIT | 23 |
| NEWFUNCTION\_DYN | 24 |
| PUT | 25 |
| GET | 26 |
| AND | 27 |
| OR | 28 |
| XOR | 29 |
| NOT | 30 |
| CJMP | 31 |
| CAR | 32 |
| CDR | 33 |
| SETCAR | 34 |
| SETCDR | 35 |
| GETELT\_LIT | 36 |
| GETELT\_DYN | 37 |
| SETELT\_LIT | 38 |
| SETELT\_DYN | 39 |
| EQ\_TWO | 40 |
| EQ\_N | 41 |
| NUM\_GT | 42 |
| NUM\_GE | 43 |
| NUM\_EQ | 44 |
| NUM\_LE | 45 |
| NUM\_LT | 46 |
- DIV dest:reg, count:u64
Divide "arg0" by the product of the COUNT - 1 "arg" registers starting from "arg1"
## Examples
This:
```lisp
(format t "Hello World~%")
```
Compiles into:
```text
INTERN_LIT val0, "Hello World~%"
```
- INT_DIV dest:reg, val1:reg, val2:reg
Divide VAL1 by VAL2 and place the integer part of the result in DEST.
- RECIP dest:reg, val:reg
Divide 1 by VAL and place the result in DEST.
This:
```lisp
(defun foo (bar &key baz &rest qux)
"FOO each of BAR and BAZ as well as each of QUX."
(let (some-val (genval bar))
(foo-internal some-val :baz baz qux)))
(foo 10 :baz 20)
```
Compiles into:
```text
NEWFUNCTION val0, 13 ;; not counting this instruction
ENTER_LEXENV
INTERN_LIT saved0, "foo"
ENTER_BLOCK saved0, 9 ;; not counting this instruction
INTERN_LIT val0, "genval"
;; NOTE bar already in arg0
FUNCALL val0 ;; NOTE val0 clobbered here
INTERN_LIT val0, "foo-internal"
MOV arg0, ret0
MOV arg3, arg2
MOV arg2, arg1
INTERN_LIT arg1, ":baz"
FUNCALL val0
LEAVE_BLOCK saved0
LEAVE_LEXENV
INTERN_LIT val1, "foo"
SET_FUNCTION val1, val0
INT arg0, 10
INTERN_LIT arg1, ":baz"
INT arg2, 20
FUNCALL val1
```
- MOD dest:reg, val1:reg, val2:reg
Divide VAL1 by VAL2 and place the remainder in DEST.
- SQRT dest:reg, val:reg
Take the square root of VAL and place it in DEST.
- POW dest:reg, base:reg, exp:reg
Raise BASE to the EXP power and place the result in DEST.
- LN dest:reg, val:reg
Take the natural log of VAL and place the result in DEST.
- EXP dest:reg, val:reg
Take the exponential function at VAL and place the result in DEST.
- SIN dest:reg, val:reg
COS dest:reg, val:reg
TAN dest:reg, val:reg
Take the sine, cosine, or tangent of VAL (in radians) and place it into DEST.
- ASIN dest:reg, val:reg
ACOS dest:reg, val:reg
ATAN dest:reg, val:reg
Take the inverse sine, cosine, or tangent of VAL and place the result (in
radians) into DEST.
- BITAND dest:reg, val1:reg, val2:reg
BITOR dest:reg, val1:reg, val2:reg
BITXOR dest:reg, val1:reg, val2:reg
BITNOR dest:reg, val1:reg, val2:reg
Perform the given bit-wise operation on VAL1 and VAL2 and place the result
into DEST.
- BITNEG dest:reg, val:reg
Negate each bit in VAL. That is, flip each bit in VAL.
- LSH dest:reg, val:reg, by:reg
ASH dest:reg, val:reg, by:reg
Either logically or arithmetically shift VAL by BY bits to the left (or right
is BY is negative). Put the result in DEST.

2
CMakeLists.txt
View File

@ -14,3 +14,5 @@ endforeach()
add_executable(bootstrap-slc ${REAL_BOOTSTRAP_FILES})
target_link_libraries(bootstrap-slc m)
# target_link_libraries(bootstrap-slc m "-fsanitize=undefined" "-fsanitize=address")
# target_compile_options(bootstrap-slc PUBLIC "-fsanitize=undefined" "-fsanitize=address")

2
bootstrap/ast.c
View File

@ -262,7 +262,6 @@ static AstIntNode *process_char_token(Token *token, AstErrorList **err) {
if (!convert_named_char_escape(sym + 1, &c) &&
!convert_c_style_char_escape(sym + 1, &c) &&
!convert_numeric_char_escape(sym + 1, &c, false)) {
free(token->text);
free(node);
push_build_error(err, token, 0,
"invalid escape sequence in character literal");
@ -676,6 +675,7 @@ static AstNode *process_token(Token *token, TokenStream *stream,
abort();
break;
}
free(token->text);
return retval;
}

910
bootstrap/compile.c
View File

File diff suppressed because it is too large Load Diff

4
bootstrap/compile.h
View File

@ -98,7 +98,7 @@ typedef struct {
CompileLexenv *lexenv_stack;
// the minimum var register that is safe to use
uint32_t first_available_var;
uint32_t first_available_val;
AstQuoteType quote;
} CompileEnvironment;
@ -107,5 +107,7 @@ void destroy_compile_environment(CompileEnvironment *env);
ssize_t byte_compile_form(CompileEnvironment *env, AstNode *form, FILE *stream,
CompileError **err);
void load_toplevel_definition(CompileEnvironment *env, AstNode *form,
CompileError **err);
#endif

41
bootstrap/constants.c
View File

@ -9,29 +9,36 @@ const char *INSTRUCTION_NAMES[] = {
[INST_CONS] = "CONS",
[INST_LIST] = "LIST",
[INST_VECTOR] = "VECTOR",
[INST_LENGTH] = "LENGTH",
[INST_INTERN_LIT] = "INTERN_LIT",
[INST_INTERN_DYN] = "INTERN_DYN",
[INST_TYPE_OF] = "TYPE_OF",
[INST_SYMBOL_NAME] = "SYMBOL_NAME",
[INST_MOV] = "MOV",
[INST_FUNCALL] = "FUNCALL",
[INST_RETVAL_COUNT] = "RETVAL_COUNT",
[INST_GET_RETVAL_COUNT] = "GET_RETVAL_COUNT",
[INST_ENTER_LEXENV] = "ENTER_LEXENV",
[INST_ENTER_INHERITED_LEXENV] = "ENTER_INHERITED_LEXENV",
[INST_LEAVE_LEXENV] = "LEAVE_LEXENV",
[INST_ENTER_BLOCK] = "ENTER_BLOCK",
[INST_LEAVE_BLOCK] = "LEAVE_BLOCK",
[INST_SET_VALUE] = "SET_VALUE",
[INST_SET_FUNCTION] = "SET_FUNCTION",
[INST_GET_VALUE] = "GET_VALUE",
[INST_GET_FUNCTION] = "GET_FUNCTION",
[INST_BOUNDP] = "BOUNDP",
[INST_FUNCTIONP] = "FUNCTIONP",
[INST_NEWFUNCTION_LIT] = "NEWFUNCTION_LIT",
[INST_NEWFUNCTION_DYN] = "NEWFUNCTION_DYN",
[INST_PUT] = "PUT",
[INST_GET] = "GET",
[INST_AND] = "AND",
[INST_ANDN] = "ANDN",
[INST_OR] = "OR",
[INST_ORN] = "ORN",
[INST_XOR] = "XOR",
[INST_XORN] = "XORN",
[INST_NOT] = "NOT",
[INST_JMP] = "JMP",
[INST_CJMP] = "CJMP",
[INST_CAR] = "CAR",
[INST_CDR] = "CDR",
@ -41,13 +48,39 @@ const char *INSTRUCTION_NAMES[] = {
[INST_GETELT_DYN] = "GETELT_DYN",
[INST_SETELT_LIT] = "SETELT_LIT",
[INST_SETELT_DYN] = "SETELT_DYN",
[INST_EQ_TWO] = "EQ_TWO",
[INST_EQ_N] = "EQ_N",
[INST_EQ] = "EQ",
[INST_NUM_GT] = "NUM_GT",
[INST_NUM_GE] = "NUM_GE",
[INST_NUM_EQ] = "NUM_EQ",
[INST_NUM_LE] = "NUM_LE",
[INST_NUM_LT] = "NUM_LT",
[INST_ADD] = "ADD",
[INST_ADDN] = "ADDN",
[INST_SUB] = "SUB",
[INST_SUBN] = "SUBN",
[INST_MUL] = "MUL",
[INST_MULN] = "MULN",
[INST_DIV] = "DIV",
[INST_INT_DIV] = "INT_DIV",
[INST_RECIP] = "RECIP",
[INST_MOD] = "MOD",
[INST_SQRT] = "SQRT",
[INST_POW] = "POW",
[INST_LN] = "LN",
[INST_EXP] = "EXP",
[INST_SIN] = "SIN",
[INST_COS] = "COS",
[INST_TAN] = "TAN",
[INST_ASIN] = "ASIN",
[INST_ACOS] = "ACOS",
[INST_ATAN] = "ATAN",
[INST_BITAND] = "BITAND",
[INST_BITOR] = "BITOR",
[INST_BITXOR] = "BITXOR",
[INST_BITNOR] = "BITNOR",
[INST_BITNEG] = "BITNEG",
[INST_LSH] = "LSH",
[INST_ASH] = "ASH",
};
const char *REGISTER_NAMES[] = {

130
bootstrap/constants.h
View File

@ -5,55 +5,87 @@
typedef uint16_t LispInst;
#define INST_NIL ((LispInst) 0)
#define INST_T ((LispInst) 1)
#define INST_STRING ((LispInst) 2)
#define INST_INT ((LispInst) 3)
#define INST_FLOAT ((LispInst) 4)
#define INST_CONS ((LispInst) 5)
#define INST_LIST ((LispInst) 6)
#define INST_VECTOR ((LispInst) 7)
#define INST_INTERN_LIT ((LispInst) 8)
#define INST_INTERN_DYN ((LispInst) 9)
#define INST_SYMBOL_NAME ((LispInst) 10)
#define INST_MOV ((LispInst) 11)
#define INST_FUNCALL ((LispInst) 12)
#define INST_RETVAL_COUNT ((LispInst) 13)
#define INST_ENTER_LEXENV ((LispInst) 14)
#define INST_ENTER_INHERITED_LEXENV ((LispInst) 15)
#define INST_LEAVE_LEXENV ((LispInst) 16)
#define INST_ENTER_BLOCK ((LispInst) 17)
#define INST_LEAVE_BLOCK ((LispInst) 18)
#define INST_SET_VALUE ((LispInst) 19)
#define INST_SET_FUNCTION ((LispInst) 20)
#define INST_GET_VALUE ((LispInst) 21)
#define INST_GET_FUNCTION ((LispInst) 22)
#define INST_NEWFUNCTION_LIT ((LispInst) 23)
#define INST_NEWFUNCTION_DYN ((LispInst) 24)
#define INST_PUT ((LispInst) 25)
#define INST_GET ((LispInst) 26)
#define INST_AND ((LispInst) 27)
#define INST_OR ((LispInst) 28)
#define INST_XOR ((LispInst) 29)
#define INST_NOT ((LispInst) 30)
#define INST_CJMP ((LispInst) 31)
#define INST_CAR ((LispInst) 32)
#define INST_CDR ((LispInst) 33)
#define INST_SETCAR ((LispInst) 34)
#define INST_SETCDR ((LispInst) 35)
#define INST_GETELT_LIT ((LispInst) 36)
#define INST_GETELT_DYN ((LispInst) 37)
#define INST_SETELT_LIT ((LispInst) 38)
#define INST_SETELT_DYN ((LispInst) 39)
#define INST_EQ_TWO ((LispInst) 40)
#define INST_EQ_N ((LispInst) 41)
#define INST_NUM_GT ((LispInst) 42)
#define INST_NUM_GE ((LispInst) 43)
#define INST_NUM_EQ ((LispInst) 44)
#define INST_NUM_LE ((LispInst) 45)
#define INST_NUM_LT ((LispInst) 46)
#define N_INSTRUCTIONS ((LispInst) 47)
#define INST_NIL ((LispInst) 0)
#define INST_T ((LispInst) 1)
#define INST_STRING ((LispInst) 2)
#define INST_INT ((LispInst) 3)
#define INST_FLOAT ((LispInst) 4)
#define INST_CONS ((LispInst) 5)
#define INST_LIST ((LispInst) 6)
#define INST_VECTOR ((LispInst) 7)
#define INST_LENGTH ((LispInst) 8)
#define INST_INTERN_LIT ((LispInst) 9)
#define INST_INTERN_DYN ((LispInst) 10)
#define INST_TYPE_OF ((LispInst) 11)
#define INST_SYMBOL_NAME ((LispInst) 12)
#define INST_MOV ((LispInst) 13)
#define INST_FUNCALL ((LispInst) 14)
#define INST_RETVAL_COUNT ((LispInst) 15)
#define INST_GET_RETVAL_COUNT ((LispInst) 16)
#define INST_ENTER_LEXENV ((LispInst) 17)
#define INST_ENTER_BLOCK ((LispInst) 18)
#define INST_LEAVE_BLOCK ((LispInst) 19)
#define INST_SET_VALUE ((LispInst) 20)
#define INST_SET_FUNCTION ((LispInst) 21)
#define INST_GET_VALUE ((LispInst) 22)
#define INST_GET_FUNCTION ((LispInst) 23)
#define INST_BOUNDP ((LispInst) 24)
#define INST_FUNCTIONP ((LispInst) 25)
#define INST_NEWFUNCTION_LIT ((LispInst) 26)
#define INST_NEWFUNCTION_DYN ((LispInst) 27)
#define INST_PUT ((LispInst) 28)
#define INST_GET ((LispInst) 29)
#define INST_AND ((LispInst) 30)
#define INST_ANDN ((LispInst) 31)
#define INST_OR ((LispInst) 32)
#define INST_ORN ((LispInst) 33)
#define INST_XOR ((LispInst) 34)
#define INST_XORN ((LispInst) 35)
#define INST_NOT ((LispInst) 36)
#define INST_JMP ((LispInst) 37)
#define INST_CJMP ((LispInst) 38)
#define INST_CAR ((LispInst) 39)
#define INST_CDR ((LispInst) 40)
#define INST_SETCAR ((LispInst) 41)
#define INST_SETCDR ((LispInst) 42)
#define INST_GETELT_LIT ((LispInst) 43)
#define INST_GETELT_DYN ((LispInst) 44)
#define INST_SETELT_LIT ((LispInst) 45)
#define INST_SETELT_DYN ((LispInst) 46)
#define INST_EQ ((LispInst) 47)
#define INST_NUM_GT ((LispInst) 48)
#define INST_NUM_GE ((LispInst) 49)
#define INST_NUM_EQ ((LispInst) 50)
#define INST_NUM_LE ((LispInst) 51)
#define INST_NUM_LT ((LispInst) 52)
#define INST_ADD ((LispInst) 53)
#define INST_ADDN ((LispInst) 54)
#define INST_SUB ((LispInst) 55)
#define INST_SUBN ((LispInst) 56)
#define INST_MUL ((LispInst) 57)
#define INST_MULN ((LispInst) 58)
#define INST_DIV ((LispInst) 59)
#define INST_INT_DIV ((LispInst) 60)
#define INST_RECIP ((LispInst) 61)
#define INST_MOD ((LispInst) 62)
#define INST_SQRT ((LispInst) 63)
#define INST_POW ((LispInst) 64)
#define INST_LN ((LispInst) 65)
#define INST_EXP ((LispInst) 66)
#define INST_SIN ((LispInst) 67)
#define INST_COS ((LispInst) 68)
#define INST_TAN ((LispInst) 69)
#define INST_ASIN ((LispInst) 70)
#define INST_ACOS ((LispInst) 71)
#define INST_ATAN ((LispInst) 72)
#define INST_BITAND ((LispInst) 73)
#define INST_BITOR ((LispInst) 74)
#define INST_BITXOR ((LispInst) 75)
#define INST_BITNOR ((LispInst) 76)
#define INST_BITNEG ((LispInst) 77)
#define INST_LSH ((LispInst) 78)
#define INST_ASH ((LispInst) 79)
#define N_INSTRUCTIONS ((LispInst) 80)
extern const char *INSTRUCTION_NAMES[];

18
bootstrap/main.c
View File

@ -4,6 +4,23 @@
#include "ast.h"
#include "compile.h"
static const char NATIVE_DEFUNS[] =
"(defun native-write (bytes-or-string &key stream start end))";
static void register_native_defuns(CompileEnvironment *env) {
FILE *in = fmemopen((char *) NATIVE_DEFUNS, sizeof(NATIVE_DEFUNS) - 1, "r");
TokenStream *stream = make_token_stream(in);
while (!token_stream_is_eof(stream)) {
AstNode *node = ast_next_toplevel(stream, NULL);
if (node) {
load_toplevel_definition(env, node, NULL);
}
destroy_ast_node(node);
}
destroy_token_stream(stream);
}
int main(int argc, const char **argv) {
ast_init_parser();
FILE *file = fopen("bootstrap/test.sl", "r");
@ -13,6 +30,7 @@ int main(int argc, const char **argv) {
TokenStream *stream = make_token_stream(file);
COMPILE_FORMAT = COMPILE_FORMAT_ASM;
CompileEnvironment *env = make_compile_environment();
register_native_defuns(env);
AstErrorList *ast_errs;
CompileError *comp_errs;
while (!token_stream_is_eof(stream)) {

17
bootstrap/test.sl
View File

@ -1,3 +1,14 @@
(defun name_here ()
"Test defun"
"a")
(defun stringp (obj)
(eq (type-of obj) 'string))
(defun greet-with (message &key stream)
(native-write message :stream stream))
(defun be-sad ()
(native-write "Ok, bye then\n"))
(if (stringp *msg*)
(progn
(greet-with *msg*))
(be-sad))