1 /*
2 * memchan.c --
3 *
4 * Implementation of a memory channel.
5 *
6 * Copyright (C) 1996-1999 Andreas Kupries (a.kupries@westend.com)
7 * All rights reserved.
8 *
9 * Permission is hereby granted, without written agreement and without
10 * license or royalty fees, to use, copy, modify, and distribute this
11 * software and its documentation for any purpose, provided that the
12 * above copyright notice and the following two paragraphs appear in
13 * all copies of this software.
14 *
15 * IN NO EVENT SHALL I BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL,
16 * INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS
17 * SOFTWARE AND ITS DOCUMENTATION, EVEN IF I HAVE BEEN ADVISED OF THE
18 * POSSIBILITY OF SUCH DAMAGE.
19 *
20 * I SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
21 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
22 * PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND
23 * I HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
24 * ENHANCEMENTS, OR MODIFICATIONS.
25 *
26 * CVS: $Id: memchan.c,v 1.25 2010/12/08 18:01:52 andreas_kupries Exp $
27 */
28
29
30 #include <stdio.h> /* SEEK_ constants */
31 #include "memchanInt.h"
32
33 /*
34 * Forward declarations of internal procedures.
35 */
36
37 static int Close _ANSI_ARGS_((ClientData instanceData,
38 Tcl_Interp *interp));
39
40 static int Input _ANSI_ARGS_((ClientData instanceData,
41 char *buf, int toRead, int *errorCodePtr));
42
43 static int Output _ANSI_ARGS_((ClientData instanceData,
44 CONST84 char *buf, int toWrite, int *errorCodePtr));
45
46 static int Seek _ANSI_ARGS_((ClientData instanceData,
47 long offset, int mode, int *errorCodePtr));
48
49 static void WatchChannel _ANSI_ARGS_((ClientData instanceData, int mask));
50
51 static int GetOption _ANSI_ARGS_((ClientData instanceData,
52 Tcl_Interp* interp, CONST84 char *optionName,
53 Tcl_DString *dsPtr));
54
55 static void ChannelReady _ANSI_ARGS_((ClientData instanceData));
56 static int GetFile _ANSI_ARGS_((ClientData instanceData,
57 int direction,
58 ClientData* handlePtr));
59
60 static int BlockMode _ANSI_ARGS_((ClientData instanceData,
61 int mode));
62
63
64 /*
65 * This structure describes the channel type structure for in-memory channels:
66 */
67
68 static Tcl_ChannelType channelType = {
69 "memory", /* Type name. */
70 (Tcl_ChannelTypeVersion)BlockMode, /* Set blocking behaviour. */
71 Close, /* Close channel, clean instance data */
72 Input, /* Handle read request */
73 Output, /* Handle write request */
74 Seek, /* Move location of access point. NULL'able */
75 NULL, /* Set options. NULL'able */
76 GetOption, /* Get options. NULL'able */
77 WatchChannel, /* Initialize notifier */
78 #if GT81
79 GetFile, /* Get OS handle from the channel. */
80 NULL /* Close2Proc, not available, no partial close
81 * possible */
82 #else
83 GetFile /* Get OS handle from the channel. */
84 #endif
85 };
86
87
88 /*
89 * This structure describes the per-instance state of a in-memory channel.
90 */
91
92 typedef struct ChannelInstance {
93 unsigned long rwLoc; /* current location to read from (or write to). */
94 unsigned long allocated; /* number of allocated bytes */
95 unsigned long used; /* number of bytes stored in the channel. */
96 VOID* data; /* memory plane used to store the channel
97 * contents */
98 Tcl_Channel chan; /* Backreference to generic channel information */
99 Tcl_TimerToken timer; /* Timer used to link the channel into the
100 * notifier */
101 int interest; /* Interest in events as signaled by the user of
102 * the channel */
103 } ChannelInstance;
104
105 /*
106 *----------------------------------------------------------------------
107 *
108 * BlockMode --
109 *
110 * Helper procedure to set blocking and nonblocking modes on a
111 * memory channel. Invoked by generic IO level code.
112 *
113 * Results:
114 * 0 if successful, errno when failed.
115 *
116 * Side effects:
117 * Sets the device into blocking or non-blocking mode.
118 *
119 *----------------------------------------------------------------------
120 */
121
122 static int
BlockMode(instanceData,mode)123 BlockMode (instanceData, mode)
124 ClientData instanceData;
125 int mode;
126 {
127 return 0;
128 }
129
130 /*
131 *------------------------------------------------------*
132 *
133 * Close --
134 *
135 * ------------------------------------------------*
136 * This procedure is called from the generic IO
137 * level to perform channel-type-specific cleanup
138 * when an in-memory channel is closed.
139 * ------------------------------------------------*
140 *
141 * Sideeffects:
142 * Closes the device of the channel.
143 *
144 * Result:
145 * 0 if successful, errno if failed.
146 *
147 *------------------------------------------------------*
148 */
149 /* ARGSUSED */
150 static int
Close(instanceData,interp)151 Close (instanceData, interp)
152 ClientData instanceData; /* The instance information of the channel to
153 * close */
154 Tcl_Interp* interp; /* unused */
155 {
156 ChannelInstance* chan;
157
158 chan = (ChannelInstance*) instanceData;
159
160 if (chan->data != (char*) NULL) {
161 Tcl_Free ((char*) chan->data);
162 }
163
164 if (chan->timer != (Tcl_TimerToken) NULL) {
165 Tcl_DeleteTimerHandler (chan->timer);
166 }
167 chan->timer = (Tcl_TimerToken) NULL;
168
169 Tcl_Free ((char*) chan);
170 return 0;
171 }
172
173 /*
174 *------------------------------------------------------*
175 *
176 * Input --
177 *
178 * ------------------------------------------------*
179 * This procedure is invoked from the generic IO
180 * level to read input from an in-memory channel.
181 * ------------------------------------------------*
182 *
183 * Sideeffects:
184 * Reads input from the input device of the
185 * channel.
186 *
187 * Result:
188 * The number of bytes read is returned or
189 * -1 on error. An output argument contains
190 * a POSIX error code if an error occurs, or
191 * zero.
192 *
193 *------------------------------------------------------*
194 */
195
196 static int
Input(instanceData,buf,toRead,errorCodePtr)197 Input (instanceData, buf, toRead, errorCodePtr)
198 ClientData instanceData; /* The channel to read from */
199 char* buf; /* Buffer to fill */
200 int toRead; /* Requested number of bytes */
201 int* errorCodePtr; /* Location of error flag */
202 {
203 ChannelInstance* chan;
204
205 if (toRead == 0)
206 return 0;
207
208 chan = (ChannelInstance*) instanceData;
209
210 if ((chan->used - chan->rwLoc) <= 0) {
211 /* Signal EOF to higher layer */
212 return 0;
213 }
214
215 if ((chan->rwLoc + toRead) > chan->used) {
216 /*
217 * Reading behind the last byte is not possible,
218 * truncate the request.
219 */
220 toRead = chan->used - chan->rwLoc;
221 }
222
223 if (toRead > 0) {
224 memcpy ((VOID*) buf, (VOID*) ((char*) chan->data + chan->rwLoc), toRead);
225 chan->rwLoc += toRead;
226 }
227
228 *errorCodePtr = 0;
229 return toRead;
230 }
231
232 /*
233 *------------------------------------------------------*
234 *
235 * Output --
236 *
237 * ------------------------------------------------*
238 * This procedure is invoked from the generic IO
239 * level to write output to a file channel.
240 * ------------------------------------------------*
241 *
242 * Sideeffects:
243 * Writes output on the output device of
244 * the channel.
245 *
246 * Result:
247 * The number of bytes written is returned
248 * or -1 on error. An output argument
249 * contains a POSIX error code if an error
250 * occurred, or zero.
251 *
252 *------------------------------------------------------*
253 */
254
255 static int
Output(instanceData,buf,toWrite,errorCodePtr)256 Output (instanceData, buf, toWrite, errorCodePtr)
257 ClientData instanceData; /* The channel to write to */
258 CONST84 char* buf; /* Data to be stored. */
259 int toWrite; /* Number of bytes to write. */
260 int* errorCodePtr; /* Location of error flag. */
261 {
262 ChannelInstance* chan;
263
264 if (toWrite == 0)
265 return 0;
266
267 chan = (ChannelInstance*) instanceData;
268
269 if ((chan->rwLoc + toWrite) > chan->allocated) {
270 /*
271 * We are writing beyond the end of the allocated area,
272 * it is necessary to extend it. Try to use a fixed
273 * increment first and adjust if that is not enough.
274 */
275
276 chan->allocated += INCREMENT;
277
278 if ((chan->rwLoc + toWrite) > chan->allocated) {
279 chan->allocated = chan->rwLoc + toWrite;
280 }
281
282 chan->data = Tcl_Realloc (chan->data, chan->allocated);
283 }
284
285 memcpy ((VOID*) ((char*) chan->data + chan->rwLoc), (VOID*) buf, toWrite);
286 chan->rwLoc += toWrite;
287
288 if (chan->rwLoc > chan->used) {
289 chan->used = chan->rwLoc;
290 }
291
292 return toWrite;
293 }
294
295 /*
296 *------------------------------------------------------*
297 *
298 * Seek --
299 *
300 * ------------------------------------------------*
301 * This procedure is called by the generic IO level
302 * to move the access point in a in-memory channel.
303 * ------------------------------------------------*
304 *
305 * Sideeffects:
306 * Moves the location at which the channel
307 * will be accessed in future operations.
308 *
309 * Result:
310 * -1 if failed, the new position if
311 * successful. An output argument contains
312 * the POSIX error code if an error
313 * occurred, or zero.
314 *
315 *------------------------------------------------------*
316 */
317
318 static int
Seek(instanceData,offset,mode,errorCodePtr)319 Seek (instanceData, offset, mode, errorCodePtr)
320 ClientData instanceData; /* The channel to manipulate */
321 long offset; /* Size of movement. */
322 int mode; /* How to move */
323 int* errorCodePtr; /* Location of error flag. */
324 {
325 ChannelInstance* chan;
326 long int newLocation;
327
328 chan = (ChannelInstance*) instanceData;
329 *errorCodePtr = 0;
330
331 switch (mode) {
332 case SEEK_SET:
333 newLocation = offset;
334 break;
335
336 case SEEK_CUR:
337 newLocation = chan->rwLoc + offset;
338 break;
339
340 case SEEK_END:
341 /* SF Memchan Bug 556819 */
342 newLocation = chan->used + offset;
343 break;
344
345 default:
346 Tcl_Panic ("illegal seek-mode specified");
347 return -1;
348 }
349
350 if ((newLocation < 0) || (newLocation > (long int) chan->used)) {
351 *errorCodePtr = EINVAL; /* EBADRQC ?? */
352 return -1;
353 }
354
355 chan->rwLoc = newLocation;
356
357 return newLocation;
358 }
359
360 /*
361 *------------------------------------------------------*
362 *
363 * GetOption --
364 *
365 * ------------------------------------------------*
366 * Computes an option value for a in-memory channel,
367 * or a list of all options and their values.
368 * ------------------------------------------------*
369 *
370 * Sideeffects:
371 * None.
372 *
373 * Result:
374 * A standard Tcl result. The value of the
375 * specified option or a list of all options
376 * and their values is returned in the
377 * supplied DString.
378 *
379 *------------------------------------------------------*
380 */
381
382 static int
GetOption(instanceData,interp,optionName,dsPtr)383 GetOption (instanceData, interp, optionName, dsPtr)
384 ClientData instanceData; /* Channel to query */
385 Tcl_Interp* interp; /* Interpreter to leave error messages in */
386 CONST84 char* optionName; /* Name of reuqested option */
387 Tcl_DString* dsPtr; /* String to place the result into */
388 {
389 /*
390 * In-memory channels provide two channel type specific,
391 * read-only, fconfigure options, "length", that obtains
392 * the current number of bytes of data stored in the channel,
393 * and "allocated", that obtains the current number of bytes
394 * really allocated by the system for its buffers.
395 */
396
397 ChannelInstance* chan;
398 char buffer [50];
399 /* sufficient even for 64-bit quantities */
400
401 chan = (ChannelInstance*) instanceData;
402
403 /* Known options:
404 * -length: Number of bytes currently used by the buffers.
405 * -allocated: Number of bytes currently allocated by the buffers.
406 */
407
408 if ((optionName != (char*) NULL) &&
409 (0 != strcmp (optionName, "-length")) &&
410 (0 != strcmp (optionName, "-allocated"))) {
411 Tcl_SetErrno (EINVAL);
412 return Tcl_BadChannelOption (interp, optionName, "length allocated");
413 }
414
415 if (optionName == (char*) NULL) {
416 /* optionName == NULL
417 * => a list of options and their values was requested,
418 */
419
420 Tcl_DStringAppendElement (dsPtr, "-length");
421 LTOA (chan->used, buffer);
422 Tcl_DStringAppendElement (dsPtr, buffer);
423
424 Tcl_DStringAppendElement (dsPtr, "-allocated");
425 LTOA (chan->allocated, buffer);
426 Tcl_DStringAppendElement (dsPtr, buffer);
427
428 } else if (0 == strcmp (optionName, "-length")) {
429 LTOA (chan->used, buffer);
430 Tcl_DStringAppendElement (dsPtr, buffer);
431
432 } else if (0 == strcmp (optionName, "-allocated")) {
433 LTOA (chan->allocated, buffer);
434 Tcl_DStringAppendElement (dsPtr, buffer);
435 }
436
437 return TCL_OK;
438 }
439
440 /*
441 *------------------------------------------------------*
442 *
443 * WatchChannel --
444 *
445 * ------------------------------------------------*
446 * Initialize the notifier to watch Tcl_Files from
447 * this channel.
448 * ------------------------------------------------*
449 *
450 * Sideeffects:
451 * Sets up the notifier so that a future
452 * event on the channel will be seen by Tcl.
453 *
454 * Result:
455 * None.
456 *
457 *------------------------------------------------------*
458 */
459 /* ARGSUSED */
460 static void
WatchChannel(instanceData,mask)461 WatchChannel (instanceData, mask)
462 ClientData instanceData; /* Channel to watch */
463 int mask; /* Events of interest */
464 {
465 /*
466 * In-memory channels are not based on files.
467 * They are always writable, and almost always readable.
468 * We could call Tcl_NotifyChannel immediately, but this
469 * would starve other sources, so a timer is set up instead.
470 */
471
472 ChannelInstance* chan = (ChannelInstance*) instanceData;
473
474 if (mask) {
475 if (chan->timer == (Tcl_TimerToken) NULL) {
476 chan->timer = Tcl_CreateTimerHandler (DELAY, ChannelReady, instanceData);
477 }
478 } else {
479 if (chan->timer != (Tcl_TimerToken) NULL) {
480 Tcl_DeleteTimerHandler (chan->timer);
481 }
482 chan->timer = (Tcl_TimerToken) NULL;
483 }
484
485 chan->interest = mask;
486 }
487
488 /*
489 *------------------------------------------------------*
490 *
491 * ChannelReady --
492 *
493 * ------------------------------------------------*
494 * Called by the notifier (-> timer) to check whether
495 * the channel is readable or writable.
496 * ------------------------------------------------*
497 *
498 * Sideeffects:
499 * As of 'Tcl_NotifyChannel'.
500 *
501 * Result:
502 * None.
503 *
504 *------------------------------------------------------*
505 */
506
507 static void
ChannelReady(instanceData)508 ChannelReady (instanceData)
509 ClientData instanceData; /* Channel to query */
510 {
511 /*
512 * In-memory channels are always writable (fileevent
513 * writable) and they are readable if the current access
514 * point is before the last byte contained in the channel.
515 */
516
517 ChannelInstance* chan = (ChannelInstance*) instanceData;
518 int mask = TCL_READABLE | TCL_WRITABLE;
519
520 /*
521 * Timer fired, our token is useless now.
522 */
523
524 chan->timer = (Tcl_TimerToken) NULL;
525
526 if (!chan->interest) {
527 return;
528 }
529
530 if (chan->rwLoc > chan->used)
531 mask &= ~TCL_READABLE;
532
533 /* Tell Tcl about the possible events.
534 * This will regenerate the timer too, via 'WatchChannel'.
535 */
536
537 mask &= chan->interest;
538 if (mask) {
539 Tcl_NotifyChannel (chan->chan, mask);
540 } else {
541 chan->timer = Tcl_CreateTimerHandler (DELAY, ChannelReady, instanceData);
542 }
543 }
544
545 /*
546 *------------------------------------------------------*
547 *
548 * GetFile --
549 *
550 * ------------------------------------------------*
551 * Called from Tcl_GetChannelHandle to retrieve
552 * OS handles from inside a in-memory channel.
553 * ------------------------------------------------*
554 *
555 * Sideeffects:
556 * None.
557 *
558 * Result:
559 * The appropriate OS handle or NULL if not
560 * present.
561 *
562 *------------------------------------------------------*
563 */
564 static int
GetFile(instanceData,direction,handlePtr)565 GetFile (instanceData, direction, handlePtr)
566 ClientData instanceData; /* Channel to query */
567 int direction; /* Direction of interest */
568 ClientData* handlePtr; /* Space to the handle into */
569 {
570 /*
571 * In-memory channels are not based on files.
572 */
573
574 /* *handlePtr = (ClientData) NULL; */
575 return TCL_ERROR;
576 }
577
578 /*
579 * ----------------------------------------------------------------------
580 *
581 * Memchan_CreateMemoryChannel -
582 *
583 * Creates a new 'memchan' channel.
584 *
585 * Results:
586 * Returns the newly minted channel
587 *
588 * Side effects:
589 * A new 'memchan' channel is registered in the current interpreter.
590 *
591 * ----------------------------------------------------------------------
592 */
593
594 Tcl_Channel
Memchan_CreateMemoryChannel(interp,initialSize)595 Memchan_CreateMemoryChannel(interp, initialSize)
596 Tcl_Interp *interp; /* current interpreter */
597 int initialSize; /* buffer size to pre-allocate */
598 {
599 Tcl_Obj* channelHandle;
600 Tcl_Channel chan;
601 ChannelInstance* instance;
602
603 instance = (ChannelInstance*) Tcl_Alloc (sizeof (ChannelInstance));
604 instance->rwLoc = 0;
605 instance->used = 0;
606 instance->allocated = initialSize;
607
608 if (initialSize > 0) {
609 instance->data = (VOID*) Tcl_Alloc (initialSize);
610 } else {
611 instance->data = (VOID*) NULL;
612 }
613
614 channelHandle = MemchanGenHandle ("mem");
615
616 chan = Tcl_CreateChannel (&channelType,
617 Tcl_GetStringFromObj (channelHandle, NULL),
618 (ClientData) instance,
619 TCL_READABLE | TCL_WRITABLE);
620
621 instance->chan = chan;
622 instance->timer = (Tcl_TimerToken) NULL;
623 instance->interest = 0;
624
625 Tcl_RegisterChannel (interp, chan);
626 Tcl_SetChannelOption (interp, chan, "-buffering", "none");
627 Tcl_SetChannelOption (interp, chan, "-blocking", "0");
628
629 return chan;
630 }
631
632 /*
633 *------------------------------------------------------*
634 *
635 * MemchanCmd --
636 *
637 * ------------------------------------------------*
638 * This procedure realizes the 'memchan' command.
639 * See the manpages for details on what it does.
640 * ------------------------------------------------*
641 *
642 * Sideeffects:
643 * See the user documentation.
644 *
645 * Result:
646 * A standard Tcl result.
647 *
648 *------------------------------------------------------*
649 */
650 /* ARGSUSED */
651 int
MemchanCmd(notUsed,interp,objc,objv)652 MemchanCmd (notUsed, interp, objc, objv)
653 ClientData notUsed; /* Not used. */
654 Tcl_Interp* interp; /* Current interpreter. */
655 int objc; /* Number of arguments. */
656 Tcl_Obj*CONST objv[]; /* Argument objects. */
657 {
658 Tcl_Channel chan;
659 int initialSize = 0;
660
661 if ((objc != 1) && (objc != 3)) {
662 goto argerr;
663 } else if (objc == 3) {
664 int len;
665 char* buf = Tcl_GetStringFromObj (objv [1], &len);
666
667 if (0 != strncmp (buf, "-initial-size", len)) {
668 goto argerr;
669 } else if (TCL_OK != Tcl_GetIntFromObj (interp, objv [2], &initialSize)) {
670 goto argerr;
671 }
672 }
673
674 chan = Memchan_CreateMemoryChannel(interp, initialSize);
675 Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *)NULL);
676 return TCL_OK;
677
678 argerr:
679 Tcl_AppendResult (interp,
680 "wrong # args: should be \"memchan ?-initial-size number?\"",
681 (char*) NULL);
682 return TCL_ERROR;
683 }
684
685