diff options
| -rw-r--r-- | include/lcq/pit/runtime.h | 46 | ||||
| -rw-r--r-- | src/library.c | 28 | ||||
| -rw-r--r-- | src/main.c | 44 | ||||
| -rw-r--r-- | src/parser.c | 14 | ||||
| -rw-r--r-- | src/runtime.c | 65 | ||||
| -rw-r--r-- | x86.lisp | 173 |
6 files changed, 274 insertions, 96 deletions
diff --git a/include/lcq/pit/runtime.h b/include/lcq/pit/runtime.h index 41ca3ec..02a2249 100644 --- a/include/lcq/pit/runtime.h +++ b/include/lcq/pit/runtime.h @@ -224,4 +224,50 @@ void *pit_nativedata_get(pit_runtime *rt, pit_value tag, pit_value v); pit_value pit_expand_macros(pit_runtime *rt, pit_value top); pit_value pit_eval(pit_runtime *rt, pit_value e); +/* repl / file loading */ +#define PIT_DEFAULT_MAIN(rt) \ + if (argc < 2) { /* run repl */ \ + char buf[1024] = {0}; \ + i64 len = 0; \ + pit_runtime_freeze(rt); \ + if (pit_runtime_print_error(rt)) { exit(1); } \ + setbuf(stdout, NULL); \ + printf("> "); \ + while (len < (i64) sizeof(buf) && (buf[len++] = (char) getchar()) != EOF) { \ + if (buf[len - 1] == '\n') { \ + pit_value bs, prog, res; \ + buf[len - 1] = 0; \ + bs = pit_bytes_new_cstr(rt, buf); \ + prog = pit_read_bytes(rt, bs); \ + res = pit_eval(rt, prog); \ + if (pit_runtime_print_error(rt)) { \ + rt->error = PIT_NIL; \ + printf("> "); \ + } else { \ + char dumpbuf[1024] = {0}; \ + pit_dump(rt, dumpbuf, sizeof(dumpbuf) - 1, res, true); \ + printf("%s\n> ", dumpbuf); \ + } \ + len = 0; \ + } \ + } \ + } else { /* run file */ \ + pit_value bs = pit_bytes_new_file(rt, argv[1]); \ + pit_lexer lex; \ + pit_parser parse; \ + bool eof = false; \ + pit_value p = PIT_NIL; \ + if (!pit_lexer_from_bytes(rt, &lex, bs)) { \ + pit_error(rt, "failed to initialize lexer"); \ + } \ + pit_parser_from_lexer(&parse, &lex); \ + while (p = pit_parse(rt, &parse, &eof), !eof) { \ + if (pit_runtime_print_error(rt)) exit(1); \ + pit_eval(rt, p); \ + if (pit_runtime_print_error(rt)) exit(1); \ + } \ + if (pit_runtime_print_error(rt)) exit(1); \ + } \ + return 0; + #endif diff --git a/src/library.c b/src/library.c index 2cdbef7..7c63066 100644 --- a/src/library.c +++ b/src/library.c @@ -255,6 +255,11 @@ static pit_value impl_funcall(pit_runtime *rt, pit_value args) { pit_value f = pit_car(rt, args); return pit_apply(rt, f, pit_cdr(rt, args)); } +static pit_value impl_apply(pit_runtime *rt, pit_value args) { + pit_value f = pit_car(rt, args); + pit_value xs = pit_car(rt, pit_cdr(rt, args)); + return pit_apply(rt, f, xs); +} static pit_value impl_error(pit_runtime *rt, pit_value args) { rt->error = PIT_T; rt->error = pit_car(rt, args); @@ -323,6 +328,22 @@ static pit_value impl_list(pit_runtime *rt, pit_value args) { (void) rt; return args; } +static pit_value impl_list_nth(pit_runtime *rt, pit_value args) { + i64 n = pit_as_integer(rt, pit_car(rt, args)); + pit_value xs = pit_car(rt, pit_cdr(rt, args)); + while (xs != PIT_NIL && n-- > 0) { + xs = pit_cdr(rt, xs); + } + return pit_car(rt, xs); +} +static pit_value impl_list_iota(pit_runtime *rt, pit_value args) { + i64 n = pit_as_integer(rt, pit_car(rt, args)); + pit_value ret = PIT_NIL; + while (n > 0) { + ret = pit_cons(rt, pit_integer_new(rt, --n), ret); + } + return ret; +} static pit_value impl_list_len(pit_runtime *rt, pit_value args) { pit_value arr = pit_car(rt, args); return pit_integer_new(rt, pit_list_len(rt, arr)); @@ -685,7 +706,9 @@ static pit_value impl_bitwise_lshift(pit_runtime *rt, pit_value args) { static pit_value impl_bitwise_rshift(pit_runtime *rt, pit_value args) { i64 val = pit_as_integer(rt, pit_car(rt, args)); i64 shift = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args))); - return pit_integer_new(rt, val >> shift); + if (shift >= 64) val = 0; + else val >>= shift; + return pit_integer_new(rt, val); } void pit_install_library_essential(pit_runtime *rt) { /* special forms */ @@ -722,6 +745,7 @@ void pit_install_library_essential(pit_runtime *rt) { pit_fset(rt, pit_intern_cstr(rt, "fset!"), pit_nativefunc_new(rt, impl_fset)); pit_fset(rt, pit_intern_cstr(rt, "symbol-is-macro!"), pit_nativefunc_new(rt, impl_symbol_is_macro)); pit_fset(rt, pit_intern_cstr(rt, "funcall"), pit_nativefunc_new(rt, impl_funcall)); + pit_fset(rt, pit_intern_cstr(rt, "apply"), pit_nativefunc_new(rt, impl_apply)); /* cons cells */ pit_fset(rt, pit_intern_cstr(rt, "cons"), pit_nativefunc_new(rt, impl_cons)); pit_fset(rt, pit_intern_cstr(rt, "car"), pit_nativefunc_new(rt, impl_car)); @@ -730,6 +754,8 @@ void pit_install_library_essential(pit_runtime *rt) { pit_fset(rt, pit_intern_cstr(rt, "setcdr!"), pit_nativefunc_new(rt, impl_setcdr)); /* cons lists*/ pit_fset(rt, pit_intern_cstr(rt, "list"), pit_nativefunc_new(rt, impl_list)); + pit_fset(rt, pit_intern_cstr(rt, "list/nth"), pit_nativefunc_new(rt, impl_list_nth)); + pit_fset(rt, pit_intern_cstr(rt, "list/iota"), pit_nativefunc_new(rt, impl_list_iota)); pit_fset(rt, pit_intern_cstr(rt, "list/len"), pit_nativefunc_new(rt, impl_list_len)); pit_fset(rt, pit_intern_cstr(rt, "list/reverse"), pit_nativefunc_new(rt, impl_list_reverse)); pit_fset(rt, pit_intern_cstr(rt, "list/uniq"), pit_nativefunc_new(rt, impl_list_uniq)); @@ -14,47 +14,5 @@ int main(int argc, char **argv) { pit_install_library_plist(rt); pit_install_library_alist(rt); pit_install_library_bytestring(rt); - if (argc < 2) { /* run repl */ - char buf[1024] = {0}; - i64 len = 0; - pit_runtime_freeze(rt); - if (pit_runtime_print_error(rt)) { exit(1); } - setbuf(stdout, NULL); - printf("> "); - while (len < (i64) sizeof(buf) && (buf[len++] = (char) getchar()) != EOF) { - if (buf[len - 1] == '\n') { - pit_value bs, prog, res; - buf[len - 1] = 0; - bs = pit_bytes_new_cstr(rt, buf); - prog = pit_read_bytes(rt, bs); - res = pit_eval(rt, prog); - if (pit_runtime_print_error(rt)) { - rt->error = PIT_NIL; - printf("> "); - } else { - char dumpbuf[1024] = {0}; - pit_dump(rt, dumpbuf, sizeof(dumpbuf) - 1, res, true); - printf("%s\n> ", dumpbuf); - } - len = 0; - } - } - } else { /* run file */ - pit_value bs = pit_bytes_new_file(rt, argv[1]); - pit_lexer lex; - pit_parser parse; - bool eof = false; - pit_value p = PIT_NIL; - if (!pit_lexer_from_bytes(rt, &lex, bs)) { - pit_error(rt, "failed to initialize lexer"); - } - pit_parser_from_lexer(&parse, &lex); - while (p = pit_parse(rt, &parse, &eof), !eof) { - if (pit_runtime_print_error(rt)) exit(1); - pit_eval(rt, p); - if (pit_runtime_print_error(rt)) exit(1); - } - if (pit_runtime_print_error(rt)) exit(1); - } - return 0; + PIT_DEFAULT_MAIN(rt); } diff --git a/src/parser.c b/src/parser.c index 9c112c2..b2d0f31 100644 --- a/src/parser.c +++ b/src/parser.c @@ -86,8 +86,18 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { i64 scratch_reset = rt->scratch->next; pit_value ret = PIT_NIL; while (!match(st, PIT_LEX_TOKEN_RPAREN)) { - pit_value *cell = pit_arena_alloc_bulk(rt->scratch, sizeof(pit_value)); - *cell = pit_parse(rt, st, eof); + if (match(st, PIT_LEX_TOKEN_DOT)) { + ret = pit_parse(rt, st, eof); + if (match(st, PIT_LEX_TOKEN_RPAREN)) { + break; + } else { + pit_error(rt, "unterminated dotted list"); + return PIT_NIL; + } + } else { + pit_value *cell = pit_arena_alloc_bulk(rt->scratch, sizeof(pit_value)); + *cell = pit_parse(rt, st, eof); + } if (rt->error != PIT_NIL || (eof != NULL && *eof)) { pit_error(rt, "unterminated list"); return PIT_NIL; /* if we hit an error, stop!*/ diff --git a/src/runtime.c b/src/runtime.c index 6ea9aa1..668ad4b 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -24,7 +24,9 @@ i32 pit_arena_next_idx(pit_arena *a) { } i32 pit_arena_alloc_idx(pit_arena *a) { i32 byte_idx = pit_arena_next_idx(a); - if (byte_idx >= a->capacity) { return -1; } + if (byte_idx >= a->capacity) { + return -1; + } a->next += 1; return byte_idx; } @@ -36,7 +38,9 @@ i32 pit_arena_alloc_bulk_idx(pit_arena *a, i64 num) { return byte_idx; } void *pit_arena_idx(pit_arena *a, i32 idx) { - if (idx < 0 || idx >= a->capacity) return NULL; + if (idx < 0 || idx >= a->capacity) { + return NULL; + } return &a->data[idx]; } void *pit_arena_alloc(pit_arena *a) { @@ -68,16 +72,16 @@ u64 pit_value_data(pit_value v) { pit_runtime *pit_runtime_new() { pit_runtime *ret = malloc(sizeof(*ret)); - ret->values = pit_arena_new(1024 * 1024, sizeof(pit_value_heavy)); + ret->values = pit_arena_new(64 * 1024 * 1024, sizeof(pit_value_heavy)); ret->arrays = pit_arena_new(1024 * 1024, sizeof(pit_value)); ret->bytes = pit_arena_new(1024 * 1024, sizeof(u8)); ret->symtab = pit_arena_new(1024 * 1024, sizeof(pit_symtab_entry)); ret->symtab_len = 0; ret->scratch = pit_arena_new(1024 * 1024, sizeof(u8)); - ret->expr_stack = pit_values_new(1024); - ret->result_stack = pit_values_new(1024); + ret->expr_stack = pit_values_new(64 * 1024); + ret->result_stack = pit_values_new(64 * 1024); ret->program = pit_runtime_eval_program_new(64 * 1024); - ret->saved_bindings = pit_values_new(1024); + ret->saved_bindings = pit_values_new(64 * 1024); ret->frozen_values = 0; ret->frozen_arrays = 0; ret->frozen_bytes = 0; @@ -227,6 +231,7 @@ void pit_error(pit_runtime *rt, const char *format, ...) { va_end(vargs); rt->error = PIT_T; /* we set the error now to prevent infinite recursion */ rt->error = pit_bytes_new_cstr(rt, buf); /* in case this errs also */ + if (rt->error == PIT_NIL) rt->error = PIT_T; rt->error_line = rt->source_line; rt->error_column = rt->source_column; } @@ -302,6 +307,10 @@ pit_value pit_ref_new(pit_runtime *rt, pit_ref r) { pit_value pit_heavy_new(pit_runtime *rt) { i32 idx = pit_arena_alloc_idx(rt->values); + if (idx < 0) { + pit_error(rt, "failed to allocate space for heavy value"); + return PIT_NIL; + } return pit_ref_new(rt, idx); } @@ -557,7 +566,6 @@ void pit_set(pit_runtime *rt, pit_value sym, pit_value v) { if (pit_value_sort(ent->value) != PIT_VALUE_SORT_REF) { ent->value = pit_cell_new(rt, PIT_NIL); } - fprintf(stderr, "setting "); pit_trace(rt, sym); fprintf(stderr, " to "); pit_trace(rt, v); pit_cell_set(rt, ent->value, v, sym); } pit_value pit_fget(pit_runtime *rt, pit_value sym) { @@ -606,7 +614,6 @@ void pit_bind(pit_runtime *rt, pit_value sym, pit_value cell) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); if (!ent) { pit_error(rt, "bad symbol"); return; } pit_values_push(rt, rt->saved_bindings, ent->value); - fprintf(stderr, "binding "); pit_trace(rt, sym); fprintf(stderr, " to "); pit_trace(rt, cell); ent->value = cell; } pit_value pit_unbind(pit_runtime *rt, pit_value sym) { @@ -817,28 +824,35 @@ pit_value pit_plist_get(pit_runtime *rt, pit_value k, pit_value vs) { return PIT_NIL; } -pit_value pit_free_vars(pit_runtime *rt, pit_value bound, pit_value body) { +pit_value pit_free_vars(pit_runtime *rt, pit_value initial_bound, pit_value body) { i64 expr_stack_reset = rt->expr_stack->top; pit_value ret = PIT_NIL; - pit_values_push(rt, rt->expr_stack, body); + pit_values_push(rt, rt->expr_stack, pit_cons(rt, initial_bound, body)); while (rt->expr_stack->top > expr_stack_reset) { - pit_value cur = pit_values_pop(rt, rt->expr_stack); + pit_value boundscur = pit_values_pop(rt, rt->expr_stack); + pit_value bound = pit_car(rt, boundscur); + pit_value cur = pit_cdr(rt, boundscur); if (pit_is_cons(rt, cur)) { pit_value fsym = pit_car(rt, cur); bool is_symbol = pit_is_symbol(rt, fsym); pit_value fargs = pit_cdr(rt, cur); if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "lambda")) { - bound = pit_append(rt, pit_car(rt, fargs), bound); + pit_value new_bound = pit_append(rt, pit_car(rt, fargs), bound); + fargs = pit_cdr(rt, fargs); + while (fargs != PIT_NIL) { + pit_values_push(rt, rt->expr_stack, pit_cons(rt, new_bound, pit_car(rt, fargs))); + fargs = pit_cdr(rt, fargs); + } } else if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "quote")) { /* don't look inside quote! if we add other special forms, make sure to consider them here if necessary! */ } else { while (fargs != PIT_NIL) { - pit_values_push(rt, rt->expr_stack, pit_car(rt, fargs)); + pit_values_push(rt, rt->expr_stack, pit_cons(rt, bound, pit_car(rt, fargs))); fargs = pit_cdr(rt, fargs); } if (!is_symbol) { - pit_values_push(rt, rt->expr_stack, fsym); + pit_values_push(rt, rt->expr_stack, pit_cons(rt, bound, fsym)); } } } else if (pit_is_symbol(rt, cur)) { @@ -873,12 +887,10 @@ pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body) { pit_value next_nm = pit_car(rt, pit_cdr(rt, args)); if (next_nm == PIT_NIL) { pit_error(rt, "invalid & in lambda list"); return PIT_NIL; } arg_rest_nm = next_nm; - pit_value ent = pit_cons(rt, next_nm, pit_cell_new(rt, PIT_NIL)); - arg_cells = pit_cons(rt, ent, arg_cells); + arg_cells = pit_cons(rt, next_nm, arg_cells); break; } else { - pit_value ent = pit_cons(rt, nm, pit_cell_new(rt, PIT_NIL)); - arg_cells = pit_cons(rt, ent, arg_cells); + arg_cells = pit_cons(rt, nm, arg_cells); args = pit_cdr(rt, args); } } @@ -898,6 +910,7 @@ pit_value pit_nativefunc_new(pit_runtime *rt, pit_nativefunc f) { return ret; } pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { + char buf[256] = {0}; if (pit_is_symbol(rt, f)) { f = pit_fget(rt, f); } @@ -921,9 +934,8 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { } pit_value anames = h->in.func.args; while (anames != PIT_NIL) { /* bind all argument names to their values */ - pit_value aform = pit_car(rt, anames); - pit_value nm = pit_car(rt, aform); - pit_value cell = pit_cdr(rt, aform); + pit_value nm = pit_car(rt, anames); + pit_value cell = pit_cell_new(rt, PIT_NIL); if (h->in.func.arg_rest_nm != PIT_NIL && pit_eq(nm, h->in.func.arg_rest_nm)) { pit_cell_set(rt, cell, args, nm); pit_bind(rt, nm, cell); @@ -946,14 +958,19 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { /* calling native functions is even simpler */ return h->in.nativefunc(rt, args); } else { - pit_error(rt, "attempt to apply non-nativefunc ref"); + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "attempted to apply non-function ref: %s", buf); return PIT_NIL; } } - default: - pit_error(rt, "attempted to apply non-function value"); + default: { + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "attempted to apply non-function value: %s", buf); return PIT_NIL; } + } } pit_value pit_nativedata_new(pit_runtime *rt, pit_value tag, void *d) { @@ -63,10 +63,8 @@ (defun! x86/integer-fits-in-bits? (bits x) "Determine if X fits in BITS." (if (integer? x) - (let ((bound (bitwise/lshift 1 bits))) - (or - (and (>= x 0) (< x bound)) - (and (< x 0) (<= (abs x) (/ bound 2))))))) + (let ((leftover (bitwise/rshift x bits))) + (eq? leftover 0)))) (defun! x86/operand-immediate-fits? (sz x) "Determine if immediate operand X fits in SZ." (let @@ -197,14 +195,14 @@ (or modrm-rm 0)))) (if disp (cond - ((= (car disp) 1) (list (cdr disp))) - ((= (car disp) 4) (x86/split32le (cdr disp))) + ((eq? (car disp) 1) (list (cdr disp))) + ((eq? (car disp) 4) (x86/split32le (cdr disp))) (t (error! "malformed displacement for instruction")))) (if imm (cond - ((= (car imm) 1) (list (cdr imm))) - ((= (car imm) 2) (x86/split16le (cdr imm))) - ((= (car imm) 4) (x86/split32le (cdr imm))) + ((eq? (car imm) 1) (list (cdr imm))) + ((eq? (car imm) 2) (x86/split16le (cdr imm))) + ((eq? (car imm) 4) (x86/split32le (cdr imm))) (t (error! "malformed immediate for instruction"))))))) (defun! x86/instruction-update-sizes (ins ops default-size) @@ -232,12 +230,12 @@ The effective operand size is ESZ." (let ((loc (bytes/range 0 1 pat))) (cond ((equal? loc "I") - (let ((immsz (min esz 4))) + (let ((immsz (if (>= esz 4) 4 esz))) (if (not (x86/integer-fits-in-bits? (* 8 immsz) op)) (error! "Immediate too large" op)) (x86/ins/set-imm! ins (cons immsz op)))) ((equal? loc "J") - (let ((immsz (if (= esz 1) 1 4))) + (let ((immsz (if (eq? esz 1) 1 4))) (if (not (x86/integer-fits-in-bits? (* 8 immsz) op)) (error! "jump displacement too large")) (x86/ins/set-disp! ins (cons immsz op)))) @@ -249,8 +247,8 @@ The effective operand size is ESZ." (x86/ins/set-modrm-rm! ins (or (x86/register? op) (error "Invalid register: %s" op)))) ((or (equal? loc "M") (and (equal? loc "E") (x86/operand-memory-location? op))) - (let ( (base (x86/memory-location-base op)) - (off (x86/memory-location-off op))) + (let ( (base (x86/memory-operand-base op)) + (off (x86/memory-operand-off op))) (cond ((eq? base 'eip) (x86/ins/set-modrm-rm! ins 0b101) @@ -283,13 +281,9 @@ The effective operand size is ESZ." "Return an instruction handler for OPCODE. The instruction handler will run POSTHOOK on the instruction at the end. DEFAULT-SIZE is the default operand size." - (print! opcode) (let ( (posthook (plist/get :posthook kwargs)) (default-size (plist/get :default-size kwargs))) (lambda (pats ops) - (print! opcode) - ;; (print! default-size) - ;; (print! posthook) (let ((ret (x86/ins/new :opcode opcode))) (let ((esz (or (x86/instruction-update-sizes ret ops default-size) @@ -303,6 +297,141 @@ DEFAULT-SIZE is the default operand size." (funcall posthook ret ops)) ret)))) +(defun! x86/instruction-handler-jcc (opcode immsz) + "Return an instruction handler for a Jcc instruction at OPCODE. +IMMSZ is the size of the displacement from RIP." + (lambda (_pats ops) + (let ((ret (x86/ins/new :opcode opcode))) + (x86/ins/set-disp! ret (cons immsz (car ops))) + ret))) + +(defun! x86/generate-handlers-arith (opbase group1reg) + "Return handlers for an arithmetic mnemonic starting at OPBASE. +The REG value in ModR/M is indicated by GROUP1REG." + (list + (cons '("Eb" "Gb") (x86/default-instruction-handler (+ opbase 0))) + (cons '("Ev" "Gv") (x86/default-instruction-handler (+ opbase 1))) + (cons '("Gb" "Eb") (x86/default-instruction-handler (+ opbase 2))) + (cons '("Gv" "Ev") (x86/default-instruction-handler (+ opbase 3))) + (cons '(al "Ib") (x86/default-instruction-handler (+ opbase 4))) + (cons '((ax eax rax) "Iz") (x86/default-instruction-handler (+ opbase 5))) + (cons '("Eb" "Ib") + (x86/default-instruction-handler 0x80 + :posthook (lambda (ins _) (x86/ins/set-modrm-reg! ins group1reg)))) + (cons '("Ev" "Iz") + (x86/default-instruction-handler 0x81 + :posthook (lambda (ins _) (x86/ins/set-modrm-reg! ins group1reg)))) + (cons '("Ev" "Ib") + (x86/default-instruction-handler 0x83 + :posthook (lambda (ins _) (setf (x86/ins-modrm-reg ins) group1reg)))))) + +(setq! x86/registers-+reg-base + '( (+rb . (al cl dl bl ah ch dh bh)) + (+rw . (ax cx dx bx sp bp si di)) + (+rd . (eax ecx edx ebx esp ebp esi edi)) + (+rq . (rax rcx rdx rbx rsp rbp rsi rdi)))) +(setq! x86/registers-+reg-extended + '( (+rw . (r8b r9b r10b r11b r12b r13b r14b r15b)) + (+rw . (r8w r9w r10w r11w r12w r13w r14w r15w)) + (+rd . (r8d r9d r10d r11d r12d r13d r14d r15d)) + (+rq . (r8 r9 r10 r11 r12 r13 r14 r15)))) +(defun! x86/generate-handlers-opcode-+reg (opbase extraops addends & args) + "Generate handlers for a family of opcodes that uses the +reg encoding. +OPBASE is the base opcode. +EXTRAOPS are additional operands after the register operand. +ADDENDS is a list of symbols like +rw, +rq etc. that denote allowed registers. +ARGS are passed verbatim to `u/x86/default-instruction-handler." + (list/map + (lambda (it) + (let ( (abase (list/map (lambda (a) (list/nth it (alist/get a x86/registers-+reg-base))) addends)) + (aext (list/map (lambda (a) (list/nth it (alist/get a x86/registers-+reg-extended))) addends))) + (cons + (cons (list/append abase aext) extraops) + (apply 'x86/default-instruction-handler (cons (+ opbase it) args))))) + (list/iota 8))) + +(setq! + x86/mnemonic-table + (list + (cons 'add (x86/generate-handlers-arith 0x00 0)) + (cons 'or (x86/generate-handlers-arith 0x08 1)) + (cons 'adc (x86/generate-handlers-arith 0x10 2)) + (cons 'sbb (x86/generate-handlers-arith 0x18 3)) + (cons 'and (x86/generate-handlers-arith 0x20 4)) + (cons 'sub (x86/generate-handlers-arith 0x28 5)) + (cons 'xor (x86/generate-handlers-arith 0x30 6)) + (cons 'cmp (x86/generate-handlers-arith 0x38 7)) + (cons 'push + (x86/generate-handlers-opcode-+reg 0x50 '() '(+rw +rq) + :default-size 8 + :posthook (lambda (ins ops) (x86/ins/set-rex-b! ins (x86/register-extended? (car ops)))))) + (cons 'pop + (x86/generate-handlers-opcode-+reg 0x58 '() '(+rw +rq) + :default-size 8 + :posthook (lambda (ins ops) (x86/ins/set-rex-b! ins (x86/register-extended? (car ops)))))) + (list 'jo + (cons '("Jb") (x86/instruction-handler-jcc 0x70 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x80) 4))) + (list 'jno + (cons '("Jb") (x86/instruction-handler-jcc 0x71 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x81) 4))) + (list 'jb + (cons '("Jb") (x86/instruction-handler-jcc 0x72 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x82) 4))) + (list 'jnb + (cons '("Jb") (x86/instruction-handler-jcc 0x73 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x83) 4))) + (list 'jz + (cons '("Jb") (x86/instruction-handler-jcc 0x74 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x84) 4))) + (list 'jnz + (cons '("Jb") (x86/instruction-handler-jcc 0x75 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x85) 4))) + (list 'jbe + (cons '("Jb") (x86/instruction-handler-jcc 0x76 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x86) 4))) + (list 'jnbe + (cons '("Jb") (x86/instruction-handler-jcc 0x77 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x87) 4))) + (list 'js + (cons '("Jb") (x86/instruction-handler-jcc 0x78 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x88) 4))) + (list 'jns + (cons '("Jb") (x86/instruction-handler-jcc 0x79 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x89) 4))) + (list 'jp + (cons '("Jb") (x86/instruction-handler-jcc 0x7a 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x8a) 4))) + (list 'jnp + (cons '("Jb") (x86/instruction-handler-jcc 0x7b 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x8b) 4))) + (list 'jl + (cons '("Jb") (x86/instruction-handler-jcc 0x7c 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x8c) 4))) + (list 'jnl + (cons '("Jb") (x86/instruction-handler-jcc 0x7d 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x8d) 4))) + (list 'jle + (cons '("Jb") (x86/instruction-handler-jcc 0x7e 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x8e) 4))) + (list 'jnle + (cons '("Jb") (x86/instruction-handler-jcc 0x7f 1)) + (cons '("Jz") (x86/instruction-handler-jcc '(0x0f 0x8f) 4))) + (cons 'mov + (x86/generate-handlers-opcode-+reg 0xb0 '("Ib") '(+rb) + :posthook (lambda (ins ops) (x86/ins/set-rex-b! ins (x86/register-extended? (car ops)))))) + (cons 'mov + (x86/generate-handlers-opcode-+reg 0xb8 '("Iv") '(+rw +rd +rq) + :posthook (lambda (ins ops) (x86/ins/set-rex-b! ins (x86/register-extended? (car ops)))))) + (list 'jmp + (cons '("Ev") + (x86/default-instruction-handler 0xff + :default-size 8 + :posthook (lambda (ins _) (setf (u/x86/ins-modrm-reg ins) 4))))) + (list 'syscall + (cons '() (lambda (_ _) (x86/ins/new :opcode '(0x0f 0x05))))) + )) + (defun! x86/asm (op) "Assemble OP to an instruction." (let ((mnem (car op)) (operands (cdr op))) @@ -317,14 +446,6 @@ DEFAULT-SIZE is the default operand size." (funcall (cdr v) (car v) operands) (error! "could not identify instruction")))))) -(setq! - x86/mnemonic-table - (list - (cons 'add - (list - (cons (list "Eb" "Gb") (x86/default-instruction-handler 0)) - (cons (list "Ev" "Gv") (x86/default-instruction-handler 1)))))) - -(setq! test-ins (x86/asm '(add al bl))) +(setq! test-ins (x86/asm '(syscall))) (print! test-ins) (print! (x86/ins-bytes test-ins)) |