From: ian Date: Sun, 2 Apr 2006 13:35:26 +0000 (+0000) Subject: new initialisation arrangements are sane and consistent X-Git-Tag: debian/1.1.1~53 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl.git;a=commitdiff_plain;h=dea4e335a78d52ed5f4b71908aa8fcbf392e96be new initialisation arrangements are sane and consistent --- diff --git a/adns/adns.c b/adns/adns.c index 6405f00..53a1b01 100644 --- 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); } -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 2f80d58..a8f399d 100644 --- 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 */ -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); @@ -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_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 { @@ -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))) +/* macros for Chiark_tcl_FOOBAR_Init et al */ + + /* + * use these macros like this: + * CHT_INIT(, + * , + * ) + * where + * + * is the short name eg `hbytes' + * and should correspond to EXTBASE from the Makefile. + * + * 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. + * + * 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 + * initialisations) and also when another extension declares a + * dependency on this one with CHTI_OTHER. + * + * Both and 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__entries) + * where the .tct file contains + * Table * TopLevel_Command + * + * CHTI_OTHER() + * which does the of that extension + * (if they have not already been done). + * + * CHTI_TYPE(cht__type) + * where extern Tcl_ObjType cht__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*/ diff --git a/base/hook.c b/base/hook.c index acd708a..e0b16d4 100644 --- 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; - 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); - - return TCL_OK; } diff --git a/cdb/lookup.c b/cdb/lookup.c index 6245384..50d5598 100644 --- 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; } - -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 f8c567f..17aefc3 100644 --- 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); } -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 f3817ff..a219886 100644 --- 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); } -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))