/*
 * valid_ptr - returns true if p points to allocated memory and
 * has at least size available
 */
int valid_ptr(const void* p, size_t size)
{
  BlkHdr* bh;
  assert(0 != p);
  assert(0 < size);

  bh = find_blk(p);
  /*
   * check that there are at least size bytes available from p
   */
  assert((BYTE_PTR(p) + size) <= (BYTE_PTR(bh->buf) + bh->size));
  return 1;
}
/*
 * find_blk_exhaustive - find a block by scanning the
 * entire hash table. This function finds blocks that do not
 * start at the pointer returned from Malloc.
 */
static BlkHdr* find_blk_exhaustive(const void* p)
{
  int i;
  BlkHdr* bh;

  for (i = 0; i < HTABLE_SIZE; ++i) {
    for (bh = bhTab[i]; bh; bh = bh->next) {
      if (bh->buf <= p && BYTE_PTR(p) < (BYTE_PTR(bh->buf) + bh->size))
        return bh;
    }
  }
  return 0;
}
/*
 * fda_free - check chunk of memory for overruns and free it
 */
void fda_free(void* p)
{
  if (p) {
    size_t size;
    BlkHdr* bh = find_blk(p);
    void*   bp;

    /* p already freed or not allocated? */
    assert(0 != bh);
    assert(p == bh->buf);

    bp = BASE_PTR(p);
    /* buffer underflow? */
    assert(DEADBEEF == *((size_t*) bp));
    /* 
     * buffer overflow?
     * Note: it's possible to have up to 3 bytes of unchecked space 
     * between size and DEADBEEF
     */
    size = BASE_SIZE(bh->size);
    assert(DEADBEEF == *((size_t*)(BYTE_PTR(bp) + size - S_SIZE)));
    SHRED_MEM(bp, size);

    free_blk(p);
    free(bp);
  }
}
/*
 * fda_realloc - resize a buffer, force reallocation if new size is
 * larger than old size
 */
