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

238
BYTECODE.md
View File

@ -24,6 +24,7 @@ The argument types are as follows:
| double | Equivilant to the C type "double" | | double | Equivilant to the C type "double" |
| reg | register (format: type:u8,which:u32) | | reg | register (format: type:u8,which:u32) |
| str | string (format: length:u64,data:[i8]) | | str | string (format: length:u64,data:[i8]) |
| bool | boolean (format: u8) |
### Registers ### Registers
Most instructions take register numbers instead of direct arguments. Registers Most instructions take register numbers instead of direct arguments. Registers
@ -63,11 +64,17 @@ lexenv register or "arg0" is the first argument register.
- VECTOR dest:reg, count:u64 - VECTOR dest:reg, count:u64
Create a vector from the first COUNT "arg" registers and store it into DEST. 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\_LIT reg:reg, name:str
INTERN\_DYN reg:reg, name:reg INTERN\_DYN reg:reg, name:reg
These instructions convert the string literal or register containing a string These instructions convert the string literal or register containing a string
NAME into a symbol and store the symbol into REG. 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 - SYMBOL\_NAME dest:reg, sym:reg
Store the name of SYM into DEST. 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 - GET\_RETVAL\_COUNT dest:reg
Place the count last set with RETVAL\_COUNT into DEST. Place the count last set with RETVAL\_COUNT into DEST.
- ENTER\_LEXENV - ENTER\_LEXENV count:u64
ENTER\_INHERITED\_LEXENV Enter a new lexical environment. COUNT is the number of instructions that this
LEAVE\_LEXENV environment lasts.
Push or restore the current lexical environment. An inherited lexenv does not
save or restore the "saved" registers.
- ENTER\_BLOCK sym:reg, count:u64 - ENTER\_BLOCK name:str, count:u64
LEAVE\_BLOCK sym:reg LEAVE\_BLOCK name:str
Enter a new named block which is identified by the symbol in SYM. The block is Enter a new named block which is identified by the symbol named NAME. The
COUNT instructions long. LEAVE\_BLOCK leaved the block identified by block is COUNT instructions long. LEAVE\_BLOCK leaves the block identified by
SYM. 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\_VALUE sym:reg, value:reg
Set the value as a variable of SYM to VALUE. 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 - GET\_FUNCTION dest:reg, sym:reg
Store the value as a function of the symbol SYM into DEST. Store the value as a function of the symbol SYM into DEST.
- NEWFUNCTION\_LIT dest:reg, count:u64 - BOUNDP dest:reg, sym:reg
NEWFUNCTION\_DYN dest:reg, src: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 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 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 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 - PUT sym:reg, key:reg, value:reg
Associate KEY with VALUE in the plist of SYM. 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 - GET dest:reg, sym:reg, key:reg
Store the value associated with KEY in the plist of SYM into DEST. Store the value associated with KEY in the plist of SYM into DEST.
- AND dest:reg, count:u64, values:[reg] - AND2 dest:reg, val1:reg, val2:reg
OR dest:reg, count:u64, values:[reg] ANDN dest:reg, count:u64
XOR dest:reg, count:u64, values:[reg] Logical and VAL1 and VAL2, or the first COUNT "arg" registers, and place the
NOT dest:reg, value:reg result in DEST.
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.
- CJMP cond:reg, offset:i64 - 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.
- JMP offset:i64
CJMP cond:reg, offset:i64
If the value in COND is truthy (not nil), skip the next OFFSET If the value in COND is truthy (not nil), skip the next OFFSET
instructions. If OFFSET is negative, instead go back abs(OFFSET) instructions. If OFFSET is negative, instead go back abs(OFFSET)
instructions. CJMP is NOT counted as an instruction for the purposes of instructions. CJMP is NOT counted as an instruction for the purposes of
counting offsets. Therefore an OFFSET of -2 means restart execute at the 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 - CAR dest:reg, cons:reg
CDR 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 SETCDR cons:reg, value:reg
Store VALUE into the car or cdr of CONS. Store VALUE into the car or cdr of CONS.
- GETELT\_LIT dest:reg, seq:reg, index:u64 - GETELT\_LIT dest:reg, seq:reg, index:u64
GETELT\_DYN dest:reg, seq:reg, index:reg 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\_LIT seq:reg, index:u64, value:reg
SETELT\_DYN seq:reg, index:reg, 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 dest:reg, val1:reg, val2:reg
EQ\_N dest:reg, count:u64
Compare VAL1 and VAL2, if they are the same object (or symbols with the same 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 name) store T into DEST, otherwise, store NIL.
first COUNT "arg" registers are the same object (or symbols with the same
name), store T into DEST, otherwise, store NIL.
- NUM\_GT dest:reg, val1:reg, val2:reg - NUM\_GT dest:reg, val1:reg, val2:reg
NUM\_GE 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 Compare VAL1 and VAL2, which must be numbers, and compare their values. If
they pass, store T into DEST, otherwise store NIL. 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.
| Mnemonic | Number | - SUB dest:reg, val1:reg, val2:reg
|:-----------------|:------:| Subtract the sum of the first COUNT - 1 "arg" registers starting from "arg1",
| STRING\_LIT | 0 | that is "arg1", "arg2", "arg3", etc., from "arg0". Store the result in DEST.
| 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 |
## Examples - MUL dest:reg, count:u64
This: Multiply the first COUNT "arg" registers and place the result in DEST.
```lisp
(format t "Hello World~%")
```
Compiles into:
```text
INTERN_LIT val0, "Hello World~%"
```
This: - DIV dest:reg, count:u64
```lisp Divide "arg0" by the product of the COUNT - 1 "arg" registers starting from "arg1"
(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) - INT_DIV dest:reg, val1:reg, val2:reg
``` Divide VAL1 by VAL2 and place the integer part of the result in DEST.
Compiles into:
```text - RECIP dest:reg, val:reg
NEWFUNCTION val0, 13 ;; not counting this instruction Divide 1 by VAL and place the result in DEST.
ENTER_LEXENV
INTERN_LIT saved0, "foo" - MOD dest:reg, val1:reg, val2:reg
ENTER_BLOCK saved0, 9 ;; not counting this instruction Divide VAL1 by VAL2 and place the remainder in DEST.
INTERN_LIT val0, "genval"
;; NOTE bar already in arg0 - SQRT dest:reg, val:reg
FUNCALL val0 ;; NOTE val0 clobbered here Take the square root of VAL and place it in DEST.
INTERN_LIT val0, "foo-internal"
MOV arg0, ret0 - POW dest:reg, base:reg, exp:reg
MOV arg3, arg2 Raise BASE to the EXP power and place the result in DEST.
MOV arg2, arg1
INTERN_LIT arg1, ":baz" - LN dest:reg, val:reg
FUNCALL val0 Take the natural log of VAL and place the result in DEST.
LEAVE_BLOCK saved0
LEAVE_LEXENV - 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.
INTERN_LIT val1, "foo"
SET_FUNCTION val1, val0
INT arg0, 10
INTERN_LIT arg1, ":baz"
INT arg2, 20
FUNCALL val1
```

