Language 84

File

language84-0.4/support.c

#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;
}

//  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)
        die("Ill-formed function application.");
    return closure_rep->native_code;
}

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

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