Fossil

Check-in [66104f8b]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Documented the "ob" API, added "ob level".
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | th1-query-api
Files: files | file ages | folders
SHA1: 66104f8b5d8278cd7a15cdd4f8ea09437ae53c31
User & Date: stephan 2012-07-14 19:19:19.292
Context
2012-07-14
19:48
Fixed a segfault in proc_command() caused by invalid inspection of an empty array. ... (check-in: f2d87242 user: stephan tags: th1-query-api)
19:19
Documented the "ob" API, added "ob level". ... (check-in: 66104f8b user: stephan tags: th1-query-api)
18:55
Fixed a crash case off-by-1 in th1 (ob get). ... (check-in: ef68eb01 user: stephan tags: th1-query-api)
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/th.c.
2749
2750
2751
2752
2753
2754
2755








2756
2757
2758
2759
2760
2761





2762
2763
2764
2765
2766
2767
2768




2769
2770
2771
2772
2773




2774
2775
2776
2777
2778
2779
2780
2781
2782



2783
2784
2785
2786
2787
2788
2789
2790
2791

2792
2793
2794
2795
2796
2797
2798
2799

2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
}

#endif
/* end TH_USE_SQLITE */


#ifdef TH_USE_OUTBUF








struct Th_Ob_Man {
  Blob ** aBuf;
  int nBuf;
  int cursor;
  Th_Interp * interp;
  Th_Vtab ** aVtab;





};

typedef struct Th_Ob_Man Th_Ob_Man;
#define Th_Ob_Man_empty_m { NULL, 0, -1, NULL, NULL }
static const Th_Ob_Man Th_Ob_Man_empty = Th_Ob_Man_empty_m;
static Th_Ob_Man Th_Ob_Man_instance = Th_Ob_Man_empty_m;





static Blob * Th_ob_current( Th_Ob_Man * pMan ){
  return pMan->nBuf>0 ? pMan->aBuf[pMan->cursor] : 0;
}






static int Th_output_ob( char const * zData, int len, void * pState ){
  Th_Ob_Man * pMan = (Th_Ob_Man*)pState;
  Blob * b = Th_ob_current( pMan );
  assert( NULL != pMan );
  assert( b );
  blob_append( b, zData, len );
  return len;
}




static Th_Vtab Th_Vtab_Ob = { th_fossil_realloc,
  {
    Th_output_ob,
    NULL,
    1
  }
};

#if 0

#define OB_MALLOC(I,N) malloc((N))
#define OB_REALLOC(I,P,N) realloc((P),(N))
#define OB_FREE(I,P) free((P))
#else
#define OB_MALLOC(I,N) Th_Malloc((I),(N))
#define OB_REALLOC(I,P,N) Th_Realloc((I),(P),(N))
#define OB_FREE(I,P) Th_Free((I),(P))
#endif

