Check-in [e5b6962adf]
Overview
Comment:Minimal support to be loaded and not crash the process
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: e5b6962adfbac23bb929a521406e61fc5ee68d827240ea21131a76b6f12697a2
User & Date: rkeene on 2019-05-02 21:08:06
Other Links: manifest | tags
Context
2019-05-02
23:06
Basic functionality to the point where Tcl_Channel types need to be implemented check-in: d121970301 user: rkeene tags: trunk
21:08
Minimal support to be loaded and not crash the process check-in: e5b6962adf user: rkeene tags: trunk
19:58
Start of data/directory handling check-in: 32b55a907b user: rkeene tags: trunk
Changes

Modified Makefile from [f8664e614e] to [8907b35042].






1
2
3
4
5
6
7
8

9
10
11

12
13
14

15
16
17

18
19
20
21
22
23
24
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15

16
17
18

19
20
21

22
23
24
25
26
27
28
29
+
+
+
+
+







-
+


-
+


-
+


-
+







CPPFLAGS := -I. -DUSE_TCL_STUBS=1
CFLAGS   := -fPIC -g3 -ggdb3 -Wall
LDFLAGS  :=
LIBS     := -ltclstub8.6

all: example.so

example.c: $(shell find example -type f) $(shell find lib -type f) xvfs.c.rvt xvfs-create Makefile
	./xvfs-create --directory example --name example > example.c.new
	mv example.c.new example.c

example.o: example.c xvfs-core.h Makefile
	cc -fPIC -Wall -I. -o example.o -c example.c
	$(CC) $(CPPFLAGS) $(CFLAGS) -o example.o -c example.c

xvfs-core.o: xvfs-core.c xvfs-core.h Makefile
	cc -fPIC -Wall -I. -o xvfs-core.o -c xvfs-core.c
	$(CC) $(CPPFLAGS) $(CFLAGS) -o xvfs-core.o -c xvfs-core.c

example.so: example.o xvfs-core.o Makefile
	cc -fPIC -shared -o example.so example.o xvfs-core.o
	$(CC) $(CFLAGS) $(LDFLAGS) -shared -o example.so example.o xvfs-core.o $(LIBS)

test: example.so
	echo 'load ./example.so Xvfs_example; puts OK' | tclsh | grep '^OK$$'
	echo 'if {[catch { load ./example.so Xvfs_example; source //xvfs:/main.tcl }]} { puts stderr $$::errorInfo; exit 1 }; exit 0' | tclsh

clean:
	rm -f example.so example.o example.c

distclean: clean

.PHONY: all clean distclean test

Modified xvfs-core.c from [1f3798f743] to [b7bfd15588].

1
2












3
4
5
6
7
8
9
10
11
12
13
14
15
16



17
18
19
20
21
22
23
24



































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31








32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98


+
+
+
+
+
+
+
+
+
+
+
+














+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <xvfs-core.h>
#include <tcl.h>

static int xvfs_tclvfs_standalone_pathInFilesystem(Tcl_Obj *path, ClientData *dataPtr) {
	return(TCL_ERROR);
}

static int xvfs_tclvfs_normalizePath(Tcl_Interp *interp, Tcl_Obj *path, int nextCheckpoint) {
	return(TCL_ERROR);
}

static Tcl_Obj *xvfs_tclvfs_listVolumes() {
	return(NULL);
}

/*
 * There are three (3) modes of operation for Xvfs_Register:
 *    1. standalone -- We register our own Tcl_Filesystem
 *                     and handle requests under `//xvfs:/<fsName>`
 *    2. client -- A single Tcl_Filesystem is registered for the
 *                 interp to handle requests under `//xvfs:/` which
 *                 then dispatches to the appropriate registered
 *                 handler
 *    3. flexible -- Attempts to find a core Xvfs instance for the
 *                   process at runtime, if found do #2, otherwise
 *                   fallback to #1
 *
 */
