From c83f3ec09757eb48bf7d48f3063b39e4d8bd9345 Mon Sep 17 00:00:00 2001 From: primo-ppcg Date: Wed, 28 Jun 2023 16:35:16 +0700 Subject: [PATCH] floor div, variadic mod --- src/boot/boot.janet | 2 +- src/core/asm.c | 1 + src/core/bytecode.c | 2 ++ src/core/cfuns.c | 53 +++++++++++++++++++++++++-------------------- src/core/compile.h | 1 + src/core/corelib.c | 27 ++++++++++------------- src/core/inttypes.c | 28 ++++++++++++++++++++++++ src/core/vm.c | 17 ++++++++++++++- src/include/janet.h | 1 + 9 files changed, 90 insertions(+), 42 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c6c1ff27..74f6384d 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -151,7 +151,7 @@ (defmacro -= "Decrements the var x by n." [x & ns] ~(set ,x (,- ,x ,;ns))) (defmacro *= "Shorthand for (set x (\\* x n))." [x & ns] ~(set ,x (,* ,x ,;ns))) (defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns))) -(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n))) +(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns))) (defmacro assert "Throw an error if x is not truthy. Will not evaluate `err` if x is truthy." diff --git a/src/core/asm.c b/src/core/asm.c index b09b7e3a..e5712cc1 100644 --- a/src/core/asm.c +++ b/src/core/asm.c @@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = { {"cmp", JOP_COMPARE}, {"cncl", JOP_CANCEL}, {"div", JOP_DIVIDE}, + {"divf", JOP_DIVIDE_FLOOR}, {"divim", JOP_DIVIDE_IMMEDIATE}, {"eq", JOP_EQUALS}, {"eqim", JOP_EQUALS_IMMEDIATE}, diff --git a/src/core/bytecode.c b/src/core/bytecode.c index 34383aa7..821bf42d 100644 --- a/src/core/bytecode.c +++ b/src/core/bytecode.c @@ -42,6 +42,7 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = { JINT_SSS, /* JOP_MULTIPLY, */ JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */ JINT_SSS, /* JOP_DIVIDE, */ + JINT_SSS, /* JOP_DIVIDE_FLOOR */ JINT_SSS, /* JOP_MODULO, */ JINT_SSS, /* JOP_REMAINDER, */ JINT_SSS, /* JOP_BAND, */ @@ -301,6 +302,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) { case JOP_SUBTRACT: case JOP_MULTIPLY: case JOP_DIVIDE: + case JOP_DIVIDE_FLOOR: case JOP_MODULO: case JOP_REMAINDER: case JOP_SHIFT_LEFT: diff --git a/src/core/cfuns.c b/src/core/cfuns.c index 7656fe5e..be61da80 100644 --- a/src/core/cfuns.c +++ b/src/core/cfuns.c @@ -116,7 +116,8 @@ static JanetSlot opreduce( JanetSlot *args, int op, int opim, - Janet nullary) { + Janet nullary, + Janet unary) { JanetCompiler *c = opts.compiler; int32_t i, len; int8_t imm = 0; @@ -132,7 +133,7 @@ static JanetSlot opreduce( if (op == JOP_SUBTRACT) { janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1); } else { - janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1); + janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1); } return t; } @@ -155,7 +156,7 @@ static JanetSlot opreduce( /* Function optimizers */ static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil()); + return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil()); } static JanetSlot do_error(JanetFopts opts, JanetSlot *args) { janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0); @@ -172,7 +173,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) { return t; } static JanetSlot do_in(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil()); + return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil()); } static JanetSlot do_get(JanetFopts opts, JanetSlot *args) { if (janet_v_count(args) == 3) { @@ -192,20 +193,14 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) { c->buffer[label] |= (current - label) << 16; return t; } else { - return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil()); + return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil()); } } static JanetSlot do_next(JanetFopts opts, JanetSlot *args) { return opfunction(opts, args, JOP_NEXT, janet_wrap_nil()); } -static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil()); -} -static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil()); -} static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil()); + return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil()); } static JanetSlot do_put(JanetFopts opts, JanetSlot *args) { if (opts.flags & JANET_FOPTS_DROP) { @@ -262,34 +257,43 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) { /* Variadic operators specialization */ static JanetSlot do_add(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0)); + return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0)); } static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0)); + return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0)); } static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1)); + return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); } static JanetSlot do_div(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1)); + return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); +} +static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) { + return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1)); +} +static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) { + return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1)); +} +static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) { + return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1)); } static JanetSlot do_band(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1)); + return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1)); } static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0)); + return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0)); } static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0)); + return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0)); } static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1)); + return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); } static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1)); + return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); } static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) { - return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1)); + return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); } static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) { return genericSS(opts, JOP_BNOT, args[0]); @@ -383,10 +387,11 @@ static const JanetFunOptimizer optimizers[] = { {fixarity2, do_propagate}, {arity2or3, do_get}, {arity1or2, do_next}, - {fixarity2, do_modulo}, - {fixarity2, do_remainder}, + {NULL, do_modulo}, + {NULL, do_remainder}, {fixarity2, do_cmp}, {fixarity2, do_cancel}, + {NULL, do_divf} }; const JanetFunOptimizer *janetc_funopt(uint32_t flags) { diff --git a/src/core/compile.h b/src/core/compile.h index 5863c0b8..05e6f39b 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -69,6 +69,7 @@ typedef enum { #define JANET_FUN_REMAINDER 30 #define JANET_FUN_CMP 31 #define JANET_FUN_CANCEL 32 +#define JANET_FUN_DIVIDE_FLOOR 33 /* Compiler typedefs */ typedef struct JanetCompiler JanetCompiler; diff --git a/src/core/corelib.c b/src/core/corelib.c index 741425a0..46a078e1 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -985,14 +985,6 @@ static const uint32_t next_asm[] = { JOP_NEXT | (1 << 24), JOP_RETURN }; -static const uint32_t modulo_asm[] = { - JOP_MODULO | (1 << 24), - JOP_RETURN -}; -static const uint32_t remainder_asm[] = { - JOP_REMAINDER | (1 << 24), - JOP_RETURN -}; static const uint32_t cmp_asm[] = { JOP_COMPARE | (1 << 24), JOP_RETURN @@ -1077,14 +1069,6 @@ static void janet_load_libs(JanetTable *env) { JanetTable *janet_core_env(JanetTable *replacements) { JanetTable *env = (NULL != replacements) ? replacements : janet_table(0); - janet_quick_asm(env, JANET_FUN_MODULO, - "mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm), - JDOC("(mod dividend divisor)\n\n" - "Returns the modulo of dividend / divisor.")); - janet_quick_asm(env, JANET_FUN_REMAINDER, - "%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm), - JDOC("(% dividend divisor)\n\n" - "Returns the remainder of dividend / divisor.")); janet_quick_asm(env, JANET_FUN_CMP, "cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm), JDOC("(cmp x y)\n\n" @@ -1183,6 +1167,17 @@ JanetTable *janet_core_env(JanetTable *replacements) { "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " "values.")); + templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR, + JDOC("(div & xs)\n\n" + "Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns " + "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " + "values.")); + templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO, + JDOC("(mod dividend divisor)\n\n" + "Returns the modulo of dividend / divisor.")); + templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER, + JDOC("(% dividend divisor)\n\n" + "Returns the remainder of dividend / divisor.")); templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND, JDOC("(band & xs)\n\n" "Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); diff --git a/src/core/inttypes.c b/src/core/inttypes.c index 7c2fef33..3910a866 100644 --- a/src/core/inttypes.c +++ b/src/core/inttypes.c @@ -490,11 +490,34 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ return janet_wrap_abstract(box); \ } \ +static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) { + janet_fixarity(argc, 2); + int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); + int64_t op1 = janet_unwrap_s64(argv[0]); + int64_t op2 = janet_unwrap_s64(argv[1]); + if (op2 == 0) janet_panic("division by zero"); + int64_t x = op1 / op2; + *box = x - (((op1 ^ op2) < 0) && (x * op2 != op1)); + return janet_wrap_abstract(box); +} + +static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) { + janet_fixarity(argc, 2); + int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); + int64_t op2 = janet_unwrap_s64(argv[0]); + int64_t op1 = janet_unwrap_s64(argv[1]); + if (op2 == 0) janet_panic("division by zero"); + int64_t x = op1 / op2; + *box = x - (((op1 ^ op2) < 0) && (x * op2 != op1)); + return janet_wrap_abstract(box); +} + static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) { janet_fixarity(argc, 2); int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t op1 = janet_unwrap_s64(argv[0]); int64_t op2 = janet_unwrap_s64(argv[1]); + if (op2 == 0) janet_panic("division by zero"); int64_t x = op1 % op2; *box = (op1 > 0) ? ((op2 > 0) ? x : (0 == x ? x : x + op2)) @@ -507,6 +530,7 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) { int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t op2 = janet_unwrap_s64(argv[0]); int64_t op1 = janet_unwrap_s64(argv[1]); + if (op2 == 0) janet_panic("division by zero"); int64_t x = op1 % op2; *box = (op1 > 0) ? ((op2 > 0) ? x : (0 == x ? x : x + op2)) @@ -555,6 +579,8 @@ static JanetMethod it_s64_methods[] = { {"r*", cfun_it_s64_mul}, {"/", cfun_it_s64_div}, {"r/", cfun_it_s64_divi}, + {"div", cfun_it_s64_divf}, + {"rdiv", cfun_it_s64_divfi}, {"mod", cfun_it_s64_mod}, {"rmod", cfun_it_s64_modi}, {"%", cfun_it_s64_rem}, @@ -580,6 +606,8 @@ static JanetMethod it_u64_methods[] = { {"r*", cfun_it_u64_mul}, {"/", cfun_it_u64_div}, {"r/", cfun_it_u64_divi}, + {"div", cfun_it_u64_div}, + {"rdiv", cfun_it_u64_divi}, {"mod", cfun_it_u64_mod}, {"rmod", cfun_it_u64_modi}, {"%", cfun_it_u64_mod}, diff --git a/src/core/vm.c b/src/core/vm.c index 12f990c9..e013fc78 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -342,6 +342,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { &&label_JOP_MULTIPLY, &&label_JOP_DIVIDE_IMMEDIATE, &&label_JOP_DIVIDE, + &&label_JOP_DIVIDE_FLOOR, &&label_JOP_MODULO, &&label_JOP_REMAINDER, &&label_JOP_BAND, @@ -583,7 +584,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { &&label_unknown_op, &&label_unknown_op, &&label_unknown_op, - &&label_unknown_op, &&label_unknown_op }; #endif @@ -688,6 +688,21 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { VM_OP(JOP_DIVIDE) vm_binop( /); + VM_OP(JOP_DIVIDE_FLOOR) { + Janet op1 = stack[B]; + Janet op2 = stack[C]; + if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) { + double x1 = janet_unwrap_number(op1); + double x2 = janet_unwrap_number(op2); + stack[A] = janet_wrap_number(floor(x1 / x2)); + vm_pcnext(); + } else { + vm_commit(); + stack[A] = janet_binop_call("div", "rdiv", op1, op2); + vm_checkgc_pcnext(); + } + } + VM_OP(JOP_MODULO) { Janet op1 = stack[B]; Janet op2 = stack[C]; diff --git a/src/include/janet.h b/src/include/janet.h index 34cfa06a..ada92277 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1267,6 +1267,7 @@ enum JanetOpCode { JOP_MULTIPLY, JOP_DIVIDE_IMMEDIATE, JOP_DIVIDE, + JOP_DIVIDE_FLOOR, JOP_MODULO, JOP_REMAINDER, JOP_BAND,