1/*
2 * registry.c --
3 *
4 *	Implements the C level procedures handling the registry
5 *
6 *
7 * Copyright (c) 1996-1999 Andreas Kupries (a.kupries@westend.com)
8 * All rights reserved.
9 *
10 * Permission is hereby granted, without written agreement and without
11 * license or royalty fees, to use, copy, modify, and distribute this
12 * software and its documentation for any purpose, provided that the
13 * above copyright notice and the following two paragraphs appear in
14 * all copies of this software.
15 *
16 * IN NO EVENT SHALL I LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL,
17 * INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS
18 * SOFTWARE AND ITS DOCUMENTATION, EVEN IF I HAVE BEEN ADVISED OF THE
19 * POSSIBILITY OF SUCH DAMAGE.
20 *
21 * I SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
22 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
23 * PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND
24 * I HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
25 * ENHANCEMENTS, OR MODIFICATIONS.
26 *
27 * CVS: $Id: registry.c,v 1.58 2009/05/07 05:30:35 andreas_kupries Exp $
28 */
29
30#include "transformInt.h"
31
32/*
33 * Code used to associate the registry with an interpreter.
34 */
35
36#define ASSOC "binTrf"
37
38#ifdef TRF_DEBUG
39int n = 0;
40#endif
41
42/*
43 * Possible values for 'flags' field in control structure.
44 */
45#define CHANNEL_ASYNC		(1<<0) /* non-blocking mode */
46
47/*
48 * Number of milliseconds to wait before firing an event to flush
49 * out information waiting in buffers (fileevent support).
50 *
51 * Relevant for only Tcl 8.0 and beyond.
52 */
53
54#define TRF_DELAY (5)
55
56/*
57 * Structures used by an attached transformation procedure
58 *
59 * => Information stored for a single direction of the channel.
60 * => Information required by a result buffer.
61 * => Information stored for the complete channel.
62 */
63
64typedef struct _DirectionInfo_ {
65  Trf_ControlBlock   control; /* control block of transformation */
66  Trf_Vectors*       vectors; /* vectors used during the transformation */
67} DirectionInfo;
68
69
70/*
71 * Definition of the structure containing the information about the
72 * internal input buffer.
73 */
74
75typedef struct _SeekState_ SeekState;
76
77typedef struct _ResultBuffer_ {
78  unsigned char* buf;       /* Reference to the buffer area */
79  int            allocated; /* Allocated size of the buffer area */
80  int            used;      /* Number of bytes in the buffer, <= allocated */
81
82  SeekState*    seekState;
83} ResultBuffer;
84
85
86typedef struct _SeekConfig_ {
87
88  int          overideAllowed; /* Boolean flag. If set the user may overide the
89				* standard policy with his own choice */
90  Trf_SeekInformation natural; /* Natural seek policy, copied from the
91				* transform definition */
92  Trf_SeekInformation  chosen;  /* Seek policy chosen from natural policy
93				 * and the underlying channels; */
94  int identity;                 /* Flag, set if 'identity' was forced by the
95				 * user. */
96} SeekConfig;
97
98
99struct _SeekState_ {
100  /* -- Integrity conditions --
101   *
102   * BufStartLoc == BufEndLoc	implies 	ResultLength(&result) == 0.
103   * BufStartLoc == BufEndLoc	implies		UpLoc == BufStart.
104   *
105   * UP_CONVERT (DownLoc - AheadOffset) == BufEndLoc
106   *
107   * UpXLoc % seekState.used.numBytesTransform == 0
108   * <=> Transform may seek only in multiples of its input tuples.
109   *
110   * (DownLoc - AheadOffset) % seekState.used.numBytesDown == 0
111   * <=> Downstream channel operates in multiples of the transformation
112   *     output tuples, except for possible offsets because of read ahead.
113   *
114   * UP_CONVERT (DownZero) == 0
115   *
116   * -- Integrity conditions --
117   */
118
119  Trf_SeekInformation    used;  /* Seek policy currently in effect, might
120				 * be chosen by user */
121  int                 allowed;  /* Flag. Set for seekable transforms. Derived
122				 * from the contents of 'used'. */
123
124  int upLoc;         /* Current location of file pointer in the
125		      * transformed stream. */
126  int upBufStartLoc; /* Same as above, for start of read buffer (result) */
127  int upBufEndLoc;   /* See above, for the character after the end of the
128		      * buffer. */
129  int downLoc;       /* Current location of the file pointer in the channel
130		      * downstream. */
131  int downZero;      /* location downstream equivalent to UpLoc == 0 */
132  int aheadOffset;   /* #Bytes DownLoc is after the down location of
133		      * BufEnd. Values > 0 indicate incomplete data in the
134		      * transform buffer itself. */
135  int changed;       /* Flag, set if seeking occured with 'identity' set */
136};
137
138
139/** XXX change definition for 8.2, at compile time */
140
141typedef struct _TrfTransformationInstance_ {
142#ifdef USE_TCL_STUBS
143  int patchVariant; /* See transformInt.h, Trf_Registry */
144#endif
145
146  /* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com> */
147
148  Tcl_Channel self;   /* Our own channel handle */
149  Tcl_Channel parent; /* The channel we are stacked upon. Relevant
150		       * only for values PATCH_ORIG and PATCH_832 of
151		       * 'patchVariant', see above. */
152
153  int readIsFlushed; /* flag to note wether in.flushProc was called or not */
154
155  /* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com> */
156
157  int flags;         /* currently CHANNEL_ASYNC or zero */
158  int watchMask;     /* current TrfWatch mask */
159
160  int mode;          /* mode of parent channel,
161		      * OR'ed combination of
162		      * TCL_READABLE, TCL_WRITABLE */
163
164  /* Tcl_Transformation standard; data required for all transformation
165   * instances.
166   */
167  DirectionInfo      in;   /* information for transformation of read data */
168  DirectionInfo      out;  /* information for transformation of written data */
169  ClientData         clientData; /* copy from entry->trfType->clientData */
170
171  /*
172   * internal result buffer used during transformations of incoming data.
173   * Stores results waiting for retrieval too, i.e. state information
174   * carried from call to call.
175   */
176
177  ResultBuffer result;
178
179  /* Number of bytes written during a down transformation.
180   */
181
182  int lastWritten;
183
184  /* Number of bytes stored during an up transformation
185   */
186
187  int lastStored;
188
189
190  /* Timer for automatic push out of information sitting in various channel
191   * buffers. Used by the fileevent support. See 'ChannelHandler'.
192   */
193
194  Tcl_TimerToken timer;
195
196  /* Information about the chosen and used seek policy and wether the user
197   * is allowed to change it. Runtime configuration.
198   */
199
200  SeekConfig seekCfg;
201
202  /* More seek information, runtime state.
203   */
204
205  SeekState seekState;
206
207#ifdef TRF_STREAM_DEBUG
208  char*         name;       /* Name of transformation command */
209  unsigned long inCounter;  /* Number of bytes read from below */
210  unsigned long outCounter; /* Number of bytes stored in 'result' */
211#endif
212
213} TrfTransformationInstance;
214
215#ifdef TRF_STREAM_DEBUG
216#define STREAM_IN(trans,blen,buf) {int i; for (i=0;i<(blen);i++,(trans)->inCounter++) {printf ("%p:%s:in_\t%d\t%02x\n", (trans), (trans)->name, (trans)->inCounter, 0xff & ((buf) [i]));}}
217#define STREAM_OUT(trans,blen,buf) {int i; for (i=0;i<(blen);i++,(trans)->outCounter++) {printf ("%p:%s:out\t%d\t%02x\n", (trans), (trans)->name, (trans)->outCounter, 0xff & ((buf) [i]));}}
218#else
219#define STREAM_IN(t,bl,b)
220#define STREAM_OUT(t,bl,b)
221#endif
222
223
224#define INCREMENT (512)
225#define READ_CHUNK_SIZE 4096
226
227
228#define TRF_UP_CONVERT(trans,k) \
229     (((k) / trans->seekState.used.numBytesDown) * trans->seekState.used.numBytesTransform)
230
231#define TRF_DOWN_CONVERT(trans,k) \
232     (((k) / trans->seekState.used.numBytesTransform) * trans->seekState.used.numBytesDown)
233
234#define TRF_IS_UNSEEKABLE(si) \
235     (((si).numBytesTransform == 0) || ((si).numBytesDown == 0))
236
237#define TRF_SET_UNSEEKABLE(si) \
238     {(si).numBytesTransform = 0 ; (si).numBytesDown = 0;}
239
240
241
242/*
243 * forward declarations of all internally used procedures.
244 */
245
246static Tcl_ChannelType*
247AllocChannelType _ANSI_ARGS_ ((int* sizePtr));
248
249static Tcl_ChannelType*
250InitializeChannelType _ANSI_ARGS_ ((CONST char* name, int patchVariant));
251
252
253static int
254TrfUnregister _ANSI_ARGS_ ((Tcl_Interp*       interp,
255                            Trf_RegistryEntry* entry));
256
257static void
258TrfDeleteRegistry _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp));
259
260static int
261TrfExecuteObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp* interp,
262			      int objc, struct Tcl_Obj* CONST objv []));
263
264static void
265TrfDeleteCmd _ANSI_ARGS_((ClientData clientData));
266
267#if 0
268static int
269TrfInfoObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp* interp,
270			   int objc, struct Tcl_Obj* CONST objv []));
271#endif
272/* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com>
273 */
274static int
275TrfBlock _ANSI_ARGS_ ((ClientData instanceData, int mode));
276
277static int
278TrfClose _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp* interp));
279
280static int
281TrfInput _ANSI_ARGS_ ((ClientData instanceData,
282		       char* buf, int toRead,
283		       int*       errorCodePtr));
284
285static int
286TrfOutput _ANSI_ARGS_ ((ClientData instanceData,
287			CONST84 char* buf, int toWrite,
288			int*        errorCodePtr));
289
290static int
291TrfSeek _ANSI_ARGS_ ((ClientData instanceData, long offset,
292		      int mode, int* errorCodePtr));
293static void
294TrfWatch _ANSI_ARGS_ ((ClientData instanceData, int mask));
295
296static int
297TrfGetFile _ANSI_ARGS_ ((ClientData instanceData, int direction,
298			 ClientData* handlePtr));
299
300static int
301TrfGetOption _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp* interp,
302			   CONST84 char* optionName, Tcl_DString* dsPtr));
303
304static int
305TrfSetOption _ANSI_ARGS_((ClientData instanceData, Tcl_Interp* interp,
306			  CONST char* optionName, CONST char* value));
307#ifdef USE_TCL_STUBS
308static int
309TrfNotify _ANSI_ARGS_((ClientData instanceData, int interestMask));
310#endif
311
312static int
313TransformImmediate _ANSI_ARGS_ ((Tcl_Interp* interp, Trf_RegistryEntry* entry,
314				 Tcl_Channel source, Tcl_Channel destination,
315				 struct Tcl_Obj* CONST in,
316				 Trf_Options optInfo));
317
318static int
319AttachTransform _ANSI_ARGS_ ((Trf_RegistryEntry* entry,
320			      Trf_BaseOptions*   baseOpt,
321			      Trf_Options        optInfo,
322			      Tcl_Interp*        interp));
323
324static int
325PutDestination _ANSI_ARGS_ ((ClientData clientData,
326                             unsigned char* outString, int outLen,
327                             Tcl_Interp* interp));
328
329static int
330PutDestinationImm _ANSI_ARGS_ ((ClientData clientData,
331				unsigned char* outString, int outLen,
332				Tcl_Interp* interp));
333static int
334PutTrans _ANSI_ARGS_ ((ClientData clientData,
335		       unsigned char* outString, int outLen,
336		       Tcl_Interp* interp));
337
338static int
339PutInterpResult _ANSI_ARGS_ ((ClientData clientData,
340			      unsigned char* outString, int outLen,
341			      Tcl_Interp* interp));
342/* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com>
343 */
344static void
345ChannelHandler _ANSI_ARGS_ ((ClientData clientData, int mask));
346
347static void
348ChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData));
349
350#ifdef USE_TCL_STUBS
351static Tcl_Channel
352DownChannel _ANSI_ARGS_ ((TrfTransformationInstance* ctrl));
353
354static int
355DownSeek _ANSI_ARGS_ ((TrfTransformationInstance* ctrl, int offset, int mode));
356
357static int
358DownRead _ANSI_ARGS_ ((TrfTransformationInstance* ctrl,
359		       char* buf, int toRead));
360static int
361DownWrite _ANSI_ARGS_ ((TrfTransformationInstance* ctrl,
362		       char* buf, int toWrite));
363static int
364DownSOpt _ANSI_ARGS_ ((Tcl_Interp* interp,
365		       TrfTransformationInstance* ctrl,
366		       CONST char* optionName, CONST char* value));
367static int
368DownGOpt _ANSI_ARGS_ ((Tcl_Interp* interp,
369		       TrfTransformationInstance* ctrl,
370		       CONST84 char* optionName, Tcl_DString* dsPtr));
371
372#define DOWNC(trans)             (DownChannel (trans))
373#define TELL(trans)              (SEEK (trans, 0, SEEK_CUR))
374#define SEEK(trans,off,mode)     (DownSeek  ((trans), (off), (mode)))
375#define READ(trans,buf,toRead)   (DownRead  ((trans), (buf), (toRead)))
376#define WRITE(trans,buf,toWrite) (DownWrite ((trans), (buf), (toWrite)))
377#define SETOPT(i,trans,opt,val)  (DownSOpt  ((i), (trans), (opt), (val)))
378#define GETOPT(i,trans,opt,ds)   (DownGOpt  ((i), (trans), (opt), (ds)))
379#else
380#define DOWNC(trans)             ((trans)->parent)
381#define TELL(trans)              (SEEK (trans, 0, SEEK_CUR))
382#define SEEK(trans,off,mode)     (Tcl_Seek  ((trans)->parent, (off), (mode)))
383#define READ(trans,buf,toRead)   (Tcl_Read  ((trans)->parent, (buf), (toRead)))
384#define WRITE(trans,buf,toWrite) (Tcl_Write ((trans)->parent, (buf), (toWrite)))
385#define SETOPT(i,trans,opt,val)  (Tcl_SetChannelOption ((i), (trans)->parent, (opt), (val)))
386#define GETOPT(i,trans,opt,ds)   (Tcl_GetChannelOption ((i), (trans)->parent, (opt), (ds)))
387#endif
388
389/* Convenience macro for allocation
390 * of new transformation instances.
391 */
392
393#define NEW_TRANSFORM \
394(TrfTransformationInstance*) ckalloc (sizeof (TrfTransformationInstance));
395
396/* Procedures to handle the internal timer.
397 */
398
399static void
400TimerKill _ANSI_ARGS_ ((TrfTransformationInstance* trans));
401
402static void
403TimerSetup _ANSI_ARGS_ ((TrfTransformationInstance* trans));
404
405static void
406ChannelHandlerKS _ANSI_ARGS_ ((TrfTransformationInstance* trans, int mask));
407
408
409
410/* Procedures to handle the internal read buffer.
411 */
412
413static void             ResultClear  _ANSI_ARGS_ ((ResultBuffer* r));
414static void             ResultInit   _ANSI_ARGS_ ((ResultBuffer* r));
415static int              ResultLength _ANSI_ARGS_ ((ResultBuffer* r));
416static int              ResultCopy   _ANSI_ARGS_ ((ResultBuffer* r,
417			    unsigned char* buf, int toRead));
418static void             ResultDiscardAtStart _ANSI_ARGS_ ((ResultBuffer* r,
419							   int n));
420static void             ResultAdd    _ANSI_ARGS_ ((ResultBuffer* r,
421                            unsigned char* buf, int toWrite));
422
423/*
424 * Procedures to handle seeking information.
425 */
426
427static void
428SeekCalculatePolicies _ANSI_ARGS_ ((TrfTransformationInstance* trans));
429
430static void
431SeekInitialize _ANSI_ARGS_ ((TrfTransformationInstance* trans));
432
433static void
434SeekClearBuffer _ANSI_ARGS_ ((TrfTransformationInstance* trans, int which));
435
436static void
437SeekSynchronize _ANSI_ARGS_ ((TrfTransformationInstance* trans,
438			      Tcl_Channel parent));
439
440static Tcl_Obj*
441SeekStateGet _ANSI_ARGS_ ((Tcl_Interp* interp, SeekState* state));
442
443static Tcl_Obj*
444SeekConfigGet _ANSI_ARGS_ ((Tcl_Interp* interp, SeekConfig* cfg));
445
446static void
447SeekPolicyGet _ANSI_ARGS_ ((TrfTransformationInstance* trans,
448			    char*                      policy));
449
450#ifdef TRF_DEBUG
451static void
452SeekDump _ANSI_ARGS_ ((TrfTransformationInstance* trans, CONST char* place));
453
454#define SEEK_DUMP(str) SeekDump (trans, #str)
455#else
456#define SEEK_DUMP(str)
457#endif
458
459/*
460 *------------------------------------------------------*
461 *
462 *	TrfGetRegistry --
463 *
464 *	------------------------------------------------*
465 *	Accessor to the interpreter associated registry
466 *	of transformations.
467 *	------------------------------------------------*
468 *
469 *	Sideeffects:
470 *		Allocates and initializes the hashtable
471 *		during the first call and associates it
472 *		with the specified interpreter.
473 *
474 *	Result:
475 *		The internal registry of transformations.
476 *
477 *------------------------------------------------------*
478 */
479
480Trf_Registry*
481TrfGetRegistry (interp)
482Tcl_Interp* interp;
483{
484  Trf_Registry* registry;
485
486  START (TrfGetRegistry);
487
488  registry = TrfPeekForRegistry (interp);
489
490  if (registry == (Trf_Registry*) NULL) {
491    registry           = (Trf_Registry*)  ckalloc (sizeof (Trf_Registry));
492    registry->registry = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
493
494    Tcl_InitHashTable (registry->registry, TCL_STRING_KEYS);
495
496    Tcl_SetAssocData (interp, ASSOC, TrfDeleteRegistry,
497		      (ClientData) registry);
498  }
499
500  DONE (TrfGetRegistry);
501  return registry;
502}
503
504/*
505 *------------------------------------------------------*
506 *
507 *	TrfPeekForRegistry --
508 *
509 *	------------------------------------------------*
510 *	Accessor to the interpreter associated registry
511 *	of transformations. Does not create the registry
512 *	(in contrast to 'TrfGetRegistry').
513 *	------------------------------------------------*
514 *
515 *	Sideeffects:
516 *		None.
517 *
518 *	Result:
519 *		The internal registry of transformations.
520 *
521 *------------------------------------------------------*
522 */
523
524Trf_Registry*
525TrfPeekForRegistry (interp)
526Tcl_Interp* interp;
527{
528  Tcl_InterpDeleteProc* proc;
529
530  START (TrfPeekForRegistry);
531
532  proc = TrfDeleteRegistry;
533
534  DONE (TrfPeekForRegistry);
535  return (Trf_Registry*) Tcl_GetAssocData (interp, ASSOC, &proc);
536}
537
538/*
539 *------------------------------------------------------*
540 *
541 *	Trf_Register --
542 *
543 *	------------------------------------------------*
544 *	Announce a transformation to the registry associated
545 *	with the specified interpreter.
546 *	------------------------------------------------*
547 *
548 *	Sideeffects:
549 *		May create the registry. Allocates and
550 *		initializes the structure describing
551 *		the announced transformation.
552 *
553 *	Result:
554 *		A standard TCL error code.
555 *
556 *------------------------------------------------------*
557 */
558
559int
560Trf_Register (interp, type)
561Tcl_Interp*               interp;
562CONST Trf_TypeDefinition* type;
563{
564  Trf_Registry*      registry;
565  Trf_RegistryEntry* entry;
566  Tcl_HashEntry*     hPtr;
567  int                new;
568
569  START (Trf_Register);
570  PRINT ("(%p, \"%s\")\n", type, type->name); FL;
571
572  registry = TrfGetRegistry (interp);
573
574  /*
575   * Already defined ?
576   */
577
578  hPtr = Tcl_FindHashEntry (registry->registry, (char*) type->name);
579
580  if (hPtr != (Tcl_HashEntry*) NULL) {
581    PRINT ("Already defined!\n"); FL;
582    DONE (Trf_Register);
583    return TCL_ERROR;
584  }
585
586  /*
587   * Check validity of given structure
588   */
589
590#define IMPLY(a,b) ((! (a)) || (b))
591
592  /* assert (type->options); */
593  assert (IMPLY(type->options != NULL, type->options->createProc != NULL));
594  assert (IMPLY(type->options != NULL, type->options->deleteProc != NULL));
595  assert (IMPLY(type->options != NULL, type->options->checkProc  != NULL));
596  assert (IMPLY(type->options != NULL,
597		(type->options->setProc   != NULL) ||
598		(type->options->setObjProc != NULL)));
599  assert (IMPLY(type->options != NULL, type->options->queryProc  != NULL));
600
601  assert (type->encoder.createProc);
602  assert (type->encoder.deleteProc);
603  assert ((type->encoder.convertProc != NULL) ||
604	  (type->encoder.convertBufProc != NULL));
605  assert (type->encoder.flushProc);
606  assert (type->encoder.clearProc);
607
608  assert (type->decoder.createProc);
609  assert (type->decoder.deleteProc);
610  assert ((type->decoder.convertProc != NULL) ||
611	  (type->decoder.convertBufProc != NULL));
612  assert (type->decoder.flushProc);
613  assert (type->decoder.clearProc);
614
615  /*
616   * Generate command to execute transformations immediately or to generate
617   * filters.
618   */
619
620  entry          = (Trf_RegistryEntry*) ckalloc (sizeof (Trf_RegistryEntry));
621  entry->registry   = registry;
622
623  entry->trfType    = (Trf_TypeDefinition*) type;
624  entry->interp     = interp;
625#ifndef USE_TCL_STUBS
626  entry->transType  = InitializeChannelType (type->name, -1);
627#else
628  entry->transType  = InitializeChannelType (type->name,
629					     registry->patchVariant);
630#endif
631  entry->trfCommand = Tcl_CreateObjCommand (interp, (char*) type->name,
632					    TrfExecuteObjCmd,
633					    (ClientData) entry, TrfDeleteCmd);
634
635  /*
636   * Add entry to internal registry.
637   */
638
639  hPtr = Tcl_CreateHashEntry (registry->registry, (char*) type->name, &new);
640  Tcl_SetHashValue (hPtr, entry);
641
642  DONE (Trf_Register);
643  return TCL_OK;
644}
645
646/*
647 *------------------------------------------------------*
648 *
649 *	Trf_Unregister --
650 *
651 *	------------------------------------------------*
652 *	Removes the transformation from the registry
653 *	------------------------------------------------*
654 *
655 *	Sideeffects:
656 *		Releases the memory allocated in 'Trf_Register'.
657 *
658 *	Result:
659 *		A standard TCL error code.
660 *
661 *------------------------------------------------------*
662 */
663
664static int
665TrfUnregister (interp, entry)
666Tcl_Interp*        interp;
667Trf_RegistryEntry* entry;
668{
669  Trf_Registry*  registry;
670  Tcl_HashEntry* hPtr;
671
672  START (Trf_Unregister);
673
674  registry  = TrfGetRegistry    (interp);
675  hPtr      = Tcl_FindHashEntry (registry->registry,
676				 (char*) entry->trfType->name);
677
678  ckfree ((char*) entry->transType);
679  ckfree ((char*) entry);
680
681  Tcl_DeleteHashEntry (hPtr);
682
683  DONE (Trf_Unregister);
684  return TCL_OK;
685}
686
687/*
688 *------------------------------------------------------*
689 *
690 *	TrfDeleteRegistry --
691 *
692 *	------------------------------------------------*
693 *	Trap handler. Called by the Tcl core during
694 *	interpreter destruction. Destroys the registry
695 *	of transformations.
696 *	------------------------------------------------*
697 *
698 *	Sideeffects:
699 *		Releases the memory allocated in 'TrfGetRegistry'.
700 *
701 *	Result:
702 *		None.
703 *
704 *------------------------------------------------------*
705 */
706
707static void
708TrfDeleteRegistry (clientData, interp)
709ClientData  clientData;
710Tcl_Interp* interp;
711{
712  Trf_Registry* registry = (Trf_Registry*) clientData;
713
714  START (TrfDeleteRegistry);
715
716  /*
717   * The commands are already deleted, therefore the hashtable is empty here.
718   */
719
720  Tcl_DeleteHashTable (registry->registry);
721  ckfree ((char*) registry);
722
723  DONE (TrfDeleteRegistry);
724}
725
726/* (readable) shortcuts for calling the option processing vectors.
727 */
728
729#define CLT  (entry->trfType->clientData)
730#define OPT  (entry->trfType->options)
731
732#define CREATE_OPTINFO         (OPT ? (*OPT->createProc) (CLT) : NULL)
733#define DELETE_OPTINFO         if (optInfo) (*OPT->deleteProc) (optInfo, CLT)
734#define CHECK_OPTINFO(baseOpt) (optInfo ? (*OPT->checkProc) (optInfo, interp, &baseOpt, CLT) : TCL_OK)
735#define SET_OPTION(opt,optval) (optInfo ? (*OPT->setProc) (optInfo, interp, opt, optval, CLT) : TCL_ERROR)
736
737#define SET_OPTION_OBJ(opt,optval) (optInfo ? (*OPT->setObjProc) (optInfo, interp, opt, optval, CLT) : TCL_ERROR)
738
739#define ENCODE_REQUEST(entry,optInfo) (optInfo ? (*OPT->queryProc) (optInfo, CLT) : 1)
740
741/*
742 *------------------------------------------------------*
743 *
744 *	TrfExecuteObjCmd --
745 *
746 *	------------------------------------------------*
747 *	Implementation procedure for all transformations.
748 *	Equivalent to 'TrfExecuteCmd', but using the new
749 *	Object interfaces.
750 *	------------------------------------------------*
751 *
752 *	Sideeffects:
753 *		See 'TrfExecuteCmd'.
754 *
755 *	Result:
756 *		A standard TCL error code.
757 *
758 *------------------------------------------------------*
759 */
760
761static int
762TrfExecuteObjCmd (clientData, interp, objc, objv)
763     ClientData              clientData;
764     Tcl_Interp*             interp;
765     int                     objc;
766     struct Tcl_Obj* CONST * objv;
767{
768  /* (readable) shortcuts for calling the option processing vectors.
769   * as defined in 'TrfExecuteCmd'.
770   */
771
772  int                res, len;
773  /*  Tcl_Channel        source, destination;*/
774  /*  int                src_mode, dst_mode;*/
775  const char*        cmd;
776  const char*        option;
777  struct Tcl_Obj*    optarg;
778  Trf_RegistryEntry* entry;
779  Trf_Options        optInfo;
780  Trf_BaseOptions    baseOpt;
781  int                mode;
782  int                wrong_mod2;
783  int                wrong_number;
784
785  START (TrfExecuteObjCmd);
786#ifdef TRF_DEBUG
787  {
788    int i;
789    for (i = 0; i < objc; i++) {
790      PRINT ("Argument [%03d] = \"%s\"\n",
791	     i, Tcl_GetStringFromObj (objv [i], NULL)); FL;
792    }
793  }
794#endif
795
796  baseOpt.attach      = (Tcl_Channel) NULL;
797  baseOpt.attach_mode = 0;
798  baseOpt.source      = (Tcl_Channel) NULL;
799  baseOpt.destination = (Tcl_Channel) NULL;
800  baseOpt.policy      = (Tcl_Obj*)    NULL;
801
802  entry = (Trf_RegistryEntry*) clientData;
803  cmd   = Tcl_GetStringFromObj (objv [0], NULL);
804
805  objc --;
806  objv ++;
807
808  optInfo = CREATE_OPTINFO;
809
810  PRINT ("Processing options...\n"); FL; IN;
811
812  while ((objc > 0) && (*Tcl_GetStringFromObj (objv [0], NULL) == '-')) {
813    /*
814     * Process options, as long as they are found
815     */
816
817    option = Tcl_GetStringFromObj (objv [0], NULL);
818
819    if (0 == strcmp (option, "--")) {
820      /* end of option list */
821      objc--, objv++;
822      break;
823    }
824
825    wrong_number = (objc < 2); /* option, but without argument */
826
827    optarg = objv [1];
828
829    objc -= 2;
830    objv += 2;
831
832    len = strlen (option);
833
834    if (len < 2)
835      goto unknown_option;
836
837    switch (option [1])
838      {
839      case 'a':
840	if (0 != strncmp (option, "-attach", len))
841	  goto check_for_trans_option;
842
843	if (wrong_number) {
844	  Tcl_AppendResult (interp, cmd, ": wrong # args, option \"", option, "\" requires an argument", (char*) NULL);
845	  OT;
846	  goto cleanup_after_error;
847	}
848
849	baseOpt.attach = Tcl_GetChannel (interp,
850					 Tcl_GetStringFromObj (optarg, NULL),
851					 &baseOpt.attach_mode);
852	if (baseOpt.attach == (Tcl_Channel) NULL) {
853	  OT;
854	  goto cleanup_after_error;
855	}
856	break;
857
858      case 'i':
859	if (0 != strncmp (option, "-in", len))
860	  goto check_for_trans_option;
861
862	if (wrong_number) {
863	  Tcl_AppendResult (interp, cmd, ": wrong # args, option \"", option, "\" requires an argument", (char*) NULL);
864	  OT;
865	  goto cleanup_after_error;
866	}
867
868	baseOpt.source = Tcl_GetChannel (interp,
869					 Tcl_GetStringFromObj (optarg, NULL),
870					 &mode);
871	if (baseOpt.source == (Tcl_Channel) NULL)
872	  goto cleanup_after_error;
873
874	if (! (mode & TCL_READABLE)) {
875	  Tcl_AppendResult (interp, cmd,
876			    ": source-channel not readable",
877			    (char*) NULL);
878	  OT;
879	  goto cleanup_after_error;
880	}
881	break;
882
883      case 'o':
884	if (0 != strncmp (option, "-out", len))
885	  goto check_for_trans_option;
886
887	if (wrong_number) {
888	  Tcl_AppendResult (interp, cmd, ": wrong # args, option \"", option, "\" requires an argument", (char*) NULL);
889	  OT;
890	  goto cleanup_after_error;
891	}
892
893	baseOpt.destination = Tcl_GetChannel (interp,
894					      Tcl_GetStringFromObj (optarg,
895								    NULL),
896					      &mode);
897
898	if (baseOpt.destination == (Tcl_Channel) NULL) {
899	  OT;
900	  goto cleanup_after_error;
901	}
902
903	if (! (mode & TCL_WRITABLE)) {
904	  Tcl_AppendResult (interp, cmd,
905			    ": destination-channel not writable",
906			    (char*) NULL);
907	  OT;
908	  goto cleanup_after_error;
909	}
910	break;
911
912      case 's':
913	if (0 != strncmp (option, "-seekpolicy", len))
914	  goto check_for_trans_option;
915
916	if (wrong_number) {
917	  Tcl_AppendResult (interp, cmd, ": wrong # args, option \"", option, "\" requires an argument", (char*) NULL);
918	  OT;
919	  goto cleanup_after_error;
920	}
921
922	baseOpt.policy = optarg;
923	Tcl_IncrRefCount (optarg);
924	break;
925
926      default:
927      check_for_trans_option:
928	if (wrong_number) {
929	  Tcl_AppendResult (interp, cmd, ": wrong # args, all options require an argument", (char*) NULL);
930	  OT;
931	  goto cleanup_after_error;
932	}
933
934	if ((*OPT->setObjProc) == NULL) {
935	  res = SET_OPTION     (option, Tcl_GetStringFromObj (optarg, NULL));
936	} else {
937	  res = SET_OPTION_OBJ (option, optarg);
938	}
939
940	if (res != TCL_OK) {
941	  OT;
942	  goto cleanup_after_error;
943	}
944	break;
945      } /* switch option */
946  } /* while options */
947
948  OT;
949
950  /*
951   * Check argument restrictions, insert defaults if necessary,
952   * execute the required operation.
953   */
954
955  if ((baseOpt.attach != (Tcl_Channel) NULL) &&
956      ((baseOpt.source      != (Tcl_Channel) NULL) ||
957       (baseOpt.destination != (Tcl_Channel) NULL))) {
958    Tcl_AppendResult (interp, cmd,
959	      ": inconsistent options, -in/-out not allowed with -attach",
960		      (char*) NULL);
961
962    PRINT ("Inconsistent options\n"); FL;
963    goto cleanup_after_error;
964  }
965
966  if ((baseOpt.attach == (Tcl_Channel) NULL) &&
967      baseOpt.policy !=  (Tcl_Obj*) NULL) {
968
969    Tcl_AppendResult (interp, cmd,
970		      ": inconsistent options, -seekpolicy ",
971		      "not allowed without -attach",
972		      (char*) NULL);
973
974    PRINT ("Inconsistent options\n"); FL;
975    goto cleanup_after_error;
976  }
977
978  if ((baseOpt.source == (Tcl_Channel) NULL) &&
979      (baseOpt.attach == (Tcl_Channel) NULL))
980    wrong_mod2 = 0;
981  else
982    wrong_mod2 = 1;
983
984  if (wrong_mod2 == (objc % 2)) {
985      Tcl_AppendResult (interp, cmd, ": wrong # args", (char*) NULL);
986      PRINT ("Wrong # args\n"); FL;
987      goto cleanup_after_error;
988  }
989
990  res = CHECK_OPTINFO (baseOpt);
991  if (res != TCL_OK) {
992    DELETE_OPTINFO;
993
994    PRINT ("Options contain errors\n"); FL;
995    DONE (TrfExecuteObjCmd);
996    return TCL_ERROR;
997  }
998
999  if (baseOpt.attach == (Tcl_Channel) NULL) /* TRF_IMMEDIATE */ {
1000    /*
1001     * Immediate execution of transformation requested.
1002     */
1003
1004    res = TransformImmediate (interp, entry,
1005			      baseOpt.source, baseOpt.destination,
1006			      objv [0], optInfo);
1007
1008  } else /* TRF_ATTACH */ {
1009    /*
1010     * User requested attachment of transformation procedure to a channel.
1011     * In case of a stub-aware interpreter use that to check for the
1012     * existence of the necessary patches ! Bail out if not.
1013     */
1014
1015#ifdef USE_TCL_STUBS
1016    if (Tcl_StackChannel == NULL) {
1017      Tcl_AppendResult (interp, cmd, ": this feature (-attach) is not ",
1018			"available as the required patch to the core ",
1019			"was not applied", (char*) NULL);
1020      DELETE_OPTINFO;
1021
1022      PRINT ("-attach not available\n"); FL;
1023      DONE (TrfExecuteObjCmd);
1024      return TCL_ERROR;
1025    }
1026#endif
1027
1028    res = AttachTransform (entry, &baseOpt, optInfo, interp);
1029
1030    if (baseOpt.policy != (Tcl_Obj*) NULL) {
1031      Tcl_DecrRefCount (baseOpt.policy);
1032      baseOpt.policy = (Tcl_Obj*) NULL;
1033    }
1034  }
1035
1036  DELETE_OPTINFO;
1037  DONE (TrfExecuteObjCmd);
1038  return res;
1039
1040
1041unknown_option:
1042  PRINT ("Unknown option \"%s\"\n", option); FL; OT;
1043
1044  Tcl_AppendResult (interp, cmd, ": unknown option '", option, "', should be '-attach/in/out' or '-seekpolicy'",
1045		    (char*) NULL);
1046  /* fall through to cleanup */
1047
1048cleanup_after_error:
1049  DELETE_OPTINFO;
1050  DONE (TrfExecuteObjCmd);
1051  return TCL_ERROR;
1052}
1053
1054/*
1055 *------------------------------------------------------*
1056 *
1057 *	TrfDeleteCmd --
1058 *
1059 *	------------------------------------------------*
1060 *	Trap handler. Called by the Tcl core during
1061 *	destruction of the command for invocation of a
1062 *	transformation.
1063 *	------------------------------------------------*
1064 *
1065 *	Sideeffects:
1066 *		Removes the transformation from the registry.
1067 *
1068 *	Result:
1069 *		None.
1070 *
1071 *------------------------------------------------------*
1072 */
1073
1074static void
1075TrfDeleteCmd (clientData)
1076ClientData clientData;
1077{
1078  Trf_RegistryEntry* entry;
1079
1080  START (TrfDeleteCmd);
1081
1082  entry = (Trf_RegistryEntry*) clientData;
1083
1084  TrfUnregister (entry->interp, entry);
1085  DONE (TrfDeleteCmd);
1086}
1087
1088/*
1089 *----------------------------------------------------------------------
1090 *
1091 * TrfInfoObjCmd --
1092 *
1093 *	This procedure is invoked to process the "trfinfo" Tcl command.
1094 *	See the user documentation for details on what it does.
1095 *
1096 * Results:
1097 *	A standard Tcl result.
1098 *
1099 * Side effects:
1100 *	None.
1101 *
1102 *----------------------------------------------------------------------
1103 */
1104#if 0
1105static int
1106TrfInfoObjCmd (notUsed, interp, objc, objv)
1107     ClientData              notUsed;	/* Not used. */
1108     Tcl_Interp*             interp;	/* Current interpreter. */
1109     int                     objc;
1110     struct Tcl_Obj* CONST * objv;
1111{
1112  /*
1113   * trfinfo <channel>
1114   */
1115
1116  static char* subcmd [] = {
1117    "seekstate", "seekcfg", NULL
1118  };
1119  enum subcmd {
1120    TRFINFO_SEEKSTATE, TRFINFO_SEEKCFG
1121  };
1122
1123  Tcl_Channel                chan;
1124  int                        mode, pindex;
1125  char*                      chanName;
1126  TrfTransformationInstance* trans;
1127
1128
1129  if ((objc < 2) || (objc > 3)) {
1130    Tcl_AppendResult (interp,
1131		      "wrong # args: should be \"trfinfo cmd channel\"",
1132		      (char*) NULL);
1133    return TCL_ERROR;
1134  }
1135
1136  chanName = Tcl_GetStringFromObj (objv [2], NULL);
1137  chan     = Tcl_GetChannel (interp, chanName, &mode);
1138
1139  if (chan == (Tcl_Channel) NULL) {
1140    return TCL_ERROR;
1141  }
1142
1143  if (Tcl_GetChannelType (chan)->seekProc != TrfSeek) {
1144    /* No trf transformation, info not applicable.
1145     */
1146
1147    Tcl_AppendResult (interp,
1148		      "channel \"", chanName,
1149		      "\" is no transformation from trf",
1150		      (char*) NULL);
1151    return TCL_ERROR;
1152  }
1153
1154  /* Peek into the instance structure and return the requested
1155   * information.
1156   */
1157
1158  if (Tcl_GetIndexFromObj(interp, objv [1], subcmd, "subcommand", 0,
1159			  &pindex) != TCL_OK) {
1160    return TCL_ERROR;
1161  }
1162
1163  trans = (TrfTransformationInstance*) Tcl_GetChannelInstanceData (chan);
1164
1165  switch (pindex) {
1166  case TRFINFO_SEEKSTATE:
1167    {
1168      Tcl_Obj* state = SeekStateGet (interp, &trans->seekState);
1169
1170      if (state == NULL)
1171	return TCL_ERROR;
1172
1173      Tcl_SetObjResult (interp, state);
1174      return TCL_OK;
1175    }
1176    break;
1177
1178  case TRFINFO_SEEKCFG:
1179    {
1180      Tcl_Obj* cfg = SeekConfigGet (interp, &trans->seekCfg);
1181
1182      if (cfg == NULL)
1183	return TCL_ERROR;
1184
1185      Tcl_SetObjResult (interp, cfg);
1186      return TCL_OK;
1187    }
1188    break;
1189
1190  default:
1191    /* impossible */
1192    return TCL_ERROR;
1193  }
1194
1195  /* We should not come to this place */
1196  return TCL_ERROR;
1197}
1198#endif
1199
1200/*
1201 *------------------------------------------------------*
1202 *
1203 *	TrfInit_Info --
1204 *
1205 *	------------------------------------------------*
1206 *	Register the 'info' command.
1207 *	------------------------------------------------*
1208 *
1209 *	Sideeffects:
1210 *		As of 'Tcl_CreateObjCommand'.
1211 *
1212 *	Result:
1213 *		A standard Tcl error code.
1214 *
1215 *------------------------------------------------------*
1216 */
1217
1218int
1219TrfInit_Info (interp)
1220Tcl_Interp* interp;
1221{
1222#if 0
1223  Tcl_CreateObjCommand (interp, "trfinfo", TrfInfoObjCmd,
1224			(ClientData) NULL,
1225			(Tcl_CmdDeleteProc *) NULL);
1226#endif
1227  return TCL_OK;
1228}
1229
1230/* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com>
1231 */
1232/*
1233 *------------------------------------------------------*
1234 *
1235 *	TrfBlock --
1236 *
1237 *	------------------------------------------------*
1238 *	Trap handler. Called by the generic IO system
1239 *	during option processing to change the blocking
1240 *	mode of the channel.
1241 *	------------------------------------------------*
1242 *
1243 *	Sideeffects:
1244 *		Forwards the request to the underlying
1245 *		channel.
1246 *
1247 *	Result:
1248 *		0 if successful, errno when failed.
1249 *
1250 *------------------------------------------------------*
1251 */
1252
1253static int
1254TrfBlock (instanceData, mode)
1255ClientData  instanceData;
1256int mode;
1257{
1258  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
1259  char                   block [2] = {0,0};
1260  Tcl_Channel            parent;
1261
1262  START (TrfBlock);
1263  PRINT ("Mode = %d\n", mode); FL;
1264
1265  parent = DOWNC (trans);
1266
1267  if (mode == TCL_MODE_NONBLOCKING) {
1268    trans->flags |= CHANNEL_ASYNC;
1269    block [0] = '0';
1270  } else {
1271    trans->flags &= ~(CHANNEL_ASYNC);
1272    block [0] = '1';
1273  }
1274
1275#ifndef USE_TCL_STUBS
1276  Tcl_SetChannelOption (NULL, parent, "-blocking", block);
1277#else
1278  if ((trans->patchVariant == PATCH_ORIG) ||
1279      (trans->patchVariant == PATCH_82)) {
1280    /*
1281     * Both old-style patch and first integrated version of the patch
1282     * require the transformation to pass the blocking mode to the
1283     * channel downstream. The newest implementation (PATCH_832)
1284     * handles this in the core.
1285     */
1286
1287    Tcl_SetChannelOption (NULL, parent, "-blocking", block);
1288  }
1289#endif
1290
1291  DONE (TrfBlock);
1292  return 0;
1293}
1294
1295/*
1296 *------------------------------------------------------*
1297 *
1298 *	TrfClose --
1299 *
1300 *	------------------------------------------------*
1301 *	Trap handler. Called by the generic IO system
1302 *	during destruction of the transformation channel.
1303 *	------------------------------------------------*
1304 *
1305 *	Sideeffects:
1306 *		Releases the memory allocated in
1307 *		'AttachTransform'.
1308 *
1309 *	Result:
1310 *		None.
1311 *
1312 *------------------------------------------------------*
1313 */
1314
1315static int
1316TrfClose (instanceData, interp)
1317ClientData  instanceData;
1318Tcl_Interp* interp;
1319{
1320  /*
1321   * The parent channel will be removed automatically
1322   * (if necessary and/or desired).
1323   */
1324
1325  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
1326  Tcl_Channel               parent;
1327
1328  START (TrfClose);
1329
1330#ifndef USE_TCL_STUBS
1331  if ((trans  == (TrfTransformationInstance*) NULL) ||
1332      (interp == (Tcl_Interp*) NULL)) {
1333    /* Hack, prevent 8.0 from crashing upon exit if channels
1334     * with transformations were left open during exit
1335     *
1336     * Suggested by Mikhail Teterin <mi@aldan.algebra.com> 25.11.1999.
1337     */
1338
1339    DONE (TrfClose);
1340    return TCL_OK;
1341  }
1342#endif
1343
1344  parent = DOWNC (trans);
1345
1346  /* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com>
1347   * Remove event handler to underlying channel, this could
1348   * be because we are closing for real, or being "unstacked".
1349   */
1350
1351#ifndef USE_TCL_STUBS
1352  Tcl_DeleteChannelHandler (parent, ChannelHandler, (ClientData) trans);
1353#else
1354  if ((trans->patchVariant == PATCH_ORIG) ||
1355      (trans->patchVariant == PATCH_82)) {
1356    Tcl_DeleteChannelHandler (parent, ChannelHandler, (ClientData) trans);
1357  }
1358  /*
1359   * PATCH_832 doesn't use channelhandlers for communication of events
1360   * between the channels of stack anymore.
1361   */
1362#endif
1363
1364  TimerKill (trans);
1365
1366  /*
1367   * Flush data waiting in transformation buffers to output.
1368   * Flush input too, maybe there are side effects other
1369   * parts do rely on (-> message digests).
1370   */
1371
1372  if (trans->mode & TCL_WRITABLE) {
1373    PRINT ("out.flushproc\n"); FL;
1374
1375    trans->out.vectors->flushProc (trans->out.control,
1376				   (Tcl_Interp*) NULL,
1377				   trans->clientData);
1378  }
1379
1380  if (trans->mode & TCL_READABLE) {
1381    if (!trans->readIsFlushed) {
1382      PRINT ("in_.flushproc\n"); FL;
1383
1384      trans->readIsFlushed = 1;
1385      trans->in.vectors->flushProc (trans->in.control,
1386				    (Tcl_Interp*) NULL,
1387				    trans->clientData);
1388    }
1389  }
1390
1391  if (trans->mode & TCL_WRITABLE) {
1392    PRINT ("out.deleteproc\n"); FL;
1393    trans->out.vectors->deleteProc (trans->out.control, trans->clientData);
1394  }
1395
1396  if (trans->mode & TCL_READABLE) {
1397    PRINT ("in_.deleteproc\n"); FL;
1398    trans->in.vectors->deleteProc  (trans->in.control,  trans->clientData);
1399  }
1400
1401  ResultClear (&trans->result);
1402
1403  /*
1404   * Complement to NEW_TRANSFORM in AttachChannel.
1405   * [Bug 2788106].
1406   */
1407  ckfree(trans);
1408
1409  DONE (TrfClose);
1410  return TCL_OK;
1411}
1412
1413/*
1414 *------------------------------------------------------*
1415 *
1416 *	TrfInput --
1417 *
1418 *	------------------------------------------------*
1419 *	Called by the generic IO system to convert read data.
1420 *	------------------------------------------------*
1421 *
1422 *	Sideeffects:
1423 *		As defined by the conversion.
1424 *
1425 *	Result:
1426 *		A transformed buffer.
1427 *
1428 *------------------------------------------------------*
1429 */
1430
1431static int
1432TrfInput (instanceData, buf, toRead, errorCodePtr)
1433ClientData instanceData;
1434char*      buf;
1435int        toRead;
1436int*       errorCodePtr;
1437{
1438  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
1439  int       gotBytes, read, i, res, copied, maxRead;
1440  Tcl_Channel parent;
1441
1442  START (TrfInput);
1443  PRINT ("trans = %p, toRead = %d\n", trans, toRead); FL;
1444
1445  parent = DOWNC (trans);
1446
1447  /* should assert (trans->mode & TCL_READABLE) */
1448
1449  gotBytes = 0;
1450
1451  SEEK_DUMP (TrfInput; Start);
1452
1453  while (toRead > 0) {
1454    /* Loop until the request is satisfied
1455     * (or no data available from below, possibly EOF).
1456     */
1457
1458    SEEK_DUMP (TrfInput; Loop_);
1459
1460    /* The position may be inside the buffer, and not at its start.
1461     * Remove the superfluous data now. There was no need to do it
1462     * earlier, as intervening seeks and writes could have discarded
1463     * the buffer completely, seeked back to an earlier point in it, etc.
1464     * We can be sure that the location is not behind its end!
1465     * And for an empty buffer location and buffer start are identical,
1466     * bypassing this code. See integrity constraints listed in the
1467     * description of Trf_TransformationInstance.
1468     */
1469
1470    if (trans->seekState.upLoc > trans->seekState.upBufStartLoc) {
1471      ResultDiscardAtStart (&trans->result,
1472		    trans->seekState.upLoc - trans->seekState.upBufStartLoc);
1473    }
1474
1475    /* Assertion: UpLoc == UpBufStartLoc now. */
1476
1477    SEEK_DUMP (TrfInput; Disc<);
1478
1479    copied    = ResultCopy (&trans->result, (unsigned char*) buf, toRead);
1480    toRead   -= copied;
1481    buf      += copied;
1482    gotBytes += copied;
1483    trans->seekState.upLoc += copied;
1484
1485    SEEK_DUMP (TrfInput; Copy<);
1486
1487    if (toRead == 0) {
1488      PRINT ("Got %d, satisfied from result buffer\n", gotBytes); FL;
1489      DONE  (TrfInput);
1490      return gotBytes;
1491    }
1492
1493    /* The buffer is exhausted, but the caller wants even more. We now have
1494     * to go to the underlying channel, get more bytes and then transform
1495     * them for delivery. We may not get that we want (full EOF or temporary
1496     * out of data). This part has to manipulate the various seek locations
1497     * in a more complicated way to keep everything in sync.
1498     */
1499
1500    /* Assertion:    UpLoc == UpBufEndLoc now (and == UpBufStartLoc).
1501     * Additionally: UP_CONVERT (DownLoc - AheadOffset) == BufEndLoc
1502     */
1503
1504    /*
1505     * Length (trans->result) == 0, toRead > 0 here  Use 'buf'! as target
1506     * to store the intermediary information read from the parent channel.
1507     *
1508     * Ask the transform how much data it allows us to read from
1509     * the underlying channel. This feature allows the transform to
1510     * signal EOF upstream although there is none downstream. Useful
1511     * to control an unbounded 'fcopy' for example, either through counting
1512     * bytes, or by pattern matching.
1513     */
1514
1515    if (trans->in.vectors->maxReadProc == (Trf_QueryMaxRead*) NULL)
1516      maxRead = -1;
1517    else
1518      maxRead = trans->in.vectors->maxReadProc (trans->in.control,
1519						trans->clientData);
1520
1521    if (maxRead >= 0) {
1522      if (maxRead < toRead) {
1523	toRead = maxRead;
1524      }
1525    } /* else: 'maxRead < 0' == Accept the current value of toRead */
1526
1527    if (toRead <= 0) {
1528      PRINT ("Got %d, constrained by script\n", gotBytes); FL;
1529      DONE  (TrfInput);
1530      return gotBytes;
1531    }
1532
1533    PRINT ("Read from parent %p\n", parent);
1534    IN; IN;
1535
1536    read = READ (trans, buf, toRead);
1537
1538    OT; OT;
1539    PRINT  ("................\n");
1540    /*PRTSTR ("Retrieved = {%d, \"%s\"}\n", read, buf);*/
1541
1542    PRINT ("Retrieved = %d {\n", read);
1543    DUMP  (read, buf);
1544    PRINT ("}\n");
1545    STREAM_IN (trans, read, buf);
1546
1547    if (read < 0) {
1548      /* Report errors to caller.
1549       * The state of the seek system is unchanged!
1550       */
1551
1552      if ((Tcl_GetErrno () == EAGAIN) && (gotBytes > 0)) {
1553	  /* EAGAIN is a special situation.  If we had some data
1554	   * before we report that instead of the request to re-try.
1555	   */
1556
1557	  PRINT ("Got %d, read < 0, <EAGAIN>\n", gotBytes);
1558	  FL; DONE (TrfInput);
1559	  return gotBytes;
1560      }
1561
1562      *errorCodePtr = Tcl_GetErrno ();
1563
1564      PRINT ("Got %d, read < 0, report error %d\n", gotBytes, *errorCodePtr);
1565      FL; DONE (TrfInput);
1566      return -1;
1567    }
1568
1569    if (read == 0) {
1570      /* Check wether we hit on EOF in 'parent' or
1571       * not. If not differentiate between blocking and
1572       * non-blocking modes. In non-blocking mode we ran
1573       * temporarily out of data. Signal this to the caller
1574       * via EWOULDBLOCK and error return (-1). In the other
1575       * cases we simply return what we got and let the
1576       * caller wait for more. On the other hand, if we got
1577       * an EOF we have to convert and flush all waiting
1578       * partial data.
1579       */
1580
1581      /* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com>
1582       */
1583      if (! Tcl_Eof (parent)) {
1584	/* The state of the seek system is unchanged! */
1585
1586	if (gotBytes == 0 && trans->flags & CHANNEL_ASYNC) {
1587	  *errorCodePtr = EWOULDBLOCK;
1588
1589	  PRINT ("Got %d, report EWOULDBLOCK\n", gotBytes); FL;
1590	  DONE (TrfInput);
1591	  return -1;
1592	} else {
1593	  PRINT ("(Got = %d || not async)\n", gotBytes); FL;
1594	  DONE (TrfInput);
1595	  return gotBytes;
1596	}
1597      } else {
1598	PRINT ("EOF in downstream channel\n"); FL;
1599	if (trans->readIsFlushed) {
1600	  /* The state of the seek system is unchanged! */
1601	  /* already flushed, nothing to do anymore */
1602	  PRINT ("Got %d, !read flushed\n", gotBytes); FL;
1603	  DONE (TrfInput);
1604	  return gotBytes;
1605	}
1606
1607	/* Now this is a bit different. The partial data waiting is converted
1608	 * and returned. So the 'AheadOffset' changes despite the location
1609	 * downstream not changing at all. It is now the negative of its
1610	 * additive inverse modulo 'numBytesDown':
1611	 *	 -((-k)%n) == -((n-1)-k) == k+1-n.
1612	 */
1613
1614	PRINT ("in_.flushproc\n"); FL;
1615
1616	trans->readIsFlushed = 1;
1617	trans->lastStored    = 0;
1618
1619	res = trans->in.vectors->flushProc (trans->in.control,
1620					    (Tcl_Interp*) NULL,
1621					    trans->clientData);
1622	if (trans->seekState.allowed &&
1623	    trans->seekState.used.numBytesDown > 1) {
1624	  trans->seekState.aheadOffset += -trans->seekState.used.numBytesDown;
1625	}
1626
1627	SEEK_DUMP (TrfInput; AhdC<);
1628
1629	if (ResultLength (&trans->result) == 0) {
1630	  /* we had nothing to flush */
1631	  PRINT ("Got %d, read flushed / no result\n", gotBytes); FL;
1632	  DONE (TrfInput);
1633	  return gotBytes;
1634	}
1635	continue; /* at: while (toRead > 0) */
1636      }
1637    } /* read == 0 */
1638
1639    /* Transform the read chunk, which was not empty.
1640     * The transformation processes 'read + aheadOffset' bytes.
1641     * So UP_CONVERT (read+ahead) == #bytes produced == ResultLength!
1642     * And  (read+ahead) % #down == #bytes now waiting == new ahead.
1643     */
1644
1645    SEEK_DUMP (TrfInput; Read<);
1646    trans->lastStored = 0;
1647
1648    if (trans->in.vectors->convertBufProc){
1649      PRINT ("in_.convertbufproc\n"); FL;
1650
1651      res = trans->in.vectors->convertBufProc (trans->in.control,
1652					       (unsigned char*) buf, read,
1653					       (Tcl_Interp*) NULL,
1654					       trans->clientData);
1655    } else {
1656      PRINT ("in_.convertproc\n"); FL;
1657
1658      res = TCL_OK;
1659      for (i=0; i < read; i++) {
1660	res = trans->in.vectors->convertProc (trans->in.control, buf [i],
1661					      (Tcl_Interp*) NULL,
1662					      trans->clientData);
1663	if (res != TCL_OK) {
1664	  break;
1665	}
1666      }
1667    }
1668
1669    if (res != TCL_OK) {
1670      *errorCodePtr = EINVAL;
1671      PRINT ("Got %d, report error in transform (EINVAL)\n", gotBytes); FL;
1672      DONE (TrfInput);
1673      return -1;
1674    }
1675
1676    /* Assert: UP_CONVERT (read+ahead) == ResultLength! */
1677
1678    trans->seekState.downLoc += read;
1679
1680    if (trans->seekState.allowed) {
1681      trans->seekState.aheadOffset += (read % trans->seekState.used.numBytesDown);
1682      trans->seekState.aheadOffset %= trans->seekState.used.numBytesDown;
1683    }
1684
1685  } /* while toRead > 0 */
1686
1687  SEEK_DUMP (TrfInput; Loop<);
1688
1689  PRINT ("Got %d, after loop\n", gotBytes); FL;
1690  DONE (TrfInput);
1691  return gotBytes;
1692}
1693
1694/*
1695 *------------------------------------------------------*
1696 *
1697 *	TrfOutput --
1698 *
1699 *	------------------------------------------------*
1700 *	Called by the generic IO system to convert data
1701 *	waiting to be written.
1702 *	------------------------------------------------*
1703 *
1704 *	Sideeffects:
1705 *		As defined by the transformation.
1706 *
1707 *	Result:
1708 *		A transformed buffer.
1709 *
1710 *------------------------------------------------------*
1711 */
1712
1713static int
1714TrfOutput (instanceData, buf, toWrite, errorCodePtr)
1715ClientData instanceData;
1716CONST84 char*      buf;
1717int        toWrite;
1718int*       errorCodePtr;
1719{
1720  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
1721  int i, res;
1722  Tcl_Channel parent;
1723
1724  START (TrfOutput);
1725
1726  parent = DOWNC (trans);
1727
1728  /* should assert (trans->mode & TCL_WRITABLE) */
1729
1730  /*
1731   * transformation results are automatically written to
1732   * the parent channel ('PutDestination' was configured
1733   * as write procedure in 'AttachTransform').
1734   */
1735
1736  if (toWrite == 0) {
1737    /* Nothing came in to write, ignore the call
1738     */
1739
1740    PRINT ("Nothing to write\n"); FL; DONE (TrfOutput);
1741    return 0;
1742  }
1743
1744  SEEK_DUMP (TrfOutput; Start);
1745
1746  /* toWrite / seekState.used.numBytesTransform = #tuples converted.
1747   * toWrite % seekState.used.numBytesTransform = #Bytes waiting in the transform.
1748   */
1749
1750  SeekSynchronize (trans, parent);
1751
1752  SEEK_DUMP (TrfOutput; Syncd);
1753
1754  trans->lastWritten = 0;
1755
1756  if (trans->out.vectors->convertBufProc){
1757    PRINT ("out.convertbufproc\n"); FL;
1758
1759    res = trans->out.vectors->convertBufProc (trans->out.control,
1760					      (unsigned char*) buf, toWrite,
1761					      (Tcl_Interp*) NULL,
1762					      trans->clientData);
1763  } else {
1764    PRINT ("out.convertproc\n"); FL;
1765
1766    res = TCL_OK;
1767    for (i=0; i < toWrite; i++) {
1768      res = trans->out.vectors->convertProc (trans->out.control, buf [i],
1769					     (Tcl_Interp*) NULL,
1770					     trans->clientData);
1771      if (res != TCL_OK) {
1772	break;
1773      }
1774    }
1775  }
1776
1777  if (res != TCL_OK) {
1778    *errorCodePtr = EINVAL;
1779    PRINT ("error EINVAL\n"); FL; DONE (TrfInput);
1780    return -1;
1781  }
1782
1783  /* Update seek state to new location
1784   * Assert: lastWritten == TRF_DOWN_CONVERT (trans, toWrite)
1785   */
1786
1787  trans->seekState.upLoc        += toWrite;
1788  trans->seekState.upBufStartLoc = trans->seekState.upLoc;
1789  trans->seekState.upBufEndLoc   = trans->seekState.upLoc;
1790  trans->seekState.downLoc      += trans->lastWritten;
1791  trans->lastWritten       = 0;
1792
1793  SEEK_DUMP (TrfOutput; Done_);
1794
1795  /* In the last statement above the integer division automatically
1796   * strips off the #bytes waiting in the transform.
1797   */
1798
1799  PRINT ("Written: %d\n", toWrite); FL; DONE (TrfOutput);
1800  return toWrite;
1801}
1802
1803/*
1804 *------------------------------------------------------*
1805 *
1806 *	TrfSeek --
1807 *
1808 *	------------------------------------------------*
1809 *	This procedure is called by the generic IO level
1810 *	to move the access point in a channel.
1811 *	------------------------------------------------*
1812 *
1813 *	Sideeffects:
1814 *		Moves the location at which the channel
1815 *		will be accessed in future operations.
1816 *		Flushes all transformation buffers, then
1817 *		forwards it to the underlying channel.
1818 *
1819 *	Result:
1820 *		-1 if failed, the new position if
1821 *		successful. An output argument contains
1822 *		the POSIX error code if an error
1823 *		occurred, or zero.
1824 *
1825 *------------------------------------------------------*
1826 */
1827
1828static int
1829TrfSeek (instanceData, offset, mode, errorCodePtr)
1830ClientData instanceData;	/* The channel to manipulate */
1831long       offset;		/* Size of movement. */
1832int        mode;		/* How to move */
1833int*       errorCodePtr;	/* Location of error flag. */
1834{
1835  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
1836  int         result;
1837  Tcl_Channel parent;
1838  int         newLoc;
1839
1840  START (TrfSeek);
1841  PRINT ("(Mode = %d, Offset = %ld)\n", mode, offset); FL;
1842
1843  parent = DOWNC (trans);
1844
1845  /*
1846   * Several things to look at before deciding what to do.
1847   * Is it a tell request ?
1848   * Is the channel unseekable ?
1849   * If not, are we in pass-down mode ?
1850   * If not, check buffer boundaries, etc. before discarding buffers, etc.
1851   */
1852
1853  if ((offset == 0) && (mode == SEEK_CUR)) {
1854    /* Tell location.
1855     */
1856
1857    PRINT ("[Tell], Location = %d\n", trans->seekState.upLoc); FL;
1858    DONE (TrfSeek);
1859    return trans->seekState.upLoc;
1860  }
1861
1862  if (!trans->seekState.allowed) {
1863    *errorCodePtr = EINVAL;
1864
1865    PRINT ("[Unseekable]\n"); FL; DONE (TrfSeek);
1866    return -1;
1867  }
1868
1869  /* Assert: seekState.allowed, numBytesDown > 0, numBytesTransform > 0 */
1870
1871  if (trans->seekCfg.identity) {
1872    /* Pass down mode. Pass request and record the change. This is used after
1873     * restoration of constrained seek to force the usage of a new zero-point.
1874     */
1875
1876    PRINT ("[Passing down]\n"); FL;
1877
1878    SeekClearBuffer (trans, TCL_WRITABLE | TCL_READABLE);
1879
1880    trans->seekState.changed = 1;
1881
1882    result = SEEK (trans, offset, mode);
1883    *errorCodePtr = (result == -1) ? Tcl_GetErrno () : 0;
1884
1885    SEEK_DUMP (TrfSeek; Pass<);
1886    DONE (TrfSeek);
1887    return result;
1888  }
1889
1890  /* Constrained seeking, as specified by the transformation.
1891   */
1892
1893  if (mode == SEEK_SET) {
1894    /* Convert and handle absolute from start as relative to current
1895     * location.
1896     */
1897
1898    PRINT ("[Seek from start] => Seek relative\n"); FL;
1899    result = TrfSeek (trans, offset - trans->seekState.upLoc, SEEK_CUR,
1900		      errorCodePtr);
1901    DONE (TrfSeek);
1902    return result;
1903  }
1904
1905  if (mode == SEEK_END) {
1906    /* Can't do that right now! TODO */
1907    *errorCodePtr = EINVAL;
1908
1909    PRINT ("[Seek from end not available]"); FL; DONE (TrfSeek);
1910    return -1;
1911  }
1912
1913  /* Seeking relative to the current location.
1914   */
1915
1916  newLoc = trans->seekState.upLoc + offset;
1917
1918  if (newLoc % trans->seekState.used.numBytesTransform) {
1919    /* Seek allowed only to locations which are multiples of the input.
1920     */
1921
1922    *errorCodePtr = EINVAL;
1923
1924    PRINT ("Seek constrained to multiples of input tuples\n"); FL;
1925    DONE (TrfSeek);
1926    return -1;
1927  }
1928
1929  if (newLoc < 0) {
1930    *errorCodePtr = EINVAL;
1931
1932    PRINT ("[Seek relative], cannot seek before start of stream\n"); FL;
1933    DONE (TrfSeek);
1934    return -1;
1935  }
1936
1937  if ((newLoc < trans->seekState.upBufStartLoc) ||
1938      (trans->seekState.upBufEndLoc <= newLoc)) {
1939    /* We are seeking out of the read buffer.
1940     * Discard it, adjust our position and seek the channel below to the
1941     * equivalent position.
1942     */
1943
1944    int offsetDown, newDownLoc;
1945
1946    PRINT ("[Seek relative], beyond read buffer\n"); FL;
1947
1948    newDownLoc = trans->seekState.downZero + TRF_DOWN_CONVERT (trans, newLoc);
1949    offsetDown = newDownLoc - trans->seekState.downLoc;
1950
1951    SeekClearBuffer (trans, TCL_WRITABLE | TCL_READABLE);
1952
1953    if (offsetDown != 0) {
1954      result = SEEK (trans, offsetDown, SEEK_CUR);
1955      *errorCodePtr = (result == -1) ? Tcl_GetErrno () : 0;
1956    }
1957
1958    trans->seekState.downLoc      += offsetDown;
1959    trans->seekState.upLoc         = newLoc;
1960    trans->seekState.upBufStartLoc = newLoc;
1961    trans->seekState.upBufEndLoc   = newLoc;
1962
1963    SEEK_DUMP (TrfSeek; NoBuf);
1964    DONE (TrfSeek);
1965    return newLoc;
1966  }
1967
1968  /* We are still inside the buffer, adjust the position
1969   * and clear out incomplete data waiting in the write
1970   * buffers, they are now invalid.
1971   */
1972
1973  SeekClearBuffer (trans, TCL_WRITABLE);
1974  trans->seekState.upLoc = newLoc;
1975
1976  SEEK_DUMP (TrfSeek; Base_);
1977  DONE (TrfSeek);
1978  return newLoc;
1979}
1980
1981/*
1982 *------------------------------------------------------*
1983 *
1984 *	TrfWatch --
1985 *
1986 *	------------------------------------------------*
1987 *	Initialize the notifier to watch Tcl_Files from
1988 *	this channel.
1989 *	------------------------------------------------*
1990 *
1991 *	Sideeffects:
1992 *		Sets up the notifier so that a future
1993 *		event on the channel will be seen by Tcl.
1994 *
1995 *	Result:
1996 *		None.
1997 *
1998 *------------------------------------------------------*
1999 */
2000	/* ARGSUSED */
2001static void
2002TrfWatch (instanceData, mask)
2003ClientData instanceData;	/* Channel to watch */
2004int        mask;		/* Events of interest */
2005{
2006  /*
2007   * 08/01/2000 - Completely rewritten to support as many versions of
2008   * the core and their different implementation s of stacked channels.
2009   */
2010  /* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com>
2011   * Added the comments.  */
2012  /* The caller expressed interest in events occuring for this
2013   * channel. Instead of forwarding the call to the underlying
2014   * channel we now express our interest in events on that
2015   * channel. This will ripple through all stacked channels to
2016   * the bottom-most real one actually able to generate events
2017   * (files, sockets, pipes, ...). The improvement beyond the
2018   * simple forwarding is that the generated events will ripple
2019   * back up to us, until they reach the channel the user
2020   * expressed his interest in (via fileevent). This way the
2021   * low-level events are propagated upward to the place where
2022   * the real event script resides, something which does not
2023   * happen in the simple forwarding model. It loses these events.
2024   */
2025
2026  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
2027
2028  START (TrfWatch);
2029
2030#ifndef USE_TCL_STUBS
2031  /* 8.0.x. Original patch. */
2032
2033  if (mask == trans->watchMask) {
2034    /* No changes in the expressed interest, skip this call.
2035     */
2036    DONE (TrfWatch);
2037    return;
2038  }
2039
2040  ChannelHandlerKS (trans, mask);
2041#else
2042  /* 8.1. and up */
2043
2044  if ((trans->patchVariant == PATCH_ORIG) ||
2045      (trans->patchVariant == PATCH_82)) {
2046
2047    if (mask == trans->watchMask) {
2048      /* No changes in the expressed interest, skip this call.
2049       */
2050      DONE (TrfWatch);
2051      return;
2052    }
2053
2054    ChannelHandlerKS (trans, mask);
2055
2056  } else if (trans->patchVariant == PATCH_832) {
2057    /* 8.3.2 and up */
2058
2059    Tcl_DriverWatchProc* watchProc;
2060    Tcl_Channel          parent;
2061
2062    trans->watchMask = mask;
2063
2064    /* No channel handlers any more. We will be notified automatically
2065     * about events on the channel below via a call to our
2066     * 'TransformNotifyProc'. But we have to pass the interest down now.
2067     * We are allowed to add additional 'interest' to the mask if we want
2068     * to. But this transformation has no such interest. It just passes
2069     * the request down, unchanged.
2070     */
2071
2072    parent    = DOWNC (trans);
2073    watchProc = Tcl_ChannelWatchProc (Tcl_GetChannelType (parent));
2074
2075    (*watchProc) (Tcl_GetChannelInstanceData(parent), mask);
2076
2077  } else {
2078    Tcl_Panic ("Illegal value for 'patchVariant'");
2079  }
2080#endif
2081
2082  /*
2083   * Management of the internal timer.
2084   */
2085
2086  if (!(mask & TCL_READABLE) || (ResultLength(&trans->result) == 0)) {
2087    /* A pending timer may exist, but either is there no (more)
2088     * interest in the events it generates or nothing is available
2089     * for reading. Remove it, if existing.
2090     */
2091
2092    TimerKill (trans);
2093  } else {
2094    /* There might be no pending timer, but there is interest in
2095     * readable events and we actually have data waiting, so
2096     * generate a timer to flush that if it does not exist.
2097     */
2098
2099    TimerSetup (trans);
2100  }
2101
2102  DONE (TrfWatch);
2103}
2104
2105/*
2106 *------------------------------------------------------*
2107 *
2108 *	TrfGetFile --
2109 *
2110 *	------------------------------------------------*
2111 *	Called from Tcl_GetChannelHandle to retrieve
2112 *	OS specific file handle from inside this channel.
2113 *	------------------------------------------------*
2114 *
2115 *	Sideeffects:
2116 *		None.
2117 *
2118 *	Result:
2119 *		The appropriate Tcl_File or NULL if not
2120 *		present.
2121 *
2122 *------------------------------------------------------*
2123 */
2124
2125static int
2126TrfGetFile (instanceData, direction, handlePtr)
2127ClientData  instanceData;	/* Channel to query */
2128int         direction;		/* Direction of interest */
2129ClientData* handlePtr;		/* Place to store the handle into */
2130{
2131  /*
2132   * return handle belonging to parent channel
2133   */
2134
2135  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
2136  Tcl_Channel parent;
2137
2138  START (TrfGetFile);
2139
2140  parent = DOWNC (trans);
2141
2142  DONE (TrfGetFile);
2143  return Tcl_GetChannelHandle (parent, direction, handlePtr);
2144}
2145
2146/*
2147 *------------------------------------------------------*
2148 *
2149 *	TrfSetOption --
2150 *
2151 *	------------------------------------------------*
2152 *	Called by the generic layer to handle the reconfi-
2153 *	guration of channel specific options. Unknown
2154 *	options are passed downstream.
2155 *	------------------------------------------------*
2156 *
2157 *	Sideeffects:
2158 *		As defined by the channel downstream.
2159 *
2160 *	Result:
2161 *		A standard TCL error code.
2162 *
2163 *------------------------------------------------------*
2164 */
2165
2166static int
2167TrfSetOption (instanceData, interp, optionName, value)
2168     ClientData  instanceData;
2169     Tcl_Interp* interp;
2170     CONST char* optionName;
2171     CONST char* value;
2172{
2173  /* Recognized options:
2174   *
2175   * -seekpolicy	Accepted values: unseekable, identity, {}
2176   */
2177
2178  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
2179
2180  START (TrfSetOption);
2181
2182  if (0 == strcmp (optionName, "-seekpolicy")) {
2183    /* The seekpolicy is about to be changed. Make sure that we got a valid
2184     * value and that it really changes the used policy. Failing the first
2185     * test causes an error, failing the second causes the system to silently
2186     * ignore this request. Reconfiguration will fail for a non-overidable
2187     * policy too.
2188     */
2189
2190    if (!trans->seekCfg.overideAllowed) {
2191      Tcl_SetErrno (EINVAL);
2192      Tcl_AppendResult (interp, "It is not allowed to overide ",
2193			"the seek policy used by this channel.", NULL);
2194      DONE (TrfSetOption);
2195      return TCL_ERROR;
2196    }
2197
2198    if (0 == strcmp (value, "unseekable")) {
2199      if (!trans->seekState.allowed) {
2200	/* Ignore the request if the channel already uses this policy.
2201	 */
2202	DONE (TrfSetOption);
2203	return TCL_OK;
2204      }
2205
2206      TRF_SET_UNSEEKABLE (trans->seekState.used);
2207      trans->seekState.allowed = 0;
2208      trans->seekCfg.identity  = 0;
2209
2210      /* Changed is not touched! We might have been forced to identity
2211       * before, and have to remember this for any restoration.
2212       */
2213
2214    } else if (0 == strcmp (value, "identity")) {
2215
2216      if (trans->seekState.allowed &&
2217	  (trans->seekState.used.numBytesTransform == 1) &&
2218	  (trans->seekState.used.numBytesDown == 1)) {
2219
2220	/* Ignore the request if the channel already uses this policy.
2221	 */
2222	DONE (TrfSetOption);
2223	return TCL_OK;
2224      }
2225
2226      trans->seekState.used.numBytesTransform = 1;
2227      trans->seekState.used.numBytesDown      = 1;
2228      trans->seekState.allowed                = 1;
2229      trans->seekCfg.identity                 = 1;
2230      trans->seekState.changed                = 0;
2231
2232    } else if (0 == strcmp (value, "")) {
2233      if ((trans->seekState.used.numBytesTransform ==
2234	   trans->seekCfg.chosen.numBytesTransform) &&
2235	  (trans->seekState.used.numBytesDown ==
2236	   trans->seekCfg.chosen.numBytesDown)) {
2237	/* Ignore the request if the channel already uses hios chosen policy.
2238	 */
2239	DONE (TrfSetOption);
2240	return TCL_OK;
2241      }
2242
2243      trans->seekState.used.numBytesTransform =
2244	trans->seekCfg.chosen.numBytesTransform;
2245
2246      trans->seekState.used.numBytesDown =
2247	trans->seekCfg.chosen.numBytesDown;
2248
2249      trans->seekState.allowed = !TRF_IS_UNSEEKABLE (trans->seekState.used);
2250
2251      if (trans->seekState.changed) {
2252	/* Define new base location. Resync up and down to get the
2253	 * proper location without read-ahead. Reinitialize the
2254	 * upper location.
2255	 */
2256
2257	Tcl_Channel parent = DOWNC (trans);
2258	SeekSynchronize (trans, parent);
2259	trans->seekState.downLoc     = TELL (trans);
2260
2261#ifdef USE_TCL_STUBS
2262	if (trans->patchVariant == PATCH_832) {
2263	  trans->seekState.downLoc  -= Tcl_ChannelBuffered (parent);
2264	}
2265#endif
2266	trans->seekState.downZero    = trans->seekState.downLoc;
2267	trans->seekState.aheadOffset = 0;
2268
2269	trans->seekState.upLoc         = 0;
2270	trans->seekState.upBufStartLoc = 0;
2271	trans->seekState.upBufEndLoc   = ResultLength (&trans->result);
2272      }
2273
2274      trans->seekCfg.identity  = 0;
2275      trans->seekState.changed = 0;
2276
2277    } else {
2278      Tcl_SetErrno (EINVAL);
2279      Tcl_AppendResult (interp, "Invalid value \"", value,
2280			"\", must be one of 'unseekable', 'identity' or ''.",
2281			NULL);
2282      DONE (TrfSetOption);
2283      return TCL_ERROR;
2284    }
2285
2286  } else {
2287    int res;
2288    res = SETOPT (interp, trans, optionName, value);
2289    DONE (TrfSetOption);
2290    return res;
2291  }
2292
2293  DONE (TrfSetOption);
2294  return TCL_OK;
2295}
2296
2297/*
2298 *------------------------------------------------------*
2299 *
2300 *	TrfGetOption --
2301 *
2302 *	------------------------------------------------*
2303 *	Called by generic layer to handle requests for
2304 *	the values of channel specific options. As this
2305 *	channel type does not have such, it simply passes
2306 *	all requests downstream.
2307 *	------------------------------------------------*
2308 *
2309 *	Sideeffects:
2310 *		Adds characters to the DString refered by
2311 *		'dsPtr'.
2312 *
2313 *	Result:
2314 *		A standard TCL error code.
2315 *
2316 *------------------------------------------------------*
2317 */
2318
2319static int
2320TrfGetOption (instanceData, interp, optionName, dsPtr)
2321     ClientData    instanceData;
2322     Tcl_Interp*   interp;
2323     CONST84 char* optionName;
2324     Tcl_DString*  dsPtr;
2325{
2326  /* Recognized options:
2327   *
2328   * -seekcfg
2329   * -seekstate
2330   * -seekpolicy
2331   */
2332
2333  TrfTransformationInstance* trans = (TrfTransformationInstance*) instanceData;
2334
2335  if (optionName == (char*) NULL) {
2336    /* A list of options and their values was requested,
2337     */
2338
2339    Tcl_Obj* tmp;
2340    char policy [20];
2341
2342    SeekPolicyGet (trans, policy);
2343    Tcl_DStringAppendElement (dsPtr, "-seekpolicy");
2344    Tcl_DStringAppendElement (dsPtr, policy);
2345
2346    Tcl_DStringAppendElement (dsPtr, "-seekcfg");
2347    tmp = SeekConfigGet (interp, &trans->seekCfg);
2348    Tcl_DStringAppendElement (dsPtr, Tcl_GetStringFromObj (tmp, NULL));
2349    Tcl_DecrRefCount (tmp);
2350
2351    Tcl_DStringAppendElement (dsPtr, "-seekstate");
2352    tmp = SeekStateGet (interp, &trans->seekState);
2353    Tcl_DStringAppendElement (dsPtr, Tcl_GetStringFromObj (tmp, NULL));
2354    Tcl_DecrRefCount (tmp);
2355
2356    /* Pass the request down to all channels below so that we may a complete
2357     * state.
2358     */
2359
2360    return GETOPT (interp, trans, optionName, dsPtr);
2361
2362  } else if (0 == strcmp (optionName, "-seekpolicy")) {
2363    /* Deduce the policy in effect, use chosen/used
2364     * policy and identity to do this. Use a helper
2365     * procedure to allow easy reuse in the code above.
2366     */
2367
2368    char policy [20];
2369
2370    SeekPolicyGet (trans, policy);
2371    Tcl_DStringAppend (dsPtr, policy, -1);
2372    return TCL_OK;
2373
2374  } else if (0 == strcmp (optionName, "-seekcfg")) {
2375    Tcl_Obj* tmp;
2376
2377    tmp = SeekConfigGet (interp, &trans->seekCfg);
2378    Tcl_DStringAppend (dsPtr, Tcl_GetStringFromObj (tmp, NULL), -1);
2379    Tcl_DecrRefCount (tmp);
2380
2381    return TCL_OK;
2382  } else if (0 == strcmp (optionName, "-seekstate")) {
2383    Tcl_Obj* tmp;
2384
2385    tmp = SeekStateGet (interp, &trans->seekState);
2386    Tcl_DStringAppend (dsPtr, Tcl_GetStringFromObj (tmp, NULL), -1);
2387    Tcl_DecrRefCount (tmp);
2388
2389    return TCL_OK;
2390  } else {
2391    /* Unknown option. Pass it down to the channels below, maybe one
2392     * of them is able to handle this request.
2393     */
2394
2395    return GETOPT (interp, trans, optionName, dsPtr);
2396#if 0
2397    Tcl_SetErrno (EINVAL);
2398    return Tcl_BadChannelOption (interp, optionName, "seekcfg seekstate");
2399#endif
2400  }
2401}
2402
2403#ifdef USE_TCL_STUBS
2404/*
2405 *------------------------------------------------------*
2406 *
2407 *	TrfNotify --
2408 *
2409 *	------------------------------------------------*
2410 *	Called by the generic layer of 8.3.2 and higher
2411 *	to handle events coming from below. We simply pass
2412 *	them upward.
2413 *	------------------------------------------------*
2414 *
2415 *	Sideeffects:
2416 *		None.
2417 *
2418 *	Result:
2419 *		The unchanged interest mask.
2420 *
2421 *------------------------------------------------------*
2422 */
2423static int
2424TrfNotify (instanceData, interestMask)
2425     ClientData instanceData;
2426     int        interestMask;
2427{
2428  /*
2429   * An event occured in the underlying channel.  This transformation
2430   * doesn't process such events thus returns the incoming mask
2431   * unchanged.
2432   *
2433   * We do delete an existing timer. It was not fired, yet we are
2434   * here, so the channel below generated such an event and we don't
2435   * have to. The renewal of the interest after the execution of
2436   * channel handlers will eventually cause us to recreate the timer
2437   * (in TrfWatch).
2438   */
2439
2440  TimerKill ((TrfTransformationInstance*) instanceData);
2441  return interestMask;
2442}
2443#endif
2444
2445/*
2446 *------------------------------------------------------*
2447 *
2448 *	TransformImmediate --
2449 *
2450 *	------------------------------------------------*
2451 *	Read from source, apply the specified transformation
2452 *	and write the result to destination.
2453 *	------------------------------------------------*
2454 *
2455 *	Sideeffects:
2456 *		The access points of source and destination
2457 *		change, data is added to destination too.
2458 *
2459 *	Result:
2460 *		A standard Tcl error code.
2461 *
2462 *------------------------------------------------------* */
2463
2464static int
2465TransformImmediate (interp, entry, source, destination, in, optInfo)
2466Tcl_Interp*        interp;
2467Trf_RegistryEntry* entry;
2468Tcl_Channel        source;
2469Tcl_Channel        destination;
2470struct Tcl_Obj* CONST in;
2471Trf_Options        optInfo;
2472{
2473  Trf_Vectors*     v;
2474  Trf_ControlBlock control;
2475  int              res = TCL_OK;
2476
2477  ResultBuffer r;
2478
2479  START (TransformImmediate);
2480
2481  if (ENCODE_REQUEST (entry, optInfo)) {
2482    v = &(entry->trfType->encoder);
2483  } else {
2484    v = &(entry->trfType->decoder);
2485  }
2486
2487  /* Take care of output (channel vs. interpreter result area).
2488   */
2489
2490  if (destination == (Tcl_Channel) NULL) {
2491    ResultInit (&r);
2492
2493    PRINT ("___.createproc\n"); FL;
2494    control = v->createProc ((ClientData) &r, PutInterpResult,
2495			     optInfo, interp,
2496			     entry->trfType->clientData);
2497  } else {
2498    PRINT ("___.createproc\n"); FL;
2499    control = v->createProc ((ClientData) destination, PutDestinationImm,
2500			     optInfo, interp,
2501			     entry->trfType->clientData);
2502  }
2503
2504  if (control == (Trf_ControlBlock) NULL) {
2505    DONE (TransformImmediate);
2506    return TCL_ERROR;
2507  }
2508
2509
2510  /* Now differentiate between immediate value and channel as input.
2511   */
2512
2513  if (source == (Tcl_Channel) NULL) {
2514    /* Immediate value.
2515     * -- VERSION DEPENDENT CODE --
2516     */
2517    int            length;
2518    unsigned char* buf;
2519
2520    buf = GET_DATA (in, &length);
2521    if (v->convertBufProc) {
2522      /* play it safe, use a copy, avoid clobbering the input. */
2523      unsigned char* tmp;
2524
2525      tmp = (unsigned char*) ckalloc (length);
2526      memcpy (tmp, buf, length);
2527
2528      PRINT ("___.convertbufproc\n"); FL;
2529
2530      res = v->convertBufProc (control, tmp, length, interp,
2531			       entry->trfType->clientData);
2532      ckfree ((char*) tmp);
2533    } else {
2534      unsigned int i, c;
2535
2536      PRINT ("___.convertproc\n"); FL;
2537
2538      for (i=0; i < ((unsigned int) length); i++) {
2539	c = buf [i];
2540	res = v->convertProc (control, c, interp,
2541			      entry->trfType->clientData);
2542
2543	if (res != TCL_OK)
2544	  break;
2545      }
2546    }
2547
2548    if (res == TCL_OK) {
2549      PRINT ("___.flushproc\n"); FL;
2550
2551      res = v->flushProc (control, interp, entry->trfType->clientData);
2552    }
2553  } else {
2554    /* Read from channel.
2555     */
2556
2557    unsigned char* buf;
2558    int            actuallyRead;
2559
2560    buf = (unsigned char*) ckalloc (READ_CHUNK_SIZE);
2561
2562    while (1) {
2563      if (Tcl_Eof (source))
2564	break;
2565
2566      actuallyRead = Tcl_Read (source, (char*) buf, READ_CHUNK_SIZE);
2567
2568      if (actuallyRead <= 0)
2569	break;
2570
2571      if (v->convertBufProc) {
2572	PRINT ("___.convertbufproc\n"); FL;
2573
2574	res = v->convertBufProc (control, buf, actuallyRead, interp,
2575				 entry->trfType->clientData);
2576      } else {
2577	unsigned int i, c;
2578
2579	PRINT ("___.convertproc\n"); FL;
2580
2581	for (i=0; i < ((unsigned int) actuallyRead); i++) {
2582	  c = buf [i];
2583	  res = v->convertProc (control, c, interp,
2584				entry->trfType->clientData);
2585
2586	  if (res != TCL_OK)
2587	    break;
2588	}
2589      }
2590
2591      if (res != TCL_OK)
2592	break;
2593    }
2594
2595    ckfree ((char*) buf);
2596
2597    if (res == TCL_OK)
2598      res = v->flushProc (control, interp, entry->trfType->clientData);
2599  }
2600
2601  PRINT ("___.deleteproc\n"); FL;
2602  v->deleteProc (control, entry->trfType->clientData);
2603
2604
2605  if (destination == (Tcl_Channel) NULL) {
2606    /* Now write into interpreter result area.
2607     */
2608
2609    if (res == TCL_OK) {
2610      Tcl_ResetResult (interp);
2611
2612      if (r.buf != NULL) {
2613	Tcl_Obj* o = NEW_DATA (r);
2614	Tcl_IncrRefCount (o);
2615	Tcl_SetObjResult (interp, o);
2616	Tcl_DecrRefCount (o);
2617      }
2618    }
2619    ResultClear (&r);
2620  }
2621
2622  DONE (TransformImmediate);
2623  return res;
2624}
2625
2626/*
2627 *------------------------------------------------------*
2628 *
2629 *	AttachTransform --
2630 *
2631 *	------------------------------------------------*
2632 *	Create an instance of a transformation and
2633 *	associate as filter it with the specified channel.
2634 *	------------------------------------------------*
2635 *
2636 *	Sideeffects:
2637 *		Allocates memory, changes the internal
2638 *		state of the channel.
2639 *
2640 *	Result:
2641 *		A standard Tcl error code.
2642 *
2643 *------------------------------------------------------*
2644 */
2645
2646static int
2647AttachTransform (entry, baseOpt, optInfo, interp)
2648Trf_RegistryEntry* entry;
2649Trf_BaseOptions*   baseOpt;
2650Trf_Options        optInfo;
2651Tcl_Interp*        interp;
2652{
2653  TrfTransformationInstance* trans;
2654
2655  trans = NEW_TRANSFORM;
2656
2657  START (AttachTransform);
2658
2659#ifdef TRF_STREAM_DEBUG
2660  trans->inCounter  = 0;
2661  trans->outCounter = 0;
2662  trans->name       = (char*) entry->trfType->name;
2663#endif
2664#ifdef USE_TCL_STUBS
2665  trans->patchVariant = entry->registry->patchVariant;
2666#endif
2667
2668  /* trans->standard.typePtr = entry->transType; */
2669  trans->clientData       = entry->trfType->clientData;
2670
2671  if (trans->patchVariant == PATCH_832) {
2672    trans->parent = Tcl_GetTopChannel (baseOpt->attach);
2673  } else {
2674    trans->parent = baseOpt->attach;
2675  }
2676
2677  trans->readIsFlushed    = 0;
2678
2679  /* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com>
2680   */
2681  trans->flags            = 0;
2682  trans->watchMask        = 0;
2683
2684  /* 03/28/2000 Added by DNew@Invisible.Net because Purify says so. */
2685  trans->lastStored       = 0;
2686
2687  trans->mode             = Tcl_GetChannelMode (baseOpt->attach);
2688  trans->timer            = (Tcl_TimerToken) NULL;
2689
2690  if (ENCODE_REQUEST (entry, optInfo)) {
2691    /* ENCODE on write
2692     * DECODE on read
2693     */
2694
2695    trans->out.vectors = ((trans->mode & TCL_WRITABLE) ?
2696			  &entry->trfType->encoder     :
2697			  NULL);
2698    trans->in.vectors  = ((trans->mode & TCL_READABLE) ?
2699			  &entry->trfType->decoder     :
2700			  NULL);
2701
2702  } else /* mode == DECODE */ {
2703    /* DECODE on write
2704     * ENCODE on read
2705     */
2706
2707    trans->out.vectors = ((trans->mode & TCL_WRITABLE) ?
2708			  &entry->trfType->decoder     :
2709			  NULL);
2710    trans->in.vectors  = ((trans->mode & TCL_READABLE) ?
2711			  &entry->trfType->encoder     :
2712			  NULL);
2713  }
2714
2715  /* 'PutDestination' is ok for write, only read
2716   * requires 'PutTrans' and its internal buffer.
2717   */
2718
2719  if (trans->mode & TCL_WRITABLE) {
2720    PRINT ("out.createproc\n"); FL;
2721
2722    trans->out.control = trans->out.vectors->createProc ((ClientData) trans,
2723							 PutDestination,
2724							 optInfo, interp,
2725							 trans->clientData);
2726
2727    if (trans->out.control == (Trf_ControlBlock) NULL) {
2728      ckfree ((char*) trans);
2729      DONE (AttachTransform);
2730      return TCL_ERROR;
2731    }
2732  }
2733
2734  if (trans->mode & TCL_READABLE) {
2735    PRINT ("in_.createproc\n"); FL;
2736
2737    trans->in.control  = trans->in.vectors->createProc  ((ClientData) trans,
2738							 PutTrans,
2739							 optInfo, interp,
2740							 trans->clientData);
2741
2742    if (trans->in.control == (Trf_ControlBlock) NULL) {
2743      ckfree ((char*) trans);
2744      DONE (AttachTransform);
2745      return TCL_ERROR;
2746    }
2747  }
2748
2749  ResultInit (&trans->result);
2750  trans->result.seekState = &trans->seekState;
2751
2752  /*
2753   * Build channel from converter definition and stack it upon the one we
2754   * shall attach to.
2755   */
2756
2757  /* Discard information dangerous for the integrated patch.
2758   * (This makes sure that we don't miss any place using this pointer
2759   * without generating a crash (instead of some silent failure, like
2760   * thrashing far away memory)).
2761   */
2762
2763#ifndef USE_TCL_STUBS
2764  trans->self   = Tcl_StackChannel (interp, entry->transType,
2765				    (ClientData) trans, trans->mode,
2766				    trans->parent);
2767#else
2768  if ((trans->patchVariant == PATCH_ORIG) ||
2769      (trans->patchVariant == PATCH_832)) {
2770
2771    trans->self = Tcl_StackChannel (interp, entry->transType,
2772				    (ClientData) trans, trans->mode,
2773				    trans->parent);
2774
2775  } else if (trans->patchVariant == PATCH_82) {
2776    trans->parent = NULL;
2777    trans->self   = baseOpt->attach;
2778
2779    Tcl_StackChannel (interp, entry->transType,
2780		      (ClientData) trans, trans->mode,
2781		      trans->self);
2782  } else {
2783    Tcl_Panic ("Illegal value for 'patchVariant'");
2784  }
2785#endif
2786
2787  if (trans->self == (Tcl_Channel) NULL) {
2788    ckfree ((char*) trans);
2789    Tcl_AppendResult (interp, "internal error in Tcl_StackChannel",
2790		      (char*) NULL);
2791    DONE (AttachTransform);
2792    return TCL_ERROR;
2793  }
2794
2795  /* Initialize the seek subsystem.
2796   */
2797
2798  PRINTLN ("Initialize Seeking");
2799  PRINTLN ("Copy configuration");
2800
2801  trans->seekCfg.natural.numBytesTransform =
2802    entry->trfType->naturalSeek.numBytesTransform;
2803
2804  trans->seekCfg.natural.numBytesDown      =
2805    entry->trfType->naturalSeek.numBytesDown;
2806
2807  if (optInfo && (*OPT->seekQueryProc != (Trf_SeekQueryOptions*) NULL)) {
2808    PRINTLN ("Query seekQueryProc");
2809    (*OPT->seekQueryProc) (interp, optInfo, &trans->seekCfg.natural, CLT);
2810  }
2811
2812  PRINTLN ("Determine Policy");
2813  SeekCalculatePolicies (trans);
2814
2815  PRINTLN ("    Initialize");
2816  SeekInitialize        (trans);
2817
2818  /* Check for options overiding the policy. If they do despite being not
2819   * allowed to do so we have to remove the transformation and break it down.
2820   * We do this by calling 'Unstack', which does all the necessary things for
2821   * us.
2822   */
2823
2824  PRINTLN ("    Policy options ?");
2825  if (baseOpt->policy != (Tcl_Obj*) NULL) {
2826    if (TCL_OK != TrfSetOption ((ClientData) trans, interp, "-seekpolicy",
2827				Tcl_GetStringFromObj (baseOpt->policy,
2828						      NULL))) {
2829
2830      /* An error prevented setting a policy. Save the resulting error
2831       * message across the necessary unstacking of the now faulty
2832       * transformation.
2833       */
2834
2835#if GT81
2836      Tcl_SavedResult ciSave;
2837
2838      Tcl_SaveResult     (interp, &ciSave);
2839      Tcl_UnstackChannel (interp, trans->self);
2840      Tcl_RestoreResult  (interp, &ciSave);
2841#else
2842      Tcl_UnstackChannel (interp, trans->self);
2843#endif
2844      DONE (AttachTransform);
2845      return TCL_ERROR;
2846    }
2847  }
2848
2849  /*  Tcl_RegisterChannel (interp, new); */
2850  Tcl_AppendResult (interp, Tcl_GetChannelName (trans->self),
2851		    (char*) NULL);
2852  DONE (AttachTransform);
2853  return TCL_OK;
2854}
2855
2856/*
2857 *------------------------------------------------------*
2858 *
2859 *	PutDestination --
2860 *
2861 *	------------------------------------------------*
2862 *	Handler used by a transformation to write its results.
2863 *	------------------------------------------------*
2864 *
2865 *	Sideeffects:
2866 *		Writes to the channel.
2867 *
2868 *	Result:
2869 *		A standard Tcl error code.
2870 *
2871 *------------------------------------------------------*
2872 */
2873
2874static int
2875PutDestination (clientData, outString, outLen, interp)
2876ClientData     clientData;
2877unsigned char* outString;
2878int            outLen;
2879Tcl_Interp*    interp;
2880{
2881  TrfTransformationInstance* trans = (TrfTransformationInstance*) clientData;
2882  int         res;
2883  Tcl_Channel parent;
2884
2885  START  (PutDestination);
2886  /*PRTSTR ("Data = {%d, \"%s\"}\n", outLen, outString);*/
2887  PRINT ("Data = %d {\n", outLen);
2888  DUMP  (outLen, outString);
2889  PRINT ("}\n");
2890
2891  parent = DOWNC (trans);
2892
2893  trans->lastWritten += outLen;
2894
2895  res = WRITE (trans, (char*) outString, outLen);
2896
2897  if (res < 0) {
2898    if (interp) {
2899      Tcl_AppendResult (interp, "error writing \"",
2900			Tcl_GetChannelName (parent),
2901			"\": ", Tcl_PosixError (interp),
2902			(char*) NULL);
2903    }
2904    PRINT ("ERROR /written = %d, errno = %d, (%d) %s\n",
2905	   res, Tcl_GetErrno (), EACCES, strerror (Tcl_GetErrno ()));
2906    DONE (PutDestination);
2907    return TCL_ERROR;
2908  }
2909
2910  DONE (PutDestination);
2911  return TCL_OK;
2912}
2913
2914/*
2915 *------------------------------------------------------*
2916 *
2917 *	PutDestinationImm --
2918 *
2919 *	------------------------------------------------*
2920 *	Handler used during an immediate transformation
2921 *	to write its results into the -out channel.
2922 *	------------------------------------------------*
2923 *
2924 *	Sideeffects:
2925 *		Writes to the channel.
2926 *
2927 *	Result:
2928 *		A standard Tcl error code.
2929 *
2930 *------------------------------------------------------*
2931 */
2932
2933static int
2934PutDestinationImm (clientData, outString, outLen, interp)
2935ClientData     clientData;
2936unsigned char* outString;
2937int            outLen;
2938Tcl_Interp*    interp;
2939{
2940  int         res;
2941  Tcl_Channel destination = (Tcl_Channel) clientData;
2942
2943  START  (PutDestinationImm);
2944  /*PRTSTR ("Data = {%d, \"%s\"}\n", outLen, outString);*/
2945  PRINT ("Data = %d {\n", outLen);
2946  DUMP  (outLen, outString);
2947  PRINT ("}\n");
2948
2949  res = Tcl_Write (destination, (char*) outString, outLen);
2950
2951  if (res < 0) {
2952    if (interp) {
2953      Tcl_AppendResult (interp, "error writing \"",
2954			Tcl_GetChannelName (destination),
2955			"\": ", Tcl_PosixError (interp),
2956			(char*) NULL);
2957    }
2958    DONE (PutDestinationImm);
2959    return TCL_ERROR;
2960  }
2961
2962  DONE (PutDestinationImm);
2963  return TCL_OK;
2964}
2965
2966/*
2967 *------------------------------------------------------*
2968 *
2969 *	PutTrans --
2970 *
2971 *	------------------------------------------------*
2972 *	Handler used by a transformation to write its
2973 *	results (to be read later). Used by transformations
2974 *	acting as filter.
2975 *	------------------------------------------------*
2976 *
2977 *	Sideeffects:
2978 *		May allocate memory.
2979 *
2980 *	Result:
2981 *		A standard Tcl error code.
2982 *
2983 *------------------------------------------------------*
2984 */
2985
2986static int
2987PutTrans (clientData, outString, outLen, interp)
2988ClientData     clientData;
2989unsigned char* outString;
2990int            outLen;
2991Tcl_Interp*    interp;
2992{
2993  TrfTransformationInstance* trans = (TrfTransformationInstance*) clientData;
2994
2995  START  (PutTrans);
2996  /*PRTSTR ("Data = {%d, \"%s\"}\n", outLen, outString);*/
2997  PRINT ("Data = %d {\n", outLen);
2998  DUMP  (outLen, outString);
2999  PRINT ("}\n");
3000  STREAM_OUT (trans, outLen, outString);
3001
3002  trans->lastStored += outLen;
3003
3004  ResultAdd (&trans->result, outString, outLen);
3005
3006  DONE (PutTrans);
3007  return TCL_OK;
3008}
3009
3010/*
3011 *------------------------------------------------------*
3012 *
3013 *	PutInterpResult --
3014 *
3015 *	------------------------------------------------*
3016 *	Handler used by a transformation to write its
3017 *	results into the interpreter result area.
3018 *	------------------------------------------------*
3019 *
3020 *	Sideeffects:
3021 *		changes the contents of the interpreter
3022 *		result area.
3023 *
3024 *	Result:
3025 *		A standard Tcl error code.
3026 *
3027 *------------------------------------------------------*
3028 */
3029
3030static int
3031PutInterpResult (clientData, outString, outLen, interp)
3032ClientData     clientData;
3033unsigned char* outString;
3034int            outLen;
3035Tcl_Interp*    interp;
3036{
3037  ResultBuffer* r = (ResultBuffer*) clientData;
3038
3039  START  (PutInterpResult);
3040  /*PRTSTR ("Data = {%d, \"%s\"}\n", outLen, outString);*/
3041  PRINT ("Data = %d {\n", outLen);
3042  DUMP  (outLen, outString);
3043  PRINT ("}\n");
3044
3045  ResultAdd (r, outString, outLen);
3046
3047  DONE (PutInterpResult);
3048  return TCL_OK;
3049}
3050
3051/* 04/13/1999 Fileevent patch from Matt Newman <matt@novadigm.com>
3052 */
3053/*
3054 *------------------------------------------------------*
3055 *
3056 *	ChannelHandler --
3057 *
3058 *	------------------------------------------------*
3059 *	Handler called by Tcl as a result of
3060 *	Tcl_CreateChannelHandler - to inform us of activity
3061 *	on the underlying channel.
3062 *	------------------------------------------------*
3063 *
3064 *	Sideeffects:
3065 *		May generate subsequent calls to
3066 *		Tcl_NotifyChannel.
3067 *
3068 *	Result:
3069 *		None.
3070 *
3071 *------------------------------------------------------*
3072 */
3073
3074static void
3075ChannelHandler (clientData, mask)
3076ClientData     clientData;
3077int            mask;
3078{
3079  /*
3080   * An event occured in the underlying channel. Forward it to
3081   * ourself. This will either execute an attached event script
3082   * (fileevent) or an intermediate handler like this one propagating
3083   * the event further upward.
3084   *
3085   * This procedure is called only for the original and the 8.2
3086   * patch. The 8.2.3 patch uses a new vector in the driver to get and
3087   * handle events coming from below.
3088   */
3089
3090  TrfTransformationInstance* trans = (TrfTransformationInstance*) clientData;
3091
3092#ifndef USE_TCL_STUBS
3093  /*
3094   * Core 8.0.x. Forward the event to ourselves.
3095   */
3096
3097  Tcl_NotifyChannel (trans->self, mask);
3098#else
3099  /*
3100   * Check for the correct variants first. Forwarding the event is not
3101   * required for the 8.2 patch. For that variant the core,
3102   * i.e. Tcl_NotifyChannel loops over all channels in the stack by
3103   * itself.
3104   */
3105
3106  if (trans->patchVariant == PATCH_832) {
3107    Tcl_Panic ("Illegal value for 'patchVariant' in ChannelHandler");
3108  }
3109  if (trans->patchVariant == PATCH_ORIG) {
3110    Tcl_NotifyChannel (trans->self, mask);
3111  }
3112#endif
3113
3114  /*
3115   * Check the I/O-Buffers of this channel for waiting information.
3116   * Setup a timer generating an artificial event for us if we have
3117   * such. We could call Tcl_NotifyChannel directly, but this would
3118   * starve other event sources, so a timer is used to prevent that.
3119   */
3120
3121  TimerKill (trans);
3122
3123  /* Check for waiting data, flush it out with a timer.
3124   */
3125
3126#ifndef USE_TCL_STUBS
3127  if ((mask & TCL_READABLE) && ((ResultLength (&trans->result) > 0) ||
3128				(Tcl_InputBuffered (trans->self) > 0))) {
3129    TimerSetup (trans);
3130  }
3131#else
3132  if (trans->patchVariant != PATCH_ORIG) {
3133    if ((mask & TCL_READABLE) && (ResultLength (&trans->result) > 0)) {
3134      TimerSetup (trans);
3135    }
3136  } else {
3137    if ((mask & TCL_READABLE) && ((ResultLength (&trans->result) > 0) ||
3138				  (Tcl_InputBuffered (trans->self) > 0))) {
3139      TimerSetup (trans);
3140    }
3141  }
3142#endif
3143}
3144
3145/*
3146 *------------------------------------------------------*
3147 *
3148 *	ChannelHandlerTimer --
3149 *
3150 *	------------------------------------------------*
3151 *	Called by the notifier (-> timer) to flush out
3152 *	information waiting in channel buffers.
3153 *	------------------------------------------------*
3154 *
3155 *	Sideeffects:
3156 *		As of 'ChannelHandler'.
3157 *
3158 *	Result:
3159 *		None.
3160 *
3161 *------------------------------------------------------*
3162 */
3163
3164static void
3165ChannelHandlerTimer (clientData)
3166ClientData clientData; /* Transformation to query */
3167{
3168  TrfTransformationInstance* trans = (TrfTransformationInstance*) clientData;
3169
3170  trans->timer = (Tcl_TimerToken) NULL;
3171
3172#ifndef USE_TCL_STUBS
3173  /* 8.0.x.
3174   * Use the channel handler itself to do the necessary actions
3175   */
3176
3177  ChannelHandler (clientData, trans->watchMask);
3178#else
3179  if ((trans->patchVariant == PATCH_82) ||
3180      (trans->patchVariant == PATCH_832)) {
3181    /*
3182     * Use the standard notification mechanism to invoke all channel
3183     * handlers.
3184     */
3185    Tcl_NotifyChannel (trans->self, TCL_READABLE);
3186  } else {
3187    /* PATCH_ORIG, seee 8.0.x
3188     */
3189
3190    ChannelHandler (clientData, trans->watchMask);
3191  }
3192#endif
3193}
3194
3195#ifdef USE_TCL_STUBS
3196/*
3197 *------------------------------------------------------*
3198 *
3199 *	DownSOpt --
3200 *
3201 *	Helper procedure. Writes an option to the downstream channel.
3202 *
3203 *	Sideeffects:
3204 *		As of Tcl_SetChannelOption
3205 *
3206 *	Result:
3207 *		A standard tcl error code.
3208 *
3209 *------------------------------------------------------*
3210 */
3211
3212static int
3213DownSOpt (interp, ctrl, optionName, value)
3214     Tcl_Interp*                interp;
3215     TrfTransformationInstance* ctrl;
3216     CONST char*                optionName;
3217     CONST char*                value;
3218{
3219  Tcl_Channel parent = DOWNC (ctrl);
3220
3221  if (ctrl->patchVariant == PATCH_832) {
3222    /*
3223     * The newly written patch forces direct use of the driver.
3224     */
3225
3226    Tcl_DriverSetOptionProc *setOptionProc =
3227      Tcl_ChannelSetOptionProc (Tcl_GetChannelType (parent));
3228
3229    if (setOptionProc != NULL) {
3230      return (*setOptionProc) (Tcl_GetChannelInstanceData (parent),
3231			       interp, optionName, value);
3232    } else {
3233      return TCL_ERROR;
3234    }
3235
3236  } else {
3237    return Tcl_SetChannelOption (interp, parent, optionName, value);
3238  }
3239}
3240
3241/*
3242 *------------------------------------------------------*
3243 *
3244 *	DownGOpt --
3245 *
3246 *	Helper procedure. Reads options from the downstream channel.
3247 *
3248 *	Sideeffects:
3249 *		As of Tcl_GetChannelOption
3250 *
3251 *	Result:
3252 *		A standard tcl error code.
3253 *
3254 *------------------------------------------------------*
3255 */
3256
3257static int
3258DownGOpt (interp, ctrl, optionName, dsPtr)
3259     Tcl_Interp*                interp;
3260     TrfTransformationInstance* ctrl;
3261     CONST84 char*              optionName;
3262     Tcl_DString*               dsPtr;
3263{
3264  Tcl_Channel parent = DOWNC (ctrl);
3265
3266  if (ctrl->patchVariant == PATCH_832) {
3267    /*
3268     * The newly written patch forces direct use of the driver.
3269     */
3270
3271    Tcl_DriverGetOptionProc *getOptionProc =
3272      Tcl_ChannelGetOptionProc (Tcl_GetChannelType (parent));
3273
3274    if (getOptionProc != NULL) {
3275	return (*getOptionProc) (Tcl_GetChannelInstanceData (parent),
3276				 interp, optionName, dsPtr);
3277    }
3278
3279    /*
3280     * Downstream channel has no driver to get options. Fall back on
3281     * some default behaviour. A query for all options is ok. A
3282     * request for a specific unknown option OTOH has to fail.
3283     */
3284
3285    if (optionName == (char*) NULL) {
3286      return TCL_OK;
3287    } else {
3288      return TCL_ERROR;
3289    }
3290  } else {
3291    return Tcl_GetChannelOption (interp, parent, optionName, dsPtr);
3292  }
3293}
3294
3295/*
3296 *------------------------------------------------------*
3297 *
3298 *	DownWrite --
3299 *
3300 *	Helper procedure. Writes to the downstream channel.
3301 *
3302 *	Sideeffects:
3303 *		As of TclWrite / Tcl_WriteRaw
3304 *
3305 *	Result:
3306 *		The number of bytes written.
3307 *
3308 *------------------------------------------------------*
3309 */
3310
3311static int
3312DownWrite (ctrl, buf, toWrite)
3313     TrfTransformationInstance* ctrl;
3314     char*                      buf;
3315     int                        toWrite;
3316{
3317  Tcl_Channel parent = DOWNC (ctrl);
3318
3319  if (ctrl->patchVariant == PATCH_832) {
3320    /*
3321     * The newly written patch forces use of the new raw-API.
3322     */
3323
3324    PRINT ("WriteRaw %p %s\n", parent, Tcl_GetChannelType (parent)->typeName);
3325    return Tcl_WriteRaw (parent, buf, toWrite);
3326  } else {
3327    return Tcl_Write (parent, buf, toWrite);
3328  }
3329  return TCL_OK;
3330}
3331
3332/*
3333 *------------------------------------------------------*
3334 *
3335 *	DownRead --
3336 *
3337 *	Helper procedure. Reads from the downstream channel.
3338 *
3339 *	Sideeffects:
3340 *		As of TclRead / Tcl_ReadRaw
3341 *
3342 *	Result:
3343 *		The number of bytes read.
3344 *
3345 *------------------------------------------------------*
3346 */
3347
3348static int
3349DownRead (ctrl, buf, toRead)
3350     TrfTransformationInstance* ctrl;
3351     char*                      buf;
3352     int                        toRead;
3353{
3354  Tcl_Channel parent = DOWNC (ctrl);
3355
3356  if (ctrl->patchVariant == PATCH_832) {
3357    /*
3358     * The newly written patch forces use of the new raw-API.
3359     */
3360
3361    return Tcl_ReadRaw (parent, buf, toRead);
3362  } else {
3363    return Tcl_Read (parent, buf, toRead);
3364  }
3365  return TCL_OK;
3366}
3367
3368/*
3369 *------------------------------------------------------*
3370 *
3371 *	DownSeek --
3372 *
3373 *	Helper procedure. Asks the downstream channel
3374 *	to seek, or for its current location.
3375 *
3376 *	Sideeffects:
3377 *		None.
3378 *
3379 *	Result:
3380 *		The location in the downstream channel
3381 *
3382 *------------------------------------------------------*
3383 */
3384
3385static int
3386DownSeek (ctrl, offset, mode)
3387    TrfTransformationInstance* ctrl;
3388    int                        offset;
3389    int                        mode;
3390{
3391  Tcl_Channel parent = DOWNC (ctrl);
3392
3393  if (ctrl->patchVariant == PATCH_832) {
3394    /*
3395     * The newly rewritten patch forces the transformation into
3396     * directly using the seek-proc of the downstream driver. Tcl_Seek
3397     * would compensate for the stack and cause and infinite recursion
3398     * blowing the stack.
3399     */
3400
3401    Tcl_ChannelType*    parentType     = Tcl_GetChannelType  (parent);
3402    Tcl_DriverSeekProc* parentSeekProc = Tcl_ChannelSeekProc (parentType);
3403    int                 errorCode;
3404
3405    if (parentSeekProc == (Tcl_DriverSeekProc*) NULL) {
3406      return -1;
3407    }
3408
3409    return (*parentSeekProc) (Tcl_GetChannelInstanceData (parent),
3410			      offset, mode, &errorCode);
3411  }
3412
3413  /*
3414   * (ctrl->patchVariant == PATCH_ORIG)
3415   * (ctrl->patchVariant == PATCH_82)
3416   *
3417   * Both the original patch for stacked channels and rewritten
3418   * implementation for 8.2. have the same simple semantics for
3419   * getting at the location of the downstream channel.
3420   *
3421   * Just use the standard 'Tcl_Seek'.
3422   */
3423
3424    return (int) Tcl_Seek (parent, offset, mode);
3425}
3426
3427/*
3428 *------------------------------------------------------*
3429 *
3430 *	DownChannel --
3431 *
3432 *	Helper procedure. Finds the downstream channel.
3433 *
3434 *	Sideeffects:
3435 *		May modify 'self'.
3436 *
3437 *	Result:
3438 *		None.
3439 *
3440 *------------------------------------------------------*
3441 */
3442
3443static Tcl_Channel
3444DownChannel (ctrl)
3445    TrfTransformationInstance* ctrl;
3446{
3447  Tcl_Channel self;
3448  Tcl_Channel next;
3449
3450  if ((ctrl->patchVariant == PATCH_ORIG) ||
3451      (ctrl->patchVariant == PATCH_832)) {
3452    /*
3453     * Both the original patch for stacked channels and rewritten
3454     * implementation for 8.3.2. have simple semantics for getting at
3455     * the parent of a channel.
3456     */
3457
3458    return ctrl->parent;
3459  }
3460
3461  /*
3462   * The first rewrite of the stacked channel patch initially included
3463   * in 8.2. requires that a transformation searches it's channel in
3464   * the whole stack. Only for the versions of the core using this
3465   * implementation, 8.2 till 8.3.1, the comments below apply.
3466   */
3467
3468  /* The reason for the existence of this procedure is
3469   * the fact that stacking a transform over another
3470   * transform will leave our internal pointer unchanged,
3471   * and thus pointing to the new transform, and not the
3472   * Channel structure containing the saved state of this
3473   * transform. This is the price to pay for leaving
3474   * Tcl_Channel references intact. The only other solution
3475   * is an extension of Tcl_ChannelType with another driver
3476   * procedure to notify a Channel about the (un)stacking.
3477   *
3478   * It walks the chain of Channel structures until it
3479   * finds the one pointing having 'ctrl' as instanceData
3480   * and then returns the superceding channel to that.
3481   */
3482
3483  self = ctrl->self;
3484
3485  while ((ClientData) ctrl != Tcl_GetChannelInstanceData (self)) {
3486    next = Tcl_GetStackedChannel (self);
3487    if (next == (Tcl_Channel) NULL) {
3488      /* 09/24/1999 Unstacking bug, found by Matt Newman <matt@sensus.org>.
3489       *
3490       * We were unable to find the channel structure for this
3491       * transformation in the chain of stacked channel. This
3492       * means that we are currently in the process of unstacking
3493       * it *and* there were some bytes waiting which are now
3494       * flushed. In this situation the pointer to the channel
3495       * itself already refers to the parent channel we have to
3496       * write the bytes into, so we return that.
3497       */
3498      return ctrl->self;
3499    }
3500    self = next;
3501  }
3502
3503  return Tcl_GetStackedChannel (self);
3504}
3505#endif
3506
3507/*
3508 *------------------------------------------------------*
3509 *
3510 *	ResultClear --
3511 *
3512 *	Deallocates any memory allocated by 'ResultAdd'.
3513 *
3514 *	Sideeffects:
3515 *		See above.
3516 *
3517 *	Result:
3518 *		None.
3519 *
3520 *------------------------------------------------------*
3521 */
3522
3523static void
3524ResultClear (r)
3525     ResultBuffer* r; /* Reference to the buffer to clear out */
3526{
3527  r->used = 0;
3528
3529  if (r->allocated) {
3530    ckfree ((char*) r->buf);
3531    r->buf       = (unsigned char*) NULL;
3532    r->allocated = 0;
3533  }
3534
3535  if (r->seekState != (SeekState*) NULL) {
3536    r->seekState->upBufStartLoc  = r->seekState->upLoc;
3537    r->seekState->upBufEndLoc    = r->seekState->upLoc;
3538  }
3539}
3540
3541/*
3542 *------------------------------------------------------*
3543 *
3544 *	ResultInit --
3545 *
3546 *	Initializes the specified buffer structure. The
3547 *	structure will contain valid information for an
3548 *	emtpy buffer.
3549 *
3550 *	Sideeffects:
3551 *		See above.
3552 *
3553 *	Result:
3554 *		None.
3555 *
3556 *------------------------------------------------------*
3557 */
3558
3559static void
3560ResultInit (r)
3561    ResultBuffer* r; /* Reference to the structure to initialize */
3562{
3563    r->used      = 0;
3564    r->allocated = 0;
3565    r->buf       = (unsigned char*) NULL;
3566    r->seekState = (SeekState*) NULL;
3567}
3568
3569/*
3570 *------------------------------------------------------*
3571 *
3572 *	ResultLength --
3573 *
3574 *	Returns the number of bytes stored in the buffer.
3575 *
3576 *	Sideeffects:
3577 *		None.
3578 *
3579 *	Result:
3580 *		An integer, see above too.
3581 *
3582 *------------------------------------------------------*
3583 */
3584
3585static int
3586ResultLength (r)
3587    ResultBuffer* r; /* The structure to query */
3588{
3589    return r->used;
3590}
3591
3592/*
3593 *------------------------------------------------------*
3594 *
3595 *	ResultCopy --
3596 *
3597 *	Copies the requested number of bytes from the
3598 *	buffer into the specified array and removes them
3599 *	from the buffer afterward. Copies less if there
3600 *	is not enough data in the buffer.
3601 *
3602 *	Sideeffects:
3603 *		See above.
3604 *
3605 *	Result:
3606 *		The number of actually copied bytes,
3607 *		possibly less than 'toRead'.
3608 *
3609 *------------------------------------------------------*
3610 */
3611
3612static int
3613ResultCopy (r, buf, toRead)
3614     ResultBuffer*  r;      /* The buffer to read from */
3615     unsigned char* buf;    /* The buffer to copy into */
3616     int            toRead; /* Number of requested bytes */
3617{
3618  int copied;
3619
3620  START (ResultCopy);
3621  PRINT ("request = %d, have = %d\n", toRead, r->used); FL;
3622
3623  if (r->used == 0) {
3624    /* Nothing to copy in the case of an empty buffer.
3625     */
3626
3627    copied = 0;
3628    goto done;
3629  }
3630
3631  if (r->used == toRead) {
3632    /* We have just enough. Copy everything to the caller.
3633     */
3634
3635    memcpy ((VOID*) buf, (VOID*) r->buf, toRead);
3636    r->used = 0;
3637
3638    copied = toRead;
3639    goto done;
3640  }
3641
3642  if (r->used > toRead) {
3643    /* The internal buffer contains more than requested.
3644     * Copy the requested subset to the caller, and shift
3645     * the remaining bytes down.
3646     */
3647
3648    memcpy  ((VOID*) buf,    (VOID*) r->buf,            toRead);
3649    memmove ((VOID*) r->buf, (VOID*) (r->buf + toRead), r->used - toRead);
3650
3651    r->used -= toRead;
3652
3653    copied = toRead;
3654    goto done;
3655  }
3656
3657  /* There is not enough in the buffer to satisfy the caller, so
3658   * take everything.
3659   */
3660
3661  memcpy ((VOID*) buf, (VOID*) r->buf, r->used);
3662  toRead  = r->used;
3663  r->used = 0;
3664  copied  = toRead;
3665
3666  /* -- common postwork code ------- */
3667
3668done:
3669  if ((copied > 0) &&
3670      (r->seekState != (SeekState*) NULL)) {
3671    r->seekState->upBufStartLoc += copied;
3672  }
3673
3674  DONE (ResultCopy);
3675  return copied;
3676}
3677
3678/*
3679 *------------------------------------------------------*
3680 *
3681 *	ResultDiscardAtStart --
3682 *
3683 *	Removes the n bytes at the beginning of the buffer
3684 *	from it. Clears the buffer if n is greater than
3685 *	its length.
3686 *
3687 *	Sideeffects:
3688 *		See above.
3689 *
3690 *	Result:
3691 *		None.
3692 *
3693 *------------------------------------------------------*
3694 */
3695
3696static void
3697ResultDiscardAtStart (r, n)
3698     ResultBuffer*  r; /* The buffer to manipulate  */
3699     int            n; /* Number of bytes to remove */
3700{
3701  START (ResultDiscardAtStart);
3702  PRINT ("n = %d, have = %d\n", n, r->used); FL;
3703
3704  if (r->used == 0) {
3705    /* Nothing to remove in the case of an empty buffer.
3706     */
3707
3708    DONE (ResultDiscardAtStart);
3709    return;
3710  }
3711
3712  if (n > r->used) {
3713    ResultClear (r);
3714    DONE (ResultDiscardAtStart);
3715    return;
3716  }
3717
3718  /* Shift remaining information down */
3719
3720  memmove ((VOID*) r->buf, (VOID*) (r->buf + n), r->used - n);
3721  r->used -= n;
3722
3723  if (r->seekState != (SeekState*) NULL) {
3724    r->seekState->upBufStartLoc += n;
3725  }
3726
3727  DONE (ResultCopy);
3728}
3729
3730/*
3731 *------------------------------------------------------*
3732 *
3733 *	ResultAdd --
3734 *
3735 *	Adds the bytes in the specified array to the
3736 *	buffer, by appending it.
3737 *
3738 *	Sideeffects:
3739 *		See above.
3740 *
3741 *	Result:
3742 *		None.
3743 *
3744 *------------------------------------------------------*
3745 */
3746
3747static void
3748ResultAdd (r, buf, toWrite)
3749    ResultBuffer*  r;       /* The buffer to extend */
3750    unsigned char* buf;     /* The buffer to read from */
3751    int            toWrite; /* The number of bytes in 'buf' */
3752{
3753  START (ResultAdd);
3754  PRINT ("have %d, adding %d\n", r->used, toWrite); FL;
3755
3756  if ((r->used + toWrite + 1) > r->allocated) {
3757    /* Extension of the internal buffer is required.
3758     */
3759
3760    if (r->allocated == 0) {
3761      r->allocated = toWrite + INCREMENT;
3762      r->buf       = (unsigned char*) ckalloc (r->allocated);
3763    } else {
3764      r->allocated += toWrite + INCREMENT;
3765      r->buf        = (unsigned char*) ckrealloc((char*) r->buf,
3766						   r->allocated);
3767    }
3768  }
3769
3770  /* now copy data */
3771  memcpy (r->buf + r->used, buf, toWrite);
3772  r->used += toWrite;
3773
3774  if (r->seekState != (SeekState*) NULL) {
3775    r->seekState->upBufEndLoc += toWrite;
3776  }
3777
3778  DONE (ResultAdd);
3779}
3780
3781/*
3782 *------------------------------------------------------*
3783 *
3784 *	SeekCalculatePolicies --
3785 *
3786 *	Computes standard and used policy from the natural
3787 *	policy of the transformation, all transformations
3788 *	below and its base channel.
3789 *
3790 *	Sideeffects:
3791 *		See above.
3792 *
3793 *	Result:
3794 *		None.
3795 *
3796 *------------------------------------------------------*
3797 */
3798
3799static void
3800SeekCalculatePolicies (trans)
3801     TrfTransformationInstance* trans;
3802{
3803  /* Define seek related runtime configuration.
3804   * seekCfg.overideAllowed, seekCfg.chosen, seekState.used
3805   *
3806   * i.   some transformation below unseekable ? not-overidable unseekable
3807   * ii.  base channel unseekable ?              see above
3808   * iii. naturally unseekable ?                 overidable unseekable.
3809   *
3810   * WARNING: For 8.0 and 8.1 we will always return 'unseekable'. Due to a
3811   * missing 'Tcl_GetStackedChannel' we are unable to go down through the
3812   * stack of transformations.
3813   */
3814
3815#ifndef USE_TCL_STUBS
3816  START (SeekCalculatePolicies);
3817  PRINTLN ("8.0., no Tcl_GetStackedChannel, unseekable, no overide");
3818
3819  TRF_SET_UNSEEKABLE (trans->seekCfg.chosen);
3820  trans->seekCfg.overideAllowed = 0;
3821
3822#else
3823  Tcl_Channel self = trans->self;
3824  Tcl_Channel next;
3825
3826  int stopped = 0;
3827
3828  START (SeekCalculatePolicies);
3829
3830  if (trans->patchVariant == PATCH_ORIG) {
3831    PRINTLN ("8.1., no Tcl_GetStackedChannel, unseekable, no overide");
3832
3833    TRF_SET_UNSEEKABLE (trans->seekCfg.chosen);
3834    trans->seekCfg.overideAllowed = 0;
3835    goto done;
3836  }
3837
3838  /* 8.2 or higher */
3839
3840  while (self != (Tcl_Channel) NULL) {
3841    PRINT ("Check %p\n", self); FL;
3842
3843#if GT81
3844    next = Tcl_GetStackedChannel (self);
3845#else
3846    /* In case of 8.1 and higher we can use the (integrated or patched)
3847     * 'Tcl_GetStackedChannel' to find the next transform in a general
3848     * way. Else we have to check the type of 'next' itself before trying
3849     * to peek into its structure. If it is no Trf transform we cannot go
3850     * deeper into the stack. But that is not necessary, as the result of
3851     * 'unseekable' will not change anymore.
3852     */
3853
3854    if (Tcl_GetChannelType (self)->seekProc != TrfSeek) {
3855      PRINTLN ("Can't go further down, unseekable, disallow overide");
3856
3857      TRF_SET_UNSEEKABLE (trans->seekCfg.chosen);
3858      trans->seekCfg.overideAllowed = 0;
3859      stopped = 1;
3860      break;
3861    }
3862
3863    next = ((TrfTransformationInstance*)
3864		   Tcl_GetChannelInstanceData (self))->parent;
3865#endif
3866
3867    if (next == (Tcl_Channel) NULL) {
3868      /* self points to base channel (ii).
3869       */
3870
3871      if (Tcl_GetChannelType (self)->seekProc == (Tcl_DriverSeekProc*) NULL) {
3872	/* Base is unseekable.
3873	 */
3874
3875	PRINTLN ("Base is unseekable");
3876
3877	TRF_SET_UNSEEKABLE (trans->seekCfg.chosen);
3878	trans->seekCfg.overideAllowed = 0;
3879	stopped = 1;
3880	break;
3881      }
3882    } else {
3883      /* 'next' points to a transformation.
3884       */
3885
3886      Tcl_Channel nextAfter;
3887
3888#if GT81
3889      nextAfter = Tcl_GetStackedChannel (next);
3890#else
3891      nextAfter = ((TrfTransformationInstance*)
3892		   Tcl_GetChannelInstanceData (next))->parent;
3893#endif
3894
3895      if (nextAfter != (Tcl_Channel) NULL) {
3896	/* next points to a transformation below the top (i).
3897	 * Assume unseekable for a non-trf transformation, else peek directly
3898	 * into the relevant structure
3899	 */
3900
3901	if (Tcl_GetChannelType (next)->seekProc != TrfSeek) {
3902	  PRINTLN ("Unknown type of transform, unseekable, no overide");
3903
3904	  TRF_SET_UNSEEKABLE (trans->seekCfg.chosen);
3905	  trans->seekCfg.overideAllowed = 0;
3906	  stopped = 1;
3907	} else {
3908	  TrfTransformationInstance* down =
3909	    (TrfTransformationInstance*) Tcl_GetChannelInstanceData (next);
3910
3911	  if (!down->seekState.allowed) {
3912	    PRINTLN ("Trf transform, unseekable");
3913
3914	    TRF_SET_UNSEEKABLE (trans->seekCfg.chosen);
3915	    trans->seekCfg.overideAllowed = 0;
3916	    stopped = 1;
3917	  }
3918	}
3919      } else {
3920	/* Next points to the base channel */
3921	/* assert (0); */
3922      }
3923    }
3924
3925    self = next;
3926  }
3927
3928  PRINTLN ("Looping done");
3929
3930  if (!stopped) {
3931    PRINTLN ("Search went through, check natural policy");
3932
3933    if (TRF_IS_UNSEEKABLE (trans->seekCfg.natural)) {
3934      /* Naturally unseekable (iii)
3935       */
3936
3937      PRINTLN ("Naturally unseekable");
3938
3939      TRF_SET_UNSEEKABLE (trans->seekCfg.chosen);
3940      trans->seekCfg.overideAllowed = 1;
3941    } else {
3942      /* Take the natural ratio.
3943       */
3944
3945      PRINTLN ("naturally seekable");
3946
3947      trans->seekCfg.chosen.numBytesTransform =
3948	trans->seekCfg.natural.numBytesTransform;
3949
3950      trans->seekCfg.chosen.numBytesDown      =
3951	trans->seekCfg.natural.numBytesDown;
3952
3953      trans->seekCfg.overideAllowed = 1;
3954    }
3955  }
3956#endif
3957
3958  PRINTLN ("Copy ratio chosen :- used");
3959
3960#ifdef USE_TCL_STUBS
3961done:
3962#endif
3963  trans->seekState.used.numBytesTransform =
3964    trans->seekCfg.chosen.numBytesTransform;
3965
3966  trans->seekState.used.numBytesDown      =
3967    trans->seekCfg.chosen.numBytesDown;
3968
3969  trans->seekState.allowed                =
3970    !TRF_IS_UNSEEKABLE (trans->seekState.used);
3971
3972  DONE (SeekCalculatePolicies);
3973}
3974
3975/*
3976 *------------------------------------------------------*
3977 *
3978 *	SeekInitialize --
3979 *
3980 *	Initialize the runtime state of the seek mechanisms
3981 *
3982 *	Sideeffects:
3983 *		See above.
3984 *
3985 *	Result:
3986 *		None.
3987 *
3988 *------------------------------------------------------*
3989 */
3990
3991static void
3992SeekInitialize (trans)
3993     TrfTransformationInstance* trans;
3994{
3995  trans->seekState.upLoc         = 0;
3996  trans->seekState.upBufStartLoc = 0;
3997  trans->seekState.upBufEndLoc   = 0;
3998
3999  if (trans->seekState.allowed) {
4000    trans->seekState.downLoc     = TELL (trans);
4001#ifdef USE_TCL_STUBS
4002    if (trans->patchVariant == PATCH_832) {
4003      trans->seekState.downLoc  -= Tcl_ChannelBuffered (DOWNC (trans));
4004    }
4005#endif
4006    trans->seekState.downZero    = trans->seekState.downLoc;
4007    trans->seekState.aheadOffset = 0;
4008  } else {
4009    trans->seekState.downLoc     = 0;
4010    trans->seekState.downZero    = 0;
4011    trans->seekState.aheadOffset = 0;
4012  }
4013
4014  trans->seekCfg.identity   = 0;
4015  trans->seekState.changed  = 0;
4016
4017  SEEK_DUMP (Seek Initialized);
4018}
4019
4020/*
4021 *------------------------------------------------------*
4022 *
4023 *	SeekClearBuffer --
4024 *
4025 *	Clear read / write buffers of the transformation,
4026 *	as specified by the second argument.
4027 *
4028 *	Sideeffects:
4029 *		See above.
4030 *
4031 *	Result:
4032 *		None.
4033 *
4034 *------------------------------------------------------*
4035 */
4036
4037static void
4038SeekClearBuffer (trans, which)
4039     TrfTransformationInstance* trans;
4040     int                        which;
4041{
4042  /*
4043   * Discard everything in the input and output buffers, both
4044   * in the transformation and in the generic layer of Trf.
4045   */
4046
4047  if (trans->mode & which & TCL_WRITABLE) {
4048    PRINT ("out.clearproc\n"); FL;
4049
4050    trans->out.vectors->clearProc (trans->out.control, trans->clientData);
4051  }
4052
4053  if (trans->mode & which & TCL_READABLE) {
4054    PRINT ("in.clearproc\n"); FL;
4055
4056    trans->in.vectors->clearProc  (trans->in.control, trans->clientData);
4057    trans->readIsFlushed = 0;
4058    ResultClear (&trans->result);
4059  }
4060}
4061
4062/*
4063 *------------------------------------------------------*
4064 *
4065 *	SeekSynchronize --
4066 *
4067 *	Discard an existing read buffer and annulate the
4068 *	read ahead in the downstream channel.
4069 *
4070 *	Sideeffects:
4071 *		See above.
4072 *
4073 *	Result:
4074 *		None.
4075 *
4076 *------------------------------------------------------*
4077 */
4078
4079static void
4080SeekSynchronize (trans, parent)
4081     TrfTransformationInstance* trans;
4082     Tcl_Channel                parent;
4083{
4084  int offsetDown;
4085
4086  if (!trans->seekState.allowed) {
4087    /* No synchronisation required for an unseekable transform */
4088    return;
4089  }
4090
4091  if ((trans->seekState.upLoc == trans->seekState.upBufEndLoc) &&
4092      (trans->seekState.aheadOffset == 0)) {
4093    /* Up and down locations are in sync, nothing to do. */
4094    return;
4095  }
4096
4097  PRINT ("in.clearproc\n"); FL;
4098
4099  trans->in.vectors->clearProc  (trans->in.control, trans->clientData);
4100  trans->readIsFlushed = 0;
4101
4102  offsetDown  = TRF_DOWN_CONVERT (trans,
4103				  trans->seekState.upLoc - trans->seekState.upBufEndLoc);
4104  offsetDown -= trans->seekState.aheadOffset; /* !! */
4105
4106  ResultClear (&trans->result);
4107
4108  if (offsetDown != 0) {
4109    SEEK (trans, offsetDown, SEEK_CUR);
4110  }
4111
4112  trans->seekState.downLoc += offsetDown;
4113}
4114
4115/*
4116 *------------------------------------------------------*
4117 *
4118 *	SeekPolicyGet --
4119 *
4120 *	Compute the currently used policy and store its
4121 *	name into the character buffer.
4122 *
4123 *	Sideeffects:
4124 *		See above.
4125 *
4126 *	Result:
4127 *		None.
4128 *
4129 *------------------------------------------------------*
4130 */
4131
4132static void
4133SeekPolicyGet (trans, policy)
4134     TrfTransformationInstance* trans;
4135     char*                      policy;
4136{
4137  if (trans->seekCfg.identity) {
4138    /* identity forced */
4139
4140    strcpy (policy, "identity");
4141    return;
4142  }
4143
4144  if (!trans->seekState.allowed &&
4145      ((trans->seekState.used.numBytesTransform !=
4146	trans->seekCfg.chosen.numBytesTransform) ||
4147       (trans->seekState.used.numBytesDown !=
4148	trans->seekCfg.chosen.numBytesDown))) {
4149    /* unseekable forced */
4150
4151    strcpy (policy, "unseekable");
4152    return;
4153  }
4154
4155  /* chosen policy in effect */
4156
4157  strcpy (policy, "");
4158  return;
4159}
4160
4161/*
4162 *------------------------------------------------------*
4163 *
4164 *	SeekConfigGet --
4165 *
4166 *	Generates a list containing the current configuration
4167 *	of the seek system in a readable manner.
4168 *
4169 *	Sideeffects:
4170 *		See above.
4171 *
4172 *	Result:
4173 *		An Tcl_Obj, or NULL.
4174 *
4175 *------------------------------------------------------*
4176 */
4177
4178static Tcl_Obj*
4179SeekConfigGet (interp, cfg)
4180     Tcl_Interp* interp;
4181     SeekConfig* cfg;
4182{
4183  int      res;
4184  Tcl_Obj* list = (Tcl_Obj*) NULL;
4185  Tcl_Obj* sub1 = (Tcl_Obj*) NULL;
4186  Tcl_Obj* sub2 = (Tcl_Obj*) NULL;
4187
4188  list = Tcl_NewListObj (0, NULL);
4189
4190  if (list == (Tcl_Obj*) NULL) {
4191    goto error;
4192  }
4193
4194  LIST_ADDSTR (error, list, "ratioNatural");
4195  sub1 = Tcl_NewListObj (0, NULL);
4196
4197  if (sub1 == (Tcl_Obj*) NULL) {
4198    goto error;
4199  }
4200
4201  LIST_ADDINT (error, sub1, cfg->natural.numBytesTransform);
4202  LIST_ADDINT (error, sub1, cfg->natural.numBytesDown);
4203  LIST_ADDOBJ (error, list, sub1);
4204
4205
4206  LIST_ADDSTR (error, list, "ratioChosen");
4207  sub2 = Tcl_NewListObj (0, NULL);
4208
4209  if (sub2 == (Tcl_Obj*) NULL) {
4210    goto error;
4211  }
4212
4213  LIST_ADDINT (error, sub2, cfg->chosen.numBytesTransform);
4214  LIST_ADDINT (error, sub2, cfg->chosen.numBytesDown);
4215  LIST_ADDOBJ (error, list, sub2);
4216
4217  LIST_ADDSTR (error, list, "overideAllowed");
4218  LIST_ADDINT (error, list, cfg->overideAllowed);
4219
4220  LIST_ADDSTR (error, list, "identityForced");
4221  LIST_ADDINT (error, list, cfg->identity);
4222
4223  return list;
4224
4225error:
4226  /* Cleanup any remnants of errors above */
4227
4228  if (list != (Tcl_Obj*) NULL) {
4229    Tcl_DecrRefCount (list);
4230  }
4231
4232  if (sub1 != (Tcl_Obj*) NULL) {
4233    Tcl_DecrRefCount (sub1);
4234  }
4235
4236  if (sub2 != (Tcl_Obj*) NULL) {
4237    Tcl_DecrRefCount (sub2);
4238  }
4239
4240  return NULL;
4241}
4242
4243/*
4244 *------------------------------------------------------*
4245 *
4246 *	SeekStateGet --
4247 *
4248 *	Generates a list containing the current state of
4249 *	the seek system in a readable manner.
4250 *
4251 *	Sideeffects:
4252 *		See above.
4253 *
4254 *	Result:
4255 *		An Tcl_Obj, or NULL.
4256 *
4257 *------------------------------------------------------*
4258 */
4259
4260static Tcl_Obj*
4261SeekStateGet (interp, state)
4262     Tcl_Interp* interp;
4263     SeekState* state;
4264{
4265  int      res;
4266  Tcl_Obj* list = (Tcl_Obj*) NULL;
4267  Tcl_Obj* sub  = (Tcl_Obj*) NULL;
4268
4269  list = Tcl_NewListObj (0, NULL);
4270
4271  if (list == (Tcl_Obj*) NULL) {
4272    goto error;
4273  }
4274
4275  LIST_ADDSTR (error, list, "seekable");
4276  LIST_ADDINT (error, list, state->allowed);
4277
4278  LIST_ADDSTR (error, list, "ratio");
4279
4280  sub  = Tcl_NewListObj (0, NULL);
4281  if (sub == (Tcl_Obj*) NULL) {
4282    goto error;
4283  }
4284
4285  LIST_ADDINT (error, sub, state->used.numBytesTransform);
4286  LIST_ADDINT (error, sub, state->used.numBytesDown);
4287  LIST_ADDOBJ (error, list, sub);
4288
4289  LIST_ADDSTR (error, list, "up");
4290  LIST_ADDINT (error, list, state->upLoc);
4291
4292  LIST_ADDSTR (error, list, "upBufStart");
4293  LIST_ADDINT (error, list, state->upBufStartLoc);
4294
4295  LIST_ADDSTR (error, list, "upBufEnd");
4296  LIST_ADDINT (error, list, state->upBufEndLoc);
4297
4298  LIST_ADDSTR (error, list, "down");
4299  LIST_ADDINT (error, list, state->downLoc);
4300
4301  LIST_ADDSTR (error, list, "downBase");
4302  LIST_ADDINT (error, list, state->downZero);
4303
4304  LIST_ADDSTR (error, list, "downAhead");
4305  LIST_ADDINT (error, list, state->aheadOffset);
4306
4307  LIST_ADDSTR (error, list, "changed");
4308  LIST_ADDINT (error, list, state->changed);
4309
4310  return list;
4311
4312error:
4313  /* Cleanup any remnants of errors above */
4314
4315  if (list != (Tcl_Obj*) NULL) {
4316    Tcl_DecrRefCount (list);
4317  }
4318
4319  if (sub != (Tcl_Obj*) NULL) {
4320    Tcl_DecrRefCount (sub);
4321  }
4322
4323  return NULL;
4324}
4325
4326#ifdef TRF_DEBUG
4327/*
4328 *------------------------------------------------------*
4329 *
4330 *	PrintString --
4331 *
4332 *	Defined only in debug mode, enforces correct
4333 *	printing of strings by adding a \0 after its value.
4334 *
4335 *	Sideeffects:
4336 *		See above.
4337 *
4338 *	Result:
4339 *		None.
4340 *
4341 *------------------------------------------------------*
4342 */
4343
4344void
4345PrintString (fmt,len,bytes)
4346     char* fmt;
4347     int   len;
4348     char* bytes;
4349{
4350  char* tmp = (char*) ckalloc (len+1);
4351  memcpy (tmp, bytes, len);
4352  tmp [len] = '\0';
4353
4354  PRINT (fmt, len, tmp);
4355
4356  ckfree (tmp);
4357}
4358
4359/*
4360 *------------------------------------------------------*
4361 *
4362 *	DumpString --
4363 *
4364 *	Defined only in debug mode, dumps information
4365 *	in hex blocks
4366 *
4367 *	Sideeffects:
4368 *		See above.
4369 *
4370 *	Result:
4371 *		None.
4372 *
4373 *------------------------------------------------------*
4374 */
4375
4376void
4377DumpString (n,len,bytes)
4378     int   n;
4379     int   len;
4380     char* bytes;
4381{
4382  int i, c;
4383
4384  for (i=0, c=0; i < len; i++, c++) {
4385    if (c == 0) {
4386      BLNKS;
4387    }
4388
4389    printf (" %02x", (0xff & bytes [i]));
4390
4391    if (c == 16) {
4392      c = -1;
4393      printf ("\n");
4394    }
4395  }
4396
4397  if (c != 0) {
4398    printf ("\n");
4399  }
4400}
4401
4402/*
4403 *------------------------------------------------------*
4404 *
4405 *	SeekDump --
4406 *
4407 *	Defined only in debug mode, dumps the complete
4408 *	state of all seek variables.
4409 *
4410 *	Sideeffects:
4411 *		See above.
4412 *
4413 *	Result:
4414 *		None.
4415 *
4416 *------------------------------------------------------*
4417 */
4418
4419static void
4420SeekDump (trans, place)
4421     TrfTransformationInstance* trans;
4422     CONST char*                place;
4423{
4424  int         loc;
4425  Tcl_Channel parent = DOWNC (trans);
4426
4427  loc = TELL (trans);
4428
4429#if 0
4430  PRINT ("SeekDump (%s) {\n", place); FL; IN;
4431
4432  PRINT ("ratio up:down    %d : %d\n",
4433	 trans->seekState.used.numBytesTransform,
4434	 trans->seekState.used.numBytesDown); FL;
4435  PRINT ("seekable         %d\n",
4436	 trans->seekState.allowed); FL;
4437  PRINT ("up               %d [%d .. %d]\n",
4438	 trans->seekState.upLoc,
4439	 trans->seekState.upBufStartLoc,
4440	 trans->seekState.upBufEndLoc); FL;
4441  PRINT ("down             %d [%d] | %d\n",
4442	 trans->seekState.downLoc,
4443	 trans->seekState.aheadOffset,
4444	 loc); FL;
4445  PRINT ("base             %d\n",
4446	 trans->seekState.downZero); FL;
4447  PRINT ("identity force   %d\n",
4448	 trans->seekCfg.identity); FL;
4449  PRINT ("seek while ident %d\n",
4450	 trans->seekState.changed); FL;
4451  PRINT ("read buffer      %d\n",
4452	 ResultLength (&trans->result)); FL;
4453
4454  OT ; PRINT ("}\n"); FL;
4455#else
4456  PRINT ("SkDmp (%s) ", place); FL;
4457
4458#if 0
4459  NPRINT ("(%2d : %2d) | ",
4460	  trans->seekCfg.natural.numBytesTransform,
4461	  trans->seekCfg.natural.numBytesDown); FL;
4462  NPRINT ("(%2d : %2d) | ",
4463	  trans->seekCfg.chosen.numBytesTransform,
4464	  trans->seekCfg.chosen.numBytesDown); FL;
4465#endif
4466  NPRINT ("%2d:%2d /%1d |r %5d |u %5d [%5d..%5d] |d %5d [%2d] %5d | %5d | %1d %1d",
4467	  trans->seekState.used.numBytesTransform,
4468	  trans->seekState.used.numBytesDown,
4469	  trans->seekState.allowed,
4470	  ResultLength (&trans->result),
4471	  trans->seekState.upLoc,
4472	  trans->seekState.upBufStartLoc,
4473	  trans->seekState.upBufEndLoc,
4474	  trans->seekState.downLoc,
4475	  trans->seekState.aheadOffset,
4476	  loc,
4477	  trans->seekState.downZero,
4478	  trans->seekCfg.identity,
4479	  trans->seekState.changed
4480	  ); FL;
4481
4482  NPRINT ("\n"); FL;
4483#endif
4484}
4485#endif
4486
4487/*
4488 *------------------------------------------------------*
4489 *
4490 *	AllocChannelType --
4491 *
4492 *	Allocates a new ChannelType structure.
4493 *
4494 *
4495 *	Sideeffects:
4496 *		See above.
4497 *
4498 *	Result:
4499 *		A reference to the new structure.
4500 *
4501 *------------------------------------------------------*
4502 */
4503
4504static Tcl_ChannelType*
4505AllocChannelType (sizePtr)
4506     int* sizePtr;
4507{
4508  /*
4509   * Allocation of a new channeltype structure is not easy, because of
4510   * the various version of the core and subsequent changes to the
4511   * structure. The main challenge is to allocate enough memory for
4512   * modern versions even if this extension is compiled against one
4513   * of the older variants!
4514   *
4515   * (1) Versions before stubs (8.0.x) are simple, because they are
4516   *     supported only if the extension is compiled against exactly
4517   *     that version of the core.
4518   *
4519   * (2) With stubs we just determine the difference between the older
4520   *     and modern variant and overallocate accordingly if compiled
4521   *     against an older variant.
4522   */
4523
4524  int size = sizeof(Tcl_ChannelType); /* Base size */
4525
4526#ifdef USE_TCL_STUBS
4527  /*
4528   * Size of a procedure pointer. We assume that all procedure
4529   * pointers are of the same size, regardless of exact type
4530   * (arguments and return values).
4531   *
4532   * 8.1.   First version containing close2proc. Baseline.
4533   * 8.3.2  Three additional vectors. Moved blockMode, new flush- and
4534   *        handlerProc's.
4535   * 8.4+   wide seek, and thread action.
4536   *
4537   * => Compilation against earlier version has to overallocate five
4538   *    procedure pointers.
4539   */
4540
4541#if !(GT832)
4542  size += 5 * procPtrSize;
4543#endif
4544#endif
4545
4546  if (sizePtr != (int*) NULL) {
4547    *sizePtr = size;
4548  }
4549  return (Tcl_ChannelType*) ckalloc (size);
4550}
4551
4552/*
4553 *------------------------------------------------------*
4554 *
4555 *	InitializeChannelType --
4556 *
4557 *	Initializes a new ChannelType structure.
4558 *
4559 *
4560 *	Sideeffects:
4561 *		See above.
4562 *
4563 *	Result:
4564 *		None.
4565 *
4566 *------------------------------------------------------*
4567 */
4568
4569static Tcl_ChannelType*
4570InitializeChannelType (name, patchVariant)
4571     CONST char*      name;
4572     int              patchVariant;
4573{
4574  Tcl_ChannelType* tct;
4575  int              size;
4576
4577  /*
4578   * Initialization of a new channeltype structure is not easy,
4579   * because of the various version of the core and subsequent changes
4580   * to the structure. The main problem is if compiled against an
4581   * older version how to access the elements of the structure not
4582   * known in that version. It is made a bit easier because the
4583   * allocation routine returns the allocated size. This allows us to
4584   * clear out the entire structure. So we just have to deal with the
4585   * elements to set and not the ones left alone.
4586   */
4587
4588  tct           = AllocChannelType (&size);
4589  tct->typeName = (char*) name;
4590
4591  memset ((VOID*) tct, '\0', size);
4592
4593  /*
4594   * Common elements of the structure (no changes in location or name)
4595   */
4596
4597  tct->closeProc        = TrfClose;
4598  tct->inputProc        = TrfInput;
4599  tct->outputProc       = TrfOutput;
4600  tct->seekProc         = TrfSeek;
4601  tct->setOptionProc    = TrfSetOption;
4602  tct->getOptionProc    = TrfGetOption;
4603  tct->watchProc        = TrfWatch;
4604  tct->getHandleProc    = TrfGetFile;
4605
4606  /*
4607   * No need to handle close2Proc. Already cleared with the 'memset'
4608   * above.
4609   */
4610
4611  /*
4612   * blockModeProc is a twister. For 8.0.x we can access it
4613   * immediately. For the higher versions we have to make some
4614   * runtime-choices, and their implementation depends on the version
4615   * we compile against.
4616   */
4617
4618#ifndef USE_TCL_STUBS
4619  /* 8.0.x */
4620  tct->blockModeProc    = TrfBlock;
4621#else
4622#if GT832
4623  /* 8.3.2. and higher. Direct access to all elements possible. Use
4624   *'patchVariant' information to select the values to use.
4625   */
4626
4627  if ((patchVariant == PATCH_ORIG) ||
4628      (patchVariant == PATCH_82)) {
4629    /* The 'version' element of 8.3.2 is in the the place of the
4630     * blockModeProc. For the original patch in 8.1.x and the firstly
4631     * included (8.2) we have to set our blockModeProc into this
4632     * place.
4633     */
4634    tct->version = (Tcl_ChannelTypeVersion) TrfBlock;
4635  } else /* patchVariant == PATCH_832 */ {
4636    /* For the 8.3.2 core we present ourselves as a version 2
4637     * driver. This means a speciial value in version (ex
4638     * blockModeProc), blockModeProc in a different place and of
4639     * course usage of the handlerProc.
4640     */
4641
4642    tct->version       = TCL_CHANNEL_VERSION_2;
4643    tct->blockModeProc = TrfBlock;
4644    tct->handlerProc   = TrfNotify;
4645  }
4646#else
4647  /* Same as above, but as we are compiling against an older core we
4648   * have to create some definitions for the new elements as the compiler
4649   * does not know them by name.
4650   */
4651
4652  if ((patchVariant == PATCH_ORIG) ||
4653      (patchVariant == PATCH_82)) {
4654    /* The 'version' element of 8.3.2 is in the the place of the
4655     * blockModeProc. For the original patch in 8.1.x and the firstly
4656     * included (8.2) we have to set our blockModeProc into this
4657     * place.
4658     */
4659    tct->blockModeProc = TrfBlock;
4660  } else /* patchVariant == PATCH_832 */ {
4661    /* For the 8.3.2 core we present ourselves as a version 2
4662     * driver. This means a special value in version (ex
4663     * blockModeProc), blockModeProc in a different place and of
4664     * course usage of the handlerProc.
4665     */
4666
4667#define TRF_CHANNEL_VERSION_2	((TrfChannelTypeVersion) 0x2)
4668
4669#define BMP (*((Tcl_DriverBlockModeProc**) (&(tct->close2Proc) + 1)))
4670#define HP  (*((TrfDriverHandlerProc**)    (&(tct->close2Proc) + 3)))
4671
4672    typedef struct TrfChannelTypeVersion_* TrfChannelTypeVersion;
4673    typedef int	(TrfDriverHandlerProc) _ANSI_ARGS_((ClientData instanceData,
4674						    int interestMask));
4675
4676    tct->blockModeProc = (Tcl_DriverBlockModeProc*) TRF_CHANNEL_VERSION_2;
4677
4678    BMP = TrfBlock;
4679    HP  = TrfNotify;
4680
4681#undef BMP
4682#undef HP
4683#undef TRF_CHANNEL_VERSION_2
4684  }
4685#endif
4686#endif
4687
4688  return tct;
4689}
4690
4691/*
4692 *------------------------------------------------------*
4693 *
4694 *	TimerKill --
4695 *
4696 *	Timer management. Removes the internal timer
4697 *	if it exists.
4698 *
4699 *	Sideeffects:
4700 *		See above.
4701 *
4702 *	Result:
4703 *		None.
4704 *
4705 *------------------------------------------------------*
4706 */
4707
4708static void
4709TimerKill (trans)
4710     TrfTransformationInstance* trans;
4711{
4712  if (trans->timer != (Tcl_TimerToken) NULL) {
4713    /* Delete an existing flush-out timer,
4714     * prevent it from firing on removed channel.
4715     */
4716
4717    Tcl_DeleteTimerHandler (trans->timer);
4718    trans->timer = (Tcl_TimerToken) NULL;
4719
4720    PRINT ("Timer deleted ..."); FL;
4721  }
4722}
4723
4724/*
4725 *------------------------------------------------------*
4726 *
4727 *	TimerSetup --
4728 *
4729 *	Timer management. Creates the internal timer
4730 *	if it does not exist.
4731 *
4732 *	Sideeffects:
4733 *		See above.
4734 *
4735 *	Result:
4736 *		None.
4737 *
4738 *------------------------------------------------------*
4739 */
4740
4741static void
4742TimerSetup (trans)
4743     TrfTransformationInstance* trans;
4744{
4745  if (trans->timer == (Tcl_TimerToken) NULL) {
4746    trans->timer = Tcl_CreateTimerHandler (TRF_DELAY, ChannelHandlerTimer,
4747					   (ClientData) trans);
4748  }
4749}
4750
4751/*
4752 *------------------------------------------------------*
4753 *
4754 *	ChannelHandlerKS --
4755 *
4756 *	Management of channel handlers. Deletes/Recreates
4757 *	as required by the specified mask.
4758 *
4759 *	Sideeffects:
4760 *		See above.
4761 *
4762 *	Result:
4763 *		None.
4764 *
4765 *------------------------------------------------------*
4766 */
4767
4768static void
4769ChannelHandlerKS (trans, mask)
4770     TrfTransformationInstance* trans;
4771     int                        mask;
4772{
4773  /*
4774   * This procedure is called only for the original and the 8.2
4775   * patch. The new 8.2.3 patch does not use channel handlers but a
4776   * separate NotifyHandler in the driver.
4777   */
4778
4779  Tcl_Channel parent = DOWNC (trans);
4780
4781  if (trans->watchMask) {
4782    /*
4783     * Remove event handler to underlying channel, this could
4784     * be because we are closing for real, or being "unstacked".
4785     */
4786
4787    Tcl_DeleteChannelHandler (parent, ChannelHandler,
4788			      (ClientData) trans);
4789  }
4790
4791  trans->watchMask = mask;
4792
4793  if (trans->watchMask) {
4794    /*
4795     * Setup active monitor for events on underlying Channel
4796     */
4797
4798    Tcl_CreateChannelHandler (parent, trans->watchMask,
4799			      ChannelHandler, (ClientData) trans);
4800  }
4801}
4802