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