int Th_ob_push( Th_Ob_Man * pMan, Blob ** pOut ){
  Blob * pBlob;
  int x, i;
  assert( NULL != pMan->interp );
  pBlob = (Blob *)OB_MALLOC(pMan->interp, sizeof(Blob));
  *pBlob = empty_blob;

  if( pMan->cursor <= pMan->nBuf ){
    /* expand if needed */
    x = (pMan->cursor>0 ? pMan->cursor : 1) * 2;
    /*fprintf(stderr,"OB EXPAND x=%d\n",x);*/
    void * re = OB_REALLOC( pMan->interp, pMan->aBuf, x * sizeof(Blob*) );
    if(NULL==re){
      goto error;
    }
    pMan->aBuf = (Blob **)re;
    re = OB_REALLOC( pMan->interp, pMan->aVtab, x * sizeof(Th_Vtab*) );
    if(NULL==re){
      goto error;
    }
    pMan->aVtab = (Th_Vtab**)re;
    for( i = pMan->nBuf; i < x; ++i ){
      pMan->aVtab[i] = NULL;
      pMan->aBuf[i] = NULL;







>
>
>
>
>
>
>
>

|
|
|
|
|
>
>
>
>
>







>
>
>
>





>
>
>
>
|








>
>
>


|





<
>
|
|
|
<
<
<
<
|
>




|






|




|







2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814

2815
2816
2817
2818




2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
}

#endif
/* end TH_USE_SQLITE */


#ifdef TH_USE_OUTBUF
/* Reminder: the ob code "really" belongs in th_lang.c,
   but we need access to Th_Interp internals in order to
   swap out Th_Vtab parts for purposes of stacking layers
   of buffers.
*/
/*
** Manager of a stack of Blob objects for output buffering.
*/
struct Th_Ob_Man {
  Blob ** aBuf;        /* Stack of Blobs */
  int nBuf;            /* Number of blobs */
  int cursor;          /* Current level (-1=not active) */
  Th_Interp * interp;  /* The associated interpreter */
  Th_Vtab ** aVtab;    /* Stack of Vtabs (they get restored
                          when a buffering level is popped).
                          Has nBuf entries.

                          FIXME? Only swap out the "out" members?
                       */
};

typedef struct Th_Ob_Man Th_Ob_Man;
#define Th_Ob_Man_empty_m { NULL, 0, -1, NULL, NULL }
static const Th_Ob_Man Th_Ob_Man_empty = Th_Ob_Man_empty_m;
static Th_Ob_Man Th_Ob_Man_instance = Th_Ob_Man_empty_m;

/*
** Returns the top-most Blob in pMan's stack, or NULL
** if buffering is not active.
*/
static Blob * Th_ob_current( Th_Ob_Man * pMan ){
  return pMan->nBuf>0 ? pMan->aBuf[pMan->cursor] : 0;
}


/*
** Th_output_f() impl which expects pState to be (Th_Ob_Man*).
** (zData,len) are appended to pState's current output buffer.
*/
static int Th_output_f_ob( char const * zData, int len, void * pState ){
  Th_Ob_Man * pMan = (Th_Ob_Man*)pState;
  Blob * b = Th_ob_current( pMan );
  assert( NULL != pMan );
  assert( b );
  blob_append( b, zData, len );
  return len;
}

/*
** Vtab impl for the ob buffering layer.
*/
static Th_Vtab Th_Vtab_Ob = { th_fossil_realloc,
  {
    Th_output_f_ob,
    NULL,
    1
  }
};


/*
** Pushes a new blob onto pMan's stack. On success
** returns TH_OK and assigns *pOut (if pOut is not NULL)
** to the new blob (which is owned by pMan). On error




** pOut is not modified and non-0 is returned.
*/
int Th_ob_push( Th_Ob_Man * pMan, Blob ** pOut ){
  Blob * pBlob;
  int x, i;
  assert( NULL != pMan->interp );
  pBlob = (Blob *)Th_Malloc(pMan->interp, sizeof(Blob));
  *pBlob = empty_blob;

  if( pMan->cursor <= pMan->nBuf ){
    /* expand if needed */
    x = (pMan->cursor>0 ? pMan->cursor : 1) * 2;
    /*fprintf(stderr,"OB EXPAND x=%d\n",x);*/
    void * re = Th_Realloc( pMan->interp, pMan->aBuf, x * sizeof(Blob*) );
    if(NULL==re){
      goto error;
    }
    pMan->aBuf = (Blob **)re;
    re = Th_Realloc( pMan->interp, pMan->aVtab, x * sizeof(Th_Vtab*) );
    if(NULL==re){
      goto error;
    }
    pMan->aVtab = (Th_Vtab**)re;
    for( i = pMan->nBuf; i < x; ++i ){
      pMan->aVtab[i] = NULL;
      pMan->aBuf[i] = NULL;
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845








2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865








2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881








2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897












2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916











2917
2918
2919
2920
2921
2922
2923
  if( pOut ){
    *pOut = pBlob;
  }
  /*fprintf(stderr,"OB PUSH: %p\n", pBlob);*/
  return TH_OK;
  error:
  if( pBlob ){
    OB_FREE( pMan->interp, pBlob );
  }
  return TH_ERROR;
}









Blob * Th_ob_pop( Th_Ob_Man * pMan ){
  if( pMan->cursor < 0 ){
    return NULL;
  }else{
    Blob * rc;
    assert( pMan->nBuf > pMan->cursor );
    rc = pMan->aBuf[pMan->cursor];
    pMan->aBuf[pMan->cursor] = NULL;
    pMan->interp->pVtab = pMan->aVtab[pMan->cursor];
    pMan->aVtab[pMan->cursor] = NULL;
    if(-1 == --pMan->cursor){
      OB_FREE( pMan->interp, pMan->aBuf );
      OB_FREE( pMan->interp, pMan->aVtab );
      *pMan = Th_Ob_Man_empty;
    }
    /*fprintf(stderr,"OB pop: %p level=%d\n", rc, pMan->cursor-1);*/
    return rc;
  }
}









static int ob_clean_command( Th_Interp *interp, void *ctx,
                             int argc,  const char **argv, int *argl
){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b;
  assert( pMan && (interp == pMan->interp) );
  b = pMan ? Th_ob_current(pMan) : NULL;
  if(!b){
    Th_ErrorMessage( interp, "Not currently buffering.", NULL, 0 );
    return TH_ERROR;
  }else{
    blob_reset(b);
  }
  return TH_OK;
}









static int ob_end_command( Th_Interp *interp, void *ctx,
                           int argc,  const char **argv, int *argl ){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b;
  assert( pMan && (interp == pMan->interp) );
  b = Th_ob_pop(pMan);
  if(!b){
    Th_ErrorMessage( interp, "Not currently buffering.", NULL, 0 );
    return TH_ERROR;
  }else{
    blob_reset(b);
    OB_FREE( interp, b );
  }
  return TH_OK;
}













static int ob_flush_command( Th_Interp *interp, void *ctx,
                             int argc,  const char **argv, int *argl ){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b = NULL;
  Th_Vtab * oldVtab;
  assert( pMan && (interp == pMan->interp) );
  b = Th_ob_current(pMan);
  if( NULL == b ){
    Th_ErrorMessage( interp, "Not currently buffering.", NULL, 0 );
    return TH_ERROR;
  }
  oldVtab = interp->pVtab;
  interp->pVtab = pMan->aVtab[pMan->cursor];
  Th_output( interp, blob_str(b), b->nUsed );
  interp->pVtab = oldVtab;
  blob_reset(b);
  return TH_OK;
}












static int ob_get_command( Th_Interp *interp, void *ctx,
                           int argc,  const char **argv, int *argl){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b = NULL;
  assert( pMan && (interp == pMan->interp) );
  b = Th_ob_current(pMan);
  if( NULL == b ){







|




>
>
>
>
>
>
>
>











|
|







>
>
>
>
>
>
>
>
















>
>
>
>
>
>
>
>











|




>
>
>
>
>
>
>
>
>
>
>
>



















>
>
>
>
>
>
>
>
>
>
>







2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
  if( pOut ){
    *pOut = pBlob;
  }
  /*fprintf(stderr,"OB PUSH: %p\n", pBlob);*/
  return TH_OK;
  error:
  if( pBlob ){
    Th_Free( pMan->interp, pBlob );
  }
  return TH_ERROR;
}

/*
** Pops the top-most output buffer off the stack and returns
** it. Returns NULL if there is no current buffer.  When the last
** buffer is popped, pMan's internals are cleaned up.
**
** The caller owns the returned object and must eventually call
** blob_reset() on it.
*/
Blob * Th_ob_pop( Th_Ob_Man * pMan ){
  if( pMan->cursor < 0 ){
    return NULL;
  }else{
    Blob * rc;
    assert( pMan->nBuf > pMan->cursor );
    rc = pMan->aBuf[pMan->cursor];
    pMan->aBuf[pMan->cursor] = NULL;
    pMan->interp->pVtab = pMan->aVtab[pMan->cursor];
    pMan->aVtab[pMan->cursor] = NULL;
    if(-1 == --pMan->cursor){
      Th_Free( pMan->interp, pMan->aBuf );
      Th_Free( pMan->interp, pMan->aVtab );
      *pMan = Th_Ob_Man_empty;
    }
    /*fprintf(stderr,"OB pop: %p level=%d\n", rc, pMan->cursor-1);*/
    return rc;
  }
}

/*
** TH Syntax:
**
** ob clean
**
** Erases any currently buffered contents but does not modify
** the buffering level.
*/
static int ob_clean_command( Th_Interp *interp, void *ctx,
                             int argc,  const char **argv, int *argl
){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b;
  assert( pMan && (interp == pMan->interp) );
  b = pMan ? Th_ob_current(pMan) : NULL;
  if(!b){
    Th_ErrorMessage( interp, "Not currently buffering.", NULL, 0 );
    return TH_ERROR;
  }else{
    blob_reset(b);
  }
  return TH_OK;
}

/*
** TH Syntax:
**
** ob end
**
** Erases any currently buffered contents and pops the current buffer
** from the stack.
*/
static int ob_end_command( Th_Interp *interp, void *ctx,
                           int argc,  const char **argv, int *argl ){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b;
  assert( pMan && (interp == pMan->interp) );
  b = Th_ob_pop(pMan);
  if(!b){
    Th_ErrorMessage( interp, "Not currently buffering.", NULL, 0 );
    return TH_ERROR;
  }else{
    blob_reset(b);
    Th_Free( interp, b );
  }
  return TH_OK;
}

/*
** TH Syntax:
**
** ob flush
**
** UNTESTED! Maybe not needed.
**
** Briefly reverts the output layer to the next-lower
** level, flushes the current buffer to that output layer,
** and clears out the current buffer. Does not change the
** buffering level.
*/
static int ob_flush_command( Th_Interp *interp, void *ctx,
                             int argc,  const char **argv, int *argl ){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b = NULL;
  Th_Vtab * oldVtab;
  assert( pMan && (interp == pMan->interp) );
  b = Th_ob_current(pMan);
  if( NULL == b ){
    Th_ErrorMessage( interp, "Not currently buffering.", NULL, 0 );
    return TH_ERROR;
  }
  oldVtab = interp->pVtab;
  interp->pVtab = pMan->aVtab[pMan->cursor];
  Th_output( interp, blob_str(b), b->nUsed );
  interp->pVtab = oldVtab;
  blob_reset(b);
  return TH_OK;
}

/*
** TH Syntax:
**
** ob get ?clean|end?
**
** Fetches the contents of the current buffer level.  If either
** 'clean' or 'end' are specified then the effect is as if "ob clean"
** or "ob end", respectively, are called after fetching the
** value. Calling "ob get end" is functionality equivalent to "ob get"
** followed by "ob end".
*/
static int ob_get_command( Th_Interp *interp, void *ctx,
                           int argc,  const char **argv, int *argl){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b = NULL;
  assert( pMan && (interp == pMan->interp) );
  b = Th_ob_current(pMan);
  if( NULL == b ){
2940
2941
2942
2943
2944
2945
2946
























2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964








2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977

2978
2979
2980
2981
2982
2983
2984
2985

2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
        rc |= ob_end_command(interp, ctx, argc-1, argv+1, argl+1);
      }
    }
    return rc;
  }
}

























static int ob_start_command( Th_Interp *interp, void *ctx,
                             int argc,  const char **argv, int *argl
){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b = NULL;
  int rc;
  assert( pMan && (interp == pMan->interp) );
  rc = Th_ob_push(pMan, &b);
  if( TH_OK != rc ){
    assert( NULL == b );
    return rc;
  }
  assert( NULL != b );
  /*fprintf(stderr,"OB STARTED: %p level=%d\n", b, pMan->cursor);*/
  Th_SetResultInt( interp, pMan->cursor );
  return TH_OK;
}









static int ob_cmd(
  Th_Interp *interp, 
  void *ignored, 
  int argc, 
  const char **argv, 
  int *argl
){
  static Th_Ob_Man * pMan = &Th_Ob_Man_instance;
  Th_SubCommand aSub[] = {
    { "clean",     ob_clean_command },
    { "end",       ob_end_command },
    { "flush",     ob_flush_command },
    { "get",       ob_get_command },

    { "start",     ob_start_command },
    { 0, 0 }
  };
  if(NULL == pMan->interp){
    pMan->interp = interp;
    /*
      FIXME: add rudamentary at-finalization GC to Th_Interp and clean
      this up there.

    */
  }
  return Th_CallSubCommand(interp, pMan, argc, argv, argl, aSub);
  
}

int th_register_ob(Th_Interp * interp){
  static Th_Command_Reg aCommand[] = {
    {"ob",    ob_cmd,   0},
    {0,0,0}
  };
  return Th_register_commands( interp, aCommand );
}
#undef OB_MALLOC
#undef OB_REALLOC
#undef OB_FREE
#endif
/* end TH_USE_OUTBUF */








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>














|



>
>
>
>
>
>
>
>













>







|
>













|
<
|



3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101

3102
3103
3104
3105
        rc |= ob_end_command(interp, ctx, argc-1, argv+1, argl+1);
      }
    }
    return rc;
  }
}

