Index: kitsh/buildsrc/kitsh-0.0/Makefile.common.in ================================================================== --- kitsh/buildsrc/kitsh-0.0/Makefile.common.in +++ kitsh/buildsrc/kitsh-0.0/Makefile.common.in @@ -15,17 +15,17 @@ EXTRA_VFS_OBJS = @EXTRA_VFS_OBJS@ TCLSH_NATIVE = tclsh # Build targets ## VFS Build -vfs_kitdll_data_tcl.o: vfs_kitdll_data_tcl.c -vfs_kitdll_data_tcl.c: dir2c.tcl starpack.vfs vfs_kitdll_data.c - "$(TCLSH_NATIVE)" dir2c.tcl tcl starpack.vfs > vfs_kitdll_data_tcl.c +cvfs_data_tcl.o: cvfs_data_tcl.c +cvfs_data_tcl.c: dir2c.tcl starpack.vfs cvfs_data.c + "$(TCLSH_NATIVE)" dir2c.tcl tcl starpack.vfs > cvfs_data_tcl.c ## Tcl scripts that need to be converted to C headers -vfs_kitdll.tcl.h: vfs_kitdll.tcl - "$(TCLSH_NATIVE)" ./stringify.tcl vfs_kitdll.tcl > vfs_kitdll.tcl.h +cvfs.tcl.h: cvfs.tcl + "$(TCLSH_NATIVE)" ./stringify.tcl cvfs.tcl > cvfs.tcl.h boot.tcl.h: boot.tcl "$(TCLSH_NATIVE)" ./stringify.tcl boot.tcl > boot.tcl.h zipvfs.tcl.h: zipvfs.tcl @@ -44,21 +44,21 @@ # Cleanup routines clean: rm -f kit kit.res.o rm -f libtclkit@KITDLL_LIB_VERSION@.@SHOBJEXT@ rm -f $(OBJS) $(EXTRA_OBJS) $(EXTRA_VFS_OBJS) - rm -f vfs_kitdll_data_tcl.c - rm -f vfs_kitdll.tcl.h + rm -f cvfs_data_tcl.c cvfs_data_tcl.o + rm -f cvfs.tcl.h rm -f tclsh.o tclsh tclsh.exe rm -f wish.o wish wish.exe distclean: clean rm -f Makefile Makefile.in Makefile.common rm -f config.status config.log rm -f *~ - rm -rf autom4te.cache rm -rf starpack.vfs + rm -rf autom4te.cache mrproper: distclean rm -f configure config.h boot.tcl.h zipvfs.tcl.h .PHONY: all clean distclean mrproper Index: kitsh/buildsrc/kitsh-0.0/boot.tcl ================================================================== --- kitsh/buildsrc/kitsh-0.0/boot.tcl +++ kitsh/buildsrc/kitsh-0.0/boot.tcl @@ -72,18 +72,18 @@ seek $::tclKitStorage_fd 0 set vfsHandler [list ::vfs::zip::handler $::tclKitStorage_fd] unset ::tclKitStorage_fd } "cvfs" { - set vfsHandler [list ::vfs::kitdll::vfshandler tcl] + set vfsHandler [list ::vfs::cvfs::vfshandler tcl] # Load these, the original Tclkit does so it should be safe. foreach vfsfile [list vfsUtils vfslib] { unset -nocomplain s catch { - set s [::vfs::kitdll::data::getData tcl "lib/vfs/${vfsfile}.tcl"] + set s [::vfs::cvfs::data::getData tcl "lib/vfs/${vfsfile}.tcl"] } if {![info exists s]} { continue } Index: kitsh/buildsrc/kitsh-0.0/configure.ac ================================================================== --- kitsh/buildsrc/kitsh-0.0/configure.ac +++ kitsh/buildsrc/kitsh-0.0/configure.ac @@ -181,15 +181,15 @@ ], cvfs, [ AC_DEFINE([KIT_STORAGE_CVFS], [1], [Define if you are going to use C-VFS for kit storage]) dnl Define that C-VFS should be make [load]-able - AC_DEFINE([KITDLL_MAKE_LOADABLE], [1], [Specify that the C-VFS should be able to be loaded]) + AC_DEFINE([CVFS_MAKE_LOADABLE], [1], [Specify that the C-VFS should be able to be loaded]) dnl Add appropriate dependencies - EXTRA_KIT_DEPS="vfs_kitdll.tcl.h" - EXTRA_VFS_OBJS="${EXTRA_VFS_OBJS} vfs_kitdll_data_tcl.o" + EXTRA_KIT_DEPS="cvfs.tcl.h" + EXTRA_VFS_OBJS="${EXTRA_VFS_OBJS} cvfs_data_tcl.o" ] ) AC_SUBST(EXTRA_KIT_DEPS) ADDED kitsh/buildsrc/kitsh-0.0/cvfs.tcl Index: kitsh/buildsrc/kitsh-0.0/cvfs.tcl ================================================================== --- /dev/null +++ kitsh/buildsrc/kitsh-0.0/cvfs.tcl @@ -0,0 +1,335 @@ +#! /usr/bin/env tcl + +package require vfs + +namespace eval ::vfs::cvfs {} + +# Convience functions +proc ::vfs::cvfs::Mount {hashkey local} { + vfs::filesystem mount $local [list ::vfs::cvfs::vfshandler $hashkey] + catch { + vfs::RegisterMount $local [list ::vfs::cvfs::Unmount] + } +} + +proc ::vfs::cvfs::Unmount {local} { + vfs::filesystem unmount $local +} + +# Implementation +## I/O Handlers (pass to appropriate hashkey) +namespace eval ::vfs::cvfs::data {} +proc ::vfs::cvfs::data::getChildren args { + set hashkey [lindex $args 0] + + set cmd "::vfs::cvfs::data::${hashkey}::getChildren" + set cmd [linsert $args 0 $cmd] + + eval $cmd +} + +proc ::vfs::cvfs::data::getMetadata args { + set hashkey [lindex $args 0] + + set cmd "::vfs::cvfs::data::${hashkey}::getMetadata" + set cmd [linsert $args 0 $cmd] + + eval $cmd +} + +proc ::vfs::cvfs::data::getData args { + set hashkey [lindex $args 0] + + set cmd "::vfs::cvfs::data::${hashkey}::getData" + set cmd [linsert $args 0 $cmd] + + eval $cmd +} + +## VFS and Chan I/O +### Dispatchers +proc ::vfs::cvfs::vfshandler {hashkey subcmd args} { + set cmd $args + set cmd [linsert $cmd 0 "::vfs::cvfs::vfsop_${subcmd}" $hashkey] + + return [eval $cmd] +} + +proc ::vfs::cvfs::chanhandler {hashkey subcmd args} { + set cmd $args + set cmd [linsert $cmd 0 "::vfs::cvfs::chanop_${subcmd}" $hashkey] + + return [eval $cmd] +} + +### Actual handlers +#### Channel operation handlers +proc ::vfs::cvfs::chanop_initialize {hashkey chanId mode} { + return [list initialize finalize watch read seek] +} + +proc ::vfs::cvfs::chanop_finalize {hashkey chanId} { + unset -nocomplain ::vfs::cvfs::chandata([list $hashkey $chanId]) + + return +} + +proc ::vfs::cvfs::chanop_watch {hashkey chanId eventSpec} { + array set chaninfo $::vfs::cvfs::chandata([list $hashkey $chanId]) + + set chaninfo(watching) $eventSpec + + set ::vfs::cvfs::chandata([list $hashkey $chanId]) [array get chaninfo] + + if {[lsearch -exact $chaninfo(watching) "read"] != -1} { + after 0 [list catch "chan postevent $chanId [list {read}]"] + } + + return +} + +proc ::vfs::cvfs::chanop_read {hashkey chanId bytes} { + array set chaninfo $::vfs::cvfs::chandata([list $hashkey $chanId]) + + set pos $chaninfo(pos) + set len $chaninfo(len) + + if {[lsearch -exact $chaninfo(watching) "read"] != -1} { + after 0 [list catch "chan postevent $chanId [list {read}]"] + } + + if {$pos == $len} { + return "" + } + + set end [expr {$pos + $bytes}] + if {$end > $len} { + set end $len + } + + set data [::vfs::cvfs::data::getData $hashkey $chaninfo(file) $pos $end] + + set dataLen [string length $data] + incr pos $dataLen + + set chaninfo(pos) $pos + + set ::vfs::cvfs::chandata([list $hashkey $chanId]) [array get chaninfo] + + return $data +} + +proc ::vfs::cvfs::chanop_seek {hashkey chanId offset origin} { + array set chaninfo $::vfs::cvfs::chandata([list $hashkey $chanId]) + + set pos $chaninfo(pos) + set len $chaninfo(len) + + switch -- $origin { + "start" - "0" { + set pos $offset + } + "current" - "1" { + set pos [expr {$pos + $offset}] + } + "end" - "2" { + set pos [expr {$len + $offset}] + } + } + + if {$pos < 0} { + set pos 0 + } + + if {$pos > $len} { + set pos $len + } + + set chaninfo(pos) $pos + set ::vfs::cvfs::chandata([list $hashkey $chanId]) [array get chaninfo] + + return $pos +} + +#### VFS operation handlers +proc ::vfs::cvfs::vfsop_stat {hashkey root relative actualpath} { + catch { + set ret [::vfs::cvfs::data::getMetadata $hashkey $relative] + } + + if {![info exists ret]} { + vfs::filesystem posixerror $::vfs::posix(ENOENT) + } + + return $ret +} + +proc ::vfs::cvfs::vfsop_access {hashkey root relative actualpath mode} { + set ret [::vfs::cvfs::data::getMetadata $hashkey $relative] + + if {$mode & 0x2} { + vfs::filesystem posixerror $::vfs::posix(EROFS) + } + + return 1 +} + +proc ::vfs::cvfs::vfsop_matchindirectory {hashkey root relative actualpath pattern types} { + set ret [list] + + catch { + array set metadata [::vfs::cvfs::data::getMetadata $hashkey $relative] + } + + if {![info exists metadata]} { + return [list] + } + + if {$pattern == ""} { + set children [list $relative] + } else { + set children [::vfs::cvfs::data::getChildren $hashkey $relative] + } + + foreach child $children { + if {$pattern != ""} { + if {![string match $pattern $child]} { + continue + } + } + + unset -nocomplain metadata + catch { + array set metadata [::vfs::cvfs::data::getMetadata $hashkey $child] + } + + if {[string index $root end] == "/"} { + set child "${root}${child}" + } else { + set child "${root}/${child}" + } + if {[string index $child end] == "/"} { + set child [string range $child 0 end-1] + } + + if {![info exists metadata(type)]} { + continue + } + + set filetype 0 + switch -- $metadata(type) { + "directory" { + set filetype [expr {$filetype | 0x04}] + } + "file" { + set filetype [expr {$filetype | 0x10}] + } + "link" { + set filetype [expr {$filetype | 0x20}] + } + default { + continue + } + } + + if {($filetype & $types) != $types} { + continue + } + + lappend ret $child + } + + return $ret +} + +proc ::vfs::cvfs::vfsop_fileattributes {hashkey root relative actualpath {index -1} {value ""}} { + set attrs [list -owner -group -permissions] + + if {$value != ""} { + vfs::filesystem posixerror $::vfs::posix(EROFS) + } + + if {$index == -1} { + return $attrs + } + + array set metadata [::vfs::cvfs::data::getMetadata $hashkey $relative] + + set attr [lindex $attrs $index] + + switch -- $attr { + "-owner" { + return $metadata(uid) + } + "-group" { + return $metadata(gid) + } + "-permissions" { + if {$metadata(type) == "directory"} { + set metadata(mode) [expr {$metadata(mode) | 040000}] + } + + return [format {0%o} $metadata(mode)] + } + } + + return -code error "Invalid index" +} + +proc ::vfs::cvfs::vfsop_open {hashkey root relative actualpath mode permissions} { + if {$mode != "" && $mode != "r"} { + vfs::filesystem posixerror $::vfs::posix(EROFS) + } + + catch { + array set metadata [::vfs::cvfs::data::getMetadata $hashkey $relative] + } + + if {![info exists metadata]} { + vfs::filesystem posixerror $::vfs::posix(ENOENT) + } + + if {$metadata(type) == "directory"} { + vfs::filesystem posixerror $::vfs::posix(EISDIR) + } + + if {[info command chan] != ""} { + set chan [chan create [list "read"] [list ::vfs::cvfs::chanhandler $hashkey]] + + set ::vfs::cvfs::chandata([list $hashkey $chan]) [list file $relative pos 0 len $metadata(size) watching ""] + + return [list $chan] + } + + if {[info command rechan] == ""} { + catch { + package require rechan + } + } + + if {[info command rechan] != ""} { + set chan [rechan [list ::vfs::cvfs::chanhandler $hashkey] 2] + + set ::vfs::cvfs::chandata([list $hashkey $chan]) [list file $relative pos 0 len $metadata(size) watching ""] + + return [list $chan] + } + + return -code error "No way to generate a channel, need either Tcl 8.5+, \"rechan\"" +} + +##### No-Ops since we are a readonly filesystem +proc ::vfs::cvfs::vfsop_createdirectory {args} { + vfs::filesystem posixerror $::vfs::posix(EROFS) +} +proc ::vfs::cvfs::vfsop_deletefile {args} { + vfs::filesystem posixerror $::vfs::posix(EROFS) +} +proc ::vfs::cvfs::vfsop_removedirectory {args} { + vfs::filesystem posixerror $::vfs::posix(EROFS) +} +proc ::vfs::cvfs::vfsop_utime {} { + vfs::filesystem posixerror $::vfs::posix(EROFS) +} + +package provide vfs::cvfs 1.0 ADDED kitsh/buildsrc/kitsh-0.0/cvfs_data.c Index: kitsh/buildsrc/kitsh-0.0/cvfs_data.c ================================================================== --- /dev/null +++ kitsh/buildsrc/kitsh-0.0/cvfs_data.c @@ -0,0 +1,270 @@ +#include + +#ifdef HAVE_STDLIB_H +# include +#endif + +typedef struct cvfs_data *(cmd_getData_t)(const char *, unsigned long); +typedef unsigned long (cmd_getChildren_t)(const char *, unsigned long *, unsigned long); + +/* Your implementation must provide these */ +static cmd_getData_t *getCmdData(const char *hashkey); +static cmd_getChildren_t *getCmdChildren(const char *hashkey); + +/* Tcl Commands */ +static int getMetadata(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + cmd_getData_t *cmd_getData; + cmd_getChildren_t *cmd_getChildren; + struct cvfs_data *finfo = NULL; + Tcl_Obj *ret_list, *ret_list_items[20]; + unsigned long num_children; + const char *hashkey; + const char *file; + + if (objc != 3) { + Tcl_SetResult(interp, "wrong # args: should be \"getMetadata hashKey fileName\"", TCL_STATIC); + + return(TCL_ERROR); + } + + hashkey = Tcl_GetString(objv[1]); + file = Tcl_GetString(objv[2]); + + cmd_getData = getCmdData(hashkey); + cmd_getChildren = getCmdChildren(hashkey); + + if (cmd_getData == NULL || cmd_getChildren == NULL) { + Tcl_SetResult(interp, "No such hashkey", TCL_STATIC); + + return(TCL_ERROR); + } + + finfo = cmd_getData(file, 0); + + if (finfo == NULL) { + Tcl_SetResult(interp, "No such file or directory", TCL_STATIC); + + return(TCL_ERROR); + } + + /* Values that can be derived from "finfo" */ + ret_list_items[0] = Tcl_NewStringObj("type", 4); + ret_list_items[2] = Tcl_NewStringObj("mode", 4); + ret_list_items[4] = Tcl_NewStringObj("nlink", 5); + + if (finfo->type == CVFS_FILETYPE_DIR) { + num_children = cmd_getChildren(file, NULL, 0); + + ret_list_items[1] = Tcl_NewStringObj("directory", 9); + ret_list_items[3] = Tcl_NewLongObj(040555); + ret_list_items[5] = Tcl_NewLongObj(num_children); + } else { + ret_list_items[1] = Tcl_NewStringObj("file", 4); + ret_list_items[3] = Tcl_NewLongObj(0444); + ret_list_items[5] = Tcl_NewLongObj(1); + } + + ret_list_items[6] = Tcl_NewStringObj("ino", 3); + ret_list_items[7] = Tcl_NewLongObj(finfo->index); + + ret_list_items[8] = Tcl_NewStringObj("size", 4); + ret_list_items[9] = Tcl_NewLongObj(finfo->size); + + /* Dummy values */ + ret_list_items[10] = Tcl_NewStringObj("uid", 3); + ret_list_items[11] = Tcl_NewStringObj("0", 1); + + ret_list_items[12] = Tcl_NewStringObj("gid", 3); + ret_list_items[13] = Tcl_NewStringObj("0", 1); + + ret_list_items[14] = Tcl_NewStringObj("atime", 5); + ret_list_items[15] = Tcl_NewStringObj("0", 1); + + ret_list_items[16] = Tcl_NewStringObj("mtime", 5); + ret_list_items[17] = Tcl_NewStringObj("0", 1); + + ret_list_items[18] = Tcl_NewStringObj("ctime", 5); + ret_list_items[19] = Tcl_NewStringObj("0", 1); + + ret_list = Tcl_NewListObj(sizeof(ret_list_items) / sizeof(ret_list_items[0]), ret_list_items); + + Tcl_SetObjResult(interp, ret_list); + + return(TCL_OK); +} + +static int getData(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + struct cvfs_data *finfo = NULL; + cmd_getData_t *cmd_getData; + const char *hashkey; + const char *file; + const char *end_str; + Tcl_Obj *ret_str; + long start = 0; + long end = -1; + int tclGetLFO_ret; + + if (objc < 3 || objc > 5) { + Tcl_SetResult(interp, "wrong # args: should be \"getData hashKey fileName ?start? ?end?\"", TCL_STATIC); + + return(TCL_ERROR); + } + + hashkey = Tcl_GetString(objv[1]); + file = Tcl_GetString(objv[2]); + + if (objc > 3) { + tclGetLFO_ret = Tcl_GetLongFromObj(interp, objv[3], &start); + + if (tclGetLFO_ret != TCL_OK) { + return(tclGetLFO_ret); + } + } + + if (objc > 4) { + end_str = Tcl_GetString(objv[4]); + if (strcmp(end_str, "end") == 0) { + end = -1; + } else { + tclGetLFO_ret = Tcl_GetLongFromObj(interp, objv[4], &end); + + if (tclGetLFO_ret != TCL_OK) { + return(tclGetLFO_ret); + } + } + } + + cmd_getData = getCmdData(hashkey); + + if (cmd_getData == NULL) { + Tcl_SetResult(interp, "No such hashkey", TCL_STATIC); + + return(TCL_ERROR); + } + + finfo = cmd_getData(file, 0); + + if (finfo == NULL) { + Tcl_SetResult(interp, "No such file or directory", TCL_STATIC); + + return(TCL_ERROR); + } + + if (finfo->type != CVFS_FILETYPE_FILE) { + Tcl_SetResult(interp, "Not a file", TCL_STATIC); + + return(TCL_ERROR); + } + + if (end == -1) { + end = finfo->size; + } + + if (end > finfo->size) { + end = finfo->size; + } + + if (start < 0) { + start = 0; + } + + if (end < 0) { + end = 0; + } + + if (end < start) { + Tcl_SetResult(interp, "Invalid arguments, start must be less than end", TCL_STATIC); + + return(TCL_ERROR); + } + + ret_str = Tcl_NewByteArrayObj(finfo->data + start, (end - start)); + + Tcl_SetObjResult(interp, ret_str); + + return(TCL_OK); +} + +static int getChildren(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + struct cvfs_data *finfo = NULL; + cmd_getChildren_t *cmd_getChildren; + cmd_getData_t *cmd_getData; + unsigned long num_children, idx; + unsigned long *children; + const char *hashkey; + const char *file; + const char *child; + Tcl_Obj *ret_list, *ret_curr_obj; + + if (objc != 3) { + Tcl_SetResult(interp, "wrong # args: should be \"getChildren hashKey fileName\"", TCL_STATIC); + + return(TCL_ERROR); + } + + hashkey = Tcl_GetString(objv[1]); + file = Tcl_GetString(objv[2]); + + cmd_getData = getCmdData(hashkey); + cmd_getChildren = getCmdChildren(hashkey); + + if (cmd_getData == NULL || cmd_getChildren == NULL) { + Tcl_SetResult(interp, "No such hashkey", TCL_STATIC); + + return(TCL_ERROR); + } + + finfo = cmd_getData(file, 0); + + if (finfo == NULL) { + Tcl_SetResult(interp, "No such file or directory", TCL_STATIC); + + return(TCL_ERROR); + } + + if (finfo->type != CVFS_FILETYPE_DIR) { + Tcl_SetResult(interp, "Not a directory", TCL_STATIC); + + return(TCL_ERROR); + } + + num_children = cmd_getChildren(file, NULL, 0); + + if (num_children == 0) { + /* Return immediately if there are no children */ + Tcl_SetResult(interp, "", TCL_STATIC); + + return(TCL_OK); + } + + ret_list = Tcl_NewObj(); + if (ret_list == NULL) { + Tcl_SetResult(interp, "Failed to allocate new object", TCL_STATIC); + + return(TCL_ERROR); + } + + children = malloc(sizeof(*children) * num_children); + + num_children = cmd_getChildren(file, children, num_children); + + for (idx = 0; idx < num_children; idx++) { + finfo = cmd_getData(NULL, children[idx]); + + if (finfo == NULL || finfo->name == NULL) { + continue; + } + + child = finfo->name; + + ret_curr_obj = Tcl_NewStringObj(child, strlen(child)); + + Tcl_ListObjAppendList(interp, ret_list, ret_curr_obj); + } + + free(children); + + Tcl_SetObjResult(interp, ret_list); + + return(TCL_OK); +} Index: kitsh/buildsrc/kitsh-0.0/dir2c.tcl ================================================================== --- kitsh/buildsrc/kitsh-0.0/dir2c.tcl +++ kitsh/buildsrc/kitsh-0.0/dir2c.tcl @@ -1,9 +1,9 @@ #! /usr/bin/env tclsh if {[llength $argv] != 2} { - puts stderr "Usage: kitdll " + puts stderr "Usage: dir2c.tcl " exit 1 } set hashkey [lindex $argv 0] @@ -74,11 +74,11 @@ return $ret } # This function must be kept in-sync with the generated C function below -proc kitdll_hash {path} { +proc cvfs_hash {path} { set h 0 set g 0 for {set idx 0} {$idx < [string length $path]} {incr idx} { binary scan [string index $path $idx] H* char @@ -101,12 +101,12 @@ # Insert dummy entry cooresponding to C dummy entry set files [linsert $files 0 "__DUMMY__"] # Produce C89 compatible header -set cpp_tag "KITDLL_[string toupper $hashkey]" -set code_tag "kitdll_[string tolower $hashkey]" +set cpp_tag "CVFS_[string toupper $hashkey]" +set code_tag "cvfs_[string tolower $hashkey]" set hashkey [string tolower $hashkey] puts "#ifndef $cpp_tag" puts "# define $cpp_tag 1" puts { @@ -123,27 +123,27 @@ # endif # ifdef HAVE_STRING_H # include # endif -# ifndef LOADED_KITDLL_COMMON -# define LOADED_KITDLL_COMMON 1 +# ifndef LOADED_CVFS_COMMON +# define LOADED_CVFS_COMMON 1 typedef enum { - KITDLL_FILETYPE_FILE, - KITDLL_FILETYPE_DIR -} kitdll_filetype_t; + CVFS_FILETYPE_FILE, + CVFS_FILETYPE_DIR +} cvfs_filetype_t; -struct kitdll_data { +struct cvfs_data { const char * name; unsigned long index; unsigned long size; - kitdll_filetype_t type; + cvfs_filetype_t type; const unsigned char * data; }; -static unsigned long kitdll_hash(const unsigned char *path) { +static unsigned long cvfs_hash(const unsigned char *path) { unsigned long i, h = 0, g = 0; for (i = 0; path[i]; i++) { h = (h << 4) + path[i]; g = h & 0xf0000000; @@ -154,14 +154,14 @@ } return(h); } -# endif /* !LOADED_KITDLL_COMMON */} +# endif /* !LOADED_CVFS_COMMON */} puts "" -puts "static struct kitdll_data ${code_tag}_data\[\] = {" +puts "static struct cvfs_data ${code_tag}_data\[\] = {" puts "\t{" puts "\t\t.name = NULL," puts "\t\t.index = 0," puts "\t\t.type = 0," puts "\t\t.size = 0," @@ -174,11 +174,11 @@ unset -nocomplain finfo type file stat $file finfo switch -- $finfo(type) { "file" { - set type "KITDLL_FILETYPE_FILE" + set type "CVFS_FILETYPE_FILE" set size $finfo(size) set fd [open $file] fconfigure $fd -translation binary set data [read $fd] @@ -185,11 +185,11 @@ close $fd set data "(unsigned char *) [stringify $data]" } "directory" { - set type "KITDLL_FILETYPE_DIR" + set type "CVFS_FILETYPE_DIR" set data "NULL" set size 0 } } @@ -203,16 +203,16 @@ } puts "};" puts "" puts "static unsigned long ${code_tag}_lookup_index(const char *path) {" -puts "\tswitch (kitdll_hash((unsigned char *) path)) {" +puts "\tswitch (cvfs_hash((unsigned char *) path)) {" for {set idx 1} {$idx < [llength $files]} {incr idx} { set file [lindex $files $idx] set shortfile [shorten_file $startdir $file] - set hash [kitdll_hash $shortfile] + set hash [cvfs_hash $shortfile] lappend indexes_per_hash($hash) [list $shortfile $idx] } foreach {hash idx_list} [array get indexes_per_hash] { @@ -236,11 +236,11 @@ puts "\t}" puts "\treturn(0);" puts "}" puts "" -puts "static struct kitdll_data *${code_tag}_getData(const char *path, unsigned long index) {" +puts "static struct cvfs_data *${code_tag}_getData(const char *path, unsigned long index) {" puts "\tif (path != NULL) {" puts "\t\tindex = ${code_tag}_lookup_index(path);" puts "\t}" puts "" puts "\tif (index == 0) {" @@ -264,11 +264,11 @@ puts "\tindex = ${code_tag}_lookup_index(path);" puts "\tif (index == 0) {" puts "\t\treturn(0);" puts "\t}" puts "" -puts "\tif (${code_tag}_data\[index\].type != KITDLL_FILETYPE_DIR) {" +puts "\tif (${code_tag}_data\[index\].type != CVFS_FILETYPE_DIR) {" puts "\t\treturn(0);" puts "\t}" puts "" puts "\tif (strcmp(path, ${code_tag}_data\[index\].name) != 0) {" puts "\t\treturn(0);" @@ -349,13 +349,13 @@ puts "" puts "\treturn(num_children);" puts "}" puts "" -puts "# ifdef KITDLL_MAKE_LOADABLE" +puts "# ifdef CVFS_MAKE_LOADABLE" -set fd [open "vfs_kitdll_data.c"] +set fd [open "cvfs_data.c"] puts [read $fd] close $fd puts "static cmd_getData_t *getCmdData(const char *hashkey) {" @@ -365,31 +365,31 @@ puts "static cmd_getChildren_t *getCmdChildren(const char *hashkey) {" puts "\treturn(${code_tag}_getChildren);" puts "}" puts "" -puts "int Vfs_kitdll_data_${hashkey}_Init(Tcl_Interp *interp) {" +puts "int Cvfs_data_${hashkey}_Init(Tcl_Interp *interp) {" puts "\tTcl_Command tclCreatComm_ret;" puts "\tint tclPkgProv_ret;" puts "" -puts "\ttclCreatComm_ret = Tcl_CreateObjCommand(interp, \"::vfs::kitdll::data::${hashkey}::getMetadata\", getMetadata, NULL, NULL);" +puts "\ttclCreatComm_ret = Tcl_CreateObjCommand(interp, \"::vfs::cvfs::data::${hashkey}::getMetadata\", getMetadata, NULL, NULL);" +puts "\tif (!tclCreatComm_ret) {" +puts "\t\treturn(TCL_ERROR);" +puts "\t}" +puts "" +puts "\ttclCreatComm_ret = Tcl_CreateObjCommand(interp, \"::vfs::cvfs::data::${hashkey}::getData\", getData, NULL, NULL);" puts "\tif (!tclCreatComm_ret) {" puts "\t\treturn(TCL_ERROR);" puts "\t}" puts "" -puts "\ttclCreatComm_ret = Tcl_CreateObjCommand(interp, \"::vfs::kitdll::data::${hashkey}::getData\", getData, NULL, NULL);" +puts "\ttclCreatComm_ret = Tcl_CreateObjCommand(interp, \"::vfs::cvfs::data::${hashkey}::getChildren\", getChildren, NULL, NULL);" puts "\tif (!tclCreatComm_ret) {" puts "\t\treturn(TCL_ERROR);" puts "\t}" puts "" -puts "\ttclCreatComm_ret = Tcl_CreateObjCommand(interp, \"::vfs::kitdll::data::${hashkey}::getChildren\", getChildren, NULL, NULL);" -puts "\tif (!tclCreatComm_ret) {" -puts "\t\treturn(TCL_ERROR);" -puts "\t}" -puts "" -puts "\ttclPkgProv_ret = Tcl_PkgProvide(interp, \"vfs::kitdll::data::${hashkey}\", \"1.0\");" +puts "\ttclPkgProv_ret = Tcl_PkgProvide(interp, \"vfs::cvfs::data::${hashkey}\", \"1.0\");" puts "" puts "\treturn(tclPkgProv_ret);" puts "\t}" -puts "# endif /* KITDLL_MAKE_LOADABLE */" +puts "# endif /* CVFS_MAKE_LOADABLE */" puts "#endif /* !$cpp_tag */" Index: kitsh/buildsrc/kitsh-0.0/kitInit.c ================================================================== --- kitsh/buildsrc/kitsh-0.0/kitInit.c +++ kitsh/buildsrc/kitsh-0.0/kitInit.c @@ -73,11 +73,11 @@ #endif #ifdef KIT_INCLUDES_ZLIB Tcl_AppInitProc Zlib_Init; #endif #ifdef KIT_STORAGE_CVFS -Tcl_AppInitProc Vfs_kitdll_data_tcl_Init; +Tcl_AppInitProc Cvfs_data_tcl_Init; #endif #ifdef TCL_THREADS Tcl_AppInitProc Thread_Init; #endif #ifdef _WIN32 @@ -186,15 +186,15 @@ #endif /* KIT_STORAGE_ZIP */ #ifdef KIT_STORAGE_CVFS "set ::tclKitStorage \"cvfs\"\n" "load {} rechan\n" "load {} vfs\n" - "load {} vfs_kitdll_data_tcl\n" -#include "vfs_kitdll.tcl.h" + "load {} cvfs_data_tcl\n" +#include "cvfs.tcl.h" "if {![info exists s]} {\n" "catch {\n" - "set s [::vfs::kitdll::data::getData tcl boot.tcl]\n" + "set s [::vfs::cvfs::data::getData tcl boot.tcl]\n" "}\n" "}\n" #endif /* KIT_STORAGE_CVFS */ #ifndef TCLKIT_DLL "if {![info exists s]} {\n" @@ -353,11 +353,11 @@ Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL); #ifdef KIT_INCLUDES_ZLIB Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL); #endif #ifdef KIT_STORAGE_CVFS - Tcl_StaticPackage(0, "vfs_kitdll_data_tcl", Vfs_kitdll_data_tcl_Init, NULL); + Tcl_StaticPackage(0, "cvfs_data_tcl", Cvfs_data_tcl_Init, NULL); #endif #ifdef TCL_THREADS Tcl_StaticPackage(0, "Thread", Thread_Init, NULL); #endif #ifdef _WIN32 DELETED kitsh/buildsrc/kitsh-0.0/vfs_kitdll.tcl Index: kitsh/buildsrc/kitsh-0.0/vfs_kitdll.tcl ================================================================== --- kitsh/buildsrc/kitsh-0.0/vfs_kitdll.tcl +++ /dev/null @@ -1,335 +0,0 @@ -#! /usr/bin/env tcl - -package require vfs - -namespace eval ::vfs::kitdll {} - -# Convience functions -proc ::vfs::kitdll::Mount {hashkey local} { - vfs::filesystem mount $local [list ::vfs::kitdll::vfshandler $hashkey] - catch { - vfs::RegisterMount $local [list ::vfs::kitdll::Unmount] - } -} - -proc ::vfs::kitdll::Unmount {local} { - vfs::filesystem unmount $local -} - -# Implementation -## I/O Handlers (pass to appropriate hashkey) -namespace eval ::vfs::kitdll::data {} -proc ::vfs::kitdll::data::getChildren args { - set hashkey [lindex $args 0] - - set cmd "::vfs::kitdll::data::${hashkey}::getChildren" - set cmd [linsert $args 0 $cmd] - - eval $cmd -} - -proc ::vfs::kitdll::data::getMetadata args { - set hashkey [lindex $args 0] - - set cmd "::vfs::kitdll::data::${hashkey}::getMetadata" - set cmd [linsert $args 0 $cmd] - - eval $cmd -} - -proc ::vfs::kitdll::data::getData args { - set hashkey [lindex $args 0] - - set cmd "::vfs::kitdll::data::${hashkey}::getData" - set cmd [linsert $args 0 $cmd] - - eval $cmd -} - -## VFS and Chan I/O -### Dispatchers -proc ::vfs::kitdll::vfshandler {hashkey subcmd args} { - set cmd $args - set cmd [linsert $cmd 0 "::vfs::kitdll::vfsop_${subcmd}" $hashkey] - - return [eval $cmd] -} - -proc ::vfs::kitdll::chanhandler {hashkey subcmd args} { - set cmd $args - set cmd [linsert $cmd 0 "::vfs::kitdll::chanop_${subcmd}" $hashkey] - - return [eval $cmd] -} - -### Actual handlers -#### Channel operation handlers -proc ::vfs::kitdll::chanop_initialize {hashkey chanId mode} { - return [list initialize finalize watch read seek] -} - -proc ::vfs::kitdll::chanop_finalize {hashkey chanId} { - unset -nocomplain ::vfs::kitdll::chandata([list $hashkey $chanId]) - - return -} - -proc ::vfs::kitdll::chanop_watch {hashkey chanId eventSpec} { - array set chaninfo $::vfs::kitdll::chandata([list $hashkey $chanId]) - - set chaninfo(watching) $eventSpec - - set ::vfs::kitdll::chandata([list $hashkey $chanId]) [array get chaninfo] - - if {[lsearch -exact $chaninfo(watching) "read"] != -1} { - after 0 [list catch "chan postevent $chanId [list {read}]"] - } - - return -} - -proc ::vfs::kitdll::chanop_read {hashkey chanId bytes} { - array set chaninfo $::vfs::kitdll::chandata([list $hashkey $chanId]) - - set pos $chaninfo(pos) - set len $chaninfo(len) - - if {[lsearch -exact $chaninfo(watching) "read"] != -1} { - after 0 [list catch "chan postevent $chanId [list {read}]"] - } - - if {$pos == $len} { - return "" - } - - set end [expr {$pos + $bytes}] - if {$end > $len} { - set end $len - } - - set data [::vfs::kitdll::data::getData $hashkey $chaninfo(file) $pos $end] - - set dataLen [string length $data] - incr pos $dataLen - - set chaninfo(pos) $pos - - set ::vfs::kitdll::chandata([list $hashkey $chanId]) [array get chaninfo] - - return $data -} - -proc ::vfs::kitdll::chanop_seek {hashkey chanId offset origin} { - array set chaninfo $::vfs::kitdll::chandata([list $hashkey $chanId]) - - set pos $chaninfo(pos) - set len $chaninfo(len) - - switch -- $origin { - "start" - "0" { - set pos $offset - } - "current" - "1" { - set pos [expr {$pos + $offset}] - } - "end" - "2" { - set pos [expr {$len + $offset}] - } - } - - if {$pos < 0} { - set pos 0 - } - - if {$pos > $len} { - set pos $len - } - - set chaninfo(pos) $pos - set ::vfs::kitdll::chandata([list $hashkey $chanId]) [array get chaninfo] - - return $pos -} - -#### VFS operation handlers -proc ::vfs::kitdll::vfsop_stat {hashkey root relative actualpath} { - catch { - set ret [::vfs::kitdll::data::getMetadata $hashkey $relative] - } - - if {![info exists ret]} { - vfs::filesystem posixerror $::vfs::posix(ENOENT) - } - - return $ret -} - -proc ::vfs::kitdll::vfsop_access {hashkey root relative actualpath mode} { - set ret [::vfs::kitdll::data::getMetadata $hashkey $relative] - - if {$mode & 0x2} { - vfs::filesystem posixerror $::vfs::posix(EROFS) - } - - return 1 -} - -proc ::vfs::kitdll::vfsop_matchindirectory {hashkey root relative actualpath pattern types} { - set ret [list] - - catch { - array set metadata [::vfs::kitdll::data::getMetadata $hashkey $relative] - } - - if {![info exists metadata]} { - return [list] - } - - if {$pattern == ""} { - set children [list $relative] - } else { - set children [::vfs::kitdll::data::getChildren $hashkey $relative] - } - - foreach child $children { - if {$pattern != ""} { - if {![string match $pattern $child]} { - continue - } - } - - unset -nocomplain metadata - catch { - array set metadata [::vfs::kitdll::data::getMetadata $hashkey $child] - } - - if {[string index $root end] == "/"} { - set child "${root}${child}" - } else { - set child "${root}/${child}" - } - if {[string index $child end] == "/"} { - set child [string range $child 0 end-1] - } - - if {![info exists metadata(type)]} { - continue - } - - set filetype 0 - switch -- $metadata(type) { - "directory" { - set filetype [expr {$filetype | 0x04}] - } - "file" { - set filetype [expr {$filetype | 0x10}] - } - "link" { - set filetype [expr {$filetype | 0x20}] - } - default { - continue - } - } - - if {($filetype & $types) != $types} { - continue - } - - lappend ret $child - } - - return $ret -} - -proc ::vfs::kitdll::vfsop_fileattributes {hashkey root relative actualpath {index -1} {value ""}} { - set attrs [list -owner -group -permissions] - - if {$value != ""} { - vfs::filesystem posixerror $::vfs::posix(EROFS) - } - - if {$index == -1} { - return $attrs - } - - array set metadata [::vfs::kitdll::data::getMetadata $hashkey $relative] - - set attr [lindex $attrs $index] - - switch -- $attr { - "-owner" { - return $metadata(uid) - } - "-group" { - return $metadata(gid) - } - "-permissions" { - if {$metadata(type) == "directory"} { - set metadata(mode) [expr {$metadata(mode) | 040000}] - } - - return [format {0%o} $metadata(mode)] - } - } - - return -code error "Invalid index" -} - -proc ::vfs::kitdll::vfsop_open {hashkey root relative actualpath mode permissions} { - if {$mode != "" && $mode != "r"} { - vfs::filesystem posixerror $::vfs::posix(EROFS) - } - - catch { - array set metadata [::vfs::kitdll::data::getMetadata $hashkey $relative] - } - - if {![info exists metadata]} { - vfs::filesystem posixerror $::vfs::posix(ENOENT) - } - - if {$metadata(type) == "directory"} { - vfs::filesystem posixerror $::vfs::posix(EISDIR) - } - - if {[info command chan] != ""} { - set chan [chan create [list "read"] [list ::vfs::kitdll::chanhandler $hashkey]] - - set ::vfs::kitdll::chandata([list $hashkey $chan]) [list file $relative pos 0 len $metadata(size) watching ""] - - return [list $chan] - } - - if {[info command rechan] == ""} { - catch { - package require rechan - } - } - - if {[info command rechan] != ""} { - set chan [rechan [list ::vfs::kitdll::chanhandler $hashkey] 2] - - set ::vfs::kitdll::chandata([list $hashkey $chan]) [list file $relative pos 0 len $metadata(size) watching ""] - - return [list $chan] - } - - return -code error "No way to generate a channel, need either Tcl 8.5+, \"rechan\"" -} - -##### No-Ops since we are a readonly filesystem -proc ::vfs::kitdll::vfsop_createdirectory {args} { - vfs::filesystem posixerror $::vfs::posix(EROFS) -} -proc ::vfs::kitdll::vfsop_deletefile {args} { - vfs::filesystem posixerror $::vfs::posix(EROFS) -} -proc ::vfs::kitdll::vfsop_removedirectory {args} { - vfs::filesystem posixerror $::vfs::posix(EROFS) -} -proc ::vfs::kitdll::vfsop_utime {} { - vfs::filesystem posixerror $::vfs::posix(EROFS) -} - -package provide vfs::kitdll 1.0 DELETED kitsh/buildsrc/kitsh-0.0/vfs_kitdll_data.c Index: kitsh/buildsrc/kitsh-0.0/vfs_kitdll_data.c ================================================================== --- kitsh/buildsrc/kitsh-0.0/vfs_kitdll_data.c +++ /dev/null @@ -1,270 +0,0 @@ -#include - -#ifdef HAVE_STDLIB_H -# include -#endif - -typedef struct kitdll_data *(cmd_getData_t)(const char *, unsigned long); -typedef unsigned long (cmd_getChildren_t)(const char *, unsigned long *, unsigned long); - -/* Your implementation must provide these */ -static cmd_getData_t *getCmdData(const char *hashkey); -static cmd_getChildren_t *getCmdChildren(const char *hashkey); - -/* Tcl Commands */ -static int getMetadata(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - cmd_getData_t *cmd_getData; - cmd_getChildren_t *cmd_getChildren; - struct kitdll_data *finfo = NULL; - Tcl_Obj *ret_list, *ret_list_items[20]; - unsigned long num_children; - const char *hashkey; - const char *file; - - if (objc != 3) { - Tcl_SetResult(interp, "wrong # args: should be \"getMetadata hashKey fileName\"", TCL_STATIC); - - return(TCL_ERROR); - } - - hashkey = Tcl_GetString(objv[1]); - file = Tcl_GetString(objv[2]); - - cmd_getData = getCmdData(hashkey); - cmd_getChildren = getCmdChildren(hashkey); - - if (cmd_getData == NULL || cmd_getChildren == NULL) { - Tcl_SetResult(interp, "No such hashkey", TCL_STATIC); - - return(TCL_ERROR); - } - - finfo = cmd_getData(file, 0); - - if (finfo == NULL) { - Tcl_SetResult(interp, "No such file or directory", TCL_STATIC); - - return(TCL_ERROR); - } - - /* Values that can be derived from "finfo" */ - ret_list_items[0] = Tcl_NewStringObj("type", 4); - ret_list_items[2] = Tcl_NewStringObj("mode", 4); - ret_list_items[4] = Tcl_NewStringObj("nlink", 5); - - if (finfo->type == KITDLL_FILETYPE_DIR) { - num_children = cmd_getChildren(file, NULL, 0); - - ret_list_items[1] = Tcl_NewStringObj("directory", 9); - ret_list_items[3] = Tcl_NewLongObj(040555); - ret_list_items[5] = Tcl_NewLongObj(num_children); - } else { - ret_list_items[1] = Tcl_NewStringObj("file", 4); - ret_list_items[3] = Tcl_NewLongObj(0444); - ret_list_items[5] = Tcl_NewLongObj(1); - } - - ret_list_items[6] = Tcl_NewStringObj("ino", 3); - ret_list_items[7] = Tcl_NewLongObj(finfo->index); - - ret_list_items[8] = Tcl_NewStringObj("size", 4); - ret_list_items[9] = Tcl_NewLongObj(finfo->size); - - /* Dummy values */ - ret_list_items[10] = Tcl_NewStringObj("uid", 3); - ret_list_items[11] = Tcl_NewStringObj("0", 1); - - ret_list_items[12] = Tcl_NewStringObj("gid", 3); - ret_list_items[13] = Tcl_NewStringObj("0", 1); - - ret_list_items[14] = Tcl_NewStringObj("atime", 5); - ret_list_items[15] = Tcl_NewStringObj("0", 1); - - ret_list_items[16] = Tcl_NewStringObj("mtime", 5); - ret_list_items[17] = Tcl_NewStringObj("0", 1); - - ret_list_items[18] = Tcl_NewStringObj("ctime", 5); - ret_list_items[19] = Tcl_NewStringObj("0", 1); - - ret_list = Tcl_NewListObj(sizeof(ret_list_items) / sizeof(ret_list_items[0]), ret_list_items); - - Tcl_SetObjResult(interp, ret_list); - - return(TCL_OK); -} - -static int getData(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - struct kitdll_data *finfo = NULL; - cmd_getData_t *cmd_getData; - const char *hashkey; - const char *file; - const char *end_str; - Tcl_Obj *ret_str; - long start = 0; - long end = -1; - int tclGetLFO_ret; - - if (objc < 3 || objc > 5) { - Tcl_SetResult(interp, "wrong # args: should be \"getData hashKey fileName ?start? ?end?\"", TCL_STATIC); - - return(TCL_ERROR); - } - - hashkey = Tcl_GetString(objv[1]); - file = Tcl_GetString(objv[2]); - - if (objc > 3) { - tclGetLFO_ret = Tcl_GetLongFromObj(interp, objv[3], &start); - - if (tclGetLFO_ret != TCL_OK) { - return(tclGetLFO_ret); - } - } - - if (objc > 4) { - end_str = Tcl_GetString(objv[4]); - if (strcmp(end_str, "end") == 0) { - end = -1; - } else { - tclGetLFO_ret = Tcl_GetLongFromObj(interp, objv[4], &end); - - if (tclGetLFO_ret != TCL_OK) { - return(tclGetLFO_ret); - } - } - } - - cmd_getData = getCmdData(hashkey); - - if (cmd_getData == NULL) { - Tcl_SetResult(interp, "No such hashkey", TCL_STATIC); - - return(TCL_ERROR); - } - - finfo = cmd_getData(file, 0); - - if (finfo == NULL) { - Tcl_SetResult(interp, "No such file or directory", TCL_STATIC); - - return(TCL_ERROR); - } - - if (finfo->type != KITDLL_FILETYPE_FILE) { - Tcl_SetResult(interp, "Not a file", TCL_STATIC); - - return(TCL_ERROR); - } - - if (end == -1) { - end = finfo->size; - } - - if (end > finfo->size) { - end = finfo->size; - } - - if (start < 0) { - start = 0; - } - - if (end < 0) { - end = 0; - } - - if (end < start) { - Tcl_SetResult(interp, "Invalid arguments, start must be less than end", TCL_STATIC); - - return(TCL_ERROR); - } - - ret_str = Tcl_NewByteArrayObj(finfo->data + start, (end - start)); - - Tcl_SetObjResult(interp, ret_str); - - return(TCL_OK); -} - -static int getChildren(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - struct kitdll_data *finfo = NULL; - cmd_getChildren_t *cmd_getChildren; - cmd_getData_t *cmd_getData; - unsigned long num_children, idx; - unsigned long *children; - const char *hashkey; - const char *file; - const char *child; - Tcl_Obj *ret_list, *ret_curr_obj; - - if (objc != 3) { - Tcl_SetResult(interp, "wrong # args: should be \"getChildren hashKey fileName\"", TCL_STATIC); - - return(TCL_ERROR); - } - - hashkey = Tcl_GetString(objv[1]); - file = Tcl_GetString(objv[2]); - - cmd_getData = getCmdData(hashkey); - cmd_getChildren = getCmdChildren(hashkey); - - if (cmd_getData == NULL || cmd_getChildren == NULL) { - Tcl_SetResult(interp, "No such hashkey", TCL_STATIC); - - return(TCL_ERROR); - } - - finfo = cmd_getData(file, 0); - - if (finfo == NULL) { - Tcl_SetResult(interp, "No such file or directory", TCL_STATIC); - - return(TCL_ERROR); - } - - if (finfo->type != KITDLL_FILETYPE_DIR) { - Tcl_SetResult(interp, "Not a directory", TCL_STATIC); - - return(TCL_ERROR); - } - - num_children = cmd_getChildren(file, NULL, 0); - - if (num_children == 0) { - /* Return immediately if there are no children */ - Tcl_SetResult(interp, "", TCL_STATIC); - - return(TCL_OK); - } - - ret_list = Tcl_NewObj(); - if (ret_list == NULL) { - Tcl_SetResult(interp, "Failed to allocate new object", TCL_STATIC); - - return(TCL_ERROR); - } - - children = malloc(sizeof(*children) * num_children); - - num_children = cmd_getChildren(file, children, num_children); - - for (idx = 0; idx < num_children; idx++) { - finfo = cmd_getData(NULL, children[idx]); - - if (finfo == NULL || finfo->name == NULL) { - continue; - } - - child = finfo->name; - - ret_curr_obj = Tcl_NewStringObj(child, strlen(child)); - - Tcl_ListObjAppendList(interp, ret_list, ret_curr_obj); - } - - free(children); - - Tcl_SetObjResult(interp, ret_list); - - return(TCL_OK); -}