#include <stdint.h>
#include <assert.h>

#include <stdlib.h>
#include <string.h>
#include <ctype.h>

#include <stdio.h>
#include <inttypes.h>

// PRINCIPLE

/*
A simple 64-bit bytecode virtual machine in portable C, suitable
for being the core of a HYDROGEN implementation.

Instructions are packed several into each cell. A cell of instructions
is loaded into IR, the Instruction Register, and executed from the
least significant instruction to the most until we run out of instructions and move on to the next cell full of instructions.

However if any instructions consume immediate operands, they are taken
from the next cell and the instruction pointer IP is moved forwards.

This means that a single cell full of instructions might be followed
by several cells of immediate values consumed by those instructions.

We make instruction 0 be the one that loads a new cell full of instructions into
IR, so that we always end up with that instruction as we shift IR down an
instruction at a time, or we can explicitly use instruction 0 to terminate a
group of instructions in a cell early.
 */

// CONFIG
typedef int64_t cell;
typedef uint64_t u_cell;

#define CELL_BITS 64
#define BITS_PER_INSTRUCTION 8

#define DEBUG

// INSN_NEXT *must* be 0. All others can be arbitrary values as long as they're
// no larger than BITS_PER_INSTRUCTION bits.
#define INSN_NEXT 0 // Move to next instruction group cell
#define INSN_PUSH 1 // Push immediate
#define INSN_CALL 2 // Call to immediate address
#define INSN_ICALL 3 // Call to address from stack
#define INSN_RET 4 // Return from call
#define INSN_HALT 5 // Halt VM (TODO: Replace with more general vm-operations syscall instruction that takes an immediate syscall number)
#define INSN_IF 6 // Conditional call (pop cell from stack and read immediate word, call to immediate address if cell from stack is nonzero)
#define INSN_IFELSE 7 // Biconditional call (pop cell from stack and read two immediate words, call to first immediate address if cell from stack is nonzero or second otherwise
#define INSN_TAILCALL 8 // Tail-call immediate
#define INSN_TAILICALL 9 // Tail-call indirect
#define INSN_ADD 10
#define INSN_SUB 11

// TODO: Syscall codes for INSN_SYSCALL

#define SYSCALL_HALT 0 // Halt CPU
#define SYSCALL_CPUID 1 // Push CPUID
#define SYSCALL_MALLOC 2 // Alloc from C heap
#define SYSCALL_FREE 3 // Return to C heap
#define SYSCALL_READ_BOOT 4 // Read a character from the boot media stream, or EOF
// TODO: ...plus console syscalls, at least for logging for now

// Directives for the assembler (they look like instructions)
#define DIRECTIVE_CELL -1
#define DIRECTIVE_STRING -2
// TODO: A directive to define a constant, .define <immediate> "name"; goes into a linked list of constants in the assembler state; then a new kind of immediate syntax is ".name" that looks up the value of "name" in the constant list. Useful to make code a bit clearer. Re-defining the same name should update the existing linked list entry rather than adding a new one.

// Special value for invalid instruction
#define INVALID_INSTRUCTION -127

// TODO: Add pointer registers (IX,IY,IZ) to the VM with instructions to push/pop them to the stack, and to read/write cells/bytes from/to memory via them, with optional pre/post inc/decrement.

// TODO: Add REPEAT that acts like CALL but afterwards pops a number from the stack and repeats the call if it's nonzero.

// TODO: Add WHILE that has two immediate operands; CALLs the first and pops a cell and if it's nonzero calls the second and repeats the whole process.

// Both need to set something magic in the state on the stack to mark it as a
// REPEAT or WHILE, so that the RETs ending the called subroutines "know" to
// invoke the special behaviour rather than just continuing.

// TODO: Add instructions for managing task state. There's a task register
// pointing to the current task block, with instructions to push and pop
// it. There's also an instruction to switch tasks, which saves all the current
// registers to the current task block, pops a new task block pointer, and loads
// all the registers from it. And instructions to load/save user cells that are
// stored in the task block after the system-specific task data. This enables
// task switching, with user task-local data. The task-local data is needed at
// this stage because it's where all the "globals" in traditional FORTH will be
// kept - we need them task-local so we can be multithreaded at the core.

#define INSTRUCTION_COUNT 12