/*
** TH Syntax:
**
** ob level
**
** Returns the buffering level, where 0 means no buffering is
** active, 1 means 1 level is active, etc.
*/
static int ob_level_command( Th_Interp *interp, void *ctx,
                             int argc,  const char **argv, int *argl
){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Th_SetResultInt( interp, 1 + pMan->cursor );
  return TH_OK;
}

/*
** TH Syntax:
**
** ob start
**
** Pushes a new level of buffering onto the buffer stack.
** Returns the new buffering level (1-based).
*/
static int ob_start_command( Th_Interp *interp, void *ctx,
                             int argc,  const char **argv, int *argl
){
  Th_Ob_Man * pMan = (Th_Ob_Man *)ctx;
  Blob * b = NULL;
  int rc;
  assert( pMan && (interp == pMan->interp) );
  rc = Th_ob_push(pMan, &b);
  if( TH_OK != rc ){
    assert( NULL == b );
    return rc;
  }
  assert( NULL != b );
  /*fprintf(stderr,"OB STARTED: %p level=%d\n", b, pMan->cursor);*/
  Th_SetResultInt( interp, 1 + pMan->cursor );
  return TH_OK;
}

/*
** TH Syntax:
**
** ob clean|end|flush|get|level|start
**
** Runs the given subcommand.
** 
*/
static int ob_cmd(
  Th_Interp *interp, 
  void *ignored, 
  int argc, 
  const char **argv, 
  int *argl
){
  static Th_Ob_Man * pMan = &Th_Ob_Man_instance;
  Th_SubCommand aSub[] = {
    { "clean",     ob_clean_command },
    { "end",       ob_end_command },
    { "flush",     ob_flush_command },
    { "get",       ob_get_command },
    { "level",     ob_level_command },
    { "start",     ob_start_command },
    { 0, 0 }
  };
  if(NULL == pMan->interp){
    pMan->interp = interp;
    /*
      FIXME: add rudamentary at-finalization GC to Th_Interp and clean
      this up there. We currently leak only if the client does not
      close all buffering levels properly.
    */
  }
  return Th_CallSubCommand(interp, pMan, argc, argv, argl, aSub);
  
}

