From ecc350ca5c2eb50be8309c5f14f8bf0d87db9a02 Mon Sep 17 00:00:00 2001 From: Moon Flower Date: Mon, 12 Oct 2026 08:46:23 +0330 Subject: a --- src/baremetal/link_aarch64.ld | 37 + src/baremetal/link_riscv.ld | 39 + src/baremetal/port.c | 339 ++ src/baremetal/run.sh | 104 + src/baremetal/start_aarch64.S | 38 + src/baremetal/start_riscv.S | 20 + src/compiler/compiler.zc | 8027 +++++++++++++++++++++++++++++++++++++++++ src/core/bops.h | 87 + src/core/core.c | 5889 ++++++++++++++++++++++++++++++ src/core/fops.h | 1048 ++++++ src/core/io_linux.c | 69 + src/core/io_win.c | 25 + src/core/memmap.h | 53 + src/core/stack.h | 112 + src/js/extract_genome.js | 45 + src/js/extract_lsp.js | 21 + src/js/mapvalues.js | 22 + src/js/tinyvm.ts | 946 +++++ src/lib/std.zc | 455 +++ src/lsp/server.zc | 1929 ++++++++++ src/micro/micro.c | 643 ++++ src/micro/micro_port.h | 89 + src/micro/port_linux.c | 284 ++ src/micro/port_stub.c | 59 + src/micro/port_wasm_stream.c | 121 + src/micro/port_win.c | 268 ++ src/runtime/rt.zc | 1326 +++++++ src/runtime/run.zc | 27 + src/tools/automap.sh | 58 + src/tools/build.zc | 14 + src/tools/genmap.c | 858 +++++ src/tools/mkgenome.c | 31 + src/tools/mklsp.sh | 14 + src/tools/mklspwasm.sh | 20 + src/tools/mkvsix.sh | 35 + src/tools/zc0.c | 880 +++++ src/tools/zcc | 54 + src/web/build.sh | 12 + src/web/index.html | 60 + src/web/port_wasm.c | 86 + src/web/zc.js | 28 + 41 files changed, 24272 insertions(+) create mode 100644 src/baremetal/link_aarch64.ld create mode 100644 src/baremetal/link_riscv.ld create mode 100644 src/baremetal/port.c create mode 100755 src/baremetal/run.sh create mode 100644 src/baremetal/start_aarch64.S create mode 100644 src/baremetal/start_riscv.S create mode 100644 src/compiler/compiler.zc create mode 100644 src/core/bops.h create mode 100644 src/core/core.c create mode 100644 src/core/fops.h create mode 100644 src/core/io_linux.c create mode 100644 src/core/io_win.c create mode 100644 src/core/memmap.h create mode 100644 src/core/stack.h create mode 100644 src/js/extract_genome.js create mode 100644 src/js/extract_lsp.js create mode 100644 src/js/mapvalues.js create mode 100644 src/js/tinyvm.ts create mode 100644 src/lib/std.zc create mode 100644 src/lsp/server.zc create mode 100644 src/micro/micro.c create mode 100644 src/micro/micro_port.h create mode 100644 src/micro/port_linux.c create mode 100644 src/micro/port_stub.c create mode 100644 src/micro/port_wasm_stream.c create mode 100644 src/micro/port_win.c create mode 100644 src/runtime/rt.zc create mode 100644 src/runtime/run.zc create mode 100755 src/tools/automap.sh create mode 100644 src/tools/build.zc create mode 100644 src/tools/genmap.c create mode 100644 src/tools/mkgenome.c create mode 100755 src/tools/mklsp.sh create mode 100755 src/tools/mklspwasm.sh create mode 100755 src/tools/mkvsix.sh create mode 100644 src/tools/zc0.c create mode 100755 src/tools/zcc create mode 100755 src/web/build.sh create mode 100644 src/web/index.html create mode 100644 src/web/port_wasm.c create mode 100644 src/web/zc.js (limited to 'src') diff --git a/src/baremetal/link_aarch64.ld b/src/baremetal/link_aarch64.ld new file mode 100644 index 0000000..6740f21 --- /dev/null +++ b/src/baremetal/link_aarch64.ld @@ -0,0 +1,37 @@ +OUTPUT_ARCH(aarch64) +OUTPUT_FORMAT(elf64-littleaarch64) +ENTRY(_start) + +/* virt RAM starts at 0x40000000. The PL011 UART is at 0x09000000, outside this. */ +MEMORY +{ + RAM (rwx) : ORIGIN = 0x40000000, LENGTH = 48M +} + +SECTIONS +{ + .text : { + KEEP(*(.text.init)) + *(.text .text.*) + } > RAM + .rodata : { + *(.rodata .rodata.*) + } > RAM + .data : { + *(.data .data.*) + } > RAM + .bss : { + . = ALIGN(16); + _sbss = .; + *(.bss .bss.*) + *(COMMON) + . = ALIGN(16); + _ebss = .; + } > RAM + .stack : { + . = ALIGN(16); + . += 64K; + _stack_top = .; + } > RAM + /DISCARD/ : { *(.eh_frame*) *(.comment) *(.note*) } +} diff --git a/src/baremetal/link_riscv.ld b/src/baremetal/link_riscv.ld new file mode 100644 index 0000000..cd470a4 --- /dev/null +++ b/src/baremetal/link_riscv.ld @@ -0,0 +1,39 @@ +OUTPUT_ARCH(riscv) +OUTPUT_FORMAT(elf64-littleriscv) +ENTRY(_start) + +MEMORY +{ + RAM (rwx) : ORIGIN = 0x80000000, LENGTH = 48M +} + +SECTIONS +{ + .text : { + KEEP(*(.text.init)) + *(.text .text.*) + } > RAM + .rodata : { + *(.rodata .rodata.*) + *(.srodata .srodata.*) + } > RAM + .data : { + *(.data .data.*) + *(.sdata .sdata.*) + } > RAM + .bss : { + . = ALIGN(16); + _sbss = .; + *(.bss .bss.*) + *(.sbss .sbss.*) + *(COMMON) + . = ALIGN(16); + _ebss = .; + } > RAM + .stack : { + . = ALIGN(16); + . += 64K; + _stack_top = .; + } > RAM + /DISCARD/ : { *(.eh_frame*) *(.comment) *(.note*) *(.riscv.attributes) } +} diff --git a/src/baremetal/port.c b/src/baremetal/port.c new file mode 100644 index 0000000..636c1ea --- /dev/null +++ b/src/baremetal/port.c @@ -0,0 +1,339 @@ +/* UART port for the microcore. No libc. BARE_RISCV is the 16550 at + 0x10000000 on qemu's riscv virt. BARE_AARCH64 is the PL011 at 0x09000000 + on qemu's aarch64 virt. + + BARE_INPUT=0 (a program baked into the image, nothing typed): eof is + true and getc is -1. BARE_INPUT=1: bytes come from the UART. getc and + eof both wait until a byte is there. 0x04 (EOT) is end of input and is + not delivered. A gap is not the end, so a stream longer than the UART + FIFO still echoes until EOT. The compiler's backtick still ends a unit; + the byte after it is the program's first input, or EOT when the program + reads nothing. + + Syscalls, same numbers as the hosted ports: + 1 open 2 close 3 read 4 write a small RAM file store + 5 getenv BOARD is "riscv" or "aarch64" + 6 time the hardware counter, not unix seconds + 7 exit(status) + 8 random + 9 memory 0 micro_mem_words(), 1 HEAP_LO, 2 HEAP_HI, 3 micro_mem_words()*8 + 10 bopen 11 bread 12 bwrite 13 bgetenv + 10..13 use packed bytes. Anything else is -1. */ +#include "micro_port.h" +#include "bops.h" + +#ifndef BARE_INPUT +#define BARE_INPUT 0 +#endif + +#if defined(BARE_RISCV) +static volatile unsigned char *const uart = (volatile unsigned char *)0x10000000; +#define UART_LSR 5 +#define LSR_RX 0x01 +#define LSR_TX 0x20 + +static void uart_init(void) +{ + /* QEMU's 16550 already speaks 8N1. Rewriting LCR or FCR after + bytes have arrived drops the first one, and the source is + already in the FIFO by the time this runs. */ +} + +static int rx_ready(void) { return uart[UART_LSR] & LSR_RX; } +static void uart_write(unsigned char c) +{ + while ((uart[UART_LSR] & LSR_TX) == 0) ; + uart[0] = c; +} +static int uart_read(void) +{ + while (!rx_ready()) ; + return uart[0]; +} +static unsigned long timer(void) +{ + unsigned long t; + __asm__ volatile("rdtime %0" : "=r"(t)); + return t; +} +static void exit_status(int code) +{ + volatile unsigned *test = (volatile unsigned *)0x100000; + /* PASS exits 0. FAIL's high half is the status (16 bits). */ + if (code == 0) *test = 0x5555; + else *test = ((unsigned)(code & 0xffff) << 16) | 0x3333; + for (;;) ; +} +#elif defined(BARE_AARCH64) +static volatile unsigned *const uart = (volatile unsigned *)0x09000000; +#define UART_FR 6 /* 0x18 / 4 */ +#define FR_RXFE 0x10 +#define FR_TXFF 0x20 + +static void uart_init(void) { } +static int rx_ready(void) { return (uart[UART_FR] & FR_RXFE) == 0; } +static void uart_write(unsigned char c) +{ + while (uart[UART_FR] & FR_TXFF) ; + uart[0] = c; +} +static int uart_read(void) +{ + while (!rx_ready()) ; + return (int)uart[0]; +} +static unsigned long timer(void) +{ + unsigned long t; + __asm__ volatile("mrs %0, cntvct_el0" : "=r"(t)); + return t; +} +static void exit_status(int code) +{ + /* SYS_EXIT. x1 points at {ADP_Stopped_ApplicationExit, status}. + QEMU has to be started with -semihosting; PSCI SYSTEM_OFF cannot + carry a status. */ + unsigned long blk[2]; + register unsigned long x0 __asm__("x0") = 0x18; + register unsigned long x1 __asm__("x1"); + blk[0] = 0x20026ul; + blk[1] = (unsigned long)code; + x1 = (unsigned long)blk; + __asm__ volatile("hlt #0xf000" :: "r"(x0), "r"(x1) : "memory"); + for (;;) ; +} +#else +#error define BARE_RISCV or BARE_AARCH64 +#endif + +static int saw_end, have_peek, peekc; + +void micro_putc(int c) { uart_write((unsigned char)c); } + +void micro_msg(const char *s) +{ + while (*s) uart_write((unsigned char)*s++); +} + +/* the machine's memory on this board: the arena below, which is the board's RAM as + memmap.h sizes it. a board's RAM is a fixed amount of hardware, so this is the one + place the port has a size; it returns NULL past it. */ +/* physical backing is separate from the vm's configurable growth limit. */ +#ifndef MICRO_PORT_WORDS +#define MICRO_PORT_WORDS (HEAP_HI > PW ? HEAP_HI : PW) +#endif +static Cell arena[MICRO_PORT_WORDS]; + +Cell *micro_mem_alloc(UCell words) +{ + if (words > MICRO_PORT_WORDS) return 0; + return arena; +} + +static int inmem(Cell a) { return (UCell)a < (UCell)micro_mem_words(); } + +static int zcstr(Cell *mem, Cell addr, char *dst, int max) +{ + int i = 0, c; + if (max < 1) return -1; + if (!inmem(addr)) { dst[0] = 0; return -1; } + while (i < max - 1 && inmem(addr + i)) { + c = (int)mem[addr + i]; + if (!c) break; + dst[i++] = (char)(c & 255); + } + dst[i] = 0; + return i; +} + +static int streq(const char *a, const char *b) +{ + int i = 0; + while (a[i] && a[i] == b[i]) i++; + return a[i] == b[i]; +} + +#define NFILES 4 +#define FCAP 128 +#define NLEN 32 +static struct { + char name[NLEN]; + unsigned char data[FCAP]; + int len, pos; +} ramf[NFILES]; + +static int ram_slot(const char *name, int create) +{ + int i, free_i = -1, n; + for (i = 0; i < NFILES; i++) { + if (!ramf[i].name[0]) { if (free_i < 0) free_i = i; continue; } + if (streq(ramf[i].name, name)) return i; + } + if (!create || free_i < 0) return -1; + for (n = 0; name[n] && n < NLEN - 1; n++) ramf[free_i].name[n] = name[n]; + ramf[free_i].name[n] = 0; + ramf[free_i].len = 0; + ramf[free_i].pos = 0; + return free_i; +} + +static UCell rng; +static Cell rnd(void) +{ + if (!rng) rng = timer() ^ 0x9E3779B97F4A7C15ull; + if (!rng) rng = 0x9E3779B97F4A7C15ull; + rng ^= rng << 13; + rng ^= rng >> 7; + rng ^= rng << 17; + if ((Cell)rng == -1) rng ^= 0x100; + return (Cell)rng; +} + +static void board_name(char *dst) +{ +#if defined(BARE_RISCV) + dst[0] = 'r'; dst[1] = 'i'; dst[2] = 's'; dst[3] = 'c'; dst[4] = 'v'; dst[5] = 0; +#else + dst[0] = 'a'; dst[1] = 'a'; dst[2] = 'r'; dst[3] = 'c'; dst[4] = 'h'; + dst[5] = '6'; dst[6] = '4'; dst[7] = 0; +#endif +} + +Cell micro_syscall(Cell *mem, Cell op, Cell a, Cell b, Cell c) +{ + char path[NLEN]; + int fd, n, i; + switch ((int)op) { + case 1: + if (zcstr(mem, a, path, NLEN) < 0 || !path[0]) return -1; + fd = ram_slot(path, b == 1); + if (fd < 0) return -1; + if (b == 1) { ramf[fd].len = 0; ramf[fd].pos = 0; } + else ramf[fd].pos = 0; + return fd; + case 2: + if ((UCell)a >= NFILES || !ramf[a].name[0]) return -1; + ramf[a].pos = 0; + return 0; + case 3: + if ((UCell)a >= NFILES || !ramf[a].name[0] || c < 0 || !inmem(b)) return -1; + n = 0; + while (n < c && ramf[a].pos < ramf[a].len && inmem(b + n)) { + mem[b + n] = ramf[a].data[ramf[a].pos++]; + n++; + } + return n; + case 4: + if ((UCell)a >= NFILES || !ramf[a].name[0] || c < 0 || !inmem(b)) return -1; + n = 0; + while (n < c && ramf[a].len < FCAP && inmem(b + n)) { + ramf[a].data[ramf[a].len++] = (unsigned char)mem[b + n]; + n++; + } + ramf[a].pos = ramf[a].len; + return n; + case 5: { + char board[8], *e; + if (zcstr(mem, a, path, NLEN) < 0) return -1; + board_name(board); + e = streq(path, "BOARD") ? board : 0; + if (!e) return -1; + if (c < 1 || !inmem(b)) return -1; + i = 0; + while (e[i] && i < c - 1 && inmem(b + i)) { mem[b + i] = (unsigned char)e[i]; i++; } + if (inmem(b + i)) mem[b + i] = 0; + return i; + } + case 6: + return (Cell)timer(); + case 7: + exit_status((int)a); + return 0; + case 8: + return rnd(); + case 9: + if (a == 0) return micro_mem_words(); + if (a == 1) return HEAP_LO; + if (a == 2) return HEAP_HI; + if (a == 3) return (Cell)micro_mem_words() * 8; + return -1; + case 10: + if (bop_cstr(mem, a, path, NLEN, micro_mem_words()) < 0 || !path[0]) return -1; + fd = ram_slot(path, b == 1); + if (fd < 0) return -1; + if (b == 1) { ramf[fd].len = 0; ramf[fd].pos = 0; } + else ramf[fd].pos = 0; + return fd; + case 11: + if ((UCell)a >= NFILES || !ramf[a].name[0] || c < 0 || (c > 0 && !bop_ok(b, 1, micro_mem_words()))) return -1; + n = 0; + while (n < c && ramf[a].pos < ramf[a].len && bop_ok(b + n, 1, micro_mem_words())) { + bop_put1(mem, b + n, ramf[a].data[ramf[a].pos++]); + n++; + } + return n; + case 12: + if ((UCell)a >= NFILES || !ramf[a].name[0] || c < 0 || (c > 0 && !bop_ok(b, 1, micro_mem_words()))) return -1; + n = 0; + while (n < c && ramf[a].len < FCAP && bop_ok(b + n, 1, micro_mem_words())) { + ramf[a].data[ramf[a].len++] = (unsigned char)bop_load(mem, b + n, 1); + n++; + } + ramf[a].pos = ramf[a].len; + return n; + case 13: { + char board[8], *e; + if (bop_cstr(mem, a, path, NLEN, micro_mem_words()) < 0) return -1; + board_name(board); + e = streq(path, "BOARD") ? board : 0; + if (!e) return -1; + if (c < 1 || !bop_ok(b, 1, micro_mem_words())) return -1; + i = 0; + while (e[i] && i < c - 1 && bop_ok(b + i, 1, micro_mem_words())) { bop_put1(mem, b + i, (unsigned char)e[i]); i++; } + if (bop_ok(b + i, 1, micro_mem_words())) bop_put1(mem, b + i, 0); + return i; + } + case 21: /* argc: a board has no command line, so alone */ + return 1; + case 22: { /* argv: entry 0 is , as in zy(1) */ + static const char lead[] = ""; + if (a != 0) return -1; + if (!b) return 6; + if (c < 7 || !inmem(b) || !inmem(b + 6)) return -1; + for (i = 0; i < 6; i++) mem[b + i] = (unsigned char)lead[i]; + mem[b + 6] = 0; + return 6; + } + case 23: /* envc: a board has no environment */ + return 0; + default: + return -1; + } +} + +int micro_getc(void) +{ + int ch; + if (!BARE_INPUT || saw_end) return -1; + if (have_peek) { have_peek = 0; ch = peekc; } + else ch = uart_read(); + if (ch == 4) { saw_end = 1; return -1; } + return ch; +} + +int micro_eof(void) +{ + if (!BARE_INPUT || saw_end) return 1; + if (!have_peek) { + peekc = uart_read(); /* wait: an empty FIFO is not the end */ + have_peek = 1; + } + if (peekc == 4) { saw_end = 1; have_peek = 0; return 1; } + return 0; +} + +void bare_main(void) +{ + uart_init(); + exit_status(micro_run() != 0); +} diff --git a/src/baremetal/run.sh b/src/baremetal/run.sh new file mode 100755 index 0000000..d6ac333 --- /dev/null +++ b/src/baremetal/run.sh @@ -0,0 +1,104 @@ +#!/bin/bash +# Build a freestanding microcore and boot it on qemu-system-*. +# src/baremetal/run.sh ready riscv|aarch64 +# src/baremetal/run.sh riscv|aarch64 run examples/hello.zc +# src/baremetal/run.sh riscv|aarch64 io examples/echo.zc +# src/baremetal/run.sh riscv|aarch64 compile examples/hello.zc +# run: the program is compiled into the image. nothing is read. +# io: the same image, but stdin is the program's input and 0x04 ends it. +# compile: the default 1,048,576-word genome. the source, a backtick, and +# 0x04 are written to the UART. the backtick ends the unit; the +# 0x04 is what eof() waits for after that. +# Prints the program's UART output and nothing else. Exits 0 on a clean +# power-off. A missing toolchain exits 0 from `ready` and 1 otherwise. +set -euo pipefail +cd "$(dirname "$0")/../.." + +ready() { + case "$1" in + riscv) command -v riscv64-linux-gnu-gcc >/dev/null && command -v qemu-system-riscv64 >/dev/null ;; + aarch64) command -v aarch64-linux-gnu-gcc >/dev/null && command -v qemu-system-aarch64 >/dev/null ;; + *) return 1 ;; + esac +} + +if [ "${1:-}" = ready ]; then + ready "${2:-}" + exit $? +fi +if [ $# -ne 3 ]; then + echo "usage: src/baremetal/run.sh riscv|aarch64 run|io|compile FILE" >&2 + exit 2 +fi +target=$1 mode=$2 src=$3 +ready "$target" || { echo "baremetal: missing toolchain for $target" >&2; exit 1; } +[ -f "$src" ] || { echo "baremetal: no $src" >&2; exit 1; } + +case "$target" in +riscv) + cc=riscv64-linux-gnu-gcc + qemu=qemu-system-riscv64 + cflags="-march=rv64gc -mabi=lp64d -mcmodel=medany -mno-relax" + asm=src/baremetal/start_riscv.S + ld=src/baremetal/link_riscv.ld + def=-DBARE_RISCV + qargs=(-machine virt -bios none -cpu rv64 -m 64) + ;; +aarch64) + cc=aarch64-linux-gnu-gcc + qemu=qemu-system-aarch64 + cflags="-march=armv8-a" + asm=src/baremetal/start_aarch64.S + ld=src/baremetal/link_aarch64.ld + def=-DBARE_AARCH64 + qargs=(-machine virt -cpu cortex-a57 -m 64 -semihosting-config enable=on,target=native) + ;; +*) echo "baremetal: unknown target $target" >&2; exit 2 ;; +esac + +D=$(mktemp -d) +trap 'rm -rf "$D"' EXIT +common="$cflags -ffreestanding -fno-pic -fno-pie -fno-builtin -fno-unwind-tables -fno-asynchronous-unwind-tables -O2 -Wall -Wextra" + +if [ "$mode" = run ] || [ "$mode" = io ]; then + # the map is sized to the program, so a bigger runtime or program just gets a bigger board + gcc -O2 -w src/tools/genmap.c -o "$D/genmap" + GENMAP="$D/genmap" bash src/tools/automap.sh run "$D/img" src/runtime/run.zc "$src" >"$D/genmap.log" 2>&1 || { cat "$D/genmap.log" >&2; exit 1; } + cp src/micro/micro.c src/micro/micro_port.h src/core/fops.h src/core/bops.h src/core/stack.h "$D/img/" + "$cc" $common $def -I"$D/img" -c "$D/img/micro.c" -o "$D/micro.o" + if [ "$mode" = io ]; then + "$cc" $common $def -DBARE_INPUT=1 -I"$D/img" -c src/baremetal/port.c -o "$D/port.o" + timeout=60 + else + "$cc" $common $def -DBARE_INPUT=0 -I"$D/img" -c src/baremetal/port.c -o "$D/port.o" + timeout=120 + fi +elif [ "$mode" = compile ]; then + cp src/micro/micro.c src/micro/micro_port.h src/core/memmap.h src/core/genome.h src/core/fops.h src/core/bops.h src/core/stack.h "$D/" + "$cc" $common $def -I"$D" -c "$D/micro.c" -o "$D/micro.o" + "$cc" $common $def -DBARE_INPUT=1 -I"$D" -c src/baremetal/port.c -o "$D/port.o" + timeout=90 +else + echo "baremetal: mode is run, io or compile" >&2 + exit 2 +fi +"$cc" $common $def -c "$asm" -o "$D/start.o" +"$cc" $common $def -nostdlib -static -Wl,--build-id=none -Wl,--no-warn-rwx-segments -T "$ld" -o "$D/bare.elf" "$D/start.o" "$D/port.o" "$D/micro.o" +if [ "${BARE_SIZE:-}" = 1 ]; then + size=$(wc -c < "$D/bare.elf") + text=$(size "$D/bare.elf" | awk 'NR==2{print $1+$2}') + bss=$(size "$D/bare.elf" | awk 'NR==2{print $3}') + echo "elf $size bytes, text+data $text, bss $bss" >&2 +fi + +# -serial stdio is the UART. The monitor stays off so it cannot eat bytes. +runq() { + timeout "$timeout" "$qemu" "${qargs[@]}" -nographic -monitor none -serial stdio -kernel "$D/bare.elf" +} +if [ "$mode" = compile ]; then + (cat "$src"; printf '`\004') | runq +elif [ "$mode" = io ]; then + (cat; printf '\004') | runq +else + runq tokens (nextch, lex1, next/peek). a token is a +// kind (tk), a value (tv: number or interned name) and a +// place (line, offset, length). sources nest: stdin, a +// token list for macros, a string for eval. +// 2 symbols every name is interned once in a string pool; symbols +// (functions, globals, constants, keywords, types) hang +// off the interned name and shadow one another. +// 3 types records in the type area, hash-consed, so comparing two +// types is comparing two words. typing is optional: an +// untyped program is all "word". +// 4 analyzer the ownership/lifetime pass. it runs while the parser +// emits code, tracking for every local whether it owns an +// object in this block (m), moves one up and out (u), or +// moves one down into a lower scope (d). borrowing is +// tracked separately. the pass inserts frees, and joins +// merge that knowledge at +// if/else, loops and switches. +// 5 expressions precedence climbing over the operator tables, which a +// program can extend at compile time. +// 6 statements blocks, control flow, switch, asm blocks, quote/grab. +// 7 functions signatures, prologues, closures, methods, generics, +// fattening (typed new) and the top level. +// 8 setup the keyword table, built-in names, entry point. +// 9 check mode the same compiler run over an in-memory document for the +// language server: errors and hints become records. +// +// the compiler emits vm words directly into memory at "here" (there is no +// intermediate tree). a forward reference emits a placeholder literal and +// remembers the site on a patch chain; defining the name patches the chain. +// the compiler is itself written in zc and lives in the genome next to rt.zc, +// so a program being compiled can call any function in this file, and +// immediate fns (parse words) run in the middle of compilation and can read +// tokens, emit code, or add operators. a few conventions that recur: +// - "plain word": most values are untyped 64-bit words. a pointer is just a +// word that happens to be a heap address. +// - a code word is lit(v) = 2v+1 (odd) or op(k) = 2k (even). see lit and op. +// - names ending in an s_ prefix are interned spellings the parser compares +// against by pointer, which is why intern exists. +// - serr reports and carries on; die reports and skips input to the next +// ; or }. nothing in here raises or unwinds. +// - a backtick outside a comment or a literal ends the source (srcend). zc0, +// the c bootstrap, reads the same way, so a backtick in a comment is fine. +// +// ---- compiler data region (@map-cc) ---- +// src/tools/genmap computes these addresses from the compiler table sizes for each +// build. later regions (the type area, local types, exit records) are computed +// from these names. + +// @map-cc + +const int IHN = 0x8000; +const word R_IH = 0x90100; +const word R_POOL = 0x98100; +const word R_POOLEND = 0xD8100; +const int NS = 0x4000; +const word R_SYM = 0xD8200; +const word sname_BASE = 0xD8200; +const word skind_BASE = 0xDC200; +const word sval_BASE = 0xE0200; +const word ssig_BASE = 0xE4200; +const word sflag_BASE = 0xE8200; +const word sfix_BASE = 0xEC200; +const word snext_BASE = 0xF0200; +const int NL = 0x200; +const word lname_BASE = 0xF4200; +const word lslot_BASE = 0xF4400; +const word lhome_BASE = 0xF4600; +const word lstate_BASE = 0xF4800; +const word lowner_BASE = 0xF4A00; +const word lused_BASE = 0xF4C00; +const word larr_BASE = 0xF4E00; +const word lown_BASE = 0xF5000; +const int NF = 0x8000; +const word fsite_BASE = 0xF5200; +const word fnext_BASE = 0xFD200; +const word R_SNAP_BASE = 0x105200; +const word R_QBUF_BASE = 0x109200; +const word R_SRC_BASE = 0x10D200; +const word R_SEQ_BASE = 0x10D600; +const word bname_BASE = 0x10DE00; +const word bprec_BASE = 0x10DE40; +const word bseq_BASE = 0x10DE80; +const word blen_BASE = 0x10DEC0; +const word uname_BASE = 0x10DF00; +const word useq_BASE = 0x10DF20; +const word ulen_BASE = 0x10DF40; +const word aname_BASE = 0x10DF60; +const word abin_BASE = 0x10DFA0; +const word kops_BASE = 0x10E000; +const word R_CTX_BASE = 0x10E200; +const word R_LOOP_BASE = 0x10EA00; +const word R_ASM = 0x10EE00; +const int ASM_LABELS = 0x40; +const int ASM_REFS = 0x100; +const int ASM_WORDS = 0x400; +const int EXIT_WORDS = 0xA00; +const int ENUM_MEMBERS = 0x80; +const int TAGGED_ENUMS = 0x10; +const int STRUCT_METHODS = 0x20; +const int GENERATED_WORDS = 0x2000; +const int RANGE_FACTS = 0x20; +const int JOIN_PATHS = 0x40; +const int O3_REGIONS = 0xA; +// @end-map + +// table bases start in the generated map; growth copies columns without changing indices. +word sname = sname_BASE; +word skind = skind_BASE; +word sval = sval_BASE; +word ssig = ssig_BASE; +word sflag = sflag_BASE; +word sfix = sfix_BASE; +word snext = snext_BASE; +word lname = lname_BASE; +word lslot = lslot_BASE; +word lhome = lhome_BASE; +word lstate = lstate_BASE; +word lowner = lowner_BASE; +word lused = lused_BASE; +word larr = larr_BASE; +word lown = lown_BASE; +word fsite = fsite_BASE; +word fnext = fnext_BASE; +int symcap = NS, loccap = NL, fixcap = NF; + +const word R_TY = ZFP - 16384, R_TYEND = ZFP; +// interned text and type records never move: only their index vectors grow. +word namehash = R_IH, poolend = R_POOLEND; +word poolblocks, typeblocks; +int hashcap = IHN, namecount, poolchunk = R_POOLEND - R_POOL; +word typelist = R_TY, tyend = R_TYEND; +int typecap = 1024; + +// growing scratch regions retain offsets used by nested parser frames. +word R_SNAP = R_SNAP_BASE; int R_SNAP_cap = R_QBUF_BASE - R_SNAP_BASE; +word R_QBUF = R_QBUF_BASE; int R_QBUF_cap = R_SRC_BASE - R_QBUF_BASE; +word R_SRC = R_SRC_BASE; int R_SRC_cap = R_SEQ_BASE - R_SRC_BASE; +word R_SEQ = R_SEQ_BASE; int R_SEQ_cap = bname_BASE - R_SEQ_BASE; +word R_CTX = R_CTX_BASE; int R_CTX_cap = R_LOOP_BASE - R_CTX_BASE; +word R_LOOP = R_LOOP_BASE; int R_LOOP_cap = R_ASM - R_LOOP_BASE; +[60]word lpfact_initial; word lpfact = lpfact_initial; int loopfacts_cap = 60; + +// operator columns grow independently of their initial map reservations. +word bname = bname_BASE; +word bprec = bprec_BASE; +word bseq = bseq_BASE; +word blen = blen_BASE; +word uname = uname_BASE; +word useq = useq_BASE; +word ulen = ulen_BASE; +word aname = aname_BASE; +word abin = abin_BASE; +word kops = kops_BASE; +int bincap = bprec_BASE - bname_BASE, uncap = useq_BASE - uname_BASE, asgcap = abin_BASE - aname_BASE, kopcap = R_CTX_BASE - kops_BASE; +// ---- token kinds, symbol kinds and flags ---- +const int T_EOF = 0, T_NUM = 1, T_ID = 2, T_STR = 3, T_OP = 4, T_FLT = 5, T_BSTR = 6; +const int K_FN = 1, K_GVAR = 2, K_GARR = 3, K_CONST = 4, K_KW = 5, K_ENH = 6, K_TYPE = 7, K_DOC = 8; +const int F_DEF = 1, F_SIG = 2, F_UNTYPED = 4, F_STMT = 8, F_EXPR = 16, F_TOP = 32, F_FALLBACK = 64, F_GEN = 128, F_PRE = 256, F_O3 = 512, F_EXT = 1024, F_TPL = 2048, F_STATIC = 4096, F_DECL = 8192, F_RETOWN = 16384, F_EARLY = 32768; +// variable states for the lifetime analyzer +const int S_PLAIN = 0, S_M = 1, S_U = 2, S_D = 3, S_DEAD = 4, S_CHILD = 5, S_BORROW = 6; +// expression classes: plain word, a new object, or a bare variable (C_VAR + index) +const int C_PLAIN = 0, C_FRESH = 1, C_VAR = 2; +// lvalue kinds +const int LV_NONE = 0, LV_LOCAL = 1, LV_GLOBAL = 2, LV_ELEM = 3, LV_OTHER = 4; +// opcodes +const int O_Q = 0, O_LD = 1, O_ST = 2, O_PICK = 3, O_DROP = 4, O_SWAP = 5, O_CALL = 6, O_JMP = 7; +const int O_JZ = 8, O_RET = 9, O_ADD = 13, O_SUB = 14, O_LT = 20; +const int XOP0 = 22; // first enhancement opcode +const int OP_FLIT = 600, OP_FADD = 601, OP_FSUB = 602, OP_FMUL = 603, OP_FDIV = 604; +const int OP_FEQ = 605, OP_FLT = 606, OP_FLE = 607, OP_I2F = 608, OP_F2I = 609; +const int SEQWORD = -4; // in an operator sequence: the next word is a full-width literal +const int SEQREF = -2; // in an operator sequence: the next word names a symbol + +// ---- state ---- +int chk_heap; +int nenh; word pooltop; int nsym, ubase, vislo, nfixu, fixfree; +int nbin, nun, nasg, nkop, seqtop; +char* mnem = "q@!$_~cjzr,?.+-*&|^><%"; +int check_on = 1; // set to 0 to switch the analyzer off for what follows +int tk; word tv; int tglue, tline, line = 1, ch, chkind; word chptr, chbase; int qdone, isp = -1, pendot; +// where the current token sits in its source (chars from the start, -1 for a token list), how long it is, and where the one before it ended +int toff = -1, toklen, tpend = -1, tpline; +int ntok; // tokens taken so far, so a parse word that reads nothing can be caught +int qst, qesc, qp; // srcend's reading state: normal, line comment, block comment, string, char literal +[1100]word tbuf_initial; word tbuf = tbuf_initial; int tbufcap = 1100; +// doc comments: the comment lines directly above a declaration (no blank line +// between them or before the declaration) are its documentation. the lexer +// collects them in dbuf, dlast is the line of the last one, and dline the +// line of the token that follows them. only when docs are on. +int docs_on; // docs on; keeps them: a symbol "doc name" holds a byte string +[2100]word dbuf_initial; word dbuf = dbuf_initial; int docbufcap = 2100; int dn, dlast, dline, docpending; +[2100]word dsnap_initial; word dsnap = dsnap_initial; int docsnapcap = 2100; int dsn, dnm; [300]word dnmb_initial; word dnmb = dnmb_initial; int docnamecap = 300; +int pk_tk, pk_tv, pq_n; [4]word pq_tk; [4]word pq_tv; [4]word pq_gl; [4]word pq_ln; // up to 4 tokens of lookahead +int here, hdelta, hlimit, ptop; +int code_chunk = CODE_END; +word image_buffer, image_words; int image_active, image_org, image_capacity, image_size; +int nloc, lbase, fdepth, fslots, fchk, fret, live, bxdepth, epichain, fframe, infn; +int finsym, finfer; // the function being compiled, and whether its owned return is still to be inferred (no .u) +int stubgen; // 1 while an extern's generated stub is compiled: the stub gets no hints +int xbor = -1; // local a pointer value is borrowed from, or -1 +int mdbg, mdbg_flags; // memdebug: compile checks in, and the flags start() turns on +int lsp, loopbase, ctxsp, snaptop; +int lv, lvk, lvi, kw_expr, xcls, fty; +// interned spellings the parser compares against +int s_lp, s_rp, s_lb, s_rb, s_lk, s_rk, s_comma, s_semi, s_eq, s_arrow, s_inc, s_dec; +int s_star, s_slash, s_amp, s_colon, s_hash, s_minus, s_andand, s_oror; +int s_dot, s_fn, s_var, s_const, s_else, s_as, s_unchecked, s_immediate, s_m, s_d, s_u; +int s_q, s_case, s_default, s_fovf, s_start, s_main, s_free, s_recycle, s_own, s_qnew, s_enhance, s_micro, s_vm; +int s_frame_floor, s_frame_top, s_frame_node, s_frame_busy, s_frame_guard, s_frame_grow, s_frame_leave; +int s_do, s_while, s_enum, s_include, s_memdebug, s_scrub, s_alloc, s_check, s_memset, s_static; + +// ---- types: kinds, tables and parser state (see the types section) ---- +const int TY_WORD = 0, TY_INT = 1, TY_CHAR = 2, TY_BOOL = 3, TY_VOID = 4, TY_PTR = 5, TY_ARR = 6; +// dyn: []T, a = element, n = 1 if fixed +const int TY_FN = 7, TY_STRUCT = 8, TY_VAR = 9, TY_GEN = 10, TY_DYN = 11, TY_FLOAT = 12; +const int NTL = 1024; // the first NTL words list every record +// type per local, declared tag per local, type per symbol +const word LTYPE_BASE = R_ASM + ASM_WORDS, LTAG_BASE = LTYPE_BASE + NL, STYPE_BASE = LTAG_BASE + NL; +word ltype = LTYPE_BASE, ltag = LTAG_BASE, stype = STYPE_BASE; +int tytop, ntl; word tword, tint, tchar, tbool, tvoid, tfloat, tf32; +int ckst, ckn; // extern: the zc struct a by-value parameter names (ckind), and its name +int tc_on; // the optional typechecker, off unless a program says typecheck on; +// type, literal 0, float, byte string, dry runs (typeof), unique giveaway +word xty; int xzero, xfloat, xstr, dry, xgive; +// the type facts of annotate mode (see type facts below): the tables, and where the declaration being read starts +const int NIF = 431, IFP = 24, IFW = 80, IFN = 4096, IFT = 32768; +int ifon; word ifs, ifr; int nif; word ifx; int nifx; word ift; int nift; word ifcur; int ifkp, ifkk, ifcall, ifgk, ifstrict; +int ifrcap = NIF, ifxcap = IFN, iftcap = IFT; +int fldst, fldi; // the one struct a bare address's field name resolved to +[8]word tpn; int ntp; // type parameters in scope +// reading a return type: unknown names are type parameters declared after the function's name +int tvauto; +int dty, dtag; // result of dtype() +int s_lt, s_gt, s_shr, s_le, s_ge, s_eqeq, s_ne, s_plus, s_struct, s_type, s_typecheck, s_docs, s_on, s_off, s_new, s_new_t; +int s_o3, s_lfa, s_outside, s_new_raw, s_new_oz, s_oob; +int s_ld8, s_st8, s_ld16, s_st16, s_ld32, s_st32; +// ---- o3 region state ---- + +// each promoted slot maps to a register; pending regions use 67-word records and a descriptor buffer. +int o3on, o3nxt, o3one; [32]word o3sl; [32]word o3rg; int no3sl; [O3_REGIONS * 67]word o3pend_initial; word o3pend = o3pend_initial; int o3pendcap = O3_REGIONS, no3pend; [80]word o3dsc; int o3fs, o3na, o3fn0; +// o3free holds registers released by closed scopes; o3cache holds the items pointer and length slots for fixed arrays. +[8]word o3free; int no3free, o3nreg; [NL]word o3cache_initial; word o3cache = o3cache_initial; int argloc, s_hitems, s_hlen, s_fatten; +// operator names used by numeric type checks. +[12]word numops; int nnumops, s_fixed, s_dlen, s_dcap, s_dnew, s_dat, s_dpush, s_dpop, s_dresize, xconst, xcval; +int xlenloc, arrloc, fortest, forstep, ft_iv, ft_bd, ft_ir, ft_nops, fs_ok, xstamp; +// local lower bound / len(array); one proof record per live loop +int nfact, factcap = RANGE_FACTS; [RANGE_FACTS]word floc_initial, flo_initial, flen_initial; word floc = floc_initial, flo = flo_initial, flen = flen_initial; +int s_len_s, s_at_s, s_slice_s, s_cat_s, s_eq_s, s_lt_s, s_le_s, s_put_bs, s_put_s, s_n_to_s, s_new_s; +int mdg; [8]word mdn; // the type parameters of the generic struct whose methods are being compiled +[8]word gbind; int ngbind; // explicit type arguments for the next call: f(...) +// generic functions. the template (type parameters stay variables) is compiled once, as before, +// and its tokens are kept; a call whose type arguments are all known gets an instance, the same +// tokens compiled again with the parameters bound to those types, so new(T) and sizeof(T) +// inside it mean the real type. instances are compiled after the item that asked for them. +int grec; word gbuf; int gn, gcap; // the tokens of the top-level item being read +int gnew, gnew_np; [8]word gnew_nm; // a generic function was just defined +word gtab; int gt_n, gtcap = 64, gicap = 128; word gt_sym, gt_tok, gt_np; int gt_nm; // the columns are allocated at the first generic function +int gi_n; word gi_t, gi_sym, gi_ar, gi_done; +int ginst; [8]word gnm; [8]word gib; int gng, ginsn; // compiling an instance: the names and what they stand for +int s_this; +// closures being compiled, innermost last: the enclosing function's locals +// (lo .. hi), how many variables the body has captured so far (names and the +// enclosing local each came from), and the body's own hidden env parameter +const int NCLO = 8, NCAP = 32; +int nclo, closure_cap = NCLO, capture_width = NCAP; +[NCLO]word clo_lo_initial; word clo_lo = clo_lo_initial; +[NCLO]word clo_hi_initial; word clo_hi = clo_hi_initial; +[NCLO]word clo_n_initial; word clo_n = clo_n_initial; +[NCLO]word clo_env_initial; word clo_env = clo_env_initial; +[NCLO]word clo_ret_initial; word clo_ret = clo_ret_initial; +[256]word clo_name_initial; word clo_name = clo_name_initial; +[256]word clo_loc_initial; word clo_loc = clo_loc_initial; +[256]word clo_via_initial; word clo_via = clo_via_initial; + + +// ---- errors ---- +// the compiler reports up to 20 errors before it stops. a syntax error +// (die) skips the token it happened on and sets panic, which skips ahead to +// the next ; or } (or the next top-level item) and keeps quiet until then. +// other errors (serr) just report: the parse is still in step. +// +// check mode (cmode) is for the language server, which runs the real compiler +// over a document it holds in memory. nothing is printed and nothing halts: +// each error is written into dgbuf as a record [severity, line, offset, +// length, chars...] and giveup raises chkabort, which makes the lexer return +// end of file so every parsing loop winds down by itself. +int nerr, panic; +// bits kept in a local's ltag for the hints: assigned after its declaration, +// read, declared with let, initialized with a literal; the size of the object +// a new gave it (bits 16 to 39); and how many times it was used (from bit 56) +const int LASG = 0x1000, LREAD = 0x2000, LDECL = 0x4000, LCONST = 0x8000, LCNT1 = 0x100000000000000; +const int NEWTYPED = 0x800000; +[NL]word lpos_initial; word lpos = lpos_initial; [NL]word lnsz_initial; word lnsz = lnsz_initial; [NL]word lleaf_initial; word lleaf = lleaf_initial; [NL]word lrsoff_initial; word lrsoff = lrsoff_initial; [NL]word lrskind_initial; word lrskind = lrskind_initial; int newsz, newleaf, nomagic, callpos; +[NL]word lptr_initial; word lptr = lptr_initial; // annotate mode: the local was indexed or dereferenced, so it holds an address +// storage facts are shared by aliases. they describe one allocation, not a +// variable slot: [length, lifetime, kind, allocation place, end place, owner]. +// lifetime is 0 unknown, 1 live, 2 ended; kind is 1 stack, 2 heap, 3 array handle. +[NL]word lafact_initial; word lafact = lafact_initial; +[NL]word laaddr_initial; word laaddr = laaddr_initial; word xaf, argfact; +// local name lookup keeps a head for each spelling and a shadow link per slot. +[NL]word lprev_initial; word lprev = lprev_initial; +[256]word lkeys_initial; word lkeys = lkeys_initial; +[256]word lheads_initial; word lheads = lheads_initial; int lkeycap = 256, lkeyn; +int s_new_k, s_recycle_leaf; +// dgprev: the next record sits at the end of the previous token +int cmode, chkabort, chkfuel; word dgbuf, dggrow; int dgcap, dgpos, dgn, dgopen, dgprev, dgmode; +// expand a diagnostic in progress, keeping its output offset within the buffer. +int dg_expand() { + dgbuf = chk_resize(dgbuf, dgpos + 5 + outn, dgcap * 2); + dgcap = dgcap * 2; outbuf = dgbuf + dgpos + 5; outcap = dgcap - dgpos - 5; + return 0; +} +// diagnostic records for check mode. dg_open starts a record [severity, line, +// offset, length, text length, text...] at the current token (or just past the +// previous one when dgprev is set) and redirects the error text into it with +// outmode 2; dg_close seals it with the length of the text and restores output. +// severity 1 is an error, 2 a warning, and 4 a hint. +int dg_close() { + if (!dgopen) return 0; + dgbuf[dgpos + 4] = outn; dgpos = dgpos + 5 + outn; dgn++; + dgopen = 0; outmode = dgmode; outgrow = dggrow; + return 0; +} +// open a check-mode diagnostic record of the given severity. +int dg_open(int sev) { + dg_close(); + if (dgpos + 205 > dgcap) { + int cap = dgcap; while (cap < dgpos + 205) cap = cap * 2; + dgbuf = chk_resize(dgbuf, dgpos, cap); dgcap = cap; + } + if (dgprev && tpend >= 0) { + dgbuf[dgpos + 1] = tpline; + dgbuf[dgpos + 2] = tpend - 1; + dgbuf[dgpos + 3] = 1; + } + else { dgbuf[dgpos + 1] = tline; dgbuf[dgpos + 2] = toff; dgbuf[dgpos + 3] = toklen; } + dgbuf[dgpos] = sev; + outbuf = dgbuf + dgpos + 5; outn = 0; outcap = dgcap - dgpos - 5; + dggrow = outgrow; outgrow = dg_expand; + outmode = 2; dgopen = 1; + return 0; +} +[256]word dgseen_initial; word dgseen = dgseen_initial; int dgseen_cap = 256, dgseen_n; +// start and stop a check run. chk_begin points the diagnostics at a buffer +// the caller owns; chk_end flushes any open record and restores output. +int chk_begin(int buf, int cap) { + cmode = 1; chkabort = 0; chkfuel = 0; dgbuf = buf; dgcap = cap; dgpos = 0; dgn = 0; dgopen = 0; + nerr = 0; panic = 0; dgmode = outmode; fill_w(dgseen, 0, dgseen_cap); dgseen_n = 0; + return 0; +} +// end check mode and put the output back the way it was. +int chk_end() { + dg_close(); + cmode = 0; + outmode = dgmode; + return 0; +} +// a hint is a finding that isn't an error: the program still compiles, and +// only check mode reports it. hint_begin(place) opens the record at a packed +// place (see tpack) and says whether to write the text; dg_close ends it. +// one hint per source position. a growing set keeps large documents linear +// instead of rescanning every previous diagnostic for each local. +int dg_hash(int key, int cap) { return ((key ^ (key >> 21)) * 0x9E37) & (cap - 1); } +int dg_dup() { + int key = ((toff + 1) << 24) | tline, i, k, cap; word old; + if (dgseen_n + dgseen_n >= dgseen_cap) { + old = dgseen; cap = dgseen_cap * 2; dgseen = chk_resize(0, 0, cap); + i = 0; + while (i < dgseen_cap) { + if (old[i]) { k = dg_hash(old[i], cap); while (dgseen[k]) k = (k + 1) & (cap - 1); dgseen[k] = old[i]; } + i++; + } + dgseen_cap = cap; + } + i = dg_hash(key, dgseen_cap); + while (dgseen[i]) { if (dgseen[i] == key) return 1; i = (i + 1) & (dgseen_cap - 1); } + dgseen[i] = key; dgseen_n++; return 0; +} +// start a check-mode hint at token position p, or say no when hints are off. +int hint_begin(int p) { + int sv, ok; + if (!cmode || dry || panic || chkabort || stubgen) return 0; + sv = tpack(); tunpack(p); + ok = !dg_dup(); + if (ok) { dg_open(4); ok = dgopen; } + tunpack(sv); + return ok; +} +// error plumbing. errat prints the "zc: line N:" prefix (or opens a record in +// check mode) and counts the error; errend ends the line and gives up after +// 20; giveup prints the total and halts (check mode: sets chkabort, which +// makes the lexer return end of file so the parse unwinds). fatal reports and +// stops at once; serr just reports; die reports and also skips input to the +// next ; or } (panic) so one mistake does not become a screen of errors. +int errat() { + if (cmode) { + dg_open(1); + } else { + put_s("zc: line "); + put_n(tline); + put_s(": "); + } + nerr++; + return 0; +} +// finish an error line; the compiler stops after 20 errors. +int errend() { + if (cmode) { dg_close(); if (nerr >= 20) chkabort = 1; return 0; } + put_c(10); + if (nerr >= 20) { put_s("zc: too many errors, stopping\n"); halt(); } + return 0; +} +// stop compiling after errors and report how many there were. +int giveup() { + if (cmode) { dg_close(); chkabort = 1; return 0; } + put_s("zc: "); put_n(nerr); if (nerr == 1) put_s(" error\n"); else put_s(" errors\n"); halt(); + return 0; +} +// report a fatal error and stop, or record it in check mode. +int fatal(int msg) { + errat(); put_s(msg); + if (cmode) { dg_close(); chkabort = 1; return 0; } + put_c(10); halt(); + return 0; +} +// report a syntax error at the current token, once per recovery. +int serr(int msg) { + if (!panic && !dry) { + errat(); + put_s(msg); + errend(); + } + return 0; +} +// report an error that names something, then the message. +int serrn(int name, int msg) { + if (!panic && !dry) { + errat(); + put_s(name); + put_s(": "); + put_s(msg); + errend(); + } + return 0; +} +// report an error and skip to the next top-level item. +int die(int msg) { + serr(msg); + panic = 1; + if (tk == T_EOF) giveup(); + next(); + return 0; +} +// what the parser is looking at, for the "found" part of a message +int tokshow() { + if (tk == T_EOF) { put_s("the end of the file"); return 0; } + if (tk == T_NUM) { put_s("the number "); put_n(tv); return 0; } + if (tk == T_STR) { put_s("a string"); return 0; } + if (tk == T_BSTR) { put_s("a byte string"); return 0; } + if (tk == T_FLT) { put_s("a float"); return 0; } + put_s("'"); put_s(tv); put_s("'"); + return 0; +} +// like die, and says what was found instead +int diefound(int msg) { + if (!panic && !dry) { + errat(); + put_s(msg); put_s(", found "); tokshow(); + errend(); + } + panic = 1; + if (tk == T_EOF) giveup(); + next(); + return 0; +} +// die with a name shown before the message. +int dien(int name, int msg) { + serrn(name, msg); + panic = 1; + if (tk == T_EOF) giveup(); + next(); + return 0; +} +// four classification bits live next to each interned spelling. this works +// for names in later pool chunks too, without indexing by a fixed pool offset. +const int LSW = 1; +word lsets; +int lsmark(int set, int n) { + if (lsets) n[-2] = n[-2] | (1 << set); + return 0; +} +word lsget(int set, int n) { + if (!lsets) return 0; + return (n[-2] >> set) & 1; +} +// name resolution for the language server. while a check runs over the document +// at rsbase, every name a use or a declaration resolves to is written into rsrec +// as a record: the byte offset, kind (RS_LOCAL, RS_PARAM, RS_SYM or RS_FIELD), +// declaration or symbol, and storage facts at that position. a local names its declaration by offset +// (-1 when it has none), a symbol names its kind and flags (see rs_sym). the +// compiler's own scopes decide, so the highlighter and hover see locals and +// parameters first, then globals and built-ins, the way the compiler does. +const int RS_LOCAL = 1, RS_PARAM = 2, RS_SYM = 3, RS_FIELD = 4, RS_CAP = 32768, RS_W = 9; +int lt_on, lt_n, ltcap = 256, ltxtcap = 2048; +word lt_off, lt_at, lt_len, lt_type, ltxt; int ltxn; +int ht_n, htcap = 256; word ht_start, ht_end, ht_type; +int fieldn, fieldcap = 128; word fieldtypes, fieldnames, fieldoffs; +int field_note(word t, word n, int off) { + if (!lt_on || isp != 0 || dry) return 0; + if (!fieldtypes || fieldn == fieldcap) { + if (fieldtypes) fieldcap = fieldcap * 2; + fieldtypes = chk_resize(fieldtypes, fieldn, fieldcap); + fieldnames = chk_resize(fieldnames, fieldn, fieldcap); + fieldoffs = chk_resize(fieldoffs, fieldn, fieldcap); + } + fieldtypes[fieldn] = t; fieldnames[fieldn] = n; fieldoffs[fieldn] = off; fieldn++; + return 0; +} +int field_decl(word t, word n) { + int k = 0; + while (k < fieldn) { if (fieldtypes[k] == t && fieldnames[k] == n) return fieldoffs[k]; k++; } + return 0 - 1; +} +word rsrec, rstmp; [32]word pnoffs; int rsn, rscap, rsbase, nameoff; +// resize check-mode tables; their global pointers keep them visible to gc. +unchecked word chk_resize(word old, int count, int capacity) { + word p = new(capacity); + p[-4] = p[-4] | F_INTERNAL; + fill_w(p, 0, capacity); + if (old && count) copy_w(p, old, count); + return p; +} +// lexer and documentation buffers grow before storing the next character. +int token_char(int n, int c) { + if (n + 2 > tbufcap) { tbuf = chk_resize(tbuf, n, tbufcap * 2); tbufcap = tbufcap * 2; } + tbuf[n] = c; return n + 1; +} +int doc_char(int c) { + if (dn + 2 > docbufcap) { dbuf = chk_resize(dbuf, dn, docbufcap * 2); docbufcap = docbufcap * 2; } + dbuf[dn] = c; dn++; return 0; +} +int doc_name_room(int need) { + if (need <= docnamecap) return 0; + while (docnamecap < need) docnamecap = docnamecap * 2; + dnmb = chk_resize(dnmb, 0, docnamecap); return 0; +} +// reserve compiler columns at execution time. indices remain valid after a copy. +int reserve_symbols(int need) { + int cap = symcap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + sname = chk_resize(sname, nsym, cap); + skind = chk_resize(skind, nsym, cap); + sval = chk_resize(sval, nsym, cap); + ssig = chk_resize(ssig, nsym, cap); + sflag = chk_resize(sflag, nsym, cap); + sfix = chk_resize(sfix, nsym, cap); + snext = chk_resize(snext, nsym, cap); + stype = chk_resize(stype, nsym, cap); + if (ifs) ifs = chk_resize(ifs, symcap, cap); + symcap = cap; return cap; +} +int reserve_locals(int need) { + int cap = loccap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + lname = chk_resize(lname, nloc, cap); + lslot = chk_resize(lslot, nloc, cap); + lhome = chk_resize(lhome, nloc, cap); + lstate = chk_resize(lstate, nloc, cap); + lowner = chk_resize(lowner, nloc, cap); + lused = chk_resize(lused, nloc, cap); + larr = chk_resize(larr, nloc, cap); + lown = chk_resize(lown, nloc, cap); + ltype = chk_resize(ltype, nloc, cap); + ltag = chk_resize(ltag, nloc, cap); + lpos = chk_resize(lpos, nloc, cap); + lnsz = chk_resize(lnsz, nloc, cap); + lleaf = chk_resize(lleaf, nloc, cap); + lrsoff = chk_resize(lrsoff, nloc, cap); + lrskind = chk_resize(lrskind, nloc, cap); + lptr = chk_resize(lptr, nloc, cap); + lafact = chk_resize(lafact, nloc, cap); laaddr = chk_resize(laaddr, nloc, cap); lprev = chk_resize(lprev, nloc, cap); + o3cache = chk_resize(o3cache, nloc, cap); + loccap = cap; return cap; +} +int reserve_fixes(int need) { + int cap = fixcap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + fsite = chk_resize(fsite, fixcap, cap); + fnext = chk_resize(fnext, fixcap, cap); + fixcap = cap; return cap; +} +const word R_EXIT_BASE = STYPE_BASE + NS, R_EXITEND = R_EXIT_BASE + EXIT_WORDS; +word R_EXIT = R_EXIT_BASE; int R_EXIT_cap = EXIT_WORDS; +int reserve_R_SNAP(int need) { + int cap = R_SNAP_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + R_SNAP = chk_resize(R_SNAP, R_SNAP_cap, cap); R_SNAP_cap = cap; + return cap; +} +int reserve_R_QBUF(int need) { + int cap = R_QBUF_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + R_QBUF = chk_resize(R_QBUF, R_QBUF_cap, cap); R_QBUF_cap = cap; + return cap; +} +int reserve_R_SRC(int need) { + int cap = R_SRC_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + R_SRC = chk_resize(R_SRC, R_SRC_cap, cap); R_SRC_cap = cap; + return cap; +} +int reserve_R_SEQ(int need) { + int cap = R_SEQ_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + R_SEQ = chk_resize(R_SEQ, R_SEQ_cap, cap); R_SEQ_cap = cap; + return cap; +} +int reserve_R_CTX(int need) { + int cap = R_CTX_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + R_CTX = chk_resize(R_CTX, R_CTX_cap, cap); R_CTX_cap = cap; + return cap; +} +int reserve_R_LOOP(int need) { + int cap = R_LOOP_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + R_LOOP = chk_resize(R_LOOP, R_LOOP_cap, cap); R_LOOP_cap = cap; + if (cap / 8 > loopfacts_cap) { lpfact = chk_resize(lpfact, loopfacts_cap, cap / 8); loopfacts_cap = cap / 8; } + return cap; +} +int reserve_R_EXIT(int need) { + int cap = R_EXIT_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + R_EXIT = chk_resize(R_EXIT, R_EXIT_cap, cap); R_EXIT_cap = cap; + return cap; +} +int reserve_binary(int need) { + int cap = bincap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + bname = chk_resize(bname, nbin, cap); + bprec = chk_resize(bprec, nbin, cap); + bseq = chk_resize(bseq, nbin, cap); + blen = chk_resize(blen, nbin, cap); + bincap = cap; return cap; +} +int reserve_unary(int need) { + int cap = uncap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + uname = chk_resize(uname, nun, cap); + useq = chk_resize(useq, nun, cap); + ulen = chk_resize(ulen, nun, cap); + uncap = cap; return cap; +} +int reserve_assignment(int need) { + int cap = asgcap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + aname = chk_resize(aname, nasg, cap); + abin = chk_resize(abin, nasg, cap); + asgcap = cap; return cap; +} +int reserve_operators(int need) { + int cap = kopcap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + kops = chk_resize(kops, nkop, cap); + kopcap = cap; return cap; +} +// write a record for the name at byte offset off. ref is what a local names (its +// declaration's offset, or -1); sym is the symbol a RS_SYM record names, or -1. +int rs_put(int off, int kind, int ref, int sym) { + int at; + if (!rsrec || !cmode || dry || chkind != 3 || chbase != rsbase || off < 0) return 0; + if (rsn >= rscap) { + rsrec = chk_resize(rsrec, rsn * RS_W, rscap * 2 * RS_W); + rstmp = chk_resize(0, 0, rscap * 2 * RS_W); + rscap = rscap * 2; + } + at = rsn * RS_W; + rsrec[at] = off; rsrec[at + 1] = kind; rsrec[at + 2] = ref; rsrec[at + 3] = sym; + fill_w(rsrec + at + 4, 0, RS_W - 4); + rsn++; + return 0; +} +// write a record for the name token that is current. +int rs_note(int kind, int ref) { return rs_put(toff, kind, ref, 0 - 1); } +// the flags of every symbol record, read again once the check has defined the +// whole document (a function used before its definition is defined by now). +int rs_fix() { + int i = 0; + while (i < rsn) { + if (rsrec[i * RS_W + 1] == RS_SYM && rsrec[i * RS_W + 3] >= 0) rsrec[i * RS_W + 2] = rs_sym(rsrec[i * RS_W + 3]); + i++; + } + return 0; +} +// what a symbol is, as a record keeps it: its kind, plus 16 for a symbol the +// document declares (not a built-in) and 32 when that symbol has a definition +int rs_sym(int s) { + int v = skind[s]; + if (s >= ubase) v = v | 16; + if (sflag[s] & F_DEF) v = v | 32; + return v; +} +// copies record a of from to record b of to (the merge sort moves records this way). +int rs_move(word from, int a, word to, int b) { + copy_w(to + b * RS_W, from + a * RS_W, RS_W); + return 0; +} +// sort the records by offset: a bottom-up merge sort through rstmp, so a long +// document costs n log n, whatever order its names come in. +int rs_sort() { + int w = 1, lo, mid, hi, i, j, k, n = rsn; + if (n < 2) return 0; + while (w < n) { + lo = 0; + while (lo < n) { + mid = lo + w; if (mid > n) mid = n; + hi = lo + w * 2; if (hi > n) hi = n; + i = lo; j = mid; k = lo; + while (i < mid && j < hi) { + if (rsrec[j * RS_W] < rsrec[i * RS_W]) { rs_move(rsrec, j, rstmp, k); j++; } + else { rs_move(rsrec, i, rstmp, k); i++; } + k++; + } + while (i < mid) { rs_move(rsrec, i, rstmp, k); i++; k++; } + while (j < hi) { rs_move(rsrec, j, rstmp, k); j++; k++; } + lo = hi; + } + i = 0; + while (i < n * RS_W) { rsrec[i] = rstmp[i]; i++; } + w = w * 2; + } + return 0; +} +// analyzer errors only count in checked, reachable code +int cerr(int msg) { + if (fchk && live) serr(msg); + return 0; +} +// report an analyzer error about local i, named in the message. +int cerrn(int i, int msg) { + if (fchk && live) serrn(lname[i], msg); + return 0; +} + +// ---- interning ---- +// the pool: an open addressing hash table (R_IH) of pointers into a string +// pool (R_POOL). each spelling has two spare words: its symbol-chain head at +// p[-1] and editor classification bits at p[-2]. equal text returns the same +// stable handle, which lookup can use directly. +int hashs(word s) { + int h = 0; + while (*s) { h = h * 31 + *s; s++; } + return h & (hashcap - 1); +} +// rehash the index without moving strings or their symbol-chain heads. +int reserve_names(int need) { + int cap = hashcap, previous = hashcap, i = 0, h; word p, old; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + old = namehash; + namehash = chk_resize(0, 0, cap); + hashcap = cap; + while (i < previous) { + p = old[i]; + if (p) { h = hashs(p); while (namehash[h]) h = (h + 1) & (hashcap - 1); namehash[h] = p; } + i++; + } + return cap; +} +// return the interned copy of a spelling. new chunks preserve every old handle. +word intern(word s) { + int h; word p; int n; + if ((namecount + 1) * 2 >= hashcap) reserve_names(hashcap * 2); + h = hashs(s); + while (1) { + p = namehash[h]; + if (!p) break; + if (p[0] == s[0] && eq_w(p, s)) return p; + h = (h + 1) & (hashcap - 1); + } + n = len_w(s); + if (pooltop + n + 3 > poolend) { + if (poolchunk < n + 3) poolchunk = n + 3; + else if (poolchunk < 0x20000000) poolchunk = poolchunk * 2; + p = chk_resize(0, 0, poolchunk + 1); p[0] = poolblocks; poolblocks = p; + pooltop = p + 1; poolend = pooltop + poolchunk; + } + pooltop[0] = 0; pooltop[1] = 0; + p = pooltop + 2; + copy_w(p, s, n + 1); + pooltop = pooltop + n + 3; + namehash[h] = p; namecount++; + return p; +} + +// ---- symbols ---- +// each interned name keeps the index (+1) of its newest symbol in p[-1], and +// each symbol links to the one it shadows, so lookup is one step. +int addsym(word name, int kind, int val) { + int i = nsym; + if (nsym >= symcap) reserve_symbols(nsym + 1); + nsym++; + sname[i] = name; + skind[i] = kind; + sval[i] = val; + ssig[i] = 0; + sflag[i] = F_DEF; + sfix[i] = 0; + stype[i] = 0; + snext[i] = name[-1]; + name[-1] = i + 1; + return i; +} +// while an image builds, names below vislo are hidden, except keywords +int lookup(word name) { + int i = name[-1] - 1; + while (i >= 0) { + if (i >= vislo || skind[i] == K_KW || skind[i] == K_TYPE) return i; + i = snext[i] - 1; + } + return -1; +} +// drop the symbols above index to, which ends a scope. +int popsyms(int to) { + while (nsym > to) { nsym--; sname[nsym][-1] = snext[nsym]; } + return 0; +} +// look a name up from a plain string. +word lookups(int s) { return lookup(intern(s)); } + +// patch nodes +int fixnew(int site, int link) { + int i = fixfree; + if (i) fixfree = fnext[i]; + else { nfixu++; i = nfixu; if (i >= fixcap) reserve_fixes(i + 1); } + fsite[i] = site; fnext[i] = link; + return i; +} +// patch every lit in a chain to point at v, and recycle the nodes +int fixall(int head, int v) { + int n; + while (head) { + setlit(fsite[head], v); + n = fnext[head]; + fnext[head] = fixfree; + fixfree = head; + head = n; + } + return 0; +} + +// ---- code emission ---- +// code goes straight into memory at "here". hdelta shifts where it is written +// (an image build emits at one address and stores at another, see nested +// compiles), and dry turns emission off entirely, which typeof and similar +// queries use to type an expression without producing code. +// reserve contiguous words before recording an address or writing a data block. +// new runtime segments are linked by jumps; earlier code and globals stay put. +int reserve_code(int need) { + word p; int cap, top; + if (dry) return 0; + if (need < 0 || need > 0x7fffffff - 8) fatal("bad code reservation"); + if (image_active) { + if (need <= hlimit - here) return hlimit - here; + cap = image_capacity; + while (cap < here - image_org + need) { + if (cap > (0x7fffffff - image_org) / 2) fatal("image too big"); + cap = cap * 2; + } + image_buffer = chk_resize(image_buffer, here - image_org, cap); + image_capacity = cap; hdelta = image_buffer - image_org; hlimit = image_org + cap; + return hlimit - here; + } + if (need <= hlimit - here - 2) return hlimit - here - 2; + if (here + 1 >= hlimit) fatal("no room for a code link"); + cap = code_chunk; + if (cap < need + 5) cap = need + 5; + p = chk_resize(0, 0, cap); top = p + p[-5] - HDR; + if (syscall(9, 9, top, 0) < top) fatal("code address reservation failed"); + p[0] = code_blocks; p[1] = p + 3; p[2] = top; code_blocks = p; + *here = (p + 3) * 2 + 1; here[1] = O_JMP * 2; + here = p + 3; hlimit = top; + if (cap < 0x20000000) code_chunk = cap * 2; + return hlimit - here - 2; +} +// a region handed to an optimizer must fit in one contiguous segment. +int code_contiguous(int lo, int hi) { + word p = code_blocks; + if (image_active || (lo >= 0 && hi <= CODE_END)) return 1; + while (p) { if (lo >= p[1] && hi <= p[2] - 2) return 1; p = p[0]; } + return 0; +} +int emit(int w) { + if (dry) return 0; + if (w == OP_FLIT * 2) reserve_code(2); else reserve_code(1); + *(here + hdelta) = w; + here++; + return 0; +} +// a vm code word with the low bit set pushes the value in its upper bits +// (v + v + 1); an even word is an opcode (k + k). jmp pushes a target and jumps. +int lit(int v) { + if ((v >> 62) != 0 && (v >> 62) != -1) { + reserve_code(5); + emit((v >> 32) * 2 + 1); emit(0x100000000 * 2 + 1); op(15); + emit((v & 0xFFFFFFFF) * 2 + 1); op(17); + } else emit(v + v + 1); + return 0; +} +// emit one vm opcode. +int op(int k) { emit(k + k); return 0; } +// fill the literal placeholder at address at with value v. +int setlit(int at, int v) { + if (dry) return 0; + if ((v >> 62) != 0 && (v >> 62) != -1) fatal("literal patch too large"); + *(at + hdelta) = v + v + 1; + return 0; +} +// emit a jump to the address t. +int jmp(int t) { + lit(t); + op(O_JMP); + return 0; +} +// a lit that will be patched later; returns its address +int hole() { + int a; + reserve_code(1); a = here; + lit(MW - 1); + return a; +} +// forward references. calling a function that is not defined yet creates a +// symbol with F_DEF clear whose value is the place of its first use (for the +// "never defined" error). each call site emits a placeholder literal and adds +// itself to the symbol's chain (sfix); defining the function runs fixall to +// patch every site. MW-1 is a jump target that halts, so an unpatched call +// stops the machine instead of running garbage. +int fwdfn_at(int name, int p) { + int s = addsym(name, K_FN, p); + sflag[s] = 0; + return s; +} +// the place of the first use (line, and offset above bit 24), until it's defined +int fwdfn(int name) { + return fwdfn_at(name, tpack()); +} +// emit a reference to function s, patched later if it is not defined yet. +int fnref(int s) { + if (sflag[s] & F_DEF) { lit(sval[s]); return 0; } + if (dry) return 0; + reserve_code(1); sfix[s] = fixnew(here, sfix[s]); + lit(MW - 1); // a jump to MW-1 halts if it ever runs unpatched + return 0; +} +// emit a call to the function with this name, making a forward slot if it is not defined. +int callname(int name) { + int s = lookup(name); + if (s < 0) s = fwdfn(name); + fnref(s); + op(O_CALL); + return 0; +} +// the address of local slot k: the frame pointer lives in the word ZFP, and a +// local is fp + k. (o3 locals live in cpu registers instead; see vaddr.) +int laddr(int k) { + lit(ZFP); + op(O_LD); + if (k) { lit(k); op(O_ADD); } + return 0; +} +// an o3 variable's address: lfa(k) is fp + k as one enhancement, which the +// jit specializes on the literal k +word vaddr(int i) { + int s; + if (ltag[i] & 16) { + s = lookup(s_lfa); + if (s >= 0 && skind[s] == K_ENH) { + lit(lslot[i]); + op(XOP0 + sval[s]); + return 0; + } + } + return laddr(lslot[i]); +} +// registers for an o3 region's variables: the cpu has 7. a variable takes the +// one its region freed last (when a scope closed), or the next unused one +// ---- o3: the optimizing region compiler's bookkeeping ---- +// code inside an o3 region (or a function marked o3) keeps hot locals in the +// cpu's registers. the compiler does not change what it emits for them; it +// records which frame slot maps to which register and hands the finished +// region to the core through install(). the core compiles the whole region +// with those slots held in registers and writes them back to the frame when +// control leaves it. there are 7 registers, so locals past that stay in +// memory. +int o3reset() { + no3free = 0; + o3nreg = 1; + no3sl = 0; + return 0; +} +// a freed register keeps its class. a float home is a d register and an int +// home is an x register, and one var index cannot be both, so a number that +// was a float is only handed out again as a float. +int o3take(int fp) { + int i = 0, k, w = -1; + while (i < no3free) { + k = o3free[i]; + if (fp && k < 0) w = i; + if (!fp && k > 0) w = i; + i++; + } + if (w >= 0) { + k = o3free[w]; + no3free--; + o3free[w] = o3free[no3free]; + if (k < 0) return 0 - k; + return k; + } + if (o3nreg < 8) { o3nreg++; return o3nreg - 1; } + return 0; +} +// true when a type is a plain number that o3 can keep in a register. +int o3plain(word t) { + if (!t) return 0; + if (t[0] == TY_INT || t[0] == TY_CHAR || t[0] == TY_BOOL || t[0] == TY_FLOAT) return 1; + return 0; +} +// move a local into an o3 register when the region can keep it there. +int o3promote(int i) { + int r, fp; + ltag[i] = ltag[i] - (ltag[i] & 1792); + if (!o3on || larr[i] || no3sl >= 32) return 0; + fp = isfl(ltype[i]); + r = o3take(fp); + if (!r) return 0; + ltag[i] = ltag[i] + r * 256; + o3sl[no3sl] = lslot[i]; + if (o3plain(ltype[i])) r = r + 16; // 16 marks a plain number: the core need not write it back before a call + if (fp) r = 0 - r; // the install word is negative when the home is a d register + o3rg[no3sl] = r; no3sl++; + return 0; +} +// a fixed []T can't change its items or its length, so o3 code keeps both in +// two hidden variables, loaded when the array variable is set (or when the +// region starts), and indexes through them +int o3mkcache(int i) { + int k; + if (!o3on || ltype[i][0] != TY_DYN || !ltype[i][3] || tbytes(ltype[i][4])) return 0; + k = newloc(s_hitems); fslots++; ltag[k] = 16; o3promote(k); + newloc(s_hlen); fslots++; ltag[k + 1] = 16; o3promote(k + 1); + o3cache[i] = k; + return 0; +} +// reload the o3 register cache of a local from its memory slot. +int o3refresh(int i) { + int k = o3cache[i]; + if (!k) return 0; + vaddr(i); op(O_LD); lit(2); op(O_ADD); op(O_LD); vaddr(k); op(O_ST); + vaddr(i); op(O_LD); op(O_LD); vaddr(k + 1); op(O_ST); + return 0; +} +// hands a region to the cpu: install kind 2 is [-, 2, lo, hi, n, slot, register, ..., fslots, argc, fnstart] +// fslots, argc and the prologue address sit in o3fs, o3na, o3fn0. a bare o3 block leaves the prologue at -1, so a function that starts at address 0 still binds. +int o3region(int lo, int hi, word sl, word rg, int n) { + int i = 0; + if (hdelta || lo >= hi || !code_contiguous(lo, hi)) return 0; + o3dsc[0] = 0; o3dsc[1] = 2; o3dsc[2] = lo; o3dsc[3] = hi; o3dsc[4] = n; + while (i < n) { o3dsc[5 + i + i] = sl[i]; o3dsc[6 + i + i] = rg[i]; i++; } + o3dsc[5 + n + n] = o3fs; o3dsc[6 + n + n] = o3na; o3dsc[7 + n + n] = o3fn0; + install(o3dsc); + return 0; +} +// o3 blocks go to the cpu once their function is done, so every jump in them is final +int o3flush() { + int i = 0; word p; + o3fs = 0; o3na = 0; o3fn0 = -1; /* -1 is not a function; a prologue at address 0 is */ + while (i < no3pend) { p = o3pend + i * 67; o3region(p[0], p[1], p + 3, p + 35, p[2]); i++; } + no3pend = 0; + return 0; +} +// a string literal: the characters (one per word, then a 0) are emitted into +// the code stream behind a jump, and the literal's value is their address +int strlit(word s) { + int j = hole(), a; + op(O_JMP); + reserve_code(len_w(s) + 1); a = here; + while (*s) { emit(*s); s++; } + emit(0); + setlit(j, here); + lit(a); + return 0; +} + +// ---- input sources ---- +// frame: 0 kind (0 stdin, 1 token list, 2 string) 1 object 2 index 3 end +// 4 transparent 5..7 saved token 8..10 saved char state 11 owned 12 saved line +// 13 saved token line 14 saved lookahead count 15..30 saved lookahead 31 saved char buffer +// a backtick ends the source: it is how a program tells the compiler where its +// own text stops and the program's input begins. but only a backtick the +// lexer would read as a token counts. srcend is fed every character of a +// stdin source in order and follows just enough of the lexer's rules to know +// whether it is inside a // comment, a /* */ comment, a string or a char +// literal (a backslash escapes the next character in the last two). it +// returns 1 for a backtick outside all of them. readsrc and nextch both use +// it, so a backtick in a comment or a string is just a character. +int srcend(int c) { + if (qst == 0) { + if (c == 96) return 1; + if (c == 34) qst = 3; + else if (c == 39) qst = 4; + else if (c == '*' && qp == '/') { qst = 2; qp = 0; return 0; } + else if (c == '/' && qp == '/') { qst = 1; qp = 0; return 0; } + qp = c; + return 0; + } + if (qst == 1) { + if (c == 10) { qst = 0; qp = 0; } + return 0; + } + if (qst == 2) { + if (c == '/' && qp == '*') { qst = 0; qp = 0; return 0; } + qp = c; + return 0; + } + if (qesc) { qesc = 0; return 0; } + if (c == 92) { qesc = 1; return 0; } + if ((qst == 3 && c == 34) || (qst == 4 && c == 39)) { qst = 0; qp = 0; } + return 0; +} +// the character level of the lexer: ch is the current char (-1 at the end), +// and chkind says where it comes from (0 stdin, 3 a byte string, anything +// else a word string). a stdin source ends at a backtick (see srcend). +int nextch() { + if (chkind == 3) { // the usual case: the unit readsrc packed + ch = (chbase[chptr >> 2] >> ((chptr & 3) * 8)) & 255; + if (ch) chptr++; else ch = -1; + } else if (chkind == 0) { + if (qdone || eof()) { ch = -1; return 0; } + ch = get_c() & 255; + if (srcend(ch)) { qdone = 1; ch = -1; return 0; } // a backtick ends the source + } else { + ch = *chptr & 255; + if (ch) chptr++; else ch = -1; + } + if (ch == 10) line++; + return 0; +} +// the place of a token travels with its line: line in the low 24 bits, then +// the length (16 bits), the offset + 1 (21 bits) and its glue (2 bits, so a +// replayed token list still tells u*x from a product) +int tpack() { return tline | (toklen << 24) | ((toff + 1) << 40) | ((tglue & 3) << 61); } +// restore the token position that tpack saved in a word. +int tunpack(int x) { + tline = x & 0xFFFFFF; + toklen = (x >> 24) & 0xFFFF; + toff = ((x >> 40) & 0x1FFFFF) - 1; + tglue = (x >> 61) & 3; + return 0; +} +// chars consumed so far in the source being read: the index of the char in ch +// (or of the end, once the source is used up). a stdin source reports -1. +int cpos() { + if (chkind == 3) { if (ch < 0) return chptr; return chptr - 1; } + if (chkind == 2) { if (ch < 0) return chptr - chbase; return chptr - chbase - 1; } + return 0 - 1; +} +// push a new input source. the current token, char state and lookahead are +// saved into a 32 word frame so src_pop can put them back exactly. kind 0 is +// stdin, 1 a token list (obj[0] is the count, then triples of kind, value and +// packed place: this is how macros, quote/grab and feed replay code), 2 a +// word string and 3 a byte string. trans means "transparent": when a token +// list runs out the reader pops it and carries on in the source below, which +// is what lets a fed list splice into the text around it. owned means the +// frame frees obj when it pops. +int src_push(int kind, word obj, int trans, int owned) { + word f; int i; + isp++; + reserve_R_SRC((isp + 1) * 32); + f = R_SRC + isp * 32; + f[0] = kind; f[1] = obj; f[2] = 0; f[3] = 0; f[4] = trans; f[11] = owned; + f[5] = tk; f[6] = tv; f[7] = tglue; f[8] = ch; f[9] = chkind; f[10] = chptr; + f[12] = line; f[13] = tpack(); f[14] = pq_n; f[31] = chbase; + i = 0; + while (i < pq_n) { + f[15 + i * 4] = pq_tk[i]; + f[16 + i * 4] = pq_tv[i]; + f[17 + i * 4] = pq_gl[i]; + f[18 + i * 4] = pq_ln[i]; + i++; + } + pq_n = 0; + if (kind == 1) f[3] = obj[0]; + if (kind == 0) { chkind = 0; qdone = 0; qst = 0; qp = 0; qesc = 0; line = 1; nextch(); } + if (kind == 2) { chkind = 2; chptr = obj; chbase = obj; line = 1; nextch(); } + if (kind == 3) { chkind = 3; chbase = obj; chptr = 0; line = 1; nextch(); } + return 0; +} +// leave the current source and restore the one beneath it +int src_pop() { + word f = R_SRC + isp * 32; int i = 0; + tk = f[5]; tv = f[6]; tglue = f[7]; ch = f[8]; chkind = f[9]; chptr = f[10]; + line = f[12]; tunpack(f[13]); pq_n = f[14]; chbase = f[31]; + while (i < pq_n) { + pq_tk[i] = f[15 + i * 4]; + pq_tv[i] = f[16 + i * 4]; + pq_gl[i] = f[17 + i * 4]; + pq_ln[i] = f[18 + i * 4]; + i++; + } + isp--; + if (f[11]) free(f[1]); + f[1] = 0; // a dead source pointer would pin a quarantined block + return 0; +} +// the lexer's character classes. an operator is built one character at a time +// for as long as the text so far is still a prefix of some known operator +// (opprefix), so a program that adds an operator with add_binop changes how +// the next source is split into tokens without any other bookkeeping. +// the operator characters are + - * / % = < > ! & | ^ ~ ? : . @ # $ . those below +// 64 are a bit mask indexed from 33, the rest are four compares +int isopch(int c) { + if (c < 33 || c > 126) return 0; + if (c < 64) return (0x7a00763d >> (c - 33)) & 1; + return c == 64 || c == 94 || c == 124 || c == 126; +} +// is buf[0..n) followed by c the start of some operator the lexer knows? +int opprefix(int n, int c) { + int i = 0; word k; int j; + while (i < nkop) { + k = kops[i]; + j = 0; + while (j < n && k[j] == tbuf[j]) j++; + if (j == n && k[n] == c) return 1; + i++; + } + return 0; +} +// true for a decimal digit. +int isdig(int c) { return c >= '0' && c <= '9'; } +// true for a letter or an underscore. +int isal(int c) { return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '_'; } +// a letter, digit or _ : the characters after the first one of a name +int isidc(int c) { + if (c >= 'a') return c <= 'z'; + if (c >= 'A') return c <= 'Z' || c == '_'; + return c >= '0' && c <= '9'; +} +// the value of a hex digit, or a value past 15 when c is not one. +int hexv(int c) { + if (isdig(c)) return c - '0'; + if (c >= 'a' && c <= 'f') return c - 'a' + 10; + if (c >= 'A' && c <= 'F') return c - 'A' + 10; + return -1; +} +// one possibly escaped character of a string or char literal +int escch() { + int c = ch; + nextch(); + if (c != 92) return c; + c = ch; + nextch(); + if (c == 'n') return 10; + if (c == 't') return 9; + if (c == 'r') return 13; + if (c == '0') return 0; + if (c == 'e') return 27; + return c; +} +// finish lexing an operator whose first n characters are in tbuf +int oplex(int n) { + while (ch >= 0 && isopch(ch) && opprefix(n, ch)) { n = token_char(n, ch); nextch(); } + tbuf[n] = 0; + tk = T_OP; tv = intern(tbuf); + return 0; +} +// per-local type flags kept in ltag. these are tiny accessors; the whole bit +// layout is: 0..3 the u/m/d tag, 4 o3, 5 float, 6 byte string, 8..10 the o3 +// register, 12.. the hint bits (see LASG and friends). +// bit 5 of ltag: this local holds a float. the low bits are the u/m/d tag and bit 4 is o3. +word getflt(int i) { return (ltag[i] >> 5) & 1; } +// mark local i as holding a float, or clear the mark. +int setflt(int i, int f) { + if (f) ltag[i] = ltag[i] | 32; + else ltag[i] = ltag[i] - (ltag[i] & 32); + return 0; +} +// bit 6 of ltag: this local holds a byte string. bit 5 is the float. +word getstr(int i) { return (ltag[i] >> 6) & 1; } +// mark local i as holding a string, or clear the mark. +int setstr(int i, int f) { + if (f) ltag[i] = ltag[i] | 64; + else ltag[i] = ltag[i] - (ltag[i] & 64); + return 0; +} +// b"...": length word, then bytes packed 8 per word, little-endian, and a 0 +// after the last byte. a jump skips the data. the address pushed is the length. +int bstrlit(word s) { + int j = hole(), a, n = 0, i = 0, w, k; + op(O_JMP); + while (s[n]) n++; + reserve_code((n >> 3) + 2); a = here; + emit(n); + while (i < n) { + w = 0; k = 0; + while (k < 8 && i < n) { w = w | (s[i] << (k * 8)); k++; i++; } + emit(w); + } + if (!(n & 7)) emit(0); + setlit(j, here); + lit(a); + return 0; +} +// ---- float literals and float code ---- +// a float is one word holding the ieee bits. the lexer collects the literal's +// text in tbuf and fbits asks the core (opcode 611) to convert it, so the +// compiler needs no float parser of its own. float operations are single vm +// opcodes (OP_FADD ...). an int operand is converted on the fly, and a +// comparison leaves a plain 0/1 behind. xfloat says whether the expression +// just compiled is a float. +int fbits() { return asm { tbuf @ #1222 }; } +// collect an exponent (e+3) onto the literal in tbuf; n is the length so far +int takeexp(int n) { + if (ch != 'e' && ch != 'E') return n; + n = token_char(n, ch); + nextch(); + if (ch == '+' || ch == '-') { n = token_char(n, ch); nextch(); } + if (!isdig(ch)) { die("bad float"); return n; } + while (isdig(ch)) { n = token_char(n, ch); nextch(); } + return n; +} +// the literal in tbuf[0..n) is a float: hand it back as a T_FLT token +int floatok(int n) { + tbuf[n] = 0; + tk = T_FLT; + tv = fbits(); + return 0; +} +// the binary operators that have a float form +int isfop(int o) { + if (o == s_plus || o == s_minus || o == s_star || o == s_slash) return 1; + if (o == s_lt || o == s_gt || o == s_le || o == s_ge || o == s_eqeq || o == s_ne) return 1; + return 0; +} +// emit float arithmetic or comparison o for operands that are floats (lf, rf). +// an int left operand sits under the right one, so it is converted with +// swap / i2f / swap. > and >= are < and <= with the operands swapped, and != +// is == followed by not. +int femit(int o, int lf, int rf) { + if (!lf) { op(O_SWAP); op(OP_I2F); op(O_SWAP); } + if (!rf) op(OP_I2F); + if (o == s_plus) { op(OP_FADD); xfloat = 1; return 0; } + if (o == s_minus) { op(OP_FSUB); xfloat = 1; return 0; } + if (o == s_star) { op(OP_FMUL); xfloat = 1; return 0; } + if (o == s_slash) { op(OP_FDIV); xfloat = 1; return 0; } + if (o == s_eqeq) { op(OP_FEQ); xfloat = 0; return 0; } + if (o == s_ne) { op(OP_FEQ); lit(1); op(18); xfloat = 0; return 0; } + if (o == s_lt) { op(OP_FLT); xfloat = 0; return 0; } + if (o == s_gt) { op(O_SWAP); op(OP_FLT); xfloat = 0; return 0; } + if (o == s_le) { op(OP_FLE); xfloat = 0; return 0; } + if (o == s_ge) { op(O_SWAP); op(OP_FLE); xfloat = 0; return 0; } + xfloat = 0; + return 0; +} +// true when a type is a float, the same as isfl. +word isfloat(int t) { return isfl(t); } +// float, f32, and f32's packed twin: everything computed as a double +word isfl(word t) { return t && t[0] == TY_FLOAT; } +// ±0 is false, like 0.0. every other float, including NaN, is true. the vm's +// jz stays an integer test, so a float is compared with +0 first. +int ftest() { + if (!xfloat) return 0; + op(OP_FLIT); emit(0); op(OP_FEQ); lit(1); op(18); + xfloat = 0; xty = tbool; + return 0; +} +// a float stored into an int becomes an int, and an int stored into a float +// becomes a float. word keeps the bits and drops the float mark. +int fcoerce(word dst) { + if (!dst || dst[0] == TY_VAR) return 0; + if (isfl(dst)) { + if (!xfloat) { op(OP_I2F); xfloat = 1; xty = tfloat; } + // an f32 variable holds a value rounded to single precision; a packed + // element is rounded when pkst stores it + if (dst == tf32 && xty != tf32 && !ispk(xty)) { xenh("zf2s"); xenh("zs2f"); xty = tf32; } + return 0; + } + if (!xfloat) { + if (tbytes(dst) && !samesz(dst, xty)) tnorm(dst); + return 0; + } + if (isnum(dst)) { op(OP_F2I); xfloat = 0; xty = dst; if (tbytes(dst)) tnorm(dst); return 0; } + if (dst == tword) xfloat = 0; + return 0; +} +// sized integers. a value stored into a variable, field, parameter or array +// element of type t is cut to size first: unsigned types are masked and signed +// ones are masked and then sign-extended (xor the sign bit, subtract it). +// samesz says a value of type b is already in range for type a. +word samesz(word a, word b) { return tbytes(a) && tbytes(b) == tbytes(a) && (a[6] & 1) == (b[6] & 1); } +// narrow the integer on the stack to the width of its type. +int tnorm(word t) { + int b = tbytes(t), s; + if (!b || t[0] != TY_INT) return 0; + lit((1 << (8 * b)) - 1); op(16); + if (t[6] & 1) { s = 1 << (8 * b - 1); lit(s); op(18); lit(s); op(O_SUB); } + return 0; +} +// [byte address] -> [value]: load a packed element of type t (the twin) +int pkld(word t) { + int b = t[5]; + if (b == 1) op(612); else if (b == 2) op(614); else op(616); + pkfix(t); + return 0; +} +// a zero extended packed element on the stack becomes the value of type t +int pkfix(word t) { + int b = t[5], s; + if (t[0] == TY_FLOAT) { xenh("zs2f"); return 0; } // f32: the bits widen to a double + if (t[6] & 1) { s = 1 << (8 * b - 1); lit(s); op(18); lit(s); op(O_SUB); } + return 0; +} +// [value byte-address] -> []: store a packed element of type t +int pkst(word t) { + int b = t[5]; + if (t[0] == TY_FLOAT) { op(O_SWAP); xenh("zf2s"); op(O_SWAP); op(617); return 0; } // f32: round the double to single bits + if (b == 1) op(613); else if (b == 2) op(615); else op(617); + return 0; +} +// an integer address and a field name: the name has to belong to one struct. +// field lookup on a bare address, for untyped code such as p.x where p is a +// plain word. if exactly one struct in the type area has a field called n, that +// is the one meant; with two or more it is ambiguous (the caller reports it). +int fieldscan(int n) { + int i = 0; word t; int k, hit = 0; + fldst = 0; fldi = -1; + while (i < ntl) { + t = typelist[i]; + if (t[0] == TY_STRUCT && t[3] >= 0) { + k = 0; + while (k < t[3]) { + if (t[4][k * 3] == n) { + if (hit) return 2; + hit = 1; fldst = t; fldi = k; + } + k++; + } + } + i++; + } + return hit; +} +// a // comment, with ch on its second slash. one that starts a line joins the +// doc comment being collected, if the line above was part of it, or starts a +// new one; a comment after code on the same line is not documentation. +int doccomment(int nl) { + int cl = line; + nextch(); + if (!nl) { while (ch >= 0 && ch != 10) nextch(); return 0; } + if (dn && dlast != cl - 1) dn = 0; + if (ch == 32) nextch(); + while (ch >= 0 && ch != 10) { doc_char(ch); nextch(); } + while (dn && (dbuf[dn - 1] == 32 || dbuf[dn - 1] == 9 || dbuf[dn - 1] == 13)) dn--; + doc_char(10); + dlast = cl; docpending = 1; + return 0; +} +// block documentation can end on the declaration's line. remove the optional +// leading star on each line, while leaving markdown inside the comment intact. +int docblock(int nl) { + int cl = line, bol = 1, c; + if (!nl || (dn && dlast != cl - 1)) dn = 0; + nextch(); + if (ch == '*') { nextch(); if (ch == '/') { nextch(); return 0; } } + while (ch >= 0) { + if (bol) { + while (ch == 32 || ch == 9) nextch(); + if (ch == '*') { nextch(); if (ch == '/') { cl = line; nextch(); break; } if (ch == 32) nextch(); } + bol = 0; + } + c = ch; nextch(); + if (c == '*' && ch == '/') { cl = line; nextch(); break; } + doc_char(c); + if (c == 10) bol = 1; + } + while (dn && (dbuf[dn - 1] == 32 || dbuf[dn - 1] == 9 || dbuf[dn - 1] == 10 || dbuf[dn - 1] == 13)) dn--; + doc_char(10); dlast = cl; docpending = 1; + return 0; +} +// the lexer proper: skip white space and comments, then read one token into +// tk / tv with its place in tline / toff. numbers (decimal, hex, floats), +// names, char and string literals (b"..." is a byte string), and operators +// all start here. tglue is 1 when the token touches the one before it with no +// white space, 0 when it does not, and 3 for a char literal (so the magic +// number hint can leave 'a' alone). asm blocks use it to read -5 as one +// literal. +int lex1() { + int n = 0, v, dg, nl; + if (pendot) { + pendot = 0; tglue = 1; tline = line; toff = cpos(); + tbuf[0] = '.'; tbuf[1] = 0; tk = T_OP; tv = intern(tbuf); + return 0; + } + tglue = 1; + nl = tline != line; + while (1) { + while (ch == 32 || ch == 9 || ch == 10 || ch == 13) { if (ch == 10) nl = 1; nextch(); tglue = 0; } + if (ch != '/') break; + nextch(); + if (ch == '/') { + if (docs_on) doccomment(nl); else while (ch >= 0 && ch != 10) nextch(); + tglue = 0; continue; + } + if (ch == '*') { + if (docs_on) { docblock(nl); tglue = 0; continue; } + nextch(); + while (ch >= 0) { if (ch == '*') { nextch(); if (ch == '/') break; } else nextch(); } + nextch(); tglue = 0; continue; + } + tline = line; toff = cpos() - 1; tbuf[0] = '/'; oplex(1); return 0; + } + tline = line; toff = cpos(); + if (docpending) { + dline = 0; + if (dn && (tline == dlast || tline == dlast + 1)) dline = tline; + docpending = 0; + } + if (ch < 0) { tk = T_EOF; tv = 0; return 0; } + if (isdig(ch)) { + v = 0; n = 0; + if (ch == '0') { + nextch(); + if (ch == 'x' || ch == 'X') { + nextch(); + while ((dg = hexv(ch)) >= 0) { v = v * 16 + dg; nextch(); } + tk = T_NUM; tv = v; return 0; + } + tbuf[0] = '0'; n = 1; + } + while (isdig(ch)) { n = token_char(n, ch); v = v * 10 + ch - '0'; nextch(); } + if (ch == 'e' || ch == 'E') { n = takeexp(n); return floatok(n); } + if (ch == '.') { + nextch(); + if (isdig(ch) || ch == 'e' || ch == 'E') { + n = token_char(n, '.'); + while (isdig(ch)) { n = token_char(n, ch); nextch(); } + return floatok(takeexp(n)); + } + if (isal(ch)) { pendot = 1; tk = T_NUM; tv = v; return 0; } // 1.field + n = token_char(n, '.'); + return floatok(n); + } + tk = T_NUM; tv = v; return 0; + } + if (isal(ch)) { + while (isidc(ch)) { n = token_char(n, ch); nextch(); } + tbuf[n] = 0; + if (n == 1 && tbuf[0] == 'b' && ch == 34) { + n = 0; nextch(); + while (ch >= 0 && ch != 34) { v = escch(); n = token_char(n, v); } + nextch(); + tbuf[n] = 0; + tk = T_BSTR; tv = intern(tbuf); return 0; + } + tk = T_ID; tv = intern(tbuf); return 0; + } + if (ch == 39) { + nextch(); + tv = escch(); + if (ch != 39) die("bad character literal"); + nextch(); + tk = T_NUM; + tglue = 3; + return 0; + } + if (ch == 34) { + nextch(); + while (ch >= 0 && ch != 34) { v = escch(); n = token_char(n, v); } + nextch(); + tbuf[n] = 0; + tk = T_STR; tv = intern(tbuf); return 0; + } + if (ch == '.') { + nextch(); + if (isdig(ch)) { + n = 0; tbuf[0] = '.'; n = 1; + while (isdig(ch)) { n = token_char(n, ch); nextch(); } + return floatok(takeexp(n)); + } + tbuf[0] = '.'; + if (isopch(ch) && opprefix(1, ch)) return oplex(1); + tbuf[1] = 0; + tk = T_OP; tv = intern(tbuf); + return 0; + } + tbuf[0] = ch; + nextch(); + if (isopch(tbuf[0])) return oplex(1); + tbuf[1] = 0; + tk = T_OP; tv = intern(tbuf); + return 0; +} +// lex1 plus the token's length, so the language server knows its extent +int lex() { + lex1(); + if (toff < 0) toklen = 0; else toklen = cpos() - toff; + return 0; +} +// one token of lookahead: peek() fills pk_*, next() takes it first +int next() { + int i = 1; + ntok++; + if (toff >= 0) { tpend = toff + toklen; tpline = tline; } + if (pq_n) { + tk = pq_tk[0]; tv = pq_tv[0]; tglue = pq_gl[0]; tunpack(pq_ln[0]); + while (i < pq_n) { + pq_tk[i - 1] = pq_tk[i]; + pq_tv[i - 1] = pq_tv[i]; + pq_gl[i - 1] = pq_gl[i]; + pq_ln[i - 1] = pq_ln[i]; + i++; + } + pq_n--; + if (grec) grec_add(); + return 0; + } + next0(); + if (grec) grec_add(); + return 0; +} +// the k-th token after the current one (k from 0 to 3), into pk_tk and pk_tv +int peekat(int k) { + int a, b, c, e; + while (pq_n <= k) { + a = tk; b = tv; c = tglue; e = tpack(); + next0(); + pq_tk[pq_n] = tk; pq_tv[pq_n] = tv; pq_gl[pq_n] = tglue; pq_ln[pq_n] = tpack(); pq_n++; + tk = a; tv = b; tglue = c; tunpack(e); + } + pk_tk = pq_tk[k]; pk_tv = pq_tv[k]; + return 0; +} +// look at the next token without consuming it. +int peek() { return peekat(0); } +// the lowest level of "next token": from a token list if one is the current +// source, otherwise from the lexer. in check mode after an abort it returns +// end of file forever, which unwinds every parsing loop without any special +// case in them. +int next0() { + word f, q; int i; + if (chkabort) { tk = T_EOF; tv = 0; chkfuel++; if (chkfuel > 3000000) halt(); return 0; } + f = R_SRC + isp * 32; + if (f[0] != 1) { lex(); return 0; } + i = f[2]; + if (i < f[3]) { + q = f[1]; + tk = q[1 + i * 3]; + tv = q[2 + i * 3]; + tunpack(q[3 + i * 3]); + f[2] = i + 1; + return 0; + } + if (!f[4]) { tk = T_EOF; tv = 0; return 0; } + src_pop(); // a fed list ran out: continue with the token that followed it + return 0; +} +// token tests. s is an interned spelling, so these are pointer compares. +int is_op(int s) { return tk == T_OP && tv == s; } +// true when the current token is the name s. +int is_id(int s) { return tk == T_ID && tv == s; } +// consume the current token if it is the operator or name s, and say whether it did. +int accept(int s) { + if ((tk == T_OP || tk == T_ID) && tv == s) { next(); return 1; } + return 0; +} +// accept(s) consumes the token if it is s. expect reports "expected s" at the +// end of the previous token (dgprev) when it is missing, and goes into panic. +int expect(int s) { + if (!accept(s)) { + if (!panic && !dry) { + dgprev = 1; + errat(); + dgprev = 0; + put_s("expected '"); put_s(s); put_s("', found "); tokshow(); + errend(); + } + panic = 1; + if (tk == T_EOF) giveup(); + } + return 0; +} +// read an identifier and return its interned handle +int name() { + int n = tv; + if (tk != T_ID) diefound("expected a name"); + nameoff = toff; + next(); + return n; +} + +// ---- operator tables ---- +// a sequence is written like asm: one-char mnemonics, numbers, and names +// (resolved when the operator is used, so image builds stay self-contained) +int seqasm(word s) { + int start = seqtop, n, neg, v, k, c; + while (1) { + while (*s == 32) s++; + if (!*s) break; + n = 0; + while (s[n] && s[n] != 32) { n = token_char(n, s[n]); } + tbuf[n] = 0; + s = s + n; + reserve_R_SEQ(seqtop + 2); + neg = tbuf[0] == '-' && isdig(tbuf[1]); + if (isdig(tbuf[neg])) { + v = 0; k = neg; + while (tbuf[k]) { v = v * 10 + tbuf[k] - '0'; k++; } + if (neg) v = 0 - v; + if ((v >> 62) != 0 && (v >> 62) != -1) { R_SEQ[seqtop] = SEQWORD; R_SEQ[seqtop + 1] = v; seqtop = seqtop + 2; } + else { R_SEQ[seqtop] = v + v + 1; seqtop++; } + } else if (n == 1 && (c = mnemidx(tbuf[0])) >= 0) { + R_SEQ[seqtop] = c + c; seqtop++; + } else { + R_SEQ[seqtop] = SEQREF; R_SEQ[seqtop + 1] = intern(tbuf); seqtop = seqtop + 2; + } + } + return start; +} +// the index of an assembler mnemonic in the table, or -1 when there is none. +int mnemidx(int c) { + int i = 0; + while (mnem[i]) { + if (mnem[i] == c) return i; + i++; + } + return -1; +} +// emit n words of a stored sequence, resolving its references. +int emitseq(int a, int n) { + int e = a + n, s; + while (a < e) { + if (R_SEQ[a] == SEQWORD) { lit(R_SEQ[a + 1]); a = a + 2; } + else if (R_SEQ[a] == SEQREF) { + s = lookup(R_SEQ[a + 1]); + if (s < 0) s = fwdfn(R_SEQ[a + 1]); + if (skind[s] == K_FN) { + fnref(s); + } else if (skind[s] == K_ENH) op(XOP0 + sval[s]); else lit(sval[s]); + a = a + 2; + } else { emit(R_SEQ[a]); a++; } + } + return 0; +} +// add an operator name to the table of known operators, once. +int addkop(int p) { + int i = 0; + while (i < nkop) { + if (kops[i] == p) return 0; + i++; + } + reserve_operators(nkop + 1); + kops[nkop] = p; + nkop++; + return 0; +} +// find a binary operator by its name. +int binfind(int p) { + int i = nbin; + while (i) { + i--; + if (bname[i] == p) return i; + } + return -1; +} +// find a unary operator by its name. +int unfind(int p) { + int i = nun; + while (i) { + i--; + if (uname[i] == p) return i; + } + return -1; +} +// find an assignment operator by its name. +int asgfind(int p) { + int i = nasg; + while (i) { + i--; + if (aname[i] == p) return i; + } + return -1; +} +// add or replace a binary operator. code is a sequence string, or 0 for the +// built-in && (prec 2) and || (prec 1) behaviour, chosen by -1 / -2 in prec. +int add_binop(int nm, int prec, int code) { + int p = intern(nm), i = binfind(p), a, n; + if (i < 0) { reserve_binary(nbin + 1); i = nbin; nbin++; } + bname[i] = p; bprec[i] = prec; + if (prec < 0) { bprec[i] = 0 - prec; blen[i] = prec; bseq[i] = 0; addkop(p); return i; } + bseq[i] = seqasm(code); blen[i] = seqtop - bseq[i]; + addkop(p); + // and its compound assignment, x op= y + n = len_w(nm); + while (1002 + n > tbufcap) { tbuf = chk_resize(tbuf, 0, tbufcap * 2); tbufcap = tbufcap * 2; } + copy_w(tbuf + 1000, nm, n); + tbuf[1000 + n] = '='; tbuf[1001 + n] = 0; + a = intern(tbuf + 1000); + if (prec >= 8 || prec == 5 || prec == 4 || prec == 3) { + if (asgfind(a) < 0) { reserve_assignment(nasg + 1); aname[nasg] = a; nasg++; } + abin[asgfind(a)] = i; + addkop(a); + } + return i; +} +// register a unary operator and the sequence it expands to. +int add_unop(int nm, int code) { + int p = intern(nm), i = unfind(p); + if (i < 0) { reserve_unary(nun + 1); i = nun; nun++; } + uname[i] = p; useq[i] = seqasm(code); ulen[i] = seqtop - useq[i]; + addkop(p); + return i; +} +// register a keyword with its handler and flags. +int add_kw(int nm, int handler, int flags) { + int s = addsym(intern(nm), K_KW, handler); + sflag[s] = F_DEF | flags; + return s; +} + +// ---- locals and the analyzer's view of them ---- +// these warnings add no ownership rules. facts are discarded at control-flow +// joins and after unknown effects, so a possible failure is never called definite. +word af_new(int length, int kind, int place) { + word f; + if (dry || stubgen) return 0; + f = talloc(6); f[0] = length; f[1] = 1; f[2] = kind; + f[3] = place; f[4] = 0; f[5] = -1; + return f; +} +int af_forget() { + int i = lbase; + while (i < nloc) { lafact[i] = 0; i++; } + xaf = 0; return 0; +} +// an unknown callee may change a passed allocation's length or lifetime. +int af_escape(word f) { + if (f) { f[0] = -1; f[1] = 0; } + return 0; +} +int af_store(int i) { + if (!dry) lafact[i] = xaf; + return 0; +} +int af_record(int off, word f) { + int at; + if (!f || !cmode || dry || chkind != 3 || chbase != rsbase || !rsn) return 0; + at = (rsn - 1) * RS_W; + if (rsrec[at] != off) return 0; + copy_w(rsrec + at + 4, f, 5); return 0; +} +// keep declaration previews as well as the facts at each use site. +int af_declaration(int off, word f) { + int i = rsn; + if (!f || !cmode || dry || chkind != 3 || chbase != rsbase) return 0; + while (i) { i--; if (rsrec[i * RS_W] == off) { copy_w(rsrec + i * RS_W + 4, f, 5); return 0; } } + return 0; +} +int af_warning(int place) { + int sv; + if (dry || panic || chkabort || stubgen || !live) return 0; + sv = tpack(); tunpack(place); + if (cmode) dg_open(2); + else { put_s("zc: line "); put_n(tline); put_s(": warning: "); } + tunpack(sv); return 1; +} +int af_warning_end() { if (cmode) dg_close(); else put_c(10); return 0; } +int af_access(word f, int place) { + if (!f || f[1] != 2 || !af_warning(place)) return 0; + put_s("use after free: this storage's lifetime ended on line "); + put_n(f[4] & 0xFFFFFF); af_warning_end(); return 0; +} +int af_index(word f, int place) { + if (!f || f[1] == 2 || f[0] < 0 || !xconst || (xcval >= 0 && xcval < f[0])) return 0; + if (!af_warning(place)) return 0; + put_s("out-of-bounds access: index "); put_n(xcval); + put_s(" is outside length "); put_n(f[0]); af_warning_end(); return 0; +} +// freeing an alias ends the same allocation as freeing its original name. +int af_end(word f, int place) { + if (f && !dry && live) { f[1] = 2; f[4] = place; } + return 0; +} +int af_close(int save) { + int i = save; word f; + if (dry) return 0; + while (i < nloc) { + f = laaddr[i]; if (f) af_end(f, tpack()); + f = lafact[i]; + if (f && fchk && lstate[i] == S_M && lown[i]) af_end(f, tpack()); + i++; + } + return 0; +} +// the analyzer's model of a local. locals are numbered in declaration order +// and every fact about one lives in a parallel array indexed by that number +// (see the data region). for ownership the ones that matter are: +// lstate what the local holds right now: +// S_PLAIN nothing tracked (a number, or untracked memory) +// S_M owns an object; the compiler frees it when the block ends +// S_U owns one that has to leave the block (return it, make +// it the block's value, or assign it to the enclosing block) +// S_D was handed in to be given away, and hasn't been yet +// S_DEAD the object is gone (given away); any use is an error +// S_CHILD the object belongs to a container, lowner says which local +// S_BORROW a .m parameter: usable but not freeable or storable +// lhome the block depth that owns the object (fdepth where it was declared) +// lown 1 once the local has owned an object, lused the line of its last use +// ltag the tag written on the declaration, plus the flag bits (float, +// byte string, o3 register, hint bits) +// fchk says the function being compiled is analyzed at all (unchecked turns +// it off) and live says the code just emitted is reachable. ownership rules +// return when fchk is off; definite storage warnings also inspect unchecked code. +// findloc looks a name up among the current function's locals, innermost first. +// name heads and shadow links keep declaration and use lookup independent of +// the number of earlier locals. dropping a scope restores the previous heads. +int local_bucket(int n, int cap) { return ((n ^ (n >> 16)) * 0x9E37) & (cap - 1); } +int local_key(int n) { + int k = local_bucket(n, lkeycap); + while (lkeys[k] && lkeys[k] != n) k = (k + 1) & (lkeycap - 1); + return k; +} +int local_bind(int n, int i) { + int k, j, at, cap; word keys, heads; + if (lkeyn + lkeyn >= lkeycap) { + keys = lkeys; heads = lheads; cap = lkeycap * 2; + lkeys = chk_resize(0, 0, cap); lheads = chk_resize(0, 0, cap); + j = 0; + while (j < lkeycap) { + if (keys[j]) { at = local_bucket(keys[j], cap); while (lkeys[at]) at = (at + 1) & (cap - 1); lkeys[at] = keys[j]; lheads[at] = heads[j]; } + j++; + } + lkeycap = cap; + } + k = local_key(n); + if (!lkeys[k]) { lkeys[k] = n; lheads[k] = -1; lkeyn++; } + lprev[i] = lheads[k]; lheads[k] = i; return 0; +} +int local_drop(int save) { + int i = nloc, k; + while (i > save) { i--; k = local_key(lname[i]); lheads[k] = lprev[i]; } + nloc = save; return 0; +} +int findloc(int n) { + int k = local_key(n), i; + if (!lkeys[k]) return -1; + i = lheads[k]; + while (i >= nloc) i = lprev[i]; + if (i >= lbase) return i; + return -1; +} +// declare a local: take the next slot in the frame (fslots) and reset every +// per-local fact so a reused index never inherits the old variable's state +int newloc(int n) { + int i = nloc; + if (nloc >= loccap) reserve_locals(nloc + 1); + nloc++; + lname[i] = n; local_bind(n, i); lslot[i] = fslots; lhome[i] = fdepth; lstate[i] = S_PLAIN; lsmark(0, n); + lowner[i] = 0; + lrsoff[i] = 0 - 1; lrskind[i] = RS_LOCAL; + lused[i] = 0; + larr[i] = 0; + lown[i] = 0; + ltype[i] = tword; + ltag[i] = 0; + o3cache[i] = 0; + lafact[i] = 0; laaddr[i] = 0; + return i; +} +// a local's known lower bound, and the array whose length it holds. -1 is unknown. +// the table is dropped as scopes close, so a reused slot does not keep the old fact. +word getlo(int i) { + int k = 0; + while (k < nfact) { + if (floc[k] == i) return flo[k]; + k++; + } + return -1; +} +// the length of the recorded fact for line i, or -1 when there is none. +word getln(int i) { + int k = 0; + while (k < nfact) { + if (floc[k] == i) return flen[k]; + k++; + } + return -1; +} +// record the range lo to lo+ln for line i. +int putfact(int i, int lo, int ln) { + int k = 0; + while (k < nfact) { if (floc[k] == i) { flo[k] = lo; flen[k] = ln; return 0; } k++; } + if (lo < 0 && ln < 0) return 0; + if (nfact >= factcap) { + floc = chk_resize(floc, nfact, factcap * 2); flo = chk_resize(flo, nfact, factcap * 2); flen = chk_resize(flen, nfact, factcap * 2); + factcap = factcap * 2; + } + floc[nfact] = i; flo[nfact] = lo; flen[nfact] = ln; nfact++; + return 0; +} +// drop the recorded facts from line from onward. +int fdrop(int from) { + int k = 0, w = 0; + while (k < nfact) { + if (floc[k] < from) { + if (w != k) { floc[w] = floc[k]; flo[w] = flo[k]; flen[w] = flen[k]; } + w++; + } + k++; + } + nfact = w; + return 0; +} +// a loop fact stores three full local indices: the +// induction variable, its bound and the array the bound is the length of. a +// loop "for (i = 0; i < len(a); i++)" records (i, bound, a) in lpfact, which +// is how proven() knows that a[i] needs no bounds check inside it. +int pfact(int iv, int bd, int ar) { word p = talloc(3); p[0] = iv; p[1] = bd; p[2] = ar; return p; } +// the induction variable of a loop proof. +int p_iv(int w) { return w[0]; } +// the array's bound in a loop proof. +int p_bd(int w) { return w[1]; } +// the array a loop proof refers to. +int p_ar(int w) { return w[2]; } +// a store to the induction variable, the bound, or the array ends the proof +int bpoison(int i) { + int k = lsp, w; + while (k > loopbase) { + k--; + w = lpfact[k]; + if (w >= 0 && (p_iv(w) == i || p_bd(w) == i || p_ar(w) == i)) lpfact[k] = -1; + } + return 0; +} +// note a store to a local: a constant or a length it now holds. +int note_store(int i) { + int lo = -1, ln = -1; + if (xconst && xcval >= 0) lo = xcval; + if (xlenloc >= 0) ln = xlenloc; + putfact(i, lo, ln); + bpoison(i); + return 0; +} +// i >= 0 and i < len(a), proved by the loop test and a step of +1 +int proven(int a, int ix) { + int k = lsp, w; + if (ltype[a][0] != TY_DYN || !ltype[a][3] || tbytes(ltype[a][4])) return 0; + while (k > loopbase) { + k--; + w = lpfact[k]; + if (w >= 0 && p_iv(w) == ix && p_ar(w) == a) return 1; + } + return 0; +} +// follow child links up to the local that really owns the object +int lroot(int i) { + while (lstate[i] == S_CHILD) i = lowner[i]; + return i; +} +// true when a local has an ownership state the analyzer follows. +word tracked(int i) { return lstate[i] != S_PLAIN; } +// a child link with nothing owned: a pointer computed from some other variable +word isalias(int i) { return lstate[i] == S_CHILD && !lown[i]; } +// record the last-use line and saturating count read by the hints ("only +// handed off once"). +int luse(int i) { + lused[i] = tline; + if ((ltag[i] >> 56) < 100) ltag[i] = ltag[i] + LCNT1; + return 0; +} +// touch records a use of a tracked local and rejects dead objects. a d object +// read in an inner block moves there, where the block owns it as m. +int touch(int i) { + int r; + luse(i); + ltag[i] = ltag[i] | LREAD; + if (!fchk) return 0; + r = lroot(i); + luse(r); + if (lstate[r] == S_DEAD) { cerrn(i, "used after it was given away"); return 0; } + // a d object that shows up in a deeper block is given to that block + if (lstate[r] == S_D && lhome[r] < fdepth) { lhome[r] = fdepth; lstate[r] = S_M; lown[r] = 1; } + return 0; +} +// an expression of class c used as a plain value (a lend, an operand). a new +// object can't be used that way, since nothing would own it. +int plainuse(int c) { + if (c == C_FRESH) cerr("a new object can't be used as a plain value; bind it to a name first"); + if (c >= C_VAR) touch(c - C_VAR); + return C_PLAIN; +} +// the size class of an n word object, for a constant-size new +int szclass(int n) { + int k = 3; + while (pow2[k] < n + HDR) k++; + return k; +} +// freeing an owned local. one that holds a typed object with no pointer +// fields goes back through recycle_leaf, which knows its class +int freevar(int i) { + laddr(lslot[i]); op(O_LD); + if (lleaf[i] && !o3on && !dry && lookup(s_recycle_leaf) >= 0) { + lit(lleaf[i]); + lit(szclass(lnsz[i])); + callname(s_recycle_leaf); + } + else callname(s_recycle); op(O_DROP); lit(0); laddr(lslot[i]); op(O_ST); return 0; +} +// leaving every block deeper than or equal to dep: free what is owned, and +// complain about what should have left already. final means the block really +// ends here rather than an early exit. +int exit_vars(int dep, int final) { + int i = nloc, st; + if (!fchk || !live) return 0; + while (i > lbase) { + i--; + if (lhome[i] < dep) continue; + st = lstate[i]; + if (st == S_M) { + freevar(i); + } else if (st == S_U) { + cerrn(i, "u object must leave this block (block value, assignment to the enclosing block, or return)"); + } + else if (st == S_D) cerrn(i, "d object was never given away"); + } + return 0; +} +// an m object has to be used somewhere in the block that owns it, on any path +// block ends. +int unused_check(int from) { + while (from < nloc) { + if (fchk && lown[from] && !lused[from]) serrn(lname[from], "m object is never used"); + from++; + } + return 0; +} +// what a block's own variables show once it ends (check mode only) +int hint_name(int i, int msg) { + if (!hint_begin(lpos[i])) return 0; + put_s(lname[i]); put_s(msg); + dg_close(); + return 0; +} +// report the locals declared from token from onward that were never used. +int local_hints(int from) { + int i = from, f; + if (!cmode || dry || panic || chkabort || stubgen) return 0; + while (i < nloc) { + f = ltag[i]; + if ((f & LDECL) && !larr[i]) { + if (!(f & LREAD)) hint_name(i, " is never read"); + else if ((f & LCONST) && !(f & LASG)) hint_name(i, " is never reassigned; make it a const"); + else if (fchk && lstate[i] == S_M && lown[i] && lnsz[i] > 0 && lnsz[i] <= 64) hint_name(i, " never leaves this function; a stack buffer (let name[n]) avoids the heap"); + else if (fchk && lstate[i] == S_M && lown[i] && lused[i] && tline - lused[i] >= 4) hint_name(i, " is last used several lines above the end of its block; close the block sooner so it is freed sooner"); + } + i++; + } + return 0; +} +// block_close runs the analyzer's end-of-block work in order: hints for the +// block's variables, o3 registers go back to the pool, an m object that was +// never used is an error, exit_vars frees what is owned and complains about +// what should have left, aliases whose owner dies are marked dead, then the +// block's locals are dropped. unused_check comes first because an unused m +// object is an error, not a free. +int block_close(int save) { + int i = save, k; + af_close(save); + local_hints(save); + if (o3on) { + while (i < nloc) { + k = (ltag[i] >> 8) & 7; + if ((ltag[i] & 16) && k && no3free < 8) { + if (getflt(i)) k = 0 - k; + o3free[no3free] = k; + no3free++; + } + i++; + } + } + i = lbase; + unused_check(save); + exit_vars(fdepth, 1); + alias_end(fdepth, save); + while (i < save) { if (lhome[i] >= fdepth) { lstate[i] = S_DEAD; lhome[i] = fdepth - 1; } i++; } + local_drop(save); + fdrop(save); + return 0; +} + +// an alias in an outer block whose owner is about to disappear dies with it +int alias_end(int dep, int save) { + int i, r; + if (!fchk) return 0; + i = lbase; + while (i < save) { + if (isalias(i)) { + r = lroot(i); + if (r >= save || lhome[r] >= dep || lstate[r] == S_DEAD) lstate[i] = S_DEAD; + } + i++; + } + return 0; +} +// snapshots: [lbase] [nloc] then state, owner, home per local +// save the states of all current locals; returns the snapshot's offset +int snap_push() { + int b = snaptop, i = lbase; word p; + af_forget(); + reserve_R_SNAP(b + 2 + 3 * (nloc - lbase)); + p = R_SNAP + b; + p[0] = lbase; p[1] = nloc; + p = p + 2; + while (i < nloc) { p[0] = lstate[i]; p[1] = lowner[i]; p[2] = lhome[i]; p = p + 3; i++; } + snaptop = p - R_SNAP; + return b; +} +// drop the snapshot at base b. +int snap_pop(int b) { snaptop = b; return 0; } +// restore the local states saved in snapshot b. +int snap_restore(int b) { + word p = R_SNAP + b; int i = p[0], e = p[1]; + af_forget(); + if (e > nloc) e = nloc; + p = p + 2; + while (i < e) { lstate[i] = p[0]; lowner[i] = p[1]; lhome[i] = p[2]; p = p + 3; i++; } + return 0; +} +// true for a plain or dead local state, which merge to dead. +int empty(int s) { return s == S_PLAIN || s == S_DEAD; } +// compare the current states with a snapshot: -1 if they agree, else the +// first local that differs. plain and dead agree and merge to dead. +int snap_cmp(int b) { + word p = R_SNAP + b; int i = p[0], e = p[1], s; + if (e > nloc) e = nloc; + p = p + 2; + while (i < e) { + s = lstate[i]; + if (empty(s) && empty(p[0])) { if (p[0] == S_DEAD) lstate[i] = S_DEAD; } + else if (s != p[0] || lhome[i] != p[2] || (s == S_CHILD && lowner[i] != p[1])) return i; + p = p + 3; i++; + } + return -1; +} +// the state names used in join and loop messages +int statename(int s) { + if (s == S_PLAIN) return "empty"; + if (s == S_M) return "m"; + if (s == S_U) return "u"; + if (s == S_D) return "d"; + if (s == S_DEAD) return "given away"; + if (s == S_CHILD) return "owned by a container"; + return "borrowed"; +} +// report that local i ends two paths in different states +int merge_err(int i, int sa, int what) { + if (!fchk || panic || dry) return 0; + errat(); put_s(lname[i]); put_s(": "); put_s(what); + put_s(" (one path leaves it "); + put_s(statename(sa)); + put_s(", another "); + put_s(statename(lstate[i])); + put_s(")"); + errend(); + return 0; +} + +// ---- snapshots and comparing paths ---- +// to analyze an if, the compiler snapshots the locals' states before the +// branch, compiles the then path, restores the snapshot for the else path, and +// then compares or merges the two. a snapshot is [lbase, nloc] followed by +// state, owner and home for each local; the stack of them is at R_SNAP. +// ---- joins ---- +// where control flow comes back together (after an if, a loop, a switch or +// ?:) every variable has to agree across the paths that reach the join. one +// exception: a variable that became d, or was given away, on some path is dead +// after the join, and the paths where it's still alive free it on the way in +// (fixups). u objects and borrows don't get this treatment: a u object still +// has to leave, and a borrow never changes. + +int extop; [JOIN_PATHS]word jps_initial; word jps = jps_initial; int jpscap = JOIN_PATHS, njps; // the paths being joined: [lbase, nloc, triples] +// accessors on a path record p (a snapshot or an exit record): the state, +// owner and home of local i on that path. locals declared after the snapshot +// read as plain. +word jst(word p, int i) { + if (i >= p[1]) return S_PLAIN; + return p[2 + 3 * (i - p[0])]; +} +// the owner recorded in a jump's state for local i. +word jow(word p, int i) { return p[3 + 3 * (i - p[0])]; } +// the jump's marker for local i, in the same record as jow. +word jhm(word p, int i) { return p[4 + 3 * (i - p[0])]; } +// the states at a break, with the jump to patch: [site] then a snapshot +word exit_rec(int site) { + word p; int i = lbase; word q; + reserve_R_EXIT(extop + 3 + 3 * (nloc - lbase)); p = R_EXIT + extop; + p[0] = site; p[1] = lbase; p[2] = nloc; + q = p + 3; + while (i < nloc) { q[0] = lstate[i]; q[1] = lowner[i]; q[2] = lhome[i]; q = q + 3; i++; } + extop = q - R_EXIT; + return p; +} +// jps is the set of paths about to be joined. jadd adds one, jsame compares +// what two paths say about a local, and join folds them all into the current +// states (reporting any local that disagrees) +int jadd(int p) { + if (njps >= jpscap) { jps = chk_resize(jps, njps, jpscap * 2); jpscap = jpscap * 2; } + jps[njps] = p; + njps++; + return 0; +} +// true when the states of two jumps agree for local i. +word jsame(int p, int q, int i) { + int s = jst(p, i), t = jst(q, i); + if (empty(s) && empty(t)) return 1; + return s == t && jhm(p, i) == jhm(q, i) && (s != S_CHILD || jow(p, i) == jow(q, i)); +} +// join the paths in jps over the locals [lbase, n0) into the current states +int join(int n0, int what) { + int i = lbase, j, p, s, s0, dead, okdead, bad; + af_forget(); + if (!njps) return 0; + while (i < n0) { + p = jps[0]; s0 = jst(p, i); + dead = 0; okdead = 1; bad = -1; + j = 0; + while (j < njps) { + s = jst(jps[j], i); + if (s == S_DEAD || s == S_D) dead = 1; + if (s == S_U || s == S_BORROW) okdead = 0; + if (!jsame(p, jps[j], i)) bad = j; + j++; + } + lstate[i] = s0; lowner[i] = jow(p, i); lhome[i] = jhm(p, i); + if (bad < 0) { + if (empty(s0)) { + j = 0; + while (j < njps) { + if (jst(jps[j], i) == S_DEAD) lstate[i] = S_DEAD; + j++; + } + } + } else if (dead && okdead) lstate[i] = S_DEAD; + else if (fchk && !panic && !dry) { + errat(); put_s(lname[i]); put_s(": "); put_s(what); + put_s(" (one path leaves it "); + put_s(statename(s0)); + put_s(", another "); + put_s(statename(jst(jps[bad], i))); + put_s(")"); + errend(); + } + i++; + } + return 0; +} +// on path p: count (and with doit, emit) the frees for what the join made dead but p still owns +int fixups(int p, int n0, int doit) { + int i = lbase, n = 0, s; + if (!fchk) return 0; + while (i < n0) { + s = jst(p, i); + if (lstate[i] == S_DEAD && (s == S_M || s == S_D)) { n++; if (doit) freevar(i); } + i++; + } + return n; +} +// a jump back to the top of a loop: whatever the loop owns has to be as it was +int backedge(int s0) { + word p = R_SNAP + s0; int i = p[0], e = p[1], s; + if (!fchk || !live) return 0; + if (e > nloc) e = nloc; + while (i < e) { + s = lstate[i]; + if (empty(s) && empty(jst(p, i))) { if (jst(p, i) == S_DEAD) lstate[i] = S_DEAD; } + else if (s != jst(p, i) || lhome[i] != jhm(p, i) || (s == S_CHILD && lowner[i] != jow(p, i))) { + if (s == S_DEAD || s == S_D) { + cerrn(i, "is given away inside a loop that comes back around to it; give it away on a path that leaves the loop"); + } + else if (!panic && !dry) { + errat(); + put_s(lname[i]); + put_s(": changes state inside a loop; each pass has to leave it as it found it (it went from "); + put_s(statename(jst(p, i))); put_s(" to "); put_s(statename(s)); put_s(")"); errend(); + } + } + i++; + } + return 0; +} +// joins two paths that end at the same point, like the branches of if/else: +// path a jumped (through the hole at ja) and path b falls through to here +// (the then path's snapshot is sa; livea / livebv say whether each path can +// reach the join at all, since a path that returned is not part of it) +int join2(int sa, int livea, int ja, int livebv, int n0, int what) { + int sb, nt, cj; + sb = snap_push(); + njps = 0; if (livea) jadd(R_SNAP + sa); if (livebv) jadd(R_SNAP + sb); + join(n0, what); + if (livebv) fixups(R_SNAP + sb, n0, 1); + nt = 0; if (livea) nt = fixups(R_SNAP + sa, n0, 0); + if (nt) { cj = hole(); op(O_JMP); setlit(ja, here); fixups(R_SNAP + sa, n0, 1); setlit(cj, here); } + else setlit(ja, here); + live = livea || livebv; + return 0; +} + +// the rules below are the heart of the analyzer. each is a function the parser +// calls at one kind of place where a value moves: recast (u*x), argument +// passing, assignment, return, block values, and discarding. the argument +// c they take is an expression class: C_PLAIN (an ordinary word), C_FRESH (a +// new object nobody owns yet) or C_VAR + n (a bare local, number n), which is +// how the analyzer knows the thing being moved is a variable it tracks. +// ---- analyzer rules for the places values flow ---- +// recast: x as u / x as d / x as m +int recast(int c, int t) { + int i, st; + if (c == C_FRESH && t == S_M) return C_PLAIN; // m*f(): the unnamed result is let go on purpose, so it can be discarded + if (!fchk) return c; + if (c < C_VAR) { cerr("only a named owned object can be recast"); return c; } + i = c - C_VAR; + st = lstate[i]; + luse(i); + if (st == S_CHILD) cerrn(i, "belongs to a container; recast the container instead"); + else if (st == S_BORROW) cerrn(i, "is borrowed and can't be recast"); + else if (st == S_PLAIN) cerrn(i, "isn't an owned object"); + else if (st == S_DEAD) cerrn(i, "used after it was given away"); + else if (t == S_M && st != S_M) cerrn(i, "can't be recast back to m"); + else lstate[i] = t; + return c; +} +// an argument for a parameter tagged t (0 plain, 1 m, 2 d) +int argcheck(int c, int t) { + int i, st; + if (!fchk) return 0; + if (c == C_FRESH) { + if (t != 2) { + cerr("a new object can only go straight to a d parameter; bind it to a name first"); + } else { + xgive = 1; + } + return 0; + } + if (c < C_VAR || !tracked(c - C_VAR)) return 0; + i = c - C_VAR; + st = lstate[i]; + if (lstate[lroot(i)] == S_DEAD) { cerrn(i, "used after it was given away"); return 0; } + if (t <= 1) { // untagged parameters are m: a lend + if (st == S_D) { + cerrn(i, "is d; pass it to a d parameter (lending it would lose it)"); + return 0; + } + touch(i); + return 0; + } + if (st == S_D) { lstate[i] = S_DEAD; luse(i); xgive = 1; return 0; } + if (st == S_M) cerrn(i, "is m; write d*x to give it away"); + else if (st == S_U) cerrn(i, "is u; write d*x to give it away instead of returning it"); + else if (st == S_CHILD) cerrn(i, "belongs to a container and can't be given away alone"); + else cerrn(i, "is borrowed and can't be given away"); + return 0; +} +// child, owner on the stack (owner on top). write owner into the child's +// header and leave the child. a shared child keeps the owner it has. a null +// child's address is out of range and the store does not land. +// o3 code can't call own(), so this is own() inlined: skip the store when the +// child is shared (flag bit 8) and otherwise write the owner into the child's +// header word p[-2] +int o3own() { + int sk, st; + lit(1); op(O_PICK); lit(4); op(O_SUB); op(O_LD); lit(8); op(16); + sk = hole(); op(O_JZ); + op(O_DROP); + st = hole(); op(O_JMP); + setlit(sk, here); + lit(1); op(O_PICK); lit(2); op(O_SUB); op(O_SWAP); op(O_SWAP); op(O_ST); + setlit(st, here); + return 0; +} +// storing a child into container local p: emit the call that records the +// owner in the child's header. a growable array's elements live in its items +// object, so that is the owner there. +int emitown(int p) { + laddr(lslot[p]); op(O_LD); + // a []T's elements live in its items object + if (ltype[p][0] == TY_DYN) { + lit(2); + op(O_ADD); + op(O_LD); + } + if (o3on && !mdbg) o3own(); + else callname(s_own); + if (o3on && hasptr(xty) && !xstamp) { lit(xty); callname(s_fatten); } + return 0; +} +// a store of class rc into an lvalue of kind k (local or container index i) +int assigncheck(int k, int i, int rc) { + int st, j, r, js, bor; + bor = xbor; xbor = -1; + if (!fchk) return C_PLAIN; + j = -1; + if (rc >= C_VAR && tracked(rc - C_VAR)) j = rc - C_VAR; + if (j >= 0 && lstate[lroot(j)] == S_DEAD) { + cerrn(j, "used after it was given away"); + return C_PLAIN; + } + if (k == LV_LOCAL) { + st = lstate[i]; + if (isalias(i)) st = S_PLAIN; // a borrow isn't an owner; overwriting it drops the alias + if (j < 0 && rc != C_FRESH) { + if (!empty(st)) cerrn(i, "still owns an object; overwriting it would leak it"); + else if (bor >= 0) { lstate[i] = S_CHILD; lowner[i] = bor; lown[i] = 0; } + else lstate[i] = S_PLAIN; + return C_PLAIN; + } + if (!empty(st)) { + cerrn(i, "still owns an object; overwriting it would leak it"); + return C_PLAIN; + } + if (rc == C_FRESH) { + lstate[i] = S_M; + lused[i] = 0; + lown[i] = 1; + if (ltag[i] & 15) lstate[i] = ltag[i] & 15; + return C_PLAIN; + } + js = lstate[j]; + if (js == S_U && lhome[i] == lhome[j] - 1) { // handing a u object up one block + lstate[i] = S_M; + lused[i] = 0; + lown[i] = 1; + lstate[j] = S_DEAD; + luse(j); + if (ltag[i] & 15) lstate[i] = ltag[i] & 15; + return C_PLAIN; + } + if (js == S_U) { + cerrn(j, "is u; it can only be handed to a variable of the enclosing block, or returned"); + } + else cerrn(j, "is an owned object and can't be copied into another variable"); + return C_PLAIN; + } + if (k == LV_ELEM) { + r = lroot(i); + st = lstate[r]; + touch(i); + if (rc == C_FRESH) { emitown(i); return C_PLAIN; } + if (j < 0) return C_PLAIN; + js = lstate[j]; + if (js == S_CHILD) cerrn(j, "already belongs to a container"); + else if (js == S_BORROW) cerrn(j, "is borrowed and can't be stored"); + else if (st == S_BORROW) { + if (js == S_U) { + cerrn(j, "is u; it has to leave through the block above, not into a borrowed object"); + } + else { lstate[j] = S_DEAD; luse(j); emitown(i); } // storing it gives it away + } else if (js != st) cerrn(j, "its tag doesn't match its container's (both have to be m, u or d)"); + else if (lhome[j] < lhome[r]) cerrn(j, "lives in an outer block than the container it's stored into"); + else { lstate[j] = S_CHILD; lowner[j] = i; luse(j); emitown(i); } + return C_PLAIN; + } + // a global, or memory the analyzer doesn't track: the collector takes it + if (j >= 0) { + if (lstate[j] == S_D) { lstate[j] = S_DEAD; luse(j); } + else cerrn(j, "must be d to be stored in a global or in untracked memory (the collector takes it over)"); + } + return C_PLAIN; +} +// return c: an owned object (d, or u after u*x) goes up with the return, and the +// function's return is owned: declared with .u, or inferred from this return when +// the function has no .u (its callers compiled after this point see it). an m +// object is lent, not given, so returning it is an error, and so is a plain word +// from an owned function that was called before its body. +int retcheck(int c) { + int i; + if (!fchk) return 0; + i = -1; + if (c >= C_VAR && tracked(c - C_VAR)) i = c - C_VAR; + if (i >= 0 && lstate[lroot(i)] == S_DEAD) { cerrn(i, "used after it was given away"); return 0; } + if (i >= 0 && (lstate[i] == S_D || (lstate[i] == S_M && lown[i])) && (fret || finfer)) lstate[i] = S_U; // returning an owned object (a d object, or a local that owns one) gives it up, as u*x does + if (!fret && finfer && (c == C_FRESH || (i >= 0 && lstate[i] == S_U))) { + if (sflag[finsym] & F_EARLY) serrn(sname[finsym], "is called before its body, so its owned return can't be known there; declare the return type with .u"); + ssig[finsym] = ssig[finsym] | 1; // the return is owned: callers read it from the signature + sflag[finsym] = sflag[finsym] | F_RETOWN; + fret = 1; finfer = 0; + } + if (fret) { + if (i >= 0) { + if (lstate[i] == S_U) { lstate[i] = S_DEAD; luse(i); } + else cerrn(i, "has to be u to be returned"); + } + return 0; + } + if (c == C_FRESH) cerr("returns a new object; give the function a .u return type"); + else if (i >= 0) cerrn(i, "is owned and can't be returned from a function whose return type isn't .u"); + return 0; +} +// the last expression of a block expression +int handup(int c) { + int i; + if (!fchk) return C_PLAIN; + if (c == C_FRESH) return C_FRESH; + if (c < C_VAR || !tracked(c - C_VAR)) return C_PLAIN; + i = c - C_VAR; + if (lstate[i] == S_U && lhome[i] == fdepth) { lstate[i] = S_DEAD; luse(i); return C_FRESH; } + if (lstate[i] == S_U) cerrn(i, "only a u object of this block can be its value"); + else cerrn(i, "has to be u to be handed up as the block's value"); + return C_PLAIN; +} +// throw away an expression result, which is an error for a fresh object. +int discard(int c) { + if (c == C_FRESH) cerr("a new object (or a u result) can't be thrown away"); + else if (c >= C_VAR) touch(c - C_VAR); + xbor = -1; + return 0; +} + +// ---- types ---- +// types are a compiler primitive: records in the type area, hash-consed so +// the same type is always the same pointer and comparing types is comparing +// words. untyped code is typed word, which goes with anything. the records +// stay in memory after compiling, so programs can inspect them. +// t[0] kind t[1] size in words t[2] name t[3] n t[4] a t[5] b t[6] c t[7..] extra +// ptr: a = element arr: a = element, n = length +// fn: a = return type, n = parameter count, b = signature (u m d tags), extra = parameter types +// struct: n = field count (-1 until laid out), a = fields (name, type, offset), +// b = generic template, c = type arguments [n, t1, t2 ...] +// var: a type parameter, n = its index +// gen: a generic struct: n = parameter count, a = fields (name, type), b = field count, c = parameter names + + +// the type area is a bump allocator of its own (tytop .. R_TYEND). talloc +// hands out zeroed words, tnew makes a record and adds it to the list of all +// types (R_TY), and the constructors below look that list up first, which is +// the hash-consing: asking for the same pointer type twice returns the same +// record. the list is searched linearly, which is fine for the few hundred +// types a program has. +unchecked int talloc(int n) { + int p = tytop; + if (tytop + n > tyend) { + p = new(n + 16385); p[-4] = p[-4] | F_INTERNAL; p[0] = typeblocks; typeblocks = p; + p++; tytop = p; tyend = p + n + 16384; + } + tytop = tytop + n; + fill_w(p, 0, n); + return p; +} +// make a type record of the given kind, size and name in the type area. +word tnew(int kind, int size, int nm, int extra) { + word t = talloc(7 + extra); + t[0] = kind; t[1] = size; t[2] = nm; + if (ntl >= typecap) { typelist = chk_resize(typelist, ntl, typecap * 2); typecap = typecap * 2; } + typelist[ntl] = t; ntl++; + return t; +} +// the pointer type to type e, reused when it already exists. +word tptr(int e) { + int i = 0; word t; + while (i < ntl) { t = typelist[i]; if (t[0] == TY_PTR && t[4] == e) return t; i++; } + t = tnew(TY_PTR, 1, 0, 0); t[4] = e; + return t; +} +// sized integers (i8 u8 i16 u16 i32 u32) are TY_INT records with t[5] = bytes, +// t[6] bit 0 = signed, and t[4] = the "packed view" twin: the same name with +// t[6] bit 1 set. a variable, parameter or field of a sized type is an +// ordinary word that is cut to size whenever it is stored. an element of an +// array or a pointer of a sized type is stored packed, 8, 4 or 2 to a word, +// and indexing yields the twin, whose lvalue is a byte address. +word tbytes(word t) { if (t[0] == TY_INT || t[0] == TY_FLOAT) return t[5]; return 0; } +// true for a packed integer or float type. +word ispk(word t) { return (t[0] == TY_INT || t[0] == TY_FLOAT) && (t[6] & 2); } +// the type a packed type stores its elements as, or the type itself. +word tpk(word t) { if ((t[0] == TY_INT || t[0] == TY_FLOAT) && t[4]) return t[4]; return t; } +// an enhancement used by the compiler itself, inline when the runtime has it +int xenh(int name) { + int s = lookup(intern(name)); + if (s >= 0 && skind[s] == K_ENH) { op(XOP0 + sval[s]); return 0; } + callname(intern(name)); + return 0; +} +// words an array of n elements of e takes: packed for a sized integer +word tasz(word e, int n) { + if (tbytes(e)) return (n * e[5] + 7) >> 3; + return n * tsz(e); +} +// the fixed array type of n elements of type e, reused when it already exists. +word tarr(int e, int n) { + int i = 0; word t; + while (i < ntl) { t = typelist[i]; if (t[0] == TY_ARR && t[4] == e && t[3] == n) return t; i++; } + t = tnew(TY_ARR, tasz(e, n), 0, 0); t[4] = e; t[3] = n; + return t; +} +// a sized integer type and its packed twin +word tsized(int name, int bytes, int sgn) { + word t = tnew(TY_INT, 1, intern(name), 0), twin = tnew(TY_INT, 1, t[2], 0); + t[5] = bytes; t[6] = sgn; t[4] = twin; + twin[5] = bytes; twin[6] = sgn | 2; + addsym(t[2], K_TYPE, t); + return t; +} +// the function type with this return, parameter list and signature. +word tfn(int ret, int np, word ps, int sig) { + int i = 0, j; word t; + while (i < ntl) { + t = typelist[i]; + if (t[0] == TY_FN && t[4] == ret && t[3] == np && t[5] == sig) { + j = 0; while (j < np && t[7 + j] == ps[j]) j++; + if (j == np) return t; + } + i++; + } + t = tnew(TY_FN, 1, 0, np); t[4] = ret; t[3] = np; t[5] = sig; + copy_w(t + 7, ps, np); + return t; +} +// []T, or fixed []T +word tdyn(int e, int f) { + int i = 0; word t; + while (i < ntl) { t = typelist[i]; if (t[0] == TY_DYN && t[4] == e && t[3] == f) return t; i++; } + t = tnew(TY_DYN, 1, 0, 0); t[4] = e; t[3] = f; + return t; +} +// the type variable with index i, reused when it already exists. +word tvar(int i, int nm) { + int k = 0; word t; + while (k < ntl) { t = typelist[k]; if (t[0] == TY_VAR && t[3] == i) return t; k++; } + t = tnew(TY_VAR, 1, nm, 0); t[3] = i; + return t; +} +// the instance of generic struct g with type arguments args[0..n). found if it +// already exists, otherwise created unlaid-out (n = -1), so that mentioning +// vec inside vec's own methods does not recurse; tresolve lays it out. +word tinst(word g, word args, int n) { + int i = 0, j; word t, v; + while (i < ntl) { + t = typelist[i]; + if (t[0] == TY_STRUCT && t[5] == g) { + v = t[6]; j = 0; while (j < n && v[1 + j] == args[j]) j++; + if (j == n) return t; + } + i++; + } + v = talloc(n + 1); v[0] = n; copy_w(v + 1, args, n); + t = tnew(TY_STRUCT, 0, g[2], 0); t[3] = -1; t[5] = g; t[6] = v; + return t; +} +// lay out a generic instance on first use +word tresolve(word t) { + word g, f; int n, i; word fs; int off = 0, ft; [8]word bs; + if (t[0] != TY_STRUCT || t[3] >= 0) return t; + if (t[3] == -2) { serr("a struct can't contain itself by value"); t[3] = 0; return t; } + t[3] = -2; + g = t[5]; n = g[5]; f = g[4]; + fill_w(bs, 0, 8); copy_w(bs, t[6] + 1, t[6][0]); + fs = talloc(n * 3 + 1); + i = 0; + while (i < n) { + ft = subst(f[i + i + 1], bs); + fs[i * 3] = f[i + i]; fs[i * 3 + 1] = ft; fs[i * 3 + 2] = off; + off = off + tsz(ft); + i++; + } + t[4] = fs; t[1] = off; t[3] = n; + return t; +} +// size of a type in words, laying out a generic instance first if it needs it +word tsz(word t) { + if (t[0] == TY_STRUCT && t[3] < 0) tresolve(t); + return t[1]; +} +// replace type parameters with what they were bound to (unbound ones become word) +word subst(word t, word bs) { + int k = t[0], i, n; [24]word v; word vec; + if (k == TY_VAR) { if (bs[t[3]]) return bs[t[3]]; return tword; } + if (k == TY_PTR) return tptr(subst(t[4], bs)); + if (k == TY_ARR) return tarr(subst(t[4], bs), t[3]); + if (k == TY_FN) { + n = t[3]; + i = 0; + while (i < n) { v[i] = subst(t[7 + i], bs); i++; } + return tfn(subst(t[4], bs), n, v, t[5]); + } + if (k == TY_STRUCT && t[5]) { + vec = t[6]; + n = vec[0]; + i = 0; + while (i < n) { v[i] = subst(vec[1 + i], bs); i++; } + return tinst(t[5], v, n); + } + return t; +} +// small type predicates. an array decays to a pointer to its element where a +// value is wanted, and telem is what indexing a pointer or array yields. +word isnum(word t) { return t[0] == TY_INT || t[0] == TY_CHAR || t[0] == TY_BOOL; } +// true for an aggregate type: an array or a struct. +word isagg(word t) { return t[0] == TY_ARR || t[0] == TY_STRUCT; } +// true for a pointer or an array type. +word isptr(word t) { return t[0] == TY_PTR || t[0] == TY_ARR; } +// the pointer an array type turns into when used as a value. +word decay(word t) { + if (t[0] == TY_ARR) return tptr(t[4]); + return t; +} +// the element type of a pointer or array, or word for anything else. +word telem(word t) { + if (t[0] == TY_PTR || t[0] == TY_ARR) return t[4]; + return tword; +} +// can a value of type src go where dst is expected? +// type compatibility, used by the optional typechecker. word is compatible with +// everything (untyped code stays legal), numbers convert freely, pointers need +// the same element unless one side is untyped or void, and a literal 0 is a +// null pointer. +word compat(word dst, word src) { + if (dst == src || dst == tword || src == tword) return 1; + if (dst[0] == TY_PTR && src[0] == TY_STRUCT && dst[4] == src) return 1; // an in-place struct supplies its address + if (isen(dst) || isen(src)) { // an enum takes only its own enum; an enum still becomes an int + if (isen(dst) && isen(src)) return dst == src; + if (isen(dst)) return 0; + } + if (isnum(dst) && isnum(src)) return 1; + if (isfl(dst) && isfl(src)) return 1; + src = decay(src); + if (dst[0] == TY_PTR && src[0] == TY_PTR) { + if (dst[4] == tword || src[4] == tword || dst[4] == tvoid || src[4] == tvoid) return 1; + return dst[4] == src[4]; + } + if ((dst[0] == TY_PTR || dst[0] == TY_FN || dst[0] == TY_DYN) && xzero) return 1; // a literal 0 is a null pointer + if (dst[0] == TY_DYN && src[0] == TY_DYN && dst[4] == src[4]) return dst[3] || !src[3]; // a growable array can't hold a fixed one + return dst == src; +} +// match pattern type p (which may contain type parameters) against actual type +// a, filling the bindings bs. this is how a call to a generic function infers +// T from its arguments. +word unify(word p, word a, word bs) { + int i, n; word pv, av; + if (p[0] == TY_VAR) { i = p[3]; if (!bs[i]) { bs[i] = a; return 1; } return compat(bs[i], a); } + a = decay(a); + if (p[0] == TY_PTR && a[0] == TY_PTR) { if (a[4] == tword) return 1; return unify(p[4], a[4], bs); } + if (p[0] == TY_STRUCT && p[5] && a[0] == TY_STRUCT && a[5] == p[5]) { + pv = p[6]; av = a[6]; n = pv[0]; i = 0; + while (i < n) { if (!unify(pv[1 + i], av[1 + i], bs)) return 0; i++; } + return 1; + } + return compat(p, a); +} +// print a type the way it is written in source. a pointer to an array or a +// function has no source spelling (T* would read as an array of pointers; give +// it a type alias), so it prints with a leading star for the reader's benefit. +word tprint(word t) { + int k = t[0], i; word v; + if (k == TY_PTR) { // T*; a pointer to an array or a function keeps the prefix form, since T* would read as an array of pointers + v = t[4][0]; + if (v == TY_ARR || v == TY_DYN || v == TY_FN) { put_c('*'); return tprint(t[4]); } + tprint(t[4]); put_c('*'); + return 0; + } + if (k == TY_DYN) { if (t[3]) put_s("fixed "); put_s("[]"); return tprint(t[4]); } + if (k == TY_ARR) { put_c('['); put_n(t[3]); put_c(']'); return tprint(t[4]); } + if (k == TY_FN) { + if (t[4] == tword) put_s("fn"); else tprint(t[4]); + if (t[5] & 1) put_s(".u"); + put_c('('); + i = 0; + while (i < t[3]) { + if (i) put_s(", "); + tprint(t[7 + i]); + if (i < 12 && tparamtag(t, i) == 1) put_s(".m"); + if (i < 12 && tparamtag(t, i) == 2) put_s(".d"); + i++; + } + put_c(')'); + return 0; + } + if (t[2]) put_s(t[2]); else put_s("?"); + if (k == TY_STRUCT && t[5]) { + v = t[6]; put_c('<'); + i = 0; while (i < v[0]) { if (i) put_s(", "); tprint(v[1 + i]); i++; } + put_c('>'); + } + return 0; +} +// typechecker errors. they only fire when "typecheck on" is set, in reachable +// code, and never during a dry run. +int tcerr(int what, int want, int got) { + if (!tc_on || !live || dry || panic) return 0; + errat(); put_s("type error: "); put_s(what); + put_s(": expected "); tprint(want); put_s(", got "); tprint(got); + errend(); + return 0; +} +// report a type error when ok is false, showing the type it got. +int tcneed(int ok, int what, int got) { + if (ok || !tc_on || !live || dry || panic) return 0; + errat(); put_s("type error: "); put_s(what); put_s(", got "); tprint(got); + errend(); + return 0; +} +// the type parameters in scope (tpn): a generic function or struct body sees +// T as a type. istypename says whether a name starts a type here, which is how +// the parser tells a declaration from an expression. +int tpfind(int n) { + int i = ntp; + while (i) { + i--; + if (tpn[i] == n) return i; + } + return -1; +} +// true when the name n is a type, a type parameter or a generic type. +word istypename(int n) { + int s; + if (n == s_fixed) return 1; + if (ginst && gfind(n) >= 0) return 1; + if (tpfind(n) >= 0) return 1; + if (findloc(n) >= 0) return 0; + s = lookup(n); + return s >= 0 && skind[s] == K_TYPE; +} +// the closing > of a type argument list; splits >> in two +int closeangle() { + if (is_op(s_shr)) { tv = s_gt; return 0; } + expect(s_gt); + return 0; +} +// a type, then any number of (params) after it: int(int, int) is a function +// returning int, fn(int) one returning a plain word +// ---- parsing types ---- +// grammar, outermost first: +// ptype a type, then any number of (params): int(int, int) is a function type +// ptype0 a type with its postfix stars: int*, vec*, point** +// ptype1 a base: [n]T, []T, fixed []T, a type name, or a generic instance +// the first thing in ptype's comment applies here too: fn(int) is a function +// returning a plain word. +int ptype() { + int start = toff, t = ptype0(), np; [24]word ps; + while (is_op(s_lp)) { + next(); np = 0; + if (!is_op(s_rp)) { + while (1) { + if (np >= 24) fatal("too many parameters"); + ps[np] = ptype(); + np++; + if (!accept(s_comma)) break; + } + } + expect(s_rp); + t = tfn(t, np, ps, np + np); + } + ht_note(start, toff, t); + return t; +} +// a type with any stars after it: int*, vec*, point** +int ptype0() { + int t = ptype1(); + while (is_op(s_star)) { next(); t = tptr(t); } + return t; +} +// parse one type with no trailing function parts. +word ptype1() { + int n, s; word t; [8]word args; int na = 0, i; + if (accept(s_lk)) { + if (accept(s_rk)) { // []T: grows + t = ptype0(); + return tdyn(t, 0); + } + n = cexpr(); + expect(s_rk); + t = ptype0(); + if (n < 0) serr("a negative array length"); + return tarr(t, n); + } + if (is_id(s_fixed)) { // fixed []T can't grow; fixed [n]T says what [n]T already means + next(); t = ptype0(); + if (t[0] == TY_DYN) return tdyn(t[4], 1); + if (t[0] != TY_ARR) serr("only arrays can be fixed"); + return t; + } + if (is_id(s_fn)) { + next(); + if (!is_op(s_lp)) die("fn as a type needs its parameters: fn(int)"); + return tword; + } + if (tk != T_ID) { diefound("expected a type"); return tword; } + n = tv; + if (ginst) { + i = gfind(n); + if (i >= 0) { next(); return gib[i]; } + } + i = tpfind(n); + if (i >= 0) { next(); return tvar(i, n); } + s = lookup(n); + // T in T first(...) + if (tvauto && (s < 0 || skind[s] != K_TYPE) && ntp < 8) { + tpn[ntp] = n; + lsmark(2, n); + ntp++; + next(); + return tvar(ntp - 1, n); + } + if (s < 0 || skind[s] != K_TYPE) { dien(n, "isn't a type"); return tword; } + next(); + t = sval[s]; + if (t[0] != TY_GEN) return t; + expect(s_lt); + while (1) { + if (na >= 8) die("too many type arguments"); + args[na] = ptype(); + if (args[na] == tvoid) serr("a type argument can't be void"); + na++; + if (!accept(s_comma)) break; + } + closeangle(); + if (na != t[3]) serrn(n, "wrong number of type arguments"); + return tinst(t, args, na); +} +// does a declaration start here? (a type, or a bare .tag) +// does a declaration start at the current token? (a type name, [, or a bare .tag) +int tstart() { + if (tk == T_OP) { + if (tv == s_lk || tv == s_dot) return 1; + return 0; + } + if (tk != T_ID) return 0; + if (tv == s_fn) return 1; + if (!istypename(tv)) return 0; + // Type.name(...) at the start of a statement is a static call, not a declaration: + // a declaration's dot is followed by a tag, u, m or d + peekat(0); + if (pk_tk == T_OP && pk_tv == s_dot) { + peekat(1); + if (pk_tk == T_ID && pk_tv != s_u && pk_tv != s_m && pk_tv != s_d) return 0; + } + return 1; +} +// [type] [.tag] +// parse a declaration's [type] [.tag] into dty and dtag +int dtype() { + dty = 0; dtag = 0; + if (!is_op(s_dot)) dty = ptype(); + if (accept(s_dot)) { + if (tv == s_m) { + dtag = S_M; + } else if (tv == s_u) { + dtag = S_U; + } else if (tv == s_d) dtag = S_D; else die("a tag is .u, .m or .d"); + next(); + } + return 0; +} +// struct name { type field, ... } or struct name { ... } +// the struct keyword. fields go in a scratch buffer first (name, type pairs), +// then are laid out: each field takes tsz(type) words, so offsets are words. +// methods are collected as token lists while the struct is read (grabfn) and +// compiled only when the struct is complete, so a method can use every field +// and call its siblings. a generic struct keeps its fields unresolved and +// can't have methods; each instance is laid out later by tresolve. +int kw_struct() { + int n; word t; int s, nf = 0; word buf = chk_resize(0, 0, 64); int bufcap = 64, i; word fs; int off = 0, gen = 0, ft, nm = 0, mcap = STRUCT_METHODS; word mn = chk_resize(0, 0, mcap), mq = chk_resize(0, 0, mcap), mst = chk_resize(0, 0, mcap), mty = chk_resize(0, 0, mcap), mrt = chk_resize(0, 0, mcap), mrg = chk_resize(0, 0, mcap); int bo, k, stat = 0, fname = 0; + next(); + n = name(); + if (is_op(s_lt)) { // generic + next(); ntp = 0; + while (1) { + if (ntp >= 8) die("too many type parameters"); + tpn[ntp] = name(); + lsmark(2, tpn[ntp]); + ntp++; + if (!accept(s_comma)) break; + } + closeangle(); + gen = 1; + t = tnew(TY_GEN, 0, n, 0); t[3] = ntp; + fs = talloc(ntp); copy_w(fs, tpn, ntp); t[6] = fs; + } else { t = tnew(TY_STRUCT, 0, n, 0); t[3] = -2; } // -2 while its fields are read + s = addsym(n, K_TYPE, t); + expect(s_lb); + while (!is_op(s_rb)) { + if (tk == T_EOF) { die("missing }"); break; } + stat = 0; + if (is_id(s_static)) { // static fn name(params) { body }, or static T name(params) { body }: a function of the struct, called as Struct.name(args), with no this + next(); + stat = 1; + } + if (is_id(s_fn)) { // fn name(params) { body }: a method, compiled once the struct is complete + next(); + if (nm >= mcap) { + mcap = mcap * 2; mn = chk_resize(mn, nm, mcap); mq = chk_resize(mq, nm, mcap); + mst = chk_resize(mst, nm, mcap); mty = chk_resize(mty, nm, mcap); + mrt = chk_resize(mrt, nm, mcap); mrg = chk_resize(mrg, nm, mcap); + } + mn[nm] = name(); + mst[nm] = stat; + mq[nm] = grabfn(); + mty[nm] = 0; + k = methdecl(n, mn[nm]); + if (stat) sflag[k] = sflag[k] | F_STATIC; + nm++; + continue; + } + // let x, y; fields are plain words + fname = 0; + if (is_id(s_var)) { + if (stat) die("static must be followed by fn or a typed method"); + next(); + ft = tword; + } else { + // T name(params) { body } is a typed method; T name, ...; is a typed field + rettype(); + fname = name(); + if (is_op(s_lp)) { + if (nm >= mcap) { + mcap = mcap * 2; mn = chk_resize(mn, nm, mcap); mq = chk_resize(mq, nm, mcap); + mst = chk_resize(mst, nm, mcap); mty = chk_resize(mty, nm, mcap); + mrt = chk_resize(mrt, nm, mcap); mrg = chk_resize(mrg, nm, mcap); + } + mn[nm] = fname; + mst[nm] = stat; + mq[nm] = grabfn(); + mty[nm] = 1; mrt[nm] = dty; mrg[nm] = dtag == S_U; + if (dtag && dtag != S_U) serr("the only return tag is .u"); + k = methdecl(n, fname); + if (stat) sflag[k] = sflag[k] | F_STATIC; + nm++; + continue; + } + if (stat) die("static must be followed by fn or a typed method"); + if (dtag) serr("a field has no tag"); + ft = dty; + } + while (1) { + if ((nf + 1) * 2 > bufcap) { buf = chk_resize(buf, nf * 2, bufcap * 2); bufcap = bufcap * 2; } + if (fname) { buf[nf + nf] = fname; fname = 0; } else buf[nf + nf] = name(); + lsmark(3, buf[nf + nf]); buf[nf + nf + 1] = ft; + field_note(t, buf[nf + nf], nameoff); lt_note(nameoff, ft); rs_put(nameoff, RS_FIELD, nameoff, 0); nf++; + if (!accept(s_comma)) break; + } + expect(s_semi); + } + next(); + if (gen) { + fs = talloc(nf + nf); copy_w(fs, buf, nf + nf); + t[4] = fs; t[5] = nf; + mdg = ntp; copy_w(mdn, tpn, ntp); + ntp = 0; + } else { + fs = talloc(nf * 3 + 1); + i = 0; + bo = 0; + while (i < nf) { + ft = buf[i + i + 1]; + if (ft == t) { serr("a struct can't contain itself by value; use a pointer"); ft = tword; } + fs[i * 3] = buf[i + i]; fs[i * 3 + 1] = ft; + // a sized field packs into the current word at its own alignment; its + // offset is recorded as minus (byte offset + 1). anything else starts a word + k = tbytes(ft); + if (k) { bo = (bo + k - 1) / k * k; fs[i * 3 + 2] = 0 - bo - 1; bo = bo + k; } + else { bo = (bo + 7) / 8 * 8; fs[i * 3 + 2] = bo / 8; bo = bo + tsz(ft) * 8; } + i++; + } + off = (bo + 7) / 8; + t[4] = fs; t[1] = off; t[3] = nf; + } + accept(s_semi); + i = 0; + while (i < nm) { methdef(n, mn[i], mq[i], mst[i], mty[i], mrt[i], mrg[i]); i++; } + mdg = 0; + return s; +} +// ---- methods ---- +// a method is an ordinary function named Struct.name whose first parameter is +// this, a pointer to the struct. e.method(a) calls Struct.name(e, a). the +// receiver's struct comes from its type, or, for an untyped word, from the +// one struct that has a method of that name. +// the symbol for a method is the interned string "Struct.name" +word methname(word sn, word mn) { + word b = chk_resize(0, 0, len_w(sn) + len_w(mn) + 2); int i = 0, j = 0; + while (sn[j]) { b[i] = sn[j]; i++; j++; } + b[i] = '.'; i++; + j = 0; + while (mn[j]) { b[i] = mn[j]; i++; j++; } + b[i] = 0; + return intern(b); +} +// the method called n on struct type t, as a symbol index, or -1. methwhich +// (below) does the untyped version: search every struct for one with that +// method, which is unique or ambiguous (-2). +int methof(word t, int n) { + int s = lookup(methname(t[2], n)); + if (s >= 0 && skind[s] == K_FN) return s; + return 0 - 1; +} +// the one method called n, -1 for none, -2 for several structs having one +int methscan(int n) { + int i = 0; word t; int s, hit = 0 - 1; + while (i < ntl) { + t = typelist[i]; + if (t[0] == TY_STRUCT && t[3] >= 0) { + s = methof(t, n); + if (s >= 0) { if (hit >= 0) return 0 - 2; hit = s; } + } + i++; + } + return hit; +} +// declare Struct.name now, so methods can call each other in any order +// (the declaration is what makes mutual recursion between methods work: the +// symbol exists with no body yet, and calls to it go on the patch chain) +int methdecl(int sn, int mn) { + int nm = methname(sn, mn), s = lookup(nm); + if (s >= ubase && s >= 0 && skind[s] == K_FN) { + serrn(mn, "is defined twice in this struct"); + return s; + } + s = addsym(nm, K_FN, 0); + sflag[s] = 0; + return s; +} +// the tokens of a method, from its ( to the } that closes its body, as a token list +// a method body is not parsed when the struct is read. its tokens are copied +// into a token list (kind, value, place triples) up to the matching brace, and +// methdef replays them later. the place travels with each token, so errors +// inside a method still point at the right line. +unchecked word grabfn() { + int cap = 768; word q = new(cap); int n = 0, depth = 0; word nq; + q[0] = 0; + if (!is_op(s_lp)) { die("expected ( after the method name"); return q; } + while (tk != T_EOF) { + if (n * 3 + 4 > cap) { + nq = new(cap + cap); + copy_w(nq, q, cap); + free(q); + q = nq; + cap = cap + cap; + } + q[1 + n * 3] = tk; q[2 + n * 3] = tv; q[3 + n * 3] = tpack(); n++; + if (is_op(s_lb)) depth++; + else if (is_op(s_rb)) { depth--; if (depth <= 0) { next(); break; } } + next(); + } + if (tk == T_EOF && depth > 0) die("missing } at the end of a method"); + q[0] = n; + return q; +} +// compile a method by feeding the parser fn Struct.name(Struct* this, rest...) +// build the token list "fn Struct.name ( Struct* this , rest..." from the +// method's saved tokens, push it as an input source and parse it as an +// ordinary top-level function. a method is therefore just a function whose +// first parameter is this; nothing else about it is special. +unchecked int tkput(word r, int k, int kind, int val, int pl) { + r[1 + k * 3] = kind; r[2 + k * 3] = val; r[3 + k * 3] = pl; + return k + 1; +} +// compile a struct method once the struct is complete. +unchecked int methdef(int sn, int mn, word q, int stat, int typed, int rty, int rtag) { + int n = q[0]; word r; int i, k = 0, lnp; + if (!n) { free(q); return 0; } + r = new((n + 8 + mdg * 4) * 3 + 1); + lnp = q[3]; + r[1] = T_ID; r[2] = s_fn; r[3] = lnp; k = 1; + r[1 + k * 3] = T_ID; r[2 + k * 3] = methname(sn, mn); r[3 + k * 3] = lnp; k++; + if (mdg) { // a method of a generic struct is a generic function over the struct's parameters: fn S.m(S* this, ...) + k = tkput(r, k, T_OP, s_lt, lnp); + i = 0; + while (i < mdg) { + if (i) k = tkput(r, k, T_OP, s_comma, lnp); + k = tkput(r, k, T_ID, mdn[i], lnp); + i++; + } + k = tkput(r, k, T_OP, s_gt, lnp); + } + r[1 + k * 3] = q[1]; r[2 + k * 3] = q[2]; r[3 + k * 3] = q[3]; k++; + if (stat && mdg) die("a static function can't be in a generic struct"); + if (!stat) { + r[1 + k * 3] = T_ID; r[2 + k * 3] = sn; r[3 + k * 3] = lnp; k++; + if (mdg) { + k = tkput(r, k, T_OP, s_lt, lnp); + i = 0; + while (i < mdg) { + if (i) k = tkput(r, k, T_OP, s_comma, lnp); + k = tkput(r, k, T_ID, mdn[i], lnp); + i++; + } + k = tkput(r, k, T_OP, s_gt, lnp); + } + r[1 + k * 3] = T_OP; r[2 + k * 3] = s_star; r[3 + k * 3] = lnp; k++; + r[1 + k * 3] = T_ID; r[2 + k * 3] = s_this; r[3 + k * 3] = lnp; k++; + } + if (!stat && n > 1 && !(q[1 + 3] == T_OP && q[2 + 3] == s_rp)) { + r[1 + k * 3] = T_OP; + r[2 + k * 3] = s_comma; + r[3 + k * 3] = lnp; + k++; + } + i = 1; + while (i < n) { + r[1 + k * 3] = q[1 + i * 3]; + r[2 + k * 3] = q[2 + i * 3]; + r[3 + k * 3] = q[3 + i * 3]; + k++; + i++; + } + r[0] = k; + free(q); + src_push(1, r, 0, 1); + next(); + if (typed) { + // a typed method: skip the fn and the name, then compile from the ( with the declared return type + if (mdg) die("a typed method of a generic struct is not supported yet"); + next(); + next(); + ifkp = tpack(); ifkk = 0 - 1; if (isp != 0) ifkk = 0; + o3nxt = 0; ntp = 0; + fndone(fndef(1, rty, rtag, methname(sn, mn)), 0); + } else topitem(); + if (tk != T_EOF) die("unexpected tokens after a method"); + src_pop(); + return 0; +} +// the call e.m(args): the receiver is on the stack and becomes this +// e.m(args): by now the receiver is on the stack, so it simply becomes the +// first argument. the call is checked against the method's signature if it +// has been compiled, and its result class is fresh if the method returns .u. +int methcall(int s, word rst) { + af_forget(); + int np, tags = 0, ret = 0; word ft = stype[s]; [8]word bs; + if (sflag[s] & F_SIG) { tags = ssig[s] >> 6; ret = ssig[s] & 1; } + else sflag[s] = sflag[s] | F_UNTYPED; + if (sflag[s] & F_RETOWN) ret = 1; + fill_w(bs, 0, 8); + if ((sflag[s] & F_GEN) && ft && rst && rst[0] == TY_STRUCT) unify(ft[7], tptr(rst), bs); // a method of a generic struct: the receiver says what its parameters are + np = args(tags >> 2, 0, bs, 0) + 1; + if ((sflag[s] & F_SIG) && np != ((ssig[s] >> 1) & 31)) serrn(sname[s], "wrong number of arguments"); + if (sflag[s] & F_GEN) s = ginstance(s, bs); + fnref(s); op(O_CALL); + lv = 0; + lvk = LV_NONE; + xzero = 0; + xbor = -1; + xconst = 0; + xfloat = 0; + xstr = 0; + xlenloc = -1; + xstamp = 0; + xty = tword; + if (ft) xty = subst(ft[4], bs); + if (isfl(xty)) xfloat = 1; + if (ret) return C_FRESH; + return C_PLAIN; +} +// type name = T; +// the type keyword makes an alias, which is also how a pointer to an array or +// function type gets a name. +int kw_type() { + int n; + next(); + n = name(); + expect(s_eq); + addsym(n, K_TYPE, ptype()); + expect(s_semi); + return 0; +} +// (T) or (T*) ahead of the current '(', within the lookahead we have +// the parser sees ( and has to decide between a parenthesized expression and a +// cast. a cast is ( type stars ) so peek ahead through the stars to the ). +int caststart() { + int k; + peek(); + if (pk_tk == T_ID && (istypename(pk_tv) || pk_tv == s_fn)) { + k = 1; peekat(k); + while (pk_tk == T_OP && pk_tv == s_star && k < 3) { k++; peekat(k); } // (int*)x, (node**)x + return pk_tk == T_OP && pk_tv == s_rp; + } + return 0; +} +// memdebug on; checks and interior pinning. memdebug scrub; also poisons frees. +// memdebug off; stops both. at the top level, start() applies it before main. +// ---- statements that only configure the compiler ---- +int kw_memdebug() { + int f = 0; + stmtonly(); + next(); + if (is_id(s_on)) { mdbg = 1; f = 5; } + else if (is_id(s_scrub)) { mdbg = 1; f = 7; } + else if (is_id(s_off)) { mdbg = 0; f = 0; } + else die("memdebug on, memdebug scrub or memdebug off"); + next(); + expect(s_semi); + if (infn) { lit(f); callname(s_memset); op(O_DROP); } + else mdbg_flags = f; + return 0; +} +// enum name { A, B = 5, C }; the names are global constants, the name is an int type +// the type of an enum: an int record that the typechecker keeps apart from the +// plain ints. t[6] bit 4 marks it; the members carry it in stype +word tenum(int n) { word t = tnew(TY_INT, 1, n, 0); t[6] = 16; return t; } +// true for a type made by an enum declaration. +word isen(word t) { return t[0] == TY_INT && (t[6] & 16); } +// enum name { A, B = 5 }: each member is a constant, plain (A) and scoped (name.A) +// member records for tagged enums and for plain enums (pm_en is -1 for a plain +// member). a member's payload fields are at most 8. +// the text a tagged enum or an extern stub is generated into +[GENERATED_WORDS]word ebuf_initial; word ebuf = ebuf_initial; int ebcap = GENERATED_WORDS, ebn; +[ENUM_MEMBERS]word pm_name_initial, pm_en_initial, pm_tag_initial, pm_nf_initial, pm_val_initial, pm_exp_initial; +word pm_name = pm_name_initial, pm_en = pm_en_initial, pm_tag = pm_tag_initial, pm_nf = pm_nf_initial, pm_val = pm_val_initial, pm_exp = pm_exp_initial; int pmcap = ENUM_MEMBERS, npm; +[ENUM_MEMBERS * 8]word pm_fnm_initial, pm_ft_initial, pm_off_initial; +word pm_fnm = pm_fnm_initial, pm_ft = pm_ft_initial, pm_off = pm_off_initial; +[TAGGED_ENUMS]word pe_st_initial, pe_first_initial, pe_n_initial, pe_name_initial; +word pe_st = pe_st_initial, pe_first = pe_first_initial, pe_n = pe_n_initial, pe_name = pe_name_initial; int pecap = TAGGED_ENUMS, npe; +// grow whole member rows, keeping their payload-field indices stable. +int reserve_enum_members(int need) { + int cap = pmcap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + pm_name = chk_resize(pm_name, npm, cap); pm_en = chk_resize(pm_en, npm, cap); + pm_tag = chk_resize(pm_tag, npm, cap); pm_nf = chk_resize(pm_nf, npm, cap); + pm_val = chk_resize(pm_val, npm, cap); pm_exp = chk_resize(pm_exp, npm, cap); + pm_fnm = chk_resize(pm_fnm, npm * 8, cap * 8); pm_ft = chk_resize(pm_ft, npm * 8, cap * 8); pm_off = chk_resize(pm_off, npm * 8, cap * 8); + pmcap = cap; return cap; +} +// grow the tagged-enum index independently of its member rows. +int reserve_tagged_enums(int need) { + int cap = pecap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + pe_st = chk_resize(pe_st, npe, cap); pe_first = chk_resize(pe_first, npe, cap); + pe_n = chk_resize(pe_n, npe, cap); pe_name = chk_resize(pe_name, npe, cap); + pecap = cap; return cap; +} +// a field's c-like spelling in a generated struct +int ftext(int t) { if (t == tint) return "int"; if (t == tfloat) return "float"; return "let"; } +// the member named n of a tagged enum, or -1 +int pm_find(int n) { + int gi = npm - 1; + while (gi >= 0) { if (pm_name[gi] == n && pm_en[gi] >= 0) return gi; gi--; } + return -1; +} +// the tagged enum a type is a pointer to, plus one; 0 for any other type +int ptagged(word t) { + int e = 0; + if (!t || t[0] != TY_PTR) return 0; + while (e < npe) { if (t[4] == pe_st[e]) return e + 1; e++; } + return 0; +} +// enum name { A, B = 5 } is a plain enum: each member is a constant, plain (A) +// and scoped (name.A). a member with a block of fields makes it a tagged enum +// (see enum_tagged): enum name { circle { int r; }, dot }. +int kw_enum() { + int n, en = 0, first = npm, cnt = 0, tagged = 0, gi, nf, v = 0, et = 0, sk, ft, fname; + stmtonly(); + next(); + if (tk == T_ID) { en = tv; next(); } + expect(s_lb); + while (!is_op(s_rb)) { + if (tk == T_EOF) { die("missing }"); break; } + reserve_enum_members(npm + 1); + gi = npm; npm++; + n = name(); + pm_name[gi] = n; pm_tag[gi] = cnt; pm_nf[gi] = 0; pm_en[gi] = -1; pm_val[gi] = 0; pm_exp[gi] = 0; + if (is_op(s_lb)) { + tagged = 1; next(); + while (!is_op(s_rb)) { + if (tk == T_EOF) { die("missing }"); break; } + if (pm_nf[gi] >= 8) { fatal("too many fields in a member"); break; } + if (is_id(s_var)) { next(); ft = tword; } + else { rettype(); ft = dty; if (dtag) serr("a payload field has no tag"); } + if (ft != tint && ft != tfloat && ft != tword) serr("a payload field is int, float or let"); + fname = name(); + nf = gi * 8 + pm_nf[gi]; + pm_fnm[nf] = fname; pm_ft[nf] = ft; pm_nf[gi]++; + expect(s_semi); + } + expect(s_rb); + } else if (accept(s_eq)) { pm_val[gi] = cexpr(); pm_exp[gi] = 1; } + cnt++; + if (!accept(s_comma)) break; + if (is_op(s_rb)) break; + } + expect(s_rb); + expect(s_semi); + if (tagged) return enum_tagged(en, first, cnt); + if (en) { et = tenum(en); addsym(en, K_TYPE, et); } + for (gi = first; gi < npm; gi++) { + if (pm_exp[gi]) v = pm_val[gi]; + sk = addsym(pm_name[gi], K_CONST, v); + stype[sk] = et; + if (en) { sk = addsym(methname(en, pm_name[gi]), K_CONST, v); stype[sk] = et; } + v++; + } + return 0; +} +// a tagged enum: one struct, with the tag as word 0 and the fields of every +// member after it, each named member_field. a member's constructor is a static +// function on the enum, en.member(fields...), that allocates the struct, sets +// the tag and the member's fields, and returns it owned. the struct is generated +// as source and compiled here, so its methods are ordinary zc. +int enum_tagged(int en, int first, int cnt) { + int gi, j, nf, w = 1; word buf; int sk; + if (!en) { serr("a tagged enum needs a name"); return 0; } + reserve_tagged_enums(npe + 1); + if (cnt > 63) { fatal("a tagged enum has at most 63 members"); return 0; } + for (gi = first; gi < npm; gi++) if (pm_exp[gi]) serr("a tagged enum's members take no explicit values"); + ebn = 0; ebuf[0] = 0; + ebs("struct "); ebs(en); ebs(" { int tag; "); + for (gi = first; gi < npm; gi++) { + for (j = 0; j < pm_nf[gi]; j++) { + nf = gi * 8 + j; + pm_off[nf] = w; w++; + ebs(ftext(pm_ft[nf])); ebs(" "); ebs(pm_name[gi]); ebs("_"); ebs(pm_fnm[nf]); ebs("; "); + } + } + for (gi = first; gi < npm; gi++) { + ebs("static "); ebs(en); ebs("*.u "); ebs(pm_name[gi]); ebs("("); + for (j = 0; j < pm_nf[gi]; j++) { + nf = gi * 8 + j; + if (j) ebs(", "); + if (pm_ft[nf] == tint) ebs("int "); else if (pm_ft[nf] == tfloat) ebs("float "); + ebs(pm_fnm[nf]); + } + ebs(") { "); ebs(en); ebs("* o = new("); ebs(en); ebs("); o.tag = "); ebn10(pm_tag[gi]); ebs("; "); + for (j = 0; j < pm_nf[gi]; j++) { + nf = gi * 8 + j; + ebs("o."); ebs(pm_name[gi]); ebs("_"); ebs(pm_fnm[nf]); ebs(" = "); ebs(pm_fnm[nf]); ebs("; "); + } + ebs("return u*o; } "); + } + ebs("}"); + buf = new(ebn + 2); + copy_w(buf, ebuf, ebn + 1); + src_push(2, buf, 0, 0); + next(); + stubgen = 1; + while (tk != T_EOF) topitem(); + stubgen = 0; + src_pop(); + free(d*buf); + sk = lookup(en); + if (sk < 0 || skind[sk] != K_TYPE) { serr("the tagged enum didn't make its struct"); return 0; } + pe_st[npe] = sval[sk]; pe_first[npe] = first; pe_n[npe] = cnt; pe_name[npe] = en; + for (gi = first; gi < npm; gi++) { + pm_en[gi] = npe; + sk = addsym(pm_name[gi], K_CONST, pm_tag[gi]); + stype[sk] = 0; + } + npe++; + return 0; +} +// a switch over a tagged enum that leaves out a member, with no default, is a +// warning, on the line of the switch (sl). e is the enum, cov the bit set of +// the tags the switch covers. +int cover_warn(int e, int cov, int sl) { + int k, gi, first = 1; + if (dry || panic || cmode) return 0; + for (k = 0; k < pe_n[e]; k++) { + if (k < 63 && ((cov >> k) & 1)) continue; + if (first) { put_s("zc: line "); put_n(sl); put_s(": warning: this switch doesn't cover "); first = 0; } + else put_s(", "); + gi = pe_first[e] + k; + put_s(pm_name[gi]); + } + if (!first) put_c(10); + return 0; +} +// include "path"; reads the file and compiles it here, signatures first +int kw_include() { + int path, buf; + stmtonly(); + next(); + if (tk != T_STR) { die("include needs a string"); return 0; } + path = tv; + next(); + expect(s_semi); + buf = readfile(path); + if (!buf) { serr("can't read that include"); return 0; } + prescan(2, buf); + src_push(2, buf, 0, 0); + next(); + while (tk != T_EOF) topitem(); + src_pop(); + return 0; +} +// typecheck on; / typecheck off; +int kw_typecheck() { + next(); + if (is_id(s_on)) { + tc_on = 1; + } else if (is_id(s_off)) tc_on = 0; else die("typecheck on or typecheck off"); + next(); expect(s_semi); + return 0; +} +// docs on; keeps the doc comments of what follows in the image, docs off; stops +int kw_docs() { + next(); + if (is_id(s_on)) { + docs_on = 1; + } else if (is_id(s_off)) docs_on = 0; else die("docs on or docs off"); + next(); expect(s_semi); + return 0; +} +// the doc symbol of a name: the symbol "doc name" that holds its byte string, +// or -1. the chain is walked by hand because lookup hides what is below vislo +int docsym(word nm) { + int i, k = 0; word p = "doc "; + doc_name_room(len_w(nm) + 5); + while (p[k]) { dnmb[k] = p[k]; k++; } + i = 0; while (nm[i]) { dnmb[k] = nm[i]; k++; i++; } + dnmb[k] = 0; + nm = intern(dnmb); + i = nm[-1] - 1; + while (i >= 0) { + if (skind[i] == K_DOC) return i; + i = snext[i] - 1; + } + return -1; +} +// the packed documentation of a name (a byte string) or 0 +word docofs(int nm) { + int s = docsym(nm); + if (s < 0) return 0; + return sval[s]; +} +// the documentation of a function, by address +word docof(int f) { + int i = nsym; + while (i) { + i--; + if (skind[i] == K_FN && sval[i] == f && (sflag[i] & F_DEF)) return docofs(sname[i]); + } + return 0; +} +// documentation uses stable packed objects. symbols keep them alive until an +// image copies their bytes after its code; ordinary docofs calls work too. +word doc_pack(word text, int length) { + int i = 0, k, c, w, nw = (length + 7) >> 3; word p = chk_resize(0, 0, nw + 2); + p[-4] = p[-4] | F_SHARE | F_INTERNAL; p[0] = length; + while (i < length) { + w = 0; k = 0; + while (k < 8 && i < length) { c = text[i]; if (c > 255) c = 63; w = w | (c << (k * 8)); k++; i++; } + p[1 + ((i - 1) >> 3)] = w; + } + return p; +} +// attach the doc comment above a declaration at name n. +int doc_attach(word n) { + int i = 0, w, k, c, b, nw; + if (!dsn || !n || dry || ginst) return 0; + b = doc_pack(dsnap, dsn); + doc_name_room(len_w(n) + 5); + i = 0; while ("doc "[i]) { dnmb[i] = "doc "[i]; i++; } + k = 0; while (n[k]) { dnmb[i] = n[k]; i++; k++; } + dnmb[i] = 0; + addsym(intern(dnmb), K_DOC, b); + dsn = 0; + return 0; +} +// the signature of a function as source text, "int put_c(int ch)", kept in the +// image as the symbol "sig name" when docs are on, so the language server can +// show it for any genome function, with or without a doc comment. the text is +// printed through put_c with the output sent to sgb (the same redirect the +// check uses for a parse word that prints) +[400]word sgb_initial; word sgb = sgb_initial; int sigcap = 400; +int sig_print(word n, int rty, int np, word pn, word pty, int typed) { + int i = 0; + if (typed) { tprint(rty); put_c(' '); } else put_s("fn "); + put_s(n); put_c('('); + while (i < np) { + if (i) put_s(", "); + if (typed) { tprint(pty[i]); put_c(' '); } + put_s(pn[i]); i++; + } + put_c(')'); return 0; +} +// attach a complete signature, measured before capture. +int sig_attach(word n, int rty, int np, word pn, word pty, int typed) { + int i = 0, k, b, nw, sm, sb, sn, sc, sl, w, c; + if (!docs_on || dry || ginst || ntp || panic) return 0; + sm = outmode; sb = outbuf; sn = outn; sc = outcap; + outmode = 3; outn = 0; sig_print(n, rty, np, pn, pty, typed); + if (outn > sigcap) { while (outn > sigcap) sigcap = sigcap * 2; sgb = chk_resize(sgb, 0, sigcap); } + outmode = 2; outbuf = sgb; outn = 0; outcap = sigcap; + sig_print(n, rty, np, pn, pty, typed); + sl = outn; + outmode = sm; outbuf = sb; outn = sn; outcap = sc; + b = doc_pack(sgb, sl); + doc_name_room(len_w(n) + 5); + i = 0; while ("sig "[i]) { dnmb[i] = "sig "[i]; i++; } + k = 0; while (n[k]) { dnmb[i] = n[k]; i++; k++; } + dnmb[i] = 0; + addsym(intern(dnmb), K_DOC, b); + return 0; +} +// the field of a struct type, or -1 +// ---- built-ins that look like functions ---- +// sizeof and typeof take a type or an expression; the expression form is +// compiled with dry set so it contributes only its type. len, cap, push, pop +// and resize work on growable arrays ([]T handles in rt.zc); arrarg parses +// their first argument and remembers which local it was, so the o3 and +// bounds-proof machinery can see it. +int tfindfield(word t, int n) { + int i = 0; + tresolve(t); + while (i < t[3]) { + if (t[4][i * 3] == n) return i; + i++; + } + return -1; +} +// sizeof(T or expr), typeof(T or expr): the expression form is compiled dry, so it never runs +int typearg() { + int t, sb, c, ob; + expect(s_lp); + if (tstart() && !is_op(s_dot)) t = ptype(); + else { + sb = snap_push(); ob = xbor; dry++; + c = expr(); rval(); + t = xty; + dry--; xbor = ob; snap_restore(sb); snap_pop(sb); + } + expect(s_rp); + return t; +} +// len(a), cap(a), push(a, x), pop(a), resize(a, n): growable arrays. +// len of a [n]T is just n. +word arrarg() { + int c; + expect(s_lp); c = expr(); + argloc = -1; arrloc = -1; + if (lv && lvk == LV_LOCAL && xty[0] == TY_DYN) { + arrloc = lvi; + if (o3on && o3cache[lvi]) argloc = lvi; + } + rval(); plainuse(c); af_access(xaf, tpack()); + return xty; +} +// report an error when a fixed array is asked to grow or shrink. +int nogrow(word t) { + if (t[0] == TY_DYN && t[3]) serr("a fixed array can't grow or shrink"); + return 0; +} +// compile len(a): the length of an array. +int kw_len() { + word t; int a; + next(); t = arrarg(); a = arrloc; expect(s_rp); + if (xstr) { + callname(s_len_s); + xty = tint; + xstr = 0; + xfloat = 0; + xlenloc = -1; + xstamp = 0; + return 0; + } + if (t[0] == TY_ARR) { op(O_DROP); lit(t[3]); } + else { tcneed(t[0] == TY_DYN || t == tword, "len needs an array", t); if (argloc >= 0) { op(O_DROP); vaddr(o3cache[argloc] + 1); op(O_LD); } else if (o3on && t[0] == TY_DYN) op(O_LD); else callname(s_dlen); } + xty = tint; + xlenloc = -1; xstamp = 0; + if (a >= 0 && t[0] == TY_DYN && t[3]) xlenloc = a; // the whole expression is len of a fixed array + return 0; +} +// compile cap(a): the capacity of a growable array. +int kw_cap() { + word t; + next(); + t = arrarg(); + expect(s_rp); + tcneed(t[0] == TY_DYN || t == tword, "cap needs a []T", t); + callname(s_dcap); + xty = tint; + return 0; +} +// compile push(a, v): add an element to the end of a growable array. +int kw_push() { + word t; int c; + next(); t = arrarg(); af_escape(xaf); nogrow(t); + if (t[0] == TY_DYN && tsz(t[4]) != 1) serr("push takes one-word elements; use resize for structs"); + expect(s_comma); c = expr(); rval(); argcheck(c, 2); + if (t[0] == TY_DYN && !compat(t[4], xty)) tcerr("push", t[4], xty); + if (o3on && t[0] == TY_DYN && hasptr(t[4])) { lit(t[4]); callname(s_fatten); } + expect(s_rp); + if (t[0] == TY_DYN && tbytes(t[4])) { // packed: an f32 goes in as its 32 bits, the rest are cut by the store + if (isfl(t[4])) { if (!xfloat) op(OP_I2F); xenh("zf2s"); } + callname(intern("dpushb")); xty = tint; xfloat = 0; + return 0; + } + if (o3on && t[0] == TY_DYN && !hasptr(t[4]) && tsz(t[4]) == 1) { pushfast(); xty = tint; xfloat = 0; return 0; } + callname(s_dpush); xty = tint; + return 0; +} +// pop in o3 code, inline: a non-empty array gives up its last word, an empty one is dpop's report +int popfast() { + int k, e; + lit(0); op(O_PICK); op(O_LD); + k = hole(); op(O_JZ); + lit(0); op(O_PICK); op(O_LD); lit(1); op(O_SUB); lit(1); op(O_PICK); op(O_ST); + lit(0); op(O_PICK); op(O_LD); + lit(1); op(O_PICK); lit(2); op(O_ADD); op(O_LD); + op(O_ADD); op(O_LD); + op(O_SWAP); op(O_DROP); + e = hole(); op(O_JMP); + setlit(k, here); + callname(s_dpop); + setlit(e, here); + return 0; +} +// push of a plain one-word element in o3 code, inline: when len < cap the word goes +// straight into the items and len moves up, otherwise dpush grows the array +int pushfast() { + int k, e; + lit(1); op(O_PICK); op(O_LD); + lit(2); op(O_PICK); lit(1); op(O_ADD); op(O_LD); + op(O_LT); + k = hole(); op(O_JZ); + lit(1); op(O_PICK); lit(2); op(O_ADD); op(O_LD); + lit(2); op(O_PICK); op(O_LD); op(O_ADD); + op(O_ST); + lit(0); op(O_PICK); op(O_LD); lit(1); op(O_ADD); lit(1); op(O_PICK); op(O_ST); + op(O_DROP); lit(0); + e = hole(); op(O_JMP); + setlit(k, here); + callname(s_dpush); + setlit(e, here); + return 0; +} +// compile pop(a): remove and return the last element of a growable array. +int kw_pop() { + word t; + next(); + t = arrarg(); af_escape(xaf); + nogrow(t); + expect(s_rp); + if (t[0] == TY_DYN && tbytes(t[4])) { // packed: read zero extended, then sign extend or widen + callname(intern("dpopb")); + xty = t[4]; xfloat = 0; + pkfix(xty); + if (isfl(xty)) xfloat = 1; + return 0; + } + if (o3on && t[0] == TY_DYN && tsz(t[4]) == 1) popfast(); else callname(s_dpop); + xty = telem(t); + if (t[0] == TY_DYN) xty = t[4]; + xfloat = 0; + if (isfl(xty)) xfloat = 1; + return 0; +} +// compile resize(a, n): set the length of a growable array. +int kw_resize() { + word t; int c; + next(); + t = arrarg(); af_escape(xaf); + nogrow(t); + expect(s_comma); + c = expr(); + rval(); + plainuse(c); + expect(s_rp); + if (t[0] == TY_DYN && tbytes(t[4])) callname(intern("dresizeb")); else callname(s_dresize); + xty = tint; + return 0; +} +// compile sizeof(T) or sizeof(e): the size of a type or expression in words. +int kw_sizeof() { + int t; + next(); + t = typearg(); + lit(tsz(t)); + xty = tint; + return 0; +} +// compile typeof(e): the type of an expression, as a value. +int kw_typeof() { + int t; + next(); + t = typearg(); + lit(t); + xty = tword; + return 0; +} +// ---- c abi: extern and cfunc ---- +// extern double pow(double, double); or with parameter names, and an +// optional "= "cname"" to give the zc function another name than the c symbol. +// the declaration is read with c's spelling of types and turned into an +// ordinary zc function, so a call to it is a call like any other. the function +// fills a block of words that sits in the code stream (the symbol's name, the +// signature, a cache slot, then room for the arguments) and stores its arguments there, +// and gate op 14 makes the native call (see the c abi section of core.c). +// a signature is 4 bits per kind: the result, then each argument: +// 0 void 1 long 2 double 3 byte pointer 4 int 5 float 6 word pointer +// 7 unsigned int 8 short 9 unsigned short 10 char 11 unsigned char +// 12 str, a zc byte string (b"..."), given to c as the address of its bytes +// a double or float is a zc float. any pointer is a byte address (what +// addr_b(s + 1) gives for a byte string), except "word *", which is a word +// address (a zc object or array). native results come back the same way. +// append the string s to the text being generated for an extern stub. +int eb_char(int c) { + if (ebn + 2 > ebcap) { ebcap = ebcap * 2; ebuf = chk_resize(ebuf, ebn, ebcap); } + ebuf[ebn] = c; ebn++; ebuf[ebn] = 0; return 0; +} +int ebs(word s) { + while (*s) { eb_char(*s); s++; } + ebuf[ebn] = 0; + return 0; +} +// append the decimal digits of n to the generated text. +int ebn10(int n) { + if (n >= 10) ebn10(n / 10); + eb_char(48 + n % 10); + ebuf[ebn] = 0; + return 0; +} +// true for a c type keyword, like long, char or double. +int ctypeword(int w) { + return eq_w(w, "unsigned") || eq_w(w, "signed") || eq_w(w, "long") || eq_w(w, "short") || eq_w(w, "int") || eq_w(w, "char") || eq_w(w, "double") || eq_w(w, "float") || eq_w(w, "void") || eq_w(w, "const") || eq_w(w, "volatile"); +} +// a c type at the current token: its signature kind, or -1 after an error. +// skipname also eats a parameter name that follows. +// a plain zc struct a native call takes by value: every field is one word (a long, +// a double or a pointer), so word g of the struct is eightbyte g. returns its +// word count, or -1 after an error. +int cstruct_ok(word st, int nm) { + int i = 0, n; word ft; + tresolve(st); + n = st[1]; + if (st[0] != TY_STRUCT || st[5] || n < 1 || n > 15 || st[3] != n) { serrn(nm, "can't be passed by value to a native call: it needs one word fields, at most 15 words"); return 0 - 1; } + while (i < n) { + ft = st[4][i * 3 + 1]; + if (tbytes(ft) || tsz(ft) != 1 || ft[0] == TY_STRUCT || ft[0] == TY_ARR || st[4][i * 3 + 2] != i) { serrn(nm, "can't be passed by value to a native call: every field has to be one word (long, double or a pointer)"); return 0 - 1; } + i++; + } + return n; +} +// the native signature kind of the c type at the current token, or -1 after an error. +int ckind(int skipname) { + int w, uns = 0, lng = 0, shrt = 0, chr = 0, ints = 0, dbl = 0, flt = 0, vd = 0, other = 0, ptr = 0, seen = 0, k = -1, sw = 0, sk, nw; + ckst = 0; ckn = 0; + while (tk == T_ID) { + w = tv; + if (eq_w(w, "const") || eq_w(w, "volatile") || eq_w(w, "restrict")) { next(); continue; } + if (eq_w(w, "struct") || eq_w(w, "enum") || eq_w(w, "union")) { + next(); + if (tk == T_ID) { if (eq_w(w, "struct")) sw = tv; next(); } + other = 1; seen = 1; + continue; + } + if (seen && !ctypeword(w)) break; + if (eq_w(w, "unsigned")) uns = 1; + else if (eq_w(w, "signed")) ints = 1; + else if (eq_w(w, "long")) lng++; + else if (eq_w(w, "short")) shrt = 1; + else if (eq_w(w, "char")) chr = 1; + else if (eq_w(w, "int")) ints = 1; + else if (eq_w(w, "double") || eq_w(w, "f64")) dbl = 1; + else if (eq_w(w, "float") || eq_w(w, "f32")) flt = 1; + else if (eq_w(w, "void")) vd = 1; + else other = w; + seen = 1; + next(); + } + if (!seen) { die("expected a c type"); return 0 - 1; } + while (is_op(s_star)) { + ptr = 1; next(); + while (is_id(intern("const"))) next(); + } + if (skipname && tk == T_ID) next(); + if (ptr) { + if (other && other != 1 && eq_w(other, "word")) return 6; + return 3; + } + if (dbl) return 2; + if (flt) return 5; + if (vd) return 0; + if (chr) { if (uns) return 11; return 10; } + if (shrt) { if (uns) return 9; return 8; } + if (lng) return 1; + if (ints || uns) { if (uns) return 7; return 4; } + if (other == 1) { + if (!sw) { serr("a struct has to be passed by pointer"); return 0 - 1; } + sk = lookup(sw); + if (sk < 0 || skind[sk] != K_TYPE || sval[sk][0] != TY_STRUCT) { serrn(sw, "isn't a zc struct: a native call takes a zc struct by value, declared with word fields"); return 0 - 1; } + nw = cstruct_ok(sval[sk], sw); + if (nw < 0) return 0 - 1; + ckst = sval[sk]; ckn = sw; + if (nw <= 2) return 13; // in registers when they fit (sysv: 16 bytes or less) + return 14; // in memory: on the stack, word after word + } + if (eq_w(other, "str")) return 12; + if (eq_w(other, "size_t") || eq_w(other, "ssize_t") || eq_w(other, "intptr_t") || eq_w(other, "uintptr_t") || eq_w(other, "ptrdiff_t") || eq_w(other, "int64_t") || eq_w(other, "uint64_t") || eq_w(other, "off_t") || eq_w(other, "time_t") || eq_w(other, "word")) return 1; + if (eq_w(other, "int32_t") || eq_w(other, "i32")) return 4; + if (eq_w(other, "uint32_t") || eq_w(other, "u32")) return 7; + if (eq_w(other, "int16_t") || eq_w(other, "i16")) return 8; + if (eq_w(other, "uint16_t") || eq_w(other, "u16")) return 9; + if (eq_w(other, "int8_t") || eq_w(other, "i8")) return 10; + if (eq_w(other, "uint8_t") || eq_w(other, "u8") || eq_w(other, "byte") || eq_w(other, "bool") || eq_w(other, "_Bool")) return 11; + serrn(other, "isn't a c type extern knows (use long, int, double, a pointer, ...)"); + return 0 - 1; +} +// true for a native kind that travels in a float register. +int ckindfloat(int k) { return k == 2 || k == 5; } +// parse an extern declaration: a c function with its signature, and a zc stub for it. +unchecked int kw_extern() { + int rk; [16]word ks; [16]word kst; [16]word ksn; int np = 0, k, fname; word cname; int i, a, j, n, w, sig, bad = 0; word buf; int pos, len, g; word st, rst; int rn, rsd, sret = 0; + stmtonly(); + next(); + rk = ckind(0); + // a struct result: the stub makes it (new) and passes it as the first item; the + // call block's word 2 says how many words it has and which of them are floats + if (rk >= 13) { + sret = 1; rst = ckst; rn = ckn; + if (rst[1] > 7) { serr("a native call can return at most 7 words"); rk = 0 - 1; } + } + fname = name(); + cname = fname; + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + k = ckind(1); + if (k < 0) { bad = 1; break; } + if (k == 0 && np == 0 && is_op(s_rp)) break; // (void) + if (k == 0) { serr("a parameter can't be void"); bad = 1; break; } + if (np >= 15) { serr("a native call takes at most 15 arguments"); bad = 1; break; } + ks[np] = k; kst[np] = ckst; ksn[np] = ckn; np++; + if (!accept(s_comma)) break; + } + } + expect(s_rp); + if (accept(s_eq)) { + if (tk != T_STR) { die("expected the c name as a string"); return 0; } + cname = tv; + next(); + } + expect(s_semi); + if (bad || rk < 0 || panic) return 0; + if (sret && np > 14) { serr("a native call that returns a struct takes at most 14 arguments"); return 0; } + rsd = 0; + if (sret) { + rsd = rst[1]; g = 0; + while (g < rst[1]) { + if (rst[4][g * 3 + 1] == tfloat) rsd = rsd | (2 << (4 + 4 * g)); else rsd = rsd | (1 << (4 + 4 * g)); + g++; + } + } + // the block, then the name as packed bytes, then the block's own address + // (the word before the stub's entry, which is how a call site finds it): + // [0] the name's byte address, [1] the signature, [2] a lookup cache the + // host fills in, [3..17] the arguments, [18..] the name + // the arguments' nibbles: one per argument. a struct is a group: code 13 (in + // registers if they fit) or 14 (in memory), its length in eightbytes, then one + // class nibble per eightbyte (2 for a float word, 1 otherwise). the group is one + // stack item: the struct's address + sig = rk; + pos = 1; i = 0; + while (i < np) { + if (ks[i] < 13) { + sig = sig | (ks[i] << (4 * pos)); pos++; + } else { + st = kst[i]; len = st[1]; + if (pos + 1 + len > 15) { serr("the arguments of this native call are too many words"); return 0; } + sig = sig | (ks[i] << (4 * pos)); pos++; + sig = sig | (len << (4 * pos)); pos++; + g = 0; + while (g < len) { + if (st[4][g * 3 + 1] == tfloat) sig = sig | (2 << (4 * pos)); else sig = sig | (1 << (4 * pos)); + pos++; g++; + } + } + i++; + } + j = hole(); + op(O_JMP); + reserve_code(20 + (len_w(cname) >> 3)); a = here; + emit((a + 18) << 3); + emit(sig); + emit(rsd << 32); // the cache's half is the host's; this half is the result's descriptor + i = 3; + while (i < 18) { emit(0); i++; } + n = 0; + while (cname[n]) n++; + i = 0; + while (i < n) { + w = 0; k = 0; + while (k < 8 && i < n) { w = w | (cname[i] << (k * 8)); k++; i++; } + emit(w); + } + if (!(n & 7)) emit(0); + emit(a); + setlit(j, here); + // the stub, compiled as if it had been written in the source. it stays + // for the places that take the function's address; a direct call to it + // compiles to the native-call opcode instead (see call) + ebn = 0; ebuf[0] = 0; + if (sret) { ebs("unchecked "); ebs(rn); ebs("*.u "); } + else if (rk == 5) ebs("f32 "); else if (ckindfloat(rk)) ebs("float "); else ebs("int "); + ebs(fname); ebs("("); + i = 0; + while (i < np) { + if (i) ebs(", "); + if (ks[i] >= 13) { ebs(ksn[i]); ebs(" p"); } else if (ks[i] == 5) ebs("f32 p"); else if (ckindfloat(ks[i])) ebs("float p"); else ebs("int p"); + ebn10(i); + i++; + } + ebs(") { let b = "); ebn10(a); ebs(";"); + if (sret) { ebs(" "); ebs(rn); ebs("* r = new("); ebs(rn); ebs("); b[3] = r;"); } + i = 0; + while (i < np) { ebs(" b["); ebn10(i + 3 + sret); ebs("] = p"); ebn10(i); ebs(";"); i++; } + if (sret) ebs(" syscall(14, b, 0, 0); return r; }"); + else { + ebs(" return syscall(14, b, 0, 0)"); + if (rk == 5) ebs(" as f32"); else if (ckindfloat(rk)) ebs(" as float"); + ebs("; }"); + } + buf = new(ebn + 2); + copy_w(buf, ebuf, ebn + 1); + src_push(2, buf, 0, 0); + next(); + stubgen = 1; // the stub is ours, not the document's: its locals get no hints + while (tk != T_EOF) topitem(); + stubgen = 0; + src_pop(); + free(buf); + k = lookup(fname); + if (k >= 0 && skind[k] == K_FN && (sflag[k] & F_DEF) && !sret) sflag[k] = sflag[k] | F_EXT; // a struct result is called as its stub + return 0; +} +// the c kind of a zc type, for cfunc +int ckindof(word t) { + if (t == tfloat) return 2; + if (t == tf32) return 5; + if (t[0] == TY_INT && t[5]) { // i8 u8 i16 u16 i32 u32 pass and come back at their width + if (t[5] == 1) { if (t[6] & 1) return 10; return 11; } + if (t[5] == 2) { if (t[6] & 1) return 8; return 9; } + if (t[6] & 1) return 4; + return 7; + } + if (t == tvoid) return 0; + if (t[0] == TY_PTR || t[0] == TY_ARR || t[0] == TY_DYN) return 6; + return 1; +} +// cfunc(f): a native function pointer that runs the zc function f, with the +// c signature its declared types give (float is a double, f32 a c float, i8..u32 their width, a pointer is a word +// address, anything else a long). the pointer can be given to c code, which +// may call it while a native call from zc is running. +int kw_cfunc() { + int s; word t; int sig = 1, i, nm; + next(); + expect(s_lp); + if (tk != T_ID) { die("cfunc needs the name of a function"); return 0; } + s = lookup(tv); + if (s < 0 || skind[s] != K_FN) { serrn(tv, "isn't a function"); return 0; } + t = sigof(sval[s]); + if (!t) t = stype[s]; + if (t && t[0] == TY_FN) { + sig = ckindof(t[4]); + i = 0; + if (t[3] > 14) serrn(tv, "has more than 14 parameters"); + while (i < t[3] && i < 14) { sig = sig | (ckindof(t[7 + i]) << (4 * (i + 1))); i++; } + } else { + i = (ssig[s] >> 1) & 31; + while (i > 0) { i--; sig = sig | (1 << (4 * (i + 1))); } + } + expr(); rval(); + lit(sig); + callname(intern("cbmake")); + expect(s_rp); + xty = tint; xfloat = 0; + return 0; +} +// intern the built-in types and the spellings the parser compares against. +// the s_ names are plain globals holding interned handles, so a check like +// is_id(s_fn) is one pointer compare. +int types_init() { + word f32p; + tytop = R_TY + NTL; tyend = R_TYEND; typeblocks = 0; ntl = 0; fieldn = 0; + if (R_TY + typecap > R_TYEND && typelist == R_TY) typelist = chk_resize(0, 0, typecap); + tword = tnew(TY_WORD, 1, intern("word"), 0); + tint = tnew(TY_INT, 1, intern("int"), 0); + tchar = tnew(TY_CHAR, 1, intern("char"), 0); + tbool = tnew(TY_BOOL, 1, intern("bool"), 0); + tvoid = tnew(TY_VOID, 0, intern("void"), 0); + tfloat = tnew(TY_FLOAT, 1, intern("float"), 0); + addsym(tword[2], K_TYPE, tword); addsym(tint[2], K_TYPE, tint); addsym(tchar[2], K_TYPE, tchar); + addsym(tbool[2], K_TYPE, tbool); addsym(tvoid[2], K_TYPE, tvoid); addsym(tfloat[2], K_TYPE, tfloat); + addsym(intern("f64"), K_TYPE, tfloat); + // f32: single precision. a variable holds the rounded value as a double; an element + // of an array or pointer of f32 is packed two to a word, like the sized integers + f32p = tnew(TY_FLOAT, 1, intern("f32"), 0); + tf32 = tnew(TY_FLOAT, 1, f32p[2], 0); + tf32[5] = 4; tf32[4] = f32p; f32p[5] = 4; f32p[6] = 2; + addsym(tf32[2], K_TYPE, tf32); + tsized("i8", 1, 1); addsym(intern("byte"), K_TYPE, tsized("u8", 1, 0)); + tsized("i16", 2, 1); tsized("u16", 2, 0); tsized("i32", 4, 1); tsized("u32", 4, 0); + s_lt = intern("<"); + s_gt = intern(">"); + s_shr = intern(">>"); + s_le = intern("<="); + s_ge = intern(">="); + s_eqeq = intern("=="); s_ne = intern("!="); s_plus = intern("+"); + s_struct = intern("struct"); s_type = intern("type"); s_typecheck = intern("typecheck"); s_docs = intern("docs"); + s_on = intern("on"); + s_off = intern("off"); + s_new = intern("new"); + s_new_t = intern("new_t"); + s_new_k = intern("new_k"); + s_recycle_leaf = intern("recycle_leaf"); + s_hitems = intern("#items"); s_hlen = intern("#len"); s_fatten = intern("fatten"); + s_this = intern("this"); + s_o3 = intern("o3"); + s_lfa = intern("lfa"); + s_outside = intern("outside"); + s_new_raw = intern("new_raw"); + s_oob = intern("oob"); + s_new_oz = intern("new_oz"); + s_ld8 = intern("ld8"); s_st8 = intern("st8"); s_ld16 = intern("ld16"); s_st16 = intern("st16"); + s_ld32 = intern("ld32"); s_st32 = intern("st32"); + s_fixed = intern("fixed"); + s_dlen = intern("dlen"); + s_dcap = intern("dcap"); + s_dnew = intern("dnew"); + s_dat = intern("dat"); + s_len_s = intern("len_s"); + s_at_s = intern("at_s"); + s_slice_s = intern("slice_s"); + s_cat_s = intern("cat_s"); + s_eq_s = intern("eq_s"); + s_lt_s = intern("lt_s"); + s_le_s = intern("le_s"); + s_put_bs = intern("put_bs"); + s_put_s = intern("put_s"); + s_n_to_s = intern("n_to_s"); s_new_s = intern("new_s"); + s_dpush = intern("dpush"); s_dpop = intern("dpop"); s_dresize = intern("dresize"); + numops[0] = intern("*"); numops[1] = intern("/"); numops[2] = intern("%"); numops[3] = intern("&"); + numops[4] = intern("|"); + numops[5] = intern("^"); + numops[6] = intern("<<"); + numops[7] = s_shr; + nnumops = 8; + return 0; +} +// true for an operator that works on numbers. +int isnumop(int o) { + int i = 0; + while (i < nnumops) { + if (numops[i] == o) return 1; + i++; + } + return 0; +} +// the type of a binary operation, checking it when the typechecker is on +// the result type of binary operator b, which is also where the typechecker +// complains: pointer plus int is that pointer, pointer minus pointer is an int, +// word on either side wins, and a float on either side makes arithmetic float. +word bintype(int b, word lt, word rt) { + int o = bname[b]; + lt = decay(lt); rt = decay(rt); + if (blen[b] < 0) { tcneed(!isagg(lt) && !isagg(rt), "&& and || need scalars", lt); return tbool; } + if (isfl(lt) || isfl(rt)) { + if (o == s_plus || o == s_minus || o == s_star || o == s_slash) { + if (lt[0] == TY_PTR || rt[0] == TY_PTR) { tcerr("+", lt, rt); return tword; } + return tfloat; + } + if (o == s_eqeq || o == s_ne || o == s_lt || o == s_gt || o == s_le || o == s_ge) return tbool; + } + if (o == s_eqeq || o == s_ne) { + if (!compat(lt, rt) && !compat(rt, lt)) tcerr("comparison", lt, rt); + return tbool; + } + if (o == s_lt || o == s_gt || o == s_le || o == s_ge) { + if (!(lt == tword || rt == tword || (isnum(lt) && isnum(rt)) || (lt[0] == TY_PTR && rt[0] == TY_PTR))) { + tcerr("comparison", lt, rt); + } + return tbool; + } + if (o == s_plus) { + if (lt[0] == TY_PTR && (isnum(rt) || rt == tword)) return lt; + if (rt[0] == TY_PTR && isnum(lt)) return rt; + if (lt == tword || rt == tword) return tword; + if (isnum(lt) && isnum(rt)) return tint; + tcerr("+", lt, rt); return tword; + } + if (o == s_minus) { + if (lt[0] == TY_PTR && rt[0] == TY_PTR) return tint; + if (lt[0] == TY_PTR && (isnum(rt) || rt == tword)) return lt; + if (lt == tword || rt == tword) return tword; + if (isnum(lt) && isnum(rt)) return tint; + tcerr("-", lt, rt); return tword; + } + if (isnumop(o)) { + if (lt == tword || rt == tword) return tword; + if (isnum(lt) && isnum(rt)) return tint; + if (isnum(lt)) lt = rt; + tcneed(0, "arithmetic needs numbers", lt); return tword; + } + return tword; // operators a program added +} + +// ---- reflection ---- +// for programs (and parse words) looking at types at runtime +word tkind(word t) { return t[0]; } +// the size of a type in words. +word tsize(int t) { return tsz(t); } +// the name of a type. +word tname(word t) { return t[2]; } +// the length of an array type. +word tlen(word t) { return t[3]; } +// the number of fields of a struct type. +word tnfields(word t) { tresolve(t); return t[3]; } +// ---- fattening ---- +// typed new stamps the header, in o3 the same as outside it. fatten is for a +// value that still has new_raw's blank type word when it reaches code that +// isn't o3: a store into a normal local or a global, an argument to a +// function that isn't o3, the call site where non-o3 code calls an o3 +// function whose result has pointers, and the end of an o3 block. a child +// store of a value new(T) just allocated, or that an o3 function returned, +// does not call fatten: the header is already that type. a call or return +// from o3 to o3 does not fatten. fatten(p, t) stamps the type, zeroes the +// slack, and follows every typed pointer. it returns p. +// a type whose objects can never hold a pointer: numbers, chars, bools, and +// arrays and plain structs of them. word, generics and anything unknown say no +// two questions about a type's shape, both answered structurally: +// isleaf can an object of this type never hold a heap pointer? the +// allocator uses it to pick the recycle_leaf fast path (no children +// to walk, so the block goes straight back on its size-class list). +// hasptr can it hold one? fatten uses it to decide whether stamping a +// type has to follow pointers. +word isleaf(word t) { + int k = t[0], i, n; + if (k == TY_INT || k == TY_CHAR || k == TY_BOOL || k == TY_FLOAT) return 1; + if (k == TY_ARR) return isleaf(t[4]); + if (k == TY_STRUCT && !t[5]) { + n = tnfields(t); + i = 0; + while (i < n) { + if (!isleaf(tftype(t, i))) return 0; + i++; + } + return 1; + } + return 0; +} +// true when a value of type t holds a pointer that fattening must follow. +word hasptr(word t) { + int k = t[0], i, n; + if (k == TY_PTR || k == TY_DYN) return 1; + if (k == TY_ARR) return hasptr(t[4]); + if (k == TY_STRUCT && !t[5]) { + n = tnfields(t); + i = 0; + while (i < n) { + if (hasptr(tftype(t, i))) return 1; + i++; + } + } + return 0; +} +// stamp p with its type t, then the pointers it holds. +int fatten(int p, int t) { fat1(p, t, 32); return p; } +// stamp p with type t if it has no type yet, then follow its pointers. dl is a +// depth limit so a cycle through growable arrays ends. a raw header holds +// -(n + 1) for an object of n words, which tells how many elements to type. +int fat1(word p, word t, int dl) { + word e; int n, k, i, es; + if (dl <= 0 || !t || !isobj(p)) return 0; + if (t[0] == TY_DYN) { // a handle is always fat; what it holds may not be + if (hasptr(t[4])) { + es = tsz(t[4]); + n = p[0]; + i = 0; + while (i < n) { fatin(p[2] + i * es, t[4], dl - 1); i++; } + } + return 0; + } + if (t[0] != TY_PTR || p[-1] >= 0) return 0; + e = t[4]; n = 0 - p[-1] - 1; es = tsz(e); + if (es < 1) es = 1; + if (e == tword || e[0] == TY_VAR) p[-1] = 0; + else if (n > es) p[-1] = tarr(e, 0); + else p[-1] = e; + if (osize(p) > n) fill_w(p + n, 0, osize(p) - n); + if (hasptr(e)) { k = n / es; i = 0; while (i < k) { fatin(p + i * es, e, dl - 1); i++; } } + return 0; +} +// fatten the value stored at address a, which has type t: a pointer or handle +// is fattened itself, an array or struct is walked element by element +word fatin(word a, word t, int dl) { + int k = t[0], i, n, o, ft, es; + if (k == TY_PTR || k == TY_DYN) return fat1(a[0], t, dl); + if (k == TY_ARR) { + if (!hasptr(t[4])) return 0; + n = t[3]; + es = tsz(t[4]); + i = 0; + while (i < n) { fatin(a + i * es, t[4], dl); i++; } + return 0; + } + if (k == TY_STRUCT && !t[5]) { + n = tnfields(t); + i = 0; + while (i < n) { + o = tfoff(t, i); + ft = tftype(t, i); + if (o >= 0) fatin(a + o, ft, dl); + i++; + } + } + return 0; +} +// reflection accessors over type records (see the layout under types). they +// resolve a generic instance first, so asking about vec works. +word tfname(word t, int i) { tresolve(t); return t[4][i * 3]; } +// the type of field i of a struct. +word tftype(word t, int i) { tresolve(t); return t[4][i * 3 + 1]; } +// the offset of field i of a struct. +word tfoff(word t, int i) { tresolve(t); return t[4][i * 3 + 2]; } +// the return type of a function type. +word tret(word t) { return t[4]; } +// the number of parameters of a function type. +word tnparams(word t) { return t[3]; } +// the type of parameter i of a function type. +word tparam(word t, int i) { return t[7 + i]; } +// the tag of parameter i: 0 untagged, 1 .m, 2 .d. +word tparamtag(word t, int i) { return ((t[5] >> 6) >> (i + i)) & 3; } // 0 untagged (m), 1 .m, 2 .d +// true when a function type returns an owned object (.u). +word tretu(word t) { return t[5] & 1; } +// the number of type arguments a generic struct instance has. +word tnargs(word t) { + if (t[0] != TY_STRUCT || !t[5]) return 0; + return t[6][0]; +} +// type argument i of a generic struct instance. +word targ(word t, int i) { return t[6][1 + i]; } +// the type of a function, by address. untyped functions get one made from their signature +// ---- function types by address ---- +word sigof(int f) { + int i = nsym, s = -1; [24]word ws; int n, k; + while (i) { i--; if (skind[i] == K_FN && sval[i] == f && (sflag[i] & F_DEF)) { s = i; break; } } + if (s < 0) return 0; + if (stype[s]) return stype[s]; + n = (ssig[s] >> 1) & 31; k = 0; + while (k < n) { ws[k] = tword; k++; } + return tfn(tword, n, ws, ssig[s]); +} +// the function type of the function named nm, or 0 when there is none. +word sigofs(int nm) { + int s = lookups(nm); + if (s < 0 || skind[s] != K_FN) return 0; + return sigof(sval[s]); +} + +// ---- expressions ---- +// every expression leaves its value on the stack, returns its analyzer class, +// and sets xty to its type. lv means the stack holds an address that hasn't +// been loaded yet; structs and arrays are never loaded, their address is +// their value. +// memdebug: the address on top of the stack, checked before a heap load +// (dbg_addr duplicates the address on top and calls the runtime's checkptr on +// the copy, so memdebug catches a load from a freed object) +int dbg_addr() { + if (mdbg && !dry) { + lit(0); + op(O_PICK); + callname(s_check); + op(O_DROP); + } + return 0; +} +// turn an lvalue into a value. when lv is set the stack holds the address of a +// variable, field or element that has not been loaded; rval loads it, unless +// the thing is an array or struct, whose address is its value. every place +// that needs a value calls this after parsing an expression. +int rval() { + if (lv && lvk == LV_LOCAL) ltag[lvi] = ltag[lvi] | LREAD; + if (lv) { + if (ispk(xty)) pkld(xty); + else if (!isagg(xty)) { dbg_addr(); op(O_LD); } + lv = 0; + } + return 0; +} +// run a keyword's handler (kw_len, kw_struct, a parse word...) from the spot +// where the parser met it. e is 1 in expression position, where statement-only +// keywords refuse to run. the handler reports the class of what it produced +// in xcls. +int kwcall(int s, int e) { + int f = sval[s], old = kw_expr, c, n0 = ntok; + kw_expr = e; xcls = C_PLAIN; xty = tword; xzero = 0; + f(); xaf = 0; + // a handler that never reads a token (not even its own name) would be called + // again on the same token forever, so it is an error, and the token is skipped + if (ntok == n0) die("a parse word has to read its own name with next()"); + xbor = -1; + kw_expr = old; + c = xcls; + lv = 0; lvk = LV_NONE; + return c; +} +// report an error when a statement is used inside an expression. +int stmtonly() { + if (kw_expr) serr("this can't be used inside an expression"); + return 0; +} +// the arguments of a call. ft is the callee's type (or 0), bs the generic bindings +// (tags packs two bits per parameter: 0 lend, 1 .m, 2 .d. bs collects type +// parameter bindings as the argument types are unified with the signature. +// fat asks for every pointer argument to be fattened first, for o3 code +// calling code that is not o3.) +int args(int tags, word ft, int bs, int fat) { + int np = 0, c, pt, t, cs = ifcall, freeing = 0, harmless = 0; word first = 0; + if (cs >= 0 && cs < ubase) { + freeing = sname[cs] == s_free || sname[cs] == s_recycle; + harmless = sname[cs] == s_put_s || eq_w(sname[cs], "put_n") || eq_w(sname[cs], "put_c") || eq_w(sname[cs], "len") || eq_w(sname[cs], "cap"); + } + xgive = 0; ifcall = 0 - 1; + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + c = expr(); rval(); + if (!np) first = xaf; + if (!freeing && !harmless) af_escape(xaf); + if (cs >= 0) if_arg(cs, np, xty, xzero); + if (ft && np < ft[3]) fcoerce(subst(ft[7 + np], bs)); + t = xty; + argcheck(c, (tags >> (np + np)) & 3); + // o3 data handed to normal code + if (fat && hasptr(t)) { + lit(t); + callname(s_fatten); + xty = t; + } + if (ft && np < ft[3]) { + pt = ft[7 + np]; + if (!unify(pt, xty, bs)) tcerr("argument", subst(pt, bs), xty); + } + np++; + if (!accept(s_comma)) break; + } + } + expect(s_rp); + argfact = first; xaf = 0; + return np; +} +// memdebug records the source line on the next new, via the runtime global +// memdebug: store the current line in the runtime's alloc_line just before an +// allocation, so a leak report can say where the object came from +int stamp_site() { + int s; + if (!mdbg || dry || o3on) return 0; + s = lookup(s_alloc); + if (s < 0) return 0; + lit(tline); lit(sval[s]); op(O_ST); + return 0; +} +// new(T) and new(T, count): a typed object, its type stamped into the header +// new(T), new(T, n), new([]T), new(fixed []T, n). a growable array goes to +// dnew. otherwise the call is new_t(size, type), unless the size is known at +// compile time and we are not in o3 or a dry run: then the size class is +// computed here and the call is new_k(size, type, class), which pops a block +// straight off the class list. newsz and newleaf record what was allocated so +// the variable it lands in can later be freed with the matching fast path. +int newtyped() { + word t; int c, fast = 0, length = 1, place = tpack(); + t = ptype(); + if (t[0] == TY_DYN) { // a growable array: element size, length, type + if (tbytes(t[4])) lit(0 - tbytes(t[4])); else lit(tsz(t[4])); // packed elements say so with a negative size: minus their bytes + if (accept(s_comma)) { c = expr(); rval(); plainuse(c); length = -1; if (xconst && xcval >= 0) length = xcval; } + else { length = 0; lit(0); if (t[3]) serr("a fixed array needs its length: new(fixed []T, n)"); } + lit(t); + expect(s_rp); + stamp_site(); + callname(s_dnew); + xaf = af_new(length, 3, place); + lv = 0; lvk = LV_NONE; xty = t; xzero = 0; xstamp = 1; + return C_FRESH; + } + if (accept(s_comma)) { + c = expr(); rval(); plainuse(c); + length = -1; if (xconst && xcval >= 0) length = xcval; + if (tbytes(t)) { // packed: n elements take (n * bytes + 7) / 8 words + if (tbytes(t) != 1) { lit(tbytes(t)); op(15); } + lit(7); op(O_ADD); lit(3); op(19); + } else if (tsz(t) != 1) { lit(tsz(t)); op(15); } + lit(tarr(t, 0)); + newsz = -1; newleaf = 0; + } else { + lit(tsz(t)); lit(t); + newsz = tsz(t); newleaf = 0; + if (isleaf(t)) newleaf = t; + if (!o3on && !dry && lookup(s_new_k) >= 0) { lit(szclass(newsz)); fast = 1; } + } + expect(s_rp); + stamp_site(); + if (fast) callname(s_new_k); else callname(s_new_t); + xaf = af_new(length, 2, place); + lv = 0; lvk = LV_NONE; xty = tptr(t); xzero = 0; xstamp = 1; + return C_FRESH; +} +// ld8/st8 and the 16- and 32-bit pair. 0 when this call should stay a call. +// a store's opcode is odd: the arguments arrive address then value, and the +// opcode wants the address on top. +// (the byte-access functions become single opcodes inside o3 code) +int byteop(int s) { + if (sname[s] == s_ld8) return 612; + if (sname[s] == s_st8) return 613; + if (sname[s] == s_ld16) return 614; + if (sname[s] == s_st16) return 615; + if (sname[s] == s_ld32) return 616; + if (sname[s] == s_st32) return 617; + return 0; +} +// ---- type facts ---- +// annotate mode (the language server asks for it, ifon) collects the types the +// untyped declarations of a document could be given, as edits: a place, how +// many chars it replaces (0 inserts) and the text. a local gets the type of +// its initializer, a parameter the type every call passes it, and a function +// the type of what it returns. only types that change nothing are offered: no +// floats and no sized integers, because a typed one converts or cuts to size +// where the untyped word did not, so the annotated program is the same program. +// the declarations are found while they compile, the calls too, and the +// edits are written at the end of the unit, when every call has been seen. +// a type that can be written in front of a name and changes nothing +word ifpure(word t) { + int k; + if (!t || t == tword || t == tvoid) return 0; + k = t[0]; + if (k == TY_INT) return t[5] == 0; + if (k == TY_CHAR || k == TY_BOOL || k == TY_STRUCT) return t[2] != 0; + if (k == TY_PTR) { + k = t[4][0]; + if (k == TY_ARR || k == TY_DYN || k == TY_FN) return 0; + return t[4] == tword || ifpure(t[4]); + } + if (k == TY_ARR || k == TY_DYN) return t[4] == tword || ifpure(t[4]); + return 0; +} +// one edit: the token at place p is replaced by the type t and then the text +// after (len < 0: the token's own length; 0: nothing is replaced) +int fact_add(int p, int len, int t, int after) { + int sv, o, at, n; word e; int osm = outmode, osb = outbuf, osn = outn, osc = outcap; + // the text is printed with tprint into the pool: output mode 2 writes into outbuf + if (!ifx || dry || panic || chkabort) return 0; + sv = tpack(); tunpack(p); o = toff; if (len < 0) len = toklen; tunpack(sv); + if (o < 0) return 0; + at = nift; + outn = 0; outmode = 3; tprint(t); put_s(after); n = outn; + if (nifx >= ifxcap) { ifxcap = ifxcap * 2; ifx = chk_resize(ifx, nifx * 4, ifxcap * 4); } + if (at + n > iftcap) { while (at + n > iftcap) iftcap = iftcap * 2; ift = chk_resize(ift, at, iftcap); } + outbuf = ift + at; outn = 0; outcap = n; outmode = 2; + tprint(t); put_s(after); + n = outn; + outmode = osm; outbuf = osb; outn = osn; outcap = osc; + e = ifx + nifx * 4; + e[0] = o; e[1] = len; e[2] = at; e[3] = n; + nifx++; nift = at + n; + return 0; +} +// the record of function symbol s: calls can come before the definition +word if_get(int s) { + int id; word r; + if (!ifs || s < 0 || s >= symcap) return 0; + id = ifs[s]; + if (id) return ifr[id - 1]; + if (nif >= ifrcap) { ifrcap = ifrcap * 2; ifr = chk_resize(ifr, nif, ifrcap); } + nif++; ifs[s] = nif; + r = chk_resize(0, 0, IFW); ifr[nif - 1] = r; + fill_w(r, 0, IFW); + r[0] = s; + return r; +} +// a state is 0 (nothing seen), a type, or -1 (no single type): p points at it +int if_join(word p, int t) { + if (*p == 0 - 1) return 0; + if (!ifpure(t)) *p = 0 - 1; + else if (!*p) *p = t; + else if (*p != t) *p = 0 - 1; + return 0; +} +// argument j of a call of s has the type t (a literal 0 says nothing: it is a +// null pointer as often as a number) +int if_arg(int s, int j, int t, int zero) { + int r; + if (!ifs || dry || j >= IFP || zero) return 0; + r = if_get(s); + if (r) if_join(r + 8 + 3 * j, t); + return 0; +} +// a function at the top level starts: its header is at ifkp and ifkk says how +// to edit it (1: fn becomes the type, 2: the type goes in front of a .u) +int if_begin(int s, int k) { + word r = if_get(s); + ifcur = 0; + if (!r) return 0; + r[2] = 1; r[5] = ifkp; r[6] = k; + ifcur = r; + return 0; +} +// parameter j: p is where its type would go, kind 0 for a typed one, 1 to +// insert the type and a space, 2 to insert it right in front of a tag +int if_param(int j, int p, int kind) { + word r = ifcur; + if (!r || j >= IFP) return 0; + r[8 + 3 * j] = 0; r[9 + 3 * j] = p; r[10 + 3 * j] = kind; + if (kind) r[7] = j + 1; + return 0; +} +// a return statement: t is what it returns, zero if that is a bare 0 +int if_ret(int t, int zero) { + word r = ifcur; + if (!r || nclo || dry) return 0; + r[1] = 1; + if (zero) r[4] = 1; else if_join(r + 3, t); + return 0; +} +// the function ends: which of its parameters were used as addresses +int if_fin() { + word r = ifcur; int j = 0; + while (j < r[7]) { + if (lptr[lbase + j]) r[10 + 3 * j] = r[10 + 3 * j] | 4; + j++; + } + return 0; +} +// the edits of every function, once all the calls have been seen +int if_emit() { + int i = 0, j; word r; int t, k; + while (i < nif) { + r = ifr[i]; + i++; + if (!r[2]) continue; + j = 0; + while (j < r[7]) { + k = r[10 + 3 * j]; t = r[8 + 3 * j]; + if ((k & 3) && !t && (k & 4)) t = tptr(tword); // no call says more, but the body uses it as an address + if ((k & 3) == 1 && t > 0) fact_add(r[9 + 3 * j], 0, t, " "); + else if ((k & 3) == 2 && t > 0) fact_add(r[9 + 3 * j], 0, t, ""); + j++; + } + t = r[3]; + if (r[1] && t != 0 - 1) { + if (!t && r[4]) t = tint; + if (t && r[6] == 1) fact_add(r[5], 0 - 1, t, ""); + else if (t && r[6] == 2) fact_add(r[5], 0, t, ""); + } + } + return 0; +} +// ---- hints ---- +// findings that are not errors. each is written only in check mode, through +// hint_begin, and none of them changes the code the compiler emits. +int magic(int v) { + if (!hint_begin(tpack())) return 0; + put_s("the number "); put_n(v); put_s(" has no name; a const says what it means"); + dg_close(); + return 0; +} +// warn that a new inside a loop allocates on every pass. +int newloop(int p) { + if (!hint_begin(p)) return 0; + put_s("new inside a loop allocates on every pass; allocate once above the loop if the object can be reused"); + dg_close(); + return 0; +} +// hint when a shift by v is past the width of the value. +int shifthint(int p, int v) { + int k = 0; + if (!hint_begin(p)) return 0; + while ((1 << k) < v) k++; + put_s("multiplying by "); put_n(v); put_s(" is a shift; write << "); put_n(k); + dg_close(); + return 0; +} +// a call to function symbol s, with the callee name already consumed and the +// ( next. in order: +// 1. new(...) with a type argument is redirected to newtyped +// 2. in o3 code, untyped new becomes new_oz and the byte accessors turn into +// opcodes +// 3. the arguments are parsed against the signature (args), checking each +// against its parameter tag; generic type parameters are bound here +// 4. free whose argument was a given-away last pointer becomes recycle; a +// constant-size new becomes new_k with its class; put_s of a byte string +// becomes put_bs +// 5. the call is emitted (fnref pushes the address, or a patch site if the +// function isn't defined yet) +// 6. the result's type and class are set: .u functions return C_FRESH, which +// is how the analyzer knows the caller now owns a new object +int call(int s) { + int np, tags = 0, ret = 0; word ft = stype[s]; [8]word bs; int rs, rt = 0, kop, cp = callpos, original = s; word storage; + if (sname[s] == s_new && skind[s] == K_FN) { + peek(); + if (pk_tk == T_OP && pk_tv == s_lk) { next(); return newtyped(); } + if (pk_tk == T_ID && (istypename(pk_tv) || pk_tv == s_fn)) { next(); return newtyped(); } + } + if (o3on && sname[s] == s_new) { tags = lookup(s_new_oz); if (tags >= 0) s = tags; tags = 0; } + if (o3on) { + kop = byteop(s); + if (kop) { + np = args(0, 0, bs, 0); + if (kop & 1) { + if (np != 2) serrn(sname[s], "wrong number of arguments"); + op(O_SWAP); op(kop); lit(0); + } else { + if (np != 1) serrn(sname[s], "wrong number of arguments"); + op(kop); + } + lv = 0; lvk = LV_NONE; xty = tword; xzero = 0; xbor = -1; + xfloat = 0; xstr = 0; xlenloc = -1; xstamp = 0; + return C_PLAIN; + } + } + if (sflag[s] & F_SIG) { tags = ssig[s] >> 6; ret = ssig[s] & 1; } + else sflag[s] = sflag[s] | F_UNTYPED; + if (sflag[s] & F_RETOWN) ret = 1; + fill_w(bs, 0, 8); + if (ngbind) { copy_w(bs, gbind, ngbind); ngbind = 0; } + np = 0; + if (o3on && !(sflag[s] & F_O3) && sname[s] != s_free && sname[s] != s_recycle) np = 1; // o3 calling normal code: fatten the arguments + ifcall = s; + np = args(tags, ft, bs, np); + storage = argfact; + if (original < ubase && (sname[original] == s_free || sname[original] == s_recycle)) af_end(storage, cp); + if (sflag[s] & F_GEN) s = ginstance(s, bs); + if (sname[s] == s_free && xgive) { // the last pointer: straight back to the size-class list + rs = lookup(s_recycle); + if (rs >= 0) s = rs; + } + if ((sflag[s] & F_SIG) && np != ((ssig[s] >> 1) & 31)) serrn(sname[s], "wrong number of arguments"); + if (sname[s] == s_new) { + stamp_site(); newsz = -1; newleaf = 0; + if (np == 1 && xconst && xcval >= 0) newsz = xcval; + xaf = af_new(newsz, 2, cp); + if (lsp > 0) newloop(cp); + // a constant size: the class is known now, so use the allocator's direct path + if (newsz >= 0 && !o3on && !dry && lookup(s_new_k) >= 0) { + lit(0); + lit(szclass(newsz)); + s = lookup(s_new_k); + } + } + if (sname[s] == s_put_s && np == 1 && xstr) { + s = lookup(s_put_bs); + if (s < 0) s = fwdfn(s_put_bs); + } + if (!(sflag[s] & F_DEF) || s == finsym) sflag[s] = sflag[s] | F_EARLY; // called before its body: an owned return is not inferred for it + if (sflag[s] & F_EXT) { lit(sval[s][-1]); op(620); } // an extern: the native call opcode, with the block's address + else { fnref(s); op(O_CALL); } + if (!o3on && (sflag[s] & F_O3) && ft) { // non-o3 called o3: fatten the result here, not inside the callee + rt = subst(ft[4], bs); + if (hasptr(rt)) { lit(rt); callname(s_fatten); } + } + xstr = 0; + if (sname[s] == s_cat_s || sname[s] == s_slice_s || sname[s] == s_n_to_s || sname[s] == s_new_s) { + xstr = 1; + } + lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; xconst = 0; + xty = tword; + if (ft) xty = subst(ft[4], bs); + xfloat = 0; + if (isfl(xty)) xfloat = 1; + xlenloc = -1; xstamp = 0; + if (o3on && (sflag[s] & F_O3) && ft && hasptr(xty)) xstamp = 1; + if (ret) return C_FRESH; + return C_PLAIN; +} +// an enhancement used like a function: the arguments, then its one opcode +// an enhancement (a custom opcode declared with "enhance") called like a +// function. it compiles to the one opcode, or to a call of its fallback +// function when the cpu does not have the opcode. +int enhcall(int s) { + int nin = ssig[s] & 15, nout = (ssig[s] >> 4) & 15, n = 0, c; + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + c = expr(); + rval(); + plainuse(c); + n++; + if (!accept(s_comma)) break; + } + } + expect(s_rp); + if (n != nin) serrn(sname[s], "wrong number of inputs"); + lv = 0; lvk = LV_NONE; xty = tword; xzero = 0; xbor = -1; xlenloc = -1; xstamp = 0; + if (sflag[s] & F_FALLBACK) { fnref(sfix[s] - 1); op(O_CALL); return C_PLAIN; } + op(XOP0 + sval[s]); + if (nout == 0) lit(0); + if (nout > 1) serrn(sname[s], "leaves several values; use it from asm"); + return C_PLAIN; +} +// ---- closures ---- +// fn(a, b) { ... } is a function whose last, hidden parameter is a pointer to +// its environment. the closure value is a heap block: word 0 is the body's +// entry, and the captured variables start at word 3. the block itself is never +// run as code. callable_code distinguishes plain function addresses, including +// linked heap code segments, from closure blocks. a plain function is called +// as it is. a closure is called with block + 3 as its env, at the entry in +// word 0. a captured variable is copied in when the closure is made; the body +// reads and writes its own copy. +// grow closure frames and capture rows while keeping closure and capture indices. +int reserve_closures(int need) { + int cap = closure_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + clo_lo = chk_resize(clo_lo, nclo, cap); + clo_hi = chk_resize(clo_hi, nclo, cap); + clo_n = chk_resize(clo_n, nclo, cap); + clo_env = chk_resize(clo_env, nclo, cap); + clo_ret = chk_resize(clo_ret, nclo, cap); + clo_name = chk_resize(clo_name, nclo * capture_width, cap * capture_width); + clo_loc = chk_resize(clo_loc, nclo * capture_width, cap * capture_width); + clo_via = chk_resize(clo_via, nclo * capture_width, cap * capture_width); + closure_cap = cap; return cap; +} +int reserve_captures(int need) { + int cap = capture_width, i = 0; word names, locals, via; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + names = chk_resize(0, 0, closure_cap * cap); + locals = chk_resize(0, 0, closure_cap * cap); + via = chk_resize(0, 0, closure_cap * cap); + while (i < nclo) { + copy_w(names + i * cap, clo_name + i * capture_width, clo_n[i]); + copy_w(locals + i * cap, clo_loc + i * capture_width, clo_n[i]); + copy_w(via + i * cap, clo_via + i * capture_width, clo_n[i]); i++; + } + clo_name = names; clo_loc = locals; clo_via = via; capture_width = cap; return cap; +} +// find or create the capture slot for variable n in the innermost closure +// being compiled: if the name is one of the enclosing function's locals, it is +// recorded (once) and the body reads it from its own environment copy. +// a name from further out is captured through each closure in between: the +// closure that encloses this one captures it too, and this one copies it from +// that closure's environment (clo_via is the slot there, -1 for a local). +word clocap(int n) { return clocap_at(nclo - 1, n); } +// the slot of the name n in closure c's captures, adding it when the closure has +// not captured it yet. returns the capture index, or -1 when no such name is visible. +word clocap_at(int c, int n) { + int i = 0, j, base = c * capture_width, r; + while (i < clo_n[c]) { if (clo_name[base + i] == n) return i; i++; } + j = clo_hi[c]; + while (j > clo_lo[c]) { + j--; + if (lname[j] != n) continue; + if (larr[j]) serrn(n, "an array can't be captured; capture a pointer to it"); + reserve_captures(clo_n[c] + 1); base = c * capture_width; + clo_name[base + clo_n[c]] = n; clo_loc[base + clo_n[c]] = j; clo_via[base + clo_n[c]] = 0 - 1; clo_n[c]++; + return clo_n[c] - 1; + } + if (c == 0) return 0 - 1; + r = clocap_at(c - 1, n); base = c * capture_width; + if (r < 0) return 0 - 1; + reserve_captures(clo_n[c] + 1); base = c * capture_width; + clo_name[base + clo_n[c]] = n; clo_loc[base + clo_n[c]] = clo_loc[(c - 1) * capture_width + r]; clo_via[base + clo_n[c]] = r; clo_n[c]++; + return clo_n[c] - 1; +} +// fn(params) { body } as an expression. the body is compiled in place behind +// a jump (hop) as a nested function with a hidden last parameter, env. when +// the code that creates the closure runs, it allocates the block (code, then +// captured values), writes the three code words and copies each captured +// variable in. ctx_push / ctx_pop save and restore the enclosing function's +// compiler state around the body. +int closure() { + int np = 0; [20]word pn; [20]word pty; int hop, entry, i, t, envl, ncap, c, result; + reserve_closures(nclo + 1); + if (o3on) serr("closures can't be made inside an o3 region"); + next(); + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + pty[np] = tword; + if (!is_op(s_dot) && ((tk == T_OP && tv == s_lk) || (tk == T_ID && (tv == s_fn || istypename(tv))))) { + pty[np] = ptype(); + } + pnoffs[np] = toff; rs_note(RS_PARAM, toff); pn[np] = name(); + np++; + if (np >= 20) { die("too many parameters"); break; } + if (!accept(s_comma)) break; + } + } + expect(s_rp); + ctx_push(); ifcur = 0; ifcall = -1; + clo_lo[nclo] = lbase; clo_hi[nclo] = nloc; clo_n[nclo] = 0; clo_ret[nclo] = 0; + nclo++; + hop = hole(); op(O_JMP); + entry = here; + fn_begin(1, 0); + prologue(); + i = 0; + while (i < np) { + t = newloc(pn[i]); lrskind[t] = RS_PARAM; lrsoff[t] = pnoffs[i]; fslots++; lsmark(1, pn[i]); + ltype[t] = pty[i]; + if (isfl(pty[i])) setflt(t, 1); + i++; + } + envl = newloc(intern("")); fslots++; + clo_env[nclo - 1] = envl; + i = np + 1; + while (i) { i--; laddr(i); op(O_ST); } + body(); + result = clo_ret[nclo - 1]; + if (result <= 0 || live) result = tword; + epilogue(); + nclo--; + c = nclo; + ncap = clo_n[c]; + setlit(hop, here); + ctx_pop(); + // the block: [push env][push body][jump] and the captured values + // the block: word 0 is the body's entry, words 3 on are the captured values. + // a call through the closure pushes block + 3 as the env and jumps to word 0. + lit(3 + ncap); callname(s_new); + lit(entry); lit(1); op(O_PICK); op(O_ST); + i = 0; + while (i < ncap) { + t = clo_loc[c * capture_width + i]; + if (clo_via[c * capture_width + i] < 0) { touch(t); vaddr(t); op(O_LD); } + else { vaddr(clo_env[c - 1]); op(O_LD); lit(clo_via[c * capture_width + i]); op(O_ADD); op(O_LD); } + lit(1); op(O_PICK); lit(3 + i); op(O_ADD); op(O_ST); + i++; + } + lv = 0; + lvk = LV_NONE; + xzero = 0; + xbor = -1; + xconst = 0; + xfloat = 0; + xstr = 0; + xlenloc = -1; + xstamp = 0; + xty = tfn(result, np, pty, np + np); + return C_FRESH; +} +// ---- the expression grammar ---- +// precedence, loosest to tightest: +// expr (assignment, ?:) -> bin (binary operators by precedence) -> +// unary (prefix operators, casts, recasts) -> postfix (index, field, call, +// ++ --, as) -> primary (literals, names, parentheses, blocks, closures) +// each level leaves its value on the stack and sets the x* globals: xty is the +// type, xfloat / xstr say the value is a float or byte string, xzero and +// xconst mark a literal 0 or constant (xcval holds it), xbor names the local a +// pointer value was borrowed from, and lv / lvk / lvi say the stack holds an +// unloaded address and what it is the address of. +// +// primary: one operand. a number, string, parenthesized expression, block +// expression, closure, or a name. a name is looked up in this order: a local +// of the current function, a variable captured by an enclosing closure, then +// the symbol table (keyword, constant, global, enhancement, function). a local +// the analyzer tracks returns C_VAR + its index so the caller can tell which +// variable the value is. +int primary() { + int n, i, s, c, k; [8]word bs0; int ft, mn, ms; + lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; + xconst = 0; xfloat = 0; xstr = 0; xlenloc = -1; xstamp = 0; xaf = 0; + if (tk == T_FLT) { op(OP_FLIT); emit(tv); xfloat = 1; xty = tfloat; next(); return C_PLAIN; } + if (tk == T_NUM) { + if (cmode && tv >= 100 && tglue != 3 && !nomagic && (tv & (tv - 1)) && (tv & (tv + 1))) { + magic(tv); + } + lit(tv); xzero = tv == 0; xconst = 1; xcval = tv; xty = tint; next(); return C_PLAIN; + } + if (tk == T_BSTR) { bstrlit(tv); xstr = 1; xty = tword; next(); return C_PLAIN; } + if (tk == T_STR) { strlit(tv); next(); xty = tptr(tchar); return C_PLAIN; } + if (tk == T_OP) { + if (tv == s_lp) { next(); c = expr(); expect(s_rp); return c; } + if (tv == s_lb) return blockexpr(); + diefound("expected an expression"); lit(0); xty = tword; return C_PLAIN; + } + if (tk != T_ID) { diefound("expected an expression"); lit(0); xty = tword; return C_PLAIN; } + if (tv == s_fn) { peek(); if (pk_tk == T_OP && pk_tv == s_lp) return closure(); } + n = tv; callpos = tpack(); + i = findloc(n); + if (i < 0 && nclo) { + k = clocap(n); + if (k >= 0) { + rs_note(RS_LOCAL, 0 - 1); + next(); + i = nclo - 1; + vaddr(clo_env[i]); op(O_LD); lit(k); op(O_ADD); + i = clo_loc[i * capture_width + k]; + xty = ltype[i]; xfloat = getflt(i); if (isfl(xty)) xfloat = 1; xstr = getstr(i); + lv = 1; lvk = LV_OTHER; + return C_PLAIN; + } + } + if (i >= 0) { + luse(i); + rs_note(lrskind[i], lrsoff[i]); + xaf = lafact[i]; af_record(toff, xaf); + next(); + if (!fchk && tracked(i)) { + serrn(n, "is tracked by the analyzer and can't be used in unchecked code"); + } + vaddr(i); + xty = ltype[i]; + if (larr[i]) return C_PLAIN; + xfloat = getflt(i); + if (isfl(ltype[i])) xfloat = 1; + xstr = getstr(i); + lv = 1; lvk = LV_LOCAL; lvi = i; + if (isalias(i)) { touch(i); xbor = lroot(i); return C_PLAIN; } + if (tracked(i)) return C_VAR + i; + return C_PLAIN; + } + s = lookup(n); + if (s >= 0) rs_put(toff, RS_SYM, rs_sym(s), s); + if (s >= 0 && skind[s] == K_KW) { + if (!(sflag[s] & F_EXPR)) dien(n, "can't be used inside an expression"); + return kwcall(s, 1); + } + if (s >= 0 && skind[s] == K_TYPE) { + next(); + if (is_op(s_dot)) { // Struct.name(args): a static function of the struct + next(); + mn = name(); + ms = lookup(methname(n, mn)); + if (ms >= 0 && skind[ms] == K_CONST) { // Enum.MEMBER + lit(sval[ms]); + xty = tint; + if (stype[ms]) xty = stype[ms]; + xzero = sval[ms] == 0; + xconst = 1; + xcval = sval[ms]; + return C_PLAIN; + } + if (ms >= 0 && skind[ms] == K_FN && (sflag[ms] & F_STATIC)) { + if (!is_op(s_lp)) die("a static function is called with ( after its name"); + return call(ms); + } + serrn(mn, "is not a static function of this struct"); + lit(0); + xty = tword; + return C_PLAIN; + } + dien(n, "is a type, not a value"); + lit(0); + xty = tword; + return C_PLAIN; + } + next(); + xty = tword; + if (s >= 0 && skind[s] == K_CONST) { + lit(sval[s]); + xty = tint; + if (stype[s]) xty = stype[s]; + xzero = sval[s] == 0; + xconst = 1; + xcval = sval[s]; + return C_PLAIN; + } + if (s >= 0 && skind[s] == K_GVAR) { + lit(sval[s]); + if (stype[s]) xty = stype[s]; + if (isfl(xty)) xfloat = 1; + lv = 1; + lvk = LV_GLOBAL; + return C_PLAIN; + } + if (s >= 0 && skind[s] == K_GARR) { lit(sval[s]); if (stype[s]) xty = stype[s]; return C_PLAIN; } + if (s >= 0 && skind[s] == K_ENH) return enhcall(s); + if (s < 0) s = fwdfn_at(n, callpos); + if (is_op(s_lt) && (sflag[s] & F_GEN)) { // f(...) + next(); ngbind = 0; + while (1) { + if (ngbind >= 8) die("too many type arguments"); + gbind[ngbind] = ptype(); + ngbind++; + if (!accept(s_comma)) break; + } + closeangle(); + if (!is_op(s_lp)) { // f alone is that instance, as a function value + fill_w(bs0, 0, 8); copy_w(bs0, gbind, ngbind); ngbind = 0; + ft = stype[s]; + s = ginstance(s, bs0); + fnref(s); + xty = tword; + if (ft) xty = subst(ft, bs0); + return C_PLAIN; + } + } + if (is_op(s_lp)) return call(s); + fnref(s); + if (stype[s]) xty = stype[s]; + return C_PLAIN; +} +// ++ and -- on the address at the top of the stack. post says the old value +// is the result; dlt is +1 or -1. it also updates the loop-bound facts: a +// decrement or a store of an unknown value ends any proof about the variable. +int incdec(int post, int dlt) { + int t; + if (lv && lvk == LV_LOCAL) lafact[lvi] = 0; xaf = 0; + if (!lv) die("++ and -- need something to assign to"); + if (lvk == LV_LOCAL && fchk && tracked(lvi) && !isalias(lvi)) { + cerrn(lvi, "owns an object and can't be incremented"); + } + tcneed(isnum(xty) || xty[0] == TY_PTR || xty == tword, "++ and -- need a number or a pointer", xty); + if (lvk == LV_LOCAL) { + ltag[lvi] = ltag[lvi] | LASG; + setflt(lvi, 0); setstr(lvi, 0); + if (forstep && lvi == ft_iv && dlt == 1) fs_ok = 1; + if (dlt < 0) putfact(lvi, -1, -1); else putfact(lvi, getlo(lvi), -1); + bpoison(lvi); + } + lv = 0; lvk = LV_NONE; xzero = 0; xfloat = 0; xstr = 0; + t = xty; + lit(0); op(O_PICK); + if (ispk(t)) pkld(t); else { dbg_addr(); op(O_LD); } + // a sized integer wraps: the new value is cut to size before it is stored + if (post) { + lit(0); op(O_PICK); lit(dlt); op(O_ADD); + if (tbytes(t)) tnorm(t); + lit(2); op(O_PICK); + if (ispk(t)) pkst(t); else op(O_ST); + } else { + lit(dlt); op(O_ADD); + if (tbytes(t)) tnorm(t); + lit(0); op(O_PICK); lit(2); op(O_PICK); + if (ispk(t)) pkst(t); else op(O_ST); + } + op(O_SWAP); op(O_DROP); + return C_PLAIN; +} +// p.x and p->x: a field of a struct, or of the struct a pointer points at +// the field access after a dot or arrow: c is the class of the left side. a +// field of a typed struct is its offset added to the address. an untyped word +// is searched for the one struct that has that field name (fieldscan). if the +// name is followed by ( it is a method call instead. a pointer-valued field +// of a tracked variable is a borrow of that variable (xbor). +word field(int c) { + int n, fieldoff; word st; + af_access(xaf, tpack()); xaf = 0; int i, b = -1, k = 0, scanned = 0, ms; + next(); + n = name(); fieldoff = nameoff; + rval(); + if (c == C_FRESH) cerr("use a field of a new object only after binding it to a name"); + else if (c >= C_VAR) { touch(c - C_VAR); b = c - C_VAR; } + st = xty; + if (st[0] == TY_PTR) st = st[4]; + if (is_op(s_lp)) { // e.name(...): a method, unless the struct has a field of that name + ms = 0 - 1; + if (st[0] == TY_STRUCT) { if (tfindfield(st, n) < 0) ms = methof(st, n); } + else if (st == tword || isnum(st)) { if (fieldscan(n) == 0) ms = methscan(n); } + if (ms == 0 - 2) { serrn(n, "is a method of more than one struct"); ms = 0 - 1; } + if (ms >= 0) return methcall(ms, st); + } + if (st[0] != TY_STRUCT && (st == tword || isnum(st))) { + k = fieldscan(n); + if (k == 1) { st = fldst; scanned = 1; } + else if (k > 1) { + if (!panic && !dry) { + errat(); + put_c('.'); + put_s(n); + put_s(" is a field of more than one struct"); + errend(); + } + xty = tword; lv = 1; lvk = LV_OTHER; xbor = -1; return C_PLAIN; + } + } + if (st[0] != TY_STRUCT) { + if (!panic && !dry) { + errat(); + put_c('.'); + put_s(n); + put_s(": that's a "); + tprint(xty); + put_s(", not a struct or a pointer to one"); + errend(); + } + xty = tword; lv = 1; lvk = LV_OTHER; xbor = -1; return C_PLAIN; + } + if (scanned) i = fldi; else i = tfindfield(st, n); + if (i < 0) { + if (!panic && !dry) { errat(); tprint(st); put_s(" has no field "); put_s(n); errend(); } + xty = tword; lv = 1; lvk = LV_OTHER; xbor = -1; return C_PLAIN; + } + rs_put(fieldoff, RS_FIELD, field_decl(st, n), st[4][i * 3 + 1]); + k = st[4][i * 3 + 2]; + xty = st[4][i * 3 + 1]; + if (k < 0) { // a packed field: the lvalue is a byte address, of the packed twin + lit(8); op(15); + k = 0 - k - 1; + if (k) { lit(k); op(O_ADD); } + xty = tpk(xty); + } else if (k) { lit(k); op(O_ADD); } + if (xty[0] == TY_PTR) { if (b >= 0) xbor = lroot(b); } + else xbor = -1; + lv = 1; xzero = 0; + if (b >= 0) { lvk = LV_ELEM; lvi = b; } else lvk = LV_OTHER; + return C_PLAIN; +} +// array indexing, address arithmetic. mulsz scales an index by the element +// size. the addr_ functions build the address of element ix of a growable +// array in the different situations the bounds-check removal produces: the +// stack holds handle and index (addr_stk), the items pointer is cached in a +// hidden o3 variable (addr_cached), or only the handle is available +// (addr_hdr). range_jz is the inline bounds check, one "outside" enhancement +// and a branch to the oob report. +int mulsz(int et) { + if (tsz(et) != 1) { lit(tsz(et)); op(15); } + return 0; +} +// address of an element of a stack array, from the index on the stack. +int addr_stk(int et) { + op(O_SWAP); + lit(2); + op(O_ADD); + op(O_LD); + op(O_SWAP); + mulsz(et); + op(O_ADD); + return 0; +} +// address of an element of an array whose base is cached in a register. +int addr_cached(int ci, int ix, int et) { + vaddr(ci); + op(O_LD); + vaddr(ix); + op(O_LD); + mulsz(et); + op(O_ADD); + return 0; +} +// address of an element of a growable array, reading its header. +int addr_hdr(int al, int ix, int et) { + vaddr(al); op(O_LD); lit(2); op(O_ADD); op(O_LD); + vaddr(ix); op(O_LD); mulsz(et); op(O_ADD); + return 0; +} +// reload the index and the length on each side of the branch, so neither is a stack temporary +int range_jz(int ix, int src, int fld) { + int k, s; + vaddr(ix); op(O_LD); vaddr(src); op(O_LD); if (fld) op(O_LD); + s = lookup(s_outside); op(XOP0 + sval[s]); + k = hole(); op(O_JZ); + vaddr(ix); op(O_LD); vaddr(src); op(O_LD); if (fld) op(O_LD); + callname(s_oob); + setlit(k, here); + return 0; +} +// suffixes after a primary, in a loop: e as T, [index], .field, ->field, +// (call through a value), ++ and --. the index case is the long one. a byte +// string takes an index or a slice. a growable array is checked: through dat() +// normally, but inline when the compiler can prove or cheaply test the bound +// (o3 code with the cache variables, or an index the loop test already +// compared with the length). a plain pointer or fixed array is just base + +// index * size, and a constant index against a known length is checked at +// compile time. +int postfix() { + int c = primary(), b, n, t, et; word ft; [8]word bs; int k, ci, was, al, ix, enh, cz, cj, place; word storage; + while (1) { + if (tk == T_ID && tv == s_as) { // e as T: same bits, another type + next(); t = ptype(); rval(); xaf = 0; + if (tbytes(t) && !xfloat && !samesz(t, xty)) { tnorm(t); xconst = 0; } // x as u8 cuts the value to size + xty = t; xfloat = 0; lvk = LV_NONE; + if (isfl(t)) xfloat = 1; + continue; + } + if (tk != T_OP) return c; + if (tv == s_lk) { + storage = xaf; place = tpack(); af_access(storage, place); + was = xstr; + ci = 0; + if (lv && lvk == LV_LOCAL) lptr[lvi] = 1; + if (o3on && lv && lvk == LV_LOCAL && o3cache[lvi]) ci = o3cache[lvi]; + next(); + rval(); + if (was) { + c = expr(); rval(); plainuse(c); + if (accept(s_colon)) { + c = expr(); rval(); plainuse(c); + expect(s_rk); + callname(s_slice_s); + lv = 0; lvk = LV_NONE; xty = tword; xfloat = 0; xstr = 1; xzero = 0; xbor = -1; + c = C_PLAIN; + continue; + } + expect(s_rk); + callname(s_at_s); + lv = 0; lvk = LV_NONE; xty = tint; xfloat = 0; xstr = 0; xzero = 0; xbor = -1; + c = C_PLAIN; + continue; + } + b = -1; + if (c == C_FRESH) cerr("index a new object only after binding it to a name"); + else if (c >= C_VAR) { touch(c - C_VAR); b = c - C_VAR; } + if (xty[0] == TY_DYN && tbytes(xty[4])) { // packed elements: the runtime checks and gives the byte address + et = xty[4]; + c = expr(); rval(); plainuse(c); + af_index(storage, place); + tcneed(isnum(xty) || xty == tword, "an index has to be a number", xty); + expect(s_rk); + callname(intern("datb")); + et = tpk(et); + } else if (xty[0] == TY_DYN) { // a growable array: bounds-checked, through the runtime + et = xty[4]; + al = -1; + if (lvk == LV_LOCAL) al = lvi; + if (ci && !mdbg && lookup(s_outside) >= 0) op(O_DROP); + c = expr(); + ix = -1; + if (lv && lvk == LV_LOCAL) ix = lvi; + rval(); plainuse(c); + af_index(storage, place); + tcneed(isnum(xty) || xty == tword, "an index has to be a number", xty); + expect(s_rk); + k = lookup(s_outside); + enh = k >= 0 && skind[k] == K_ENH; + if (!mdbg && ix >= 0 && al >= 0 && proven(al, ix)) { // the loop test already compared this index with the length + if (ci) { vaddr(ci); op(O_LD); op(O_SWAP); mulsz(et); op(O_ADD); } + else addr_stk(et); + } else if (ci && !mdbg && enh && ix >= 0) { + op(O_DROP); + range_jz(ix, ci + 1, 0); + addr_cached(ci, ix, et); + } else if (ci && !mdbg && enh) { + lit(0); op(O_PICK); vaddr(ci + 1); op(O_LD); op(XOP0 + sval[k]); + k = hole(); op(O_JZ); + vaddr(ci + 1); op(O_LD); callname(s_oob); + setlit(k, here); + vaddr(ci); op(O_LD); op(O_SWAP); + mulsz(et); op(O_ADD); + } else if (!mdbg && o3on && enh && ix >= 0 && al >= 0) { + op(O_DROP); op(O_DROP); + range_jz(ix, al, 1); + addr_hdr(al, ix, et); + } else if (!mdbg && o3on && enh && ix >= 0) { + op(O_DROP); + vaddr(ix); op(O_LD); + lit(1); op(O_PICK); op(O_LD); op(XOP0 + sval[k]); + k = hole(); op(O_JZ); + vaddr(ix); op(O_LD); lit(1); op(O_PICK); op(O_LD); callname(s_oob); + setlit(k, here); + lit(2); op(O_ADD); op(O_LD); vaddr(ix); op(O_LD); + mulsz(et); op(O_ADD); + } else if (!mdbg && o3on && enh) { + lit(0); op(O_PICK); lit(2); op(O_PICK); op(O_LD); op(XOP0 + sval[k]); + k = hole(); op(O_JZ); + lit(1); op(O_PICK); op(O_LD); callname(s_oob); + setlit(k, here); + op(O_SWAP); lit(2); op(O_ADD); op(O_LD); op(O_SWAP); + mulsz(et); op(O_ADD); + } else callname(s_dat); + } else { + tcneed(isptr(xty) || xty == tword, "only pointers and arrays can be indexed", xty); + et = telem(xty); + n = 0 - 1; if (xty[0] == TY_ARR && xty[3] > 0) n = xty[3]; + xconst = 0; + c = expr(); rval(); plainuse(c); + if (n < 0) af_index(storage, place); + if (n >= 0 && xconst && (xcval < 0 || xcval >= n)) { + serr("the index is out of range for this array"); + } + tcneed(isnum(xty) || xty == tword, "an index has to be a number", xty); + expect(s_rk); + if (tbytes(et)) { // packed: byte address = base * 8 + index * bytes + if (tbytes(et) != 1) { lit(tbytes(et)); op(15); } + op(O_SWAP); lit(8); op(15); op(O_ADD); + et = tpk(et); + } else { + if (tsz(et) != 1) { lit(tsz(et)); op(15); } + op(O_ADD); + } + } + xaf = 0; + lv = 1; xty = et; xzero = 0; xconst = 0; xlenloc = -1; xstamp = 0; + if (xty[0] == TY_PTR) { if (b >= 0) xbor = lroot(b); } + else xbor = -1; + if (b >= 0) { lvk = LV_ELEM; lvi = b; } else lvk = LV_OTHER; + c = C_PLAIN; + xfloat = 0; if (isfl(xty)) xfloat = 1; xstr = 0; + continue; + } + if (tv == s_dot || tv == s_arrow) { + xconst = 0; + c = field(c); + xfloat = 0; + if (isfl(xty)) xfloat = 1; + xstr = 0; + continue; + } + if (tv == s_lp) { // call through a value + rval(); plainuse(c); + ft = 0; + if (xty[0] == TY_FN) ft = xty; + else tcneed(xty == tword, "only functions can be called", xty); + fill_w(bs, 0, 8); + n = args(0, ft, bs, o3on); + // raw code can live in a heap segment; a closure has an environment block + lit(n); op(O_PICK); callname(intern("callable_code")); + cz = hole(); op(O_JZ); + lit(n); op(O_PICK); op(O_CALL); + cj = hole(); op(O_JMP); + setlit(cz, here); + lit(n); op(O_PICK); lit(3); op(O_ADD); // env: the captures start 3 words into the block + lit(n + 1); op(O_PICK); op(O_LD); // the body's entry, word 0 of the block + op(O_CALL); + setlit(cj, here); + op(O_SWAP); op(O_DROP); + lv = 0; lvk = LV_NONE; c = C_PLAIN; xzero = 0; xbor = -1; xconst = 0; + xty = tword; + if (ft) xty = subst(ft[4], bs); + xfloat = 0; if (isfl(xty)) xfloat = 1; xstr = 0; + continue; + } + if (tv == s_inc) { next(); c = incdec(1, 1); continue; } + if (tv == s_dec) { next(); c = incdec(1, -1); continue; } + return c; + } + return c; +} +// prefix operators: the u*x / d*x / m*x recasts (the star has to touch the +// tag), casts like (int)x and (node*)x, dereference, address-of, prefix ++ and +// --, and any unary operator a program added (- ! ~ built in). +int unary() { + int c, un, t, place, constant, value; word storage; + if (tk == T_ID && (tv == s_u || tv == s_m || tv == s_d)) { // u*x, d*x, m*x: recast only when * is glued + peek(); + if (pk_tk == T_OP && pk_tv == s_star && pq_gl[0]) { + t = S_M; if (tv == s_u) t = S_U; if (tv == s_d) t = S_D; + next(); expect(s_star); + c = unary(); rval(); + lvk = LV_NONE; + return recast(c, t); + } + } + if (tk == T_OP && tv == s_lp && caststart()) { // (int)x, (node*)x: same bits, the type changes + next(); + t = ptype(); + expect(s_rp); + c = unary(); rval(); plainuse(c); xaf = 0; + if (isfl(t)) { if (!xfloat) { op(OP_I2F); xfloat = 1; } if (t == tf32) { xenh("zf2s"); xenh("zs2f"); } } + else if (xfloat && isnum(t)) { op(OP_F2I); xfloat = 0; } + else xfloat = 0; + if (tbytes(t) && !samesz(t, xty)) { tnorm(t); xconst = 0; } // (u8)x cuts the value to size + xty = t; lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; + return C_PLAIN; + } + if (tk == T_OP) { + if (tv == s_star) { + place = tpack(); next(); c = unary(); + af_access(xaf, place); xaf = 0; + if (lv && lvk == LV_LOCAL) lptr[lvi] = 1; + rval(); plainuse(c); + tcneed(xty[0] == TY_PTR || xty == tword, "only pointers can be dereferenced", xty); + xty = telem(xty); + if (tbytes(xty)) { lit(8); op(15); xty = tpk(xty); } // the first packed element: a byte address + lv = 1; + lvk = LV_OTHER; + xzero = 0; + xbor = -1; + xfloat = 0; + if (isfl(xty)) xfloat = 1; + xstr = 0; + return C_PLAIN; + } + if (tv == s_amp) { + place = tpack(); next(); c = unary(); + storage = 0; + if (lv && lvk == LV_LOCAL) { + storage = laaddr[lvi]; + if (!storage) { storage = af_new(1, 1, place); laaddr[lvi] = storage; if (storage) storage[5] = lvi; } + af_forget(); + } + else if (isagg(xty)) storage = 0; + if (!lv && !isagg(xty)) die("& needs something addressable"); + if (lv && ispk(xty)) serr("an element of a sized-integer array has no address; it is a byte inside a word"); + if (lv && lvk == LV_LOCAL && (ltag[lvi] & 16)) serr("an o3 variable has no address"); + if (lv && lvk == LV_LOCAL) ltag[lvi] = ltag[lvi] | LREAD | LASG; + if (c >= C_VAR) touch(c - C_VAR); + lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; xfloat = 0; xstr = 0; + xty = tptr(xty); xaf = storage; + return C_PLAIN; + } + if (tv == s_inc) { next(); unary(); return incdec(0, 1); } + if (tv == s_dec) { next(); unary(); return incdec(0, -1); } + un = unfind(tv); + if (un >= 0) { + next(); c = unary(); rval(); plainuse(c); + constant = xconst && !xfloat && uname[un] == s_minus; value = xcval; xaf = 0; + if (un <= 1) ftest(); + if (uname[un] == s_minus && xfloat) { + op(OP_FLIT); + emit(0); + op(O_SWAP); + op(OP_FSUB); + xty = tfloat; + } + else { + emitseq(useq[un], ulen[un]); xfloat = 0; + if (un <= 1) xty = tbool; + else if (xty != tword && !isfl(xty)) { tcneed(isnum(xty), "this operator needs a number", xty); xty = tint; } + } + xstr = 0; + xconst = constant; if (constant) xcval = 0 - value; xlenloc = -1; xstamp = 0; + lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; + return C_PLAIN; + } + } + return postfix(); +} +// binary operators by precedence climbing: parse an operand, then while the +// next token is a binary operator of at least minp, parse its right side at one +// level tighter and emit its code sequence from the operator table. && and || +// short-circuit with jumps; floats get their own opcodes; a * or / by a +// constant that is a power of two gets a shift hint in check mode. +int bin(int minp) { + int c = unary(), b, p, a, j, lt, lb, rb, src, lf, rf, ls, rs, fresh, top = 0, il = -1, opp; + if (fortest == 1) { fortest = 2; top = 1; ft_nops = 0; } + while (tk == T_OP) { + b = binfind(tv); + if (b < 0) return c; + p = bprec[b]; + if (p < minp) return c; + lb = -1; + if (c >= C_VAR && tracked(c - C_VAR)) lb = lroot(c - C_VAR); else lb = xbor; + lf = xfloat; ls = xstr; fresh = 0; + il = -1; + if (top && lv && lvk == LV_LOCAL) il = lvi; + opp = tpack(); + next(); rval(); plainuse(c); + lt = xty; + if (isfl(lt)) lf = 1; + src = -1; + if (blen[b] == -1) { // && : 0 if the left side is 0, else the right side as 0 or 1 + af_forget(); + ftest(); + a = hole(); op(O_JZ); + c = bin(p + 1); rval(); plainuse(c); + ftest(); + emitseq(useq[1], ulen[1]); // !! normalizes + j = hole(); op(O_JMP); + setlit(a, here); lit(0); setlit(j, here); + xfloat = 0; xstr = 0; + } else if (blen[b] == -2) { // || : 1 if the left side isn't 0, else the right side as 0 or 1 + af_forget(); + ftest(); + a = hole(); op(O_JZ); + lit(1); j = hole(); op(O_JMP); + setlit(a, here); + c = bin(p + 1); rval(); plainuse(c); + ftest(); + emitseq(useq[1], ulen[1]); + setlit(j, here); + xfloat = 0; xstr = 0; + } else { + c = bin(p + 1); + rb = -1; + if (c >= C_VAR && tracked(c - C_VAR)) rb = lroot(c - C_VAR); else rb = xbor; + if (top) { ft_ir = -1; if (lv && lvk == LV_LOCAL) ft_ir = lvi; } + rval(); plainuse(c); + if (cmode && bname[b] == s_star && xconst && xcval >= 2 && !(xcval & (xcval - 1)) && !lf) { + shifthint(opp, xcval); + } + rf = xfloat; rs = xstr; + if (isfl(xty)) rf = 1; + if ((ls || rs) && (bname[b] == s_plus || bname[b] == s_eqeq || bname[b] == s_ne || bname[b] == s_lt || bname[b] == s_gt || bname[b] == s_le || bname[b] == s_ge)) { + if (!(ls && rs)) serr("a byte string needs a byte string on the other side"); + if (bname[b] == s_plus) { callname(s_cat_s); xstr = 1; xfloat = 0; } + else if (bname[b] == s_eqeq) { callname(s_eq_s); xstr = 0; xfloat = 0; } + else if (bname[b] == s_ne) { callname(s_eq_s); lit(1); op(18); xstr = 0; xfloat = 0; } + else if (bname[b] == s_lt) { callname(s_lt_s); xstr = 0; xfloat = 0; } + else if (bname[b] == s_gt) { op(O_SWAP); callname(s_lt_s); xstr = 0; xfloat = 0; } + else if (bname[b] == s_le) { callname(s_le_s); xstr = 0; xfloat = 0; } + else { op(O_SWAP); callname(s_le_s); xstr = 0; xfloat = 0; } + } else if ((lf || rf) && isfop(bname[b])) { femit(bname[b], lf, rf); xstr = 0; } + else { emitseq(bseq[b], blen[b]); xfloat = 0; xstr = 0; } + if (bname[b] == s_plus || bname[b] == s_minus) { + if (lb >= 0) src = lb; else src = rb; + if (bname[b] == s_minus && lb >= 0 && rb >= 0) src = -1; // pointer difference is a distance + } + } + if (blen[b] < 0) af_forget(); + xty = bintype(b, lt, xty); + if (src >= 0 && xty[0] != TY_PTR && xty != tword) src = -1; + xbor = src; + if (top) { + ft_nops++; + if (ft_nops > 1) ft_iv = -1; + else if (bname[b] == s_lt && blen[b] > 0 && il >= 0 && ft_ir >= 0 && !lf && !rf && !ls && !rs) { ft_iv = il; ft_bd = ft_ir; } + } + lv = 0; lvk = LV_NONE; c = C_PLAIN; xzero = 0; xconst = 0; xlenloc = -1; xstamp = 0; xaf = 0; + if (fresh) c = C_FRESH; + } + return c; +} +// ---- assignment, conditionals and blocks as expressions ---- +int storekeep(int t) { + if (mdbg && !dry && !ispk(t)) { lit(1); op(O_PICK); callname(s_check); op(O_DROP); } + op(O_SWAP); lit(1); op(O_PICK); op(O_SWAP); + if (ispk(t)) pkst(t); else op(O_ST); + return 0; +} +// c ? a : b. both sides are analyzed from the same starting state (a snapshot, +// restored for the second side) and then joined, so a variable can't be given +// away on one side only. both sides are fresh objects, or neither is. +int ternary(int c) { + int a, b, s0, sa, livea, live0 = live, n0 = nloc, ca, cb, ta, ba, bb; + rval(); plainuse(c); + ftest(); + next(); + a = hole(); op(O_JZ); + s0 = snap_push(); + ca = expr(); rval(); ta = xty; ba = xbor; + if (ca != C_FRESH) plainuse(ca); + livea = live; sa = snap_push(); + b = hole(); op(O_JMP); + expect(s_colon); + setlit(a, here); + snap_restore(s0); live = live0; + cb = expr(); rval(); bb = xbor; + if (cb != C_FRESH) plainuse(cb); + join2(sa, livea, b, live, n0, "ends the two sides of ?: in different states"); + snap_pop(s0); + if (isfl(ta) && !isfl(xty)) { op(OP_I2F); xfloat = 1; xty = tfloat; } + if (!compat(ta, xty) && !compat(xty, ta)) tcerr("the two sides of ?:", ta, xty); + if (ta != tword && !isfl(ta)) xty = ta; + else if (isfl(ta) || isfl(xty)) { xty = tfloat; xfloat = 1; } + if (ba != bb) xbor = -1; + lv = 0; lvk = LV_NONE; xzero = 0; + if (ca == C_FRESH && cb == C_FRESH) return C_FRESH; + if (ca == C_FRESH || cb == C_FRESH) cerr("both sides of ?: have to be new objects, or neither"); + return C_PLAIN; +} +// the top of the expression grammar: a binary expression, then possibly ?: or +// an assignment. plain = stores the value and leaves it on the stack; the +// analyzer's assigncheck decides what the store means for ownership (a fresh +// object makes the target an owner, a u object moves up a block, and so on). +// compound assignment (+= etc.) loads the old value, applies the operator +// sequence from the table and stores the result. an o3 variable is stored with +// the value first and the address after, so no address waits on the stack +// across a branch. +int expr() { + int c = bin(1), k, i, a, rc, lt, lf, rf, fk; + if (tk != T_OP) return c; + if (tv == s_q) return ternary(c); + if (tv == s_eq) { + if (!lv) die("this can't be assigned to"); + k = lvk; i = lvi; lt = xty; + if (isagg(lt)) serr("a whole struct or array can't be assigned; assign its fields"); + next(); + a = o3on && k == LV_LOCAL && (ltag[i] & 16) && !larr[i]; + if (a) op(O_DROP); // an o3 variable: its address comes after the value, so it never waits on the stack across a branch + rc = expr(); rval(); + if (k != LV_LOCAL) af_escape(xaf); + fcoerce(lt); + if (k == LV_LOCAL) { + ltag[i] = ltag[i] | LASG; + setflt(i, xfloat); + setstr(i, xstr); + note_store(i); af_store(i); + } + if (!compat(lt, xty)) tcerr("assignment", lt, xty); + if (a) { lit(0); op(O_PICK); vaddr(i); op(O_ST); o3refresh(i); } + else { + if (o3on && k != LV_ELEM && hasptr(lt)) { lit(lt); callname(s_fatten); } // o3 data going somewhere normal code can see + storekeep(lt); + } + lv = 0; lvk = LV_NONE; xty = lt; xzero = 0; + return assigncheck(k, i, rc); + } + a = asgfind(tv); + if (a >= 0) { + if (!lv) die("this can't be assigned to"); + if (lvk == LV_LOCAL && fchk && tracked(lvi) && !isalias(lvi)) { + cerrn(lvi, "owns an object; compound assignment would lose it"); + } + lt = xty; + fk = -1; lf = xfloat; + if (lvk == LV_LOCAL) fk = lvi; + if (isfl(lt)) lf = 1; + next(); + i = o3on && lvk == LV_LOCAL && (ltag[lvi] & 16) && !larr[lvi]; + if (i) { i = lvi; op(O_DROP); vaddr(i); op(O_LD); i = i + 1; } + else if (ispk(lt)) { lit(0); op(O_PICK); pkld(lt); } + else { lit(0); op(O_PICK); op(O_LD); } + lv = 0; + rc = expr(); rval(); plainuse(rc); + rf = xfloat; + if ((lf || rf) && isfop(bname[abin[a]])) femit(bname[abin[a]], lf, rf); + else { emitseq(bseq[abin[a]], blen[abin[a]]); xfloat = 0; } + fcoerce(lt); + if (fk >= 0) { + lafact[fk] = 0; xaf = 0; + ltag[fk] = ltag[fk] | LASG; + setflt(fk, xfloat); setstr(fk, 0); + if (forstep && fk == ft_iv && bname[abin[a]] == s_plus && xconst && xcval == 1) fs_ok = 1; + if (bname[abin[a]] == s_plus && xconst && xcval > 0) putfact(fk, getlo(fk), -1); + else putfact(fk, -1, -1); + bpoison(fk); + } + k = bintype(abin[a], lt, xty); + if (!compat(lt, k)) tcerr("compound assignment", lt, k); + if (i) { lit(0); op(O_PICK); vaddr(i - 1); op(O_ST); } else storekeep(lt); + lv = 0; lvk = LV_NONE; xty = lt; xzero = 0; + return C_PLAIN; + } + return c; +} +// does the current token start a statement rather than an expression? +// a block as an expression: { stmts; tail }. it opens a scope like any block, +// so its variables are freed when it closes, and the tail is how a u object +// leaves the block with a value (handup). +word stmtstart() { + int s; + if (tk == T_OP) return tv == s_semi || tv == s_lb || tstart(); + if (tk != T_ID || findloc(tv) >= 0) return 0; + if (tstart()) return 1; + s = lookup(tv); + return s >= 0 && skind[s] == K_KW && !(sflag[s] & F_EXPR); +} +// { stmts; tail } as an expression: its value is the tail, or 0 +int blockexpr() { + int save = nloc, c = C_PLAIN, tail = 0, t = tint; + next(); + fdepth++; bxdepth++; + while (!is_op(s_rb)) { + if (tk == T_EOF) { die("missing }"); break; } + if (stmtstart()) { stmt(); continue; } + c = expr(); rval(); + if (accept(s_semi)) { op(O_DROP); discard(c); c = C_PLAIN; continue; } + if (!is_op(s_rb)) die("expected ; or } after an expression"); + tail = 1; t = xty; + } + next(); + if (tail) c = handup(c); else { lit(0); xbor = -1; xfloat = 0; xstr = 0; } + if (xbor >= save) xbor = -1; // that local dies with this block; the pointer leaves untracked + block_close(save); + fdepth--; bxdepth--; + lv = 0; lvk = LV_NONE; xty = t; xzero = 0; + return c; +} + +// ---- constant expressions ---- +// constant expressions, evaluated while compiling: numbers, named constants, +// addresses of globals and functions, unary minus and ~, parentheses, and the +// operators + - * | & << >>. used for array lengths, enum values, const +// initializers and asm operands. +word cprim() { + int v, s, mc; + if (tk == T_NUM) { v = tv; next(); return v; } + if (accept(s_minus)) return 0 - cprim(); + if (tk == T_OP && tv == uname[2]) { next(); return ~cprim(); } + if (accept(s_lp)) { v = cexpr(); expect(s_rp); return v; } + if (tk == T_ID) { + s = lookup(tv); + if (s >= 0 && (skind[s] == K_CONST || skind[s] == K_GARR || (skind[s] == K_FN && (sflag[s] & F_DEF)) || skind[s] == K_GVAR)) { + next(); + return sval[s]; + } + if (s >= 0 && skind[s] == K_TYPE) { // Enum.MEMBER in a constant expression + peekat(0); + if (pk_tk == T_OP && pk_tv == s_dot) { + peekat(1); + if (pk_tk == T_ID) { + mc = lookup(methname(tv, pk_tv)); + if (mc >= 0 && skind[mc] == K_CONST) { next(); next(); next(); return sval[mc]; } + } + } + } + } + die("expected a constant"); + return 0; +} +// compile an expression: a primary, then the operators that follow it. +int cexpr() { + int v = cprim(), o; + while (tk == T_OP) { + o = tv; + if (o == bname[3]) { next(); v = v + cprim(); } + else if (o == bname[4]) { next(); v = v - cprim(); } + else if (o == bname[0]) { next(); v = v * cprim(); } + else if (o == bname[15]) { next(); v = v | cprim(); } + else if (o == bname[13]) { next(); v = v & cprim(); } + else if (o == bname[5]) { next(); v = v << cprim(); } + else if (o == bname[6]) { next(); v = v >> cprim(); } + else return v; + } + return v; +} + +// ---- statements ---- +// after a syntax error: skip to the end of the statement +// statements. stmt is the dispatcher: a keyword statement (if, while, return, +// a parse word...), a declaration, an empty statement, a block, or an +// expression statement whose value is dropped. after a syntax error panic is +// set and stmt calls resync to skip to the next ; or }. +int resync() { + while (tk != T_EOF && !is_op(s_semi) && !is_op(s_rb)) next(); + if (is_op(s_semi)) next(); + panic = 0; + return 0; +} +// compile one statement. +int stmt() { + int s, c; + if (panic) return resync(); + if (tk == T_ID && findloc(tv) < 0) { + s = lookup(tv); + if (s >= 0 && skind[s] == K_KW && (sflag[s] & F_STMT)) { kwcall(s, 0); return 0; } + } + if (tstart()) { localdecl(1); return 0; } + if (tk == T_OP) { + if (tv == s_semi) { next(); return 0; } + if (tv == s_lb) { block(); return 0; } + } + c = expr(); rval(); op(O_DROP); + expect(s_semi); + discard(c); + return 0; +} +// compile a block, with its own scope for the locals it declares. +int block() { + int save = nloc; + expect(s_lb); + fdepth++; + while (!is_op(s_rb)) { if (tk == T_EOF) { die("missing }"); break; } stmt(); } + block_close(save); // before the }, so its line is the one reported + next(); + fdepth--; + return 0; +} +// the body of if/while/for: its own block, even without braces +// (the body of if/while/for is always its own block, even without braces, so +// variables declared in it die with it) +int substmt() { + int save = nloc; + if (is_op(s_lb)) return block(); + fdepth++; + stmt(); + block_close(save); + fdepth--; + return 0; +} +// let a = e, b[10]; or, typed: int a = 1, b; node*.m p = new(node); .u r; +// let infers pointer, struct and function types from the initializer and +// keeps numbers as plain words. +// (each declared name gets a slot; an initializer is compiled and stored, and +// assigncheck gives the new local its analyzer state. an initializer that is a +// constant number marks the local as a const candidate for the hints, and a +// new records the size and leaf-ness for the matching recycle.) +// the type of each untyped local while the language server checks a document: +// the byte offset of its name in the document, and the type's text in ltxt +// (one character per word). the server turns it into the hover of the local. +// record a parsed type expression so arrays, stars, and function types have hovers. +int ht_note(int start, int end, word t) { + if (!lt_on || isp != 0 || dry || !t || start < 0 || end <= start) return 0; + if (!ht_start || ht_n == htcap) { + if (ht_start) htcap = htcap * 2; + ht_start = chk_resize(ht_start, ht_n, htcap); + ht_end = chk_resize(ht_end, ht_n, htcap); + ht_type = chk_resize(ht_type, ht_n, htcap); + } + ht_start[ht_n] = start; ht_end[ht_n] = end; ht_type[ht_n] = t; ht_n++; + return 0; +} +// record the type of a local at byte offset o for the language server. +int lt_note(int o, int t) { + int sm, sb, sn, sc, sl, need; + if (!lt_on || isp != 0 || dry || o < 0 || !t) return 0; + if (!lt_off || lt_n == ltcap) { + if (lt_off) ltcap = ltcap * 2; + lt_off = chk_resize(lt_off, lt_n, ltcap); lt_at = chk_resize(lt_at, lt_n, ltcap); + lt_len = chk_resize(lt_len, lt_n, ltcap); lt_type = chk_resize(lt_type, lt_n, ltcap); + } + sm = outmode; sb = outbuf; sn = outn; sc = outcap; + outmode = 3; outn = 0; tprint(t); need = ltxn + outn; + if (!ltxt || need > ltxtcap) { + while (need > ltxtcap) ltxtcap = ltxtcap * 2; + ltxt = chk_resize(ltxt, ltxn, ltxtcap); + } + outmode = 2; outbuf = ltxt; outn = ltxn; outcap = ltxtcap; + tprint(t); + sl = outn; + outmode = sm; outbuf = sb; outn = sn; outcap = sc; + lt_off[lt_n] = o; lt_at[lt_n] = ltxn; lt_len[lt_n] = sl - ltxn; lt_type[lt_n] = t; lt_n++; + ltxn = sl; + return 0; +} +// compile a local declaration, typed or let-style. +int localdecl(int typed) { + int n, i, c, k, t = 0, tg = 0, pp, kc, kp = ifkp, gty = 0, gok = !typed && ifon && !dry, o; + if (typed) { dtype(); t = dty; tg = dtag; if (t == tvoid) serr("a variable can't be void"); } + if ((o3on || o3one) && !typed) serr("o3 variables need a type"); + while (1) { + pp = tpack(); + o = toff; + rs_note(RS_LOCAL, o); + n = name(); + i = newloc(n); + lrsoff[i] = o; + ltag[i] = tg | LDECL; lpos[i] = pp; lnsz[i] = 0; lleaf[i] = 0; + if (o3on || o3one) ltag[i] = ltag[i] | 16; + if (accept(s_lk)) { + k = cexpr(); expect(s_rk); + if (!t) t = tword; + larr[i] = 1; ltype[i] = tarr(t, k); fslots = fslots + tsz(ltype[i]); + if (gok) { if (!gty) gty = tint; else if (gty != tint) gok = 0; } + } else if (t && isagg(t)) { larr[i] = 1; ltype[i] = t; fslots = fslots + tsz(t); } + else { fslots++; if (t) ltype[i] = t; if (isfl(t)) setflt(i, 1); if (o3on) { o3promote(i); o3mkcache(i); } } + if (accept(s_eq)) { + if (larr[i]) serr("an array or a struct can't be initialized with ="); + newsz = -1; newleaf = 0; if (tk == T_NUM) nomagic = 1; + c = expr(); rval(); nomagic = 0; kc = xconst && !xfloat; + if (kc) ltag[i] = ltag[i] | LCONST; + if (c == C_FRESH) { lnsz[i] = newsz; lleaf[i] = newleaf; } + if (t) fcoerce(t); + vaddr(i); + op(O_ST); + o3refresh(i); + setflt(i, xfloat); + setstr(i, xstr); + note_store(i); af_store(i); + if (t) { if (!compat(t, xty)) tcerr("initializer", t, xty); } + else if (!isnum(xty)) { + if (xty[0] == TY_ARR) ltype[i] = decay(xty); + else if (xty[0] == TY_STRUCT) ltype[i] = tptr(xty); + else ltype[i] = xty; + } + assigncheck(LV_LOCAL, i, c); + if (gok) { k = xty; if (isagg(k)) k = ltype[i]; if (!ifpure(k) || (gty && gty != k)) gok = 0; else gty = k; } + } else if (gok && !larr[i]) gok = 0; // no initializer: nothing says what it is + if (larr[i]) { k = 1; if (ltype[i][0] == TY_ARR) k = ltype[i][3]; lafact[i] = af_new(k, 1, pp); laaddr[i] = lafact[i]; if (lafact[i]) lafact[i][5] = i; } + af_declaration(o, lafact[i]); + kc = tword; + if (ltype[i]) kc = ltype[i]; + lt_note(((pp >> 40) & 0x1FFFFF) - 1, kc); + if (!accept(s_comma)) break; + } + expect(s_semi); + if (gok && gty && kp) fact_add(kp, 0 - 1, gty, ""); + return 0; +} +// compile a variable declaration. +int kw_var() { + stmtonly(); + ifkp = 0; + if (isp == 0) ifkp = tpack(); // only the document itself: an include has other offsets + next(); + return localdecl(0); +} +// if / else. the shape of every branching construct is the same: snapshot the +// analyzer state, compile one path, restore the snapshot, compile the other, +// then join the two end states (join2). a path that does not reach the join +// (it returned or broke) is left out. without an else the "other path" is +// the state before the branch. +int kw_if() { + int a, b, c, s0, sa, live0, livea, n0 = nloc, nt, cj; + stmtonly(); + next(); + expect(s_lp); c = expr(); rval(); plainuse(c); ftest(); expect(s_rp); + a = hole(); op(O_JZ); + live0 = live; + s0 = snap_push(); + substmt(); + livea = live; sa = snap_push(); + if (is_id(s_else)) { + next(); + b = hole(); op(O_JMP); + setlit(a, here); + snap_restore(s0); live = live0; + substmt(); + join2(sa, livea, b, live, n0, "ends the branches of an if in different states"); + } else { + // the path that skips the then branch still has the states from before it + njps = 0; if (livea) jadd(R_SNAP + sa); if (live0) jadd(R_SNAP + s0); + join(n0, "ends the branches of an if in different states"); + if (livea) fixups(R_SNAP + sa, n0, 1); + nt = 0; if (live0) nt = fixups(R_SNAP + s0, n0, 0); + if (nt) { + cj = hole(); + op(O_JMP); + setlit(a, here); + fixups(R_SNAP + s0, n0, 1); + setlit(cj, here); + } + else setlit(a, here); + live = livea || live0; + } + snap_pop(s0); + return 0; +} +// loop frame: 0 continue target (-1 for a switch) 2 depth 3 snapshot at the top +// 4 block-expression depth 5 locals at the start 6 its first exit record +// loops and switches share a frame stack (R_LOOP, 8 words each). a break adds +// an exit record (the analyzer state at that point) with a jump to patch; +// loop_end joins all of them with the normal fall-out and patches the jumps. +int loop_push(int cont, int s0) { + word f; + reserve_R_LOOP((lsp + 1) * 8); + if (lsp >= loopfacts_cap) { lpfact = chk_resize(lpfact, loopfacts_cap, loopfacts_cap * 2); loopfacts_cap = loopfacts_cap * 2; } + f = R_LOOP + lsp * 8; + f[0] = cont; + f[1] = 0; + f[2] = fdepth; + f[3] = s0; + f[4] = bxdepth; + f[5] = nloc; + f[6] = extop; + f[7] = 0; + lpfact[lsp] = -1; + lsp++; + return 0; +} +// the end of a loop or switch: join its exits (the fall-out path sc through +// the jump at a, if there is one, and every break) and lay out each path's +// fixups on its way to the end +int loop_end(int a, int sc) { + word f, p; int e, n0, outs = 0; + lsp--; + f = R_LOOP + lsp * 8; + n0 = f[5]; + njps = 0; + if (sc >= 0) jadd(R_SNAP + sc); + p = R_EXIT + f[6]; e = R_EXIT + extop; + while (p < e) { jadd(p + 1); p = p + 3 + 3 * (p[2] - p[1]); } + join(n0, "leaves the loop in different states on different paths"); + live = njps > 0; + p = R_EXIT + f[6]; + while (p < e) { + if (fixups(p + 1, n0, 0)) { + setlit(p[0], here); + fixups(p + 1, n0, 1); + outs = fixnew(hole(), outs); + op(O_JMP); + } + else outs = fixnew(p[0], outs); + p = p + 3 + 3 * (p[2] - p[1]); + } + if (a >= 0) setlit(a, here); + if (sc >= 0) fixups(R_SNAP + sc, n0, 1); + fixall(outs, here); + extop = f[6]; + return 0; +} +// while. the back edge is checked against the snapshot taken at the top, so a +// loop body that gives something away and comes around again is an error. a +// literal while (1) has no fall-out path, only its breaks. +int kw_while() { + int c0 = here, a, s0, sc = -1, c, inf = 0; + stmtonly(); + next(); + s0 = snap_push(); + expect(s_lp); + // while (1): no way out but break + if (tk == T_NUM && tv) { + peek(); + if (pk_tk == T_OP && pk_tv == s_rp) inf = 1; + } + c = expr(); rval(); plainuse(c); ftest(); expect(s_rp); + a = hole(); op(O_JZ); + if (!inf && live) sc = snap_push(); + loop_push(c0, s0); + substmt(); + backedge(s0); + jmp(c0); + loop_end(a, sc); + snap_pop(s0); + return 0; +} +// for (init; test; step) body. the code is laid out test first, then a jump +// over the step into the body, and the step jumps back to the test, so the +// step is compiled before the body but runs after it. while the test and the +// step are parsed, fortest and forstep record the shape "i < bound ... i++": +// if it holds and the bound is len(a) of a fixed array, the body is told that +// a[i] is in range (lpfact), and its bounds check disappears. +int kw_for() { + int save = nloc, s0, sc = -1, c0, a, b, st, c, inf = 0; + stmtonly(); + next(); + expect(s_lp); + fdepth++; + if (is_id(s_var)) kw_var(); + else if (tstart()) localdecl(1); + else { if (!is_op(s_semi)) { c = expr(); rval(); op(O_DROP); discard(c); } expect(s_semi); } + s0 = snap_push(); + c0 = here; + ft_iv = -1; fs_ok = 0; fortest = 1; + if (!is_op(s_semi)) { + if (tk == T_NUM && tv) { peek(); if (pk_tk == T_OP && pk_tv == s_semi) inf = 1; } + c = expr(); rval(); plainuse(c); ftest(); + } else { lit(1); inf = 1; xfloat = 0; } + fortest = 0; + expect(s_semi); + a = hole(); op(O_JZ); + if (!inf && live) sc = snap_push(); + b = hole(); op(O_JMP); + st = here; + forstep = 1; + if (!is_op(s_rp)) { c = expr(); rval(); op(O_DROP); discard(c); } + forstep = 0; + expect(s_rp); + jmp(c0); + setlit(b, here); + loop_push(st, s0); + if (ft_iv >= 0 && ft_bd >= 0 && fs_ok && getlo(ft_iv) >= 0 && getln(ft_bd) >= 0) { + lpfact[lsp - 1] = pfact(ft_iv, ft_bd, getln(ft_bd)); + } + substmt(); + backedge(s0); + jmp(st); + loop_end(a, sc); + snap_pop(s0); + block_close(save); + fdepth--; + return 0; +} +// do stmt while (cond); the body runs once before the test. continue jumps +// to the test, which is patched in after the body (f[0] == -2 marks that). +int kw_do() { + int body, s0, sc = -1, a, c; word f; int inf = 0; + stmtonly(); + next(); + s0 = snap_push(); + body = here; + loop_push(-2, s0); + substmt(); + f = R_LOOP + (lsp - 1) * 8; + fixall(f[7], here); + backedge(s0); + if (!is_id(s_while)) die("expected while after do"); + next(); + expect(s_lp); + if (tk == T_NUM && tv) { peek(); if (pk_tk == T_OP && pk_tv == s_rp) inf = 1; } + c = expr(); rval(); plainuse(c); ftest(); + expect(s_rp); + expect(s_semi); + if (!inf && live) sc = snap_push(); + a = hole(); op(O_JZ); + jmp(body); + loop_end(a, sc); + snap_pop(s0); + return 0; +} +// break and continue unwind the scopes they leave (exit_vars frees what those +// blocks own on the way out). break records the analyzer state for the join +// at the end of the loop; continue checks the state against the loop top. +int kw_break() { + word f; + stmtonly(); + next(); expect(s_semi); + if (lsp <= loopbase) { serr("break outside a loop or a switch"); return 0; } + f = R_LOOP + (lsp - 1) * 8; + if (f[4] != bxdepth) { serr("break can't leave a block expression"); return 0; } + exit_vars(f[2] + 1, 0); + if (live) exit_rec(hole()); else hole(); + op(O_JMP); + live = 0; + return 0; +} +// compile continue: jump to the test of the innermost loop. +int kw_continue() { + int j = lsp - 1; word f; + stmtonly(); + next(); expect(s_semi); + while (j >= loopbase && R_LOOP[j * 8] == -1) j--; // past any switch + if (j < loopbase) { serr("continue outside a loop"); return 0; } + f = R_LOOP + j * 8; + if (f[4] != bxdepth) { serr("continue can't leave a block expression"); return 0; } + backedge(f[3]); + exit_vars(f[2] + 1, 0); + if (f[0] == -2) { f[7] = fixnew(hole(), f[7]); op(O_JMP); } // do/while: the condition isn't placed yet + else jmp(f[0]); + live = 0; + return 0; +} +// switch (e) { case 1, 2: ... case 'x': ... default: ... } +// cases don't fall through: each one ends where the next begins, and break +// leaves the switch early. case labels are constants. +// one case's statements, analyzed from the state at the top of the switch. +// the end of a case jumps out of the switch, so cases never fall through. +int casebody(int s0, int live0) { + int save = nloc; + snap_restore(s0); live = live0; + fdepth++; + while (!is_op(s_rb) && !is_id(s_case) && !is_id(s_default)) { + if (tk == T_EOF) { die("missing }"); break; } + stmt(); + } + block_close(save); + fdepth--; + if (live) { exit_rec(hole()); op(O_JMP); } // the end of a case leaves the switch + live = 0; + return 0; +} +// compile a switch statement. +int kw_switch() { + int sl = tline; + int save = nloc, tmp, c, s0, live0, defent = -1, skip, nxt, bj, v, a = -1, st, tg = 0, cov = 0, gi, nb = 0, j, arm, bi; + [8]word pbn; [8]word pbl; + stmtonly(); + next(); + expect(s_lp); c = expr(); st = xty; rval(); plainuse(c); expect(s_rp); + tg = ptagged(st); + fdepth++; + tmp = newloc(0); fslots++; // a hidden local holds the value + laddr(lslot[tmp]); op(O_ST); + live0 = live; + s0 = snap_push(); + loop_push(-1, s0); + expect(s_lb); + while (!is_op(s_rb)) { + if (tk == T_EOF) { die("missing }"); break; } + if (is_id(s_case)) { + next(); + bj = 0; + gi = -1; + peek(); + if (tg && tk == T_ID && pk_tk == T_OP && pk_tv == s_lp) gi = pm_find(tv); + if (gi >= 0) { + // case member(a, b): a member of a tagged enum, its fields bound to the names + next(); next(); + nb = 0; + while (!is_op(s_rp)) { + if (nb >= 8) { die("too many names in a case"); break; } + pbn[nb] = name(); nb++; + if (!accept(s_comma)) break; + } + expect(s_rp); + if (nb != pm_nf[gi]) serr("a case binds every field of its member"); + v = pm_tag[gi]; + if (v < 63) cov = cov | (1 << v); + laddr(lslot[tmp]); op(O_LD); op(O_LD); lit(v); op(O_SUB); + bj = fixnew(hole(), bj); op(O_JZ); + expect(s_colon); + arm = nloc; + for (j = 0; j < nb && j < pm_nf[gi]; j++) { + bi = newloc(pbn[j]); fslots++; + ltype[bi] = pm_ft[gi * 8 + j]; + if (isfl(ltype[bi])) setflt(bi, 1); + pbl[j] = bi; + } + nxt = hole(); op(O_JMP); + fixall(bj, here); + for (j = 0; j < nb && j < pm_nf[gi]; j++) { + laddr(lslot[tmp]); op(O_LD); lit(pm_off[gi * 8 + j]); op(O_ADD); op(O_LD); + vaddr(pbl[j]); op(O_ST); + } + casebody(s0, live0); + block_close(arm); + setlit(nxt, here); + } else { + while (1) { + v = cexpr(); + if (tg && v >= 0 && v < 63) cov = cov | (1 << v); + laddr(lslot[tmp]); op(O_LD); + if (tg) op(O_LD); + lit(v); op(O_SUB); + bj = fixnew(hole(), bj); op(O_JZ); + if (!accept(s_comma)) break; + } + expect(s_colon); + nxt = hole(); op(O_JMP); + fixall(bj, here); + casebody(s0, live0); + setlit(nxt, here); + } + } else if (is_id(s_default)) { + next(); expect(s_colon); + if (defent >= 0) serr("a switch has one default"); + skip = hole(); op(O_JMP); // only reached when nothing matched + defent = here; + casebody(s0, live0); + setlit(skip, here); + } else die("expected case or default"); + } + next(); + snap_restore(s0); live = live0; + if (tg && defent < 0) cover_warn(tg - 1, cov, sl); + if (defent >= 0) { jmp(defent); loop_end(-1, -1); } + else { a = hole(); op(O_JMP); loop_end(a, s0); } // nothing matched: out with the states from the top + snap_pop(s0); + block_close(save); + fdepth--; + return 0; +} +// return: coerce and check the value, run the analyzer's return rule, free +// everything the function owns (exit_vars from depth 1), and jump to the +// epilogue, which is a patch chain resolved when the function ends. +int kw_return() { + int c, returned = tint; + stmtonly(); + next(); + if (!infn) serr("return outside a function"); + if (bxdepth) serr("return can't leave a block expression"); + if (is_op(s_semi)) { lit(0); c = C_PLAIN; if_ret(0, 1); } + else { + c = expr(); rval(); + returned = xty; + if_ret(xty, xzero); + if (fty && fty != tvoid) fcoerce(fty); + if (fty == tvoid) tcerr("return value", tvoid, xty); + else if (fty && !compat(fty, xty)) tcerr("return value", fty, xty); + } + if (nclo) { + if (!clo_ret[nclo - 1]) clo_ret[nclo - 1] = returned; + else if (clo_ret[nclo - 1] != returned) clo_ret[nclo - 1] = 0 - 1; + } + expect(s_semi); + retcheck(c); + exit_vars(1, 0); + epichain = fixnew(here, epichain); + lit(MW - 1); op(O_JMP); + live = 0; + return 0; +} +// o3 { ... }: an optimized region. o3 T x = e;: one o3 variable +// (a block is compiled as normal code behind a jump and handed to the core +// as a region once the function is complete: o3pend queues them. variables +// declared outside that are o3 get registers too, and anything with a pointer +// in it is fattened when control leaves the region.) +int kw_o3() { + int lo, i; word p; int save, outer; + stmtonly(); + next(); + if (!is_op(s_lb)) { o3one = 1; localdecl(1); o3one = 0; return 0; } + if (o3on || !infn) return block(); + reserve_code(2); lo = here + 2; lit(lo); op(O_JMP); + o3on = 1; o3reset(); + save = nloc; outer = nloc; + i = lbase; + // o3 variables declared outside + while (i < outer) { + if (ltag[i] & 16) { + o3promote(i); + o3mkcache(i); + o3refresh(i); + } + i++; + } + block(); + o3on = 0; + if (no3pend >= o3pendcap) { o3pend = chk_resize(o3pend, no3pend * 67, o3pendcap * 2 * 67); o3pendcap = o3pendcap * 2; } + { + p = o3pend + no3pend * 67; p[0] = lo; p[1] = here; p[2] = no3sl; + copy_w(p + 3, o3sl, no3sl); copy_w(p + 35, o3rg, no3sl); no3pend++; + } + local_drop(save); fdrop(save); // the hidden cache variables + i = lbase; + while (i < outer) { + ltag[i] = ltag[i] - (ltag[i] & 1792); o3cache[i] = 0; + // leaving o3: fatten what they hold + if ((ltag[i] & 16) && hasptr(ltype[i])) { + vaddr(i); + op(O_LD); + lit(ltype[i]); + callname(s_fatten); + op(O_DROP); + } + i++; + } + return 0; +} +// unchecked turns the analyzer off for one statement +int kw_unchecked() { + int old = fchk; + stmtonly(); + next(); + fchk = 0; + substmt(); + fchk = old; + return 0; +} + +// ---- asm blocks: raw vm words, one per token ---- +// numbers push, -n pushes a negative number, #n emits a raw word, one-char +// tokens from the mnemonic table are opcodes, names push the address of a +// variable or function, :name defines a label for this block. +// (labels are local to the block: :name defines one, a later name refers to it, +// and references to labels not yet defined are resolved when the block ends) +word asm_names = R_ASM, asm_sites = R_ASM + ASM_LABELS; +word asm_refs = R_ASM + ASM_LABELS + ASM_LABELS, asm_fixes = R_ASM + ASM_LABELS + ASM_LABELS + ASM_REFS; +int asm_labelcap = ASM_LABELS, asm_refcap = ASM_REFS; +int reserve_asm_labels(int need) { + int cap = asm_labelcap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + asm_names = chk_resize(asm_names, asm_labelcap, cap); asm_sites = chk_resize(asm_sites, asm_labelcap, cap); + asm_labelcap = cap; return cap; +} +int reserve_asm_references(int need) { + int cap = asm_refcap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + asm_refs = chk_resize(asm_refs, asm_refcap, cap); asm_fixes = chk_resize(asm_fixes, asm_refcap, cap); + asm_refcap = cap; return cap; +} +int asmblock() { + af_forget(); + int nl = 0, nr = 0, i, k, c, s; word ln = asm_names, la = asm_sites, rn = asm_refs, ra = asm_fixes; + expect(s_lb); + while (!is_op(s_rb)) { + if (tk == T_EOF) { die("unterminated asm block"); break; } + if (tk == T_FLT) { op(OP_FLIT); emit(tv); next(); continue; } + if (tk == T_NUM) { lit(tv); next(); continue; } + if (tk == T_BSTR) { bstrlit(tv); next(); continue; } + if (tk == T_STR) { strlit(tv); next(); continue; } + if (is_op(s_hash)) { + next(); + if (tk != T_NUM) die("# needs a number"); + emit(tv); + next(); + continue; + } + if (is_op(s_minus)) { + next(); + if (tk == T_NUM && tglue) { + lit(0 - tv); + next(); + } else { + op(O_SUB); + } + continue; + } + if (is_op(s_colon)) { + next(); + reserve_asm_labels(nl + 1); ln = asm_names; la = asm_sites; + ln[nl] = name(); + la[nl] = here; + nl++; + continue; + } + if (tv[0] && !tv[1] && (c = mnemidx(tv[0])) >= 0) { op(c); next(); continue; } + if (tk != T_ID) die("bad token in asm"); + i = findloc(tv); + if (i >= 0 && (ltag[i] & 16) && !larr[i]) serr("asm can't reach an o3 variable"); + if (i >= 0) { luse(i); ltag[i] = ltag[i] | LREAD | LASG; laddr(lslot[i]); next(); continue; } + k = -1; i = 0; + while (i < nl) { if (ln[i] == tv) k = i; i++; } + if (k >= 0) { lit(la[k]); next(); continue; } + s = lookup(tv); + if (s >= 0 && skind[s] == K_ENH) { op(XOP0 + sval[s]); next(); continue; } + if (s >= 0 && skind[s] != K_FN && skind[s] != K_KW) { lit(sval[s]); next(); continue; } + if (s >= 0 && skind[s] == K_FN) { fnref(s); next(); continue; } + reserve_asm_references(nr + 1); rn = asm_refs; ra = asm_fixes; + rn[nr] = tv; ra[nr] = hole(); nr++; next(); // a label further down this block + } + next(); + i = 0; + while (i < nr) { + k = -1; c = 0; + while (c < nl) { if (ln[c] == rn[i]) k = c; c++; } + if (k < 0) serrn(rn[i], "unknown name in asm"); + setlit(ra[i], la[k]); + i++; + } + return 0; +} +// virtual enhancement bodies are recipes read as a flat range by the host. +int contiguous_asm() { + word q = grab(), wrapped; int n = q[0], i = 0, need = 2, entry, at; + while (i < n) { + need = need + 16; + if (q[1 + i * 3] == T_STR || q[1 + i * 3] == T_BSTR) need = need + len_w(q[2 + i * 3]); + i++; + } + reserve_code(need); entry = here; + wrapped = chk_resize(0, 0, n * 3 + 7); wrapped[0] = n + 2; + wrapped[1] = T_OP; wrapped[2] = s_lb; wrapped[3] = tpack(); + copy_w(wrapped + 4, q + 1, n * 3); at = 4 + n * 3; + wrapped[at] = T_OP; wrapped[at + 1] = s_rb; wrapped[at + 2] = tpack(); + src_push(1, wrapped, 0, 0); next(); asmblock(); src_pop(); op(O_RET); + free(d*q); return entry; +} +// asm as a keyword (statement or expression): the block's own stack effect is +// the program's responsibility, so the result is a plain word +int kw_asm() { + next(); + asmblock(); + xcls = C_PLAIN; + return 0; +} + +// ---- quote: code as data ---- +// a token list is an object: [n] then kind, value, line for each token. names, +// strings and operators are interned pointers. +// grab reads the { ... } after quote or times (a parse word) into a token list, +// stopping at the matching brace. it buffers the tokens in R_QBUF, then copies +// them to a fresh object. quote compiles a list into the program as data and +// returns a copy at run time; feed (below) pushes a list back as input. +word .u grab() { + int n = 0, depth = 0; word q; + if (!is_op(s_lb)) die("expected {"); + next(); + while (1) { + if (tk == T_EOF) { die("unterminated quote"); break; } + if (is_op(s_lb)) depth++; + if (is_op(s_rb)) { if (!depth) break; depth--; } + reserve_R_QBUF((n + 1) * 3); + R_QBUF[n * 3] = tk; R_QBUF[n * 3 + 1] = tv; R_QBUF[n * 3 + 2] = tline; n++; + next(); + } + next(); + q = new(n * 3 + 1); + q[0] = n; + copy_w(q + 1, R_QBUF, n * 3); + return u*q; +} +unchecked word .u qnew(word src) { int n = src[0] * 3 + 1; word q = new(n); copy_w(q, src, n); return q; } +word .u qdup(.m q) { int n = q[0] * 3 + 1; word r = new(n); copy_w(r, q, n); return u*r; } +// emit n words copied from the array q. +int wcopyto(.m q, int n) { + int i = 0; reserve_code(n); + while (i < n) { emit(q[i]); i++; } + return 0; +} +// quote { tokens }: the list is emitted into the code behind a jump, and the +// expression's value is a fresh copy of it (qnew), so a program can edit its +// copy without touching the original +int kw_quote() { + word q; int j, a, n; + next(); + q = grab(); + j = hole(); op(O_JMP); + n = q[0] * 3 + 1; reserve_code(n); a = here; + wcopyto(q, n); + free(d*q); + setlit(j, here); + lit(a); + callname(s_qnew); + xcls = C_FRESH; + return 0; +} +// tokens of a string, as a token list +word .u tokens(int s) { + int n = 0; word q; + src_push(2, s, 0, 0); + next(); + while (tk != T_EOF) { + reserve_R_QBUF((n + 1) * 3); + R_QBUF[n * 3] = tk; R_QBUF[n * 3 + 1] = tv; R_QBUF[n * 3 + 2] = tline; n++; + next(); + } + src_pop(); + q = new(n * 3 + 1); + q[0] = n; + copy_w(q + 1, R_QBUF, n * 3); + return u*q; +} +// feed a token list into the input: the parser reads it next, then carries +// on where it was. the list is freed once it has been read. +unchecked int feed(.d q) { + src_push(1, q, 1, 1); + next(); + return 0; +} + +// ---- reading a unit and scanning it for signatures ---- +// a unit from stdin is read whole first (4 chars to a word), then scanned +// once for function signatures, so a function's tags are known before its first +// call even when it's defined further down. +// read the whole unit from stdin, up to a backtick (outside comments and +// literals, see srcend) or end of input, packing 4 +// characters to a word, so prescan can run over it and then the real parse can +// run over the same text +unchecked word readsrc() { + int cap = 4090; word b; int n = 0, c; word nb; int w; + b = new(4090); + qst = 0; qp = 0; qesc = 0; + while (!asm { ? }) { + c = asm { , } & 255; + // srcend only has anything to decide at a quote, a slash or a star (or + // inside a comment or literal); every other character in plain code just + // clears the "previous char was a slash" memory + if (qst || c == 34 || c == 39 || c == '/' || c == '*' || c == 96) { if (srcend(c)) break; } + else qp = 0; + if ((n >> 2) + 2 >= cap) { + nb = new(cap + cap + 6); + copy_w(nb, b, cap); + free(b); + b = nb; + cap = cap + cap + 6; + } + w = n >> 2; + if (!(n & 3)) b[w] = 0; + b[w] = b[w] | (c << ((n & 3) * 8)); + n++; + } + b[n >> 2] = b[n >> 2] & (pow2[(n & 3) * 8] - 1); // the 0 at the end + if ((n & 3) == 0) b[n >> 2] = 0; + b[(n >> 2) + 1] = 0; + return b; +} +// skip a <...> group (type parameters) +// prescan: before a unit is compiled, one dry pass over it records the +// signature (parameter tags, .u return, o3) of every function declared in it, +// so a call that appears before its definition is checked against the tags +// the callee will have. it only needs the shape of a declaration, not its body. +int pskipangle() { + int dp = 0; + while (tk != T_EOF) { + if (is_op(s_lt)) dp++; + else if (is_op(s_gt)) dp--; + else if (is_op(s_shr)) dp = dp - 2; + next(); + if (dp <= 0) return 0; + } + return 0; +} +// at the name after fn: read the signature's tags and record them +// prescan: at the ( after a function name, read the parameter list and record +// the signature packed into ssig (bit 0 .u return, bits 1..5 parameter count, +// two bits per parameter from bit 6) +int prescan_fn(int ret, int n, int o3) { + int np = 0, tags = 0, t = 0, dp, s; + next(); // the ( + if (!is_op(s_rp)) { + np = 1; dp = 1; + while (tk != T_EOF) { + if (is_op(s_lp)) dp++; + else if (is_op(s_rp)) { dp--; if (!dp) break; } + else if (dp == 1 && is_op(s_comma)) { if (np <= 12) tags = tags + (t << (np + np - 2)); np++; t = 0; } + else if (dp == 1 && is_op(s_dot)) { next(); if (is_id(s_m)) t = 1; else if (is_id(s_d)) t = 2; continue; } + next(); + } + if (np <= 12) tags = tags + (t << (np + np - 2)); + } + next(); + if (!is_op(s_lb) && !is_op(s_semi)) return 0; // not a function: an enhancement, a call in a parse word... + if (!dnm) dnm = n; + s = lookup(n); + if (s < 0 || s < ubase || skind[s] != K_FN || (sflag[s] & F_DEF)) s = fwdfn(n); + if (!(sflag[s] & F_SIG)) { + ssig[s] = ret + np + np + tags * 64; + sflag[s] = sflag[s] | F_SIG | F_PRE; + } + if (o3) sflag[s] = sflag[s] | F_O3; + return 0; +} +// scan ahead, without emitting code, to learn what a block of tokens contains. +int prescan(int kind, int obj) { + int depth = 0, sp = panic, sn = nerr, pend = 0, po3 = 0, n, dep; + dry++; + src_push(kind, obj, 0, 0); + next(); + while (tk != T_EOF) { + if (is_op(s_lb)) depth++; + else if (is_op(s_rb)) { depth--; pend = 0; po3 = 0; } + else if (depth <= 0) { + if (is_op(s_semi)) { pend = 0; po3 = 0; } + else if (is_op(s_dot)) { peek(); if (pk_tk == T_ID && pk_tv == s_u) pend = 1; } + else if (is_id(s_o3)) po3 = 1; + else if (tk == T_ID) { + peek(); + if (pk_tk == T_OP && pk_tv == s_lp) { + n = tv; + next(); + prescan_fn(pend, n, po3); + pend = 0; + po3 = 0; + continue; + } + if (pk_tk == T_OP && pk_tv == s_lt) { // list in a type, or first( a generic function + n = tv; next(); dep = 0; + while (tk != T_EOF) { + if (is_op(s_lt)) { + dep++; + } else if (is_op(s_gt)) { + dep--; + } else if (is_op(s_shr)) dep = dep - 2; + next(); + if (dep <= 0) break; + } + if (is_op(s_lp)) { prescan_fn(pend, n, po3); pend = 0; po3 = 0; } + continue; + } + } + } + next(); + } + src_pop(); + dry--; panic = sp; nerr = sn; + return 0; +} +// compile a whole unit from stdin +int unit_stdin() { + int src = readsrc(); + prescan(3, src); + src_push(3, src, 0, 0); + next(); + unit_top(); + unit_end(ubase); + src_pop(); + free(src); + return 0; +} + +// ---- nested compiles ---- +// compile() and load() can run while another function is being compiled (from +// a parse word). the function context is saved, the new code is emitted in +// place with a jump around it, and then everything is put back. +// the context frame is 34 words: everything about the function being compiled +// that a nested compile would otherwise clobber (locals, depth, frame size, +// loop stack position, the expression-state globals). closures use the same +// pair. +const int CTX_WORDS = 34; +int ctx_push() { + af_forget(); + word f; + reserve_R_CTX((ctxsp + 1) * CTX_WORDS); f = R_CTX + ctxsp * CTX_WORDS; + ctxsp++; + f[0] = nloc; f[1] = lbase; f[2] = fdepth; f[3] = fslots; f[4] = fchk; f[5] = fret; f[6] = live; + f[7] = bxdepth; f[8] = epichain; f[9] = fframe; f[10] = infn; f[11] = lsp; f[12] = loopbase; + f[13] = lv; f[14] = lvk; f[15] = lvi; f[16] = kw_expr; f[17] = xcls; f[18] = snaptop; + f[19] = fty; f[20] = ntp; f[21] = xty; copy_w(f + 22, tpn, 8); + f[30] = finsym; f[31] = finfer; f[32] = ifcur; f[33] = ifcall; + return 0; +} +// pop the innermost function context. +int ctx_pop() { + word f; + ctxsp--; + f = R_CTX + ctxsp * CTX_WORDS; + local_drop(f[0]); + fdrop(nloc); + lbase = f[1]; + fdepth = f[2]; + fslots = f[3]; + fchk = f[4]; + fret = f[5]; + live = f[6]; + bxdepth = f[7]; epichain = f[8]; fframe = f[9]; infn = f[10]; lsp = f[11]; loopbase = f[12]; + lv = f[13]; lvk = f[14]; lvi = f[15]; kw_expr = f[16]; xcls = f[17]; snaptop = f[18]; + fty = f[19]; ntp = f[20]; xty = f[21]; copy_w(tpn, f + 22, 8); + finsym = f[30]; finfer = f[31]; ifcur = f[32]; ifcall = f[33]; + return 0; +} + +// ---- functions and the top level ---- +// ---- a function, start to finish ---- +// fndef reads the header, then: fn_begin resets the per-function state, +// prologue emits the frame setup, the parameters are declared and stored from +// the stack into their slots, body parses the statements, and epilogue emits +// the shared exit (return jumps here through the epichain patch list). the +// frame size is not known until the end, so the prologue's subtract is a hole +// that epilogue fills with fslots. +// fn_begin: chk is 0 for unchecked, ret is 1 for a .u return +int fn_begin(int chk, int ret) { + lbase = nloc; fdepth = 1; fslots = 0; fchk = chk && check_on; fret = ret; fty = 0; finfer = 0; + live = 1; bxdepth = 0; epichain = 0; infn = 1; loopbase = lsp; lv = 0; lvk = LV_NONE; xbor = -1; + return 0; +} +// allocate the frame, retaining the caller's pointer until any growth finishes. +int prologue() { + int k, busy, done, helper = !nclo && (sname[finsym] == s_frame_grow || sname[finsym] == s_frame_leave); + lit(ZFP); op(O_LD); + if (!helper) { lit(0); op(O_PICK); } + fframe = hole(); op(O_SUB); lit(ZFP); op(O_ST); + if (helper) return 0; + lit(sval[lookup(s_frame_busy)]); op(O_LD); busy = hole(); op(O_JZ); + done = hole(); op(O_JMP); setlit(busy, here); + lit(ZFP); op(O_LD); lit(sval[lookup(s_frame_floor)]); op(O_LD); + lit(sval[lookup(s_frame_guard)]); op(O_LD); op(O_ADD); op(O_LT); k = hole(); op(O_JZ); + lit(ZFP); op(O_LD); lit(1); op(O_PICK); lit(ZFP); op(O_ST); + callname(s_frame_grow); lit(ZFP); op(O_ST); + busy = hole(); op(O_JMP); + setlit(k, here); setlit(done, here); op(O_DROP); setlit(busy, here); + return 0; +} +// emit the function epilogue, patching every return to it. +int epilogue() { + int k, node, done, helper = !nclo && (sname[finsym] == s_frame_grow || sname[finsym] == s_frame_leave); + lit(0); + fixall(epichain, here); + lit(ZFP); op(O_LD); lit(fslots); op(O_ADD); lit(ZFP); op(O_ST); + if (!helper) { + lit(sval[lookup(s_frame_node)]); op(O_LD); node = hole(); op(O_JZ); + lit(ZFP); op(O_LD); lit(sval[lookup(s_frame_top)]); op(O_LD); op(O_SUB); k = hole(); op(O_JZ); + done = hole(); op(O_JMP); setlit(k, here); + callname(s_frame_leave); lit(ZFP); op(O_ST); setlit(done, here); setlit(node, here); + } + op(O_RET); + setlit(fframe, fslots); + infn = 0; + local_drop(lbase); + fdrop(lbase); + return 0; +} +// the statements of a function between its braces, then the end-of-function +// checks: hints, unused m objects, anything still owned is freed, and a .u +// function that falls off the end is an error +int body() { + expect(s_lb); + while (!is_op(s_rb)) { + if (tk == T_EOF) { die("missing } at the end of a function"); break; } + stmt(); + } + local_hints(lbase); + unused_check(lbase); + if (ifcur) if_fin(); + if (ifcur && live && ifcur[1]) ifcur[4] = 1; // falling off the end gives 0 + if (fchk && live) { + exit_vars(1, 1); + if (fret) cerr("a function returning .u has to end with a return"); + } + next(); + return 0; +} +// the rest of a function, after its return type and name: +// int f(int a, node*.m n, .d x, b) { ... } *list.u mk(int n) { ... } +// rty is 0 for fn (a plain word), ret is 1 for a .u return +// (this is also where a function's signature is packed into ssig and its type +// into stype, checked against any earlier prototype or prescan result, and +// where the o3 region for an o3 function is handed to the core) +int fndef(int chk, int rty, int ret, int n) { + int s, np = 0, tags = 0, t, sig, i; [24]word pn; [24]word pt; [24]word pty; int typed = 0, ft, o3f = o3nxt, lo, hi, pk; + o3nxt = 0; + if (rty || ntp) typed = 1; + if (!dnm) dnm = n; + s = lookup(n); + if (s < 0 || s < ubase || skind[s] != K_FN || (sflag[s] & F_DEF)) { + s = addsym(n, K_FN, 0); + sflag[s] = 0; + } + ifcur = 0; + if (ifon && ifkk && !ginst && !ntp && !dry) { + if (ifkk > 0 && !rty) if_begin(s, ifkk); else if_begin(s, 0); + } + ifkk = 0; + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + t = 0; + pty[np] = tword; + pk = 0; + if (!is_op(s_dot) && ((tk == T_OP && tv == s_lk) || (tk == T_ID && (tv == s_fn || istypename(tv))))) { + pty[np] = ptype(); typed = 1; pk = 1; + if (isagg(pty[np])) { + if (ginst) pty[np] = tptr(pty[np]); else if (!stubgen) serr("structs and arrays are passed by pointer"); + // (an extern stub takes its struct by value, which is an address here) + } + } + if (ifcur) { + if (pk) if_param(np, tpack(), 0); + else if (is_op(s_dot)) if_param(np, tpack(), 2); + else if_param(np, tpack(), 1); + } + if (accept(s_dot)) { // .m lends, .d takes over + if (tv == s_m) { + t = 1; + } else if (tv == s_d) t = 2; else die("a parameter tag is .m or .d"); + next(); + } + pnoffs[np] = toff; rs_note(RS_PARAM, toff); pn[np] = name(); + if (o3f && pty[np] == tword) serr("o3 parameters need a type"); + if (np >= 12 && t) die("only the first 12 parameters can be tagged"); + pt[np] = t; + if (np < 12) tags = tags + (t << (np + np)); + np++; + if (np >= 24) die("too many parameters"); + if (!accept(s_comma)) break; + } + } + expect(s_rp); + sig = ret + np + np + tags * 64; + if ((sflag[s] & F_SIG) && !(sflag[s] & F_PRE)) { + if (ssig[s] != sig) serrn(n, "doesn't match its earlier declaration"); + } + else if ((sflag[s] & F_UNTYPED) && (tags || ret)) serrn(n, "was called before its tags were declared; put a prototype above the first call"); + ssig[s] = sig; + sflag[s] = (sflag[s] | F_SIG) - (sflag[s] & F_PRE); + if (ntp) { sflag[s] = sflag[s] | F_GEN; if (!ginst) gtmake(s); } + if (typed) { + if (!rty) rty = tword; + ft = tfn(rty, np, pty, sig); + if (stype[s] && stype[s] != ft) serrn(n, "doesn't match its earlier declaration"); + stype[s] = ft; + } + sig_attach(n, rty, np, pn, pty, typed); + if (accept(s_semi)) { sflag[s] = sflag[s] | F_DECL; ntp = 0; return s; } + if (sflag[s] & F_DEF) serrn(n, "is defined twice"); + if (!ginst && ntp) { // a generic function is not compiled here: its tokens are kept and each set of type arguments gets its own copy + if (sflag[s] & F_TPL) serrn(n, "is defined twice"); + sflag[s] = sflag[s] | F_TPL; + gnew = gtmake(s); + gskip(); + ntp = 0; + sval[s] = here; // the name still has an address and a type, so reflection can ask for them; it halts if it is ever jumped to + sflag[s] = sflag[s] | F_DEF; + fixall(sfix[s], here); sfix[s] = 0; + lit(MW - 1); op(O_JMP); + return s; + } + sval[s] = here; + sflag[s] = sflag[s] | F_DEF; + fixall(sfix[s], here); sfix[s] = 0; + fn_begin(chk, ret); + finsym = s; finfer = !ret; + if (typed) fty = rty; + no3pend = 0; + if (o3f) { o3on = 1; o3reset(); sflag[s] = sflag[s] | F_O3; } + prologue(); + i = 0; + while (i < np) { + t = newloc(pn[i]); lrskind[t] = RS_PARAM; lrsoff[t] = pnoffs[i]; fslots++; lsmark(1, pn[i]); + ltype[t] = pty[i]; lptr[t] = 0; + lt_note(pnoffs[i], pty[i]); + if (o3f) { ltag[t] = 16; o3promote(t); } + if (isfl(pty[i])) setflt(t, 1); + if (fchk && pt[i] == 1) lstate[t] = S_BORROW; + if (fchk && pt[i] == 2) { lstate[t] = S_M; lown[t] = 1; } + i++; + } + i = np; + while (i) { i--; laddr(i); op(O_ST); } + if (o3f) { // the region starts here: a jump, so the cpu enters it + reserve_code(2); lo = here + 2; lit(lo); op(O_JMP); + i = 0; while (i < np) { t = lbase + i; o3mkcache(t); o3refresh(t); i++; } + } + body(); + hi = here; + epilogue(); + if (o3f) { + o3on = 0; + o3fs = fslots; + o3na = np; + o3fn0 = sval[s]; + o3region(lo, hi, o3sl, o3rg, no3sl); + } + o3flush(); + ntp = 0; ifcur = 0; + return s; +} +// let g = 1, buf[10]; int g = 3; [10]int buf; point origin; +// ---- globals, constants, enhancements ---- +// a global's storage is emitted in place among the code (one word, or the +// whole array), and the symbol's value is its address. a string initializer +// points at characters emitted right after. +int gdecl(int typed) { + ifgk = 0; + if (isp == 0) ifgk = tpack(); + next(); + return gdecl2(0, 0, name()); +} +// compile the rest of a global declaration: its type, name and initial value. +int gdecl2(int t, int tg, int n) { + int a, ng = nameoff; word k, arraytype; int s, kp = ifgk, gty = 0, gok = ifon && !t && !dry; + ifgk = 0; + if (!dnm) dnm = n; + if (tg) serr("tags go on locals and parameters, not globals"); + if (t == tvoid) serr("a variable can't be void"); + while (1) { + if (accept(s_lk)) { + k = cexpr(); expect(s_rk); + if (!t) t = tword; + arraytype = tarr(t, k); k = tsz(arraytype); reserve_code(k); + s = addsym(n, K_GARR, here); rs_put(ng, RS_SYM, rs_sym(s), s); stype[s] = arraytype; + while (k) { emit(0); k--; } + if (gok) { if (!gty) gty = tint; else if (gty != tint) gok = 0; } + } else if (t && isagg(t)) { + k = tsz(t); reserve_code(k); + s = addsym(n, K_GARR, here); rs_put(ng, RS_SYM, rs_sym(s), s); stype[s] = t; + while (k) { emit(0); k--; } + } else { + reserve_code(1); a = here; + s = addsym(n, K_GVAR, a); rs_put(ng, RS_SYM, rs_sym(s), s); + if (t) stype[s] = t; + emit(0); + if (accept(s_eq)) { + if (tk == T_STR) { + reserve_code(len_w(tv) + 1); *(a + hdelta) = here; + k = tv; + while (*k) { emit(*k); k++; } + emit(0); + next(); + if (gok) { if (!gty) gty = tptr(tchar); else if (gty != tptr(tchar)) gok = 0; } + } + else { + *(a + hdelta) = cnorm(t, cexpr()); + if (gok) { if (!gty) gty = tint; else if (gty != tint) gok = 0; } + } + } else if (gok) gok = 0; // no initializer: nothing says what it is + } + if (stype[s]) lt_note(ng, stype[s]); else lt_note(ng, tword); + if (!accept(s_comma)) break; + ng = toff; n = name(); + } + expect(s_semi); + if (gok && gty && kp) fact_add(kp, 0 - 1, gty, ""); + return 0; +} +// a constant cut to the sized integer type t, the way tnorm does at run time +int cnorm(word t, int v) { + int b, mask, sg; + if (!t) return v; + b = tbytes(t); + if (!b || t[0] != TY_INT) return v; + mask = (1 << (8 * b)) - 1; + v = v & mask; + if (t[6] & 1) { sg = 1 << (8 * b - 1); v = (v ^ sg) - sg; } + return v; +} +// const A = 1, B = A + 2; +// const [type] NAME = e, NAME = e; the type is optional and is read and dropped, as in zc0 +int gconst() { + int n; + next(); + if (tk == T_ID) { peekat(0); if (pk_tk == T_ID || (pk_tk == T_OP && pk_tv == s_star)) ptype(); } + while (1) { n = name(); if (!dnm) dnm = n; expect(s_eq); addsym(n, K_CONST, cexpr()); if (!accept(s_comma)) break; } + expect(s_semi); + return 0; +} +// enhance [n] name(a, b) micro "recipe" [else fn]; n outputs, 1 if left out +// enhance [n] name(a, b) vm { asm } [else fn]; +// lays out the descriptor the install opcode reads, and wires it in right +// away (an image wires its own in when it boots). +int enhdef() { + int n, np = 0, nout = 1, dsc, na, pay, len = 0, kind = 0, i; word p; int s, slot, r; [8]word pn; + next(); + // enhance 2 divmod(a, b) + if (tk == T_NUM) { + if (tv < 0 || tv > 8) serr("an enhancement has at most 8 outputs"); + nout = tv; + next(); + } + n = name(); + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + if (np == 8) die("an enhancement takes at most 8 inputs"); + pnoffs[np] = toff; rs_note(RS_PARAM, toff); pn[np] = name(); + np++; + if (!accept(s_comma)) break; + } + } + expect(s_rp); + len = 7 + np; i = 0; while (i < np) { len = len + len_w(pn[i]) + 1; i++; } + reserve_code(len); len = 0; dsc = here; i = 0; while (i < 7) { emit(0); i++; } + na = here; i = 0; while (i < np) { emit(0); i++; } + i = 0; + while (i < np) { *(na + i + hdelta) = here; p = pn[i]; while (*p) { emit(*p); p++; } emit(0); i++; } + if (accept(s_micro)) { + if (tk != T_STR) die("expected the recipe as a string"); + ebn = 0; while (tk == T_STR) { ebs(tv); next(); } + reserve_code(ebn + 1); pay = here; wcopyto(ebuf, ebn + 1); + } else if (accept(s_vm)) { pay = contiguous_asm(); len = here - pay; kind = 1; } + else die("expected micro or vm"); + slot = nenh; + if (slot >= 512) fatal("all 512 enhancement slots are taken"); + nenh++; + p = dsc + hdelta; + p[0] = slot; p[1] = kind; p[2] = np; p[3] = nout; p[4] = pay; p[5] = len; p[6] = na; + s = addsym(n, K_ENH, slot); + ssig[s] = np + nout * 16 + dsc * 256; + if (accept(s_else)) { r = lookup(tv); if (r < 0) r = fwdfn(tv); next(); sfix[s] = r + 1; } + expect(s_semi); + if (!hdelta) { + r = install(dsc); + if (r < 0) { + if (!sfix[s]) serrn(n, "the enhancement didn't install (see install's codes in core.c)"); + sflag[s] = sflag[s] | F_FALLBACK; + } + } + return 0; +} +// recovery at the top level: skip to the next token that can start a +// declaration, outside any braces +int topsync() { + int depth = 0; + while (tk != T_EOF) { + if (is_op(s_lb)) depth++; + else if (is_op(s_rb)) { depth--; if (depth < 0) depth = 0; } + else if (!depth && tk == T_ID && (tv == s_fn || tv == s_var || tv == s_const || tv == s_struct || tv == s_type + || tv == s_enhance || tv == s_typecheck || tv == s_docs || tv == s_unchecked || tv == s_immediate || tv == s_o3 + || tv == s_memdebug || tv == s_enum || tv == s_include)) break; + next(); + } + panic = 0; + return 0; +} +// after a function's name: declares its type parameters. any the return +// type used were taken on trust; now they get their real numbers +int genparams() { + int i, j, n = 0; [8]word ps; [8]word bs; + if (!is_op(s_lt)) { if (ntp) serrn(tpn[0], "isn't a type"); ntp = 0; return 0; } + next(); + while (1) { + if (n >= 8) fatal("too many type parameters"); + ps[n] = name(); + n++; + if (!accept(s_comma)) break; + } + closeangle(); + fill_w(bs, 0, 8); + i = 0; + while (i < ntp) { + j = 0; + while (j < n && ps[j] != tpn[i]) j++; + if (j == n) serrn(tpn[i], "isn't a type"); else bs[i] = tvar(j, ps[j]); + i++; + } + if (ntp && dty) dty = subst(dty, bs); + copy_w(tpn, ps, n); ntp = n; + if (ginst) ntp = 0; + return 0; +} +// the return type of a function or the type of a global, with unknown names allowed for now +int rettype() { + tvauto = 1; + dtype(); + tvauto = 0; + return 0; +} +// finish a function declaration. an immediate fn also becomes a keyword +// (kind K_KW whose handler is the function), which is how parse words work: +// the parser calls it with kwcall the moment it meets the name. +int fndone(int s, int imm) { + int k; + ntp = 0; + if (imm) { + if (hdelta) serr("parse words can't be defined while building an image"); + k = addsym(sname[s], K_KW, sval[s]); + sflag[k] = F_DEF | F_STMT | F_EXPR | F_TOP; + } + return 0; +} +// one top-level item. this is the dispatcher for everything a unit can +// contain: unchecked / immediate / o3 prefixes, fn declarations (with or +// without a leading return type), globals, struct, type, enum, include, +// typecheck, memdebug, enhance, const, and parse words used at the top level. +// anything else is a typed global or function: a type, a name, and then +// ( or < means function, otherwise a global. +int topitem0() { + int r, i; + dsn = 0; dnm = 0; + if (docs_on && dn && dline == tline && !ginst) { + if (dn > docsnapcap) { docsnapcap = dn; dsnap = chk_resize(dsnap, 0, docsnapcap); } + i = 0; while (i < dn) { dsnap[i] = dbuf[i]; i++; } + dsn = dn; dline = 0; + } + r = topitem1(); + if (dsn && dnm) doc_attach(dnm); + dsn = 0; dnm = 0; + return r; +} +// compile one top-level item, after the first check of its keyword. +int topitem1() { + int chk = 1, imm = 0, s, k, n; + if (panic) return topsync(); + if (is_id(s_unchecked)) { + next(); + if (accept(s_semi)) { check_on = 0; return 0; } // unchecked; switches the analyzer off from here on + chk = 0; + } + if (is_id(s_immediate)) { next(); imm = 1; } + o3nxt = 0; + if (is_id(s_o3)) { next(); o3nxt = 1; } + ntp = 0; ifkk = 0; + if (is_id(s_fn)) { + peek(); + if (!(pk_tk == T_OP && pk_tv == s_lp)) { + ifkp = tpack(); ifkk = 1; + if (isp != 0) ifkk = 0; + next(); + n = name(); + if (ginst) n = ginsn; + dty = 0; + genparams(); + return fndone(fndef(chk, 0, 0, n), imm); + } + } + if (!chk || imm || o3nxt) { // has to be a function, with a return type + ifkp = tpack(); ifkk = 0 - 1; if (is_op(s_dot)) ifkk = 2; + if (isp != 0) ifkk = 0; + rettype(); n = name(); if (ginst) n = ginsn; genparams(); + if (dtag && dtag != S_U) serr("the only return tag is .u"); + if (!is_op(s_lp)) { die("expected a function"); return 0; } + return fndone(fndef(chk, dty, dtag == S_U, n), imm); + } + if (is_id(s_var)) return gdecl(0); + if (is_id(s_struct)) { kw_struct(); return 0; } + if (is_id(s_type)) return kw_type(); + if (is_id(s_typecheck)) return kw_typecheck(); + if (is_id(s_docs)) return kw_docs(); + if (is_id(s_memdebug)) return kw_memdebug(); + if (is_id(s_enum)) return kw_enum(); + if (is_id(s_include)) return kw_include(); + if (is_id(s_enhance)) return enhdef(); + if (is_id(s_const)) return gconst(); + if (tk == T_ID) { + s = lookup(tv); + if (s >= 0 && skind[s] == K_KW && (sflag[s] & F_TOP)) { kwcall(s, 0); return 0; } + } + if (tstart() || (tk == T_ID && lookup(tv) < 0)) { // int f(...) { }, T first(...) { }, int g = 1; + ifkp = tpack(); ifkk = 0 - 1; if (is_op(s_dot)) ifkk = 2; + if (isp != 0) ifkk = 0; + rettype(); n = name(); + if (is_op(s_lp) || is_op(s_lt)) { + if (ginst) n = ginsn; + genparams(); + if (dtag && dtag != S_U) serr("the only return tag is .u"); + return fndone(fndef(chk, dty, dtag == S_U, n), 0); + } + if (ntp) { serrn(tpn[0], "isn't a type"); ntp = 0; } + return gdecl2(dty, dtag, n); + } + die("expected a declaration"); + return 0; +} +// ---- generic functions: templates and instances ---- +// which type parameter does name n stand for while an instance is compiled +int gfind(int n) { + int i = 0; + while (i < gng) { + if (gnm[i] == n) return i; + i++; + } + return 0 - 1; +} +// does a type still mention a type parameter? +word hasvar(word t) { + int k = t[0], i; word v; + if (k == TY_VAR) return 1; + if (k == TY_PTR || k == TY_ARR || k == TY_DYN) return hasvar(t[4]); + if (k == TY_FN) { + if (hasvar(t[4])) return 1; + i = 0; + while (i < t[3]) { + if (hasvar(t[7 + i])) return 1; + i++; + } + return 0; + } + if (k == TY_STRUCT && t[5]) { + v = t[6]; i = 0; + while (i < v[0]) { + if (hasvar(v[1 + i])) return 1; + i++; + } + } + return 0; +} +// add the current token to the item being recorded +unchecked int grec_add() { + word nb; + if (gn * 3 + 4 > gcap) { + nb = new(gcap + gcap); + copy_w(nb, gbuf, gcap); + free(gbuf); + gbuf = nb; + gcap = gcap + gcap; + } + gbuf[1 + gn * 3] = tk; gbuf[2 + gn * 3] = tv; gbuf[3 + gn * 3] = tpack(); + gn++; + return 0; +} +// the template entry for generic function s, made on first sight of its header +unchecked int ginit() { + gtab = 1; + gt_sym = chk_resize(0, 0, gtcap); gt_tok = chk_resize(0, 0, gtcap); gt_np = chk_resize(0, 0, gtcap); + gt_nm = chk_resize(0, 0, gtcap * 8); + gi_t = chk_resize(0, 0, gicap); gi_sym = chk_resize(0, 0, gicap); gi_done = chk_resize(0, 0, gicap); + gi_ar = chk_resize(0, 0, gicap * 8); + return 0; +} +int reserve_generics(int need) { + int cap = gtcap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + gt_sym = chk_resize(gt_sym, gt_n, cap); gt_tok = chk_resize(gt_tok, gt_n, cap); + gt_np = chk_resize(gt_np, gt_n, cap); gt_nm = chk_resize(gt_nm, gt_n * 8, cap * 8); + gtcap = cap; return cap; +} +int reserve_instances(int need) { + int cap = gicap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + gi_t = chk_resize(gi_t, gi_n, cap); gi_sym = chk_resize(gi_sym, gi_n, cap); + gi_done = chk_resize(gi_done, gi_n, cap); gi_ar = chk_resize(gi_ar, gi_n * 8, cap * 8); + gicap = cap; return cap; +} +// make the generic instance of the function or struct s for its type arguments. +unchecked int gtmake(int s) { + int k = 0; + if (!gtab) ginit(); + while (k < gt_n) { + if (gt_sym[k] == s) break; + k++; + } + if (k == gt_n) { + if (gt_n >= gtcap) reserve_generics(gt_n + 1); + gt_n++; + gt_sym[k] = s; gt_tok[k] = 0; + } + gt_np[k] = ntp; + copy_w(gt_nm + k * 8, tpn, ntp); + return k; +} +// skip a function body without compiling it: from the { to its matching } +int gskip() { + int depth = 0; + if (!is_op(s_lb)) { die("expected { to start the function"); return 0; } + while (tk != T_EOF) { + if (is_op(s_lb)) depth++; + else if (is_op(s_rb)) { + depth--; + if (depth <= 0) { next(); break; } + } + next(); + } + return 0; +} +// the item just read defined generic function gnew: keep its tokens +unchecked int gattach(word buf, int n) { + n--; // the last token belongs to the next item + if (nerr) { free(buf); return 0; } + buf[0] = n; + gt_tok[gnew] = buf; + return 0; +} +// the symbol for template s with these type arguments, made on first use and +// queued to be compiled once the template's tokens are in. a type parameter +// that nothing bound is a plain word. +word ginstance(int s, word bs) { + int k = 0, t = 0 - 1, np, i, j, ns; word nm; [24]word dg; int nd; word a; + if (dry || !gtab) return s; + while (k < gt_n) { + if (gt_sym[k] == s) { t = k; break; } + k++; + } + if (t < 0) return s; + np = gt_np[t]; + i = 0; + while (i < np) { + if (!bs[i]) bs[i] = tword; + if (hasvar(bs[i])) return s; + i++; + } + k = 0; + while (k < gi_n) { + if (gi_t[k] == t) { + j = 0; + while (j < np && gi_ar[k * 8 + j] == bs[j]) j++; + if (j == np) return gi_sym[k]; + } + k++; + } + if (gi_n >= gicap) reserve_instances(gi_n + 1); + i = 0; j = 0; + a = sname[s]; nm = chk_resize(0, 0, len_w(a) + np * 18 + 3); + while (a[j]) { nm[i] = a[j]; i++; j++; } + nm[i] = '<'; i++; + k = 0; + while (k < np) { + if (k) { nm[i] = ','; i++; } + a = bs[k]; nd = 0; + while (a && nd < 20) { dg[nd] = '0' + (a & 15); nd++; a = a >> 4; } + while (nd) { nd--; nm[i] = dg[nd]; i++; } + k++; + } + nm[i] = '>'; i++; nm[i] = 0; + ns = addsym(intern(nm), K_FN, tpack()); + sflag[ns] = F_SIG | (sflag[s] & F_O3); + ssig[ns] = ssig[s]; + k = gi_n; gi_n++; + gi_t[k] = t; gi_sym[k] = ns; gi_done[k] = 0; + copy_w(gi_ar + k * 8, bs, np); + return ns; +} +// compile one instance: replay the template's tokens with its type +// parameters bound +unchecked int gcompile(int k) { + int t = gi_t[k]; + ginst = 1; gng = gt_np[t]; + copy_w(gnm, gt_nm + t * 8, 8); + copy_w(gib, gi_ar + k * 8, 8); + ginsn = sname[gi_sym[k]]; + src_push(1, gt_tok[t], 0, 0); + next(); + topitem0(); + if (tk != T_EOF) die("unexpected tokens after a generic function"); + src_pop(); + ginst = 0; gng = 0; + return 0; +} +// compile the instances asked for so far whose templates have been read, and +// any they ask for in turn +int gdrain() { + int k, more = 1; + if (infn || ginst) return 0; + if (panic) return 0; + while (more) { + more = 0; + k = 0; + while (k < gi_n) { + if (!gi_done[k] && gt_tok[gi_t[k]]) { + gi_done[k] = 1; + gcompile(k); + more = 1; + } + k++; + } + } + return 0; +} +// one top-level item, recording its tokens so that a generic function's can be kept +int topitem() { + int sb = gbuf, sn = gn, sc = gcap, sr = grec, sg = gnew, rb, rn; + if (ginst) return topitem0(); + gbuf = new(256); gcap = 256; gn = 0; grec = 1; gnew = 0 - 1; + grec_add(); + topitem0(); + rb = gbuf; rn = gn; + grec = sr; gbuf = sb; gn = sn; gcap = sc; + if (gnew >= 0) gattach(rb, rn); else free(rb); + gnew = sg; + gdrain(); + return 0; +} +// a unit is compiled item by item; unit_end then reports any function that +// was called but never defined, and stops if any error was found +int unit_top() { + while (tk != T_EOF) topitem(); + return 0; +} +// the edit distance between two names (levenshtein), or 99 when one is too long +word editdist(word a, word b) { + int la = len_w(a), lb = len_w(b), i, j, x, y, z, last, row[65]; + if (la > 60 || lb > 60) return 99; + j = 0; while (j <= lb) { row[j] = j; j++; } + i = 1; + while (i <= la) { + last = row[0]; row[0] = i; j = 1; + while (j <= lb) { + x = row[j] + 1; + y = row[j - 1] + 1; + z = last + (a[i - 1] != b[j - 1]); + last = row[j]; + if (y < x) x = y; + if (z < x) x = z; + row[j] = x; + j++; + } + i++; + } + return row[lb]; +} +// the defined function, global or constant whose name is closest to n, if it +// is close enough to be a likely typo; 0 when none is +int similar(int n) { + int j = 0, best = 0, bd = 99, dist, k, lim = len_w(n) / 3; + if (lim < 1) lim = 1; + if (lim > 3) lim = 3; + while (j < nsym) { + k = skind[j]; + if (k == K_FN || k == K_GVAR || k == K_GARR || k == K_CONST) { + if (sflag[j] & F_DEF) { + if (sname[j] != n) { + dist = editdist(n, sname[j]); + if (dist < bd) { bd = dist; best = sname[j]; } + } + } + } + j++; + } + if (bd > lim) return 0; + return best; +} +// end a compile unit from token from onward, and report what it defined. +int unit_end(int from) { + int i = from, best; + panic = 0; + while (i < nsym) { + // a bodyless declaration (fn f();) promises a definition elsewhere. in check mode that + // elsewhere is another file of the same build, which this document can't see + if (skind[i] == K_FN && !(sflag[i] & F_DEF) && sfix[i] && !(cmode && (sflag[i] & F_DECL))) { + tunpack(sval[i]); + best = similar(sname[i]); + if (!dry) { + errat(); + put_s(sname[i]); put_s(" is used but never defined"); + if (best) { put_s("; did you mean '"); put_s(best); put_s("'?"); } + errend(); + } + } + i++; + } + if (nerr) giveup(); + return 0; +} + +// compile a token list as the body of a new function, or (top) as top-level +// declarations. returns the entry address of the function. +// (this is what eval, compile and load are built on. a function body made this +// way is emitted behind a jump when another function is being compiled, so +// compile() works inside a parse word.) +unchecked int compile_list(int q, int top) { + int hop = -1, entry = 0, from = nsym; + ctx_push(); ifcur = 0; ifcall = -1; + if (infn) { hop = hole(); op(O_JMP); } + if (top) prescan(1, q); + src_push(1, q, 0, 0); + next(); + if (top) unit_top(); + else { + entry = here; + fn_begin(1, 0); + prologue(); + while (tk != T_EOF) stmt(); + unused_check(lbase); + if (fchk && live) exit_vars(1, 1); + epilogue(); + } + src_pop(); + unit_end(from); + if (hop >= 0) setlit(hop, here); + if (here > ptop) ptop = here; + ctx_pop(); + return entry; +} +// compile a token list into a function and return its address. +int compile(int q) { return compile_list(q, 0); } +// compile a token list and run its top-level code. +int load(int q) { compile_list(q, 1); return 0; } +// compile a token list and run it, returning its result. +int eval(int q) { int f = compile_list(q, 0); return f(); } +// compile the source string s and run it, returning its result. +int evals(int s) { + word q = tokens(s); int r = eval(q); + free(d*q); + return r; +} + +// ---- symbol blob ---- +// an image ends with its own symbol table so the genome knows its names: +// kind, value, signature, name chars, 0 ... then a 0 kind. +// emit the names defined since symbol index from (functions, globals, +// constants, enhancements) as the image's trailing symbol table +int blob_emit(int from) { + int i = from, table, words = 1; word p; int b, k; + while (i < nsym) { + if (skind[i] == K_DOC) { b = sval[i]; words = words + 2 + (b[0] >> 3); } + if ((skind[i] >= K_FN && skind[i] <= K_CONST) || skind[i] == K_ENH || skind[i] == K_DOC) words = words + 4 + len_w(sname[i]); + i++; + } + reserve_code(words); i = from; + // the docs first: each one's bytes go in the image here, and its symbol + // takes their address (the bytes come after the code, so no code moves) + while (i < nsym) { + if (skind[i] == K_DOC) { + b = sval[i]; + sval[i] = here; + emit(b[0]); + k = 0; + while (k < ((b[0] + 7) >> 3)) { emit(b[1 + k]); k++; } + if (!(b[0] & 7)) emit(0); + } + i++; + } + table = here; i = from; + while (i < nsym) { + if ((skind[i] >= K_FN && skind[i] <= K_CONST) || skind[i] == K_ENH || skind[i] == K_DOC) { + emit(skind[i]); emit(sval[i]); emit(ssig[i]); + p = sname[i]; + while (*p) { emit(*p); p++; } + emit(0); + } + i++; + } + emit(0); + return table; +} +// the reverse: read a blob and define its names, so a running genome knows its +// own functions by name +// hide: leave out the language server's names. functions are entered before +// constants and globals in the blob, so the server's functions come after +// chk_mark but the runtime's constants and globals come after it too: the +// cut is by name, the functions after chk_mark, and everything from the +// server's marker const (LSP_SERVER, the first thing src/lsp/server.zc declares) +int blob_load(word p, int hide) { + int s, n, past = 0, after = 0, skip, mkn = intern("chk_mark"), srvn = intern("LSP_SERVER"); + while (*p) { + n = intern(p + 3); + if (hide && n == srvn) after = 1; + skip = hide && (after || (past && p[0] == K_FN)); + if (hide && n == mkn) past = 1; + if (!skip) { + s = addsym(n, p[0], p[1]); + ssig[s] = p[2]; + sflag[s] = F_DEF | F_SIG; + if (p[0] == K_ENH) { if (p[1] >= nenh) nenh = p[1] + 1; install(p[2] >> 8); } + } + p = p + 3 + len_w(p + 3) + 1; + } + return 0; +} +// compile the rest of stdin for org into a growing output buffer. the image's +// addresses remain logical addresses at org while its temporary storage grows. +// image_words and image_size expose the finished image; initial is its first +// buffer reservation. the matching host layout must still fit the finished image. +int build_image_grow(int org, int initial) { + int sh = here, sd = hdelta, sl = hlimit, sub = ubase, svl = vislo, sns = nsym, sen = nenh, n; + word saved_buffer = image_buffer; int saved_active = image_active, saved_org = image_org, saved_capacity = image_capacity; + if (org < 0 || initial < 7 || initial > 0x7fffffff - org) fatal("bad image reservation"); + image_buffer = chk_resize(0, 0, initial); image_active = 1; image_org = org; image_capacity = initial; + ubase = nsym; vislo = nsym; nenh = 0; + here = org; hdelta = image_buffer - org; hlimit = org + initial; + lit(FTOP); lit(ZFP); op(O_ST); fnref(fwdfn(s_start)); op(O_JMP); emit(0); emit(0); + unit_stdin(); + n = blob_emit(ubase); + image_buffer[5] = n; + image_buffer[6] = here; + n = here - org; image_words = image_buffer; image_size = n; + popsyms(sns); + ubase = sub; vislo = svl; here = sh; hdelta = sd; hlimit = sl; nenh = sen; + image_buffer = saved_buffer; image_active = saved_active; image_org = saved_org; image_capacity = saved_capacity; + return n; +} +// retain the explicit destination interface for callers that already own storage. +// use build_image_grow and image_words when the output must grow independently. +int build_image(int org, int dst) { + int n = build_image_grow(org, 4096), words = syscall(9, 0, 0, 0); + if (dst < 0 || n > words - dst) fatal("image destination too small"); + copy_w(dst, image_words, n); + return n; +} + +// ---- setup ---- +// the collector's roots for the compiler's half of the memory map: the program +// area (globals live between functions), the genome's globals, the input source +// frames, the live frame stack and the live data stack. rt.zc declares this +// and calls it from gc(). +int gc_roots() { + int end = ptop; if (end > CODE_END) end = CODE_END; + markrange(0, end); + if (!hdelta && here > ptop && ptop < CODE_END) { end = here; if (end > CODE_END) end = CODE_END; markrange(ptop, end); } // globals of a unit still compiling + markrange(GORG, GORG[6]); + markrange(R_IH, R_POOLEND); + markrange(sval, sval + nsym); + markrange(R_TY, R_TYEND); + markrange(R_SRC, R_SRC + R_SRC_cap); + gc_frames(); + markrange(dsp(), data_top); + return 0; +} +// start-up in two parts. zc_init clears the intern table and interns the +// spellings the parser compares against; zc_tables fills the operator and +// keyword tables. an operator is a name, a precedence and a code sequence in +// the vm's own one-letter mnemonics (see seqasm), so "<=" is "~ < 1 ^": swap, +// less-than, flip the bit. +int zc_init() { + pooltop = R_POOL; + poolend = R_POOLEND; poolblocks = 0; namecount = 0; + fill_w(namehash, 0, hashcap); + nsym = 0; nfixu = 0; fixfree = 0; nbin = 0; nun = 0; nasg = 0; nkop = 0; seqtop = 0; + lsp = 0; ctxsp = 0; snaptop = 0; nloc = 0; lbase = 0; npm = 0; npe = 0; fill_w(lkeys, 0, lkeycap); lkeyn = 0; + s_lp = intern("("); s_rp = intern(")"); s_lb = intern("{"); s_rb = intern("}"); + s_lk = intern("["); s_rk = intern("]"); s_comma = intern(","); s_semi = intern(";"); + s_eq = intern("="); s_arrow = intern("->"); s_inc = intern("++"); s_dec = intern("--"); + s_star = intern("*"); + s_slash = intern("/"); + s_amp = intern("&"); + s_colon = intern(":"); + s_hash = intern("#"); + s_minus = intern("-"); + s_dot = intern("."); + s_q = intern("?"); + s_case = intern("case"); + s_default = intern("default"); + s_andand = intern("&&"); + s_oror = intern("||"); + s_fn = intern("fn"); s_var = intern("let"); s_const = intern("const"); s_else = intern("else"); + s_as = intern("as"); s_unchecked = intern("unchecked"); s_immediate = intern("immediate"); + s_m = intern("m"); s_d = intern("d"); s_u = intern("u"); s_static = intern("static"); + s_start = intern("start"); + s_main = intern("main"); + s_free = intern("free"); + s_recycle = intern("recycle"); + s_do = intern("do"); + s_while = intern("while"); + s_enum = intern("enum"); + s_include = intern("include"); + s_memdebug = intern("memdebug"); s_scrub = intern("scrub"); s_alloc = intern("alloc_line"); + s_check = intern("checkptr"); s_memset = intern("mem_set"); + s_own = intern("own"); s_qnew = intern("qnew"); s_fovf = intern("frame_overflow"); + s_frame_floor = intern("frame_floor"); s_frame_top = intern("frame_top"); s_frame_node = intern("frame_node"); + s_frame_busy = intern("frame_busy"); s_frame_guard = intern("frame_guard"); + s_frame_grow = intern("frame_grow"); s_frame_leave = intern("frame_leave"); + s_enhance = intern("enhance"); s_micro = intern("micro"); s_vm = intern("vm"); + return 0; +} +// operators and keywords. these are plain tables in memory: a program can +// add operators, change precedences or replace keywords with its own. +// (the order of the first binary operators matters: cexpr refers to * + - << >> +// & | by their index, and the comments mark which ones) +int zc_tables() { + add_unop("!", "0 $ 0 ~ - | 63 > 1 +"); // index 0 + add_unop("!!", "0 $ 0 ~ - | 63 > 0 ~ -"); // index 1: normalize to 0 or 1 + add_unop("~", "-1 ^"); // index 2 + add_unop("-", "0 ~ -"); + add_binop("*", 10, "*"); // the first few indexes are used by cexpr + add_binop("/", 10, "idiv"); // native divide, wired in by rt.zc + add_binop("%", 10, "imod"); + add_binop("+", 9, "+"); // 3 + add_binop("-", 9, "-"); // 4 + add_binop("<<", 8, "ishl"); // 5 + add_binop(">>", 8, ">"); // 6 + add_binop("<", 7, "<"); + add_binop(">", 7, "~ <"); + add_binop("<=", 7, "~ < 1 ^"); + add_binop(">=", 7, "< 1 ^"); + add_binop("==", 6, "- 0 $ 0 ~ - | 63 > 1 +"); + add_binop("!=", 6, "- 0 $ 0 ~ - | 63 > 0 ~ -"); + add_binop("&", 5, "&"); // 13 + add_binop("^", 4, "^"); + add_binop("|", 3, "|"); // 15 + add_binop("&&", -1, 0); + add_binop("||", -2, 0); + addkop(s_eq); addkop(s_arrow); addkop(s_inc); addkop(s_dec); + add_kw("let", kw_var, F_STMT); + add_kw("if", kw_if, F_STMT); + add_kw("while", kw_while, F_STMT); + add_kw("for", kw_for, F_STMT); + add_kw("do", kw_do, F_STMT); + add_kw("enum", kw_enum, F_STMT | F_TOP); + add_kw("include", kw_include, F_TOP); + add_kw("memdebug", kw_memdebug, F_STMT | F_TOP); + add_kw("switch", kw_switch, F_STMT); + add_kw("break", kw_break, F_STMT); + add_kw("continue", kw_continue, F_STMT); + add_kw("return", kw_return, F_STMT); + add_kw("unchecked", kw_unchecked, F_STMT); + add_kw("asm", kw_asm, F_STMT | F_EXPR); + add_kw("quote", kw_quote, F_EXPR); + add_kw("sizeof", kw_sizeof, F_EXPR); + add_kw("typeof", kw_typeof, F_EXPR); + add_kw("extern", kw_extern, F_TOP); + add_kw("cfunc", kw_cfunc, F_EXPR); + add_kw("o3", kw_o3, F_STMT); + add_kw("len", kw_len, F_EXPR); + add_kw("cap", kw_cap, F_EXPR); + add_kw("push", kw_push, F_EXPR); + add_kw("pop", kw_pop, F_EXPR); + add_kw("resize", kw_resize, F_EXPR); + return 0; +} +// the default map's type records sit in the last 16384 words of the heap. +// the type list is the first words of that range, so it cannot be kept aside +// as a buddy block: types_init would overwrite the header and the allocator +// would hand the range out again. cut the heap off at R_TY until the unit +// has been compiled, then put the tail back for the program. +int heldk; +// the size class of the type area, for the memory map. +int type_class() { + int k = 0, n = R_TYEND - R_TY; + while (k < 31 && pow2[k] < n) k++; + if (pow2[k] != n) return 0 - 1; + return k; +} +// keep the type area out of the collector's reach while it is in use. +int shield_types() { + int k; + heldk = 0 - 1; + if (R_TY <= HEAP_LO || R_TY >= HEAP_HI || R_TYEND > HEAP_HI) return 0; + k = type_class(); + if (k < 0) return 0; + if (R_TY + pow2[k] != R_TYEND) return 0; + if (heap_reset(R_TY)) heldk = k; + return 0; +} +// let the collector see the type area again. +int unshield_types() { + if (heldk >= 0) { heap_uncut(R_TY, heldk); heldk = 0 - 1; } + return 0; +} +// the genome's entry point, run when the image boots: set up the heap and +// the compiler, then either run the language server (a genome that carries it) +// or compile the unit on stdin, collect the garbage that compiling made, and +// call main(). +int start() { + int s, f; + heap_init(); chk_heap = 1; + shield_types(); + zc_init(); + blob_load(GORG[5], 0); + zc_tables(); + types_init(); + here = 0; hdelta = 0; hlimit = CODE_END; ptop = 0; + ubase = nsym; vislo = 0; + // a genome that carries the language server runs it instead of compiling stdin + s = lookup(intern("lsp_main")); + if (s >= 0 && skind[s] == K_FN && (sflag[s] & F_DEF)) { f = sval[s]; f(); halt(); } + unit_stdin(); + if (here > ptop) ptop = here; + scrub(); // compilation's stale words would keep quarantined blocks alive + gc(); + // the type area stays out of the allocator. main() may compile again + // (the self-host does) and a later new() would otherwise reuse it. + if (mdbg_flags) mem_set(mdbg_flags); + // a unit that carries src/lib/std.zc has a libinit to fill argc/argv/envc/envp + // with. it runs before main, the same way lsp_main runs instead of stdin. + s = lookup(intern("libinit")); + if (s >= 0 && skind[s] == K_FN && (sflag[s] & F_DEF)) { f = sval[s]; f(); } + s = lookup(s_main); + if (s >= 0 && skind[s] == K_FN && (sflag[s] & F_DEF)) { f = sval[s]; f(); } + halt(); + return 0; +} + +// ---- check mode: the language server ---- +// the server runs this compiler, unchanged, over a document it holds in +// memory. chk_unit compiles it as a whole unit, in a machine set up the way +// start() sets one up (the genome's own names, the default operators and +// keywords), so the document's parse words, operators and types change what +// the rest of it means exactly as they would in a real build. the symbols +// the document made stay in the tables afterwards for the highlighter. +// chk_mark is the last function of the compiler proper, and LSP_SERVER (in +// src/lsp/server.zc) the first constant of the server: the server's names are +// hidden from the document, the runtime's and the compiler's are not. +int chk_mark() { return 0; } +// reset check mode for a new document. +int chk_reset() { + code_blocks = 0; code_chunk = CODE_END; + isp = -1; + docs_on = 0; dn = 0; dline = 0; docpending = 0; dsn = 0; dnm = 0; + pq_n = 0; + pendot = 0; + qdone = 0; + ch = 0; + chkind = 0; + line = 1; + tk = 0; + tv = 0; + tglue = 0; + tline = 1; + toff = 0 - 1; toklen = 0; tpend = 0 - 1; tpline = 1; + infn = 0; + fdepth = 0; + fslots = 0; + fchk = 0; + fret = 0; + live = 0; + bxdepth = 0; + epichain = 0; + fframe = 0; + xbor = 0 - 1; xaf = 0; argfact = 0; + mdbg = 0; mdbg_flags = 0; lv = 0; lvk = 0; lvi = 0; kw_expr = 0; xcls = 0; fty = 0; + check_on = 1; tc_on = ifstrict; dry = 0; ntp = 0; tvauto = 0; ngbind = 0; xgive = 0; xconst = 0; + o3on = 0; o3nxt = 0; no3pend = 0; no3sl = 0; no3free = 0; o3nreg = 0; o3na = 0; o3fn0 = 0; + nfact = 0; fortest = 0; forstep = 0; argloc = 0; arrloc = 0; njps = 0; extop = 0; nnumops = 0; + nenh = 0; panic = 0; nerr = 0; dgprev = 0; nclo = 0; newsz = 0 - 1; nomagic = 0; callpos = 0; + grec = 0; gnew = 0 - 1; gt_n = 0; gi_n = 0; ginst = 0; gtab = 0; + return 0; +} +// src: the document, 4 chars to a word and a 0 at the end. buf, cap: where +// the records go. sets: 4 * LSW words for the name sets. lim: code may grow up +// to here. every block the caller holds is a heap object reachable from its +// globals, so the check's garbage is collected and nothing is cut off. +// check one document in check mode and fill the records it made. +int chk_unit(int src, int buf, int cap, int sets, int lim) { + chk_reset(); + chk_begin(buf, cap); + lsets = sets; + if (sets) fill_w(sets, 0, 4 * LSW); + if (!chk_heap) { heap_init(); chk_heap = 1; } else gc(); // the caller's blocks are reachable from its globals, the rest goes + rsn = 0; rsbase = src; + if (!rsrec) { rscap = RS_CAP; rsrec = new(RS_CAP * RS_W); rstmp = new(RS_CAP * RS_W); } + ifs = 0; ifx = 0; nifx = 0; nift = 0; nif = 0; ifcur = 0; ifkk = 0; ifgk = 0; ifcall = 0 - 1; + if (ifon) { + ifrcap = NIF; ifxcap = IFN; iftcap = IFT; + ifs = new(symcap); ifr = chk_resize(0, 0, ifrcap); ifx = chk_resize(0, 0, ifxcap * 4); ift = chk_resize(0, 0, iftcap); + fill_w(ifs, 0, symcap); + } + zc_init(); + blob_load(GORG[5], 1); + zc_tables(); + types_init(); + here = 0; hdelta = 0; hlimit = lim; ptop = 0; + ubase = nsym; vislo = 0; + prescan(3, src); + src_push(3, src, 0, 0); + next(); + unit_top(); + rs_fix(); + unit_end(ubase); + if (ifx) if_emit(); + src_pop(); + rs_sort(); + chk_end(); + return 0; +} +// walk a document's tokens with the lexer as the check left it. hl_begin +// loads the first token into tk, tv, toff and toklen; next() moves on; hl_end +// restores the previous state. +// the syntax highlighter's view of the lexer. it re-lexes the document after +// the check, so the tokens it sees are cut exactly where the compiler's were +// (parse words that changed the operators included). +int hl_begin(int src) { + chkabort = 0; isp = -1; pq_n = 0; pendot = 0; qdone = 0; panic = 0; + dry++; + src_push(3, src, 0, 0); + next(); + return 0; +} +// end a highlight pass: leave the source and the dry run. +int hl_end() { + src_pop(); + dry--; + isp = -1; + pq_n = 0; + return 0; +} diff --git a/src/core/bops.h b/src/core/bops.h new file mode 100644 index 0000000..a7ef0d9 --- /dev/null +++ b/src/core/bops.h @@ -0,0 +1,87 @@ +/* little-endian bytes of a word-addressed cell array. + byte address b names bits [8b, 8b+8) of the flat image: word b>>3, + low byte first. a byte address is an ordinary integer. the odd/even + tag is only for code words, and ownership tags stay on word pointers. + wider loads and stores are little-endian and may cross a word. an + access that does not lie entirely inside the image is refused. */ +#ifndef BOPS_H +#define BOPS_H +#include + +static int bop_ok(int64_t addr, int n, int64_t nwords) +{ + uint64_t bytes, a, k; + if (n <= 0 || n > 8 || addr < 0 || nwords < 1) return 0; + bytes = (uint64_t)nwords << 3; + a = (uint64_t)addr; + k = (uint64_t)n; + if (a >= bytes || k > bytes - a) return 0; + return 1; +} + +static int64_t bop_load(const int64_t *mem, int64_t addr, int n) +{ + int64_t v = 0; + int i; + for (i = 0; i < n; i++) { + int64_t a = addr + i; + int sh = (int)((a & 7) << 3); + v |= (int64_t)(((uint64_t)mem[a >> 3] >> sh) & 255) << (i * 8); + } + return v; +} + +/* fold n bytes of val into the words they touch. *w0 is the first word. + returns how many words changed (1 or 2). does not write mem. */ +static int bop_merge(const int64_t *mem, int64_t addr, int64_t val, int n, int64_t *out, int64_t *w0) +{ + int i, nw; + int64_t base = addr >> 3; + nw = (int)(((addr + n - 1) >> 3) - base) + 1; + *w0 = base; + out[0] = mem[base]; + if (nw > 1) out[1] = mem[base + 1]; + for (i = 0; i < n; i++) { + int64_t a = addr + i; + int wi = (int)((a >> 3) - base); + int sh = (int)((a & 7) << 3); + uint64_t mask = (uint64_t)255 << sh; + uint64_t byte = ((uint64_t)val >> (i * 8)) & 255; + out[wi] = (int64_t)(((uint64_t)out[wi] & ~mask) | (byte << sh)); + } + return nw; +} + +static void bop_put1(int64_t *mem, int64_t addr, int byte) +{ + int64_t out[2], w0; + int n, i; + n = bop_merge(mem, addr, byte & 255, 1, out, &w0); + for (i = 0; i < n; i++) mem[w0 + i] = out[i]; +} + +/* copy a NUL-terminated byte string into dst. returns the length, or -1 + when the address is outside the image. */ +static int bop_cstr(const int64_t *mem, int64_t addr, char *dst, int max, int64_t nwords) +{ + int i = 0, c; + if (max < 1) return -1; + if (!bop_ok(addr, 1, nwords)) { dst[0] = 0; return -1; } + while (i < max - 1 && bop_ok(addr + i, 1, nwords)) { + c = (int)bop_load(mem, addr + i, 1); + if (!c) break; + dst[i++] = (char)c; + } + dst[i] = 0; + return i; +} + +/* how many of the next n bytes, starting at addr, lie inside the image */ +static int bop_span(int64_t addr, int n, int64_t nwords) +{ + int i; + if (n <= 0) return 0; + for (i = 0; i < n; i++) if (!bop_ok(addr + i, 1, nwords)) return i; + return n; +} +#endif diff --git a/src/core/core.c b/src/core/core.c new file mode 100644 index 0000000..2f6032a --- /dev/null +++ b/src/core/core.c @@ -0,0 +1,5889 @@ +/* zygote core: puts the genome (the zc compiler and its runtime, both vm code) + into memory and runs it. on arm64, every block of vm code is translated to + arm64 the first time it is reached, straight from live memory. stores that + land on translated words throw those translations away, so code that + rewrites itself, including the resident compiler, just gets retranslated + on the next visit. on other hosts (or with -DZYINTERP) a plain interpreter + with the same semantics runs instead. ZYTRACE=1 logs translations on stderr. */ +#include +#include +#include +#include +#include +#include +#ifdef _WIN32 +#include +#include +#ifndef O_BINARY +#define O_BINARY _O_BINARY +#endif +#if defined(_MSC_VER) +#define open _open +#define close _close +#define read _read +#define write _write +#endif +#else +#include +#ifndef O_BINARY +#define O_BINARY 0 +#endif +#endif +#include +#if (defined(__linux__) || defined(__APPLE__)) && !defined(__wasm__) && !defined(ZY_NOFFI) +#define ZYFFI 1 +#include +#endif +#if defined(__aarch64__) && !defined(ZYINTERP) +#define ZYJIT 1 +#include +#ifdef __APPLE__ +#include +#include +#endif +#endif +#if defined(__linux__) && defined(__GLIBC__) && !defined(__wasm__) && !defined(ZYJIT) && !defined(ZY_NOBIGSTACK) +#define ZYBIGSTACK 1 +#include +#include +#endif +#ifdef USE_LSP_GENOME +#include "lsp_genome.h" +#elif defined(GENOME_H) +#include GENOME_H +#else +#include "genome.h" +#endif +#include "memmap.h" +#include "fops.h" +#include "bops.h" + +#ifndef JTYPE +#define JTYPE char +#endif +char Q(void); +void G(char); +extern JTYPE J; + +typedef int64_t Cell; /* one vm word. memory stays word-addressed. */ +typedef uint64_t UCell; +enum { DEFAULT_MEMORY_LIMIT = MW }; +static int memory_limit = DEFAULT_MEMORY_LIMIT; +static int memory_words; +static int memory_growth_limit; +/* bounds baked into native blocks use the reservation, whose base never moves. */ +#undef MW +#define MW memory_limit +/* MW, the stacks and SYSGATE come from memmap.h. the default is 1<<20. */ +/* stop values stay outside every executable address reservation. */ +#define PC_HALT 0x7ffffff0 +#define PC_DATA_OVERFLOW (PC_HALT + 1) +#define PC_RETURN_OVERFLOW (PC_HALT + 2) +#define PC_FRAME_OVERFLOW (PC_HALT + 3) +static Cell code_words; +static int code_reserve(Cell end); +static int code_range_live(Cell start, Cell count); +/* why the cpu stopped, when it wasn't a halt */ +static int stopped(int p) +{ + if (p == PC_DATA_OVERFLOW) { fprintf(stderr, "zy: data stack overflow\n"); return 2; } + if (p == PC_RETURN_OVERFLOW) { fprintf(stderr, "zy: return stack overflow\n"); return 2; } + if (p == PC_FRAME_OVERFLOW) { fprintf(stderr, "zy: frame stack overflow\n"); return 2; } + return 0; +} +#define CODEW (4 << 20) /* 16 MB of code, in instruction words */ +#define MAXB 65536 +#define BLKW 1024 /* longest block, in vm words */ + +static Cell *m; +static Cell frame_floor_word = ZFP + 6, frame_top_word = ZFP + 7, frame_guard_word = ZFP + 8; +static Cell frame_bound(void) { return m[frame_floor_word] + m[frame_guard_word]; } + +static int b_ok(Cell addr, int n) { return bop_ok(addr, n, MW); } +static Cell b_load(Cell addr, int n) +{ + if (!b_ok(addr, n)) return 0; + return bop_load(m, addr, n); +} +static void b_commit(Cell w, Cell v); +static void b_store(Cell addr, Cell val, int n) +{ + Cell out[2], w0; + int nw, i; + if (!b_ok(addr, n)) return; + nw = bop_merge(m, addr, val, n, out, &w0); + for (i = 0; i < nw; i++) b_commit(w0 + i, out[i]); +} +static Cell bld8(Cell a) { return b_load(a, 1); } +static Cell bld16(Cell a) { return b_load(a, 2); } +static Cell bld32(Cell a) { return b_load(a, 4); } +static void bst8(Cell a, Cell v) { b_store(a, v, 1); } +static void bst16(Cell a, Cell v) { b_store(a, v, 2); } +static void bst32(Cell a, Cell v) { b_store(a, v, 4); } + +static void fop_print(Cell bits) +{ + char buf[400]; + int n = fop_format((uint64_t)bits, buf), i; + for (i = 0; i < n; i++) G(buf[i]); +} +/* opcode 618: (bits prec mode --). mode 0 shortest, 1 fixed, 2 scientific. */ +static void fop_print_mode(Cell bits, Cell prec, Cell mode) +{ + char buf[400]; + int n = fop_format_mode((uint64_t)bits, mode, prec, buf), i; + for (i = 0; i < n; i++) G(buf[i]); +} +static Cell fop_parse_cell(Cell addr) +{ + if ((UCell)addr >= (UCell)MW) return 0; + return (Cell)fop_parse_words(m + addr, (UCell)MW - (UCell)addr); +} +static int trace; + +/* the command line and the environment, kept for ops 21 to 24. a program read + from stdin has no file name, so argv[0] is , as in zy(1). the rest of + the host's argv follows it. the environment is a bare char **, so its count + is counted once at startup. */ +#ifndef _WIN32 +extern char **environ; +#endif +static int zy_argc; +static char **zy_argv; +static int zy_envc; +static char **zy_envp; + +static void zy_args(int argc, char **argv) +{ + char **e; + int n = 0; +#ifdef _WIN32 + e = _environ; +#else + e = environ; +#endif + while (e && e[n]) n++; + zy_envp = e; zy_envc = n; + zy_argv = argv; + zy_argc = argc > 0 ? argc : 1; +} + +/* syscall gate: a store of the op to SYSGATE runs hostcall. args sit in the + next three words, and the result replaces the op. see rt.zc. */ +static int zcstr(int addr, char *dst, int max) +{ + int i = 0, c; + if (max < 1) return -1; + if ((unsigned)addr >= MW) { dst[0] = 0; return -1; } + while (i < max - 1 && (unsigned)(addr + i) < MW) { + c = (int)m[addr + i]; + if (!c) break; + dst[i++] = (char)c; + } + dst[i] = 0; + return i; +} +static int inmem(Cell a) { return (UCell)a < (UCell)MW; } +static int stack_memory_grow(UCell words) +{ + if (words > (UCell)memory_growth_limit) return 0; + if (words > (UCell)memory_words) memory_words = (int)words; + return 1; +} +#include "stack.h" + +/* copy entry a of a char ** into vm words, one character per word, terminated + like SYS_GETENV. a zero buffer asks for the length only, which is how the + caller sizes the string before fetching it. lead, when given, replaces entry + zero: a program read from stdin has no file name, so argv[0] is . */ +static Cell vecstr(char **v, int count, Cell a, Cell b, Cell c, const char *lead) +{ + char *e; + int i = 0; + if (a < 0 || a >= (Cell)count) return -1; + e = (a == 0 && lead) ? (char *)lead : v[a]; + if (!e) return -1; + if (!b) { while (e[i]) i++; return i; } + if (c < 1 || !inmem(b)) return -1; + while (e[i] && i < c - 1 && inmem(b + i)) { m[b + i] = (unsigned char)e[i]; i++; } + if (inmem(b + i)) m[b + i] = 0; + return i; +} +static Cell host_rand(void) +{ + static uint64_t s; + if (!s) s = (uint64_t)time(0) ^ 0x9E3779B97F4A7C15ull; + if (!s) s = 0x9E3779B97F4A7C15ull; + s ^= s << 13; s ^= s >> 7; s ^= s << 17; + if ((Cell)s == -1) s ^= 0x100; + return (Cell)s; +} +/* c abi: ops 14..18 of the gate. see the ffi section further down. cb_s and + cb_r are the vm stack pointers as of the gate store, so that a callback from + native code can run vm code on top of them. */ +static Cell cb_s, cb_r; +static Cell ffi_call(Cell blk); +static Cell ffi_find(Cell name); +static Cell ffi_cbmake(Cell entry, Cell sig); +static Cell ffi_load(Cell name); +static Cell hostcall(Cell op, Cell a, Cell b, Cell c) +{ + char path[1024], tmp[512]; + int n, i, got; +#ifdef ZY_SANDBOX + /* a build for checking code the user has not run yet (the language server): compile-time + code may read what it includes, but it may not write files, exit, load or call C code, + or make raw system calls */ + if (op == 4 || op == 7 || op == 12 || (op >= 14 && op <= 17) || op == 40) return -1; + if ((op == 1 || op == 10) && b != 0) return -1; +#endif + switch (op) { + case 1: + if (zcstr(a, path, 1024) < 0) return -1; + if (b == 1) return open(path, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0644); + return open(path, O_RDONLY | O_BINARY); + case 2: + return close((int)a); + case 3: + if (c < 0 || !inmem(b)) return -1; + n = 0; + while (n < c) { + i = c - n; + if (i > 512) i = 512; + if (!inmem(b + n)) break; + if (!inmem(b + n + i - 1)) i = (int)(MW - (b + n)); + if (i <= 0) break; + got = (int)read((int)a, tmp, (size_t)i); + if (got <= 0) break; + for (i = 0; i < got; i++) m[b + n + i] = (unsigned char)tmp[i]; + n += got; + } + return n; + case 4: + if (c < 0 || !inmem(b)) return -1; + n = 0; + while (n < c) { + i = c - n; + if (i > 512) i = 512; + if (!inmem(b + n)) break; + if (!inmem(b + n + i - 1)) i = (int)(MW - (b + n)); + if (i <= 0) break; + for (got = 0; got < i; got++) tmp[got] = (char)m[b + n + got]; + got = (int)write((int)a, tmp, (size_t)i); + if (got <= 0) break; + n += got; + } + return n; + case 5: { + char *e; + if (zcstr(a, path, 1024) < 0) return -1; + e = getenv(path); + if (!e) return -1; + if (c < 1 || !inmem(b)) return -1; + i = 0; + while (e[i] && i < c - 1 && inmem(b + i)) { m[b + i] = (unsigned char)e[i]; i++; } + if (inmem(b + i)) m[b + i] = 0; + return i; + } + case 6: + return (Cell)time(0); + case 7: + exit((int)a); + case 8: + return host_rand(); + case 9: + if (a == 0) return memory_words; + if (a == 1) return HEAP_LO; + if (a == 2) return HEAP_HI; + if (a == 3) return (Cell)memory_words * 8; + if (a == 4) { + if (b < 0 || b > memory_growth_limit) return -1; + if (b > memory_words) memory_words = (int)b; + return memory_words; + } + if (a == 5) { + if (b < memory_words || b > MW) return -1; + memory_growth_limit = (int)b; return b; + } + if (a == 6) { + if (!stack_register(b)) return -1; + frame_floor_word = m[b]; frame_top_word = m[b + 1]; frame_guard_word = m[b + 2]; + return 0; + } + if (a == 7 || a == 8) return stack_expand(a == 8, b, &cb_s, &cb_r); + if (a == 9) return code_reserve(b); + return -1; + case 10: + if (bop_cstr(m, a, path, 1024, MW) < 0) return -1; + if (b == 1) return open(path, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0644); + return open(path, O_RDONLY | O_BINARY); + case 11: + if (c < 0 || (c > 0 && !bop_ok(b, 1, MW))) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + i = bop_span(b + n, i, MW); + if (i <= 0) break; + got = (int)read((int)a, tmp, (size_t)i); + if (got <= 0) break; + for (i = 0; i < got; i++) bop_put1(m, b + n + i, (unsigned char)tmp[i]); + n += got; + } + return n; + case 12: + if (c < 0 || (c > 0 && !bop_ok(b, 1, MW))) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + i = bop_span(b + n, i, MW); + if (i <= 0) break; + for (got = 0; got < i; got++) tmp[got] = (char)bop_load(m, b + n + got, 1); + got = (int)write((int)a, tmp, (size_t)i); + if (got <= 0) break; + n += got; + } + return n; + case 13: { + char *e; + if (bop_cstr(m, a, path, 1024, MW) < 0) return -1; + e = getenv(path); + if (!e) return -1; + if (c < 1 || !bop_ok(b, 1, MW)) return -1; + i = 0; + while (e[i] && i < c - 1 && bop_ok(b + i, 1, MW)) { bop_put1(m, b + i, (unsigned char)e[i]); i++; } + if (bop_ok(b + i, 1, MW)) bop_put1(m, b + i, 0); + return i; + } + case 14: return ffi_call(a); + case 15: return ffi_find(a); + case 16: return ffi_cbmake(a, b); + case 17: return ffi_load(a); + case 18: { /* fill words: a = dst, b = value, c = count. above the program area only + (no translation covers it), and -1 means "do it yourself" */ + Cell i; + if (a < PW || code_range_live(a, c) || c <= 0 || c > MW - a) return -1; + for (i = 0; i < c; i++) m[a + i] = b; + return c; } + case 19: /* copy words: a = dst, b = src, c = count. a forward copy that overlaps + itself (dst inside the source) is left to the caller's loop */ + if (a < PW || code_range_live(a, c) || b < 0 || c <= 0 || c > MW - a || c > MW - b) return -1; + if (a > b && a < b + c) return -1; + memmove(m + a, m + b, (size_t)c * sizeof(Cell)); + return c; + case 20: { /* scan for heap pointers: a = first word, b = count, c = hbump. the index of + the first word that could be the payload address of an allocated block (a + heap address whose check word at w[-3] is w ^ MAGIC), or b if there is none. + the allocator's header is 5 words and its magic 0x2B7E1516 (src/runtime/rt.zc); the + caller still checks the flags, this only skips the words that are plainly + not pointers. -1 if the range is not in memory */ + Cell i, w, lim = c > MW ? MW : c; + if (a < 0 || b <= 0 || b > MW - a) return -1; + for (i = 0; i < b; i++) { + w = m[a + i]; + if (w >= HEAP_LO + 5 && w < lim && m[w - 3] == (w ^ 0x2B7E1516)) return i; + } + return b; } + case 21: /* argc: the host's argument count, or 1 for alone */ + return (Cell)zy_argc; + case 22: /* argv: a = index, b = buffer, c = capacity. a zero buffer asks for the + length only, which is how the caller sizes the string before it fetches + it. the string is copied one character per word and terminated, like + SYS_GETENV. -1 if there is no such argument */ + return vecstr(zy_argv, zy_argc, a, b, c, ""); + case 23: /* envc: how many entries the environment has */ + return (Cell)zy_envc; + case 24: /* envp: one entry of the environment, shaped like argv */ + return vecstr(zy_envp, zy_envc, a, b, c, 0); + case 40: /* raw host syscall: a = address of seven words, the syscall number and then its six arguments. the result is the kernel's, or -errno. linux only; elsewhere -1 */ +#ifdef __linux__ + { + long w[7], r; + int k; + if (!inmem(a) || !inmem(a + 6)) return -1; + for (k = 0; k < 7; k++) w[k] = (long)m[a + k]; + r = syscall(w[0], w[1], w[2], w[3], w[4], w[5], w[6]); + if (r == -1) return -(Cell)errno; + return (Cell)r; + } +#else + return -1; +#endif + default: + return -1; + } +} + +/* ---- virtual enhancements ---- + up to 512 custom opcodes (22 .. 533), wired in at runtime by the install + opcode (21). an enhancement is a short program over native micro-ops, + written either as a recipe (text) or as straight-line vm code that gets + lifted. both become ssa, go through the optimizer below, and then run in + the interpreter or get inlined by the jit as native code. */ +#define NENH 512 +#define XOP0 22 +enum { U_LI, U_MOV, U_ADD, U_SUB, U_MUL, U_SDIV, U_UDIV, U_SREM, U_UREM, U_AND, U_OR, U_XOR, + U_SHL, U_SHR, U_SAR, U_NEG, U_NOT, U_LT, U_LTU, U_EQ, U_NE, U_MIN, U_MAX, U_MINU, U_MAXU, + U_MULHS, U_MULHU, U_CLZ, U_ABS, U_SEL, U_LD, U_ST, + U_FADD, U_FSUB, U_FMUL, U_FDIV, U_FEQ, U_FLT, U_FLE, U_I2F, U_F2I, + U_LD8, U_LD16, U_LD32, U_ST8, U_ST16, U_ST32, + U_NARG, U_NCALL, /* a native call is one narg per argument (imm = its position) and then the ncall (imm = the call's descriptor) */ + U_CTZ, U_POPCNT, U_BSWAP, U_ROTL, U_ROTR, /* bit tricks: count trailing zeros, population count, byte swap, rotates */ + U_F2S, U_S2F, /* binary64 bits to binary32 bits (rounded) and back (exact) */ + U_N }; +static const char *unames[U_N] = { "li", "mov", "add", "sub", "mul", "sdiv", "udiv", "srem", "urem", + "and", "or", "xor", "shl", "shr", "sar", "neg", "not", "lt", "ltu", "eq", "ne", "min", "max", + "minu", "maxu", "mulhs", "mulhu", "clz", "abs", "sel", "ld", "st", + "fadd", "fsub", "fmul", "fdiv", "feq", "flt", "fle", "i2f", "f2i", + "ld8", "ld16", "ld32", "st8", "st16", "st32", "narg", "ncall", + "ctz", "popcnt", "bswap", "rotl", "rotr", "f2s", "s2f" }; +static const signed char uarity[U_N] = { 0, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 1, 1, 3, 1, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 2, 2, 2, 1, 0, 1, 1, 1, 2, 2, 1, 1 }; +static int is_store(int op) +{ + return op == U_ST || op == U_ST8 || op == U_ST16 || op == U_ST32; +} +/* ops that matter even when nothing reads their value: a store, an argument + handed to a native call, the call. none of them has a result a later pass + may reuse or drop */ +static int is_eff(int op) +{ + return is_store(op) || op == U_NARG || op == U_NCALL; +} +static int is_memop(int op) +{ + return is_eff(op) || op == U_LD || op == U_LD8 || op == U_LD16 || op == U_LD32; +} +static int bwidth(int op) +{ + if (op == U_LD8 || op == U_ST8) return 1; + if (op == U_LD16 || op == U_ST16) return 2; + if (op == U_LD32 || op == U_ST32) return 4; + return 0; +} +typedef struct { int op, d, a, b, c; Cell imm; } Uop; /* ssa: d is a fresh value, a b c are values */ +typedef struct { + int live, kind, nin, nout, n, nv, out[8]; + Uop *u; + signed char *reg; /* physical register per value, for the jit; 0 if it didn't fit */ +} Enh; +static Enh enh[NENH]; +static int need_flush; + +#define MAXUOP 4096 +static Uop ub[MAXUOP]; static int un, unv, uerr; /* the program being built */ +static int unew(int op, int a, int b, int c, Cell imm) +{ + Uop *u; + if (un >= MAXUOP) { uerr = -5; return 0; } + u = &ub[un++]; u->op = op; u->d = unv++; u->a = a; u->b = b; u->c = c; u->imm = imm; + return u->d; +} +static Cell mread(int a) { return (unsigned)a < MW ? m[a] : 0; } + +/* recipe text: one statement per line or per ';' + r0 = sdiv r0 r1 dst = op operands, operands are rN, parameter names or numbers + r2 = r0 a copy, or a number + st r1 r0 memory[r1] = r0 + inputs arrive in r0.. (and under the parameter names), outputs leave from r0.. */ +static int parse_recipe(int src, int names, int nin, int nout, int *out) +{ + int cur[16], i, p = src, n, k, op, args[3], na, dst, isst; + char tok[8][32]; int nt; + for (i = 0; i < 16; i++) cur[i] = i < nin ? i : -1; + for (;;) { + /* read one statement into tokens */ + nt = 0; + for (;;) { + int c = mread(p); + while (c == ' ' || c == '\t' || c == '\r') c = mread(++p); + if (!c || c == '\n' || c == ';') break; + if (c == '=') { if (nt < 8) strcpy(tok[nt++], "="); p++; continue; } + n = 0; + while (c && c != ' ' && c != '\t' && c != '\n' && c != ';' && c != '=' && c != '\r') { if (n < 31) tok[nt < 8 ? nt : 7][n++] = (char)c; c = mread(++p); } + if (nt < 8) tok[nt++][n] = 0; + } + if (nt) { + isst = !strcmp(tok[0], "st"); + if (!isst && (nt < 3 || strcmp(tok[1], "="))) return -2; + /* destination register */ + dst = -1; + if (!isst) { + if (tok[0][0] == 'r' && tok[0][1] >= '0' && tok[0][1] <= '9') dst = atoi(tok[0] + 1); + else for (i = 0; i < nin && names; i++) { + int s = mread(names + i), j = 0; + while (mread(s + j) && mread(s + j) == (unsigned char)tok[0][j]) j++; + if (!mread(s + j) && !tok[0][j]) dst = i; + } + if (dst < 0 || dst > 15) return -2; + } + k = isst ? 1 : 2; /* first token after "=" (or after st) */ + op = -1; + if (!isst && nt > 3) { for (i = 0; i < U_N; i++) if (!strcmp(tok[k], unames[i])) op = i; if (op < 0) return -2; k++; } + if (isst) op = U_ST; + na = 0; + for (; k < nt; k++) { + char *t = tok[k]; int v = -1; + if (na >= 3) return -2; + if (t[0] == 'r' && t[1] >= '0' && t[1] <= '9') { int r = atoi(t + 1); if (r > 15) return -2; if (cur[r] < 0) cur[r] = unew(U_LI, 0, 0, 0, 0); v = cur[r]; } + else if ((t[0] >= '0' && t[0] <= '9') || t[0] == '-') { char *e; Cell x = (Cell)strtoll(t, &e, 0); if (*e) return -2; v = unew(U_LI, 0, 0, 0, x); } + else { + for (i = 0; i < nin && names; i++) { + int s = mread(names + i), j = 0; + while (mread(s + j) && mread(s + j) == (unsigned char)t[j]) j++; + if (!mread(s + j) && !t[j]) v = cur[i] < 0 ? (cur[i] = unew(U_LI, 0, 0, 0, 0)) : cur[i]; + } + if (v < 0) return -2; + } + args[na++] = v; + } + if (op < 0) { /* x = y */ + if (na != 1) return -2; + cur[dst] = args[0]; + } else { + if (na != (op == U_LI ? 0 : uarity[op])) { + if (!(op == U_LI && na == 1)) return -2; + } + if (op == U_LI) cur[dst] = args[0]; + else if (is_store(op)) unew(op, args[0], args[1], 0, 0); + else cur[dst] = unew(op, args[0], na > 1 ? args[1] : 0, na > 2 ? args[2] : 0, 0); + } + if (uerr) return uerr; + } + if (!mread(p)) break; + p++; + } + for (i = 0; i < nout; i++) { if (cur[i] < 0) cur[i] = unew(U_LI, 0, 0, 0, 0); out[i] = cur[i]; } + return uerr; +} + +/* straight-line vm code from addr up to its ret, run symbolically */ +static int lift_vm(int a, int len, int nin, int nout, int *out) +{ + int st[256], sp = 0, i, k, x, y; Cell w; + for (i = 0; i < nin; i++) st[sp++] = i; + for (i = 0; i < len; i++) { + w = mread(a + i); + if (w & 1) { if (sp >= 256) return -4; st[sp++] = unew(U_LI, 0, 0, 0, w >> 1); continue; } + k = w / 2; + if (k == 9) break; + switch (k) { + case 1: if (sp < 1) return -4; st[sp - 1] = unew(U_LD, st[sp - 1], 0, 0, 0); break; + case 2: if (sp < 2) return -4; unew(U_ST, st[sp - 1], st[sp - 2], 0, 0); sp -= 2; break; + case 3: /* pick needs a constant index */ + if (sp < 1) return -4; + x = st[sp - 1]; + if (x < nin) return -4; + { int j; for (j = 0; j < un && ub[j].d != x; j++); if (j == un || ub[j].op != U_LI) return -4; y = (int)ub[j].imm; } + if (y < 0 || y >= sp - 1) return -4; + st[sp - 1] = st[sp - 2 - y]; + break; + case 4: if (sp < 1) return -4; sp--; break; + case 5: if (sp < 2) return -4; x = st[sp - 1]; st[sp - 1] = st[sp - 2]; st[sp - 2] = x; break; + case 13: case 14: case 15: case 16: case 17: case 18: case 19: case 20: { + static const int map[] = { U_ADD, U_SUB, U_MUL, U_AND, U_OR, U_XOR, U_SAR, U_LT }; + if (sp < 2) return -4; + x = st[sp - 1]; y = st[sp - 2]; sp -= 2; + st[sp++] = unew(map[k - 13], y, x, 0, 0); + break; } + default: return -4; /* control flow, i/o and other enhancements don't lift */ + } + if (uerr) return uerr; + } + if (sp != nout) return -4; + for (i = 0; i < nout; i++) out[i] = st[i]; + return uerr; +} + +/* ---- the optimizer ---- + one forward pass of copy propagation, constant folding, algebraic + simplification, division by constants (the multiply-high trick) and + common subexpression elimination, then dead code removal. */ +static Cell ev(int op, Cell a, Cell b, Cell c) +{ + UCell ua = (UCell)a, ub_ = (UCell)b; + switch (op) { + case U_ADD: return (Cell)(ua + ub_); + case U_SUB: return (Cell)(ua - ub_); + case U_MUL: return (Cell)(ua * ub_); + case U_SDIV: return b == 0 ? 0 : (a == INT64_MIN && b == -1) ? a : a / b; + case U_UDIV: return b == 0 ? 0 : (Cell)(ua / ub_); + case U_SREM: return b == 0 ? a : (a == INT64_MIN && b == -1) ? 0 : a % b; + case U_UREM: return b == 0 ? a : (Cell)(ua % ub_); + case U_AND: return a & b; + case U_OR: return a | b; + case U_XOR: return a ^ b; + case U_SHL: return (Cell)(ua << (b & 63)); + case U_SHR: return (Cell)(ua >> (b & 63)); + case U_SAR: return a >> (b & 63); + case U_NEG: return (Cell)(0ull - ua); + case U_NOT: return ~a; + case U_LT: return a < b; + case U_LTU: return ua < ub_; + case U_EQ: return a == b; + case U_NE: return a != b; + case U_MIN: return a < b ? a : b; + case U_MAX: return a > b ? a : b; + case U_MINU: return ua < ub_ ? a : b; + case U_MAXU: return ua > ub_ ? a : b; + case U_MULHS: return (Cell)(((__int128)a * (__int128)b) >> 64); + case U_MULHU: return (Cell)(((unsigned __int128)ua * ub_) >> 64); + case U_CLZ: { int n = 0; if (!ua) return 64; while (!(ua & (1ull << 63))) { ua <<= 1; n++; } return n; } + case U_ABS: return a < 0 ? (Cell)(0ull - ua) : a; + case U_CTZ: return ua ? __builtin_ctzll(ua) : 64; + case U_POPCNT: return __builtin_popcountll(ua); + case U_BSWAP: return (Cell)__builtin_bswap64(ua); + case U_ROTL: return (Cell)((ua << (b & 63)) | (ua >> ((64 - (b & 63)) & 63))); + case U_ROTR: return (Cell)((ua >> (b & 63)) | (ua << ((64 - (b & 63)) & 63))); + case U_F2S: return (Cell)fop_f2s((uint64_t)a); + case U_S2F: return (Cell)fop_s2f((uint64_t)a); + case U_SEL: return a ? b : c; + case U_FADD: return (Cell)fop_add((uint64_t)a, (uint64_t)b); + case U_FSUB: return (Cell)fop_sub((uint64_t)a, (uint64_t)b); + case U_FMUL: return (Cell)fop_mul((uint64_t)a, (uint64_t)b); + case U_FDIV: return (Cell)fop_div((uint64_t)a, (uint64_t)b); + case U_FEQ: return fop_eq((uint64_t)a, (uint64_t)b); + case U_FLT: return fop_lt((uint64_t)a, (uint64_t)b); + case U_FLE: return fop_le((uint64_t)a, (uint64_t)b); + case U_I2F: return (Cell)fop_i2f(a); + case U_F2I: return fop_f2i((uint64_t)a); + } + return 0; +} +static void smagic(Cell d, Cell *mul, int *sh) /* hacker's delight, signed, 64-bit */ +{ + const UCell two63 = 1ull << 63; + UCell ad = d < 0 ? 0ull - (UCell)d : (UCell)d, t = two63 + ((UCell)d >> 63); + UCell anc = t - 1 - t % ad, q1 = two63 / anc, r1 = two63 - q1 * anc, q2 = two63 / ad, r2 = two63 - q2 * ad, delta; + int p = 63; + do { + p++; + q1 *= 2; r1 *= 2; if (r1 >= anc) { q1++; r1 -= anc; } + q2 *= 2; r2 *= 2; if (r2 >= ad) { q2++; r2 -= ad; } + delta = ad - r2; + } while (q1 < delta || (q1 == delta && r1 == 0)); + *mul = (Cell)(q2 + 1); if (d < 0) *mul = -*mul; + *sh = p - 64; +} +static void umagic(UCell d, UCell *mul, int *add, int *sh) /* hacker's delight, unsigned, 64-bit */ +{ + UCell nc = ~0ull - (0ull - d) % d, q1, r1, q2, r2, delta; + const UCell two63 = 1ull << 63; + int p = 63; + *add = 0; + q1 = two63 / nc; r1 = two63 - q1 * nc; + q2 = (two63 - 1) / d; r2 = (two63 - 1) - q2 * d; + do { + p++; + if (r1 >= nc - r1) { q1 = 2 * q1 + 1; r1 = 2 * r1 - nc; } else { q1 = 2 * q1; r1 = 2 * r1; } + if (r2 + 1 >= d - r2) { if (q2 >= two63 - 1) *add = 1; q2 = 2 * q2 + 1; r2 = 2 * r2 + 1 - d; } + else { if (q2 >= two63) *add = 1; q2 = 2 * q2; r2 = 2 * r2 + 1; } + delta = d - 1 - r2; + } while (p < 128 && (q1 < delta || (q1 == delta && r1 == 0))); + *mul = q2 + 1; *sh = p - 64; +} + +static Uop ob[MAXUOP]; static int on, onv; +static int *omap, *isk; static Cell *kv; /* old value -> new value; constness of new values */ +static int pure(int op) { return !is_memop(op); } +static int ispow2(UCell x) { return x && !(x & (x - 1)); } +static int lg2(UCell x) { int n = 0; while (x > 1) { x >>= 1; n++; } return n; } +static int oe(int op, int a, int b, int c, Cell imm); +static int K(Cell v) { return oe(U_LI, 0, 0, 0, v); } +static int raw(int op, int a, int b, int c, Cell imm) +{ + Uop *u; int i; + if (pure(op)) /* cse */ + for (i = 0; i < on; i++) { + u = &ob[i]; + if (u->op == op && u->a == a && u->b == b && u->c == c && u->imm == imm) return u->d; + } + if (on >= MAXUOP) { uerr = -5; return 0; } + u = &ob[on++]; u->op = op; u->d = onv++; u->a = a; u->b = b; u->c = c; u->imm = imm; + isk[u->d] = op == U_LI; kv[u->d] = imm; + return u->d; +} +static int sdivk(int a, Cell d) /* a / d for a constant d, no divide instruction */ +{ + Cell mul; int sh, q, t, k; + UCell ad; + if (d == 1) return a; + if (d == -1) return oe(U_NEG, a, 0, 0, 0); + if (d == INT64_MIN) return oe(U_EQ, a, K(d), 0, 0); + ad = (UCell)(d < 0 ? -d : d); + if (ispow2(ad)) { + k = lg2(ad); + t = oe(U_SAR, a, K(63), 0, 0); + t = oe(U_SHR, t, K(64 - k), 0, 0); + q = oe(U_SAR, oe(U_ADD, a, t, 0, 0), K(k), 0, 0); + return d < 0 ? oe(U_NEG, q, 0, 0, 0) : q; + } + smagic(d, &mul, &sh); + q = oe(U_MULHS, a, K(mul), 0, 0); + if (d > 0 && mul < 0) q = oe(U_ADD, q, a, 0, 0); + if (d < 0 && mul > 0) q = oe(U_SUB, q, a, 0, 0); + if (sh) q = oe(U_SAR, q, K(sh), 0, 0); + return oe(U_ADD, q, oe(U_SHR, q, K(63), 0, 0), 0, 0); +} +static int udivk(int a, UCell d) +{ + UCell mul; int add, sh, t; + if (d == 1) return a; + if (ispow2(d)) return oe(U_SHR, a, K(lg2(d)), 0, 0); + if (d > (1ull << 63)) return oe(U_XOR, oe(U_LTU, a, K((Cell)d), 0, 0), K(1), 0, 0); /* a >= d */ + umagic(d, &mul, &add, &sh); + t = oe(U_MULHU, a, K((Cell)mul), 0, 0); + if (!add) return sh ? oe(U_SHR, t, K(sh), 0, 0) : t; + t = oe(U_ADD, oe(U_SHR, oe(U_SUB, a, t, 0, 0), K(1), 0, 0), t, 0, 0); + return sh > 1 ? oe(U_SHR, t, K(sh - 1), 0, 0) : t; +} +static int oe(int op, int a, int b, int c, Cell imm) +{ + int ka, kb; Cell A, B; + if (op == U_LI) return raw(U_LI, 0, 0, 0, imm); + if (op == U_MOV) return a; + if (is_memop(op)) return raw(op, a, b, 0, 0); + ka = isk[a]; kb = uarity[op] > 1 && isk[b]; + A = kv[a]; B = kv[b]; + /* everything constant: fold */ + if (ka && (uarity[op] < 2 || kb) && (uarity[op] < 3 || isk[c])) return K(ev(op, A, B, kv[c])); + /* constants go right for commutative ops */ + if (ka && !kb && (op == U_ADD || op == U_MUL || op == U_AND || op == U_OR || op == U_XOR || op == U_EQ || op == U_NE || + op == U_MIN || op == U_MAX || op == U_MINU || op == U_MAXU || op == U_MULHS || op == U_MULHU || + op == U_FADD || op == U_FMUL || op == U_FEQ)) { + int t = a; a = b; b = t; kb = 1; B = A; ka = 0; + } + if (op == U_SEL && ka) return A ? b : c; + if (op == U_SEL && b == c) return b; + if (kb) switch (op) { + case U_ADD: case U_SUB: case U_OR: case U_XOR: case U_SHL: case U_SHR: case U_SAR: + if (!B || (op >= U_SHL && op <= U_SAR && !(B & 63))) return a; + break; + case U_MUL: + if (B == 0) return K(0); + if (B == 1) return a; + if (B == -1) return oe(U_NEG, a, 0, 0, 0); + if (B > 0 && ispow2((UCell)B)) return oe(U_SHL, a, K(lg2((UCell)B)), 0, 0); + break; + case U_AND: if (B == 0) return K(0); if (B == -1) return a; break; + case U_SDIV: if (B == 0) return K(0); return sdivk(a, B); + case U_SREM: if (B == 0) return a; if (B == 1 || B == -1) return K(0); + return oe(U_SUB, a, oe(U_MUL, sdivk(a, B), b, 0, 0), 0, 0); + case U_UDIV: if (B == 0) return K(0); return udivk(a, (UCell)B); + case U_UREM: if (B == 0) return a; + if (B > 0 && ispow2((UCell)B)) return oe(U_AND, a, K(B - 1), 0, 0); + return oe(U_SUB, a, oe(U_MUL, udivk(a, (UCell)B), b, 0, 0), 0, 0); + } + /* two equal operands. not applied to the float ops: x - x is a NaN when x is, + and x == x is false for a NaN. a pair of constant floats already folded. */ + if (a == b && uarity[op] == 2) { + if (op == U_SUB || op == U_XOR || op == U_LT || op == U_LTU || op == U_NE) return K(0); + if (op == U_AND || op == U_OR || op == U_MIN || op == U_MAX || op == U_MINU || op == U_MAXU) return a; + if (op == U_EQ) return K(1); + } + return raw(op, a, b, c, 0); +} +/* runs the optimizer over ub[0..un) with nin inputs; leaves the result in e */ +static int optimize(Enh *e, int nin, int *out, int nout) +{ + int i, *live, n = 0; + static int omap_[MAXUOP + 16], isk_[MAXUOP * 4]; static Cell kv_[MAXUOP * 4]; + omap = omap_; isk = isk_; kv = kv_; + on = 0; onv = nin; + for (i = 0; i < nin; i++) { omap[i] = i; isk[i] = 0; } + for (i = 0; i < un && !uerr; i++) { + Uop *u = &ub[i]; + int a = uarity[u->op] > 0 || u->op == U_ST || u->op == U_LD ? omap[u->a] : 0; + int b = uarity[u->op] > 1 || u->op == U_ST ? omap[u->b] : 0; + int c = uarity[u->op] > 2 ? omap[u->c] : 0; + if (u->op == U_ST) oe(U_ST, a, b, 0, 0); + else omap[u->d] = oe(u->op, a, b, c, u->imm); + } + if (uerr) return uerr; + /* dead code: outputs and stores are live */ + live = calloc(onv + 1, sizeof *live); + for (i = 0; i < nout; i++) { e->out[i] = omap[out[i]]; live[e->out[i]] = 1; } + for (i = on; i--;) { + Uop *u = &ob[i]; + if (!is_store(u->op) && !live[u->d]) { u->op = -1; continue; } + if (uarity[u->op] > 0 || is_memop(u->op)) live[u->a] = 1; + if (uarity[u->op] > 1 || is_store(u->op)) live[u->b] = 1; + if (uarity[u->op] > 2) live[u->c] = 1; + } + free(live); + e->u = malloc((on + 1) * sizeof(Uop)); + for (i = 0; i < on; i++) if (ob[i].op >= 0) e->u[n++] = ob[i]; + e->n = n; e->nv = onv; e->nin = nin; e->nout = nout; + return 0; +} +/* run an installed enhancement on a downward-growing stack; returns the new top */ +static Cell *xexec(Enh *e, Cell *sp) +{ + Cell vb[256], *v = e->nv <= 256 ? vb : malloc(e->nv * sizeof(Cell)), i, j; + for (j = 0; j < e->nin; j++) v[j] = sp[e->nin - 1 - j]; + for (i = 0; i < e->n; i++) { + Uop *u = &e->u[i]; + switch (u->op) { + case U_LI: v[u->d] = u->imm; break; + case U_LD: v[u->d] = mread(v[u->a]); break; + case U_ST: if (inmem(v[u->a])) m[v[u->a]] = v[u->b]; break; + default: + if (u->op >= U_LD8 && u->op <= U_ST32) { + if (u->op == U_LD8) v[u->d] = bld8(v[u->a]); + else if (u->op == U_LD16) v[u->d] = bld16(v[u->a]); + else if (u->op == U_LD32) v[u->d] = bld32(v[u->a]); + else if (u->op == U_ST8) bst8(v[u->a], v[u->b]); + else if (u->op == U_ST16) bst16(v[u->a], v[u->b]); + else if (u->op == U_ST32) bst32(v[u->a], v[u->b]); + break; + } + v[u->d] = ev(u->op, v[u->a], v[u->b], v[u->c]); + } + } + sp += e->nin - e->nout; + for (j = 0; j < e->nout; j++) sp[e->nout - 1 - j] = v[e->out[j]]; + if (v != vb) free(v); + return sp; +} +static void xdump(int slot, Enh *e) +{ + int i; + fprintf(stderr, "enh %d: %d in, %d out, %d ops\n", slot, e->nin, e->nout, e->n); + for (i = 0; i < e->n; i++) { + Uop *u = &e->u[i]; + if (u->op == U_ST) fprintf(stderr, " st v%d v%d\n", u->a, u->b); + else if (u->op == U_LI) fprintf(stderr, " v%d = %lld\n", u->d, (long long)u->imm); + else { fprintf(stderr, " v%d = %s v%d", u->d, unames[u->op], u->a); if (uarity[u->op] > 1) fprintf(stderr, " v%d", u->b); if (uarity[u->op] > 2) fprintf(stderr, " v%d", u->c); fprintf(stderr, "\n"); } + } + for (i = 0; i < e->nout; i++) fprintf(stderr, " out%d = v%d\n", i, e->out[i]); +} +/* registers for the jit: values live in x0..x15, straight-line linear scan. + if they don't fit, reg stays 0 and the jit calls the interpreter instead. */ +static void regalloc(Enh *e) +{ + int *last = malloc(e->nv * sizeof(int)), i, j, k, fr = 0xffff; + signed char *r = malloc(e->nv); + for (i = 0; i < e->nv; i++) { last[i] = -2; r[i] = -1; } + for (i = 0; i < e->n; i++) { + Uop *u = &e->u[i]; + if (uarity[u->op] > 0 || u->op == U_ST || u->op == U_LD) last[u->a] = i; + if (uarity[u->op] > 1 || u->op == U_ST) last[u->b] = i; + if (uarity[u->op] > 2) last[u->c] = i; + } + for (i = 0; i < e->nout; i++) last[e->out[i]] = e->n; +#define TAKE(v) do { for (k = 0; k < 16 && !(fr >> k & 1); k++); if (k == 16) goto fail; fr &= ~(1 << k); r[v] = (signed char)k; } while (0) + for (j = 0; j < e->nin; j++) if (last[j] >= -1 && last[j] != -2) TAKE(j); + for (i = 0; i < e->n; i++) { + Uop *u = &e->u[i]; int ops[3], no = 0; + if (uarity[u->op] > 0 || u->op == U_ST || u->op == U_LD) ops[no++] = u->a; + if (uarity[u->op] > 1 || u->op == U_ST) ops[no++] = u->b; + if (uarity[u->op] > 2) ops[no++] = u->c; + for (j = 0; j < no; j++) if (last[ops[j]] == i && r[ops[j]] >= 0 && (fr >> r[ops[j]] & 1) == 0) fr |= 1 << r[ops[j]]; + if (!is_store(u->op)) TAKE(u->d); + if (!is_store(u->op) && last[u->d] == -2) fr |= 1 << r[u->d]; /* never used */ + } +#undef TAKE + free(last); e->reg = r; return; +fail: + free(last); free(r); e->reg = 0; +} +/* the install opcode. descriptor: slot, kind (0 recipe, 1 vm code), inputs, + outputs, payload address, payload length, parameter names (or 0). kind 2 + is an o3 region (below). + returns 0, or -1 bad descriptor, -2 recipe syntax, -4 code doesn't lift, + -5 too big. */ +static int o3install(int d); +static void slot_changed(int slot); +static int install(int d) +{ + int slot = mread(d), kind = mread(d + 1), nin = mread(d + 2), nout = mread(d + 3); + int pay = mread(d + 4), len = mread(d + 5), names = mread(d + 6), out[8], r; + Enh ne; + if (kind == 2) return o3install(d); + if ((unsigned)slot >= NENH || (unsigned)nin > 8 || (unsigned)nout > 8 || (kind != 0 && kind != 1)) return -1; + un = 0; unv = nin; uerr = 0; + r = kind == 0 ? parse_recipe(pay, names, nin, nout, out) : lift_vm(pay, len, nin, nout, out); + if (r) { if (trace) fprintf(stderr, "enh %d: install failed (%d)\n", slot, r); return r; } + memset(&ne, 0, sizeof ne); + if ((r = optimize(&ne, nin, out, nout))) return r; + ne.kind = kind; ne.live = 1; + regalloc(&ne); + if (enh[slot].live) { free(enh[slot].u); free(enh[slot].reg); } + enh[slot] = ne; + slot_changed(slot); + if (trace) xdump(slot, &enh[slot]); + return 0; +} + +/* ---- o3: optimized regions ---- + o3 code comes from the compiler as a region: a range [lo, hi) of vm words + plus the frame slots that nothing takes the address of, each with one of 7 + registers (install kind 2: [-, 2, lo, hi, n, slot, register, ...]). the region is cut into basic blocks. each + block is lifted to ssa: the vm stack is tracked symbolically, so only what + is left on it at the end of the block touches memory, the slots live in + registers across blocks (VGET reads one at block entry, the block's end + says what each one holds now), the frame pointer is var 0, and enhancements + are spliced in. empty jumps are folded and a straight loop is rotated, so + the backends see one block per iteration when the body itself doesn't + branch. a backend compiles the whole region at once: arm64, llvm at O3, or the + region interpreter below. the region is entered at lo and at the return + points of its calls. a register can stand for several slots (variables + whose scopes don't overlap), and spilling writes it to all of them. calls, + returns, jumps out, and anything a block can't + lift leave it: the slots go back to the frame first, so the code outside + sees the usual memory. stores to its own code drop it; it lifts again on + its next entry. */ +/* ZFP is the frame pointer word from memmap.h */ +#define U_VGET U_N /* a var at block entry; imm = var */ +#define U_SLD (U_N + 1) /* the stack word at offset imm from the top at block entry */ +#define RMAXV 8 +#define RMAXE 256 +enum { T_BR, T_CBR, T_JMP, T_CALL, T_RET }; +typedef struct { + int a, n, nv, delta, nso, term, cv, s1, s2, x1, x2; + int vs[RMAXV]; /* each var's value at the end, -1 if unchanged */ + int *so; /* stack words to write at the end: offset, value */ + Uop *u; +} RB; +typedef struct { + int idx, lo, hi, nv, nv0, slot[RMAXV], lifted, dead, nonat, nb, ne, maxnv; + int np, ps[32], pv[32]; /* frame slot -> var; vars in scopes that never overlap share one */ + unsigned char fv[RMAXV]; /* 1: this var's home is a d register, not an x register */ + unsigned char seen[RMAXV]; + unsigned char sc[RMAXV]; /* 1: every local that lives in this var is a plain number (int, char, bool, float), never a pointer */ + int ent[RMAXE], entb[RMAXE]; + RB *b; + void *nat, *dnat, *stub[RMAXE]; /* the backend's code; dnat is the register-passing entry of a function region */ + int fslots, argc, fn; /* callable o3 function: frame, arity, prologue address */ + int marked; /* the backend is watching the region's words */ + unsigned char dep[NENH / 8]; /* enhancement slots spliced into the lifted code */ + void *rt; /* llvm: the resource tracker that owns the region's code */ + unsigned gen; /* bumped every time the region's code is dropped: a copy made from an older one is stale */ +} Rg; +#define MAXRG 4096 +static Rg *rgs[MAXRG]; +static int nrg; +static int fn_pc[MAXRG]; +static Rg *fn_rg_[MAXRG]; +static Rg *fn_cache[1024]; +static int nfn; + +/* ---- bookkeeping for translated code, shared by the backends ---- + a translation covers a range of vm words [a,b). three things have to stay + cheap when code is rewritten while it runs. which translation a store + hits: ranges are indexed by 64-word page, so a covered store looks at the + handful of ranges on its page. which words are still covered after one + goes: the coverage bytes are counters (a word two translations share counts + 2; 255 sticks), so dropping a translation subtracts its own range and + nothing is rebuilt. and what an install invalidates: a translation records + the enhancement slots it inlined, or found unwired, so an install drops + those and keeps the rest. */ +#define PGSH 6 +#define NPG ((code_words >> PGSH) + 1) +#define MAXPGN (1 << 19) +#define MAXDEP (1 << 18) +static struct { int a, b; } ix_blk[MAXB]; +static int ix_n; +static int *pg_head, pg_free, pg_top, pg_live; /* node numbers are stored plus one: 0 is none */ +static struct { int blk, next; } pg_node[MAXPGN]; +static int dep_head[NENH + 1], dep_n; /* slot NENH: depends on every install */ +static struct { int blk, next; } dep_node[MAXDEP]; +static int drop_epoch; /* changes whenever any translation dies */ +static void be_drop(int j); /* the backend forgets block j's code and coverage */ +static void runmark(Rg *R); /* the backend stops watching the region's words */ +static void rclear(Rg *R); +static void cinc(unsigned char *c, int lo, int hi) { if (hi > code_words) hi = (int)code_words; for (; lo < hi; lo++) if (c[lo] != 255) c[lo]++; } +static void cdec(unsigned char *c, int lo, int hi) { if (hi > code_words) hi = (int)code_words; for (; lo < hi; lo++) if (c[lo] && c[lo] != 255) c[lo]--; } +static void ix_reset(void) +{ + memset(pg_head, 0, NPG * sizeof *pg_head); memset(dep_head, 0, sizeof dep_head); + pg_free = pg_top = pg_live = dep_n = ix_n = 0; + drop_epoch++; +} +static int ix_room(void) { return ix_n < MAXB && pg_live + 24 < MAXPGN && dep_n + 300 < MAXDEP; } +static int ix_add(int a, int b) +{ + int j = ix_n++, pg, nd; + ix_blk[j].a = a; ix_blk[j].b = b; + for (pg = a >> PGSH; pg <= (b - 1) >> PGSH; pg++) { + if (pg_free) { nd = pg_free - 1; pg_free = pg_node[nd].next; } else nd = pg_top++; + pg_node[nd].blk = j; pg_node[nd].next = pg_head[pg]; pg_head[pg] = nd + 1; pg_live++; + } + return j; +} +static void ix_kill(int j) +{ + if (ix_blk[j].a < 0) return; + be_drop(j); + ix_blk[j].a = -1; + drop_epoch++; +} +/* drop every translation whose range holds addr; dead entries on the page are unlinked on the way */ +static int ix_drop_at(int addr) +{ + int *pp = &pg_head[addr >> PGSH], hit = 0, nd, j; + while (*pp) { + nd = *pp - 1; j = pg_node[nd].blk; + if (ix_blk[j].a < 0) { *pp = pg_node[nd].next; pg_node[nd].next = pg_free; pg_free = nd + 1; pg_live--; continue; } + if (ix_blk[j].a <= addr && addr < ix_blk[j].b) { ix_kill(j); hit++; continue; } + pp = &pg_node[nd].next; + } + return hit; +} +static void dep_add(int slot, int j) +{ + if ((unsigned)slot > NENH) slot = NENH; + dep_node[dep_n].blk = j; dep_node[dep_n].next = dep_head[slot]; dep_head[slot] = ++dep_n; +} +/* slot was (re)wired: drop what used it, or found it unwired, and nothing else */ +static void slot_changed(int slot) +{ + int d, h, j; + for (h = 0; h < 2; h++) { + int *hp = &dep_head[h ? NENH : slot]; + for (d = *hp; d; d = dep_node[d - 1].next) ix_kill(dep_node[d - 1].blk); + *hp = 0; + } + for (j = 0; j < nrg; j++) + if (rgs[j]->lifted && (rgs[j]->dep[slot >> 3] & (1 << (slot & 7)))) { rclear(rgs[j]); drop_epoch++; } +} +static Cell halt_at = -1; /* a nested call stopped the machine: operand or return overflow */ +static unsigned short *o3ent; /* region + 1 at an entry point */ +static unsigned char *o3ei; /* which of its entries */ +static int o3_ready(Rg *C); +static int o3_exec_region(Rg *C, int entry, Cell *ps, Cell *pr); +static int vm_until(int pc, int stop_eq, int stop_ge, Rg *re, Cell *ps, Cell *pr); +static void o3_bind(Rg *R) +{ + int i; + if (R->fn < 0) return; /* -1: a bare block. 0 is a real function at address 0 */ + fn_cache[R->fn & 1023] = R; + for (i = 0; i < nfn; i++) if (fn_pc[i] == R->fn) { fn_rg_[i] = R; return; } + if (nfn < MAXRG) { fn_pc[nfn] = R->fn; fn_rg_[nfn++] = R; } +} +static Rg *fnlookup(int pc) +{ + int i; + Rg *R = fn_cache[pc & 1023]; + if (R && R->fn == pc && !R->dead) return R; + for (i = 0; i < nfn; i++) if (fn_pc[i] == pc) { + R = fn_rg_[i]; + if (R && !R->dead) { fn_cache[pc & 1023] = R; return R; } + } + return 0; +} +/* a call made from inside a region. an o3 callee gets a frame and is entered + at its region, and its epilogue is not run: fp comes back here. anything + else is an ordinary call, pushed on the vm return stack and run until that + address is the pc again. */ +/* what is left of a call once the callee's region has returned `back`: a + return address at or past the end of the function is the normal exit (the + epilogue's lit 0 is pushed when it fell off the end), anything else is + code to run on the vm until the function is left */ +static void o3_finish(Rg *C, int back, Cell *ps, Cell *pr) +{ + for (;;) { + if (halt_at >= 0 || back < 0 || (unsigned)back >= (unsigned)MW) { + if (halt_at < 0) halt_at = back < 0 ? PC_HALT : back; + m[ZFP] = mread(ZFP) + C->fslots; + return; + } + if (back >= C->hi) { + if (back == C->hi) { /* fell off the end: the epilogue's lit 0 */ + Cell sp = *ps - 1; + if ((unsigned)sp < (unsigned)MW) { m[sp] = 0; *ps = sp; } + } + m[ZFP] = mread(ZFP) + C->fslots; + return; + } + if (back >= C->lo && o3ent[back] == C->idx + 1) { + back = o3_exec_region(C, o3ei[back], ps, pr); + continue; + } + back = vm_until(back, -1, C->hi, C, ps, pr); + } +} +/* the llvm code calls this one with the callee and the address it returned, + when the quick exit did not apply */ +static void o3_finish_c(Cell *ps, Cell *pr, Rg *C, Cell back) { o3_finish(C, (int)back, ps, pr); } +static void o3_invoke(Cell *ps, Cell *pr, Cell target, Cell retpc) +{ + Rg *C = fnlookup((int)target); + int back, fp, i, s; + if (halt_at >= 0) return; + if (*ps < stack_data_limit() + 16) { + if (stack_expand(0, stack_get(SC_DATA_TOP) - stack_get(SC_DATA_LOW) + 1, ps, pr) < 0) { halt_at = PC_DATA_OVERFLOW; return; } + } + if (!C || mread(ZFP) - C->fslots < frame_bound() || !o3_ready(C)) { + if ((unsigned)*pr < (unsigned)MW) m[(*pr)++] = retpc; + back = vm_until((int)target, (int)retpc, -1, 0, ps, pr); + if (back < 0 || (unsigned)back >= (unsigned)code_words) halt_at = back < 0 ? PC_HALT : back; + return; + } + fp = (int)mread(ZFP) - C->fslots; + m[ZFP] = fp; + s = (int)*ps; + for (i = C->argc; i-- > 0; ) { + if ((unsigned)s < (unsigned)MW && (unsigned)(fp + i) < (unsigned)MW) m[fp + i] = m[s]; + s++; + } + *ps = s; + back = o3_exec_region(C, 0, ps, pr); + o3_finish(C, back, ps, pr); +} +/* ---- c abi ---- + gate ops 14..17 and opcode 620 let vm code call native functions and hand + native code functions of its own. vm memory is one flat array of words, so + a vm byte address b is the host pointer (char *)m + b and a word address w + is (char *)m + 8 * w. an argument or result of pointer kind is converted + that way when it lies inside the array, and passed through untouched (an + opaque host pointer, a malloc result) when it does not. 0 is NULL both + ways. + + a signature is a word of 4-bit kinds: the return kind first, then one per + argument (at most 15), and a 0 kind ends the list. + 0 void 1 long (any 64-bit integer) 2 double 3 byte pointer + 4 int (32-bit, sign extended) 5 float (32-bit, widened to a double word) + 6 word pointer 7 unsigned int 8 short 9 unsigned short + 10 char 11 unsigned char (small kinds are extended on the way back) + 12 byte string object (the word address of its length word; the + native side gets the address of its first byte) + integers fill the platform's integer argument registers (6 on x86-64, 8 on + arm64), doubles the 8 fp registers, and whatever does not fit goes on the + native stack in argument order: the call goes through a prototype of that + many integer and fp parameters followed by nine stack words, so the + platform's own rules place every argument. + op 14 (blk): blk is a block of words: [0] the symbol name as a byte + address, [1] the signature, [2] a lookup cache the host keeps, [3...] the + arguments in order. the result is the native result as a word (the bits, + for a double). a missing symbol prints a message and gives -1. + op 15 (name): 1 if the symbol resolves, else 0. + op 16 (entry, sig): a native function pointer that calls the vm function at + entry with the arguments the signature names, or 0. the vm code runs on top + of the stacks as they were when the native call that is running started, so + the pointer is only good while some native call from the vm is running. + op 17 (path): dlopen a library so later lookups can find its symbols. + opcode 620 (a0 ... an-1 blk -- r) is op 14 with the arguments on the stack + and the block's signature saying how many; o3 lifts it to the micro-ops + narg and ncall, and the llvm backend turns those into a direct typed call. */ +#ifdef ZYFFI +#if defined(__aarch64__) +#define FFI_NI 8 +#define FFI_IT Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell +#define FFI_IN Cell a, Cell b, Cell c, Cell d, Cell e, Cell f, Cell g, Cell h +#define FFI_IV a, b, c, d, e, f, g, h +#define FFI_IC(iv) iv[0], iv[1], iv[2], iv[3], iv[4], iv[5], iv[6], iv[7] +#else +#define FFI_NI 6 +#define FFI_IT Cell, Cell, Cell, Cell, Cell, Cell +#define FFI_IN Cell a, Cell b, Cell c, Cell d, Cell e, Cell f +#define FFI_IV a, b, c, d, e, f +#define FFI_IC(iv) iv[0], iv[1], iv[2], iv[3], iv[4], iv[5] +#endif +#define FFI_NS 15 +#define FFI_DT double, double, double, double, double, double, double, double +#define FFI_ST Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell, Cell +typedef Cell (*FfiI)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef double (*FfiD)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef float (*FfiF)(FFI_IT, FFI_DT, FFI_ST, ...); +#define FFI_SYMS 256 +#define FFI_LIBS 16 +static struct { char name[96]; void *p; } ffi_sym[FFI_SYMS]; +static int ffi_nsym; +static void *ffi_lib[FFI_LIBS]; +static int ffi_nlib, ffi_tried_libm; +static void *ffi_lookup(const char *name) +{ + int i; + void *p; + for (i = 0; i < ffi_nsym; i++) if (!strcmp(ffi_sym[i].name, name)) return ffi_sym[i].p; + p = dlsym(RTLD_DEFAULT, name); + for (i = 0; !p && i < ffi_nlib; i++) p = dlsym(ffi_lib[i], name); + if (!p && !ffi_tried_libm) { /* the math library is not linked into every host */ + void *h; + ffi_tried_libm = 1; + h = dlopen("libm.so.6", RTLD_NOW | RTLD_GLOBAL); + if (!h) h = dlopen("libm.dylib", RTLD_NOW | RTLD_GLOBAL); + if (h && ffi_nlib < FFI_LIBS) ffi_lib[ffi_nlib++] = h; + for (i = 0; !p && i < ffi_nlib; i++) p = dlsym(ffi_lib[i], name); + } + if (p && strlen(name) < sizeof ffi_sym[0].name && ffi_nsym < FFI_SYMS) { + strcpy(ffi_sym[ffi_nsym].name, name); + ffi_sym[ffi_nsym++].p = p; + } + return p; +} +static Cell ffi_name(Cell a, char *dst, int max) +{ + return bop_cstr(m, a, dst, max, MW); +} +static Cell ffi_find(Cell a) +{ + char name[96]; + if (ffi_name(a, name, 96) <= 0) return 0; + return ffi_lookup(name) ? 1 : 0; +} +static Cell ffi_load(Cell a) +{ + char path[512]; + void *h; + if (ffi_name(a, path, 512) <= 0 || ffi_nlib >= FFI_LIBS) return 0; + h = dlopen(path, RTLD_NOW | RTLD_GLOBAL); + if (!h) return 0; + ffi_lib[ffi_nlib++] = h; + return 1; +} +static Cell ffi_in(Cell v, int kind) /* a vm value as the native argument */ +{ + if (kind == 3 && v && (UCell)v < (UCell)MW * 8) return (Cell)((char *)m + v); + if (kind == 6 && v && (UCell)v < (UCell)MW) return (Cell)((char *)m + v * 8); + if (kind == 12 && v && (UCell)v + 1 < (UCell)MW) return (Cell)((char *)m + (v + 1) * 8); + return v; +} +static Cell ffi_out(Cell v, int kind) /* a native result as a vm value */ +{ + char *p = (char *)v, *lo = (char *)m, *hi = (char *)m + (size_t)MW * 8; + if (kind == 4) return (Cell)(int)v; + if (kind == 7) return (Cell)(uint32_t)v; + if (kind == 8) return (Cell)(int16_t)v; + if (kind == 9) return (Cell)(uint16_t)v; + if (kind == 10) return (Cell)(int8_t)v; + if (kind == 11) return (Cell)(uint8_t)v; + if ((kind == 3 || kind == 6) && p >= lo && p < hi) return kind == 3 ? (Cell)(p - lo) : (Cell)((p - lo) >> 3); + return v; +} +static double ffi_d(Cell v) { double d; memcpy(&d, &v, 8); return d; } +static Cell ffi_bits(double d) { Cell v; memcpy(&v, &d, 8); return v; } +/* a signature's arguments are nibbles after the result. code 13 (a struct in + registers) and code 14 (a struct in memory) start a group: the next nibble is + its length in eightbytes, and each eightbyte is one more nibble (1 integer, + 2 sse). every other code is one argument. on the stack a group is one item: + the vm address of the struct, and its eightbytes are the words from there on. + every argument, a group included, is one item (one word of the stack or of a + call block's slots) */ +#define FFI_GROUP_REG 13 +#define FFI_GROUP_MEM 14 +static int ffi_hasgroup(Cell sig) +{ + int p; + for (p = 1; p <= 15; p++) { + int k = (int)((sig >> (4 * p)) & 15); + if (!k) break; + if (k == FFI_GROUP_REG || k == FFI_GROUP_MEM) return 1; + } + return 0; +} +static int ffi_nargs(Cell sig) +{ + int n = 0, p = 1; + while (p <= 15) { + int k = (int)((sig >> (4 * p)) & 15); + if (!k) break; + if (k == FFI_GROUP_REG || k == FFI_GROUP_MEM) { + int len = (int)((sig >> (4 * (p + 1))) & 15); + n++; + p += 2 + len; + } else { n++; p++; } + } + return n; +} +/* the symbol a block names. word 2 remembers which table slot answered last + time (plus one), so a repeated call costs one string compare. a stale + number from another run fails the compare and goes through the lookup */ +static void *ffi_blkfn(Cell blk) +{ + char name[96]; + void *f; + int k; + if (blk < 0 || blk + 18 >= MW) return 0; + if (ffi_name(m[blk], name, 96) <= 0) return 0; + k = (int)(m[blk + 2] & 0xffffffffLL); + if (k > 0 && k <= ffi_nsym && !strcmp(ffi_sym[k - 1].name, name)) return ffi_sym[k - 1].p; + f = ffi_lookup(name); + for (k = 0; f && k < ffi_nsym; k++) if (ffi_sym[k].p == f && !strcmp(ffi_sym[k].name, name)) { m[blk + 2] = (m[blk + 2] & ~0xffffffffLL) | (k + 1); break; } + if (!f) fprintf(stderr, "zy: no native symbol %s\n", name); + return f; +} +/* a struct result. the call block's word 2 holds the host's cache in its low half + and the result's descriptor in its high half: the struct's length in words, then + one class nibble per word (1 integer, 2 float). the result's memory is the first + item of the call (the stub makes it), and the words go there. which words travel + in memory is the host's rule (ffi_retmem); the rest come back in registers, and + the c function type that returns the matching struct gets them there */ +typedef struct { Cell a, b; } FfiSII; +typedef struct { double a, b; } FfiSDD; +typedef struct { Cell a; double b; } FfiSID; +typedef struct { double a; Cell b; } FfiSDI; +typedef struct { double d[1]; } FfiSF1; +typedef struct { double d[2]; } FfiSF2; +typedef struct { double d[3]; } FfiSF3; +typedef struct { double d[4]; } FfiSF4; +typedef struct { Cell w[7]; } FfiSBIG; +typedef FfiSII (*FfiRII)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef FfiSDD (*FfiRDD)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef FfiSID (*FfiRID)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef FfiSDI (*FfiRDI)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef FfiSF1 (*FfiRF1)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef FfiSF2 (*FfiRF2)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef FfiSF3 (*FfiRF3)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef FfiSF4 (*FfiRF4)(FFI_IT, FFI_DT, FFI_ST, ...); +typedef FfiSBIG (*FfiRBIG)(FFI_IT, FFI_DT, FFI_ST, ...); +#define FFI_CALL(T) ((T)f)(FFI_IC(iv), dv[0], dv[1], dv[2], dv[3], dv[4], dv[5], dv[6], dv[7], sv[0], sv[1], sv[2], sv[3], sv[4], sv[5], sv[6], sv[7], sv[8], sv[9], sv[10], sv[11], sv[12], sv[13], sv[14]) +/* does the host send this result through memory? sysv: more than two words. aapcs64: + more than two words unless it is a float struct of up to four words, which comes + back in the v registers, and an integer struct of up to two */ +static int ffi_retmem(Cell rdesc) +{ + int n = (int)(rdesc & 15), g; + if (n <= 2) return 0; +#if defined(__aarch64__) + if (n > 4) return 1; + for (g = 0; g < n; g++) if (((rdesc >> (4 + 4 * g)) & 15) != 2) return 1; + return 0; +#else + return 1; +#endif +} +/* the call that returns a struct: the words land in m at res */ +static void ffi_call_ret(void *f, Cell rdesc, Cell *iv, double *dv, Cell *sv, Cell res) +{ + int n = (int)(rdesc & 15), g, c[8], hfa = 1; + for (g = 0; g < n; g++) { c[g] = (int)((rdesc >> (4 + 4 * g)) & 15); if (c[g] != 2) hfa = 0; } +#if defined(__x86_64__) || defined(__aarch64__) + if (ffi_retmem(rdesc)) { +#if defined(__x86_64__) + FFI_CALL(FfiI); /* iv[0] is the hidden pointer (ffi_invoke set it); the callee writes there */ +#else + { FfiSBIG s = FFI_CALL(FfiRBIG); for (g = 0; g < n; g++) m[res + g] = s.w[g]; } +#endif + return; + } +#if defined(__aarch64__) + if (hfa && n == 1) { FfiSF1 s = FFI_CALL(FfiRF1); m[res] = ffi_bits(s.d[0]); } + else if (hfa && n == 2) { FfiSF2 s = FFI_CALL(FfiRF2); m[res] = ffi_bits(s.d[0]); m[res + 1] = ffi_bits(s.d[1]); } + else if (hfa && n == 3) { FfiSF3 s = FFI_CALL(FfiRF3); for (g = 0; g < 3; g++) m[res + g] = ffi_bits(s.d[g]); } + else if (hfa && n == 4) { FfiSF4 s = FFI_CALL(FfiRF4); for (g = 0; g < 4; g++) m[res + g] = ffi_bits(s.d[g]); } + else { FfiSII s = FFI_CALL(FfiRII); m[res] = s.a; if (n > 1) m[res + 1] = s.b; } +#else + if (n == 1) { if (c[0] == 2) m[res] = ffi_bits(FFI_CALL(FfiD)); else m[res] = FFI_CALL(FfiI); } + else if (c[0] == 1 && c[1] == 1) { FfiSII s = FFI_CALL(FfiRII); m[res] = s.a; m[res + 1] = s.b; } + else if (c[0] == 2 && c[1] == 2) { FfiSDD s = FFI_CALL(FfiRDD); m[res] = ffi_bits(s.a); m[res + 1] = ffi_bits(s.b); } + else if (c[0] == 1) { FfiSID s = FFI_CALL(FfiRID); m[res] = s.a; m[res + 1] = ffi_bits(s.b); } + else { FfiSDI s = FFI_CALL(FfiRDI); m[res] = ffi_bits(s.a); m[res + 1] = s.b; } +#endif +#else + (void)f; (void)rdesc; (void)iv; (void)dv; (void)sv; (void)res; (void)hfa; + fprintf(stderr, "zy: a struct result needs x86-64 or arm64 in this build\n"); +#endif +} +/* call f with the vm values av, by the signature. integer-class arguments take + the integer registers in turn, fp ones the fp registers, and what is left + over lands in the stack words in order (a float32 is the low half of a + word, as it would sit in a register) */ +/* darwin puts unnamed arguments on the stack. these standard stdio entry + points have known fixed prefixes even when an extern uses a zc alias. */ +static int ffi_varargs(void *f) +{ +#if defined(__APPLE__) && defined(__aarch64__) + static const char *names[] = { "printf", "fprintf", "sprintf", "snprintf" }; + static const int fixed[] = { 1, 2, 2, 3 }; + static void *entry[4]; static int ready; + int i; + if (!ready) { for (i = 0; i < 4; i++) entry[i] = dlsym(RTLD_DEFAULT, names[i]); ready = 1; } + for (i = 0; i < 4; i++) if (f == entry[i]) return fixed[i]; +#else + (void)f; +#endif + return -1; +} +static Cell ffi_invoke(void *f, Cell sig, const Cell *av, Cell rdesc) +{ + Cell iv[8] = {0, 0, 0, 0, 0, 0, 0, 0}, sv[FFI_NS] = {0, 0, 0, 0, 0, 0, 0, 0, 0}, r, w; + Cell cbuf[225]; /* copies of the structs passed by reference (aapcs64) */ + int nc = 0; + double dv[8] = {0, 0, 0, 0, 0, 0, 0, 0}; + int ni = 0, nd = 0, ns = 0, i = 0, j = 0, p, k, rk = (int)(sig & 15), fixed = ffi_varargs(f); + int sret = rk == FFI_GROUP_REG || rk == FFI_GROUP_MEM, rn = (int)(rdesc & 15); + Cell res = 0; + if (sret) { + if (rn < 1 || rn > 7) return -1; + res = av[0]; + if (res < 0 || res + rn > MW) return -1; + j = 1; +#if defined(__x86_64__) + if (ffi_retmem(rdesc)) { iv[0] = (Cell)(intptr_t)(m + res); ni = 1; } +#endif + } + for (p = 1; p <= 15; p++) { + k = (int)((sig >> (4 * p)) & 15); + if (!k) break; + if (k == FFI_GROUP_REG || k == FFI_GROUP_MEM) { + /* a struct: one item, its vm address. its eightbytes take registers only as + a whole, else all of them go on the stack, in order (the sysv rule). only + the sysv classes are done so far */ +#if defined(__x86_64__) || defined(__aarch64__) + int len = (int)((sig >> (4 * (p + 1))) & 15), g, need_i = 0, need_d = 0; + Cell base = av[j]; + if (base < 0 || base + len > MW || len < 1 || len > 15) return -1; + for (g = 0; g < len; g++) { + if (((sig >> (4 * (p + 2 + g))) & 15) == 2) need_d++; else need_i++; + } +#if defined(__aarch64__) + /* aapcs64: a homogeneous float struct of up to four words goes in the v + registers, one word each; another struct of two words or less goes in + the x registers; a bigger one is passed by reference (a copy, whose + address is the integer argument). a struct that does not fit takes the + rest of its register class, so the later arguments go on the stack */ + if (need_i == 0 && len <= 4) { + if (nd + len <= 8) { for (g = 0; g < len; g++) dv[nd++] = ffi_d(m[base + g]); } + else { nd = 8; for (g = 0; g < len; g++) { if (ns >= FFI_NS) return -1; sv[ns++] = m[base + g]; } } + } else if (len <= 2) { + if (ni + len <= FFI_NI) { for (g = 0; g < len; g++) iv[ni++] = m[base + g]; } + else { ni = FFI_NI; for (g = 0; g < len; g++) { if (ns >= FFI_NS) return -1; sv[ns++] = m[base + g]; } } + } else { + Cell *cp = cbuf + nc; + for (g = 0; g < len; g++) { if (nc >= 225) return -1; cbuf[nc++] = m[base + g]; } + if (ni < FFI_NI) iv[ni++] = (Cell)(intptr_t)cp; + else if (ns < FFI_NS) sv[ns++] = (Cell)(intptr_t)cp; + else return -1; + } +#else + if (k == FFI_GROUP_REG && ni + need_i <= FFI_NI && nd + need_d <= 8) { + for (g = 0; g < len; g++) { + if (((sig >> (4 * (p + 2 + g))) & 15) == 2) dv[nd++] = ffi_d(m[base + g]); + else iv[ni++] = m[base + g]; + } + } else { + for (g = 0; g < len; g++) { + if (ns >= FFI_NS) return -1; + sv[ns++] = m[base + g]; + } + } +#endif + j++; + p += 1 + len; + continue; +#else + fprintf(stderr, "zy: a struct by value needs x86-64 or arm64 in this build\n"); + return -1; +#endif + } + if (fixed >= 0 && p > fixed) { + if (ns >= FFI_NS) return -1; + if (k == 5) w = ffi_bits((double)(float)ffi_d(av[j])); + else if (k == 2) w = av[j]; + else w = ffi_in(av[j], k); + sv[ns++] = w; j++; continue; + } + if (k == 2 || k == 5) { + if (k == 5) { + float fl = (float)ffi_d(av[j]); + uint32_t u; + memcpy(&u, &fl, 4); + w = (Cell)u; + } else w = av[j]; + if (nd < 8) dv[nd++] = ffi_d(w); + else if (ns < FFI_NS) sv[ns++] = w; + else return -1; + } else { + w = ffi_in(av[j], k); + if (ni < FFI_NI) iv[ni++] = w; + else if (ns < FFI_NS) sv[ns++] = w; + else return -1; + } + j++; + } + (void)i; + if (sret) { ffi_call_ret(f, rdesc, iv, dv, sv, res); return 0; } + if (rk == 2) r = ffi_bits(FFI_CALL(FfiD)); + else if (rk == 5) r = ffi_bits((double)FFI_CALL(FfiF)); + else { + r = FFI_CALL(FfiI); + r = rk ? ffi_out(r, rk) : 0; + } + return r; +} +static Cell ffi_call(Cell blk) +{ + void *f = ffi_blkfn(blk); + Cell av[15]; + int i; + if (!f) return -1; + for (i = 0; i < 15; i++) av[i] = m[blk + 3 + i]; + return ffi_invoke(f, m[blk + 1], av, (Cell)((UCell)m[blk + 2] >> 32)); +} +/* opcode 620 on the data stack: blk on top, then the arguments, the last one + next. returns the new stack top, with the result on it. cb_r has to be set + by the caller (the interpreter's r, an llvm block's r) */ +static Cell ncall_exec(Cell s) +{ + Cell blk, sig, av[15], res = -1; + int n, i; + void *f; + if ((UCell)s >= (UCell)MW) return s; + blk = m[s]; + if (blk < 0 || blk + 18 >= MW) return s + 1; + sig = m[blk + 1]; + n = ffi_nargs(sig); + if (s + n >= MW) return s + 1; + for (i = 0; i < n; i++) av[i] = m[s + n - i]; + f = ffi_blkfn(blk); + cb_s = s + n + 1; + if ((sig & 15) >= 13) res = -1; /* a struct result is only made by the stub's syscall */ + else if (f) res = ffi_invoke(f, sig, av, 0); + m[s + n] = res; + return s + n; +} +/* the jit's form: sp and rp are host pointers into m */ +static long ncall_host(long sp, long rp) +{ + Cell s = ((Cell *)sp - m); + cb_r = (Cell *)rp - m; + return (long)(m + ncall_exec(s)); +} + +/* callbacks. each slot is a native function of the c shapes (the integer and + fp registers and nine stack words in, one result out), one set per result + class. calling it pushes the arguments on the vm data stack as vm code + expects them, pushes a return address that stops the nested run, runs the + vm function and pops its result. */ +#define FFI_CBS 16 +static struct { Cell entry, sig; int used; } ffi_cb[3][FFI_CBS]; +static Cell ffi_enter(int cls, int k, Cell *iv, double *dv, Cell *sv) +{ + Cell s = cb_s, r = cb_r, sig = ffi_cb[cls][k].sig, res = 0, sent = 1, w; + int i, kind, ni = 0, nd = 0, ns = 0, n = 0, back; + Cell args[16]; + if (halt_at >= 0 || (unsigned)(s - 20) >= (unsigned)MW || (unsigned)r >= (unsigned)MW) return 0; + for (i = 0; i < 15; i++) { + kind = (int)((sig >> (4 * (i + 1))) & 15); + if (!kind) break; + if (kind == 2 || kind == 5) { + w = nd < 8 ? ffi_bits(dv[nd++]) : ns < FFI_NS ? sv[ns++] : 0; + if (kind == 5) { + uint32_t u = (uint32_t)w; + float fl; + memcpy(&fl, &u, 4); + w = ffi_bits((double)fl); + } + args[n++] = w; + } else { + w = ni < FFI_NI ? iv[ni++] : ns < FFI_NS ? sv[ns++] : 0; + args[n++] = ffi_out(w, kind); + } + } + for (i = 0; i < n; i++) m[--s] = args[i]; + m[r++] = sent; + back = vm_until((int)ffi_cb[cls][k].entry, (int)sent, -1, 0, &s, &r); + if (back < 0 || (unsigned)back >= (unsigned)code_words) halt_at = back < 0 ? PC_HALT : back; + if (halt_at >= 0) return 0; + if ((unsigned)s < (unsigned)MW) res = m[s++]; + cb_s = s; cb_r = r; + kind = (int)(sig & 15); + if (cls == 0) return kind ? ffi_in(res, kind) : 0; + return res; +} +#define FFI_ARGS FFI_IN, double x0, double x1, double x2, double x3, double x4, double x5, double x6, double x7, Cell s0, Cell s1, Cell s2, Cell s3, Cell s4, Cell s5, Cell s6, Cell s7, Cell s8 +#define FFI_PACK Cell iv[8] = {FFI_IV}; double dv[8] = {x0, x1, x2, x3, x4, x5, x6, x7}; Cell sv[FFI_NS] = {s0, s1, s2, s3, s4, s5, s6, s7, s8} +#define FFI_SLOT(K) \ + static Cell ffi_i##K(FFI_ARGS) { FFI_PACK; return ffi_enter(0, K, iv, dv, sv); } \ + static double ffi_d##K(FFI_ARGS) { FFI_PACK; return ffi_d(ffi_enter(1, K, iv, dv, sv)); } \ + static float ffi_f##K(FFI_ARGS) { FFI_PACK; return (float)ffi_d(ffi_enter(2, K, iv, dv, sv)); } +#define FFI_ALL(X) X(0) X(1) X(2) X(3) X(4) X(5) X(6) X(7) X(8) X(9) X(10) X(11) X(12) X(13) X(14) X(15) +FFI_ALL(FFI_SLOT) +#define FFI_PICK(K) (void *)ffi_i##K, +#define FFI_PICKD(K) (void *)ffi_d##K, +#define FFI_PICKF(K) (void *)ffi_f##K, +static void *ffi_fn[3][FFI_CBS] = { { FFI_ALL(FFI_PICK) }, { FFI_ALL(FFI_PICKD) }, { FFI_ALL(FFI_PICKF) } }; +static Cell ffi_cbmake(Cell entry, Cell sig) +{ + int cls = (sig & 15) == 2 ? 1 : (sig & 15) == 5 ? 2 : 0, k; + for (k = 0; k < FFI_CBS; k++) + if (ffi_cb[cls][k].used && ffi_cb[cls][k].entry == entry && ffi_cb[cls][k].sig == sig) return (Cell)ffi_fn[cls][k]; + for (k = 0; k < FFI_CBS; k++) + if (!ffi_cb[cls][k].used) { + ffi_cb[cls][k].used = 1; ffi_cb[cls][k].entry = entry; ffi_cb[cls][k].sig = sig; + return (Cell)ffi_fn[cls][k]; + } + return 0; +} +/* a native call the o3 lifter has resolved: the micro-ops narg and ncall carry + an index into this table. imm of narg is the argument's position */ +typedef struct { void *f; Cell sig; int n; char name[48]; } Ncd; +static Ncd ncd[256]; +static int nncd; +static int ncd_get(Cell blk) +{ + void *f; + Cell sig; + char name[96]; + int i; + if (blk < 0 || blk + 18 >= MW) return -1; + if (ffi_name(m[blk], name, 96) <= 0) return -1; + f = ffi_lookup(name); + if (!f) return -1; + sig = m[blk + 1]; + if (ffi_hasgroup(sig) || (sig & 15) >= 13) return -1; /* the o3 lifter reads one nibble per argument; a struct goes through ncall_exec */ + for (i = 0; i < nncd; i++) if (ncd[i].f == f && ncd[i].sig == sig) return i; + if (nncd >= 256) return -1; + ncd[nncd].f = f; ncd[nncd].sig = sig; ncd[nncd].n = ffi_nargs(sig); + strncpy(ncd[nncd].name, name, 47); + ncd[nncd].name[47] = 0; + return nncd++; +} +#else +static Cell ffi_call(Cell blk) { return -1; } +static Cell ffi_find(Cell name) { return 0; } +static Cell ffi_cbmake(Cell entry, Cell sig) { return 0; } +static Cell ffi_load(Cell name) { return 0; } +static Cell ncall_exec(Cell s) +{ + Cell blk, sig; + int n = 0; + if ((UCell)s >= (UCell)MW) return s; + blk = m[s]; + if (blk < 0 || blk + 18 >= MW) return s + 1; + sig = m[blk + 1]; + while (n < 15 && ((sig >> (4 * (n + 1))) & 15)) n++; + m[s + n] = -1; + return s + n; +} +static long ncall_host(long sp, long rp) { return (long)(m + ncall_exec((Cell *)sp - m)); } +static int ncd_get(Cell blk) { return -1; } +#endif + +static void rforget(Rg *R); /* the backend drops its code */ +static void rmark(Rg *R); /* the backend watches the region's words */ +static void rcompile(Rg *R, int eager); + +static int nargs(int op) { return op >= U_N ? 0 : uarity[op]; } +static int op_fpdest(int op) +{ + return op == U_FADD || op == U_FSUB || op == U_FMUL || op == U_FDIV || op == U_I2F || op == U_S2F; +} +/* operand 0 is a, 1 is b. comparisons read floats and write an integer. */ +static int op_fpuse(int op, int which) +{ + if (op == U_FADD || op == U_FSUB || op == U_FMUL || op == U_FDIV || op == U_FEQ || op == U_FLT || op == U_FLE) return 1; + if ((op == U_F2I || op == U_F2S) && which == 0) return 1; + return 0; +} +/* 1 when the value should stay in an FP register: a float result, a float + variable, or a load/constant that is only ever used as a float. a use that + also wants an integer (a branch, an int variable) keeps the bits in a GPR + and the float use converts at that instruction. */ +static void class_fp(Rg *R, RB *B, unsigned char *fp) +{ + int i, j, *fu, *gu, n = B->nv; + fu = calloc(n + 1, sizeof(int)); + gu = calloc(n + 1, sizeof(int)); + memset(fp, 0, n); + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int na = nargs(u->op); + if (na > 0) { if (op_fpuse(u->op, 0)) fu[u->a]++; else gu[u->a]++; } + if (na > 1) { if (op_fpuse(u->op, 1)) fu[u->b]++; else gu[u->b]++; } + if (na > 2) gu[u->c]++; + } + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0) { + if (R->fv[j]) fu[B->vs[j]]++; else gu[B->vs[j]]++; + } + if ((B->term == T_CBR || B->term == T_JMP || B->term == T_CALL) && B->cv >= 0) gu[B->cv]++; + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int d = u->d; + if (is_store(u->op) || u->op == U_NARG) continue; + if (u->op == U_VGET) { if ((unsigned)u->imm < RMAXV && R->fv[u->imm]) fp[d] = 1; continue; } + if (op_fpdest(u->op) || (fu[d] && !gu[d])) fp[d] = 1; + } + free(fu); free(gu); +} +static void rclear(Rg *R) +{ + int b; + if (R->marked) { runmark(R); R->marked = 0; } + memset(R->dep, 0, sizeof R->dep); + rforget(R); + for (b = 0; b < R->nb; b++) { free(R->b[b].u); free(R->b[b].so); } + free(R->b); R->b = 0; R->nb = 0; R->lifted = 0; + R->gen++; +} +static void rdrop_all(void) { int j; for (j = 0; j < nrg; j++) if (rgs[j]->lifted) rclear(rgs[j]); } + +/* lifting one block */ +static Rg *R_; +static unsigned char *lead_; +static int *bidx_, *wl_, nw_; +static int lv_[RMAXV], lw_[RMAXV]; +#define SB 1100 +static int skv[2 * SB], stp, slo, shi; +static unsigned char skk[2 * SB]; +static int afp[MAXUOP * 4 + 16]; /* value -> 1 + its offset from fp, if it is fp + k */ +static int emap[MAXUOP * 4 + 16]; + +static int rvar(int v) +{ + if (lv_[v] < 0) { lv_[v] = raw(U_VGET, 0, 0, 0, v); if (!v) afp[lv_[v]] = 1; } + return lv_[v]; +} +static int slotvar(int off) { int j; for (j = 0; j < R_->np; j++) if (R_->ps[j] == off) return R_->pv[j]; return 0; } +static int rbin(int op, int x, int y, int z) +{ + int r = oe(op, x, y, z, 0); + if (op == U_ADD && !afp[r]) { + if (afp[x] && isk[y]) afp[r] = afp[x] + kv[y]; + else if (afp[y] && isk[x]) afp[r] = afp[y] + kv[x]; + } + return r; +} +static int rld(int a) +{ + int v; + if (isk[a] && kv[a] == ZFP) return rvar(0); + if (afp[a] && (v = slotvar(afp[a] - 1))) return rvar(v); + return oe(U_LD, a, 0, 0, 0); +} +static int rst(int a, int b) +{ + int v; + if (isk[a] && kv[a] == ZFP) return 0; /* moving the frame: not in here */ + if (afp[a] && (v = slotvar(afp[a] - 1))) { lv_[v] = b; lw_[v] = 1; return 1; } + oe(U_ST, a, b, 0, 0); + return 1; +} +static int sget(int o) +{ + if (o < -SB || o >= SB) { uerr = -6; return 0; } + if (!skk[o + SB]) { + if (o < 0) { uerr = -6; return 0; } + skv[o + SB] = raw(U_SLD, 0, 0, 0, o); skk[o + SB] = 1; + } + if (o < slo) slo = o; + if (o >= shi) shi = o + 1; + return skv[o + SB]; +} +static void sset(int o, int v) +{ + if (o < -SB || o >= SB) { uerr = -6; return; } + skv[o + SB] = v; skk[o + SB] = 1; + if (o < slo) slo = o; + if (o >= shi) shi = o + 1; +} +static int spop(void) { return sget(stp++); } +static void spush(int v) { sset(--stp, v); } +static int rblk(int t) { return t >= R_->lo && t < R_->hi && lead_[t - R_->lo] ? bidx_[t - R_->lo] : -1; } +/* an enhancement, spliced into the block */ +static int rsplice(Enh *e) +{ + int i, j; + for (j = e->nin; j--;) emap[j] = spop(); + for (i = 0; i < e->n && !uerr; i++) { + Uop *u = &e->u[i]; + int na = nargs(u->op), a = na > 0 ? emap[u->a] : 0, b = na > 1 ? emap[u->b] : 0, c = na > 2 ? emap[u->c] : 0; + if (u->op == U_LI) emap[u->d] = K(u->imm); + else if (u->op == U_LD) emap[u->d] = rld(a); + else if (u->op == U_ST) { if (!rst(a, b)) uerr = -4; } + else emap[u->d] = rbin(u->op, a, b, c); + } + for (j = 0; j < e->nout; j++) spush(emap[e->out[j]]); + return uerr; +} +static int lift_block(int bi) +{ + static const int map[] = { U_ADD, U_SUB, U_MUL, U_AND, U_OR, U_XOR, U_SAR, U_LT }; + RB *B = &R_->b[bi]; + int i = B->a, k, x, y, t, j, o, n = 0, *live; + Cell w; + on = 0; onv = 0; uerr = 0; + memset(afp, 0, sizeof afp); memset(skk, 0, sizeof skk); + stp = slo = shi = 0; + for (j = 0; j < RMAXV; j++) { lv_[j] = -1; lw_[j] = 0; } + B->term = T_JMP; B->cv = -1; B->s1 = B->s2 = -1; B->x1 = B->x2 = 0; + for (;;) { + if (uerr) return uerr; + if (i != B->a && (t = rblk(i)) >= 0) { B->term = T_BR; B->s1 = t; goto done; } + if (i < R_->lo || i >= R_->hi) goto leave_at; + w = m[i]; + if (w & 1) { spush(K(w >> 1)); i++; continue; } + k = (int)(w >> 1); + switch (k) { + case 0: B->cv = K(-1); goto done; /* halt */ + case 1: x = spop(); spush(rld(x)); break; + case 2: + x = sget(stp); + if (isk[x] && kv[x] == ZFP) goto leave_at; + x = spop(); y = spop(); rst(x, y); + break; + case 3: /* pick: a constant depth */ + x = sget(stp); + if (!isk[x] || kv[x] < 0 || kv[x] > 1024) goto leave_at; + stp++; spush(sget(stp + kv[x])); + break; + case 4: stp++; break; + case 5: x = sget(stp); y = sget(stp + 1); sset(stp, y); sset(stp + 1, x); break; + case 6: B->cv = spop(); B->term = T_CALL; B->x2 = i + 1; goto done; + case 7: + x = spop(); + if (isk[x] && (t = rblk(kv[x])) >= 0) { B->term = T_BR; B->s1 = t; } + else B->cv = x; + goto done; + case 8: + x = sget(stp); + if (!isk[x]) goto leave_at; + stp++; y = spop(); + if (isk[y]) { /* a known condition */ + if (kv[y]) { i++; continue; } + if ((t = rblk(kv[x])) >= 0) { B->term = T_BR; B->s1 = t; } else B->cv = K(kv[x]); + goto done; + } + B->term = T_CBR; B->cv = y; + B->x1 = kv[x]; B->s1 = rblk(kv[x]); + B->x2 = i + 1; B->s2 = rblk(i + 1); + goto done; + case 9: B->term = T_RET; goto done; + case 13: case 14: case 15: case 16: case 17: case 18: case 19: case 20: + x = spop(); y = spop(); spush(rbin(map[k - 13], y, x, 0)); + break; + case 600: /* flit: the next word is the raw bits, even when it looks like halt */ + if (i + 1 >= code_words) goto leave_at; + spush(K(m[i + 1])); + i += 2; + continue; + case 601: case 602: case 603: case 604: case 605: case 606: case 607: { + static const int fmap[] = { U_FADD, U_FSUB, U_FMUL, U_FDIV, U_FEQ, U_FLT, U_FLE }; + x = spop(); y = spop(); spush(rbin(fmap[k - 601], y, x, 0)); + break; } + case 608: x = spop(); spush(rbin(U_I2F, x, 0, 0)); break; + case 609: x = spop(); spush(rbin(U_F2I, x, 0, 0)); break; + case 620: { /* a native call: the block address is a constant, so the callee and its signature are known now */ +#ifdef ZYJIT + goto leave_at; +#else + int di, na, av[15]; + x = sget(stp); + if (!isk[x] || (di = ncd_get(kv[x])) < 0) goto leave_at; + na = ncd[di].n; + stp++; + for (j = na; j-- > 0;) av[j] = spop(); + for (j = 0; j < na; j++) raw(U_NARG, av[j], 0, 0, j); + spush(raw(U_NCALL, 0, 0, 0, di)); + break; +#endif + } + case 612: x = spop(); spush(raw(U_LD8, x, 0, 0, 0)); break; + case 614: x = spop(); spush(raw(U_LD16, x, 0, 0, 0)); break; + case 616: x = spop(); spush(raw(U_LD32, x, 0, 0, 0)); break; + case 613: x = spop(); y = spop(); raw(U_ST8, x, y, 0, 0); break; + case 615: x = spop(); y = spop(); raw(U_ST16, x, y, 0, 0); break; + case 617: x = spop(); y = spop(); raw(U_ST32, x, y, 0, 0); break; + default: + if (k >= XOP0 && k < XOP0 + NENH && enh[k - XOP0].live) { R_->dep[(k - XOP0) >> 3] |= 1 << ((k - XOP0) & 7); if (rsplice(&enh[k - XOP0])) return uerr; break; } + goto leave_at; /* i/o, install, unwired: done the usual way */ + } + i++; + } +leave_at: + B->term = T_JMP; B->cv = K(i); +done: + if (uerr) return uerr; + B->delta = stp; + B->so = malloc((shi - slo + 1) * 2 * sizeof(int)); + B->nso = 0; + for (o = stp > slo ? stp : slo; o < shi; o++) + if (skk[o + SB]) { + x = skv[o + SB]; + if (ob[x].op == U_SLD && ob[x].imm == o) continue; /* still the word that was there */ + if (afp[x] && slotvar(afp[x] - 1)) return -7; /* a register var's address can't wait in memory */ + B->so[2 * B->nso] = o; B->so[2 * B->nso + 1] = x; B->nso++; + } + for (j = 0; j < RMAXV; j++) B->vs[j] = -1; + for (j = 1; j < R_->nv; j++) + if (lw_[j] && !(ob[lv_[j]].op == U_VGET && ob[lv_[j]].imm == j)) B->vs[j] = lv_[j]; + /* dead code: what the block leaves behind and its stores are live */ + live = calloc(onv + 1, sizeof *live); + for (j = 0; j < B->nso; j++) live[B->so[2 * j + 1]] = 1; + for (j = 1; j < R_->nv; j++) if (B->vs[j] >= 0) live[B->vs[j]] = 1; + if (B->term == T_CBR || B->term == T_JMP || B->term == T_CALL) live[B->cv] = 1; + for (i = on; i--;) { + Uop *u = &ob[i]; + if (!is_eff(u->op) && !live[u->d]) { u->op = -1; continue; } + k = nargs(u->op); + if (k > 0) live[u->a] = 1; + if (k > 1) live[u->b] = 1; + if (k > 2) live[u->c] = 1; + } + free(live); + B->u = malloc((on + 1) * sizeof(Uop)); + for (i = 0; i < on; i++) if (ob[i].op >= 0) B->u[n++] = ob[i]; + B->n = n; B->nv = onv; + if (onv > R_->maxnv) R_->maxnv = onv; + return 0; +} +/* ---- shape: empty jumps, straight-line merges, rotated loops ---- + the for-loop the compiler emits is a test, an empty jump, a body and a + step: four dispatches per iteration. fold the empty jump, paste a block + onto its only predecessor, and rotate a straight loop so the hot path is + one block that branches to itself. a call, a return, a stack word, or a + second branch stays where it is. an entry is never pasted over. */ +static int bempty(Rg *R, int b) +{ + RB *B = &R->b[b]; + int j; + if (B->n || B->nso || B->delta || B->term != T_BR) return 0; + if (B->s1 < 0 || B->s1 == b) return 0; + for (j = 0; j < R->nv; j++) if (B->vs[j] >= 0) return 0; + return 1; +} +static int bfollow(Rg *R, int b) +{ + unsigned char *seen = calloc(R->nb, 1); + int n = 0; + if (!seen) return b; + while ((unsigned)b < (unsigned)R->nb && bempty(R, b) && !seen[b] && n++ < R->nb) { + seen[b] = 1; + b = R->b[b].s1; + } + free(seen); + return b; +} +static int breach(Rg *R, unsigned char *reach) +{ + int *st = malloc((R->nb + 1) * sizeof(int)), n = 0, e, b; + if (!st) return -1; + for (e = 0; e < R->ne; e++) { + b = R->entb[e]; + if ((unsigned)b < (unsigned)R->nb && !reach[b]) { reach[b] = 1; st[n++] = b; } + } + while (n) { + RB *B; + b = st[--n]; + B = &R->b[b]; + if ((B->term == T_BR || B->term == T_CBR) && (unsigned)B->s1 < (unsigned)R->nb && !reach[B->s1]) { + reach[B->s1] = 1; st[n++] = B->s1; + } + if (B->term == T_CBR && (unsigned)B->s2 < (unsigned)R->nb && !reach[B->s2]) { + reach[B->s2] = 1; st[n++] = B->s2; + } + } + free(st); + return 0; +} +static int rempty(Rg *R) +{ + int b, e, ch = 0, *to = malloc(R->nb * sizeof(int)); + if (!to) return 0; + for (b = 0; b < R->nb; b++) { + int d = bfollow(R, b); + to[b] = (d != b && (unsigned)d < (unsigned)R->nb && !bempty(R, d)) ? d : b; + } + for (b = 0; b < R->nb; b++) { + RB *B = &R->b[b]; + if ((unsigned)B->s1 < (unsigned)R->nb && to[B->s1] != B->s1) { B->s1 = to[B->s1]; ch = 1; } + if ((unsigned)B->s2 < (unsigned)R->nb && to[B->s2] != B->s2) { B->s2 = to[B->s2]; ch = 1; } + } + for (e = 0; e < R->ne; e++) if ((unsigned)R->entb[e] < (unsigned)R->nb && to[R->entb[e]] != R->entb[e]) { + R->entb[e] = to[R->entb[e]]; ch = 1; + } + free(to); + return ch; +} +static int bmapat(int *map, int nv, int x, int *ok) +{ + if ((unsigned)x >= (unsigned)nv || map[x] < 0) { *ok = 0; return 0; } + return map[x]; +} +/* paste the blocks in order. a VGET of a var this paste already wrote is the + written value, not a fresh read of the block's entry. the last block's + branch is the branch of the result. */ +static int rb_build(Rg *R, int *ix, int nix, RB *dst) +{ + int cap = 0, i, j, n = 0, nid = 0, cur[RMAXV], wrote[RMAXV]; + Uop *o; + for (i = 0; i < nix; i++) { + if ((unsigned)ix[i] >= (unsigned)R->nb) return -1; + cap += R->b[ix[i]].n; + } + if (cap > 2048 || !nix) return -1; + o = malloc((cap + 1) * sizeof(Uop)); + if (!o) return -1; + for (j = 0; j < RMAXV; j++) { cur[j] = -1; wrote[j] = 0; } + for (i = 0; i < nix; i++) { + RB *S = &R->b[ix[i]]; + int nvmap = S->nv > 0 ? S->nv : 1, k, ok; + int *map = malloc(nvmap * sizeof(int)); + if (!map) { free(o); return -1; } + for (k = 0; k < nvmap; k++) map[k] = -1; + for (k = 0; k < S->n; k++) { + Uop u = S->u[k]; + int na = nargs(u.op); + ok = 1; + if (u.op == U_VGET && (unsigned)u.imm < RMAXV && cur[u.imm] >= 0) { + if ((unsigned)u.d >= (unsigned)nvmap) { free(map); free(o); return -1; } + map[u.d] = cur[u.imm]; + continue; + } + if (na > 0) u.a = bmapat(map, nvmap, u.a, &ok); + if (na > 1) u.b = bmapat(map, nvmap, u.b, &ok); + if (na > 2) u.c = bmapat(map, nvmap, u.c, &ok); + if (!ok || n >= cap) { free(map); free(o); return -1; } + if (!is_store(u.op)) { + if ((unsigned)u.d >= (unsigned)nvmap || nid >= 4096) { free(map); free(o); return -1; } + map[u.d] = nid; + u.d = nid++; + } else u.d = 0; + o[n++] = u; + } + for (j = 0; j < R->nv; j++) if (S->vs[j] >= 0) { + if ((unsigned)S->vs[j] >= (unsigned)nvmap || map[S->vs[j]] < 0) { free(map); free(o); return -1; } + cur[j] = map[S->vs[j]]; wrote[j] = 1; + } + if (i + 1 == nix) { + dst->term = S->term; + dst->s1 = S->s1; dst->s2 = S->s2; dst->x1 = S->x1; dst->x2 = S->x2; + if (S->cv >= 0) { + if ((unsigned)S->cv >= (unsigned)nvmap || map[S->cv] < 0) { free(map); free(o); return -1; } + dst->cv = map[S->cv]; + } else dst->cv = -1; + } + free(map); + } + dst->u = o; dst->n = n; dst->nv = nid > 0 ? nid : 1; + dst->nso = 0; dst->so = 0; dst->delta = 0; dst->a = R->b[ix[0]].a; + for (j = 0; j < RMAXV; j++) dst->vs[j] = wrote[j] ? cur[j] : -1; + if (dst->nv > R->maxnv) R->maxnv = dst->nv; + return 0; +} +static void addpred(int *np, int *pr, int s, int from) +{ + np[s]++; + if (np[s] == 1) pr[s] = from; + else if (pr[s] != from) pr[s] = -2; +} +static int rmerge_one(Rg *R) +{ + unsigned char *reach = calloc(R->nb, 1), *ent = calloc(R->nb, 1); + int *np = calloc(R->nb, sizeof(int)), *pr = malloc(R->nb * sizeof(int)); + int b, e, did = 0; + if (!reach || !ent || !np || !pr || breach(R, reach)) goto out; + for (b = 0; b < R->nb; b++) pr[b] = -1; + for (e = 0; e < R->ne; e++) if ((unsigned)R->entb[e] < (unsigned)R->nb) ent[R->entb[e]] = 1; + for (b = 0; b < R->nb; b++) if (reach[b]) { + RB *B = &R->b[b]; + if ((B->term == T_BR || B->term == T_CBR) && (unsigned)B->s1 < (unsigned)R->nb) addpred(np, pr, B->s1, b); + if (B->term == T_CBR && (unsigned)B->s2 < (unsigned)R->nb) addpred(np, pr, B->s2, b); + } + for (b = 0; b < R->nb && !did; b++) { + RB *A = &R->b[b], built; + int s, ix[2]; + if (!reach[b] || A->term != T_BR) continue; + s = A->s1; + if ((unsigned)s >= (unsigned)R->nb || s == b || !reach[s] || ent[s]) continue; + if (np[s] != 1 || pr[s] != b) continue; + if (A->nso || A->delta || R->b[s].nso || R->b[s].delta) continue; + ix[0] = b; ix[1] = s; + memset(&built, 0, sizeof built); + if (rb_build(R, ix, 2, &built)) continue; + free(A->u); free(A->so); + built.a = A->a; + R->b[b] = built; + did = 1; + } +out: + free(reach); free(ent); free(np); free(pr); + return did; +} +/* length of the straight run of single-predecessor jumps from s back to h, + or 0 when s is not that kind of back edge. the other edge may leave the + loop and come back in later through some other header; that is still an + exit of this loop, and the straight edge can be rotated. */ +static int try_chain(Rg *R, int h, int s, int *ch, int *np, int *pr, unsigned char *ent) +{ + int n = 0, prev = h, guard = 0; + if (s < 0 || s == h) return 0; + while (s != h) { + RB *B; + if ((unsigned)s >= (unsigned)R->nb || ++guard > R->nb) return 0; + B = &R->b[s]; + if (ent[s] || np[s] != 1 || pr[s] != prev || B->nso || B->delta || B->term != T_BR) return 0; + ch[n++] = s; + prev = s; + s = B->s1; + } + return n; +} +static int rrotate_one(Rg *R) +{ + unsigned char *reach = calloc(R->nb, 1), *ent = calloc(R->nb, 1); + int *np = calloc(R->nb, sizeof(int)), *pr = malloc(R->nb * sizeof(int)); + int *ch1 = malloc(R->nb * sizeof(int)), *ch2 = malloc(R->nb * sizeof(int)); + int b, e, did = 0; + if (!reach || !ent || !np || !pr || !ch1 || !ch2 || breach(R, reach)) goto out; + for (b = 0; b < R->nb; b++) pr[b] = -1; + for (e = 0; e < R->ne; e++) if ((unsigned)R->entb[e] < (unsigned)R->nb) ent[R->entb[e]] = 1; + for (b = 0; b < R->nb; b++) if (reach[b]) { + RB *B = &R->b[b]; + if ((B->term == T_BR || B->term == T_CBR) && (unsigned)B->s1 < (unsigned)R->nb) addpred(np, pr, B->s1, b); + if (B->term == T_CBR && (unsigned)B->s2 < (unsigned)R->nb) addpred(np, pr, B->s2, b); + } + for (b = 0; b < R->nb && !did; b++) { + RB *H = &R->b[b], built, *grown; + int n1, n2, n, back, L, *ch, *ix, i; + if (!reach[b] || H->term != T_CBR || H->nso || H->delta || H->cv < 0) continue; + n1 = try_chain(R, b, H->s1, ch1, np, pr, ent); + n2 = try_chain(R, b, H->s2, ch2, np, pr, ent); + if (n2 > 0 && n1 == 0) { n = n2; ch = ch2; back = 2; } + else if (n1 > 0 && n2 == 0) { n = n1; ch = ch1; back = 1; } + else continue; + ix = malloc((n + 1) * sizeof(int)); + if (!ix) continue; + for (i = 0; i < n; i++) ix[i] = ch[i]; + ix[n] = b; + memset(&built, 0, sizeof built); + if (rb_build(R, ix, n + 1, &built)) { free(ix); continue; } + free(ix); + grown = realloc(R->b, (R->nb + 1) * sizeof(RB)); + if (!grown) { free(built.u); continue; } + R->b = grown; + L = R->nb; + R->b[L] = built; + R->nb++; + if (back == 2) { R->b[L].s2 = L; R->b[b].s2 = L; } + else { R->b[L].s1 = L; R->b[b].s1 = L; } + did = 1; + } +out: + free(reach); free(ent); free(np); free(pr); free(ch1); free(ch2); + return did; +} +static void rdead(Rg *R) +{ + unsigned char *reach = calloc(R->nb, 1); + int b; + if (!reach || breach(R, reach)) { free(reach); return; } + for (b = 0; b < R->nb; b++) if (!reach[b]) { + R->b[b].term = T_BR; + R->b[b].s1 = b; + R->b[b].s2 = -1; + R->b[b].cv = -1; + } + free(reach); +} +static void rshape(Rg *R) +{ + int i, guard; + if (R->nb < 1) return; + for (i = 0; i < 4; i++) if (!rempty(R)) break; + guard = R->nb + 4; + for (i = 0; i < guard; i++) if (!rmerge_one(R)) break; + guard = R->nb + 4; + for (i = 0; i < guard; i++) if (!rrotate_one(R)) break; + guard = R->nb + 4; + for (i = 0; i < guard; i++) if (!rmerge_one(R)) break; + for (i = 0; i < 4; i++) if (!rempty(R)) break; + rdead(R); +} +/* ---- the global pass ---- + a block only knows its own values, but the variables carry facts from one + block to the next. this pass runs a forward dataflow over the blocks for the + one fact that pays off everywhere: a variable that holds the same constant + on every path into a block. such a read becomes a constant, the block is + emitted again through the same folding and strength reduction the lifter + uses (so x / step turns into a multiply once step is known, and an add of + two known values disappears), and a branch on a known value becomes a jump. + the second fact is a copy: on every path a variable holds what another + variable holds, and neither has been written since. a read of the copy + becomes a read of its source, so the copy can stop being kept at all. a + block that writes the source drops the copies of it. the blocks that no + longer have a way in are dropped by the shaping that follows, and it + repeats while something changes. */ +enum { C_UNSEEN, C_CONST, C_VAR, C_COPY }; +/* C_COPY: the variable holds the same value as variable v (both at the same point) */ +static int copy_ok(const Rg *R, int j, int k) { return j > 0 && j < RMAXV && k > 0 && k < R->nv && !R->fv[j] && !R->fv[k]; } +typedef struct { unsigned char st[RMAXV]; Cell v[RMAXV]; } CIn; +static int g_isk[MAXUOP * 4]; static Cell g_kv[MAXUOP * 4]; static int g_omap[MAXUOP + 16]; +static int cjoin(CIn *d, const CIn *s) +{ + int j, ch = 0; + for (j = 1; j < RMAXV; j++) { + if (s->st[j] == C_UNSEEN) continue; + if (d->st[j] == C_UNSEEN) { d->st[j] = s->st[j]; d->v[j] = s->v[j]; ch = 1; } + else if (d->st[j] != C_VAR && (s->st[j] == C_VAR || s->st[j] != d->st[j] || s->v[j] != d->v[j])) { d->st[j] = C_VAR; ch = 1; } + } + return ch; +} +/* does the block write variable k (a write other than the plain entry read)? */ +static int written_here(const RB *B, int k) +{ + if (k <= 0 || k >= RMAXV) return 1; + if (B->vs[k] < 0) return 0; + return !(B->u[B->vs[k]].op == U_VGET && B->u[B->vs[k]].imm == k); +} +/* what each variable holds when the block ends, given what it held at the start */ +static void cblock(Rg *R, RB *B, const CIn *in, CIn *out) +{ + int i, j, na; + unsigned char *kc = calloc(B->nv + 1, 1); + Cell *kw = calloc(B->nv + 1, sizeof(Cell)); + int *cpk = calloc(B->nv + 1, sizeof(int)); /* cpk[v] = k + 1 when v is a plain read of the entry value of k */ + *out = *in; + if (!kc || !kw || !cpk) { for (j = 1; j < RMAXV; j++) out->st[j] = C_VAR; free(kc); free(kw); free(cpk); return; } + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + if (is_store(u->op) || u->op == U_NARG) continue; + if ((unsigned)u->d >= (unsigned)B->nv) continue; + if (u->op == U_LI) { kc[u->d] = 1; kw[u->d] = u->imm; continue; } + if (u->op == U_VGET) { + j = (int)u->imm; + if (j > 0 && j < RMAXV && in->st[j] == C_CONST && !R->fv[j]) { kc[u->d] = 1; kw[u->d] = in->v[j]; } + if (j > 0 && j < RMAXV && in->st[j] == C_COPY && copy_ok(R, j, (int)in->v[j])) cpk[u->d] = (int)in->v[j] + 1; + else if (j > 0 && j < RMAXV) cpk[u->d] = j + 1; + continue; + } + if (u->op >= U_N || is_memop(u->op)) continue; + na = nargs(u->op); + if ((na > 0 && !kc[u->a]) || (na > 1 && !kc[u->b]) || (na > 2 && !kc[u->c])) continue; + kc[u->d] = 1; kw[u->d] = ev(u->op, na > 0 ? kw[u->a] : 0, na > 1 ? kw[u->b] : 0, na > 2 ? kw[u->c] : 0); + } + /* a variable the block writes is a copy of k when its value is the entry value of k and k is not written here */ + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0) { + int w = B->vs[j], k; + if (kc[w] && !R->fv[j]) { out->st[j] = C_CONST; out->v[j] = kw[w]; } + else if (w < B->nv && cpk[w] && (k = cpk[w] - 1) != j && copy_ok(R, j, k) && !written_here(B, k)) { out->st[j] = C_COPY; out->v[j] = k; } + else out->st[j] = C_VAR; + } + /* a copy of a variable this block writes is gone; so is a copy whose variable the block writes */ + for (j = 1; j < RMAXV; j++) if (out->st[j] == C_COPY && written_here(B, (int)out->v[j])) out->st[j] = C_VAR; + free(kc); free(kw); free(cpk); +} +/* emit the block again with the known variables as constants. returns 1 if it changed, -1 if it could not be done */ +static int rb_refold(Rg *R, RB *B, const CIn *in) +{ + int i, j, na, any = 0, n = 0, *live, *mp, bad = 0; + int *sisk = isk, *somap = omap; Cell *skv = kv; + Uop *nu; + for (i = 0; i < B->n; i++) if (B->u[i].op == U_VGET) { + j = (int)B->u[i].imm; + if (j > 0 && j < RMAXV && in->st[j] == C_CONST && !R->fv[j]) any = 1; + if (j > 0 && j < RMAXV && in->st[j] == C_COPY && copy_ok(R, j, (int)in->v[j])) any = 1; + } + if (!any) return 0; + for (j = 0; j < B->nso; j++) if ((unsigned)B->so[2 * j + 1] >= (unsigned)B->nv) bad = 1; + for (j = 1; j < R->nv; j++) if (B->vs[j] >= B->nv) bad = 1; + if (B->cv >= B->nv) bad = 1; + for (i = 0; i < B->n; i++) if ((unsigned)B->u[i].d >= (unsigned)B->nv && !is_store(B->u[i].op) && B->u[i].op != U_NARG) bad = 1; + if (bad) return 0; + mp = malloc((B->nv + 1) * sizeof(int)); + if (!mp) return 0; + isk = g_isk; kv = g_kv; omap = g_omap; + on = 0; onv = 0; uerr = 0; + for (i = 0; i < B->n && !uerr; i++) { + Uop *u = &B->u[i]; + na = u->op >= U_N ? 0 : nargs(u->op); + if (u->op == U_VGET) { + j = (int)u->imm; + if (j > 0 && j < RMAXV && in->st[j] == C_CONST && !R->fv[j]) mp[u->d] = K(in->v[j]); + else if (j > 0 && j < RMAXV && in->st[j] == C_COPY && copy_ok(R, j, (int)in->v[j])) mp[u->d] = raw(U_VGET, 0, 0, 0, in->v[j]); + else mp[u->d] = raw(U_VGET, 0, 0, 0, u->imm); + } else if (u->op == U_SLD) mp[u->d] = raw(U_SLD, 0, 0, 0, u->imm); + else if (u->op == U_LI) mp[u->d] = K(u->imm); + else if (is_store(u->op)) oe(u->op, mp[u->a], mp[u->b], 0, 0); + else if (u->op == U_NARG) raw(U_NARG, mp[u->a], 0, 0, u->imm); + else if (u->op == U_NCALL) mp[u->d] = raw(U_NCALL, 0, 0, 0, u->imm); + else mp[u->d] = oe(u->op, na > 0 ? mp[u->a] : 0, na > 1 ? mp[u->b] : 0, na > 2 ? mp[u->c] : 0, u->imm); + } + if (uerr) { isk = sisk; kv = skv; omap = somap; free(mp); return 0; } + live = calloc(onv + 2, sizeof *live); + nu = malloc((on + 1) * sizeof(Uop)); + if (!live || !nu) { free(live); free(nu); isk = sisk; kv = skv; omap = somap; free(mp); return 0; } + for (j = 0; j < B->nso; j++) B->so[2 * j + 1] = mp[B->so[2 * j + 1]]; + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0) B->vs[j] = mp[B->vs[j]]; + if (B->cv >= 0) B->cv = mp[B->cv]; + /* a branch on a known value is a jump, when the way it goes stays in the region; otherwise the exit */ + if (B->term == T_CBR && B->cv >= 0 && g_isk[B->cv]) { + int zero = g_kv[B->cv] == 0, to = zero ? B->s1 : B->s2, x = zero ? B->x1 : B->x2; + if (to >= 0) { B->term = T_BR; B->s1 = to; B->s2 = -1; B->cv = -1; } + else { B->cv = K(x); B->term = T_JMP; B->s1 = B->s2 = -1; if (onv + 2 > 0) { free(live); live = calloc(onv + 2, sizeof *live); free(nu); nu = malloc((on + 1) * sizeof(Uop)); } } + } + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0 && ob[B->vs[j]].op == U_VGET && ob[B->vs[j]].imm == j) B->vs[j] = -1; + for (j = 0; j < B->nso; j++) live[B->so[2 * j + 1]] = 1; + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0) live[B->vs[j]] = 1; + if ((B->term == T_CBR || B->term == T_JMP || B->term == T_CALL) && B->cv >= 0) live[B->cv] = 1; + for (i = on; i--;) { + Uop *u = &ob[i]; + if (!is_eff(u->op) && !live[u->d]) { u->op = -1; continue; } + na = u->op >= U_N ? 0 : nargs(u->op); + if (is_store(u->op)) na = 2; + if (u->op == U_NARG) na = 1; + if (na > 0) live[u->a] = 1; + if (na > 1) live[u->b] = 1; + if (na > 2) live[u->c] = 1; + } + for (i = 0; i < on; i++) if (ob[i].op >= 0) nu[n++] = ob[i]; + free(B->u); B->u = nu; B->n = n; B->nv = onv; + if (onv > R->maxnv) R->maxnv = onv; + free(live); free(mp); + isk = sisk; kv = skv; omap = somap; + return 1; +} +static void rglobal(Rg *R) +{ + int round, b, e, s, changed, sweeps, did; + if (R->nb < 1 || R->nb > 600) return; + for (round = 0; round < 4; round++) { + CIn *in = calloc(R->nb, sizeof(CIn)), out; + unsigned char *reached = calloc(R->nb, 1); + if (!in || !reached) { free(in); free(reached); return; } + for (e = 0; e < R->ne; e++) { + b = R->entb[e]; + if ((unsigned)b < (unsigned)R->nb) { + int j; + reached[b] = 1; + for (j = 1; j < RMAXV; j++) in[b].st[j] = C_VAR; + } + } + sweeps = 0; changed = 1; + while (changed && sweeps++ < 64) { + changed = 0; + for (b = 0; b < R->nb; b++) { + RB *B = &R->b[b]; + if (!reached[b]) continue; + cblock(R, B, &in[b], &out); + if (B->term != T_BR && B->term != T_CBR) continue; + for (s = 0; s < 2; s++) { + int t = s ? B->s2 : B->s1; + if (s && B->term != T_CBR) break; + if ((unsigned)t >= (unsigned)R->nb) continue; + if (!reached[t]) { reached[t] = 1; in[t] = out; changed = 1; } + else if (cjoin(&in[t], &out)) changed = 1; + } + } + } + did = 0; + for (b = 0; b < R->nb; b++) if (reached[b]) did |= rb_refold(R, &R->b[b], &in[b]); + free(in); free(reached); + if (!did) return; + rshape(R); + } +} +/* ---- loops, shared values and dead variables ---- + what the per-block lifter and the constant pass can't see is work that is + done again: an expression inside a loop whose operands don't change in it, + the same expression (or the same load, when nothing stored in between) in + two blocks one of which always runs before the other, and a variable that + is written and then written again before anyone reads it. blocks share + only variables, so a value that has to cross a block edge needs one: the + passes below take a spare register for it (a region has at most 7). each + step moves one expression and the analysis is run again, so a later step + sees what the earlier one did. */ +typedef struct { + int nb, *idom, *rn, *rpo, nrpo, *dep, nl; + int *pp, *pl; /* predecessors of b: pl[pp[b] .. pp[b + 1]); the root, nb, is left out */ + unsigned char *reach, *isent; + struct { int h, n, bad; unsigned char *in; } *lp; +} Cfg; +static int csucc(Rg *R, int b, int *o) +{ + int n = 0, e; + if (b == R->nb) { + for (e = 0; e < R->ne; e++) if ((unsigned)R->entb[e] < (unsigned)R->nb) o[n++] = R->entb[e]; + return n; + } + { + RB *B = &R->b[b]; + if ((B->term == T_BR || B->term == T_CBR) && (unsigned)B->s1 < (unsigned)R->nb) o[n++] = B->s1; + if (B->term == T_CBR && (unsigned)B->s2 < (unsigned)R->nb) o[n++] = B->s2; + } + return n; +} +static void cfg_free(Cfg *G) +{ + int i; + if (!G) return; + for (i = 0; i < G->nl; i++) free(G->lp[i].in); + free(G->lp); free(G->idom); free(G->rn); free(G->rpo); free(G->dep); free(G->pp); free(G->pl); free(G->reach); free(G->isent); free(G); +} +static int cdom(const Cfg *G, int a, int b) +{ + int n = 0; + while (b != a) { + if (b >= G->nb || b < 0 || G->idom[b] < 0 || ++n > G->nb + 2) return 0; + b = G->idom[b]; + } + return 1; +} +static Cfg *cfg_build(Rg *R) +{ + Cfg *G = calloc(1, sizeof *G); + int nb = R->nb, b, i, n, e, k, sp, succ[RMAXE + 2], changed, *po, *stn, *sti, npo = 0, guard; + if (!G) return 0; + G->nb = nb; + G->idom = malloc((nb + 1) * sizeof(int)); G->rn = malloc((nb + 1) * sizeof(int)); G->rpo = malloc((nb + 2) * sizeof(int)); + G->dep = calloc(nb + 1, sizeof(int)); G->pp = calloc(nb + 2, sizeof(int)); + G->reach = calloc(nb + 1, 1); G->isent = calloc(nb + 1, 1); + po = malloc((nb + 2) * sizeof(int)); stn = malloc((nb + 2) * sizeof(int)); sti = malloc((nb + 2) * sizeof(int)); + if (!G->idom || !G->rn || !G->rpo || !G->dep || !G->pp || !G->reach || !G->isent || !po || !stn || !sti) { free(po); free(stn); free(sti); cfg_free(G); return 0; } + for (b = 0; b <= nb; b++) { G->idom[b] = -1; G->rn[b] = -1; } + for (e = 0; e < R->ne; e++) if ((unsigned)R->entb[e] < (unsigned)nb) G->isent[R->entb[e]] = 1; + /* postorder from the root */ + sp = 0; stn[0] = nb; sti[0] = 0; G->reach[nb] = 1; + while (sp >= 0) { + n = csucc(R, stn[sp], succ); + if (sti[sp] < n) { + int s = succ[sti[sp]++]; + if (!G->reach[s]) { G->reach[s] = 1; sp++; stn[sp] = s; sti[sp] = 0; } + } else { po[npo++] = stn[sp]; sp--; } + } + G->nrpo = npo; + for (i = 0; i < npo; i++) { G->rpo[i] = po[npo - 1 - i]; G->rn[G->rpo[i]] = i; } + free(po); free(stn); free(sti); + /* predecessors (the root is not one) */ + for (b = 0; b < nb; b++) if (G->reach[b]) { n = csucc(R, b, succ); for (i = 0; i < n; i++) G->pp[succ[i] + 1]++; } + for (b = 0; b < nb; b++) G->pp[b + 1] += G->pp[b]; + G->pl = malloc((G->pp[nb] + 1) * sizeof(int)); + { + int *fill = calloc(nb + 1, sizeof(int)); + if (!G->pl || !fill) { free(fill); cfg_free(G); return 0; } + for (b = 0; b < nb; b++) if (G->reach[b]) { n = csucc(R, b, succ); for (i = 0; i < n; i++) { int s = succ[i]; G->pl[G->pp[s] + fill[s]++] = b; } } + free(fill); + } + /* dominators: the root dominates the entries, and the entries are roots of the graph */ + G->idom[nb] = nb; + guard = 0; changed = 1; + while (changed && guard++ < 64) { + changed = 0; + for (k = 1; k < npo; k++) { + int nw = -1, p, j; + b = G->rpo[k]; + if (G->isent[b]) nw = nb; + for (j = G->pp[b]; j < G->pp[b + 1]; j++) { + p = G->pl[j]; + if (G->idom[p] < 0) continue; + if (nw < 0) { nw = p; continue; } + { + int x = p, y = nw, g2 = 0; + while (x != y && g2++ < 2 * nb + 4) { + while (G->rn[x] > G->rn[y] && g2++ < 2 * nb + 4) x = G->idom[x]; + while (G->rn[y] > G->rn[x] && g2++ < 2 * nb + 4) y = G->idom[y]; + } + nw = x; + } + } + if (nw >= 0 && G->idom[b] != nw) { G->idom[b] = nw; changed = 1; } + } + } + if (changed) { cfg_free(G); return 0; } + /* natural loops: a back edge is one whose target dominates its source */ + G->lp = calloc(nb + 1, sizeof *G->lp); + if (!G->lp) { cfg_free(G); return 0; } + for (b = 0; b < nb; b++) if (G->reach[b]) { + n = csucc(R, b, succ); + for (i = 0; i < n; i++) { + int h = succ[i], li, *stk, ns = 0, x, j; + if (!cdom(G, h, b)) continue; + for (li = 0; li < G->nl && G->lp[li].h != h; li++); + if (li == G->nl) { + G->lp[li].h = h; G->lp[li].in = calloc(nb + 1, 1); G->nl++; + if (!G->lp[li].in) { cfg_free(G); return 0; } + G->lp[li].in[h] = 1; G->lp[li].n = 1; + } + stk = malloc((nb + 1) * sizeof(int)); + if (!stk) { cfg_free(G); return 0; } + if (!G->lp[li].in[b]) { G->lp[li].in[b] = 1; G->lp[li].n++; stk[ns++] = b; } + while (ns) { + x = stk[--ns]; + for (j = G->pp[x]; j < G->pp[x + 1]; j++) { + int p = G->pl[j]; + if (G->reach[p] && !G->lp[li].in[p]) { G->lp[li].in[p] = 1; G->lp[li].n++; stk[ns++] = p; } + } + } + free(stk); + } + } + for (i = 0; i < G->nl; i++) for (b = 0; b < nb; b++) if (G->lp[i].in[b]) { + G->dep[b]++; + if (G->isent[b]) G->lp[i].bad = 1; + } + return G; +} +static int w10(int d) { return d <= 0 ? 1 : d == 1 ? 10 : d == 2 ? 100 : d == 3 ? 1000 : 10000; } +static int opcost(int op) +{ + switch (op) { + case U_LI: case U_VGET: case U_SLD: return 0; + case U_LD: case U_LD8: case U_LD16: case U_LD32: case U_MUL: case U_MULHS: case U_MULHU: case U_FMUL: return 3; + case U_SDIV: case U_UDIV: case U_SREM: case U_UREM: case U_FDIV: return 10; + default: return 1; + } +} +/* value numbering: a table of what each number stands for */ +#define GOP_MEM (U_N + 2) +#define GOP_PHI (U_N + 3) +#define GOP_ENT (U_N + 4) +#define GOP_PHIM (U_N + 5) +#define GNMAX (1 << 17) +typedef struct { int op, a, b, c, next; Cell imm; } GN; +static GN *gn_; static int gn_n, *gh_, gn_over; +static int gn_init(void) +{ + if (!gn_) { gn_ = malloc(GNMAX * sizeof(GN)); gh_ = malloc(GNMAX * sizeof(int)); } + if (!gn_ || !gh_) return -1; + gn_n = 0; gn_over = 0; memset(gh_, 0, GNMAX * sizeof(int)); + return 0; +} +static int gnum(int op, int a, int b, int c, Cell imm) +{ + unsigned h; int i; + if (op == U_ADD || op == U_MUL || op == U_AND || op == U_OR || op == U_XOR || op == U_EQ || op == U_NE || + op == U_MIN || op == U_MAX || op == U_MINU || op == U_MAXU || op == U_MULHS || op == U_MULHU || + op == U_FADD || op == U_FMUL || op == U_FEQ) if (a > b) { int t = a; a = b; b = t; } + h = ((unsigned)op * 2654435761u) ^ ((unsigned)a * 40503u) ^ ((unsigned)b * 69069u) ^ ((unsigned)c * 1103515245u) ^ (unsigned)(imm * 0x9e3779b1u) ^ (unsigned)((UCell)imm >> 32); + h %= GNMAX; + for (i = gh_[h]; i; i = gn_[i - 1].next) + if (gn_[i - 1].op == op && gn_[i - 1].a == a && gn_[i - 1].b == b && gn_[i - 1].c == c && gn_[i - 1].imm == imm) return i; + if (gn_n >= GNMAX - 1) { gn_over = 1; return 1; } + gn_[gn_n].op = op; gn_[gn_n].a = a; gn_[gn_n].b = b; gn_[gn_n].c = c; gn_[gn_n].imm = imm; + gn_[gn_n].next = gh_[h]; gh_[h] = ++gn_n; + return gn_n; +} +typedef struct { RB *src; int val, var; } Hoist; /* write the value src computes into var, in this block */ +typedef struct { int idx, var; } Export; /* after the block is built, var := what its idx-th op computed */ +/* the value val of block S built again inside the block being emitted */ +static int matv(const RB *P, const int *mp, RB *S, const int *def, int *memo, int val) +{ + Uop *u = &S->u[def[val]]; + int na, a = 0, b = 0, c = 0, r; + if (memo[val] >= 0) return memo[val]; + if (u->op == U_LI) r = K(u->imm); + else if (u->op == U_VGET) { + int j = (int)u->imm; + r = j >= 0 && j < RMAXV && P->vs[j] >= 0 ? mp[P->vs[j]] : raw(U_VGET, 0, 0, 0, u->imm); + } else { + na = nargs(u->op); + if (na > 0) a = matv(P, mp, S, def, memo, u->a); + if (na > 1) b = matv(P, mp, S, def, memo, u->b); + if (na > 2) c = matv(P, mp, S, def, memo, u->c); + r = oe(u->op, a, b, c, u->imm); + } + memo[val] = r; + return r; +} +/* the block again through the folding emitter. repl[i] (when nonzero) makes the i-th op a read of that + variable; the hoists and exports give variables new values at the end. returns 1 if it was rebuilt */ +static int rb_emit(Rg *R, RB *B, const int *repl, const Hoist *H, int nh, const Export *X, int nx) +{ + int i, j, na, n = 0, *live, *mp, bad = 0, *hv = 0, *xv = 0; + int *sisk = isk, *somap = omap; Cell *skv = kv; + Uop *nu; + for (j = 0; j < B->nso; j++) if ((unsigned)B->so[2 * j + 1] >= (unsigned)B->nv) bad = 1; + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= B->nv) bad = 1; + if (B->cv >= B->nv) bad = 1; + for (i = 0; i < B->n; i++) if ((unsigned)B->u[i].d >= (unsigned)B->nv && !is_store(B->u[i].op) && B->u[i].op != U_NARG) bad = 1; + if (bad) return 0; + mp = malloc((B->nv + 1) * sizeof(int)); + hv = malloc((nh + 1) * sizeof(int)); xv = malloc((nx + 1) * sizeof(int)); + if (!mp || !hv || !xv) { free(mp); free(hv); free(xv); return 0; } + isk = g_isk; kv = g_kv; omap = g_omap; + on = 0; onv = 0; uerr = 0; + for (i = 0; i < B->n && !uerr; i++) { + Uop *u = &B->u[i]; + na = u->op >= U_N ? 0 : nargs(u->op); + if (repl && repl[i] && !is_store(u->op) && u->op != U_NARG && u->op != U_NCALL) mp[u->d] = raw(U_VGET, 0, 0, 0, repl[i]); + else if (u->op == U_VGET) mp[u->d] = raw(U_VGET, 0, 0, 0, u->imm); + else if (u->op == U_SLD) mp[u->d] = raw(U_SLD, 0, 0, 0, u->imm); + else if (u->op == U_LI) mp[u->d] = K(u->imm); + else if (is_store(u->op)) oe(u->op, mp[u->a], mp[u->b], 0, 0); + else if (u->op == U_NARG) raw(U_NARG, mp[u->a], 0, 0, u->imm); + else if (u->op == U_NCALL) mp[u->d] = raw(U_NCALL, 0, 0, 0, u->imm); + else mp[u->d] = oe(u->op, na > 0 ? mp[u->a] : 0, na > 1 ? mp[u->b] : 0, na > 2 ? mp[u->c] : 0, u->imm); + } + for (j = 0; j < nh && !uerr; j++) { + RB *S = H[j].src; + int *def = malloc((S->nv + 1) * sizeof(int)), *memo = malloc((S->nv + 1) * sizeof(int)); + if (!def || !memo) { free(def); free(memo); uerr = -5; break; } + for (i = 0; i < S->nv; i++) { def[i] = 0; memo[i] = -1; } + for (i = 0; i < S->n; i++) if (!is_store(S->u[i].op) && S->u[i].op != U_NARG && (unsigned)S->u[i].d < (unsigned)S->nv) def[S->u[i].d] = i; + hv[j] = matv(B, mp, S, def, memo, H[j].val); + free(def); free(memo); + } + for (j = 0; j < nx; j++) xv[j] = mp[B->u[X[j].idx].d]; + if (uerr) { isk = sisk; kv = skv; omap = somap; free(mp); free(hv); free(xv); return 0; } + live = calloc(onv + 2, sizeof *live); + nu = malloc((on + 1) * sizeof(Uop)); + if (!live || !nu) { free(live); free(nu); isk = sisk; kv = skv; omap = somap; free(mp); free(hv); free(xv); return 0; } + for (j = 0; j < B->nso; j++) B->so[2 * j + 1] = mp[B->so[2 * j + 1]]; + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= 0) B->vs[j] = mp[B->vs[j]]; + if (B->cv >= 0) B->cv = mp[B->cv]; + for (j = 0; j < nh; j++) B->vs[H[j].var] = hv[j]; + for (j = 0; j < nx; j++) B->vs[X[j].var] = xv[j]; + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= 0 && ob[B->vs[j]].op == U_VGET && ob[B->vs[j]].imm == j) B->vs[j] = -1; + for (j = 0; j < B->nso; j++) live[B->so[2 * j + 1]] = 1; + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= 0) live[B->vs[j]] = 1; + if ((B->term == T_CBR || B->term == T_JMP || B->term == T_CALL) && B->cv >= 0) live[B->cv] = 1; + for (i = on; i--;) { + Uop *u = &ob[i]; + if (!is_eff(u->op) && !live[u->d]) { u->op = -1; continue; } + na = u->op >= U_N ? 0 : nargs(u->op); + if (is_store(u->op)) na = 2; + if (u->op == U_NARG) na = 1; + if (na > 0) live[u->a] = 1; + if (na > 1) live[u->b] = 1; + if (na > 2) live[u->c] = 1; + } + for (i = 0; i < on; i++) if (ob[i].op >= 0) nu[n++] = ob[i]; + free(B->u); B->u = nu; B->n = n; B->nv = onv; + if (onv > R->maxnv) R->maxnv = onv; + free(live); free(mp); free(hv); free(xv); + isk = sisk; kv = skv; omap = somap; + return 1; +} +/* a new variable for a value that has to cross blocks: 0 if the region has no register left */ +static int newcarry(Rg *R) +{ + int v; + if (R->nv >= RMAXV) return 0; + v = R->nv++; + R->slot[v] = R->np ? R->ps[0] : 0; R->fv[v] = 0; R->sc[v] = 1; + return v; +} +/* ---- hoisting: an expression in a loop whose operands the loop doesn't change is built once, in front of it ---- */ +static int licm_loop(Rg *R, Cfg *G, int li) +{ + int nb = R->nb, b, i, j, k, W = 0, hasmem = 0, h = G->lp[li].h, nc = 0, best = -1, P = -1, nout = 0, outp[64]; + unsigned char *in = G->lp[li].in; + struct { int kid, cost, b, d; long long save; } cand[64]; + long long bestsave = 0; + if (G->lp[li].bad || R->nv >= RMAXV) return 0; + for (b = 0; b < nb; b++) if (in[b]) { + RB *B = &R->b[b]; + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= 0) W |= 1 << j; + for (i = 0; i < B->n; i++) if (is_store(B->u[i].op) || B->u[i].op == U_NARG || B->u[i].op == U_NCALL) hasmem = 1; + if (B->term == T_CALL) return 0; + } + for (j = G->pp[h]; j < G->pp[h + 1]; j++) if (!in[G->pl[j]]) { if (nout < 64) outp[nout] = G->pl[j]; nout++; } + if (nout < 1 || nout > 64) return 0; + if (gn_init()) return 0; + for (b = 0; b < nb; b++) if (in[b]) { + RB *B = &R->b[b]; + int n = B->nv + 1, *kid = calloc(n, sizeof(int)), *cst = calloc(n, sizeof(int)), *used = calloc(n, sizeof(int)); + unsigned char *inv = calloc(n, 1), *fpv = calloc(n, 1); + if (!kid || !cst || !used || !inv || !fpv) { free(kid); free(cst); free(used); free(inv); free(fpv); return 0; } + class_fp(R, B, fpv); + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int d = u->d, na; + if (is_store(u->op) || u->op == U_NARG || u->op == U_NCALL || (unsigned)d >= (unsigned)B->nv) continue; + if (u->op == U_LI) { inv[d] = 1; kid[d] = gnum(U_LI, 0, 0, 0, u->imm); } + else if (u->op == U_VGET) { + j = (int)u->imm; + inv[d] = j >= 0 && j < RMAXV && !(W >> j & 1) && !fpv[d]; + kid[d] = gnum(U_VGET, 0, 0, 0, u->imm); + } else if (u->op == U_SLD || u->op >= U_N) inv[d] = 0; + else { + na = nargs(u->op); + inv[d] = (na < 1 || inv[u->a]) && (na < 2 || inv[u->b]) && (na < 3 || inv[u->c]) && !fpv[d]; + if (is_memop(u->op) && hasmem) inv[d] = 0; + if (inv[d]) { + kid[d] = gnum(u->op, na > 0 ? kid[u->a] : 0, na > 1 ? kid[u->b] : 0, na > 2 ? kid[u->c] : 0, u->imm); + cst[d] = opcost(u->op) + (na > 0 ? cst[u->a] : 0) + (na > 1 ? cst[u->b] : 0) + (na > 2 ? cst[u->c] : 0); + } + } + } + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int na; + if (is_store(u->op)) { used[u->a] = 1; used[u->b] = 1; continue; } + if (u->op == U_NARG) { used[u->a] = 1; continue; } + if (u->op == U_NCALL || (unsigned)u->d >= (unsigned)B->nv || inv[u->d]) continue; + na = u->op >= U_N ? 0 : nargs(u->op); + if (na > 0) used[u->a] = 1; + if (na > 1) used[u->b] = 1; + if (na > 2) used[u->c] = 1; + } + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= 0) used[B->vs[j]] = 1; + for (j = 0; j < B->nso; j++) used[B->so[2 * j + 1]] = 1; + if (B->cv >= 0 && (B->term == T_CBR || B->term == T_JMP || B->term == T_CALL)) used[B->cv] = 1; + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int d = u->d; + if (is_store(u->op) || u->op == U_NARG || u->op == U_NCALL || (unsigned)d >= (unsigned)B->nv) continue; + if (!inv[d] || !used[d] || cst[d] < 2 || u->op == U_LI || u->op == U_VGET) continue; + for (k = 0; k < nc && cand[k].kid != kid[d]; k++); + if (k == nc) { + if (nc >= 64) continue; + cand[nc].kid = kid[d]; cand[nc].cost = cst[d]; cand[nc].b = b; cand[nc].d = d; cand[nc].save = 0; nc++; + } + cand[k].save += (long long)cst[d] * w10(G->dep[b]); + } + free(kid); free(cst); free(used); free(inv); free(fpv); + } + if (gn_over) return 0; + for (k = 0; k < nc; k++) { + long long net = cand[k].save - (long long)(cand[k].cost + 1) * w10(G->dep[h] - 1); + if (net > bestsave) { bestsave = net; best = k; } + } + if (best < 0 || bestsave < 3) return 0; + /* where it goes: the one block outside the loop that falls into it, or a new one */ + if (nout == 1) { + RB *Pb = &R->b[outp[0]]; + if ((Pb->term == T_BR && Pb->s1 == h) || Pb->term == T_CBR) P = outp[0]; + } + if (P < 0) { + RB *grown = realloc(R->b, (nb + 1) * sizeof(RB)), *N; + if (!grown) return 0; + R->b = grown; + N = &R->b[nb]; + memset(N, 0, sizeof *N); + N->a = R->b[h].a; N->u = malloc(sizeof(Uop)); N->so = malloc(sizeof(int)); N->n = 0; N->nv = 1; N->term = T_BR; N->s1 = h; N->s2 = -1; N->cv = -1; + for (j = 0; j < RMAXV; j++) N->vs[j] = -1; + for (j = 0; j < nout; j++) { + RB *Q = &R->b[outp[j]]; + if (Q->s1 == h) Q->s1 = nb; + if (Q->term == T_CBR && Q->s2 == h) Q->s2 = nb; + } + R->nb = nb + 1; + P = nb; + } + { + int s = newcarry(R); + Hoist hs; + RB *src = &R->b[cand[best].b]; + if (!s) return 0; + hs.src = src; hs.val = cand[best].d; hs.var = s; + if (!rb_emit(R, &R->b[P], 0, &hs, 1, 0, 0)) { R->nv--; return 0; } + /* every block of the loop that builds the same thing reads the new variable instead */ + for (b = 0; b < R->nb; b++) if (b < nb && in[b]) { + RB *B = &R->b[b]; + int n = B->nv + 1, *kid = calloc(n, sizeof(int)), *rp = calloc(B->n + 1, sizeof(int)), any = 0; + unsigned char *inv = calloc(n, 1), *fpv = calloc(n, 1); + if (!kid || !rp || !inv || !fpv) { free(kid); free(rp); free(inv); free(fpv); continue; } + class_fp(R, B, fpv); + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int d = u->d, na; + if (is_store(u->op) || u->op == U_NARG || u->op == U_NCALL || (unsigned)d >= (unsigned)B->nv) continue; + if (u->op == U_LI) { inv[d] = 1; kid[d] = gnum(U_LI, 0, 0, 0, u->imm); } + else if (u->op == U_VGET) { j = (int)u->imm; inv[d] = j >= 0 && j < RMAXV && !(W >> j & 1) && !fpv[d]; kid[d] = gnum(U_VGET, 0, 0, 0, u->imm); } + else if (u->op == U_SLD || u->op >= U_N) inv[d] = 0; + else { + na = nargs(u->op); + inv[d] = (na < 1 || inv[u->a]) && (na < 2 || inv[u->b]) && (na < 3 || inv[u->c]) && !fpv[d]; + if (is_memop(u->op) && hasmem) inv[d] = 0; + if (inv[d]) { + kid[d] = gnum(u->op, na > 0 ? kid[u->a] : 0, na > 1 ? kid[u->b] : 0, na > 2 ? kid[u->c] : 0, u->imm); + if (kid[d] == cand[best].kid && u->op != U_LI && u->op != U_VGET) { rp[i] = s; any = 1; } + } + } + } + if (any) rb_emit(R, B, rp, 0, 0, 0, 0); + free(kid); free(rp); free(inv); free(fpv); + } + } + return 1; +} + +/* ---- shared expressions: the same value built in two blocks, one of which always runs first ---- */ +typedef struct { int g[RMAXV]; int mem; } GS; +static void gtrans(Rg *R, int b, const GS *in, GS *out, int *vg, int *vc) +{ + RB *B = &R->b[b]; + int i, j, mem = in->mem; + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int op = u->op, d = u->d, na; + if (op == U_NARG) continue; + if (is_store(op)) { mem = gnum(GOP_MEM, b, i, 0, 0); continue; } + if ((unsigned)d >= (unsigned)B->nv) continue; + vc[d] = 0; + if (op == U_LI) vg[d] = gnum(U_LI, 0, 0, 0, u->imm); + else if (op == U_VGET) vg[d] = in->g[(int)u->imm & (RMAXV - 1)]; + else if (op == U_SLD) vg[d] = gnum(U_SLD, b, 0, 0, u->imm); + else if (op == U_NCALL) { vg[d] = gnum(U_NCALL, b, i, 0, 0); mem = gnum(GOP_MEM, b, i, 1, 0); } + else if (op == U_LD || op == U_LD8 || op == U_LD16 || op == U_LD32) { vg[d] = gnum(op, vg[u->a], mem, 0, 0); vc[d] = opcost(op) + vc[u->a]; } + else { + na = nargs(op); + vg[d] = gnum(op, na > 0 ? vg[u->a] : 0, na > 1 ? vg[u->b] : 0, na > 2 ? vg[u->c] : 0, u->imm); + vc[d] = opcost(op) + (na > 0 ? vc[u->a] : 0) + (na > 1 ? vc[u->b] : 0) + (na > 2 ? vc[u->c] : 0); + } + } + *out = *in; + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= 0 && (unsigned)B->vs[j] < (unsigned)B->nv) out->g[j] = vg[B->vs[j]]; + out->mem = mem; +} +static int gjoin(GS *d, const GS *s, int blk) +{ + int v, ch = 0, p; + for (v = 0; v < RMAXV; v++) if (d->g[v] != s->g[v]) { + p = gnum(GOP_PHI, blk, v, 0, 0); + if (d->g[v] != p) { d->g[v] = p; ch = 1; } + } + if (d->mem != s->mem) { + p = gnum(GOP_PHIM, blk, 0, 0, 0); + if (d->mem != p) { d->mem = p; ch = 1; } + } + return ch; +} +typedef struct { int g, b, i, cost; } Site; +static int sitecmp(const void *x, const void *y) +{ + const Site *a = x, *b = y; + if (a->g != b->g) return a->g < b->g ? -1 : 1; + if (a->b != b->b) return a->b < b->b ? -1 : 1; + return a->i - b->i; +} +static int cse_one(Rg *R, Cfg *G) +{ + int nb = R->nb, b, i, e, k, sweeps, changed, ns = 0, capn = 0, s, did = 0; + GS *in = 0, *out = 0; + unsigned char *seen = 0; + int **vgs = 0, **vcs = 0; + Site *sites = 0; + if (R->nv >= RMAXV || gn_init()) return 0; + in = calloc(nb, sizeof(GS)); out = calloc(nb, sizeof(GS)); seen = calloc(nb, 1); + vgs = calloc(nb, sizeof(int *)); vcs = calloc(nb, sizeof(int *)); + if (!in || !out || !seen || !vgs || !vcs) goto fin; + for (b = 0; b < nb; b++) { + vgs[b] = calloc(R->b[b].nv + 1, sizeof(int)); vcs[b] = calloc(R->b[b].nv + 1, sizeof(int)); + if (!vgs[b] || !vcs[b]) goto fin; + } + for (e = 0; e < R->ne; e++) { + b = R->entb[e]; + if ((unsigned)b >= (unsigned)nb) continue; + for (k = 0; k < RMAXV; k++) in[b].g[k] = gnum(GOP_ENT, b, k, 0, 0); + in[b].mem = gnum(GOP_ENT, b, RMAXV, 0, 0); + seen[b] = 1; + } + for (sweeps = 0, changed = 1; changed && sweeps < 80; sweeps++) { + changed = 0; + for (k = 0; k < G->nrpo; k++) { + int sc[2], nsu, t; + b = G->rpo[k]; + if (b >= nb || !seen[b]) continue; + gtrans(R, b, &in[b], &out[b], vgs[b], vcs[b]); + nsu = 0; + if (R->b[b].term == T_BR || R->b[b].term == T_CBR) if ((unsigned)R->b[b].s1 < (unsigned)nb) sc[nsu++] = R->b[b].s1; + if (R->b[b].term == T_CBR && (unsigned)R->b[b].s2 < (unsigned)nb) sc[nsu++] = R->b[b].s2; + for (t = 0; t < nsu; t++) { + int sx = sc[t]; + if (!seen[sx]) { seen[sx] = 1; in[sx] = out[b]; changed = 1; } + else if (gjoin(&in[sx], &out[b], sx)) changed = 1; + } + } + if (gn_over) goto fin; + } + if (changed) goto fin; + for (b = 0; b < nb; b++) if (seen[b]) gtrans(R, b, &in[b], &out[b], vgs[b], vcs[b]); + if (gn_over) goto fin; + /* every place that builds something worth sharing */ + for (b = 0; b < nb; b++) if (seen[b]) { + RB *B = &R->b[b]; + unsigned char *fpv = calloc(B->nv + 1, 1); + if (!fpv) goto fin; + class_fp(R, B, fpv); + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int d = u->d; + if (is_store(u->op) || u->op == U_NARG || u->op == U_NCALL || u->op == U_LI || u->op == U_VGET || u->op == U_SLD || u->op >= U_N) continue; + if ((unsigned)d >= (unsigned)B->nv || fpv[d] || vcs[b][d] < 3) continue; + if (ns >= capn) { + Site *g2; + capn = capn ? capn * 2 : 256; + g2 = realloc(sites, capn * sizeof(Site)); + if (!g2) { free(fpv); goto fin; } + sites = g2; + } + sites[ns].g = vgs[b][d]; sites[ns].b = b; sites[ns].i = i; sites[ns].cost = vcs[b][d]; ns++; + } + free(fpv); + } + if (ns > 1) qsort(sites, ns, sizeof(Site), sitecmp); /* no sites: sites may be null, which qsort must not get */ + { + long long bestsave = 0; + int bs = -1, be = -1, bd = -1; + for (s = 0; s < ns; s = e) { + long long save = 0; + int d0 = -1, q; + for (e = s; e < ns && sites[e].g == sites[s].g; e++); + if (e - s < 2) continue; + /* the site that comes first on every path to the others */ + for (q = s; q < e && d0 < 0; q++) { + int r2, good = 1; + for (r2 = s; r2 < e && good; r2++) { + if (r2 == q) continue; + if (sites[r2].b == sites[q].b) { if (sites[r2].i < sites[q].i) good = 0; } + else if (!cdom(G, sites[q].b, sites[r2].b)) good = 0; + } + if (good) d0 = q; + } + if (d0 < 0) continue; + for (q = s; q < e; q++) if (q != d0 && sites[q].b != sites[d0].b) save += (long long)sites[q].cost * w10(G->dep[sites[q].b]); + save -= (long long)(sites[d0].cost + 1) * w10(G->dep[sites[d0].b]) / 4 + w10(G->dep[sites[d0].b]); + if (save > bestsave) { bestsave = save; bs = s; be = e; bd = d0; } + } + if (bs >= 0 && bestsave >= 3) { + int v = newcarry(R), q; + if (v) { + Export ex; + ex.idx = sites[bd].i; ex.var = v; + if (!rb_emit(R, &R->b[sites[bd].b], 0, 0, 0, &ex, 1)) { R->nv--; goto fin; } + for (q = bs; q < be; q++) { + RB *B = &R->b[sites[q].b]; + int *rp, q2; + if (sites[q].b == sites[bd].b) continue; + if (q > bs && sites[q - 1].b == sites[q].b) continue; /* a block is rebuilt once, for all its sites */ + rp = calloc(B->n + 1, sizeof(int)); + if (!rp) continue; + for (q2 = q; q2 < be && sites[q2].b == sites[q].b; q2++) rp[sites[q2].i] = v; + rb_emit(R, B, rp, 0, 0, 0, 0); + free(rp); + } + did = 1; + } + } + } +fin: + if (vgs) for (b = 0; b < nb; b++) free(vgs[b]); + if (vcs) for (b = 0; b < nb; b++) free(vcs[b]); + free(vgs); free(vcs); free(in); free(out); free(seen); free(sites); + return did; +} +/* ---- variables written and never read ---- */ +static int rdead_vars(Rg *R) +{ + int nb = R->nb, b, i, j, sweeps, changed, did = 0, nreal = R->nv0 ? R->nv0 : R->nv; + unsigned char *gen, *kill, *lin, *lout; + unsigned allreal = 0; + for (j = 1; j < nreal; j++) allreal |= 1u << j; + gen = calloc(nb, 1); kill = calloc(nb, 1); lin = calloc(nb, 1); lout = calloc(nb, 1); + if (!gen || !kill || !lin || !lout) { free(gen); free(kill); free(lin); free(lout); return 0; } + for (b = 0; b < nb; b++) { + RB *B = &R->b[b]; + for (i = 0; i < B->n; i++) if (B->u[i].op == U_VGET && B->u[i].imm >= 0 && B->u[i].imm < RMAXV) gen[b] |= 1u << B->u[i].imm; + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= 0) kill[b] |= 1u << j; + } + for (sweeps = 0, changed = 1; changed && sweeps < 64; sweeps++) { + changed = 0; + for (b = nb; b--;) { + RB *B = &R->b[b]; + unsigned o = 0; + int s, x; + if (B->term == T_BR) o = (unsigned)B->s1 < (unsigned)nb ? lin[B->s1] : allreal; + else if (B->term == T_CBR) { + for (s = 0; s < 2; s++) { + int t = s ? B->s2 : B->s1, xa = s ? B->x2 : B->x1; + if ((unsigned)t < (unsigned)nb) o |= lin[t]; + else o |= (R->fn >= 0 && xa >= R->hi) ? 0 : allreal; + } + } else if (B->term == T_JMP) { + int dead = 0; + if (R->fn >= 0 && B->cv >= 0) for (x = 0; x < B->n; x++) if (B->u[x].d == B->cv && B->u[x].op == U_LI && B->u[x].imm >= R->hi) dead = 1; + o = dead ? 0 : allreal; + } else if (B->term == T_CALL) { + int ee; + o = allreal; + for (ee = 0; ee < R->ne; ee++) if (R->ent[ee] == B->x2 && (unsigned)R->entb[ee] < (unsigned)nb) { o = lin[R->entb[ee]]; break; } + } else o = allreal; + if (o != lout[b]) { lout[b] = (unsigned char)o; changed = 1; } + x = gen[b] | (lout[b] & ~kill[b]); + if (x != lin[b]) { lin[b] = (unsigned char)x; changed = 1; } + } + } + if (changed) { free(gen); free(kill); free(lin); free(lout); return 0; } + for (b = 0; b < nb; b++) { + RB *B = &R->b[b]; + int any = 0; + for (j = 1; j < RMAXV; j++) if (B->vs[j] >= 0 && !(lout[b] >> j & 1)) { B->vs[j] = -1; any = 1; } + if (any) { rb_emit(R, B, 0, 0, 0, 0, 0); did = 1; } + } + free(gen); free(kill); free(lin); free(lout); + return did; +} +static int rshare(Rg *R) +{ + int iter, did = 0; + if (R->nb < 1 || R->nb > 300 || getenv("ZYNOSHARE")) return 0; + for (iter = 0; iter < 8; iter++) { + Cfg *G = cfg_build(R); + int li, one = 0, ord[256], n, x, y; + if (!G) break; + n = G->nl < 256 ? G->nl : 256; + for (x = 0; x < n; x++) ord[x] = x; + for (x = 1; x < n; x++) for (y = x; y > 0 && G->lp[ord[y]].n < G->lp[ord[y - 1]].n; y--) { int t = ord[y]; ord[y] = ord[y - 1]; ord[y - 1] = t; } + for (li = 0; li < n && !one; li++) one = licm_loop(R, G, ord[li]); + if (!one) one = cse_one(R, G); + cfg_free(G); + if (!one) break; + did = 1; + } + if (rdead_vars(R)) did = 1; + return did; +} +static void addl(int x, int en) +{ + int e; + if (x < R_->lo || x >= R_->hi) return; + if (!lead_[x - R_->lo]) { lead_[x - R_->lo] = 1; wl_[nw_++] = x; } + if (en) { for (e = 0; e < R_->ne && R_->ent[e] != x; e++); if (e == R_->ne && e < RMAXE) R_->ent[R_->ne++] = x; } +} +/* blocks, then each one lifted and optimized */ +static int rlift(Rg *R) +{ + int n = R->hi - R->lo, L, i, k, t, b, e, r = 0, cnt; + Cell w; + if (R->lifted) rclear(R); + if (R->nv0) R->nv = R->nv0; + R_ = R; + lead_ = calloc(n, 1); bidx_ = malloc(n * sizeof(int)); wl_ = malloc(n * sizeof(int)); nw_ = 0; + R->ne = 0; + addl(R->lo, 1); + while (nw_) { + L = wl_[--nw_]; + for (i = L, cnt = 0;;) { + if (i >= R->hi || (i != L && lead_[i - R->lo])) break; + if (cnt++ >= 1000) { addl(i, 0); break; } + w = m[i]; + if (w & 1) { + if (i + 1 < R->hi && !(m[i + 1] & 1) && (k = (int)(m[i + 1] >> 1)) >= 6 && k <= 8) { + t = (int)(w >> 1); + if (k == 6) addl(i + 2, 1); /* a call comes back here */ + else if (k == 7) addl(t, 0); + else { addl(t, 0); addl(i + 2, 0); } + break; + } + i++; + continue; + } + k = (int)(w >> 1); + if (k == 600) { i += 2; continue; } /* payload is data, not an opcode */ + if (k == 6) { addl(i + 1, 1); break; } + if (k == 8) { addl(i + 1, 0); break; } + if (k == 0 || k == 7 || k == 9) break; + i++; + } + } + for (i = 0, b = 0; i < n; i++) if (lead_[i]) bidx_[i] = b++; + R->nb = b; R->b = calloc(b, sizeof(RB)); R->maxnv = 0; + for (i = 0; i < n; i++) if (lead_[i]) R->b[bidx_[i]].a = R->lo + i; + for (b = 0; b < R->nb && !r; b++) r = lift_block(b); + for (e = 0; e < R->ne; e++) R->entb[e] = bidx_[R->ent[e] - R->lo]; + free(lead_); free(bidx_); free(wl_); + if (r) { + if (trace) fprintf(stderr, "o3: %d..%d doesn't lift (%d)\n", R->lo, R->hi - 1, r); + R->lifted = 1; rclear(R); return r; + } + rshape(R); + if (!getenv("ZYNOGLOBAL")) rglobal(R); + if (rshare(R)) rshape(R); + for (e = 0; e < R->ne; e++) { o3ent[R->ent[e]] = R->idx + 1; o3ei[R->ent[e]] = e; } + R->lifted = 1; + rmark(R); + if (trace) { + int ops = 0; + for (b = 0; b < R->nb; b++) ops += R->b[b].n; + fprintf(stderr, "o3: %d..%d: %d blocks, %d entries, %d vars, %d micro-ops\n", R->lo, R->hi - 1, R->nb, R->ne, R->nv - 1, ops); + if (getenv("ZYO3DUMP")) + for (b = 0; b < R->nb; b++) { + RB *B = &R->b[b]; + fprintf(stderr, " b%d @%d: %d ops, sp %+d, term %d cv v%d s %d/%d x %d/%d\n", b, B->a, B->n, B->delta, B->term, B->cv, B->s1, B->s2, B->x1, B->x2); + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + if (u->op == U_ST) fprintf(stderr, " st v%d v%d\n", u->a, u->b); + else if (u->op == U_LI) fprintf(stderr, " v%d = %lld\n", u->d, (long long)u->imm); + else if (u->op == U_VGET) fprintf(stderr, " v%d = var%d\n", u->d, u->imm); + else if (u->op == U_SLD) fprintf(stderr, " v%d = s[%d]\n", u->d, u->imm); + else { fprintf(stderr, " v%d = %s v%d", u->d, unames[u->op], u->a); if (nargs(u->op) > 1) fprintf(stderr, " v%d", u->b); if (nargs(u->op) > 2) fprintf(stderr, " v%d", u->c); fprintf(stderr, "\n"); } + } + for (i = 0; i < B->nso; i++) fprintf(stderr, " s[%d] = v%d\n", B->so[2 * i], B->so[2 * i + 1]); + for (i = 1; i < R->nv; i++) if (B->vs[i] >= 0) fprintf(stderr, " var%d = v%d\n", i, B->vs[i]); + } + } + return 0; +} +/* install kind 2 */ +static int o3install(int d) +{ + int lo = mread(d + 2), hi = mread(d + 3), n = mread(d + 4), i, r; + Rg *R; + if (lo <= 0 || hi <= lo || hi > code_words || hi - lo > 1000000 || (unsigned)n > 32 || nrg >= MAXRG) return -1; + R = calloc(1, sizeof *R); + R->idx = nrg; rgs[nrg++] = R; + R->lo = lo; R->hi = hi; R->nv = 1; R->np = n; + for (i = 1; i < RMAXV; i++) R->slot[i] = -1; + for (i = 0; i < n; i++) { /* pairs: frame slot, register 1..7 */ + int s = mread(d + 5 + 2 * i), v = mread(d + 6 + 2 * i), fp = 0, pl = 0; + if (v < 0) { fp = 1; v = -v; } /* a negative register is a d-register home */ + if (v >= 16) { pl = 1; v -= 16; } + if ((unsigned)s >= 4096 || v < 1 || v >= RMAXV) { R->dead = 1; return -1; } + R->fv[v] = (unsigned char)fp; + R->sc[v] = (unsigned char)((R->sc[v] || !R->seen[v]) && pl); + R->seen[v] = 1; + R->ps[i] = s; R->pv[i] = v; + if (R->slot[v] < 0) R->slot[v] = s; + if (v >= R->nv) R->nv = v + 1; + } + for (i = 1; i < R->nv; i++) if (R->slot[i] < 0) R->slot[i] = R->ps[0]; + R->nv0 = R->nv; + R->fslots = mread(d + 5 + 2 * n); + R->argc = mread(d + 6 + 2 * n); + R->fn = mread(d + 7 + 2 * n); + if ((unsigned)R->argc > 32 || R->fslots < 0) { R->dead = 1; return -1; } + if ((r = rlift(R))) { R->dead = 1; return r; } + o3_bind(R); + rcompile(R, 1); + return 0; +} +/* the region entered at p, lifted again if it has to be, or 0 */ +static Rg *rat(int p) +{ + Rg *R = rgs[o3ent[p] - 1]; + if (R->dead) { o3ent[p] = 0; return 0; } + if (!R->lifted && rlift(R)) { R->dead = 1; o3ent[p] = 0; return 0; } + if (o3ei[p] >= R->ne || R->ent[o3ei[p]] != p) { o3ent[p] = 0; return 0; } + return R; +} + +#ifdef ZYJIT +static unsigned char *cov; /* how many live translations cover the word (255 sticks) */ +static void **tab; /* vm address -> translation */ +static void be_drop(int j) { tab[ix_blk[j].a] = 0; cdec(cov, ix_blk[j].a, ix_blk[j].b); if (trace) fprintf(stderr, "jit: dropped %d..%d\n", ix_blk[j].a, ix_blk[j].b - 1); } +static unsigned *code, *cp, *x_enter, *x_exit, *x_disp, *x_first; +static long S[14]; /* memory, stacks, hooks, limits, and the target saved on overflow */ +static void o3_invoke_jit(Cell *ps, Cell *pr, Cell target, Cell retpc) +{ + o3_invoke(ps, pr, target, retpc); + S[11] = (long)(m + stack_data_limit()); S[12] = (long)(m + stack_return_limit()); +} + +enum { W0 = 0, W1 = 1, X9 = 9, X10, X11, M = 19, SP = 20, RP = 21, TAB = 22, ST = 23 }; + +static void E(unsigned x) { *cp++ = x; } +static void li(int d, Cell v) /* movz/movk x, four halfwords; a vm immediate */ +{ + UCell u = (UCell)v; + E(0xd2800000 | ((unsigned)(u & 0xffff) << 5) | d); + if (u >> 16) E(0xf2a00000 | ((unsigned)((u >> 16) & 0xffff) << 5) | d); + if (u >> 32) E(0xf2c00000 | ((unsigned)((u >> 32) & 0xffff) << 5) | d); + if (u >> 48) E(0xf2e00000 | ((unsigned)((u >> 48) & 0xffff) << 5) | d); +} +/* executable bounds are read again after a compiler grows its code storage. */ +static void cmp_code(unsigned rn) +{ + int tmp = X9; + li(tmp, (Cell)(uintptr_t)&code_words); E(0xf9400000u | ((unsigned)tmp << 5) | tmp); + E(0xeb00001fu | ((unsigned)tmp << 16) | (rn << 5)); +} +/* cmp xn, #MW through a scratch register: a data address is in range. MW can be + far past what an immediate encodes, since the heap grows into it. */ +static void cmp_mw(unsigned rn, int tmp) +{ + li(tmp, MW); + E(0xeb00001fu | ((unsigned)tmp << 16) | (rn << 5)); +} +static void ldr_post(int t, int n, int i) { E(0xf8400400 | (i & 0x1ff) << 12 | n << 5 | t); } +static void ldr_pre(int t, int n, int i) { E(0xf8400c00 | (i & 0x1ff) << 12 | n << 5 | t); } +static void str_pre(int t, int n, int i) { E(0xf8000c00 | (i & 0x1ff) << 12 | n << 5 | t); } +static void str_post(int t, int n, int i) { E(0xf8000400 | (i & 0x1ff) << 12 | n << 5 | t); } +static void ldr_u(int t, int n, int o) { E(0xf9400000 | (o / 8) << 10 | n << 5 | t); } /* 8-byte cells */ +static void str_u(int t, int n, int o) { E(0xf9000000 | (o / 8) << 10 | n << 5 | t); } +static void ldr_d(int t, int n, int o) { E(0xfd400000 | (o / 8) << 10 | n << 5 | t); } /* ldr Dt, [Xn, #o] */ +static void str_d(int t, int n, int o) { E(0xfd000000 | (o / 8) << 10 | n << 5 | t); } +static void ldr_d_rr(int t, int n, int r) { E(0xfc605800 | r << 16 | n << 5 | t); } /* ldr Dt, [Xn, Wr, uxtw #3] */ +static void str_d_rr(int t, int n, int r) { E(0xfc205800 | r << 16 | n << 5 | t); } +static void fmov_dx(int d, int n) { E(0x9e670000 | n << 5 | d); } /* fmov Dd, Xn */ +static void fmov_xd(int d, int n) { E(0x9e660000 | n << 5 | d); } /* fmov Xd, Dn */ +static void fmov_dd(int d, int n) { E(0x1e604000 | n << 5 | d); } /* fmov Dd, Dn */ +static void ldrx_u(int t, int n, int o) { E(0xf9400000 | (o / 8) << 10 | n << 5 | t); } +static void ldr_rr(int t, int n, int r, int ext) { E(0xf8600800 | r << 16 | ext << 13 | 1 << 12 | n << 5 | t); } +static void str_rr(int t, int n, int r, int ext) { E(0xf8200800 | r << 16 | ext << 13 | 1 << 12 | n << 5 | t); } +static void ldp_post(int t, int u, int n, int i) { E(0xa8c00000 | ((i / 8) & 0x7f) << 15 | u << 10 | n << 5 | t); } +static void op3(unsigned op, int d, int n, int r) { E(op | r << 16 | n << 5 | d); } +static void addx_ext(int d, int n, int r, int ext, int sh) { E(0x8b200000 | r << 16 | ext << 13 | sh << 10 | n << 5 | d); } +static void movw(int d, int r) { E(0xaa0003e0 | r << 16 | d); } /* mov xd, xr */ +static void blr(int n) { E(0xd63f0000 | n << 5); } +static void b_to(unsigned *t) { long o = t - cp; E(0x14000000 | (o & 0x3ffffff)); } +static void cb_fix(unsigned *at, unsigned *to) { *at |= ((to - at) & 0x7ffff) << 5; } +#define SXTW 6 +#define UXTW 2 + +static void build_stubs(void) +{ + cp = code; + x_enter = cp; /* int enter(long *S, void *code) */ + E(0xa9b97bfd); /* stp x29, x30, [sp, #-112]! */ + E(0x910003fd); /* mov x29, sp */ + E(0xa90153f3); /* stp x19, x20, [sp, #16] */ + E(0xa9025bf5); /* stp x21, x22, [sp, #32] */ + E(0xf9001bf7); /* str x23, [sp, #48] */ + E(0xa90467f8); /* stp x24, x25, [sp, #64] */ + E(0xa9056ffa); /* stp x26, x27, [sp, #80] */ + E(0xf90033fc); /* str x28, [sp, #96] */ + E(0xaa0003f7); /* mov x23, x0 */ + ldrx_u(M, ST, 0); + ldrx_u(24, ST, 88); ldrx_u(25, ST, 96); /* x24, x25: the stack limits, as addresses */ + ldr_u(X9, ST, 8); addx_ext(SP, M, X9, UXTW, 3); /* sp = m + s*8 */ + ldr_u(X9, ST, 16); addx_ext(RP, M, X9, UXTW, 3); + ldrx_u(TAB, ST, 24); + E(0xd61f0020); /* br x1 */ + x_exit = cp; /* x0 = next vm address */ + op3(0xcb000000, X9, SP, M); E(0xd343fd29); str_u(X9, ST, 8); /* s = (x20 - x19) >> 3 */ + op3(0xcb000000, X9, RP, M); E(0xd343fd29); str_u(X9, ST, 16); + E(0xa94153f3); /* ldp x19, x20, [sp, #16] */ + E(0xa9425bf5); /* ldp x21, x22, [sp, #32] */ + E(0xf9401bf7); /* ldr x23, [sp, #48] */ + E(0xa94467f8); /* ldp x24, x25, [sp, #64] */ + E(0xa9456ffa); /* ldp x26, x27, [sp, #80] */ + E(0xf94033fc); /* ldr x28, [sp, #96] */ + E(0xa8c77bfd); /* ldp x29, x30, [sp], #112 */ + E(0xd65f03c0); /* ret */ + { + unsigned *ovd = cp, *ovr; + li(W0, PC_DATA_OVERFLOW); b_to(x_exit); /* data stack overflow */ + ovr = cp; + li(W0, PC_RETURN_OVERFLOW); b_to(x_exit); /* return stack overflow */ + x_disp = cp; /* w0 = target: check the stacks, chain through tab[] or fall back to c */ + str_u(0, ST, 104); + E(0xeb18029f); /* cmp x20, x24 */ + E(0x54000003 | ((ovd - cp) & 0x7ffff) << 5); /* b.lo data overflow */ + E(0xeb1902bf); /* cmp x21, x25 */ + E(0x54000002 | ((ovr - cp) & 0x7ffff) << 5); /* b.hs return overflow */ + } + cmp_code(0); /* compare the current code reservation */ + E(0x54000002 | ((x_exit - cp) & 0x7ffff) << 5); /* b.hs exit */ + ldrx_u(TAB, ST, 24); + E(0xf8605ac9); /* ldr x9, [x22, w0, uxtw #3] */ + E(0xb4000009 | ((x_exit - cp) & 0x7ffff) << 5); /* cbz x9, exit */ + E(0xd61f0120); /* br x9 */ + x_first = cp; +} + +static void flush(void) +{ + memset(tab, 0, (size_t)code_words * sizeof *tab); + rdrop_all(); + memset(cov, 0, (size_t)code_words); + cov[SYSGATE] = 255; + ix_reset(); + cp = x_first; + if (trace) fprintf(stderr, "jit: flushed\n"); +} + +static void jitwrite(int on) +{ +#ifdef __APPLE__ + pthread_jit_write_protect_np(!on); +#else + (void)on; +#endif +} + +static void syncicache(unsigned *a, unsigned *b) +{ +#ifdef __APPLE__ + sys_icache_invalidate(a, (char *)b - (char *)a); +#else + __builtin___clear_cache((char *)a, (char *)b); +#endif +} + +/* store hook for words that are covered by a translation */ +static int hook(Cell a, Cell v) +{ + int j, hit = 0; + if (a == SYSGATE) { + int moving = v == 9 && (m[a + 1] == 7 || m[a + 1] == 8); + cb_s = S[1]; cb_r = S[2]; m[a] = hostcall(v, m[a + 1], m[a + 2], m[a + 3]); + if (moving) { S[1] = cb_s; S[2] = cb_r; } + S[11] = (long)(m + stack_data_limit()); S[12] = (long)(m + stack_return_limit()); + S[3] = (long)tab; + return 0; + } + if (m[a] == v) return 0; + m[a] = v; + hit = ix_drop_at((int)a); + for (j = 0; j < nrg; j++) + if (rgs[j]->lifted && rgs[j]->lo <= a && a < rgs[j]->hi) { + if (trace) fprintf(stderr, "o3: dropped %d..%d (a store to %d)\n", rgs[j]->lo, rgs[j]->hi - 1, (int)a); + rclear(rgs[j]); + hit = 1; + } + if (hit) drop_epoch++; + return hit; +} + +/* float ops 601..611 and 618. 600 (flit) is handled by translate, which eats the raw bits. */ +static void fjit(int k) +{ + unsigned opw = 0; + if (k == 601) opw = 0x1e602820; /* fadd d0, d1, d0 */ + else if (k == 602) opw = 0x1e603820; /* fsub */ + else if (k == 603) opw = 0x1e600820; /* fmul */ + else if (k == 604) opw = 0x1e601820; /* fdiv */ + if (opw) { + E(0xfd400280); /* ldr d0, [x20] */ + E(0xfd400681); /* ldr d1, [x20, #8] */ + E(opw); + E(0x91002294); /* add x20, x20, #8 */ + E(0xfd000280); /* str d0, [x20] */ + return; + } + if (k >= 605 && k <= 607) { + E(0xfd400280); + E(0xfd400681); + E(0x1e602020); /* fcmp d1, d0: left ? right. mi/ls, not lt/le: unordered is not less */ + if (k == 605) E(0x9a9f17ea); /* cset x10, eq */ + else if (k == 606) E(0x9a9f57ea); /* cset x10, mi */ + else E(0x9a9f87ea); /* cset x10, ls */ + E(0x91002294); + str_u(X10, SP, 0); + return; + } + if (k == 608) { ldr_u(X9, SP, 0); E(0x9e620120); E(0xfd000280); return; } /* scvtf d0, x9; str d0 */ + if (k == 609) { E(0xfd400280); E(0x9e78000a); str_u(X10, SP, 0); return; } /* fcvtzs x10, d0 */ + if (k == 610) { ldr_post(0, SP, 8); li(X11, (Cell)(uintptr_t)fop_print); blr(X11); return; } + if (k == 618) { /* (bits prec mode --) */ + ldr_u(2, SP, 0); + ldr_u(1, SP, 8); + ldr_u(0, SP, 16); + E(0x91006294); /* add x20, x20, #24 */ + li(X11, (Cell)(uintptr_t)fop_print_mode); + blr(X11); + return; + } + ldr_u(0, SP, 0); li(X11, (Cell)(uintptr_t)fop_parse_cell); blr(X11); str_u(0, SP, 0); +} + +/* byte ops 612..617. the address is a byte index into m[], little-endian. */ +static void bjit(int k) +{ + Cell fn; + if (k == 612 || k == 614 || k == 616) { + ldr_u(0, SP, 0); + if (k == 612) fn = (Cell)(uintptr_t)bld8; + else if (k == 614) fn = (Cell)(uintptr_t)bld16; + else fn = (Cell)(uintptr_t)bld32; + li(X11, fn); blr(X11); str_u(0, SP, 0); + return; + } + ldp_post(0, 1, SP, 16); + if (k == 613) fn = (Cell)(uintptr_t)bst8; + else if (k == 615) fn = (Cell)(uintptr_t)bst16; + else fn = (Cell)(uintptr_t)bst32; + li(X11, fn); blr(X11); +} + +static void op(int i, int k) /* everything except control flow */ +{ + unsigned *a, *b, *c, *z; + switch (k) { + case 1: + ldr_u(X9, SP, 0); cmp_mw(9, X11); + a = cp; E(0x54000002); /* b.hs zero */ + ldr_rr(X9, M, X9, UXTW); + b = cp; E(0x14000000); + cb_fix(a, cp); li(X9, 0); + *b |= (cp - b) & 0x3ffffff; + str_u(X9, SP, 0); return; + case 2: /* store: inline unless the target word is translated */ + ldp_post(X9, X10, SP, 16); + cmp_mw(9, X11); /* cmp x9, MW */ + a = cp; E(0x54000002); /* b.hs done */ + ldrx_u(X11, ST, 32); + E(0x3869496b); /* ldrb w11, [x11, w9, uxtw] */ + b = cp; E(0x3500000b); /* cbnz w11, slow */ + str_rr(X10, M, X9, UXTW); + c = cp; E(0x14000000); /* b done */ + cb_fix(b, cp); /* slow: hook(a, v) */ + movw(W0, X9); movw(W1, X10); + /* publish s and r (as exit does) so a syscall that calls back into the vm + can find the stacks. the hook reads them for a gate store */ + op3(0xcb000000, X9, SP, M); E(0xd343fd29); str_u(X9, ST, 8); + op3(0xcb000000, X9, RP, M); E(0xd343fd29); str_u(X9, ST, 16); + ldrx_u(X11, ST, 64); blr(X11); + ldr_u(X9, ST, 8); addx_ext(SP, M, X9, UXTW, 3); + ldr_u(X9, ST, 16); addx_ext(RP, M, X9, UXTW, 3); + ldrx_u(24, ST, 88); ldrx_u(25, ST, 96); ldrx_u(TAB, ST, 24); + z = cp; E(0x34000000); /* cbz w0, done: hook's int result */ + li(W0, i + 1); b_to(x_exit); /* a translation died: resume at i+1 in c */ + cb_fix(a, cp); cb_fix(z, cp); + *c |= (cp - c) & 0x3ffffff; + return; + case 3: /* pick uses a word address, with the same bounds as load */ + ldr_u(X9, SP, 0); + op3(0xcb000000, X10, SP, M); E(0xd343fd4a); /* (sp - m) / 8 */ + E(0x9100054a); op3(0x8b000000, X9, X10, X9); + cmp_mw(9, X11); + a = cp; E(0x54000002); + ldr_rr(X9, M, X9, UXTW); + b = cp; E(0x14000000); + cb_fix(a, cp); li(X9, 0); + *b |= (cp - b) & 0x3ffffff; + str_u(X9, SP, 0); return; + case 4: E(0x91002294); return; /* add x20, x20, #8 */ + case 5: E(0xa9402a89); E(0xa900268a); return; /* ldp x9, x10, [x20]; stp x10, x9, [x20] */ + case 10: ldrx_u(X11, ST, 40); blr(X11); E(0x93401c09); str_pre(X9, SP, -8); return; /* sxtb x9, w0 */ + case 11: + ldrx_u(X9, ST, 56); + if (sizeof J == 1) E(0x39400129); else E(0xb9400129); /* ldrb or ldr w: J is a host flag, not a vm word */ + str_pre(X9, SP, -8); + return; + case 12: ldr_post(W0, SP, 8); E(0x93401c00); ldrx_u(X11, ST, 48); blr(X11); return; /* sxtb x0, w0 */ + } + ldr_post(X9, SP, 8); + ldr_u(X10, SP, 0); + switch (k) { + case 13: op3(0x8b000000, X10, X10, X9); break; + case 14: op3(0xcb000000, X10, X10, X9); break; + case 15: op3(0x9b007c00, X10, X10, X9); break; + case 16: op3(0x8a000000, X10, X10, X9); break; + case 17: op3(0xaa000000, X10, X10, X9); break; + case 18: op3(0xca000000, X10, X10, X9); break; + case 19: op3(0x9ac02800, X10, X10, X9); break; + default: E(0xeb09015f); E(0x9a9fa7ea); /* cmp x10, x9; cset x10, lt */ + } + str_u(X10, SP, 0); +} + +/* one micro-op, operands in registers. tmp is a scratch register for the + remainders; x16 and x17 are scratch too. */ +/* a byte address is an index into the flat image. out of range loads 0 and + stores nothing. a store into a word some translation covers calls the + same helper as opcode 2, so the block is dropped. x16, x17 and the saved link register are scratch, + and the address and value are parked on the machine stack across that. */ +static void emit_byte(int op, int d, int a, int b) +{ + int n = bwidth(op), j, ar; + unsigned *oob, *cov1, *nocross, *cov2, *over; + Cell fn; + if (!n) return; + str_pre(30, 31, -16); /* x18 is reserved on darwin; borrow the saved link register */ + if (!is_store(op)) { + ar = a; + if (d == a) { movw(17, a); ar = 17; } + E(0xd2800000 | d); /* mov xd, #0 */ + li(30, ((Cell)MW << 3) - (n - 1)); + E(0xeb1e001f | (ar << 5)); /* cmp xAr, x30 */ + oob = cp; E(0x54000002); /* b.hs done */ + E(0x8b000000 | (ar << 16) | (M << 5) | 17); /* add x17, x19, xAr */ + if (n == 1) E(0x39400000 | (17 << 5) | d); + else if (n == 2) E(0x79400000 | (17 << 5) | d); + else E(0xb9400000 | (17 << 5) | d); + cb_fix(oob, cp); + ldr_post(30, 31, 16); + return; + } + str_pre(a, 31, -16); + str_u(b, 31, 8); + li(16, ((Cell)MW << 3) - (n - 1)); + ldr_u(17, 31, 0); + E(0xeb10023f); /* cmp x17, x16 */ + oob = cp; E(0x54000002); /* b.hs pop */ + E(0xd343fe30); /* lsr x16, x17, #3 */ + ldrx_u(30, ST, 32); + E(0x38704bde); /* ldrb w30, [x30, w16, uxtw] */ + cov1 = cp; E(0x35000000 | 30); /* cbnz w30, slow */ + E(0x92400a3e); /* and x30, x17, #7 */ + E(0x91000000 | (n << 10) | (30 << 5) | 30); /* add x30, x30, #n */ + E(0xf10023df); /* cmp x30, #8 */ + nocross = cp; E(0x54000009); /* b.ls inline */ + E(0x91000610); /* add x16, x16, #1 */ + ldrx_u(30, ST, 32); + E(0x38704bde); /* ldrb w30, [x30, w16, uxtw] */ + cov2 = cp; E(0x35000000 | 30); /* cbnz w30, slow */ + cb_fix(nocross, cp); /* inline */ + ldr_u(17, 31, 0); + ldr_u(16, 31, 8); + E(0x8b11027e); /* add x30, x19, x17 */ + if (n == 1) E(0x390003d0); + else if (n == 2) E(0x790003d0); + else E(0xb90003d0); /* str w16, [x30] */ + over = cp; E(0x14000000); /* b pop */ + cb_fix(cov1, cp); + cb_fix(cov2, cp); /* slow */ + E(0xd10203ff); /* sub sp, sp, #128 */ + for (j = 0; j < 16; j += 2) E(0xa9000000 | (j / 2 * 2) << 15 | (j + 1) << 10 | 31 << 5 | j); + ldr_u(0, 31, 128); + ldr_u(1, 31, 136); + fn = n == 1 ? (Cell)(uintptr_t)bst8 : n == 2 ? (Cell)(uintptr_t)bst16 : (Cell)(uintptr_t)bst32; + li(16, fn); blr(16); + for (j = 0; j < 16; j += 2) E(0xa9400000 | (j / 2 * 2) << 15 | (j + 1) << 10 | 31 << 5 | j); + E(0x910203ff); /* add sp, sp, #128 */ + *over |= (cp - over) & 0x3ffffff; + cb_fix(oob, cp); /* pop */ + E(0x910043ff); /* add sp, sp, #16 */ + ldr_post(30, 31, 16); + (void)d; +} +static void emit_uop(int op, int d, int a, int b, int c, int tmp) +{ + switch (op) { + case U_ADD: op3(0x8b000000, d, a, b); break; + case U_SUB: op3(0xcb000000, d, a, b); break; + case U_MUL: op3(0x9b007c00, d, a, b); break; + case U_SDIV: op3(0x9ac00c00, d, a, b); break; + case U_UDIV: op3(0x9ac00800, d, a, b); break; + case U_SREM: op3(0x9ac00c00, tmp, a, b); E(0x9b008000 | b << 16 | a << 10 | tmp << 5 | d); break; /* msub */ + case U_UREM: op3(0x9ac00800, tmp, a, b); E(0x9b008000 | b << 16 | a << 10 | tmp << 5 | d); break; + case U_AND: op3(0x8a000000, d, a, b); break; + case U_OR: op3(0xaa000000, d, a, b); break; + case U_XOR: op3(0xca000000, d, a, b); break; + case U_SHL: op3(0x9ac02000, d, a, b); break; + case U_SHR: op3(0x9ac02400, d, a, b); break; + case U_SAR: op3(0x9ac02800, d, a, b); break; + case U_NEG: E(0xcb0003e0 | a << 16 | d); break; + case U_NOT: E(0xaa2003e0 | a << 16 | d); break; + case U_LT: E(0xeb00001f | b << 16 | a << 5); E(0x9a9fa7e0 | d); break; /* cmp; cset lt */ + case U_LTU: E(0xeb00001f | b << 16 | a << 5); E(0x9a9f27e0 | d); break; /* cset lo */ + case U_EQ: E(0xeb00001f | b << 16 | a << 5); E(0x9a9f17e0 | d); break; + case U_NE: E(0xeb00001f | b << 16 | a << 5); E(0x9a9f07e0 | d); break; + case U_MIN: E(0xeb00001f | b << 16 | a << 5); E(0x9a800000 | b << 16 | 11 << 12 | a << 5 | d); break; + case U_MAX: E(0xeb00001f | b << 16 | a << 5); E(0x9a800000 | b << 16 | 12 << 12 | a << 5 | d); break; + case U_MINU: E(0xeb00001f | b << 16 | a << 5); E(0x9a800000 | b << 16 | 3 << 12 | a << 5 | d); break; + case U_MAXU: E(0xeb00001f | b << 16 | a << 5); E(0x9a800000 | b << 16 | 8 << 12 | a << 5 | d); break; + case U_MULHS: E(0x9b407c00 | b << 16 | a << 5 | d); break; /* smulh */ + case U_MULHU: E(0x9bc07c00 | b << 16 | a << 5 | d); break; /* umulh */ + case U_CLZ: E(0xdac01000 | a << 5 | d); break; + case U_CTZ: E(0xdac00000 | a << 5 | 16); E(0xdac01000 | 16 << 5 | d); break; /* rbit; clz */ + case U_BSWAP: E(0xdac00c00 | a << 5 | d); break; /* rev */ + case U_POPCNT: + fmov_dx(16, a); E(0x0e205800 | 16 << 5 | 16); /* cnt v16.8b */ + E(0x0e31b800 | 16 << 5 | 16); /* addv b16, v16.8b */ + E(0x0e013c00 | 16 << 5 | d); break; /* umov w, v16.b[0] */ + case U_ROTR: op3(0x9ac02c00, d, a, b); break; + case U_ROTL: E(0xcb0003e0 | b << 16 | 16); op3(0x9ac02c00, d, a, 16); break; /* neg x16, b; ror */ + case U_F2S: fmov_dx(16, a); E(0x1e624000 | 16 << 5 | 16); E(0x1e260000 | 16 << 5 | d); break; /* fcvt s16, d16; fmov w, s */ + case U_S2F: E(0x1e270000 | a << 5 | 16); E(0x1e22c000 | 16 << 5 | 16); E(0x9e660000 | 16 << 5 | d); break; /* fmov s16, w; fcvt d16, s16; fmov x, d16 */ + case U_ABS: E(0xf100001f | a << 5); E(0xda800400 | a << 16 | 10 << 12 | a << 5 | d); break; /* cmp #0; cneg */ + case U_SEL: E(0xf100001f | a << 5); E(0x9a800000 | c << 16 | 1 << 12 | b << 5 | d); break; /* csel ne */ + case U_FADD: case U_FSUB: case U_FMUL: case U_FDIV: { /* operands arrive in GPRs; enhancements have no d homes */ + unsigned base = op == U_FADD ? 0x1e602800u : op == U_FSUB ? 0x1e603800u : op == U_FMUL ? 0x1e600800u : 0x1e601800u; + fmov_dx(16, a); fmov_dx(17, b); E(base | 17u << 16 | 16u << 5 | 16u); fmov_xd(d, 16); break; } + case U_FEQ: case U_FLT: case U_FLE: + fmov_dx(16, a); fmov_dx(17, b); E(0x1e602000 | 17u << 16 | 16u << 5); + E((op == U_FEQ ? 0x9a9f17e0u : op == U_FLT ? 0x9a9f57e0u : 0x9a9f87e0u) | d); break; + case U_I2F: E(0x9e620000 | a << 5 | 16); fmov_xd(d, 16); break; /* scvtf d16, Xa */ + case U_F2I: fmov_dx(16, a); E(0x9e780000 | 16 << 5 | d); break; /* fcvtzs Xd, d16 */ + case U_LD: /* out of range reads 0, like the interpreter */ + E(0xd2800011); cmp_mw(a, 16); E(0x54000042); ldr_rr(17, M, a, UXTW); movw(d, 17); + break; + case U_ST: cmp_mw(a, 16); E(0x54000042); str_rr(b, M, a, UXTW); break; + case U_LD8: case U_LD16: case U_LD32: case U_ST8: case U_ST16: case U_ST32: + emit_byte(op, d, a, b); break; + } +} +/* an enhancement, inlined: inputs from the data stack into x0..x15, the + optimized micro-ops, outputs back. constants are made where they're used, + or folded into the instruction (a fixed address, a small addend). */ +static int ekc[MAXUOP * 4 + 16]; static Cell ekv[MAXUOP * 4 + 16]; +static void emit_enh_e(Enh *e, int s) +{ + signed char *r = e->reg; + int i, j, delta, na; + if (!r) { /* didn't fit in registers: x0 = data stack, w1 = slot, call the interpreter */ + E(0xaa1403e0); li(W1, s); ldrx_u(X11, ST, 80); blr(X11); E(0xaa0003f4); + return; + } + for (i = 0; i < e->nv; i++) ekc[i] = 0; + for (i = 0; i < e->n; i++) if (e->u[i].op == U_LI) { ekc[e->u[i].d] = 1; ekv[e->u[i].d] = e->u[i].imm; } +#define EOP(x) (ekc[x] ? (li(r[x], ekv[x]), r[x]) : r[x]) + for (j = 0; j < e->nin; j++) if (r[j] >= 0) ldr_u(r[j], SP, 8 * (e->nin - 1 - j)); + for (i = 0; i < e->n; i++) { + Uop *u = &e->u[i]; + int d = is_store(u->op) ? 0 : r[u->d], a = 0, b = 0, c = 0; + if (u->op == U_LI) continue; + if (u->op == U_LD && ekc[u->a] && inmem(ekv[u->a])) { + if (ekv[u->a] < 4096) ldr_u(d, M, (int)ekv[u->a] * 8); else ldr_rr(d, M, EOP(u->a), UXTW); + continue; + } + if ((u->op == U_ADD || u->op == U_SUB) && ekc[u->b] && ekv[u->b] >= 0 && ekv[u->b] < 4096) { + E((u->op == U_ADD ? 0x91000000 : 0xd1000000) | (unsigned)ekv[u->b] << 10 | EOP(u->a) << 5 | d); + continue; + } + na = nargs(u->op); + if (na > 0) a = EOP(u->a); + if (na > 1) b = EOP(u->b); + if (na > 2) c = EOP(u->c); + emit_uop(u->op, d, a, b, c, 16); + } + delta = 8 * (e->nin - e->nout); + if (delta > 0) E(0x91000294 | delta << 10); + if (delta < 0) E(0xd1000294 | (-delta) << 10); + for (j = 0; j < e->nout; j++) str_u(EOP(e->out[j]), SP, 8 * (e->nout - 1 - j)); +#undef EOP +} +static void emit_enh(int s) { emit_enh_e(&enh[s], s); } +/* lit .. lit xop: the enhancement specialized on the literals that feed its + last inputs, so the optimizer sees them as constants (x / 7 becomes a + multiply, lfa(k) a load and an add). 0 if it worked. */ +static int spec_enh(int s, Cell *ks, int nk, Enh *te) +{ + Enh *e = &enh[s]; + int nin = e->nin - nk, i, j, out[8], na; + static int mp[MAXUOP * 4 + 16]; + if (e->nv > MAXUOP * 4) return -1; + un = 0; unv = nin; uerr = 0; + for (j = 0; j < nin; j++) mp[j] = j; + for (j = 0; j < nk; j++) mp[nin + j] = unew(U_LI, 0, 0, 0, ks[j]); + for (i = 0; i < e->n; i++) { + Uop *u = &e->u[i]; + na = nargs(u->op); + j = unew(u->op, na > 0 ? mp[u->a] : 0, na > 1 ? mp[u->b] : 0, na > 2 ? mp[u->c] : 0, u->imm); + if (u->op != U_ST) mp[u->d] = j; + } + for (j = 0; j < e->nout; j++) out[j] = mp[e->out[j]]; + memset(te, 0, sizeof *te); + if (uerr || optimize(te, nin, out, e->nout)) return -1; + regalloc(te); + if (!te->reg) { free(te->u); return -1; } + return 0; +} + +/* ---- o3 regions on arm64 ---- + int vars live in x0..x7 (x0 is the frame pointer) and float vars in the + d register of the same number. block values use x8..x14 and w26..w28, or + d8..d15 when the value is a float, so a chain of float ops does not move + through an integer register. constants have no register: they are made in + a scratch (x16/x17 or d16/d17) where they're used. */ +static signed char rreg[MAXUOP * 4 + 16]; +static unsigned char rk[MAXUOP * 4 + 16], rhome[MAXUOP * 4 + 16], rfp[MAXUOP * 4 + 16]; +static Cell rkv[MAXUOP * 4 + 16]; static int rlast[MAXUOP * 4 + 16]; +static unsigned **rfa; static int *rfb, rnf; /* branches to blocks, fixed up at the end */ + +#define LINKN 1024 +static void *linkstk[LINKN]; +static Cell jit_depth; +typedef struct { void *stub; int fslots; int argc; } FnNat; +static FnNat *fn_nat; +static void rforget(Rg *R) +{ + int e; + if (R->nat) for (e = 0; e < R->ne; e++) if (tab[R->ent[e]] == R->stub[e]) tab[R->ent[e]] = 0; + if ((unsigned)R->fn < (unsigned)code_words) fn_nat[R->fn].stub = 0; + R->nat = 0; +} +static void rmark(Rg *R) { R->marked = 1; cinc(cov, R->lo, R->hi); } +static void runmark(Rg *R) { cdec(cov, R->lo, R->hi); } +static int ralloc(Rg *R, RB *B) +{ + int i, j, k, n = B->n; + unsigned fr = 0x7f00u | 0x1c000000u; /* w8..w14, w26..w28 */ + unsigned ffr = 0xff00u; /* d8..d15 */ + unsigned char *want; + for (j = R->nv; j < 8; j++) fr |= 1u << j; + for (j = 1; j < R->nv && j < 8; j++) if (R->fv[j]) fr |= 1u << j; /* that x register is free */ + for (j = 1; j < 8; j++) if (!R->fv[j]) ffr |= 1u << j; + if (B->nv > MAXUOP * 4) return -1; + want = calloc(B->nv + 1, 1); + class_fp(R, B, want); + for (i = 0; i < B->nv; i++) { rlast[i] = -2; rk[i] = 0; rhome[i] = 0; rreg[i] = -1; rfp[i] = want[i]; } + for (i = 0; i < n; i++) { + Uop *u = &B->u[i]; int na = nargs(u->op); + if (na > 0) rlast[u->a] = i; + if (na > 1) rlast[u->b] = i; + if (na > 2) rlast[u->c] = i; + } + for (j = 0; j < B->nso; j++) rlast[B->so[2 * j + 1]] = n; + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0) rlast[B->vs[j]] = n; + if (B->term == T_CBR || B->term == T_JMP || B->term == T_CALL) rlast[B->cv] = n; + for (i = 0; i < n; i++) { + Uop *u = &B->u[i]; int na = nargs(u->op), ops[3], d = u->d, asfp; + ops[0] = u->a; ops[1] = u->b; ops[2] = u->c; + for (j = 0; j < na; j++) { + int x = ops[j]; + if (rlast[x] == i && rreg[x] >= 0 && !rhome[x]) { + if (rfp[x]) ffr |= 1u << rreg[x]; else fr |= 1u << rreg[x]; + } + } + if (is_store(u->op)) continue; + if (u->op == U_LI) { rk[d] = 1; rkv[d] = u->imm; continue; } + if (u->op == U_VGET) { + rreg[d] = (signed char)u->imm; rhome[d] = 1; + rfp[d] = (unsigned)u->imm < RMAXV && R->fv[u->imm]; + continue; + } + asfp = rfp[d]; + if (asfp) { + for (k = 0; k < 32 && !(ffr >> k & 1); k++); + if (k == 32) { free(want); return -1; } + ffr &= ~(1u << k); + } else { + for (k = 0; k < 32 && !(fr >> k & 1); k++); + if (k == 32) { free(want); return -1; } + fr &= ~(1u << k); + } + rreg[d] = (signed char)k; + if (rlast[d] == -2) { if (asfp) ffr |= 1u << k; else fr |= 1u << k; } + } + free(want); + return 0; +} +/* a GPR holding the bits. a float-resident value is moved across. */ +static int rgpr(int x, int s) +{ + if (rk[x]) { li(s, rkv[x]); return s; } + if (rfp[x]) { fmov_xd(s, rreg[x]); return s; } + return rreg[x]; +} +/* a d register holding the bits. scratch s is d16 or d17. */ +static int rdf(int x, int s) +{ + if (rfp[x] && !rk[x]) return rreg[x]; + if (rk[x]) { li(16, rkv[x]); fmov_dx(s, 16); return s; } + fmov_dx(s, rreg[x]); + return s; +} +static int ropr(int x, int s) { return rgpr(x, s); } +/* w t <-> the data stack word o places from the top at block entry */ +static void rsw(int t, int o, int store) +{ + int by = o * 8; + if (by >= 0 && by < 32768) { if (store) str_u(t, SP, by); else ldr_u(t, SP, by); } + else if (by >= -256 && by < 256) E((store ? 0xf8000000u : 0xf8400000u) | (unsigned)(by & 0x1ff) << 12 | SP << 5 | t); /* stur, ldur */ + else { li(16, by); addx_ext(16, SP, 16, SXTW, 0); if (store) str_u(t, 16, 0); else ldr_u(t, 16, 0); } +} +static void rswd(int t, int o, int store) +{ + int by = o * 8; + if (by >= 0 && by < 32768) { if (store) str_d(t, SP, by); else ldr_d(t, SP, by); } + else { li(16, by); addx_ext(16, SP, 16, SXTW, 0); if (store) str_d(t, 16, 0); else ldr_d(t, 16, 0); } +} +static void addsp(int by) +{ + if (by > 0 && by < 4096) E(0x91000294 | by << 10); + else if (by < 0 && -by < 4096) E(0xd1000294 | (-by) << 10); + else if (by) { li(16, by); addx_ext(SP, SP, 16, SXTW, 0); } +} +static void rspill(Rg *R) +{ + int v; + for (v = 0; v < R->np; v++) { /* add x16, x0, #slot */ + E(0x91000000 | R->ps[v] << 10 | 16); + if (R->fv[R->pv[v]]) str_d_rr(R->pv[v], M, 16); else str_rr(R->pv[v], M, 16, UXTW); + } +} +static void rload(Rg *R) +{ + int v; + li(16, ZFP); ldr_rr(0, M, 16, UXTW); + for (v = 1; v < R->nv; v++) { + E(0x91000000 | R->slot[v] << 10 | 16); + if (R->fv[v]) ldr_d_rr(v, M, 16); else ldr_rr(v, M, 16, UXTW); + } +} +/* a direct o3 call blrs the callee's entry stub. the stub saves x30 in linkstk + when jit_depth is nonzero, and the return reloads it and rets. depth 0 leaves + through x_exit, which is how a region entered from bytecode returns. + x17 is the vm address being left. vars are already spilled. a fall off the + end (pc == hi) pushes the implicit 0. the frame is given back either way. */ +static void rfinish(Rg *R) +{ + unsigned *ne, *z; + /* entered from bytecode: the epilogue is still ahead of us and it + pushes the implicit 0 and puts the frame back. a direct caller + skipped that epilogue, so do both here and ret. */ + li(16, (Cell)(uintptr_t)&jit_depth); + ldr_u(X9, 16, 0); + z = cp; E(0xb4000000 | X9); /* cbz x9, leave to the epilogue */ + li(16, R->hi); + E(0xeb10023f); /* cmp x17, x16 */ + ne = cp; E(0x54000001); /* b.ne value already pushed */ + E(0xd1002294); /* sub x20, x20, #8 */ + E(0xf900029f); /* str xzr, [x20] */ + cb_fix(ne, cp); + if (R->fslots) { + li(16, ZFP); + ldr_rr(10, M, 16, UXTW); + if (R->fslots > 0 && R->fslots < 4096) E(0x91000000 | (R->fslots << 10) | (10 << 5) | 10); + else { li(11, R->fslots); E(0x8b0b014a); } /* add x10, x10, x11 */ + str_rr(10, M, 16, UXTW); + } + li(16, (Cell)(uintptr_t)&jit_depth); + ldr_u(X9, 16, 0); + E(0xd1000529); /* sub x9, x9, #1 */ + str_u(X9, 16, 0); + li(16, (Cell)(uintptr_t)linkstk); + E(0x8b090e10); /* add x16, x16, x9, lsl #3 */ + ldr_u(30, 16, 0); + E(0xd65f03c0); /* ret */ + cb_fix(z, cp); + movw(W0, 17); + b_to(x_exit); +} +static void rexitk(Rg *R, int t) +{ + rspill(R); + if (t >= R->hi) { li(17, t); rfinish(R); } + else { li(W0, t); b_to(x_disp); } +} +/* o3-to-o3 is a blr from this region to the callee's entry, with the frame + built here. anything else is an ordinary vm call: the return address goes + on the vm return stack and x_disp runs the callee. */ +static void rcall(Rg *R, RB *B) +{ + unsigned *to_slow, *is_null, *too_deep, *too_small, *cz; + int e, hopped; + rspill(R); + li(16, (Cell)(uintptr_t)&fn_nat); ldr_u(16, 16, 0); + cmp_code(17); + to_slow = cp; E(0x54000002); /* b.hs slow */ + E(0x8b11120c); /* add x12, x16, x17, lsl #4 */ + ldr_u(X9, 12, 0); + is_null = cp; E(0xb4000000 | X9); /* cbz x9, slow */ + li(16, (Cell)(uintptr_t)&jit_depth); + ldr_u(10, 16, 0); + E(0xf110015f); /* cmp x10, #1024 */ + too_deep = cp; E(0x54000002); /* b.hs slow */ + E(0xb940098a); /* ldr w10, [x12, #8] fslots */ + E(0xb9400d8b); /* ldr w11, [x12, #12] argc */ + li(16, ZFP); + ldr_rr(13, M, 16, UXTW); + E(0xcb0a01ad); /* sub x13, x13, x10 */ + li(16, (Cell)(uintptr_t)&frame_floor_word); ldr_u(16, 16, 0); ldr_rr(14, M, 16, UXTW); + li(16, (Cell)(uintptr_t)&frame_guard_word); ldr_u(16, 16, 0); ldr_rr(15, M, 16, UXTW); + op3(0x8b000000, 14, 14, 15); E(0xeb0e01bf); /* cmp x13, x14 */ + too_small = cp; E(0x54000003); /* b.lo slow: bytecode can grow the frame */ + str_pre(X9, 31, -16); + li(16, ZFP); + str_rr(13, M, 16, UXTW); + cz = cp; E(0x34000000 | 11); /* cbz w11, copied */ + E(0x5100056b); /* sub w11, w11, #1 */ + ldr_post(14, SP, 8); + E(0x8b0b01af); /* add x15, x13, x11 */ + str_rr(14, M, 15, UXTW); + b_to(cz); + cb_fix(cz, cp); + ldr_post(X9, 31, 16); /* stub */ + li(16, (Cell)(uintptr_t)&jit_depth); + ldr_u(10, 16, 0); + E(0x9100054a); /* add x10, x10, #1 */ + str_u(10, 16, 0); + blr(X9); + hopped = 0; + for (e = 0; e < R->ne; e++) if (R->ent[e] == B->x2) { b_to((unsigned *)R->stub[e]); hopped = 1; break; } + if (!hopped) { li(W0, B->x2); b_to(x_disp); } + cb_fix(to_slow, cp); + cb_fix(is_null, cp); + cb_fix(too_deep, cp); + cb_fix(too_small, cp); + /* nested bytecode runs with its own direct-call depth and returns here. */ + op3(0xcb000000, X9, SP, M); E(0xd343fd29); str_u(X9, ST, 8); + op3(0xcb000000, X9, RP, M); E(0xd343fd29); str_u(X9, ST, 16); + E(0x91000000 | (8 << 10) | (ST << 5)); + E(0x91000000 | (16 << 10) | (ST << 5) | 1); + movw(2, 17); li(3, B->x2); li(16, (Cell)(uintptr_t)o3_invoke_jit); blr(16); + ldr_u(X9, ST, 8); E(0x8b090e74); /* sp = m + state[1] * 8 */ + ldr_u(X9, ST, 16); E(0x8b090e75); /* rp = m + state[2] * 8 */ + ldrx_u(24, ST, 88); ldrx_u(25, ST, 96); ldrx_u(TAB, ST, 24); + li(16, (Cell)(uintptr_t)&halt_at); ldr_u(X9, 16, 0); E(0xf100013f); + cz = cp; E(0x5400000b); /* b.lt resumed */ + movw(W0, X9); b_to(x_exit); cb_fix(cz, cp); + hopped = 0; + for (e = 0; e < R->ne; e++) if (R->ent[e] == B->x2) { b_to((unsigned *)R->stub[e]); hopped = 1; break; } + if (!hopped) { li(W0, B->x2); b_to(x_disp); } +} +static void rbranch(int b) { rfa[rnf] = cp; rfb[rnf++] = b; E(0x14000000); } +/* m[a] = v, checked like the jit's own stores: a word some translation covers goes through hook */ +static void rstore(int a, int v, int fp) +{ + unsigned *p1, *p2, *p3; + int j; + cmp_mw(a, 15); /* cmp xa, MW */ + p1 = cp; E(0x54000002); /* b.hs done */ + ldrx_u(15, ST, 32); + E(0x38604800 | a << 16 | 15 << 5 | 15); /* ldrb w15, [x15, wa, uxtw] */ + p2 = cp; E(0x35000000 | 15); /* cbnz w15, slow */ + if (fp) str_d_rr(v, M, a); else str_rr(v, M, a, UXTW); + p3 = cp; E(0x14000000); + cb_fix(p2, cp); + E(0xd10203ff); /* sub sp, sp, #128 */ + for (j = 0; j < 16; j += 2) E(0xa9000000 | (j / 2 * 2) << 15 | (j + 1) << 10 | 31 << 5 | j); /* stp xj, xj+1, [sp, #8j] */ + movw(15, a); if (fp) fmov_xd(1, v); else movw(1, v); movw(0, 15); + ldrx_u(16, ST, 64); blr(16); + for (j = 0; j < 16; j += 2) E(0xa9400000 | (j / 2 * 2) << 15 | (j + 1) << 10 | 31 << 5 | j); + E(0x910203ff); /* add sp, sp, #128 */ + cb_fix(p1, cp); + *p3 |= (cp - p3) & 0x3ffffff; +} +static void rpmove(Rg *R, RB *B) +{ + int dst[RMAXV], src[RMAXV], n = 0, j, k, x, s; + for (j = 1; j < R->nv; j++) if (R->fv[j] && B->vs[j] >= 0) { + s = B->vs[j]; + if (rk[s]) { li(16, rkv[s]); fmov_dx(j, 16); continue; } + if (!rfp[s]) { fmov_dx(j, rreg[s]); continue; } + if (rreg[s] == j) continue; + dst[n] = j; src[n] = rreg[s]; n++; + } + while (n) { + for (j = 0; j < n; j++) { for (k = 0; k < n && src[k] != dst[j]; k++); if (k == n) break; } + if (j < n) { fmov_dd(dst[j], src[j]); n--; dst[j] = dst[n]; src[j] = src[n]; continue; } + x = src[0]; fmov_dd(16, x); + for (k = 0; k < n; k++) if (src[k] == x) src[k] = 16; + } + n = 0; + for (j = 1; j < R->nv; j++) if (!R->fv[j] && B->vs[j] >= 0) { + s = B->vs[j]; + if (rk[s]) { li(j, rkv[s]); continue; } + if (rfp[s]) { fmov_xd(j, rreg[s]); continue; } + if (rreg[s] == j) continue; + dst[n] = j; src[n] = rreg[s]; n++; + } + while (n) { + for (j = 0; j < n; j++) { for (k = 0; k < n && src[k] != dst[j]; k++); if (k == n) break; } + if (j < n) { movw(dst[j], src[j]); n--; dst[j] = dst[n]; src[j] = src[n]; continue; } + x = src[0]; movw(16, x); + for (k = 0; k < n; k++) if (src[k] == x) src[k] = 16; + } +} +static void emit_uop(int op, int d, int a, int b, int c, int tmp); +static int remit(Rg *R, int bi) +{ + RB *B = &R->b[bi]; + int i, j, d, a, b, c; + unsigned *p; + if (ralloc(R, B)) return -1; + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + switch (u->op) { + case U_LI: case U_VGET: continue; + case U_SLD: + if (rfp[u->d] && !rk[u->d]) rswd(rreg[u->d], (int)u->imm, 0); + else rsw(rreg[u->d], (int)u->imm, 0); + continue; + case U_LD: + if (rfp[u->d] && !rk[u->d]) { + if (rk[u->a] && inmem(rkv[u->a])) { + if (rkv[u->a] < 4096) ldr_d(rreg[u->d], M, (int)rkv[u->a] * 8); + else { li(16, rkv[u->a]); ldr_d_rr(rreg[u->d], M, 16); } + } else ldr_d_rr(rreg[u->d], M, rgpr(u->a, 16)); + continue; + } + if (rk[u->a] && inmem(rkv[u->a])) { /* a fixed address */ + if (rkv[u->a] < 4096) ldr_u(rreg[u->d], M, (int)rkv[u->a] * 8); + else { li(16, rkv[u->a]); ldr_rr(rreg[u->d], M, 16, UXTW); } + continue; + } + break; + case U_ST: + a = rgpr(u->a, 16); + if (rfp[u->b] && !rk[u->b]) rstore(a, rreg[u->b], 1); + else rstore(a, rgpr(u->b, 17), 0); + continue; + case U_LD8: case U_LD16: case U_LD32: + emit_byte(u->op, rreg[u->d], rgpr(u->a, 16), 0); + continue; + case U_ST8: case U_ST16: case U_ST32: + emit_byte(u->op, 0, rgpr(u->a, 16), rgpr(u->b, 17)); + continue; + case U_FADD: case U_FSUB: case U_FMUL: case U_FDIV: { + unsigned base = u->op == U_FADD ? 0x1e602800u : u->op == U_FSUB ? 0x1e603800u : u->op == U_FMUL ? 0x1e600800u : 0x1e601800u; + int da = rdf(u->a, 16), db = rdf(u->b, 17); + E(base | (unsigned)db << 16 | (unsigned)da << 5 | (unsigned)rreg[u->d]); + continue; } + case U_FEQ: case U_FLT: case U_FLE: { + unsigned cset = u->op == U_FEQ ? 0x9a9f17e0u : u->op == U_FLT ? 0x9a9f57e0u : 0x9a9f87e0u; + int da = rdf(u->a, 16), db = rdf(u->b, 17); + E(0x1e602000u | (unsigned)db << 16 | (unsigned)da << 5); + E(cset | (unsigned)rreg[u->d]); + continue; } + case U_I2F: E(0x9e620000u | (unsigned)rgpr(u->a, 16) << 5 | (unsigned)rreg[u->d]); continue; + case U_F2I: E(0x9e780000u | (unsigned)rdf(u->a, 16) << 5 | (unsigned)rreg[u->d]); continue; + case U_F2S: E(0x1e624000u | (unsigned)rdf(u->a, 16) << 5 | 16u); E(0x1e260000u | 16u << 5 | (unsigned)rreg[u->d]); continue; /* fcvt s16, d; fmov w, s16 */ + case U_S2F: E(0x1e270000u | (unsigned)rgpr(u->a, 16) << 5 | 16u); E(0x1e22c000u | 16u << 5 | (unsigned)rreg[u->d]); continue; /* fmov s16, w; fcvt d, s16 */ + case U_ADD: case U_SUB: + if (rk[u->b] && rkv[u->b] >= 0 && rkv[u->b] < 4096) { + E((u->op == U_ADD ? 0x91000000 : 0xd1000000) | (unsigned)rkv[u->b] << 10 | ropr(u->a, 16) << 5 | rreg[u->d]); + continue; + } + break; + } + d = rreg[u->d]; + a = nargs(u->op) > 0 ? ropr(u->a, 16) : 0; + b = nargs(u->op) > 1 ? ropr(u->b, 17) : 0; + c = nargs(u->op) > 2 ? ropr(u->c, 15) : 0; + emit_uop(u->op, d, a, b, c, 15); + } + for (j = 0; j < B->nso; j++) { + int v = B->so[2 * j + 1]; + if (rfp[v] && !rk[v]) rswd(rreg[v], B->so[2 * j], 1); + else rsw(rgpr(v, 17), B->so[2 * j], 1); + } + if (B->term == T_CBR || B->term == T_JMP || B->term == T_CALL) { + if (rk[B->cv]) li(17, rkv[B->cv]); + else if (rfp[B->cv]) fmov_xd(17, rreg[B->cv]); + else movw(17, rreg[B->cv]); + } + addsp(B->delta * 8); + rpmove(R, B); + switch (B->term) { + case T_BR: rbranch(B->s1); break; + case T_CBR: + if (B->s1 >= 0) { rfa[rnf] = cp; rfb[rnf++] = B->s1; E(0xb4000000 | 17); } /* cbz x17, taken */ + else { p = cp; E(0xb5000000 | 17); rexitk(R, B->x1); cb_fix(p, cp); } + if (B->s2 >= 0) rbranch(B->s2); else rexitk(R, B->x2); + break; + case T_CALL: rcall(R, B); break; + case T_RET: rspill(R); ldr_pre(W0, RP, -8); b_to(x_disp); break; + default: { + unsigned *hs; + rspill(R); li(16, R->hi); E(0xeb10023f); /* cmp x17, x16 */ + hs = cp; E(0x54000002); /* b.hs finish: the epilogue, or past the region */ + movw(W0, 17); b_to(x_disp); + cb_fix(hs, cp); + rfinish(R); + break; } + } + return 0; +} +/* the whole region: entry stubs that load the vars, then the blocks */ +static int rjit(Rg *R, int wr) +{ + unsigned *start = cp, **lab; + int b, e, j, bad = 0; + long need = (long)(R->hi - R->lo) * 160 + (long)R->ne * 64 + 8192; + if (need > (code + CODEW) - cp) return -1; + if (wr) jitwrite(1); + lab = malloc((R->nb + 1) * sizeof *lab); + rfa = malloc((2 * R->nb + R->ne + 4) * sizeof *rfa); rfb = malloc((2 * R->nb + R->ne + 4) * sizeof *rfb); rnf = 0; + for (e = 0; e < R->ne; e++) { + unsigned *skip; + R->stub[e] = cp; + if (e == 0) { /* a direct caller left its return address in x30 and bumped jit_depth */ + li(16, (Cell)(uintptr_t)&jit_depth); + ldr_u(X9, 16, 0); + skip = cp; E(0xb4000000 | X9); /* cbz x9, plain entry */ + E(0xd100052a); /* sub x10, x9, #1 */ + li(16, (Cell)(uintptr_t)linkstk); + E(0x8b0a0e10); /* add x16, x16, x10, lsl #3 */ + str_u(30, 16, 0); + cb_fix(skip, cp); + } + rload(R); rbranch(R->entb[e]); + } + for (b = 0; b < R->nb && !bad; b++) { lab[b] = cp; bad = remit(R, b); } + if (!bad) { + for (j = 0; j < rnf; j++) { + unsigned *at = rfa[j], *to = lab[rfb[j]]; + if ((*at & 0xfc000000u) == 0x14000000u) *at |= (to - at) & 0x3ffffff; else cb_fix(at, to); + } + R->nat = start; + for (e = 0; e < R->ne; e++) tab[R->ent[e]] = R->stub[e]; + if ((unsigned)R->fn < (unsigned)code_words) { + fn_nat[R->fn].stub = R->stub[0]; + fn_nat[R->fn].fslots = R->fslots; + fn_nat[R->fn].argc = R->argc; + } + syncicache(start, cp); + if (trace) fprintf(stderr, "o3: %d..%d -> %ld bytes of arm64\n", R->lo, R->hi - 1, (long)((char *)cp - (char *)start)); + } else { + cp = start; + if (trace) fprintf(stderr, "o3: %d..%d: a block needs too many registers\n", R->lo, R->hi - 1); + } + free(lab); free(rfa); free(rfb); + if (wr) jitwrite(0); + return bad; +} +static void rcompile(Rg *R, int eager) +{ + if (R->nat || R->nonat) return; + if (rjit(R, eager) && cp - code < CODEW / 2) R->nonat = 1; /* registers, not space: give up on it */ +} + +static int inst_hook(int d) { return install(d); } +static long xrun(long sp, int slot) { return (long)xexec(&enh[slot], (Cell *)sp); } + +static void *translate(int p) +{ + unsigned *start; + int i = p, n = 0, k, t, used[64], nused = 0, j2, ju; + Cell w, x; + if (cp - code > CODEW - 65536 || !ix_room()) flush(); + if (o3ent[p]) { /* an o3 region starts here */ + Rg *R = rat(p); + if (R) { rcompile(R, 0); if (R->nat && tab[p]) return tab[p]; } + } + start = cp; + for (;;) { + if (i >= code_words) { E(0x92800000); b_to(x_exit); break; } /* movn x0, #0: halt */ + if (n++ >= BLKW) { li(W0, i); b_to(x_disp); break; } + w = m[i]; + if (w & 1 && i + 1 < code_words && !(m[i + 1] & 1) && (k = (int)(m[i + 1] / 2)) >= 6 && k <= 8) { + t = (int)((w - 1) / 2); /* literal + call/jmp/jz with a known target */ + if (k == 8) { + unsigned *a; + ldr_post(X10, SP, 8); + a = cp; E(0xb500000a); /* cbnz x10, fallthrough */ + li(W0, t); b_to(x_disp); + cb_fix(a, cp); + i += 2; + continue; + } + li(X10, i + 2); + if (k == 6) str_post(X10, RP, 8); else str_u(X10, RP, 0); + li(W0, t); b_to(x_disp); + i += 2; + break; + } + if (w & 1) { + int L = 0, s, nk, j; + Cell ks[8]; + Enh te; + while (L < 8 && i + L < code_words && (m[i + L] & 1)) L++; + x = i + L < code_words ? m[i + L] : 1; + if (!(x & 1) && (s = (int)(x / 2) - XOP0) >= 0 && s < NENH && enh[s].live && enh[s].nin) { + nk = L < enh[s].nin ? L : enh[s].nin; + for (j = 0; j < nk; j++) ks[j] = m[i + L - nk + j] >> 1; + if (!spec_enh(s, ks, nk, &te)) { + for (j = 0; j < L - nk; j++) { li(X9, m[i + j] >> 1); str_pre(X9, SP, -8); } + if (nused < 64) used[nused++] = s; else used[0] = -1; + emit_enh_e(&te, s); + free(te.u); free(te.reg); + i += L + 1; n += L; + continue; + } + } + li(X9, (w - 1) / 2); str_pre(X9, SP, -8); i++; continue; + } + k = (int)(w / 2); + if (k == 0) { E(0x92800000); b_to(x_exit); i++; break; } + if (k < 0 || k == 6 || k == 7) { + ldr_post(W0, SP, 8); + li(X10, i + 1); + if (k == 6) str_post(X10, RP, 8); else str_u(X10, RP, 0); + if (k < 0) { li(X11, 7 - k); addx_ext(RP, RP, X11, SXTW, 3); } + b_to(x_disp); + i++; + break; + } + if (k == 8) { /* jz: taken leaves, not taken keeps going */ + ldp_post(X9, X10, SP, 16); + E(0xb500006a); /* cbnz x10, +3 */ + movw(W0, X9); + b_to(x_disp); + i++; + continue; + } + if (k == 9) { ldr_pre(W0, RP, -8); b_to(x_disp); i++; break; } + if (k == 21) { /* install: call into c, then return to it so it can flush */ + ldr_u(W0, SP, 0); ldrx_u(X11, ST, 72); blr(X11); + E(0x93407c00); /* sxtw x0, w0: Wn writes zero the high half, so -4 would look positive */ + str_u(W0, SP, 0); + li(W0, i + 1); b_to(x_exit); i++; break; + } + if (k == 600) { /* flit: the next word is raw IEEE bits, even when bit 0 is set */ + if (i + 1 >= code_words) { E(0x92800000); b_to(x_exit); i++; break; } + li(X9, m[i + 1]); + str_pre(X9, SP, -8); + i += 2; + continue; + } + if ((k >= 601 && k <= 611) || k == 618) { fjit(k); i++; continue; } + if (k >= 612 && k <= 617) { bjit(k); i++; continue; } + if (k == 619) { /* push the data-stack index: the word s points at */ + op3(0xcb000000, X9, SP, M); /* sub x9, x20, x19 */ + E(0xd343fd29); /* lsr x9, x9, #3 */ + str_pre(X9, SP, -8); + i++; + continue; + } + if (k == 620) { /* a native call: the helper pops the arguments and pushes the result */ + movw(0, SP); movw(1, RP); + li(X11, (Cell)(uintptr_t)ncall_host); blr(X11); + movw(SP, 0); + i++; + continue; + } + if (k >= XOP0 && k < XOP0 + NENH && enh[k - XOP0].live) { if (nused < 64) used[nused++] = k - XOP0; else used[0] = -1; emit_enh(k - XOP0); i++; continue; } + if (k >= XOP0 && k < XOP0 + NENH) { if (nused < 64) used[nused++] = k - XOP0; else used[0] = -1; } /* unwired now, but an install makes this a different block */ + if (k > 20) { E(0x92800000); b_to(x_exit); i++; break; } /* not wired: halt */ + op(i, k); + i++; + } + j2 = ix_add(p, i); + cinc(cov, p, i); + if (nused && used[0] < 0) dep_add(NENH, j2); + else for (ju = 0; ju < nused; ju++) dep_add(used[ju], j2); + tab[p] = start; + syncicache(start, cp); + if (trace) fprintf(stderr, "jit: %d..%d -> %ld bytes\n", p, i - 1, (long)((char *)cp - (char *)start)); + return start; +} +static int o3_ready(Rg *C) +{ + if (!C || C->dead) return 0; + if (!C->lifted && rlift(C)) { C->dead = 1; return 0; } + if (!C->lifted || C->dead) return 0; + rcompile(C, 1); + return C->nat != 0; +} +static int vm_until(int pc, int stop_eq, int stop_ge, Rg *re, Cell *ps, Cell *pr) +{ + union { unsigned *u; int (*f)(long *, void *); } enter; + void *saved_eq = 0, *saved_ent[RMAXE]; + int i, nent = 0, flushed = 0, ep0 = drop_epoch; + Cell return_depth = *pr - (stack_control ? stack_get(SC_RETURN_LOW) : RS0) - 1; + Cell saved_depth = jit_depth, *saved_links = 0; + if (saved_depth) { + saved_links = malloc((size_t)saved_depth * sizeof *saved_links); + if (!saved_links) return PC_FRAME_OVERFLOW; + memcpy(saved_links, linkstk, (size_t)saved_depth * sizeof *saved_links); + } + jit_depth = 0; + enter.u = x_enter; + if (stop_eq >= 0 && stop_eq < code_words) { saved_eq = tab[stop_eq]; tab[stop_eq] = 0; } + if (re) { + nent = re->ne; if (nent > RMAXE) nent = RMAXE; + for (i = 0; i < nent; i++) { saved_ent[i] = tab[re->ent[i]]; tab[re->ent[i]] = 0; } + } + S[1] = *ps; S[2] = *pr; + while ((unsigned)pc < (unsigned)code_words || pc == PC_DATA_OVERFLOW || pc == PC_RETURN_OVERFLOW) { + void *c; + if (pc == PC_DATA_OVERFLOW || pc == PC_RETURN_OVERFLOW) { + Cell sp = S[1], rp = S[2]; int ret = pc == PC_RETURN_OVERFLOW; + if (!stack_control || stack_expand(ret, stack_get(ret ? SC_RETURN_TOP : SC_DATA_TOP) - stack_get(ret ? SC_RETURN_LOW : SC_DATA_LOW) + 1, &sp, &rp) < 0) break; + S[1] = sp; S[2] = rp; S[11] = (long)(m + stack_data_limit()); S[12] = (long)(m + stack_return_limit()); + pc = (int)S[13]; continue; + } + if (stop_eq >= 0 && pc == stop_eq && S[2] - (stack_control ? stack_get(SC_RETURN_LOW) : RS0) == return_depth) break; + if (stop_ge >= 0 && pc >= stop_ge) break; + if (re && pc >= re->lo && pc < re->hi && o3ent[pc] == re->idx + 1) break; + c = tab[pc]; + if (!c) { + jitwrite(1); c = translate(pc); jitwrite(0); + if (stop_eq >= 0 && stop_eq < code_words) tab[stop_eq] = 0; + if (re) for (i = 0; i < nent; i++) tab[re->ent[i]] = 0; + } + if (!c) break; + pc = enter.f(S, c); + if (need_flush) { need_flush = 0; jitwrite(1); flush(); jitwrite(0); } + } + *ps = S[1]; *pr = S[2]; + jit_depth = saved_depth; + if (saved_links) { memcpy(linkstk, saved_links, (size_t)saved_depth * sizeof *saved_links); free(saved_links); } + flushed = drop_epoch != ep0; + if (!flushed) { + if (stop_eq >= 0 && stop_eq < code_words) tab[stop_eq] = saved_eq; + if (re) for (i = 0; i < nent; i++) tab[re->ent[i]] = saved_ent[i]; + } + return pc; +} +static int o3_exec_region(Rg *C, int entry, Cell *ps, Cell *pr) +{ + union { unsigned *u; int (*f)(long *, void *); } enter; + void *codep; + int back; + Cell saved_depth, *saved_links = 0; + if (!C || C->dead || entry < 0 || entry >= C->ne) return -1; + if (!C->lifted && rlift(C)) { C->dead = 1; return -1; } + rcompile(C, 1); + codep = C->nat ? C->stub[entry] : 0; + if (!codep) return -1; + enter.u = x_enter; + S[1] = *ps; S[2] = *pr; + saved_depth = jit_depth; + if (saved_depth) { + saved_links = malloc((size_t)saved_depth * sizeof *saved_links); + if (!saved_links) return PC_FRAME_OVERFLOW; + memcpy(saved_links, linkstk, (size_t)saved_depth * sizeof *saved_links); + } + jit_depth = 0; + back = enter.f(S, codep); + jit_depth = saved_depth; + if (saved_links) { memcpy(linkstk, saved_links, (size_t)saved_depth * sizeof *saved_links); free(saved_links); } + *ps = S[1]; *pr = S[2]; + return back; +} + +#else +/* portable path for hosts without the arm64 jit: a plain interpreter with + the same semantics (shift counts wrap at 64, stores outside memory are + ignored, loads outside memory read 0, leaving memory halts). */ +#ifdef ZYLLVM +/* ---- llvm backend ---- + a tiered jit for hosts the arm64 backend doesn't cover. the interpreter + counts how often each block start is reached; a hot block is translated to + llvm ir (same block rules as the arm64 jit: it ends at call, jump, ret or + halt, and keeps going past a jz), optimized at O2 and compiled with orc. + enhancements are inlined as ir. stores into compiled words drop the blocks + that cover them, so self-modifying code still works. */ +#include +#include +#include +#include +#include +#include +#include +#include +static int HOT = 5000; /* runs before a block gets compiled: ZYHOT */ +static const char *lpasses = "default"; /* ZYPASSES */ +#define LMAXB 65536 +typedef Cell (*Blk)(Cell *mem, Cell *regs); +static Blk *lt; /* address -> compiled block */ +static unsigned short *hot; +static unsigned char *lcov; /* how many compiled blocks cover the word (255 sticks) */ +static void *lrt[MAXB]; /* each block's resource tracker: removing it frees the block's code */ +static int llvm_ok, nblocks; +static LLVMOrcLLJITRef jit; +static LLVMTargetMachineRef tm_; /* the host cpu, so the pass pipeline's cost models know the target */ +static LLVMOrcThreadSafeContextRef tsc; +static LLVMContextRef ctx; +static LLVMTypeRef i8t, i32t, i64t, ptrt, i1t, f64t; +static LLVMBuilderRef bd; +static LLVMValueRef rvv[RMAXV]; +static LLVMValueRef fn_, vm_, vregs, vs, vr; /* function, memory, regs, s and r slots */ +static LLVMTypeRef l_dret; /* what a register-passing function returns: the next address and s */ +static int l_dm; /* the function being built is the register-passing one */ +static Cell d_r; /* r, left here by a register-passing function that exits abnormally */ +static LLVMModuleRef mod_; + +static unsigned char *rcov; /* how many lifted o3 regions cover the word */ +static int rdrop(int a); +/* code that is dropped is freed when no compiled code is running: a block can + drop itself (it stores into its own words), and a callback can nest */ +static int ccode; +static LLVMOrcResourceTrackerRef pend_rt[1024]; +static int npend_rt; +static void rt_sweep(void) +{ + LLVMErrorRef err; + if (ccode) return; + while (npend_rt > 0) { + LLVMOrcResourceTrackerRef rt = pend_rt[--npend_rt]; + if ((err = LLVMOrcResourceTrackerRemove(rt))) LLVMConsumeError(err); + LLVMOrcReleaseResourceTracker(rt); + } +} +static void rt_queue(void *rt) +{ + if (!rt) return; + if (npend_rt >= 1024) { rt_sweep(); if (npend_rt >= 1024) { LLVMOrcReleaseResourceTracker((LLVMOrcResourceTrackerRef)rt); return; } } + pend_rt[npend_rt++] = (LLVMOrcResourceTrackerRef)rt; +} +static void be_drop(int j) +{ + int a = ix_blk[j].a; + lt[a] = 0; hot[a] = 0; + cdec(lcov, a, ix_blk[j].b); + rt_queue(lrt[j]); lrt[j] = 0; + if (trace) fprintf(stderr, "llvm: dropped %d..%d\n", a, ix_blk[j].b - 1); +} +static void ldrop_all(void) +{ + int j; + rdrop_all(); + for (j = 0; j < ix_n; j++) if (ix_blk[j].a >= 0) { rt_queue(lrt[j]); lrt[j] = 0; } + memset(rcov, 0, (size_t)code_words); + memset(lt, 0, (size_t)code_words * sizeof *lt); memset(lcov, 0, (size_t)code_words); memset(hot, 0, (size_t)code_words * sizeof *hot); ix_reset(); + if (trace) fprintf(stderr, "llvm: dropped every block\n"); +} +/* a store to a word some block covers: write it, drop those blocks */ +static int lhook(Cell a, Cell v) +{ + int hit; + if (m[a] == v) return 0; + m[a] = v; + hit = ix_drop_at((int)a); + if (rcov[a] && rdrop((int)a)) hit = 1; + if (hit) drop_epoch++; + return hit; +} +static Cell linstall(Cell d) { return install((int)d); } + +static LLVMValueRef K32(int v) { return LLVMConstInt(i32t, (unsigned)v, 0); } +static LLVMValueRef Kw(Cell v) { return LLVMConstInt(i64t, (unsigned long long)v, 0); } +static LLVMValueRef cptr(void *p) { return LLVMConstIntToPtr(LLVMConstInt(i64t, (unsigned long long)(size_t)p, 0), ptrt); } +static LLVMValueRef mslot(LLVMValueRef idx) { return LLVMBuildInBoundsGEP2(bd, i64t, vm_, &idx, 1, ""); } +static LLVMValueRef ld(LLVMValueRef idx) { return LLVMBuildLoad2(bd, i64t, mslot(idx), ""); } +static void st(LLVMValueRef idx, LLVMValueRef v) { LLVMBuildStore(bd, v, mslot(idx)); } +static LLVMValueRef stack_ir(void) { return LLVMBuildLoad2(bd, i64t, vs, ""); } +static void set_stack_ir(LLVMValueRef v) { LLVMBuildStore(bd, v, vs); } +static LLVMValueRef add(LLVMValueRef a, int k) { return LLVMBuildAdd(bd, a, Kw(k), ""); } +/* a load that reads 0 outside memory */ +static LLVMValueRef safeld(LLVMValueRef a) +{ + LLVMValueRef in = LLVMBuildICmp(bd, LLVMIntULT, a, Kw(MW), ""); + LLVMValueRef v = ld(LLVMBuildSelect(bd, in, a, Kw(0), "")); + return LLVMBuildSelect(bd, in, v, Kw(0), ""); +} +static void push(LLVMValueRef v) { LLVMValueRef s = add(stack_ir(), -1); set_stack_ir(s); st(s, v); } +/* leave the block: write s and r back, return the next vm address */ +static void leave(LLVMValueRef next) +{ + LLVMValueRef r0 = Kw(0), r1 = Kw(1); + if (l_dm) { + LLVMValueRef agg; + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, vr, ""), cptr(&d_r)); + agg = LLVMBuildInsertValue(bd, LLVMGetUndef(l_dret), next, 0, ""); + agg = LLVMBuildInsertValue(bd, agg, stack_ir(), 1, ""); + LLVMBuildRet(bd, agg); + return; + } + LLVMBuildStore(bd, stack_ir(), LLVMBuildGEP2(bd, i64t, vregs, &r0, 1, "")); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, vr, ""), LLVMBuildGEP2(bd, i64t, vregs, &r1, 1, "")); + LLVMBuildRet(bd, next); +} +/* a function region returns for good: its frame is dead, so its variables are not written back */ +static void leave_ok(LLVMValueRef next) +{ + if (l_dm) { + LLVMValueRef agg = LLVMBuildInsertValue(bd, LLVMGetUndef(l_dret), next, 0, ""); + agg = LLVMBuildInsertValue(bd, agg, stack_ir(), 1, ""); + LLVMBuildRet(bd, agg); + return; + } + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, rvv[0], ""), mslot(Kw(ZFP))); + leave(next); +} +static LLVMBasicBlockRef newbb(void) { return LLVMAppendBasicBlockInContext(ctx, fn_, ""); } +static LLVMValueRef callp(void *f, LLVMTypeRef ret, LLVMTypeRef *at, int n, LLVMValueRef *args) +{ + LLVMTypeRef ft = LLVMFunctionType(ret, at, (unsigned)n, 0); + return LLVMBuildCall2(bd, ft, cptr(f), args, (unsigned)n, ""); +} +/* one micro-op as ir: the same semantics as ev() */ +static LLVMValueRef ir_op(int op, LLVMValueRef a, LLVMValueRef b, LLVMValueRef c) +{ + LLVMValueRef z = Kw(0), q, d, t, c1, c2, r = 0; + LLVMTypeRef i128 = LLVMIntTypeInContext(ctx, 128); + switch (op) { + case U_ADD: r = LLVMBuildAdd(bd, a, b, ""); break; + case U_SUB: r = LLVMBuildSub(bd, a, b, ""); break; + case U_MUL: r = LLVMBuildMul(bd, a, b, ""); break; + case U_SDIV: case U_SREM: /* /0 and INT64_MIN/-1 are defined, like the cpu */ + c1 = LLVMBuildICmp(bd, LLVMIntEQ, b, z, ""); + c2 = LLVMBuildAnd(bd, LLVMBuildICmp(bd, LLVMIntEQ, a, Kw(INT64_MIN), ""), LLVMBuildICmp(bd, LLVMIntEQ, b, Kw(-1), ""), ""); + d = LLVMBuildSelect(bd, LLVMBuildOr(bd, c1, c2, ""), Kw(1), b, ""); + if (op == U_SDIV) { q = LLVMBuildSDiv(bd, a, d, ""); r = LLVMBuildSelect(bd, c1, z, q, ""); } + else { q = LLVMBuildSRem(bd, a, d, ""); r = LLVMBuildSelect(bd, c1, a, LLVMBuildSelect(bd, c2, z, q, ""), ""); } + break; + case U_UDIV: case U_UREM: + c1 = LLVMBuildICmp(bd, LLVMIntEQ, b, z, ""); + d = LLVMBuildSelect(bd, c1, Kw(1), b, ""); + if (op == U_UDIV) r = LLVMBuildSelect(bd, c1, z, LLVMBuildUDiv(bd, a, d, ""), ""); + else r = LLVMBuildSelect(bd, c1, a, LLVMBuildURem(bd, a, d, ""), ""); + break; + case U_AND: r = LLVMBuildAnd(bd, a, b, ""); break; + case U_OR: r = LLVMBuildOr(bd, a, b, ""); break; + case U_XOR: r = LLVMBuildXor(bd, a, b, ""); break; + case U_SHL: r = LLVMBuildShl(bd, a, LLVMBuildAnd(bd, b, Kw(63), ""), ""); break; + case U_SHR: r = LLVMBuildLShr(bd, a, LLVMBuildAnd(bd, b, Kw(63), ""), ""); break; + case U_SAR: r = LLVMBuildAShr(bd, a, LLVMBuildAnd(bd, b, Kw(63), ""), ""); break; + case U_NEG: r = LLVMBuildSub(bd, z, a, ""); break; + case U_NOT: r = LLVMBuildNot(bd, a, ""); break; + case U_LT: r = LLVMBuildZExt(bd, LLVMBuildICmp(bd, LLVMIntSLT, a, b, ""), i64t, ""); break; + case U_LTU: r = LLVMBuildZExt(bd, LLVMBuildICmp(bd, LLVMIntULT, a, b, ""), i64t, ""); break; + case U_EQ: r = LLVMBuildZExt(bd, LLVMBuildICmp(bd, LLVMIntEQ, a, b, ""), i64t, ""); break; + case U_NE: r = LLVMBuildZExt(bd, LLVMBuildICmp(bd, LLVMIntNE, a, b, ""), i64t, ""); break; + case U_MIN: r = LLVMBuildSelect(bd, LLVMBuildICmp(bd, LLVMIntSLT, a, b, ""), a, b, ""); break; + case U_MAX: r = LLVMBuildSelect(bd, LLVMBuildICmp(bd, LLVMIntSGT, a, b, ""), a, b, ""); break; + case U_MINU: r = LLVMBuildSelect(bd, LLVMBuildICmp(bd, LLVMIntULT, a, b, ""), a, b, ""); break; + case U_MAXU: r = LLVMBuildSelect(bd, LLVMBuildICmp(bd, LLVMIntUGT, a, b, ""), a, b, ""); break; + case U_MULHS: case U_MULHU: { + LLVMValueRef x = op == U_MULHS ? LLVMBuildSExt(bd, a, i128, "") : LLVMBuildZExt(bd, a, i128, ""); + LLVMValueRef y = op == U_MULHS ? LLVMBuildSExt(bd, b, i128, "") : LLVMBuildZExt(bd, b, i128, ""); + r = LLVMBuildTrunc(bd, LLVMBuildLShr(bd, LLVMBuildMul(bd, x, y, ""), LLVMConstInt(i128, 64, 0), ""), i64t, ""); + break; } + case U_CLZ: { + unsigned id = LLVMLookupIntrinsicID("llvm.ctlz", 9); + LLVMValueRef f = LLVMGetIntrinsicDeclaration(mod_, id, &i64t, 1), args[2]; + args[0] = a; args[1] = LLVMConstInt(i1t, 0, 0); + r = LLVMBuildCall2(bd, LLVMIntrinsicGetType(ctx, id, &i64t, 1), f, args, 2, ""); + break; } + case U_CTZ: case U_POPCNT: case U_BSWAP: { + const char *nm = op == U_CTZ ? "llvm.cttz" : op == U_POPCNT ? "llvm.ctpop" : "llvm.bswap"; + unsigned id = LLVMLookupIntrinsicID(nm, strlen(nm)); + LLVMValueRef f = LLVMGetIntrinsicDeclaration(mod_, id, &i64t, 1), args[2]; + args[0] = a; args[1] = LLVMConstInt(i1t, 0, 0); + r = LLVMBuildCall2(bd, LLVMIntrinsicGetType(ctx, id, &i64t, 1), f, args, op == U_CTZ ? 2 : 1, ""); + break; } + case U_ROTL: case U_ROTR: { + const char *nm = op == U_ROTL ? "llvm.fshl" : "llvm.fshr"; + unsigned id = LLVMLookupIntrinsicID(nm, strlen(nm)); + LLVMValueRef f = LLVMGetIntrinsicDeclaration(mod_, id, &i64t, 1), args[3]; + args[0] = a; args[1] = a; args[2] = LLVMBuildAnd(bd, b, Kw(63), ""); + r = LLVMBuildCall2(bd, LLVMIntrinsicGetType(ctx, id, &i64t, 1), f, args, 3, ""); + break; } + case U_F2S: { + LLVMTypeRef f32t = LLVMFloatTypeInContext(ctx), i32t = LLVMInt32TypeInContext(ctx); + LLVMValueRef s = LLVMBuildFPTrunc(bd, LLVMBuildBitCast(bd, a, f64t, ""), f32t, ""); + r = LLVMBuildZExt(bd, LLVMBuildBitCast(bd, s, i32t, ""), i64t, ""); + break; } + case U_S2F: { + LLVMTypeRef f32t = LLVMFloatTypeInContext(ctx), i32t = LLVMInt32TypeInContext(ctx); + LLVMValueRef s = LLVMBuildBitCast(bd, LLVMBuildTrunc(bd, a, i32t, ""), f32t, ""); + r = LLVMBuildBitCast(bd, LLVMBuildFPExt(bd, s, f64t, ""), i64t, ""); + break; } + case U_ABS: t = LLVMBuildICmp(bd, LLVMIntSLT, a, z, ""); r = LLVMBuildSelect(bd, t, LLVMBuildSub(bd, z, a, ""), a, ""); break; + case U_SEL: r = LLVMBuildSelect(bd, LLVMBuildICmp(bd, LLVMIntNE, a, z, ""), b, c, ""); break; + case U_FADD: case U_FSUB: case U_FMUL: case U_FDIV: case U_FEQ: case U_FLT: case U_FLE: case U_I2F: case U_F2I: { + LLVMValueRef da = LLVMBuildBitCast(bd, a, f64t, ""), db = b ? LLVMBuildBitCast(bd, b, f64t, "") : 0, dv = 0; + if (op == U_FADD) dv = LLVMBuildFAdd(bd, da, db, ""); + else if (op == U_FSUB) dv = LLVMBuildFSub(bd, da, db, ""); + else if (op == U_FMUL) dv = LLVMBuildFMul(bd, da, db, ""); + else if (op == U_FDIV) dv = LLVMBuildFDiv(bd, da, db, ""); + else if (op == U_FEQ) dv = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOEQ, da, db, ""), i64t, ""); + else if (op == U_FLT) dv = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOLT, da, db, ""), i64t, ""); + else if (op == U_FLE) dv = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOLE, da, db, ""), i64t, ""); + else if (op == U_I2F) dv = LLVMBuildSIToFP(bd, a, f64t, ""); + else dv = LLVMBuildFPToSI(bd, da, i64t, ""); + if (op == U_FADD || op == U_FSUB || op == U_FMUL || op == U_FDIV || op == U_I2F) dv = LLVMBuildBitCast(bd, dv, i64t, ""); + r = dv; + break; } + } + return r; +} +/* byte address into the flat image. an out-of-range load is 0. a store that + misses the image does nothing, and one that touches translated code goes + through the same helper as a word store so the translation is dropped. */ +static LLVMValueRef bload_ir(LLVMValueRef addr, int n) +{ + LLVMTypeRef ty = LLVMIntTypeInContext(ctx, (unsigned)n * 8); + LLVMValueRef lim = Kw(((Cell)MW << 3) - (n - 1)); + LLVMValueRef in = LLVMBuildICmp(bd, LLVMIntULT, addr, lim, ""); + LLVMValueRef safe = LLVMBuildSelect(bd, in, addr, Kw(0), ""); + LLVMValueRef p = LLVMBuildGEP2(bd, i8t, vm_, &safe, 1, ""); + LLVMValueRef ldv = LLVMBuildLoad2(bd, ty, p, ""); + LLVMValueRef z; + LLVMSetAlignment(ldv, 1); + z = LLVMBuildZExt(bd, ldv, i64t, ""); + return LLVMBuildSelect(bd, in, z, Kw(0), ""); +} +static void bstore_ir(LLVMValueRef addr, LLVMValueRef val, int n) +{ + LLVMTypeRef ty = LLVMIntTypeInContext(ctx, (unsigned)n * 8); + LLVMBasicBlockRef inb, callb, inl, out; + LLVMValueRef lim, word, endw, c1, c2, covered, p, stv, args[2]; + LLVMTypeRef at[2]; + void *fn = n == 1 ? (void *)bst8 : n == 2 ? (void *)bst16 : (void *)bst32; + lim = Kw(((Cell)MW << 3) - (n - 1)); + inb = newbb(); callb = newbb(); inl = newbb(); out = newbb(); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntULT, addr, lim, ""), inb, out); + LLVMPositionBuilderAtEnd(bd, inb); + word = LLVMBuildLShr(bd, addr, Kw(3), ""); + endw = LLVMBuildLShr(bd, LLVMBuildAdd(bd, addr, Kw(n - 1), ""), Kw(3), ""); + c1 = LLVMBuildLoad2(bd, i8t, LLVMBuildGEP2(bd, i8t, cptr(lcov), &word, 1, ""), ""); + c2 = LLVMBuildLoad2(bd, i8t, LLVMBuildGEP2(bd, i8t, cptr(lcov), &endw, 1, ""), ""); + covered = LLVMBuildOr(bd, LLVMBuildICmp(bd, LLVMIntNE, c1, LLVMConstInt(i8t, 0, 0), ""), + LLVMBuildICmp(bd, LLVMIntNE, c2, LLVMConstInt(i8t, 0, 0), ""), ""); + LLVMBuildCondBr(bd, covered, callb, inl); + LLVMPositionBuilderAtEnd(bd, callb); + at[0] = i64t; at[1] = i64t; args[0] = addr; args[1] = val; + callp(fn, LLVMVoidTypeInContext(ctx), at, 2, args); + LLVMBuildBr(bd, out); + LLVMPositionBuilderAtEnd(bd, inl); + p = LLVMBuildGEP2(bd, i8t, vm_, &addr, 1, ""); + stv = LLVMBuildStore(bd, LLVMBuildTrunc(bd, val, ty, ""), p); + LLVMSetAlignment(stv, 1); + LLVMBuildBr(bd, out); + LLVMPositionBuilderAtEnd(bd, out); +} +/* an enhancement as ir */ +static void ir_enh(Enh *e) +{ + LLVMValueRef *v = calloc(e->nv + 1, sizeof *v), s = stack_ir(); + int i, j; + for (j = 0; j < e->nin; j++) v[j] = ld(add(s, e->nin - 1 - j)); + for (i = 0; i < e->n; i++) { + Uop *u = &e->u[i]; + LLVMValueRef a = u->op == U_LI ? 0 : v[u->a], b = uarity[u->op] > 1 || is_store(u->op) ? v[u->b] : 0, c = uarity[u->op] > 2 ? v[u->c] : 0, r = 0; + switch (u->op) { + case U_LI: r = Kw(u->imm); break; + case U_LD: r = safeld(a); break; + case U_ST: { + LLVMBasicBlockRef yes = newbb(), done = newbb(); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntULT, a, Kw(MW), ""), yes, done); + LLVMPositionBuilderAtEnd(bd, yes); st(a, b); LLVMBuildBr(bd, done); + LLVMPositionBuilderAtEnd(bd, done); + break; } + case U_LD8: case U_LD16: case U_LD32: r = bload_ir(a, bwidth(u->op)); break; + case U_ST8: case U_ST16: case U_ST32: bstore_ir(a, b, bwidth(u->op)); break; + default: r = ir_op(u->op, a, b, c); + } + if (!is_store(u->op)) v[u->d] = r; + } + s = add(s, e->nin - e->nout); set_stack_ir(s); + for (j = 0; j < e->nout; j++) st(add(s, e->nout - 1 - j), v[e->out[j]]); + free(v); +} +static void llvm_init(void) +{ + LLVMErrorRef err; + if (llvm_ok) return; /* a nested run() must keep the jit it already built */ + if (getenv("ZYHOT")) HOT = atoi(getenv("ZYHOT")); + if (HOT < 1) HOT = 1; + if (HOT > 65000) HOT = 65000; + if (getenv("ZYPASSES")) lpasses = getenv("ZYPASSES"); + LLVMInitializeNativeTarget(); LLVMInitializeNativeAsmPrinter(); + if ((err = LLVMOrcCreateLLJIT(&jit, 0))) { char *msg = LLVMGetErrorMessage(err); fprintf(stderr, "llvm: %s\n", msg); LLVMDisposeErrorMessage(msg); return; } +#if LLVM_VERSION_MAJOR >= 23 + ctx = LLVMContextCreate(); + tsc = LLVMOrcCreateNewThreadSafeContextFromLLVMContext(ctx); +#else + tsc = LLVMOrcCreateNewThreadSafeContext(); + ctx = LLVMOrcThreadSafeContextGetContext(tsc); +#endif + { /* a target machine for the same host the jit generates for: llvm's vectorizer, + unroller and inliner price instructions from it, and the passes run before + the module reaches the jit, so without one they would price for nothing */ + LLVMTargetRef tg; char *e = 0, *cpu = LLVMGetHostCPUName(), *feat = LLVMGetHostCPUFeatures(); + const char *tr = LLVMOrcLLJITGetTripleString(jit); + if (!LLVMGetTargetFromTriple(tr, &tg, &e)) + tm_ = LLVMCreateTargetMachine(tg, tr, cpu, feat, LLVMCodeGenLevelAggressive, LLVMRelocDefault, LLVMCodeModelJITDefault); + else LLVMDisposeMessage(e); + LLVMDisposeMessage(cpu); LLVMDisposeMessage(feat); + } + i1t = LLVMInt1TypeInContext(ctx); i8t = LLVMInt8TypeInContext(ctx); i32t = LLVMInt32TypeInContext(ctx); + i64t = LLVMInt64TypeInContext(ctx); f64t = LLVMDoubleTypeInContext(ctx); ptrt = LLVMPointerTypeInContext(ctx, 0); + bd = LLVMCreateBuilderInContext(ctx); + llvm_ok = 1; +} +/* a new module for the jit's triple and data layout, and a function with what is + known about its two pointers: the vm memory is MW aligned words, the register + pair is two. no noalias: the host helpers it calls read and write that memory. */ +static void lfunc_attrs(LLVMValueRef f) +{ + static unsigned kn, ka, kd, knu; + LLVMValueRef p0 = LLVMGetParam(f, 0); + (void)p0; + if (!kn) { + kn = LLVMGetEnumAttributeKindForName("nonnull", 7); + ka = LLVMGetEnumAttributeKindForName("align", 5); + kd = LLVMGetEnumAttributeKindForName("dereferenceable", 15); + knu = LLVMGetEnumAttributeKindForName("nounwind", 8); + } + LLVMAddAttributeAtIndex(f, 1, LLVMCreateEnumAttribute(ctx, kn, 0)); + LLVMAddAttributeAtIndex(f, 1, LLVMCreateEnumAttribute(ctx, ka, 8)); + LLVMAddAttributeAtIndex(f, 1, LLVMCreateEnumAttribute(ctx, kd, (unsigned long long)MW * 8)); + LLVMAddAttributeAtIndex(f, 2, LLVMCreateEnumAttribute(ctx, kn, 0)); + LLVMAddAttributeAtIndex(f, 2, LLVMCreateEnumAttribute(ctx, ka, 8)); + LLVMAddAttributeAtIndex(f, 2, LLVMCreateEnumAttribute(ctx, kd, 16)); + LLVMAddAttributeAtIndex(f, (LLVMAttributeIndex)-1, LLVMCreateEnumAttribute(ctx, knu, 0)); +} +static void lmodule_target(void) +{ + LLVMSetTarget(mod_, LLVMOrcLLJITGetTripleString(jit)); + LLVMSetDataLayout(mod_, LLVMOrcLLJITGetDataLayoutStr(jit)); +} +static void lrun_passes(const char *pipeline) +{ + LLVMErrorRef err; + LLVMPassBuilderOptionsRef po = LLVMCreatePassBuilderOptions(); + if ((err = LLVMRunPasses(mod_, pipeline, tm_, po))) LLVMConsumeError(err); + LLVMDisposePassBuilderOptions(po); +} +/* compile the block at p; 0 if it couldn't be */ +static Blk lcompile(int p) +{ + char name[32]; LLVMTypeRef pt[2], ft; LLVMValueRef s, a, b, v, r, args[2]; LLVMTypeRef at[2]; + LLVMOrcExecutorAddress addr; LLVMErrorRef err; LLVMPassBuilderOptionsRef po; + int i = p, n = 0, k, t, done = 0, used[64], nused = 0, jb, ju; Cell w; + LLVMOrcResourceTrackerRef rt; + if (!llvm_ok) return 0; + if (!ix_room()) ldrop_all(); + sprintf(name, "b%d_%d", p, nblocks++); + mod_ = LLVMModuleCreateWithNameInContext(name, ctx); + lmodule_target(); + pt[0] = ptrt; pt[1] = ptrt; + ft = LLVMFunctionType(i64t, pt, 2, 0); + fn_ = LLVMAddFunction(mod_, name, ft); + lfunc_attrs(fn_); + vm_ = LLVMGetParam(fn_, 0); vregs = LLVMGetParam(fn_, 1); + LLVMPositionBuilderAtEnd(bd, newbb()); + vs = LLVMBuildAlloca(bd, i64t, "s"); vr = LLVMBuildAlloca(bd, i64t, "r"); + { LLVMValueRef r0 = Kw(0), r1 = Kw(1); + set_stack_ir(LLVMBuildLoad2(bd, i64t, LLVMBuildGEP2(bd, i64t, vregs, &r0, 1, ""), "")); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, LLVMBuildGEP2(bd, i64t, vregs, &r1, 1, ""), ""), vr); } + while (!done) { + if (i >= code_words) { leave(Kw(PC_HALT)); break; } + if (n++ >= 1024) { leave(Kw(i)); break; } + w = m[i]; + if (w & 1) { + /* a literal followed by call, jump or jz: a known target */ + if (i + 1 < code_words && !(m[i + 1] & 1) && (k = (int)(m[i + 1] / 2)) >= 6 && k <= 8) { + t = (int)(w >> 1); + if (k == 8) { + LLVMBasicBlockRef tk = newbb(), go = newbb(); + s = stack_ir(); a = ld(s); set_stack_ir(add(s, 1)); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntEQ, a, Kw(0), ""), tk, go); + LLVMPositionBuilderAtEnd(bd, tk); leave(Kw(t)); + LLVMPositionBuilderAtEnd(bd, go); + i += 2; continue; + } + if (k == 6) { r = LLVMBuildLoad2(bd, i64t, vr, ""); st(r, Kw(i + 2)); LLVMBuildStore(bd, add(r, 1), vr); } + leave(Kw(t)); i += 2; break; + } + push(Kw(w >> 1)); i++; continue; + } + k = (int)(w / 2); + s = stack_ir(); + switch (k) { + case 0: leave(Kw(PC_HALT)); done = 1; break; + case 1: st(s, safeld(ld(s))); break; + case 2: { + LLVMBasicBlockRef rng = newbb(), in = newbb(), cv = newbb(), plain = newbb(), out = newbb(), quit = newbb(), gate = newbb(); + LLVMTypeRef gt[4]; + LLVMValueRef gv[4]; + a = ld(s); b = ld(add(s, 1)); set_stack_ir(add(s, 2)); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntEQ, a, Kw(SYSGATE), ""), gate, rng); + LLVMPositionBuilderAtEnd(bd, gate); + gt[0] = gt[1] = gt[2] = gt[3] = i64t; + gv[0] = b; gv[1] = ld(Kw(SYSGATE + 1)); gv[2] = ld(Kw(SYSGATE + 2)); gv[3] = ld(Kw(SYSGATE + 3)); + LLVMBuildStore(bd, stack_ir(), cptr(&cb_s)); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, vr, ""), cptr(&cb_r)); + st(Kw(SYSGATE), callp((void *)hostcall, i64t, gt, 4, gv)); + { + LLVMBasicBlockRef moved = newbb(); + LLVMValueRef moving = LLVMBuildAnd(bd, LLVMBuildICmp(bd, LLVMIntEQ, b, Kw(9), ""), + LLVMBuildOr(bd, LLVMBuildICmp(bd, LLVMIntEQ, gv[1], Kw(7), ""), LLVMBuildICmp(bd, LLVMIntEQ, gv[1], Kw(8), ""), ""), ""); + LLVMBuildCondBr(bd, moving, moved, out); + LLVMPositionBuilderAtEnd(bd, moved); + set_stack_ir(LLVMBuildLoad2(bd, i64t, cptr(&cb_s), "")); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, cptr(&cb_r), ""), vr); + LLVMBuildBr(bd, out); + } + LLVMPositionBuilderAtEnd(bd, rng); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntULT, a, Kw(MW), ""), in, out); + LLVMPositionBuilderAtEnd(bd, in); + v = LLVMBuildLoad2(bd, i8t, LLVMBuildGEP2(bd, i8t, cptr(lcov), &a, 1, ""), ""); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntNE, v, LLVMConstInt(i8t, 0, 0), ""), cv, plain); + LLVMPositionBuilderAtEnd(bd, plain); st(a, b); LLVMBuildBr(bd, out); + LLVMPositionBuilderAtEnd(bd, cv); + at[0] = i64t; at[1] = i64t; args[0] = a; args[1] = b; + v = callp((void *)lhook, i32t, at, 2, args); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntNE, v, K32(0), ""), quit, out); + LLVMPositionBuilderAtEnd(bd, quit); leave(Kw(i + 1)); /* a block died: back to the loop */ + LLVMPositionBuilderAtEnd(bd, out); + break; } + case 3: a = ld(s); st(s, safeld(LLVMBuildAdd(bd, add(s, 1), a, ""))); break; + case 4: set_stack_ir(add(s, 1)); break; + case 5: a = ld(s); b = ld(add(s, 1)); st(s, b); st(add(s, 1), a); break; + case 6: case 7: + a = ld(s); set_stack_ir(add(s, 1)); + if (k == 6) { r = LLVMBuildLoad2(bd, i64t, vr, ""); st(r, Kw(i + 1)); LLVMBuildStore(bd, add(r, 1), vr); } + leave(a); done = 1; break; + case 8: { + LLVMBasicBlockRef tk = newbb(), go = newbb(); + a = ld(s); b = ld(add(s, 1)); set_stack_ir(add(s, 2)); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntEQ, b, Kw(0), ""), tk, go); + LLVMPositionBuilderAtEnd(bd, tk); leave(a); + LLVMPositionBuilderAtEnd(bd, go); + break; } + case 9: + r = add(LLVMBuildLoad2(bd, i64t, vr, ""), -1); LLVMBuildStore(bd, r, vr); + leave(ld(r)); done = 1; break; + case 10: v = callp((void *)Q, i8t, 0, 0, 0); push(LLVMBuildSExt(bd, v, i64t, "")); break; + case 11: + if (sizeof J == 1) push(LLVMBuildZExt(bd, LLVMBuildLoad2(bd, i8t, cptr(&J), ""), i64t, "")); + else push(LLVMBuildSExt(bd, LLVMBuildLoad2(bd, i32t, cptr(&J), ""), i64t, "")); + break; + case 12: at[0] = i8t; args[0] = LLVMBuildTrunc(bd, ld(s), i8t, ""); callp((void *)G, LLVMVoidTypeInContext(ctx), at, 1, args); set_stack_ir(add(s, 1)); break; + case 13: case 14: case 15: case 16: case 17: case 18: case 19: case 20: + a = ld(s); b = ld(add(s, 1)); s = add(s, 1); set_stack_ir(s); + switch (k) { + case 13: v = LLVMBuildAdd(bd, b, a, ""); break; + case 14: v = LLVMBuildSub(bd, b, a, ""); break; + case 15: v = LLVMBuildMul(bd, b, a, ""); break; + case 16: v = LLVMBuildAnd(bd, b, a, ""); break; + case 17: v = LLVMBuildOr(bd, b, a, ""); break; + case 18: v = LLVMBuildXor(bd, b, a, ""); break; + case 19: v = LLVMBuildAShr(bd, b, LLVMBuildAnd(bd, a, Kw(63), ""), ""); break; + default: v = LLVMBuildZExt(bd, LLVMBuildICmp(bd, LLVMIntSLT, b, a, ""), i64t, ""); + } + st(s, v); break; + case 21: /* install: then back to the loop, which drops every block */ + at[0] = i64t; args[0] = ld(s); + st(s, callp((void *)linstall, i64t, at, 1, args)); + leave(Kw(i + 1)); done = 1; break; + case 600: /* flit: next word is raw bits */ + if (i + 1 >= code_words) { leave(Kw(PC_HALT)); done = 1; break; } + i++; push(Kw(m[i])); break; + case 601: case 602: case 603: case 604: case 605: case 606: case 607: { + LLVMValueRef da, db, dv; + a = ld(s); b = ld(add(s, 1)); s = add(s, 1); set_stack_ir(s); + da = LLVMBuildBitCast(bd, a, f64t, ""); + db = LLVMBuildBitCast(bd, b, f64t, ""); + if (k == 601) dv = LLVMBuildFAdd(bd, db, da, ""); + else if (k == 602) dv = LLVMBuildFSub(bd, db, da, ""); + else if (k == 603) dv = LLVMBuildFMul(bd, db, da, ""); + else if (k == 604) dv = LLVMBuildFDiv(bd, db, da, ""); + else if (k == 605) dv = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOEQ, db, da, ""), i64t, ""); + else if (k == 606) dv = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOLT, db, da, ""), i64t, ""); + else dv = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOLE, db, da, ""), i64t, ""); + if (k <= 604) dv = LLVMBuildBitCast(bd, dv, i64t, ""); + st(s, dv); + break; } + case 608: + st(s, LLVMBuildBitCast(bd, LLVMBuildSIToFP(bd, ld(s), f64t, ""), i64t, "")); + break; + case 609: + st(s, LLVMBuildFPToSI(bd, LLVMBuildBitCast(bd, ld(s), f64t, ""), i64t, "")); + break; + case 610: { + LLVMTypeRef ft = i64t; LLVMValueRef arg = ld(s); + callp((void *)fop_print, LLVMVoidTypeInContext(ctx), &ft, 1, &arg); + set_stack_ir(add(s, 1)); + break; } + case 611: { + LLVMTypeRef ft = i64t; LLVMValueRef arg = ld(s); + st(s, callp((void *)fop_parse_cell, i64t, &ft, 1, &arg)); + break; } + case 618: { /* (bits prec mode --) */ + LLVMTypeRef ft[3]; + LLVMValueRef args3[3]; + ft[0] = ft[1] = ft[2] = i64t; + args3[0] = ld(add(s, 2)); + args3[1] = ld(add(s, 1)); + args3[2] = ld(s); + callp((void *)fop_print_mode, LLVMVoidTypeInContext(ctx), ft, 3, args3); + set_stack_ir(add(s, 3)); + break; } + case 612: case 614: case 616: { + LLVMTypeRef ft = i64t; LLVMValueRef arg = ld(s); + void *f = k == 612 ? (void *)bld8 : k == 614 ? (void *)bld16 : (void *)bld32; + st(s, callp(f, i64t, &ft, 1, &arg)); + break; } + case 619: push(s); break; + case 620: { + LLVMTypeRef ft = i64t; LLVMValueRef arg = s; + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, vr, ""), cptr(&cb_r)); + set_stack_ir(callp((void *)ncall_exec, i64t, &ft, 1, &arg)); + break; } + case 613: case 615: case 617: { + LLVMTypeRef ft[2], vt = LLVMVoidTypeInContext(ctx); + LLVMValueRef args[2]; + void *f = k == 613 ? (void *)bst8 : k == 615 ? (void *)bst16 : (void *)bst32; + ft[0] = i64t; ft[1] = i64t; + args[0] = ld(s); args[1] = ld(add(s, 1)); + callp(f, vt, ft, 2, args); + set_stack_ir(add(s, 2)); + break; } + default: + if (k >= XOP0 && k < XOP0 + NENH) { if (nused < 64) used[nused++] = k - XOP0; else used[0] = -1; } + if (k >= XOP0 && k < XOP0 + NENH && enh[k - XOP0].live) { ir_enh(&enh[k - XOP0]); break; } + leave(Kw(PC_HALT)); done = 1; /* not wired: halt */ + } + i++; + } + jb = ix_add(p, i); + cinc(lcov, p, i); + if (nused && used[0] < 0) dep_add(NENH, jb); + else for (ju = 0; ju < nused; ju++) dep_add(used[ju], jb); + lrun_passes(lpasses); + rt = LLVMOrcJITDylibCreateResourceTracker(LLVMOrcLLJITGetMainJITDylib(jit)); + if ((err = LLVMOrcLLJITAddLLVMIRModuleWithRT(jit, rt, LLVMOrcCreateNewThreadSafeModule(mod_, tsc)))) { + char *msg = LLVMGetErrorMessage(err); fprintf(stderr, "llvm: %s\n", msg); LLVMDisposeErrorMessage(msg); LLVMOrcReleaseResourceTracker(rt); return 0; + } + lrt[jb] = rt; + if ((err = LLVMOrcLLJITLookup(jit, &addr, name))) { char *msg = LLVMGetErrorMessage(err); fprintf(stderr, "llvm: %s\n", msg); LLVMDisposeErrorMessage(msg); return 0; } + if (trace) fprintf(stderr, "llvm: %d..%d compiled\n", p, i - 1); + return (Blk)(size_t)addr; +} +#endif + +/* ---- o3 regions without the arm64 jit: compiled by llvm, or run here ---- */ +#ifndef ZYLLVM +static unsigned char *rcov; /* 1 on the words of a lifted region */ +#endif +static Cell rvals[MAXUOP * 4 + 16]; +#define RPOOL 40 +static Cell rpool[RPOOL][MAXUOP * 4 + 16]; +static int rpool_n; +static int rdrop(int a) /* a store landed on region code: drop those regions */ +{ + int j, hit = 0; + for (j = 0; j < nrg; j++) + if (rgs[j]->lifted && rgs[j]->lo <= a && a < rgs[j]->hi) { + if (trace) fprintf(stderr, "o3: dropped %d..%d (a store to %d: %d)\n", rgs[j]->lo, rgs[j]->hi - 1, a, m[a]); + rclear(rgs[j]); hit = 1; + } + return hit; +} +#ifdef ZYLLVM +static int lhook(Cell a, Cell v); +#define RSTORE(a, b) do { if (inmem(a)) { if (lcov[(int)(a)]) lhook(a, b); else m[a] = (Cell)(b); } } while (0) +#else +#define RSTORE(a, b) do { if ((unsigned)(a) < MW) { m[a] = b; if (rcov[a]) rdrop(a); } } while (0) +#endif +/* the region interpreter: ssa values in an array, vars in locals */ +static int rexec(Rg *R, int e, int *ps, int *pr) +{ + Cell var[RMAXV], nv2[RMAXV], *v, t = 0, npend[16]; + int s = *ps, r = *pr, b = R->entb[e], fp, j, i, o, pooled = 0, mine = 0; + if (rpool_n < RPOOL) { v = rpool[rpool_n++]; pooled = 1; } + else { v = malloc((MAXUOP * 4 + 16) * sizeof(Cell)); if (v) mine = 1; else v = rvals; } + var[0] = fp = mread(ZFP); + for (j = 1; j < R->nv; j++) var[j] = mread(fp + R->slot[j]); + for (;;) { + RB *B = &R->b[b]; + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + switch (u->op) { + case U_LI: v[u->d] = u->imm; break; + case U_VGET: v[u->d] = var[u->imm]; break; + case U_SLD: v[u->d] = mread(s + u->imm); break; + case U_LD: v[u->d] = mread(v[u->a]); break; + case U_ST: RSTORE(v[u->a], v[u->b]); break; + case U_NARG: npend[u->imm] = v[u->a]; break; + case U_NCALL: +#ifdef ZYFFI + cb_s = s; cb_r = r; + v[u->d] = ffi_invoke(ncd[u->imm].f, ncd[u->imm].sig, npend, 0); +#endif + break; + default: + if (u->op >= U_LD8 && u->op <= U_ST32) { + if (u->op == U_LD8) v[u->d] = bld8(v[u->a]); + else if (u->op == U_LD16) v[u->d] = bld16(v[u->a]); + else if (u->op == U_LD32) v[u->d] = bld32(v[u->a]); + else if (u->op == U_ST8) bst8(v[u->a], v[u->b]); + else if (u->op == U_ST16) bst16(v[u->a], v[u->b]); + else if (u->op == U_ST32) bst32(v[u->a], v[u->b]); + break; + } + v[u->d] = ev(u->op, v[u->a], v[u->b], v[u->c]); + } + } + for (j = 0; j < B->nso; j++) { o = s + B->so[2 * j]; if ((unsigned)o < MW) m[o] = v[B->so[2 * j + 1]]; } + s += B->delta; + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0) nv2[j] = v[B->vs[j]]; + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0) var[j] = nv2[j]; + if (B->term == T_BR) { b = B->s1; continue; } + if (B->term == T_CBR) { + if (!v[B->cv]) { if (B->s1 >= 0) { b = B->s1; continue; } t = B->x1; } + else { if (B->s2 >= 0) { b = B->s2; continue; } t = B->x2; } + } else if (B->term == T_JMP) t = v[B->cv]; + else if (B->term == T_CALL) { + Cell cs, cr; + for (j = 0; j < R->np; j++) if ((unsigned)(fp + R->ps[j]) < MW) m[fp + R->ps[j]] = var[R->pv[j]]; + cs = s; cr = r; + o3_invoke(&cs, &cr, v[B->cv], B->x2); + s = (int)cs; r = (int)cr; + if (halt_at >= 0) { t = halt_at; break; } + var[0] = fp = mread(ZFP); + for (j = 1; j < R->nv; j++) var[j] = mread(fp + R->slot[j]); + if ((unsigned)B->x2 < (unsigned)code_words && o3ent[B->x2] == R->idx + 1) { b = R->entb[o3ei[B->x2]]; continue; } + t = B->x2; + break; + } + else t = m[--r]; + break; + } + for (j = 0; j < R->np; j++) if ((unsigned)(fp + R->ps[j]) < MW) m[fp + R->ps[j]] = var[R->pv[j]]; + *ps = s; *pr = r; + if (pooled) rpool_n--; + if (mine) free(v); + return (int)t; +} +#ifndef ZYLLVM +static void be_drop(int j) { (void)j; } +static void rforget(Rg *R) { (void)R; } +static void rmark(Rg *R) { R->marked = 1; cinc(rcov, R->lo, R->hi); } +static void runmark(Rg *R) { cdec(rcov, R->lo, R->hi); } +static void rcompile(Rg *R, int eager) { (void)R; (void)eager; } +#endif +#ifdef ZYLLVM + +/* ---- o3 regions in llvm: one function per region, vars in allocas (so + mem2reg makes them ssa across blocks), each block's micro-ops as ir, then + the O3 pipeline. f(mem, regs, entry) returns the next vm address. */ +typedef Cell (*RFn)(Cell *mem, Cell *regs, int ent); +static int nregions; +static void rforget(Rg *R) { rt_queue(R->rt); R->rt = 0; R->nat = 0; R->dnat = 0; } +static void rmark(Rg *R) { R->marked = 1; cinc(rcov, R->lo, R->hi); cinc(lcov, R->lo, R->hi); } +static void runmark(Rg *R) { cdec(rcov, R->lo, R->hi); cdec(lcov, R->lo, R->hi); } +static LLVMValueRef as_f64(LLVMValueRef v, int fp) { return fp ? v : LLVMBuildBitCast(bd, v, f64t, ""); } +static LLVMValueRef as_i64(LLVMValueRef v, int fp) { return fp ? LLVMBuildBitCast(bd, v, i64t, "") : v; } +/* the variables go back to their frame slots. before a call from inside the + region only the ones that may hold a pointer need to (the rest are never + looked at again by anything outside: the region goes on with its own + copies), and the frame pointer word is not touched */ +static void rspill_vars(Rg *R, int ptr_only) +{ + LLVMValueRef fp = LLVMBuildLoad2(bd, i64t, rvv[0], ""); + int j; + for (j = 0; j < R->np; j++) { + int v = R->pv[j]; + if (ptr_only && R->sc[v]) continue; + LLVMValueRef bits = R->fv[v] ? LLVMBuildBitCast(bd, LLVMBuildLoad2(bd, f64t, rvv[v], ""), i64t, "") : LLVMBuildLoad2(bd, i64t, rvv[v], ""); + st(add(fp, R->ps[j]), bits); + } +} +static void rspill_ir(Rg *R) +{ + st(Kw(ZFP), LLVMBuildLoad2(bd, i64t, rvv[0], "")); + rspill_vars(R, 0); +} +static LLVMBasicBlockRef rexit_bb(Rg *R, int t) +{ + LLVMBasicBlockRef here = LLVMGetInsertBlock(bd), x = newbb(); + LLVMPositionBuilderAtEnd(bd, x); + if (R->fn >= 0 && t >= R->hi) leave_ok(Kw(t)); + else { rspill_ir(R); leave(Kw(t)); } + LLVMPositionBuilderAtEnd(bd, here); + return x; +} +/* m[a] = v, through lhook if some compiled code covers the word */ +static void rstore_ir(LLVMValueRef a, LLVMValueRef b) +{ + LLVMBasicBlockRef in = newbb(), cv = newbb(), plain = newbb(), out = newbb(); + LLVMValueRef v, args[2]; LLVMTypeRef at[2]; + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntULT, a, Kw(MW), ""), in, out); + LLVMPositionBuilderAtEnd(bd, in); + v = LLVMBuildLoad2(bd, i8t, LLVMBuildGEP2(bd, i8t, cptr(lcov), &a, 1, ""), ""); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntNE, v, LLVMConstInt(i8t, 0, 0), ""), cv, plain); + LLVMPositionBuilderAtEnd(bd, plain); st(a, b); LLVMBuildBr(bd, out); + LLVMPositionBuilderAtEnd(bd, cv); + at[0] = i64t; at[1] = i64t; args[0] = a; args[1] = b; + callp((void *)lhook, i32t, at, 2, args); + LLVMBuildBr(bd, out); + LLVMPositionBuilderAtEnd(bd, out); +} +#ifdef ZYFFI +/* a native call as ir. the callee and its signature are known, so llvm sees a + call with the real argument types and lays out registers and stack by the + platform's rules itself (no limit on the number of arguments). pointer + kinds are converted from vm addresses to host addresses inline. the + common libm functions on doubles become llvm's own intrinsics, which the + backend can turn into one instruction (sqrt) or fold. ai and af are each + argument as an i64 and as a double. s0 and rcur are the stacks as of the + start of the block, for callbacks. */ +static LLVMValueRef lptr_in(LLVMValueRef v, int kind) +{ + LLVMValueRef mb = Kw((Cell)(uintptr_t)m), host, inr, nz = LLVMBuildICmp(bd, LLVMIntNE, v, Kw(0), ""); + if (kind == 3) { + inr = LLVMBuildICmp(bd, LLVMIntULT, v, Kw((Cell)MW * 8), ""); + host = LLVMBuildSelect(bd, inr, LLVMBuildAdd(bd, mb, v, ""), v, ""); + } else if (kind == 6) { + inr = LLVMBuildICmp(bd, LLVMIntULT, v, Kw(MW), ""); + host = LLVMBuildSelect(bd, inr, LLVMBuildAdd(bd, mb, LLVMBuildShl(bd, v, Kw(3), ""), ""), v, ""); + } else { + LLVMValueRef v1 = LLVMBuildAdd(bd, v, Kw(1), ""); + inr = LLVMBuildICmp(bd, LLVMIntULT, v1, Kw(MW), ""); + host = LLVMBuildSelect(bd, inr, LLVMBuildAdd(bd, mb, LLVMBuildShl(bd, v1, Kw(3), ""), ""), v, ""); + } + return LLVMBuildSelect(bd, nz, host, Kw(0), ""); +} +static LLVMValueRef lptr_out(LLVMValueRef p, int kind) +{ + LLVMValueRef mb = Kw((Cell)(uintptr_t)m), off = LLVMBuildSub(bd, p, mb, ""); + LLVMValueRef inr = LLVMBuildICmp(bd, LLVMIntULT, off, Kw((Cell)MW * 8), ""); + if (kind == 6) off = LLVMBuildLShr(bd, off, Kw(3), ""); + return LLVMBuildSelect(bd, inr, off, p, ""); +} +static void lext_attr(LLVMValueRef call, unsigned idx, int sign) +{ + const char *nm = sign ? "signext" : "zeroext"; + unsigned kid = LLVMGetEnumAttributeKindForName(nm, strlen(nm)); + LLVMAddCallSiteAttribute(call, idx, LLVMCreateEnumAttribute(ctx, kid, 0)); +} +static LLVMValueRef lncall(int di, LLVMValueRef *ai, LLVMValueRef *af, LLVMValueRef s0, LLVMValueRef rcur) +{ + Ncd *d = &ncd[di]; + LLVMTypeRef pt[15], rt, ft, f32t = LLVMFloatTypeInContext(ctx), i16t = LLVMInt16TypeInContext(ctx); + LLVMValueRef av[15], call, res; + int i, k, rk = (int)(d->sig & 15), allf = rk == 2, na = d->n; + LLVMBuildStore(bd, s0, cptr(&cb_s)); + LLVMBuildStore(bd, rcur, cptr(&cb_r)); + for (i = 0; i < na; i++) { + k = (int)((d->sig >> (4 * (i + 1))) & 15); + if (k != 2) allf = 0; + switch (k) { + case 2: pt[i] = f64t; av[i] = af[i]; break; + case 5: pt[i] = f32t; av[i] = LLVMBuildFPTrunc(bd, af[i], f32t, ""); break; + case 4: case 7: pt[i] = i32t; av[i] = LLVMBuildTrunc(bd, ai[i], i32t, ""); break; + case 8: case 9: pt[i] = i16t; av[i] = LLVMBuildTrunc(bd, ai[i], i16t, ""); break; + case 10: case 11: pt[i] = i8t; av[i] = LLVMBuildTrunc(bd, ai[i], i8t, ""); break; + case 3: case 6: case 12: pt[i] = i64t; av[i] = lptr_in(ai[i], k); break; + default: pt[i] = i64t; av[i] = ai[i]; break; + } + } + rt = rk == 0 ? LLVMVoidTypeInContext(ctx) : rk == 2 ? f64t : rk == 5 ? f32t : (rk == 4 || rk == 7) ? i32t : (rk == 8 || rk == 9) ? i16t : (rk == 10 || rk == 11) ? i8t : i64t; + if (allf && na >= 1 && na <= 3) { /* libm on doubles: the intrinsic */ + static const struct { const char *c, *ll; int n; } lm[] = { + { "sqrt", "llvm.sqrt.f64", 1 }, { "fabs", "llvm.fabs.f64", 1 }, { "floor", "llvm.floor.f64", 1 }, + { "ceil", "llvm.ceil.f64", 1 }, { "trunc", "llvm.trunc.f64", 1 }, { "round", "llvm.round.f64", 1 }, + { "sin", "llvm.sin.f64", 1 }, { "cos", "llvm.cos.f64", 1 }, { "exp", "llvm.exp.f64", 1 }, + { "exp2", "llvm.exp2.f64", 1 }, { "log", "llvm.log.f64", 1 }, { "log2", "llvm.log2.f64", 1 }, + { "log10", "llvm.log10.f64", 1 }, { "pow", "llvm.pow.f64", 2 }, { "copysign", "llvm.copysign.f64", 2 }, + { "fma", "llvm.fma.f64", 3 } }; + for (i = 0; i < (int)(sizeof lm / sizeof lm[0]); i++) + if (lm[i].n == na && !strcmp(lm[i].c, d->name)) { + LLVMTypeRef it = LLVMFunctionType(f64t, pt, (unsigned)na, 0); + LLVMValueRef fn = LLVMGetNamedFunction(mod_, lm[i].ll); + if (!fn) fn = LLVMAddFunction(mod_, lm[i].ll, it); + return LLVMBuildBitCast(bd, LLVMBuildCall2(bd, it, fn, av, (unsigned)na, ""), i64t, ""); + } + } +#if defined(__x86_64__) + ft = LLVMFunctionType(rt, pt, (unsigned)na, 1); /* a vararg type makes llvm set al, which a variadic callee reads */ +#else + { + int fixed = ffi_varargs(d->f); + if (fixed >= 0 && fixed <= na) { + for (i = fixed; i < na; i++) { + if (pt[i] == f32t) { av[i] = LLVMBuildFPExt(bd, av[i], f64t, ""); pt[i] = f64t; } + else if (pt[i] == i8t || pt[i] == i16t) { + int kind = (int)((d->sig >> (4 * (i + 1))) & 15); + av[i] = kind == 9 || kind == 11 ? LLVMBuildZExt(bd, av[i], i32t, "") : LLVMBuildSExt(bd, av[i], i32t, ""); pt[i] = i32t; + } + } + ft = LLVMFunctionType(rt, pt, (unsigned)fixed, 1); + } else ft = LLVMFunctionType(rt, pt, (unsigned)na, 0); + } +#endif + call = LLVMBuildCall2(bd, ft, cptr(d->f), av, (unsigned)na, ""); + for (i = 0; i < na; i++) { + k = (int)((d->sig >> (4 * (i + 1))) & 15); + if (k == 4 || k == 8 || k == 10) lext_attr(call, (unsigned)i + 1, 1); + if (k == 7 || k == 9 || k == 11) lext_attr(call, (unsigned)i + 1, 0); + } + switch (rk) { + case 0: res = Kw(0); break; + case 2: res = LLVMBuildBitCast(bd, call, i64t, ""); break; + case 5: res = LLVMBuildBitCast(bd, LLVMBuildFPExt(bd, call, f64t, ""), i64t, ""); break; + case 4: res = LLVMBuildSExt(bd, call, i64t, ""); break; + case 8: case 10: res = LLVMBuildSExt(bd, call, i64t, ""); break; + case 7: case 9: case 11: res = LLVMBuildZExt(bd, call, i64t, ""); break; + case 3: case 6: res = lptr_out(call, rk); break; + default: res = call; break; + } + return res; +} +#endif +static LLVMValueRef l_dfn; /* the register-passing function being built or declared for this region */ +static int has_ret(Rg *R) +{ + int b; + for (b = 0; b < R->nb; b++) if (R->b[b].term == T_RET) return 1; + return 0; +} +/* an o3 call to a register-passing callee is inlined: the callee's body is built again into + the caller's module as an internal function, so llvm can inline it there. the copy is good + for one generation of the callee (rclear bumps gen whenever the callee's code is dropped), and + the caller checks that generation before the fast path, so a stale copy is never entered. */ +#define INL_MAX 8 /* copies in one module */ +#define INL_BLOCKS 24 /* largest callee copied */ +typedef struct { Rg *C; unsigned gen; LLVMValueRef fn; } InlEnt; +static InlEnt inl_tab[INL_MAX]; +static int ninl, inl_depth; +static void lbody(Rg *R, int direct, LLVMValueRef fnv); +static LLVMValueRef inline_fn(Rg *C, unsigned *gen) +{ + static int off = -1, inl_n; + LLVMValueRef sfn, sdfn, svm, svregs, svs, svr, nf, srv[RMAXV]; + LLVMBasicBlockRef at; + LLVMTypeRef dpt[6]; + char nm[24]; + int i, j, sdm; + if (off < 0) off = getenv("ZYNOINLINE") != 0; + if (off || inl_depth || !C->lifted || !C->dnat || C->nb > INL_BLOCKS || has_ret(C)) return 0; + for (i = 0; i < ninl; i++) if (inl_tab[i].C == C && inl_tab[i].gen == C->gen) { *gen = C->gen; return inl_tab[i].fn; } + if (ninl >= INL_MAX) return 0; + at = LLVMGetInsertBlock(bd); sfn = fn_; sdfn = l_dfn; sdm = l_dm; + svm = vm_; svregs = vregs; svs = vs; svr = vr; + memcpy(srv, rvv, sizeof rvv); + for (j = 0; j < 6; j++) dpt[j] = i64t; + sprintf(nm, "inl_%d", inl_n++); + nf = LLVMAddFunction(mod_, nm, LLVMFunctionType(l_dret, dpt, 6, 0)); + LLVMSetLinkage(nf, LLVMInternalLinkage); + l_dfn = nf; + inl_depth++; + lbody(C, 1, nf); + inl_depth--; + fn_ = sfn; l_dfn = sdfn; l_dm = sdm; + vm_ = svm; vregs = svregs; vs = svs; vr = svr; + memcpy(rvv, srv, sizeof rvv); + LLVMPositionBuilderAtEnd(bd, at); + inl_tab[ninl].C = C; inl_tab[ninl].gen = C->gen; inl_tab[ninl].fn = nf; ninl++; + *gen = C->gen; + return nf; +} +/* one function for the region. the plain one is f(mem, regs, entry) and takes + the vm's own protocol: s and r in regs, variables from the frame. the + register-passing one is fd(s, r, fp, a0, a1, a2), entered only at the top of + a function by another region: the arguments are the variables, the frame + pointer is a value, and it returns the next address and s. */ +/* the callee of a call to a known address, if it is a function region that takes its + arguments in registers */ +static Rg *dcallee(LLVMValueRef tgt) +{ + Rg *C; + if (!LLVMIsAConstantInt(tgt)) return 0; + C = fnlookup((int)LLVMConstIntGetZExtValue(tgt)); + if (!C || C->dead || C->fn < 0 || C->argc > 3 || C->fslots < 0) return 0; + return C; +} +static void lbody(Rg *R, int direct, LLVMValueRef fnv) +{ + LLVMTypeRef pt[3], ft; LLVMValueRef sw = 0, *val, s0, fp, r, ent = 0, rg2; + LLVMBasicBlockRef *bb, *ebs, eb, dflt = 0; + int b, i, j, e; + LLVMValueRef npi[16], npf[16], dev[4]; + int deo[4], nde = 0; + Rg *Cp = 0; + (void)pt; (void)ft; + fn_ = fnv; + l_dm = direct; + LLVMPositionBuilderAtEnd(bd, newbb()); + vs = LLVMBuildAlloca(bd, i64t, "s"); vr = LLVMBuildAlloca(bd, i64t, "r"); + rg2 = LLVMBuildAlloca(bd, LLVMArrayType(i64t, 2), "regs"); + for (j = 0; j < R->nv; j++) rvv[j] = LLVMBuildAlloca(bd, j && R->fv[j] ? f64t : i64t, ""); + bb = malloc(R->nb * sizeof *bb); + ebs = calloc(R->ne + 1, sizeof *ebs); + for (b = 0; b < R->nb; b++) bb[b] = newbb(); + if (direct) { + vm_ = cptr(m); vregs = 0; + LLVMBuildStore(bd, LLVMGetParam(fn_, 0), vs); + LLVMBuildStore(bd, LLVMGetParam(fn_, 1), vr); + LLVMBuildStore(bd, LLVMGetParam(fn_, 2), rvv[0]); + for (j = 1; j < R->nv; j++) { + LLVMValueRef bits = Kw(0); + if (R->slot[j] >= 0 && R->slot[j] < R->argc && R->slot[j] < 3) bits = LLVMGetParam(fn_, 3 + R->slot[j]); + if (R->fv[j]) bits = LLVMBuildBitCast(bd, bits, f64t, ""); + LLVMBuildStore(bd, bits, rvv[j]); + } + LLVMBuildBr(bd, bb[R->entb[0]]); + } else { + vm_ = LLVMGetParam(fn_, 0); vregs = LLVMGetParam(fn_, 1); ent = LLVMGetParam(fn_, 2); + { LLVMValueRef r0 = Kw(0), r1 = Kw(1); + set_stack_ir(LLVMBuildLoad2(bd, i64t, LLVMBuildGEP2(bd, i64t, vregs, &r0, 1, ""), "")); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, LLVMBuildGEP2(bd, i64t, vregs, &r1, 1, ""), ""), vr); } + dflt = newbb(); + sw = LLVMBuildSwitch(bd, ent, dflt, (unsigned)R->ne); + } + for (e = direct ? 1 : 0; e < R->ne; e++) { + eb = ebs[e] = newbb(); + if (!direct) LLVMAddCase(sw, K32(e), eb); + LLVMPositionBuilderAtEnd(bd, eb); + fp = ld(Kw(ZFP)); + LLVMBuildStore(bd, fp, rvv[0]); + for (j = 1; j < R->nv; j++) { + LLVMValueRef bits = safeld(add(fp, R->slot[j])); + if (R->fv[j]) bits = LLVMBuildBitCast(bd, bits, f64t, ""); + LLVMBuildStore(bd, bits, rvv[j]); + } + LLVMBuildBr(bd, bb[R->entb[e]]); + } + if (!direct) { LLVMPositionBuilderAtEnd(bd, dflt); leave(Kw(-1)); } + val = calloc(R->maxnv + 1, sizeof *val); + for (b = 0; b < R->nb; b++) { + RB *B = &R->b[b]; + unsigned char *fpv = calloc(B->nv + 1, 1); + class_fp(R, B, fpv); + LLVMPositionBuilderAtEnd(bd, bb[b]); + s0 = stack_ir(); + for (i = 0; i < B->n; i++) { + Uop *u = &B->u[i]; + int na = nargs(u->op); + LLVMValueRef a = na > 0 ? val[u->a] : 0, x = na > 1 ? val[u->b] : 0, c = na > 2 ? val[u->c] : 0; + LLVMValueRef ai = na > 0 ? as_i64(a, fpv[u->a]) : 0, af = na > 0 ? as_f64(a, fpv[u->a]) : 0; + LLVMValueRef xi = na > 1 ? as_i64(x, fpv[u->b]) : 0, xf = na > 1 ? as_f64(x, fpv[u->b]) : 0; + LLVMValueRef ci = na > 2 ? as_i64(c, fpv[u->c]) : 0; + switch (u->op) { + case U_LI: val[u->d] = Kw(u->imm); if (fpv[u->d]) val[u->d] = LLVMBuildBitCast(bd, val[u->d], f64t, ""); break; + case U_VGET: + val[u->d] = LLVMBuildLoad2(bd, (unsigned)u->imm < RMAXV && R->fv[u->imm] ? f64t : i64t, rvv[u->imm], ""); + break; + case U_SLD: val[u->d] = ld(add(s0, (int)u->imm)); if (fpv[u->d]) val[u->d] = LLVMBuildBitCast(bd, val[u->d], f64t, ""); break; + case U_LD: val[u->d] = safeld(ai); if (fpv[u->d]) val[u->d] = LLVMBuildBitCast(bd, val[u->d], f64t, ""); break; + case U_ST: rstore_ir(ai, xi); break; + case U_NARG: npi[u->imm] = ai; npf[u->imm] = af; break; + case U_NCALL: +#ifdef ZYFFI + val[u->d] = lncall((int)u->imm, npi, npf, s0, LLVMBuildLoad2(bd, i64t, vr, "")); + if (fpv[u->d]) val[u->d] = LLVMBuildBitCast(bd, val[u->d], f64t, ""); +#endif + break; + case U_LD8: case U_LD16: case U_LD32: val[u->d] = bload_ir(ai, bwidth(u->op)); if (fpv[u->d]) val[u->d] = LLVMBuildBitCast(bd, val[u->d], f64t, ""); break; + case U_ST8: case U_ST16: case U_ST32: bstore_ir(ai, xi, bwidth(u->op)); break; + case U_FADD: val[u->d] = LLVMBuildFAdd(bd, af, xf, ""); break; + case U_FSUB: val[u->d] = LLVMBuildFSub(bd, af, xf, ""); break; + case U_FMUL: val[u->d] = LLVMBuildFMul(bd, af, xf, ""); break; + case U_FDIV: val[u->d] = LLVMBuildFDiv(bd, af, xf, ""); break; + case U_FEQ: val[u->d] = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOEQ, af, xf, ""), i64t, ""); break; + case U_FLT: val[u->d] = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOLT, af, xf, ""), i64t, ""); break; + case U_FLE: val[u->d] = LLVMBuildZExt(bd, LLVMBuildFCmp(bd, LLVMRealOLE, af, xf, ""), i64t, ""); break; + case U_I2F: val[u->d] = LLVMBuildSIToFP(bd, ai, f64t, ""); break; + case U_F2I: val[u->d] = LLVMBuildFPToSI(bd, af, i64t, ""); break; + default: val[u->d] = ir_op(u->op, ai, xi, ci); if (fpv[u->d]) val[u->d] = LLVMBuildBitCast(bd, val[u->d], f64t, ""); break; + } + } + Cp = B->term == T_CALL && B->cv >= 0 ? dcallee(as_i64(val[B->cv], fpv[B->cv])) : 0; + nde = 0; + for (j = 0; j < B->nso; j++) { + int off = B->so[2 * j]; + LLVMValueRef sv_ = as_i64(val[B->so[2 * j + 1]], fpv[B->so[2 * j + 1]]); + if (Cp && off >= B->delta && off < B->delta + Cp->argc) { deo[nde] = off; dev[nde++] = sv_; continue; } /* the register call does not need them in memory */ + st(add(s0, off), sv_); + } + set_stack_ir(add(s0, B->delta)); + for (j = 1; j < R->nv; j++) if (B->vs[j] >= 0) { + LLVMValueRef bits = R->fv[j] ? as_f64(val[B->vs[j]], fpv[B->vs[j]]) : as_i64(val[B->vs[j]], fpv[B->vs[j]]); + LLVMBuildStore(bd, bits, rvv[j]); + } + switch (B->term) { + case T_BR: LLVMBuildBr(bd, bb[B->s1]); break; + case T_CBR: + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntEQ, as_i64(val[B->cv], fpv[B->cv]), Kw(0), ""), + B->s1 >= 0 ? bb[B->s1] : rexit_bb(R, B->x1), B->s2 >= 0 ? bb[B->s2] : rexit_bb(R, B->x2)); + break; + case T_CALL: { + LLVMTypeRef at[4]; LLVMValueRef args[4]; LLVMBasicBlockRef bad, okb, slowb, fastb, helpb, finb, eqb, doneb, chk; int ee; + LLVMValueRef tgt = as_i64(val[B->cv], fpv[B->cv]), natp = 0, fpn = 0, sv = 0, ret = 0; + Rg *C = 0; + rspill_vars(R, 1); + for (ee = 0; ee < R->ne; ee++) if (R->ent[ee] == B->x2) break; + if (LLVMIsAConstantInt(tgt)) { + C = fnlookup((int)LLVMConstIntGetZExtValue(tgt)); + if (C && (C->dead || C->argc > 12 || C->fslots < 0)) C = 0; + } + slowb = newbb(); okb = newbb(); chk = newbb(); + if (C && C->fn >= 0 && C->argc <= 3) { + /* a callee that is a function region: its arguments go in registers, its frame is a value, + and it comes back with the next address and s. the callee may not be compiled yet, or the + frame or the stack may be about to run out: the helper takes those */ + LLVMBasicBlockRef dfast = newbb(), dnorm = newbb(), dabn = newbb(), deq = newbb(), dcont = newbb(); + LLVMValueRef dn, cond, fpc, a3[3], da[6], res, rret, rs2, okf, tmp0, tmp1; + LLVMTypeRef dt = LLVMFunctionType(l_dret, (LLVMTypeRef[]){ i64t, i64t, i64t, i64t, i64t, i64t }, 6, 0); + int ai2; + unsigned igen = 0; + LLVMValueRef inl = C == R ? 0 : inline_fn(C, &igen); + if (C == R) dn = l_dfn; + else if (inl) dn = inl; + else dn = LLVMBuildLoad2(bd, ptrt, cptr(&C->dnat), ""); + fpc = LLVMBuildLoad2(bd, i64t, rvv[0], ""); + fpn = LLVMBuildSub(bd, fpc, Kw(C->fslots), ""); + sv = stack_ir(); + cond = LLVMBuildICmp(bd, LLVMIntUGE, fpn, + LLVMBuildAdd(bd, ld(LLVMBuildLoad2(bd, i64t, cptr(&frame_floor_word), "")), ld(LLVMBuildLoad2(bd, i64t, cptr(&frame_guard_word), "")), ""), ""); + cond = LLVMBuildAnd(bd, cond, LLVMBuildICmp(bd, LLVMIntULT, fpn, ld(LLVMBuildLoad2(bd, i64t, cptr(&frame_top_word), "")), ""), ""); + cond = LLVMBuildAnd(bd, cond, LLVMBuildICmp(bd, LLVMIntUGE, add(sv, -16), Kw(DSLIM), ""), ""); + cond = LLVMBuildAnd(bd, cond, LLVMBuildICmp(bd, LLVMIntULT, sv, Kw(DSHI), ""), ""); + if (inl) cond = LLVMBuildAnd(bd, cond, LLVMBuildICmp(bd, LLVMIntEQ, LLVMBuildLoad2(bd, i32t, cptr(&C->gen), ""), K32((int)igen), ""), ""); + else if (C != R) cond = LLVMBuildAnd(bd, cond, LLVMBuildICmp(bd, LLVMIntNE, LLVMBuildPtrToInt(bd, dn, i64t, ""), Kw(0), ""), ""); + LLVMBuildCondBr(bd, cond, dfast, slowb); + LLVMPositionBuilderAtEnd(bd, dfast); + for (ai2 = 0; ai2 < 3; ai2++) { + int off = B->delta + C->argc - 1 - ai2, q; + a3[ai2] = Kw(0); + if (ai2 >= C->argc) continue; + a3[ai2] = 0; + for (q = 0; q < nde; q++) if (deo[q] == off) a3[ai2] = dev[q]; + if (!a3[ai2]) a3[ai2] = ld(add(sv, C->argc - 1 - ai2)); + } + da[0] = add(sv, C->argc); da[1] = LLVMBuildLoad2(bd, i64t, vr, ""); + da[2] = fpn; da[3] = a3[0]; da[4] = a3[1]; da[5] = a3[2]; + res = LLVMBuildCall2(bd, dt, dn, da, 6, ""); + rret = LLVMBuildExtractValue(bd, res, 0, ""); + rs2 = LLVMBuildExtractValue(bd, res, 1, ""); + okf = LLVMBuildAnd(bd, LLVMBuildICmp(bd, LLVMIntUGE, rret, Kw(C->hi), ""), LLVMBuildICmp(bd, LLVMIntULT, rret, Kw(MW), ""), ""); + LLVMBuildCondBr(bd, okf, dnorm, dabn); + LLVMPositionBuilderAtEnd(bd, dnorm); + set_stack_ir(rs2); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntEQ, rret, Kw(C->hi), ""), deq, dcont); + LLVMPositionBuilderAtEnd(bd, deq); + { LLVMValueRef sn = add(stack_ir(), -1); st(sn, Kw(0)); set_stack_ir(sn); } + LLVMBuildBr(bd, dcont); + LLVMPositionBuilderAtEnd(bd, dcont); + if (ee < R->ne) LLVMBuildBr(bd, bb[R->entb[ee]]); else leave(Kw(B->x2)); + LLVMPositionBuilderAtEnd(bd, dabn); + tmp0 = LLVMBuildGEP2(bd, i64t, rg2, (LLVMValueRef[]){ Kw(0) }, 1, ""); + tmp1 = LLVMBuildGEP2(bd, i64t, rg2, (LLVMValueRef[]){ Kw(1) }, 1, ""); + LLVMBuildStore(bd, rs2, tmp0); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, cptr(&d_r), ""), tmp1); + at[0] = ptrt; at[1] = ptrt; at[2] = ptrt; at[3] = i64t; + args[0] = tmp0; args[1] = tmp1; args[2] = cptr(C); args[3] = rret; + callp((void *)o3_finish_c, LLVMVoidTypeInContext(ctx), at, 4, args); + set_stack_ir(LLVMBuildLoad2(bd, i64t, tmp0, "")); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, tmp1, ""), vr); + LLVMBuildBr(bd, chk); + (void)fastb; (void)helpb; (void)finb; (void)eqb; (void)doneb; (void)natp; (void)ret; + } else if (C) { + /* a callee that is already compiled is entered from here: a frame below this one, + the arguments copied across, a call through its entry. the other cases (not + compiled yet, a frame outside memory) take the helper */ + LLVMValueRef cond, fz; + fastb = newbb(); helpb = newbb(); finb = newbb(); eqb = newbb(); doneb = newbb(); + natp = LLVMBuildLoad2(bd, ptrt, cptr(&C->nat), ""); + fz = LLVMBuildLoad2(bd, i64t, rvv[0], ""); + fpn = LLVMBuildSub(bd, fz, Kw(C->fslots), ""); + sv = stack_ir(); + cond = LLVMBuildICmp(bd, LLVMIntNE, LLVMBuildPtrToInt(bd, natp, i64t, ""), Kw(0), ""); + cond = LLVMBuildAnd(bd, cond, LLVMBuildICmp(bd, LLVMIntUGE, fpn, + LLVMBuildAdd(bd, ld(LLVMBuildLoad2(bd, i64t, cptr(&frame_floor_word), "")), ld(LLVMBuildLoad2(bd, i64t, cptr(&frame_guard_word), "")), ""), ""), ""); + cond = LLVMBuildAnd(bd, cond, LLVMBuildICmp(bd, LLVMIntULT, fpn, Kw(MW - 64), ""), ""); + cond = LLVMBuildAnd(bd, cond, LLVMBuildICmp(bd, LLVMIntULT, add(sv, -1), Kw(MW - 64), ""), ""); + LLVMBuildCondBr(bd, cond, fastb, slowb); + LLVMPositionBuilderAtEnd(bd, fastb); + { + LLVMTypeRef ct[3]; LLVMValueRef ca[3], r1, haltv, okf, sn, rv; + int i2; + st(Kw(ZFP), fpn); + for (i2 = 0; i2 < C->argc; i2++) st(add(fpn, i2), ld(add(sv, C->argc - 1 - i2))); + r1 = Kw(1); + LLVMBuildStore(bd, add(sv, C->argc), rg2); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, vr, ""), LLVMBuildGEP2(bd, i64t, rg2, &r1, 1, "")); + ct[0] = ptrt; ct[1] = ptrt; ct[2] = i32t; + ca[0] = vm_; ca[1] = rg2; ca[2] = K32(0); + ret = LLVMBuildCall2(bd, LLVMFunctionType(i64t, ct, 3, 0), natp, ca, 3, ""); + set_stack_ir(LLVMBuildLoad2(bd, i64t, rg2, "")); + LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, LLVMBuildGEP2(bd, i64t, rg2, &r1, 1, ""), ""), vr); + haltv = LLVMBuildLoad2(bd, i64t, cptr(&halt_at), ""); + okf = LLVMBuildAnd(bd, LLVMBuildICmp(bd, LLVMIntUGE, ret, Kw(C->hi), ""), LLVMBuildICmp(bd, LLVMIntULT, ret, Kw(MW), ""), ""); + okf = LLVMBuildAnd(bd, okf, LLVMBuildICmp(bd, LLVMIntSLT, haltv, Kw(0), ""), ""); + LLVMBuildCondBr(bd, okf, finb, helpb); + LLVMPositionBuilderAtEnd(bd, finb); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntEQ, ret, Kw(C->hi), ""), eqb, doneb); + LLVMPositionBuilderAtEnd(bd, eqb); + sn = add(stack_ir(), -1); st(sn, Kw(0)); set_stack_ir(sn); + LLVMBuildBr(bd, doneb); + LLVMPositionBuilderAtEnd(bd, doneb); + rv = ld(Kw(ZFP)); + st(Kw(ZFP), add(rv, C->fslots)); + if (ee < R->ne) LLVMBuildBr(bd, bb[R->entb[ee]]); else leave(Kw(B->x2)); + LLVMPositionBuilderAtEnd(bd, helpb); + { + LLVMValueRef t0 = LLVMBuildGEP2(bd, i64t, rg2, (LLVMValueRef[]){ Kw(0) }, 1, ""), t1 = LLVMBuildGEP2(bd, i64t, rg2, (LLVMValueRef[]){ Kw(1) }, 1, ""); + LLVMBuildStore(bd, stack_ir(), t0); LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, vr, ""), t1); + at[0] = ptrt; at[1] = ptrt; at[2] = ptrt; at[3] = i64t; + args[0] = t0; args[1] = t1; args[2] = cptr(C); args[3] = ret; + callp((void *)o3_finish_c, LLVMVoidTypeInContext(ctx), at, 4, args); + set_stack_ir(LLVMBuildLoad2(bd, i64t, t0, "")); LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, t1, ""), vr); + } + LLVMBuildBr(bd, chk); + } + } else LLVMBuildBr(bd, slowb); + LLVMPositionBuilderAtEnd(bd, slowb); + { int q; for (q = 0; q < nde; q++) st(add(s0, deo[q]), dev[q]); } + st(Kw(ZFP), LLVMBuildLoad2(bd, i64t, rvv[0], "")); + { + LLVMValueRef t0 = LLVMBuildGEP2(bd, i64t, rg2, (LLVMValueRef[]){ Kw(0) }, 1, ""), t1 = LLVMBuildGEP2(bd, i64t, rg2, (LLVMValueRef[]){ Kw(1) }, 1, ""); + LLVMBuildStore(bd, stack_ir(), t0); LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, vr, ""), t1); + at[0] = ptrt; at[1] = ptrt; at[2] = i64t; at[3] = i64t; + args[0] = t0; args[1] = t1; + args[2] = tgt; args[3] = Kw(B->x2); + callp((void *)o3_invoke, LLVMVoidTypeInContext(ctx), at, 4, args); + set_stack_ir(LLVMBuildLoad2(bd, i64t, t0, "")); LLVMBuildStore(bd, LLVMBuildLoad2(bd, i64t, t1, ""), vr); + } + LLVMBuildBr(bd, chk); + LLVMPositionBuilderAtEnd(bd, chk); + bad = newbb(); + LLVMBuildCondBr(bd, LLVMBuildICmp(bd, LLVMIntSGE, LLVMBuildLoad2(bd, i64t, cptr(&halt_at), ""), Kw(0), ""), bad, okb); + LLVMPositionBuilderAtEnd(bd, bad); leave(l_dm ? Kw(-1) : LLVMBuildLoad2(bd, i64t, cptr(&halt_at), "")); /* a direct callee says -1: any address could look like a return */ + LLVMPositionBuilderAtEnd(bd, okb); + if (ee < R->ne) LLVMBuildBr(bd, bb[R->entb[ee]]); else leave(Kw(B->x2)); + (void)fpn; (void)sv; + break; } + case T_RET: + r = add(LLVMBuildLoad2(bd, i64t, vr, ""), -1); LLVMBuildStore(bd, r, vr); + rspill_ir(R); leave(ld(r)); + break; + default: { + LLVMValueRef tv = as_i64(val[B->cv], fpv[B->cv]); + if (R->fn >= 0 && LLVMIsAConstantInt(tv) && (long long)LLVMConstIntGetSExtValue(tv) >= R->hi) leave_ok(tv); + else { rspill_ir(R); leave(tv); } + } + } + free(fpv); + } + free(val); free(bb); free(ebs); + l_dm = 0; +} +static void *lregion(Rg *R) +{ + char name[40], dname[48]; LLVMTypeRef pt[3], ft, dpt[6]; LLVMValueRef f1, f2 = 0; + LLVMOrcExecutorAddress addr; LLVMErrorRef err; + int dir, i; + sprintf(name, "o3_%d_%d", R->lo, nregions++); + sprintf(dname, "%s_d", name); + mod_ = LLVMModuleCreateWithNameInContext(name, ctx); + ninl = 0; + lmodule_target(); + pt[0] = ptrt; pt[1] = ptrt; pt[2] = i32t; + ft = LLVMFunctionType(i64t, pt, 3, 0); + f1 = LLVMAddFunction(mod_, name, ft); + lfunc_attrs(f1); + dir = R->fn >= 0 && R->argc <= 3 && R->fslots >= 0 && !has_ret(R); + if (dir) { + static unsigned knu; + LLVMTypeRef rt2[2]; + rt2[0] = i64t; rt2[1] = i64t; + l_dret = LLVMStructTypeInContext(ctx, rt2, 2, 0); + for (i = 0; i < 6; i++) dpt[i] = i64t; + f2 = LLVMAddFunction(mod_, dname, LLVMFunctionType(l_dret, dpt, 6, 0)); + if (!knu) knu = LLVMGetEnumAttributeKindForName("nounwind", 8); + LLVMAddAttributeAtIndex(f2, (LLVMAttributeIndex)-1, LLVMCreateEnumAttribute(ctx, knu, 0)); + } + l_dfn = f2; + lbody(R, 0, f1); + if (dir) lbody(R, 1, f2); + l_dfn = 0; + lrun_passes("default"); + if (getenv("ZYLLIR")) LLVMDumpModule(mod_); + { LLVMOrcResourceTrackerRef rt = LLVMOrcJITDylibCreateResourceTracker(LLVMOrcLLJITGetMainJITDylib(jit)); + if ((err = LLVMOrcLLJITAddLLVMIRModuleWithRT(jit, rt, LLVMOrcCreateNewThreadSafeModule(mod_, tsc)))) { + char *msg = LLVMGetErrorMessage(err); fprintf(stderr, "llvm: %s\n", msg); LLVMDisposeErrorMessage(msg); LLVMOrcReleaseResourceTracker(rt); return 0; + } + R->rt = rt; } + if ((err = LLVMOrcLLJITLookup(jit, &addr, name))) { char *msg = LLVMGetErrorMessage(err); fprintf(stderr, "llvm: %s\n", msg); LLVMDisposeErrorMessage(msg); return 0; } + if (dir) { + LLVMOrcExecutorAddress da; + if (!(err = LLVMOrcLLJITLookup(jit, &da, dname))) R->dnat = (void *)(size_t)da; else LLVMConsumeError(err); + } + if (trace) fprintf(stderr, "o3: %d..%d compiled by llvm%s\n", R->lo, R->hi - 1, R->dnat ? " (with a register entry)" : ""); + return (void *)(size_t)addr; +} +static void rcompile(Rg *R, int eager) +{ + (void)eager; + if (R->nat || R->nonat || !llvm_ok) return; + if (!(R->nat = lregion(R))) R->nonat = 1; +} +#endif +#define LD(x) (inmem(x) ? m[x] : 0) +static int stop_eq = -1, stop_ge = -1, stop_return_depth = -1, run_nest; +static Rg *stop_rg; +static Cell run_s, run_r; +static int run(int p) +{ + int s = run_nest ? (int)run_s : DS0, r = run_nest ? (int)run_r : RS0, xfer = 1; + Cell w, a, b; + unsigned long long steps = 0; +#ifdef ZYLLVM + Cell regs[2]; + if (!getenv("ZYNOLLVM")) llvm_init(); +#endif + while ((unsigned)p < (unsigned)code_words) { + if (run_nest) { + if (stop_eq >= 0 && p == stop_eq && r - (stack_control ? stack_get(SC_RETURN_LOW) : RS0) == stop_return_depth) break; + if (stop_ge >= 0 && p >= stop_ge) break; + if (stop_rg && p >= stop_rg->lo && p < stop_rg->hi && o3ent[p] == stop_rg->idx + 1) break; + } + if (xfer && (s < stack_data_limit() || r > stack_return_limit())) { + Cell sp = s, rp = r; + int ret = r > stack_return_limit(); + if (!stack_control || stack_expand(ret, stack_get(ret ? SC_RETURN_TOP : SC_DATA_TOP) - stack_get(ret ? SC_RETURN_LOW : SC_DATA_LOW) + 1, &sp, &rp) < 0) { p = ret ? PC_RETURN_OVERFLOW : PC_DATA_OVERFLOW; break; } + s = (int)sp; r = (int)rp; + } + if (xfer && o3ent[p]) { /* an o3 region */ + Rg *R = rat(p); + if (R) { +#ifdef ZYLLVM + rcompile(R, 0); + if (R->nat) { regs[0] = s; regs[1] = r; ccode++; p = (int)((RFn)R->nat)(m, regs, o3ei[p]); ccode--; rt_sweep(); s = (int)regs[0]; r = (int)regs[1]; } + else +#endif + p = rexec(R, o3ei[p], &s, &r); + continue; + } + } +#ifdef ZYLLVM + if (xfer && llvm_ok) { /* at a block start: run it compiled, or count it */ + xfer = 0; + if (!lt[p] && hot[p] < 65535 && ++hot[p] == HOT && !(lt[p] = lcompile(p))) hot[p] = 65535; + if (lt[p]) { + regs[0] = s; regs[1] = r; + ccode++; p = lt[p](m, regs); ccode--; + s = regs[0]; r = regs[1]; + rt_sweep(); + if (need_flush) { need_flush = 0; ldrop_all(); } + xfer = 1; + continue; + } + } +#endif + w = m[p++]; + steps++; + if (w & 1) { m[--s] = w >> 1; continue; } + a = m[s]; b = m[s + 1]; + switch ((int)(w >> 1)) { + case 1: m[s] = LD(a); break; + case 2: + if (a == SYSGATE) { + int moving = b == 9 && (m[a + 1] == 7 || m[a + 1] == 8); + cb_s = s + 2; cb_r = r; m[a] = hostcall(b, m[a + 1], m[a + 2], m[a + 3]); + if (moving) { s = (int)cb_s; r = (int)cb_r; } else s += 2; + break; + } + if (inmem(a)) { +#ifdef ZYLLVM + if (lcov[a]) lhook(a, b); else +#else + if (rcov[a]) { m[a] = b; rdrop(a); } else +#endif + m[a] = b; + } + s += 2; break; + case 3: m[s] = LD(s + 1 + a); break; + case 4: s++; break; + case 5: m[s] = b; m[s + 1] = a; break; + case 6: m[r++] = p; p = a; s++; xfer = 1; break; + case 7: p = a; s++; xfer = 1; break; + case 8: if (!b) { p = a; xfer = 1; } s += 2; break; + case 9: p = m[--r]; xfer = 1; break; + case 10: m[--s] = (signed char)Q(); break; + case 11: m[--s] = J; break; + case 12: G((char)a); s++; break; + case 13: m[++s] = b + a; break; + case 14: m[++s] = b - a; break; + case 15: m[++s] = b * a; break; + case 16: m[++s] = b & a; break; + case 17: m[++s] = b | a; break; + case 18: m[++s] = b ^ a; break; + case 19: m[++s] = b >> (a & 63); break; + case 20: m[++s] = b < a; break; + case 600: + if (p >= code_words) { p = PC_HALT; break; } + m[--s] = m[p++]; + break; + case 601: m[++s] = (Cell)fop_add((uint64_t)b, (uint64_t)a); break; + case 602: m[++s] = (Cell)fop_sub((uint64_t)b, (uint64_t)a); break; + case 603: m[++s] = (Cell)fop_mul((uint64_t)b, (uint64_t)a); break; + case 604: m[++s] = (Cell)fop_div((uint64_t)b, (uint64_t)a); break; + case 605: m[++s] = fop_eq((uint64_t)b, (uint64_t)a); break; + case 606: m[++s] = fop_lt((uint64_t)b, (uint64_t)a); break; + case 607: m[++s] = fop_le((uint64_t)b, (uint64_t)a); break; + case 608: m[s] = (Cell)fop_i2f(a); break; + case 609: m[s] = fop_f2i((uint64_t)a); break; + case 610: fop_print(a); s++; break; + case 611: m[s] = fop_parse_cell(a); break; + case 618: fop_print_mode(m[s + 2], b, a); s += 3; break; + case 612: m[s] = bld8(a); break; + case 613: bst8(a, b); s += 2; break; + case 614: m[s] = bld16(a); break; + case 615: bst16(a, b); s += 2; break; + case 616: m[s] = bld32(a); break; + case 617: bst32(a, b); s += 2; break; + case 619: { Cell t = s; m[--s] = t; break; } + case 620: cb_r = r; s = (int)ncall_exec(s); break; + case 21: + m[s] = install(a); +#ifdef ZYLLVM + if (need_flush) { need_flush = 0; ldrop_all(); } +#else + if (need_flush) { need_flush = 0; rdrop_all(); memset(rcov, 0, (size_t)code_words); } +#endif + break; + default: + if ((int)(w >> 1) >= XOP0 && (int)(w >> 1) < XOP0 + NENH && enh[(int)(w >> 1) - XOP0].live) s = (int)(xexec(&enh[(int)(w >> 1) - XOP0], m + s) - m); + else p = PC_HALT; /* halt: unwired opcodes and the reserved negative ones */ + } + } + if (run_nest) { run_s = s; run_r = r; return p; } + halt_at = -1; + if (trace) fprintf(stderr, "interp: %llu steps\n", steps); + return stopped(p); +} +static int vm_until(int pc, int seq, int sge, Rg *re, Cell *ps, Cell *pr) +{ + int pe = stop_eq, pg = stop_ge, pd = stop_return_depth, pn = run_nest, back; + Rg *old = stop_rg; + Cell ss = run_s, rr = run_r; + stop_eq = seq; stop_ge = sge; stop_return_depth = (int)(*pr - (stack_control ? stack_get(SC_RETURN_LOW) : RS0) - 1); stop_rg = re; + run_nest = 1; run_s = *ps; run_r = *pr; + back = run(pc); + *ps = run_s; *pr = run_r; + stop_eq = pe; stop_ge = pg; stop_return_depth = pd; stop_rg = old; run_nest = pn; run_s = ss; run_r = rr; + return back; +} +static int o3_ready(Rg *C) +{ + if (!C || C->dead) return 0; + if (!C->lifted && rlift(C)) { C->dead = 1; return 0; } + return C->lifted && !C->dead; +} +static int o3_exec_region(Rg *C, int entry, Cell *ps, Cell *pr) +{ + int s, r, back; + if (!C || C->dead || entry < 0 || entry >= C->ne) return -1; + if (!C->lifted && rlift(C)) { C->dead = 1; return -1; } +#ifdef ZYLLVM + rcompile(C, 0); + if (C->nat) { + typedef Cell (*RFn2)(Cell *, Cell *, int); + Cell regs[2]; + regs[0] = *ps; regs[1] = *pr; + back = (int)((RFn2)C->nat)(m, regs, entry); + *ps = regs[0]; *pr = regs[1]; + return back; + } +#endif + s = (int)*ps; r = (int)*pr; + back = rexec(C, entry, &s, &r); + *ps = s; *pr = r; + return back; +} +#endif + +/* a byte store writes whole words through the same hook as opcode 2, so a + translation covering either word is dropped. it does not run a syscall: + the gate is a word store at SYSGATE. */ +static void b_commit(Cell w, Cell v) +{ + if ((unsigned)w >= (unsigned)MW) return; + if (w == SYSGATE) { m[w] = v; return; } +#if defined(ZYJIT) + if (cov[(int)w]) hook(w, v); else m[w] = v; +#elif defined(ZYLLVM) + if (lcov[(int)w]) lhook(w, v); else m[w] = v; +#else + if (rcov[(int)w]) { m[w] = v; rdrop((int)w); } else m[w] = v; +#endif +} + +#ifdef ZYBIGSTACK +static ucontext_t uc_main, uc_vm; +static int vm_rc; +static void vm_entry(void) { vm_rc = run(GORG); } +#endif +static int memory_option(const char *name, int fallback, int minimum) +{ + const char *s = getenv(name); + char *end; + unsigned long long words; + if (!s) return fallback; + errno = 0; words = strtoull(s, &end, 0); + if (errno || !*s || *end || words < (unsigned)minimum || words > 0x7fffffff) { + fprintf(stderr, "zy: invalid %s (minimum %d words)\n", name, minimum); + return -1; + } + return (int)words; +} +/* reserve all address-indexed metadata together; a denied request leaves it intact. */ +static int code_reserve(Cell end) +{ + Cell cap = code_words ? code_words : PW; + void *slots[6], *previous[6], *fresh[6]; size_t widths[6], oldn[6], newn[6]; int count = 0, i, j; + if (end <= 0 || end > memory_words || end >= PC_HALT) return -1; + if (end <= code_words) return (int)code_words; + while (cap < end) { if (cap > memory_words / 2) { cap = memory_words; break; } cap *= 2; } + if (cap >= PC_HALT) cap = PC_HALT - 1; + if (cap < end) return -1; +#define CODE_COLUMN(name, before, after) do { slots[count] = &name; previous[count] = name; widths[count] = sizeof *name; oldn[count] = (size_t)(before); newn[count] = (size_t)(after); count++; } while (0) + CODE_COLUMN(pg_head, code_words ? NPG : 0, (cap >> PGSH) + 1); + CODE_COLUMN(o3ent, code_words, cap); CODE_COLUMN(o3ei, code_words, cap); +#ifdef ZYJIT + CODE_COLUMN(tab, code_words, cap); CODE_COLUMN(fn_nat, code_words, cap); +#elif defined(ZYLLVM) + CODE_COLUMN(lt, code_words, cap); CODE_COLUMN(hot, code_words, cap); +#endif +#undef CODE_COLUMN + for (i = 0; i < count; i++) { + fresh[i] = calloc(newn[i], widths[i]); + if (!fresh[i]) { for (j = 0; j < i; j++) free(fresh[j]); return -1; } + if (oldn[i]) memcpy(fresh[i], previous[i], oldn[i] * widths[i]); + } + for (i = 0; i < count; i++) { free(previous[i]); memcpy(slots[i], &fresh[i], sizeof fresh[i]); } + code_words = cap; +#ifdef ZYJIT + S[3] = (long)tab; +#endif + return (int)cap; +} +/* bulk writes use the ordinary store path when they would rewrite live code. */ +static int code_range_live(Cell start, Cell count) +{ + Cell end, i; + if (start < 0 || count <= 0 || start >= code_words) return 0; + end = count > code_words - start ? code_words : start + count; + for (i = start; i < end; i++) { +#ifdef ZYJIT + if (cov[i]) return 1; +#else + if (rcov[i]) return 1; +#ifdef ZYLLVM + if (lcov[i]) return 1; +#endif +#endif + } + return 0; +} + +int main(int argc, char **argv) +{ +#ifdef _WIN32 + _setmode(_fileno(stdin), _O_BINARY); + _setmode(_fileno(stdout), _O_BINARY); +#endif + zy_args(argc, argv); + memory_limit = memory_option("TINYVM_MAX_MEMORY_WORDS", DEFAULT_MEMORY_LIMIT, HEAP_HI > PW ? HEAP_HI : PW); + if (memory_limit < 0) return 1; + memory_growth_limit = memory_limit; + memory_words = memory_option("TINYVM_MEMORY_WORDS", HEAP_HI > PW ? HEAP_HI : PW, HEAP_HI > PW ? HEAP_HI : PW); + if (memory_words < 0) return 1; + if (memory_words > memory_limit) { fprintf(stderr, "zy: initial memory exceeds its limit\n"); return 1; } + m = calloc((size_t)MW, sizeof *m); +#ifdef ZYJIT + cov = calloc((size_t)MW, 1); + if (!cov) { fprintf(stderr, "zy: cannot reserve translation coverage\n"); return 1; } +#else + rcov = calloc((size_t)MW, 1); +#ifdef ZYLLVM + lcov = calloc((size_t)MW, 1); + if (!lcov) { fprintf(stderr, "zy: cannot reserve translation coverage\n"); return 1; } +#endif + if (!rcov) { fprintf(stderr, "zy: cannot reserve region coverage\n"); return 1; } +#endif + if (!m) { fprintf(stderr, "zy: cannot reserve vm memory\n"); return 1; } + if (code_reserve(PW) < 0) { fprintf(stderr, "zy: cannot reserve code metadata\n"); return 1; } + trace = getenv("ZYTRACE") != 0; + if ((unsigned)GORG + (unsigned)GLEN > (unsigned)PW || (unsigned)GORG + (unsigned)GLEN > (unsigned)FBOT) { + fprintf(stderr, "zy: genome does not fit\n"); + return 1; + } + memcpy(m + GORG, genome, sizeof genome); + m[ZFP + 6] = FBOT; m[ZFP + 7] = FTOP; m[ZFP + 8] = 1024; +#ifdef ZYJIT + { + int p = GORG; + union { unsigned *u; int (*f)(long *, void *); } enter; +#ifdef __APPLE__ + code = mmap(0, CODEW * 4, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_PRIVATE | MAP_ANON | MAP_JIT, -1, 0); +#else + code = mmap(0, CODEW * 4, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); +#endif + if (code == MAP_FAILED) { perror("mmap"); return 1; } + jitwrite(1); + build_stubs(); + jitwrite(0); + syncicache(code, cp); + S[0] = (long)m; S[1] = DS0; S[2] = RS0; S[3] = (long)tab; S[4] = (long)cov; + S[5] = (long)Q; S[6] = (long)G; S[7] = (long)&J; S[8] = (long)hook; + S[9] = (long)inst_hook; S[10] = (long)xrun; + S[11] = (long)(m + DSLIM); S[12] = (long)(m + RSLIM); + cov[SYSGATE] = 1; + enter.u = x_enter; + while ((unsigned)p < (unsigned)code_words || p == PC_DATA_OVERFLOW || p == PC_RETURN_OVERFLOW) { + if (p == PC_DATA_OVERFLOW || p == PC_RETURN_OVERFLOW) { + Cell sp = S[1], rp = S[2]; int ret = p == PC_RETURN_OVERFLOW; + if (!stack_control || stack_expand(ret, stack_get(ret ? SC_RETURN_TOP : SC_DATA_TOP) - stack_get(ret ? SC_RETURN_LOW : SC_DATA_LOW) + 1, &sp, &rp) < 0) break; + S[1] = sp; S[2] = rp; + S[11] = (long)(m + stack_data_limit()); S[12] = (long)(m + stack_return_limit()); + p = (int)S[13]; continue; + } + void *c = tab[p]; + if (!c) { jitwrite(1); c = translate(p); jitwrite(0); } + p = enter.f(S, c); + if (need_flush) { need_flush = 0; jitwrite(1); flush(); jitwrite(0); } + } + return stopped(p); + } +#elif defined(ZYBIGSTACK) + { + /* o3 calls nest on the host stack, one native frame per call: give the machine a + stack as deep as its own frame stack can go (untouched pages cost nothing) */ + size_t sz = (size_t)1 << 29; + void *stk = mmap(0, sz, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE, -1, 0); + if (stk != MAP_FAILED) { + getcontext(&uc_vm); + uc_vm.uc_stack.ss_sp = stk; uc_vm.uc_stack.ss_size = sz; uc_vm.uc_link = &uc_main; + makecontext(&uc_vm, vm_entry, 0); + swapcontext(&uc_main, &uc_vm); + return vm_rc; + } + return run(GORG); + } +#else + return run(GORG); +#endif + return 0; +} diff --git a/src/core/fops.h b/src/core/fops.h new file mode 100644 index 0000000..9213603 --- /dev/null +++ b/src/core/fops.h @@ -0,0 +1,1048 @@ +/* IEEE-754 binary64, packed in one 64-bit word. + a float on the stack is the raw 64 bits. the odd/even tag is only for the + instruction stream, so a float literal is two words: opcode 600 (the even + word 1200) and then the raw bits, which the decoder must consume itself + because bit 0 is often set. + + two arithmetic paths, chosen when the image is built: + - hardware (the default). fop_* are volatile host doubles, so gcc emits + the FPU (x86_64 SSE2, AArch64 FP, RV64 D). the arm64 jit and the llvm + backend do not call these for 601..609; they emit fadd/fmul/fcmp/scvtf + and the matching llvm double ops. bare metal turns the FPU on in the + boot stub and compiles this file with a hard-float ABI. + - soft (compile with -DZY_SOFTFLOAT). integer IEEE, round ties to even, + no host double. a port with no FPU selects this. print and parse stay + on the integer side either way, so the text does not depend on libc. + + print and parse are integer, on both paths, so the text does not depend + on libc or the host libm. opcode 610 prints six digits after the dot and + rounds a tie in the next digit away from zero. opcode 618 (the word 1236) + takes (bits prec mode --): mode 0 is the shortest spelling that parses + back to the same bits, mode 1 is fixed (prec digits after the dot) and + mode 2 is scientific (prec significant digits). prec is capped at 17. + the parser keeps the digits it is given, rounds ties to even, and accepts + an exponent, inf and nan. */ +#ifndef FOPS_H +#define FOPS_H +#include + +#ifdef ZY_SOFTFLOAT +/* ---- soft-float: binary64 in integer registers, selected with -DZY_SOFTFLOAT ---- */ +typedef struct { uint64_t sig; int exp; int sign; int cls; } FopSF; /* cls 0 finite, 1 inf, 2 nan */ + +static int fop_clz(uint64_t x) +{ + int n = 0; + if (!x) return 64; + if (!(x & 0xffffffff00000000ull)) { n += 32; x <<= 32; } + if (!(x & 0xffff000000000000ull)) { n += 16; x <<= 16; } + if (!(x & 0xff00000000000000ull)) { n += 8; x <<= 8; } + if (!(x & 0xf000000000000000ull)) { n += 4; x <<= 4; } + if (!(x & 0xc000000000000000ull)) { n += 2; x <<= 2; } + if (!(x & 0x8000000000000000ull)) n++; + return n; +} +static int fop_clz128(unsigned __int128 x) +{ + uint64_t hi = (uint64_t)(x >> 64); + if (hi) return fop_clz(hi); + return 64 + fop_clz((uint64_t)x); +} +static void fop_dec(uint64_t u, FopSF *o) +{ + int eb = (int)((u >> 52) & 0x7ff); + uint64_t frac = u & 0x000fffffffffffffull; + o->sign = (int)(u >> 63); + o->sig = frac; + o->exp = 0; + if (eb == 0x7ff) { o->cls = frac ? 2 : 1; return; } + o->cls = 0; + if (!eb) { o->exp = -1074; return; } + o->sig = frac | (1ull << 52); + o->exp = eb - 1023 - 52; +} +/* value = sig * 2^exp, ties to even. sticky is bits below sig. + a magnitude below 2^-1075 is a zero; that exact power is the tie between + zero and the smallest subnormal, and it rounds back to zero. */ +static uint64_t fop_sf_round(int sign, int exp, uint64_t sig, int sticky) +{ + int round = 0, bit, topw; + uint64_t sgn = (uint64_t)sign << 63; + if (!sig) return sgn; + topw = exp + 63 - fop_clz(sig); + if (topw < -1075) return sgn; + if (topw == -1075) return (sticky || (sig & (sig - 1))) ? sgn | 1 : sgn; + while (sig < (1ull << 52) && exp > -1074) { sig <<= 1; exp--; } + while (sig >= (1ull << 53) || (exp < -1074 && sig)) { + bit = (int)(sig & 1); + sig >>= 1; + exp++; + sticky = sticky || round; + round = bit; + } + if (round && (sticky || (sig & 1))) { + sig++; + if (sig >= (1ull << 53)) { sig >>= 1; exp++; } + } + if (!sig) return sgn; + if (exp > 971) return sgn | 0x7ff0000000000000ull; /* exp + 52 > 1023 */ + if (sig < (1ull << 52)) return sgn | sig; + return sgn | ((uint64_t)(exp + 52 + 1023) << 52) | (sig & 0x000fffffffffffffull); +} +static uint64_t fop_add(uint64_t x, uint64_t y) +{ + FopSF a, b; + unsigned __int128 as, bs, sum; + int sh, sticky = 0, sign, lz; + uint64_t top; + fop_dec(x, &a); + fop_dec(y, &b); + if (a.cls == 2 || b.cls == 2) return 0x7ff8000000000000ull; + if (a.cls == 1 && b.cls == 1) { + if (a.sign != b.sign) return 0x7ff8000000000000ull; + return ((uint64_t)a.sign << 63) | 0x7ff0000000000000ull; + } + if (a.cls == 1) return ((uint64_t)a.sign << 63) | 0x7ff0000000000000ull; + if (b.cls == 1) return ((uint64_t)b.sign << 63) | 0x7ff0000000000000ull; + if (!a.sig && !b.sig) return (a.sign && b.sign) ? 0x8000000000000000ull : 0; + if (!a.sig) return y; + if (!b.sig) return x; + as = (unsigned __int128)a.sig << 60; + bs = (unsigned __int128)b.sig << 60; + if (a.exp < b.exp) { FopSF t = a; a = b; b = t; as = bs; bs = (unsigned __int128)b.sig << 60; } + sh = a.exp - b.exp; + if (sh >= 128) { sticky = b.sig != 0; bs = 0; } + else if (sh) { + sticky = (bs & (((unsigned __int128)1 << sh) - 1)) != 0; + bs >>= sh; + } + if (a.sign == b.sign) { sum = as + bs; sign = a.sign; } + else if (as == bs) return 0; + else if (as > bs) { sum = as - bs; sign = a.sign; } + else { sum = bs - as; sign = b.sign; } + lz = fop_clz128(sum); + sum <<= lz; + top = (uint64_t)(sum >> 64); + if ((uint64_t)sum) sticky = 1; + return fop_sf_round(sign, a.exp + 4 - lz, top, sticky); +} +static uint64_t fop_sub(uint64_t x, uint64_t y) { return fop_add(x, y ^ 0x8000000000000000ull); } +static uint64_t fop_mul(uint64_t x, uint64_t y) +{ + FopSF a, b; + unsigned __int128 prod; + int sign, lz, sticky = 0; + uint64_t top; + fop_dec(x, &a); + fop_dec(y, &b); + sign = a.sign ^ b.sign; + if (a.cls == 2 || b.cls == 2) return 0x7ff8000000000000ull; + if ((a.cls == 1 && !b.sig) || (b.cls == 1 && !a.sig)) return 0x7ff8000000000000ull; + if (a.cls == 1 || b.cls == 1) return ((uint64_t)sign << 63) | 0x7ff0000000000000ull; + if (!a.sig || !b.sig) return (uint64_t)sign << 63; + prod = (unsigned __int128)a.sig * b.sig; + lz = fop_clz128(prod); + prod <<= lz; + top = (uint64_t)(prod >> 64); + if ((uint64_t)prod) sticky = 1; + return fop_sf_round(sign, a.exp + b.exp + 64 - lz, top, sticky); +} +static uint64_t fop_div(uint64_t x, uint64_t y) +{ + FopSF a, b; + unsigned __int128 num, q128; + int sign, lz, sticky; + fop_dec(x, &a); + fop_dec(y, &b); + sign = a.sign ^ b.sign; + if (a.cls == 2 || b.cls == 2) return 0x7ff8000000000000ull; + if (a.cls == 1 && b.cls == 1) return 0x7ff8000000000000ull; + if (a.cls == 1) return ((uint64_t)sign << 63) | 0x7ff0000000000000ull; + if (!b.sig || b.cls == 1) { + if (!b.sig && !a.sig) return 0x7ff8000000000000ull; + if (!b.sig) return ((uint64_t)sign << 63) | 0x7ff0000000000000ull; + return (uint64_t)sign << 63; /* finite / inf */ + } + if (!a.sig) return (uint64_t)sign << 63; + /* (sig << 64) / sig fits in 128 bits even for a subnormal divisor of 1. */ + num = (unsigned __int128)a.sig << 64; + q128 = num / b.sig; + sticky = (num % b.sig) != 0; + lz = fop_clz128(q128); + q128 <<= lz; + if ((uint64_t)q128) sticky = 1; + return fop_sf_round(sign, a.exp - b.exp - lz, (uint64_t)(q128 >> 64), sticky); +} +static int fop_eq(uint64_t x, uint64_t y) +{ + FopSF a, b; + fop_dec(x, &a); + fop_dec(y, &b); + if (a.cls == 2 || b.cls == 2) return 0; + if (!a.cls && !b.cls && !a.sig && !b.sig) return 1; + return x == y; +} +static int fop_lt(uint64_t x, uint64_t y) +{ + FopSF a, b; + int mag; + fop_dec(x, &a); + fop_dec(y, &b); + if (a.cls == 2 || b.cls == 2) return 0; + if (a.cls == 1 && b.cls == 1) return a.sign > b.sign; + if (a.cls == 1) return a.sign; + if (b.cls == 1) return !b.sign; + if (!a.sig && !b.sig) return 0; + if (a.sign != b.sign) return a.sign; + if (a.exp != b.exp) mag = a.exp < b.exp; + else mag = a.sig < b.sig; + if (a.exp == b.exp && a.sig == b.sig) return 0; + return a.sign ? !mag : mag; +} +static int fop_le(uint64_t x, uint64_t y) { return fop_eq(x, y) || fop_lt(x, y); } +static uint64_t fop_i2f(int64_t i) +{ + uint64_t mag; + if (!i) return 0; + if (i < 0) { + mag = (i == (int64_t)((uint64_t)1 << 63)) ? ((uint64_t)1 << 63) : (uint64_t)(-i); + return fop_sf_round(1, 0, mag, 0); + } + return fop_sf_round(0, 0, (uint64_t)i, 0); +} +static int64_t fop_f2i(uint64_t u) +{ + FopSF a; + uint64_t mag; + fop_dec(u, &a); + if (a.cls == 2 || !a.sig) return 0; + if (a.cls == 1 || a.exp >= 63) return a.sign ? (int64_t)((uint64_t)1 << 63) : 9223372036854775807LL; + if (a.exp >= 0) { + if (a.exp > 0 && a.sig > (~0ull >> a.exp)) return a.sign ? (int64_t)((uint64_t)1 << 63) : 9223372036854775807LL; + mag = a.sig << a.exp; + } else { + if (-a.exp >= 64) return 0; + mag = a.sig >> -a.exp; + } + if (!a.sign) { + if (mag > 9223372036854775807ull) return 9223372036854775807LL; + return (int64_t)mag; + } + if (mag > 9223372036854775808ull) return (int64_t)((uint64_t)1 << 63); + if (mag == 9223372036854775808ull) return (int64_t)((uint64_t)1 << 63); + return -(int64_t)mag; +} + +#else +static double fop_d(uint64_t u) +{ + union { uint64_t u; double d; } x; + x.u = u; + return x.d; +} +static uint64_t fop_u(double d) +{ + union { uint64_t u; double d; } x; + x.d = d; + return x.u; +} +static uint64_t fop_add(uint64_t x, uint64_t y) +{ + volatile double a = fop_d(x), b = fop_d(y), c = a + b; + return fop_u(c); +} +static uint64_t fop_sub(uint64_t x, uint64_t y) +{ + volatile double a = fop_d(x), b = fop_d(y), c = a - b; + return fop_u(c); +} +static uint64_t fop_mul(uint64_t x, uint64_t y) +{ + volatile double a = fop_d(x), b = fop_d(y), c = a * b; + return fop_u(c); +} +static uint64_t fop_div(uint64_t x, uint64_t y) +{ + volatile double a = fop_d(x), b = fop_d(y), c = a / b; + return fop_u(c); +} +static int fop_eq(uint64_t x, uint64_t y) +{ + volatile double a = fop_d(x), b = fop_d(y); + return a == b; +} +static int fop_lt(uint64_t x, uint64_t y) +{ + volatile double a = fop_d(x), b = fop_d(y); + return a < b; +} +static int fop_le(uint64_t x, uint64_t y) +{ + volatile double a = fop_d(x), b = fop_d(y); + return a <= b; +} +static uint64_t fop_i2f(int64_t i) +{ + volatile double d = (double)i; + return fop_u(d); +} +/* trunc toward 0. values outside int64 saturate, and a nan becomes 0. + tests stay in range, where this matches a hardware fcvtzs. */ +static int64_t fop_f2i(uint64_t x) +{ + volatile double d = fop_d(x); + if (!(d == d)) return 0; + if (d >= 9223372036854775808.0) return 9223372036854775807LL; + if (d <= -9223372036854775808.0) return (int64_t)((uint64_t)1 << 63); + return (int64_t)d; +} +#endif + +/* binary64 <-> binary32, in integer arithmetic so every build agrees (no libm, + no compiler runtime). f2s rounds to nearest even and takes a double's bits to + a single's bits (in the low 32); s2f is exact. a nan keeps its sign and the top + of its payload, and comes out quiet. */ +static uint64_t fop_f2s(uint64_t x) +{ + uint64_t sign = (x >> 63) << 31, frac = x & 0xFFFFFFFFFFFFFull, sig, q, rem, half; + int e = (int)((x >> 52) & 0x7FF), E, shift; + if (e == 0x7FF) { + if (!frac) return sign | 0x7F800000u; + return sign | 0x7FC00000u | (frac >> 29); + } + if (e == 0) return sign; /* zero, or a subnormal double: far below the smallest single */ + E = e - 1023; + sig = frac | (1ull << 52); + if (E > 127) return sign | 0x7F800000u; + shift = 29; + if (E < -126) { shift = 29 + (-126 - E); if (shift > 54) return sign; } + q = sig >> shift; + rem = sig & ((1ull << shift) - 1); + half = 1ull << (shift - 1); + if (rem > half || (rem == half && (q & 1))) q++; + if (shift == 29) { + if (q == (1ull << 24)) { q >>= 1; E++; if (E > 127) return sign | 0x7F800000u; } + return sign | ((uint64_t)(E + 127) << 23) | (q & 0x7FFFFF); + } + return sign | q; /* a subnormal; if it rounded up to the smallest normal these are that normal's bits */ +} +static uint64_t fop_s2f(uint64_t x) +{ + uint64_t sign, frac; + int e, p; + x &= 0xFFFFFFFFull; + sign = (x >> 31) << 63; + frac = x & 0x7FFFFF; + e = (int)((x >> 23) & 0xFF); + if (e == 0xFF) { + if (!frac) return sign | 0x7FF0000000000000ull; + return sign | 0x7FF8000000000000ull | (frac << 29); + } + if (e == 0) { + if (!frac) return sign; + p = 22; + while (!(frac >> p)) p--; + frac = (frac << (52 - p)) & 0xFFFFFFFFFFFFFull; + return sign | ((uint64_t)(p - 149 + 1023) << 52) | frac; + } + return sign | ((uint64_t)(e - 127 + 1023) << 52) | (frac << 29); +} + +/* decimal conversion in base 2^32. 96 limbs is room for a 120-digit + significand times 5^445, which covers every double and the digits a + 127-character literal can hold. copies go through a volatile store so a + freestanding build does not emit memcpy. */ +#define FOP_BI 96 +typedef struct { uint32_t d[FOP_BI]; int n; } FopBi; + +static void bi_norm(FopBi *a) +{ + while (a->n > 0 && !a->d[a->n - 1]) a->n--; +} +static void bi_clear(FopBi *a) { a->n = 0; } +static void bi_copy(FopBi *dst, const FopBi *src) +{ + volatile uint32_t *w = dst->d; + int i; + dst->n = src->n; + for (i = 0; i < src->n; i++) w[i] = src->d[i]; +} +static void bi_set(FopBi *a, uint64_t v) +{ + a->n = 0; + if (!v) return; + a->d[0] = (uint32_t)v; + a->n = 1; + if (v >> 32) { a->d[1] = (uint32_t)(v >> 32); a->n = 2; } +} +static void bi_add_u32(FopBi *a, uint32_t v) +{ + uint64_t c = v; + int i = 0; + if (!v) return; + while (c) { + if (i >= FOP_BI) return; + if (i == a->n) a->d[a->n++] = 0; + c += a->d[i]; + a->d[i++] = (uint32_t)c; + c >>= 32; + } +} +static void bi_mul_u32(FopBi *a, uint32_t m) +{ + uint64_t c = 0; + int i; + if (!m || !a->n) { a->n = 0; return; } + for (i = 0; i < a->n; i++) { + c += (uint64_t)a->d[i] * m; + a->d[i] = (uint32_t)c; + c >>= 32; + } + if (c && a->n < FOP_BI) a->d[a->n++] = (uint32_t)c; +} +static void bi_mul(FopBi *a, const FopBi *b) +{ + FopBi r; + int i, j; + uint64_t c; + if (!a->n || !b->n) { a->n = 0; return; } + bi_clear(&r); + r.n = a->n + b->n; + if (r.n > FOP_BI) r.n = FOP_BI; + for (i = 0; i < r.n; i++) r.d[i] = 0; + for (i = 0; i < a->n; i++) { + c = 0; + for (j = 0; j < b->n && i + j < FOP_BI; j++) { + c += (uint64_t)r.d[i + j] + (uint64_t)a->d[i] * b->d[j]; + r.d[i + j] = (uint32_t)c; + c >>= 32; + } + if (c && i + b->n < r.n) r.d[i + b->n] = (uint32_t)c; + } + bi_norm(&r); + bi_copy(a, &r); +} +static void bi_pow5(FopBi *out, int e) +{ + FopBi base, acc; + bi_set(&acc, 1); + bi_set(&base, 5); + if (e < 0) e = 0; + while (e) { + if (e & 1) bi_mul(&acc, &base); + e >>= 1; + if (e) bi_mul(&base, &base); + } + bi_copy(out, &acc); +} +static int bi_bitlen(const FopBi *a) +{ + uint32_t x; + int n; + if (!a->n) return 0; + x = a->d[a->n - 1]; + n = (a->n - 1) * 32; + while (x) { n++; x >>= 1; } + return n; +} +static int bi_bit(const FopBi *a, int i) +{ + if (i < 0 || (i >> 5) >= a->n) return 0; + return (int)((a->d[i >> 5] >> (i & 31)) & 1); +} +static int bi_low_any(const FopBi *a, int nbits) +{ + int i, w, b; + if (nbits <= 0) return 0; + w = nbits >> 5; + b = nbits & 31; + for (i = 0; i < w && i < a->n; i++) if (a->d[i]) return 1; + if (b && w < a->n && (a->d[w] & ((1u << b) - 1))) return 1; + return 0; +} +static uint64_t bi_extract(const FopBi *a, int lo, int nbits) +{ + uint64_t r = 0; + int i; + if (nbits > 63) nbits = 63; + for (i = 0; i < nbits; i++) if (bi_bit(a, lo + i)) r |= (uint64_t)1 << i; + return r; +} +static void bi_shl(FopBi *a, int s) +{ + int w, b, i; + uint32_t prev; + if (s <= 0 || !a->n) return; + w = s >> 5; + b = s & 31; + if (a->n + w + (b ? 1 : 0) > FOP_BI) { + for (i = 0; i < FOP_BI; i++) a->d[i] = 0xffffffffu; + a->n = FOP_BI; + return; + } + if (b) { + prev = 0; + for (i = 0; i < a->n; i++) { + uint32_t cur = a->d[i]; + a->d[i] = (cur << b) | prev; + prev = cur >> (32 - b); + } + if (prev) a->d[a->n++] = prev; + } + if (w) { + for (i = a->n - 1; i >= 0; i--) a->d[i + w] = a->d[i]; + for (i = 0; i < w; i++) a->d[i] = 0; + a->n += w; + } +} +static int bi_cmp(const FopBi *a, const FopBi *b) +{ + int i; + if (a->n != b->n) return a->n < b->n ? -1 : 1; + for (i = a->n - 1; i >= 0; i--) if (a->d[i] != b->d[i]) return a->d[i] < b->d[i] ? -1 : 1; + return 0; +} +static void bi_sub(FopBi *a, const FopBi *b) +{ + uint64_t br = 0; + int i; + for (i = 0; i < a->n; i++) { + uint64_t av = a->d[i]; + uint64_t bv = (uint64_t)(i < b->n ? b->d[i] : 0) + br; + if (av < bv) { a->d[i] = (uint32_t)(av + (1ull << 32) - bv); br = 1; } + else { a->d[i] = (uint32_t)(av - bv); br = 0; } + } + bi_norm(a); +} +/* q = floor(num/den), rem = num % den. den must be nonzero. */ +static void bi_divmod(const FopBi *num, const FopBi *den, FopBi *q, FopBi *rem) +{ + int i, nb = bi_bitlen(num); + bi_clear(q); + bi_clear(rem); + for (i = nb - 1; i >= 0; i--) { + bi_shl(rem, 1); + if (bi_bit(num, i)) bi_add_u32(rem, 1); + if (bi_cmp(rem, den) >= 0) { + bi_sub(rem, den); + { + int w = i >> 5; + while (q->n <= w) q->d[q->n++] = 0; + q->d[w] |= 1u << (i & 31); + } + } + } + bi_norm(q); +} +/* half up: remainder >= half the divisor increments the quotient. */ +static void bi_div_halfup(const FopBi *num, const FopBi *den, FopBi *q) +{ + FopBi rem, twice; + bi_divmod(num, den, q, &rem); + bi_copy(&twice, &rem); + bi_shl(&twice, 1); + if (bi_cmp(&twice, den) >= 0) bi_add_u32(q, 1); +} +static uint32_t bi_div10(FopBi *a) +{ + uint64_t rem = 0; + int i; + for (i = a->n - 1; i >= 0; i--) { + rem = (rem << 32) | a->d[i]; + a->d[i] = (uint32_t)(rem / 10); + rem %= 10; + } + bi_norm(a); + return (uint32_t)rem; +} +static int bi_to_digits(const FopBi *a, char *dig) +{ + FopBi x; + char rev[400]; + int n = 0, i; + bi_copy(&x, a); + if (!x.n) { dig[0] = '0'; dig[1] = 0; return 1; } + while (x.n && n < 390) rev[n++] = (char)('0' + (int)bi_div10(&x)); + for (i = 0; i < n; i++) dig[i] = rev[n - 1 - i]; + dig[n] = 0; + return n; +} +/* right shift by s, then +1 if the highest discarded bit was set. */ +static void bi_shr_halfup(const FopBi *a, int s, FopBi *dst) +{ + int up, w, b, i, len; + if (s <= 0) { bi_copy(dst, a); return; } + len = bi_bitlen(a); + up = bi_bit(a, s - 1); + if (s >= len) { + bi_clear(dst); + if (up) bi_set(dst, 1); + return; + } + w = s >> 5; + b = s & 31; + dst->n = 0; + if (!b) { + for (i = w; i < a->n; i++) dst->d[dst->n++] = a->d[i]; + } else { + for (i = w; i < a->n; i++) { + uint32_t cur = a->d[i] >> b; + if (i + 1 < a->n) cur |= a->d[i + 1] << (32 - b); + dst->d[dst->n++] = cur; + } + } + bi_norm(dst); + if (up) bi_add_u32(dst, 1); +} + +/* q * 2^scale, plus a nonzero fraction below bit 0 when extra is set. + round ties to even. a pure power of two at 2^-1075 is the tie between + zero and the smallest subnormal, and it rounds back to zero. */ +static uint64_t fop_qbits(const FopBi *q, int scale, int extra, int neg) +{ + uint64_t sgn = (uint64_t)neg << 63; + int top, unbiased, low, roundb, sticky; + uint64_t sig; + if (!q->n) return sgn; + top = bi_bitlen(q) - 1; + unbiased = top + scale; + if (unbiased > 1023) return sgn | 0x7ff0000000000000ull; + if (unbiased < -1075) return sgn; + if (unbiased == -1075) { + if (!extra && !bi_low_any(q, top)) return sgn; + return sgn | 1; + } + if (unbiased < -1022) { + int rsh = -(scale + 1074); + if (rsh >= 0) { + sig = bi_extract(q, rsh, top - rsh + 1); + roundb = rsh > 0 ? bi_bit(q, rsh - 1) : 0; + sticky = extra || (rsh > 1 && bi_low_any(q, rsh - 1)); + } else { + sig = bi_extract(q, 0, top + 1) << (-rsh); + roundb = 0; + sticky = extra; + } + if (roundb && (sticky || (sig & 1))) sig++; + if (sig >= (1ull << 52)) return sgn | (1ull << 52); + return sgn | sig; + } + low = top - 52; + if (low <= 0) { + sig = bi_extract(q, 0, top + 1); + if (low < 0) sig <<= -low; + roundb = 0; + sticky = extra; + } else { + sig = bi_extract(q, low, 53); + roundb = bi_bit(q, low - 1); + sticky = extra || bi_low_any(q, low - 1); + } + if (roundb && (sticky || (sig & 1))) { + sig++; + if (sig == (1ull << 53)) { + sig >>= 1; + unbiased++; + if (unbiased > 1023) return sgn | 0x7ff0000000000000ull; + } + } + return sgn | ((uint64_t)(unbiased + 1023) << 52) | (sig & 0xfffffffffffffull); +} + +/* sig * 10^exp10, with sticky meaning the true value is strictly larger. */ +static uint64_t fop_dec_bits(const FopBi *sig, int exp10, int neg, int sticky) +{ + FopBi num, den, q, rem; + int bexp, approx, target, sh, guard = 0; + int sgn = neg ? 1 : 0; + if (!sig->n) return sgn ? 0x8000000000000000ull : 0; + if (exp10 >= 0) { + bi_copy(&num, sig); + bi_pow5(&den, exp10); + bi_mul(&num, &den); + bi_set(&den, 1); + bexp = exp10; + } else { + bi_copy(&num, sig); + bi_pow5(&den, -exp10); + bexp = exp10; + } + approx = bi_bitlen(&num) - bi_bitlen(&den) + bexp; + if (approx > 1080) return sgn ? 0xfff0000000000000ull : 0x7ff0000000000000ull; + if (approx < -1140) return sgn ? 0x8000000000000000ull : 0; +again: + if (approx < -902) target = -1088; + else target = approx - 80; + target -= guard * 32; + sh = bexp - target; + { + FopBi n2, d2; + bi_copy(&n2, &num); + bi_copy(&d2, &den); + if (sh >= 0) bi_shl(&n2, sh); + else bi_shl(&d2, -sh); + bi_divmod(&n2, &d2, &q, &rem); + { + int top = q.n ? bi_bitlen(&q) - 1 : 0; + int low = top - 52; + int unbiased = q.n ? top + target : -9999; + if (q.n && unbiased >= -1022 && low < 4 && guard < 4) { guard++; goto again; } + } + return fop_qbits(&q, target, sticky || rem.n != 0, sgn); + } +} + +/* parse directly from byte text or vm words, without truncating a lexer buffer. */ +typedef struct { const char *bytes; const int64_t *words; uint64_t length; } FopText; +static char fop_char(FopText *s, uint64_t at) +{ + if (s->words) return at < s->length ? (char)(s->words[at] & 255) : 0; + return s->bytes[at]; +} +static int fop_word(FopText *s, uint64_t p, const char *w) +{ + while (*w) { + char c = fop_char(s, p); + if (c >= 'A' && c <= 'Z') c = (char)(c - 'A' + 'a'); + if (c != *w) return 0; + p++; + w++; + } + return fop_char(s, p) == 0; +} + +static uint64_t fop_parse_text(FopText *s) +{ + uint64_t p = 0; + int neg = 0, exp10 = 0, nexp = 0, eneg = 0, frac = 0, saw = 0, nd = 0, sticky = 0; + int dec; + FopBi sig; + if (fop_char(s, p) == '+') p++; + else if (fop_char(s, p) == '-') { neg = 1; p++; } + if (fop_word(s, p, "inf")) return neg ? 0xfff0000000000000ull : 0x7ff0000000000000ull; + if (fop_word(s, p, "nan")) return neg ? 0xfff8000000000000ull : 0x7ff8000000000000ull; + bi_clear(&sig); + while (fop_char(s, p) == '.' || (fop_char(s, p) >= '0' && fop_char(s, p) <= '9')) { + if (fop_char(s, p) == '.') { + if (frac) break; + frac = 1; + p++; + continue; + } + saw = 1; + if (fop_char(s, p) == '0' && !sig.n) { + if (frac) exp10--; + } else if (nd < 80) { + bi_mul_u32(&sig, 10); + bi_add_u32(&sig, (uint32_t)(fop_char(s, p) - '0')); + nd++; + if (frac) exp10--; + } else { + if (fop_char(s, p) != '0') sticky = 1; + if (!frac) exp10++; + } + p++; + } + if (fop_char(s, p) == 'e' || fop_char(s, p) == 'E') { + p++; + if (fop_char(s, p) == '+') p++; + else if (fop_char(s, p) == '-') { eneg = 1; p++; } + while (fop_char(s, p) >= '0' && fop_char(s, p) <= '9') { + if (nexp < 1000000) nexp = nexp * 10 + (fop_char(s, p) - '0'); + p++; + } + if (eneg) exp10 -= nexp; + else exp10 += nexp; + } + if (!saw || !sig.n) return neg ? 0x8000000000000000ull : 0; + dec = exp10 + nd - 1; + if (dec > 309) return neg ? 0xfff0000000000000ull : 0x7ff0000000000000ull; + if (dec < -326) return neg ? 0x8000000000000000ull : 0; + return fop_dec_bits(&sig, exp10, neg, sticky); +} + +static uint64_t fop_parse(const char *bytes) +{ + FopText text = { bytes, 0, 0 }; + return fop_parse_text(&text); +} +static uint64_t fop_parse_words(const int64_t *words, uint64_t length) +{ + FopText text = { 0, words, length }; + return length ? fop_parse_text(&text) : 0; +} + +static void fop_decode(uint64_t bits, uint64_t *sig, int *e2, int *neg, int *cls) +{ + uint64_t exp = (bits >> 52) & 0x7ff; + uint64_t frac = bits & 0x000fffffffffffffull; + *neg = (int)(bits >> 63); + *cls = 0; + *sig = 0; + *e2 = 0; + if (exp == 0x7ff) { *cls = frac ? 2 : 1; return; } + if (!exp) { + *sig = frac; + *e2 = -1074; + return; + } + *sig = frac | (1ull << 52); + *e2 = (int)exp - 1023 - 52; +} + +/* x ? 10^k. x = sig * 2^e2, sig > 0. */ +static int fop_cmp10(uint64_t sig, int e2, int k) +{ + FopBi a, b; + int q; + if (k >= 0) { + bi_set(&a, sig); + bi_pow5(&b, k); + if (e2 >= k) bi_shl(&a, e2 - k); + else bi_shl(&b, k - e2); + return bi_cmp(&a, &b); + } + q = -k; + bi_set(&a, sig); + bi_pow5(&b, q); + bi_mul(&a, &b); + if (e2 + q >= 0) { + bi_shl(&a, e2 + q); + if (!a.n) return -1; + if (a.n == 1 && a.d[0] == 1) return 0; + return 1; + } + bi_set(&b, 1); + bi_shl(&b, -(e2 + q)); + return bi_cmp(&a, &b); +} + +/* no __builtin_clzll: a freestanding riscv link has no __clzdi2. */ +static int fop_nlz(uint64_t x) +{ + int n = 0; + if (!x) return 64; + if (!(x & 0xffffffff00000000ull)) { n += 32; x <<= 32; } + if (!(x & 0xffff000000000000ull)) { n += 16; x <<= 16; } + if (!(x & 0xff00000000000000ull)) { n += 8; x <<= 8; } + if (!(x & 0xf000000000000000ull)) { n += 4; x <<= 4; } + if (!(x & 0xc000000000000000ull)) { n += 2; x <<= 2; } + if (!(x & 0x8000000000000000ull)) n++; + return n; +} +static int fop_decexp(uint64_t sig, int e2) +{ + int log2 = 63 - fop_nlz(sig) + e2; + int est, guard = 0; + if (log2 >= 0) est = (int)(((unsigned __int128)log2 * 1292913986ull) >> 32); + else { + unsigned __int128 m = (unsigned __int128)(-log2) * 1292913986ull; + est = -(int)(m >> 32); + if (m & 0xffffffffull) est--; + } + while (guard++ < 12 && fop_cmp10(sig, e2, est + 1) >= 0) est++; + guard = 0; + while (guard++ < 12 && fop_cmp10(sig, e2, est) < 0) est--; + return est; +} + +/* round_half_up(sig * 2^e2 * 10^scale) as an integer. */ +static void fop_scale(uint64_t sig, int e2, int scale, FopBi *mag) +{ + FopBi num, den; + int i, q10; + if (scale >= 0) { + bi_set(&num, sig); + for (i = 0; i < scale; i++) bi_mul_u32(&num, 5); + if (e2 + scale >= 0) bi_shl(&num, e2 + scale); + else { bi_shr_halfup(&num, -(e2 + scale), mag); return; } + bi_copy(mag, &num); + return; + } + q10 = -scale; + bi_set(&num, sig); + bi_pow5(&den, q10); + if (e2 >= q10) bi_shl(&num, e2 - q10); + else bi_shl(&den, q10 - e2); + bi_div_halfup(&num, &den, mag); +} + +static int fop_putu(char *out, int n, int v) +{ + char b[16]; + int i = 0, j; + if (v < 0) v = -v; + if (!v) { out[n++] = '0'; return n; } + while (v) { b[i++] = (char)('0' + v % 10); v /= 10; } + for (j = i - 1; j >= 0; j--) out[n++] = b[j]; + return n; +} + +/* plain when the exponent is in [-4, 15], otherwise scientific. */ +static int fop_spell(const char *dig, int nd, int dec, int neg, int scientific, char *out) +{ + int n = 0, i; + if (neg) out[n++] = '-'; + if (!scientific) { + if (dec >= 0) { + int whole = dec + 1; + if (nd <= whole) { + for (i = 0; i < nd; i++) out[n++] = dig[i]; + for (; i < whole; i++) out[n++] = '0'; + } else { + for (i = 0; i < whole; i++) out[n++] = dig[i]; + out[n++] = '.'; + for (; i < nd; i++) out[n++] = dig[i]; + } + } else { + out[n++] = '0'; + out[n++] = '.'; + for (i = 0; i < -dec - 1; i++) out[n++] = '0'; + for (i = 0; i < nd; i++) out[n++] = dig[i]; + } + } else { + out[n++] = dig[0]; + if (nd > 1) { + out[n++] = '.'; + for (i = 1; i < nd; i++) out[n++] = dig[i]; + } + out[n++] = 'e'; + out[n++] = dec < 0 ? '-' : '+'; + n = fop_putu(out, n, dec < 0 ? -dec : dec); + } + out[n] = 0; + return n; +} + +static void fop_sigdigs(uint64_t sig, int e2, int prec, char *dig, int *dec) +{ + int d = fop_decexp(sig, e2); + FopBi mag; + char tmp[48]; + int nd = 0, i, guard = 0; + while (guard++ < 8) { + int zeros = 1; + fop_scale(sig, e2, prec - 1 - d, &mag); + nd = bi_to_digits(&mag, tmp); + if (nd == prec) break; + if (nd == prec + 1) { + for (i = 1; i < nd; i++) if (tmp[i] != '0') zeros = 0; + if (tmp[0] == '1' && zeros) { + d++; + dig[0] = '1'; + for (i = 1; i < prec; i++) dig[i] = '0'; + dig[prec] = 0; + *dec = d; + return; + } + } + if (nd > prec) d += nd - prec; + else d -= prec - nd; + } + if (nd > prec) nd = prec; + for (i = 0; i < prec - nd; i++) dig[i] = '0'; + for (i = 0; i < nd && i < prec; i++) dig[prec - nd + i] = tmp[i]; + dig[prec] = 0; + *dec = d; +} + +static int fop_format_fixed(uint64_t sig, int e2, int neg, int prec, char *out) +{ + FopBi t, mag; + char dig[400]; + int n = 0, nd, i, whole; + bi_set(&t, sig ? sig : 0); + if (!sig) bi_clear(&mag); + else { + int i5; + for (i5 = 0; i5 < prec; i5++) bi_mul_u32(&t, 5); + if (e2 + prec >= 0) { bi_shl(&t, e2 + prec); bi_copy(&mag, &t); } + else bi_shr_halfup(&t, -(e2 + prec), &mag); + } + if (neg) out[n++] = '-'; + nd = bi_to_digits(&mag, dig); + if (nd <= prec) { + out[n++] = '0'; + if (prec) { + out[n++] = '.'; + for (i = 0; i < prec - nd; i++) out[n++] = '0'; + for (i = 0; i < nd; i++) out[n++] = dig[i]; + } + } else { + whole = nd - prec; + for (i = 0; i < whole && n < 380; i++) out[n++] = dig[i]; + if (prec && n < 390) { + out[n++] = '.'; + for (i = 0; i < prec; i++) out[n++] = dig[whole + i]; + } + } + out[n] = 0; + return n; +} + +static int fop_special_text(int cls, int neg, char *out) +{ + int n = 0; + if (cls == 2) { out[0] = 'n'; out[1] = 'a'; out[2] = 'n'; out[3] = 0; return 3; } + if (neg) out[n++] = '-'; + out[n++] = 'i'; out[n++] = 'n'; out[n++] = 'f'; + out[n] = 0; + return n; +} + +/* mode 0 shortest, 1 fixed, 2 scientific. out must hold 400 bytes. */ +static int fop_format_mode(uint64_t bits, int64_t mode, int64_t prec, char *out) +{ + uint64_t sig; + int e2, neg, cls, n, k, dec, scientific; + char dig[24], buf[80]; + fop_decode(bits, &sig, &e2, &neg, &cls); + if (cls) return fop_special_text(cls, neg, out); + if (mode == 1) { + if (prec < 0) prec = 0; + if (prec > 17) prec = 17; + return fop_format_fixed(sig, e2, neg, (int)prec, out); + } + if (!sig) { + if (mode == 2) { + int p = (int)prec; + int i; + if (p < 1) p = 1; + if (p > 17) p = 17; + n = 0; + if (neg) out[n++] = '-'; + out[n++] = '0'; + if (p > 1) { + out[n++] = '.'; + for (i = 1; i < p; i++) out[n++] = '0'; + } + out[n++] = 'e'; out[n++] = '+'; out[n++] = '0'; + out[n] = 0; + return n; + } + out[0] = '0'; + if (neg) { out[0] = '-'; out[1] = '0'; out[2] = 0; return 2; } + out[1] = 0; + return 1; + } + if (mode == 2) { + int p = (int)prec; + if (p < 1) p = 1; + if (p > 17) p = 17; + fop_sigdigs(sig, e2, p, dig, &dec); + return fop_spell(dig, p, dec, neg, 1, out); + } + for (k = 1; k <= 18; k++) { + fop_sigdigs(sig, e2, k, dig, &dec); + scientific = !(dec >= -4 && dec <= 15); + fop_spell(dig, k, dec, neg, scientific, buf); + if (k == 18 || fop_parse(buf) == bits) return fop_spell(dig, k, dec, neg, scientific, out); + } + return fop_spell(dig, 18, dec, neg, 1, out); +} + +static int fop_format(uint64_t bits, char *out) +{ + return fop_format_mode(bits, 1, 6, out); +} +#endif diff --git a/src/core/io_linux.c b/src/core/io_linux.c new file mode 100644 index 0000000..8a024aa --- /dev/null +++ b/src/core/io_linux.c @@ -0,0 +1,69 @@ +#include +#ifdef _WIN32 +#include +#include +#else +#include +#include +#endif + +int J; + +#ifdef _WIN32 +static int pk(void){int c=getchar();ungetc(c,stdin);return c==EOF;} +char Q(void){int c=getchar();J=pk();return c;} +#else +/* input is read here, not through stdio, so the end-of-input flag J never blocks. + a client that keeps the pipe open (an editor talking to the language server) sends + one message and waits for the answer: peeking for the next byte after the last + one would wait for a message that comes only after the answer. so J is 1 only + when the end is known, and 0 when more may come. the output is flushed before + any read that can wait, for the same reason. */ +static unsigned char ib[65536]; +static int ip, in, ieof; +/* make a byte available. wait is 0 to look without waiting. returns 1 when one is ready */ +static int fill(int wait) +{ + int n; + if (ip < in) return 1; + if (ieof) return 0; + if (!wait) { + struct pollfd f; f.fd = 0; f.events = POLLIN; f.revents = 0; + if (poll(&f, 1, 0) <= 0) return 0; /* nothing yet: not the end, not a byte */ + } else fflush(stdout); + n = (int)read(0, ib, sizeof ib); + if (n <= 0) { ieof = 1; return 0; } + ip = 0; in = n; + return 1; +} +static int pk(void) { if (ip < in) return 0; if (ieof) return 1; fill(0); return ieof; } +char Q(void) +{ + int c; + if (!fill(1)) { J = 1; return (char)-1; } + c = ib[ip++]; + J = pk(); + return (char)c; +} +#endif +void G(char c){putchar(c);} + +static void init_io(void) { +#ifdef _WIN32 + _setmode(_fileno(stdin), _O_BINARY); + _setmode(_fileno(stdout), _O_BINARY); + J = pk(); +#else + J = pk(); +#endif +} + +#if defined(__GNUC__) || defined(__clang__) +__attribute__((constructor)) static void init(void) { init_io(); } +#elif defined(_MSC_VER) +#pragma section(".CRT$XCU", read) +static void __cdecl msc_init(void) { init_io(); } +__declspec(allocate(".CRT$XCU")) static void (__cdecl *msc_init_fn)(void) = msc_init; +#else +static void init(void) { init_io(); } +#endif diff --git a/src/core/io_win.c b/src/core/io_win.c new file mode 100644 index 0000000..e197353 --- /dev/null +++ b/src/core/io_win.c @@ -0,0 +1,25 @@ +/* Windows I/O port for tinyvm: provides Q, G and J with binary stdio */ +#include +#include +#include + +int J; +static int pk(void) { int c = _fgetc_nolock(stdin); if (c != EOF) _ungetc_nolock(c, stdin); return c == EOF; } +char Q(void) { int c = _fgetc_nolock(stdin); J = pk(); return (char)c; } +void G(char c) { _fputc_nolock(c, stdout); } + +static void init_io(void) { + _setmode(_fileno(stdin), _O_BINARY); + _setmode(_fileno(stdout), _O_BINARY); + J = pk(); +} + +#if defined(__GNUC__) || defined(__clang__) +__attribute__((constructor)) static void init(void) { init_io(); } +#elif defined(_MSC_VER) +#pragma section(".CRT$XCU", read) +static void __cdecl msc_init(void) { init_io(); } +__declspec(allocate(".CRT$XCU")) static void (__cdecl *msc_init_fn)(void) = msc_init; +#else +static void init(void) { init_io(); } +#endif diff --git a/src/core/memmap.h b/src/core/memmap.h new file mode 100644 index 0000000..b2ee787 --- /dev/null +++ b/src/core/memmap.h @@ -0,0 +1,53 @@ +/* machine map, in words. the default has the code area, the compiler tables, + the genome and the stacks first (PW words in all) and the heap last: it + starts at PW and grows at run time, up to MW words of memory. MW is the + host's memory size; the array behind it is untouched until the heap grows + into it. a smaller board is a different build: src/tools/genmap writes a + directory whose memmap.h and genome agree, and the C cores are compiled + against that directory. do not edit the numbers by hand in one file only. + + include genome.h before this header when both are in the translation + unit. the linked image's GORG then wins; it has to be the same value + this header would have defined. + + PW is the first word past the initial stacks. emitted code can add heap + segments, and native code-address tables grow with those reservations. + MW bounds data addresses. a fixed map (HEAP_GROW 0) has MW == PW. + + DSLIM and RSLIM are the interpreter's stack checks. a straight-line + block can push about 1024 words after the check, which is why the data + limit sits 1100 words above DSLO. the genome's prologue checks the current frame segment and adds another + segment when needed. */ +#ifndef MEMMAP_H +#define MEMMAP_H +#define PW 0x1C5000 +#define CODE_END 0x80000 +#define HEAP_LO 0x1C5000 +#define HEAP_HI 0x225000 +#define HEAP_GROW 1 +#ifndef MW +#define MW 0x8000000 +#endif +#if MW < HEAP_HI +#error MW is below the end of the initial heap +#endif +#define ZFP 0x90000 +#ifdef GORG +#if GORG != 0x114100 +#error genome GORG does not match this map +#endif +#else +#define GORG 0x114100 +#endif +#define FBOT 0x164100 +#define FTOP 0x1A4100 +#define RS0 0x1A4100 +#define MARK0 0x1B4100 +#define MARKN 0x8000 +#define DSLO 0x1BC100 +#define DSHI 0x1C4FF0 +#define DS0 DSHI +#define SYSGATE (ZFP + 2) +#define DSLIM (DSLO + 1100) +#define RSLIM (MARK0 - 8) +#endif diff --git a/src/core/stack.h b/src/core/stack.h new file mode 100644 index 0000000..49f347c --- /dev/null +++ b/src/core/stack.h @@ -0,0 +1,112 @@ +/* growing operand and return stacks share the runtime's buddy allocator. + allocation here cannot call vm code or collect: an overflowing return stack + has no room for an allocator call. the runtime registers its allocator and + stack globals once the heap is ready. addresses are vm word indices. */ +#ifndef TINYVM_STACK_H +#define TINYVM_STACK_H + +static Cell stack_control; +enum { + SC_FRAME_FLOOR, SC_FRAME_TOP, SC_FRAME_GUARD, + SC_DATA_LOW, SC_DATA_TOP, SC_DATA_NODE, + SC_RETURN_LOW, SC_RETURN_TOP, SC_RETURN_NODE, + SC_FREE, SC_STOP, SC_BUMP, SC_MAX, SC_HOLD_LOW, SC_HOLD_HIGH, SC_CUT, SC_GC_ACTIVE, SC_COUNT +}; + +/* the including core supplies stack_memory_grow and refreshes m if it moves. */ +static Cell stack_get(int slot) { Cell p = m[stack_control + slot]; return inmem(p) ? m[p] : 0; } +static void stack_set(int slot, Cell value) { Cell p = m[stack_control + slot]; if (inmem(p)) m[p] = value; } +static int stack_register(Cell control) +{ + int i; + if (control <= 0 || !inmem(control + SC_COUNT - 1)) return 0; + for (i = 0; i < SC_COUNT; i++) if (!inmem(m[control + i])) return 0; + if (!inmem(m[control + SC_FREE] + 31)) return 0; + stack_control = control; + return 1; +} +static void stack_push(Cell b, int k) +{ + Cell list = m[stack_control + SC_FREE], head; + if (k < 3 || k >= 31 || b < 0 || !inmem(b + 6) || list < 0 || !inmem(list + k)) return; + head = m[list + k]; + if (head && (head < 0 || !inmem(head + 6))) return; + m[b] = (Cell)1 << k; m[b + 1] = (Cell)k << 16; m[b + 2] = 0; + m[b + 3] = 0; m[b + 4] = 0; m[b + 5] = head; m[b + 6] = 0; + if (head) m[head + 6] = b; + m[list + k] = b; +} +static int stack_heap_grow(int k) +{ + Cell old = stack_get(SC_STOP), h = old - HEAP_LO, block = (Cell)1 << k; + Cell need = ((h + block - 1) / block + 1) * block, size = h * 2, off, part; + int c; + if (h <= 0 || (h & 7) || !HEAP_GROW || !stack_get(SC_MAX) || stack_get(SC_CUT) || stack_get(SC_HOLD_HIGH)) return 0; + if (size < need) size = need; + if (HEAP_LO + size > 0x7fffffff || !stack_memory_grow((UCell)(HEAP_LO + size))) { + size = need; + if (HEAP_LO + size > 0x7fffffff || !stack_memory_grow((UCell)(HEAP_LO + size))) return 0; + } + stack_set(SC_STOP, HEAP_LO + size); stack_set(SC_BUMP, HEAP_LO + size); + stack_set(SC_MAX, HEAP_LO + size); + off = h; + while (off < size) { + part = 8; c = 3; + while (part * 2 <= size - off && !(off % (part * 2))) { part *= 2; c++; } + stack_push(HEAP_LO + off, c); off += part; + } + return 1; +} +static Cell stack_allocate(Cell words) +{ + Cell list, b, next, other, p, i; + int k = 3, j, grown = 0; + if (!stack_control || words < 0 || words > 0x3ffffffa) return 0; + while (((Cell)1 << k) < words + 5) k++; + for (;;) { + list = m[stack_control + SC_FREE]; j = k; + if (list < 0 || !inmem(list + 31)) return 0; + while (j < 31 && !m[list + j]) j++; + if (j == 31) { + if (grown || !stack_heap_grow(k)) return 0; + grown = 1; continue; + } + b = m[list + j]; + if (b < 0 || !inmem(b + ((Cell)1 << j) - 1) || m[b] != ((Cell)1 << j) || (m[b + 1] & 65535)) return 0; + next = m[b + 5]; m[list + j] = next; + if (next) { if (!inmem(next + 6)) return 0; m[next + 6] = 0; } + while (j > k) { j--; other = b + ((Cell)1 << j); stack_push(other, j); } + if (stack_get(SC_HOLD_HIGH) && b < stack_get(SC_HOLD_HIGH) && b + ((Cell)1 << k) > stack_get(SC_HOLD_LOW)) { + m[b] = (Cell)1 << k; m[b + 1] = ((Cell)k << 16) | 2; + m[b + 2] = 0; m[b + 5] = 0; m[b + 6] = 0; continue; + } + p = b + 5; + m[b] = (Cell)1 << k; m[b + 1] = ((Cell)k << 16) | 1 | 512 | 1024 | (stack_get(SC_GC_ACTIVE) ? 2 : 0); + m[b + 2] = p ^ 0x2B7E1516; m[b + 3] = 0; m[b + 4] = -words - 1; + for (i = p; i < b + ((Cell)1 << k); i++) m[i] = 0; + return p; + } +} +static Cell stack_expand(int is_return, Cell minimum, Cell *sp, Cell *rp) +{ + int low_slot = is_return ? SC_RETURN_LOW : SC_DATA_LOW, top_slot = low_slot + 1, node_slot = low_slot + 2; + Cell low, top, capacity, used, node, oldnode, i, source; + if (!stack_control) return -1; + low = stack_get(low_slot); top = stack_get(top_slot); capacity = top - low; + used = is_return ? *rp - low : top - *sp; + if (capacity <= 0 || used < 0 || used > capacity + (is_return ? 8 : 0) || minimum < 0 || minimum > 0x3ffffff0) return -1; + if (minimum <= capacity) return capacity; + if (minimum < capacity * 2) minimum = capacity * 2; + node = stack_allocate(minimum + 16); + if (!node) return -1; + source = is_return ? low : *sp; + for (i = 0; i < used; i++) m[node + (is_return ? i : minimum - used + i)] = m[source + i]; + oldnode = stack_get(node_slot); + stack_set(low_slot, node); stack_set(top_slot, node + minimum); stack_set(node_slot, node); + if (is_return) *rp = node + used; else *sp = node + minimum - used; + if (oldnode >= 5 && inmem(oldnode - 4)) stack_push(oldnode - 5, (int)((m[oldnode - 4] >> 16) & 31)); + return minimum; +} +static Cell stack_data_limit(void) { return stack_control ? stack_get(SC_DATA_LOW) + 1100 : DSLIM; } +static Cell stack_return_limit(void) { return stack_control ? stack_get(SC_RETURN_TOP) : RSLIM; } +#endif diff --git a/src/js/extract_genome.js b/src/js/extract_genome.js new file mode 100644 index 0000000..5cb2b38 --- /dev/null +++ b/src/js/extract_genome.js @@ -0,0 +1,45 @@ +const fs = require('fs'); +const path = require('path'); + +const srcPath = path.join(__dirname, '..', 'core', 'genome.h'); +const outPath = path.join(__dirname, 'genome.json'); + +const text = fs.readFileSync(srcPath, 'utf8'); +const gorgMatch = text.match(/#define\s+GORG\s+(\d+)/); +const glenMatch = text.match(/#define\s+GLEN\s+(\d+)/); + +const gorg = parseInt(gorgMatch[1], 10); +const glen = parseInt(glenMatch[1], 10); + +const arrMatch = text.match(/genome\[\]\s*=\s*\{([\s\S]*?)\};/); +if (!arrMatch) { + console.error('Could not find genome array in genome.h'); + process.exit(1); +} + +const words = arrMatch[1] + .split(',') + .map(s => s.trim()) + .filter(s => s.length > 0) + .map(s => s); // keep as string numbers + +console.log(`Parsed genome: GORG=${gorg}, GLEN=${words.length}`); + +if (words.length !== glen) throw new Error('genome length does not match GLEN'); + +// the compiler's map, from src/core/memmap.h, as typescript constants: the js vm reads +// them instead of its own copies. the values are computed here, from the map. +const { mapValues } = require('./mapvalues.js'); +const names = ['MW', 'PW', 'ZFP', 'GORG', 'DS0', 'DSLIM', 'RS0', 'RSLIM', 'SYSGATE', 'HEAP_LO', 'HEAP_HI']; +const map = mapValues(path.join(__dirname, '..', 'core', 'memmap.h'), names); +if (map.GORG !== gorg) throw new Error('genome GORG ' + gorg + ' is not the map GORG ' + map.GORG); +fs.writeFileSync(outPath, JSON.stringify({ gorg, glen, words })); +console.log(`saved genome to ${outPath}`); +const lines = names.map(k => ` ${k}: ${map[k]},`).join('\n'); +fs.writeFileSync(path.join(__dirname, 'layout.ts'), + '// generated by src/js/extract_genome.js from src/core/memmap.h. do not edit.\n' + + 'export const MAP = {\n' + lines + '\n} as const;\n'); +console.log(`Saved the map to ${path.join(__dirname, 'layout.ts')}`); +fs.writeFileSync(path.join(__dirname, 'layout.js'), + '// generated by src/js/extract_genome.js from src/core/memmap.h. do not edit.\n' + + 'exports.MAP = ' + JSON.stringify(map, null, 4) + ';\n'); diff --git a/src/js/extract_lsp.js b/src/js/extract_lsp.js new file mode 100644 index 0000000..6f53ebc --- /dev/null +++ b/src/js/extract_lsp.js @@ -0,0 +1,21 @@ +// writes src/js/lsp.json: the language server's image (build/lsp/genome.h, made by +// src/tools/mklsp.sh) and the map it was built for, read from build/lsp/map/memmap.h. +// the vm needs the layout, because the server's map is not the compiler's. +const fs = require('fs'); +const path = require('path'); + +const root = path.join(__dirname, '..', '..'); +const genome = fs.readFileSync(path.join(root, 'build', 'lsp', 'genome.h'), 'utf8'); + +const { mapValues } = require('./mapvalues.js'); +const layout = mapValues(path.join(root, 'build', 'lsp', 'map', 'memmap.h'), ['GORG', 'DS0', 'DSLIM', 'RS0', 'RSLIM', 'SYSGATE', 'ZFP', 'HEAP_LO', 'HEAP_HI']); + +const gorg = parseInt(genome.match(/#define\s+GORG\s+(\d+)/)[1], 10); +const glen = parseInt(genome.match(/#define\s+GLEN\s+(\d+)/)[1], 10); +const arr = genome.match(/genome\[\]\s*=\s*\{([\s\S]*?)\};/); +const words = arr[1].split(',').map(s => s.trim()).filter(s => s.length > 0); +if (words.length !== glen) throw new Error('genome has ' + words.length + ' words, GLEN says ' + glen); +if (gorg !== layout.GORG) throw new Error('genome GORG ' + gorg + ' is not the map GORG ' + layout.GORG); + +fs.writeFileSync(path.join(__dirname, 'lsp.json'), JSON.stringify({ gorg, glen, layout, words })); +console.log('wrote src/js/lsp.json: genome ' + glen + ' words at ' + gorg + ', heap ' + layout.HEAP_LO + '..' + layout.HEAP_HI); diff --git a/src/js/mapvalues.js b/src/js/mapvalues.js new file mode 100644 index 0000000..f701ba2 --- /dev/null +++ b/src/js/mapvalues.js @@ -0,0 +1,22 @@ +// reads the values of a machine map from its memmap.h. the #define lines may use +// other names and small sums (ZFP + 2, DSLO + 1100), so each value is evaluated +// with its names substituted. shared by extract_genome.js and extract_lsp.js. +const fs = require('fs'); + +function mapValues(mapPath, names) { + const text = fs.readFileSync(mapPath, 'utf8'); + const defs = {}; + for (const m of text.matchAll(/^#define[ \t]+(\w+)[ \t]+(.+)$/gm)) defs[m[1]] = m[2].trim(); + function value(name, depth = 0) { + if (depth > 20) throw new Error('map loop at ' + name); + const expr = defs[name]; + if (expr === undefined) throw new Error(mapPath + ' has no ' + name); + const sub = expr.replace(/\b[A-Za-z_]\w*\b/g, id => '(' + value(id, depth + 1) + ')'); + return Function('return (' + sub + ');')(); + } + const out = {}; + for (const k of names) out[k] = value(k); + return out; +} + +module.exports = { mapValues }; diff --git a/src/js/tinyvm.ts b/src/js/tinyvm.ts new file mode 100644 index 0000000..ab1e4da --- /dev/null +++ b/src/js/tinyvm.ts @@ -0,0 +1,946 @@ +/** + * the typescript and javascript vm follows the portable microcore. + * it uses 64-bit word memory, + * stacks, opcodes, hostcalls, enhancements, float and byte operations. + */ + +// node's own globals, for the command line runner at the end of this file. they are +// declared here and required where used, so building needs no @types/node +declare const process: any, require: any, module: any, __dirname: string, Buffer: any; +const fs: any = typeof require === 'function' ? require('fs') : undefined; +const path: any = typeof require === 'function' ? require('path') : undefined; + +// the compiler's map, computed from src/core/memmap.h at build time (src/js/layout.ts) +import { MAP } from './layout'; + +// float bits stay in vm words; arithmetic uses javascript's binary64 numbers. +const floatView = new DataView(new ArrayBuffer(8)); +function floatNumber(bits: bigint): number { + floatView.setBigInt64(0, bits, true); return floatView.getFloat64(0, true); +} +function floatBits(value: number): bigint { + floatView.setFloat64(0, value, true); return floatView.getBigInt64(0, true); +} +function floatInteger(bits: bigint): bigint { + const value = floatNumber(bits); + if (Number.isNaN(value)) return 0n; + if (value >= 9223372036854775808) return 9223372036854775807n; + if (value <= -9223372036854775808) return -9223372036854775808n; + return BigInt(Math.trunc(value)); +} +function floatSingle(bits: bigint): bigint { + const raw = BigInt.asUintN(64, bits), frac = raw & 0xfffffffffffffn; + if (((raw >> 52n) & 2047n) === 2047n && frac) return ((raw >> 63n) << 31n) | 0x7fc00000n | (frac >> 29n); + floatView.setFloat32(0, floatNumber(bits), true); return BigInt(floatView.getUint32(0, true)); +} +function floatDouble(bits: bigint): bigint { + const raw = bits & 0xffffffffn, frac = raw & 0x7fffffn; + if (((raw >> 23n) & 255n) === 255n && frac) return BigInt.asIntN(64, ((raw >> 31n) << 63n) | 0x7ff8000000000000n | (frac << 29n)); + floatView.setUint32(0, Number(raw), true); return floatBits(floatView.getFloat32(0, true)); +} +function parseFloatBits(text: string): bigint { + if (/^[+-]?inf$/i.test(text)) return floatBits(text[0] === '-' ? -Infinity : Infinity); + if (/^[+-]?nan$/i.test(text)) return BigInt.asIntN(64, text[0] === '-' ? 0xfff8000000000000n : 0x7ff8000000000000n); + const match = /^[+-]?(?:\d+\.?\d*|\.\d+)(?:[eE][+-]?\d+)?/.exec(text); + return floatBits(match ? Number(match[0]) : 0); +} +// exact decimal scaling keeps fixed and scientific output consistent with fops.h. +function formatFloat(bits: bigint, mode: bigint, precision: bigint): string { + const raw = BigInt.asUintN(64, bits), negative = (raw >> 63n) !== 0n; + const sign = negative ? '-' : '', exponent = Number((raw >> 52n) & 2047n), fraction = raw & 0xfffffffffffffn; + if (exponent === 2047) return fraction ? 'nan' : sign + 'inf'; + const sig = exponent ? fraction | (1n << 52n) : fraction, shift = exponent ? exponent - 1075 : -1074; + const scale = (places: number): string => { + let numerator = sig, denominator = 1n; + if (shift >= 0) numerator <<= BigInt(shift); else denominator <<= BigInt(-shift); + if (places >= 0) numerator *= 10n ** BigInt(places); else denominator *= 10n ** BigInt(-places); + return ((numerator * 2n + denominator) / (denominator * 2n)).toString(); + }; + if (mode === 1n) { + const places = Number(precision < 0n ? 0n : precision > 17n ? 17n : precision); + const digits = scale(places).padStart(places + 1, '0'); + return sign + (places ? digits.slice(0, -places) + '.' + digits.slice(-places) : digits); + } + const scientific = mode === 2n; + const places = Number(precision < 1n ? 1n : precision > 17n ? 17n : precision); + if (!sig) return sign + (scientific ? '0' + (places > 1 ? '.' + '0'.repeat(places - 1) : '') + 'e+0' : '0'); + const spell = (digits: string, decimal: number, useExponent: boolean): string => { + if (useExponent) return sign + digits[0] + (digits.length > 1 ? '.' + digits.slice(1) : '') + 'e' + (decimal < 0 ? '-' : '+') + Math.abs(decimal); + if (decimal < 0) return sign + '0.' + '0'.repeat(-decimal - 1) + digits; + const whole = decimal + 1; + return sign + (digits.length <= whole ? digits + '0'.repeat(whole - digits.length) : digits.slice(0, whole) + '.' + digits.slice(whole)); + }; + for (let count = scientific ? places : 1; count <= (scientific ? places : 18); count++) { + let decimal = Math.floor(Math.log10(Math.abs(floatNumber(bits)))); + let digits = scale(count - 1 - decimal); + while (digits.length !== count) { decimal += digits.length - count; digits = scale(count - 1 - decimal); } + const text = spell(digits, decimal, scientific || decimal < -4 || decimal > 15); + if (scientific || floatBits(Number(text)) === bits || count === 18) return text; + } + return sign + '0'; +} + +// the machine starts at the initial heap's end and grows on the heap's request (syscall 9, 4) +export const DEFAULT_MW = MAP.HEAP_HI; +export const GORG = MAP.GORG; +export const DS0 = MAP.DS0; +export const DSLIM = MAP.DSLIM; +export const RS0 = MAP.RS0; +export const RSLIM = MAP.RSLIM; +export const SYSGATE = MAP.SYSGATE; +export const XOP0 = 22; +export const NENH = 512; + +// micro-op opcode constants +export const U_LI = 0, U_MOV = 1, U_ADD = 2, U_SUB = 3, U_MUL = 4, U_SDIV = 5, U_UDIV = 6, U_SREM = 7, U_UREM = 8; +export const U_AND = 9, U_OR = 10, U_XOR = 11, U_SHL = 12, U_SHR = 13, U_SAR = 14, U_NEG = 15, U_NOT = 16; +export const U_LT = 17, U_LTU = 18, U_EQ = 19, U_NE = 20, U_MIN = 21, U_MAX = 22, U_MINU = 23, U_MAXU = 24; +export const U_MULHS = 25, U_MULHU = 26, U_CLZ = 27, U_ABS = 28, U_SEL = 29, U_LD = 30, U_ST = 31, + U_CTZ = 32, U_POPCNT = 33, U_BSWAP = 34, U_ROTL = 35, U_ROTR = 36, U_F2S = 37, U_S2F = 38; + +export const UNAMES = [ + "li", "mov", "add", "sub", "mul", "sdiv", "udiv", "srem", "urem", + "and", "or", "xor", "shl", "shr", "sar", "neg", "not", + "lt", "ltu", "eq", "ne", "min", "max", "minu", "maxu", + "mulhs", "mulhu", "clz", "abs", "sel", "ld", "st", + "ctz", "popcnt", "bswap", "rotl", "rotr", "f2s", "s2f" +]; + +/** where the image sits and how the map is laid out. the compiler's own genome + (the default) and the language server's have different maps, so the layout + is data, not constants: a program built for another map passes its own. */ +export interface Layout { + GORG: number; + DS0: number; + DSLIM: number; + RS0: number; + RSLIM: number; + SYSGATE: number; + ZFP: number; + HEAP_LO: number; + HEAP_HI: number; +} +export const DEFAULT_LAYOUT: Layout = { + GORG, DS0, DSLIM, RS0, RSLIM, SYSGATE, ZFP: MAP.ZFP, HEAP_LO: MAP.HEAP_LO, HEAP_HI: MAP.HEAP_HI, +}; +/** run() returns this when a streaming program waits for input. */ +export const BLOCKED = 3; + +export interface VMOptions { + memoryWords?: number; + maxMemoryWords?: number; + /** the map the program was built for; the default is the compiler's. */ + layout?: Partial; + /** streaming: input arrives in pieces (feed) and a get_c with nothing + buffered suspends the program instead of reading the end. resume() goes + on from there. eof() is true only once close() has been called. */ + streaming?: boolean; + input?: string | Uint8Array; + onOutput?: (byte: number) => void; + onMessage?: (msg: string) => void; + /** command line for the zc program, ops 21 and 22. empty means the program + was read from stdin, so argv[0] is on its own. */ + args?: string[]; + /** environment entries, ops 23 and 24, each a NAME=value string. */ + env?: string[]; +} + +export interface Enhancement { + live: boolean; + nin: number; + nout: number; + ops: MicroOp[]; + out: number[]; + nv: number; +} + +export interface MicroOp { + op: number; + d: number; + a: number; + b: number; + c: number; + imm: bigint; +} + +export class TinyVM { + public mem: BigInt64Array; + public bytes: Uint8Array; + public view: DataView; + public mw: number; + + private inputBuffer: Uint8Array = new Uint8Array(0); + private inputPos: number = 0; + private outputBuffer: number[] = []; + private onOutput?: (byte: number) => void; + private onMessage?: (msg: string) => void; + + private enh: Enhancement[] = []; + public L: Layout; + private streaming: boolean = false; + private closed: boolean = false; + private blocked: boolean = false; + private rp: number = 0; + private rs: number = 0; + private rr: number = 0; + private memoryLimit: number; + private stackControl = 0; + private args: string[]; + private env: string[]; + + constructor(options: VMOptions = {}) { + this.L = Object.assign({}, DEFAULT_LAYOUT, options.layout || {}); + const minimumWords = Math.max(this.L.HEAP_HI, this.L.DS0 + 16); + this.mw = options.memoryWords ?? minimumWords; + this.memoryLimit = options.maxMemoryWords ?? 0x7fffffff; + if (!Number.isSafeInteger(this.mw) || this.mw < minimumWords || + !Number.isSafeInteger(this.memoryLimit) || this.memoryLimit < this.mw || this.memoryLimit > 0x7fffffff) { + throw new RangeError('invalid initial memory or growth limit'); + } + this.streaming = !!options.streaming; + const buffer = new ArrayBuffer(this.mw * 8); + this.mem = new BigInt64Array(buffer); + this.bytes = new Uint8Array(buffer); + this.view = new DataView(buffer); + + this.onOutput = options.onOutput; + this.onMessage = options.onMessage; + this.args = options.args || []; + this.env = options.env || []; + + if (options.input) { + this.setInput(options.input); + } + + for (let i = 0; i < NENH; i++) { + this.enh.push({ live: false, nin: 0, nout: 0, ops: [], out: [], nv: 0 }); + } + } + + public setInput(input: string | Uint8Array): void { + if (typeof input === 'string') { + this.inputBuffer = new TextEncoder().encode(input); + } else { + this.inputBuffer = input; + } + this.inputPos = 0; + } + + /** streaming input: more bytes after what is already here. */ + public feed(input: string | Uint8Array): void { + const more = typeof input === 'string' ? new TextEncoder().encode(input) : input; + const rest = this.inputBuffer.subarray(this.inputPos); + const joined = new Uint8Array(rest.length + more.length); + joined.set(rest, 0); + joined.set(more, rest.length); + this.inputBuffer = joined; + this.inputPos = 0; + } + + /** no more input will come: a streaming program now reads the end. */ + public close(): void { + this.closed = true; + } + + /** true once the input is used up and nothing more can come. */ + private atEof(): boolean { + if (this.streaming && !this.closed) return false; + return this.inputPos >= this.inputBuffer.length; + } + + public loadGenome(words: (number | string | bigint)[], org: number = this.L.GORG): void { + for (let i = 0; i < words.length; i++) { + this.mem[org + i] = BigInt(words[i]); + } + } + + public getOutput(): string { + return new TextDecoder().decode(new Uint8Array(this.outputBuffer)); + } + + // stack controls and allocator headers use the same layout as stack.h. + private stackGet(slot: number): number { + return Number(this.mem[Number(this.mem[this.stackControl + slot])]); + } + private stackSet(slot: number, value: number): void { + this.mem[Number(this.mem[this.stackControl + slot])] = BigInt(value); + } + private stackRegister(control: number): boolean { + if (!Number.isSafeInteger(control) || control <= 0 || control + 16 >= this.mw) return false; + for (let i = 0; i < 17; i++) { + const address = Number(this.mem[control + i]); + if (!Number.isSafeInteger(address) || address < 0 || address >= this.mw) return false; + } + if (Number(this.mem[control + 9]) + 31 >= this.mw) return false; + this.stackControl = control; + return true; + } + private stackPush(block: number, sizeClass: number): void { + const list = Number(this.mem[this.stackControl + 9]), head = this.mem[list + sizeClass]; + this.mem[block] = BigInt(2 ** sizeClass); this.mem[block + 1] = BigInt(sizeClass * 65536); + this.mem[block + 2] = this.mem[block + 3] = this.mem[block + 4] = 0n; + this.mem[block + 5] = head; this.mem[block + 6] = 0n; + if (head) this.mem[Number(head) + 6] = BigInt(block); + this.mem[list + sizeClass] = BigInt(block); + } + private stackHeapGrow(sizeClass: number): boolean { + const heap = this.stackGet(10) - this.L.HEAP_LO, block = 2 ** sizeClass; + const need = (Math.ceil(heap / block) + 1) * block; + let size = Math.max(heap * 2, need); + if (!this.stackGet(12) || this.stackGet(15) || this.stackGet(14)) return false; + try { if (this.grow(this.L.HEAP_LO + size) < 0) throw new RangeError('stack growth limit'); } + catch { + size = need; + try { if (this.grow(this.L.HEAP_LO + size) < 0) return false; } catch { return false; } + } + this.stackSet(10, this.L.HEAP_LO + size); this.stackSet(11, this.L.HEAP_LO + size); + this.stackSet(12, this.L.HEAP_LO + size); + let offset = heap; + while (offset < size) { + let part = 8, k = 3; + while (part * 2 <= size - offset && offset % (part * 2) === 0) { part *= 2; k++; } + this.stackPush(this.L.HEAP_LO + offset, k); offset += part; + } + return true; + } + private stackAllocate(words: number): number { + if (!this.stackControl || words < 0 || words > 0x3ffffffa) return 0; + let k = 3, grown = false; + while (2 ** k < words + 5) k++; + while (true) { + const list = Number(this.mem[this.stackControl + 9]); + let j = k; + while (j < 31 && !this.mem[list + j]) j++; + if (j === 31) { + if (grown || !this.stackHeapGrow(k)) return 0; + grown = true; continue; + } + const block = Number(this.mem[list + j]); + if (block < 0 || block + 2 ** j > this.mw || this.mem[block] !== BigInt(2 ** j) || (this.mem[block + 1] & 65535n)) return 0; + const next = this.mem[block + 5]; this.mem[list + j] = next; + if (next) { if (Number(next) + 6 >= this.mw) return 0; this.mem[Number(next) + 6] = 0n; } + while (j > k) { j--; this.stackPush(block + 2 ** j, j); } + if (this.stackGet(14) && block < this.stackGet(14) && block + 2 ** k > this.stackGet(13)) { + this.mem[block] = BigInt(2 ** k); this.mem[block + 1] = BigInt(k * 65536 + 2); + this.mem[block + 2] = this.mem[block + 5] = this.mem[block + 6] = 0n; continue; + } + const pointer = block + 5; + this.mem[block] = BigInt(2 ** k); this.mem[block + 1] = BigInt(k * 65536 + 1537 + (this.stackGet(16) ? 2 : 0)); + this.mem[block + 2] = BigInt(pointer) ^ 0x2B7E1516n; this.mem[block + 3] = 0n; this.mem[block + 4] = -BigInt(words) - 1n; + this.mem.fill(0n, pointer, block + 2 ** k); + return pointer; + } + } + private stackExpand(isReturn: boolean, minimum: number, s: number, r: number): number[] | null { + if (!this.stackControl || !Number.isSafeInteger(minimum) || minimum < 0 || minimum > 0x3ffffff0) return null; + const slot = isReturn ? 6 : 3, low = this.stackGet(slot), top = this.stackGet(slot + 1); + const capacity = top - low, used = isReturn ? r - low : top - s; + if (capacity <= 0 || used < 0 || used > capacity + (isReturn ? 8 : 0)) return null; + if (minimum <= capacity) return [s, r, capacity]; + minimum = Math.max(minimum, capacity * 2); + const node = this.stackAllocate(minimum + 16); + if (!node) return null; + const source = isReturn ? low : s, destination = isReturn ? node : node + minimum - used; + this.mem.copyWithin(destination, source, source + used); + const old = this.stackGet(slot + 2); + this.stackSet(slot, node); this.stackSet(slot + 1, node + minimum); this.stackSet(slot + 2, node); + if (old) this.stackPush(old - 5, Number((this.mem[old - 4] >> 16n) & 31n)); + this.L.DSLIM = this.stackGet(3) + 1100; this.L.RSLIM = this.stackGet(7); + return isReturn ? [s, node + used, minimum] : [node + minimum - used, r, minimum]; + } + + /** the next byte, -1 at the end, or BLOCKED when a streaming program has + to wait for more input. */ + private get_c(): number { + if (this.inputPos >= this.inputBuffer.length) { + if (this.streaming && !this.closed) return BLOCKED; + return -1; + } + return this.inputBuffer[this.inputPos++]; + } + + private put_c(c: number): void { + const b = c & 0xFF; + this.outputBuffer.push(b); + if (this.onOutput) { + this.onOutput(b); + } + } + + /** the machine's memory grows to words; the old words stay where they were. returns the new size. */ + private grow(words: number): number { + if (!Number.isSafeInteger(words) || words < 0 || words > this.memoryLimit) return -1; + if (words <= this.mw) return this.mw; + const buf = new ArrayBuffer(words * 8); + new Uint8Array(buf).set(this.bytes.subarray(0, this.mw * 8)); + this.mem = new BigInt64Array(buf); + this.bytes = new Uint8Array(buf); + this.view = new DataView(buf); + this.mw = words; + return words; + } + + private syscall(op: bigint, a: bigint, b: bigint, c: bigint): bigint { + const opNum = Number(op); + switch (opNum) { + case 1: // open + return -1n; + case 2: // close + return 0n; + case 3: // read + return 0n; + case 4: { // write(fd, buf, n) + const n = Number(c); + const bufAddr = Number(b); + for (let i = 0; i < n; i++) { + const ch = Number(this.mem[bufAddr + i] & 0xFFn); + this.put_c(ch); + } + return c; + } + case 5: // getenv + return -1n; + case 6: // time + return BigInt(Math.floor(Date.now() / 1000)); + case 7: // exit + return 0n; + case 8: // rand + return BigInt(Math.floor(Math.random() * 0x7FFFFFFF)); + case 9: { // memory info; a = 4 grows the machine to b words (the heap asks for it) + if (a === 4n) { + try { return BigInt(this.grow(Number(b))); } catch { return -1n; } + } + if (a === 0n) return BigInt(this.mw); + if (a === 1n) return BigInt(this.L.HEAP_LO); + if (a === 2n) return BigInt(this.L.HEAP_HI); + if (a === 3n) return BigInt(this.mw * 8); + if (a === 5n) { + const words = Number(b); + if (!Number.isSafeInteger(words) || words < this.mw || words > 0x7fffffff) return -1n; + this.memoryLimit = words; return b; + } + if (a === 9n) return b > 0n && b <= BigInt(this.mw) ? BigInt(this.mw) : -1n; + if (a === 6n) return this.stackRegister(Number(b)) ? 0n : -1n; + if (a === 7n || a === 8n) { + const moved = this.stackExpand(a === 8n, Number(b), this.rs, this.rr); + if (!moved) return -1n; + [this.rs, this.rr] = moved; + return BigInt(moved[2]); + } + return -1n; + } + case 18: { // fill heap words without running one vm store per word + if (a < BigInt(this.L.HEAP_LO) || c <= 0n || a > BigInt(this.mw) || c > BigInt(this.mw) - a) return -1n; + this.mem.fill(b, Number(a), Number(a + c)); return c; + } + case 19: { // forward word copy; a forward overlap keeps the vm-loop path + if (a < BigInt(this.L.HEAP_LO) || b < 0n || c <= 0n || a > BigInt(this.mw) || b > BigInt(this.mw) || c > BigInt(this.mw) - a || c > BigInt(this.mw) - b) return -1n; + if (a > b && a < b + c) return -1n; + this.mem.copyWithin(Number(a), Number(b), Number(b + c)); return c; + } + case 20: { // skip words that cannot be live heap pointers during collection + if (a < 0n || b < 0n || a > BigInt(this.mw) || b > BigInt(this.mw) - a) return -1n; + const begin = Number(a), count = Number(b), low = BigInt(this.L.HEAP_LO + 5); + for (let i = 0; i < count; i++) { + const word = this.mem[begin + i]; + if (word >= low && word < c && word < BigInt(this.mw) && this.mem[Number(word) - 3] === (word ^ 0x2b7e1516n)) return BigInt(i); + } + return b; + } + case 21: // argc: on its own when there is no program file name + return BigInt(this.args.length ? this.args.length : 1); + case 22: { // argv(i, buf, cap): a zero buffer asks for the length only + const i = Number(a); + const s = (i === 0 && this.args.length === 0) ? '' : this.args[i]; + if (s === undefined) return -1n; + if (b === 0n) return BigInt(s.length); + const addr = Number(b); + const cap = Number(c); + if (cap < 1 || addr < 0 || addr + cap > this.mw) return -1n; + const n = Math.min(s.length, cap - 1); + for (let k = 0; k < n; k++) this.mem[addr + k] = BigInt(s.charCodeAt(k)); + this.mem[addr + n] = 0n; + return BigInt(n); + } + case 23: // envc + return BigInt(this.env.length); + case 24: { // envp, shaped like argv + const s = this.env[Number(a)]; + if (s === undefined) return -1n; + if (b === 0n) return BigInt(s.length); + const addr = Number(b); + const cap = Number(c); + if (cap < 1 || addr < 0 || addr + cap > this.mw) return -1n; + const n = Math.min(s.length, cap - 1); + for (let k = 0; k < n; k++) this.mem[addr + k] = BigInt(s.charCodeAt(k)); + this.mem[addr + n] = 0n; + return BigInt(n); + } + default: + return -1n; + } + } + + private evMicroOp(op: number, a: bigint, b: bigint, c: bigint): bigint { + const ua = BigInt.asUintN(64, a); + const ub = BigInt.asUintN(64, b); + const sh = Number(b & 63n); + + switch (op) { + case U_LI: return a; + case U_MOV: return a; + case U_ADD: return BigInt.asIntN(64, a + b); + case U_SUB: return BigInt.asIntN(64, a - b); + case U_MUL: return BigInt.asIntN(64, a * b); + case U_SDIV: return b === 0n ? 0n : BigInt.asIntN(64, a / b); + case U_UDIV: return ub === 0n ? 0n : BigInt.asIntN(64, BigInt(ua / ub)); + case U_SREM: return b === 0n ? a : BigInt.asIntN(64, a % b); + case U_UREM: return ub === 0n ? a : BigInt.asIntN(64, BigInt(ua % ub)); + case U_AND: return a & b; + case U_OR: return a | b; + case U_XOR: return a ^ b; + case U_SHL: return BigInt.asIntN(64, a << BigInt(sh)); + case U_SHR: return BigInt.asIntN(64, BigInt(ua >> BigInt(sh))); + case U_SAR: return a >> BigInt(sh); + case U_NEG: return BigInt.asIntN(64, -a); + case U_NOT: return ~a; + case U_LT: return a < b ? 1n : 0n; + case U_LTU: return ua < ub ? 1n : 0n; + case U_EQ: return a === b ? 1n : 0n; + case U_NE: return a !== b ? 1n : 0n; + case U_MIN: return a < b ? a : b; + case U_MAX: return a > b ? a : b; + case U_MINU: return ua < ub ? a : b; + case U_MAXU: return ua > ub ? a : b; + case U_MULHS: return BigInt.asIntN(64, (a * b) >> 64n); + case U_MULHU: return BigInt.asIntN(64, (ua * ub) >> 64n); + case U_CLZ: return ua === 0n ? 64n : BigInt(64 - ua.toString(2).length); + case U_CTZ: { if (ua === 0n) return 64n; let n = 0n, x = ua; while (!(x & 1n)) { x >>= 1n; n++; } return n; } + case U_POPCNT: { let n = 0n, x = ua; while (x) { x &= x - 1n; n++; } return n; } + case U_BSWAP: { let r = 0n, x = ua; for (let i = 0; i < 8; i++) { r = (r << 8n) | (x & 0xffn); x >>= 8n; } return BigInt.asIntN(64, r); } + case U_ROTL: return BigInt.asIntN(64, (ua << BigInt(sh)) | (ua >> BigInt((64 - sh) & 63))); + case U_ROTR: return BigInt.asIntN(64, (ua >> BigInt(sh)) | (ua << BigInt((64 - sh) & 63))); + case U_F2S: return floatSingle(a); + case U_S2F: return floatDouble(a); + case U_ABS: return a < 0n ? BigInt.asIntN(64, -a) : a; + case U_SEL: return a !== 0n ? b : c; + default: return 0n; + } + } + + private wordText(address: number): string { + let text = ''; + while (address >= 0 && address < this.mw) { + const value = this.mem[address++]; + if (!value) return text; + text += String.fromCharCode(Number(value & 255n)); + } + throw new Error('recipe string outside memory'); + } + + private parseRecipe(pay: number, namesAddr: number, nin: number, nout: number): { ops: MicroOp[], out: number[], nv: number } { + const ops: MicroOp[] = [], names = new Map(); + const current = Array.from({ length: 16 }, (_, i) => i < nin ? i : -1); + const arity = [0, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 3, 1, 2, 1, 1, 1, 2, 2, 1, 1]; + let next = nin; + const append = (op: number, args: number[], imm = 0n): number => { + const d = next++; + ops.push({ op, d, a: args[0] ?? 0, b: args[1] ?? 0, c: args[2] ?? 0, imm }); + return d; + }; + for (let i = 0; i < nin; i++) names.set(this.wordText(Number(this.mem[namesAddr + i])), i); + const register = (name: string): number => { + const match = /^r(\d+)$/.exec(name); + const index = match ? Number(match[1]) : names.get(name); + if (index === undefined || index < 0 || index > 15) throw new Error('unknown recipe register'); + return index; + }; + const value = (index: number): number => { + if (current[index] < 0) current[index] = append(U_LI, [], 0n); + return current[index]; + }; + const operand = (token: string): number => { + const numeric = /^([+-]?)(0[xX][0-9a-fA-F]+|\d+)$/.exec(token); + if (numeric) return append(U_LI, [], BigInt.asIntN(64, (numeric[1] === '-' ? -1n : 1n) * BigInt(numeric[2]))); + return value(register(token)); + }; + for (const statement of this.wordText(pay).split(/[;\n]/).map(text => text.trim()).filter(Boolean)) { + const store = /^st(?:\s|$)/.test(statement); + const match = store ? null : /^(\S+)\s*=\s*(.+)$/.exec(statement); + if (!store && !match) throw new Error('malformed recipe assignment'); + const destination = store ? -1 : register(match![1]); + const tokens = (store ? statement.slice(2) : match![2]).trim().split(/\s+/); + let op = store ? U_ST : -1; + if (!store && tokens.length > 1) { + op = UNAMES.indexOf(tokens.shift()!); + if (op < 0) throw new Error('unknown recipe operation'); + } + const args = tokens.map(operand); + if (op < 0 || op === U_MOV || op === U_LI) { + if (args.length !== 1) throw new Error('wrong recipe arity'); + current[destination] = args[0]; + } else { + if (args.length !== arity[op]) throw new Error('wrong recipe arity'); + const result = append(op, args); + if (!store) current[destination] = result; + } + } + return { ops, out: Array.from({ length: nout }, (_, i) => value(i)), nv: next }; + } + + private lowerVM(pay: number, length: number, nin: number, nout: number): { ops: MicroOp[], out: number[], nv: number } { + const ops: MicroOp[] = [], stack = Array.from({ length: nin }, (_, i) => i); + const map = [U_ADD, U_SUB, U_MUL, U_AND, U_OR, U_XOR, U_SAR, U_LT]; + const constants = new Map(); + let next = nin; + const append = (op: number, args: number[], imm = 0n): number => { + const d = next++; + ops.push({ op, d, a: args[0] ?? 0, b: args[1] ?? 0, c: 0, imm }); + if (op === U_LI) constants.set(d, imm); + return d; + }; + const require = (count: number): void => { if (stack.length < count) throw new Error('invalid vm recipe stack'); }; + for (let i = 0; i < length; i++) { + const word = this.mem[pay + i]; + if (word & 1n) { stack.push(append(U_LI, [], word >> 1n)); continue; } + const op = Number(word >> 1n); + if (op === 9) break; + if (op === 1) { require(1); stack.push(append(U_LD, [stack.pop()!])); } + else if (op === 2) { require(2); const address = stack.pop()!, value = stack.pop()!; append(U_ST, [address, value]); } + else if (op === 3) { + require(1); + const depth = constants.get(stack.pop()!); + if (depth === undefined || depth < 0n || depth >= BigInt(stack.length)) throw new Error('invalid vm recipe pick'); + stack.push(stack[stack.length - 1 - Number(depth)]); + } else if (op === 4) { require(1); stack.pop(); } + else if (op === 5) { require(2); const a = stack.pop()!, b = stack.pop()!; stack.push(a, b); } + else if (op >= 13 && op <= 20) { require(2); const a = stack.pop()!, b = stack.pop()!; stack.push(append(map[op - 13], [b, a])); } + else throw new Error('unsupported vm recipe operation'); + } + if (stack.length !== nout) throw new Error('wrong vm recipe output count'); + return { ops, out: stack, nv: next }; + } + + private install(descAddr: bigint): bigint { + const addr = Number(descAddr); + if (!Number.isSafeInteger(addr) || addr < 0 || addr + 6 >= this.mw) return -1n; + const slot = Number(this.mem[addr]), kind = Number(this.mem[addr + 1]); + // optimizer-region descriptors leave micro-op slots intact on portable hosts. + if (kind === 2) return 0n; + const nin = Number(this.mem[addr + 2]), nout = Number(this.mem[addr + 3]); + const pay = Number(this.mem[addr + 4]), length = Number(this.mem[addr + 5]), names = Number(this.mem[addr + 6]); + if (slot < 0 || slot >= NENH || nin < 0 || nin > 8 || nout < 0 || nout > 8 || (kind !== 0 && kind !== 1)) return -1n; + if (pay < 0 || pay >= this.mw || names < 0 || names + nin > this.mw) return -1n; + if (kind === 1 && (length < 0 || length > 100000 || length > this.mw - pay)) return -5n; + try { + const parsed = kind === 0 ? this.parseRecipe(pay, names, nin, nout) : this.lowerVM(pay, length, nin, nout); + this.enh[slot] = { live: true, nin, nout, ...parsed }; + return 0n; + } catch { + return kind === 0 ? -2n : -4n; + } + } + + private xrun(enh: Enhancement, s: number): number { + const xv: bigint[] = new Array(enh.nv).fill(0n); + + for (let j = 0; j < enh.nin; j++) { + xv[j] = this.mem[s + enh.nin - 1 - j]; + } + + for (const u of enh.ops) { + if (u.op === U_LI) { + xv[u.d] = u.imm; + } else if (u.op === U_LD) { + const addr = Number(xv[u.a]); + xv[u.d] = (addr >= 0 && addr < this.mw) ? this.mem[addr] : 0n; + } else if (u.op === U_ST) { + const addr = Number(xv[u.a]); + if (addr >= 0 && addr < this.mw) this.mem[addr] = xv[u.b]; + } else { + xv[u.d] = this.evMicroOp(u.op, xv[u.a], xv[u.b], xv[u.c]); + } + } + + s = s + enh.nin - enh.nout; + for (let j = 0; j < enh.nout; j++) { + this.mem[s + enh.nout - 1 - j] = xv[enh.out[j]]; + } + return s; + } + + /** runs the image from entryPc. returns 0 when it halts, BLOCKED when a + streaming program waits for input (then feed() and resume()). */ + public run(entryPc: number = this.L.GORG): number { + return this.exec(entryPc, this.L.DS0, this.L.RS0); + } + + /** goes on from a BLOCKED run, once input has been fed. */ + public resume(): number { + if (!this.blocked) return 0; + this.blocked = false; + return this.exec(this.rp, this.rs, this.rr); + } + + private exec(p0: number, s0: number, r0: number): number { + let p = p0; + let s = s0; + let r = r0; + + // the machine's memory can grow in a syscall, so these are read again after one + let mem = this.mem; + let bytes = this.bytes; + let view = this.view; + let mw = this.mw; + + while (p < mw) { + if (s < this.L.DSLIM || r > this.L.RSLIM) { + const isReturn = r > this.L.RSLIM, slot = isReturn ? 6 : 3; + const moved = this.stackControl ? this.stackExpand(isReturn, this.stackGet(slot + 1) - this.stackGet(slot) + 1, s, r) : null; + if (!moved) { + if (this.onMessage) this.onMessage(isReturn ? "zy: return stack overflow\n" : "zy: data stack overflow\n"); + return 2; + } + [s, r] = moved; + mem = this.mem; bytes = this.bytes; view = this.view; mw = this.mw; + } + + const w = mem[p++]; + if ((w & 1n) !== 0n) { + mem[--s] = w >> 1n; + continue; + } + + const op = Number(w >> 1n); + const a = mem[s]; + const b = mem[s + 1]; + + switch (op) { + case 1: // ld + mem[s] = (Number(a) >= 0 && Number(a) < mw) ? mem[Number(a)] : 0n; + break; + case 2: // st + if (Number(a) === this.L.SYSGATE) { + this.rs = s + 2; this.rr = r; + const result = this.syscall(b, mem[Number(a) + 1], mem[Number(a) + 2], mem[Number(a) + 3]); + mem = this.mem; bytes = this.bytes; view = this.view; mw = this.mw; // a grow may have moved them + mem[Number(a)] = result; + s = this.rs; r = this.rr; + break; + } else if (Number(a) >= 0 && Number(a) < mw) { + mem[Number(a)] = b; + } + s += 2; + break; + case 3: { // pick follows the same bounds as a word load + const address = s + 1 + Number(a); + mem[s] = address >= 0 && address < mw ? mem[address] : 0n; + break; + } + case 4: // drop + s++; + break; + case 5: // swap + mem[s] = b; + mem[s + 1] = a; + break; + case 6: // call + mem[r++] = BigInt(p); + p = Number(a); + s++; + break; + case 7: // jmp + p = Number(a); + s++; + break; + case 8: // jz + if (b === 0n) p = Number(a); + s += 2; + break; + case 9: // ret + p = Number(mem[--r]); + break; + case 10: { // get_c + const ch = this.get_c(); + if (ch === BLOCKED) { + // the get_c op runs again when there is input: back to it, stacks as they are + this.rp = p - 1; this.rs = s; this.rr = r; this.blocked = true; + return BLOCKED; + } + mem[--s] = BigInt(ch); + break; + } + case 11: // eof + mem[--s] = this.atEof() ? 1n : 0n; + break; + case 12: // put_c + this.put_c(Number(a & 0xFFn)); + s++; + break; + case 13: // add + mem[++s] = BigInt.asIntN(64, b + a); + break; + case 14: // sub + mem[++s] = BigInt.asIntN(64, b - a); + break; + case 15: // mul + mem[++s] = BigInt.asIntN(64, b * a); + break; + case 16: // and + mem[++s] = b & a; + break; + case 17: // or + mem[++s] = b | a; + break; + case 18: // xor + mem[++s] = b ^ a; + break; + case 19: // sar + mem[++s] = b >> (a & 63n); + break; + case 20: // lt + mem[++s] = b < a ? 1n : 0n; + break; + case 21: // install + mem[s] = this.install(a); + break; + + // float operations use the same stack effects as the portable core. + case 600: + if (p >= mw) return 0; + mem[--s] = mem[p++]; break; + case 601: mem[++s] = floatBits(floatNumber(b) + floatNumber(a)); break; + case 602: mem[++s] = floatBits(floatNumber(b) - floatNumber(a)); break; + case 603: mem[++s] = floatBits(floatNumber(b) * floatNumber(a)); break; + case 604: mem[++s] = floatBits(floatNumber(b) / floatNumber(a)); break; + case 605: mem[++s] = floatNumber(b) === floatNumber(a) ? 1n : 0n; break; + case 606: mem[++s] = floatNumber(b) < floatNumber(a) ? 1n : 0n; break; + case 607: mem[++s] = floatNumber(b) <= floatNumber(a) ? 1n : 0n; break; + case 608: mem[s] = floatBits(Number(a)); break; + case 609: mem[s] = floatInteger(a); break; + case 610: { + const text = formatFloat(a, 1n, 6n); + for (const char of text) this.put_c(char.charCodeAt(0)); + s++; break; + } + case 611: { + let text = '', address = Number(a); + while (address >= 0 && address < mw && mem[address]) text += String.fromCharCode(Number(mem[address++] & 255n)); + mem[s] = parseFloatBits(text); break; + } + case 618: { + const text = formatFloat(mem[s + 2], a, b); + for (const char of text) this.put_c(char.charCodeAt(0)); + s += 3; break; + } + + // byte ops + case 612: { // ld8 + const addr = Number(a); + mem[s] = (addr >= 0 && addr < mw * 8) ? BigInt(bytes[addr]) : 0n; + break; + } + case 613: { // st8 + const addr = Number(a); + if (addr >= 0 && addr < mw * 8) bytes[addr] = Number(b & 0xFFn); + s += 2; + break; + } + case 614: { // ld16 + const addr = Number(a); + mem[s] = (addr >= 0 && addr + 1 < mw * 8) ? BigInt(view.getUint16(addr, true)) : 0n; + break; + } + case 615: { // st16 + const addr = Number(a); + if (addr >= 0 && addr + 1 < mw * 8) view.setUint16(addr, Number(b & 0xFFFFn), true); + s += 2; + break; + } + case 616: { // ld32 + const addr = Number(a); + mem[s] = (addr >= 0 && addr + 3 < mw * 8) ? BigInt(view.getUint32(addr, true)) : 0n; + break; + } + case 617: { // st32 + const addr = Number(a); + if (addr >= 0 && addr + 3 < mw * 8) view.setUint32(addr, Number(b & 0xFFFFFFFFn), true); + s += 2; + break; + } + case 619: // push s + mem[--s] = BigInt(s + 1); + break; + case 620: { // a native call: no native code here, pop the arguments and answer -1 + const blk = Number(a); + const sig = blk >= 0 && blk + 1 < mw ? BigInt.asUintN(64, mem[blk + 1]) : 0n; + let n = 0; + while (n < 15 && ((sig >> BigInt(4 * (n + 1))) & 15n)) n++; + s += n; + mem[s] = -1n; + break; + } + + default: + // custom enhancement + if (op >= XOP0 && op < XOP0 + NENH && this.enh[op - XOP0].live) { + s = this.xrun(this.enh[op - XOP0], s); + } else { + p = mw; + } + break; + } + } + + return 0; + } +} + +// command line runner: node src/js/tinyvm.js , or the source on stdin +if (typeof require === 'function' && typeof module !== 'undefined' && require.main === module) { + const genomePath = path.join(__dirname, 'genome.json'); + if (!fs.existsSync(genomePath)) { + console.error('Error: genome.json not found. Run extract_genome.js first.'); + process.exit(1); + } + + const genomeData = JSON.parse(fs.readFileSync(genomePath, 'utf8')); + let inputSource = ''; + + if (process.argv.length > 2) { + const filePath = process.argv[2]; + if (fs.existsSync(filePath)) { + inputSource = fs.readFileSync(filePath, 'utf8'); + } else { + console.error(`Error: File not found: ${filePath}`); + process.exit(1); + } + } else { + try { + inputSource = fs.readFileSync(0, 'utf8'); + } catch (e) { + console.error('Usage: node tinyvm.js '); + process.exit(1); + } + } + + const environmentWords = (name: string): number | undefined => { + const value = process.env[name]; + if (value === undefined) return undefined; + if (!/^(?:[0-9]+|0x[0-9a-f]+)$/i.test(value)) throw new RangeError('invalid ' + name); + return Number(value); + }; + const vm = new TinyVM({ + memoryWords: environmentWords('TINYVM_MEMORY_WORDS'), + maxMemoryWords: environmentWords('TINYVM_MAX_MEMORY_WORDS'), + onOutput: (byte: number) => process.stdout.write(Buffer.from([byte])), + onMessage: (msg: string) => process.stderr.write(msg) + }); + + vm.loadGenome(genomeData.words, genomeData.gorg); + vm.setInput(inputSource); + const code = vm.run(genomeData.gorg); + process.exit(code); +} + +if (typeof module !== 'undefined') module.exports = { TinyVM, DEFAULT_MW, GORG }; diff --git a/src/lib/std.zc b/src/lib/std.zc new file mode 100644 index 0000000..375f403 --- /dev/null +++ b/src/lib/std.zc @@ -0,0 +1,455 @@ +// small helpers for strings, files, the clock and byte buffers. not part of the +// genome; include it with: include "src/lib/std.zc"; +// syscall numbers (SYS_OPEN and the rest) live in the runtime. +// a string here is a word string, one character per word and a 0 at the end, +// which is char*. the Bytes group takes packed byte strings (b"..."), whose +// type is a plain word. +// the helpers are grouped in structs, and each is a static function, so it is +// called as Group.name(args): Text.itoa(n, buf), Host.now(), Buf.get(b, 0). +// the constructors arena(n) and bnew(n) and the argv helpers are plain +// functions, because an owned result has to carry its .u tag. + +// ---- the command line and the environment ---- + +// argc and argv, envc and envp, the way c hands them to main. a zc string is +// one character per word, so an array of them is []char*. libinit() fills +// these and the runtime calls it before main, if the program has one (an +// image built by build_image, or a check-mode document, does not). +int argc; +[]char* argv; +int envc; +[]char* envp; + +// one entry of a vector syscall, as a fresh string, or 0 past the end. +// op: the syscall that fetches an entry (SYS_ARG or SYS_ENV) +// i: which entry +// returns: the entry, owned by the caller; 0 when there is no entry i +unchecked char*.u argstr(int op, int i) { + int n = syscall(op, i, 0, 0); + char* s; + if (n < 0) return 0; + s = new(n + 1); + syscall(op, i, s, n + 1); + return s; +} + +// every entry of a vector syscall, in order. +// cntop: the syscall that counts the entries (SYS_ARGC or SYS_ENVC) +// stop: the syscall that fetches one (SYS_ARG or SYS_ENV) +// returns: a new array of the strings, owned by the caller +unchecked []char*.u argsvec(int cntop, int stop) { + int n = syscall(cntop, 0, 0, 0), i = 0; + []char* a = new([]char*, 0); + while (i < n) { push(a, argstr(stop, i)); i++; } + return a; +} + +// reads the command line and the environment into argc, argv, envc and envp. +// it stays a plain function: the compiler looks it up by name. +// returns: 0 +int libinit() { + argv = argsvec(SYS_ARGC, SYS_ARG); + envp = argsvec(SYS_ENVC, SYS_ENV); + argc = len(argv); envc = len(envp); + return 0; +} + +// ---- capturing output ---- + +// capture.start() redirects everything the program writes into a string and +// hands it back. writes go to the buffer instead of the terminal until end() +// stops it, so the buffer is a string once end() has run: +// let buf = capture.start(); +// put_s("hello world!"); // nothing on the terminal +// buf.end(); +// put_s(buf); // hello world +// one capture at a time, and the buffer belongs to whoever holds it. +struct capture { + // starts a capture of the output. + // returns: the buffer, a word on purpose: the method end() is looked up on + // any receiver the compiler cannot type, and a typed one has none + static word start() { + int cap = 256; + outmode = 2; outn = 0; outcap = cap; + outbuf = new(cap); + return outbuf; + } + + // stops the capture and terminates the buffer. + // returns: the string it collected (this is the buffer) + word end() { + outbuf[outn] = 0; + outmode = 0; outbuf = 0; outn = 0; outcap = 0; + return this; + } +} + +// ---- word strings ---- + +struct Text { + // the number written in decimal at the start of s. a leading '-' makes it + // negative and the first character that is not a digit ends it. + // s: the string to read + // returns: the number, 0 when s starts with no digit + static int atoi(char* s) { + int n = 0, i = 0, sign = 1; + if (s[0] == '-') { sign = 0 - 1; i = 1; } + while (s[i] >= '0' && s[i] <= '9') { n = n * 10 + s[i] - '0'; i++; } + return n * sign; + } + + // writes n in decimal into dst, with a 0 after it. + // n: the number + // dst: where the text goes; 24 words is always enough + // returns: how many characters were written, not counting the 0 + static int itoa(int n, char* dst) { + int b[24], i = 0, j = 0, neg = 0; + if (!n) { dst[0] = '0'; dst[1] = 0; return 1; } + if (n < 0) { neg = 1; n = 0 - n; } + if (n < 0) { copy_w(dst, "-9223372036854775808", 21); return 20; } + while (n) { b[i] = '0' + n % 10; i++; n = n / 10; } + if (neg) { dst[0] = '-'; j = 1; } + while (i) { i--; dst[j] = b[i]; j++; } + dst[j] = 0; + return j; + } + + // joins two strings. + // dst: where the result goes, with room for both and a 0; not a or b + // a: the first string + // b: the second string + // returns: the length of the result + static int cat(char* dst, char* a, char* b) { + int i = 0, j = 0; + while (a[i]) { dst[j] = a[i]; i++; j++; } + i = 0; + while (b[i]) { dst[j] = b[i]; i++; j++; } + dst[j] = 0; + return j; + } + + // does s begin with pfx? + // s: the string to test + // pfx: the beginning to look for + // returns: 1 if it does (always, for an empty pfx), 0 if not + static int starts(char* s, char* pfx) { + int i = 0; + while (pfx[i]) { if (s[i] != pfx[i]) return 0; i++; } + return 1; + } + + // how many characters come before the 0. + // s: the string + // returns: the length, not counting the 0 + static int len(char* s) { + int n = 0; + while (s[n]) n++; + return n; + } + + // are the two strings the same, character for character? + // a, b: the strings to compare + // returns: 1 if they are equal, 0 if not + static int eq(char* a, char* b) { + int i = 0; + while (a[i] && a[i] == b[i]) i++; + return a[i] == b[i]; + } + + // copies s into dst, with a 0 after it. + // dst: where the copy goes, with room for s and the 0 + // s: the string to copy + // returns: the length of the copy + static int copy(char* dst, char* s) { + int i = 0; + while (s[i]) { dst[i] = s[i]; i++; } + dst[i] = 0; + return i; + } + + // where pat first appears in s. + // s: the string to search + // pat: the string to look for; an empty pat is found at 0 + // returns: the index of the first match, or -1 when there is none + static int find(char* s, char* pat) { + int i = 0, j; + if (!pat[0]) return 0; + while (s[i]) { + j = 0; + while (pat[j] && s[i + j] == pat[j]) j++; + if (!pat[j]) return i; + i++; + } + return 0 - 1; + } + + // changes the ASCII letters of s to lower case, in place. + // s: the string to change + // returns: the length of s + static int lower(char* s) { + int i = 0; + while (s[i]) { + if (s[i] >= 'A' && s[i] <= 'Z') s[i] = s[i] + 32; + i++; + } + return i; + } + + // changes the ASCII letters of s to upper case, in place. + // s: the string to change + // returns: the length of s + static int upper(char* s) { + int i = 0; + while (s[i]) { + if (s[i] >= 'a' && s[i] <= 'z') s[i] = s[i] - 32; + i++; + } + return i; + } + + // removes the spaces, tabs and line breaks from both ends of s, in place. + // s: the string to change + // returns: the length of what is left + static int trim(char* s) { + int n = 0, a = 0, b, i = 0, c; + while (s[n]) n++; + while (a < n && (s[a] == ' ' || s[a] == '\t' || s[a] == '\n' || s[a] == '\r')) a++; + b = n; + while (b > a) { + c = s[b - 1]; + if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r')) break; + b--; + } + n = b - a; + while (i < n) { s[i] = s[i + a]; i++; } + s[n] = 0; + return n; + } +} + +// ---- numbers ---- +// plain integer helpers. none of them can fail: an out of range result wraps +// the same way the arithmetic does. +struct Num { + // the absolute value of n. + static int abs(int n) { + if (n < 0) return 0 - n; + return n; + } + + // the smaller of a and b. + static int min(int a, int b) { + if (a < b) return a; + return b; + } + + // the larger of a and b. + static int max(int a, int b) { + if (a > b) return a; + return b; + } + + // v, kept between lo and hi. + // v: the value + // lo, hi: the bounds, lo first + static int clamp(int v, int lo, int hi) { + if (v < lo) return lo; + if (v > hi) return hi; + return v; + } + + // the greatest common divisor of two numbers, always 0 or more. + static int gcd(int a, int b) { + if (a < 0) a = 0 - a; + if (b < 0) b = 0 - b; + int t; + while (b) { t = a % b; a = b; b = t; } + return a; + } + + // b raised to the power e, for e of 0 or more. e below 0 gives 1. + static int pow(int b, int e) { + int r = 1; + while (e > 0) { r = r * b; e--; } + return r; + } + + // the whole square root of n, rounded down. n below 0 gives 0. + static int isqrt(int n) { + int lo = 0, hi = 3037000499, mid; + if (n <= 0) return 0; + while (lo < hi) { + mid = lo + (hi - lo + 1) / 2; + if (mid <= n / mid) lo = mid; else hi = mid - 1; + } + return lo; + } + + // -1, 0 or 1 by the sign of n. + static int sign(int n) { + if (n < 0) return 0 - 1; + if (n > 0) return 1; + return 0; + } +} + +// ---- the host ---- + +// the argument block for Host.raw: the number, then its six arguments. +int rawblk[7]; + +struct Host { + // calls any linux system call on the host. this is the escape hatch below + // the named helpers: the number is the kernel's, so the meaning of each + // argument depends on the call. a pointer argument is an address in the + // program's memory, and only the host reads it, so a string or buffer has + // to be passed as its address. + // it runs the call on the real machine, not inside the vm, so a program + // that uses it can do whatever the process can do. only use it where that + // is wanted. + // nr: the syscall number (x86-64 and arm64 numbers differ, so check the host) + // a..f: the six arguments, unused ones 0 + // returns: the kernel's result, or -errno when the call fails + static int raw(int nr, int a, int b, int c, int d, int e, int f) { + rawblk[0] = nr; rawblk[1] = a; rawblk[2] = b; rawblk[3] = c; + rawblk[4] = d; rawblk[5] = e; rawblk[6] = f; + return syscall(SYS_RAW, rawblk, 0, 0); + } + + // the value of an environment variable. + // name: the variable's name + // dst: where the value goes, a word string + // n: how many words dst has + // returns: the length of the value, -1 if the variable is not set + static int env(char* name, char* dst, int n) { return syscall(SYS_GETENV, name, dst, n); } + + // the clock. + // returns: the time in seconds since 1970 + static int now() { return syscall(SYS_TIME, 0, 0, 0); } + + // writes a string to a file, replacing what was there. + // path: the file's name + // s: the text to write + // returns: how many bytes were written, -1 if the file could not be opened + static int writefile(char* path, char* s) { + int fd = syscall(SYS_OPEN, path, 1, 0), n; + if (fd < 0) return -1; + n = syscall(SYS_WRITE, fd, s, len_w(s)); + syscall(SYS_CLOSE, fd, 0, 0); + return n; + } +} + +// ---- byte strings ---- +// the same helpers for packed byte strings. word strings above are unchanged. +// a byte string is a word whose first word is its length (see len_s). + +struct Bytes { + // like Text.atoi, for a byte string. + // s: the byte string + // returns: the number + static int atoi(word s) { return s_to_n(s); } + + // like Text.itoa, but the text is made fresh. + // n: the number + // returns: a new byte string + static word itoa(int n) { return n_to_s(n); } + + // like Text.starts, for byte strings. + // s: the byte string to test + // pfx: the beginning to look for + // returns: 1 if s begins with pfx, 0 if not + static int starts(word s, word pfx) { + int i = 0; + if (len_s(pfx) > len_s(s)) return 0; + while (i < len_s(pfx)) { if (at_s(s, i) != at_s(pfx, i)) return 0; i++; } + return 1; + } + + // like Host.env, for byte strings. + // name: the variable's name, a byte string + // dst: where the value goes, a word buffer + // n: how many bytes dst can take + // returns: the length of the value, -1 if the variable is not set + static int env(word name, word dst, int n) { return bgetenv(name, dst, n); } + + // like Host.writefile, for a byte string. + // path: the file's name, a byte string + // s: the bytes to write + // returns: how many bytes were written, -1 if the file could not be opened + static int writefile(word path, word s) { + int fd = bopen(path, 1), n; + if (fd < 0) return -1; + n = bwrite(fd, s, len_s(s)); + syscall(SYS_CLOSE, fd, 0, 0); + return n; + } +} + +// ---- arenas ---- + +// a region that is freed all at once. +// n: its size in words +// returns: the arena, owned by the caller +int .u arena(int n) { return arena_new(n); } + +struct Arena { + // takes n words from an arena. + // a: the arena + // n: how many words + // returns: the address of the first, 0 if the arena is full + static int alloc(word a, int n) { return arena_alloc(a, n); } + + // gives every block of an arena back at once. + // a: the arena + // returns: 0 + static int reset(word a) { return arena_reset(a); } +} + +// ---- growable byte buffers ---- + +// a byte buffer that knows its length and its capacity: two words, then the +// bytes, packed. +// n: the capacity in bytes +// returns: the buffer, owned by the caller, empty +word .u bnew(int n) { + int words; + word p; + if (n < 0) n = 0; + words = (n + 7) >> 3; + p = new(2 + words); + p[0] = 0; + p[1] = n; + return u*p; +} + +struct Buf { + // how many bytes a buffer holds. + // b: the buffer + // returns: its length + static int length(word b) { return b[0]; } + + // how many bytes a buffer can hold. + // b: the buffer + // returns: its capacity + static int capacity(word b) { return b[1]; } + + // one byte of a buffer. + // b: the buffer + // i: the position + // returns: the byte, 0 when i is outside the buffer + static int get(word b, int i) { if (i < 0 || i >= b[0]) return 0; return ld8(addr_b(b + 2) + i); } + + // sets one byte of a buffer. setting the byte just past the end makes the + // buffer one longer. + // b: the buffer + // i: the position, below the capacity + // v: the value; only its low 8 bits are kept + // returns: the byte stored, 0 when i is outside the capacity + static int set(word b, int i, int v) { + if (i < 0 || i >= b[1]) return 0; + st8(addr_b(b + 2) + i, v & 255); + if (i >= b[0]) b[0] = i + 1; + return v & 255; + } +} diff --git a/src/lsp/server.zc b/src/lsp/server.zc new file mode 100644 index 0000000..98e71c3 --- /dev/null +++ b/src/lsp/server.zc @@ -0,0 +1,1929 @@ +// ============================================================================ +// server.zc: the language server. it is appended to the genome after the +// compiler (cat src/runtime/rt.zc src/compiler/compiler.zc src/lsp/server.zc | zc0), so it does not +// analyze zc with a second implementation of the grammar: it runs the +// compiler itself over the document, in check mode (see chk_unit in +// compiler.zc), and reports what the compiler said. a parse word, an +// operator or a type the document defines changes how the rest of the +// document is read, for the checker and for the highlighter, because both are +// the compiler. it speaks json-rpc on stdin and stdout, and when stdin is not +// a protocol stream but a source file it prints the diagnostics as text. +// ============================================================================ + +// the first constant the server declares: the blob cut for a document starts +// here (blob_load, compiler.zc), so this name must stay the first one of the server. +const int LSP_SERVER = 1; + +// the compiler's own functions, declared here so this file checks on its own +// in an editor: the build places them in front of this file, so these lines only +// promise what is already defined there +int chk_unit(int src, int buf, int cap, int sets, int lim); +int hl_begin(int src); +int hl_end(); + +// ---- memory ---- +// nothing here has a fixed address. a document is a heap block of its text, the +// diagnostics and the check's name sets are blocks too, and a check collects +// what the last one left behind (chk_unit). a document compiles into the +// program region from 0 up to CODE_END, which is the map's own. + +const int DGCAP = 12000; +word dgb, sets; int jsize, tcap; +int dgbcap = DGCAP; + +const int MAXDOC = 16, URIW = 160; + +// ---- output ---- +// every message is written twice: once to count its bytes for the header, +// once for real. wc is the only thing that touches the terminal. +int wmode, wcnt; +// writes one byte of output. while a message is being sized the byte is only +// counted; otherwise it goes to the terminal. +int wc(int c) { + if (wmode) wcnt++; else raw_c(c); + return 0; +} +// writes a zero-terminated word string, one byte per character. +int ws(word s) { + int i = 0; + while (s[i]) { wc(s[i]); i++; } + return 0; +} +// writes n in decimal, with a minus sign when it is negative. +int wn(int n) { + [24]word b; int i = 0; + if (n < 0) { wc('-'); n = 0 - n; } + while (1) { b[i] = '0' + n % 10; i++; n = n / 10; if (!n) break; } + while (i) { i--; wc(b[i]); } + return 0; +} +// writes byte c inside a json string: quotes and backslashes are escaped, and +// the control characters become their escapes (\n, \t, \u00xx) so the text stays one line. +int wesc(int c) { + if (c == 34) { wc(92); wc(34); return 0; } + if (c == 92) { wc(92); wc(92); return 0; } + if (c == 10) { wc(92); wc('n'); return 0; } + if (c == 13) { wc(92); wc('r'); return 0; } + if (c == 9) { wc(92); wc('t'); return 0; } + if (c < 32) { + ws("\\u00"); + wc("0123456789abcdef"[c >> 4]); + wc("0123456789abcdef"[c & 15]); + return 0; + } + wc(c); + return 0; +} +// a json string from n chars at p, one per word +int wjs(word p, int n) { + int i = 0; + wc(34); + while (i < n) { wesc(p[i]); i++; } + wc(34); + return 0; +} +// sends one message. gen writes its body: it runs once to count the bytes for the +// Content-Length header, and once more to write them. +int send(int gen) { + wmode = 1; wcnt = 0; gen(); + wmode = 0; + ws("Content-Length: "); wn(wcnt); ws("\r\n\r\n"); + gen(); + return 0; +} + +// ---- documents ---- +// a document is its text, four bytes to a word, in a heap block of its own +// (doff), with a zero word after the last byte so the lexer sees the end. a +// replaced text is a new block, and the old one is garbage for the collector. + +int nodoc, doccap = MAXDOC; +word duri, dulen, doff, dsize, dver, dgen, dlive; +// Grow a heap buffer while retaining its contents. Globals keep these buffers rooted. +unchecked word lsp_grow(word old, int count, int capacity) { + word p = new(capacity); + fill_w(p, 0, capacity); + if (old && count) copy_w(p, old, count); + return p; +} +// Document columns grow together; each URI has its own string allocation. +int docs_grow() { + int next = doccap * 2; + duri = lsp_grow(duri, doccap, next); dulen = lsp_grow(dulen, doccap, next); + doff = lsp_grow(doff, doccap, next); dsize = lsp_grow(dsize, doccap, next); + dver = lsp_grow(dver, doccap, next); dgen = lsp_grow(dgen, doccap, next); + dlive = lsp_grow(dlive, doccap, next); + doccap = next; + return 0; +} +// the byte at offset i of a text. texts are packed four bytes to a word, low byte first. +word dc(word base, int i) { return (base[i >> 2] >> ((i & 3) * 8)) & 255; } +// the document with the uri p (n bytes long), or -1 when the server has no such document. +int dfind(word p, int n) { + int i = 0, k; + while (i < doccap) { + if (dlive[i] && dulen[i] == n) { + k = 0; + while (k < n && duri[i][k] == p[k]) k++; + if (k == n) return i; + } + i++; + } + return 0 - 1; +} +// takes a free document slot for the uri p (n bytes long), growing the columns +// when needed. commit_text sets its text after this. +int docnew(word p, int n) { + int i = 0, k; + while (1) { + if (i == doccap) docs_grow(); + if (!dlive[i]) { + duri[i] = lsp_grow(0, 0, n + 1); + k = 0; while (k < n) { duri[i][k] = p[k]; k++; } + dulen[i] = n; dlive[i] = 1; doff[i] = 0; dsize[i] = 0; dver[i] = 0; dgen[i] = 0; + return i; + } + i++; + } + return 0 - 1; +} +// the text, its terminator and a spare zero word +int dwords(int n) { return (n >> 2) + 2; } +// ---- the check ---- +int chk_i, chk_gen; // the document the compiler's tables describe, and its generation +// checks document i with the compiler in check mode. the diagnostics are left in +// dgb, and the types of the untyped lets are recorded while it runs (lt_on). +int check_doc(int i) { + chk_i = i; chk_gen = dgen[i]; + outmode = 1; + lt_on = 1; lt_n = 0; ltxn = 0; ht_n = 0; + chk_unit(doff[i], dgb, dgbcap, sets, CODE_END); + dgb = dgbuf; dgbcap = dgcap; + lt_on = 0; + outmode = 0; + return 0; +} +// the entry of the untyped local declared at byte offset o, or -1 +int lt_find(int o) { + int k = 0; + while (k < lt_n) { if (lt_off[k] == o) return k; k++; } + return 0 - 1; +} +int ensure_checked(int i) { + if (chk_i != i || chk_gen != dgen[i]) check_doc(i); + return 0; +} + +// ---- positions ---- +// a cursor over the document that turns byte offsets into the line and the +// utf-16 column the protocol wants. it only moves forward, or starts over. +int pbase, plen, poff, pline, pcol; +// starts the position cursor at the top of document i. +int pc_reset(int i) { + pbase = doff[i]; + plen = dsize[i]; + poff = 0; + pline = 0; + pcol = 0; + return 0; +} +// moves the position cursor forward to byte offset off, counting lines and the +// utf-16 columns the protocol uses (a character of four bytes takes two columns). +// a cursor that is past off starts over from the top. +int pc_to(int off) { + int b; + if (off < poff) { poff = 0; pline = 0; pcol = 0; } + if (off > plen) off = plen; + while (poff < off) { + b = dc(pbase, poff); + if (b == 10) { pline++; pcol = 0; } + else if (b < 128 || b >= 192) { if (b >= 240) pcol = pcol + 2; else pcol++; } + poff++; + } + return 0; +} +// the byte offset where the 1-based line l starts, or the end of the text when +// there is no such line. +int line_off(int l) { + int o = 0; + while (l > 1 && o < plen) { if (dc(pbase, o) == 10) l--; o++; } + return o; +} + +// ---- diagnostics ---- +int gd; // the document being reported +// writes a json position, {line, character}, for byte offset off. +int wpos(int off) { + pc_to(off); + ws("{\"line\":"); + wn(pline); + ws(",\"character\":"); + wn(pcol); + wc('}'); + return 0; +} +// writes the publishDiagnostics message for document gd from dgb. each record +// becomes a range (the whole line when the compiler only knew the line), a +// severity and its message. +int gen_diag() { + int at = 0, first = 1, sev, rln, off, rlen, n, o, e; + ws("{\"jsonrpc\":\"2.0\",\"method\":\"textDocument/publishDiagnostics\",\"params\":{\"uri\":"); + wjs(duri[gd], dulen[gd]); + ws(",\"version\":"); wn(dver[gd]); + ws(",\"diagnostics\":["); + pc_reset(gd); + while (at < dgpos) { + sev = dgb[at]; rln = dgb[at + 1]; off = dgb[at + 2]; rlen = dgb[at + 3]; n = dgb[at + 4]; + if (off < 0) { // the compiler only knew the line: mark its text + o = line_off(rln); + while (o < plen && (dc(pbase, o) == 32 || dc(pbase, o) == 9)) o++; + e = o; + while (e < plen && dc(pbase, e) != 10) e++; + if (e > o && dc(pbase, e - 1) == 13) e--; + } else { + o = off; e = off + rlen; + if (o >= plen) { // the end of the file: the last thing before it + o = plen; + while (o > 0 && (dc(pbase, o - 1) == 32 || dc(pbase, o - 1) == 10 || dc(pbase, o - 1) == 13 || dc(pbase, o - 1) == 9)) { + o--; + } + if (o > 0) o--; + e = o + 1; + } + if (e <= o) e = o + 1; + } + if (e > plen) e = plen; + if (o > e) o = e; + if (!first) wc(','); + first = 0; + ws("{\"range\":{\"start\":"); wpos(o); ws(",\"end\":"); wpos(e); + ws("},\"severity\":"); wn(sev); ws(",\"source\":\"zc\",\"message\":"); + wjs(dgb + at + 5, n); + wc('}'); + at = at + 5 + n; + } + ws("]}}"); + return 0; +} +// sends the diagnostics of document i. +int publish(int i) { + gd = i; + send(gen_diag); + return 0; +} + +// ---- semantic tokens ---- +// the legend: keyword type function variable string number operator comment +// parameter property macro enumMember +const int TT_KW = 0, TT_TYPE = 1, TT_FN = 2, TT_VAR = 3, TT_STR = 4, TT_NUM = 5, TT_OP = 6, TT_COM = 7, TT_PARAM = 8, TT_PROP = 9, TT_MACRO = 10, TT_ENUM = 11; +int tfirst, tprevl, tprevc; +// one token on one line +int tok_out(int off, int end, int ty) { + int l, c, len; + pc_to(off); l = pline; c = pcol; + pc_to(end); len = pcol - c; + if (len <= 0) return 0; + if (!tfirst) wc(','); + tfirst = 0; + if (l == tprevl) { wn(0); wc(','); wn(c - tprevc); } else { wn(l - tprevl); wc(','); wn(c); } + wc(','); wn(len); wc(','); wn(ty); ws(",0"); + tprevl = l; tprevc = c; + return 0; +} +// a range that may cross lines is cut at the line ends +int range_out(int off, int end, int ty) { + int e; + while (off < end) { + e = off; + while (e < end && dc(pbase, e) != 10) e++; + if (e > off && dc(pbase, e - 1) == 13) tok_out(off, e - 1, ty); else tok_out(off, e, ty); + off = e + 1; + } + return 0; +} +// between two tokens there is only space and comments +int gap_out(int from, int to) { + int o = from, e, c; + while (o < to) { + c = dc(pbase, o); + if (c == '/' && dc(pbase, o + 1) == '/') { + e = o; while (e < to && dc(pbase, e) != 10) e++; + range_out(o, e, TT_COM); o = e; + } else if (c == '/' && dc(pbase, o + 1) == '*') { + e = o + 2; + while (e < plen && !(dc(pbase, e) == '*' && dc(pbase, e + 1) == '/')) e++; + e = e + 2; if (e > plen) e = plen; + range_out(o, e, TT_COM); o = e; + } else o++; + } + return 0; +} +// is c an operator character, which the highlighter marks as an operator. +int isopc(int c) { + word s = "+-*/%=<>!&|^~?@#$"; + int i = 0; + while (s[i]) { if (s[i] == c) return 1; i++; } + return 0; +} +// is the name n one of the words the highlighter shows as keywords even when the +// compiler has no record for it. +int iskeyword(int n) { + return n == s_fn || n == s_var || n == s_const || n == s_else || n == s_as || n == s_unchecked || n == s_immediate + || n == s_case || n == s_default || n == s_do || n == s_while || n == s_enum || n == s_include || n == s_memdebug + || n == s_enhance || n == s_micro || n == s_vm || n == s_struct || n == s_type || n == s_typecheck; +} +// the record of the name at byte offset o (see rs_note in the compiler), or -1. +// the records are sorted by offset, so this is a binary search. +int rs_find(int o) { + int lo = 0, hi = rsn - 1, mid, v; + while (lo <= hi) { + mid = (lo + hi) / 2; + v = rsrec[mid * RS_W]; + if (v == o) return mid; + if (v < o) lo = mid + 1; else hi = mid - 1; + } + return 0 - 1; +} +// rs_cur is the cursor of the highlighter's pass over the records, which move +// forward with the tokens. +int rs_cur; +// the class of an identifier at byte offset o: what the compiler resolved it to +// when it checked the document, so a local named like a built-in is a variable. +// classify guesses from the name alone, and only serves names with no record. +int rs_class(int o, int n, int pt, int pv) { + int r = -1, k, v, sk; + while (rs_cur < rsn && rsrec[rs_cur * RS_W] < o) rs_cur++; + if (rs_cur < rsn && rsrec[rs_cur * RS_W] == o) r = rs_cur; + if (r < 0) return classify(n, pt, pv); + k = rsrec[r * RS_W + 1]; + if (k == RS_LOCAL) return TT_VAR; + if (k == RS_PARAM) return TT_PARAM; + if (k == RS_FIELD) return TT_PROP; + v = rsrec[r * RS_W + 2]; + sk = v & 15; + if (sk == K_KW) { if (v & 16) return TT_MACRO; return TT_KW; } + if (sk == K_TYPE) return TT_TYPE; + if (sk == K_FN) { if (v & 32) return TT_FN; return TT_VAR; } + if (sk == K_ENH) return TT_FN; + if (sk == K_CONST) return TT_ENUM; + return TT_VAR; +} +// the class of an identifier. pt, pv: the token before it +int classify(int n, int pt, int pv) { + int s, nx = 0; + // a name after fn is a declaration; a name after . or -> that is called is a method + if (pt == T_ID && pv == s_fn) return TT_FN; + if (pt == T_OP && pv == s_dot) { + if (n == s_m || n == s_d || n == s_u) return TT_KW; + peek(); + if (pk_tk == T_OP && pk_tv == s_lp) return TT_FN; + return TT_PROP; + } + if (pt == T_OP && pv == s_arrow) { + peek(); + if (pk_tk == T_OP && pk_tv == s_lp) return TT_FN; + return TT_PROP; + } + if (iskeyword(n)) return TT_KW; + peek(); + if (pk_tk == T_OP && pk_tv == s_lp) nx = 1; + s = lookup(n); + if (s >= 0) { + if (skind[s] == K_KW) { if (s >= ubase) return TT_MACRO; return TT_KW; } + if (skind[s] == K_TYPE) return TT_TYPE; + if (skind[s] == K_FN && !(sflag[s] & F_DEF)) return TT_VAR; // never defined: the check says so + if (skind[s] == K_FN || skind[s] == K_ENH) { + if (nx) return TT_FN; + if (lsget(1, n)) return TT_PARAM; + if (lsget(0, n)) return TT_VAR; + return TT_FN; + } + if (skind[s] == K_CONST) return TT_ENUM; + if (lsget(1, n)) return TT_PARAM; + return TT_VAR; + } + if (lsget(2, n)) return TT_TYPE; + if (lsget(1, n)) return TT_PARAM; + if (lsget(0, n)) return TT_VAR; + if (lsget(3, n)) return TT_PROP; + return TT_VAR; +} +// writes the semantic tokens of document gd: every token in order, each with the +// class the compiler resolved it to (rs_class), and numbers, strings and operators +// by their kind. comments are left to the editor's own grammar. +int gen_tokens() { + int last = 0, ty, pt = 0, pv = 0, o, e, c; + ws("{\"jsonrpc\":\"2.0\",\"id\":"); wid(); ws(",\"result\":{\"data\":["); + pc_reset(gd); + tfirst = 1; tprevl = 0; tprevc = 0; rs_cur = 0; + hl_begin(doff[gd]); + while (tk != T_EOF) { + o = toff; e = toff + toklen; + if (toklen > 0 && o >= last) { + gap_out(last, o); + ty = 0 - 1; + if (tk == T_ID) ty = rs_class(o, tv, pt, pv); + else if (tk == T_NUM) { + c = dc(pbase, o); + if (c == 39) ty = TT_STR; else ty = TT_NUM; + } else if (tk == T_FLT) ty = TT_NUM; + else if (tk == T_STR || tk == T_BSTR) ty = TT_STR; + else if (tk == T_OP) { if (isopc(dc(pbase, o))) ty = TT_OP; } + if (ty >= 0) range_out(o, e, ty); + last = e; + } + pt = tk; pv = tv; + next(); + } + gap_out(last, plen); + hl_end(); + ws("]}}"); + return 0; +} + +// ---- json in ---- +// the body of a message is read straight off stdin a char at a time and +// never held whole: the fields the server cares about are picked out as they +// go by, and a document's text is decoded into the store as it arrives. +int jleft, jpk; +int hline, hchar, hn, hoff, hcursor; word hov; int hovcap = 2300; word htb; int htbc = 80, htn, ann_name_at; word hname; int hnamecap = 80; int hdl, hdle, hcs; +word ann_text; int ann_n; +word mbuf, idbuf, jk, kbuf; int mcap = 64, idcap = 64, jkcap = 16, kcap = 40; int mn, idn, idtype; word ubuf; int ucap = URIW; int un, jver, kn; +word tbase; int tn, thave, tover, tuseen; +// the next byte of the json body. the body is read from stdin and stops after +// jleft bytes; -1 means the end. junget returns a byte to the next jgetc. +int jgetc() { + int c; + if (jpk != 0 - 2) { c = jpk; jpk = 0 - 2; return c; } + if (jleft <= 0) return 0 - 1; + jleft--; + if (eof()) { jleft = 0; return 0 - 1; } + return get_c() & 255; +} +// return byte c, so that the next jgetc reads it again. +int junget(int c) { jpk = c; return 0; } +// the next byte of the json body that is not white space. +int jws() { + int c = jgetc(); + while (c == 32 || c == 9 || c == 10 || c == 13) c = jgetc(); + return c; +} +// where the decoded bytes of a string go +int jput(int sink, int b) { + word at; + if (sink == 1) { + if (mn + 1 >= mcap) { mbuf = lsp_grow(mbuf, mn, mcap * 2); mcap = mcap * 2; } + mbuf[mn] = b; mn++; + } + else if (sink == 2) { + if (idn + 1 >= idcap) { idbuf = lsp_grow(idbuf, idn, idcap * 2); idcap = idcap * 2; } + idbuf[idn] = b; idn++; + } + else if (sink == 3) { + if (un + 1 >= ucap) { ubuf = lsp_grow(ubuf, un, ucap * 2); ucap = ucap * 2; } + ubuf[un] = b; un++; + } + else if (sink == 4) { + if ((tn >> 2) + 2 >= tcap) { tover = 1; return 0; } + at = tbase + (tn >> 2); + if ((tn & 3) == 0) at[0] = 0; + at[0] = at[0] | (b << ((tn & 3) * 8)); + tn++; + } else if (sink == 5) { + if (kn + 1 >= kcap) { kbuf = lsp_grow(kbuf, kn, kcap * 2); kcap = kcap * 2; } + kbuf[kn] = b; kn++; + } + return 0; +} +// writes the code point cp as utf-8 into sink (one byte at a time through jput). +int jutf8(int sink, int cp) { + if (cp < 128) { jput(sink, cp); return 0; } + if (cp < 2048) { jput(sink, 192 | (cp >> 6)); jput(sink, 128 | (cp & 63)); return 0; } + if (cp < 65536) { + jput(sink, 224 | (cp >> 12)); + jput(sink, 128 | ((cp >> 6) & 63)); + jput(sink, 128 | (cp & 63)); + return 0; + } + jput(sink, 240 | (cp >> 18)); + jput(sink, 128 | ((cp >> 12) & 63)); + jput(sink, 128 | ((cp >> 6) & 63)); + jput(sink, 128 | (cp & 63)); + return 0; +} +// reads the four hex digits of a \u escape and returns their value. when a byte +// is not a hex digit, the digits read so far are returned and that byte goes back. +int jhex4() { + int v = 0, i = 0, c, h; + while (i < 4) { + c = jgetc(); h = hexv(c); + if (h < 0) { junget(c); return v; } + v = v * 16 + h; i++; + } + return v; +} +// the rest of a string, the opening quote already read +int jstr(int sink) { + int c, e, cp, lo; + while (1) { + c = jgetc(); + if (c < 0 || c == 34) return 0; + if (c != 92) { jput(sink, c); continue; } + e = jgetc(); + if (e == 'n') jput(sink, 10); + else if (e == 't') jput(sink, 9); + else if (e == 'r') jput(sink, 13); + else if (e == 'b') jput(sink, 8); + else if (e == 'f') jput(sink, 12); + else if (e == 'u') { + cp = jhex4(); + if (cp >= 55296 && cp < 56320) { // a high surrogate: the low half follows as another \u + c = jgetc(); + if (c == 92) { + c = jgetc(); + if (c == 'u') { lo = jhex4(); cp = 65536 + ((cp - 55296) << 10) + (lo - 56320); } + } + } + jutf8(sink, cp); + } else if (e >= 0) jput(sink, e); + } + return 0; +} +// the code of the json key in kbuf, for the keys the server reads (0 for the others). +int kcode() { + if (eq_w(kbuf, "method")) return 1; + if (eq_w(kbuf, "id")) return 2; + if (eq_w(kbuf, "params")) return 3; + if (eq_w(kbuf, "textDocument")) return 4; + if (eq_w(kbuf, "uri")) return 5; + if (eq_w(kbuf, "text")) return 6; + if (eq_w(kbuf, "contentChanges")) return 7; + if (eq_w(kbuf, "version")) return 8; + if (eq_w(kbuf, "position")) return 9; + if (eq_w(kbuf, "line")) return 10; + if (eq_w(kbuf, "character")) return 11; + return 0; +} +// is the key code one of the first dep keys on the json path to the value being read. +int janc(int dep, int code) { + int i = 0; + while (i < dep) { + if (jk[i] == code) return 1; + i++; + } + return 0; +} +// reads one json value at nesting depth dep. the keys the server reads (key) go to +// their fields, and objects and arrays are walked for the ones inside them. +int jval(int key, int dep) { + int c; word k; int sink, neg; + if (dep >= jkcap) { jk = lsp_grow(jk, jkcap, jkcap * 2); jkcap = jkcap * 2; } + jk[dep] = key; + c = jws(); + if (c == '{') { + while (1) { + c = jws(); + if (c < 0 || c == '}') return 0; + if (c == ',') continue; + if (c != 34) continue; + kn = 0; jstr(5); kbuf[kn] = 0; + k = kcode(); + c = jws(); // the colon + jval(k, dep + 1); + } + } + if (c == '[') { + while (1) { + c = jws(); + if (c < 0 || c == ']') return 0; + // a '}' inside an array is malformed: stop here and leave it for the enclosing object, + // since a bare value stops at '}' without taking it, and looping would never end + if (c == '}') { junget(c); return 0; } + if (c == ',') continue; + junget(c); + jval(key, dep + 1); + } + } + if (c == 34) { + sink = 0; + if (key == 1 && dep == 1) { sink = 1; mn = 0; } + else if (key == 2 && dep == 1) { sink = 2; idn = 0; idtype = 2; } + else if (key == 5 && janc(dep, 4)) { sink = 3; un = 0; tuseen = 1; } + else if (key == 6 && (janc(dep, 7) || janc(dep, 4))) { sink = 4; thave = 1; tover = 0; tbase = text_start(); tn = 0; } + jstr(sink); + if (sink == 1) mbuf[mn] = 0; + if (sink == 2) idbuf[idn] = 0; + if (sink == 3) ubuf[un] = 0; + if (sink == 4) { + k = tbase + (tn >> 2); // zero the rest of the last word and the one after it + if ((tn & 3) == 0) k[0] = 0; + k[1] = 0; + } + return 0; + } + if (c < 0) return 0; + // a number, true, false or null + sink = 0; + if (key == 2 && dep == 1) { sink = 2; idn = 0; idtype = 1; } + k = 0; neg = 0; + while (c >= 0 && c != ',' && c != '}' && c != ']' && c != 32 && c != 10 && c != 13 && c != 9) { + if (sink == 2) jput(2, c); + if ((key == 8 && janc(dep, 4)) || ((key == 10 || key == 11) && janc(dep, 9))) { + if (c == '-') { + neg = 1; + } else if (isdig(c)) k = k * 10 + c - '0'; + } + c = jgetc(); + } + junget(c); + if (sink == 2) { + idbuf[idn] = 0; + if (eq_w(idbuf, "null")) idtype = 0; + } + if (key == 8 && janc(dep, 4)) { if (neg) k = 0 - k; jver = k; } + if (key == 10 && janc(dep, 9)) hline = k; + if (key == 11 && janc(dep, 9)) hchar = k; + return 0; +} +// the text of a document being read goes into a block that holds the whole +// message: decoded text is never longer than the message it came in +word text_start() { + tcap = dwords(jsize); + tbase = new(tcap); + return tbase; +} + +// ---- messages in ---- +word lbuf; int lcap = 160; int rfirst = 0 - 1; +// one header line, without the line end. returns its length, or -1 at the end of the input +int rl() { + int n = 0, c; + while (1) { + if (rfirst >= 0) { c = rfirst; rfirst = 0 - 1; } + else { + if (eof()) { if (!n) return 0 - 1; return n; } + c = get_c() & 255; + } + if (c == 10) return n; + if (c != 13) { + if (n + 1 >= lcap) { lbuf = lsp_grow(lbuf, n, lcap * 2); lcap = lcap * 2; } + lbuf[n] = c; n++; + } + } + return n; +} +// the lower case of an ascii letter. other bytes are unchanged. +int lower(int c) { + if (c >= 'A' && c <= 'Z') return c + 32; + return c; +} +// does the header line in lbuf start with content-length: (in any case). +int is_clen(int n) { + if (n < 15) return 0; + word s = "content-length:"; int i = 0; + while (s[i]) { if (lower(lbuf[i]) != s[i]) return 0; i++; } + return 1; +} +int inited, shut, quit; +// read one message into the field buffers. returns 0 at the end of the input +int read_message() { + int n, size = 0 - 1, i; + while (1) { + n = rl(); + if (n < 0) return 0; + if (n == 0) { if (size >= 0) break; else continue; } + if (is_clen(n)) { + i = 15; size = 0; + while (i < n && (lbuf[i] == 32 || lbuf[i] == 9)) i++; + while (i < n && isdig(lbuf[i])) { size = size * 10 + lbuf[i] - '0'; i++; } + } + } + jleft = size; jpk = 0 - 2; jsize = size; + mn = 0; mbuf[0] = 0; idn = 0; idbuf[0] = 0; idtype = 0; un = 0; ubuf[0] = 0; jver = 0; + thave = 0; tover = 0; tuseen = 0; tn = 0; tbase = 0; hline = 0; hchar = 0; + jval(0, 0); + while (jleft > 0) jgetc(); // whatever the parser left behind + return 1; +} + +// ---- messages out ---- +int wid() { + if (idtype == 2) { + wjs(idbuf, idn); + } else if (idtype == 1) ws(idbuf); else ws("null"); + return 0; +} +// the reply to initialize: the server's capabilities, which are text sync, hover, +// and semantic tokens with their legend. +int gen_init() { + ws("{\"jsonrpc\":\"2.0\",\"id\":"); wid(); + ws(",\"result\":{\"capabilities\":{\"textDocumentSync\":{\"openClose\":true,\"change\":1,\"save\":{\"includeText\":true}},"); + ws("\"hoverProvider\":true,\"semanticTokensProvider\":{\"legend\":{\"tokenTypes\":[\"keyword\",\"type\",\"function\",\"variable\",\"string\",\"number\",\"operator\",\"comment\",\"parameter\",\"property\",\"macro\",\"enumMember\"],\"tokenModifiers\":[]},\"full\":true}},"); + ws("\"serverInfo\":{\"name\":\"zc\",\"version\":\"2\"}}}"); + return 0; +} +// a reply with a null result, for the request id in the message. +int gen_null() { + ws("{\"jsonrpc\":\"2.0\",\"id\":"); + wid(); + ws(",\"result\":null}"); + return 0; +} +// the error code the next error reply carries. +int errcode; +// an error reply with the code errcode and a matching message. +int gen_error() { + ws("{\"jsonrpc\":\"2.0\",\"id\":"); + wid(); + ws(",\"error\":{\"code\":"); + wn(errcode); + ws(",\"message\":"); + if (errcode == 0 - 32601) ws("\"method not found\""); else ws("\"server not initialized\""); + ws("}}"); + return 0; +} +// a semantic tokens reply with no tokens, for a document the server does not have. +int gen_empty() { + ws("{\"jsonrpc\":\"2.0\",\"id\":"); + wid(); + ws(",\"result\":{\"data\":[]}}"); + return 0; +} +// sends an error reply with the code given. +int reply_error(int code) { + errcode = code; + send(gen_error); + return 0; +} + +// ---- hover ---- +// the documentation of the name under the cursor: the comment lines directly +// above its declaration in the document, or, for what the compiler and the +// standard library define, the docs stored in the image +int hid(int c) { return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c == '_'; } +// the identifier at hline, hchar of document i, into hname. returns its length +int hover_word(int i) { + int base = doff[i], size = dsize[i], o = 0, ln = 0, col = 0, c, step, width, b, e, n = 0; + hcursor = 0 - 1; hname[0] = 0; + if (hline < 0 || hchar < 0) return 0; + while (ln < hline && o < size) { if (dc(base, o) == 10) ln++; o++; } + if (ln != hline) return 0; + // the protocol counts utf-16 units; the document stores utf-8 bytes. + while (col < hchar && o < size) { + c = dc(base, o); + if (c == 10 || c == 13) return 0; + step = 1; width = 1; + if (c >= 192 && c < 224) step = 2; + else if (c >= 224 && c < 240) step = 3; + else if (c >= 240) { step = 4; width = 2; } + o = o + step; col = col + width; + } + if (col != hchar) return 0; + hcursor = o; + if (o >= size || !hid(dc(base, o))) return 0; + b = o; + while (b > 0 && hid(dc(base, b - 1))) b--; + e = o; + while (e < size && hid(dc(base, e))) e++; + if (e - b + 1 > hnamecap) { hnamecap = e - b + 1; hname = lsp_grow(0, 0, hnamecap); } + hoff = b; + while (b < e) { hname[n] = dc(base, b); n++; b++; } + hname[n] = 0; + return n; +} +// is c a delimiter that ends the name in a top-level declaration +int hdelim(int c) { return c == '(' || c == '=' || c == ';' || c == ',' || c == '[' || c == '<' || c == '{'; } +// does the line at ls (ending before le) declare hname. only a top-level line +// counts (hover_scan has already checked it starts in column 0). the name is +// the word just before the line's first delimiter, so a keyword or type on the +// line (int, fixed, fn) is never the declared name, and a use of the name +// further along the line is not a declaration +word hover_decl(int base, int ls, int le) { + int dl = ls, e, b, k = 0; + while (dl < le && !hdelim(dc(base, dl))) dl++; + if (dl >= le) return 0; + e = dl; + while (e > ls && (dc(base, e - 1) == 32 || dc(base, e - 1) == 9)) e--; + b = e; + while (b > ls && hid(dc(base, b - 1))) b--; + if (b == e) return 0; + while (hname[k] && b + k < e && dc(base, b + k) == hname[k]) k++; + return !hname[k] && b + k == e; +} +// the top-level declaration of hname, found by its line: hdl and hdle are the +// line's start and end, and hcs is the start of the comment block directly above +// it (hcs is -1 when none) which runs to the line at hdl. a declaration needs +// no comment, so the signature still shows without one. +int hover_scan(int i) { + int base = doff[i], size = dsize[i], ls = 0, le, cs = 0 - 1, c0; + while (ls < size) { + le = ls; + while (le < size && dc(base, le) != 10) le++; + c0 = dc(base, ls); + if (c0 == '/' && ls + 1 < le && dc(base, ls + 1) == '/') { + if (cs < 0) cs = ls; + } else { + if (le > ls && c0 != 32 && c0 != 9 && hover_decl(base, ls, le)) { + hdl = ls; hdle = le; hcs = cs; + return 1; + } + cs = 0 - 1; + } + ls = le + 1; + } + return 0; +} +// one character of the hover text, up to its cap +int hov_put(int c) { + if (hn == hovcap) { hov = lsp_grow(hov, hn, hovcap * 2); hovcap = hovcap * 2; } + hov[hn] = c; hn++; + return 0; +} +// comment ranges are scanned once per document version, outside strings and chars. +int hc_i = -1, hc_gen = -1, hc_n, hc_cap = 64; +word hc_start, hc_end, hc_kind; +int hover_comments(int i) { + int o = 0, size = dsize[i], base = doff[i], c, start, kind, bol = 1, quote; + if (hc_i == i && hc_gen == dgen[i]) return 0; + hc_i = i; hc_gen = dgen[i]; hc_n = 0; + while (o < size) { + c = dc(base, o); + if (c == 10) { bol = 1; o++; continue; } + if (c == 32 || c == 9 || c == 13) { o++; continue; } + if (c == 34 || c == 39) { + quote = c; o++; + while (o < size && dc(base, o) != quote) { if (dc(base, o) == 92) o++; o++; } + o++; bol = 0; continue; + } + kind = 0; start = o; + if (c == '/' && dc(base, o + 1) == '/') { + kind = 1; if (bol) kind = 2; + o = o + 2; while (o < size && dc(base, o) != 10) o++; + } else if (c == '/' && dc(base, o + 1) == '*') { + kind = 3; o = o + 2; + while (o < size && !(dc(base, o) == '*' && dc(base, o + 1) == '/')) { if (dc(base, o) == 10) bol = 1; o++; } + if (o < size) o = o + 2; + } else { o++; bol = 0; continue; } + if (!hc_start || hc_n == hc_cap) { + if (hc_start) hc_cap = hc_cap * 2; + hc_start = lsp_grow(hc_start, hc_n, hc_cap); hc_end = lsp_grow(hc_end, hc_n, hc_cap); hc_kind = lsp_grow(hc_kind, hc_n, hc_cap); + } + hc_start[hc_n] = start; hc_end[hc_n] = o; hc_kind[hc_n] = kind; hc_n++; + } + return 0; +} +// whitespace between documentation and its target may cross one line, not a blank line. +int doc_gap(int base, int from, int to) { + int c, lines = 0; + while (from < to) { + c = dc(base, from); from++; + if (c == 10) { lines++; if (lines > 1) return 0; } + else if (c != 32 && c != 9 && c != 13) return 0; + } + return 1; +} +// remove comment delimiters and optional line-leading stars; retain markdown. +int hover_comment_text(int i, int index) { + int base = doff[i], o = hc_start[index] + 2, end = hc_end[index], bol = 1, c, before = hn; + if (hc_kind[index] == 3) { + if (end >= o + 2 && dc(base, end - 2) == '*' && dc(base, end - 1) == '/') end = end - 2; + if (o < end && dc(base, o) == '*') o++; + } + while (o < end && (dc(base, o) == 32 || dc(base, o) == 9 || dc(base, o) == 10 || dc(base, o) == 13)) o++; + while (end > o && (dc(base, end - 1) == 32 || dc(base, end - 1) == 9 || dc(base, end - 1) == 10 || dc(base, end - 1) == 13)) end--; + if (o == end) return 0; + hov_text("\n\n"); + while (o < end) { + if (bol && hc_kind[index] == 3) { + while (o < end && (dc(base, o) == 32 || dc(base, o) == 9)) o++; + if (o < end && dc(base, o) == '*') { o++; if (dc(base, o) == 32) o++; } + bol = 0; + } + if (o >= end) break; + c = dc(base, o); o++; + if (c != 13) hov_put(c); + if (c == 10) bol = 1; + } + return hn - before; +} +// attach leading docs and adjacent block docs to this exact declaration name. +int hover_docs(int i, int head, int name, int length) { + int k, first = -1, last = -1, pos = head, base = doff[i]; + hover_comments(i); + k = hc_n - 1; + while (k >= 0 && hc_end[k] > head) k--; + while (k >= 0 && hc_kind[k] != 1 && doc_gap(base, hc_end[k], pos)) { + if (last < 0) last = k; + first = k; pos = hc_start[k]; k--; + } + if (first >= 0) { k = first; while (k <= last) { hover_comment_text(i, k); k++; } } + k = 0; + while (k < hc_n) { + if (hc_kind[k] == 3 && (k < first || k > last)) { + if (hc_start[k] >= head && hc_end[k] <= name && doc_gap(base, hc_end[k], name)) hover_comment_text(i, k); + else if (hc_start[k] >= name + length && doc_gap(base, name + length, hc_start[k])) hover_comment_text(i, k); + } + k++; + } + return 0; +} +// the markdown for a declaration: its signature as a code block, then the +// comment block above it, without the slashes, if there is one +int hover_fill(int i) { + int base = doff[i], o = hdl, c, cs, ls, typed = 0, k, start, end; + hn = 0; + while (o < hdle && dc(base, o) != '{' && dc(base, o) != ';' && dc(base, o) != '=') o++; + while (o > hdl && (dc(base, o - 1) == 32 || dc(base, o - 1) == 9)) o--; + hov_put('`'); hov_put('`'); hov_put('`'); hov_put('z'); hov_put('c'); hov_put(10); + c = hdl; + // an untyped fn: the return type the body gives it replaces the fn + if (dc(base, hdl) == 'f' && dc(base, hdl + 1) == 'n' && dc(base, hdl + 2) == 32) { + ensure_annot(i); + k = hdl + 3; + while (k < hdle && (dc(base, k) == 32 || dc(base, k) == 9)) k++; + if (ann_type(i, k)) { + start = ann_name_at; + while (start > 0 && dc(ann_text, start - 1) != 10 && dc(ann_text, start - 1) != ';' && dc(ann_text, start - 1) != '}') start--; + while (start < ann_name_at && (dc(ann_text, start) == 32 || dc(ann_text, start) == 9)) start++; + end = ann_name_at; + while (end < ann_n && dc(ann_text, end) != '{' && dc(ann_text, end) != ';') end++; + while (end > start && (dc(ann_text, end - 1) == 32 || dc(ann_text, end - 1) == 9 || dc(ann_text, end - 1) == 10 || dc(ann_text, end - 1) == 13)) end--; + k = start; while (k < end) { hov_put(dc(ann_text, k)); k++; } + hov_text("\n```"); htn = 0; hover_docs(i, hdl, hdl, 0); + return hn; + } + htn = 0; + } + while (c < o) { hov_put(dc(base, c)); c++; } + hov_put(10); hov_put('`'); hov_put('`'); hov_put('`'); + hover_docs(i, hdl, hdl, 0); + return hn; +} +// the hover reply: the markdown in hov, or null when there is nothing to show. +int gen_hover() { + ws("{\"jsonrpc\":\"2.0\",\"id\":"); wid(); + if (!hn) { ws(",\"result\":null}"); return 0; } + ws(",\"result\":{\"contents\":{\"kind\":\"markdown\",\"value\":"); + wjs(hov, hn); + ws("}}}"); + return 0; +} +// the doc of a name from the image's own symbol blob, or 0. the checks reset the +// symbol table (zc_init, chk_mark), so the docs are read from the blob itself, +// which stays in the image +word blobdoc(word nm) { + word p = GORG[5]; int k; + while (*p) { + if (p[0] == K_DOC && p[3] == 'd' && p[4] == 'o' && p[5] == 'c' && p[6] == ' ') { + k = 0; + while (nm[k] && p[7 + k] == nm[k]) k++; + if (!nm[k] && !p[7 + k]) return p[1]; + } + p = p + 3 + len_w(p + 3) + 1; + } + return 0; +} +// the signature of a name from the image's own symbol blob, or 0 +word blobsig(word nm) { + word p = GORG[5]; int k; + while (*p) { + if (p[0] == K_DOC && p[3] == 's' && p[4] == 'i' && p[5] == 'g' && p[6] == ' ') { + k = 0; + while (nm[k] && p[7 + k] == nm[k]) k++; + if (!nm[k] && !p[7 + k]) return p[1]; + } + p = p + 3 + len_w(p + 3) + 1; + } + return 0; +} +// the start of the line before the one starting at ls, or -1 at the top +int hl_prev(int base, int ls) { + int q; + if (ls <= 0) return 0 - 1; + q = ls - 1; + while (q > 0 && dc(base, q - 1) != 10) q--; + return q; +} +// the last declaration of hname above the hovered line, inside the top-level +// item that holds it: a parameter of its header, or a local (a line of the form +// type name = ..., so a plain use of the name does not count). the text, marked +// as a parameter or a local, goes into hov as a code block. returns 1 when found. +int hover_local(int i) { + int base = doff[i], size = dsize[i], hs = 0, ln = 0, o = 0, ts = 0 - 1, q, c, hl, le, e, b, k, a, found = 0, kind = 0, sb = 0, se = 0, da = 0 - 1; + while (ln < hline && o < size) { if (dc(base, o) == 10) ln++; o++; } + hs = o; + // the top-level line: the hovered line if it starts in column 0, else the + // nearest such line above it (a line that starts in column 0, not a comment) + q = hs; + c = dc(base, q); + if (c != 10 && c != 32 && c != 9 && !(c == '/' && dc(base, q + 1) == '/')) ts = q; + while (ts < 0) { + q = hl_prev(base, q); + if (q < 0) break; + c = dc(base, q); + if (c == 10 || c == 32 || c == 9) continue; + if (c == '/' && dc(base, q + 1) == '/') continue; + ts = q; + } + if (ts < 0) return 0; + // the header line: a parameter named hname is the last word of its segment + hl = ts; + le = hl; + while (le < size && dc(base, le) != 10 && dc(base, le) != '{' && dc(base, le) != ';') le++; + o = hl; + // the segments of the header, one at a time + o = hl; + while (o < le && dc(base, o) != '(') o++; + o++; + while (o < le) { + while (o < le && (dc(base, o) == 32 || dc(base, o) == 9)) o++; + sb = o; + while (o < le && dc(base, o) != ',' && dc(base, o) != ')') o++; + se = o; + while (se > sb && (dc(base, se - 1) == 32 || dc(base, se - 1) == 9)) se--; + e = se; + b = e; + while (b > sb && hid(dc(base, b - 1))) b--; + if (b < e) { // a typed parameter has its type before the name, an untyped one is the name alone + k = 0; + while (hname[k] && b + k < e && dc(base, b + k) == hname[k]) k++; + if (!hname[k] && b + k == e) { found = 1; kind = 1; break; } + } + if (o < le && dc(base, o) == ')') break; + o++; + } + if (found) { hover_put_sig(base, sb, se, kind, 0 - 1); return 1; } + // the body: the last declaration of hname from the item's next line through the + // hovered line (a declaration on the hovered line itself counts) + o = ts; + while (o <= hs) { + le = o; + while (le < hs && dc(base, le) != 10) le++; + if (le == hs) while (le < size && dc(base, le) != 10) le++; + // le is the end of this line; skip the blank and comment lines + q = o; + while (q < le && (dc(base, q) == 32 || dc(base, q) == 9)) q++; + if (q < le && !(dc(base, q) == '/' && dc(base, q + 1) == '/') && q > o && !hl_kw(base, q)) { + e = hdeclend(base, q, le); + if (e < le) { + b = e; + while (b > q && (dc(base, b - 1) == 32 || dc(base, b - 1) == 9)) b--; + a = b; + while (a > q && hid(dc(base, a - 1))) a--; + if (a < b && a > q) { + k = 0; + while (hname[k] && a + k < b && dc(base, a + k) == hname[k]) k++; + if (!hname[k] && a + k == b && (dc(base, a - 1) == 32 || dc(base, a - 1) == 9)) { found = 1; kind = 2; da = a; sb = q; se = e; while (se > sb && (dc(base, se - 1) == 32 || dc(base, se - 1) == 9)) se--; } + } + } + } + if (le >= hs) break; + o = le + 1; + } + if (found) { + k = 0 - 1; + if (kind == 2) k = lt_find(da); + hover_put_sig(base, sb, se, kind, k); + return 1; + } + return 0; +} +// does the word from q to e equal w +word hl_is(int base, int q, int e, word w) { + int k = 0; + while (w[k] && q + k < e && dc(base, q + k) == w[k]) k++; + return !w[k] && q + k == e; +} +// does a statement start at q with a keyword that cannot begin a declaration, +// so that "return i;" is not taken for a declaration of i +word hl_kw(int base, int q) { + int e = q; + while (hid(dc(base, e))) e++; + return hl_is(base, q, e, "return") || hl_is(base, q, e, "if") || hl_is(base, q, e, "while") || hl_is(base, q, e, "else") || hl_is(base, q, e, "break") || hl_is(base, q, e, "continue"); +} +// where a declaration's name ends on the line from q: at = ; , { ( or a [ that +// follows a name (let b[24]); the [ of a type (fixed []int) is passed over +int hdeclend(int base, int q, int le) { + int e = q, c; + while (e < le) { + c = dc(base, e); + if (c == '=' || c == ';' || c == ',' || c == '{' || c == '(' || c == ')') return e; + if (c == '[' && e > q && hid(dc(base, e - 1))) return e; + e++; + } + return le; +} +const int AROUNDS = 6; +word abase, aerr; int nbase, aerrcap; +word afx, aft, amask; int anf, afcap, atcap; +word awp; int awn; +word ann_half; +// the inferred types of the untyped declarations. annotate_doc runs the annotate +// rounds on a document (in doc slot 0, which is put back afterwards), and the +// text it ends with is kept in ann_text. ann_type then finds, for a name the +// document declares untyped, the type annotate gave that name: the text between +// the token before it in the annotated text and the name, after the last ( , { ; or =. +int ann_i = -1, ann_gen = -1, ai_end; +// runs the annotate rounds on document i. the rounds run in doc slot 0, and the +// slots they use are put back afterwards. the text they end with is kept in +// ann_text, with its length in ann_n. +int annotate_doc(int i) { + int round = 0, n, k, sv_size, sv_live, sv_ulen, sv_gen, sv_slot1 = 0, sv_live1, sv_ulen1, sv_gen1; + word sv_base, sv_base1; + sv_base = doff[0]; sv_size = dsize[0]; sv_live = dlive[0]; sv_ulen = dulen[0]; sv_gen = dgen[0]; + sv_base1 = doff[1]; sv_slot1 = dsize[1]; sv_live1 = dlive[1]; sv_ulen1 = dulen[1]; sv_gen1 = dgen[1]; + dlive[0] = 1; dulen[0] = 0; + doff[0] = doff[i]; dsize[0] = dsize[i]; dgen[0] = sv_gen + 1; + ifstrict = 1; + check_doc(0); + nbase = err_lines(abase); + while (round < AROUNDS) { + ifon = 1; check_doc(0); ifon = 0; + save_facts(); + if (!anf) break; + k = 0; while (k < anf) { amask[k] = 0; k++; } + fresh_half(); + try_range(0, anf); + n = apply_masked(ann_half); + if (!n) break; + doff[0] = ann_half; dsize[0] = awn; dgen[0] = dgen[0] + 1; + round++; + } + ifstrict = 0; ifon = 0; + ann_text = doff[0]; ann_n = dsize[0]; + doff[0] = sv_base; dsize[0] = sv_size; dlive[0] = sv_live; dulen[0] = sv_ulen; dgen[0] = sv_gen; + doff[1] = sv_base1; dsize[1] = sv_slot1; dlive[1] = sv_live1; dulen[1] = sv_ulen1; dgen[1] = sv_gen1; + chk_i = -1; + return 0; +} +// annotate for the current state of document i, once per state of it +int ensure_annot(int i) { + if (ann_i == i && ann_gen == dgen[i]) return 0; + annotate_doc(i); + ann_i = i; ann_gen = dgen[i]; + return 0; +} +// the next identifier of base at or after pos: its start, with its end in ai_end. +// comments, strings and numbers are passed over. -1 when there is none. +int ai_next(word base, int size, int pos) { + int c, st, q; + while (pos < size) { + c = dc(base, pos); + if (c == '/' && pos + 1 < size && dc(base, pos + 1) == '/') { + while (pos < size && dc(base, pos) != 10) pos++; + } else if (c == '/' && pos + 1 < size && dc(base, pos + 1) == '*') { + pos = pos + 2; + while (pos < size && !(dc(base, pos) == '*' && dc(base, pos + 1) == '/')) pos++; + if (pos < size) pos = pos + 2; + } else if (c == '"' || c == 39) { + q = c; pos++; + while (pos < size && dc(base, pos) != q && dc(base, pos) != 10) { if (dc(base, pos) == 92) pos++; pos++; } + pos++; + } else if (c >= '0' && c <= '9') { + while (pos < size && hid(dc(base, pos))) pos++; + } else if (hid(c)) { + st = pos; + while (pos < size && hid(dc(base, pos))) pos++; + ai_end = pos; + return st; + } else pos++; + } + return 0 - 1; +} +// do the words a[as..ae) of base a and b[bs..be) of base b read the same +int ai_same(word a, int as, int ae, word b, int bs, int be) { + int k = 0; + if (ae - as != be - bs) return 0; + while (as + k < ae) { if (dc(a, as + k) != dc(b, bs + k)) return 0; k++; } + return 1; +} +// is the word at s..e fn or let, which annotate replaces with a type +int ai_kw(word base, int s, int e) { + int k = 0; + if (e - s == 2 && dc(base, s) == 'f' && dc(base, s + 1) == 'n') return 1; + if (e - s == 3 && dc(base, s) == 'l' && dc(base, s + 1) == 'e' && dc(base, s + 2) == 't') return 1; + return k; +} +// is the name at offset o of document i declared untyped: a parameter after ( or +// , and a local after let or a function after fn. only those can gain a type +int ann_untyped(int i, int o) { + word base = doff[i]; + int p = o - 1; + while (p >= 0) { + while (p >= 0 && (dc(base, p) == 32 || dc(base, p) == 9 || dc(base, p) == 10 || dc(base, p) == 13)) p--; + if (p >= 1 && dc(base, p) == '/' && dc(base, p - 1) == '*') { + p = p - 2; while (p >= 1 && !(dc(base, p - 1) == '/' && dc(base, p) == '*')) p--; + p = p - 2; + } else break; + } + if (p < 0) return 0; + if (dc(base, p) == '(' || dc(base, p) == ',') return 1; + if (p >= 2 && dc(base, p) == 't' && dc(base, p - 1) == 'e' && dc(base, p - 2) == 'l') return 1; + if (p >= 1 && dc(base, p) == 'n' && dc(base, p - 1) == 'f') return 1; + return 0; +} +// the type annotate gave the name declared at offset o of document i, in htb +// (htn bytes), or none. the names of the two texts are walked in step: the +// annotated text has the same names in the same order, plus the types it put in. +int ann_type(int i, int o) { + word ob = doff[i], ab = ann_text; + int osz = dsize[i], asz = ann_n, op = 0, ap = 0, prev = 0, os, oe, as, ae, cut, k, n = 0, c; + htn = 0; + while (1) { + os = ai_next(ob, osz, op); + if (os < 0) return 0; + oe = ai_end; + op = oe; + if (ai_kw(ob, os, oe)) continue; + while (1) { + as = ai_next(ab, asz, ap); + if (as < 0) return 0; + ae = ai_end; + ap = ae; + if (ai_same(ob, os, oe, ab, as, ae)) break; + } + if (os == o) { + ann_name_at = as; + cut = prev; + k = prev; + while (k < as) { c = dc(ab, k); if (c == '(' || c == ',' || c == '{' || c == ';' || c == '=' || c == '}' || c == 10) cut = k + 1; k++; } + while (cut < as && (dc(ab, cut) == 32 || dc(ab, cut) == 9 || dc(ab, cut) == 10)) cut++; + k = cut; + while (k < as) { + if (dc(ab, k) == '/' && dc(ab, k + 1) == '*') { + k = k + 2; while (k < as && !(dc(ab, k) == '*' && dc(ab, k + 1) == '/')) k++; + k = k + 2; continue; + } + if (n == htbc) { htb = lsp_grow(htb, n, htbc * 2); htbc = htbc * 2; } + htb[n] = dc(ab, k); n++; k++; + } + while (n > 0 && (htb[n - 1] == 32 || htb[n - 1] == 9 || htb[n - 1] == 10)) n--; + htn = n; + if (htn == 2 && htb[0] == 'f' && htb[1] == 'n') htn = 0; // annotate left a fn alone + if (htn == 3 && htb[0] == 'l' && htb[1] == 'e' && htb[2] == 't') htn = 0; + return htn; + } + prev = ae; + } + return 0; +} +// the markdown of a local or parameter: its declaration text, then what it is +int hover_put_sig(int base, int sb, int se, int kind, int lk) { + int k = sb; + hn = 0; + hov_put('`'); hov_put('`'); hov_put('`'); hov_put('z'); hov_put('c'); hov_put(10); + while (k < se) { hov_put(dc(base, k)); k++; } + if (kind == 1) { + hov_put(' '); hov_put(' '); hov_put('/'); hov_put('/'); hov_put(' '); k = 0; while ("parameter"[k]) { hov_put("parameter"[k]); k++; } + if (htn > 0) { k = 0; while ("; type "[k]) { hov_put("; type "[k]); k++; } k = 0; while (k < htn) { hov_put(htb[k]); k++; } } + } + else { + hov_put(' '); hov_put(' '); hov_put('/'); hov_put('/'); hov_put(' '); k = 0; while ("local"[k]) { hov_put("local"[k]); k++; } + if (lk >= 0) { k = 0; while ("; type "[k]) { hov_put("; type "[k]); k++; } k = lt_at[lk]; while (k < lt_at[lk] + lt_len[lk]) { hov_put(ltxt[k]); k++; } } + else if (htn > 0) { k = 0; while ("; type "[k]) { hov_put("; type "[k]); k++; } k = 0; while (k < htn) { hov_put(htb[k]); k++; } } + } + hov_put(10); hov_put('`'); hov_put('`'); hov_put('`'); + return hn; +} +// a genome name: its signature as a code block, then its doc if the image has one +int hover_blob(int i) { + int ss, ds, k = 0, n = 0; + ss = blobsig(hname); + ds = blobdoc(hname); + hn = 0; + if (ss) { + hov_put('`'); hov_put('`'); hov_put('`'); hov_put('z'); hov_put('c'); hov_put(10); + while (k < len_s(ss)) { hov_put(at_s(ss, k)); k++; } + hov_put(10); hov_put('`'); hov_put('`'); hov_put('`'); + } + if (ds) { + if (ss) { hov_put(10); hov_put(10); } + k = 0; + while (k < len_s(ds)) { hov_put(at_s(ds, k)); k++; } + } + return hn; +} +// does the hovered word equal w +word hname_is(word w) { + int k = 0; + while (w[k] && hname[k] == w[k]) k++; + return !w[k] && !hname[k]; +} +// append a word string, or a compiler type, to the markdown buffer. +int hov_text(word s) { int k = 0; while (s[k]) { hov_put(s[k]); k++; } return 0; } +int hov_type(word t) { + int sm = outmode, sb = outbuf, sn = outn, sc = outcap, need; + outmode = 3; outn = 0; tprint(t); need = hn + outn; + if (need > hovcap) { + while (need > hovcap) hovcap = hovcap * 2; + hov = lsp_grow(hov, hn, hovcap); + } + outmode = 2; outbuf = hov; outn = hn; outcap = hovcap; tprint(t); hn = outn; + outmode = sm; outbuf = sb; outn = sn; outcap = sc; + return 0; +} +// explain composite types without relying on their source spelling. +int hover_type_info(word t) { + int kind, k; + if (!t) return 0; + kind = t[0]; + if (kind == TY_PTR) { + hov_text("\n\na pointer to `"); hov_type(t[4]); hov_text("`. the pointer occupies one word; the pointed-to storage is separate."); + } else if (kind == TY_ARR) { + hov_text("\n\nan array stored in place, with a fixed length of "); + k = t[3]; hov_number(k); hov_text(" elements of type `"); hov_type(t[4]); hov_text("`. storage: "); hov_number(tsz(t)); hov_text(" words."); + } else if (kind == TY_DYN) { + if (t[3]) hov_text("\n\nan array handle with a fixed runtime length. "); + else hov_text("\n\na growable array handle. "); + hov_text("element type: `"); hov_type(t[4]); hov_text("`. `len` gives the current length and `cap` gives capacity."); + if (t[3]) hov_text(" `push`, `pop`, and `resize` cannot change its length."); + } else if (kind == TY_STRUCT) { + hov_text("\n\na struct stored in place. storage: "); hov_number(tsz(t)); hov_text(" words."); + if (t[3] > 0) { + hov_text("\n\nfields:\n\n```zc\n"); + k = 0; + while (k < t[3]) { hov_type(t[4][k * 3 + 1]); hov_put(' '); hov_text(t[4][k * 3]); hov_text(";\n"); k++; } + hov_text("```"); + } + } else if (kind == TY_FN) hov_text("\n\na callable value. the type lists its result and parameter types."); + return 0; +} +// decimal numbers in markdown use the ordinary printer through the capture buffer. +int hov_number(int n) { + int sm = outmode, sb = outbuf, sn = outn, sc = outcap; + while (hn + 24 > hovcap) { hov = lsp_grow(hov, hn, hovcap * 2); hovcap = hovcap * 2; } + outmode = 2; outbuf = hov; outn = hn; outcap = hovcap; put_n(n); hn = outn; + outmode = sm; outbuf = sb; outn = sn; outcap = sc; + return 0; +} +// a parsed type includes its brackets and stars, so those characters hover too. +int hover_type_span(int i) { + int k = 0, best = 0 - 1, width = 0, end; word t; + while (k < ht_n) { + end = ht_end[k]; + while (end > ht_start[k] && (dc(doff[i], end - 1) == 32 || dc(doff[i], end - 1) == 9 || dc(doff[i], end - 1) == 10 || dc(doff[i], end - 1) == 13)) end--; + if (hcursor >= ht_start[k] && hcursor < end && end - ht_start[k] > width) { best = k; width = end - ht_start[k]; } + k++; + } + if (best < 0) return 0; + t = ht_type[best]; + hov_text("```zc\n"); hov_type(t); hov_text("\n```"); hover_type_info(t); + k = kwtext(); + if (k && (hname_is("word") || hname_is("int") || hname_is("char") || hname_is("bool") || hname_is("void") || hname_is("float") || hname_is("f32") || hname_is("f64") || hname_is("byte") || hname_is("u8") || hname_is("i8") || hname_is("u16") || hname_is("i16") || hname_is("u32") || hname_is("i32"))) { + while (*k && *k != '~') k++; + if (*k) { hov_text("\n\n"); hov_text(k + 1); } + } + return 1; +} +// the text of a keyword or a built-in word, from the language guide, or 0. this +// one table holds every keyword the compiler registers and the built-ins that +// have their own form. the form comes first, then a ~, then what it does (the ~ +// separates the two). a name the table does not hold gets the image's docs. +int kwtext() { + if (hname_is("word")) return "word~one 64-bit vm word; the default type for untyped integer values and word-sized storage"; + if (hname_is("int")) return "int~one signed, word-sized integer; arrays of int use one word per element"; + if (hname_is("char")) return "char~one word holding a character code; arrays of char use one word per element"; + if (hname_is("bool")) return "bool~one word for a boolean value; comparison and logical operators produce 0 or 1"; + if (hname_is("void")) return "void~marks a function with no meaningful result; the vm still uses a one-word return convention"; + if (hname_is("float")) return "float~one-word ieee binary64 value; arrays of float use one word per element"; + if (hname_is("f64")) return "f64~alias for float, a one-word ieee binary64 value"; + if (hname_is("f32")) return "f32~binary32 value rounded when stored; arrays and pointers pack two elements per word"; + if (hname_is("u8")) return "u8~unsigned 8-bit integer, range 0..255; values narrow on store and arrays or pointers pack eight elements per word"; + if (hname_is("i8")) return "i8~signed 8-bit integer, range -128..127; values narrow on store and arrays or pointers pack eight elements per word"; + if (hname_is("u16")) return "u16~unsigned 16-bit integer, range 0..65535; values narrow on store and arrays or pointers pack four elements per word"; + if (hname_is("i16")) return "i16~signed 16-bit integer, range -32768..32767; values narrow on store and arrays or pointers pack four elements per word"; + if (hname_is("u32")) return "u32~unsigned 32-bit integer, range 0..4294967295; values narrow on store and arrays or pointers pack two elements per word"; + if (hname_is("i32")) return "i32~signed 32-bit integer, range -2147483648..2147483647; values narrow on store and arrays or pointers pack two elements per word"; + if (hname_is("byte")) return "byte~alias for u8, an unsigned 8-bit integer packed in arrays and pointers"; + if (hname_is("fixed")) return "fixed~marks an array whose length cannot change; fixed arrays cannot grow or shrink"; + if (hname_is("new")) return "new(T) or new(T, n)~returns a fresh object on the heap. bound to a local, the local owns it (tagged m) and the block frees it when it ends, so you don't write free yourself."; + if (hname_is("free")) return "free(d*p)~frees a heap object. the block is kept until the next collection finds nothing pointing at it, and a second free does nothing. free takes an object tagged d, so a checked call is free(d*p)."; + if (hname_is("sizeof")) return "sizeof(e) or sizeof(T)~the size in words, found by compiling the expression dry, so it is not run. a packed array counts (n * bytes + 7) / 8 words."; + if (hname_is("typeof")) return "typeof(e) or typeof(T)~the type record of an expression or a type, found by compiling it dry. tkind, tsize, tname and the other t functions read it at runtime."; + if (hname_is("syscall")) return "syscall(op, a, b, c)~a call to the host through the gate word. the ops are SYS_OPEN, SYS_CLOSE, SYS_READ, SYS_WRITE, SYS_GETENV, SYS_TIME and the rest of the named ones, and SYS_RAW (40) runs any linux syscall on the host. o3 code does not go through the gate, so call syscall from ordinary code."; + if (hname_is("len")) return "len(a)~the number of items in an array, growable or fixed."; + if (hname_is("cap")) return "cap(a)~the number of items a growable array can hold before it has to grow."; + if (hname_is("push")) return "push(a, x)~adds x to the end of a growable array, growing it when needed. a growable array owns its items."; + if (hname_is("pop")) return "pop(a)~removes the last item of a growable array and gives it back."; + if (hname_is("resize")) return "resize(a, n)~sets the length of a growable array to n, growing or shrinking it."; + if (hname_is("o3")) return "o3~marks code for the optimizing tier. it goes on a function, a block or a single variable, and its variables live in registers."; + if (hname_is("fn")) return "fn name(a, b) { }~declares a function whose return is a word. a typed function is written like c, int f(int x) { }."; + if (hname_is("let")) return "let name = e~declares a local whose type comes from its value. a number stays a plain word, and a pointer or a struct keeps its type."; + if (hname_is("const")) return "const [type] NAME = e~a named constant. its value is worked out while compiling, so it can size an array or label a case."; + if (hname_is("else")) return "else~the other branch of an if. after an enhance's body, else names the fallback function that runs where the enhancement can't."; + if (hname_is("as")) return "e as T~changes the type of an expression without changing its bits."; + if (hname_is("unchecked")) return "unchecked fn f() { } / unchecked { } / unchecked;~turns the lifetime analyzer off for a function, a block, or the rest of the unit. the code is not checked, so the analyzer's rules don't apply to it."; + if (hname_is("immediate")) return "immediate fn name() { }~a parse word. it runs during compilation whenever its name shows up as a statement, inside an expression or at the top level."; + if (hname_is("case")) return "case v:~a label in a switch. each case ends where the next one begins, so cases don't fall through."; + if (hname_is("default")) return "default:~the arm of a switch that runs when no case matches."; + if (hname_is("do")) return "do { } while (cond);~a loop that runs its body once before the test."; + if (hname_is("while")) return "while (cond) { }~a loop that tests the condition before each pass."; + if (hname_is("for")) return "for (init; cond; step) { }~a loop with its start, test and step written on one line."; + if (hname_is("if")) return "if (cond) { } else { }~runs one branch or the other, by the condition."; + if (hname_is("switch")) return "switch (e) { case 1, 2: ... default: ... }~a branch on constant labels. the cases don't fall through, and break leaves early."; + if (hname_is("break")) return "break;~leaves the innermost loop or switch."; + if (hname_is("continue")) return "continue;~goes on to the next pass of the innermost loop."; + if (hname_is("return")) return "return e;~leaves the function with a value. a u object leaves with u*x, and the function's return is then owned."; + if (hname_is("enum")) return "enum name { A, B = 5 };~global constants. under typecheck on they are a type of their own, and a member can carry fields to make a constructor."; + if (hname_is("struct")) return "struct name { fields };~a record type. struct name { } makes it generic, one copy for each set of type arguments."; + if (hname_is("type")) return "type name = T;~an alias for a type, such as type row = [3]int; for a pointer to an array."; + if (hname_is("include")) return "include \"path\";~reads a file and compiles it at that point, its signatures first."; + if (hname_is("memdebug")) return "memdebug on; / memdebug off; / memdebug scrub;~header checks, allocation sites and leak reports for the rest of the file. scrub also fills a freed payload with 0xDEAD."; + if (hname_is("typecheck")) return "typecheck on; / typecheck off;~turns on type checks for the code that follows, enums included."; + if (hname_is("docs")) return "docs on; / docs off;~keeps the doc comments above declarations in the image, so the language server can show them on hover."; + if (hname_is("micro")) return "enhance name(args) micro \"recipe\";~the body of an enhancement, written as micro-ops on registers r0 to r15. the inputs arrive in r0 and up, and the outputs leave from r0."; + if (hname_is("vm")) return "enhance name(args) vm { ... };~the body of an enhancement, written as stack machine asm. it becomes one opcode when the core lifts it."; + if (hname_is("enhance")) return "enhance name(args) micro \"...\" or vm { ... };~installs a custom opcode at compile time, with up to 8 inputs and 8 outputs. an enhancement with one output can be called like a function."; + if (hname_is("asm")) return "asm { ... }~a block of stack machine asm, and asm operands can be used inside expressions."; + if (hname_is("quote")) return "quote { tokens }~a token list as a fresh object. a parse word can read it and build code from it."; + if (hname_is("extern")) return "extern type name(params);~declares a c function on the host and calls it through the native call."; + if (hname_is("cfunc")) return "cfunc(f)~a native function pointer that runs the zc function f when c calls it."; + return 0; +} +// the markdown of a keyword: its form as a code block, then what it does +int kw_put(word s) { + int k = 0; + hov_put('`'); hov_put('`'); hov_put('`'); hov_put('z'); hov_put('c'); hov_put(10); + while (s[k] && s[k] != '~') { hov_put(s[k]); k++; } + hov_put(10); hov_put('`'); hov_put('`'); hov_put('`'); + if (s[k]) { + hov_put(10); hov_put(10); k++; + while (s[k]) { hov_put(s[k]); k++; } + } + return hn; +} +// does the line from q declare hname as a method: the name is followed by (, and +// what comes before it is a type, fn or static, and nothing that makes it a call +int hm_decl(int base, int q, int le) { + int po = q, ns, e, k = 0, c; + while (po < le && dc(base, po) != '(') po++; + if (po >= le) return 0; + e = po; + ns = e; + while (ns > q && hid(dc(base, ns - 1))) ns--; + if (ns == e || ns == q) return 0; + while (hname[k] && ns + k < e && dc(base, ns + k) == hname[k]) k++; + if (hname[k] || ns + k != e) return 0; + if (dc(base, ns - 1) != 32 && dc(base, ns - 1) != 9) return 0; + k = q; + while (k < ns) { + c = dc(base, k); + if (c == '=' || c == '.' || c == ';' || c == '(' || c == ',' || c == '{' || c == '}') return 0; + k++; + } + if (hl_kw(base, q)) return 0; + return 1; +} +// the markdown of a method or a static function of a struct: its line as the +// signature, then the comment lines right above it. the methods are indented in +// the struct body, so hover_scan (which reads column 0) does not find them. +// returns 1 when the hovered word is such a name. +int hover_method(int i) { + int base = doff[i], size = dsize[i], ls = 0, le, q, p, e, k, cs, pv, found = 0, sg, se, n; + while (ls < size && !found) { + le = ls; + while (le < size && dc(base, le) != 10) le++; + q = ls; + while (q < le && (dc(base, q) == 32 || dc(base, q) == 9)) q++; + if (q > ls && hm_decl(base, q, le)) { found = 1; sg = q; se = q; } + if (!found) ls = le + 1; + } + if (!found) return 0; + // the signature: up to the body, a ; or the end of the line + se = sg; + while (se < size && dc(base, se) != 10 && dc(base, se) != '{' && dc(base, se) != ';') se++; + while (se > sg && (dc(base, se - 1) == 32 || dc(base, se - 1) == 9)) se--; + hn = 0; + hov_put('`'); hov_put('`'); hov_put('`'); hov_put('z'); hov_put('c'); hov_put(10); + k = sg; + while (k < se) { hov_put(dc(base, k)); k++; } + hov_put(10); hov_put('`'); hov_put('`'); hov_put('`'); + hover_docs(i, sg, sg, 0); + return 1; +} +// the markdown of a local at its declaration: the name's declaration line, with +// the type an untyped let was given. o is the byte offset of the declared name. +int hover_named(int i, int o, int kind) { + int base = doff[i], end = o, head = o, k, entry, untyped; word t = 0; + while (end < dsize[i] && hid(dc(base, end))) end++; + if (end == o) return 0; + untyped = ann_untyped(i, o); htn = 0; + if (untyped) { ensure_annot(i); ann_type(i, o); ensure_checked(i); } + entry = lt_find(o); + if (entry >= 0) t = lt_type[entry]; + k = 0; + while (k < ht_n) { if (ht_end[k] == o && ht_start[k] < head) head = ht_start[k]; k++; } + if (untyped && kind != 1) { + k = o - 1; + while (k >= 0 && (dc(base, k) == 32 || dc(base, k) == 9)) k--; + if (k >= 2 && dc(base, k) == 't' && dc(base, k - 1) == 'e' && dc(base, k - 2) == 'l') head = k - 2; + } + hn = 0; hov_text("```zc\n"); + if (untyped && kind != 1) hov_text("let "); + else if (!untyped && t) { hov_type(t); hov_put(' '); } + k = o; while (k < end) { hov_put(dc(base, k)); k++; } + if (kind == 1) hov_text(" // parameter"); + else if (kind == 3) hov_text(" // global"); + else if (kind == 4) hov_text(" // field"); + else hov_text(" // local"); + if (htn || entry >= 0) { + hov_text("; type "); + if (htn) { k = 0; while (k < htn) { hov_put(htb[k]); k++; } } + else { k = lt_at[entry]; while (k < lt_at[entry] + lt_len[entry]) { hov_put(ltxt[k]); k++; } } + } + hov_text("\n```"); hover_type_info(t); hover_docs(i, head, o, end - o); + if (hoff != o) hover_docs(i, hoff, hoff, len_w(hname)); + htn = 0; + return 1; +} +int hover_at_decl(int i, int o) { return hover_named(i, o, 2); } +// storage facts are copied at the reference's position, before later statements +// can change them. unknown facts stay unknown in the preview. +int hover_storage(int r) { + word p, t = 0; int entry, kind; + if (r < 0 || !hn) return 0; + p = rsrec + r * RS_W; kind = p[6]; + if (!kind) { + if (p[1] == RS_LOCAL || p[1] == RS_PARAM || p[1] == RS_FIELD) { + entry = lt_find(p[2]); if (entry >= 0) t = lt_type[entry]; + } else if (p[1] == RS_SYM && p[3] >= 0) t = stype[p[3]]; + if (!t || (t[0] != TY_PTR && t[0] != TY_ARR && t[0] != TY_DYN)) return 0; + hov_text("\n\nsize: "); + if (t[0] == TY_ARR) { hov_number(t[3]); hov_text(" elements"); } + else hov_text("unknown"); + hov_text(". lifetime: unknown at this position."); return 0; + } + hov_text("\n\nsize: "); + if (p[4] >= 0) { hov_number(p[4]); hov_text(" elements"); } + else hov_text("unknown"); + hov_text(". lifetime: "); + if (p[5] == 2) { hov_text("ended on line "); hov_number(p[8] & 0xFFFFFF); } + else if (p[5] == 1) { + if (kind == 1) hov_text("stack storage; ends when its declaring scope exits"); + else hov_text("heap storage; live here, ends when freed or its owner releases it"); + } else hov_text("unknown after a call or control-flow change"); + if (p[7]) { hov_text(". storage begins on line "); hov_number(p[7] & 0xFFFFFF); } + hov_text("."); return 0; +} +// the hover of a name that is not a local. kind is 1 for a built-in (the guide's +// text, then the image's docs), 2 for a symbol the document declares (its +// declaration, a method, then the image's docs), and 0 when no record says (the +// guide, then the text of the document, as before) +int hover_global(int i, int kind) { + int kt; + if (kind != 2) { kt = kwtext(); if (kt) return kw_put(kt); } + if (kind == 1) { hover_blob(i); return hn; } + if (hover_scan(i)) { hover_fill(i); return hn; } + if (hover_method(i)) return hn; + if (kind == 0 && hover_local(i)) return hn; + hover_blob(i); + return hn; +} +// the hover at the cursor. the compiler's record of the name decides what it +// is: a local is its declaration, a parameter the header that names it, and a +// symbol is looked up as that kind of symbol. a name with no record is found by +// its text, as before. +int do_hover(int i) { + int r, k = 0, v = 0, has_word, s, q, o; + hn = 0; + ensure_checked(i); + has_word = hover_word(i); + if (hover_type_span(i)) { send(gen_hover); return 0; } + if (has_word) { + r = rs_find(hoff); + if (r >= 0) { k = rsrec[r * RS_W + 1]; v = rsrec[r * RS_W + 2]; } + if (k == RS_LOCAL && v >= 0) hover_at_decl(i, v); + else if (k == RS_PARAM && v >= 0) hover_named(i, v, 1); + else if (k == RS_FIELD && v >= 0) hover_named(i, v, 4); + else if (k == RS_LOCAL) hover_local(i); + else if (k == RS_SYM) { + if ((v & 15) == K_GVAR || (v & 15) == K_GARR) { + s = rsrec[r * RS_W + 3]; q = 0; o = 0 - 1; + while (q < rsn) { if (rsrec[q * RS_W + 3] == s && lt_find(rsrec[q * RS_W]) >= 0) { o = rsrec[q * RS_W]; break; } q++; } + if (o >= 0) hover_named(i, o, 3); else if (v & 16) hover_global(i, 2); else hover_global(i, 1); + } else if (v & 16) hover_global(i, 2); else hover_global(i, 1); + } + else hover_global(i, 0); + r = rs_find(hoff); hover_storage(r); + } + send(gen_hover); + return 0; +} + +// ---- dispatch ---- +// the text just read belongs to the document named by the uri +int commit_text() { + int i; + if (!thave || !tuseen) return 0 - 1; + i = dfind(ubuf, un); + if (i < 0) i = docnew(ubuf, un); + if (i < 0) return 0 - 1; + doff[i] = tbase; dsize[i] = tn; dver[i] = jver; dgen[i]++; + return i; +} +// handles one message: the lifecycle (initialize, shutdown, exit), changes to a +// document (which are checked and published), and the requests for semantic +// tokens and hovers. +int handle() { + int i; + if (eq_w(mbuf, "initialize")) { inited = 1; send(gen_init); return 0; } + if (eq_w(mbuf, "exit")) { quit = 1; return 0; } + if (eq_w(mbuf, "shutdown")) { shut = 1; send(gen_null); return 0; } + if (!inited) { if (idtype) reply_error(0 - 32002); return 0; } + if (eq_w(mbuf, "textDocument/didOpen") || eq_w(mbuf, "textDocument/didChange") || eq_w(mbuf, "textDocument/didSave")) { + i = commit_text(); + if (i < 0 && tuseen) i = dfind(ubuf, un); + if (i >= 0) { check_doc(i); publish(i); } + return 0; + } + if (eq_w(mbuf, "textDocument/didClose")) { + i = dfind(ubuf, un); + if (i >= 0) { + dgpos = 0; publish(i); // an empty list clears its markers + dlive[i] = 0; dsize[i] = 0; doff[i] = 0; duri[i] = 0; + chk_i = 0 - 1; + hc_i = 0 - 1; ann_i = 0 - 1; + } + return 0; + } + if (eq_w(mbuf, "textDocument/semanticTokens/full")) { + i = dfind(ubuf, un); + if (i < 0) { send(gen_empty); return 0; } + ensure_checked(i); + gd = i; send(gen_tokens); + return 0; + } + if (eq_w(mbuf, "textDocument/hover")) { + i = dfind(ubuf, un); + if (i < 0) { send(gen_null); return 0; } + do_hover(i); + return 0; + } + if (idtype) reply_error(0 - 32601); + return 0; +} + +// ---- command line ---- +// a source file on stdin instead of a protocol stream: print what the +// compiler found, one line each. with --annotate, print the file with the +// types the compiler can see written in +unchecked int load_stdin(int first) { + int n = 0, c = first, cap = 4096; word nb; int k; + tbase = new(cap); + while (c >= 0) { + if ((n >> 2) + 4 >= cap) { + nb = new(cap * 2); k = 0; + while (k < cap) { nb[k] = tbase[k]; k++; } + tbase = nb; cap = cap * 2; + } + if ((n & 3) == 0) tbase[n >> 2] = 0; + tbase[n >> 2] = tbase[n >> 2] | (c << ((n & 3) * 8)); + n++; + if (eof()) break; + c = get_c() & 255; + } + if (n & 3) { } else tbase[n >> 2] = 0; + tbase[(n >> 2) + 1] = 0; + dlive[0] = 1; doff[0] = tbase; dsize[0] = n; dgen[0] = 1; dulen[0] = 0; + return n; +} +// zclsp given a source file on stdin prints its diagnostics as file:line:column +// lines, one per error or hint, and says so when there are none. +int cli(int first) { + int at = 0, i, o; + load_stdin(first); + check_doc(0); + pc_reset(0); + while (at < dgpos) { + o = dgb[at + 2]; + if (o < 0) { put_s("line "); put_n(dgb[at + 1]); } + else { pc_to(o); put_n(pline + 1); put_c(':'); put_n(pcol + 1); } + if (dgb[at] == 1) put_s(": error: "); else if (dgb[at] == 2) put_s(": warning: "); else put_s(": hint: "); + i = 0; while (i < dgb[at + 4]) { put_c(dgb[at + 5 + i]); i++; } + put_c(10); + at = at + 5 + dgb[at + 4]; + } + if (!dgpos) put_s("no errors\n"); + return 0; +} + +// ---- annotate ---- +// zclsp --annotate < file.zc prints the file with the types the compiler can +// see written in: locals from their initializers, parameters from what every +// call passes them or from being used as an address, returns from what the +// function returns (the type facts of compiler.zc). the typechecker is on for +// it, and every edit has to leave the file with no error it didn't have, so +// what comes out compiles wherever the input did. when a batch of edits +// fails, the batch is cut in halves until the bad edits are found and left +// out. run it again and the types it just wrote let the next round see more. +int aw_start(int p) { awp = p; awn = 0; return 0; } +// appends byte c to the output being built at awp (awn bytes so far). +int aw(int c) { + if ((awn & 3) == 0) awp[awn >> 2] = 0; + awp[awn >> 2] = awp[awn >> 2] | ((c & 255) << ((awn & 3) * 8)); + awn++; + return 0; +} +// ends the output being built: a zero word follows the last byte, so it reads as a text. +int aw_end() { + if ((awn & 3) == 0) awp[awn >> 2] = 0; + awp[(awn >> 2) + 1] = 0; + return 0; +} +// the lines of the errors the last check found +int err_lines(word dst) { + int at = 0, n = 0, need = dgpos / 5 + 1, baseline = dst == abase; + if (need > aerrcap) { + while (need > aerrcap) { if (!aerrcap) aerrcap = 512; else aerrcap = aerrcap * 2; } + abase = lsp_grow(abase, nbase, aerrcap); aerr = lsp_grow(aerr, 0, aerrcap); + } + if (baseline) dst = abase; else dst = aerr; + while (at < dgpos) { + if (dgb[at] == 1) { dst[n] = dgb[at + 1]; n++; } + at = at + 5 + dgb[at + 4]; + } + return n; +} +// is v one of the first n words of set. +int in_set(int v, word set, int n) { + int i = 0; + while (i < n) { if (set[i] == v) return 1; i++; } + return 0; +} +// the facts, in the order of the text +int sort_facts() { + int i = 1, j; word a, b; int t0, t1, t2, t3; + while (i < nifx) { + j = i; + while (j > 0 && ifx[(j - 1) * 4] > ifx[j * 4]) { + a = ifx + (j - 1) * 4; b = ifx + j * 4; + t0 = a[0]; t1 = a[1]; t2 = a[2]; t3 = a[3]; + a[0] = b[0]; a[1] = b[1]; a[2] = b[2]; a[3] = b[3]; + b[0] = t0; b[1] = t1; b[2] = t2; b[3] = t3; + j--; + } + i++; + } + return 0; +} +// the facts the last check collected, kept across the checks that follow +int save_facts() { + int i = 0, nt = 0; word f; int k; + sort_facts(); + if (nifx > afcap) { + while (nifx > afcap) { if (!afcap) afcap = 4096; else afcap = afcap * 2; } + afx = lsp_grow(afx, 0, afcap * 4); amask = lsp_grow(amask, 0, afcap); + } + if (nift > atcap) { + while (nift > atcap) { if (!atcap) atcap = 24000; else atcap = atcap * 2; } + aft = lsp_grow(aft, 0, atcap); + } + anf = 0; + while (i < nifx) { + f = ifx + i * 4; + i++; + afx[anf * 4] = f[0]; afx[anf * 4 + 1] = f[1]; afx[anf * 4 + 2] = nt; afx[anf * 4 + 3] = f[3]; + k = 0; while (k < f[3]) { aft[nt + k] = ift[f[2] + k]; k++; } + nt = nt + f[3]; + anf++; + } + return 0; +} +// the text of document 0 with the facts in the mask applied, into dst. a fact +// that overlaps the one before it is left out. returns how many went in +int apply_masked(int dst) { + int i = 0, o = 0; word f; int k, n = 0, size = dsize[0], base = doff[0], last = 0 - 1; + aw_start(dst); + while (i < anf) { + f = afx + i * 4; + i++; + if (!amask[i - 1] || f[0] < o || f[0] == last || f[0] + f[1] > size) continue; + while (o < f[0]) { aw(dc(base, o)); o++; } + k = 0; while (k < f[3]) { aw(aft[f[2] + k]); k++; } + o = f[0] + f[1]; last = f[0]; + n++; + } + while (o < size) { aw(dc(base, o)); o++; } + aw_end(); + return n; +} +// the block the masked text is written into: room for the document and every +// replacement, so it never runs out +word fresh_half() { + int n = dsize[0], i = 0; + while (i < anf) { n = n + afx[i * 4 + 3]; i++; } + ann_half = new(dwords(n)); + return ann_half; +} +// does the document with the masked facts applied check with no new error? +int verify() { + int ne, i; + apply_masked(ann_half); + dlive[1] = 1; doff[1] = ann_half; dsize[1] = awn; dgen[1] = dgen[1] + 1; dulen[1] = 0; + check_doc(1); + ne = err_lines(aerr); + i = 0; + while (i < ne) { if (!in_set(aerr[i], abase, nbase)) return 0; i++; } + return 1; +} +// take the facts lo .. hi if they fit together, else halve them and try the halves +int try_range(int lo, int hi) { + int mid, k; + if (lo >= hi) return 0; + k = lo; while (k < hi) { amask[k] = 1; k++; } + if (verify()) return 0; + k = lo; while (k < hi) { amask[k] = 0; k++; } + if (hi - lo == 1) return 0; + mid = (lo + hi) / 2; + try_range(lo, mid); + try_range(mid, hi); + return 0; +} +// zclsp --annotate reads a source file on stdin and prints it with the types the +// compiler can see written in. the rounds run the check with the type facts on, +// keep the edits that add no error, and run again on the text they made. +int annotate(int first) { + int round = 0, n, i; + load_stdin(first); + ifstrict = 1; // the typechecker runs, so a type that doesn't fit how a name is used is an error + check_doc(0); + nbase = err_lines(abase); + while (round < AROUNDS) { + ifon = 1; check_doc(0); ifon = 0; + save_facts(); + if (!anf) break; + i = 0; while (i < anf) { amask[i] = 0; i++; } + fresh_half(); + try_range(0, anf); + n = apply_masked(ann_half); + if (!n) break; + doff[0] = ann_half; dsize[0] = awn; dgen[0] = dgen[0] + 1; + round++; + } + ifstrict = 0; + i = 0; + while (i < dsize[0]) { put_c(dc(doff[0], i)); i++; } + return 0; +} +// the first argument: 1 for --annotate, 2 for --types, which lists the edits +// instead of making them +unchecked int cli_mode() { + int n = syscall(SYS_ARGC, 0, 0, 0), len; word s; int r = 0; + if (n < 2) return 0; + len = syscall(SYS_ARG, 1, 0, 0); + if (len != 10 && len != 7) return 0; + s = new(len + 1); + syscall(SYS_ARG, 1, s, len + 1); + if (s[0] == '-' && s[1] == '-' && s[2] == 'a' && s[3] == 'n' && len == 10) r = 1; + if (s[0] == '-' && s[1] == '-' && s[2] == 't' && s[3] == 'y' && len == 7) r = 2; + free(s); + return r; +} +// zclsp --types < file.zc: one line per edit, line:column, how many characters +// it replaces and the text that goes in +int list_types(int first) { + int i = 0; word f; int k; + load_stdin(first); + ifon = 1; check_doc(0); ifon = 0; + sort_facts(); + pc_reset(0); + while (i < nifx) { + f = ifx + i * 4; + pc_to(f[0]); + put_n(pline + 1); put_c(':'); put_n(pcol + 1); put_c(32); put_n(f[1]); put_c(32); + k = 0; while (k < f[3]) { put_c(ift[f[2] + k]); k++; } + put_c(10); + i++; + } + return 0; +} + +// the entry point of zclsp. the input is either a source file (checked, and its +// diagnostics printed), a file to annotate or to list the types of (--annotate, +// --types), or the json-rpc stream of a language server (when it starts with a +// Content-Length header). +int lsp_main() { + int c, k; + docs_on = 0; // the image was made with docs on; the documents checked here are not docs + chk_heap = 1; + dgb = new(DGCAP); sets = new(4 * LSW); + duri = lsp_grow(0, 0, doccap); dulen = lsp_grow(0, 0, doccap); + doff = lsp_grow(0, 0, doccap); dsize = lsp_grow(0, 0, doccap); + dver = lsp_grow(0, 0, doccap); dgen = lsp_grow(0, 0, doccap); dlive = lsp_grow(0, 0, doccap); + mbuf = lsp_grow(0, 0, mcap); idbuf = lsp_grow(0, 0, idcap); jk = lsp_grow(0, 0, jkcap); kbuf = lsp_grow(0, 0, kcap); lbuf = lsp_grow(0, 0, lcap); + ubuf = lsp_grow(0, 0, ucap); hov = lsp_grow(0, 0, hovcap); hname = lsp_grow(0, 0, hnamecap); htb = lsp_grow(0, 0, htbc); + chk_i = 0 - 1; jpk = 0 - 2; rfirst = 0 - 1; + if (eof()) return 0; + c = get_c() & 255; + if (c != 'C' && c != 'c') { + k = cli_mode(); + if (k == 1) annotate(c); else if (k == 2) list_types(c); else cli(c); + return 0; + } + rfirst = c; + while (!quit) { + if (!read_message()) break; + handle(); + } + return 0; +} diff --git a/src/micro/micro.c b/src/micro/micro.c new file mode 100644 index 0000000..4542bd8 --- /dev/null +++ b/src/micro/micro.c @@ -0,0 +1,643 @@ +/* portable microcore. the base machine from core.c — memory, the two stacks, + the 22 opcodes, call/ret, and the genome — without the jit, llvm, o3, or + the enhancement optimizer. + + `/` `%` `<<` and every other custom opcode are installed at runtime + (opcode 21). the genome's own idiv, imod, ishl, lfa and outside arrive + that way, and so do programs that declare enhance. this file lowers a + recipe or a straight-line vm body into a flat list of micro-ops and runs + that list. there is no constant folding and no multiply-high rewrite of + division; the results match, the list is just longer. install kind 2 is + an o3 region: it is accepted and ignored, and the ordinary bytecode of + that region runs instead, which is the same program the full interpreter + would run if the region did not lift. + + no libc in this file. stdint.h is freestanding. 64-bit division is the + compiler's runtime. bss must be zero before micro_run. + + memory size and the map come from memmap.h (the default is 1,048,576 + words). a smaller board compiles this file against the headers src/tools/genmap + writes, and against the genome built for that same map. */ +#include +#ifdef USE_LSP_GENOME +#include "lsp_genome.h" +#elif defined(GENOME_H) +#include GENOME_H +#else +#include "genome.h" +#endif +#include "micro_port.h" +#include "fops.h" +#include "bops.h" +#define NENH 512 +#define XOP0 22 +#define XPOOL 4096 +#define MAXOPS 128 +#define MAXV 256 + +enum { + U_LI, U_MOV, U_ADD, U_SUB, U_MUL, U_SDIV, U_UDIV, U_SREM, U_UREM, + U_AND, U_OR, U_XOR, U_SHL, U_SHR, U_SAR, U_NEG, U_NOT, + U_LT, U_LTU, U_EQ, U_NE, U_MIN, U_MAX, U_MINU, U_MAXU, + U_MULHS, U_MULHU, U_CLZ, U_ABS, U_SEL, U_LD, U_ST, + U_CTZ, U_POPCNT, U_BSWAP, U_ROTL, U_ROTR, U_F2S, U_S2F, U_N +}; +static const char *const uname[U_N] = { + "li", "mov", "add", "sub", "mul", "sdiv", "udiv", "srem", "urem", + "and", "or", "xor", "shl", "shr", "sar", "neg", "not", + "lt", "ltu", "eq", "ne", "min", "max", "minu", "maxu", + "mulhs", "mulhu", "clz", "abs", "sel", "ld", "st", + "ctz", "popcnt", "bswap", "rotl", "rotr", "f2s", "s2f" +}; +static const signed char uarity[U_N] = { + 0, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 3, 1, 2, + 1, 1, 1, 2, 2, 1, 1 +}; + +typedef struct { + unsigned char op, a, b, c; + unsigned short d; + Cell imm; +} Xop; +typedef struct { + unsigned char live, nin, nout; + unsigned short n, at, nv; + unsigned short out[8]; +} Enh; + +/* the machine: m is mw words, and grows on demand through the port (micro_mem_alloc). + every access goes through m and mw, which the port's memory may move under. */ +static Cell *m; +static UCell mw; +static UCell memory_initial = MICRO_MW_INIT, memory_limit = MICRO_MW_LIMIT; +int micro_memory_config(UCell initial, UCell limit) +{ + if (m || initial < MICRO_MW_INIT || limit < initial || limit > 0x7fffffff) return 0; + memory_initial = initial; memory_limit = limit; return 1; +} +static Xop xops[XPOOL]; +static int xuse; +static Enh enh[NENH]; +static Xop build[MAXOPS]; +static int bn, bnv, berr; +static Cell xv[MAXV]; +static int jflag; +static int jknown; /* 0 until something asks for the end-of-input flag: the probe reads the port, so it waits for the first ask */ + +UCell micro_mem_words(void) { return mw; } +static int inmem(Cell a) { return (UCell)a < mw; } +static Cell ld(Cell a) { return inmem(a) ? m[a] : 0; } +static Cell b_load(Cell addr, int n) +{ + if (!bop_ok(addr, n, mw)) return 0; + return bop_load(m, addr, n); +} +static void b_store(Cell addr, Cell val, int n) +{ + Cell out[2], w0; + int nw, i; + if (!bop_ok(addr, n, mw)) return; + nw = bop_merge(m, addr, val, n, out, &w0); + for (i = 0; i < nw; i++) if (inmem(w0 + i)) m[w0 + i] = out[i]; +} + +/* the run's sentinel pcs: each names why a run stopped that is not a halt. they + are negative, so no address in memory is one of them. */ +#define PC_DATA_OVERFLOW (-3) +#define PC_RETURN_OVERFLOW (-4) +#define PC_PAST_END (-5) +#define PC_BAD_OP (-6) +#define PC_HALT (-7) /* the zero word: the program's halt, not an error */ +static int bad_op; + +/* grows the machine to at least words words, through the port. the contents stay, + and the new words are zero. 1 on success, 0 when the port has no more memory. */ +static int mem_grow_words(UCell words) +{ + Cell *n; + if (words <= mw && m) return 1; + if (words > memory_limit) return 0; + n = micro_mem_alloc(words); + if (!n) return 0; + m = n; + mw = words; + return 1; +} + +/* the heap asks for more memory (syscall 9, a = 4, b = words). answers the new + size in words, or -1 when the port cannot give it */ +static Cell mem_grow_request(Cell words) +{ + if (words < 0) return -1; + if (!mem_grow_words((UCell)words)) return -1; + return (Cell)mw; +} +static int stack_memory_grow(UCell words) { return mem_grow_words(words); } +#include "stack.h" + +static Cell mulhu(UCell a, UCell b) +{ + UCell a0 = a & 0xffffffffull, a1 = a >> 32, b0 = b & 0xffffffffull, b1 = b >> 32; + UCell p0 = a0 * b0, p1 = a1 * b0, p2 = a0 * b1, p3 = a1 * b1; + UCell mid = (p0 >> 32) + (p1 & 0xffffffffull) + (p2 & 0xffffffffull); + return (Cell)(p3 + (p1 >> 32) + (p2 >> 32) + (mid >> 32)); +} +static Cell mulhs(Cell a, Cell b) +{ + Cell hi = mulhu((UCell)a, (UCell)b); + if (a < 0) hi -= b; + if (b < 0) hi -= a; + return hi; +} +static Cell sar(Cell v, int n) +{ + if (n <= 0) return v; + if (v < 0) return (Cell)(((UCell)v >> n) | (~(UCell)0 << (64 - n))); + return (Cell)((UCell)v >> n); +} +static Cell ev(int op, Cell a, Cell b, Cell c) +{ + UCell ua = (UCell)a, ub = (UCell)b; + int sh = (int)(b & 63); + switch (op) { + case U_MOV: return a; + case U_ADD: return (Cell)(ua + ub); + case U_SUB: return (Cell)(ua - ub); + case U_MUL: return (Cell)(ua * ub); + case U_SDIV: return b == 0 ? 0 : (a == (Cell)((UCell)1 << 63) && b == -1) ? a : a / b; + case U_UDIV: return b == 0 ? 0 : (Cell)(ua / ub); + case U_SREM: return b == 0 ? a : (a == (Cell)((UCell)1 << 63) && b == -1) ? 0 : a % b; + case U_UREM: return b == 0 ? a : (Cell)(ua % ub); + case U_AND: return a & b; + case U_OR: return a | b; + case U_XOR: return a ^ b; + case U_SHL: return (Cell)(ua << sh); + case U_SHR: return (Cell)(ua >> sh); + case U_SAR: return sar(a, sh); + case U_NEG: return (Cell)(0ull - ua); + case U_NOT: return ~a; + case U_LT: return a < b; + case U_LTU: return ua < ub; + case U_EQ: return a == b; + case U_NE: return a != b; + case U_MIN: return a < b ? a : b; + case U_MAX: return a > b ? a : b; + case U_MINU: return ua < ub ? a : b; + case U_MAXU: return ua > ub ? a : b; + case U_MULHS: return mulhs(a, b); + case U_MULHU: return mulhu(ua, ub); + case U_CLZ: { + int n = 0; + if (!ua) return 64; + while (!(ua & ((UCell)1 << 63))) { ua <<= 1; n++; } + return n; + } + case U_ABS: return a < 0 ? (Cell)(0ull - ua) : a; + case U_CTZ: { int n = 0; if (!ua) return 64; while (!(ua & 1)) { ua >>= 1; n++; } return n; } + case U_POPCNT: { int n = 0; while (ua) { ua &= ua - 1; n++; } return n; } + case U_BSWAP: { UCell r = 0; int i; for (i = 0; i < 8; i++) { r = (r << 8) | (ua & 0xff); ua >>= 8; } return (Cell)r; } + case U_ROTL: return (Cell)((ua << sh) | (ua >> ((64 - sh) & 63))); + case U_ROTR: return (Cell)((ua >> sh) | (ua << ((64 - sh) & 63))); + case U_F2S: return (Cell)fop_f2s((uint64_t)a); + case U_S2F: return (Cell)fop_s2f((uint64_t)a); + case U_SEL: return a ? b : c; + } + return 0; +} + +static int vnew(int op, int a, int b, int c, Cell imm) +{ + Xop *u; + if (berr) return 0; + if (bn >= MAXOPS || bnv >= MAXV) { berr = -5; return 0; } + u = &build[bn++]; + u->op = (unsigned char)op; + u->a = (unsigned char)a; + u->b = (unsigned char)b; + u->c = (unsigned char)c; + u->d = (unsigned short)bnv; + u->imm = imm; + return bnv++; +} +static int seq(const char *a, const char *b) +{ + while (*a && *a == *b) { a++; b++; } + return *a == *b; +} +static int findop(const char *s) +{ + int i; + for (i = 0; i < U_N; i++) if (seq(uname[i], s)) return i; + return -1; +} +static int parse_num(const char *t, Cell *o) +{ + int sign = 1, base = 10, d; + UCell n = 0; + if (*t == '-') { sign = -1; t++; } + else if (*t == '+') t++; + if (*t == '0' && (t[1] == 'x' || t[1] == 'X')) { base = 16; t += 2; } + else if (*t == '0' && t[1]) base = 8; + if (!*t) return -1; + for (; *t; t++) { + if (*t >= '0' && *t <= '9') d = *t - '0'; + else if (*t >= 'a' && *t <= 'f') d = *t - 'a' + 10; + else if (*t >= 'A' && *t <= 'F') d = *t - 'A' + 10; + else return -1; + if (d >= base) return -1; + n = n * (UCell)base + (UCell)d; + } + *o = sign < 0 ? (Cell)(0ull - n) : (Cell)n; + return 0; +} +static int regn(const char *t) +{ + int r = 0; + if (t[0] != 'r' || t[1] < '0' || t[1] > '9') return -1; + t++; + while (*t >= '0' && *t <= '9') { + r = r * 10 + *t++ - '0'; + if (r > 15) return -2; + } + return r; +} +static int named(Cell names, int nin, const char *t) +{ + int i, j; + Cell s; + for (i = 0; i < nin && names; i++) { + s = ld(names + i); + j = 0; + while (ld(s + j) && ld(s + j) == (unsigned char)t[j]) j++; + if (!ld(s + j) && !t[j]) return i; + } + return -1; +} +static int rget(int *cur, int r) +{ + if (cur[r] < 0) cur[r] = vnew(U_LI, 0, 0, 0, 0); + return cur[r]; +} + +static int parse_recipe(Cell src, Cell names, int nin, int nout, int *out) +{ + int cur[16], i, n, k, op, args[3], na, dst, isst, nt, rr, v; + char tok[8][32]; + Cell p = src, x; + for (i = 0; i < 16; i++) cur[i] = i < nin ? i : -1; + bn = 0; bnv = nin; berr = 0; + for (;;) { + nt = 0; + for (;;) { + int c = (int)ld(p); + while (c == ' ' || c == '\t' || c == '\r') c = (int)ld(++p); + if (!c || c == '\n' || c == ';') break; + if (c == '=') { + if (nt < 8) { tok[nt][0] = '='; tok[nt][1] = 0; nt++; } + p++; + continue; + } + n = 0; + while (c && c != ' ' && c != '\t' && c != '\n' && c != ';' && c != '=' && c != '\r') { + if (n < 31) tok[nt < 8 ? nt : 7][n++] = (char)c; + c = (int)ld(++p); + } + if (nt < 8) tok[nt++][n] = 0; + } + if (nt) { + isst = seq(tok[0], "st"); + if (!isst && (nt < 3 || !seq(tok[1], "="))) return -2; + dst = -1; + if (!isst) { + rr = regn(tok[0]); + if (rr == -2) return -2; + dst = rr >= 0 ? rr : named(names, nin, tok[0]); + if (dst < 0 || dst > 15) return -2; + } + k = isst ? 1 : 2; + op = -1; + if (!isst && nt > 3) { + op = findop(tok[k]); + if (op < 0) return -2; + k++; + } + if (isst) op = U_ST; + na = 0; + for (; k < nt; k++) { + char *t = tok[k]; + v = -1; + if (na >= 3) return -2; + rr = regn(t); + if (rr == -2) return -2; + if (rr >= 0) v = rget(cur, rr); + else if ((t[0] >= '0' && t[0] <= '9') || t[0] == '-' || t[0] == '+') { + if (parse_num(t, &x)) return -2; + v = vnew(U_LI, 0, 0, 0, x); + } else { + i = named(names, nin, t); + if (i < 0) return -2; + v = rget(cur, i); + } + if (berr) return berr; + args[na++] = v; + } + if (op < 0) { + if (na != 1) return -2; + cur[dst] = args[0]; + } else { + if (na != (op == U_LI ? 0 : uarity[op])) { + if (!(op == U_LI && na == 1)) return -2; + } + if (op == U_LI) cur[dst] = na ? args[0] : vnew(U_LI, 0, 0, 0, 0); + else if (op == U_MOV) { if (na != 1) return -2; cur[dst] = args[0]; } + else if (op == U_ST) vnew(U_ST, args[0], args[1], 0, 0); + else cur[dst] = vnew(op, args[0], na > 1 ? args[1] : 0, na > 2 ? args[2] : 0, 0); + if (berr) return berr; + } + } + if (!ld(p)) break; + p++; + } + for (i = 0; i < nout; i++) { + if (cur[i] < 0) cur[i] = vnew(U_LI, 0, 0, 0, 0); + out[i] = cur[i]; + } + return berr; +} + +static int lower_vm(Cell a, Cell len, int nin, int nout, int *out) +{ + static const int map[] = { U_ADD, U_SUB, U_MUL, U_AND, U_OR, U_XOR, U_SAR, U_LT }; + int st[256], sp = 0, i, k, x, y, j; + Cell w; + if ((UCell)len > 100000) return -5; + bn = 0; bnv = nin; berr = 0; + for (i = 0; i < nin; i++) st[sp++] = i; + for (i = 0; i < (int)len; i++) { + w = ld(a + i); + if (w & 1) { + if (sp >= 256) return -4; + st[sp++] = vnew(U_LI, 0, 0, 0, w >> 1); + if (berr) return berr; + continue; + } + k = (int)(w >> 1); + if (k == 9) break; + switch (k) { + case 1: + if (sp < 1) return -4; + st[sp - 1] = vnew(U_LD, st[sp - 1], 0, 0, 0); + break; + case 2: + if (sp < 2) return -4; + vnew(U_ST, st[sp - 1], st[sp - 2], 0, 0); + sp -= 2; + break; + case 3: + if (sp < 1) return -4; + x = st[sp - 1]; + if (x < nin) return -4; + for (j = 0; j < bn && build[j].d != (unsigned)x; j++); + if (j == bn || build[j].op != U_LI) return -4; + y = (int)build[j].imm; + if (y < 0 || y >= sp - 1) return -4; + st[sp - 1] = st[sp - 2 - y]; + break; + case 4: + if (sp < 1) return -4; + sp--; + break; + case 5: + if (sp < 2) return -4; + x = st[sp - 1]; st[sp - 1] = st[sp - 2]; st[sp - 2] = x; + break; + case 13: case 14: case 15: case 16: case 17: case 18: case 19: case 20: + if (sp < 2) return -4; + x = st[sp - 1]; y = st[sp - 2]; sp -= 2; + st[sp++] = vnew(map[k - 13], y, x, 0, 0); + break; + default: + return -4; + } + if (berr) return berr; + } + if (sp != nout) return -4; + for (i = 0; i < nout; i++) out[i] = st[i]; + return berr; +} + +static int commit(int slot, int nin, int nout, int *out) +{ + Enh *e = &enh[slot]; + int base = xuse, i; + if (berr) return berr; + if (e->live && (int)e->at + (int)e->n == xuse) base = e->at; + if (base + bn > XPOOL) return -5; + if (e->live && (int)e->at + (int)e->n == xuse) xuse = e->at; + e->at = (unsigned short)xuse; + e->n = (unsigned short)bn; + e->nv = (unsigned short)bnv; + e->nin = (unsigned char)nin; + e->nout = (unsigned char)nout; + for (i = 0; i < nout; i++) e->out[i] = (unsigned short)out[i]; + for (i = 0; i < bn; i++) xops[xuse++] = build[i]; + e->live = 1; + return 0; +} + +static int install(Cell d) +{ + Cell slot, kind, nin, nout, pay, len, names; + int out[8], r; + if (!inmem(d) || !inmem(d + 6)) return -1; + slot = m[d]; kind = m[d + 1]; nin = m[d + 2]; nout = m[d + 3]; + pay = m[d + 4]; len = m[d + 5]; names = m[d + 6]; + if (kind == 2) return 0; + if ((UCell)slot >= NENH || (UCell)nin > 8 || (UCell)nout > 8 || (kind != 0 && kind != 1)) return -1; + r = kind == 0 ? parse_recipe(pay, names, (int)nin, (int)nout, out) + : lower_vm(pay, len, (int)nin, (int)nout, out); + if (r) return r; + return commit((int)slot, (int)nin, (int)nout, out); +} + +static int xrun(Enh *e, int s) +{ + int i, j; + Xop *u; + for (i = 0; i < e->nv && i < MAXV; i++) xv[i] = 0; + for (j = 0; j < e->nin; j++) xv[j] = m[s + e->nin - 1 - j]; + for (i = 0; i < e->n; i++) { + u = &xops[e->at + i]; + if (u->op == U_LI) xv[u->d] = u->imm; + else if (u->op == U_LD) xv[u->d] = ld(xv[u->a]); + else if (u->op == U_ST) { if (inmem(xv[u->a])) m[xv[u->a]] = xv[u->b]; } + else xv[u->d] = ev(u->op, xv[u->a], xv[u->b], xv[u->c]); + } + s = s + e->nin - e->nout; + for (j = 0; j < e->nout; j++) m[s + e->nout - 1 - j] = xv[e->out[j]]; + return s; +} + +/* a run suspends when the port has no input yet but more may come (streaming, + see micro_port.h): micro_getc returns MICRO_WAIT, the getc is run again on + micro_resume, and the stacks wait where they are */ +static int sus_p, sus_s, sus_r; + +static int run_from(int p, int s, int r) +{ + int op; + Cell w, a, b; + while ((UCell)p < mw) { + if (s < stack_data_limit() || r > stack_return_limit()) { + Cell sp = s, rp = r; int ret = r > stack_return_limit(); + if (!stack_control || stack_expand(ret, stack_get(ret ? SC_RETURN_TOP : SC_DATA_TOP) - stack_get(ret ? SC_RETURN_LOW : SC_DATA_LOW) + 1, &sp, &rp) < 0) { + p = ret ? PC_RETURN_OVERFLOW : PC_DATA_OVERFLOW; break; + } + s = (int)sp; r = (int)rp; + } + w = m[p++]; + if (w & 1) { m[--s] = w >> 1; continue; } + a = m[s]; b = m[s + 1]; + switch ((int)(w >> 1)) { + case 1: m[s] = ld(a); break; + case 2: + if (a == SYSGATE) { + /* a call can grow the memory and move m, so the result is stored after the call */ + Cell result; + if (b == 9 && m[a + 1] == 6) result = stack_register(m[a + 2]) ? 0 : -1; + else if (b == 9 && (m[a + 1] == 7 || m[a + 1] == 8)) { + Cell sp = s + 2, rp = r; + result = stack_expand(m[a + 1] == 8, m[a + 2], &sp, &rp); + s = (int)sp; r = (int)rp; m[a] = result; break; + } + else if (b == 9 && m[a + 1] == 9) result = m[a + 2] > 0 && (UCell)m[a + 2] <= mw ? (Cell)mw : -1; + else if (b == 9 && m[a + 1] == 4) result = mem_grow_request(m[a + 2]); + else if (b == 9 && m[a + 1] == 5) { + Cell limit = m[a + 2]; + if (limit < 0 || (UCell)limit < mw || limit > 0x7fffffff) result = -1; + else { memory_limit = (UCell)limit; result = limit; } + } else result = micro_syscall(m, b, m[a + 1], m[a + 2], m[a + 3]); + m[a] = result; + s += 2; + break; + } + if (inmem(a)) m[a] = b; + s += 2; + break; + case 3: m[s] = ld((Cell)s + 1 + a); break; + case 4: s++; break; + case 5: m[s] = b; m[s + 1] = a; break; + case 6: m[r++] = p; p = (int)a; s++; break; + case 7: p = (int)a; s++; break; + case 8: if (!b) p = (int)a; s += 2; break; + case 9: p = (int)m[--r]; break; + case 10: { + int ch = micro_getc(); + if (ch == MICRO_WAIT) { sus_p = p - 1; sus_s = s; sus_r = r; return MICRO_SUSPENDED; } + m[--s] = (Cell)(signed char)ch; + jflag = micro_eof(); + jknown = 1; + break; + } + case 11: + if (!jknown) { jflag = micro_eof(); jknown = 1; } + m[--s] = jflag; + break; + case 12: micro_putc((int)a); s++; break; + case 13: m[++s] = b + a; break; + case 14: m[++s] = b - a; break; + case 15: m[++s] = b * a; break; + case 16: m[++s] = b & a; break; + case 17: m[++s] = b | a; break; + case 18: m[++s] = b ^ a; break; + case 19: m[++s] = sar(b, (int)(a & 63)); break; + case 20: m[++s] = b < a; break; + case 21: m[s] = install(a); break; + case 600: + if ((UCell)p >= mw) { p = PC_PAST_END; break; } + m[--s] = m[p++]; + break; + case 601: m[++s] = (Cell)fop_add((uint64_t)b, (uint64_t)a); break; + case 602: m[++s] = (Cell)fop_sub((uint64_t)b, (uint64_t)a); break; + case 603: m[++s] = (Cell)fop_mul((uint64_t)b, (uint64_t)a); break; + case 604: m[++s] = (Cell)fop_div((uint64_t)b, (uint64_t)a); break; + case 605: m[++s] = fop_eq((uint64_t)b, (uint64_t)a); break; + case 606: m[++s] = fop_lt((uint64_t)b, (uint64_t)a); break; + case 607: m[++s] = fop_le((uint64_t)b, (uint64_t)a); break; + case 608: m[s] = (Cell)fop_i2f(a); break; + case 609: m[s] = fop_f2i((uint64_t)a); break; + case 610: { + char buf[400]; int n = fop_format((uint64_t)a, buf), ci; + for (ci = 0; ci < n; ci++) micro_putc(buf[ci]); + s++; + break; + } + case 618: { + char buf[400]; + int n = fop_format_mode((uint64_t)m[s + 2], a, b, buf), ci; + for (ci = 0; ci < n; ci++) micro_putc(buf[ci]); + s += 3; + break; + } + case 611: + m[s] = inmem(a) ? (Cell)fop_parse_words(m + a, mw - (UCell)a) : 0; + break; + case 612: m[s] = b_load(a, 1); break; + case 613: b_store(a, b, 1); s += 2; break; + case 614: m[s] = b_load(a, 2); break; + case 615: b_store(a, b, 2); s += 2; break; + case 616: m[s] = b_load(a, 4); break; + case 617: b_store(a, b, 4); s += 2; break; + case 619: { Cell t = s; m[--s] = t; break; } + case 620: { /* a native call: there is no native code here, so pop the arguments and answer -1 */ + int n = 0; + Cell sig = (UCell)a < mw - 2 ? m[a + 1] : 0; + while (n < 15 && ((sig >> (4 * (n + 1))) & 15)) n++; + s += n; + m[s] = -1; + break; } + default: + op = (int)(w >> 1); + if (op >= XOP0 && op < XOP0 + NENH && enh[op - XOP0].live) s = xrun(&enh[op - XOP0], s); + else if (op == 0) p = PC_HALT; + else { bad_op = op; p = PC_BAD_OP; } + } + } + if (p == PC_DATA_OVERFLOW) { micro_msg("zy: data stack overflow\n"); return 2; } + if (p == PC_RETURN_OVERFLOW) { micro_msg("zy: return stack overflow\n"); return 2; } + if (p == PC_PAST_END) { micro_msg("zy: the program counter is past the end of memory\n"); return 2; } + if (p == PC_BAD_OP) { + char msg[96]; int n = 0, k, neg = bad_op < 0, v = bad_op < 0 ? -bad_op : bad_op; + const char *head = "zy: unknown opcode "; + while (head[n]) { msg[n] = head[n]; n++; } + if (neg) msg[n++] = '-'; + { char dg[12]; int nd = 0; do { dg[nd++] = (char)('0' + v % 10); v /= 10; } while (v); for (k = nd; k > 0; k--) msg[n++] = dg[k - 1]; } + msg[n++] = '\n'; msg[n] = 0; + micro_msg(msg); + return 2; + } + return 0; +} + +static int run(int p) { return run_from(p, DS0, RS0); } + +/* goes on from a run that suspended for input (MICRO_SUSPENDED), once the port + has input for it. the result is as micro_run's */ +int micro_resume(void) { return run_from(sus_p, sus_s, sus_r); } + +int micro_run(void) +{ + int i; + if (!mem_grow_words(memory_initial)) { + micro_msg("zy: no memory for the machine\n"); + return 1; + } + if ((UCell)GORG + (UCell)GLEN > mw || (UCell)GORG + (UCell)GLEN > (UCell)FBOT) { + micro_msg("zy: genome does not fit\n"); + return 1; + } + for (i = 0; i < GLEN; i++) m[GORG + i] = genome[i]; + jknown = 0; + return run(GORG); +} diff --git a/src/micro/micro_port.h b/src/micro/micro_port.h new file mode 100644 index 0000000..9f77987 --- /dev/null +++ b/src/micro/micro_port.h @@ -0,0 +1,89 @@ +/* host port for the microcore. + micro.c calls only these. a bare-metal port is the five functions below: + the uart replaces getc/putc, and every syscall returns -1. port_stub.c is + the empty shape the freestanding compile check links. src/baremetal/port.c is + the one that boots: a 16550 on riscv virt, a PL011 on aarch64 virt. + port_linux.c is the hosted one the test suite runs. + + the core does not use stdio, malloc, or the string routines. it does need + a 64-bit C compiler (division is the compiler's own runtime, not libc) and + a zeroed bss before micro_run. memory starts at MICRO_MW_INIT words of 64 + bits and grows through micro_mem_alloc when the heap asks for more. */ +#ifndef MICRO_PORT_H +#define MICRO_PORT_H +#include +#include "memmap.h" + +typedef int64_t Cell; +typedef uint64_t UCell; +#ifndef MICRO_MW_LIMIT +#define MICRO_MW_LIMIT 0x7fffffff +#endif +/* configure initial words and the growth limit before micro_run. */ +int micro_memory_config(UCell initial, UCell limit); +/* the machine starts at this many words and grows on demand through micro_mem_alloc. + the map's initial heap (HEAP_HI) on a growing map, the whole map (MW) otherwise. + there is no fixed ceiling: a run that needs more memory asks the port for it. */ +#ifndef MICRO_MW_INIT +#if HEAP_GROW +#define MICRO_MW_INIT HEAP_HI +#else +#define MICRO_MW_INIT MW +#endif +#endif + +/* the machine's memory, in words, from the port. micro_mem_alloc(words) returns a + zeroed base with at least words words that stays valid until the next call; the + port keeps what it already holds, so a grow keeps the contents. NULL when the port + has no more memory. micro_mem_words is the size micro.c has mapped now. */ +Cell *micro_mem_alloc(UCell words); +UCell micro_mem_words(void); + +/* next input byte, 0..255, or -1 at end of input. does not report whether + another byte follows; micro_eof does that, and the core asks after each read. */ +int micro_getc(void); + +/* 1 when the next micro_getc would return -1, 0 when a byte is waiting. + must not consume the byte. called once before the first instruction. */ +int micro_eof(void); + +/* streaming input: micro_getc returns MICRO_WAIT when no byte is waiting yet but + more may come (micro_eof then says 0). the run then returns MICRO_SUSPENDED, + and the port calls micro_resume once it has bytes. the browser and the + extension use this for the language server; a port with blocking input never + needs it. micro_run and micro_resume return what run returns, MICRO_SUSPENDED + included. */ +#define MICRO_WAIT (-2) +#define MICRO_SUSPENDED 3 +int micro_run(void); +int micro_resume(void); + +/* write the low 8 bits. */ +void micro_putc(int c); + +/* a store of op to SYSGATE (ZFP+2; 0xA0002 on the default map). a, b, c are the three words after the gate. + mem is the whole machine. return the result, or -1 if op is unsupported. + 1 open(path, 0 read | 1 create/truncate) -> fd + 2 close(fd) + 3 read(fd, buf, n) 4 write(fd, buf, n) one byte per word + 5 getenv(name, buf, cap) -> length, or -1 + 6 time. unix seconds on a hosted port; a hardware counter on bare metal + 7 exit(status). does not return + 8 a random word, never -1 when the port has a source + 9 memory: a = 0 words now, 1 HEAP_LO, 2 HEAP_HI, 3 bytes now, 4 grow to b words + 10 bopen(byte_addr, mode) 11 bread(fd, byte_addr, n) + 12 bwrite(fd, byte_addr, n) 13 bgetenv(name_byte_addr, dst_byte_addr, cap) + ops 1..5 and the names they take are one character per word, 0 terminated. + ops 10..13 are packed bytes, 0 terminated, the same layout as a b"..." + payload. the bare-metal port keeps files in RAM and answers + getenv("BOARD"). the stub returns -1. */ +Cell micro_syscall(Cell *mem, Cell op, Cell a, Cell b, Cell c); + +/* a short diagnostic, usually the stack-overflow lines. not program output. + may be a no-op. */ +void micro_msg(const char *s); + +/* copy the linked genome in and run from its entry. 0 on halt, 2 on a + stack overflow (after a message). */ +int micro_run(void); +#endif diff --git a/src/micro/port_linux.c b/src/micro/port_linux.c new file mode 100644 index 0000000..e6c8847 --- /dev/null +++ b/src/micro/port_linux.c @@ -0,0 +1,284 @@ +/* Linux port: stdin/stdout a byte at a time, the syscalls, diagnostics + on stderr. same behaviour as io_linux.c plus core.c's hostcall. + 1..6 are files, getenv and unix time. 7 exits the process, 8 is a + counter, 9 reports the machine size. */ +#include +#include +#include +#ifdef _WIN32 +#include +#include +#ifndef O_BINARY +#define O_BINARY _O_BINARY +#endif +#if defined(_MSC_VER) +#define open _open +#define close _close +#define read _read +#define write _write +#endif +#else +#include +#ifndef O_BINARY +#define O_BINARY 0 +#endif +#endif +#include +#include +#include +#include "micro_port.h" +#include "bops.h" + +/* the machine's memory: a block that grows by realloc, zero in the new part. the + base can move on a grow, which micro.c takes into account (it re-reads m). */ +static Cell *lmem; +static UCell lcap; + +Cell *micro_mem_alloc(UCell words) +{ + Cell *n; + if (words <= lcap && lmem) return lmem; + if (words > ((UCell)-1) / sizeof(Cell)) return NULL; + n = realloc(lmem, words * sizeof(Cell)); + if (!n) return NULL; + memset(n + lcap, 0, (words - lcap) * sizeof(Cell)); + lmem = n; + lcap = words; + return n; +} + +int micro_getc(void) +{ + int c = getchar(); + return c == EOF ? -1 : c; +} + +int micro_eof(void) +{ + int c = getchar(); + if (c == EOF) return 1; + ungetc(c, stdin); + return 0; +} + +void micro_putc(int c) { putchar(c & 255); } + +void micro_msg(const char *s) { fputs(s, stderr); } + +static int zcstr(Cell *mem, Cell addr, char *dst, int max) +{ + int i = 0, c; + if (max < 1) return -1; + if ((UCell)addr >= (UCell)micro_mem_words()) { dst[0] = 0; return -1; } + while (i < max - 1 && (UCell)(addr + i) < (UCell)micro_mem_words()) { + c = (int)mem[addr + i]; + if (!c) break; + dst[i++] = (char)c; + } + dst[i] = 0; + return i; +} + +static int inmem(Cell a) { return (UCell)a < (UCell)micro_mem_words(); } + +/* the command line and the environment, kept for ops 21 to 24: the same + contract as src/core/core.c. a program read from stdin has no file name, so + argv[0] is . */ +#ifndef _WIN32 +extern char **environ; +#endif +static int zy_argc; +static char **zy_argv; +static int zy_envc; +static char **zy_envp; + +static void zy_args(int argc, char **argv) +{ + char **e; + int n = 0; +#ifdef _WIN32 + e = _environ; +#else + e = environ; +#endif + while (e && e[n]) n++; + zy_envp = e; zy_envc = n; + zy_argv = argv; + zy_argc = argc > 0 ? argc : 1; +} + +/* copy entry a of a char ** into vm words, one character per word, terminated + like SYS_GETENV. a zero buffer asks for the length only. lead, when given, + replaces entry zero. */ +static Cell vecstr(Cell *mem, char **v, int count, Cell a, Cell b, Cell c, const char *lead) +{ + char *e; + int i = 0; + if (a < 0 || a >= (Cell)count) return -1; + e = (a == 0 && lead) ? (char *)lead : v[a]; + if (!e) return -1; + if (!b) { while (e[i]) i++; return i; } + if (c < 1 || !inmem(b)) return -1; + while (e[i] && i < c - 1 && inmem(b + i)) { mem[b + i] = (unsigned char)e[i]; i++; } + if (inmem(b + i)) mem[b + i] = 0; + return i; +} + +static Cell host_rand(void) +{ + static uint64_t s; + if (!s) s = (uint64_t)time(0) ^ 0x9E3779B97F4A7C15ull; + if (!s) s = 0x9E3779B97F4A7C15ull; + s ^= s << 13; s ^= s >> 7; s ^= s << 17; + if ((Cell)s == -1) s ^= 0x100; + return (Cell)s; +} + +static int memory_words(const char *name, UCell fallback, UCell *words) +{ + const char *s = getenv(name); + char *end; + unsigned long long value; + if (!s) { *words = fallback; return 1; } + errno = 0; + value = strtoull(s, &end, 10); + if (errno || end == s || *end || !value || value > 0x7fffffffULL) return 0; + *words = (UCell)value; + return 1; +} + +Cell micro_syscall(Cell *mem, Cell op, Cell a, Cell b, Cell c) +{ + char path[1024], tmp[512]; + int n, i, got; + switch (op) { + case 1: + if (zcstr(mem, a, path, 1024) < 0) return -1; + if (b == 1) return open(path, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0644); + return open(path, O_RDONLY | O_BINARY); + case 2: + return close((int)a); + case 3: + if (c < 0 || !inmem(b)) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + if (!inmem(b + n)) break; + if (!inmem(b + n + i - 1)) i = (int)(micro_mem_words() - (b + n)); + if (i <= 0) break; + got = (int)read((int)a, tmp, (size_t)i); + if (got <= 0) break; + for (i = 0; i < got; i++) mem[b + n + i] = (unsigned char)tmp[i]; + n += got; + } + return n; + case 4: + if (c < 0 || !inmem(b)) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + if (!inmem(b + n)) break; + if (!inmem(b + n + i - 1)) i = (int)(micro_mem_words() - (b + n)); + if (i <= 0) break; + for (got = 0; got < i; got++) tmp[got] = (char)mem[b + n + got]; + got = (int)write((int)a, tmp, (size_t)i); + if (got <= 0) break; + n += got; + } + return n; + case 5: { + char *e; + if (zcstr(mem, a, path, 1024) < 0) return -1; + e = getenv(path); + if (!e) return -1; + if (c < 1 || !inmem(b)) return -1; + i = 0; + while (e[i] && i < c - 1 && inmem(b + i)) { mem[b + i] = (unsigned char)e[i]; i++; } + if (inmem(b + i)) mem[b + i] = 0; + return i; + } + case 6: + return (Cell)time(0); + case 7: + exit((int)a); + case 8: + return host_rand(); + case 9: + if (a == 0) return micro_mem_words(); + if (a == 1) return HEAP_LO; + if (a == 2) return HEAP_HI; + if (a == 3) return (Cell)micro_mem_words() * 8; + return -1; + case 10: + if (bop_cstr(mem, a, path, 1024, micro_mem_words()) < 0) return -1; + if (b == 1) return open(path, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0644); + return open(path, O_RDONLY | O_BINARY); + case 11: + if (c < 0 || (c > 0 && !bop_ok(b, 1, micro_mem_words()))) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + i = bop_span(b + n, i, micro_mem_words()); + if (i <= 0) break; + got = (int)read((int)a, tmp, (size_t)i); + if (got <= 0) break; + for (i = 0; i < got; i++) bop_put1(mem, b + n + i, (unsigned char)tmp[i]); + n += got; + } + return n; + case 12: + if (c < 0 || (c > 0 && !bop_ok(b, 1, micro_mem_words()))) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + i = bop_span(b + n, i, micro_mem_words()); + if (i <= 0) break; + for (got = 0; got < i; got++) tmp[got] = (char)bop_load(mem, b + n + got, 1); + got = (int)write((int)a, tmp, (size_t)i); + if (got <= 0) break; + n += got; + } + return n; + case 13: { + char *e; + if (bop_cstr(mem, a, path, 1024, micro_mem_words()) < 0) return -1; + e = getenv(path); + if (!e) return -1; + if (c < 1 || !bop_ok(b, 1, micro_mem_words())) return -1; + i = 0; + while (e[i] && i < c - 1 && bop_ok(b + i, 1, micro_mem_words())) { bop_put1(mem, b + i, (unsigned char)e[i]); i++; } + if (bop_ok(b + i, 1, micro_mem_words())) bop_put1(mem, b + i, 0); + return i; + } + case 21: + return (Cell)zy_argc; + case 22: + return vecstr(mem, zy_argv, zy_argc, a, b, c, ""); + case 23: + return (Cell)zy_envc; + case 24: + return vecstr(mem, zy_envp, zy_envc, a, b, c, 0); + default: + return -1; + } +} + +int main(int argc, char **argv) { + UCell initial, limit; +#ifdef _WIN32 + _setmode(_fileno(stdin), _O_BINARY); + _setmode(_fileno(stdout), _O_BINARY); +#endif + zy_args(argc, argv); + if (!memory_words("TINYVM_MEMORY_WORDS", MICRO_MW_INIT, &initial) || + !memory_words("TINYVM_MAX_MEMORY_WORDS", MICRO_MW_LIMIT, &limit) || + initial > limit || !micro_memory_config(initial, limit)) { + fputs("micro: invalid memory configuration\n", stderr); + return 1; + } + return micro_run(); +} diff --git a/src/micro/port_stub.c b/src/micro/port_stub.c new file mode 100644 index 0000000..7bc22a7 --- /dev/null +++ b/src/micro/port_stub.c @@ -0,0 +1,59 @@ +/* bare-metal sketch. link this instead of port_linux.c and call micro_run + from the reset handler, after bss is cleared. + + point UART_TX at the transmit register. leave micro_getc returning -1 and + micro_eof returning 1 when the program arrives in the image and nothing + else is typed. micro_syscall returns -1 for every op, which the runtime + treats as failure (open fails, time is unavailable). the virt boards do + not use this file; their port is src/baremetal/port.c. */ +#include "micro_port.h" + +/* example, machine dependent: volatile unsigned char *const UART_TX = (volatile unsigned char *)0x10000000; */ + +static void uart_putc(unsigned char c) +{ + (void)c; + /* *UART_TX = c; */ +} + +/* the machine's memory on this board: the arena below, which is the board's RAM as + memmap.h sizes it. a board's RAM is a fixed amount of hardware, so this is the one + place the port has a size; it returns NULL past it. */ +/* physical backing is separate from the vm's configurable growth limit. */ +#ifndef MICRO_PORT_WORDS +#define MICRO_PORT_WORDS (HEAP_HI > PW ? HEAP_HI : PW) +#endif +static Cell arena[MICRO_PORT_WORDS]; + +Cell *micro_mem_alloc(UCell words) +{ + if (words > MICRO_PORT_WORDS) return 0; + return arena; +} + +int micro_getc(void) { return -1; } +int micro_eof(void) { return 1; } +void micro_putc(int c) { uart_putc((unsigned char)c); } + +Cell micro_syscall(Cell *mem, Cell op, Cell a, Cell b, Cell c) +{ + /* no command line and no environment here, so argv[0] is alone */ + if (op == 21) return 1; + if (op == 23) return 0; + if (op == 22) { + static const char lead[] = ""; + int i; + if (a != 0) return -1; + if (!b) return 6; + for (i = 0; i < 6; i++) mem[b + i] = (unsigned char)lead[i]; + mem[b + 6] = 0; + return 6; + } + (void)mem; (void)op; (void)a; (void)b; (void)c; + return -1; +} + +void micro_msg(const char *s) +{ + while (*s) uart_putc((unsigned char)*s++); +} diff --git a/src/micro/port_wasm_stream.c b/src/micro/port_wasm_stream.c new file mode 100644 index 0000000..155cde4 --- /dev/null +++ b/src/micro/port_wasm_stream.c @@ -0,0 +1,121 @@ +/* WebAssembly port of the microcore with streaming input, for the language + server. the host (the vs code extension) feeds the server's input in pieces + and calls wasm_resume after each feed; the server's output comes back one + byte at a time through js_putc, and its diagnostics through js_msg. the + server suspends when it wants input it does not have yet (MICRO_WAIT in + micro_port.h), so a step never blocks the host. build with + src/tools/mklspwasm.sh; nothing here needs libc. */ +#include "micro_port.h" + +extern void js_putc(int c); +extern void js_msg(int c); + +#define CHUNK 65536 +#define QCAP (8 << 20) + +/* the host copies a piece of input here, then calls wasm_feed with its length */ +static unsigned char chunk[CHUNK]; +/* the input the server has not read yet: q[qp..qn) */ +static unsigned char q[QCAP]; +static int qn, qp, closed; + +unsigned char *wasm_chunk(void) { return chunk; } +int wasm_chunk_cap(void) { return (int)sizeof chunk; } + +/* appends the first n bytes of chunk to the input. 0 on success, -1 when the + input would not fit, which the host must not allow (it drains by running) */ +int wasm_feed(int n) +{ + int i; + if (n < 0 || n > CHUNK || closed) return -1; + if (qn + n > QCAP) { /* move what is unread to the front */ + int live = qn - qp; + if (live + n > QCAP) return -1; + for (i = 0; i < live; i++) q[i] = q[qp + i]; + qp = 0; qn = live; + } + for (i = 0; i < n; i++) q[qn++] = chunk[i]; + return 0; +} + +/* no more input will come: the next read past the end is -1 */ +void wasm_close(void) { closed = 1; } + +/* the machine's memory: the linear memory above everything the module has in it. + the base is fixed when the first machine is made, and a grow only adds pages on + the top, so the base never moves. */ +static unsigned char *mbase; +static UCell mcap; /* bytes of machine memory the module has grown for */ + +Cell *micro_mem_alloc(UCell words) +{ + UCell need, extra, pages; + if (words > ((UCell)-1) / sizeof(Cell)) return 0; + if (!mbase) { + UCell top = (UCell)__builtin_wasm_memory_size(0) * 65536u; + mbase = (unsigned char *)top; + mcap = 0; + } + need = words * sizeof(Cell); + if (need <= mcap) return (Cell *)mbase; + extra = need - mcap; + pages = (extra + 65535u) / 65536u; + if (__builtin_wasm_memory_grow(0, (int)pages) < 0) return 0; + mcap += pages * 65536u; /* wasm zeroes the pages it grows by */ + return (Cell *)mbase; +} + +int micro_getc(void) +{ + if (qp < qn) return q[qp++]; + return closed ? -1 : MICRO_WAIT; +} +int micro_eof(void) { return closed && qp >= qn; } +void micro_putc(int c) { js_putc(c & 255); } +void micro_msg(const char *s) { while (*s) js_msg(*s++); } + +Cell micro_syscall(Cell *mem, Cell op, Cell a, Cell b, Cell c) +{ + switch (op) { + case 9: /* memory: the size of the machine and its heap */ + if (a == 0) return micro_mem_words(); + if (a == 1) return HEAP_LO; + if (a == 2) return HEAP_HI; + if (a == 3) return (Cell)micro_mem_words() * 8; + return -1; + case 7: /* exit: the run ends */ + return -1; + case 21: /* argc: the server has no command line of its own, so alone */ + return 1; + case 22: /* argv: entry 0 is , as in zy(1) */ + if (a != 0) return -1; + if (!b) return 6; + if (c < 7 || b + 6 >= micro_mem_words()) return -1; + { + static const char lead[] = ""; + int i; + for (i = 0; i < 6; i++) mem[b + i] = (unsigned char)lead[i]; + mem[b + 6] = 0; + } + return 6; + case 23: /* envc: the host passes no environment */ + return 0; + } + return -1; +} + +/* the core multiplies 64 by 64 into 128 bits for the float helpers; wasm has no + such instruction and there is no compiler runtime to link, so this is it */ +void __multi3(unsigned long long *r, unsigned long long al, unsigned long long ah, unsigned long long bl, unsigned long long bh) +{ + unsigned long long a0 = al & 0xffffffffu, a1 = al >> 32, b0 = bl & 0xffffffffu, b1 = bl >> 32; + unsigned long long p00 = a0 * b0, p01 = a0 * b1, p10 = a1 * b0, p11 = a1 * b1; + unsigned long long mid = (p00 >> 32) + (p01 & 0xffffffffu) + (p10 & 0xffffffffu); + r[0] = (p00 & 0xffffffffu) | (mid << 32); + r[1] = p11 + (p01 >> 32) + (p10 >> 32) + (mid >> 32) + al * bh + ah * bl; +} + +/* loads the server and runs it until it halts or waits for input (3) */ +int wasm_start(void) { return micro_run(); } +/* goes on after the host fed input: as wasm_start, halt (0), error (2) or wait (3) */ +int wasm_resume(void) { return micro_resume(); } diff --git a/src/micro/port_win.c b/src/micro/port_win.c new file mode 100644 index 0000000..8e3ef74 --- /dev/null +++ b/src/micro/port_win.c @@ -0,0 +1,268 @@ +/* Windows port for the microcore: stdin/stdout a byte at a time, the syscalls, + diagnostics on stderr. same behaviour as io_win.c plus core.c's hostcall. + 1..6 are files, getenv and unix time. 7 exits the process, 8 is a + counter, 9 reports the machine size. */ +#include +#include +#include +#include +#include +#include +#include +#include +#include "micro_port.h" +#include "bops.h" + +#ifndef O_BINARY +#define O_BINARY _O_BINARY +#endif +#if defined(_MSC_VER) +#define open _open +#define close _close +#define read _read +#define write _write +#endif + +/* the machine's memory: a block that grows by realloc, zero in the new part. the + base can move on a grow, which micro.c takes into account (it re-reads m). */ +static Cell *lmem; +static UCell lcap; + +Cell *micro_mem_alloc(UCell words) +{ + Cell *n; + if (words <= lcap && lmem) return lmem; + if (words > ((UCell)-1) / sizeof(Cell)) return NULL; + n = realloc(lmem, words * sizeof(Cell)); + if (!n) return NULL; + memset(n + lcap, 0, (words - lcap) * sizeof(Cell)); + lmem = n; + lcap = words; + return n; +} + +int micro_getc(void) +{ + int c = _fgetc_nolock(stdin); + return c == EOF ? -1 : c; +} + +int micro_eof(void) +{ + int c = _fgetc_nolock(stdin); + if (c == EOF) return 1; + _ungetc_nolock(c, stdin); + return 0; +} + +void micro_putc(int c) { _fputc_nolock(c & 255, stdout); } + +void micro_msg(const char *s) { fputs(s, stderr); } + +static int zcstr(Cell *mem, Cell addr, char *dst, int max) +{ + int i = 0, c; + if (max < 1) return -1; + if ((UCell)addr >= (UCell)micro_mem_words()) { dst[0] = 0; return -1; } + while (i < max - 1 && (UCell)(addr + i) < (UCell)micro_mem_words()) { + c = (int)mem[addr + i]; + if (!c) break; + dst[i++] = (char)c; + } + dst[i] = 0; + return i; +} + +static int inmem(Cell a) { return (UCell)a < (UCell)micro_mem_words(); } + +/* the command line and the environment, kept for ops 21 to 24: the same + contract as src/core/core.c. a program read from stdin has no file name, so + argv[0] is . */ +static int zy_argc; +static char **zy_argv; +static int zy_envc; +static char **zy_envp; + +static void zy_args(int argc, char **argv) +{ + char **e = _environ; + int n = 0; + while (e && e[n]) n++; + zy_envp = e; zy_envc = n; + zy_argv = argv; + zy_argc = argc > 0 ? argc : 1; +} + +/* copy entry a of a char ** into vm words, one character per word, terminated + like SYS_GETENV. a zero buffer asks for the length only. lead, when given, + replaces entry zero. */ +static Cell vecstr(Cell *mem, char **v, int count, Cell a, Cell b, Cell c, const char *lead) +{ + char *e; + int i = 0; + if (a < 0 || a >= (Cell)count) return -1; + e = (a == 0 && lead) ? (char *)lead : v[a]; + if (!e) return -1; + if (!b) { while (e[i]) i++; return i; } + if (c < 1 || !inmem(b)) return -1; + while (e[i] && i < c - 1 && inmem(b + i)) { mem[b + i] = (unsigned char)e[i]; i++; } + if (inmem(b + i)) mem[b + i] = 0; + return i; +} + +static Cell host_rand(void) +{ + static uint64_t s; + if (!s) s = (uint64_t)time(0) ^ 0x9E3779B97F4A7C15ull; + if (!s) s = 0x9E3779B97F4A7C15ull; + s ^= s << 13; s ^= s >> 7; s ^= s << 17; + if ((Cell)s == -1) s ^= 0x100; + return (Cell)s; +} + +static int memory_words(const char *name, UCell fallback, UCell *words) +{ + const char *s = getenv(name); + char *end; + unsigned long long value; + if (!s) { *words = fallback; return 1; } + errno = 0; + value = strtoull(s, &end, 10); + if (errno || end == s || *end || !value || value > 0x7fffffffULL) return 0; + *words = (UCell)value; + return 1; +} + +Cell micro_syscall(Cell *mem, Cell op, Cell a, Cell b, Cell c) +{ + char path[1024], tmp[512]; + int n, i, got; + switch (op) { + case 1: + if (zcstr(mem, a, path, 1024) < 0) return -1; + if (b == 1) return open(path, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0644); + return open(path, O_RDONLY | O_BINARY); + case 2: + return close((int)a); + case 3: + if (c < 0 || !inmem(b)) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + if (!inmem(b + n)) break; + if (!inmem(b + n + i - 1)) i = (int)(micro_mem_words() - (b + n)); + if (i <= 0) break; + got = (int)read((int)a, tmp, (size_t)i); + if (got <= 0) break; + for (i = 0; i < got; i++) mem[b + n + i] = (unsigned char)tmp[i]; + n += got; + } + return n; + case 4: + if (c < 0 || !inmem(b)) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + if (!inmem(b + n)) break; + if (!inmem(b + n + i - 1)) i = (int)(micro_mem_words() - (b + n)); + if (i <= 0) break; + for (got = 0; got < i; got++) tmp[got] = (char)mem[b + n + got]; + got = (int)write((int)a, tmp, (size_t)i); + if (got <= 0) break; + n += got; + } + return n; + case 5: { + char *e; + if (zcstr(mem, a, path, 1024) < 0) return -1; + e = getenv(path); + if (!e) return -1; + if (c < 1 || !inmem(b)) return -1; + i = 0; + while (e[i] && i < c - 1 && inmem(b + i)) { mem[b + i] = (unsigned char)e[i]; i++; } + if (inmem(b + i)) mem[b + i] = 0; + return i; + } + case 6: + return (Cell)time(0); + case 7: + exit((int)a); + case 8: + return host_rand(); + case 9: + if (a == 0) return micro_mem_words(); + if (a == 1) return HEAP_LO; + if (a == 2) return HEAP_HI; + if (a == 3) return (Cell)micro_mem_words() * 8; + return -1; + case 10: + if (bop_cstr(mem, a, path, 1024, micro_mem_words()) < 0) return -1; + if (b == 1) return open(path, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0644); + return open(path, O_RDONLY | O_BINARY); + case 11: + if (c < 0 || (c > 0 && !bop_ok(b, 1, micro_mem_words()))) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + i = bop_span(b + n, i, micro_mem_words()); + if (i <= 0) break; + got = (int)read((int)a, tmp, (size_t)i); + if (got <= 0) break; + for (i = 0; i < got; i++) bop_put1(mem, b + n + i, (unsigned char)tmp[i]); + n += got; + } + return n; + case 12: + if (c < 0 || (c > 0 && !bop_ok(b, 1, micro_mem_words()))) return -1; + n = 0; + while (n < c) { + i = (int)(c - n); + if (i > 512) i = 512; + i = bop_span(b + n, i, micro_mem_words()); + if (i <= 0) break; + for (got = 0; got < i; got++) tmp[got] = (char)bop_load(mem, b + n + got, 1); + got = (int)write((int)a, tmp, (size_t)i); + if (got <= 0) break; + n += got; + } + return n; + case 13: { + char *e; + if (bop_cstr(mem, a, path, 1024, micro_mem_words()) < 0) return -1; + e = getenv(path); + if (!e) return -1; + if (c < 1 || !bop_ok(b, 1, micro_mem_words())) return -1; + i = 0; + while (e[i] && i < c - 1 && bop_ok(b + i, 1, micro_mem_words())) { bop_put1(mem, b + i, (unsigned char)e[i]); i++; } + if (bop_ok(b + i, 1, micro_mem_words())) bop_put1(mem, b + i, 0); + return i; + } + case 21: + return (Cell)zy_argc; + case 22: + return vecstr(mem, zy_argv, zy_argc, a, b, c, ""); + case 23: + return (Cell)zy_envc; + case 24: + return vecstr(mem, zy_envp, zy_envc, a, b, c, 0); + default: + return -1; + } +} + +int main(int argc, char **argv) { + UCell initial, limit; + _setmode(_fileno(stdin), _O_BINARY); + _setmode(_fileno(stdout), _O_BINARY); + zy_args(argc, argv); + if (!memory_words("TINYVM_MEMORY_WORDS", MICRO_MW_INIT, &initial) || + !memory_words("TINYVM_MAX_MEMORY_WORDS", MICRO_MW_LIMIT, &limit) || + initial > limit || !micro_memory_config(initial, limit)) { + fputs("micro: invalid memory configuration\n", stderr); + return 1; + } + return micro_run(); +} diff --git a/src/runtime/rt.zc b/src/runtime/rt.zc new file mode 100644 index 0000000..3badcc2 --- /dev/null +++ b/src/runtime/rt.zc @@ -0,0 +1,1326 @@ +// ============================================================================ +// rt.zc: the runtime half of the genome. memory map, i/o, arithmetic helpers, +// the heap (size-class free lists) and the mark-sweep collector. +// ============================================================================ + +// how the runtime is laid out, for a reader coming in cold: +// +// memory map generated constants name the regions used by a build. the +// compiler and runtime use the same names and values. +// i/o, strings thin wrappers over the cpu's i/o opcodes, plus the two +// string forms (word strings and packed byte strings). +// heap a buddy allocator with a 5 word header on every block. +// new/free/recycle are built on it. every heap object has at +// most one owner (the container that holds it), and freeing +// an owner frees what it owns. +// growable arrays []T handles, built on the heap. +// mark-sweep a conservative collector. it is the safety net behind +// free: anything the compiler's ownership analysis could not +// free gets reclaimed here. +// memory debug optional checks (use after free, double free, leaks). +// syscalls file and environment access through one gate word. +// +// everything is a 64-bit word, and an address is a word index, not a byte +// index. the cpu is a stack machine, so "asm { a @ . }" pushes a, fetches the +// word at that address with @, then outputs it with . (see the vm reference). +// +// ---- memory map (words) ---- +// src/tools/genmap writes the map values for each build between these markers. +// keep the names and order stable so programs can use the same map interface +// across targets and image sizes. + +// @map-rt + +const word MW = 0x1C5000; +const word CODE_END = 0x80000; +const word HEAP_LO = 0x1C5000; +const word HEAP_HI = 0x225000; +const int HEAP_GROW = 0x1; +const word ZFP = 0x90000; +const word GORG = 0x114100; +const word FBOT = 0x164100; +const word FTOP = 0x1A4100; +const word RS0 = 0x1A4100; +const word MARK0 = 0x1B4100; +const int MARKN = 0x8000; +const word DSLO = 0x1BC100; +const word DSHI = 0x1C4FF0; +const int MAGIC = 0x2B7E1516; +// @end-map + +// frames grow in stable segments so pointers to a caller's locals stay valid. +word frame_floor = FBOT, frame_top = FTOP, frame_node; +int frame_chunk = FTOP - FBOT, frame_guard = (FTOP - FBOT) >> 2, frame_busy, gc_active; +[17]word frame_control; +word data_low = DSLO, data_top = DSHI, data_node; +word return_low = RS0, return_top = MARK0 - 8, return_node; +const int F_STACK = 1024; +const int F_INTERNAL = 512; + +// ---- virtual enhancements ---- +// install(desc) hands the core a descriptor through the % opcode. the core reads +// it and wires the region it describes into the cpu, so the compiler can replace +// a run of vm code with native code. the descriptor is laid out by the compiler +// for each enhance and o3 region (see install in compiler.zc). the enhance lines +// below are the micro forms of the same thing: a single machine instruction each. +// zdiv, zmod and zshl further down do the same arithmetic in software. this block +// comes first, since the compiler resolves / % and << to these names. + +// install the descriptor for an optimized region. +int install(int desc) { return asm { desc @ % }; } +// signed division of a by b, as one machine instruction. +enhance idiv(a, b) micro "a = sdiv a b"; +// signed remainder of a divided by b, as one machine instruction. +enhance imod(a, b) micro "a = srem a b"; +// a shifted left by b, as one machine instruction. +enhance ishl(a, b) micro "a = shl a b"; +// for o3: the address of a variable at fp + k. +enhance lfa(k) micro "r1 = ld 589824; k = add r1 k"; +// 1 when i is outside 0..n-1 (the unsigned compare also catches negative i), else 0. +enhance outside(i, n) micro "i = ltu i n; i = xor i 1"; +// ---- bit operations and float conversions ---- +// these use single machine instructions where the cpu has them. + +// the number of leading zero bits in a. +enhance clz(a) micro "a = clz a"; +// the number of trailing zero bits of a. +enhance ctz(a) micro "a = ctz a"; +// the number of one bits in a. +enhance popcnt(a) micro "a = popcnt a"; +// a with its bytes in reverse order. +enhance bswap(a) micro "a = bswap a"; +// a rotated left by n bits. +enhance rotl(a, n) micro "a = rotl a n"; +// a rotated right by n bits. +enhance rotr(a, n) micro "a = rotr a n"; +// the high word of the signed product of a and b. +enhance mulhi(a, b) micro "a = mulhs a b"; +// the high word of the unsigned product of a and b. +enhance umulhi(a, b) micro "a = mulhu a b"; +// the float a, converted to a signed integer. +enhance f2s(a) micro "a = f2s a"; +// the signed integer a, converted to a float. +enhance s2f(a) micro "a = s2f a"; +// f2s, the software form used where the cpu has none. +enhance zf2s(a) micro "a = f2s a"; +// s2f, the software form used where the cpu has none. +enhance zs2f(a) micro "a = s2f a"; + +// runtime code segments retain the addresses of earlier functions and globals. +word code_blocks; +// distinguish a raw function address from a heap closure's environment block. +int callable_code(word f) { + word p = code_blocks; + if (f < HEAP_LO) return 1; + while (p) { if (f >= p[1] && f < p[2]) return 1; p = p[0]; } + return 0; +} + +// ---- i/o ---- +// output can be redirected. mode 1 drops what is written and mode 2 appends +// it to a buffer; mode 3 counts characters without storing them (the server +// uses these modes while it checks a document, +// so a parse word that prints can't write into the protocol stream). +// raw_c always reaches the terminal. +int outmode; word outbuf; int outn, outcap; word outgrow; +// write one character to the terminal with no translation. +int raw_c(int ch) { asm { ch @ . } return 0; } +// write one character. normally it goes to the terminal; while a capture is +// running (see capture in src/lib/std.zc) it goes into the capture buffer instead. +int put_c(int ch) { + if (outmode) { + if (outmode == 3) outn++; + else if (outmode == 2) { + if (outn >= outcap && outgrow) outgrow(); + if (outn < outcap) { outbuf[outn] = ch; outn++; } + } + return 0; + } + asm { ch @ . } + return 0; +} +// read one character from the input, as a byte value. -1 means the input has +// ended, so check eof when a -1 could be a real value. +int get_c() { return asm { , }; } +// true when the input has no more characters. a get_c after this gives -1. +int eof() { return asm { ? }; } +// stop the machine now. nothing after it runs, and the exit status is 0. +int halt() { asm { q } return 0; } +// write a zero-terminated string, one character at a time. it is the same as +// put_c on each byte of s, so a capture sees the text too. +int put_s(char* s) { + int i = 0; + while (s[i]) { put_c(s[i]); i++; } + return 0; +} +// write the decimal form of a number, with a minus sign for a negative one. +// the smallest integer is handled as its own case. +int put_n(int n) { + [24]word b; int i = 0; + if (n < 0) { put_c('-'); n = 0 - n; } + if (n < 0) { put_s("9223372036854775808"); return 0; } + while (1) { b[i++] = '0' + n % 10; n = n / 10; if (!n) break; } + while (i) put_c(b[--i]); + return 0; +} +// the length of a word string, not counting its 0. +int len_w(char* s) { + int n = 0; + while (s[n]) n++; + return n; +} +// true when two word strings hold the same characters. +int eq_w(char* a, char* b) { + int i = 0; + while (a[i] && a[i] == b[i]) i++; + return a[i] == b[i]; +} +// ---- word helpers ---- +// copy and fill by word. copy_w copies forward, so overlapping ranges are only +// safe when dst is below src. a long run above the program area goes to the +// host in one call (ops 18 and 19 of the syscall gate); a host that answers -1 +// (a board, the js vm, a range that overlaps itself) gets the plain loop. + +const int SYS_FILL = 18, /* wowie! */ SYS_COPY = 19; +// copy n words from src to dst. +int copy_w(word* dst, word* src, int n) { + int i = 0; word g = ZFP + 2; + if (n >= 16 && dst >= MW) { + g[1] = dst; g[2] = src; g[3] = n; g[0] = SYS_COPY; + if (g[0] == n) return 0; + } + while (i < n) { dst[i] = src[i]; i++; } + return 0; +} +// set n words at dst to v. +int fill_w(word* dst, int v, int n) { + int i = 0; word g = ZFP + 2; + if (n >= 16 && dst >= MW) { + g[1] = dst; g[2] = v; g[3] = n; g[0] = SYS_FILL; + if (g[0] == n) return 0; + } + while (i < n) { dst[i] = v; i++; } + return 0; +} + +// byte addresses sit beside word addresses. word w is bytes (w << 3) through +// (w << 3) + 7, and byte 0 of a word is its low 8 bits. a byte address is a +// plain integer: the odd/even tag is only for code words, and u/m/d stay on +// the word pointer of a heap object. 16- and 32-bit accesses are little-endian +// and may cross a word. an access that runs off the end of memory loads 0 and +// stores nothing. a byte store never fires the syscall gate; that is a word +// store at SYSGATE. opcodes 612..617, words 1224..1234. +int addr_b(int w) { return w << 3; } +// the word address of a byte address b. +int addr_w(int b) { return b >> 3; } +// load the byte at address a. +int ld8(int a) { return asm { a @ #1224 }; } +// store the low byte of v at address a. +int st8(int a, int v) { asm { v @ a @ #1226 }; return 0; } +// load the 16-bit value at address a. +int ld16(int a) { return asm { a @ #1228 }; } +// store the low 16 bits of v at address a. +int st16(int a, int v) { asm { v @ a @ #1230 }; return 0; } +// load the 32-bit value at address a. +int ld32(int a) { return asm { a @ #1232 }; } +// store the low 32 bits of v at address a. +int st32(int a, int v) { asm { v @ a @ #1234 }; return 0; } + +// a byte string: word 0 is the length, then the bytes packed little-endian +// starting at the next word, and a 0 byte after the last character. literals +// b"..." live in the code and are not heap objects. cat_s, slice_s, n_to_s and +// new_s return a shared heap object with the same layout: many pointers may +// hold it, free does nothing, and the collector reclaims it. word strings +// (one character per word) are unchanged. +int len_s(word s) { return s[0]; } +// byte i of a packed byte string. +int at_s(word s, int i) { + if (i < 0 || i >= s[0]) return 0; + return ld8(addr_b(s + 1) + i); +} +// a new packed byte string of n bytes, owned by the caller. +unchecked word new_s(int n) { + word p = new(1 + ((n + 8) >> 3)); + p[0] = n; + return share(p); +} +// store byte v at position i of a word string. +int sput(word s, int i, int v) { st8(addr_b(s + 1) + i, v); return 0; } +// a new string with a followed by b, owned by the caller. +unchecked word cat_s(word a, word b) { + int n = a[0] + b[0]; word p = new_s(n); int i = 0; + while (i < a[0]) { sput(p, i, at_s(a, i)); i++; } + i = 0; + while (i < b[0]) { sput(p, a[0] + i, at_s(b, i)); i++; } + sput(p, n, 0); + return p; +} +// a new string with the characters from i to j of s, owned by the caller. +unchecked word slice_s(word s, int i, int j) { + int n; word p; int k = 0; + if (i < 0) i = 0; + if (j > s[0]) j = s[0]; + if (j < i) j = i; + n = j - i; + p = new_s(n); + while (k < n) { sput(p, k, at_s(s, i + k)); k++; } + sput(p, n, 0); + return p; +} +// compare two word strings: negative, 0 or positive, like strcmp. +int cmp_s(word a, word b) { + int i = 0, n = a[0], ca, cb; + if (b[0] < n) n = b[0]; + while (i < n) { + ca = at_s(a, i); cb = at_s(b, i); + if (ca != cb) { if (ca < cb) return 0 - 1; return 1; } + i++; + } + if (a[0] == b[0]) return 0; + if (a[0] < b[0]) return 0 - 1; + return 1; +} +// true when two word strings are equal. +int eq_s(word a, word b) { return cmp_s(a, b) == 0; } +// true when word string a sorts before b. +int lt_s(word a, word b) { return cmp_s(a, b) < 0; } +// true when word string a sorts before b or equals it. +int le_s(word a, word b) { return cmp_s(a, b) <= 0; } +// write a packed byte string. +int put_bs(word s) { + int i = 0; + while (i < s[0]) { put_c(at_s(s, i)); i++; } + return 0; +} +// the decimal number at the start of a packed byte string. +int s_to_n(word s) { + int n = 0, i = 0, sign = 1; word c; + if (s[0] && at_s(s, 0) == '-') { sign = 0 - 1; i = 1; } + while (i < s[0]) { + c = at_s(s, i); + if (c < '0' || c > '9') break; + n = n * 10 + c - '0'; + i++; + } + return n * sign; +} +// a new packed byte string holding the decimal form of n. +unchecked word n_to_s(int n) { + [24]word b; int i = 0, j = 0, neg = 0; word p, t; + if (!n) { p = new_s(1); sput(p, 0, '0'); sput(p, 1, 0); return p; } + if (n < 0) { neg = 1; n = 0 - n; } + if (n < 0) { + t = "-9223372036854775808"; + p = new_s(20); + while (t[i]) { sput(p, i, t[i]); i++; } + sput(p, i, 0); + return p; + } + while (n) { b[i] = '0' + n % 10; i++; n = n / 10; } + p = new_s(i + neg); + if (neg) { sput(p, 0, '-'); j = 1; } + while (i) { i--; sput(p, j, b[i]); j++; } + sput(p, j, 0); + return p; +} + +// ---- arithmetic the hardware doesn't have ---- +[64]word pow2; +int zrem; +// unsigned division of a by dv. +int zudiv(int n, int dv) { + int q = 0, r = 0, i = 62; + if (n < dv) { zrem = n; return 0; } + while (i >= 0) { + r = r + r + ((n >> i) & 1); + q = q + q; + if (r >= dv) { r = r - dv; q++; } + i--; + } + zrem = r; + return q; +} +// signed division of a by b, rounding toward zero, as c does. +int zdiv(int a, int b) { + word s = 0; int q; + if (b == 0) { zrem = a; return 0; } + if (a < 0) { a = 0 - a; s = 1; } + if (b < 0) { b = 0 - b; s = s ^ 1; } + q = zudiv(a, b); + if (s) return 0 - q; + return q; +} +// signed remainder of a divided by b, with the sign of a, as c does. +int zmod(int a, int b) { + int neg = a < 0; + if (b == 0) return a; + zdiv(a, b); + if (neg) return 0 - zrem; + return zrem; +} +// a shifted left by b bits, for b under 64. +int zshl(int a, int b) { return a * pow2[b & 63]; } + +// ---- heap ---- +// a buddy allocator. the heap is cut into aligned power-of-two chunks, every +// block is a power of two words, and a freed block merges with its buddy +// (the other half of the block they were split from) whenever that one is +// free too, so freed space can be reused at any size. every block has a 5 +// word header before the pointer the program sees: +// p[-5] block size +// p[-4] flags in the low 16 bits, size class in the next 5 +// 0 free (check word cleared) or quarantined (check word still p ^ MAGIC) +// 1 live 2 releasing 3 marked 4 quarantined but a word still points at it +// bit 8 (value 8) is orthogonal: the object is shared. free is a no-op, +// own and release do not follow it, and the sweep still collects it when +// nothing points at it. bits 0..2 keep the meanings above. +// p[-3] p ^ MAGIC p[-2] owner (the container that owns it, or 0) +// p[-1] its type (a type record from new(T), 0 from new(n), -(n + 1) from o3's new_raw) +// free blocks sit on a doubly linked list per class, linked through p[0], p[1]. +// free quarantines: the block stays intact until a sweep finds nothing pointing +// at it. recycle is the fast path for a pointer the program has already +// dropped: it pushes the block onto its size-class list and does not walk the +// heap. a two-word node is still 8 words (the smallest block); a three-word +// node fits in 8 instead of 16. +const int HDR = 5; +const int F_SHARE = 8; // p[-4] bit, orthogonal to live / mark / releasing +const int F_LOW = 65535; // flags live in these bits; the size class is above them +int hbump; [32]word freel; int gc_runs, gc_freed, gc_auto = 1; +int hstop; // block walks and new chunks stop here +int hold_lo, hold_hi; // while nonzero, balloc will not return a block overlapping this range +int hmax, hcut; // words of memory the host has (0: the heap cannot grow); hcut: the heap was cut, so it must not grow +int dbg, alloc_line; // memdebug bits, and the line the compiler stamps before new + +// the size of the top-level chunk holding heap offset off, within [0, hstop) +int topsize(int off) { + int h = hstop - HEAP_LO, base = 0, sz; + while (h) { + sz = 1; + while (sz + sz <= h) sz = sz + sz; + if (off < base + sz) return sz; + base = base + sz; h = h - sz; + } + return 0; +} +// the free lists. freel[k] heads a doubly linked list of free blocks of +// 2^k words; the links live in the block's first payload words (b[5], b[6] +// here, since b is the header address). fpush places a block on the front of its +// class list, funlink takes one out of the middle, mkblock stamps a fresh +// header, and bclass reads the size class back out of the flags word. +int fpush(word b, int k) { + b[1] = k * pow2[16]; + b[5] = freel[k]; + b[6] = 0; + if (freel[k]) freel[k][6] = b; + freel[k] = b; + return 0; +} +// remove block b from its size-class free list. +int funlink(word b, int k) { + if (b[6]) b[6][5] = b[5]; else freel[k] = b[5]; + if (b[5]) b[5][6] = b[6]; + return 0; +} +// turn the memory at b into a free block of size class k. +word mkblock(word b, int k) { + b[0] = pow2[k]; + b[1] = k * pow2[16]; + b[2] = 0; + b[3] = 0; + b[4] = 0; + return b; +} +// the size class of a heap block. +word bclass(word b) { return (b[1] >> 16) & 31; } +// rebuild the free lists for [HEAP_LO, hstop). returns 0 if that span is not +// a whole number of top-level chunks (nothing is left half-built: the caller +// restores the full heap). +int fill_free() { + int b = HEAP_LO, sz, k; + fill_w(freel, 0, 32); + while (b < hstop) { + sz = topsize(b - HEAP_LO); + if (sz <= 0 || b + sz > hstop) return 0; + k = 0; + while (k < 31 && pow2[k] < sz) k++; + if (pow2[k] != sz) return 0; + fpush(mkblock(b, k), k); + b = b + sz; + } + return 1; +} +// start-up: build the power-of-two table and hand the whole heap range to +// the free lists as a few big blocks +int heap_init() { + int i = 1; + if (frame_guard > 1024) frame_guard = 1024; + pow2[0] = 1; + while (i < 64) { pow2[i] = pow2[i - 1] + pow2[i - 1]; i++; } + hstop = HEAP_HI; + hbump = HEAP_HI; + hold_lo = 0; + hold_hi = 0; + hcut = 0; + hmax = 0; + // a map with a growing heap asks the host how much memory there is. a host + // that does not answer (-1) or has no more than the initial heap gets a + // fixed heap + if (HEAP_GROW) { hmax = syscall(9, 0, 0, 0); if (hmax <= HEAP_LO) hmax = 0; } + fill_free(); + frame_control[0] = &frame_floor; frame_control[1] = &frame_top; frame_control[2] = &frame_guard; + frame_control[3] = &data_low; frame_control[4] = &data_top; frame_control[5] = &data_node; + frame_control[6] = &return_low; frame_control[7] = &return_top; frame_control[8] = &return_node; + frame_control[9] = freel; frame_control[10] = &hstop; frame_control[11] = &hbump; + frame_control[12] = &hmax; frame_control[13] = &hold_lo; frame_control[14] = &hold_hi; frame_control[15] = &hcut; + frame_control[16] = &gc_active; + syscall(9, 6, frame_control, 0); + return 0; +} +// drop [lim, HEAP_HI) out of the allocator. the compiler reserves this range +// for type records when it overlaps the heap; the type list is at its start, so +// it cannot also be a buddy header. returns 1 if the cut landed on chunk +// boundaries. allocations that would still overlap [lim, HEAP_HI) are refused. +int heap_reset(int lim) { + int ok; + if (lim <= HEAP_LO || lim > HEAP_HI) return 0; + hstop = lim; + hbump = lim; + hold_lo = 0; + hold_hi = 0; + if (lim < HEAP_HI) { hold_lo = lim; hold_hi = HEAP_HI; hcut = 1; } + ok = fill_free(); + if (!ok) { + hstop = HEAP_HI; + hbump = HEAP_HI; + hold_lo = 0; + hold_hi = 0; + hcut = 0; + fill_free(); + } + return ok; +} +// put a power-of-two tail back. addr is the cut point heap_reset was given. +int heap_uncut(int addr, int k) { + hstop = HEAP_HI; + hbump = HEAP_HI; + hold_lo = 0; + hold_hi = 0; + hcut = 0; + if (addr < HEAP_LO || addr + pow2[k] > HEAP_HI) return 0; + fpush(mkblock(addr, k), k); + return 0; +} +// take a block of 2^k words. find the smallest non-empty class at or above k, +// unlink its first block and split it down: each half that is not kept goes +// back on its own list. a block that overlaps the held range is marked +// "releasing" and dropped from the lists for good (the loop then tries again), +// so the compiler's type area is never handed out as heap. +word balloc(int k) { + int j; word b; int h, ok; + while (1) { + j = k; + while (j < 32 && !freel[j]) j++; + if (j >= 32) return 0; + b = freel[j]; + funlink(b, j); + while (j > k) { j--; h = b + pow2[j]; fpush(mkblock(h, j), j); } + mkblock(b, k); + ok = 1; + if (hold_hi && b < hold_hi && b + pow2[k] > hold_lo) { + b[1] = (k * pow2[16]) | 2; + b[5] = 0; + b[6] = 0; + ok = 0; + } + if (ok) return b; + } + return 0; +} +// ---- a heap that grows ---- +// the heap is [HEAP_LO, hstop). on a map with HEAP_GROW the memory above +// HEAP_HI belongs to the host (a big zeroed array nobody has touched yet), and +// when the free lists cannot satisfy a request the heap takes more of it. the +// buddy allocator does not care where the top is, as long as the top-level +// chunks (topsize) are right: extending hstop re-cuts them, and every new +// piece goes through bfree, which merges it with a free buddy below it. a +// block that is in use stays where it is, so no pointer moves. +// grow so that a block of 2^k words fits: double the heap, or less when the +// host runs out. returns 0 when it cannot. +int heap_grow(int k) { + int h = hstop - HEAP_LO, h2, need, o, sz, c, room; + if (!hmax || hcut || hold_hi) return 0; + room = hmax - HEAP_LO; + need = (h + pow2[k] - 1) / pow2[k] * pow2[k] + pow2[k]; + h2 = h + h; + if (h2 < need) h2 = need; + if (h2 > room) { // the machine is smaller than the heap wants: the host grows it (syscall 9, 4) + hmax = syscall(9, 4, HEAP_LO + h2, 0); + if (hmax <= HEAP_LO) hmax = 0; + room = hmax - HEAP_LO; + } + if (h2 > room) h2 = room; + if (h2 < need) return 0; + hstop = HEAP_LO + h2; + hbump = hstop; + o = h; + while (o < h2) { + // the biggest aligned power of two that starts at o and ends by h2 + sz = 8; c = 3; + while (sz + sz <= h2 - o && o % (sz + sz) == 0) { sz = sz + sz; c++; } + bfree(mkblock(HEAP_LO + o, c)); + o = o + sz; + } + return 1; +} +// words the heap spans right now (it only ever grows) +int heap_size() { return hstop - HEAP_LO; } +// words on the free lists +int hfree() { + int k = 3, n = 0; word b; + while (k < 32) { + b = freel[k]; + while (b) { n = n + pow2[k]; b = b[5]; } + k++; + } + return n; +} +int fend; // end of the block bfree last made, for the sweep +// put block b back, merging it with its buddy as long as it can +int bfree(word b) { + int k = bclass(b), sz = pow2[k], off; word bud; + while (1) { + off = b - HEAP_LO; + if (sz >= topsize(off)) break; + bud = HEAP_LO + (off ^ sz); + // a quarantined buddy still has its check word, and isn't on a free list + if ((bud[1] & F_LOW) != 0 || bclass(bud) != k || bud[0] != sz || bud[2]) break; + funlink(bud, k); + // the upper header is inside the merged block now + if (bud < b) { + b[0] = 0; + b[2] = 0; + b = bud; + } + else { bud[0] = 0; bud[2] = 0; } + k++; sz = sz + sz; + mkblock(b, k); + } + fpush(mkblock(b, k), k); + fend = b + sz; + return 0; +} +// back onto the size-class list, with no buddy walk and no heap scan +int bdrop(word b) { + int k = bclass(b); + b[2] = 0; + fpush(b, k); + return 0; +} +// is x the payload address of a block that has been allocated (live or +// quarantined)? the check word p[-3] == p ^ MAGIC is what makes this safe to +// ask about any integer: a random value would have to match by chance. +word isobj(word x) { return x >= HEAP_LO + HDR && x < hbump && x[-3] == (x ^ MAGIC) && (x[-4] & 1); } +// the number of words to skip in p[0..n) before one that could be a pointer +// to a block (see op 20 in core.c); n when none can be. a long payload of +// plain numbers costs one host call instead of an isobj per word. a host that +// does not have the op (-1) is asked once and then never again. +const int SYS_SCAN = 20; +int scan_off; +// walk the n words at p and mark every heap object they point to. +int scan_ptr(int p, int n) { + word g = ZFP + 2; int r; + if (n < 8 || scan_off) return 0; + g[1] = p; g[2] = n; g[3] = hbump; g[0] = SYS_SCAN; + r = g[0]; + if (r < 0) { scan_off = 1; return 0; } + return r; +} + +// every prologue checks the frame stack; on overflow it resets the frame +// pointer (so this can run at all) and stops +int frame_overflow() { + put_s("zy: frame stack overflow\n"); + halt(); + return 0; +} +// choose the minimum size of subsequent frame segments, in words. +int reserve_frames(int words) { + if (words > frame_chunk) frame_chunk = words; + return frame_chunk; +} +// reserve stack words without invalidating locals or their borrowed addresses. +int reserve_data(int words) { return syscall(9, 7, words, 0); } +int reserve_returns(int words) { return syscall(9, 8, words, 0); } +// the prologue restores oldfp before calling this helper. its own calls use +// the guard space below oldfp; they must not try to grow another segment. +unchecked word frame_grow(int oldfp, int attempted) { + int size = frame_chunk, slots = oldfp - attempted; word p; + frame_busy = 1; + if (!hstop || slots < 0 || slots > 0x7FFFFFFF - frame_guard - 4) { + *ZFP = FTOP; frame_overflow(); return 0; + } + if (size < slots + frame_guard + 4) size = slots + frame_guard + 4; + p = new_oz(size); + p[-4] = p[-4] | F_INTERNAL | F_STACK; + if (gc_active) p[-4] = p[-4] | 2; + p[0] = oldfp; p[1] = frame_floor; p[2] = frame_top; p[3] = frame_node; + frame_floor = p + 4; frame_top = p + p[-5] - HDR; frame_node = p; + frame_chunk = size; + frame_busy = 0; + return frame_top - slots; +} +// only the final frame in a segment calls this helper. the helper's own +// epilogue still uses that segment; the caller stores the restored pointer. +unchecked word frame_leave() { + word p = frame_node; int oldfp = p[0]; + frame_busy = 1; + frame_floor = p[1]; frame_top = p[2]; frame_node = p[3]; + bdrop(p - HDR); + frame_busy = 0; + return oldfp; +} +// report that the heap is out of memory, and stop. +int oom() { + outmode = 0; outgrow = 0; + put_s("zc: out of heap memory\n"); + halt(); + return 0; +} +// n words, untyped and not zeroed. the type word keeps -(n + 1), so fatten +// can type it later. typed new goes through new_t. o3 new(n) goes through +// new_oz, which zeroes the words that were asked for. +unchecked int .u new_raw(int n) { + int need = n + HDR, k = 3; word b; int p; + if (n > 0x7FFFFFFF - HDR) { oom(); return 0; } + if (n < 0) need = HDR; + while (pow2[k] < need) k++; + b = balloc(k); + if (!b) { + // collect first; if that leaves the heap more than three quarters full (or + // still short), take more memory from the host + if (gc_auto) { + gc(); + b = balloc(k); + if (HEAP_GROW && hfree() < (hstop - HEAP_LO) / 4) heap_grow(k); + } + if (!b) { heap_grow(k); b = balloc(k); } + if (!b) oom(); + } + p = b + HDR; + b[1] = (k * pow2[16]) | 1; b[2] = p ^ MAGIC; b[3] = 0; b[4] = 0 - n - 1; + // the words past n are not the object's. zero them so a later walk + // doesn't follow garbage. the n words themselves stay uninitialized. + if (n > 0 && b[0] - HDR > n) fill_w(p + n, 0, b[0] - HDR - n); + else if (n <= 0) fill_w(p, 0, b[0] - HDR); + return p; +} +// n words, untyped, zeroed. the type word stays -(n + 1). new_raw does not +// zero the words that were asked for, so typed new does not zero them twice. +unchecked int .u new_oz(int n) { + int p = new_raw(n); + if (n > 0) fill_w(p, 0, n); + return p; +} +// n words typed t, zeroed. memdebug records the line the compiler stored in alloc_line +unchecked word .u new_t(int n, int t) { + word p = new_raw(n); + p[-1] = t; + fill_w(p, 0, p[-5] - HDR); + if (dbg & 1) note_alloc(p, alloc_line); + return p; +} +unchecked word .u new(int n) { return new_t(n, 0); } +// the compiler works out the size class of a constant-size new at compile +// time (k is the class of n + HDR words), so a repeated allocation of the same +// shape pays for no class search. when the class list has a block, pop it +// directly; a free block already has the right size and an empty payload to +// refill. in a loop that frees its object every pass (an m local) this is the +// block that was just recycled, so the pair costs about a dozen steps. +// memdebug, an empty list, or a block inside the held range (balloc's rule +// for the compiler's type area) fall back to the general path. +unchecked word .u new_k(int n, int t, int k) { + word b = freel[k], p, nx; + if (!b || dbg || (hold_hi && b < hold_hi && b + pow2[k] > hold_lo)) return new_t(n, t); + nx = b[5]; + freel[k] = nx; + if (nx) nx[6] = 0; + p = b + HDR; + b[1] = (k * pow2[16]) | 1; b[2] = p ^ MAGIC; b[3] = 0; b[4] = t; + if (k == 3) { p[0] = 0; p[1] = 0; p[2] = 0; } // the smallest block: three payload words + else fill_w(p, 0, pow2[k] - HDR); + return p; +} +// the size in words of the heap object p, as new asked for it. +int osize(word p) { + if (!isobj(p)) return 0; + return p[-5] - HDR; +} +// the type record stamped on the heap object p by new(T), or 0 when there is none. +int typeof_obj(word p) { + if (!isobj(p) || p[-1] < 0) return 0; + return p[-1]; +} + +// how many payload words a free walk should follow. a raw object only owns +// the words new asked for; the slack past that was never zeroed. +int paylen(word p) { + int n = p[-5] - HDR, req; + if (p[-1] < 0) { req = 0 - p[-1] - 1; if (req < n) n = req; } + return n; +} +// frees p and, recursively, every object p owns. the block stays quarantined. +int release(word p) { + word b = p - HDR; int n = paylen(p), i = 0; word w; + b[1] = (b[1] & ~7) | 2; // going: not live, and not free yet either, so a child's buddy check can't merge into it + while (i < n) { + i = i + scan_ptr(p + i, n - i); + if (i >= n) break; + w = p[i]; if (isobj(w) && !(w[-4] & F_SHARE) && w[-2] == p) release(w); + i++; + } + b[1] = b[1] & ~7; // quarantined. the check word and the bytes stay; the next sweep reclaims it + return 0; +} +// frees a heap object: p has to be tagged d, so a call is free(d*p). the object is +// not reused at once. it is kept in quarantine (a stale pointer still reads the old +// contents), and the next collection reclaims it when nothing points at it. a second +// free does nothing. a shared object is left alone. +unchecked int free(.d p) { + int n; + if (isobj(p) && (p[-4] & F_SHARE)) return 0; + if ((dbg & 1) && quar(p)) { + put_s("zy: double free from line "); put_n(site_line_of(p)); put_c(10); + return 0; + } + if (isobj(p)) { + n = paylen(p); + release(p); + if (dbg & 2) fill_w(p, 57005, n); // 0xDEAD, so a stale read is obvious + } + return 0; +} +// the pointer is the last one. children go first, then the block returns to +// its size-class list. no sweep, no buddy walk. +unchecked int recycle(.d p) { + word b; int n, i = 0; word w; + if ((dbg & 1) && quar(p)) { + put_s("zy: double free from line "); put_n(site_line_of(p)); put_c(10); + return 0; + } + if (!isobj(p) || (p[-4] & F_SHARE)) return 0; + b = p - HDR; + n = paylen(p); + b[1] = (b[1] & ~7) | 2; + while (i < n) { + i = i + scan_ptr(p + i, n - i); + if (i >= n) break; + w = p[i]; if (isobj(w) && !(w[-4] & F_SHARE) && w[-2] == p) recycle(w); + i++; + } + if (dbg & 2) fill_w(p, 57005, n); + bdrop(b); + return 0; +} +// the matching free for an object the compiler knows has no pointer fields +// (a typed new of a struct of numbers). it checks the type word and the size +// class still match what the compiler assumed, since the variable may have been +// reassigned; if not, or under memdebug, it takes the general route. +unchecked word recycle_leaf(.d p, int t, int k) { + word b = p - HDR; int f; word h; + if (dbg || p < HEAP_LO + HDR || p >= hbump) return recycle(p); + f = b[1]; + if (b[2] != (p ^ MAGIC) || (f & F_LOW) != 1 || p[-1] != t || ((f >> 16) & 31) != k) { + return recycle(p); + } + h = freel[k]; // the block goes on the head of its class list, ready for the next new_k + b[2] = 0; b[1] = k * pow2[16]; b[5] = h; b[6] = 0; + if (h) h[6] = b; + freel[k] = b; + return 0; +} +// make p the owner of c, so that freeing p also frees c. it returns c, so the call +// composes: h[0] = own(b, h). a shared object has no owner and is left alone. +word own(word c, int p) { + if (isobj(c) && !(c[-4] & F_SHARE)) c[-2] = p; + return c; +} +// an opt-in bump arena of n words, made as one block. the handle owns that block. +// arena_alloc hands out interior pointers into it and never asks the buddy lists, +// and arena_reset gives all of it back at once. +unchecked word .u arena_new(int n) { + word h = new(3), b; int cap = n; + if (cap < 1) cap = 1; + b = new(cap); + h[0] = own(b, h); + h[1] = cap; + h[2] = 0; + return h; +} +// take n zeroed words from arena a. it returns the address, or 0 when the arena +// does not have n words left. +unchecked int arena_alloc(word a, int n) { + int p, at; + if (!a || n < 0) return 0; + at = a[2]; + if (at + n > a[1]) return 0; + p = a[0] + at; + if (n) fill_w(p, 0, n); + a[2] = at + n; + return p; +} +// give back every block of arena a at once. the words it held are reused by the next +// arena_alloc calls, so pointers into the arena from before are no longer valid. +int arena_reset(word a) { + if (a) a[2] = 0; + return 0; +} +// publish p. a shared object has no owner: free does nothing to it, copies of its +// pointer are ordinary words, and the collector reclaims it once every copy is gone. +// returns p. +unchecked word share(word p) { + if (!isobj(p)) return p; + p[-4] = (p[-4] & ~7) | 1 | F_SHARE; + p[-2] = 0; + return p; +} +// true when p is a shared object, which free leaves alone. +int is_shared(word p) { + if (!isobj(p)) return 0; + if (p[-4] & F_SHARE) return 1; + return 0; +} +// make an immutable pair of a and b. a heap object that is stored in either side is +// published too, so a later free from its old owner cannot clear a cell that still +// points at it. read with car and cdr. +unchecked word cons(int a, int b) { + word p = new(2); + share(a); share(b); + p[0] = a; p[1] = b; + return share(p); +} +// make an immutable record of three words, a, b and c. read the words with tget. +unchecked word triple(int a, int b, int c) { + word p = new(3); + share(a); share(b); share(c); + p[0] = a; p[1] = b; p[2] = c; + return share(p); +} +// the first word of a pair made by cons. +unchecked word car(word p) { + if (dbg & 1) checkptr(p); + return p[0]; +} +// the second word of a pair made by cons. +unchecked word cdr(word p) { + if (dbg & 1) checkptr(p); + return p[1]; +} +// word i (0, 1 or 2) of a triple made by triple. +unchecked word tget(word p, int i) { + if (dbg & 1) checkptr(p); + return p[i]; +} + +// ---- growable arrays ---- +// a []T is a handle: [len, cap, items, element size]. items is an object the +// handle owns; growing swaps it for a bigger one and moves its children over. +unchecked word .u dnew(int es, int n, int t) { + word h = new_t(4, t); int c = n; word it; + if (c < 4) c = 4; + if (es < 0) it = new((c * (0 - es) + 7) >> 3); else it = new(c * es); // a negative size is a packed element of that many bytes + h[0] = n; h[1] = c; h[2] = own(it, h); h[3] = es; + return h; +} +// grow the growable array h so that it can hold need elements. +unchecked int dgrow(word h, int need) { + int c = h[1]; word it; int old = h[2], i = 0; word w; int n, es = h[3]; + if (need <= c) return 0; + while (c < need) c = c + c; + if (es < 0) { it = new((c * (0 - es) + 7) >> 3); n = (h[0] * (0 - es) + 7) >> 3; es = 0; } + else { it = new(c * es); n = h[0] * es; } + copy_w(it, old, n); + // the children move with the elements (packed bytes have none) + while (es && i < n) { + w = it[i]; + if (isobj(w) && w[-2] == old) w[-2] = it; + i++; + } + h[2] = own(it, h); h[1] = c; + free(old); + return 0; +} +// the out-of-range report for []T indexing (dat, dpop) +int oob(int i, int n) { + put_s("zy: index "); + put_n(i); + put_s(" out of range (length "); + put_n(n); + put_s(")\n"); + halt(); + return 0; +} +// element i of a growable array h. indexing with [] does the same, with the bounds +// check. the bounds check is what oob reports when i is outside the array. +unchecked word dat(word h, int i) { + if (i < 0 || i >= h[0]) oob(i, h[0]); + return h[2] + i * h[3]; +} +// add x to the end of a growable array h, growing its items when they are full. the +// array owns the items, so x is handed to it (tagged d). +unchecked int dpush(word h, .d x) { + dgrow(h, h[0] + 1); + h[2][h[0]] = x; + own(x, h[2]); + h[0] = h[0] + 1; + return 0; +} +// remove the last element of a growable array h and give it back. the array +// must not be empty. +unchecked word dpop(word h) { + if (!h[0]) oob(-1, 0); + h[0] = h[0] - 1; + return h[2][h[0]]; +} +// set the length of a growable array h to n. growing it fills the new elements with +// zero, and shrinking it drops the elements past n. +unchecked int dresize(word h, int n) { + int old = h[0] * h[3]; + if (n < 0) n = 0; + dgrow(h, n); + if (n * h[3] > old) fill_w(h[2] + old, 0, n * h[3] - old); + h[0] = n; + return 0; +} +// packed elements (h[3] is minus their size in bytes): the address is a byte address +unchecked word datb(word h, int i) { + if (i < 0 || i >= h[0]) oob(i, h[0]); + return addr_b(h[2]) + i * (0 - h[3]); +} +// add the byte x to the end of a growable byte array h. +unchecked int dpushb(word h, int x) { + int b = 0 - h[3], a; + dgrow(h, h[0] + 1); + a = addr_b(h[2]) + h[0] * b; + if (b == 1) st8(a, x); else if (b == 2) st16(a, x); else st32(a, x); + h[0] = h[0] + 1; + return 0; +} +// remove and return the last byte of a growable byte array h. +unchecked int dpopb(word h) { + int b = 0 - h[3], a; + if (!h[0]) oob(-1, 0); + h[0] = h[0] - 1; + a = addr_b(h[2]) + h[0] * b; + if (b == 1) return ld8(a); + if (b == 2) return ld16(a); + return ld32(a); +} +// growing zeroes the new elements, including the unused tail of the last word +unchecked int dresizeb(word h, int n) { + int b = 0 - h[3], a, e, old = (h[0] * b + 7) >> 3, nw; + if (n < 0) n = 0; + if (n > h[0]) { + dgrow(h, n); + a = addr_b(h[2]) + h[0] * b; + e = addr_b(h[2]) + old * 8; + if (e > addr_b(h[2]) + n * b) e = addr_b(h[2]) + n * b; + while (a < e) { st8(a, 0); a++; } + nw = (n * b + 7) >> 3; + if (nw > old) fill_w(h[2] + old, 0, nw - old); + } + h[0] = n; + return 0; +} +// the length of a growable array, the number of elements it holds. +int dlen(word h) { return h[0]; } +// the capacity of a growable array: how many elements it can hold before it grows. +int dcap(word h) { return h[1]; } + +// ---- mark-sweep ---- +// conservative and non-moving. roots: the program area (globals live +// between functions), the genome's globals, the compiler's input stack, +// the live part of the frame stack and the live part of the data stack. +// opcode 619 pushes that index. a word below it is not a root. +int ms_top, ms_over, gc_lo, gc_hi; +word ms_buf = MARK0; int markcap = MARKN; +// mark work must grow without starting another collection inside this one. +unchecked int reserve_mark(int need) { + int cap = markcap, auto = gc_auto; word p; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + gc_auto = 0; p = new_oz(cap); gc_auto = auto; + copy_w(p, ms_buf, ms_top); + p[-4] = p[-4] | F_INTERNAL; + if (gc_active) p[-4] = p[-4] | 2; + ms_buf = p; markcap = cap; return cap; +} +// mark one word. a word that is not the payload address of a block is not a +// pointer and is ignored (conservative). a live block gets its mark bit and +// goes on the mark stack to have its payload scanned. a quarantined block that +// something still points at is flagged 4 so the sweep keeps it quarantined +// instead of reusing it. the work stack grows before appending another block. +int mark(word w) { + int p = 0; + if (w < HEAP_LO + HDR || w >= hbump || w[-3] != (w ^ MAGIC)) { + if (dbg & 4) { p = obj_base(w); if (p) return mark(p); } + return 0; + } + if (w[-4] & 1) { if (w[-4] & 2) return 0; w[-4] = w[-4] | 2; } // live + else if ((w[-4] & F_LOW) == 0) w[-4] = w[-4] | 4; // quarantined, but still pointed at + else return 0; + if (w == ms_buf || (w[-4] & F_STACK)) return 0; + if (ms_top >= markcap) reserve_mark(markcap * 2); + ms_buf[ms_top] = w; ms_top++; + return 0; +} +// mark every word in [a, b). note *a is a plain load of the word at a. +int markrange(word a, int b) { + if (dbg & 4) { while (a < b) { mark(*a); a++; } return 0; } // interior pointers: every word counts + while (a < b) { + a = a + scan_ptr(a, b - a); + if (a >= b) break; + mark(*a); + a++; + } + return 0; +} +// empty the mark stack: scan the payload of each marked block +int drain() { + int p = 0; + while (ms_top) { ms_top--; p = ms_buf[ms_top]; ms_buf[ms_top] = 0; markrange(p, p + p[-5] - HDR); } + return 0; +} +// stack blocks are marked without scanning their unused payload. each saved +// segment records the caller's live range and the previous segment's node. +int gc_frames() { + word p = frame_node; + markrange(*ZFP, frame_top); + while (p) { mark(p); markrange(p[0], p[2]); p = p[3]; } + return 0; +} +// gc_roots is defined in the compiler half (it knows where the compiler's +// own tables live); it calls markrange over every root range +int gc_roots(); +// runs a collection: the blocks nothing points at are reclaimed, quarantined blocks +// included, and the number of blocks freed is returned. cycles are reclaimed too. +unchecked int gc() { + word b = 0; int sz = 0, n = 0; // a leftover pointer here would be a root and pin a block + ms_top = 0; ms_over = 0; gc_active = 1; + gc_roots(); + drain(); + while (ms_over) { // the mark stack overflowed: rescan marked objects + ms_over = 0; + b = HEAP_LO; + while (b < hstop) { + if ((b[1] & 7) == 3 || (b[1] & 7) == 4) markrange(b + HDR, b + b[0]); + b = b + b[0]; + drain(); + } + } + b = HEAP_LO; + while (b < hstop) { + sz = b[0]; + if ((b[1] & 7) == 1) { bfree(b); n++; b = fend; } // unmarked live object, shared or not + else if ((b[1] & 7) == 3) { b[1] = (b[1] & ~7) | 1; b = b + sz; } + else if ((b[1] & 7) == 4) { b[1] = b[1] & ~7; b = b + sz; } // still pointed at: stays quarantined + else if (!(b[1] & 7) && b[2] == ((b + HDR) ^ MAGIC)) { bfree(b); n++; b = fend; } + else b = b + sz; + } + gc_runs++; + gc_active = 0; + gc_freed = gc_freed + n; + return n; +} +// the number of live heap objects, for tests and leak checks. +int live_objects() { + word b = HEAP_LO; int n = 0; + while (b < hstop) { + if ((b[1] & 1) && !(b[1] & F_INTERNAL)) n++; + b = b + b[0]; + } + return n; +} +// the size, in words, of the biggest block that is free right now. +int largest_free() { + int k = 31; + while (k > 0 && !freel[k]) k--; + if (!freel[k]) return 0; + return pow2[k]; +} +// the data-stack index: the first live word. opcode 619, word 1238. +int dsp() { return asm { #1238 }; } +// zero the unused data stack, from the bottom up to the live top. the last +// 16 words are the ones this loop is using, so they are pushed as zeros. +int scrub() { + int top; word p; + top = dsp(); + p = data_low; + if (top < data_low + 16) return 0; + while (p + 16 < top) { *p = 0; p++; } + asm { 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }; + asm { _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ }; + return 0; +} + +// ---- memory debug ---- +// dbg bits: 1 header checks and allocation sites, 2 poison the payload on free +// (the word 57005, which is 0xDEAD), 4 interior pointers keep a quarantined +// block (the mark walks back at most 64 words to a real header). off unless +// a program asks. sites are p ^ MAGIC so the collector doesn't see them. +const int NSITE = 64; +const int POISON = 57005; +int site_drop; +[64]word site_p; [64]word site_line; +// true when p is a freed block still held in quarantine. +word quar(word p) { return p >= HEAP_LO + HDR && p < hbump && p[-3] == (p ^ MAGIC) && !(p[-4] & 1); } +// the object whose payload contains w, or 0. exact pointers and interiors. +word obj_base(int w) { + int i = 0; word p; int n; + if (w < HEAP_LO + HDR || w >= hbump) return 0; + while (i <= 64) { + p = w - i; + if (p >= HEAP_LO + HDR && p < hbump && p[-3] == (p ^ MAGIC)) { + n = p[-5] - HDR; + if (w >= p && w < p + n) return p; + } + i++; + } + return 0; +} +// the source line recorded for the allocation at p. +word site_line_of(int p) { + int i = 0, k = p ^ MAGIC; + while (i < NSITE) { if (site_p[i] == k) return site_line[i]; i++; } + return 0; +} +// record the source line of the allocation of p, for the leak report. +int note_alloc(int p, int line) { + int i = 0, k, slot = -1, q; + if (!(dbg & 1) || !p) return 0; + k = p ^ MAGIC; + while (i < NSITE) { + if (site_p[i] == k) { site_line[i] = line; return 0; } + if (slot < 0 && !site_p[i]) slot = i; + i++; + } + i = 0; + while (i < NSITE) { + q = site_p[i] ^ MAGIC; + if (site_p[i] && !isobj(q) && !quar(q)) { slot = i; i = NSITE; } + else i++; + } + if (slot < 0) { site_drop = 1; return 0; } + site_p[slot] = k; site_line[slot] = line; + return 0; +} +// turns memdebug's checks on or off with a bit set: bit 1 checks headers and reports +// use after free, and the other bits add allocation lines and poison. a program +// turns them on with memdebug on; and the runtime calls this with the flags. +int mem_set(int flags) { dbg = flags; return flags; } +// a heap address used while dbg bit 1 is on: a dead header is a use after free. +int checkptr(int w) { + word p; + if (!(dbg & 1) || !w) return 0; + if (w < HEAP_LO || w >= hstop) return 0; + p = obj_base(w); + if (!p) { put_s("zy: bad heap pointer\n"); halt(); return 0; } + if (!(p[-4] & 1)) { + put_s("zy: use after free from line "); put_n(site_line_of(p)); put_c(10); + halt(); + } + return 0; +} +// prints the live objects and the lines they were allocated on, the leak report that +// memdebug produces at the end of a run. +int memreport() { + int i = 0, p, n = 0; + if (site_drop) put_s("mem: site table full\n"); + while (i < NSITE) { + if (site_p[i]) { + p = site_p[i] ^ MAGIC; + if (isobj(p)) { + put_s("leak: line "); put_n(site_line[i]); put_s(" "); put_n(osize(p)); put_s(" words\n"); + n++; + } + } + i++; + } + return n; +} + +// ---- host syscalls ---- +// a store of the op number to SYSGATE runs it. the three words after the gate +// are the arguments, and the store leaves the result in the gate. +// 1 open(path, 0 read | 1 write-create) 2 close(fd) +// 3 read(fd, buf, n) 4 write(fd, buf, n) bytes, one per word +// 5 getenv(name, buf, cap) 6 time() unix seconds +// 21 argc() 22 argv(i, buf, cap) 23 envc() 24 envp(i, buf, cap) +// 40 raw(block) any linux syscall: the block holds the number and six arguments. +// the result is the kernel's, or -errno. see Host.raw in src/lib/std.zc +const int SYSGATE = ZFP + 2; +const int SYS_OPEN = 1, SYS_CLOSE = 2, SYS_READ = 3, SYS_WRITE = 4, SYS_GETENV = 5, SYS_TIME = 6; +const int SYS_BOPEN = 10, SYS_BREAD = 11, SYS_BWRITE = 12, SYS_BGETENV = 13; +const int SYS_RAW = 40; +// the command line and the environment. argv holds the program path, which is +// when the source came from stdin, so argc is 1 even with no arguments. +// the string ops take an index and copy one entry across, one character per +// word like SYS_GETENV: a zero buffer asks for the length alone, so the caller +// can size the string before it fetches it. src/lib/std.zc builds the arrays. +const int SYS_ARGC = 21, SYS_ARG = 22, SYS_ENVC = 23, SYS_ENV = 24; +// byte-string paths. the address is the first byte (addr_b of the word after +// the length), not the string object. word-string syscalls are unchanged. +int bopen(word path, int mode) { return syscall(SYS_BOPEN, addr_b(path + 1), mode, 0); } +// read up to n bytes from fd into the packed byte string s. +int bread(int fd, word s, int n) { return syscall(SYS_BREAD, fd, addr_b(s + 1), n); } +// write the first n bytes of the packed byte string s to fd. +int bwrite(int fd, word s, int n) { return syscall(SYS_BWRITE, fd, addr_b(s + 1), n); } +// copy the value of the environment variable name into dst, returning its length. +int bgetenv(word name, word dst, int n) { return syscall(SYS_BGETENV, addr_b(name + 1), addr_b(dst + 1), n); } +// ---- c abi ---- +// ops 14..17 reach native code (see the c abi section of core.c and extern in +// compiler.zc). cfind(name) is 1 if a native symbol resolves (name is a byte +// string), cload(path) opens a library so its symbols resolve, and +// cbmake(entry, sig) is a native function pointer that runs the zc function at +// entry (cfunc(f) in the compiler builds the signature). a native pointer +// from cbmake only works while a native call is in progress, and not on the +// arm64 jit, where it is 0. +const int SYS_CCALL = 14, SYS_CFIND = 15, SYS_CBMAKE = 16, SYS_CLOAD = 17; +// the address of the native symbol name in the loaded libraries, or 0 when it is not +// loaded. see cload. +int cfind(word name) { return syscall(SYS_CFIND, addr_b(name + 1), 0, 0); } +// loads the shared library at path, so the symbols it defines can be found with cfind. +int cload(word path) { return syscall(SYS_CLOAD, addr_b(path + 1), 0, 0); } +// makes a native function pointer that runs the vm entry with the signature sig, +// so c code can call a zc function through it. +int cbmake(int entry, int sig) { return syscall(SYS_CBMAKE, entry, sig, 0); } +// calls the host through the gate word, with the op number and up to three arguments. +// the result comes back as the call's return value (negative for an error). prefer the +// named ops (SYS_OPEN and the rest) to the raw numbers. +int syscall(int op, word a, word b, word c) { + word g = SYSGATE; + g[1] = a; g[2] = b; g[3] = c; g[0] = op; + return g[0]; +} +// the whole file as a fresh string, or 0 if it can't be opened +unchecked word .u readfile(int path) { + int fd; word buf; int n = 0, got, cap; word nb; + fd = syscall(SYS_OPEN, path, 0, 0); + if (fd < 0) return 0; + cap = 256; + buf = new(cap); + while (1) { + if (n + 128 >= cap) { + nb = new(cap + cap); + copy_w(nb, buf, n); + free(buf); + buf = nb; + cap = cap + cap; + } + got = syscall(SYS_READ, fd, buf + n, 128); + if (got <= 0) break; + n = n + got; + } + buf[n] = 0; + syscall(SYS_CLOSE, fd, 0, 0); + return buf; +} diff --git a/src/runtime/run.zc b/src/runtime/run.zc new file mode 100644 index 0000000..60193a7 --- /dev/null +++ b/src/runtime/run.zc @@ -0,0 +1,27 @@ +// run-only image: the runtime, a collector root set, and start. there is no +// resident compiler and none of its tables. put this between rt.zc and a +// program that defines main, and compile with zc0 (the program has to stay in +// the stage-0 subset: no types, no quote, no parse words). +// +// cat build/run/rt.zc src/runtime/run.zc examples/hello.zc | ./zc0 >build/run/genome.h + +// the program's entry point, written by the program (see start). +int main(); + +// the collector's roots: the code and globals, the program's frames and the +// operand stack. the collector marks from these before it frees anything. +int gc_roots() { + markrange(0, CODE_END); + markrange(GORG, GORG[6]); + gc_frames(); + markrange(dsp(), data_top); + return 0; +} + +// the first code a run-only image executes: it sets up the heap, runs main and halts. +int start() { + heap_init(); + main(); + halt(); + return 0; +} diff --git a/src/tools/automap.sh b/src/tools/automap.sh new file mode 100755 index 0000000..8cefe6a --- /dev/null +++ b/src/tools/automap.sh @@ -0,0 +1,58 @@ +#!/bin/bash +# sizes a memory map to the program it holds, before the program is compiled for it. +# src/tools/automap.sh PRESET OUTDIR FILE... +# PRESET is run, small, default or lsp. DOCS=1 makes the genome with its doc comments. FILE... are appended after the map's own +# rt.zc (and compiler.zc, for the presets that carry the compiler). the result +# is OUTDIR/memmap.h and OUTDIR/genome.h, and they agree with each other. +# +# a genome's length doesn't depend on where it lives (every address is a one +# word literal), so two passes are enough: compile once on the preset's map +# to learn the length, then lay the map out again with a genome slot of exactly +# that length, rounded up to 4096 words, and let a fixed-size map grow if it has +# to. the second compile must come out the same length, and that is checked. +# zc0 reads the map at build time, so it is built again for each layout. +# GENMAP can name a genmap that is already built. +set -e +cd "$(dirname "$0")/../.." +P=$1; O=$2; shift 2 +[ -n "$P" ] && [ -n "$O" ] || { echo "usage: src/tools/automap.sh run|small|default|lsp OUTDIR FILE..." >&2; exit 2; } +CC=${CC:-gcc} +mkdir -p "$O" +ZC0=$O/.zc0 +if [ -z "$GENMAP" ]; then + GENMAP=$O/.genmap + if [ ! -x "$GENMAP" ] || [ src/tools/genmap.c -nt "$GENMAP" ]; then $CC -O2 -w -fwrapv src/tools/genmap.c -o "$GENMAP"; fi +fi +lay() { # $1 = genome slot, or empty for the preset's own + rm -rf "$O/map" + "$GENMAP" --preset "$P" --grow ${1:+--genome $1} -o "$O/map" >/dev/null 2>&1 + $CC -O1 -w -fwrapv src/tools/zc0.c -I"$O/map" -Isrc/core -o "$ZC0" +} +build() { + if [ -f "$O/map/compiler.zc" ]; then cat "$O/map/rt.zc" "$O/map/compiler.zc" "$@"; else cat "$O/map/rt.zc" "$@"; fi | "$ZC0" +} +# with DOCS=1 the genome is made again with zc0 built for docs (ZC0DOCS), so the +# image carries the doc comments of the sources and the program can answer +# docofs(). the image is the same code either way; the docs are stored after it. +docs() { + $CC -O1 -w -fwrapv -DZC0DOCS src/tools/zc0.c -I"$O/map" -Isrc/core -o "$O/.zc0docs" + if [ -f "$O/map/compiler.zc" ]; then cat "$O/map/rt.zc" "$O/map/compiler.zc" "$@"; else cat "$O/map/rt.zc" "$@"; fi | "$O/.zc0docs" +} +len() { grep -m1 '#define GLEN' "$1" | awk '{print $3}'; } +lay "" +build "$@" > "$O/genome.h" +glen=$(len "$O/genome.h") +slot=$(( (glen + 4095) / 4096 * 4096 )) +lay "$slot" +build "$@" > "$O/genome.h" +if [ -n "$DOCS" ]; then + lay $((slot + 65536)) # room for the image with its docs while it is being made + docs "$@" > "$O/genome.h" + glen=$(len "$O/genome.h") + slot=$(( (glen + 4095) / 4096 * 4096 )) + lay "$slot" + docs "$@" > "$O/genome.h" +fi +[ "$(len "$O/genome.h")" = "$glen" ] || { echo "automap: the genome changed length with the map" >&2; exit 1; } +cp "$O/map/memmap.h" "$O/map/map.txt" "$O/" +echo "automap $P: genome $glen words in a slot of $slot, $(grep -m1 '^MW' "$O/map/map.txt")" diff --git a/src/tools/build.zc b/src/tools/build.zc new file mode 100644 index 0000000..547b70f --- /dev/null +++ b/src/tools/build.zc @@ -0,0 +1,14 @@ +// compiles the rest of stdin (after the backtick) as a genome image at GORG +// and writes it to stdout as little-endian 64-bit words. +docs on; +// writes the compiled genome image to stdout as little-endian 64-bit words. +int main() { + int n = build_image_grow(GORG, 4096), i = 0, w; + while (i < n) { + w = image_words[i]; + put_c(w); put_c(w >> 8); put_c(w >> 16); put_c(w >> 24); + put_c(w >> 32); put_c(w >> 40); put_c(w >> 48); put_c(w >> 56); + i++; + } + return 0; +} diff --git a/src/tools/genmap.c b/src/tools/genmap.c new file mode 100644 index 0000000..dc1971c --- /dev/null +++ b/src/tools/genmap.c @@ -0,0 +1,858 @@ +/* one layout for every memory size. addresses in a genome are literals, so + each size is its own image. this tool writes that image's memmap.h and + the runtime (and, for a compiler build, compiler.zc) with the same const + names as the checked-in 1,048,576-word sources. + + run from the repo root: + + cc -O2 src/tools/genmap.c -o genmap + ./genmap --preset small -o build/small + ./genmap --preset run -o build/run + ./genmap --preset default --check + + ./genmap --mode compiler --heap-lo 8192 --heap 20480 --types 8192 --genome 245760 --frame 2048 --return 512 --mark 512 --data 3072 --snap-cap 1000 --quote-cap 300 -o build/small + ./genmap --mode run --words 20480 -o build/run + + --preset default puts the code area, the compiler tables, the genome and + the stacks first and the heap last, so the heap can grow at run time up to + the total memory size (PW is where the fixed part ends; the host's MW is + the total). --preset fixed is the historical 1M map (a fixed heap below + the frame pointer, types at the top of it). --mode packs from the bottom. omitting + --words rounds MW up to a multiple of 4096, which is what the arm64 jit + needs in order to encode cmp xn, #MW. the checked-in sources stay the + default map; --check fails if they drift from that preset. */ +#include +#include +#include +#include +#include +#include +#ifdef _WIN32 +#include +#endif + +static int align_up(int x, int a) { return (x + a - 1) & ~(a - 1); } + +static void die(const char *m) { fprintf(stderr, "genmap: %s\n", m); exit(1); } + +static int parse_num(const char *s) +{ + char *e; + long v; + if (!s || !*s) die("missing number"); + v = strtol(s, &e, 0); + if (*e || v <= 0 || v > 0x7fffffff) die("bad number"); + return (int)v; +} + +static char *slurp(const char *path) +{ + FILE *f = fopen(path, "rb"); + long n; char *b; + if (!f) { perror(path); exit(1); } + if (fseek(f, 0, SEEK_END) || (n = ftell(f)) < 0 || fseek(f, 0, SEEK_SET)) die("seek"); + b = malloc((size_t)n + 1); + if (!b || fread(b, 1, (size_t)n, f) != (size_t)n) die("read"); + b[n] = 0; + fclose(f); + return b; +} + +static void emit_file(const char *path, const char *s) +{ + FILE *f = fopen(path, "wb"); + if (!f) { perror(path); exit(1); } + fputs(s, f); + if (fclose(f)) die("write"); +} + +/* replace the text between the line that is `begin` and the next line that + is `end`. the marker lines stay. */ +static char *splice(const char *src, const char *begin, const char *end, const char *repl) +{ + const char *a = strstr(src, begin), *b; + char *out; size_t n, nr; + if (!a) { fprintf(stderr, "genmap: missing %s\n", begin); exit(1); } + a += strlen(begin); + if (*a == '\n') a++; + b = strstr(a, end); + if (!b) { fprintf(stderr, "genmap: missing %s\n", end); exit(1); } + nr = strlen(repl); + n = (size_t)(a - src) + nr + strlen(b) + 1; + out = malloc(n); + if (!out) die("oom"); + memcpy(out, src, (size_t)(a - src)); + memcpy(out + (a - src), repl, nr); + strcpy(out + (a - src) + nr, b); + return out; +} + +static char *replace_all(const char *src, const char *from, const char *to) +{ + const char *p = src, *hit; + size_t nf = strlen(from), nt = strlen(to), n = 0, count = 0; + char *out, *w; + while ((hit = strstr(p, from))) { count++; p = hit + nf; } + if (!count) { fprintf(stderr, "genmap: missing %s\n", from); exit(1); } + out = malloc(strlen(src) + count * (nt - nf) + 1); + if (!out) die("oom"); + p = src; w = out; + while ((hit = strstr(p, from))) { + memcpy(w, p, (size_t)(hit - p)); w += hit - p; + memcpy(w, to, nt); w += nt; + p = hit + nf; + n++; + } + strcpy(w, p); + (void)n; + return out; +} + +typedef struct { + int MW, HEAP_LO, HEAP_HI, ZFP, GORG, FBOT, FTOP, RS0, MARK0, MARKN, DSLO, DSHI; + int TW, CODE_END, GROW; /* TW: total words (MW is where the fixed map ends); CODE_END: program words end */ + int IHN, R_IH, R_POOL, R_POOLEND, NS, R_SYM; + int sname, skind, sval, ssig, sflag, sfix, snext; + int NL, lname, lslot, lhome, lstate, lowner, lused, larr, lown; + int NF, fsite, fnext, R_SNAP, R_QBUF, R_SRC, R_SEQ; + int bname, bprec, bseq, blen, uname, useq, ulen, aname, abin, kops; + int R_CTX, R_LOOP, R_ASM, cend, glen_need, typesz; + int ASM_LABELS, ASM_REFS, ASM_WORDS, EXIT_WORDS; + int ENUM_MEMBERS, TAGGED_ENUMS, STRUCT_METHODS, GENERATED_WORDS; + int RANGE_FACTS, JOIN_PATHS, O3_REGIONS; + const char *name; +} Map; + +/* what actually differs between builds. zero means "use the mode default" + except where a preset fills the field itself before layout. */ +typedef struct { + const char *name; + int compiler; + int words; + int heap_lo, heap, types, zfp_pad; + int heap_top, code_end, total; /* heap above the stacks, free to grow up to total words */ + int genome, frame, ret, mark, data; + int ihn, pool, ns, nl, nf, snap, qbuf, src, seq, ctx, loop; + int snap_cap, quote_cap; /* 0 keeps the source caps (8000 and 2700) */ + int binary, unary, assignments, keywords; + int asm_labels, asm_refs, exits; + int enum_members, tagged_enums, struct_methods, generated_words; + int facts, paths, regions; + int type_formula; /* 0 keeps ZFP-16384; else the copy says ZFP-N */ +} Spec; + +static void need(int cond, const char *m) { if (!cond) die(m); } + +static void check_common(const Map *m) +{ + need(m->MW && (m->MW % 4096) == 0, "MW must be a positive multiple of 4096"); + need(m->HEAP_LO >= 256 && m->HEAP_HI > m->HEAP_LO, "heap"); + need(m->HEAP_HI - m->HEAP_LO >= 8 && ((m->HEAP_HI - m->HEAP_LO) & 7) == 0, "heap size must be a multiple of eight words"); + if (m->GROW) { + need(m->HEAP_LO == m->MW, "a growing heap starts where the fixed map ends"); + need(m->TW >= m->HEAP_HI && (m->TW % 4096) == 0, "total memory"); + need(m->CODE_END >= 256 && m->ZFP >= m->CODE_END && m->ZFP + 8 < m->MW, "frame pointer"); + } else { +/* the historical map sets ZFP == HEAP_HI: the type area overlaps the heap */ + need(m->ZFP >= m->HEAP_HI && m->ZFP + 8 < m->MW, "frame pointer"); + } + need(m->GORG > m->ZFP + 8, "genome overlaps the frame pointer"); + need(m->GORG + m->glen_need <= m->FBOT, "genome reservation collides with the frame stack"); + need(m->FBOT + 64 < m->FTOP && m->FTOP == m->RS0, "frame stack"); + need(m->MARK0 >= m->FTOP + 64 && m->MARK0 + m->MARKN <= m->DSLO, "mark stack"); + need(m->DSHI == m->MW - 16 && m->DSHI - m->DSLO >= 1100 + 1024, "data stack"); + need(m->DSLO > m->MARK0, "data stack overlaps the mark stack"); +} + +static void tables_tight(Spec *s) +{ + s->ihn = 2048; s->pool = 16384; s->ns = 1280; s->nl = 512; s->nf = 2048; + s->snap = 1024; s->qbuf = 1024; s->src = 1024; s->seq = 1024; + s->ctx = 1024; s->loop = 512; +} + +/* the default map's tables: room for a large program and for several generic + libraries, in words nobody touches until a program needs them */ +static void tables_big(Spec *s) +{ + s->ihn = 32768; s->pool = 0x40000; s->ns = 16384; s->nl = 512; s->nf = 32768; + s->snap = 16384; s->qbuf = 16384; s->src = 1024; s->seq = 2048; + s->ctx = 2048; s->loop = 1024; +} + +static void tables_historical(Spec *s) +{ + s->ihn = 8192; s->pool = 0x9F00; s->ns = 4096; s->nl = 512; s->nf = 8192; + s->snap = 8192; s->qbuf = 8192; s->src = 1024; s->seq = 2048; + s->ctx = 2048; s->loop = 1024; +} + +static void preset_small(Spec *s) +{ + memset(s, 0, sizeof *s); + s->name = "small"; + s->compiler = 1; + s->heap_top = 1; s->code_end = 8192; s->total = 0x8000000; + s->heap_lo = 8192; s->heap = 20480; s->types = 8192; + s->genome = 245760; s->frame = 2048; s->ret = 512; s->mark = 512; s->data = 3072; + tables_tight(s); + s->snap_cap = 1000; s->quote_cap = 300; s->snap = 1000; s->qbuf = 900; s->type_formula = 8192; +} + +static void preset_run(Spec *s) +{ + memset(s, 0, sizeof *s); + s->name = "run"; + s->heap_top = 1; s->code_end = 512; s->total = 0x8000000; + s->heap_lo = 512; s->heap = 16384; s->zfp_pad = 32; + s->genome = 15600; s->frame = 1024; s->ret = 256; s->mark = 256; s->data = 2560; +} + +static void preset_default(Spec *s) +{ + memset(s, 0, sizeof *s); + s->name = "default"; + s->compiler = 1; + s->heap_top = 1; s->code_end = 0x80000; s->types = 65536; + s->heap = 0x60000; s->total = 0x8000000; + s->genome = 0x50000; s->frame = 0x40000; s->ret = 0x10000; s->mark = 0x8000; + s->data = 0x7FF0; + tables_big(s); +} + +/* the map before the heap moved to the top: a fixed heap between the code and + the frame pointer, the type records at the end of it, 1,081,344 words */ +static void preset_fixed(Spec *s) +{ + memset(s, 0, sizeof *s); + s->name = "fixed"; + s->compiler = 1; + s->words = 0x108000; + s->heap_lo = 0x40000; s->heap = 0x60000; + s->genome = 0x28000; s->frame = 0x10000; s->ret = 0x8000; s->mark = 0x4000; + tables_historical(s); +} + +/* the language server: the compiler's own growing map. the document store, the + diagnostics and the check's sets are heap blocks now, so nothing in the server + is at a fixed address and the heap grows with the documents */ +static void preset_lsp(Spec *s) +{ + preset_default(s); + s->name = "lsp"; +} + +static void mode_defaults(Spec *s, int compiler) +{ + memset(s, 0, sizeof *s); + s->name = compiler ? "compiler" : "run"; + s->compiler = compiler; + if (compiler) { + s->heap_top = 1; s->code_end = 8192; s->total = 0x8000000; + s->heap_lo = 8192; s->heap = 20480; s->types = 8192; s->type_formula = 8192; + s->genome = 245760; s->frame = 2048; s->ret = 512; s->mark = 512; s->data = 3072; + tables_tight(s); + } else { + s->heap_top = 1; s->code_end = 512; s->total = 0x8000000; + s->heap_lo = 512; s->heap = 16384; s->zfp_pad = 32; + s->genome = 15600; s->frame = 1024; s->ret = 256; s->mark = 256; s->data = 2560; + } +} + +/* pack every region from the bottom. a requested MW larger than that keeps + the same bases and gives the spare words to the data stack. */ +static void check_layout_size(const Spec *s) +{ + long long size = (s->heap_top ? s->code_end : s->heap_lo) + (long long)s->heap + s->types + s->zfp_pad; + size += (long long)s->genome + s->frame + s->ret + s->mark + s->data + 8192; + if (s->compiler) { + size += (long long)s->ihn + s->pool + 8LL * s->ns + 10LL * s->nl + 2LL * s->nf; + size += (long long)s->snap + s->qbuf + s->src + s->seq + s->ctx + s->loop; + size += 4LL * (s->binary ? s->binary : 64) + 3LL * (s->unary ? s->unary : 32); + size += 2LL * (s->assignments ? s->assignments : 64) + (s->keywords ? s->keywords : 512); + size += 2LL * (s->asm_labels ? s->asm_labels : 64) + 2LL * (s->asm_refs ? s->asm_refs : 256); + size += s->exits ? s->exits : 2560; + } + need(size <= 0x7fffffff, "layout is too large"); + if (s->words && s->heap_top) need((long long)s->words + s->heap + 4095 <= 0x7fffffff, "heap end is too large"); +} + +static void layout(const Spec *s, Map *m) +{ + int a; + check_layout_size(s); + memset(m, 0, sizeof *m); + m->name = s->name; + m->glen_need = s->genome; + m->typesz = s->types; + if (s->heap_top) { + m->GROW = 1; + m->CODE_END = s->code_end; + m->ZFP = m->CODE_END + s->types + s->zfp_pad; + } else { + m->HEAP_LO = s->heap_lo; + m->HEAP_HI = s->heap_lo + s->heap; + m->CODE_END = m->HEAP_LO; + m->ZFP = m->HEAP_HI + s->types + s->zfp_pad; + } + if (s->compiler) { + m->IHN = s->ihn; m->NS = s->ns; m->NL = s->nl; m->NF = s->nf; + a = m->ZFP + 256; + m->R_IH = a; a += m->IHN; + m->R_POOL = a; a += s->pool; m->R_POOLEND = a; a += 256; + m->R_SYM = m->sname = a; a += m->NS; + m->skind = a; a += m->NS; + m->sval = a; a += m->NS; + m->ssig = a; a += m->NS; + m->sflag = a; a += m->NS; + m->sfix = a; a += m->NS; + m->snext = a; a += m->NS; + m->lname = a; a += m->NL; + m->lslot = a; a += m->NL; + m->lhome = a; a += m->NL; + m->lstate = a; a += m->NL; + m->lowner = a; a += m->NL; + m->lused = a; a += m->NL; + m->larr = a; a += m->NL; + m->lown = a; a += m->NL; + m->fsite = a; a += m->NF; + m->fnext = a; a += m->NF; + m->R_SNAP = a; a += s->snap; + m->R_QBUF = a; a += s->qbuf; + m->R_SRC = a; a += s->src; + m->R_SEQ = a; a += s->seq; + { + int binary = s->binary ? s->binary : 64, unary = s->unary ? s->unary : 32; + int assignments = s->assignments ? s->assignments : 64, keywords = s->keywords ? s->keywords : 512; + m->bname = a; a += binary; + m->bprec = a; a += binary; + m->bseq = a; a += binary; + m->blen = a; a += binary; + m->uname = a; a += unary; + m->useq = a; a += unary; + m->ulen = a; a += unary; + m->aname = a; a += assignments; + m->abin = a; a += assignments; + a += 32; + m->kops = a; a += keywords; + } + m->R_CTX = a; a += s->ctx; + m->R_LOOP = a; a += s->loop; + m->R_ASM = a; + m->ASM_LABELS = s->asm_labels ? s->asm_labels : 64; + m->ASM_REFS = s->asm_refs ? s->asm_refs : 256; + { + long long words = 2LL * m->ASM_LABELS + 2LL * m->ASM_REFS; + need(words <= 0x7fffff00, "assembly reservation is too large"); + m->ASM_WORDS = align_up((int)words, 256); + if (!s->asm_labels && !s->asm_refs) m->ASM_WORDS = 1024; + } + m->EXIT_WORDS = s->exits ? s->exits : 2560; + m->ENUM_MEMBERS = s->enum_members ? s->enum_members : 128; + m->TAGGED_ENUMS = s->tagged_enums ? s->tagged_enums : 16; + m->STRUCT_METHODS = s->struct_methods ? s->struct_methods : 32; + m->GENERATED_WORDS = s->generated_words ? s->generated_words : 8192; + m->RANGE_FACTS = s->facts ? s->facts : 32; m->JOIN_PATHS = s->paths ? s->paths : 64; m->O3_REGIONS = s->regions ? s->regions : 10; + need(m->O3_REGIONS <= 0x7fffffff / 67, "region reservation is too large"); + need(m->ENUM_MEMBERS <= 0x10000000, "enum member reservation is too large"); + m->cend = m->R_ASM + m->ASM_WORDS + m->NL + m->NL + m->NS + m->EXIT_WORDS; + m->GORG = align_up(m->cend + 256, 256); + } else { + m->GORG = align_up(m->ZFP + 64, 256); + } + m->FBOT = m->GORG + m->glen_need; + m->FTOP = m->FBOT + s->frame; + m->RS0 = m->FTOP; + m->MARK0 = m->FTOP + s->ret; + m->MARKN = s->mark; + m->DSLO = m->MARK0 + m->MARKN; + if (s->words) { + m->MW = s->words; + m->DSHI = m->MW - 16; + if (s->data && m->DSHI - m->DSLO < s->data) die("memory size too small for the data stack"); + } else { + m->DSHI = m->DSLO + s->data; + m->MW = align_up(m->DSHI + 16, 4096); + m->DSHI = m->MW - 16; + } + m->TW = m->MW; + if (s->heap_top) { + m->HEAP_LO = m->MW; + m->HEAP_HI = m->HEAP_LO + s->heap; + m->TW = s->total > m->HEAP_HI ? s->total : align_up(m->HEAP_HI, 4096); + } + check_common(m); + if (s->types) need(m->ZFP == (s->heap_top ? m->CODE_END : m->HEAP_HI) + s->types + s->zfp_pad, "type area"); +} + +static void hexdef(char **p, char *end, const char *n, int v) +{ + int k = snprintf(*p, (size_t)(end - *p), "const %s = 0x%X;\n", n, v); + if (k < 0 || *p + k >= end) die("const block"); + *p += k; +} + +static char *rt_block(const Map *m) +{ + char buf[2048], *p = buf; + hexdef(&p, buf + sizeof buf, "MW", m->MW); + hexdef(&p, buf + sizeof buf, "CODE_END", m->CODE_END); + hexdef(&p, buf + sizeof buf, "HEAP_LO", m->HEAP_LO); + hexdef(&p, buf + sizeof buf, "HEAP_HI", m->HEAP_HI); + hexdef(&p, buf + sizeof buf, "HEAP_GROW", m->GROW); + hexdef(&p, buf + sizeof buf, "ZFP", m->ZFP); + hexdef(&p, buf + sizeof buf, "GORG", m->GORG); + hexdef(&p, buf + sizeof buf, "FBOT", m->FBOT); + hexdef(&p, buf + sizeof buf, "FTOP", m->FTOP); + hexdef(&p, buf + sizeof buf, "RS0", m->RS0); + hexdef(&p, buf + sizeof buf, "MARK0", m->MARK0); + hexdef(&p, buf + sizeof buf, "MARKN", m->MARKN); + hexdef(&p, buf + sizeof buf, "DSLO", m->DSLO); + hexdef(&p, buf + sizeof buf, "DSHI", m->DSHI); + hexdef(&p, buf + sizeof buf, "MAGIC", 0x2B7E1516); + return strdup(buf); +} + +static char *cc_block(const Map *m) +{ + char buf[4096], *p = buf; + hexdef(&p, buf + sizeof buf, "IHN", m->IHN); + hexdef(&p, buf + sizeof buf, "R_IH", m->R_IH); + hexdef(&p, buf + sizeof buf, "R_POOL", m->R_POOL); + hexdef(&p, buf + sizeof buf, "R_POOLEND", m->R_POOLEND); + hexdef(&p, buf + sizeof buf, "NS", m->NS); + hexdef(&p, buf + sizeof buf, "R_SYM", m->R_SYM); + hexdef(&p, buf + sizeof buf, "sname_BASE", m->sname); + hexdef(&p, buf + sizeof buf, "skind_BASE", m->skind); + hexdef(&p, buf + sizeof buf, "sval_BASE", m->sval); + hexdef(&p, buf + sizeof buf, "ssig_BASE", m->ssig); + hexdef(&p, buf + sizeof buf, "sflag_BASE", m->sflag); + hexdef(&p, buf + sizeof buf, "sfix_BASE", m->sfix); + hexdef(&p, buf + sizeof buf, "snext_BASE", m->snext); + hexdef(&p, buf + sizeof buf, "NL", m->NL); + hexdef(&p, buf + sizeof buf, "lname_BASE", m->lname); + hexdef(&p, buf + sizeof buf, "lslot_BASE", m->lslot); + hexdef(&p, buf + sizeof buf, "lhome_BASE", m->lhome); + hexdef(&p, buf + sizeof buf, "lstate_BASE", m->lstate); + hexdef(&p, buf + sizeof buf, "lowner_BASE", m->lowner); + hexdef(&p, buf + sizeof buf, "lused_BASE", m->lused); + hexdef(&p, buf + sizeof buf, "larr_BASE", m->larr); + hexdef(&p, buf + sizeof buf, "lown_BASE", m->lown); + hexdef(&p, buf + sizeof buf, "NF", m->NF); + hexdef(&p, buf + sizeof buf, "fsite_BASE", m->fsite); + hexdef(&p, buf + sizeof buf, "fnext_BASE", m->fnext); + hexdef(&p, buf + sizeof buf, "R_SNAP_BASE", m->R_SNAP); + hexdef(&p, buf + sizeof buf, "R_QBUF_BASE", m->R_QBUF); + hexdef(&p, buf + sizeof buf, "R_SRC_BASE", m->R_SRC); + hexdef(&p, buf + sizeof buf, "R_SEQ_BASE", m->R_SEQ); + hexdef(&p, buf + sizeof buf, "bname_BASE", m->bname); + hexdef(&p, buf + sizeof buf, "bprec_BASE", m->bprec); + hexdef(&p, buf + sizeof buf, "bseq_BASE", m->bseq); + hexdef(&p, buf + sizeof buf, "blen_BASE", m->blen); + hexdef(&p, buf + sizeof buf, "uname_BASE", m->uname); + hexdef(&p, buf + sizeof buf, "useq_BASE", m->useq); + hexdef(&p, buf + sizeof buf, "ulen_BASE", m->ulen); + hexdef(&p, buf + sizeof buf, "aname_BASE", m->aname); + hexdef(&p, buf + sizeof buf, "abin_BASE", m->abin); + hexdef(&p, buf + sizeof buf, "kops_BASE", m->kops); + hexdef(&p, buf + sizeof buf, "R_CTX_BASE", m->R_CTX); + hexdef(&p, buf + sizeof buf, "R_LOOP_BASE", m->R_LOOP); + hexdef(&p, buf + sizeof buf, "R_ASM", m->R_ASM); + hexdef(&p, buf + sizeof buf, "ASM_LABELS", m->ASM_LABELS); + hexdef(&p, buf + sizeof buf, "ASM_REFS", m->ASM_REFS); + hexdef(&p, buf + sizeof buf, "ASM_WORDS", m->ASM_WORDS); + hexdef(&p, buf + sizeof buf, "EXIT_WORDS", m->EXIT_WORDS); + hexdef(&p, buf + sizeof buf, "ENUM_MEMBERS", m->ENUM_MEMBERS); + hexdef(&p, buf + sizeof buf, "TAGGED_ENUMS", m->TAGGED_ENUMS); + hexdef(&p, buf + sizeof buf, "STRUCT_METHODS", m->STRUCT_METHODS); + hexdef(&p, buf + sizeof buf, "GENERATED_WORDS", m->GENERATED_WORDS); + hexdef(&p, buf + sizeof buf, "RANGE_FACTS", m->RANGE_FACTS); + hexdef(&p, buf + sizeof buf, "JOIN_PATHS", m->JOIN_PATHS); + hexdef(&p, buf + sizeof buf, "O3_REGIONS", m->O3_REGIONS); + return strdup(buf); +} + +static void write_memmap(const char *dir, const Map *m) +{ + char path[512], buf[4096]; + snprintf(path, sizeof path, "%s/memmap.h", dir); + snprintf(buf, sizeof buf, + "/* generated by src/tools/genmap for the %s profile. do not edit. */\n" + "#ifndef MEMMAP_H\n#define MEMMAP_H\n" + "#define PW 0x%X\n#define CODE_END 0x%X\n#define HEAP_LO 0x%X\n#define HEAP_HI 0x%X\n" + "#define HEAP_GROW %d\n" + "#ifndef MW\n#define MW 0x%X\n#endif\n" + "#if MW < HEAP_HI\n#error MW is below the end of the initial heap\n#endif\n" + "#define ZFP 0x%X\n" + "#ifdef GORG\n#if GORG != 0x%X\n#error genome GORG does not match this map\n#endif\n" + "#else\n#define GORG 0x%X\n#endif\n" + "#define FBOT 0x%X\n#define FTOP 0x%X\n#define RS0 0x%X\n" + "#define MARK0 0x%X\n#define MARKN 0x%X\n" + "#define DSLO 0x%X\n#define DSHI 0x%X\n" + "#define DS0 DSHI\n#define SYSGATE (ZFP + 2)\n" + "#define DSLIM (DSLO + 1100)\n#define RSLIM (MARK0 - 8)\n" + "#endif\n", + m->name, m->MW, m->CODE_END, m->HEAP_LO, m->HEAP_HI, m->GROW, m->TW, m->ZFP, m->GORG, m->GORG, + m->FBOT, m->FTOP, m->RS0, m->MARK0, m->MARKN, m->DSLO, m->DSHI); + emit_file(path, buf); +} + +static char *map_txt(const Map *m) +{ + char buf[2048]; + int n; + n = snprintf(buf, sizeof buf, + "profile %s\nMW %d (%lld bytes)\nprogram 0 .. %d\nheap %d .. %d (%d words)\n", + m->name, m->TW, (long long)m->TW * 8, m->CODE_END, m->HEAP_LO, m->HEAP_HI, m->HEAP_HI - m->HEAP_LO); + if (m->GROW) + n += snprintf(buf + n, sizeof buf - n, "fixed map ends at %d; the heap grows up to %d\n", m->MW, m->TW); + if (m->typesz) + n += snprintf(buf + n, sizeof buf - n, "types %d .. %d (%d words)\n", m->ZFP - m->typesz, m->ZFP, m->typesz); + n += snprintf(buf + n, sizeof buf - n, "ZFP %d SYSGATE %d\n", m->ZFP, m->ZFP + 2); + if (m->R_ASM) { + int ltype = m->R_ASM + m->ASM_WORDS; + int rexit = ltype + m->NL + m->NL + m->NS; + n += snprintf(buf + n, sizeof buf - n, + "compiler tables %d .. %d\nltype %d R_EXIT %d .. %d\n", + m->R_IH, m->cend, ltype, rexit, rexit + m->EXIT_WORDS); + } + snprintf(buf + n, sizeof buf - n, + "GORG %d reserved through %d\nframe %d .. %d\nreturn %d .. %d\nmark %d .. %d (%d)\ndata %d .. %d\n", + m->GORG, m->GORG + m->glen_need, m->FBOT, m->FTOP, m->FTOP, m->MARK0, + m->MARK0, m->MARK0 + m->MARKN, m->MARKN, m->DSLO, m->DSHI); + return strdup(buf); +} + +static void write_map_txt(const char *dir, const char *txt) +{ + char path[512]; + snprintf(path, sizeof path, "%s/map.txt", dir); + emit_file(path, txt); + fputs(txt, stderr); +} + +static void mkdir1(const char *dir) +{ +#ifdef _WIN32 + char tmp[512]; + char *p; + snprintf(tmp, sizeof(tmp), "%s", dir); + for (p = tmp; *p; p++) { + if (*p == '/' || *p == '\\') { + char save = *p; + *p = 0; + if (*tmp) _mkdir(tmp); + *p = save; + } + } + if (_mkdir(dir) && errno != EEXIST) { perror(dir); exit(1); } +#else + if (mkdir(dir, 0755) && errno != EEXIST) { perror(dir); exit(1); } +#endif +} + +static char *between(const char *src, const char *begin, const char *end) +{ + const char *a = strstr(src, begin), *b; + char *out; size_t n; + if (!a) return 0; + a += strlen(begin); + b = strstr(a, end); + if (!b || b < a) return 0; + n = (size_t)(b - a); + out = malloc(n + 1); + if (!out) die("oom"); + memcpy(out, a, n); + out[n] = 0; + return out; +} + +static int token_hex(const char *text, const char *name, int *out) +{ + const char *p = text; + size_t n = strlen(name); + while ((p = strstr(p, name))) { + int before_ok = p == text || !(isalnum((unsigned char)p[-1]) || p[-1] == '_'); + int after_ok = !(isalnum((unsigned char)p[n]) || p[n] == '_'); + if (before_ok && after_ok) { + const char *q = p + n; + while (*q == ' ' || *q == '\t') q++; + if (*q == '=') { q++; while (*q == ' ' || *q == '\t') q++; } + if (q[0] == '0' && (q[1] == 'x' || q[1] == 'X')) { + *out = (int)strtol(q, 0, 16); + return 1; + } + if (isdigit((unsigned char)*q)) { + *out = (int)strtol(q, 0, 10); + return 1; + } + } + p += n; + } + return 0; +} + +static void expect_hex(const char *text, const char *where, const char *name, int want) +{ + int got; + if (!token_hex(text, name, &got) || got != want) { + fprintf(stderr, "genmap: %s %s is 0x%X in the layout", where, name, want); + if (token_hex(text, name, &got)) fprintf(stderr, " and 0x%X in the source", got); + fprintf(stderr, "\n"); + exit(1); + } +} + +/* the lfa immediate the checked-in rt.zc carries: the default map's ZFP */ +#define DEFAULT_ZFP 589824 + +static void check_sources(const Map *m) +{ + char lfa_old[64]; + FILE *mf = fopen("memmap.h", "rb"); + const char *mm_path = mf ? (fclose(mf), "memmap.h") : "src/core/memmap.h"; + char *rt = slurp("src/runtime/rt.zc"), *cc = slurp("src/compiler/compiler.zc"), *mm = slurp(mm_path); + char *rtb = between(rt, "// @map-rt", "// @end-map"); + char *ccb = between(cc, "// @map-cc", "// @end-map"); + static const char *rt_names[] = { + "MW", "CODE_END", "HEAP_LO", "HEAP_HI", "HEAP_GROW", "ZFP", "GORG", "FBOT", "FTOP", "RS0", + "MARK0", "MARKN", "DSLO", "DSHI", "MAGIC", 0 + }; + static const char *cc_names[] = { + "IHN", "R_IH", "R_POOL", "R_POOLEND", "NS", "R_SYM", + "sname_BASE", "skind_BASE", "sval_BASE", "ssig_BASE", "sflag_BASE", "sfix_BASE", "snext_BASE", + "NL", "lname_BASE", "lslot_BASE", "lhome_BASE", "lstate_BASE", "lowner_BASE", "lused_BASE", "larr_BASE", "lown_BASE", + "NF", "fsite_BASE", "fnext_BASE", "R_SNAP_BASE", "R_QBUF_BASE", "R_SRC_BASE", "R_SEQ_BASE", + "bname_BASE", "bprec_BASE", "bseq_BASE", "blen_BASE", "uname_BASE", "useq_BASE", "ulen_BASE", "aname_BASE", "abin_BASE", "kops_BASE", + "R_CTX_BASE", "R_LOOP_BASE", "R_ASM", "ASM_LABELS", "ASM_REFS", "ASM_WORDS", "EXIT_WORDS", "ENUM_MEMBERS", "TAGGED_ENUMS", "STRUCT_METHODS", "GENERATED_WORDS", "RANGE_FACTS", "JOIN_PATHS", "O3_REGIONS", 0 + }; + int rt_vals[] = { + m->MW, m->CODE_END, m->HEAP_LO, m->HEAP_HI, m->GROW, m->ZFP, m->GORG, m->FBOT, m->FTOP, m->RS0, + m->MARK0, m->MARKN, m->DSLO, m->DSHI, 0x2B7E1516 + }; + int cc_vals[] = { + m->IHN, m->R_IH, m->R_POOL, m->R_POOLEND, m->NS, m->R_SYM, + m->sname, m->skind, m->sval, m->ssig, m->sflag, m->sfix, m->snext, + m->NL, m->lname, m->lslot, m->lhome, m->lstate, m->lowner, m->lused, m->larr, m->lown, + m->NF, m->fsite, m->fnext, m->R_SNAP, m->R_QBUF, m->R_SRC, m->R_SEQ, + m->bname, m->bprec, m->bseq, m->blen, m->uname, m->useq, m->ulen, m->aname, m->abin, m->kops, + m->R_CTX, m->R_LOOP, m->R_ASM, m->ASM_LABELS, m->ASM_REFS, m->ASM_WORDS, m->EXIT_WORDS, m->ENUM_MEMBERS, m->TAGGED_ENUMS, m->STRUCT_METHODS, m->GENERATED_WORDS, m->RANGE_FACTS, m->JOIN_PATHS, m->O3_REGIONS + }; + int i; + if (!rtb || !ccb) die("map markers missing from the checked-in sources"); + snprintf(lfa_old, sizeof lfa_old, "ld %d", DEFAULT_ZFP); + if (!strstr(rt, lfa_old)) die("src/runtime/rt.zc no longer has the default lfa immediate"); + if (!strstr(cc, "ZFP - 16384")) die("src/compiler/compiler.zc lost its initial type-area formula"); + for (i = 0; rt_names[i]; i++) expect_hex(rtb, "src/runtime/rt.zc", rt_names[i], rt_vals[i]); + for (i = 0; rt_names[i]; i++) { + if (!strcmp(rt_names[i], "MAGIC") || !strcmp(rt_names[i], "HEAP_GROW")) continue; + expect_hex(mm, mm_path, !strcmp(rt_names[i], "MW") ? "PW" : rt_names[i], rt_vals[i]); + } + if (m->R_ASM) for (i = 0; cc_names[i]; i++) expect_hex(ccb, "src/compiler/compiler.zc", cc_names[i], cc_vals[i]); + free(rt); free(cc); free(mm); free(rtb); free(ccb); +} + +static void write_sources(const char *dir, const Spec *s, const Map *m) +{ + char path[512], lfa[64], formula[64], snap[64], quote[64]; + char *rt, *block, *spliced, *done; + rt = slurp("src/runtime/rt.zc"); + block = rt_block(m); + spliced = splice(rt, "// @map-rt", "// @end-map", block); + snprintf(lfa, sizeof lfa, "ld %d", m->ZFP); + { char old[64]; snprintf(old, sizeof old, "ld %d", DEFAULT_ZFP); done = replace_all(spliced, old, lfa); } + snprintf(path, sizeof path, "%s/rt.zc", dir); + emit_file(path, done); + free(rt); free(block); free(spliced); free(done); + if (!s->compiler) return; + { + char *cc = slurp("src/compiler/compiler.zc"); + block = cc_block(m); + spliced = splice(cc, "// @map-cc", "// @end-map", block); + if (s->type_formula) { + snprintf(formula, sizeof formula, "ZFP - %d", s->type_formula); + done = replace_all(spliced, "ZFP - 16384", formula); + free(spliced); spliced = done; + } + snprintf(path, sizeof path, "%s/compiler.zc", dir); + emit_file(path, spliced); + free(cc); free(block); free(spliced); + } +} + +static void usage_status(int status) +{ + fprintf(stderr, + "usage: genmap --preset small|run|default|fixed|lsp [-o DIR] [--check]\n" + " genmap --mode compiler|run [-o DIR] [--words N] [options]\n" + " genmap small|run DIR\n" + "options:\n" + " --code N --total N --heap N --heap-lo N --types N --zfp-pad N --genome N\n" + " --frame N --return N --mark N --data N\n" + " --hash N --pool N --symbols N --locals N --fwd N\n" + " --snap N --quote N --src N --seq N --ctx N --loop N\n" + " --binary N --unary N --assignments N --keywords N\n" + " --asm-labels N --asm-refs N --exit N\n" + " --enum-members N --tagged-enums N --methods N --generated-text N\n" + " --facts N --paths N --regions N\n" + " --snap-cap N --quote-cap N --name LABEL\n" + "--preset default has a growing heap above the stacks; fixed is the old 1,081,344-word map.\n" + "--grow lets a map with a fixed size get bigger when its genome needs more room.\n" + "--mode packs a compiler or a run-only image; spare words go to the data stack.\n" + "--check compares that layout to memmap.h and the checked-in const blocks.\n"); + exit(status); +} + +static void usage(void) { usage_status(1); } + +static int take(int argc, char **argv, int *i) +{ + if (*i + 1 >= argc) usage(); + return parse_num(argv[++*i]); +} + +int main(int argc, char **argv) +{ + Spec s; Map m; + if (argc == 2 && !strcmp(argv[1], "--help")) usage_status(0); + const char *outdir = 0, *preset = 0, *mode = 0; + int check = 0, grow = 0, i, have = 0; + int total = 0, set_total = 0, set_words = 0, set_heap = 0, set_heap_lo = 0, set_types = 0, set_zfp = 0; + int code = 0, binary = 0, unary = 0, assignments = 0, keywords = 0; + int asm_labels = 0, asm_refs = 0, exits = 0; + int enum_members = 0, tagged_enums = 0, struct_methods = 0, generated_words = 0; + int facts = 0, paths = 0, regions = 0; + int set_genome = 0, set_frame = 0, set_ret = 0, set_mark = 0, set_data = 0; + int words = 0, heap = 0, heap_lo = 0, types = 0, zfp_pad = 0; + int genome = 0, frame = 0, ret = 0, mark = 0, data = 0; + int set_ihn = 0, set_pool = 0, set_ns = 0, set_nl = 0, set_nf = 0; + int set_snap = 0, set_qbuf = 0, set_src = 0, set_seq = 0, set_ctx = 0, set_loop = 0; + int set_snap_cap = 0, set_quote_cap = 0; + int ihn = 0, pool = 0, ns = 0, nl = 0, nf = 0, snap = 0, qbuf = 0, srcn = 0, seq = 0, ctx = 0, loop = 0; + int snap_cap = 0, quote_cap = 0, set_name = 0; + const char *s_name = 0; + char *txt; + + if (argc == 3 && argv[1][0] != '-' && (strcmp(argv[1], "small") == 0 || strcmp(argv[1], "run") == 0)) { + preset = argv[1]; + outdir = argv[2]; + } else { + for (i = 1; i < argc; i++) { + if (strcmp(argv[i], "--preset") == 0) { if (++i >= argc) usage(); preset = argv[i]; } + else if (strcmp(argv[i], "--mode") == 0) { if (++i >= argc) usage(); mode = argv[i]; } + else if (strcmp(argv[i], "-o") == 0 || strcmp(argv[i], "--out") == 0) { if (++i >= argc) usage(); outdir = argv[i]; } + else if (strcmp(argv[i], "--check") == 0) check = 1; + else if (strcmp(argv[i], "--grow") == 0) grow = 1; + else if (strcmp(argv[i], "--words") == 0) { words = take(argc, argv, &i); set_words = 1; } + else if (strcmp(argv[i], "--total") == 0) { total = take(argc, argv, &i); set_total = 1; } + else if (strcmp(argv[i], "--code") == 0) code = take(argc, argv, &i); + else if (strcmp(argv[i], "--binary") == 0) binary = take(argc, argv, &i); + else if (strcmp(argv[i], "--unary") == 0) unary = take(argc, argv, &i); + else if (strcmp(argv[i], "--assignments") == 0) assignments = take(argc, argv, &i); + else if (strcmp(argv[i], "--keywords") == 0) keywords = take(argc, argv, &i); + else if (strcmp(argv[i], "--asm-labels") == 0) asm_labels = take(argc, argv, &i); + else if (strcmp(argv[i], "--asm-refs") == 0) asm_refs = take(argc, argv, &i); + else if (strcmp(argv[i], "--exit") == 0) exits = take(argc, argv, &i); + else if (strcmp(argv[i], "--enum-members") == 0) enum_members = take(argc, argv, &i); + else if (strcmp(argv[i], "--tagged-enums") == 0) tagged_enums = take(argc, argv, &i); + else if (strcmp(argv[i], "--methods") == 0) struct_methods = take(argc, argv, &i); + else if (strcmp(argv[i], "--generated-text") == 0) generated_words = take(argc, argv, &i); + else if (strcmp(argv[i], "--facts") == 0) facts = take(argc, argv, &i); + else if (strcmp(argv[i], "--paths") == 0) paths = take(argc, argv, &i); + else if (strcmp(argv[i], "--regions") == 0) regions = take(argc, argv, &i); + else if (strcmp(argv[i], "--heap") == 0) { heap = take(argc, argv, &i); set_heap = 1; } + else if (strcmp(argv[i], "--heap-lo") == 0) { heap_lo = take(argc, argv, &i); set_heap_lo = 1; } + else if (strcmp(argv[i], "--types") == 0) { types = take(argc, argv, &i); set_types = 1; } + else if (strcmp(argv[i], "--zfp-pad") == 0) { zfp_pad = take(argc, argv, &i); set_zfp = 1; } + else if (strcmp(argv[i], "--genome") == 0) { genome = take(argc, argv, &i); set_genome = 1; } + else if (strcmp(argv[i], "--frame") == 0) { frame = take(argc, argv, &i); set_frame = 1; } + else if (strcmp(argv[i], "--return") == 0) { ret = take(argc, argv, &i); set_ret = 1; } + else if (strcmp(argv[i], "--mark") == 0) { mark = take(argc, argv, &i); set_mark = 1; } + else if (strcmp(argv[i], "--data") == 0) { data = take(argc, argv, &i); set_data = 1; } + else if (strcmp(argv[i], "--hash") == 0) { ihn = take(argc, argv, &i); set_ihn = 1; } + else if (strcmp(argv[i], "--pool") == 0) { pool = take(argc, argv, &i); set_pool = 1; } + else if (strcmp(argv[i], "--symbols") == 0) { ns = take(argc, argv, &i); set_ns = 1; } + else if (strcmp(argv[i], "--locals") == 0) { nl = take(argc, argv, &i); set_nl = 1; } + else if (strcmp(argv[i], "--fwd") == 0) { nf = take(argc, argv, &i); set_nf = 1; } + else if (strcmp(argv[i], "--snap") == 0) { snap = take(argc, argv, &i); set_snap = 1; } + else if (strcmp(argv[i], "--quote") == 0) { qbuf = take(argc, argv, &i); set_qbuf = 1; } + else if (strcmp(argv[i], "--src") == 0) { srcn = take(argc, argv, &i); set_src = 1; } + else if (strcmp(argv[i], "--seq") == 0) { seq = take(argc, argv, &i); set_seq = 1; } + else if (strcmp(argv[i], "--ctx") == 0) { ctx = take(argc, argv, &i); set_ctx = 1; } + else if (strcmp(argv[i], "--loop") == 0) { loop = take(argc, argv, &i); set_loop = 1; } + else if (strcmp(argv[i], "--snap-cap") == 0) { snap_cap = take(argc, argv, &i); set_snap_cap = 1; } + else if (strcmp(argv[i], "--quote-cap") == 0) { quote_cap = take(argc, argv, &i); set_quote_cap = 1; } + else if (strcmp(argv[i], "--name") == 0) { if (++i >= argc) usage(); s_name = argv[i]; set_name = 1; } + else usage(); + } + } + if (preset && mode) die("pass --preset or --mode, not both"); + if (!preset && !mode) usage(); + if (preset) { + if (strcmp(preset, "small") == 0) preset_small(&s); + else if (strcmp(preset, "run") == 0) preset_run(&s); + else if (strcmp(preset, "default") == 0) preset_default(&s); + else if (strcmp(preset, "lsp") == 0) preset_lsp(&s); + else if (strcmp(preset, "fixed") == 0) preset_fixed(&s); + else die("preset is small, run, default, fixed or lsp"); + } else { + if (strcmp(mode, "compiler") == 0) mode_defaults(&s, 1); + else if (strcmp(mode, "run") == 0) mode_defaults(&s, 0); + else die("mode is compiler or run"); + } + if (set_words) s.words = words; + if (set_total) s.total = total; + if (set_heap) s.heap = heap; + if (set_heap_lo) { s.heap_lo = heap_lo; if (s.heap_top) s.code_end = heap_lo; } + if (code) { if (s.heap_top) s.code_end = code; else s.heap_lo = code; } + s.binary = binary; s.unary = unary; s.assignments = assignments; s.keywords = keywords; + s.asm_labels = asm_labels; s.asm_refs = asm_refs; s.exits = exits; + s.enum_members = enum_members; s.tagged_enums = tagged_enums; s.struct_methods = struct_methods; s.generated_words = generated_words; + s.facts = facts; s.paths = paths; s.regions = regions; + if (set_types) { s.types = types; s.type_formula = types == 16384 ? 0 : types; } + if (set_zfp) s.zfp_pad = zfp_pad; + if (set_genome) s.genome = genome; + if (set_frame) s.frame = frame; + if (set_ret) s.ret = ret; + if (set_mark) s.mark = mark; + if (set_data) s.data = data; + if (set_ihn) s.ihn = ihn; + if (set_pool) s.pool = pool; + if (set_ns) s.ns = ns; + if (set_nl) s.nl = nl; + if (set_nf) s.nf = nf; + if (set_snap) s.snap = snap; + if (set_qbuf) s.qbuf = qbuf; + if (set_src) s.src = srcn; + if (set_seq) s.seq = seq; + if (set_ctx) s.ctx = ctx; + if (set_loop) s.loop = loop; + if (set_snap_cap) s.snap = snap_cap; + if (set_quote_cap) { if (quote_cap > 0x7fffffff / 3) die("quote size overflow"); s.qbuf = quote_cap * 3; } + if (set_name) s.name = s_name; + /* --grow: a preset with a fixed memory size gets as many words as its layout needs. the + fixed size stays when it is big enough, so a program that fits builds the same map as + before and a bigger genome moves the top of memory up instead of failing */ + if (grow && s.words) { + Spec t = s; Map probe; + t.words = 0; + if (!t.data) t.data = 16368; + layout(&t, &probe); + if (probe.MW > s.words) s.words = probe.MW; + } + if (s.compiler && (!s.ihn || !s.pool || !s.ns || !s.nl || !s.nf)) die("compiler tables are empty"); + layout(&s, &m); + txt = map_txt(&m); + if (check) check_sources(&m); + if (outdir) { + mkdir1(outdir); + write_memmap(outdir, &m); + write_map_txt(outdir, txt); + write_sources(outdir, &s, &m); + have = 1; + } + if (!have && !check) usage(); + if (check && !outdir) fputs(txt, stdout); + free(txt); + return 0; +} diff --git a/src/tools/mkgenome.c b/src/tools/mkgenome.c new file mode 100644 index 0000000..bb2e787 --- /dev/null +++ b/src/tools/mkgenome.c @@ -0,0 +1,31 @@ +/* turns a genome image (little-endian 64-bit words on stdin, as written by + src/tools/build.zc) into genome.h */ +#include +#include +#ifdef _WIN32 +#include +#include +#endif +#include "memmap.h" +int main(void) +{ +#ifdef _WIN32 + _setmode(_fileno(stdin), _O_BINARY); + _setmode(_fileno(stdout), _O_BINARY); +#endif + unsigned char b[8]; int n = 0; size_t got; + printf("#define GORG %d\nstatic const int64_t genome[] = {", GORG); + while ((got = fread(b, 1, 8, stdin)) == 8) { + uint64_t u = (uint64_t)b[0] | (uint64_t)b[1] << 8 | (uint64_t)b[2] << 16 | (uint64_t)b[3] << 24 + | (uint64_t)b[4] << 32 | (uint64_t)b[5] << 40 | (uint64_t)b[6] << 48 | (uint64_t)b[7] << 56; + if ((n == 0 && u != (uint64_t)FTOP * 2 + 1) || + (n == 1 && u != (uint64_t)ZFP * 2 + 1) || (n == 2 && u != 4)) { + fprintf(stderr, "mkgenome: input is not a genome for this map\n"); return 1; + } + printf("%s%lld", !n ? "\n" : n % 12 ? "," : ",\n", (long long)u); + n++; + } + if (got || ferror(stdin) || n < 7) { fprintf(stderr, "mkgenome: incomplete genome\n"); return 1; } + printf("\n};\n#define GLEN %d\n", n); + return n ? 0 : 1; +} diff --git a/src/tools/mklsp.sh b/src/tools/mklsp.sh new file mode 100755 index 0000000..5edf14a --- /dev/null +++ b/src/tools/mklsp.sh @@ -0,0 +1,14 @@ +#!/bin/bash +# builds the language server: src/tools/mklsp.sh [outdir] leaves outdir/zclsp. +# the server is the real compiler (src/compiler/compiler.zc) in check mode plus +# src/lsp/server.zc. its memory map is sized to that program by src/tools/automap.sh, +# so the genome slot is as big as it needs to be and no bigger. +set -e +cd "$(dirname "$0")/../.." +O=${1:-build/lsp}; CC=${CC:-gcc} +# DOCS=1: the image carries the doc comments, so hover can show what a name is for +DOCS=1 bash src/tools/automap.sh lsp "$O" src/lsp/server.zc >/dev/null +rm -rf "$O/src"; mkdir -p "$O/src" +cp src/core/core.c src/core/io_linux.c src/core/fops.h src/core/bops.h src/core/stack.h "$O/memmap.h" "$O/src/" +cp "$O/genome.h" "$O/src/lsp_genome.h" +$CC -O2 -w -fwrapv -DJTYPE=int -DZY_SANDBOX -DUSE_LSP_GENOME "$O/src/core.c" "$O/src/io_linux.c" -I"$O/src" -o "$O/zclsp" diff --git a/src/tools/mklspwasm.sh b/src/tools/mklspwasm.sh new file mode 100755 index 0000000..56ba43b --- /dev/null +++ b/src/tools/mklspwasm.sh @@ -0,0 +1,20 @@ +#!/bin/bash +# builds the language server as WebAssembly: editors/vscode/server/lsp.wasm by +# default, or the path given as the first argument. the server is the compiler +# and src/lsp/server.zc on the map and genome that src/tools/mklsp.sh made in build/lsp, +# and the microcore (src/micro/micro.c) runs them. the host is client/wasmproc.js. +# needs clang with the wasm32 target and wasm-ld; run src/tools/mklsp.sh first. +# src/tools/mklspwasm.sh [outfile.wasm] +set -e +cd "$(dirname "$0")/../.." +OUT=${1:-editors/vscode/server/lsp.wasm} +LSP_BUILD_DIR=${LSP_BUILD_DIR:-build/lsp} +if [ "${LSP_REUSE_BUILD:-0}" != 1 ]; then bash src/tools/mklsp.sh "$LSP_BUILD_DIR" >/dev/null; fi +[ -f "$LSP_BUILD_DIR/src/lsp_genome.h" ] || { echo "mklspwasm: no language server image in $LSP_BUILD_DIR" >&2; exit 1; } +clang --target=wasm32 -O2 -w -fwrapv -nostdlib -fno-builtin -mbulk-memory -DJTYPE=int -DUSE_LSP_GENOME \ + -I"$LSP_BUILD_DIR/src" -Isrc/micro src/micro/micro.c src/micro/port_wasm_stream.c \ + -Wl,--no-entry -Wl,--export=wasm_chunk -Wl,--export=wasm_chunk_cap -Wl,--export=wasm_feed \ + -Wl,--export=wasm_close -Wl,--export=wasm_start -Wl,--export=wasm_resume \ + -Wl,--export=memory -Wl,--allow-undefined -Wl,--initial-memory=41943040 -Wl,-z,stack-size=65536 \ + -o "$OUT" +ls -l "$OUT" diff --git a/src/tools/mkvsix.sh b/src/tools/mkvsix.sh new file mode 100755 index 0000000..5ca8ef5 --- /dev/null +++ b/src/tools/mkvsix.sh @@ -0,0 +1,35 @@ +#!/bin/bash +# builds the vs code extension, with the language server inside it: the tinyvm +# javascript vm (src/js/tinyvm.js, compiled from src/js/tinyvm.ts) and the server's image +# (src/js/lsp.json, from build/lsp/genome.h and its map), and the wasm server +# (src/tools/mklspwasm.sh) when clang can build it. needs node and tsc; the +# server build (src/tools/mklsp.sh) runs first if build/lsp is missing. +# src/tools/mkvsix.sh [outfile.vsix] +set -e +cd "$(dirname "$0")/../.." +OUT=${1:-$PWD/build/zc-language-support.vsix} +case "$OUT" in /*) ;; *) OUT="$PWD/$OUT" ;; esac +mkdir -p "$(dirname "$OUT")" +bash src/tools/mklsp.sh build/lsp >/dev/null +# typescript errors stop packaging, so broken generated code is never shipped. +command -v tsc >/dev/null || { echo "mkvsix: tsc is not installed" >&2; exit 1; } +tsc src/js/tinyvm.ts --target es2020 --lib es2020,dom --module commonjs --outDir src/js +node src/js/extract_lsp.js +mkdir -p editors/vscode/server +cp src/js/tinyvm.js src/js/layout.js src/js/lsp.json editors/vscode/server/ +# the wasm server runs when it is there; without clang the vm server is packed alone +if command -v clang >/dev/null && clang --print-targets | grep -q wasm32; then + LSP_BUILD_DIR=build/lsp LSP_REUSE_BUILD=1 bash src/tools/mklspwasm.sh editors/vscode/server/lsp.wasm +else + rm -f editors/vscode/server/lsp.wasm + echo "no clang with wasm32: packing the javascript vm server only" >&2 +fi +cd editors/vscode +if [ -n "${VSCE:-}" ]; then + "$VSCE" package --allow-missing-repository --skip-license -o "$OUT" >/dev/null +elif command -v vsce >/dev/null; then + vsce package --allow-missing-repository --skip-license -o "$OUT" >/dev/null +else + npx -y @vscode/vsce package --allow-missing-repository --skip-license -o "$OUT" >/dev/null +fi +echo "$OUT" diff --git a/src/tools/zc0.c b/src/tools/zc0.c new file mode 100644 index 0000000..5ef5737 --- /dev/null +++ b/src/tools/zc0.c @@ -0,0 +1,880 @@ +/* zc0: stage 0 of the bootstrap. a small c compiler for the subset of zc that + compiler.zc is written in. it reads zc source on stdin and writes a genome + header (vm words placed at GORG) on stdout, in the same image layout the + resident compiler's image mode produces. no lifetime analysis, no quote, no + parse words, no block expressions: those only exist in compiler.zc. tags + (m, d, -> u) and casts (as u, as d) are parsed and recorded in signatures + but not checked. */ +#include +#include +#include +#include +#include +#ifdef _WIN32 +#include +#include +#endif +#include "memmap.h" +#include "fops.h" + +#ifndef MAXW +#define MAXW 0x80000 +#endif + +enum { T_EOF, T_NUM, T_ID, T_STR, T_OP, T_FLT, T_BSTR }; +enum { K_FN = 1, K_GVAR, K_GARR, K_CONST, K_KW, K_ENH, K_TYPE, K_DOC }; +enum { O_Q, O_LD, O_ST, O_PICK, O_DROP, O_SWAP, O_CALL, O_JMP, O_JZ, O_RET, + O_IN, O_EMPTY, O_OUT, O_ADD, O_SUB, O_MUL, O_AND, O_OR, O_XOR, O_SHR, O_LT }; +static const char *mn = "q@!$_~cjzr,?.+-*&|^><%"; + +static char *src; static int pos, line = 1, tstart, hdr_start; +/* the signature of the function being defined: its header's source text, for the language server (ZC0DOCS) */ +static char sgtext[400], sgname[80]; +static int tk, glue; static int64_t tv; static char ts[4096]; /* current token */ +static int xf, xs, lvi; /* float, byte string; the plain local it came from, or -1 */ + +static int64_t *img; static int imgcap, here = GORG; +static void emit(int64_t w) { + if (!img || here - GORG >= imgcap) { + int capacity; int64_t *next; + if (imgcap > (0x7fffffff - GORG) / 2) { fprintf(stderr, "zc0: image address overflow\n"); exit(1); } + capacity = imgcap ? imgcap * 2 : MAXW; + if (capacity <= imgcap || capacity > 0x7fffffff - GORG) { fprintf(stderr, "zc0: image address overflow\n"); exit(1); } + next = realloc(img, (size_t)capacity * sizeof *img); + if (!next) { fprintf(stderr, "zc0: cannot grow image buffer\n"); exit(1); } + img = next; imgcap = capacity; + } + img[here++ - GORG] = w; +} +static void lit(int64_t v) { + if ((v >> 62) != 0 && (v >> 62) != -1) { + emit((v >> 32) * 2 + 1); emit(0x100000000LL * 2 + 1); emit(O_MUL * 2); + emit((int64_t)((uint64_t)v & 0xffffffffu) * 2 + 1); emit(O_OR * 2); + } else emit(v * 2 + 1); +} +static void op(int k) { emit((int64_t)k * 2); } +static void setlit(int at, int64_t v) { img[at - GORG] = v * 2 + 1; } + +static int pguess, pbad; /* inside a speculative type parse: an error is noted instead of stopping */ +static void die(const char *m) { if (pguess) { pbad = 1; return; } fprintf(stderr, "zc0: line %d: %s (at '%s')\n", line, m, ts); exit(1); } + +/* ---- lexer ---- */ +static const char *ops3[] = { "<<=", ">>=", 0 }; +static const char *ops2[] = { "==", "!=", "<=", ">=", "<<", ">>", "&&", "||", "++", "--", "+=", "-=", "*=", "/=", "%=", "&=", "|=", "^=", "->", 0 }; +static int esc(void) +{ + int c = src[pos++]; + if (c != '\\') return c; + c = src[pos++]; + switch (c) { case 'n': return 10; case 't': return 9; case 'r': return 13; case '0': return 0; case 'e': return 27; } + return c; +} +/* doc comments, as the self-hosted compiler reads them with docs on: the // + lines directly above a declaration, up to a blank line or any other text */ +static char dbuf[2100], dsnap[2100], dnm[64]; static int dn, dlast, dline, dsn, docpending; +static void doccomment(void) /* pos is on the first slash */ +{ + int cl = line, k = pos - 1, bol; + while (k >= 0 && (src[k] == ' ' || src[k] == '\t')) k--; + bol = k < 0 || src[k] == '\n'; + pos += 2; + if (!bol) { while (src[pos] && src[pos] != '\n') pos++; return; } + if (dn && dlast != cl - 1) dn = 0; + if (src[pos] == ' ') pos++; + while (src[pos] && src[pos] != '\n') { if (dn < 2040) dbuf[dn++] = src[pos]; pos++; } + while (dn && (dbuf[dn - 1] == ' ' || dbuf[dn - 1] == '\t' || dbuf[dn - 1] == '\r')) dn--; + dbuf[dn++] = '\n'; + dlast = cl; docpending = 1; +} +/* block comments may document a declaration on the same line */ +static void docblock(void) +{ + int cl = line, k = pos - 1, bol, start = 1, c; + while (k >= 0 && (src[k] == ' ' || src[k] == '\t')) k--; + bol = k < 0 || src[k] == '\n'; + if (!bol || (dn && dlast != cl - 1)) dn = 0; + pos += 2; + if (src[pos] == '*') { pos++; if (src[pos] == '/') { pos++; return; } } + while (src[pos]) { + if (start) { + while (src[pos] == ' ' || src[pos] == '\t') pos++; + if (src[pos] == '*') { + pos++; + if (src[pos] == '/') { pos++; break; } + if (src[pos] == ' ') pos++; + } + start = 0; + } + c = src[pos++]; + if (c == '*' && src[pos] == '/') { pos++; break; } + if (dn < 2040) dbuf[dn++] = (char)c; + if (c == '\n') { line++; start = 1; } + } + while (dn && (dbuf[dn - 1] == ' ' || dbuf[dn - 1] == '\t' || dbuf[dn - 1] == '\r' || dbuf[dn - 1] == '\n')) dn--; + dbuf[dn++] = '\n'; dlast = line; docpending = 1; +} +static void next(void) +{ + int ws = 0, i; + for (;;) { + while (src[pos] && isspace((unsigned char)src[pos])) { if (src[pos] == '\n') line++; pos++; ws = 1; } + if (src[pos] == '/' && src[pos + 1] == '/') { doccomment(); ws = 1; continue; } + if (src[pos] == '/' && src[pos + 1] == '*') { docblock(); ws = 1; continue; } + break; + } + glue = !ws; + tstart = pos; + if (docpending) { + dline = 0; + if (dn && (line == dlast || line == dlast + 1)) dline = line; + docpending = 0; + } + if (!src[pos] || src[pos] == '`') { tk = T_EOF; strcpy(ts, ""); return; } + if (isdigit((unsigned char)src[pos]) || (src[pos] == '.' && isdigit((unsigned char)src[pos + 1]))) { + int p = pos, fl = 0; + if (src[pos] == '0' && (src[pos + 1] == 'x' || src[pos + 1] == 'X')) { + char *e; tv = (int64_t)strtoll(src + pos, &e, 0); memcpy(ts, src + pos, e - src - pos); ts[e - src - pos] = 0; pos = e - src; tk = T_NUM; return; + } + if (src[p] == '.') { + int nch = (unsigned char)src[p + 1]; + if (isdigit(nch) || nch == 'e' || nch == 'E' || !(isalpha(nch) || nch == '_')) fl = 1; + } else { + while (isdigit((unsigned char)src[p])) p++; + if (src[p] == '.') { + int nch = (unsigned char)src[p + 1]; + /* 1.5 and 1. and 1.e2 are floats. 1.field is an integer and a field. */ + if (isdigit(nch) || nch == 'e' || nch == 'E' || !(isalpha(nch) || nch == '_')) fl = 1; + } + } + if (!fl && (src[p] == 'e' || src[p] == 'E')) { + int q = p + 1; if (src[q] == '+' || src[q] == '-') q++; if (isdigit((unsigned char)src[q])) fl = 1; + } + if (fl) { + char b[80]; int n = 0, frac = 0; + while (src[pos] == '.' || isdigit((unsigned char)src[pos])) { + if (src[pos] == '.') { if (frac) break; frac = 1; } + if (n < 78) b[n++] = src[pos]; + pos++; + } + if (src[pos] == 'e' || src[pos] == 'E') { + int q = pos + 1; if (src[q] == '+' || src[q] == '-') q++; + if (isdigit((unsigned char)src[q])) { + if (n < 78) b[n++] = src[pos++]; + if (src[pos] == '+' || src[pos] == '-') { if (n < 78) b[n++] = src[pos++]; } + while (isdigit((unsigned char)src[pos]) && n < 78) b[n++] = src[pos++]; + } + } + b[n] = 0; memcpy(ts, b, (size_t)n + 1); tv = (int64_t)fop_parse(b); tk = T_FLT; return; + } + { char *e; tv = (int64_t)strtoll(src + pos, &e, 0); memcpy(ts, src + pos, e - src - pos); ts[e - src - pos] = 0; pos = e - src; tk = T_NUM; return; } + } + if (isalpha((unsigned char)src[pos]) || src[pos] == '_') { + i = 0; while (isalnum((unsigned char)src[pos]) || src[pos] == '_') ts[i++] = src[pos++]; + ts[i] = 0; + if (i == 1 && ts[0] == 'b' && src[pos] == '"') { + pos++; i = 0; + while (src[pos] && src[pos] != '"' && i < 4095) ts[i++] = (char)esc(); + ts[i] = 0; if (src[pos] == '"') pos++; tk = T_BSTR; return; + } + tk = T_ID; return; + } + if (src[pos] == '\'') { pos++; tv = esc(); if (src[pos++] != '\'') die("bad char literal"); tk = T_NUM; strcpy(ts, "'c'"); return; } + if (src[pos] == '"') { pos++; i = 0; while (src[pos] && src[pos] != '"') ts[i++] = (char)esc(); ts[i] = 0; pos++; tk = T_STR; return; } + tk = T_OP; + for (i = 0; ops3[i]; i++) if (!strncmp(src + pos, ops3[i], 3)) { strcpy(ts, ops3[i]); pos += 3; return; } + for (i = 0; ops2[i]; i++) if (!strncmp(src + pos, ops2[i], 2)) { strcpy(ts, ops2[i]); pos += 2; return; } + ts[0] = src[pos++]; ts[1] = 0; +} +typedef struct { char *src; int pos, line, tk, glue; int64_t tv; char ts[4096]; int xf, xs; } Lex; +static void lexsave(Lex *L) { L->src = src; L->pos = pos; L->line = line; L->tk = tk; L->glue = glue; L->tv = tv; memcpy(L->ts, ts, sizeof ts); L->xf = xf; L->xs = xs; } +static void lexrest(Lex *L) { src = L->src; pos = L->pos; line = L->line; tk = L->tk; glue = L->glue; tv = L->tv; memcpy(ts, L->ts, sizeof ts); xf = L->xf; xs = L->xs; } +static int is(const char *s) { return (tk == T_OP || tk == T_ID) && !strcmp(ts, s); } +static int accept(const char *s) { if (is(s)) { next(); return 1; } return 0; } +static void expect(const char *s) { if (!accept(s)) { char b[64]; sprintf(b, "expected '%s'", s); die(b); } } +static char *ident(void) { static char b[8][256]; static int k; char *r = b[k++ & 7]; if (tk != T_ID) die("expected a name"); strcpy(r, ts); next(); return r; } + +/* ---- symbols ---- */ +typedef struct { char name[64]; int kind, sig, defd; int64_t val; } Sym; +static Sym sy[16384]; static int nsy; +typedef struct { int at, sym; } Fix; +static Fix fx[65536]; static int nfx; +static Sym *find(const char *n) { int i; for (i = nsy; i--;) if (!strcmp(sy[i].name, n)) return &sy[i]; return 0; } +static Sym *add(const char *n, int kind, int64_t val) +{ + Sym *s = find(n); + if (s && s->kind == K_FN && kind == K_FN && !s->defd) { s->val = val; return s; } /* prototype or forward use */ + s = &sy[nsy++]; strncpy(s->name, n, 63); s->kind = kind; s->val = val; s->defd = 1; s->sig = 0; return s; +} +static void fnref(const char *n) /* push a function address, fixing it up later if needed */ +{ + Sym *s = find(n); + if (!s) { s = add(n, K_FN, 0); s->defd = 0; } + if (s->kind != K_FN) die("not a function"); + if (s->defd) { lit(s->val); return; } + fx[nfx].at = here; fx[nfx++].sym = (int)(s - sy); lit(0); +} + +/* ---- locals ---- */ +typedef struct { char name[64]; int slot, arr, flt, str; } Loc; +static Loc lo[1024]; static int nlo, nslot, infn; +static Loc *findl(const char *n) { int i; for (i = nlo; i--;) if (!strcmp(lo[i].name, n)) return &lo[i]; return 0; } +static void laddr(int k) { lit(ZFP); op(O_LD); if (k) { lit(k); op(O_ADD); } } + +/* ---- operator tables ---- */ +static void seq_isz(void) { lit(0); op(O_PICK); lit(0); op(O_SWAP); op(O_SUB); op(O_OR); lit(63); op(O_SHR); lit(1); op(O_ADD); } +/* ±0 is false. a float becomes 0 or 1 before the integer test. */ +static void ftest(void) { if (!xf) return; emit(1200); emit(0); op(605); lit(1); op(18); xf = 0; } +static void seq_nz(void) { lit(0); op(O_PICK); lit(0); op(O_SWAP); op(O_SUB); op(O_OR); lit(63); op(O_SHR); lit(0); op(O_SWAP); op(O_SUB); } +static int binprec(void) +{ + static const char *n[] = { "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=", ">=", "==", "!=", "&", "^", "|", "&&", "||", 0 }; + static int p[] = { 10, 10, 10, 9, 9, 8, 8, 7, 7, 7, 7, 6, 6, 5, 4, 3, 2, 1 }; + int i; + if (tk != T_OP) return 0; + for (i = 0; n[i]; i++) if (!strcmp(ts, n[i])) return p[i]; + return 0; +} +static int fis(const char *o) +{ + return !strcmp(o, "+") || !strcmp(o, "-") || !strcmp(o, "*") || !strcmp(o, "/") + || !strcmp(o, "<") || !strcmp(o, ">") || !strcmp(o, "<=") || !strcmp(o, ">=") + || !strcmp(o, "==") || !strcmp(o, "!="); +} +static void fbinop(const char *o, int lf, int rf) +{ + if (!lf) { op(O_SWAP); op(608); op(O_SWAP); } + if (!rf) op(608); + if (!strcmp(o, "+")) { op(601); xf = 1; } + else if (!strcmp(o, "-")) { op(602); xf = 1; } + else if (!strcmp(o, "*")) { op(603); xf = 1; } + else if (!strcmp(o, "/")) { op(604); xf = 1; } + else if (!strcmp(o, "==")) { op(605); xf = 0; } + else if (!strcmp(o, "!=")) { op(605); lit(1); op(18); xf = 0; } + else if (!strcmp(o, "<")) { op(606); xf = 0; } + else if (!strcmp(o, ">")) { op(O_SWAP); op(606); xf = 0; } + else if (!strcmp(o, "<=")) { op(607); xf = 0; } + else if (!strcmp(o, ">=")) { op(O_SWAP); op(607); xf = 0; } + else xf = 0; +} +static int sis(const char *o) +{ + return !strcmp(o, "+") || !strcmp(o, "<") || !strcmp(o, ">") || !strcmp(o, "<=") + || !strcmp(o, ">=") || !strcmp(o, "==") || !strcmp(o, "!="); +} +static void sbinop(const char *o) +{ + if (!strcmp(o, "+")) { fnref("cat_s"); op(O_CALL); xs = 1; } + else if (!strcmp(o, "==")) { fnref("eq_s"); op(O_CALL); xs = 0; } + else if (!strcmp(o, "!=")) { fnref("eq_s"); op(O_CALL); lit(1); op(O_XOR); xs = 0; } + else if (!strcmp(o, "<")) { fnref("lt_s"); op(O_CALL); xs = 0; } + else if (!strcmp(o, ">")) { op(O_SWAP); fnref("lt_s"); op(O_CALL); xs = 0; } + else if (!strcmp(o, "<=")) { fnref("le_s"); op(O_CALL); xs = 0; } + else { op(O_SWAP); fnref("le_s"); op(O_CALL); xs = 0; } + xf = 0; +} +static void binop(const char *o) +{ + if (!strcmp(o, "*")) op(O_MUL); + else if (!strcmp(o, "/")) { fnref("zdiv"); op(O_CALL); } + else if (!strcmp(o, "%")) { fnref("zmod"); op(O_CALL); } + else if (!strcmp(o, "+")) op(O_ADD); + else if (!strcmp(o, "-")) op(O_SUB); + else if (!strcmp(o, "<<")) { fnref("zshl"); op(O_CALL); } + else if (!strcmp(o, ">>")) op(O_SHR); + else if (!strcmp(o, "<")) op(O_LT); + else if (!strcmp(o, ">")) { op(O_SWAP); op(O_LT); } + else if (!strcmp(o, "<=")) { op(O_SWAP); op(O_LT); lit(1); op(O_XOR); } + else if (!strcmp(o, ">=")) { op(O_LT); lit(1); op(O_XOR); } + else if (!strcmp(o, "==")) { op(O_SUB); seq_isz(); } + else if (!strcmp(o, "!=")) { op(O_SUB); seq_nz(); } + else if (!strcmp(o, "&")) op(O_AND); + else if (!strcmp(o, "^")) op(O_XOR); + else if (!strcmp(o, "|")) op(O_OR); + else die("bad operator"); +} + +/* ---- constant expressions (globals, array sizes, const) ---- */ +static int64_t cexpr(void); +static int64_t cprim(void) +{ + int64_t v; Sym *s; + if (tk == T_NUM) { v = tv; next(); return v; } + if (accept("-")) return -cprim(); + if (accept("~")) return ~cprim(); + if (accept("(")) { v = cexpr(); expect(")"); return v; } + if (tk == T_ID && (s = find(ts)) && (s->kind == K_CONST || (s->kind != K_GVAR && s->defd))) { next(); return s->val; } + die("constant expected"); return 0; +} +static int64_t cexpr(void) +{ + int64_t v = cprim(); + for (;;) { + if (accept("+")) v += cprim(); else if (accept("-")) v -= cprim(); + else if (accept("*")) v *= cprim(); else if (accept("|")) v |= cprim(); + else if (accept("&")) v &= cprim(); else if (accept("<<")) v <<= cprim(); + else if (accept(">>")) v >>= cprim(); else return v; + } +} + +/* ---- types ---- + zc0 has no types: a type is read and thrown away. all it has to know is the + shape, so that [n]T still reserves n words and the rest reserve one. the + grammar is the compiler's own (see ptype in compiler.zc): + ptype a type, then any number of (params): int(int, int) is a function type + ptype0 a type with its stars: int*, vec*, point** + ptype1 a base: [n]T, []T, fixed []T, fn, a name, or a generic instance + each returns the words a variable of the type takes: n for a fixed array, 1 + for a growable handle or anything scalar. */ +static int ptype0(void); +static int ptype(void); +static int ptype1(void) +{ + int n, e; + if (accept("[")) { + if (accept("]")) { ptype0(); return 1; } /* []T is a handle */ + n = (int)cexpr(); expect("]"); + e = ptype0(); + return n > 0 ? n * e : e; + } + if (is("fixed")) { next(); return ptype0(); } + if (is("fn")) { next(); return 1; } /* fn(int): the parameters follow, in ptype */ + if (tk != T_ID) { die("a type name"); return 1; } + ident(); + if (accept("<")) { /* generic arguments: vec */ + do { ptype(); } while (accept(",")); + if (is(">>")) ts[1] = 0; /* >> closes two lists: leave the second > */ + else expect(">"); + } + return 1; +} +static int ptype0(void) +{ + int n = ptype1(); + while (accept("*")) n = 1; + return n; +} +static int ptype(void) +{ + int n = ptype0(); + while (accept("(")) { + if (!accept(")")) { do { ptype(); } while (accept(",")); expect(")"); } + n = 1; + } + return n; +} +/* the ownership tag after a type, .u .m or .d: 0 when there is none */ +static int ptag; +static void ptagopt(void) +{ + ptag = 0; + if (!accept(".")) return; + if (is("m")) ptag = 1; else if (is("d")) ptag = 2; else if (is("u")) ptag = 3; else die("a tag is .u, .m or .d"); + next(); +} +/* an optional type in front of a name. the words it needs, or -1 when there is + no type here at all, which is how an untyped name is told from a type. the + parse is taken back when what follows is not a name. */ +/* words that open a statement or an expression, so a type never starts with + one of them. they are all plain identifiers to the lexer. */ +static int notatype(void) +{ + static const char *w[] = { "return", "if", "else", "while", "for", "do", "break", "continue", + "let", "var", "fn", "const", "enhance", "struct", "enum", "asm", "switch", "case", + "default", "immediate", "type", "include", "as", "in", "new", "sizeof", "typeof", + "o3", "unchecked", 0 }; + int i; + if (tk != T_ID) return 0; + for (i = 0; w[i]; i++) if (!strcmp(ts, w[i])) return 1; + return 0; +} +static int optype(void) +{ + Lex L; int n; + if (notatype() || (tk != T_ID && !is("["))) return -1; + lexsave(&L); pguess = 1; pbad = 0; n = ptype(); ptagopt(); pguess = 0; + if (tk == T_ID && !pbad) return n; + lexrest(&L); + return -1; +} +/* a name followed by ( : a function definition rather than a variable */ +static int isfn(void) +{ + Lex L; int r; + lexsave(&L); pguess = 1; + r = tk == T_ID; + if (r) { ident(); r = is("("); } + pguess = 0; lexrest(&L); + return r; +} + +/* ---- expressions ---- */ +static int lv; /* the stack top is an address not yet loaded */ +static void rval(void) { if (lv) { op(O_LD); lv = 0; } } +static void expr(void); +static void strlit(void) /* inline word string: jump over it, push its address */ +{ + int j = here, a, i, n = (int)strlen(ts); + lit(0); op(O_JMP); a = here; + for (i = 0; i < n; i++) emit((unsigned char)ts[i]); + emit(0); setlit(j, here); lit(a); next(); +} +/* b"...": length word, then bytes packed 8 per word, little-endian, plus a 0 */ +static void bstrlit(void) +{ + int j = here, a, i = 0, k, n = (int)strlen(ts); + uint64_t w; + lit(0); op(O_JMP); a = here; + emit(n); + while (i < n) { + w = 0; k = 0; + while (k < 8 && i < n) { w |= (uint64_t)(unsigned char)ts[i] << (k * 8); k++; i++; } + emit((int64_t)w); + } + if ((n & 7) == 0) emit(0); + setlit(j, here); lit(a); next(); +} +static int returns_bstr(const char *n) +{ + return !strcmp(n, "cat_s") || !strcmp(n, "slice_s") || !strcmp(n, "n_to_s") || !strcmp(n, "new_s"); +} +static int args(void) { int n = 0; expect("("); if (!accept(")")) { do { expr(); rval(); n++; } while (accept(",")); expect(")"); } return n; } +static void asmblock(void); +static void primary(void) +{ + char n[64]; Loc *l; Sym *s; + lv = 0; lvi = -1; xf = 0; xs = 0; + if (tk == T_FLT) { emit(1200); emit(tv); xf = 1; next(); return; } + if (tk == T_NUM) { lit(tv); next(); return; } + if (tk == T_BSTR) { bstrlit(); xs = 1; return; } + if (tk == T_STR) { strlit(); return; } + if (accept("(")) { expr(); expect(")"); return; } + if (is("asm")) { next(); asmblock(); return; } + strcpy(n, ident()); + if ((l = findl(n))) { laddr(l->slot); lv = !l->arr; if (!l->arr) { xf = l->flt; xs = l->str; lvi = (int)(l - lo); } return; } + s = find(n); + if (s && s->kind == K_CONST) { lit(s->val); return; } + if (s && s->kind == K_GVAR) { lit(s->val); lv = 1; return; } + if (s && s->kind == K_GARR) { lit(s->val); return; } + if (is("(")) { + int na = args(); + if (!strcmp(n, "put_s") && na == 1 && xs) fnref("put_bs"); + else if (!strcmp(n, "len")) fnref("len_s"); + else fnref(n); + op(O_CALL); + xs = returns_bstr(n); xf = 0; + return; + } + fnref(n); +} +static void incdec(int post, int d) +{ + if (!lv) die("++/-- needs an lvalue"); + lv = 0; + if (lvi >= 0) lo[lvi].str = 0; + xs = 0; + if (post) { lit(0); op(O_PICK); op(O_LD); lit(0); op(O_PICK); lit(d); op(O_ADD); lit(2); op(O_PICK); op(O_ST); op(O_SWAP); op(O_DROP); } + else { lit(0); op(O_PICK); op(O_LD); lit(d); op(O_ADD); lit(0); op(O_PICK); lit(2); op(O_PICK); op(O_ST); op(O_SWAP); op(O_DROP); } +} +static void postfix(void) +{ + int n, was; + primary(); + for (;;) { + if (accept("[")) { + was = xs; rval(); expr(); rval(); + if (was && accept(":")) { + expr(); rval(); expect("]"); fnref("slice_s"); op(O_CALL); + lv = 0; xs = 1; xf = 0; lvi = -1; + } else if (was) { + expect("]"); fnref("at_s"); op(O_CALL); + lv = 0; xs = 0; xf = 0; lvi = -1; + } else { expect("]"); op(O_ADD); lv = 1; xs = 0; xf = 0; lvi = -1; } + } + else if (is("(")) { rval(); n = args(); lit(n); op(O_PICK); op(O_CALL); op(O_SWAP); op(O_DROP); xf = 0; xs = 0; lvi = -1; } + else if (accept("++")) incdec(1, 1); + else if (accept("--")) incdec(1, -1); + else if (accept("as")) ident(); + else return; + } +} +static void unary(void) +{ + if (accept("-")) { + unary(); rval(); xs = 0; + if (xf) { emit(1200); emit(0); op(O_SWAP); op(602); } + else { lit(0); op(O_SWAP); op(O_SUB); } + } + else if (accept("!")) { unary(); rval(); ftest(); seq_isz(); xf = 0; xs = 0; } + else if (accept("~")) { unary(); rval(); lit(-1); op(O_XOR); xf = 0; xs = 0; } + else if (accept("*")) { unary(); rval(); lv = 1; xs = 0; } + else if (accept("&")) { unary(); if (!lv) die("& needs an lvalue"); lv = 0; xs = 0; } + else if (accept("++")) { unary(); incdec(0, 1); } + else if (accept("--")) { unary(); incdec(0, -1); } + else if (tk == T_ID && (!strcmp(ts, "u") || !strcmp(ts, "m") || !strcmp(ts, "d"))) { next(); expect("*"); unary(); } /* u*x: a recast, no code */ + else postfix(); +} +static void bin(int minp) +{ + int p, a, b, lf, rf, ls, rs; char o[8]; + unary(); + while ((p = binprec()) && p >= minp) { + lf = xf; ls = xs; strcpy(o, ts); next(); rval(); + if (!strcmp(o, "&&")) { + ftest(); a = here; lit(0); op(O_JZ); bin(p + 1); rval(); ftest(); seq_nz(); + b = here; lit(0); op(O_JMP); setlit(a, here); lit(0); setlit(b, here); xf = 0; xs = 0; + } else if (!strcmp(o, "||")) { + ftest(); a = here; lit(0); op(O_JZ); lit(1); b = here; lit(0); op(O_JMP); + setlit(a, here); bin(p + 1); rval(); ftest(); seq_nz(); setlit(b, here); xf = 0; xs = 0; + } else { + bin(p + 1); rval(); rf = xf; rs = xs; + if ((ls || rs) && sis(o)) { + if (!(ls && rs)) die("a byte string needs a byte string on the other side"); + sbinop(o); + } else if ((lf || rf) && fis(o)) { fbinop(o, lf, rf); xs = 0; } + else { binop(o); xf = 0; xs = 0; } + } + lv = 0; lvi = -1; + } +} +static void expr(void) +{ + char o[8]; int dst, lf; + bin(1); dst = lvi; + if (is("=")) { + if (!lv) die("assignment needs an lvalue"); + next(); expr(); rval(); + op(O_SWAP); lit(1); op(O_PICK); op(O_SWAP); op(O_ST); lv = 0; + if (dst >= 0) { lo[dst].flt = xf; lo[dst].str = xs; } + } else if (tk == T_OP && strlen(ts) >= 2 && ts[strlen(ts) - 1] == '=' && strcmp(ts, "==") && strcmp(ts, "!=") && strcmp(ts, "<=") && strcmp(ts, ">=")) { + if (!lv) die("assignment needs an lvalue"); + lf = xf; strcpy(o, ts); o[strlen(o) - 1] = 0; next(); + lit(0); op(O_PICK); op(O_LD); lv = 0; expr(); rval(); + if ((lf || xf) && fis(o)) fbinop(o, lf, xf); + else { binop(o); xf = 0; } + op(O_SWAP); lit(1); op(O_PICK); op(O_SWAP); op(O_ST); lv = 0; + if (dst >= 0) { lo[dst].flt = xf; lo[dst].str = 0; } + } +} + +/* ---- asm blocks: raw vm words ---- */ +static void asmblock(void) +{ + char ln[128][64], rn[256][64]; int la[128], nl = 0, ra[256], nr = 0, i, k; const char *c; + Loc *l; Sym *s; + expect("{"); + while (!accept("}")) { + if (tk == T_EOF) die("unterminated asm"); + if (tk == T_FLT) { emit(1200); emit(tv); next(); continue; } + if (tk == T_NUM) { lit(tv); next(); continue; } + if (tk == T_BSTR) { bstrlit(); continue; } + if (tk == T_STR) { strlit(); continue; } + if (accept("#")) { if (tk != T_NUM) die("# needs a number"); emit(tv); next(); continue; } + if (is("-")) { next(); if (tk == T_NUM && glue) { lit(-tv); next(); } else op(O_SUB); continue; } + if (accept(":")) { strcpy(ln[nl], ident()); la[nl++] = here; continue; } + if (strlen(ts) == 1 && (c = strchr(mn, ts[0]))) { op((int)(c - mn)); next(); continue; } + if (tk != T_ID) die("bad asm token"); + if ((l = findl(ts))) { laddr(l->slot); next(); continue; } + if ((s = find(ts)) && s->kind != K_FN) { lit(s->val); next(); continue; } + if (s) { fnref(ts); next(); continue; } + strcpy(rn[nr], ts); ra[nr++] = here; lit(0); next(); /* a label of this block */ + } + for (i = 0; i < nr; i++) { + for (k = -1; ++k < nl && strcmp(ln[k], rn[i]);) ; + if (k == nl) die("unknown asm label"); + setlit(ra[i], la[k]); + } +} + +/* ---- statements ---- */ +static int brk[256][64], nbrk[256], cont[256], nloop; +static int epi[1024], nepi; +static void stmt(void); +static void block(void) +{ + int save = nlo; + expect("{"); + while (!accept("}")) { if (tk == T_EOF) die("missing }"); stmt(); } + nlo = save; +} +static void jmp_to(int t) { lit(t); op(O_JMP); } +static void loopbody(int contaddr) +{ + nbrk[nloop] = 0; cont[nloop++] = contaddr; + stmt(); + nloop--; +} +static void patchbreaks(void) { int i; for (i = 0; i < nbrk[nloop]; i++) setlit(brk[nloop][i], here); } +static void stmt(void) +{ + int a, b, c, d; + if (accept(";")) return; + if (is("{")) { block(); return; } + { + int nw = optype(), n; + if (nw >= 0 || accept("let") || accept("var")) { + if (nw < 0) nw = 1; + do { + Loc *l = &lo[nlo++]; strcpy(l->name, ident()); l->arr = 0; + if (nw > 1) { l->slot = nslot; nslot += nw; l->arr = 1; } + else { + if (accept("[")) { n = cexpr(); expect("]"); nslot += n; l->slot = nslot - n; l->arr = 1; } + else l->slot = nslot++; + } + l->flt = 0; l->str = 0; + if (accept("=")) { expr(); rval(); laddr(l->slot); op(O_ST); l->flt = xf; l->str = xs; } + } while (accept(",")); + expect(";"); return; + } + } + if (accept("unchecked")) { stmt(); return; } + if (accept("if")) { + expect("("); expr(); rval(); ftest(); expect(")"); + a = here; lit(0); op(O_JZ); stmt(); + if (accept("else")) { b = here; lit(0); op(O_JMP); setlit(a, here); stmt(); setlit(b, here); } + else setlit(a, here); + return; + } + if (accept("while")) { + c = here; expect("("); expr(); rval(); ftest(); expect(")"); + a = here; lit(0); op(O_JZ); + loopbody(c); jmp_to(c); setlit(a, here); patchbreaks(); return; + } + if (accept("for")) { + int save = nlo; + expect("("); + if (!is(";")) { if (is("let") || is("var") || tk == T_ID || is("[")) { stmt(); goto cond; } expr(); rval(); op(O_DROP); } + expect(";"); + cond: c = here; + if (!is(";")) { expr(); rval(); ftest(); } else { lit(1); xf = 0; } + expect(";"); + a = here; lit(0); op(O_JZ); b = here; lit(0); op(O_JMP); + d = here; + if (!is(")")) { expr(); rval(); op(O_DROP); } + expect(")"); jmp_to(c); + setlit(b, here); + loopbody(d); jmp_to(d); setlit(a, here); patchbreaks(); + nlo = save; return; + } + if (accept("break")) { if (!nloop) die("break outside a loop"); brk[nloop - 1][nbrk[nloop - 1]++] = here; lit(0); op(O_JMP); expect(";"); return; } + if (accept("continue")) { if (!nloop) die("continue outside a loop"); jmp_to(cont[nloop - 1]); expect(";"); return; } + if (accept("return")) { + if (!is(";")) { expr(); rval(); } else lit(0); + expect(";"); epi[nepi++] = here; lit(0); op(O_JMP); return; + } + if (is("asm")) { next(); asmblock(); return; } + expr(); rval(); op(O_DROP); expect(";"); +} + +/* ---- top level ---- */ +static void fndef(int ret) +{ + char *n = ident(); Sym *s; int np = 0, tags = 0, t, frame, i, helper, busy, done, check, node; + if (dsn && !dnm[0]) strcpy(dnm, n); + char pn[16][64]; + s = find(n); + if (!s || s->kind != K_FN) { s = add(n, K_FN, 0); s->defd = 0; } + expect("("); + if (!accept(")")) { + do { + t = 0; ptag = 0; + if (optype() >= 0) t = ptag == 1 ? 1 : ptag == 2 ? 2 : 0; /* the type is read and dropped */ + else if (accept(".")) { /* .m name, .d name */ + if (is("m")) t = 1; else if (is("d")) t = 2; else die("a parameter tag is .m or .d"); + next(); + } + if (np < 12) tags += t << (2 * np); + strcpy(pn[np++], ident()); + } while (accept(",")); + expect(")"); + } + s->sig = ret + 2 * np + 64 * tags; + if (accept(";")) return; /* prototype */ + if (s->defd) die("function defined twice"); + s->val = here; s->defd = 1; +#ifdef ZC0DOCS + { /* the header is the source from the item's first token to the { that opens the body */ + int hl = tstart - hdr_start; + sgname[0] = 0; + if (hl > 0 && hl < (int)sizeof sgtext - 1) { + memcpy(sgtext, src + hdr_start, hl); sgtext[hl] = 0; + while (hl && isspace((unsigned char)sgtext[hl - 1])) sgtext[--hl] = 0; + strcpy(sgname, n); + } + } +#endif + nlo = 0; nslot = 0; nepi = 0; infn = 1; + for (i = 0; i < np; i++) { strcpy(lo[nlo].name, pn[i]); lo[nlo].arr = 0; lo[nlo].flt = 0; lo[nlo].str = 0; lo[nlo++].slot = nslot++; } + /* retain the caller's pointer until the frame has its final segment. */ + helper = !find("frame_busy") || !strcmp(s->name, "frame_grow") || !strcmp(s->name, "frame_leave"); + lit(ZFP); op(O_LD); if (!helper) { lit(0); op(O_PICK); } + frame = here; lit(0); op(O_SUB); lit(ZFP); op(O_ST); + if (!helper) { + lit(find("frame_busy")->val); op(O_LD); busy = here; lit(0); op(O_JZ); + done = here; lit(0); op(O_JMP); setlit(busy, here); + lit(ZFP); op(O_LD); lit(find("frame_floor")->val); op(O_LD); + lit(find("frame_guard")->val); op(O_LD); op(O_ADD); op(O_LT); check = here; lit(0); op(O_JZ); + lit(ZFP); op(O_LD); lit(1); op(O_PICK); lit(ZFP); op(O_ST); + fnref("frame_grow"); op(O_CALL); lit(ZFP); op(O_ST); + busy = here; lit(0); op(O_JMP); + setlit(check, here); setlit(done, here); op(O_DROP); setlit(busy, here); + } + for (i = np; i--;) { laddr(i); op(O_ST); } + block(); + lit(0); + for (i = 0; i < nepi; i++) setlit(epi[i], here); + lit(ZFP); op(O_LD); lit(nslot); op(O_ADD); lit(ZFP); op(O_ST); + if (!helper) { + lit(find("frame_node")->val); op(O_LD); node = here; lit(0); op(O_JZ); + lit(ZFP); op(O_LD); lit(find("frame_top")->val); op(O_LD); op(O_SUB); check = here; lit(0); op(O_JZ); + done = here; lit(0); op(O_JMP); setlit(check, here); + fnref("frame_leave"); op(O_CALL); lit(ZFP); op(O_ST); setlit(done, here); setlit(node, here); + } + op(O_RET); + setlit(frame, nslot); + infn = 0; +} +/* enhance name(params) [-> n] micro "recipe"; or ... vm { asm }; + emits the install descriptor; the booted genome installs it */ +static int nenh; +static void enhdef(void) +{ + char *n, pn[8][64]; int np = 0, nout = 1, d, na, pay, len = 0, i, j; Sym *s; + if (tk == T_NUM) { nout = tv; next(); } /* enhance 2 name(...) */ + n = ident(); + expect("("); + if (!accept(")")) { do { if (np == 8) die("at most 8 inputs"); strcpy(pn[np++], ident()); } while (accept(",")); expect(")"); } + d = here; for (i = 0; i < 7; i++) emit(0); + na = here; for (i = 0; i < np; i++) emit(0); + for (i = 0; i < np; i++) { img[na + i - GORG] = here; for (j = 0; pn[i][j]; j++) emit((unsigned char)pn[i][j]); emit(0); } + if (accept("micro")) { pay = here; while (tk == T_STR) { for (j = 0; ts[j]; j++) emit((unsigned char)ts[j]); next(); } emit(0); } + else if (accept("vm")) { pay = here; asmblock(); op(O_RET); len = here - pay; img[d + 1 - GORG] = 1; } + else die("expected micro or vm"); + img[d - GORG] = nenh; img[d + 2 - GORG] = np; img[d + 3 - GORG] = nout; + img[d + 4 - GORG] = pay; img[d + 5 - GORG] = len; img[d + 6 - GORG] = na; + s = add(n, K_ENH, nenh++); s->sig = np + nout * 16 + d * 256; + expect(";"); +} +static void top1(void) +{ + { + if (accept("unchecked")) { top1(); return; } + if (accept("fn")) { fndef(0); return; } + if (accept(".")) { if (strcmp(ident(), "u")) die("the only return tag is .u"); fndef(1); return; } /* .u name(...) */ + if (accept("const")) { optype(); do { char *n = ident(); if (dsn && !dnm[0]) strcpy(dnm, n); expect("="); add(n, K_CONST, cexpr()); } while (accept(",")); expect(";"); return; } + if (accept("enhance")) { enhdef(); return; } + { + int nw, typed, k, a, rt; + ptag = 0; nw = optype(); typed = nw >= 0; rt = ptag == 3; + if (typed || accept("let") || accept("var")) { + if (isfn()) { fndef(rt); return; } + do { + char *n = ident(); + if (dsn && !dnm[0]) strcpy(dnm, n); + k = 0; + if (typed) k = nw > 1 ? nw : 0; + else if (accept("[")) { k = (int)cexpr(); expect("]"); } + if (k > 1) { + a = here; while (k--) emit(0); add(n, K_GARR, a); + } else { + a = here; add(n, K_GVAR, a); emit(0); + if (accept("=")) { + if (tk == T_STR) { int i, l = (int)strlen(ts); img[a - GORG] = here; for (i = 0; i < l; i++) emit((unsigned char)ts[i]); emit(0); next(); } + else img[a - GORG] = cexpr(); + } + } + } while (accept(",")); + expect(";"); return; + } + } + die("expected fn, var or const"); + } +} + +/* one item, with the doc comment above it kept under the name it declares */ +static void top(void) +{ + while (tk != T_EOF) { + dsn = 0; dnm[0] = 0; +#ifdef ZC0DOCS + sgname[0] = 0; hdr_start = tstart; +#endif + if (dn && dline == line) { memcpy(dsnap, dbuf, dn); dsn = dn; dline = 0; } + top1(); +#ifdef ZC0DOCS /* enabled for images that carry editor documentation */ + if (dsn && dnm[0]) { + int j = here, a, i = 0, k, c; uint64_t w; char nm[80]; + lit(0); op(O_JMP); a = here; + emit(dsn); + while (i < dsn) { + w = 0; k = 0; + while (k < 8 && i < dsn) { c = (unsigned char)dsnap[i]; if (c > 255) c = 63; w |= (uint64_t)c << (k * 8); k++; i++; } + emit((int64_t)w); + } + if (!(dsn & 7)) emit(0); + setlit(j, here); + sprintf(nm, "doc %s", dnm); + add(nm, K_DOC, a); + } + if (sgname[0]) { /* the signature, as the header's own text, under "sig name" */ + int j = here, a, i = 0, k, c, sl = (int)strlen(sgtext); uint64_t w; char nm[96]; + lit(0); op(O_JMP); a = here; + emit(sl); + while (i < sl) { + w = 0; k = 0; + while (k < 8 && i < sl) { c = (unsigned char)sgtext[i]; w |= (uint64_t)c << (k * 8); k++; i++; } + emit((int64_t)w); + } + if (!(sl & 7)) emit(0); + setlit(j, here); + sprintf(nm, "sig %s", sgname); + add(nm, K_DOC, a); + } +#endif + dsn = 0; dnm[0] = 0; + } +} + +int main(void) +{ +#ifdef _WIN32 + _setmode(_fileno(stdin), _O_BINARY); + _setmode(_fileno(stdout), _O_BINARY); +#endif + char *buf = malloc(65536); int capacity = 65536, n = 0, i, j; Sym *st; + if (!buf) { fprintf(stderr, "zc0: cannot allocate source buffer\n"); return 1; } + for (;;) { + size_t got; + if (n + 1 == capacity) { + char *next; + if (capacity > 0x7fffffff / 2) { fprintf(stderr, "zc0: source is too large\n"); return 1; } + capacity *= 2; next = realloc(buf, (size_t)capacity); + if (!next) { fprintf(stderr, "zc0: cannot grow source buffer\n"); return 1; } + buf = next; + } + got = fread(buf + n, 1, (size_t)(capacity - n - 1), stdin); n += (int)got; + if (!got) { if (ferror(stdin)) { fprintf(stderr, "zc0: source read failed\n"); return 1; } break; } + } + buf[n] = 0; src = buf; next(); + /* image header: set the frame pointer, jump to start, then the symbol blob pointer and image end */ + lit(FTOP); lit(ZFP); op(O_ST); fnref("start"); op(O_JMP); emit(0); emit(0); + top(); + for (i = 0; i < nfx; i++) { + Sym *s = &sy[fx[i].sym]; + if (!s->defd) { fprintf(stderr, "zc0: undefined function %s\n", s->name); return 1; } + setlit(fx[i].at, s->val); + } + if (!(st = find("start")) || !st->defd) { fprintf(stderr, "zc0: no start\n"); return 1; } + /* symbol blob: kind, value, sig, name chars, 0 ... then a 0 kind */ + img[5] = here; + for (i = 0; i < nsy; i++) { + emit(sy[i].kind); emit(sy[i].val); emit(sy[i].sig); + for (j = 0; sy[i].name[j]; j++) emit((unsigned char)sy[i].name[j]); + emit(0); + } + emit(0); + img[6] = here; + printf("#define GORG %d\n#define GLEN %d\nstatic const int64_t genome[] = {", GORG, here - GORG); + for (i = 0; i < here - GORG; i++) printf("%s%lld", !i ? "\n" : i % 12 ? "," : ",\n", (long long)img[i]); + printf("\n};\n"); + return 0; +} diff --git a/src/tools/zcc b/src/tools/zcc new file mode 100755 index 0000000..19904ea --- /dev/null +++ b/src/tools/zcc @@ -0,0 +1,54 @@ +#!/bin/bash +# zcc: compiles a ZC (ZygoteC) program into a static binary. the binary holds +# the runtime, the program and a memory map sized to them, and needs nothing +# from the system but the kernel (linux x86-64 and any host with a static +# libc). the program reads and writes through the same syscalls as zy(1). +# +# src/tools/zcc [-o OUT] [-k] FILE.zc +# +# -o OUT the binary to write (default: FILE without .zc) +# -k keep the build directory and print where it is +# CC the C compiler (default cc). CFLAGS adds to the default -O2 +# +# the build is three steps: automap sizes the map to the program and writes the +# genome (the compiled program image) for it; the micro core and its linux port +# are compiled against that map; and the link is static. make run PROG= builds +# the same image without the static link. +set -e +here="$(cd "$(dirname "$0")/../.." && pwd)" +CC=${CC:-cc} +out=""; keep=0 +while [ $# -gt 0 ]; do + case "$1" in + -o) [ $# -ge 2 ] || { echo "zcc: -o needs a name" >&2; exit 2; }; out="$2"; shift 2 ;; + -k) keep=1; shift ;; + -h|--help) sed -n '2,15p' "$0"; exit 0 ;; + -*) echo "zcc: unknown option $1" >&2; exit 2 ;; + *) break ;; + esac +done +[ $# -eq 1 ] || { echo "usage: src/tools/zcc [-o OUT] [-k] FILE.zc" >&2; exit 2; } +src="$1" +[ -f "$src" ] || { echo "zcc: no such file: $src" >&2; exit 1; } +case "$src" in *.zc) ;; *) echo "zcc: the source must end in .zc" >&2; exit 2 ;; esac +[ -n "$out" ] || { out="${src%.zc}"; out="$(basename "$out")"; } +case "$src" in /*) abs="$src" ;; *) abs="$PWD/$src" ;; esac + +work="$(mktemp -d "${TMPDIR:-/tmp}/zcc.XXXXXX")" +cleanup() { [ "$keep" = 1 ] && echo "zcc: build kept in $work" >&2 || rm -rf "$work"; } +trap cleanup EXIT + +# the map and the genome for this program only +( cd "$here" && bash src/tools/automap.sh run "$work/run" src/runtime/run.zc "$abs" ) >/dev/null +cp "$here/src/micro/micro.c" "$here/src/micro/micro_port.h" "$here/src/micro/port_linux.c" \ + "$here/src/core/fops.h" "$here/src/core/bops.h" "$here/src/core/stack.h" "$work/run/" + +# static where the toolchain allows it; a plain link otherwise, with a note +static=-static +if ! printf 'int main(void){return 0;}\n' | $CC -x c -static -o "$work/probe" - >/dev/null 2>&1; then + static="" + echo "zcc: this toolchain cannot link -static; the binary is dynamic" >&2 +fi +$CC -O2 -w -fwrapv ${CFLAGS:-} $static "$work/run/micro.c" "$work/run/port_linux.c" \ + -I"$work/run" -o "$out" +echo "zcc: wrote $out ($(wc -c < "$out" | tr -d ' ') bytes)" diff --git a/src/web/build.sh b/src/web/build.sh new file mode 100755 index 0000000..48c784e --- /dev/null +++ b/src/web/build.sh @@ -0,0 +1,12 @@ +#!/bin/bash +# builds src/web/zc.wasm (or the path given as the first argument): the microcore, with the compiler genome inside, as +# WebAssembly. needs clang with the wasm32 target and wasm-ld. the page +# (src/web/index.html) loads it next to src/web/zc.js. +set -e +cd "$(dirname "$0")/../.." +clang --target=wasm32 -O2 -w -fwrapv -nostdlib -fno-builtin -mbulk-memory -DJTYPE=int \ + -Isrc/core -Isrc/micro src/micro/micro.c src/web/port_wasm.c \ + -Wl,--no-entry -Wl,--export=wasm_input -Wl,--export=wasm_input_cap -Wl,--export=wasm_set_input -Wl,--export=wasm_run \ + -Wl,--export=memory -Wl,--allow-undefined -Wl,--initial-memory=33554432 -Wl,-z,stack-size=65536 \ + -o "${1:-src/web/zc.wasm}" +ls -l "${1:-src/web/zc.wasm}" diff --git a/src/web/index.html b/src/web/index.html new file mode 100644 index 0000000..4cf7476 --- /dev/null +++ b/src/web/index.html @@ -0,0 +1,60 @@ + + + + +zc in the browser + +
+

zc in the browser

+

the microcore compiled to webassembly, with the whole compiler inside. the program below is compiled and run by it, the same as zy < file.zc.

+
+ + + loading +
+ + 

+

+
+
+
diff --git a/src/web/port_wasm.c b/src/web/port_wasm.c
new file mode 100644
index 0000000..c1e8483
--- /dev/null
+++ b/src/web/port_wasm.c
@@ -0,0 +1,86 @@
+/* WebAssembly port of the microcore. the page hands the program over as
+   bytes, calls run(), and gets output back one byte at a time through the
+   one import. build with src/web/build.sh; nothing here needs libc. */
+#include "micro_port.h"
+
+extern void js_putc(int c);
+extern void js_msg(int c);
+
+static unsigned char inbuf[1 << 20];
+static int inn, inp;
+
+/* where the page writes the program, and how it says how long it is */
+unsigned char *wasm_input(void) { return inbuf; }
+int wasm_input_cap(void) { return (int)sizeof inbuf; }
+void wasm_set_input(int n) { inn = n; inp = 0; }
+
+/* the machine's memory: the linear memory above everything the module has in it.
+   the base is fixed when the first machine is made, and a grow only adds pages on
+   the top, so the base never moves. */
+static unsigned char *mbase;
+static UCell mcap;	/* bytes of machine memory the module has grown for */
+
+Cell *micro_mem_alloc(UCell words)
+{
+	UCell need, extra, pages;
+	if (words > ((UCell)-1) / sizeof(Cell)) return 0;
+	if (!mbase) {
+		mbase = (unsigned char *)((UCell)__builtin_wasm_memory_size(0) * 65536u);
+		mcap = 0;
+	}
+	need = words * sizeof(Cell);
+	if (need <= mcap) return (Cell *)mbase;
+	extra = need - mcap;
+	pages = (extra + 65535u) / 65536u;
+	if (__builtin_wasm_memory_grow(0, (int)pages) < 0) return 0;
+	mcap += pages * 65536u;	/* wasm zeroes the pages it grows by */
+	return (Cell *)mbase;
+}
+
+int micro_getc(void) { return inp < inn ? inbuf[inp++] : -1; }
+int micro_eof(void) { return inp >= inn; }
+void micro_putc(int c) { js_putc(c & 255); }
+void micro_msg(const char *s) { while (*s) js_msg(*s++); }
+
+Cell micro_syscall(Cell *mem, Cell op, Cell a, Cell b, Cell c)
+{
+	switch (op) {
+	case 9:		/* memory: the size of the machine and its heap */
+		if (a == 0) return micro_mem_words();
+		if (a == 1) return HEAP_LO;
+		if (a == 2) return HEAP_HI;
+		if (a == 3) return (Cell)micro_mem_words() * 8;
+		return -1;
+	case 7:		/* exit: the page sees run() return */
+		return -1;
+	case 21:	/* argc: the page has no command line, so  alone */
+		return 1;
+	case 22:	/* argv: entry 0 is , as in zy(1) */
+		if (a != 0) return -1;
+		if (!b) return 6;
+		if (c < 7 || b + 6 >= micro_mem_words()) return -1;
+		{
+			static const char lead[] = "";
+			int i;
+			for (i = 0; i < 6; i++) mem[b + i] = (unsigned char)lead[i];
+			mem[b + 6] = 0;
+		}
+		return 6;
+	case 23:	/* envc: a page has no environment */
+		return 0;
+	}
+	return -1;
+}
+
+/* the core multiplies 64 by 64 into 128 bits for the float helpers; wasm has no
+   such instruction and there is no compiler runtime to link, so this is it */
+void __multi3(unsigned long long *r, unsigned long long al, unsigned long long ah, unsigned long long bl, unsigned long long bh)
+{
+	unsigned long long a0 = al & 0xffffffffu, a1 = al >> 32, b0 = bl & 0xffffffffu, b1 = bl >> 32;
+	unsigned long long p00 = a0 * b0, p01 = a0 * b1, p10 = a1 * b0, p11 = a1 * b1;
+	unsigned long long mid = (p00 >> 32) + (p01 & 0xffffffffu) + (p10 & 0xffffffffu);
+	r[0] = (p00 & 0xffffffffu) | (mid << 32);
+	r[1] = p11 + (p01 >> 32) + (p10 >> 32) + (mid >> 32) + al * bh + ah * bl;
+}
+
+int wasm_run(void) { return micro_run(); }
diff --git a/src/web/zc.js b/src/web/zc.js
new file mode 100644
index 0000000..4f14d3c
--- /dev/null
+++ b/src/web/zc.js
@@ -0,0 +1,28 @@
+// runs zc in a browser or in node: the microcore compiled to webassembly,
+// with the compiler genome inside. ZC.load(bytes) gives a machine, and
+// machine.run(source) compiles and runs a program the way `zy < file.zc` does,
+// returning what it printed. every run starts from a fresh instance.
+(function (root) {
+	async function load(wasm) {
+		if (typeof wasm === 'string') wasm = await (await fetch(wasm)).arrayBuffer();
+		const mod = await WebAssembly.compile(wasm);
+		return {
+			async run(source) {
+				let out = [], msg = [], mem;
+				const inst = await WebAssembly.instantiate(mod, {
+					env: { js_putc: c => { out.push(c); }, js_msg: c => { msg.push(c); } }
+				});
+				const x = inst.exports;
+				const bytes = new TextEncoder().encode(source);
+				if (bytes.length > x.wasm_input_cap()) throw new Error('program too long for the input buffer');
+				new Uint8Array(x.memory.buffer).set(bytes, x.wasm_input());
+				x.wasm_set_input(bytes.length);
+				const status = x.wasm_run();
+				const dec = new TextDecoder();
+				return { output: dec.decode(new Uint8Array(out)), messages: dec.decode(new Uint8Array(msg)), status };
+			}
+		};
+	}
+	const ZC = { load };
+	if (typeof module !== 'undefined' && module.exports) module.exports = ZC; else root.ZC = ZC;
+})(typeof self !== 'undefined' ? self : this);
-- 
cgit v1.2.3