struct {
  char *name;
  int immediate_operands;
} insn_details[] = {
  {"NEXT",0},
  {"PUSH",1},
  {"CALL",1},
  {"ICALL",0},
  {"RET",0},
  {"HALT",0},
  {"IF",1},
  {"IFELSE",2},
  {"TAILCALL",1},
  {"TAILICALL",0},
  {"ADD",0},
  {"SUB",0}
};

int insn_lookup(char *name) {
  if(!strcasecmp(".cell", name)) {
    return DIRECTIVE_CELL;
  }
  if(!strcasecmp(".string", name)) {
    return DIRECTIVE_STRING;
  }
  for(int i=0;i<INSTRUCTION_COUNT;i++) {
    if(!strcasecmp(insn_details[i].name, name))
      return i;
  }
  return INVALID_INSTRUCTION;
}

// ENGINE
void hydrogen(cell CPUID, u_cell *IP, cell *SP, cell *SP0, cell *RSP, cell *RSP0) {
  u_cell IR;

  // Preload instruction register with first group
  IR = *(IP++);

  // Instructions that don't load IR need to end with this macro to move to the
  // next instruction in the IR. This zero-fills from the most significant bit
  // so we will eventually hit "instruction" 0, INSN_NEXT.
#define NEXT IR >>= BITS_PER_INSTRUCTION; break;

  // Macro to read the next word from the instruction stream
#define IMMED *(IP++)

  // Macros to access the stacks
#define PUSH(x) *(--SP) = (x)
#define POP *(SP++)
#define RPUSH(x) *(--RSP) = (x)
#define RPOP *(RSP++)

  // Execution loop
  while(1) {
    // Mask off least significant instruction in the IR and branch on it
    cell insn = IR & ((1<<BITS_PER_INSTRUCTION)-1);
#ifdef DEBUG
    printf("IP = %p, IR = %" PRIx64 ", insn = %s", IP, IR, insn_details[insn].name);
    for(int i=0;i<insn_details[insn].immediate_operands;i++) {
      printf (" %" PRIx64, IP[i]);
    }
    printf("\nSTACK : ");
    for(cell *sp = SP; sp < SP0; sp++)
      printf(" %" PRIx64, *sp);

    printf("\nRSTACK: ");
    for(cell *sp = RSP; sp < RSP0; sp++)
      printf(" %" PRIx64, *sp);

    printf("\n");
#endif

    switch(insn) {
    case INSN_NEXT: // End of instruction group in the IR, load next group
      IR = *(IP++);
      break;

    case INSN_PUSH: // Push immediate
      PUSH((cell)IMMED);
      NEXT

    case INSN_CALL: // Call immediate
      //Save our IR and IP on the return stack
      RPUSH(IR>>BITS_PER_INSTRUCTION); /* IR must be pre-advanced to the
                                          next instruction or we'll return
                                          straight back to the call */
      RPUSH((cell)(IP+1)); // Skip the immediate address
      IP = (u_cell*)IMMED; // Load address to call to from our instruction stream
      IR = IMMED; // Load first group into IR from the callee's instruction stream
      break;

    case INSN_ICALL: // Indirect call to address in SP[0]
      //Save our IR and IP on the return stack
      RPUSH(IR>>BITS_PER_INSTRUCTION); /* IR must be pre-advanced to the
                                          next instruction or we'll return
                                          straight back to the call */
      RPUSH((cell)IP);
      IP = (cell*)POP; // Load address to call to from stack
      IR = IMMED; // Load first group into IR from the callee's instruction stream
      break;

    case INSN_RET:
      // Restore IR and IP from the return stack
      IP = (cell*)RPOP;
      IR = RPOP;
      break;

    case INSN_HALT:
      // Terminate the VM. Probably replace this with a more generic "trap"
      // instruction that takes a code in SP[0] and uses it to dispatch to other
      // VM-specific operations such as I/O, to not waste opcodes.
      return;

    case INSN_IF:
      if(POP != 0) {
        //Save our IR and IP on the return stack
        RPUSH(IR>>BITS_PER_INSTRUCTION); /* IR must be pre-advanced to the
                                            next instruction or we'll return
                                            straight back to the call*/
        RPUSH((cell)(IP+1)); // Skip the immediate address
        IP = (u_cell*)IMMED; // Load address to call to from our instruction stream
        IR = IMMED; // Load first group into IR from the callee's instruction stream
        break;
      } else {
        IP++; // Skip unused call target
        NEXT
      }
    case INSN_IFELSE:
      if(POP != 0) {
        //Save our IR and IP on the return stack
        RPUSH(IR>>BITS_PER_INSTRUCTION); /* IR must be pre-advanced to the
                                            next instruction or we'll return
                                            straight back to the call */
        RPUSH((cell)(IP+2)); // Skip two immediate addresses
        IP = (u_cell*)IMMED; // Load address to call to from our instruction stream
        IR = IMMED; // Load first group into IR from the callee's instruction stream
      } else {
        //Save our IR and IP on the return stack
        RPUSH((IR>>BITS_PER_INSTRUCTION)); /* IR must be pre-advanced to the
                                              next instruction or we'll return
                                              straight back to the call */
        RPUSH((cell)(IP+2)); // Skip two immediate addresses
        IP++; // Skip IF address, we're going to the ELSE address
        IP = (u_cell*)IMMED; // Load address to call to from our instruction stream
        IR = *(IP++); // Load first group into IR from the callee's instruction stream
      }
      break;
    case INSN_TAILCALL:
      // Tail call: effectively a jump, RET from this routine and then CALL the next in one swoop. Discards current IP/IR.
      IP = (u_cell*)IMMED; // Load address to call to from our instruction stream
      IR = IMMED; // Load first group into IR from the callee's instruction stream
      break;
    case INSN_TAILICALL:
      // Tail indirect call: effectively a jump, RET from this routine and then ICALL the next in one swoop. Discards current IP/IR.
      IP = (cell*)POP; // Load address to call to from stack
      IR = IMMED; // Load first group into IR from the callee's inst
      break;
    case INSN_ADD:
      SP[1] += SP[0];
      SP++;
      NEXT
    case INSN_SUB:
      SP[1] -= SP[0];
      SP++;
      NEXT
    }
  }
}

