chiark / gitweb /
Update default TCL_VERSION to 8.5
[chiark-tcl.git] / base / chiark-tcl.h
index f136758fdfe8be32f4d29235cbf45297588887c1..2f4ae7d5f3c5ea37f62e714d5e82494010523719 100644 (file)
 /*
- */
-/*
- *  hbytes raw2h BINARY                          => hex
- *  hbytes h2raw HEX                             => binary
- *
- *  hbytes prefix VAR [VALUE ...]         = set VAR [concat VALUE ... $VAR]
- *  hbytes append VAR [VALUE ...]         = set VAR [concat $VAR VALUE ...]
- *  hbytes concat VAR [VALUE ...]         = set VAR [concat VALUE ...]
- *  hbytes unprepend VAR PREFIXLENGTH            => prefix (removed from VAR)
- *  hbytes unappend VAR SUFFIXLENGTH             => suffix (removed from VAR)
- *  hbytes chopto VAR NEWVARLENGTH               => suffix (removed from VAR)
- *                                                  (too short? error)
+ * base code for various Tcl extensions
+ * Copyright 2006-2012 Ian Jackson
  *
- *  hbytes pkcs5 pa|ua VAR ALG                   => worked?  (always 1 for p)
- *  hbytes pkcs5 pn|un VAR BLOCKSIZE             => worked?  (always 1 for p)
- *  hbytes blockcipher d|e VAR ALG MODE [IV]     => IV
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version.
  *
- *  hbytes hash ALG MESSAGE                      => hash
- *  hbytes hmac ALG MESSAGE KEY [MACLENGTH]      => mac
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
  *
- * Refs: HMAC: RFC2104
+ * You should have received a copy of the GNU General Public License
+ * along with this library; if not, see <http://www.gnu.org/licenses/>.
  */
 
-#ifndef HBYTES_H
-#define HBYTES_H
+#ifndef CHIARK_TCL_H
+#define CHIARK_TCL_H
 
 #include <assert.h>
 #include <stdlib.h>
-
+#include <errno.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <limits.h>
+#include <sys/socket.h>
+#include <sys/uio.h>
+#include <sys/un.h>
+#include <arpa/inet.h>
+
+#ifndef _TCL /* if someone already included some tcl.h, use that */
 #include <tcl.h>
+#endif /*_TCL*/
+
+#include <adns.h>
 
 typedef unsigned char Byte;
 
-/* from hbytes.c */
+/* for assisting tcmdifgen and tcmdiflib.c */
+
+typedef struct TopLevel_Command TopLevel_Command;
+
+struct TopLevel_Command {
+  const char *name;
+  Tcl_ObjCmdProc *func;
+};
+
+void cht_setstringresult(Tcl_Interp*, const char*);
+int cht_pat_enum(Tcl_Interp*, Tcl_Obj*, const void**,
+                const void*, size_t, const char *what);
+
+/* from scriptinv.c */
+
+typedef struct { /* opaque; comments are for scriptinv.c impl'n only */
+  /* states:                Cancelled       Set                          */
+  Tcl_Interp *ipq;     /*    0               valid, non-0, useable       */
+  Tcl_Obj *script;     /*    0               valid, non-0                */
+  Tcl_Obj *xargs;      /*    0               valid, may be 0             */
+  int llen;            /*    undefined       llength of script + xargs   */
+} ScriptToInvoke;
+
+void cht_scriptinv_init(ScriptToInvoke *si); /* undefined -> Cancelled */
+int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
+                     Tcl_Obj *newscript, Tcl_Obj *xargs);
+  /* Cancelled/Set -> Set (newscript!=0, ok) / Cancelled (otherwise) */
+void cht_scriptinv_cancel(ScriptToInvoke *si);
+  /* Cancelled/Set -> Cancelled.  No separate free function - just cancel. */
+#define cht_scriptinv_interp(si) ((si)->ipq)
+  /* int cht_scriptinv_interp(ScriptToInvoke *si);  returns 0 if Cancelled */
+
+int cht_scriptinv_invoke_fg(ScriptToInvoke *si, int argc,
+                           Tcl_Obj *const *argv);
+  /* is a no-op if Cancelled rather than Set */
+  /* if script fails, returns that error */
+
+void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
+  /* if script fails, reports it with Tcl_BackgroundError */
+
+/* from idtable.c */
 
 typedef struct {
-  Byte *start, *end; /* always allocated dynamically */
-} HBytes_Value; /* overlays internalRep */
+  const char *valprefix, *assockey;
+  void (*destroyitem)(Tcl_Interp *ip, void *val);
+} IdDataSpec;
+
+/* The stored struct must start with a single int, conventionally
+ * named `ix'.  When the struct is returned for the first time ix must
+ * be -1; on subsequent occasions it must be >=0.  ix will be -1 iff
+ * the struct is registered by the iddatatable machinery. */
+
+extern Tcl_ObjType cht_tabledataid_nearlytype;
+int cht_tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds);
+void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds);
+  /* call this when you destroy the struct, to remove its name;
+   * _disposing is idempotent */
+
+/* from hook.c */
+
+int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec);
+int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m);
+int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
+void cht_objfreeir(Tcl_Obj *o);
+int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l);
 
-extern Tcl_ObjType hbytes_type;
+void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...);
+  /* const char*, size_t, const char*, size_t, ..., (const char*)0 */
+void cht_obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
+void cht_obj_updatestr_string(Tcl_Obj *o, const char *str);
 
