#include <endian.h> #include <stdbool.h> #include <stdint.h> #include <stdio.h> #include <stdlib.h> #include <string.h> #include <sys/resource.h> #include <sys/stat.h> #define static_assert(c) _Static_assert(c, #c) typedef uint32_t value; static_assert(_Alignof(value) <= 4); struct closure { void *native_code; uint16_t num_params; uint16_t env_size; value env_items[]; }; struct tuple { uint16_t num_items; uint16_t layout; value items[]; }; struct variant { uint16_t label; value item; }; enum { BYTE_ARRAY_CLASS_STRING, BYTE_ARRAY_CLASS_BYTE_VECTOR, BYTE_ARRAY_CLASS_SCRATCHPAD, }; enum { BYTE_ARRAY_NUM_BYTES_MAX = 0x3fffffff }; struct byte_array { uint32_t class:2; uint32_t num_bytes:30; char bytes[]; }; static_assert(_Alignof(struct closure) <= 8); static_assert(_Alignof(struct tuple) <= 4); static_assert(_Alignof(struct variant) <= 4); static_assert(_Alignof(struct byte_array) <= 4); enum { TAG_HEAP_CLOSURE = 0x1, TAG_HEAP_TUPLE = 0x3, TAG_HEAP_VARIANT = 0x5, TAG_HEAP_BYTE_ARRAY = 0x7, TAG_IMMEDIATE_BOOLEAN = 0x0f, TAG_IMMEDIATE_TUPLE = 0x1f, TAG_IMMEDIATE_VARIANT = 0x2f, }; enum { empty_tuple = TAG_IMMEDIATE_TUPLE, }; enum { value_true = TAG_IMMEDIATE_BOOLEAN, value_false = (TAG_IMMEDIATE_BOOLEAN | 0x100), }; enum { INTEGER_MIN = INT32_MIN / 2, INTEGER_MAX = INT32_MAX / 2, }; static struct { uint32_t num_entries; const uint16_t *entries; } record_layouts; static FILE *file_table[FOPEN_MAX]; static int command_argc; static const char **command_argv; static void err_print_line(const char *s) { fprintf(stderr, "%s\n", s); } static _Noreturn void halt(void) { exit(1); } static _Noreturn void die(const char *s) { err_print_line(s); halt(); } // The Heap // // The heap is a single contiguous memory region in which value // representation data is stored. // // The heap grows monotonically. If its capacity is exceeded, then the // process exits with a nonzero exit status. // // The size of the heap for a given program is fixed at compile time and // is at most pow(2, 30) bytes (1 GiB). // // All objects allocated in the heap have 4-byte, 8-byte, or 16-byte // alignment. Each object allocated in the heap has an associated heap // identifier, established by heap_alloc. The heap_access function provides // the means for obtaining the native address of an object with a given heap // identifier. // // Members: // bytes - The bytes member holds the native address of the memory // region, which must have 16-byte alignment. The memory region // starting at this address must contain at least (4 * heap.limit) // bytes. // limit - The limit member establishes the growth limit for the heap. It // must not exceed pow(2, 28). The capacity of the heap is // (4 * heap.limit) bytes. This limit is fixed at initialization // time. // top - The top member grows as allocations are made but never exceeds // the limit member. It is initially zero. static struct { char *bytes; uint32_t limit; uint32_t top; } heap; // heap_access // // Parameters: // id - A heap object identifier produced by heap_alloc. static void * heap_access(uint32_t id) { return heap.bytes + 4 * id; } // heap_alloc // // Parameters: // align - The address alignment constraint. It must be 1, 2, 4, 8, or 16. // size - The number of bytes required, which must be greater than zero. static uint32_t heap_alloc(size_t align, size_t size) { uint32_t start = heap.top; if (align > 4) { uint32_t c = align / 4 - 1; start = (start + c) & ~c; } if (start > heap.limit || size > 4 * (heap.limit - start)) die("Failed to allocate memory."); heap.top = start + ((uint32_t)size + 3) / 4; return start; } static value value_make_box(unsigned int tag, uint32_t id) { return (id << 4) | tag; } static void * value_unbox(value x) { return heap_access(x >> 4); } static bool value_has_tag(value x, unsigned int mask, unsigned int tag) { return (x & mask) == tag; } static struct closure * closure_unbox(value closure) { if (!value_has_tag(closure, 0xf, TAG_HEAP_CLOSURE)) die("Value is not a function."); return value_unbox(closure); } static struct tuple * tuple_unbox(value tuple) { if (!value_has_tag(tuple, 0xf, TAG_HEAP_TUPLE)) die("Value is not a tuple."); return value_unbox(tuple); } static struct variant * variant_unbox(value variant) { if (!value_has_tag(variant, 0xf, TAG_HEAP_VARIANT)) die("Value is not a variant."); return value_unbox(variant); } static bool value_is_number(value v) { return (v & 1) == 0; } static value integer_encode(int32_t n) { if (n < INTEGER_MIN || INTEGER_MAX < n) die("Number is out of range."); return n << 1; } static int32_t integer_decode(value v) { if (!value_is_number(v)) die("Value is not a number."); #ifdef __GNUC__ int32_t n = v; // "implementation-defined" behaviour, according to C11. return n >> 1; // "implementation-defined" behaviour, according to C11. #else #error "Need validation of implementation-defined behaviour." #endif } static value boolean_encode(bool b) { return b ? value_true : value_false; } static value string_make(uint32_t length, const char *bytes) { if (length > INTEGER_MAX) die("String is too big."); size_t align = _Alignof(struct byte_array); size_t size = sizeof(struct byte_array) + length + 1; uint32_t id = heap_alloc(align, size); struct byte_array *string_rep = heap_access(id); string_rep->class = BYTE_ARRAY_CLASS_STRING; string_rep->num_bytes = length + 1; if (bytes != NULL) { memmove(string_rep->bytes, bytes, length); string_rep->bytes[length] = '\0'; } return value_make_box(TAG_HEAP_BYTE_ARRAY, id); } static struct byte_array * string_unbox(value string) { const char *error_message = "Value is not a string."; if (!value_has_tag(string, 0xf, TAG_HEAP_BYTE_ARRAY)) die(error_message); struct byte_array *string_rep = value_unbox(string); if (string_rep->class != BYTE_ARRAY_CLASS_STRING) die(error_message); return string_rep; } static char * string_bytes(value string) { struct byte_array *string_rep = string_unbox(string); return string_rep->bytes; } static uint32_t string_length(value string) { struct byte_array *string_rep = string_unbox(string); return string_rep->num_bytes - 1; } static int string_compare(value s_value, value t_value) { const struct byte_array *s_rep = string_unbox(s_value); const struct byte_array *t_rep = string_unbox(t_value); uint32_t s_len = s_rep->num_bytes - 1; uint32_t t_len = t_rep->num_bytes - 1; const char *s = s_rep->bytes; const char *t = t_rep->bytes; for (uint32_t i = 0; i < s_len || i < t_len; i++) { if (i == s_len) return -1; if (i == t_len) return 1; if (s[i] < t[i]) return -1; if (s[i] > t[i]) return 1; } return 0; } static struct byte_array * scratchpad_unbox(value scratchpad) { const char *error_message = "Value is not a scratchpad."; if (!value_has_tag(scratchpad, 0xf, TAG_HEAP_BYTE_ARRAY)) die(error_message); struct byte_array *scratchpad_rep = value_unbox(scratchpad); if (scratchpad_rep->class != BYTE_ARRAY_CLASS_SCRATCHPAD) die(error_message); return scratchpad_rep; } static void * scratchpad_access(value scratchpad, value i_value, int num_bytes) { struct byte_array *scratchpad_rep = scratchpad_unbox(scratchpad); int64_t i = integer_decode(i_value); if (i < 0 || i + num_bytes > scratchpad_rep->num_bytes) die("Scratchpad index is out of range."); return &scratchpad_rep->bytes[i]; } #ifdef __GNUC__ // Implementation-defined behaviour, according to C11. static int8_t from_uint8(uint8_t u) { return (int8_t)u; } static int16_t from_uint16(uint16_t u) { return (int16_t)u; } static int32_t from_uint32(uint32_t u) { return (int32_t)u; } static int64_t from_uint64(uint64_t u) { return (int64_t)u; } #else #error "Need validation of implementation-defined behaviour." #endif static value file_open(value name, const char *mode) { FILE *stream = fopen(string_bytes(name), mode); if (stream == NULL) die("Failed to open file."); int fd = fileno(stream); if (fd >= FOPEN_MAX) die("Too many open files."); file_table[fd] = stream; return integer_encode(fd); } static FILE * file_lookup(value fd_value, int *result_fd) { int32_t fd = integer_decode(fd_value); if (fd < 0 || fd >= FOPEN_MAX) die("File descriptor is out of range."); if (result_fd != NULL) *result_fd = fd; return file_table[fd]; } static void stack_init(uint32_t limit) { const char *error_message = "Failed to set the stack limit."; static_assert(sizeof(rlim_t) == 8); struct rlimit rlim; int r = getrlimit(RLIMIT_STACK, &rlim); if (r != 0) die(error_message); rlim.rlim_cur = limit; r = setrlimit(RLIMIT_STACK, &rlim); if (r != 0) die(error_message); return; } // s36: init // // heap_num_bytes must be at most pow(2, 30). // The alignment of heap_bytes must be at least 16. void s36(uint32_t heap_num_bytes, char *heap_bytes, uint32_t stack_limit, uint32_t record_layouts_num_entries, const uint16_t *record_layouts_entries, int argc, const char **argv) { heap.limit = heap_num_bytes / 4; heap.top = 0; heap.bytes = heap_bytes; stack_init(stack_limit); record_layouts.num_entries = record_layouts_num_entries; record_layouts.entries = record_layouts_entries; file_table[0] = stdin; file_table[1] = stdout; file_table[2] = stderr; command_argc = argc; command_argv = argv; } // s40: prim_command_argc value s40(value x) { (void)x; return integer_encode(command_argc); } // s24: prim_command_argv value s24(value i_value) { int32_t i = integer_decode(i_value); if (i < 0 || i >= command_argc) die("Command argument index is out of range."); return string_make(strlen(command_argv[i]), command_argv[i]); } // s87: halt // // Halt execution, returing 1 as the exit code of the process. _Noreturn value s87(void) { exit(1); } // s52: heap_get_top uint32_t s52(void) { return heap.top; } // s15: heap_set_top void s15(uint32_t top) { heap.top = top; } // s75: closure_make // // Construct a fresh closure value. // // Parameters: // native_code - A C function pointer to a function whose return type is // value and which takes one more than num_params arguments, all of // type value. // num_params - The number of parameters associated with the closure (not // the native function). // env_size - The number of values to be stored in the closure // environment. // env_items - If env_size is zero, then env_items may be NULL; // otherwise, env_items must be an array containing env_size values. // The values provided comprise the environment of the closure. value s75(void *native_code, uint16_t num_params, uint16_t env_size, const value *env_items) { size_t align = _Alignof(struct closure); size_t size = sizeof(struct closure) + env_size * sizeof(value); uint32_t id = heap_alloc(align, size); struct closure *closure_rep = heap_access(id); closure_rep->native_code = native_code; closure_rep->num_params = num_params; closure_rep->env_size = env_size; if (env_size > 0) memmove(closure_rep->env_items, env_items, env_size * sizeof(value)); return value_make_box(TAG_HEAP_CLOSURE, id); } // s62: closure_env_items const value * s62(value closure) { const struct closure *closure_rep = closure_unbox(closure); return closure_rep->env_items; } const void *s35(value closure, uint16_t num_args); value s78(uint16_t num_items, const value *items); const value * s33(value tuple, uint16_t num_items); static value adapt_closure_1_0(value closure) { return ((value (*)(value, value))s35(closure, 1))(closure, empty_tuple); } static value adapt_closure_1_2(value closure, value x0, value x1) { value x = s78(2, (const value[]){x0, x1}); return ((value (*)(value, value))s35(closure, 1))(closure, x); } static value adapt_closure_1_3(value closure, value x0, value x1, value x2) { value x = s78(3, (const value[]){x0, x1, x2}); return ((value (*)(value, value))s35(closure, 1))(closure, x); } static value adapt_closure_1_4(value closure, value x0, value x1, value x2, value x3) { value x = s78(4, (const value[]){x0, x1, x2, x3}); return ((value (*)(value, value))s35(closure, 1))(closure, x); } static value adapt_closure_0_1(value closure, value x) { if (x != empty_tuple) die("Ill-formed function application."); return ((value (*)(value))s35(closure, 0))(closure); } static value adapt_closure_2_1(value closure, value x) { const value *items = s33(x, 2); value (*f)(value, value, value) = s35(closure, 2); return f(closure, items[0], items[1]); } static value adapt_closure_3_1(value closure, value x) { const value *items = s33(x, 3); value (*f)(value, value, value, value) = s35(closure, 3); return f(closure, items[0], items[1], items[2]); } static value adapt_closure_4_1(value closure, value x) { const value *items = s33(x, 4); value (*f)(value, value, value, value, value) = s35(closure, 4); return f(closure, items[0], items[1], items[2], items[3]); } // s35: closure_native_code const void * s35(value closure, uint16_t num_args) { const struct closure *closure_rep = closure_unbox(closure); if (closure_rep->num_params == num_args) return closure_rep->native_code; if (closure_rep->num_params == 1) { switch (num_args) { case 0: return adapt_closure_1_0; case 2: return adapt_closure_1_2; case 3: return adapt_closure_1_3; case 4: return adapt_closure_1_4; default: die("Limitation: Missing adaptor for function application."); } } if (num_args == 1) { switch (closure_rep->num_params) { case 0: return adapt_closure_0_1; case 2: return adapt_closure_2_1; case 3: return adapt_closure_3_1; case 4: return adapt_closure_4_1; default: die("Limitation: Missing adaptor for function application."); } } die("Ill-formed function application."); } // s27: variant_make_nonempty // // Construct a fresh variant value where the enclosed value is not {}. // // Parameters: // label - The label! // item - The enclosed value. value s27(uint16_t label, value item) { size_t align = _Alignof(struct variant); size_t size = sizeof(struct variant); uint32_t id = heap_alloc(align, size); struct variant *variant_rep = heap_access(id); variant_rep->label = label; variant_rep->item = item; return value_make_box(TAG_HEAP_VARIANT, id); } // s09: variant_label // // The label of a variant value. // // Parameters: // variant - The variant! uint16_t s09(value variant) { if (value_has_tag(variant, 0xff, TAG_IMMEDIATE_VARIANT)) return variant >> 8; struct variant *variant_rep = variant_unbox(variant); return variant_rep->label; } // s06: variant_item // // The value embedded within a variant. // // Parameters: // variant - The variant! value s06(value variant) { if (value_has_tag(variant, 0xff, TAG_IMMEDIATE_VARIANT)) return empty_tuple; struct variant *variant_rep = variant_unbox(variant); return variant_rep->item; } // s30: tuple_make_with_layout value s30(uint16_t num_items, const value *items, uint16_t layout) { size_t align = _Alignof(struct tuple); size_t size = sizeof(struct tuple) + num_items * sizeof(value); uint32_t id = heap_alloc(align, size); struct tuple *tuple_rep = heap_access(id); tuple_rep->num_items = num_items; tuple_rep->layout = layout; if (num_items > 0) memmove(tuple_rep->items, items, num_items * sizeof(value)); return value_make_box(TAG_HEAP_TUPLE, id); } // s78: tuple_make_with_no_layout value s78(uint16_t num_items, const value *items) { return s30(num_items, items, UINT16_MAX); } // s68: tuple_fetch_at_offset value s68(value tuple, uint16_t offset) { const char *error_message = "Ill-formed tuple access."; if (tuple == empty_tuple) die(error_message); struct tuple *tuple_rep = tuple_unbox(tuple); if (offset >= tuple_rep->num_items) die(error_message); return tuple_rep->items[offset]; } // s31: tuple_fetch_at_label value s31(value tuple, uint16_t label) { const char *error_message = "Ill-formed record access."; if (tuple == empty_tuple) die(error_message); const unsigned short *entries = record_layouts.entries; struct tuple *tuple_rep = tuple_unbox(tuple); unsigned int layout = tuple_rep->layout; if (layout == UINT16_MAX) die(error_message); for (unsigned int i = layout; entries[i] != UINT16_MAX; i++) { if (entries[i] == label) return tuple_rep->items[i - layout]; } die(error_message); } // s33: tuple_items const value * s33(value tuple, uint16_t num_items) { if (tuple == empty_tuple) die("Invalid use of empty tuple."); struct tuple *tuple_rep = tuple_unbox(tuple); if (tuple_rep->num_items != num_items) die("Tuple mismatch."); return tuple_rep->items; } // s57: string_make value s57(const char *s) { return string_make(strlen(s), s); } // s86: string_make_static value s86(size_t num_bytes, const char *s) { return string_make(num_bytes - 1, s); } // s89: stuck_cond _Noreturn value s89(void) { die("Cond expression has no applicable clause."); } // s88: stuck_switch _Noreturn value s88(void) { die("Switch expression has no applicable clause."); } // s53: stuck_match _Noreturn value s53(void) { die("Match expression has no applicable clause."); } // s26: prim_die value s26(value string) { die(string_bytes(string)); } // s18: prim_print value s18(value string) { printf("%s", string_bytes(string)); return empty_tuple; } // s79: prim_print_line value s79(value string) { printf("%s\n", string_bytes(string)); return empty_tuple; } // s20: prim_file_create value s20(value name) { return file_open(name, "w"); } // s23: prim_file_open value s23(value name) { return file_open(name, "r"); } // s92: prim_file_close value s92(value fd_value) { int32_t fd = integer_decode(fd_value); if (fd < 0 || fd >= FOPEN_MAX) die("Invalid file descriptor."); if (fd <= 2) die("Attempted to close stdin, stdout, or stderr."); FILE *stream = file_table[fd]; if (stream != NULL) { fclose(stream); file_table[fd] = NULL; } return empty_tuple; } // s28: prim_file_read_all value s28(value fd_value) { int fd; FILE *stream = file_lookup(fd_value, &fd); if (stream == NULL) die("File is not open."); struct stat statbuf; if (-1 == fstat(fd, &statbuf)) die("Failed to determine file size."); off_t file_size = statbuf.st_size; if (file_size < 0 || file_size > UINT32_MAX - 1) die("Failed to read file."); value string = string_make(file_size, NULL); char *bytes = string_bytes(string); if (1 != fread(bytes, file_size, 1, stream)) die("Failed to read file."); bytes[file_size] = '\0'; return string; } // s97: prim_file_write value s97(value fd_value, value byte_array) { int fd; FILE *stream = file_lookup(fd_value, &fd); if (stream == NULL) die("File is not open."); if (!value_has_tag(byte_array, 0xf, TAG_HEAP_BYTE_ARRAY)) die("Value is not a byte array"); struct byte_array *byte_array_rep = value_unbox(byte_array); uint32_t num_bytes = byte_array_rep->num_bytes; if (byte_array_rep->class == BYTE_ARRAY_CLASS_STRING) num_bytes--; if (num_bytes > 0) { size_t r = fwrite(byte_array_rep->bytes, num_bytes, 1, stream); if (r != 1) die("Failed to write to file."); } return empty_tuple; } // s77: prim_file_write_byte value s77(value fd_value, value byte) { int fd; FILE *stream = file_lookup(fd_value, &fd); if (stream == NULL) die("File is not open."); int32_t b = integer_decode(byte); if (b < 0 || 255 < b) die("Byte value is out of range."); int r = fputc(b, stream); if (r == EOF) die("File write error."); return empty_tuple; } // s12: prim_show_integer value s12(value integer) { char text[16]; size_t len = snprintf(text, sizeof(text), "%ld", (long)integer_decode(integer)); if (len >= sizeof(text)) die("Failed to show integer."); return string_make(len, text); } // s22: prim_compose static value apply_composite(value closure, value x) { const value *env = s62(closure); value y = ((value (*)(value, value))s35(env[1], 1))(env[1], x); return ((value (*)(value, value))s35(env[0], 1))(env[0], y); } value s22(value f, value g) { bool f_is_closure = value_has_tag(f, 0xf, TAG_HEAP_CLOSURE); bool g_is_closure = value_has_tag(g, 0xf, TAG_HEAP_CLOSURE); if (!f_is_closure || !g_is_closure) die("Value is not a function."); return s75(apply_composite, 1, 2, (const value[]){f, g}); } // s93: prim_multiply value s93(value a, value b) { int32_t n; if (__builtin_mul_overflow(integer_decode(a), integer_decode(b), &n)) die("Integer is out of range."); return integer_encode(n); } // s19: prim_add value s19(value a, value b) { int32_t n; if (__builtin_add_overflow(integer_decode(a), integer_decode(b), &n)) die("Integer is out of range."); return integer_encode(n); } // s47: prim_subtract value s47(value a, value b) { int32_t n; if (__builtin_sub_overflow(integer_decode(a), integer_decode(b), &n)) die("Integer is out of range."); return integer_encode(n); } // s84: prim_negate value s84(value n) { return integer_encode(-integer_decode(n)); } struct division_result { int32_t q; int32_t r; }; static struct division_result divide(int32_t b, int32_t a) { if (a == 0) die("Division by zero."); int32_t b_abs = (b < 0) ? -b : b; int32_t a_abs = (a < 0) ? -a : a; int32_t q = b_abs / a_abs; int32_t r = b_abs % a_abs; // Invariant: b_abs = q * a_abs + r // Invariant: 0 <= r < |a| if (b < 0) { if (r > 0) { q++; r -= a_abs; } q = -q; r = -r; } // Invariant: b = q * a_abs + r // Invariant: 0 <= r < |a| if (a < 0) q = -q; // Invariant: b = q * a + r // Invariant: 0 <= r < |a| return (struct division_result){.q = q, .r = r}; } // s91: prim_quotient value s91(value b_value, value a_value) { int32_t b = integer_decode(b_value); int32_t a = integer_decode(a_value); struct division_result d = divide(b, a); return integer_encode(d.q); } // s43: prim_remainder value s43(value b_value, value a_value) { int32_t b = integer_decode(b_value); int32_t a = integer_decode(a_value); struct division_result d = divide(b, a); return integer_encode(d.r); } // s50: prim_equal value s50(value a, value b) { return boolean_encode(integer_decode(a) == integer_decode(b)); } // s10: prim_less value s10(value a, value b) { return boolean_encode(integer_decode(a) < integer_decode(b)); } // s63: prim_less_or_equal value s63(value a, value b) { return boolean_encode(integer_decode(a) <= integer_decode(b)); } // s61: prim_greater value s61(value a, value b) { return boolean_encode(integer_decode(a) > integer_decode(b)); } // s55: prim_greater_or_equal value s55(value a, value b) { return boolean_encode(integer_decode(a) >= integer_decode(b)); } // s65: prim_string_length value s65(value string) { return integer_encode(string_length(string)); } // s69: prim_string_fetch value s69(value string, value i_value) { int32_t i = integer_decode(i_value); const struct byte_array *string_rep = string_unbox(string); if (i < 0 || i >= (string_rep->num_bytes - 1)) die("Index is out of range."); return integer_encode(string_rep->bytes[i]); } // s37: prim_string_compare value s37(value s, value t) { return integer_encode(string_compare(s, t)); } // s45: prim_string_equal value s45(value s, value t) { int r = string_compare(s, t); return boolean_encode(r == 0); } // s25: prim_string_append value s25(value s, value t) { uint32_t s_length = string_length(s); uint32_t t_length = string_length(t); uint32_t u_length = s_length + t_length; value u = string_make(u_length, NULL); char *u_bytes = string_bytes(u); memmove(u_bytes, string_bytes(s), s_length); memmove(u_bytes + s_length, string_bytes(t), t_length + 1); return u; } // s44: prim_string_clip value s44(value s, value begin, value end) { uint32_t s_length = string_length(s); int32_t b = integer_decode(begin); int32_t e = integer_decode(end); if (b < 0 || e < 0 || b > e || e > s_length) die("String clip parameters are invalid."); uint32_t t_length = e - b; value t = string_make(t_length, NULL); const char *s_bytes = string_bytes(s); char *t_bytes = string_bytes(t); memmove(t_bytes, s_bytes + b, t_length); t_bytes[t_length] = '\0'; return t; } static void store_uint8(void *bytes, uint8_t u) { memmove(bytes, &u, 1); } static void store_uint16_le(void *bytes, uint16_t u) { u = htole16(u); memmove(bytes, &u, 2); } static void store_uint32_le(void *bytes, uint32_t u) { u = htole32(u); memmove(bytes, &u, 4); } static void store_uint64_le(void *bytes, uint64_t u) { u = htole64(u); memmove(bytes, &u, 8); } static void store_int8(void *bytes, int8_t s) { uint8_t u = s; memmove(bytes, &u, 1); } static void store_int16_le(void *bytes, int16_t s) { uint16_t u = s; u = htole16(u); memmove(bytes, &u, 2); } static void store_int32_le(void *bytes, int32_t s) { uint32_t u = s; u = htole32(u); memmove(bytes, &u, 4); } static void store_int64_le(void *bytes, int64_t s) { uint64_t u = s; u = htole64(u); memmove(bytes, &u, 8); } static uint8_t fetch_uint8(const void *bytes) { uint8_t u; memmove(&u, bytes, 1); return u; } static uint16_t fetch_uint16_le(const void *bytes) { uint16_t u; memmove(&u, bytes, 2); return le16toh(u); } static uint32_t fetch_uint32_le(const void *bytes) { uint32_t u; memmove(&u, bytes, 4); return le32toh(u); } static uint64_t fetch_uint64_le(const void *bytes) { uint64_t u; memmove(&u, bytes, 8); return le64toh(u); } static int8_t fetch_int8(const void *bytes) { uint8_t u; memmove(&u, bytes, 1); return from_uint8(u); } static int16_t fetch_int16_le(const void *bytes) { uint16_t u; memmove(&u, bytes, 2); u = le16toh(u); return from_uint16(u); } static int32_t fetch_int32_le(const void *bytes) { uint32_t u; memmove(&u, bytes, 4); u = le32toh(u); return from_uint32(u); } static int64_t fetch_int64_le(const void *bytes) { uint64_t u; memmove(&u, bytes, 8); u = le64toh(u); return from_uint64(u); } // s38: prim_scratchpad_new value s38(value num_bytes_value) { int32_t num_bytes = integer_decode(num_bytes_value); if (num_bytes > BYTE_ARRAY_NUM_BYTES_MAX) die("Scratchpad size is too big."); size_t align = _Alignof(struct byte_array); size_t size = sizeof(struct byte_array) + num_bytes; uint32_t id = heap_alloc(align, size); struct byte_array *scratchpad_rep = heap_access(id); scratchpad_rep->class = BYTE_ARRAY_CLASS_SCRATCHPAD; scratchpad_rep->num_bytes = num_bytes; memset(scratchpad_rep->bytes, 0, num_bytes); return value_make_box(TAG_HEAP_BYTE_ARRAY, id); } // s14: prim_scratchpad_size value s14(value scratchpad) { const struct byte_array *scratchpad_rep = scratchpad_unbox(scratchpad); return integer_encode(scratchpad_rep->num_bytes); } // s42: prim_scratchpad_store_uint8 value s42(value scratchpad, value i_value, value n_value) { void *bytes = scratchpad_access(scratchpad, i_value, 1); int64_t n = integer_decode(n_value); if (n < 0 || UINT8_MAX < n) die("Scratchpad value is out of range."); store_uint8(bytes, n); return empty_tuple; } // s13: prim_scratchpad_fetch_uint8 value s13(value scratchpad, value i_value) { const void *bytes = scratchpad_access(scratchpad, i_value, 1); uint16_t u = fetch_uint8(bytes); static_assert(UINT16_MAX <= INTEGER_MAX); return integer_encode(u); } // s76: prim_scratchpad_store_int8_le value s76(value scratchpad, value i_value, value n_value) { void *bytes = scratchpad_access(scratchpad, i_value, 1); int64_t s = integer_decode(n_value); if (s < INT8_MIN || INT8_MAX < s) die("Number is out of range."); store_int8(bytes, s); return empty_tuple; } // s46: prim_scratchpad_fetch_int8_le value s46(value scratchpad, value i_value) { const void *bytes = scratchpad_access(scratchpad, i_value, 1); int64_t s = fetch_int8(bytes); if (s < INTEGER_MIN || INTEGER_MAX < s) die("Number is out of range."); return integer_encode(s); } // s54: prim_scratchpad_store_uint16_le value s54(value scratchpad, value i_value, value n_value) { void *bytes = scratchpad_access(scratchpad, i_value, 2); int64_t n = integer_decode(n_value); if (n < 0 || UINT16_MAX < n) die("Scratchpad value is out of range."); store_uint16_le(bytes, n); return empty_tuple; } // s29: prim_scratchpad_fetch_uint16_le value s29(value scratchpad, value i_value) { const void *bytes = scratchpad_access(scratchpad, i_value, 2); uint16_t u = fetch_uint16_le(bytes); static_assert(UINT16_MAX <= INTEGER_MAX); return integer_encode(u); } // s08: prim_scratchpad_store_int16_le value s08(value scratchpad, value i_value, value n_value) { void *bytes = scratchpad_access(scratchpad, i_value, 2); int64_t s = integer_decode(n_value); if (s < INT16_MIN || INT16_MAX < s) die("Number is out of range."); store_int16_le(bytes, s); return empty_tuple; } // s98: prim_scratchpad_fetch_int16_le value s98(value scratchpad, value i_value) { const void *bytes = scratchpad_access(scratchpad, i_value, 2); int64_t s = fetch_int16_le(bytes); if (s < INTEGER_MIN || INTEGER_MAX < s) die("Number is out of range."); return integer_encode(s); } // s74: prim_scratchpad_store_uint32_le value s74(value scratchpad, value i_value, value n_value) { void *bytes = scratchpad_access(scratchpad, i_value, 4); int64_t n = integer_decode(n_value); if (n < 0 || UINT32_MAX < n) die("Scratchpad value is out of range."); store_uint32_le(bytes, n); return empty_tuple; } // s01: prim_scratchpad_fetch_uint32_le value s01(value scratchpad, value i_value) { const void *bytes = scratchpad_access(scratchpad, i_value, 4); uint32_t u = fetch_uint32_le(bytes); if (u > INTEGER_MAX) die("Number is out of range."); return integer_encode(u); } // s17: prim_scratchpad_store_int32_le value s17(value scratchpad, value i_value, value n_value) { void *bytes = scratchpad_access(scratchpad, i_value, 4); int64_t s = integer_decode(n_value); if (s < INT32_MIN || INT32_MAX < s) die("Number is out of range."); store_int32_le(bytes, s); return empty_tuple; } // s59: prim_scratchpad_fetch_int32_le value s59(value scratchpad, value i_value) { const void *bytes = scratchpad_access(scratchpad, i_value, 4); int64_t s = fetch_int32_le(bytes); if (s < INTEGER_MIN || INTEGER_MAX < s) die("Number is out of range."); return integer_encode(s); } // s21: prim_scratchpad_store_uint64_le value s21(value scratchpad, value i_value, value n_value) { void *bytes = scratchpad_access(scratchpad, i_value, 8); int64_t n = integer_decode(n_value); if (n < 0 || UINT64_MAX < n) die("Scratchpad value is out of range."); store_uint64_le(bytes, n); return empty_tuple; } // s99: prim_scratchpad_fetch_uint64_le value s99(value scratchpad, value i_value) { const void *bytes = scratchpad_access(scratchpad, i_value, 8); uint64_t u = fetch_uint64_le(bytes); if (u > INTEGER_MAX) die("Number is out of range."); return integer_encode(u); } // s58: prim_scratchpad_store_int64_le value s58(value scratchpad, value i_value, value n_value) { void *bytes = scratchpad_access(scratchpad, i_value, 8); int64_t s = integer_decode(n_value); if (s < INT64_MIN || INT64_MAX < s) die("Number is out of range."); store_int64_le(bytes, s); return empty_tuple; } // s80: prim_scratchpad_fetch_int64_le value s80(value scratchpad, value i_value) { const void *bytes = scratchpad_access(scratchpad, i_value, 8); int64_t s = fetch_int64_le(bytes); if (s < INTEGER_MIN || INTEGER_MAX < s) die("Number is out of range."); return integer_encode(s); }