// Assembler

/*
  Define a little struct full of state that assembles instructions into a memory buffer, handling the location of instruction group cells and literal operand cells for us automatically.
 */

#define MAX_INSTRUCTIONS_PER_CELL (CELL_BITS/BITS_PER_INSTRUCTION)
#define MAX_IMMEDIATES_PER_INSTRUCTION 2 // IFELSE has 2 immediates
#define MAX_IMMEDIATE_CELLS MAX_INSTRUCTIONS_PER_CELL*MAX_IMMEDIATES_PER_INSTRUCTION

// Must be longer than the longest instruction name from insn_details and the longest numerical literal and the longest label
#define MAX_TOKEN_LENGTH 128

struct label_def {
  struct label_def *next; // Linked list
  cell *location;
  char *name; // malloced memory
};

typedef struct {
  cell *ip; // Where to assemble to
  cell *limit; // Do not write to this address or beyond

  u_cell insn_buffer;
  int insn_offset;
  cell immed_buffer[MAX_IMMEDIATE_CELLS];
  int immediates;

  // Named labels
  struct label_def *labels;

  // Stuff for the parser
  enum {
    PS_INITIAL,
    PS_LABEL_DEF,
    PS_INSTRUCTION,
    PS_AFTER_INSTRUCTION,
    PS_LABEL_IMMEDIATE,
    PS_HEX_IMMEDIATE,
    PS_DECIMAL_IMMEDIATE,
    PS_STRING_IMMEDIATE,
    PS_STRING_IMMEDIATE_ESCAPE,
    PS_LINE_COMMENT,
    PS_BLOCK_COMMENT
  } parse_state;
  char parse_buffer[MAX_TOKEN_LENGTH+1];
  int parse_buffer_pos;
  int parse_instruction;
  cell parse_immediates[MAX_IMMEDIATE_CELLS];
  int parse_immediate_count;
  int parse_block_comment_depth;
} assembler;

void asm_init(assembler *a, cell *ip, cell *limit) {
  assert(ip < limit);

  a->ip = ip;
  a->limit = limit;

  a->insn_buffer = 0;
  a->insn_offset = 0;
  a->immediates = 0;

  a->labels = NULL;

  a->parse_state = PS_INITIAL;
}

