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