Beispiel #1
0
// eval_sequence may return an object with a refcount of zero.
// This is because it's the interface to the interpreter and so the
// return value may be the result of a computation that only has
// one reference inside the created vm context.  On the other hand
// it may return an object with multiple references (if the object
// returned is referenced in the passed environment, for example).
struct object *
eval_sequence(struct pair *forms, struct environment *env)
{
  struct code *prog = compile(forms);
  INC_REF(&prog->obj);
  struct codeptr *pc = make_codeptr(prog, 0);
  INC_REF(&pc->obj);
  struct stack *stk = make_stack(1024);
  // push magic "end of instructions" return address
  stack_push(stk, NULL);
  stack_push(stk, &env->obj);
  INC_REF(&env->obj);
  struct vm_context *ctx = make_vm_context(pc, stk, env);
  INC_REF(&ctx->obj);
  struct vm_context **pctx = &ctx;

  eval_instructions(pctx);
  struct object *value = stack_pop((*pctx)->stk);

  // decrement the refcount if it's positive, but don't deallocate
  // the object
  if (value->refcount > 0) {
    --(value->refcount);
  }

  DEC_REF(&prog->obj);
  assert(stack_empty((*pctx)->stk));
  DEC_REF(&ctx->obj);
  return value;
}
Beispiel #2
0
int
main(int argc, char* argv[])
{
  init_symbol_table();
  init_builtin_types();
  init_global_env();
  init_singleton_objects();
  init_primitive_procs();

  struct vm_context *global_ctx = make_vm_context(NULL, NULL,
                                                  global_env);
  INC_REF(&global_ctx->obj);
  struct vm_context **pctx = &global_ctx;
  struct object *value;
  value = load("prelude.scm", pctx);
  YIELD_OBJ(value);

  init_compiler();

  value = load("stage2.scm", pctx);
  YIELD_OBJ(value);

  struct vm_context *repl_ctx;
  repl_ctx = make_vm_context(NULL, make_stack(1024),
                             make_environment(global_env));
  INC_REF(&repl_ctx->obj);
  pctx = &repl_ctx;

  struct object *ret = env_lookup(global_env, "initial-repl");
  assert(ret->type->code == PROCEDURE_TYPE);
  struct procedure *repl = container_of(ret, struct procedure, obj);
  apply_and_run(repl, NIL, pctx);

  return 0;
}
BLEIO_SEQ_RESULT schedule_write(
    BLEIO_SEQ_HANDLE_DATA* handle_data,
    BLEIO_SEQ_INSTRUCTION* instruction,
    ON_INTERNAL_IO_COMPLETE on_internal_read_complete
)
{
    BLEIO_SEQ_RESULT result;
    WRITE_CONTEXT* context = (WRITE_CONTEXT*)malloc(sizeof(WRITE_CONTEXT));

    /*Codes_SRS_BLEIO_SEQ_13_014: [ BLEIO_Seq_Run shall return BLEIO_SEQ_ERROR if an underlying platform call fails. ]*/
    if (context == NULL)
    {
        LogError("malloc failed");
        result = BLEIO_SEQ_ERROR;
    }
    else
    {
        context->handle_data = handle_data;
        context->instruction = instruction;
        context->on_internal_read_complete = on_internal_read_complete;

        const unsigned char* buffer = BUFFER_u_char(instruction->data.buffer);
        size_t buffer_size = BUFFER_length(instruction->data.buffer);

        // add ref to the handle data object since we now will have an
        // outstanding I/O operation; the reason why we increment the
        // reference here as opposed to when we know that BLEIO_gatt_read_char_by_uuid
        // was successful is because the operation could potentially complete
        // even before we hit the if check after this call and 'on_read_complete'
        // might have run by then in which case it would have done a DEC_REF and
        // the ref counts will be out of whack
        INC_REF(BLEIO_SEQ_HANDLE_DATA, handle_data);

        int write_result = BLEIO_gatt_write_char_by_uuid(
            handle_data->bleio_gatt_handle,
            STRING_c_str(instruction->characteristic_uuid),
            buffer,
            buffer_size,
            on_write_complete,
            context
        );
        if (write_result != 0)
        {
            /*Codes_SRS_BLEIO_SEQ_13_014: [ BLEIO_Seq_Run shall return BLEIO_SEQ_ERROR if an underlying platform call fails. ]*/
            result = BLEIO_SEQ_ERROR;
            free(context);
            DEC_REF(BLEIO_SEQ_HANDLE_DATA, handle_data);
            LogError("BLEIO_gatt_write_char_by_uuid failed with %d.", write_result);
        }
        else
        {
            result = BLEIO_SEQ_OK;
        }
    }

    return result;
}
POS_HANDLE Pos_Clone(POS_HANDLE posHandle)
{
    
    if (posHandle != NULL)
    {
        pos* p = posHandle;
        INC_REF(pos, p);
    }
    return posHandle;
}
void Broker_IncRef(BROKER_HANDLE broker)
{
    /*Codes_SRS_BROKER_13_108: [If `broker` is NULL then Broker_IncRef shall do nothing.]*/
    if (broker == NULL)
    {
        LogError("invalid arg: broker is NULL");
    }
    else
    {
        /*Codes_SRS_BROKER_13_109: [Otherwise, Broker_IncRef shall increment the internal ref count.]*/
        INC_REF(BROKER_HANDLE_DATA, broker);
    }
}
void constbuffer_array_inc_ref(CONSTBUFFER_ARRAY_HANDLE constbuffer_array_handle)
{
    if (constbuffer_array_handle == NULL)
    {
        /* Codes_SRS_CONSTBUFFER_ARRAY_01_017: [ If `constbuffer_array_handle` is `NULL` then `constbuffer_array_inc_ref` shall return. ]*/
        LogError("invalid argument CONSTBUFFER_ARRAY_HANDLE constbuffer_array_handle=%p", constbuffer_array_handle);
    }
    else
    {
        /* Codes_SRS_CONSTBUFFER_ARRAY_01_018: [ Otherwise `constbuffer_array_inc_ref` shall increment the reference count for `constbuffer_array_handle`. ]*/
        INC_REF(CONSTBUFFER_ARRAY_HANDLE_DATA, constbuffer_array_handle);
    }
}
CONSTBUFFER_HANDLE CONSTBUFFER_Clone(CONSTBUFFER_HANDLE constbufferHandle)
{
    if (constbufferHandle == NULL)
    {
        /*Codes_SRS_CONSTBUFFER_02_013: [If constbufferHandle is NULL then CONSTBUFFER_Clone shall fail and return NULL.]*/
        LogError("invalid arg");
    }
    else
    {
        /*Codes_SRS_CONSTBUFFER_02_014: [Otherwise, CONSTBUFFER_Clone shall increment the reference count and return constbufferHandle.]*/
        INC_REF(CONSTBUFFER_HANDLE_DATA, constbufferHandle);
    }
    return constbufferHandle;
}
Beispiel #8
0
CONSTMAP_HANDLE ConstMap_Clone(CONSTMAP_HANDLE handle)
{
	/*Codes_SRS_CONSTMAP_17_038: [ConstMap_Clone returns NULL if parameter handle is NULL.] */
	if (handle == NULL)
	{
		LOG_CONSTMAP_ERROR(CONSTMAP_INVALIDARG);
	}
	else
    {
		/*Codes_SRS_CONSTMAP_17_039: [ConstMap_Clone shall increase the internal reference count of the immutable map indicated by parameter handle]*/
		/*Codes_SRS_CONSTMAP_17_050: [ConstMap_Clone shall return the non-NULL handle. ]*/
		INC_REF(CONSTMAP_HANDLE_DATA, handle);
    }
    return (handle);
}
Beispiel #9
0
struct symbol *
get_symbol(char *name)
{
  struct symbol *sym;
  int i;
  int size = array_size(&symbol_table);
  for (i = 0; i < size; ++i) {
    sym = *(struct symbol**) array_ref(&symbol_table, i);
    if (strcmp(name, sym->value) == 0) {
      return sym;
    }
  }

  sym = make_symbol(strdup(name));
  INC_REF(&sym->obj);
  array_add(&symbol_table, &sym);
  return sym;
}
Beispiel #10
0
struct vm_context *
clone_context(struct vm_context *ctx)
{
  struct codeptr *new_pc = make_codeptr(ctx->pc->base,
                                        ctx->pc->offset);

  struct stack *new_stack = make_stack(ctx->stk->size);
  int i;
  for (i = 0; i < ctx->stk->top; ++i) {
    stack_push(new_stack, ctx->stk->elems[i]);
    if (ctx->stk->elems[i]) {
      INC_REF(ctx->stk->elems[i]);
    }
  }

  struct vm_context *new_ctx;
  new_ctx = make_vm_context(new_pc, new_stack, ctx->env);
  return new_ctx;
}  
Beispiel #11
0
MESSAGE_HANDLE Message_Clone(MESSAGE_HANDLE message)
{
    
    if (message == NULL)
    {
        LogError("invalid arg: message is NULL");
        /*Codes_SRS_MESSAGE_02_007: [If messageHandle is NULL then Message_Clone shall return NULL.] */
    }
    else
    {
        /*Codes_SRS_MESSAGE_02_008: [Otherwise, Message_Clone shall increment the internal ref count.] */
        INC_REF(MESSAGE_HANDLE_DATA, message);
        MESSAGE_HANDLE_DATA* messageData = (MESSAGE_HANDLE_DATA*)message;
		/*Codes_SRS_MESSAGE_17_001: [Message_Clone shall clone the CONSTMAP handle.]*/
		(void)ConstMap_Clone(messageData->properties);
		/*Codes_SRS_MESSAGE_17_004: [Message_Clone shall clone the CONSTBUFFER handle]*/
		(void)CONSTBUFFER_Clone(messageData->content);
    }
    /*Codes_SRS_MESSAGE_02_010: [Message_Clone shall return messageHandle.]*/
    return message;
}
Beispiel #12
0
struct object *
invoke_continuation(struct object *cont, struct object *value,
                    struct vm_context **ctx)
{
  if (cont->type->code != CONTINUATION_TYPE) {
    printf("Wrong type for invoke-continuation: %s\n",
           cont->type->name);
    exit(1);
  }