// Flush instruction buffer to ip
void asm_flush(assembler *a) {
  if(a->insn_buffer == 0) {
    assert(a->immediates == 0);
    assert(a->insn_offset == 0);
    // Nothing to flush
  } else {
    assert(a->ip < a->limit);
    *(a->ip++) = (cell)a->insn_buffer;

    for(int i=0;i<a->immediates;i++) {
      assert(a->ip < a->limit);
      *(a->ip++) = (u_cell)a->immed_buffer[i];
    }

    a->insn_buffer = 0;
    a->insn_offset = 0;
    a->immediates = 0;
  }
}

void asm_literal_cell(assembler *a, cell data) {
  asm_flush(a);
  *(a->ip++) = data;
}

void asm_literal_string(assembler *a, char *data) {
  asm_flush(a);

  char *char_ip = (char*)a->ip;
  int len = 0;

  while(*data) {
    *char_ip++ = *data++;
    len++;
  }

  // Trailing \0
  *char_ip++ = '\0';
  len++;

  // Fix alignment by adding more \0s
  while(len % (CELL_BITS/8)) {
    *char_ip++ = '\0';
    len++;
  }

  // Update ip
  a->ip = (cell*)char_ip;
}

void asm_done(assembler *a) {
  asm_flush(a);
  struct label_def *ld = a->labels;
  while (ld != NULL) {
    free(ld->name);
    struct label_def *tmp = ld;
    ld = ld->next;
    free(tmp);
  }
}

u_cell *asm_label(assembler *a, char *name) {
  asm_flush(a);
  struct label_def *ld = (struct label_def*)malloc(sizeof(struct label_def));
  assert(ld != NULL);
  ld->next = a->labels;
  ld->location = a->ip;
  ld->name = strdup(name);
  a->labels = ld;
  return a->ip;
}

u_cell *asm_label_lookup(assembler *a, char *name) {
  struct label_def *ld = a->labels;
  while(ld != NULL) {
    if (!strcmp(ld->name, name))
      return ld->location;
    ld = ld->next;
  }
  return NULL;
}

void asm_assemble(assembler *a, u_cell instruction, int num_immediates, cell *immediates) {
  // Put the instruction in the buffer
  a->insn_buffer |= (instruction << a->insn_offset);
  a->insn_offset += BITS_PER_INSTRUCTION;
  // Add any immediates
  for(int i=0;i<num_immediates;i++) {
    a->immed_buffer[a->immediates++] = immediates[i];
  }
  // Flush if buffer is now full
  if (a->insn_offset >= CELL_BITS) {
    asm_flush(a);
  }
}

void asm_assemble0(assembler *a, u_cell instruction) {
  asm_assemble(a, instruction, 0, NULL);
}

void asm_assemble1(assembler *a, u_cell instruction, cell immediate) {
  asm_assemble(a, instruction, 1, &immediate);
}

void asm_assemble2(assembler *a, u_cell instruction, cell immediate1, cell immediate2) {
  cell immediates[2] = {immediate1,immediate2};
  asm_assemble(a, instruction, 2, immediates);
}