-int staticerr(Tcl_Interp *ip, const char *m);
-void objfreeir(Tcl_Obj *o);
+void cht_prepare__basic(Tcl_Interp *ip);
+void cht_setup__commands(Tcl_Interp *ip, const TopLevel_Command *cmds);
+  /* ... for use by CHT_INIT and CHTI_... macros only */
 
-Tcl_Obj *hbytes_set(Tcl_Obj *overwrite, const Byte *array, int l);
+/* from parse.c */
+
+typedef struct {
+  Tcl_Obj *obj, *var;
+  int copied;
+} Something_Var;
+
+void cht_init_somethingv(Something_Var *sth);
+void cht_fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth);
+int cht_pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
+                  Something_Var *sth, Tcl_ObjType *type);
 
 /* from enum.c */
 
-extern Tcl_ObjType enum_nearlytype;
+extern Tcl_ObjType cht_enum_nearlytype;
+extern Tcl_ObjType cht_enum1_nearlytype;
 
-const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
-                                   size_t entrysize, const void *firstentry,
+const void *cht_enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+                                   const void *firstentry, size_t entrysize,
                                    const char *what);
 #define enum_lookup_cached(ip,o,table,what)                    \
-    (enum_lookup_cached_func((ip),(o),                         \
-                            sizeof((table)[0]),&(table)[0],    \
+    (cht_enum_lookup_cached_func((ip),(o),                             \
+                            &(table)[0],sizeof((table)[0]),    \
                             (what)))
   /* table should be a pointer to an array of structs of size
    * entrysize, the first member of which should be a const char*.
@@ -63,12 +144,86 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
    * set to the error message.
    */
 
-/* useful macros */
+int cht_enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+                            const char *opts, const char *what);
+  /* -1 => error */
 
-#define HBYTES(o) ((HBytes_Value*)&(o)->internalRep.twoPtrValue)
-#define HBYTES_LEN(o) (HBYTES((o))->end - HBYTES((o))->start)
+/* useful macros */
 
 #define TALLOC(s) ((void*)Tcl_Alloc((s)))
 #define TFREE(f) (Tcl_Free((void*)(f)))
+#define TREALLOC(p,l) ((void*)Tcl_Realloc((void*)(p),(l)))
+
+/* macros for Chiark_tcl_FOOBAR_Init et al */
+
+  /*
+   * use these macros like this:
+   *    CHT_INIT(<extbase>,
+   *             <preparations>,
+   *             <results>)
+   * where
+   *
+   *   <extbase> is the short name eg `hbytes'
+   *     and should correspond to EXTBASE from the Makefile.
+   *
+   *   <results> are the initialisations which cause new commands
+   *     etc. to appear in the Tcl namespace.  Eg, CHTI_COMMANDS,
+   *     These initialisations are called only when a Tcl `load'
+   *     command loads this extension.
+   *
+   *   <preparations> are the initialisations that we need but which
+   *     do not interfere with the Tcl namespaces.  For example,
+   *     OBJECT types we used (CHTI_TYPE), and other chiark_tcl
+   *     extensions (CHTI_OTHER).  These initialisations are called
+   *     both as a result of Tcl `load' (before the <results>
+   *     initialisations) and also when another extension declares a
+   *     dependency on this one with CHTI_OTHER.
+   *
+   *   Both <results> and <preparations> are whitespace-separated
+   *   lists of calls to CHTI_... macros.  If the list is to be empty,
+   *   write `{ }' instead to prevent an empty macro argument.  The
+   *   preparations and results currently supported are:
+   *
+   *      CHTI_COMMANDS(cht_<somethingtoplevel>_entries)
+   *          where the .tct file contains
+   *            Table *<somethingtoplevel> TopLevel_Command
+   *
+   *      CHTI_OTHER(<extbase-of-underlying-extension>)
+   *          which does the <preparations> of that extension
+   *          (if they have not already been done).
+   *
+   *      CHTI_TYPE(cht_<something>_type)
+   *          where   extern Tcl_ObjType cht_<something>_type;
+   *          Note that CHTI_TYPE should only be called by the
+   *          extension which actually implements the type.  Other
+   *          extensions which need it should use CHTI_OTHER to bring
+   *          in the implementing extension.
+   */
 
-#endif /*HBYTES_H*/
+#define CHT_INIT(e, preparations, results)                                  \
+  extern void cht_prepare_##e(Tcl_Interp *ip);                              \
+  void cht_prepare_##e(Tcl_Interp *ip) {                                    \
+    static int prepared;                                                    \
+    if (prepared) return;                                                   \
+    cht_prepare__basic(ip);                                                 \
+    { preparations }                                                        \
+    prepared= 1;                                                            \
+  }                                                                         \
+  extern int Chiark_tcl_##e##_Init(Tcl_Interp *ip); /*called by load(3tcl)*/ \
+  int Chiark_tcl_##e##_Init(Tcl_Interp *ip) {                               \
+    static int initd;                                                       \
+    if (initd) return TCL_OK;                                               \
+    cht_prepare_##e(ip);                                                    \
+    { results }                                                                     \
+    initd= 1;                                                               \
+    return TCL_OK;                                                          \
+  }
+
+#define CHTI_OTHER(e)                                                   \
+  { extern void cht_prepare_##e(Tcl_Interp *ip); cht_prepare_##e(ip); }
+
+#define CHTI_TYPE(ot)      { Tcl_RegisterObjType(&(ot)); }
+
+#define CHTI_COMMANDS(cl)  { cht_setup__commands(ip,cl); }
+
+#endif /*CHIARK_TCL_H*/