void* fda_realloc(void* p, size_t size, const char* file, int line)
{
  void* np;
  size_t old_size;
  size_t blk_size;
  /* 
   * don't allow malloc or free through realloc 
   */
  assert(0 != p);
  assert(0 < size);
  old_size = fda_sizeof(p);
  
  if (size < old_size)
    SHRED_MEM(BYTE_PTR(p) + size, old_size - size);
  else if (size > old_size) {
    void* t = fda_malloc(size, __FILE__, __LINE__);
    memmove(t, p, old_size);
    fda_free(p);
    p = t;
  }
  blk_size = BASE_SIZE(size);

  if ((np = realloc(BASE_PTR(p), blk_size)) == 0) {
    lowMemFn();
    if ((np = realloc(BASE_PTR(p), blk_size)) == 0)
      noMemFn();
  }
  /* 
   * don't allow noMemFn to return 
   */
  assert(0 != np);

  *((size_t*)(BYTE_PTR(np) + blk_size - S_SIZE)) = DEADBEEF;

  np = BYTE_PTR(np) + S_SIZE;
  update_blk(p, np, size, file, line);
  /* 
   * shred tail 
   */
  if (size > old_size)
    SHRED_MEM(BYTE_PTR(np) + old_size, size - old_size);

  return np;
}
Beispiel #5
0
uptr_t exec_special(uptr_t *env, uptr_t form) {
  uptr_t fn = CAR(form);
  uptr_t args = CDR(form);

  switch(SVAL(fn)) {
  case S_LET:
    return let(env, args);

  case S_FN:
    return form;

  case S_LOOP:
    return loop(env, args);

  case S_DO: {
    uptr_t *body_p = refer(args), rval = NIL;

    while (*body_p) {
      rval = eval(env, CAR(*body_p));
      *body_p = CDR(*body_p);
    }
    release(1); // body_p
    return rval;
  }

  case S_RECUR: {
    uptr_t rval, *fn_p = refer(fn);
    rval = build_cons(*fn_p, eval_list(env, args));
    release(1); // fn_p
    return rval;
  }

  case S_QUOTE:
    return CAR(args);

  case S_CAR:
    return CAR(eval(env, CAR(args)));

  case S_CDR:
    return CDR(eval(env, CAR(args)));

  case S_AND: {
    if (IS_NIL(args)) return PS_TRUE;
    uptr_t *rem_args = refer(args),
      rval = NIL;
    while ((rval = eval(env, CAR(*rem_args))) && (*rem_args = CDR(*rem_args)));
    release(1);
    return rval;
  }

  case S_OR: {
    if (IS_NIL(args)) return NIL;
    uptr_t *rem_args = refer(args),
      rval = NIL;
    while (!(rval = eval(env, CAR(*rem_args))) && (*rem_args = CDR(*rem_args)));
    release(1);
    return rval;
  }

  case S_NOT: {
    if (IS_NIL(args)) return NIL;
    uptr_t rval = eval(env, CAR(args));
    return rval ? NIL : PS_TRUE;
  }

  case S_IF: {
    uptr_t rval = NIL, *clauses = refer(args);

    if (eval(env, CAR(*clauses)) && CDR(*clauses))
      rval = eval(env, CADR(*clauses));
    else if (CDDR(*clauses))
      rval = eval(env, CADDR(*clauses));

    release(1); // clauses
    return rval;
  }

  case S_WHEN: {
    uptr_t rval = NIL, *cond_p = refer(CAR(args)), *body_p = refer(CDR(args));

    if (eval(env, *cond_p))
      while(*body_p) {
        rval = eval(env, CAR(*body_p));
        *body_p = CDR(*body_p);
      }

    release(2); // cond_p, body_p
    return rval;
  }

  case S_CONS: {
    uptr_t rval = NIL, *args_p = refer(args);
    rval = build_cons(eval(env, CAR(*args_p)), eval(env, CADR(*args_p)));
    release(1); // args_p
    return rval;
  }

  case S_PRINT:
    print_form(eval(env, CAR(args)));
    printf_P(PSTR("\n"));
    return NIL;

  case S_DEF: {
    uptr_t *args_p = refer(args),
      *binding = refer(eval(env, CADR(args)));
    assoc(env, CAR(*args_p), *binding);
    release(2); // args_p, binding
    return *binding; // Yeah, it's been "released", but the pointer is still valid.
  }

  case S_EVAL:
    return eval(env, eval(env, CAR(args)));

#define _COMPR(rval) {                                                  \
      if (IS_NIL(args)) return NIL;                                     \
                                                                        \
      uptr_t *args_p = refer(args);                                     \
      while(CDR(*args_p) && (eval(env, CAR(*args_p)) _COMP_OPR eval(env, CADR(*args_p)))) \
        *args_p = CDR(*args_p);                                         \
                                                                        \
      if (IS_NIL(CDR(*args_p)))                                         \
        rval = eval(env, CAR(*args_p));                                 \
      release(1);                                                       \
    }

#define _COMP_OPR ==
  case S_EQL: {
    uptr_t rval = NIL;
    _COMPR(rval);
    return rval;
  }

  case S_NEQL: {
    uptr_t rval = NIL;
    _COMPR(rval);
    return rval ? NIL : PS_TRUE;
  }
#undef _COMP_OPR

#define _COMP_OPR <
  case S_LT: {
    uptr_t rval = NIL;
    _COMPR(rval);
    return rval;
  }
#undef _COMP_OPR

#define _COMP_OPR <=
  case S_LTE: {
    uptr_t rval = NIL;
    _COMPR(rval);
    return rval;
  }
#undef _COMP_OPR

#define _COMP_OPR >
  case S_GT: {
    uptr_t rval = NIL;
    _COMPR(rval);
    return rval;
  }
#undef _COMP_OPR

#define _COMP_OPR >=
  case S_GTE: {
    uptr_t rval = NIL;
    _COMPR(rval);
    return rval;
  }
#undef _COMP_OPR

#define _ARITH(coll) {                                          \
      uptr_t *rem_args = refer(args);                           \
      coll = TO_INT(eval(env, CAR(*rem_args)));                 \
      *rem_args = CDR(*rem_args);                               \
      while (*rem_args) {                                       \
        coll _ARITH_OPR TO_INT(eval(env, CAR(*rem_args)));      \
        *rem_args = CDR(*rem_args);                             \
      }                                                         \
      release(1);                                               \
    }

#define _ARITH_OPR +=
  case S_PLUS: {
    if (! args) return INTERN_INT(0);
    if (! CDR(args)) return eval(env, CAR(args));
    int rval;
    _ARITH(rval);
    return INTERN_INT(rval);
  }
#undef _ARITH_OPR

#define _ARITH_OPR -=
  case S_MINUS: {
    if (! args) return NIL;
    if (! CDR(args)) return INTERN_INT(0 - TO_INT(eval(env, CAR(args))));
    int rval;
    _ARITH(rval);
    return INTERN_INT(rval);
  }
#undef _ARITH_OPR