// returns NULL on success, or a static error string. The syntax that this
// parses isn't really documented - see *.hydrogen for examples and go from
// there, unless you fancy reading the raw state machine herein:
char *asm_parse(assembler *a,char ch) {
  // TODO: Add directives to assemble literal data directly to IP, as cells, bytes, or NULL-terminated ASCII strings
  int instruction_complete = 0;
  switch(a->parse_state) {
  case PS_INITIAL:
    if(!isspace(ch)) {
      if(ch == ':') {
        a->parse_state = PS_LABEL_DEF;
        a->parse_buffer_pos = 0;
      } else if(ch == '\'') {
        a->parse_state = PS_LINE_COMMENT;
      } else if(ch == '{') {
        a->parse_state = PS_BLOCK_COMMENT;
        a->parse_block_comment_depth = 1;
      } else if(isalpha(ch) || ch == '.') { // Directives are like instructions but start with a .
        a->parse_state = PS_INSTRUCTION;
        a->parse_buffer[0] = ch;
        a->parse_buffer_pos = 1;
      } else {
        return "Invalid character in PS_INTIIAL";
      }
    } // else continue in PS_INITIAL
    break;
  case PS_LABEL_DEF:
    if(isspace(ch)) {
      // End of label def
      a->parse_buffer[a->parse_buffer_pos] = '\0';
      asm_label(a, a->parse_buffer);
      a->parse_state = PS_INITIAL;
    } else {
      if(a->parse_buffer_pos >= MAX_TOKEN_LENGTH) return "Label definition name too long";
      a->parse_buffer[a->parse_buffer_pos++] = ch;
    }
    break;
  case PS_INSTRUCTION:
    if(ch == '\n') {
      // End of instruction (no immediates)
      a->parse_buffer[a->parse_buffer_pos] = '\0';
      a->parse_instruction = insn_lookup(a->parse_buffer);
      if (a->parse_instruction == INVALID_INSTRUCTION)
        return "Invalid instruction name";
      a->parse_immediate_count = 0;
      a->parse_state = PS_INITIAL;
      instruction_complete = 1;
    } else if(isspace(ch)) {
      // End of instruction name but there's immediates to be found
      a->parse_buffer[a->parse_buffer_pos] = '\0';
      a->parse_instruction = insn_lookup(a->parse_buffer);
      if (a->parse_instruction == INVALID_INSTRUCTION)
        return "Invalid instruction name";
      a->parse_state = PS_AFTER_INSTRUCTION;
      a->parse_immediate_count = 0;
    } else {
      if(a->parse_buffer_pos >= MAX_TOKEN_LENGTH) return "Instruction name too long";
      a->parse_buffer[a->parse_buffer_pos++] = ch;
    }
    break;
  case PS_AFTER_INSTRUCTION:
    if(!isspace(ch)) {
      switch(ch) {
      case '\n': // End of instruction
        a->parse_state = PS_INITIAL;
        instruction_complete = 1;
        break;
      case '\'': // End of instruction, line comment
        a->parse_state = PS_LINE_COMMENT;
        instruction_complete = 1;
        break;
      case '@': // Label immediate
        a->parse_state = PS_LABEL_IMMEDIATE;
        a->parse_buffer_pos = 0;
        break;
      case '#': // Hex immediate
        a->parse_state = PS_HEX_IMMEDIATE;
        a->parse_buffer_pos = 0;
        break;
      case '=': // Decimal immediate
        a->parse_state = PS_DECIMAL_IMMEDIATE;
        a->parse_buffer_pos = 0;
        break;
      case '"': // String immediate (special case for .string directive)
        a->parse_state = PS_STRING_IMMEDIATE;
        a->parse_buffer_pos = 0;
        break;
      default:
        return "Unknown character in PS_AFTER_INSTRUCTION";
      }
    } // Else continue in PS_AFTER_INSTRUCTION
    break;
  case PS_LABEL_IMMEDIATE:
    if(isspace(ch)) {
      a->parse_buffer[a->parse_buffer_pos] = '\0';
      cell *location = asm_label_lookup(a, a->parse_buffer);
      if(!location) return "Reference to unknown label";
      a->parse_immediates[a->parse_immediate_count++] = (cell)location;
      if(ch == '\n') {
        a->parse_state = PS_INITIAL;
        instruction_complete = 1;
      } else {
        a->parse_state = PS_AFTER_INSTRUCTION;
      }
    } else {
      if(a->parse_buffer_pos >= MAX_TOKEN_LENGTH) return "Label reference too long";
      a->parse_buffer[a->parse_buffer_pos++] = ch;
    }
    break;
  case PS_HEX_IMMEDIATE:
    if(isspace(ch)) {
      a->parse_buffer[a->parse_buffer_pos] = '\0';
      cell val = strtoll(a->parse_buffer, NULL, 16);
      a->parse_immediates[a->parse_immediate_count++] = val;

      if(ch == '\n') {
        a->parse_state = PS_INITIAL;
        instruction_complete = 1;
      } else {
        a->parse_state = PS_AFTER_INSTRUCTION;
      }
    } else {
      if(a->parse_buffer_pos >= MAX_TOKEN_LENGTH) return "Hex immediate too long";
      a->parse_buffer[a->parse_buffer_pos++] = ch;
    }
    break;
  case PS_DECIMAL_IMMEDIATE:
    if(isspace(ch)) {
      a->parse_buffer[a->parse_buffer_pos] = '\0';
      cell val = strtoll(a->parse_buffer, NULL, 10);
      a->parse_immediates[a->parse_immediate_count++] = val;

      if(ch == '\n') {
        a->parse_state = PS_INITIAL;
        instruction_complete = 1;
      } else {
        a->parse_state = PS_AFTER_INSTRUCTION;
      }
    } else {
      if(a->parse_buffer_pos >= MAX_TOKEN_LENGTH) return "Decimal immediate too long";
      a->parse_buffer[a->parse_buffer_pos++] = ch;
    }
    break;
  case PS_STRING_IMMEDIATE:
    switch(ch) {
    case '\\':
      a->parse_state = PS_STRING_IMMEDIATE_ESCAPE;
      break;
    case '\"': // End of string
      a->parse_buffer[a->parse_buffer_pos] = '\0'; // We leave the string in the buffer
      a->parse_immediates[a->parse_immediate_count++] = 0; // Leave a dummy immediate value
      a->parse_state = PS_AFTER_INSTRUCTION;
      break;
    default:
      if(a->parse_buffer_pos >= MAX_TOKEN_LENGTH) return "String immediate too long";
      a->parse_buffer[a->parse_buffer_pos++] = ch;
    }
    break;
  case PS_STRING_IMMEDIATE_ESCAPE:
    if(a->parse_buffer_pos >= MAX_TOKEN_LENGTH) return "String immediate too long";
    a->parse_buffer[a->parse_buffer_pos++] = ch;
    a->parse_state = PS_STRING_IMMEDIATE;
  case PS_LINE_COMMENT:
    if(ch == '\n') {
      a->parse_state = PS_INITIAL;
    } // else: continue in line comment
    break;
  case PS_BLOCK_COMMENT:
    if(ch == '{') {
      a->parse_block_comment_depth++;
    } else if(ch == '}') {
      a->parse_block_comment_depth--;
      if(a->parse_block_comment_depth == 0) {
        a->parse_state = PS_INITIAL;
      }
    } // Else continue in block comment
    break;
  }

  // Common code that ends many different cases so we put it behind a flag
  if(instruction_complete) {
    // Directive or real instruction?
    switch(a->parse_instruction) {
    case DIRECTIVE_CELL:
      if(a->parse_immediate_count != 1)
        return ".cell requires 1 operand";
      asm_literal_cell(a, a->parse_immediates[0]);
      break;
    case DIRECTIVE_STRING:
      // String literal is retained in buffer
      if(a->parse_immediate_count != 1)
        return ".string requires 1 operand";
      asm_literal_string(a, a->parse_buffer);
      break;
    default: // Real instruction
      // Check number of immediates matches the instruction opcode by looking in insn_details
      if(insn_details[a->parse_instruction].immediate_operands != a->parse_immediate_count)
        return "Incorrect number of immediate operands for instruction";
      asm_assemble(a, a->parse_instruction, a->parse_immediate_count, a->parse_immediates);
    }
    instruction_complete = 0;
  }

  return NULL;
}

