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" | | 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
@ -62,12 +63,18 @@ 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 - OR2 dest:reg, val1:reg, val2:reg
the overall result into DEST. NOT is special as it can only take one value, ORN dest:reg, count:u64
of which it will take the logical negation and store it into DEST. 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 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.
- 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 | - DIV dest:reg, count:u64
|:-----------------|:------:| Divide "arg0" by the product of the COUNT - 1 "arg" registers starting from "arg1"
| 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 |
## Examples - INT_DIV dest:reg, val1:reg, val2:reg
This: Divide VAL1 by VAL2 and place the integer part of the result in DEST.
```lisp
(format t "Hello World~%") - RECIP dest:reg, val:reg
``` Divide 1 by VAL and place the result in DEST.
Compiles into:
```text
INTERN_LIT val0, "Hello World~%"
```
This: - MOD dest:reg, val1:reg, val2:reg
```lisp Divide VAL1 by VAL2 and place the remainder in DEST.
(defun foo (bar &key baz &rest qux)
"FOO each of BAR and BAZ as well as each of QUX." - SQRT dest:reg, val:reg
(let (some-val (genval bar)) Take the square root of VAL and place it in DEST.
(foo-internal some-val :baz baz qux)))
- POW dest:reg, base:reg, exp:reg
(foo 10 :baz 20) Raise BASE to the EXP power and place the result in DEST.
```
Compiles into: - LN dest:reg, val:reg
```text Take the natural log of VAL and place the result in DEST.
NEWFUNCTION val0, 13 ;; not counting this instruction
ENTER_LEXENV - EXP dest:reg, val:reg
INTERN_LIT saved0, "foo" Take the exponential function at VAL and place the result in DEST.
ENTER_BLOCK saved0, 9 ;; not counting this instruction
INTERN_LIT val0, "genval" - SIN dest:reg, val:reg
;; NOTE bar already in arg0 COS dest:reg, val:reg
FUNCALL val0 ;; NOTE val0 clobbered here TAN dest:reg, val:reg
INTERN_LIT val0, "foo-internal" Take the sine, cosine, or tangent of VAL (in radians) and place it into DEST.
MOV arg0, ret0
MOV arg3, arg2 - ASIN dest:reg, val:reg
MOV arg2, arg1 ACOS dest:reg, val:reg
INTERN_LIT arg1, ":baz" ATAN dest:reg, val:reg
FUNCALL val0 Take the inverse sine, cosine, or tangent of VAL and place the result (in
LEAVE_BLOCK saved0 radians) into DEST.
LEAVE_LEXENV
- BITAND dest:reg, val1:reg, val2:reg
INTERN_LIT val1, "foo" BITOR dest:reg, val1:reg, val2:reg
SET_FUNCTION val1, val0 BITXOR dest:reg, val1:reg, val2:reg
INT arg0, 10 BITNOR dest:reg, val1:reg, val2:reg
INTERN_LIT arg1, ":baz" Perform the given bit-wise operation on VAL1 and VAL2 and place the result
INT arg2, 20 into DEST.
FUNCALL val1
``` - 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}) 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;
} }

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; 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))