1 /* Copyright 2018-2021 2 Free Software Foundation, Inc. 3 4 This file is part of Guile. 5 6 Guile is free software: you can redistribute it and/or modify it 7 under the terms of the GNU Lesser General Public License as published 8 by the Free Software Foundation, either version 3 of the License, or 9 (at your option) any later version. 10 11 Guile is distributed in the hope that it will be useful, but WITHOUT 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 14 License for more details. 15 16 You should have received a copy of the GNU Lesser General Public 17 License along with Guile. If not, see 18 <https://www.gnu.org/licenses/>. */ 19 20 #ifndef _SCM_INTRINSICS_H_ 21 #define _SCM_INTRINSICS_H_ 22 23 #ifndef BUILDING_LIBGUILE 24 #error intrinsics.h is private and uninstalled 25 #endif 26 27 #include <setjmp.h> 28 29 #include <libguile/scm.h> 30 31 32 typedef SCM (*scm_t_scm_from_scm_scm_intrinsic) (SCM, SCM); 33 typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, uint8_t); 34 typedef void (*scm_t_scm_sz_u32_intrinsic) (SCM, size_t, uint32_t); 35 typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM); 36 typedef double (*scm_t_f64_from_scm_intrinsic) (SCM); 37 typedef SCM (*scm_t_scm_from_scmn_scmn_intrinsic) (SCM, SCM); 38 39 /* If we don't have 64-bit registers, the intrinsics will take and 40 return 64-bit values by reference. */ 41 #if SIZEOF_UINTPTR_T >= 8 42 #define INDIRECT_INT64_INTRINSICS 0 43 #else 44 #define INDIRECT_INT64_INTRINSICS 1 45 #endif 46 47 #if INDIRECT_INT64_INTRINSICS 48 typedef void (*scm_t_u64_from_scm_intrinsic) (uint64_t*, SCM); 49 typedef void (*scm_t_s64_from_scm_intrinsic) (int64_t*, SCM); 50 typedef SCM (*scm_t_scm_from_u64_intrinsic) (uint64_t*); 51 typedef SCM (*scm_t_scm_from_s64_intrinsic) (int64_t*); 52 typedef SCM (*scm_t_scm_from_scm_u64_intrinsic) (SCM, uint64_t*); 53 typedef double (*scm_t_f64_from_s64_intrinsic) (uint64_t*); 54 #else 55 typedef uint64_t (*scm_t_u64_from_scm_intrinsic) (SCM); 56 typedef int64_t (*scm_t_s64_from_scm_intrinsic) (SCM); 57 typedef SCM (*scm_t_scm_from_u64_intrinsic) (uint64_t); 58 typedef SCM (*scm_t_scm_from_s64_intrinsic) (int64_t); 59 typedef SCM (*scm_t_scm_from_scm_u64_intrinsic) (SCM, uint64_t); 60 typedef double (*scm_t_f64_from_s64_intrinsic) (uint64_t); 61 #endif 62 63 typedef void (*scm_t_thread_intrinsic) (scm_thread*); 64 typedef void (*scm_t_thread_scm_intrinsic) (scm_thread*, SCM); 65 typedef void (*scm_t_thread_scm_scm_intrinsic) (scm_thread*, SCM, SCM); 66 typedef SCM (*scm_t_scm_from_thread_scm_intrinsic) (scm_thread*, SCM); 67 typedef int (*scm_t_bool_from_scm_scm_intrinsic) (SCM, SCM); 68 typedef enum scm_compare (*scm_t_compare_from_scm_scm_intrinsic) (SCM, SCM); 69 typedef void (*scm_t_thread_sp_intrinsic) (scm_thread*, union scm_vm_stack_element*); 70 typedef SCM (*scm_t_scm_from_thread_u32_intrinsic) (scm_thread*, uint32_t); 71 typedef uint32_t (*scm_t_u32_from_thread_u32_u32_intrinsic) (scm_thread*, uint32_t, uint32_t); 72 typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) (scm_thread*, uint32_t, 73 uint32_t, SCM, uint8_t, 74 uint8_t); 75 typedef SCM (*scm_t_scm_from_scm_scm_scmp_sp_intrinsic) (SCM, SCM, SCM*, 76 const union scm_vm_stack_element*); 77 typedef void (*scm_t_thread_noreturn_intrinsic) (scm_thread*) SCM_NORETURN; 78 typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_thread*, SCM) SCM_NORETURN; 79 typedef int (*scm_t_int_from_scm_intrinsic) (SCM); 80 typedef void (*scm_t_scm_scm_noreturn_intrinsic) (SCM, SCM) SCM_NORETURN; 81 typedef void (*scm_t_noreturn_intrinsic) (void) SCM_NORETURN; 82 typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN; 83 typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN; 84 typedef SCM (*scm_t_scm_from_thread_sz_intrinsic) (scm_thread*, size_t); 85 typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*); 86 typedef void (*scm_t_thread_u8_scm_sp_vra_mra_intrinsic) (scm_thread*, 87 uint8_t, SCM, 88 const union scm_vm_stack_element*, 89 uint32_t*, uint8_t*); 90 typedef void (*scm_t_thread_mra_intrinsic) (scm_thread*, uint8_t*); 91 typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) (scm_thread*); 92 typedef uint8_t* (*scm_t_mra_from_thread_scm_intrinsic) (scm_thread*, SCM); 93 typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*); 94 typedef SCM (*scm_t_scm_from_ptr_intrinsic) (SCM*); 95 typedef void (*scm_t_ptr_scm_intrinsic) (SCM*, SCM); 96 typedef SCM (*scm_t_scm_from_ptr_scm_intrinsic) (SCM*, SCM); 97 typedef SCM (*scm_t_scm_from_ptr_scm_scm_intrinsic) (SCM*, SCM, SCM); 98 typedef double (*scm_t_f64_from_f64_intrinsic) (double); 99 typedef double (*scm_t_f64_from_f64_f64_intrinsic) (double, double); 100 typedef uint32_t* scm_t_vcode_intrinsic; 101 typedef void (*scm_t_scm_scm_intrinsic) (SCM, SCM); 102 typedef void (*scm_t_scm_scm_scm_intrinsic) (SCM, SCM, SCM); 103 typedef void (*scm_t_scm_uimm_scm_intrinsic) (SCM, uint8_t, SCM); 104 105 #define SCM_FOR_ALL_VM_INTRINSICS(M) \ 106 M(scm_from_scm_scm, add, "add", ADD) \ 107 M(scm_from_scm_uimm, add_immediate, "add/immediate", ADD_IMMEDIATE) \ 108 M(scm_from_scm_scm, sub, "sub", SUB) \ 109 M(scm_from_scm_uimm, sub_immediate, "sub/immediate", SUB_IMMEDIATE) \ 110 M(scm_from_scm_scm, mul, "mul", MUL) \ 111 M(scm_from_scm_scm, div, "div", DIV) \ 112 M(scm_from_scm_scm, quo, "quo", QUO) \ 113 M(scm_from_scm_scm, rem, "rem", REM) \ 114 M(scm_from_scm_scm, mod, "mod", MOD) \ 115 M(scm_from_scm_scm, logand, "logand", LOGAND) \ 116 M(scm_from_scm_scm, logior, "logior", LOGIOR) \ 117 M(scm_from_scm_scm, logxor, "logxor", LOGXOR) \ 118 M(scm_sz_u32, string_set_x, "string-set!", STRING_SET_X) \ 119 M(scm_from_scm, string_to_number, "string->number", STRING_TO_NUMBER) \ 120 M(scm_from_scm, string_to_symbol, "string->symbol", STRING_TO_SYMBOL) \ 121 M(scm_from_scm, symbol_to_keyword, "symbol->keyword", SYMBOL_TO_KEYWORD) \ 122 M(scm_from_scm, class_of, "class-of", CLASS_OF) \ 123 M(f64_from_scm, scm_to_f64, "scm->f64", SCM_TO_F64) \ 124 M(u64_from_scm, scm_to_u64, "scm->u64", SCM_TO_U64) \ 125 M(u64_from_scm, scm_to_u64_truncate, "scm->u64/truncate", SCM_TO_U64_TRUNCATE) \ 126 M(s64_from_scm, scm_to_s64, "scm->s64", SCM_TO_S64) \ 127 M(scm_from_u64, u64_to_scm, "u64->scm", U64_TO_SCM) \ 128 M(scm_from_s64, s64_to_scm, "s64->scm", S64_TO_SCM) \ 129 M(scm_from_scm_scm, logsub, "logsub", LOGSUB) \ 130 M(thread_scm_scm, wind, "wind", WIND) \ 131 M(thread, unwind, "unwind", UNWIND) \ 132 M(thread_scm_scm, push_fluid, "push-fluid", PUSH_FLUID) \ 133 M(thread, pop_fluid, "pop-fluid", POP_FLUID) \ 134 M(scm_from_thread_scm, fluid_ref, "fluid-ref", FLUID_REF) \ 135 M(thread_scm_scm, fluid_set_x, "fluid-set!", FLUID_SET_X) \ 136 M(thread_scm, push_dynamic_state, "push-dynamic-state", PUSH_DYNAMIC_STATE) \ 137 M(thread, pop_dynamic_state, "pop-dynamic-state", POP_DYNAMIC_STATE) \ 138 M(scm_from_scm_u64, lsh, "lsh", LSH) \ 139 M(scm_from_scm_u64, rsh, "rsh", RSH) \ 140 M(scm_from_scm_uimm, lsh_immediate, "lsh/immediate", LSH_IMMEDIATE) \ 141 M(scm_from_scm_uimm, rsh_immediate, "rsh/immediate", RSH_IMMEDIATE) \ 142 M(bool_from_scm_scm, heap_numbers_equal_p, "heap-numbers-equal?", HEAP_NUMBERS_EQUAL_P) \ 143 M(compare_from_scm_scm, less_p, "<?", LESS_P) \ 144 M(bool_from_scm_scm, numerically_equal_p, "=?", NUMERICALLY_EQUAL_P) \ 145 M(scm_from_scm_uimm, resolve_module, "resolve-module", RESOLVE_MODULE) \ 146 M(scm_from_scm_scm, module_variable, "module-variable", MODULE_VARIABLE) \ 147 M(scm_from_scm_scm, define_x, "define!", DEFINE_X) \ 148 M(thread_sp, expand_stack, "expand-stack", EXPAND_STACK) \ 149 M(scm_from_thread_u32, cons_rest, "cons-rest", CONS_REST) \ 150 M(u32_from_thread_u32_u32, compute_kwargs_npositional, "compute-kwargs-npositional", COMPUTE_KWARGS_NPOSITIONAL) \ 151 M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \ 152 M(thread_mra, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \ 153 M(thread_scm_scm, foreign_call, "foreign-call", FOREIGN_CALL) \ 154 M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \ 155 M(scm_from_thread, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \ 156 M(mra_from_thread_scm, compose_continuation, "compose-continuation", COMPOSE_CONTINUATION) \ 157 M(thread, expand_apply_argument, "expand-apply-argument", EXPAND_APPLY_ARGUMENT) \ 158 M(mra_from_thread_mra, abort_to_prompt, "abort-to-prompt", ABORT_TO_PROMPT) \ 159 M(scm_scm_noreturn, throw_, "throw", THROW) \ 160 M(scm_scm_noreturn, throw_with_value, "throw/value", THROW_WITH_VALUE) \ 161 M(scm_scm_noreturn, throw_with_value_and_data, "throw/value+data", THROW_WITH_VALUE_AND_DATA) \ 162 M(thread_noreturn, error_wrong_num_args, "wrong-num-args", ERROR_WRONG_NUM_ARGS) \ 163 M(noreturn, error_no_values, "no-values", ERROR_NO_VALUES) \ 164 M(noreturn, error_not_enough_values, "not-enough-values", ERROR_NOT_ENOUGH_VALUES) \ 165 M(u32_noreturn, error_wrong_number_of_values, "wrong-number-of-values", ERROR_WRONG_NUMBER_OF_VALUES) \ 166 M(vra_from_thread, get_callee_vcode, "get-callee-vcode", GET_CALLEE_VCODE) \ 167 M(scm_from_thread_sz, allocate_words, "allocate-words", ALLOCATE_WORDS) \ 168 M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \ 169 M(thread_u8_scm_sp_vra_mra, push_prompt, "push-prompt", PUSH_PROMPT) \ 170 M(thread_scm, unpack_values_object, "unpack-values-object", UNPACK_VALUES_OBJECT) \ 171 M(vcode, handle_interrupt_code, "%handle-interrupt-code", HANDLE_INTERRUPT_CODE) \ 172 M(scm_from_thread_sz, allocate_words_with_freelist, "allocate-words/freelist", ALLOCATE_WORDS_WITH_FREELIST) \ 173 M(scm_from_scm, abs, "abs", ABS) \ 174 M(scm_from_scm, sqrt, "sqrt", SQRT) \ 175 M(f64_from_f64, fabs, "fabs", FABS) \ 176 M(f64_from_f64, fsqrt, "fsqrt", FSQRT) \ 177 M(scm_from_scm, floor, "floor", FLOOR) \ 178 M(scm_from_scm, ceiling, "ceiling", CEILING) \ 179 M(scm_from_scm, sin, "sin", SIN) \ 180 M(scm_from_scm, cos, "cos", COS) \ 181 M(scm_from_scm, tan, "tan", TAN) \ 182 M(scm_from_scm, asin, "asin", ASIN) \ 183 M(scm_from_scm, acos, "acos", ACOS) \ 184 M(scm_from_scm, atan, "atan", ATAN) \ 185 M(scm_from_scm_scm, atan2, "atan2", ATAN2) \ 186 M(f64_from_f64, ffloor, "ffloor", FFLOOR) \ 187 M(f64_from_f64, fceiling, "fceiling", FCEILING) \ 188 M(f64_from_f64, fsin, "fsin", FSIN) \ 189 M(f64_from_f64, fcos, "fcos", FCOS) \ 190 M(f64_from_f64, ftan, "ftan", FTAN) \ 191 M(f64_from_f64, fasin, "fasin", FASIN) \ 192 M(f64_from_f64, facos, "facos", FACOS) \ 193 M(f64_from_f64, fatan, "fatan", FATAN) \ 194 M(f64_from_f64_f64, fatan2, "fatan2", FATAN2) \ 195 M(scm_from_thread_sz, allocate_pointerless_words, "allocate-pointerless-words", ALLOCATE_POINTERLESS_WORDS) \ 196 M(scm_from_thread_sz, allocate_pointerless_words_with_freelist, "allocate-pointerless-words/freelist", ALLOCATE_POINTERLESS_WORDS_WITH_FREELIST) \ 197 M(scm_from_scm, inexact, "inexact", INEXACT) \ 198 M(f64_from_s64, s64_to_f64, "s64->f64", S64_TO_F64) \ 199 M(scm_from_scm, car, "$car", CAR) \ 200 M(scm_from_scm, cdr, "$cdr", CDR) \ 201 M(scm_scm, set_car_x, "$set-car!", SET_CAR_X) \ 202 M(scm_scm, set_cdr_x, "$set-cdr!", SET_CDR_X) \ 203 M(scm_from_scm, variable_ref, "$variable-ref", VARIABLE_REF) \ 204 M(scm_scm, variable_set_x, "$variable-set!", VARIABLE_SET_X) \ 205 M(scm_from_scm, vector_length, "$vector-length", VECTOR_LENGTH) \ 206 M(scm_from_scm_scm, vector_ref, "$vector-ref", VECTOR_REF) \ 207 M(scm_scm_scm, vector_set_x, "$vector-set!", VECTOR_SET_X) \ 208 M(scm_from_scm_uimm, vector_ref_immediate, "$vector-ref/immediate", VECTOR_REF_IMMEDIATE) \ 209 M(scm_uimm_scm, vector_set_x_immediate, "$vector-set!/immediate", VECTOR_SET_X_IMMEDIATE) \ 210 M(scm_from_scm_scm, allocate_struct, "$allocate-struct", ALLOCATE_STRUCT) \ 211 M(scm_from_scm, struct_vtable, "$struct-vtable", STRUCT_VTABLE) \ 212 M(scm_from_scm_scm, struct_ref, "$struct-ref", STRUCT_REF) \ 213 M(scm_scm_scm, struct_set_x, "$struct-set!", STRUCT_SET_X) \ 214 M(scm_from_scm_uimm, struct_ref_immediate, "$struct-ref/immediate", STRUCT_REF_IMMEDIATE) \ 215 M(scm_uimm_scm, struct_set_x_immediate, "$struct-set!/immediate", STRUCT_SET_X_IMMEDIATE) \ 216 M(scm_from_scm_scm, lookup, "lookup", LOOKUP) \ 217 M(scm_from_scm_scm, lookup_bound, "lookup-bound", LOOKUP_BOUND) \ 218 M(scm_from_scmn_scmn, lookup_bound_public, "lookup-bound-public", LOOKUP_BOUND_PUBLIC) \ 219 M(scm_from_scmn_scmn, lookup_bound_private, "lookup-bound-private", LOOKUP_BOUND_PRIVATE) \ 220 /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ 221 222 /* Intrinsics prefixed with $ are meant to reduce bytecode size, 223 notably for the baseline compiler. */ 224 225 enum scm_vm_intrinsic 226 { 227 #define DEFINE_ENUM(type, id, name, ID) SCM_VM_INTRINSIC_##ID, 228 SCM_FOR_ALL_VM_INTRINSICS(DEFINE_ENUM) 229 #undef DEFINE_ENUM 230 SCM_VM_INTRINSIC_COUNT 231 }; 232 233 SCM_INTERNAL struct scm_vm_intrinsics 234 { 235 #define DEFINE_MEMBER(type, id, name, ID) scm_t_##type##_intrinsic id; 236 SCM_FOR_ALL_VM_INTRINSICS(DEFINE_MEMBER) 237 #undef DEFINE_MEMBER 238 } scm_vm_intrinsics; 239 240 SCM_INTERNAL SCM scm_intrinsic_list (void); 241 242 SCM_INTERNAL void scm_bootstrap_intrinsics (void); 243 SCM_INTERNAL void scm_init_intrinsics (void); 244 245 #endif /* _SCM_INTRINSICS_H_ */ 246