int th_register_ob(Th_Interp * interp){
  static Th_Command_Reg aCommand[] = {
    {"ob",    ob_cmd,   0},
    {0,0,0}
  };
  return Th_register_commands( interp, aCommand );
}


#undef Th_Ob_Man_empty_m
#endif
/* end TH_USE_OUTBUF */

Changes to src/th.h.
1
2
3
4
5
6
7
8
9


10
11
12
13
14
15
16
#include "config.h"

#define TH_USE_SQLITE
#ifdef TH_USE_SQLITE
#include "sqlite3.h"
#endif

/*
** TH_USE_OUTBUF, if defined, enables the "ob" family of functions.


*/
#define TH_USE_OUTBUF
/*#undef TH_USE_OUTBUF*/


/* This header file defines the external interface to the custom Scripting
** Language (TH) interpreter.  TH is very similar to TCL but is not an









>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#include "config.h"

#define TH_USE_SQLITE
#ifdef TH_USE_SQLITE
#include "sqlite3.h"
#endif

/*
** TH_USE_OUTBUF, if defined, enables the "ob" family of functions.
** They are functionally similar to PHP's ob_start(), ob_end(), etc.
** family of functions, providing output capturing/buffering.
*/
#define TH_USE_OUTBUF
/*#undef TH_USE_OUTBUF*/


/* This header file defines the external interface to the custom Scripting
** Language (TH) interpreter.  TH is very similar to TCL but is not an