示例#1
0
static Tchannel
arg_server_socket (unsigned int arg)
{
  Tchannel server_socket = (arg_nonnegative_integer (arg));
  if ((OS_channel_type (server_socket)) != channel_type_tcp_server_socket)
    error_bad_range_arg (arg);
  return (server_socket);
}
示例#2
0
  if (gc_check_p)
    Primitive_GC_If_Needed (length + 1);
  {
    SCHEME_OBJECT result = (MAKE_POINTER_OBJECT (TC_VECTOR, Free));
    (*Free++) = (MAKE_OBJECT (TC_MANIFEST_VECTOR, length));
    while ((length--) > 0)
      (*Free++) = contents;
    return (result);
  }
}

DEFINE_PRIMITIVE ("VECTOR-CONS", Prim_vector_cons, 2, 2, 0)
{
  PRIMITIVE_HEADER (2);
  PRIMITIVE_RETURN
    (make_vector ((arg_nonnegative_integer (1)), (ARG_REF (2)), true));
}

DEFINE_PRIMITIVE ("VECTOR", Prim_vector, 0, LEXPR, 0)
{
  PRIMITIVE_HEADER (LEXPR);
  {
    SCHEME_OBJECT result =
      (allocate_marked_vector (TC_VECTOR, GET_LEXPR_ACTUALS, true));
    SCHEME_OBJECT * argument_scan = (ARG_LOC (1));
    SCHEME_OBJECT * argument_limit = (ARG_LOC (GET_LEXPR_ACTUALS + 1));
    SCHEME_OBJECT * result_scan = (VECTOR_LOC (result, 0));
    while (argument_scan != argument_limit)
      (*result_scan++) = (STACK_LOCATIVE_POP (argument_scan));
    PRIMITIVE_RETURN (result);
  }
示例#3
0
/* Mapping between the internal and external representations of
   primitives and return addresses.  */

DEFINE_PRIMITIVE ("MAP-CODE-TO-MACHINE-ADDRESS", Prim_map_code_to_address, 2, 2,
  "For return codes and primitives, this returns the internal\n\
representation of the return address or primitive address given the\n\
external representation.\n\
\n\
This accepts two arguments, TYPE-CODE and VALUE-CODE.  TYPE-CODE is\n\
the microcode type of the object to be returned; it must be either a\n\
return address or primitive procedure type.  VALUE-CODE is the index\n\
number (i.e. external representation) of the desired result.")
{
  long tc, number;
  PRIMITIVE_HEADER (2);
  tc = (arg_nonnegative_integer (1));
  number = (arg_nonnegative_integer (2));
  switch (tc)
  {
    case TC_RETURN_CODE:
      if (number > MAX_RETURN_CODE)
	error_bad_range_arg (2);
      PRIMITIVE_RETURN (MAKE_OBJECT (tc, number));

    case TC_PRIMITIVE:
      if (number > (NUMBER_OF_PRIMITIVES ()))
	error_bad_range_arg (2);
      PRIMITIVE_RETURN (MAKE_PRIMITIVE_OBJECT (number));

    default:
      error_bad_range_arg (1);
示例#4
0
unsigned int
arg_baud_index (unsigned int argument)
{
  return (arg_nonnegative_integer (argument));
}
示例#5
0
      SCHEME_OBJECT vector = (allocate_marked_vector (TC_VECTOR, 3, 1));
      VECTOR_SET (vector, 0, (long_to_integer (channel)));
      VECTOR_SET (vector, 1, (char_pointer_to_string (master_name)));
      VECTOR_SET (vector, 2, (char_pointer_to_string (slave_name)));
      transaction_commit ();
      PRIMITIVE_RETURN (vector);
    }
  }
}

DEFINE_PRIMITIVE ("PTY-MASTER-SEND-SIGNAL", Prim_pty_master_send_signal, 2, 2,
  "Send a signal to PTY-MASTER; second arg says which one.")
{
  PRIMITIVE_HEADER (2);
  OS_pty_master_send_signal ((arg_pty_master (1)),
			     (arg_nonnegative_integer (2)));
  PRIMITIVE_RETURN (UNSPECIFIC);
}

DEFINE_PRIMITIVE ("PTY-MASTER-KILL", Prim_pty_master_kill, 1, 1, 0)
{
  PRIMITIVE_HEADER (1);
  OS_pty_master_kill (arg_pty_master (1));
  PRIMITIVE_RETURN (UNSPECIFIC);
}

DEFINE_PRIMITIVE ("PTY-MASTER-STOP", Prim_pty_master_stop, 1, 1, 0)
{
  PRIMITIVE_HEADER (1);
  OS_pty_master_stop (arg_pty_master (1));
  PRIMITIVE_RETURN (UNSPECIFIC);