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);
}
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);
}
/* 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);
unsigned int
arg_baud_index (unsigned int argument)
{
return (arg_nonnegative_integer (argument));
}
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);