static int xvfs_standalone_register(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo) {
	Tcl_Filesystem *xvfsInfo;
	int tcl_ret;
static int Xvfs_Register_Standalone(Tcl_Interp *interp, const char *fsName, int protocolVersion, xvfs_proc_getChildren_t getChildrenProc, xvfs_proc_getData_t getDataProc) {
	Tcl_SetResult(interp, "Not implemented", NULL);
	return(TCL_ERROR);
}

int Xvfs_Register(Tcl_Interp *interp, const char *fsName, int protocolVersion, xvfs_proc_getChildren_t getChildrenProc, xvfs_proc_getData_t getDataProc) {
	return(Xvfs_Register_Standalone(interp, fsName, protocolVersion, getChildrenProc, getDataProc));
}
	
	/*
	 * In standalone mode, we only support the same protocol we are
	 * compiling for.
	 */
	if (fsInfo->protocolVersion != XVFS_PROTOCOL_VERSION) {
		if (interp) {
			Tcl_SetResult(interp, "Protocol mismatch", NULL);
		}
		return(TCL_ERROR);
	}
	
	xvfsInfo = (Tcl_Filesystem *) Tcl_AttemptAlloc(sizeof(*xvfsInfo));
	if (!xvfsInfo) {
		if (interp) {
			Tcl_SetResult(interp, "Unable to allocate Tcl_Filesystem object", NULL);
		}
		return(TCL_ERROR);
	}
	
	xvfsInfo->typeName                   = "xvfs";
	xvfsInfo->structureLength            = sizeof(*xvfsInfo);
	xvfsInfo->version                    = TCL_FILESYSTEM_VERSION_1;
	xvfsInfo->pathInFilesystemProc       = xvfs_tclvfs_standalone_pathInFilesystem;
	xvfsInfo->dupInternalRepProc         = NULL;
	xvfsInfo->freeInternalRepProc        = NULL;
	xvfsInfo->internalToNormalizedProc   = NULL;
	xvfsInfo->createInternalRepProc      = NULL;
	xvfsInfo->normalizePathProc          = xvfs_tclvfs_normalizePath;
	xvfsInfo->filesystemPathTypeProc     = NULL;
	xvfsInfo->filesystemSeparatorProc    = NULL;
	xvfsInfo->statProc                   = NULL;
	xvfsInfo->accessProc                 = NULL;
	xvfsInfo->openFileChannelProc        = NULL;
	xvfsInfo->matchInDirectoryProc       = NULL;
	xvfsInfo->utimeProc                  = NULL;
	xvfsInfo->linkProc                   = NULL;
	xvfsInfo->listVolumesProc            = xvfs_tclvfs_listVolumes;
	xvfsInfo->fileAttrStringsProc        = NULL;
	xvfsInfo->fileAttrsGetProc           = NULL;
	xvfsInfo->fileAttrsSetProc           = NULL;
	xvfsInfo->createDirectoryProc        = NULL;
	xvfsInfo->removeDirectoryProc        = NULL;
	xvfsInfo->deleteFileProc             = NULL;
	xvfsInfo->copyFileProc               = NULL;
	xvfsInfo->renameFileProc             = NULL;
	xvfsInfo->copyDirectoryProc          = NULL;
	xvfsInfo->lstatProc                  = NULL;
	xvfsInfo->loadFileProc               = NULL;
	xvfsInfo->getCwdProc                 = NULL;
	xvfsInfo->chdirProc                  = NULL;

	tcl_ret = Tcl_FSRegister(NULL, xvfsInfo);
	if (tcl_ret != TCL_OK) {
		if (interp) {
			Tcl_SetResult(interp, "Tcl_FSRegister() failed", NULL);
		}
		
		return(tcl_ret);
	}
	
	return(TCL_OK);
}

int Xvfs_Register(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo) {
	return(xvfs_standalone_register(interp, fsInfo));
}

Modified xvfs-core.h from [ac0a17191f] to [ac3847ed22].

1
2
3
4
5
6
7
8
9
10







11

12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

18
19
20










+
+
+
+
+
+
+
-
+


#ifndef XVFS_COMMON_H_1B4B28D60EBAA11D5FF85642FA7CA22C29E8E817
#define XVFS_COMMON_H_1B4B28D60EBAA11D5FF85642FA7CA22C29E8E817 1

#include <tcl.h>

#define XVFS_PROTOCOL_VERSION 1

typedef const char **(*xvfs_proc_getChildren_t)(const char *path, Tcl_WideInt *count);
typedef const unsigned char *(*xvfs_proc_getData_t)(const char *path, Tcl_WideInt start, Tcl_WideInt *length);

struct Xvfs_FSInfo {
	int                      protocolVersion;
	const char               *fsName;
	xvfs_proc_getChildren_t  getChildrenProc;
	xvfs_proc_getData_t      getDataProc;
};

int Xvfs_Register(Tcl_Interp *interp, const char *fsName, int protocolVersion, xvfs_proc_getChildren_t getChildrenProc, xvfs_proc_getData_t getDataProc);
int Xvfs_Register(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo);

#endif

Modified xvfs.c.rvt from [8333f0cfa8] to [6b271a3398].

129
130
131
132
133
134
135






136
137
138
139
140











141
142
143
144
145
146
129
130
131
132
133
134
135
136
137
138
139
140
141
142




143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159







+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+






	/*
	 * Return the data
	 */
	return(fileInfo->data.fileContents + start);
}

int Xvfs_<?= $::xvfs::fsName ?>_Init(Tcl_Interp *interp) {
	struct Xvfs_FSInfo fsInfo = {
		.protocolVersion = XVFS_PROTOCOL_VERSION,
		.fsName          = "<?= $::xvfs::fsName ?>",
		.getChildrenProc = xvfs_<?= $::xvfs::fsName ?>_getChildren,
		.getDataProc     = xvfs_<?= $::xvfs::fsName ?>_getData
	};
	int register_ret;
	
	/* XXX:TODO: Stubs */
	
	register_ret = Xvfs_Register(interp, "<?= $::xvfs::fsName ?>", XVFS_PROTOCOL_VERSION, xvfs_<?= $::xvfs::fsName ?>_getChildren, xvfs_<?= $::xvfs::fsName ?>_getData);

#ifdef USE_TCL_STUBS
	const char *tclInitStubs_ret;
	/* Initialize Stubs */
	tclInitStubs_ret = Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0);
	if (!tclInitStubs_ret) {
		return(TCL_ERROR);
	}
#endif
	
	register_ret = Xvfs_Register(interp, &fsInfo);
	if (register_ret != TCL_OK) {
		return(register_ret);
	}
	
	return(TCL_OK);
}