home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / prospty.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  3KB  |  114 lines
  1. /* -*-C-*-
  2.  
  3. $Id: prospty.c,v 1.4 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1992-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* Primitives to control terminal devices. */
  23.  
  24. #include "scheme.h"
  25. #include "prims.h"
  26. #include "osterm.h"
  27. #include "osio.h"
  28. #include "ospty.h"
  29.  
  30. static Tchannel
  31. DEFUN (arg_pty_master, (arg), unsigned int arg)
  32. {
  33.   Tchannel channel = (arg_channel (1));
  34.   if ((OS_channel_type (channel)) != channel_type_unix_pty_master)
  35.     error_bad_range_arg (1);
  36.   return (channel);
  37. }
  38.  
  39. DEFINE_PRIMITIVE ("OPEN-PTY-MASTER", Prim_open_pty_master, 0, 0,
  40.   "Open a PTY master, returning the master's channel and the slave's name.\n\
  41. Returns a vector #(CHANNEL MASTER-NAME SLAVE-NAME).")
  42. {
  43.   PRIMITIVE_HEADER (0);
  44.   {
  45.     Tchannel channel;
  46.     CONST char * master_name;
  47.     CONST char * slave_name =
  48.       (OS_open_pty_master ((&channel), (&master_name)));
  49.     transaction_begin ();
  50.     OS_channel_close_on_abort (channel);
  51.     {
  52.       SCHEME_OBJECT vector = (allocate_marked_vector (TC_VECTOR, 3, 1));
  53.       VECTOR_SET (vector, 0, (long_to_integer (channel)));
  54.       VECTOR_SET (vector, 1,
  55.           (char_pointer_to_string ((unsigned char *) master_name)));
  56.       VECTOR_SET (vector, 2,
  57.           (char_pointer_to_string ((unsigned char *) slave_name)));
  58.       transaction_commit ();
  59.       PRIMITIVE_RETURN (vector);
  60.     }
  61.   }
  62. }
  63.  
  64. DEFINE_PRIMITIVE ("PTY-MASTER-SEND-SIGNAL", Prim_pty_master_send_signal, 2, 2,
  65.   "Send a signal to PTY-MASTER; second arg says which one.")
  66. {
  67.   PRIMITIVE_HEADER (2);
  68.   OS_pty_master_send_signal ((arg_pty_master (1)),
  69.                  (arg_nonnegative_integer (2)));
  70.   PRIMITIVE_RETURN (UNSPECIFIC);
  71. }
  72.  
  73. DEFINE_PRIMITIVE ("PTY-MASTER-KILL", Prim_pty_master_kill, 1, 1, 0)
  74. {
  75.   PRIMITIVE_HEADER (1);
  76.   OS_pty_master_kill (arg_pty_master (1));
  77.   PRIMITIVE_RETURN (UNSPECIFIC);
  78. }
  79.  
  80. DEFINE_PRIMITIVE ("PTY-MASTER-STOP", Prim_pty_master_stop, 1, 1, 0)
  81. {
  82.   PRIMITIVE_HEADER (1);
  83.   OS_pty_master_stop (arg_pty_master (1));
  84.   PRIMITIVE_RETURN (UNSPECIFIC);
  85. }
  86.  
  87. DEFINE_PRIMITIVE ("PTY-MASTER-CONTINUE", Prim_pty_master_continue, 1, 1, 0)
  88. {
  89.   PRIMITIVE_HEADER (1);
  90.   OS_pty_master_continue (arg_pty_master (1));
  91.   PRIMITIVE_RETURN (UNSPECIFIC);
  92. }
  93.  
  94. DEFINE_PRIMITIVE ("PTY-MASTER-INTERRUPT", Prim_pty_master_interrupt, 1, 1, 0)
  95. {
  96.   PRIMITIVE_HEADER (1);
  97.   OS_pty_master_interrupt (arg_pty_master (1));
  98.   PRIMITIVE_RETURN (UNSPECIFIC);
  99. }
  100.  
  101. DEFINE_PRIMITIVE ("PTY-MASTER-QUIT", Prim_pty_master_quit, 1, 1, 0)
  102. {
  103.   PRIMITIVE_HEADER (1);
  104.   OS_pty_master_quit (arg_pty_master (1));
  105.   PRIMITIVE_RETURN (UNSPECIFIC);
  106. }
  107.  
  108. DEFINE_PRIMITIVE ("PTY-MASTER-HANGUP", Prim_pty_master_hangup, 1, 1, 0)
  109. {
  110.   PRIMITIVE_HEADER (1);
  111.   OS_pty_master_hangup (arg_pty_master (1));
  112.   PRIMITIVE_RETURN (UNSPECIFIC);
  113. }
  114.