#define _ARITH_OPR *=
  case S_MULT: {
    if (! args) return INTERN_INT(1);
    if (! CDR(args)) return eval(env, CAR(args));
    int rval;
    _ARITH(rval);
    return INTERN_INT(rval);
  }
#undef _ARITH_OPR

#define _ARITH_OPR /=
  case S_DIV: {
    if (! args) return NIL;
    if (! CDR(args)) return INTERN_INT(eval(env, CAR(args)) == INTERN_INT(1) ? 1 : 0);
    int rval;
    _ARITH(rval);
    return INTERN_INT(rval);
  }
#undef _ARITH_OPR

#define _ARITH_OPR &=
  case S_BAND: {
    if (! args) return NIL;
    if (! CDR(args)) return eval(env, CAR(args));
    uint8_t rval;
    _ARITH(rval);
    return INTERN_INT((int)rval);
  }
#undef _ARITH_OPR

#define _ARITH_OPR |=
  case S_BOR: {
    if (! args) return NIL;
    if (! CDR(args)) return eval(env, CAR(args));
    uint8_t rval;
    _ARITH(rval);
    return INTERN_INT((int)rval);
  }
#undef _ARITH_OPR

#define _ARITH_OPR ^=
  case S_BXOR: {
    if (! args) return NIL;
    if (! CDR(args)) return eval(env, CAR(args));
    uint8_t rval;
    _ARITH(rval);
    return INTERN_INT((int)rval);
  }
#undef _ARITH_OPR

#define _ARITH_OPR <<=
  case S_BSL: {
    if (! args) return NIL;
    if (! CDR(args)) return eval(env, CAR(args));
    uint8_t rval;
    _ARITH(rval);
    return INTERN_INT((int)rval);
  }
#undef _ARITH_OPR

#define _ARITH_OPR >>=
  case S_BSR: {
    if (! args) return NIL;
    if (! CDR(args)) return eval(env, CAR(args));
    uint8_t rval;
    _ARITH(rval);
    return INTERN_INT((int)rval);
  }
#undef _ARITH_OPR

  case S_SREG: {
    uptr_t *args_p = refer(args),
      reg = eval(env, CAR(*args_p));
    if (IS_REG(reg))
      *BYTE_PTR(reg) = eval(env, CADR(*args_p));
    else {
      printf_P(PSTR("Invalid register: "));
      print_form(reg);
      printf_P(PSTR("\n"));
    }
    release(1); // args_p
    return NIL;
  }

  case S_SLP:
    _delay_ms(TO_INT(eval(env, CAR(args))));
    return NIL;

  default:
    printf_P(PSTR("ERROR: "));
    print_form(fn);
    printf_P(PSTR(" is not a function.\n"));
    return NIL;
  }
}
/*
 * fda_malloc - allocate size chunk of memory and create debug
 * records for it.
 */
void* fda_malloc(size_t size, const char* file, int line)
{
  void* p;
  size_t blk_size;
  Location* location;

  assert(0 < size);
  assert(0 != file);
  assert(sizeof(void*) == sizeof(size_t));

  /*
   * memory limiter do not allocate more than byteLimit
   */
  if ((size + byteCount) > byteLimit)
    return 0;

  /* 
   * Make sure that there is enough room for prefix/postfix 
   * and we get an aligned buffer 
   */
  blk_size = BASE_SIZE(size);

  if ((p = malloc(blk_size)) == 0) {
    lowMemFn();
    if ((p = malloc(blk_size)) == 0)
      noMemFn();
  }
  /* 
   * don't allow malloc to fail 
   */
  assert(0 != p);
  /* 
   * shred the memory and set bounds markers 
   */
  SHRED_MEM(p, blk_size);
  *((size_t*) p) = DEADBEEF;
  *((size_t*) (BYTE_PTR(p) + blk_size - S_SIZE)) = DEADBEEF;

  /* 
   * find the location or create a new one 
   */
  if (0 == (location = findLocation(file, line))) {
    if (0 == (location = addLocation(file, line))) {
      free(p);
      noMemFn();
    }
  }
  /* 
   * don't allow noMemFn to return 
   */
  assert(0 != location);
  if (!make_blk(BYTE_PTR(p) + S_SIZE, size, location)) {
    if (0 == location->count)
      freeLocation(location);
    free(p);
    p = 0;
    noMemFn();
  }
  /* 
   * don't allow noMemFn to return 
   */
  assert(0 != p);
  return (BYTE_PTR(p) + S_SIZE);
}