// Boot loader

/*
  Use the assembler to load a minimal HYDROGEN boot loader from a file that then
  expands into a full HYDROGEN interpiler, Jonesforth style, that loads up a
  HYDROGEN standard library.
 */

/* TODO: Start writing HYDROGEN kernel in assembly

   Change test.hydrogen to test.hasm

   Make a series of .hasm files that the makefile cats together into
   "hydrogen-core.hasm" that we can load and run. Maybe feed it through a
   preprocessor so we can have macros?

   First part: root dictionary

   Start putting together hardcoded dictionary headers for core system
   words. Use a redefined-each-time :label to track the current head of the
   linked list.

   Define basic words for all the core capabilities of the VM.

   Second part: heap management

   Have a syscall give us access to the C system heap via malloc/free

   Create a library for managing an apr_pool style memory pool system. The root
   pool is the C heap. Pools have parent pools they use to do their own
   allocations from; they can, in turn, offer sub-allocations which are either
   "freeable" (just passed on to the parent heap, but the pool keeps a reference
   to it in a linked list of things to free when the pool is destroyed) which
   can be explicited "freed" when no longer used (freeing it in theparent heap
   and removing it from our list of things to free) or "fixed" (allocated by
   advancing a pointer in a memory block obtained on demand from the parent
   heap, which is also in the linked list of things to free); and the whole pool
   can be destroyed, freeing everything in its tracking list.

   Third part: allocation streams

   Create the HYDROGEN allocation stream library, that lets you create a stream
   (in a heap pool). You can write cells and strings and other HYDROGEN types to
   the stream, then when you destroy the stream, it turns into a single block of
   memory (allocated from the heap pool, fixed or freeable at your choice) with
   all the stuff you write contiguously in it. Works by creating a sub-pool and
   doing fixed allocations of a linked list of buffer pages, then concatenating
   them into one at the end.

   Fourth part: compiler

   Create the HYDROGEN compiler library, that lets you create a compile context
   with a dictionary pointer. Lets you compile words as a sequence of PUSH and
   CALL operations, and then end them, getting an XT for a word that can be
   CALLed. Also lets you create dictionary entries giving names to words or look
   up dictionary entries. The compile context has an allocation stream from
   which all allocated objects are created, and when "done" closes the stream
   into a fixed memory block in the parent heap pool given to the compile
   context. To resolve pointers, it needs to keep a linked list of offsets into
   the allocation stream that should be fixed up with the resulting base address
   of the allocated block, stored in a sub-pool that gets destroyed at the end.

   TODO: Add inlining of small words when they are CALLed

   TODO: Add peephole optimiser that fixes up common patterns, like
   PUSH-then-ICALL, PUSH-then-TAILICALL, etc

   Fifth part: interpreter

   Create the HYDROGEN interpreter, that (given a compile context) reads words
   from an input stream (passed to the interpreter as an XT for a word that
   returns a character or EOF), looks them up in the compile context's
   dictionary, and runs them in immediate mode.

   Defines the ( word that creates a new compile context with the parent's
   dicionary pointer and compiles code until a matching ), then pushes the XT of
   the resulting word (or, when being compiled, compiles code to push the XT).

   Sixth part: Bootstrap HYDROGEN

   Binds CORE-DICTIONARY to the hardcoded root dictionary, then that's the last
   word defined in it.

   Uses a syscall to access "boot media" (which just reads
   hydrogen-core.hydrogen) to apply the interpreter to the hydrogen source for
   the hydrogen-in-c kernel, then again for whatever HYDROGEN
   (implementation-unspecific!) application code we are running today, all in a
   compile context in a new "system" heap pool with the hardcoded root
   dictionary full of words we've defined thus far.

   Binds APPLICATION-DICTIONARY to the resulting dictionary (in itself), by
   mutating a reference set up in hydrogen-core.hydrogen.

   End result should be a word called "start" being defined in the application
   dictionary, which the top-level driver can invoke once all the vCPU threads
   are running.
*/

