hh_output.c

/* This file is part of Hedgehog LISP.
 * Copyright (C) 2003, 2004 Oliotalo Ltd.
 * See file LICENSE.LGPL for pertinent licensing conditions.
 *
 * Author: Kenneth Oksanen <cessu@iki.fi>
 */

#define HH_COMPILER  1

#include "hh_common.h"
#include "hh_codegen.h"
#include "hh_interp.h"
#include "hh_output.h"
#include "hh_data.h"
#include <stdlib.h>


/* Include `HH_INSN_COOKIE' from `hh_seed.h'.  This cookie contains a
   checksum of all insns and their kinds, making it possible to detect
   a mismatch between the instructions sets understood by the
   interpreter and generated by the compiler. */
#include "hh_seed.h"

#include <string.h>


static const char *hh_insn_names[HH_NUMBER_OF_INSNS] = {
#define INSN(mnemonic, flags, code)     #mnemonic,
#define IMM(mnemonic, flags, code)      /* Nothing */
#define EXT_INSN(mnemonic, flags, code) /* Nothing */

#include "hh_insn.def"
};


static const char *hh_imm_names[HH_NUMBER_OF_IMMS] = {
#define INSN(mnemonic, flags, code)     /* Nothing */
#define IMM(mnemonic, flags, code)      #mnemonic,
#define EXT_INSN(mnemonic, flags, code) /* Nothing */

#include "hh_insn.def"
};


static const char *hh_ext_insn_names[HH_NUMBER_OF_EXT_INSNS - 256] = {
#define INSN(mnemonic, flags, code)      /* Nothing */
#define IMM(mnemonic, flags, code)       /* Nothing */
#define EXT_INSN(mnemonic, flags, code)  #mnemonic,

#include "hh_insn.def"
};


static int hh_imm_width(hh_signed_word_t imm, int limit)
{
  if (limit < 0)
    limit = 0;
  if (imm <= 127 - limit && imm >= -128 + limit)
    return 1;
  else if (imm <= 32767 - limit && imm >= -32768 + limit)
    return 2;
  else
    return 4;
}

static void hh_imm_encode(unsigned char *p, hh_signed_word_t imm, int limit)
{
  if (limit < 0)
    limit = 0;
  if (imm <= 127 - limit && imm >= -128 + limit) {
    p[0] |= 0x40;
    ((signed char *) p)[1] = (signed char) imm;
  } else if (imm <= 32767 - limit && imm >= -32768 + limit) {
    p[0] |= 0x80;
    ((signed char *) p)[1] = (signed char) (imm >> 8);
    p[2] = imm & 0xFF;
  } else {
    p[0] |= 0xC0;
    ((signed char *) p)[1] = (signed char) (imm >> 24);
    p[2] = (imm >> 16) & 0xFF;
    p[3] = (imm >> 8) & 0xFF;
    p[4] = imm & 0xFF;
  }
}

static void hh_imm2_encode(unsigned char *p,
			   hh_signed_word_t imm1,
			   hh_signed_word_t imm2,
			   int limit)
{
  int len;

  if (limit < 0)
    limit = 0;
  if (imm1 <= 127 - limit && imm1 >= -128 + limit) {
    p[0] |= 0x40;
    ((signed char *) p)[1] = (signed char) imm1;
    len = 2;
  } else if (imm1 <= 32767 - limit && imm1 >= -32768 + limit) {
    p[0] |= 0x80;
    ((signed char *) p)[1] = (signed char) (imm1 >> 8);
    p[2] = imm1 & 0xFF;
    len = 3;
  } else {
    p[0] |= 0xC0;
    ((signed char *) p)[1] = (signed char) (imm1 >> 24);
    p[2] = (imm1 >> 16) & 0xFF;
    p[3] = (imm1 >> 8) & 0xFF;
    p[4] = imm1 & 0xFF;
    len = 5;
  }
  ((signed char *) p)[len] = (signed char) imm2;
}


/* Dump the given code sequence to the given file. */

