new initialisation arrangements are sane and consistent

diff --git a/adns/adns.c b/adns/adns.c
index 6405f0016d103f7b5643fb7a077a82e535f4fb09..53a1b01b61ae452ea91eea08dc5d6b23c2d547ad 100644 (file)
--- a/adns/adns.c
+++ b/adns/adns.c
@@ -812,7 +812,4 @@ int cht_do_adnstoplevel_adns(ClientData cd, Tcl_Interp *ip,
   return subcmd->func(0,ip,objc,objv);
 }
 
   return subcmd->func(0,ip,objc,objv);
 }
 

-extern int Chiark_tcl_adns_Init(Tcl_Interp *ip); /* called by Tcl's "load" */
-int Chiark_tcl_adns_Init(Tcl_Interp *ip) {
-  return cht_initextension(ip, cht_adnstoplevel_entries, 0);
-}
+CHT_INIT(adns, {}, CHTI_COMMANDS(cht_adnstoplevel_entries))

diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h
index 2f80d58172904c0eea95e3feef49fe1e04e294da..a8f399db9e9752781128edc1b60575843d88574f 100644 (file)
--- a/base/chiark-tcl.h
+++ b/base/chiark-tcl.h
@@ -97,10 +97,6 @@ void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds
 
 /* from hook.c */
 
 
 /* from hook.c */
 

-int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
-                     int *donep /* or 0, meaning no types follow */,
-                     ... /* types, terminated by 0 */);
-

 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);
 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);


@@ -116,6 +112,10 @@ void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...);
 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);
 
 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);
 

+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 */
+

 /* from parse.c */
 
 typedef struct {
 /* from parse.c */
 
 typedef struct {


@@ -157,4 +157,75 @@ int cht_enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
 #define TFREE(f) (Tcl_Free((void*)(f)))
 #define TREALLOC(p,l) ((void*)Tcl_Realloc((void*)(p),(l)))
 
 #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.
+   */
+
+#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*/
 #endif /*CHIARK_TCL_H*/

diff --git a/base/hook.c b/base/hook.c
index acd708a91f5cb92e2910e1656881300e9a9b7f32..e0b16d4fac762d7feb2ddb59948f63b89d7917be 100644 (file)
--- a/base/hook.c
+++ b/base/hook.c
@@ -102,34 +102,21 @@ int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
   }
 }
 
   }
 }
 

-int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
-                       int *donep /* or 0, meaning no types follow */,
-                       ... /* types, terminated by 0 */) {
-  static int cht_initd;
+void cht_prepare__basic(Tcl_Interp *ip) {
+  static int prepared;
+
+  if (prepared) return;
+  Tcl_RegisterObjType(&cht_tabledataid_nearlytype);
+  Tcl_RegisterObjType(&cht_enum_nearlytype);
+  Tcl_RegisterObjType(&cht_enum1_nearlytype);
+  prepared= 1;
+}

 
 

+void cht_setup__commands(Tcl_Interp *ip, const TopLevel_Command *cmds) {

   const TopLevel_Command *cmd;
   const TopLevel_Command *cmd;

-  Tcl_ObjType *ot;
-
-  va_list al;
-
-  if (!cht_initd) {
-    cht_initd= 1;
-    Tcl_RegisterObjType(&cht_tabledataid_nearlytype);
-    Tcl_RegisterObjType(&cht_enum_nearlytype);
-    Tcl_RegisterObjType(&cht_enum1_nearlytype);
-  }
-
-  if (donep && !*donep) {
-    *donep= 1;
-    va_start(al, donep);
-    while ((ot= va_arg(al, Tcl_ObjType*)))
-      Tcl_RegisterObjType(ot);
-  }
-
+  

   for (cmd= cmds;
        cmd->name;
        cmd++)
     Tcl_CreateObjCommand(ip, (char*)cmd->name, cmd->func, 0,0);
   for (cmd= cmds;
        cmd->name;
        cmd++)
     Tcl_CreateObjCommand(ip, (char*)cmd->name, cmd->func, 0,0);

-
-  return TCL_OK;

 }
 }

diff --git a/cdb/lookup.c b/cdb/lookup.c
index 6245384eed1c8c66d9c4543a3227ffde867a4a9e..50d5598a3ff20fa719432419d7000121ed580b66 100644 (file)
--- a/cdb/lookup.c
+++ b/cdb/lookup.c
@@ -62,8 +62,6 @@ int cht_cdb_lookup_cdb(Tcl_Interp *ip, struct cdb *cdb,
   return TCL_OK;
 }
 
   return TCL_OK;
 }
 

-
-extern int Chiark_tcl_cdb_Init(Tcl_Interp *ip); /* called by Tcl's "load" */
-int Chiark_tcl_cdb_Init(Tcl_Interp *ip) {
-  return cht_initextension(ip, cht_cdbtoplevel_entries, 0);
-}
+CHT_INIT(cdb,
+        CHTI_OTHER(hbytes),
+        CHTI_COMMANDS(cht_cdbtoplevel_entries))

diff --git a/crypto/hook.c b/crypto/hook.c
index f8c567fe4dfc65da87412cee6fc31a95c3e73f5b..17aefc38ab60d262b1ef2b6e2bae650e48171536 100644 (file)
--- a/crypto/hook.c
+++ b/crypto/hook.c
@@ -27,16 +27,6 @@ int cht_do_hbcryptotoplevel_hbcrypto(ClientData cd, Tcl_Interp *ip,
   return subcmd->func(0,ip,objc,objv);
 }
 
   return subcmd->func(0,ip,objc,objv);
 }
 

-extern int Chiark_tcl_crypto_Init(Tcl_Interp *ip); /*called by load(3tcl)*/
-int Chiark_tcl_crypto_Init(Tcl_Interp *ip) {
-  static int initd;
-  int rc;
-
-  rc= Chiark_tcl_hbytes_Init(ip);  if (rc) return rc;
-  rc= cht_initextension(ip, cht_hbcryptotoplevel_entries, &initd,
-                       &cht_blockcipherkey_type,
-                       (Tcl_ObjType*)0);
-  if (rc) return rc;
-
-  return TCL_OK;
-}
+CHT_INIT(crypto,
+        CHTI_OTHER(hbytes)  CHTI_TYPE(cht_blockcipherkey_type),
+        CHTI_COMMANDS(cht_hbcryptotoplevel_entries))

diff --git a/hbytes/hook.c b/hbytes/hook.c
index f3817ffe20d44de9c22029b270e554d650f0e44a..a2198866b773bed905fbe68294a5c7bcefdef574 100644 (file)
--- a/hbytes/hook.c
+++ b/hbytes/hook.c
@@ -328,11 +328,6 @@ int cht_do_hbytestoplevel_ulong(ClientData cd, Tcl_Interp *ip,
   return subcmd->func(0,ip,objc,objv);
 }
 
   return subcmd->func(0,ip,objc,objv);
 }
 

-int Chiark_tcl_hbytes_Init(Tcl_Interp *ip) {
-  static int initd;
-  
-  return cht_initextension(ip, cht_hbytestoplevel_entries, &initd,
-                          &cht_hbytes_type,
-                          &cht_ulong_type,
-                          (Tcl_ObjType*)0);
-}
+CHT_INIT(hbytes,
+        CHTI_TYPE(cht_hbytes_type) CHTI_TYPE(cht_ulong_type),
+        CHTI_COMMANDS(cht_hbytestoplevel_entries))