/[cmucl]/src/clx/sockcl.lisp
ViewVC logotype

Contents of /src/clx/sockcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Mon May 14 14:49:11 1990 UTC (23 years, 11 months ago) by ram
Branch: MAIN
CVS Tags: RELEASE_18a, RELEASE_18b
Branch point for: RELENG_18
Initial revision
1 ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
2
3 ;;;; Server Connection for kcl and ibcl
4
5 ;;; Copyright (C) 1987, 1989 Massachussetts Institute of Technology
6 ;;;
7 ;;; Permission is granted to any individual or institution to use, copy,
8 ;;; modify, and distribute this software, provided that this complete
9 ;;; copyright and permission notice is maintained, intact, in all copies and
10 ;;; supporting documentation.
11 ;;;
12 ;;; Massachussetts Institute of Technology provides this software "as is"
13 ;;; without express or implied warranty.
14 ;;;
15
16 ;;; Adapted from code by Roman Budzianowski - Project Athena/MIT
17
18 ;;; make-two-way-stream is probably not a reasonable thing to do.
19 ;;; A close on a two way stream probably does not close the substreams.
20 ;;; I presume an :io will not work (maybe because it uses 1 buffer?).
21 ;;; There should be some fast io (writes and reads...).
22
23 ;;; Compile this file with compile-file.
24 ;;; Load it with (si:faslink "sockcl.o" "socket.o -lc")
25
26 (in-package :xlib)
27
28 ;;; The cmpinclude.h file does not have this type definition from
29 ;;; <kcldistribution>/h/object.h. We include it here so the
30 ;;; compile-file will work without figuring out where the distribution
31 ;;; directory is located.
32 ;;;
33 (CLINES "
34 enum smmode { /* stream mode */
35 smm_input, /* input */
36 smm_output, /* output */
37 smm_io, /* input-output */
38 smm_probe, /* probe */
39 smm_synonym, /* synonym */
40 smm_broadcast, /* broadcast */
41 smm_concatenated, /* concatenated */
42 smm_two_way, /* two way */
43 smm_echo, /* echo */
44 smm_string_input, /* string input */
45 smm_string_output, /* string output */
46 smm_user_defined /* for user defined */
47 };
48 ")
49
50 #-akcl
51 (CLINES "
52 struct stream {
53 short t, m;
54 FILE *sm_fp; /* file pointer */
55 object sm_object0; /* some object */
56 object sm_object1; /* some object */
57 int sm_int0; /* some int */
58 int sm_int1; /* some int */
59 short sm_mode; /* stream mode */
60 /* of enum smmode */
61 };
62 ")
63
64
65 ;;;; Connect to the server.
66
67 ;;; A lisp string is not a reasonable type for C, so copy the characters
68 ;;; out and then call connect_to_server routine defined in socket.o
69
70 (CLINES "
71 int
72 konnect_to_server(host,display)
73 object host; /* host name */
74 int display; /* display number */
75 {
76 int fd; /* file descriptor */
77 int i;
78 char hname[BUFSIZ];
79 FILE *fout, *fin;
80
81 if (host->st.st_fillp > BUFSIZ - 1)
82 too_long_file_name(host);
83 for (i = 0; i < host->st.st_fillp; i++)
84 hname[i] = host->st.st_self[i];
85 hname[i] = '\\0'; /* doubled backslash for lisp */
86
87 fd = connect_to_server(hname,display);
88
89 return(fd);
90 }
91 ")
92
93 (defentry konnect-to-server (object int) (int "konnect_to_server"))
94
95
96 ;;;; Make a one-way stream from a file descriptor.
97
98 (CLINES "
99 object
100 konnect_stream(host,fd,flag,elem)
101 object host; /* not really used */
102 int fd; /* file descriptor */
103 int flag; /* 0 input, 1 output */
104 object elem; /* 'string-char */
105 {
106 struct stream *stream;
107 char *mode; /* file open mode */
108 FILE *fp; /* file pointer */
109 enum smmode smm; /* lisp mode (a short) */
110 vs_mark;
111
112 switch(flag){
113 case 0:
114 smm = smm_input;
115 mode = \"r\";
116 break;
117 case 1:
118 smm = smm_output;
119 mode = \"w\";
120 break;
121 default:
122 FEerror(\"konnect_stream : wrong mode\");
123 }
124
125 fp = fdopen(fd,mode);
126
127 if (fp == NULL) {
128 stream = Cnil;
129 vs_push(stream);
130 } else {
131 stream = alloc_object(t_stream);
132 stream->sm_mode = (short)smm;
133 stream->sm_fp = fp;
134 stream->sm_object0 = elem;
135 stream->sm_object1 = host;
136 stream->sm_int0 = stream->sm.sm_int1 = 0;
137 vs_push(stream);
138 setbuf(fp, alloc_contblock(BUFSIZ));
139 }
140 vs_reset;
141 return(stream);
142 }
143 ")
144
145 (defentry konnect-stream (object int int object) (object "konnect_stream"))
146
147
148 ;;;; Open an X stream
149
150 (defun open-socket-stream (host display)
151 (when (not (and (typep host 'string) ; sanity check the arguments
152 (typep display 'fixnum)))
153 (error "Host ~s or display ~s are bad." host display))
154
155 (let ((fd (konnect-to-server host display))) ; get a file discriptor
156 (if (< fd 0)
157 NIL
158 (let ((stream-in (konnect-stream host fd 0 'string-char)) ; input
159 (stream-out (konnect-stream host fd 1 'string-char))) ; output
160 (if (or (null stream-in) (null stream-out))
161 (error "Could not make i/o streams for fd ~d." fd))
162 (make-two-way-stream stream-in stream-out))
163 )))

  ViewVC Help
Powered by ViewVC 1.1.5