void hh_output(hh_code_t *codes, FILE *code_fp, hh_output_type_t output_type,
	       int generate_debug_data, FILE *asm_fp)
{
  hh_code_t *code;
  hh_signed_word_t position;
  int has_changed, limit, i;
  size_t n_bytes, constant_pool_offset;
  unsigned char *program;
  hh_word_t h;
#define N_LOC_CHARS  50
  char loc[N_LOC_CHARS];
  const char *s;

  if (generate_debug_data) {
    /* Create into car of debug header a list of filenames of the
       source code.  The order of the filenames in the list is
       identical to the file indicator in the debug information. */
    hh_word_t *p, *debug_hdr = hh_constant_ctx.heap + 1;

    HH_ASSERT(debug_hdr[0] == HH_DEBUG_INFO_HDR_WORD);

    for (i = hh_n_files; i >= 0; i--) {
      hh_string_t *s = hh_ast_string(hh_filename[i], strlen(hh_filename[i]));
      if (s->string_ptr == HH_NIL) {
	hh_grow_constant_ctx(HH_STRING_N_WORDS(s->n_bytes));
	s->string_ptr = hh_box_string(&hh_constant_ctx, s->bytes, s->n_bytes);
      }
      HH_CONS(&hh_constant_ctx, p, debug_hdr[1], s->string_ptr, debug_hdr[1]);
    }
  }

  /* Assign positions to each byte code instruction.  The process is
     repeated until nothing changes.  In order to avoid endless
     changes, there is a slowly increasing limit to using shorter
     immediate fiels. */
  limit = -2;
  do {
    has_changed = 0;
    position = 0;
    for (code = codes; code != NULL; code = code->next) {
      if (code->position != position) {
	code->position = position;
	has_changed = 1;
      }
      switch (code->kind) {
      case HH_LABEL:
	break;
      case HH_INSN:
	if (code->u.insn < HH_START_OF_EXT_INSNS)
	  position++;
	else
	  position += 1 + hh_imm_width(code->u.insn - 256, 0);
	break;
      case HH_FN:
	position++;
	break;
      case HH_IMM:
	position += 1 + hh_imm_width(code->u.imm.value, 0);
	break;
      case HH_IMM2:
	position += 2 + hh_imm_width(code->u.imm.value, 0);
	break;
      case HH_BRANCH:
	position += 
	  1 + hh_imm_width(code->u.branch.target->position - position, limit);
	break;
      }
    }
    limit++;
  } while (has_changed);

  /* Adjust `limit' back to where it was during the last iteration of
     the positioning loop above. */
  limit--;

  /* Create the pc to filename:linenumber -mapping to the constant
     pool.  The mapping is described in the README.  It is stored
     byte-wise into a string so that possible byte reversal in the
     target won't affect it. */
  if (generate_debug_data) {
    hh_word_t *debug_data;
    unsigned char *debug_data_ptr, *debug_data_end;
    unsigned long debug_data_offset, debug_data_n_words;
    hh_signed_word_t prev_position;
    hh_ast_t *prev_ast, *prev_prev_ast;

    HH_ASSERT(hh_constant_ctx.heap[1] == HH_DEBUG_INFO_HDR_WORD);

    debug_data_n_words = 2;
    hh_grow_constant_ctx(debug_data_n_words);
    debug_data = HH_ALLOCATE(&hh_constant_ctx, debug_data_n_words);
    debug_data_offset = debug_data - hh_constant_ctx.heap;
    debug_data[0] = 0x0A;
    debug_data_ptr = (unsigned char *) (debug_data + 1);
    debug_data_end = (unsigned char *) (debug_data + 2);
    
    prev_prev_ast = NULL;
    prev_ast = codes->ast;
    prev_position = 0;
    for (code = codes->next; code != NULL; code = code->next) {
      if (prev_ast->file != code->ast->file
	  || prev_ast->line != code->ast->line
	  || code->position > prev_position + (0x7F - 8)) {
	/* Different source code location from the previous
	   instruction, therefore can't run-length-encode any more and
	   we need to flush the info to the constant pool. */
	if (prev_prev_ast != NULL
	    && prev_prev_ast->file == prev_ast->file
	    && prev_prev_ast->line <= prev_ast->line + 60
	    && prev_prev_ast->line + 60 >= prev_ast->line) {
	  /* Use a short, 2-byte signifier. */
	  if (debug_data_ptr + 2 > debug_data_end) {
	    /* Need more space to the constant pool. */
	    hh_word_t *old_heap = hh_constant_ctx.heap;
	    hh_grow_constant_ctx(1);
	    HH_ALLOCATE(&hh_constant_ctx, 1);
	    debug_data_ptr =
	      ((unsigned char *) hh_constant_ctx.heap)
	      + (debug_data_ptr - (unsigned char *) old_heap);
	    debug_data_end =
	      ((unsigned char *) hh_constant_ctx.heap)
	      + (debug_data_end - (unsigned char *) old_heap) + 4;
	  }
	  *debug_data_ptr++ = code->position - prev_position;
	  * (signed char *) debug_data_ptr++ =
	    prev_ast->line - (hh_signed_word_t) prev_prev_ast->line;
	  prev_prev_ast = prev_ast;
	  prev_ast = code->ast;
	  prev_position = code->position;
	} else {
	  /* Use a longer, 4-byte format. */
	  if (debug_data_ptr + 4 > debug_data_end) {
	    /* Need more space to the constant pool. */
	    hh_word_t *old_heap = hh_constant_ctx.heap;
	    hh_grow_constant_ctx(1);
	    HH_ALLOCATE(&hh_constant_ctx, 1);
	    debug_data_ptr =
	      ((unsigned char *) hh_constant_ctx.heap)
	      + (debug_data_ptr - (unsigned char *) old_heap);
	    debug_data_end =
	      ((unsigned char *) hh_constant_ctx.heap)
	      + (debug_data_end - (unsigned char *) old_heap) + 4;
	  }
	  *debug_data_ptr++ = 0x80 | (code->position - prev_position);
	  *debug_data_ptr++ = prev_ast->file;
	  *debug_data_ptr++ = prev_ast->line >> 8;
	  *debug_data_ptr++ = prev_ast->line & 0xFF;
	  prev_prev_ast = prev_ast;
	  prev_ast = code->ast;
	  prev_position = code->position;
	}
      }
    }

    /* Flush the last piece of debug info. */
    if (debug_data_ptr + 4 > debug_data_end) {
      /* Need more space to the constant pool. */
      hh_word_t *old_heap = hh_constant_ctx.heap;
      hh_grow_constant_ctx(1);
      HH_ALLOCATE(&hh_constant_ctx, 1);
      debug_data_ptr =
	((unsigned char *) hh_constant_ctx.heap)
	+ (debug_data_ptr - (unsigned char *) old_heap);
    }
    *debug_data_ptr++ = 0xFF;
    *debug_data_ptr++ = prev_ast->file;
    *debug_data_ptr++ = prev_ast->line >> 8;
    *debug_data_ptr++ = prev_ast->line & 0xFF;

    /* Make a sentinel entry, in case hh_print is given some bogus
       PC. */
    if (debug_data_ptr + 1 > debug_data_end) {
      /* Need more space to the constant pool. */
      hh_word_t *old_heap = hh_constant_ctx.heap;
      hh_grow_constant_ctx(1);
      HH_ALLOCATE(&hh_constant_ctx, 1);
      debug_data_ptr =
	((unsigned char *) hh_constant_ctx.heap)
	+ (debug_data_ptr - (unsigned char *) old_heap);
    }
    *debug_data_ptr++ = 0x7F;

    hh_constant_ctx.heap[3] = 
      HH_PTR_TO_WORD(&hh_constant_ctx, 
		     hh_constant_ctx.heap + debug_data_offset,
		     0x03);
  }


  /* Allocate memory for the whole binary image.
     `position' now contains the length of the byte code program. */
  constant_pool_offset = 12 + position;
  /* Align to word boundary. */
  if (constant_pool_offset & 0x3)
    constant_pool_offset += 0x4 - (constant_pool_offset & 0x3);
  n_bytes = constant_pool_offset + 
    (hh_constant_ctx.heap_ptr - hh_constant_ctx.heap) * sizeof(hh_word_t);
  hh_constant_ctx.program = program = malloc(n_bytes);
  if (program == NULL)
    hh_fatal(NULL, "Malloc failed for final program (%d bytes)", n_bytes);
  /* Zero all but the constant pool. */
  memset(program, 0, constant_pool_offset);

  /* Construct the program header, i.e. the 12 first bytes.  The
     checksum is computed later. */
  program[0] = 0x4E;
  program[1] = 0xD6;
  program[2] = 0xE4;
  program[3] = 0x06;

  program[8] = HH_BCODE_VERSION;
  HH_ASSERT((constant_pool_offset >> 24) == 0);
  program[9] = constant_pool_offset >> 16;
  program[10] = (constant_pool_offset >> 8) & 0xFF;
  program[11] = constant_pool_offset & 0xFF;

  for (code = codes; code != NULL; code = code->next) {
    if (asm_fp != NULL) {
      if (code->ast == NULL)
	strncpy(loc, "(compiler-originated)", N_LOC_CHARS);
      else {
	s = hh_filename[code->ast->file];
	if (strlen(s) > N_LOC_CHARS + 11)
	  snprintf(loc, N_LOC_CHARS, "(\"..%s\":%d)",
		   s + (strlen(s) - N_LOC_CHARS + 13), code->ast->line);
	else
	  snprintf(loc, N_LOC_CHARS, "(\"%s\":%d)", s, code->ast->line);
      }
      memset(loc + strlen(loc), ' ', N_LOC_CHARS - strlen(loc) - 1);
      loc[N_LOC_CHARS - 1] = '\0';
    }
    switch (code->kind) {
    case HH_LABEL:
      break;
    case HH_INSN:
      if (code->u.insn < HH_START_OF_EXT_INSNS) {
	program[12 + code->position] = code->u.insn;
	if (asm_fp != NULL)
	  fprintf(asm_fp, "%06ld %s %s\n",
		  (long) code->position, loc, hh_insn_names[code->u.insn]);
      } else {
	program[12 + code->position] = HH_IMM_ext;
	hh_imm_encode(program + 12 + code->position, code->u.insn - 256, 0);
	if (asm_fp != NULL)
	  fprintf(asm_fp, "%06ld %s %s\n",
		  (long) code->position, loc,
		  hh_ext_insn_names[code->u.insn - 256]);
      }
      break;
    case HH_IMM:
      program[12 + code->position] = code->u.imm.insn;
      hh_imm_encode(program + 12 + code->position, code->u.imm.value, 0);
      if (asm_fp != NULL)
	fprintf(asm_fp, "%06ld %s %s %ld\n",
		(long) code->position, loc,
		hh_imm_names[code->u.imm.insn], (long) code->u.imm.value);
      break;
    case HH_IMM2:
      program[12 + code->position] = code->u.imm2.insn;
      hh_imm2_encode(program + 12 + code->position,
		     code->u.imm2.value1, code->u.imm2.value2, 0);
      if (asm_fp != NULL)
	fprintf(asm_fp, "%06ld %s %s %ld, %ld\n",
		(long) code->position, loc,
		hh_imm_names[code->u.imm2.insn],
		(long) code->u.imm2.value1,
		(long) code->u.imm2.value2);
      break;
    case HH_BRANCH:
      program[12 + code->position] = code->u.branch.insn;
      hh_imm_encode(program + 12 + code->position,
		    code->u.branch.target->position - code->position, limit);
      if (asm_fp != NULL)
	fprintf(asm_fp, "%06ld %s %s %ld\n",
		(long) code->position, loc,
		hh_imm_names[code->u.branch.insn],
		(long) code->u.branch.target->position);
      break;
    case HH_FN:
      program[12 + code->position] =
	(code->u.fn.allow_excess_args << 7) | code->u.fn.n_args;
      if (asm_fp != NULL)
	fprintf(asm_fp, "%06ld %s arity %s %ld\n",
		(long) code->position, loc,
		code->u.fn.allow_excess_args ? ">=" : "=",
		(long) code->u.fn.n_args);
      /* Patch the function object in the constant pool to refer to
	 this byte code insn. */
      {
	hh_word_t *p = HH_WORD_TO_PTR(&hh_constant_ctx,
				      code->u.fn.symbol->fn_ptr);
	HH_ASSERT(HH_CAR(p) == HH_NIL);
	HH_CAR(p) = HH_PC_TO_WORD(&hh_constant_ctx,
				  &program[12 + code->position]);
      }
      break;
    }
  }

  /* Copy the constant pool to its place. */
  memcpy(program + constant_pool_offset, hh_constant_ctx.heap,
	 n_bytes - constant_pool_offset);

  /* Compute the checksum. */
  h = HH_INSN_COOKIE;
  for (i = 8; i < n_bytes; i++) {
    h += program[i];
    h += h << 10;
    h ^= h >> 7;
  }
  program[4] = h >> 24;
  program[5] = (h >> 16) & 0xFF;
  program[6] = (h >> 8) & 0xFF;
  program[7] = h & 0xFF;

  /* Finally, write the byte code program. */
  switch (output_type) {
  case HH_BYTECODE:
    if (fwrite(program, 1, n_bytes, code_fp) != n_bytes)
      fprintf(stderr,
	      "Writing the final byte code program may have failed.\n");
    break;
  case HH_HEX:
    {
      unsigned char *p = program;
      int i;

      while (p < program + n_bytes) {
	for (i = 0; i < 24 && p < program + n_bytes; p++, i++)
	  fprintf(code_fp, "%02x", *p);
	fputc('\n', code_fp);
      }
      fflush(code_fp);
    }
    break;
  case HH_HEX_C:
    {
      unsigned char *p = program;
      int i;

      fprintf(code_fp, "static union {\n\
  unsigned char code[%d];\n\
  hh_word_t align; /* Force word alignment */\n\
} hh_bootstrap = {\n\
  {", n_bytes);
      while (p < program + n_bytes) {
	fputs("\n   ", code_fp);
	for (i = 0; i < 12 && p < program + n_bytes; p++, i++)
	  fprintf(code_fp, " 0x%02x,", *p);
      }
      fputs("\n  },\n};\n", code_fp);
      fflush(code_fp);
    }
    break;
  default:
    HH_NOTREACHED;
  }
}


