From a43cdb5c69224a60f9e87110093e35a0f1f0b468 Mon Sep 17 00:00:00 2001 From: ian Date: Mon, 5 Jan 2004 22:49:36 +0000 Subject: [PATCH] document tcmdifgen (and split from app, in theory) --- base/parse.c | 25 --------- base/tables-examples.tct | 2 + base/tcmdifgen | 118 ++++++++++++++++++++++++++++++++++++++- base/tcmdiflib.c | 29 ++++++++++ base/tcmdiflib.h | 2 + base/troglodyte-Makefile | 1 + hbytes/parse.c | 25 --------- 7 files changed, 150 insertions(+), 52 deletions(-) create mode 100644 base/tcmdiflib.c create mode 100644 base/tcmdiflib.h diff --git a/base/parse.c b/base/parse.c index 539f074..911cadd 100644 --- a/base/parse.c +++ b/base/parse.c @@ -10,18 +10,6 @@ int pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val, return TCL_OK; } -int pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val, - const void *opts, size_t sz, const char *what) { - *val= enum_lookup_cached_func(ip,obj,opts,sz,what); - if (!*val) return TCL_ERROR; - return TCL_OK; -} - -int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) { - *val= obj; - return TCL_OK; -} - int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) { return Tcl_GetIntFromObj(ip, obj, val); } @@ -86,10 +74,6 @@ Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) { return obj; } -Tcl_Obj *ret_int(Tcl_Interp *ip, int val) { - return Tcl_NewIntObj(val); -} - Tcl_Obj *ret_long(Tcl_Interp *ip, long val) { return Tcl_NewLongObj(val); } @@ -97,12 +81,3 @@ Tcl_Obj *ret_long(Tcl_Interp *ip, long val) { Tcl_Obj *ret_string(Tcl_Interp *ip, const char *val) { return Tcl_NewStringObj(val,-1); } - -Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) { - return val; -} - -void setstringresult(Tcl_Interp *ip, const char *m) { - Tcl_ResetResult(ip); - Tcl_AppendResult(ip, m, (char*)0); -} diff --git a/base/tables-examples.tct b/base/tables-examples.tct index f8d44ef..1042378 100644 --- a/base/tables-examples.tct +++ b/base/tables-examples.tct @@ -13,6 +13,8 @@ Type ulong: uint32_t @ Type long: long @ Type string: const char *@ +Type charfrom(const char *opts, const char *what): int + H-Include "hbytes.h" Table toplevel TopLevel_Command diff --git a/base/tcmdifgen b/base/tcmdifgen index 5cd076e..da9832d 100755 --- a/base/tcmdifgen +++ b/base/tcmdifgen @@ -1,5 +1,121 @@ #!/usr/bin/perl +# Input format is line-based, ws-significant, offside rule (some kind +# of, anyway). +# +# Type TYPE: C-TYPE-DECLARATOR +# Defines TYPE as a type (for arguments and return values) +# which corresponds to the C type specified. C-TYPE-DECLARATOR +# must contain one `@' where the identifier would go. +# The type may contain allocated memory, etc., in which case +# `Init' and `Fini' must be used. +# +# TYPE may be either TYPENAME or TYPENAME(ARGS) - in this case, +# ARGS should be C argument declarations as for in a function +# prototype, of extra arguments for the application-supplied +# parser/returner functions. Each time a TYPE is used elsewhere, +# the ARGS should be the actual arguments to pass, and will be +# textually copied into the calls to the parser/returner +# functions. +# +# `Type' causes declarations in the .h file of these functions: +# int pat_TYPENAME(Tcl_Interp*, Tcl_Obj *obj, C-TYPE *val, ARGS); +# Tcl_Obj *ret_TYPENAME(Tcl_Interp*, C-TYPE val, ARGS); +# +# pat_... must attempt to parse obj into the appropriate type. +# val will already have been initialised with `Init' statements if +# relevant. Whether pat_... fails or succeeds it may allocate +# memory into the object and must leave the object valid (for +# `Fini'). +# +# ret_... must convert the value back to a new Tcl_Obj. It may +# not fail. +# +# Init TYPENAME C-STATEMENTS +# Provides some statements which are used to initialise a variable +# of type TYPENAME. C-STATEMENTS should contain one or more `@', +# which will be replaced by the actual variable name. The +# variable will have been declared with the C declarator specified +# with `Type'. C-STATEMENTS may not fail or longjmp, and they may +# not allocate memory or other resources. If no `Init' is +# supplied then there is no invariant (so no `Fini' may be +# supplied either, and the type is `flat' - no memory, external +# refs, etc.) +# +# Fini TYPENAME C-STATEMENTS +# Provides some statements (like `Init') which are used to free a +# variable of type TYPENAME. The variable will already have been +# initialised with the `Init' statements, and may have been +# modified since by application per-type or per-command code. Its +# invariant will be satisfied before C-STATEMENTS. Afterwards the +# invariant may or may not be satisfied, but it may not have any +# memory or other resources allocated. C-STATEMENTS may not fail +# or longjmp. +# +# H-Include C-INCLUDE-SPECIFIER +# Arranges for generated .h files to #include the specified +# file. C-INCLUDE-SPECIFIER should include the <..> or "..". +# +# Table TABLENAME C-ENTRY-TYPE +# Starts a table of commands or subcommands. The generated .h +# will contain a definition of C-ENTRY-TYPE containing +# const char *name; +# Tcl_ObjCmdProc *func; +# and the generated .c will contain +# const C-ENTRY-TYPE C-ARRAY-NAME[]; +# where C-ARRAY-NAME is C-ENTRY-TYPE lowercased, with +# `s' appended. The entries are indented one level (one +# or more spaces) and look like this: +# ENTRYNAME +# FORMALARGNAME TYPE +# ... +# [ => RESULT-TYPE ] +# This will cause the declaration of +# int do_TABLENAME_ENTRYNAME(ClientData cd, Tcl_Interp *ip, +# FORMAL-ARGUMENTS, RESULT-C-TYPE*); +# which is the procedure which the application must supply to +# implement the function. If the `=> RESULT-TYPE' is omitted, so +# is the result argument to the function. Each argument to the +# function is of the C type corresponding to the specified type. +# The do_... function should not eat any memory associated with +# the arguments. The result buffer (if any) will be initialised +# using the `Init' and should on success contain the relevant +# result. On failure it should leave the result unmodified (or at +# least, not in need of freeing). +# +# There will be an entry in C-ARRAY-NAME for every table entry. +# The name will be ENTRYNAME, and the func will be a function +# suitable for use as a Tcl command procedure, which parses the +# arguments, processes the command, and sets any result, as +# applicable. +# +# ExtraEntry C-ENTRY-TYPE +# Introduces a section of additional C code which will be inserted +# into the definition of C-ENTRY-TYPE by `Table'. The C +# code, which follows on several indented lines, should be +# structure member definitions. +# +# When ExtraEntry is used, in the corresponding Table, each +# ENTRYNAME should be followed on the same line by whitespace and +# EXTRA-VALUES; the EXTRA-VALUES are used as initialisers for the +# additional structure elements. +# +# Also declared are these functions: +# void setstringresult(Tcl_Interp*, const char*); +# sets the Tcl result from the supplied string +# int pat_enum(Tcl_Interp*, Tcl_Obj*, const void **c_e_t_array, +# const void *c_e_t_return, size_t c_e_t_sz, const char *what); +# scans a table of C-ENTRY-TYPEs looking for the +# string matching the string supplied by the script +# (as a Tcl_Obj). On error sets the result, using +# what (a noun phrase describing the type of thing). +# Assumes (unportably!) that the name and func members +# are in the same places no matter what the rest of +# the struct contains. +# and the two predefined types `int' (C `int') and `obj' (Tcl_Obj*, +# unmodified.) The corresponding definitions are in tcmdiflib.c +# which #includes "tcmdiflib.h" (not supplied). + use IO; use Data::Dumper; @@ -389,5 +505,3 @@ sub badsyntax ($$$) { __DATA__ Type int: int Type obj: Tcl_Obj *@ - -Type charfrom(const char *opts, const char *what): int diff --git a/base/tcmdiflib.c b/base/tcmdiflib.c new file mode 100644 index 0000000..8bddc02 --- /dev/null +++ b/base/tcmdiflib.c @@ -0,0 +1,29 @@ +/* + */ + +#include "tcmdiflib.h" + +int pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val, + const void *opts, size_t sz, const char *what) { + *val= enum_lookup_cached_func(ip,obj,opts,sz,what); + if (!*val) return TCL_ERROR; + return TCL_OK; +} + +int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) { + *val= obj; + return TCL_OK; +} + +Tcl_Obj *ret_int(Tcl_Interp *ip, int val) { + return Tcl_NewIntObj(val); +} + +Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) { + return val; +} + +void setstringresult(Tcl_Interp *ip, const char *m) { + Tcl_ResetResult(ip); + Tcl_AppendResult(ip, m, (char*)0); +} diff --git a/base/tcmdiflib.h b/base/tcmdiflib.h new file mode 100644 index 0000000..0944e20 --- /dev/null +++ b/base/tcmdiflib.h @@ -0,0 +1,2 @@ +#include "tables.h" +#include "hbytes.h" diff --git a/base/troglodyte-Makefile b/base/troglodyte-Makefile index 9e5618a..1819d87 100644 --- a/base/troglodyte-Makefile +++ b/base/troglodyte-Makefile @@ -1,4 +1,5 @@ OBJS= tables.o \ + tcmdiflib.o \ hbytes.o \ enum.o \ idtable.o \ diff --git a/hbytes/parse.c b/hbytes/parse.c index 539f074..911cadd 100644 --- a/hbytes/parse.c +++ b/hbytes/parse.c @@ -10,18 +10,6 @@ int pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val, return TCL_OK; } -int pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val, - const void *opts, size_t sz, const char *what) { - *val= enum_lookup_cached_func(ip,obj,opts,sz,what); - if (!*val) return TCL_ERROR; - return TCL_OK; -} - -int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) { - *val= obj; - return TCL_OK; -} - int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) { return Tcl_GetIntFromObj(ip, obj, val); } @@ -86,10 +74,6 @@ Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) { return obj; } -Tcl_Obj *ret_int(Tcl_Interp *ip, int val) { - return Tcl_NewIntObj(val); -} - Tcl_Obj *ret_long(Tcl_Interp *ip, long val) { return Tcl_NewLongObj(val); } @@ -97,12 +81,3 @@ Tcl_Obj *ret_long(Tcl_Interp *ip, long val) { Tcl_Obj *ret_string(Tcl_Interp *ip, const char *val) { return Tcl_NewStringObj(val,-1); } - -Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) { - return val; -} - -void setstringresult(Tcl_Interp *ip, const char *m) { - Tcl_ResetResult(ip); - Tcl_AppendResult(ip, m, (char*)0); -} -- 2.30.2