base/chiark-tcl.h

   1 /*
   2  * base code for various Tcl extensions
   3  * Copyright 2006 Ian Jackson
   4  *
   5  * This program is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU General Public License as
   7  * published by the Free Software Foundation; either version 2 of the
   8  * License, or (at your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this library; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
  18  * 02110-1301, USA.
  19  */
  20
  21 #ifndef CHIARK_TCL_H
  22 #define CHIARK_TCL_H
  23
  24 #include <assert.h>
  25 #include <stdlib.h>
  26 #include <errno.h>
  27 #include <unistd.h>
  28 #include <fcntl.h>
  29 #include <limits.h>
  30 #include <sys/socket.h>
  31 #include <sys/uio.h>
  32 #include <sys/un.h>
  33 #include <arpa/inet.h>
  34
  35 #ifndef _TCL /* if someone already included some tcl.h, use that */
  36 #include <tcl.h>
  37 #endif /*_TCL*/
  38
  39 #include <adns.h>
  40
  41 typedef unsigned char Byte;
  42
  43 /* for assisting tcmdifgen and tcmdiflib.c */
  44
  45 typedef struct TopLevel_Command TopLevel_Command;
  46
  47 struct TopLevel_Command {
  48   const char *name;
  49   Tcl_ObjCmdProc *func;
  50 };
  51
  52 void cht_setstringresult(Tcl_Interp*, const char*);
  53 int cht_pat_enum(Tcl_Interp*, Tcl_Obj*, const void**,
  54                  const void*, size_t, const char *what);
  55
  56 /* from scriptinv.c */
  57
  58 typedef struct { /* opaque; comments are for scriptinv.c impl'n only */
  59   /* states:                Cancelled       Set                          */
  60   Tcl_Interp *ipq;     /*    0               valid, non-0, useable       */
  61   Tcl_Obj *script;     /*    0               valid, non-0                */
  62   Tcl_Obj *xargs;      /*    0               valid, may be 0             */
  63   int llen;            /*    undefined       llength of script + xargs   */
  64 } ScriptToInvoke;
  65
  66 void cht_scriptinv_init(ScriptToInvoke *si); /* undefined -> Cancelled */
  67 int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
  68                       Tcl_Obj *newscript, Tcl_Obj *xargs);
  69   /* Cancelled/Set -> Set (newscript!=0, ok) / Cancelled (otherwise) */
  70 void cht_scriptinv_cancel(ScriptToInvoke *si);
  71   /* Cancelled/Set -> Cancelled.  No separate free function - just cancel. */
  72 #define cht_scriptinv_interp(si) ((si)->ipq)
  73   /* int cht_scriptinv_interp(ScriptToInvoke *si);  returns 0 if Cancelled */
  74
  75 int cht_scriptinv_invoke_fg(ScriptToInvoke *si, int argc,
  76                             Tcl_Obj *const *argv);
  77   /* is a no-op if Cancelled rather than Set */
  78   /* if script fails, returns that error */
  79
  80 void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
  81   /* if script fails, reports it with Tcl_BackgroundError */
  82
  83 /* from idtable.c */
  84
  85 typedef struct {
  86   const char *valprefix, *assockey;
  87   void (*destroyitem)(Tcl_Interp *ip, void *val);
  88 } IdDataSpec;
  89
  90 /* The stored struct must start with a single int, conventionally
  91  * named `ix'.  When the struct is returned for the first time ix must
  92  * be -1; on subsequent occasions it must be >=0.  ix will be -1 iff
  93  * the struct is registered by the iddatatable machinery. */
  94
  95 extern Tcl_ObjType cht_tabledataid_nearlytype;
  96 int cht_tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds);
  97 void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds);
  98   /* call this when you destroy the struct, to remove its name;
  99    * _disposing is idempotent */
 100
 101 /* from hook.c */
 102
 103 int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec);
 104 int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m);
 105 int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
 106 void cht_objfreeir(Tcl_Obj *o);
 107 int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l);
 108
 109 void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...);
 110   /* const char*, size_t, const char*, size_t, ..., (const char*)0 */
 111 void cht_obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
 112 void cht_obj_updatestr_string(Tcl_Obj *o, const char *str);
 113
 114 void cht_prepare__basic(Tcl_Interp *ip);
 115 void cht_setup__commands(Tcl_Interp *ip, const TopLevel_Command *cmds);
 116   /* ... for use by CHT_INIT and CHTI_... macros only */
 117
 118 /* from parse.c */
 119
 120 typedef struct {
 121   Tcl_Obj *obj, *var;
 122   int copied;
 123 } Something_Var;
 124
 125 void cht_init_somethingv(Something_Var *sth);
 126 void cht_fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth);
 127 int cht_pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
 128                    Something_Var *sth, Tcl_ObjType *type);
 129
 130 /* from enum.c */
 131
 132 extern Tcl_ObjType cht_enum_nearlytype;
 133 extern Tcl_ObjType cht_enum1_nearlytype;
 134
 135 const void *cht_enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
 136                                     const void *firstentry, size_t entrysize,
 137                                     const char *what);
 138 #define enum_lookup_cached(ip,o,table,what)                     \
 139     (cht_enum_lookup_cached_func((ip),(o),                              \
 140                              &(table)[0],sizeof((table)[0]),    \
 141                              (what)))
 142   /* table should be a pointer to an array of structs of size
 143    * entrysize, the first member of which should be a const char*.
 144    * The table should finish with a null const char *.
 145    * On error, 0 is returned and the ip->result will have been
 146    * set to the error message.
 147    */
 148
 149 int cht_enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
 150                              const char *opts, const char *what);
 151   /* -1 => error */
 152
 153 /* useful macros */
 154
 155 #define TALLOC(s) ((void*)Tcl_Alloc((s)))
 156 #define TFREE(f) (Tcl_Free((void*)(f)))
 157 #define TREALLOC(p,l) ((void*)Tcl_Realloc((void*)(p),(l)))
 158
 159 /* macros for Chiark_tcl_FOOBAR_Init et al */
 160
 161   /*
 162    * use these macros like this:
 163    *    CHT_INIT(<extbase>,
 164    *             <preparations>,
 165    *             <results>)
 166    * where
 167    *
 168    *   <extbase> is the short name eg `hbytes'
 169    *     and should correspond to EXTBASE from the Makefile.
 170    *
 171    *   <results> are the initialisations which cause new commands
 172    *     etc. to appear in the Tcl namespace.  Eg, CHTI_COMMANDS,
 173    *     These initialisations are called only when a Tcl `load'
 174    *     command loads this extension.
 175    *
 176    *   <preparations> are the initialisations that we need but which
 177    *     do not interfere with the Tcl namespaces.  For example,
 178    *     OBJECT types we used (CHTI_TYPE), and other chiark_tcl
 179    *     extensions (CHTI_OTHER).  These initialisations are called
 180    *     both as a result of Tcl `load' (before the <results>
 181    *     initialisations) and also when another extension declares a
 182    *     dependency on this one with CHTI_OTHER.
 183    *
 184    *   Both <results> and <preparations> are whitespace-separated
 185    *   lists of calls to CHTI_... macros.  If the list is to be empty,
 186    *   write `{ }' instead to prevent an empty macro argument.  The
 187    *   preparations and results currently supported are:
 188    *
 189    *      CHTI_COMMANDS(cht_<somethingtoplevel>_entries)
 190    *          where the .tct file contains
 191    *            Table *<somethingtoplevel> TopLevel_Command
 192    *
 193    *      CHTI_OTHER(<extbase-of-underlying-extension>)
 194    *          which does the <preparations> of that extension
 195    *          (if they have not already been done).
 196    *
 197    *      CHTI_TYPE(cht_<something>_type)
 198    *          where   extern Tcl_ObjType cht_<something>_type;
 199    *          Note that CHTI_TYPE should only be called by the
 200    *          extension which actually implements the type.  Other
 201    *          extensions which need it should use CHTI_OTHER to bring
 202    *          in the implementing extension.
 203    */
 204
 205 #define CHT_INIT(e, preparations, results)                                   \
 206   extern void cht_prepare_##e(Tcl_Interp *ip);                               \
 207   void cht_prepare_##e(Tcl_Interp *ip) {                                     \
 208     static int prepared;                                                     \
 209     if (prepared) return;                                                    \
 210     cht_prepare__basic(ip);                                                  \
 211     { preparations }                                                         \
 212     prepared= 1;                                                             \
 213   }                                                                          \
 214   extern int Chiark_tcl_##e##_Init(Tcl_Interp *ip); /*called by load(3tcl)*/ \
 215   int Chiark_tcl_##e##_Init(Tcl_Interp *ip) {                                \
 216     static int initd;                                                        \
 217     if (initd) return TCL_OK;                                                \
 218     cht_prepare_##e(ip);                                                     \
 219     { results }                                                              \
 220     initd= 1;                                                                \
 221     return TCL_OK;                                                           \
 222   }
 223
 224 #define CHTI_OTHER(e)                                                    \
 225   { extern void cht_prepare_##e(Tcl_Interp *ip); cht_prepare_##e(ip); }
 226
 227 #define CHTI_TYPE(ot)      { Tcl_RegisterObjType(&(ot)); }
 228
 229 #define CHTI_COMMANDS(cl)  { cht_setup__commands(ip,cl); }
 230
 231 #endif /*CHIARK_TCL_H*/