  struct vm_context *new_ctx;
  new_ctx = container_of(cont, struct vm_context, obj);

  struct vm_context *clone = clone_context(new_ctx);
  INC_REF(&clone->obj);

  /* XXX: */
  /* DEC_REF(&(*ctx)->obj); */
  *ctx = clone;

  return value;
}
Beispiel #13
0
struct object *
call_cc(struct object *proc, struct vm_context **ctx)
{
  if (proc->type->code != PROCEDURE_TYPE) {
    printf("Wrong type for call/cc: %s\n",
           proc->type->name);
    exit(1);
  }

  // this is an awful hack.  we're using the same call
  // instruction that invoked call_cc to invoke the passed procedure
  struct vm_context *new_ctx = clone_context(*ctx);
  INC_REF(&new_ctx->obj);

  struct vm_context *old_ctx = *ctx;
  *ctx = new_ctx;

  struct pair *args = make_pair(&old_ctx->obj, &NIL->obj);

  apply(container_of(proc, struct procedure, obj), args, ctx);
  YIELD_OBJ(&args->obj);

  return NULL;
}
Beispiel #14
0
int
eval_instruction(struct vm_context **ctx)
{
  struct symbol *sym;
  struct object *value;
  struct compound_proc *template;

  switch (INS_AT((*ctx)->pc)->op) {
  case NONE:
    printf("Error: tried to execute a NONE op\n");
    exit(1);
    break;
  case PUSH:
    /* printf("PUSH instruction\n"); */
    stack_push((*ctx)->stk, INS_AT((*ctx)->pc)->arg);
    INC_REF(INS_AT((*ctx)->pc)->arg);
    ++(*ctx)->pc->offset;
    break;
  case POP:
    /* printf("POP instruction\n"); */
    value = stack_pop((*ctx)->stk);
    DEC_REF(value);
    ++(*ctx)->pc->offset;
    break;
  case LOOKUP:
    /* printf("LOOKUP instruction\n"); */
    assert(INS_AT((*ctx)->pc)->arg->type->code == SYMBOL_TYPE);
    sym = container_of(INS_AT((*ctx)->pc)->arg, struct symbol, obj);
    value = env_lookup((*ctx)->env, sym->value);
    if (! value) {
      char buf[1024];
      debug_loc_str(INS_AT((*ctx)->pc)->arg, buf, 1024);
      printf("%s: unbound name: %s\n", buf, sym->value);
      exit(1);
    }
    stack_push((*ctx)->stk, value);
    INC_REF(value);
    ++(*ctx)->pc->offset;
    break;
  case CALL:
  case TAILCALL:
    /* printf("CALL instruction @ %p\n", *pc); */
    eval_call(ctx);
    break;
  case RET:
    value = stack_pop((*ctx)->stk);
    struct object *orig_env = stack_pop((*ctx)->stk);
    assert(orig_env->type->code == ENVIRONMENT_TYPE);
    DEC_REF(orig_env);
    struct object *retaddr = stack_pop((*ctx)->stk);
    /* printf("RET instruction @ %p to %p\n", *pc, retaddr->cval); */
    stack_push((*ctx)->stk, value);
    DEC_REF(&(*ctx)->env->obj);
    (*ctx)->env = container_of(orig_env, struct environment, obj);
    if (retaddr == NULL) {
      (*ctx)->pc = NULL;
      return 1;
    }
    assert(retaddr->type->code == CODEPTR_TYPE);
    *(*ctx)->pc = *container_of(retaddr, struct codeptr, obj);
    /* XXX: */
    /* DEC_REF(retaddr); */
    break;
  case DEFINE:
    /* printf("DEFINE instruction\n"); */
    value = stack_pop((*ctx)->stk);
    assert(INS_AT((*ctx)->pc)->arg->type->code == SYMBOL_TYPE);
    sym = container_of(INS_AT((*ctx)->pc)->arg, struct symbol, obj);
    env_define((*ctx)->env, sym->value, value);
    DEC_REF(value);
    ++(*ctx)->pc->offset;
    break;
  case SET:
    value = stack_pop((*ctx)->stk);
    assert(INS_AT((*ctx)->pc)->arg->type->code == SYMBOL_TYPE);
    sym = container_of(INS_AT((*ctx)->pc)->arg, struct symbol, obj);
    env_set((*ctx)->env, sym->value, value);
    DEC_REF(value);
    ++(*ctx)->pc->offset;
    break;
  case LAMBDA:
    /* printf("LAMBDA instruction\n"); */
    value = INS_AT((*ctx)->pc)->arg;
    assert(INS_AT((*ctx)->pc)->arg->type->code == PROCEDURE_TYPE);