Beispiel #1
0
PUBLIC void vm_raise(VMSTATE vms, OBJ exception, OBJ arg) {
  if (vms->r->vm_trap_closure != NULL) {
    VECTOR argvec = newvector_noinit(5);

    push_frame(vms);

#ifdef DEBUG
    printf("%p raising %s\n", current_thread, ((BVECTOR) AT((OVECTOR) exception, SY_NAME))->vec);
#endif

    ATPUT(argvec, 0, NULL);
    ATPUT(argvec, 1, exception);
    ATPUT(argvec, 2, arg);
    ATPUT(argvec, 3, (OBJ) getcont_from(vms));
    ATPUT(argvec, 4, vms->r->vm_acc);

    vms->c.vm_top = 0;
    apply_closure(vms, vms->r->vm_trap_closure, argvec);
    vms->r->vm_frame = NULL;	/* If it ever returns, the thread dies. */
  } else {
    if (OVECTORP(exception) && ((OVECTOR) exception)->type == T_SYMBOL)
      fprintf(stderr, "excp sym = '%s\n", ((BVECTOR) AT((OVECTOR) exception, SY_NAME))->vec);
    if (OVECTORP(arg) && ((OVECTOR) arg)->type == T_SYMBOL)
      fprintf(stderr, "arg sym = '%s\n", ((BVECTOR) AT((OVECTOR) arg, SY_NAME))->vec);
    if (BVECTORP(arg))
      fprintf(stderr, "arg str = %s\n", ((BVECTOR) arg)->vec);
    fprintf(stderr,
	    "Exception raised, no handler installed -> vm death.\n");
    vms->c.vm_state = VM_STATE_DYING;
  }
}
Beispiel #2
0
PUBLIC OVECTOR getcont_from(VMSTATE vms) {
  OVECTOR cont;
  VECTOR cstk;
  int i;

  cont = newovector_noinit(CONT_MAXSLOTINDEX, T_CONTINUATION);
  ATPUT(cont, CONT_FRAME, (OBJ) vms->r->vm_frame);
  cstk = newvector_noinit(vms->c.vm_top);
  ATPUT(cont, CONT_STACK, (OBJ) cstk);

  for (i = 0; i < vms->c.vm_top; i++)
    ATPUT(cstk, i, AT(vms->r->vm_stack, i));

  return cont;
}
Beispiel #3
0
PRIVATE void compile_main(FILE *conni, FILE *conno) {
  REPL_DATA rd = allocmem(sizeof(repl_data));
  VMstate vms;

  rd->h1 = rd->h2 = NULL;

  protect(&rd->h1);
  protect(&rd->h2);

  rd->vmregs = (VMREGS) newvector(NUM_VMREGS);	/* dodgy casting :-) */
  vms.r = rd->vmregs;
  protect((OBJ *)(&rd->vmregs));

  init_vm(&vms);
  vms.c.vm_state = VM_STATE_NOQUOTA;

  while (vms.c.vm_state != VM_STATE_DYING) {
    ScanInst si;
    char buf[16384];

    rd->h1 = (OBJ) newbvector(0);

    while (1) {
      char *result;

      result = fgets(buf, 256, conni);

      if (result == NULL)
	break;

      while (1) {
	int l = strlen(buf);
	if (buf[l-1] == '\r' || buf[l-1] == '\n')
	  buf[l-1] = '\0';
	else
	  break;
      }
      strcat(buf, "\n");

      if (!strcmp(buf, ".\n"))
	break;

      rd->h2 = (OBJ) newstring(buf);
      rd->h1 = (OBJ) bvector_concat((BVECTOR) rd->h1, (BVECTOR) rd->h2);
    }

    gc_reach_safepoint();

    rd->h2 = (OBJ) newstringconn((BVECTOR) rd->h1);
    fill_scaninst(&si, (OVECTOR) rd->h2);

    while (!conn_closed((OVECTOR) rd->h2)) {
      rd->h1 = (OBJ) parse(&vms, &si);
      gc_reach_safepoint();

      if (rd->h1 == NULL) {
	sprintf(buf, "-->! the compiler returned NULL.\n");
      } else {
	vms.c.vm_state = VM_STATE_NOQUOTA;

	ATPUT((OVECTOR) rd->h1, ME_OWNER, (OBJ) vms.r->vm_uid);
	vms.r->vm_effuid = vms.r->vm_uid;
	{
	  OVECTOR c = newovector_noinit(CL_MAXSLOTINDEX, T_CLOSURE);
	  ATPUT(c, CL_SELF, NULL);
	  ATPUT(c, CL_METHOD, rd->h1);
	  rd->h1 = (OBJ) c;
	}
	apply_closure(&vms, (OVECTOR) rd->h1, newvector_noinit(1));

	while (!run_vm(&vms)) ;

	rd->h1 = (OBJ) newvector(2);
	ATPUT((VECTOR) rd->h1, 0, NULL);
	ATPUT((VECTOR) rd->h1, 1, vms.r->vm_acc);
	rd->h1 = lookup_prim(0x00001, NULL)(&vms, (VECTOR) rd->h1);
	rd->h1 = (OBJ) bvector_concat((BVECTOR) rd->h1, newbvector(1));
      	/* terminates C-string */

	gc_reach_safepoint();

	sprintf(buf, "--> %s\n", ((BVECTOR) rd->h1)->vec);
      }

      fputs(buf, conno);
    }
  }

  unprotect((OBJ *)(&rd->vmregs));
  unprotect(&rd->h2);
  unprotect(&rd->h1);

  freemem(rd);
}
Beispiel #4
0
PUBLIC int run_vm(VMSTATE vms) {
  OBJ vm_hold;	/* Holding register. NOT SEEN BY GC */
  int ticks_left = VM_TIMESLICE_TICKS;

  while (vms->c.vm_state != VM_STATE_DYING && ticks_left-- && vms->r->vm_acc != yield_thread) {
    if (vms->c.vm_state > 0) {
      vms->c.vm_state--;
      if (vms->c.vm_state == 0) {
	/* Quota expired. Warn. */
	vms->c.vm_state = VM_DEFAULT_CPU_QUOTA;
	vm_raise(vms, (OBJ) newsym("quota-expired"), NULL);
	/* Make sure we don't recurse :-) */
	vms->r->vm_trap_closure = NULL;
      }
    }

    gc_reach_safepoint();

#ifdef DEBUG
    debug_dump_instr( vms->r->vm_code->vec , vms->c.vm_ip );
#endif

    switch (CODEAT(vms->c.vm_ip)) {
      case OP_AT: {
	int index = CODEAT(vms->c.vm_ip + 1);

	if (index < 0 || index >= vms->r->vm_acc->length) {
	  vm_raise(vms, (OBJ) newsym("range-check-error"), vms->r->vm_acc);
	  break;
	}

	if (!VECTORP(vms->r->vm_acc)) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	}

	vms->r->vm_acc = AT((VECTOR) vms->r->vm_acc, index);
	vms->c.vm_ip += 2;
	break;
      }

      case OP_ATPUT: {
	int index = CODEAT(vms->c.vm_ip + 1);

	vm_hold = PEEK();

	if (index < 0 || index >= vm_hold->length) {
	  vm_raise(vms, (OBJ) newsym("range-check-error"), vm_hold);
	  break;
	}

	if (!VECTORP(vm_hold)) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vm_hold);
	  break;
	}

	ATPUT((VECTOR) vm_hold, index, vms->r->vm_acc);
	vms->c.vm_ip += 2;
	break;
      }

      case OP_MOV_A_LOCL: {
	int i = CODEAT(vms->c.vm_ip + 1);
	vm_hold = (OBJ) vms->r->vm_env;
	while (i-- > 0) vm_hold = AT((VECTOR) vm_hold, 0);
	vms->r->vm_acc = AT((VECTOR) vm_hold, CODEAT(vms->c.vm_ip + 2) + 1);
	vms->c.vm_ip += 3;
	break;
      }

      case OP_MOV_A_GLOB:
	vm_hold = AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
	vms->r->vm_acc = AT((OVECTOR) vm_hold, SY_VALUE);
	vms->c.vm_ip += 2;
	break;

      case OP_MOV_A_SLOT: {
	OVECTOR slot, slotname;

	if (!OBJECTP(vms->r->vm_acc)) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	}

	slotname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));

	if (!O_CAN_X((OBJECT) vms->r->vm_acc, vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) slotname);
	}

	slot = findslot((OBJECT) vms->r->vm_acc, slotname, NULL);

	if (slot == NULL) {
	  vm_raise(vms, (OBJ) newsym("slot-not-found"), (OBJ) slotname);
	  break;
	}

	if (!MS_CAN_R(slot, vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) slotname);
	}

	vms->r->vm_acc = AT(slot, SL_VALUE);
	vms->c.vm_ip += 2;
	break;
      }

      case OP_MOV_A_LITL:
	vms->r->vm_acc = AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
	vms->c.vm_ip += 2;
	break;

      case OP_MOV_A_SELF: vms->r->vm_acc = (OBJ) vms->r->vm_self; vms->c.vm_ip++; break;
      case OP_MOV_A_FRAM: vms->r->vm_acc = (OBJ) vms->r->vm_frame; vms->c.vm_ip++; break;

      case OP_MOV_LOCL_A: {
	int i = CODEAT(vms->c.vm_ip + 1);
	vm_hold = (OBJ) vms->r->vm_env;
	while (i-- > 0) vm_hold = AT((VECTOR) vm_hold, 0);
	ATPUT((VECTOR) vm_hold, CODEAT(vms->c.vm_ip + 2) + 1, vms->r->vm_acc);
	vms->c.vm_ip += 3;
	break;
      }

      case OP_MOV_GLOB_A:
	if (!PRIVILEGEDP(vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) newsym("setting-global-value"));
	}
	vm_hold = AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
	ATPUT((OVECTOR) vm_hold, SY_VALUE, vms->r->vm_acc);
	vms->c.vm_ip += 2;
	break;

      case OP_MOV_SLOT_A: {
	OVECTOR slot, slotname;
	OBJECT target = (OBJECT) POP();
	OBJECT foundin;

	if (!OBJECTP(target)) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), (OBJ) target);
	  break;
	}

	slotname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));

	if (!O_CAN_X(target, vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) slotname);
	}

	slot = findslot(target, slotname, &foundin);

	if (slot == NULL) {
	  vm_raise(vms, (OBJ) newsym("slot-not-found"), (OBJ) slotname);
	  break;
	}

	if (!MS_CAN_W(slot, vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) slotname);
	}

	if (foundin == target) {
	  ATPUT(slot, SL_VALUE, vms->r->vm_acc);
	} else {
	  OVECTOR newslot = addslot(target, slotname, (OBJECT) AT(slot, SL_OWNER));
	  ATPUT(newslot, SL_FLAGS, AT(slot, SL_FLAGS));
	  ATPUT(newslot, SL_VALUE, vms->r->vm_acc);
	}

	vms->c.vm_ip += 2;
	break;
      }

      case OP_MOV_FRAM_A:
	if (!PRIVILEGEDP(vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) newsym("restoring-vm-frame-pointer"));
	}

	if (!OVECTORP(vms->r->vm_acc) || ((OVECTOR) vms->r->vm_acc)->type != T_FRAME) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	}

	vms->r->vm_frame = (OVECTOR) vms->r->vm_acc;
	vms->c.vm_ip++;
	break;

      case OP_PUSH: PUSH(vms->r->vm_acc); vms->c.vm_ip++; break;
      case OP_POP: vms->r->vm_acc = POP(); vms->c.vm_ip++; break;
      case OP_SWAP:
	vm_hold = POP();
	PUSH(vms->r->vm_acc);
	vms->r->vm_acc = vm_hold;
	vms->c.vm_ip++;
	break;

      case OP_VECTOR:
	vms->r->vm_acc = (OBJ) newvector(CODEAT(vms->c.vm_ip+1));
	vms->c.vm_ip += 2;
	break;
	
      case OP_ENTER_SCOPE:
	vm_hold = (OBJ) newvector(CODEAT(vms->c.vm_ip+1) + 1);
	ATPUT((VECTOR) vm_hold, 0, (OBJ) vms->r->vm_env);
	vms->r->vm_env = (VECTOR) vm_hold;
	vms->c.vm_ip += 2;
	break;

      case OP_LEAVE_SCOPE:
	vms->r->vm_env = (VECTOR) AT(vms->r->vm_env, 0);
	vms->c.vm_ip++;
	break;

      case OP_MAKE_VECTOR: {
	int i = 0;
	int len = CODEAT(vms->c.vm_ip+1);
	VECTOR vec = newvector_noinit(len);

	for (i = len - 1; i >= 0; i--)
	  ATPUT(vec, i, POP());

	vms->r->vm_acc = (OBJ) vec;
	vms->c.vm_ip += 2;
	break;
      }

      case OP_CLOSURE:
	vms->r->vm_acc = make_closure_from((OVECTOR) vms->r->vm_acc,
					   vms->r->vm_self,
					   vms->r->vm_env,
					   vms->r->vm_effuid);
	vms->c.vm_ip++;
	break;

      case OP_METHOD_CLOSURE: {
	OVECTOR methname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
	OVECTOR method;

	if (!OBJECTP(vms->r->vm_acc)) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	}

	method = findmethod((OBJECT) vms->r->vm_acc, methname);

	if (method == NULL) {
	  vm_raise(vms, (OBJ) newsym("method-not-found"), (OBJ) methname);
	  break;
	}

	if (!MS_CAN_R(method, vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) methname);
	}

	vm_hold = (OBJ) newovector(CL_MAXSLOTINDEX, T_CLOSURE);
	ATPUT((OVECTOR) vm_hold, CL_METHOD, (OBJ) method);
	ATPUT((OVECTOR) vm_hold, CL_SELF, vms->r->vm_acc);
	vms->r->vm_acc = vm_hold;

	vms->c.vm_ip += 2;
	break;
      }

      case OP_RET:
	if (vms->r->vm_frame != NULL) {
	  restoreframe(vms, vms->r->vm_frame);
	  if (vms->r->vm_code != NULL)
	    break;
	}

	vms->c.vm_state = VM_STATE_DYING;
	return 1;	/* finished, nothing more to run! */
	
      case OP_CALL: {
	OVECTOR methname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
	OVECTOR method;

	if (vms->r->vm_acc == NULL || TAGGEDP(vms->r->vm_acc)) {
	  vm_raise(vms,
		   (OBJ) newsym("null-call-error"),
		   AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip+1)));
	  break;
	}

	if (!OBJECTP(vms->r->vm_acc)) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	}

	method = findmethod((OBJECT) vms->r->vm_acc, methname);

	if (method == NULL) {
	  vm_raise(vms, (OBJ) newsym("method-not-found"), (OBJ) methname);
	  break;
	}

	if (!MS_CAN_X(method, vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) methname);
	}

	vm_hold = POP();
	if (vm_hold->length-1 != NUM(AT(method, ME_ARGC))) {
	  vm_raise(vms, (OBJ) newsym("wrong-argc"), (OBJ) methname);
	  break;
	}

	vms->c.vm_ip += 2;
	push_frame(vms);

	vms->r->vm_env = (VECTOR) vm_hold;
	ATPUT(vms->r->vm_env, 0, AT(method, ME_ENV));
	vms->r->vm_code = (BVECTOR) AT(method, ME_CODE);
	vms->r->vm_lits = (VECTOR) AT(method, ME_LITS);
	vms->r->vm_self = (OBJECT) vms->r->vm_acc;
	if (NUM(AT(method, ME_FLAGS)) & O_SETUID)
	  vms->r->vm_effuid = (OBJECT) AT(method, ME_OWNER);
	vms->r->vm_method = method;
	vms->c.vm_ip = 0;
	break;
      }

      case OP_CALL_AS: {
	OVECTOR methname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
	OVECTOR method;

	if (vms->r->vm_self == NULL ||
	    vms->r->vm_acc == NULL || TAGGEDP(vms->r->vm_acc)) {
	  vm_raise(vms,
		   (OBJ) newsym("null-call-error"),
		   AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip+1)));
	  break;
	}

	if (!OBJECTP(vms->r->vm_acc)) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	}

	method = findmethod((OBJECT) vms->r->vm_acc, methname);

	if (method == NULL) {
	  vm_raise(vms, (OBJ) newsym("method-not-found"), (OBJ) methname);
	  break;
	}

	if (!MS_CAN_X(method, vms->r->vm_effuid)) {
	  NOPERMISSION((OBJ) methname);
	}

	vm_hold = POP();
	if (vm_hold->length-1 != NUM(AT(method, ME_ARGC))) {
	  vm_raise(vms, (OBJ) newsym("wrong-argc"), (OBJ) methname);
	  break;
	}

	vms->c.vm_ip += 2;
	push_frame(vms);

	vms->r->vm_env = (VECTOR) vm_hold;
	ATPUT(vms->r->vm_env, 0, AT(method, ME_ENV));
	vms->r->vm_code = (BVECTOR) AT(method, ME_CODE);
	vms->r->vm_lits = (VECTOR) AT(method, ME_LITS);

	/* don't set vm_self, this is OP_CALL_AS. */
	/* vms->r->vm_self = vms->r->vm_acc; */

	if (NUM(AT(method, ME_FLAGS)) & O_SETUID)
	  vms->r->vm_effuid = (OBJECT) AT(method, ME_OWNER);
	vms->r->vm_method = method;
	vms->c.vm_ip = 0;
	break;
      }

      case OP_APPLY:
	vms->c.vm_ip++;
	apply_closure(vms, (OVECTOR) vms->r->vm_acc, (VECTOR) POP());
	break;

      case OP_JUMP: vms->c.vm_ip += 3 + ((int16_t) CODE16AT(vms->c.vm_ip+1)); break;

      case OP_JUMP_TRUE:
	vms->c.vm_ip += (vms->r->vm_acc == false) ? 3 :
						    3 + ((int16_t) CODE16AT(vms->c.vm_ip+1));
	break;

      case OP_JUMP_FALSE:
	vms->c.vm_ip += (vms->r->vm_acc != false) ? 3 :
						    3 + ((int16_t) CODE16AT(vms->c.vm_ip+1));
	break;

      case OP_NOT:
	vms->r->vm_acc = (vms->r->vm_acc == false) ? true : false;
	vms->c.vm_ip++;
	break;

      case OP_EQ:
	vms->r->vm_acc = (vms->r->vm_acc == POP()) ? true : false;
	vms->c.vm_ip++;
	break;

      case OP_NE:
	vms->r->vm_acc = (vms->r->vm_acc != POP()) ? true : false;
	vms->c.vm_ip++;
	break;

      NUMOP(OP_GT, vms->r->vm_acc = (NUM(vms->r->vm_acc) < NUM(POP())) ? true : false);
      NUMOP(OP_LT, vms->r->vm_acc = (NUM(vms->r->vm_acc) > NUM(POP())) ? true : false);
      NUMOP(OP_GE, vms->r->vm_acc = (NUM(vms->r->vm_acc) <= NUM(POP())) ? true : false);
      NUMOP(OP_LE, vms->r->vm_acc = (NUM(vms->r->vm_acc) >= NUM(POP())) ? true : false);

      NUMOP(OP_NEG, vms->r->vm_acc = MKNUM(-NUM(vms->r->vm_acc)));
      NUMOP(OP_BNOT, vms->r->vm_acc = MKNUM(~NUM(vms->r->vm_acc)));
      NUMOP(OP_BOR, vms->r->vm_acc = MKNUM(NUM(vms->r->vm_acc)|NUM(POP())));
      NUMOP(OP_BAND, vms->r->vm_acc = MKNUM(NUM(vms->r->vm_acc)&NUM(POP())));

      case OP_PLUS:
	if (vms->r->vm_acc == NULL || PEEK() == NULL) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	}
	if (NUMP(vms->r->vm_acc) && NUMP(PEEK()))
	  vms->r->vm_acc = MKNUM(NUM(vms->r->vm_acc)+NUM(POP()));
	else if (TAGGEDP(vms->r->vm_acc) || TAGGEDP(PEEK())) {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	} else if (BVECTORP(vms->r->vm_acc) && BVECTORP(PEEK()))
	  vms->r->vm_acc = (OBJ) bvector_concat((BVECTOR) POP(), (BVECTOR) vms->r->vm_acc);
	else if (VECTORP(vms->r->vm_acc) && VECTORP(PEEK()))
	  vms->r->vm_acc = (OBJ) vector_concat((VECTOR) POP(), (VECTOR) vms->r->vm_acc);
	else {
	  vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
	  break;
	}
	vms->c.vm_ip++;
	break;

      NUMOP(OP_MINUS, vms->r->vm_acc = MKNUM(NUM(POP())-NUM(vms->r->vm_acc)));
      NUMOP(OP_STAR, vms->r->vm_acc = MKNUM(NUM(POP())*NUM(vms->r->vm_acc)));
      NUMOP(OP_SLASH,
	    if (vms->r->vm_acc == MKNUM(0))
	      vm_raise(vms, (OBJ) newsym("divide-by-zero"), NULL);
	    else
	      vms->r->vm_acc = MKNUM(NUM(POP())/NUM(vms->r->vm_acc)));
      NUMOP(OP_PERCENT,
	    if (vms->r->vm_acc == MKNUM(0))
	      vm_raise(vms, (OBJ) newsym("divide-by-zero"), NULL);
	    else
	      vms->r->vm_acc = MKNUM(NUM(POP())%NUM(vms->r->vm_acc)));

      default:
	fprintf(stderr, "Unknown bytecode reached (%d == 0x%x).\n",
		CODEAT(vms->c.vm_ip),
		CODEAT(vms->c.vm_ip));
	exit(MOVE_EXIT_PROGRAMMER_FUCKUP);
    }
  }

  return vms->c.vm_state == VM_STATE_DYING;
}