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);