1 /* -*-C-*-
2
3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6 Institute of Technology
7
8 This file is part of MIT/GNU Scheme.
9
10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or (at
13 your option) any later version.
14
15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
16 WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with MIT/GNU Scheme; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23 USA.
24
25 */
26
27 /* Primitives to control terminal devices. */
28
29 #include "scheme.h"
30 #include "prims.h"
31 #include "osscheme.h"
32 #include "osterm.h"
33 #include "osio.h"
34 #include "ospty.h"
35
36 static Tchannel
arg_pty_master(unsigned int arg)37 arg_pty_master (unsigned int arg)
38 {
39 Tchannel channel = (arg_channel (1));
40 if ((OS_channel_type (channel)) != channel_type_unix_pty_master)
41 error_bad_range_arg (1);
42 return (channel);
43 }
44
45 DEFINE_PRIMITIVE ("OPEN-PTY-MASTER", Prim_open_pty_master, 0, 0,
46 "Open a PTY master, returning the master's channel and the slave's name.\n\
47 Returns a vector #(CHANNEL MASTER-NAME SLAVE-NAME).")
48 {
49 PRIMITIVE_HEADER (0);
50 {
51 Tchannel channel;
52 const char * master_name;
53 const char * slave_name =
54 (OS_open_pty_master ((&channel), (&master_name)));
55 transaction_begin ();
56 OS_channel_close_on_abort (channel);
57 {
58 SCHEME_OBJECT vector = (allocate_marked_vector (TC_VECTOR, 3, 1));
59 VECTOR_SET (vector, 0, (long_to_integer (channel)));
60 VECTOR_SET (vector, 1, (char_pointer_to_string (master_name)));
61 VECTOR_SET (vector, 2, (char_pointer_to_string (slave_name)));
62 transaction_commit ();
63 PRIMITIVE_RETURN (vector);
64 }
65 }
66 }
67
68 DEFINE_PRIMITIVE ("PTY-MASTER-SEND-SIGNAL", Prim_pty_master_send_signal, 2, 2,
69 "Send a signal to PTY-MASTER; second arg says which one.")
70 {
71 PRIMITIVE_HEADER (2);
72 OS_pty_master_send_signal ((arg_pty_master (1)),
73 (arg_nonnegative_integer (2)));
74 PRIMITIVE_RETURN (UNSPECIFIC);
75 }
76
77 DEFINE_PRIMITIVE ("PTY-MASTER-KILL", Prim_pty_master_kill, 1, 1, 0)
78 {
79 PRIMITIVE_HEADER (1);
80 OS_pty_master_kill (arg_pty_master (1));
81 PRIMITIVE_RETURN (UNSPECIFIC);
82 }
83
84 DEFINE_PRIMITIVE ("PTY-MASTER-STOP", Prim_pty_master_stop, 1, 1, 0)
85 {
86 PRIMITIVE_HEADER (1);
87 OS_pty_master_stop (arg_pty_master (1));
88 PRIMITIVE_RETURN (UNSPECIFIC);
89 }
90
91 DEFINE_PRIMITIVE ("PTY-MASTER-CONTINUE", Prim_pty_master_continue, 1, 1, 0)
92 {
93 PRIMITIVE_HEADER (1);
94 OS_pty_master_continue (arg_pty_master (1));
95 PRIMITIVE_RETURN (UNSPECIFIC);
96 }
97
98 DEFINE_PRIMITIVE ("PTY-MASTER-INTERRUPT", Prim_pty_master_interrupt, 1, 1, 0)
99 {
100 PRIMITIVE_HEADER (1);
101 OS_pty_master_interrupt (arg_pty_master (1));
102 PRIMITIVE_RETURN (UNSPECIFIC);
103 }
104
105 DEFINE_PRIMITIVE ("PTY-MASTER-QUIT", Prim_pty_master_quit, 1, 1, 0)
106 {
107 PRIMITIVE_HEADER (1);
108 OS_pty_master_quit (arg_pty_master (1));
109 PRIMITIVE_RETURN (UNSPECIFIC);
110 }
111
112 DEFINE_PRIMITIVE ("PTY-MASTER-HANGUP", Prim_pty_master_hangup, 1, 1, 0)
113 {
114 PRIMITIVE_HEADER (1);
115 OS_pty_master_hangup (arg_pty_master (1));
116 PRIMITIVE_RETURN (UNSPECIFIC);
117 }
118