cell *asm_load(cell *program_buffer, int program_buffer_cells, char *filename) {
  assembler a;
  asm_init(&a, program_buffer, program_buffer+program_buffer_cells);
  FILE *fp = fopen(filename, "r");
  assert(fp);
  int line = 1;
  int col = -1;
  while(!feof(fp)) {
    int ch = fgetc(fp);

    // Track line/col and report them in error messages
    if(ch == '\n') {
      col = 0;
      line++;
    } else {
      col++;
    }

    if(ch != EOF) {
      char *error = asm_parse(&a, ch);
      if(error) {
        printf ("ASM error on line %d col %d: %s\n", line, col, error);
      }
      assert(error == NULL);
    }
  }
  asm_flush(&a);
  printf("Assembly complete, used %d cells\n", a.ip - program_buffer);
  cell *main_start= asm_label_lookup(&a, "main");
  asm_done(&a);
  return main_start;
}

// TODO: Top level driver

/*
  Create a POSIX thread per virtual CPU and use them to run the core image the
  boot loader loaded, as per the HYDROGEN boot spec, and present the initial
  device tree.
 */

// TEST HARNESS

int main(void) {
  const int program_space_size = 64;
  cell program[program_space_size];

  cell *main_start = asm_load(program, program_space_size, "test.hydrogen");

  // Check literal data at start of test.hydrogen was assembled correctly
  assert(program[0] == 12345); // Literal integer
  assert(program[1] == 0x6f77206f6c6c6548); // "Hello wo"
  assert(program[2] == 0x0000000000646c72); // "rld_____" where _ = \0

  cell stack[16] = {0};
  cell rstack[16] = {0};

  // Push 1 to initial stack
  stack[15] = 1;

  hydrogen(0, main_start, stack+15, stack+16, rstack+16, rstack+16);

  printf("Answer should be 11: It's %" PRId64 "\n", stack[15]);
  assert(stack[15] == 11); // Correct answer from computation
}