2
CMakeLists.txt
View File

@ -14,3 +14,5 @@ endforeach()
add_executable(bootstrap-slc ${REAL_BOOTSTRAP_FILES}) add_executable(bootstrap-slc ${REAL_BOOTSTRAP_FILES})
target_link_libraries(bootstrap-slc m) 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) && if (!convert_named_char_escape(sym + 1, &c) &&
!convert_c_style_char_escape(sym + 1, &c) && !convert_c_style_char_escape(sym + 1, &c) &&
!convert_numeric_char_escape(sym + 1, &c, false)) { !convert_numeric_char_escape(sym + 1, &c, false)) {
free(token->text);
free(node); free(node);
push_build_error(err, token, 0, push_build_error(err, token, 0,
"invalid escape sequence in character literal"); "invalid escape sequence in character literal");
@ -676,6 +675,7 @@ static AstNode *process_token(Token *token, TokenStream *stream,
abort(); abort();
break; break;
} }
free(token->text);
return retval; return retval;
} }

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

41
bootstrap/constants.c
View File

@ -9,29 +9,36 @@ const char *INSTRUCTION_NAMES[] = {
[INST_CONS] = "CONS", [INST_CONS] = "CONS",
[INST_LIST] = "LIST", [INST_LIST] = "LIST",
[INST_VECTOR] = "VECTOR", [INST_VECTOR] = "VECTOR",
[INST_LENGTH] = "LENGTH",
[INST_INTERN_LIT] = "INTERN_LIT", [INST_INTERN_LIT] = "INTERN_LIT",
[INST_INTERN_DYN] = "INTERN_DYN", [INST_INTERN_DYN] = "INTERN_DYN",
[INST_TYPE_OF] = "TYPE_OF",
[INST_SYMBOL_NAME] = "SYMBOL_NAME", [INST_SYMBOL_NAME] = "SYMBOL_NAME",
[INST_MOV] = "MOV", [INST_MOV] = "MOV",
[INST_FUNCALL] = "FUNCALL", [INST_FUNCALL] = "FUNCALL",
[INST_RETVAL_COUNT] = "RETVAL_COUNT", [INST_RETVAL_COUNT] = "RETVAL_COUNT",
[INST_GET_RETVAL_COUNT] = "GET_RETVAL_COUNT",
[INST_ENTER_LEXENV] = "ENTER_LEXENV", [INST_ENTER_LEXENV] = "ENTER_LEXENV",
[INST_ENTER_INHERITED_LEXENV] = "ENTER_INHERITED_LEXENV",
[INST_LEAVE_LEXENV] = "LEAVE_LEXENV",
[INST_ENTER_BLOCK] = "ENTER_BLOCK", [INST_ENTER_BLOCK] = "ENTER_BLOCK",
[INST_LEAVE_BLOCK] = "LEAVE_BLOCK", [INST_LEAVE_BLOCK] = "LEAVE_BLOCK",
[INST_SET_VALUE] = "SET_VALUE", [INST_SET_VALUE] = "SET_VALUE",
[INST_SET_FUNCTION] = "SET_FUNCTION", [INST_SET_FUNCTION] = "SET_FUNCTION",
[INST_GET_VALUE] = "GET_VALUE", [INST_GET_VALUE] = "GET_VALUE",
[INST_GET_FUNCTION] = "GET_FUNCTION", [INST_GET_FUNCTION] = "GET_FUNCTION",
[INST_BOUNDP] = "BOUNDP",
[INST_FUNCTIONP] = "FUNCTIONP",
[INST_NEWFUNCTION_LIT] = "NEWFUNCTION_LIT", [INST_NEWFUNCTION_LIT] = "NEWFUNCTION_LIT",
[INST_NEWFUNCTION_DYN] = "NEWFUNCTION_DYN", [INST_NEWFUNCTION_DYN] = "NEWFUNCTION_DYN",
[INST_PUT] = "PUT", [INST_PUT] = "PUT",
[INST_GET] = "GET", [INST_GET] = "GET",
[INST_AND] = "AND", [INST_AND] = "AND",
[INST_ANDN] = "ANDN",
[INST_OR] = "OR", [INST_OR] = "OR",
[INST_ORN] = "ORN",
[INST_XOR] = "XOR", [INST_XOR] = "XOR",
[INST_XORN] = "XORN",
[INST_NOT] = "NOT", [INST_NOT] = "NOT",
[INST_JMP] = "JMP",
[INST_CJMP] = "CJMP", [INST_CJMP] = "CJMP",
[INST_CAR] = "CAR", [INST_CAR] = "CAR",
[INST_CDR] = "CDR", [INST_CDR] = "CDR",
@ -41,13 +48,39 @@ const char *INSTRUCTION_NAMES[] = {
[INST_GETELT_DYN] = "GETELT_DYN", [INST_GETELT_DYN] = "GETELT_DYN",
[INST_SETELT_LIT] = "SETELT_LIT", [INST_SETELT_LIT] = "SETELT_LIT",
[INST_SETELT_DYN] = "SETELT_DYN", [INST_SETELT_DYN] = "SETELT_DYN",
[INST_EQ_TWO] = "EQ_TWO", [INST_EQ] = "EQ",
[INST_EQ_N] = "EQ_N",
[INST_NUM_GT] = "NUM_GT", [INST_NUM_GT] = "NUM_GT",
[INST_NUM_GE] = "NUM_GE", [INST_NUM_GE] = "NUM_GE",
[INST_NUM_EQ] = "NUM_EQ", [INST_NUM_EQ] = "NUM_EQ",
[INST_NUM_LE] = "NUM_LE", [INST_NUM_LE] = "NUM_LE",
[INST_NUM_LT] = "NUM_LT", [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[] = { const char *REGISTER_NAMES[] = {

130
bootstrap/constants.h
View File

@ -5,55 +5,87 @@
typedef uint16_t LispInst; typedef uint16_t LispInst;
#define INST_NIL ((LispInst) 0)
#define INST_NIL ((LispInst) 0) #define INST_T ((LispInst) 1)
#define INST_T ((LispInst) 1) #define INST_STRING ((LispInst) 2)
#define INST_STRING ((LispInst) 2) #define INST_INT ((LispInst) 3)
#define INST_INT ((LispInst) 3) #define INST_FLOAT ((LispInst) 4)
#define INST_FLOAT ((LispInst) 4) #define INST_CONS ((LispInst) 5)
#define INST_CONS ((LispInst) 5) #define INST_LIST ((LispInst) 6)
#define INST_LIST ((LispInst) 6) #define INST_VECTOR ((LispInst) 7)
#define INST_VECTOR ((LispInst) 7) #define INST_LENGTH ((LispInst) 8)
#define INST_INTERN_LIT ((LispInst) 8) #define INST_INTERN_LIT ((LispInst) 9)
#define INST_INTERN_DYN ((LispInst) 9) #define INST_INTERN_DYN ((LispInst) 10)
#define INST_SYMBOL_NAME ((LispInst) 10) #define INST_TYPE_OF ((LispInst) 11)
#define INST_MOV ((LispInst) 11) #define INST_SYMBOL_NAME ((LispInst) 12)
#define INST_FUNCALL ((LispInst) 12) #define INST_MOV ((LispInst) 13)
#define INST_RETVAL_COUNT ((LispInst) 13) #define INST_FUNCALL ((LispInst) 14)
#define INST_ENTER_LEXENV ((LispInst) 14) #define INST_RETVAL_COUNT ((LispInst) 15)
#define INST_ENTER_INHERITED_LEXENV ((LispInst) 15) #define INST_GET_RETVAL_COUNT ((LispInst) 16)
#define INST_LEAVE_LEXENV ((LispInst) 16) #define INST_ENTER_LEXENV ((LispInst) 17)
#define INST_ENTER_BLOCK ((LispInst) 17) #define INST_ENTER_BLOCK ((LispInst) 18)
#define INST_LEAVE_BLOCK ((LispInst) 18) #define INST_LEAVE_BLOCK ((LispInst) 19)
#define INST_SET_VALUE ((LispInst) 19) #define INST_SET_VALUE ((LispInst) 20)
#define INST_SET_FUNCTION ((LispInst) 20) #define INST_SET_FUNCTION ((LispInst) 21)
#define INST_GET_VALUE ((LispInst) 21) #define INST_GET_VALUE ((LispInst) 22)
#define INST_GET_FUNCTION ((LispInst) 22) #define INST_GET_FUNCTION ((LispInst) 23)
#define INST_NEWFUNCTION_LIT ((LispInst) 23) #define INST_BOUNDP ((LispInst) 24)
#define INST_NEWFUNCTION_DYN ((LispInst) 24) #define INST_FUNCTIONP ((LispInst) 25)
#define INST_PUT ((LispInst) 25) #define INST_NEWFUNCTION_LIT ((LispInst) 26)
#define INST_GET ((LispInst) 26) #define INST_NEWFUNCTION_DYN ((LispInst) 27)
#define INST_AND ((LispInst) 27) #define INST_PUT ((LispInst) 28)
#define INST_OR ((LispInst) 28) #define INST_GET ((LispInst) 29)
#define INST_XOR ((LispInst) 29) #define INST_AND ((LispInst) 30)
#define INST_NOT ((LispInst) 30) #define INST_ANDN ((LispInst) 31)
#define INST_CJMP ((LispInst) 31) #define INST_OR ((LispInst) 32)
#define INST_CAR ((LispInst) 32) #define INST_ORN ((LispInst) 33)
#define INST_CDR ((LispInst) 33) #define INST_XOR ((LispInst) 34)
#define INST_SETCAR ((LispInst) 34) #define INST_XORN ((LispInst) 35)
#define INST_SETCDR ((LispInst) 35) #define INST_NOT ((LispInst) 36)
#define INST_GETELT_LIT ((LispInst) 36) #define INST_JMP ((LispInst) 37)
#define INST_GETELT_DYN ((LispInst) 37) #define INST_CJMP ((LispInst) 38)
#define INST_SETELT_LIT ((LispInst) 38) #define INST_CAR ((LispInst) 39)
#define INST_SETELT_DYN ((LispInst) 39) #define INST_CDR ((LispInst) 40)
#define INST_EQ_TWO ((LispInst) 40) #define INST_SETCAR ((LispInst) 41)
#define INST_EQ_N ((LispInst) 41) #define INST_SETCDR ((LispInst) 42)
#define INST_NUM_GT ((LispInst) 42) #define INST_GETELT_LIT ((LispInst) 43)
#define INST_NUM_GE ((LispInst) 43) #define INST_GETELT_DYN ((LispInst) 44)
#define INST_NUM_EQ ((LispInst) 44) #define INST_SETELT_LIT ((LispInst) 45)
#define INST_NUM_LE ((LispInst) 45) #define INST_SETELT_DYN ((LispInst) 46)
#define INST_NUM_LT ((LispInst) 46) #define INST_EQ ((LispInst) 47)
#define N_INSTRUCTIONS ((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[]; extern const char *INSTRUCTION_NAMES[];

18
bootstrap/main.c
View File

@ -4,6 +4,23 @@
#include "ast.h" #include "ast.h"
#include "compile.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) { int main(int argc, const char **argv) {
ast_init_parser(); ast_init_parser();
FILE *file = fopen("bootstrap/test.sl", "r"); FILE *file = fopen("bootstrap/test.sl", "r");
@ -13,6 +30,7 @@ int main(int argc, const char **argv) {
TokenStream *stream = make_token_stream(file); TokenStream *stream = make_token_stream(file);
COMPILE_FORMAT = COMPILE_FORMAT_ASM; COMPILE_FORMAT = COMPILE_FORMAT_ASM;
CompileEnvironment *env = make_compile_environment(); CompileEnvironment *env = make_compile_environment();
register_native_defuns(env);
AstErrorList *ast_errs; AstErrorList *ast_errs;
CompileError *comp_errs; CompileError *comp_errs;
while (!token_stream_is_eof(stream)) { while (!token_stream_is_eof(stream)) {

17
bootstrap/test.sl
View File

@ -1,3 +1,14 @@
(defun name_here () (defun stringp (obj)
"Test defun" (eq (type-of obj) 'string))
"a")
(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))