void hh_dump_codes(hh_code_t *codes)
{
  hh_code_t *code;
#define N_LOC_CHARS  50
  char loc[N_LOC_CHARS];

  for (code = codes; code != NULL; code = code->next) {
    snprintf(loc, N_LOC_CHARS, "0x%08lX  %d  ", 
    	     (unsigned long) code, code->kind);
    switch (code->kind) {
    case HH_LABEL:
      fprintf(stderr, "%s  LABEL\n", loc);
      break;
    case HH_INSN:
      if (code->u.insn > HH_START_OF_EXT_INSNS)
	fprintf(stderr, "%s    %s\n", loc,
		hh_ext_insn_names[code->u.insn - 256]);
      else
	fprintf(stderr, "%s    %s\n", loc, hh_insn_names[code->u.insn]);
      break;
    case HH_IMM:
      fprintf(stderr, "%s    %s %ld\n", loc, hh_imm_names[code->u.imm.insn],
	      (long) code->u.imm.value);
      break;
    case HH_IMM2:
      fprintf(stderr, "%s    %s %ld %ld\n", 
	      loc, hh_imm_names[code->u.imm2.insn],
	      (long) code->u.imm2.value1, (long) code->u.imm2.value2);
      break;
    case HH_BRANCH:
      fprintf(stderr, "%s    %s 0x%08lX\n", loc,
	      hh_imm_names[code->u.branch.insn],
	      (unsigned long) code->u.branch.target);
      break;
    case HH_FN:
      fprintf(stderr, "%s  FN %s %d\n", loc,
	      code->u.fn.allow_excess_args ? ">=" : "=",
	      code->u.fn.n_args);
      break;
    }
  }
}